diff options
| author | Glenn Morris | 2008-03-14 03:31:52 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-14 03:31:52 +0000 |
| commit | 6bd7c8eb8fc3801fc65c11dba09eb8f765f0b8b1 (patch) | |
| tree | d1a8fe33b945948d2fbf0a0315b6368c592800bd | |
| parent | 6cd61ebd91f7f72ce55c6445884c46d3af926a21 (diff) | |
| download | emacs-6bd7c8eb8fc3801fc65c11dba09eb8f765f0b8b1.tar.gz emacs-6bd7c8eb8fc3801fc65c11dba09eb8f765f0b8b1.zip | |
(calendar-bahai-month-name-array, calendar-bahai-leap-base): Add doc strings.
(calendar-bahai-prompt-for-date, calendar-bahai-mark-date-pattern):
Move definition before use.
(calendar-bahai-goto-date, diary-bahai-list-entries): Doc fix.
(diary-bahai-list-entries, diary-bahai-mark-entries): Move some constant
variables outside the loop. Use dolist.
| -rw-r--r-- | lisp/ChangeLog | 9 | ||||
| -rw-r--r-- | lisp/calendar/cal-bahai.el | 296 |
2 files changed, 154 insertions, 151 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8d6618a3938..376b158738a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -3,6 +3,15 @@ | |||
| 3 | * startup.el (command-line-1): Rename -internal-script back to | 3 | * startup.el (command-line-1): Rename -internal-script back to |
| 4 | -scriptload (reverts previous change). | 4 | -scriptload (reverts previous change). |
| 5 | 5 | ||
| 6 | * calendar/cal-bahai.el (calendar-bahai-month-name-array) | ||
| 7 | (calendar-bahai-leap-base): Add doc strings. | ||
| 8 | (calendar-bahai-prompt-for-date, calendar-bahai-mark-date-pattern): | ||
| 9 | Move definition before use. | ||
| 10 | (calendar-bahai-goto-date, diary-bahai-list-entries): Doc fix. | ||
| 11 | (diary-bahai-list-entries, diary-bahai-mark-entries): Move some constant | ||
| 12 | variables outside the loop. Use dolist. | ||
| 13 | (holiday-bahai, calendar-bahai-mark-date-pattern): Use unless. | ||
| 14 | |||
| 6 | * calendar/cal-china.el: Re-order so that functions are defined before | 15 | * calendar/cal-china.el: Re-order so that functions are defined before |
| 7 | use. | 16 | use. |
| 8 | (displayed-month, displayed-year): Move declarations where needed. | 17 | (displayed-month, displayed-year): Move declarations where needed. |
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 911ee588dbb..354fcfa3cdc 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el | |||
| @@ -60,7 +60,8 @@ | |||
| 60 | (defconst calendar-bahai-month-name-array | 60 | (defconst calendar-bahai-month-name-array |
| 61 | ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál" | 61 | ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál" |
| 62 | "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il" | 62 | "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il" |
| 63 | "Sharaf" "Sultán" "Mulk" "`Alá"]) | 63 | "Sharaf" "Sultán" "Mulk" "`Alá"] |
| 64 | "Array of the month names in the Bahá'í calendar.") | ||
| 64 | 65 | ||
| 65 | (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) | 66 | (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) |
| 66 | "Absolute date of start of Bahá'í calendar = March 19, 622 A.D. (Julian).") | 67 | "Absolute date of start of Bahá'í calendar = March 19, 622 A.D. (Julian).") |
| @@ -70,7 +71,8 @@ | |||
| 70 | (calendar-leap-year-p (+ year 1844))) | 71 | (calendar-leap-year-p (+ year 1844))) |
| 71 | 72 | ||
| 72 | (defconst calendar-bahai-leap-base | 73 | (defconst calendar-bahai-leap-base |
| 73 | (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400))) | 74 | (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)) |
| 75 | "Used by `calendar-absolute-from-bahai'.") | ||
| 74 | 76 | ||
| 75 | (defun calendar-absolute-from-bahai (date) | 77 | (defun calendar-absolute-from-bahai (date) |
| 76 | "Compute absolute date from Bahá'í date DATE. | 78 | "Compute absolute date from Bahá'í date DATE. |
| @@ -145,15 +147,6 @@ Defaults to today's date if DATE is not given." | |||
| 145 | (message "Bahá'í date: %s" | 147 | (message "Bahá'í date: %s" |
| 146 | (calendar-bahai-date-string (calendar-cursor-to-date t)))) | 148 | (calendar-bahai-date-string (calendar-cursor-to-date t)))) |
| 147 | 149 | ||
| 148 | ;;;###cal-autoload | ||
| 149 | (defun calendar-bahai-goto-date (date &optional noecho) | ||
| 150 | "Move cursor to Bahá'í date DATE. | ||
| 151 | Echo Bahá'í date unless NOECHO is t." | ||
| 152 | (interactive (calendar-bahai-prompt-for-date)) | ||
| 153 | (calendar-goto-date (calendar-gregorian-from-absolute | ||
| 154 | (calendar-absolute-from-bahai date))) | ||
| 155 | (or noecho (calendar-bahai-print-date))) | ||
| 156 | |||
| 157 | (defun calendar-bahai-prompt-for-date () | 150 | (defun calendar-bahai-prompt-for-date () |
| 158 | "Ask for a Bahá'í date." | 151 | "Ask for a Bahá'í date." |
| 159 | (let* ((today (calendar-current-date)) | 152 | (let* ((today (calendar-current-date)) |
| @@ -177,6 +170,15 @@ Echo Bahá'í date unless NOECHO is t." | |||
| 177 | (lambda (x) (and (< 0 x) (<= x 19)))))) | 170 | (lambda (x) (and (< 0 x) (<= x 19)))))) |
| 178 | (list (list month day year)))) | 171 | (list (list month day year)))) |
| 179 | 172 | ||
| 173 | ;;;###cal-autoload | ||
| 174 | (defun calendar-bahai-goto-date (date &optional noecho) | ||
| 175 | "Move cursor to Bahá'í date DATE. | ||
| 176 | Echo Bahá'í date unless NOECHO is non-nil." | ||
| 177 | (interactive (calendar-bahai-prompt-for-date)) | ||
| 178 | (calendar-goto-date (calendar-gregorian-from-absolute | ||
| 179 | (calendar-absolute-from-bahai date))) | ||
| 180 | (or noecho (calendar-bahai-print-date))) | ||
| 181 | |||
| 180 | (defvar displayed-month) | 182 | (defvar displayed-month) |
| 181 | (defvar displayed-year) | 183 | (defvar displayed-year) |
| 182 | 184 | ||
| @@ -211,14 +213,13 @@ nil if it is not visible in the current calendar window." | |||
| 211 | ;;;###diary-autoload | 213 | ;;;###diary-autoload |
| 212 | (defun diary-bahai-list-entries () | 214 | (defun diary-bahai-list-entries () |
| 213 | "Add any Bahá'í date entries from the diary file to `diary-entries-list'. | 215 | "Add any Bahá'í date entries from the diary file to `diary-entries-list'. |
| 214 | Bahá'í date diary entries must be prefaced by an | 216 | Bahá'í date diary entries must be prefaced by `bahai-diary-entry-symbol' |
| 215 | `bahai-diary-entry-symbol' (normally a `B'). The same diary date | 217 | \(normally a `B'). The same diary date forms govern the style of the |
| 216 | forms govern the style of the Bahá'í calendar entries, except that the | 218 | Bahá'í calendar entries, except that the Bahá'í month names must be given |
| 217 | Bahá'í month names must be given numerically. The Bahá'í months are | 219 | numerically. The Bahá'í months are numbered from 1 to 19 with Bahá being |
| 218 | numbered from 1 to 19 with Bahá being 1 and 19 being `Alá. If a | 220 | 1 and 19 being `Alá. If a Bahá'í date diary entry begins with |
| 219 | Bahá'í date diary entry begins with a `diary-nonmarking-symbol', the | 221 | `diary-nonmarking-symbol', the entry will appear in the diary listing, but |
| 220 | entry will appear in the diary listing, but will not be marked in the | 222 | will not be marked in the calendar. This function is provided for use with |
| 221 | calendar. This function is provided for use with the | ||
| 222 | `nongregorian-diary-listing-hook'." | 223 | `nongregorian-diary-listing-hook'." |
| 223 | (if (< 0 number) | 224 | (if (< 0 number) |
| 224 | (let ((buffer-read-only nil) | 225 | (let ((buffer-read-only nil) |
| @@ -226,44 +227,42 @@ calendar. This function is provided for use with the | |||
| 226 | (gdate original-date) | 227 | (gdate original-date) |
| 227 | (mark (regexp-quote diary-nonmarking-symbol))) | 228 | (mark (regexp-quote diary-nonmarking-symbol))) |
| 228 | (dotimes (idummy number) | 229 | (dotimes (idummy number) |
| 229 | (let* ((d diary-date-forms) | 230 | (let* ((bdate (calendar-bahai-from-absolute |
| 230 | (bdate (calendar-bahai-from-absolute | ||
| 231 | (calendar-absolute-from-gregorian gdate))) | 231 | (calendar-absolute-from-gregorian gdate))) |
| 232 | (month (extract-calendar-month bdate)) | 232 | (month (extract-calendar-month bdate)) |
| 233 | (day (extract-calendar-day bdate)) | 233 | (day (extract-calendar-day bdate)) |
| 234 | (year (extract-calendar-year bdate))) | 234 | (year (extract-calendar-year bdate)) |
| 235 | (while d | 235 | backup) |
| 236 | (let* | 236 | (dolist (date-form diary-date-forms) |
| 237 | ((date-form (if (equal (car (car d)) 'backup) | 237 | (if (setq backup (eq (car date-form) 'backup)) |
| 238 | (cdr (car d)) | 238 | (setq date-form (cdr date-form))) |
| 239 | (car d))) | 239 | (let* ((dayname |
| 240 | (backup (equal (car (car d)) 'backup)) | 240 | (concat |
| 241 | (dayname | 241 | (calendar-day-name gdate) "\\|" |
| 242 | (concat | 242 | (substring (calendar-day-name gdate) 0 3) ".?")) |
| 243 | (calendar-day-name gdate) "\\|" | 243 | (calendar-month-name-array |
| 244 | (substring (calendar-day-name gdate) 0 3) ".?")) | 244 | calendar-bahai-month-name-array) |
| 245 | (calendar-month-name-array | 245 | (monthname |
| 246 | calendar-bahai-month-name-array) | 246 | (concat |
| 247 | (monthname | 247 | "\\*\\|" |
| 248 | (concat | 248 | (calendar-month-name month))) |
| 249 | "\\*\\|" | 249 | (month (concat "\\*\\|0*" (int-to-string month))) |
| 250 | (calendar-month-name month))) | 250 | (day (concat "\\*\\|0*" (int-to-string day))) |
| 251 | (month (concat "\\*\\|0*" (int-to-string month))) | 251 | (year |
| 252 | (day (concat "\\*\\|0*" (int-to-string day))) | 252 | (concat |
| 253 | (year | 253 | "\\*\\|0*" (int-to-string year) |
| 254 | (concat | 254 | (if abbreviated-calendar-year |
| 255 | "\\*\\|0*" (int-to-string year) | 255 | (concat "\\|" (int-to-string (% year 100))) |
| 256 | (if abbreviated-calendar-year | 256 | ""))) |
| 257 | (concat "\\|" (int-to-string (% year 100))) | 257 | ;; FIXME get rid of the ^M stuff. |
| 258 | ""))) | 258 | (regexp |
| 259 | (regexp | 259 | (concat |
| 260 | (concat | 260 | "\\(\\`\\|\^M\\|\n\\)" mark "?" |
| 261 | "\\(\\`\\|\^M\\|\n\\)" mark "?" | 261 | (regexp-quote bahai-diary-entry-symbol) |
| 262 | (regexp-quote bahai-diary-entry-symbol) | 262 | "\\(" |
| 263 | "\\(" | 263 | (mapconcat 'eval date-form "\\)\\(") |
| 264 | (mapconcat 'eval date-form "\\)\\(") | 264 | "\\)")) |
| 265 | "\\)")) | 265 | (case-fold-search t)) |
| 266 | (case-fold-search t)) | ||
| 267 | (goto-char (point-min)) | 266 | (goto-char (point-min)) |
| 268 | (while (re-search-forward regexp nil t) | 267 | (while (re-search-forward regexp nil t) |
| 269 | (if backup (re-search-backward "\\<" nil t)) | 268 | (if backup (re-search-backward "\\<" nil t)) |
| @@ -287,14 +286,73 @@ calendar. This function is provided for use with the | |||
| 287 | gdate | 286 | gdate |
| 288 | (buffer-substring-no-properties entry-start (point)) | 287 | (buffer-substring-no-properties entry-start (point)) |
| 289 | (buffer-substring-no-properties | 288 | (buffer-substring-no-properties |
| 290 | (1+ date-start) (1- entry-start))))))) | 289 | (1+ date-start) (1- entry-start))))))))) |
| 291 | (setq d (cdr d)))) | ||
| 292 | (setq gdate | 290 | (setq gdate |
| 293 | (calendar-gregorian-from-absolute | 291 | (calendar-gregorian-from-absolute |
| 294 | (1+ (calendar-absolute-from-gregorian gdate))))) | 292 | (1+ (calendar-absolute-from-gregorian gdate))))) |
| 295 | (set-buffer-modified-p diary-modified)) | 293 | (set-buffer-modified-p diary-modified)) |
| 296 | (goto-char (point-min)))) | 294 | (goto-char (point-min)))) |
| 297 | 295 | ||
| 296 | ;;;###diary-autoload | ||
| 297 | (defun calendar-bahai-mark-date-pattern (month day year) | ||
| 298 | "Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR. | ||
| 299 | A value of 0 in any position is a wildcard." | ||
| 300 | (save-excursion | ||
| 301 | (set-buffer calendar-buffer) | ||
| 302 | (if (and (not (zerop month)) (not (zerop day))) | ||
| 303 | (if (not (zerop year)) | ||
| 304 | ;; Fully specified Bahá'í date. | ||
| 305 | (let ((date (calendar-gregorian-from-absolute | ||
| 306 | (calendar-absolute-from-bahai | ||
| 307 | (list month day year))))) | ||
| 308 | (if (calendar-date-is-visible-p date) | ||
| 309 | (mark-visible-calendar-date date))) | ||
| 310 | ;; Month and day in any year--this taken from the holiday stuff. | ||
| 311 | (let* ((bahai-date (calendar-bahai-from-absolute | ||
| 312 | (calendar-absolute-from-gregorian | ||
| 313 | (list displayed-month 15 displayed-year)))) | ||
| 314 | (m (extract-calendar-month bahai-date)) | ||
| 315 | (y (extract-calendar-year bahai-date)) | ||
| 316 | (date)) | ||
| 317 | (if (< m 1) | ||
| 318 | nil ; Bahá'í calendar doesn't apply | ||
| 319 | (increment-calendar-month m y (- 10 month)) | ||
| 320 | (if (> m 7) ; Bahá'í date might be visible | ||
| 321 | (let ((date (calendar-gregorian-from-absolute | ||
| 322 | (calendar-absolute-from-bahai | ||
| 323 | (list month day y))))) | ||
| 324 | (if (calendar-date-is-visible-p date) | ||
| 325 | (mark-visible-calendar-date date))))))) | ||
| 326 | ;; Not one of the simple cases--check all visible dates for match. | ||
| 327 | ;; Actually, the following code takes care of ALL of the cases, but | ||
| 328 | ;; it's much too slow to be used for the simple (common) cases. | ||
| 329 | (let ((m displayed-month) | ||
| 330 | (y displayed-year) | ||
| 331 | (first-date) | ||
| 332 | (last-date)) | ||
| 333 | (increment-calendar-month m y -1) | ||
| 334 | (setq first-date | ||
| 335 | (calendar-absolute-from-gregorian | ||
| 336 | (list m 1 y))) | ||
| 337 | (increment-calendar-month m y 2) | ||
| 338 | (setq last-date | ||
| 339 | (calendar-absolute-from-gregorian | ||
| 340 | (list m (calendar-last-day-of-month m y) y))) | ||
| 341 | (calendar-for-loop date from first-date to last-date do | ||
| 342 | (let* ((b-date (calendar-bahai-from-absolute date)) | ||
| 343 | (i-month (extract-calendar-month b-date)) | ||
| 344 | (i-day (extract-calendar-day b-date)) | ||
| 345 | (i-year (extract-calendar-year b-date))) | ||
| 346 | (and (or (zerop month) | ||
| 347 | (= month i-month)) | ||
| 348 | (or (zerop day) | ||
| 349 | (= day i-day)) | ||
| 350 | (or (zerop year) | ||
| 351 | (= year i-year)) | ||
| 352 | (mark-visible-calendar-date | ||
| 353 | (calendar-gregorian-from-absolute | ||
| 354 | date))))))))) | ||
| 355 | |||
| 298 | (declare-function diary-name-pattern "diary-lib" | 356 | (declare-function diary-name-pattern "diary-lib" |
| 299 | (string-array &optional abbrev-array paren)) | 357 | (string-array &optional abbrev-array paren)) |
| 300 | 358 | ||
| @@ -313,39 +371,36 @@ Bahá'í months are numbered from 1 to 12 with Bahá being 1 and 12 being | |||
| 313 | `Alá. Bahá'í date diary entries that begin with `diary-nonmarking-symbol' | 371 | `Alá. Bahá'í date diary entries that begin with `diary-nonmarking-symbol' |
| 314 | will not be marked in the calendar. This function is provided for use as | 372 | will not be marked in the calendar. This function is provided for use as |
| 315 | part of `nongregorian-diary-marking-hook'." | 373 | part of `nongregorian-diary-marking-hook'." |
| 316 | (let ((d diary-date-forms)) | 374 | (let ((dayname (diary-name-pattern calendar-day-name-array)) |
| 317 | (while d | 375 | (monthname |
| 318 | (let* | 376 | (concat |
| 319 | ((date-form (if (equal (car (car d)) 'backup) | 377 | (diary-name-pattern calendar-bahai-month-name-array t) |
| 320 | (cdr (car d)) | 378 | "\\|\\*")) |
| 321 | (car d))) ; ignore 'backup directive | 379 | (month "[0-9]+\\|\\*") |
| 322 | (dayname (diary-name-pattern calendar-day-name-array)) | 380 | (day "[0-9]+\\|\\*") |
| 323 | (monthname | 381 | (year "[0-9]+\\|\\*") |
| 324 | (concat | 382 | (case-fold-search t)) |
| 325 | (diary-name-pattern calendar-bahai-month-name-array t) | 383 | (dolist (date-form diary-date-forms) |
| 326 | "\\|\\*")) | 384 | (if (eq (car date-form) 'backup) ; ignore 'backup directive |
| 327 | (month "[0-9]+\\|\\*") | 385 | (setq date-form (cdr date-form))) |
| 328 | (day "[0-9]+\\|\\*") | 386 | (let* ((l (length date-form)) |
| 329 | (year "[0-9]+\\|\\*") | 387 | (d-name-pos (- l (length (memq 'dayname date-form)))) |
| 330 | (l (length date-form)) | 388 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) |
| 331 | (d-name-pos (- l (length (memq 'dayname date-form)))) | 389 | (m-name-pos (- l (length (memq 'monthname date-form)))) |
| 332 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) | 390 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) |
| 333 | (m-name-pos (- l (length (memq 'monthname date-form)))) | 391 | (d-pos (- l (length (memq 'day date-form)))) |
| 334 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) | 392 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) |
| 335 | (d-pos (- l (length (memq 'day date-form)))) | 393 | (m-pos (- l (length (memq 'month date-form)))) |
| 336 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) | 394 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) |
| 337 | (m-pos (- l (length (memq 'month date-form)))) | 395 | (y-pos (- l (length (memq 'year date-form)))) |
| 338 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) | 396 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) |
| 339 | (y-pos (- l (length (memq 'year date-form)))) | 397 | (regexp |
| 340 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) | 398 | (concat |
| 341 | (regexp | 399 | "\\(\\`\\|\^M\\|\n\\)" |
| 342 | (concat | 400 | (regexp-quote bahai-diary-entry-symbol) |
| 343 | "\\(\\`\\|\^M\\|\n\\)" | 401 | "\\(" |
| 344 | (regexp-quote bahai-diary-entry-symbol) | 402 | (mapconcat 'eval date-form "\\)\\(") |
| 345 | "\\(" | 403 | "\\)"))) |
| 346 | (mapconcat 'eval date-form "\\)\\(") | ||
| 347 | "\\)")) | ||
| 348 | (case-fold-search t)) | ||
| 349 | (goto-char (point-min)) | 404 | (goto-char (point-min)) |
| 350 | (while (re-search-forward regexp nil t) | 405 | (while (re-search-forward regexp nil t) |
| 351 | (let* ((dd-name | 406 | (let* ((dd-name |
| @@ -408,68 +463,7 @@ part of `nongregorian-diary-marking-hook'." | |||
| 408 | (calendar-make-alist | 463 | (calendar-make-alist |
| 409 | calendar-bahai-month-name-array) | 464 | calendar-bahai-month-name-array) |
| 410 | t))))) | 465 | t))))) |
| 411 | (calendar-bahai-mark-date-pattern mm dd yy))))) | 466 | (calendar-bahai-mark-date-pattern mm dd yy)))))))) |
| 412 | (setq d (cdr d))))) | ||
| 413 | |||
| 414 | ;;;###diary-autoload | ||
| 415 | (defun calendar-bahai-mark-date-pattern (month day year) | ||
| 416 | "Mark dates in calendar window that conform to Bahá'í date MONTH/DAY/YEAR. | ||
| 417 | A value of 0 in any position is a wildcard." | ||
| 418 | (save-excursion | ||
| 419 | (set-buffer calendar-buffer) | ||
| 420 | (if (and (not (zerop month)) (not (zerop day))) | ||
| 421 | (if (not (zerop year)) | ||
| 422 | ;; Fully specified Bahá'í date. | ||
| 423 | (let ((date (calendar-gregorian-from-absolute | ||
| 424 | (calendar-absolute-from-bahai | ||
| 425 | (list month day year))))) | ||
| 426 | (if (calendar-date-is-visible-p date) | ||
| 427 | (mark-visible-calendar-date date))) | ||
| 428 | ;; Month and day in any year--this taken from the holiday stuff. | ||
| 429 | (let* ((bahai-date (calendar-bahai-from-absolute | ||
| 430 | (calendar-absolute-from-gregorian | ||
| 431 | (list displayed-month 15 displayed-year)))) | ||
| 432 | (m (extract-calendar-month bahai-date)) | ||
| 433 | (y (extract-calendar-year bahai-date)) | ||
| 434 | (date)) | ||
| 435 | (if (< m 1) | ||
| 436 | nil ; Bahá'í calendar doesn't apply | ||
| 437 | (increment-calendar-month m y (- 10 month)) | ||
| 438 | (if (> m 7) ; Bahá'í date might be visible | ||
| 439 | (let ((date (calendar-gregorian-from-absolute | ||
| 440 | (calendar-absolute-from-bahai | ||
| 441 | (list month day y))))) | ||
| 442 | (if (calendar-date-is-visible-p date) | ||
| 443 | (mark-visible-calendar-date date))))))) | ||
| 444 | ;; Not one of the simple cases--check all visible dates for match. | ||
| 445 | ;; Actually, the following code takes care of ALL of the cases, but | ||
| 446 | ;; it's much too slow to be used for the simple (common) cases. | ||
| 447 | (let ((m displayed-month) | ||
| 448 | (y displayed-year) | ||
| 449 | (first-date) | ||
| 450 | (last-date)) | ||
| 451 | (increment-calendar-month m y -1) | ||
| 452 | (setq first-date | ||
| 453 | (calendar-absolute-from-gregorian | ||
| 454 | (list m 1 y))) | ||
| 455 | (increment-calendar-month m y 2) | ||
| 456 | (setq last-date | ||
| 457 | (calendar-absolute-from-gregorian | ||
| 458 | (list m (calendar-last-day-of-month m y) y))) | ||
| 459 | (calendar-for-loop date from first-date to last-date do | ||
| 460 | (let* ((b-date (calendar-bahai-from-absolute date)) | ||
| 461 | (i-month (extract-calendar-month b-date)) | ||
| 462 | (i-day (extract-calendar-day b-date)) | ||
| 463 | (i-year (extract-calendar-year b-date))) | ||
| 464 | (and (or (zerop month) | ||
| 465 | (= month i-month)) | ||
| 466 | (or (zerop day) | ||
| 467 | (= day i-day)) | ||
| 468 | (or (zerop year) | ||
| 469 | (= year i-year)) | ||
| 470 | (mark-visible-calendar-date | ||
| 471 | (calendar-gregorian-from-absolute | ||
| 472 | date))))))))) | ||
| 473 | 467 | ||
| 474 | ;;;###cal-autoload | 468 | ;;;###cal-autoload |
| 475 | (defun diary-bahai-insert-entry (arg) | 469 | (defun diary-bahai-insert-entry (arg) |