diff options
| author | Glenn Morris | 2008-03-14 07:13:59 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-14 07:13:59 +0000 |
| commit | f852191f5e7d97b7fe359116ac563d0137a8c117 (patch) | |
| tree | 0ce4cac99d66b2933a735233058a1e16af384e82 | |
| parent | 9c0b91874c9ab371d3f1b53be56f5274bb06a436 (diff) | |
| download | emacs-f852191f5e7d97b7fe359116ac563d0137a8c117.tar.gz emacs-f852191f5e7d97b7fe359116ac563d0137a8c117.zip | |
(displayed-month, displayed-year)
(original-date): Move declarations where needed.
(islamic-calendar-day-number): Remove unused local variable `day'.
(calendar-goto-islamic-date): Doc fix.
(holiday-islamic): Use unless.
(list-islamic-diary-entries, mark-islamic-diary-entries): Move some
constant variables outside the loop. Use dolist.
(mark-islamic-calendar-date-pattern): Move definition before use.
Use unless.
(mark-islamic-diary-entries): Doc fix.
(insert-islamic-diary-entry, insert-monthly-islamic-diary-entry)
(insert-yearly-islamic-diary-entry): Use let rather than let*.
| -rw-r--r-- | lisp/ChangeLog | 13 | ||||
| -rw-r--r-- | lisp/calendar/cal-islam.el | 379 |
2 files changed, 197 insertions, 195 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 9b645ac1de9..75125030b4b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -51,6 +51,19 @@ | |||
| 51 | (list-hebrew-diary-entries, mark-hebrew-diary-entries): Move some | 51 | (list-hebrew-diary-entries, mark-hebrew-diary-entries): Move some |
| 52 | constant variables outside the loop. Use dolist. | 52 | constant variables outside the loop. Use dolist. |
| 53 | 53 | ||
| 54 | * calendar/cal-islam.el (displayed-month, displayed-year) | ||
| 55 | (original-date): Move declarations where needed. | ||
| 56 | (islamic-calendar-day-number): Remove unused local variable `day'. | ||
| 57 | (calendar-goto-islamic-date): Doc fix. | ||
| 58 | (holiday-islamic): Use unless. | ||
| 59 | (list-islamic-diary-entries, mark-islamic-diary-entries): Move some | ||
| 60 | constant variables outside the loop. Use dolist. | ||
| 61 | (mark-islamic-calendar-date-pattern): Move definition before use. | ||
| 62 | Use unless. | ||
| 63 | (mark-islamic-diary-entries): Doc fix. | ||
| 64 | (insert-islamic-diary-entry, insert-monthly-islamic-diary-entry) | ||
| 65 | (insert-yearly-islamic-diary-entry): Use let rather than let*. | ||
| 66 | |||
| 54 | * calendar/cal-julian.el (calendar-absolute-from-julian): Move | 67 | * calendar/cal-julian.el (calendar-absolute-from-julian): Move |
| 55 | definition before use. Remove un-needed local `day'. | 68 | definition before use. Remove un-needed local `day'. |
| 56 | (calendar-goto-julian-date, calendar-goto-astro-day-number): Doc fix. | 69 | (calendar-goto-julian-date, calendar-goto-astro-day-number): Doc fix. |
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index 6c915e2b8cf..5e760ef20fe 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el | |||
| @@ -36,10 +36,6 @@ | |||
| 36 | 36 | ||
| 37 | ;;; Code: | 37 | ;;; Code: |
| 38 | 38 | ||
| 39 | (defvar displayed-month) | ||
| 40 | (defvar displayed-year) | ||
| 41 | (defvar original-date) | ||
| 42 | |||
| 43 | (require 'cal-julian) | 39 | (require 'cal-julian) |
| 44 | 40 | ||
| 45 | (defvar calendar-islamic-month-name-array | 41 | (defvar calendar-islamic-month-name-array |
| @@ -64,11 +60,10 @@ | |||
| 64 | 60 | ||
| 65 | (defun islamic-calendar-day-number (date) | 61 | (defun islamic-calendar-day-number (date) |
| 66 | "Return the day number within the year of the Islamic date DATE." | 62 | "Return the day number within the year of the Islamic date DATE." |
| 67 | (let* ((month (extract-calendar-month date)) | 63 | (let ((month (extract-calendar-month date))) |
| 68 | (day (extract-calendar-day date))) | 64 | (+ (* 30 (/ month 2)) |
| 69 | (+ (* 30 (/ month 2)) | 65 | (* 29 (/ (1- month) 2)) |
| 70 | (* 29 (/ (1- month) 2)) | 66 | (extract-calendar-day date)))) |
| 71 | day))) | ||
| 72 | 67 | ||
| 73 | (defun calendar-absolute-from-islamic (date) | 68 | (defun calendar-absolute-from-islamic (date) |
| 74 | "Absolute date of Islamic DATE. | 69 | "Absolute date of Islamic DATE. |
| @@ -79,10 +74,17 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 79 | (year (extract-calendar-year date)) | 74 | (year (extract-calendar-year date)) |
| 80 | (y (% year 30)) | 75 | (y (% year 30)) |
| 81 | (leap-years-in-cycle | 76 | (leap-years-in-cycle |
| 82 | (cond | 77 | (cond ((< y 3) 0) |
| 83 | ((< y 3) 0) ((< y 6) 1) ((< y 8) 2) ((< y 11) 3) ((< y 14) 4) | 78 | ((< y 6) 1) |
| 84 | ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9) | 79 | ((< y 8) 2) |
| 85 | (t 10)))) | 80 | ((< y 11) 3) |
| 81 | ((< y 14) 4) | ||
| 82 | ((< y 17) 5) | ||
| 83 | ((< y 19) 6) | ||
| 84 | ((< y 22) 7) | ||
| 85 | ((< y 25) 8) | ||
| 86 | ((< y 27) 9) | ||
| 87 | (t 10)))) | ||
| 86 | (+ (islamic-calendar-day-number date) ; days so far this year | 88 | (+ (islamic-calendar-day-number date) ; days so far this year |
| 87 | (* (1- year) 354) ; days in all non-leap years | 89 | (* (1- year) 354) ; days in all non-leap years |
| 88 | (* 11 (/ year 30)) ; leap days in complete cycles | 90 | (* 11 (/ year 30)) ; leap days in complete cycles |
| @@ -142,7 +144,7 @@ Driven by the variable `calendar-date-display-form'." | |||
| 142 | 144 | ||
| 143 | ;;;###cal-autoload | 145 | ;;;###cal-autoload |
| 144 | (defun calendar-goto-islamic-date (date &optional noecho) | 146 | (defun calendar-goto-islamic-date (date &optional noecho) |
| 145 | "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t." | 147 | "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil." |
| 146 | (interactive | 148 | (interactive |
| 147 | (let* ((today (calendar-current-date)) | 149 | (let* ((today (calendar-current-date)) |
| 148 | (year (calendar-read | 150 | (year (calendar-read |
| @@ -169,6 +171,9 @@ Driven by the variable `calendar-date-display-form'." | |||
| 169 | (calendar-absolute-from-islamic date))) | 171 | (calendar-absolute-from-islamic date))) |
| 170 | (or noecho (calendar-print-islamic-date))) | 172 | (or noecho (calendar-print-islamic-date))) |
| 171 | 173 | ||
| 174 | (defvar displayed-month) ; from generate-calendar | ||
| 175 | (defvar displayed-year) | ||
| 176 | |||
| 172 | ;;;###holiday-autoload | 177 | ;;;###holiday-autoload |
| 173 | (defun holiday-islamic (month day string) | 178 | (defun holiday-islamic (month day string) |
| 174 | "Holiday on MONTH, DAY (Islamic) called STRING. | 179 | "Holiday on MONTH, DAY (Islamic) called STRING. |
| @@ -181,10 +186,9 @@ nil if it is not visible in the current calendar window." | |||
| 181 | (m (extract-calendar-month islamic-date)) | 186 | (m (extract-calendar-month islamic-date)) |
| 182 | (y (extract-calendar-year islamic-date)) | 187 | (y (extract-calendar-year islamic-date)) |
| 183 | (date)) | 188 | (date)) |
| 184 | (if (< m 1) | 189 | (unless (< m 1) ; Islamic calendar doesn't apply |
| 185 | nil ; Islamic calendar doesn't apply | ||
| 186 | (increment-calendar-month m y (- 10 month)) | 190 | (increment-calendar-month m y (- 10 month)) |
| 187 | (if (> m 7) ; Islamic date might be visible | 191 | (if (> m 7) ; Islamic date might be visible |
| 188 | (let ((date (calendar-gregorian-from-absolute | 192 | (let ((date (calendar-gregorian-from-absolute |
| 189 | (calendar-absolute-from-islamic (list month day y))))) | 193 | (calendar-absolute-from-islamic (list month day y))))) |
| 190 | (if (calendar-date-is-visible-p date) | 194 | (if (calendar-date-is-visible-p date) |
| @@ -195,6 +199,7 @@ nil if it is not visible in the current calendar window." | |||
| 195 | (date string specifier &optional marker globcolor literal)) | 199 | (date string specifier &optional marker globcolor literal)) |
| 196 | 200 | ||
| 197 | (defvar number) ; from diary-list-entries | 201 | (defvar number) ; from diary-list-entries |
| 202 | (defvar original-date) | ||
| 198 | 203 | ||
| 199 | ;;;###diary-autoload | 204 | ;;;###diary-autoload |
| 200 | (defun list-islamic-diary-entries () | 205 | (defun list-islamic-diary-entries () |
| @@ -214,44 +219,39 @@ marked in the calendar. This function is provided for use with | |||
| 214 | (gdate original-date) | 219 | (gdate original-date) |
| 215 | (mark (regexp-quote diary-nonmarking-symbol))) | 220 | (mark (regexp-quote diary-nonmarking-symbol))) |
| 216 | (dotimes (idummy number) | 221 | (dotimes (idummy number) |
| 217 | (let* ((d diary-date-forms) | 222 | (let* ((idate (calendar-islamic-from-absolute |
| 218 | (idate (calendar-islamic-from-absolute | ||
| 219 | (calendar-absolute-from-gregorian gdate))) | 223 | (calendar-absolute-from-gregorian gdate))) |
| 220 | (month (extract-calendar-month idate)) | 224 | (month (extract-calendar-month idate)) |
| 221 | (day (extract-calendar-day idate)) | 225 | (day (extract-calendar-day idate)) |
| 222 | (year (extract-calendar-year idate))) | 226 | (year (extract-calendar-year idate)) |
| 223 | (while d | 227 | backup) |
| 224 | (let* | 228 | (dolist (date-form diary-date-forms) |
| 225 | ((date-form (if (equal (car (car d)) 'backup) | 229 | (if (setq backup (eq (car date-form) 'backup)) |
| 226 | (cdr (car d)) | 230 | (setq date-form (cdr date-form))) |
| 227 | (car d))) | 231 | (let* ((dayname |
| 228 | (backup (equal (car (car d)) 'backup)) | 232 | (format "%s\\|%s\\.?" |
| 229 | (dayname | 233 | (calendar-day-name gdate) |
| 230 | (format "%s\\|%s\\.?" | 234 | (calendar-day-name gdate 'abbrev))) |
| 231 | (calendar-day-name gdate) | 235 | (calendar-month-name-array |
| 232 | (calendar-day-name gdate 'abbrev))) | 236 | calendar-islamic-month-name-array) |
| 233 | (calendar-month-name-array | 237 | (monthname |
| 234 | calendar-islamic-month-name-array) | 238 | (concat "\\*\\|" (calendar-month-name month))) |
| 235 | (monthname | 239 | (month (concat "\\*\\|0*" (int-to-string month))) |
| 236 | (concat | 240 | (day (concat "\\*\\|0*" (int-to-string day))) |
| 237 | "\\*\\|" | 241 | (year |
| 238 | (calendar-month-name month))) | 242 | (concat "\\*\\|0*" (int-to-string year) |
| 239 | (month (concat "\\*\\|0*" (int-to-string month))) | 243 | (if abbreviated-calendar-year |
| 240 | (day (concat "\\*\\|0*" (int-to-string day))) | 244 | (concat "\\|" (int-to-string (% year 100))) |
| 241 | (year | 245 | ""))) |
| 242 | (concat | 246 | ;; FIXME ^M can go now. |
| 243 | "\\*\\|0*" (int-to-string year) | 247 | (regexp |
| 244 | (if abbreviated-calendar-year | 248 | (concat |
| 245 | (concat "\\|" (int-to-string (% year 100))) | 249 | "\\(\\`\\|\^M\\|\n\\)" mark "?" |
| 246 | ""))) | 250 | (regexp-quote islamic-diary-entry-symbol) |
| 247 | (regexp | 251 | "\\(" |
| 248 | (concat | 252 | (mapconcat 'eval date-form "\\)\\(") |
| 249 | "\\(\\`\\|\^M\\|\n\\)" mark "?" | 253 | "\\)")) |
| 250 | (regexp-quote islamic-diary-entry-symbol) | 254 | (case-fold-search t)) |
| 251 | "\\(" | ||
| 252 | (mapconcat 'eval date-form "\\)\\(") | ||
| 253 | "\\)")) | ||
| 254 | (case-fold-search t)) | ||
| 255 | (goto-char (point-min)) | 255 | (goto-char (point-min)) |
| 256 | (while (re-search-forward regexp nil t) | 256 | (while (re-search-forward regexp nil t) |
| 257 | (if backup (re-search-backward "\\<" nil t)) | 257 | (if backup (re-search-backward "\\<" nil t)) |
| @@ -276,124 +276,13 @@ marked in the calendar. This function is provided for use with | |||
| 276 | (buffer-substring-no-properties entry-start (point)) | 276 | (buffer-substring-no-properties entry-start (point)) |
| 277 | (buffer-substring-no-properties | 277 | (buffer-substring-no-properties |
| 278 | (1+ date-start) (1- entry-start)) | 278 | (1+ date-start) (1- entry-start)) |
| 279 | (copy-marker entry-start)))))) | 279 | (copy-marker entry-start)))))))) |
| 280 | (setq d (cdr d)))) | ||
| 281 | (setq gdate | 280 | (setq gdate |
| 282 | (calendar-gregorian-from-absolute | 281 | (calendar-gregorian-from-absolute |
| 283 | (1+ (calendar-absolute-from-gregorian gdate))))) | 282 | (1+ (calendar-absolute-from-gregorian gdate))))) |
| 284 | (set-buffer-modified-p diary-modified)) | 283 | (set-buffer-modified-p diary-modified)) |
| 285 | (goto-char (point-min)))) | 284 | (goto-char (point-min)))) |
| 286 | 285 | ||
| 287 | (declare-function diary-name-pattern "diary-lib" | ||
| 288 | (string-array &optional abbrev-array paren)) | ||
| 289 | |||
| 290 | (declare-function mark-calendar-days-named "diary-lib" | ||
| 291 | (dayname &optional color)) | ||
| 292 | |||
| 293 | ;;;###diary-autoload | ||
| 294 | (defun mark-islamic-diary-entries () | ||
| 295 | "Mark days in the calendar window that have Islamic date diary entries. | ||
| 296 | Each entry in `diary-file' (or included files) visible in the calendar window | ||
| 297 | is marked. Islamic date entries are prefaced by `islamic-diary-entry-symbol' | ||
| 298 | \(normally an `I'). The same `diary-date-forms' govern the style of the Islamic | ||
| 299 | calendar entries, except that the Islamic month names must be spelled in full. | ||
| 300 | The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being | ||
| 301 | Dhu al-Hijjah. Islamic date diary entries that begin with a | ||
| 302 | `diary-nonmarking-symbol' will not be marked in the calendar. This function is | ||
| 303 | provided for use as part of the `nongregorian-diary-marking-hook'." | ||
| 304 | (let ((d diary-date-forms)) | ||
| 305 | (while d | ||
| 306 | (let* | ||
| 307 | ((date-form (if (equal (car (car d)) 'backup) | ||
| 308 | (cdr (car d)) | ||
| 309 | (car d))) ; ignore 'backup directive | ||
| 310 | (dayname (diary-name-pattern calendar-day-name-array | ||
| 311 | calendar-day-abbrev-array)) | ||
| 312 | (monthname | ||
| 313 | (format "%s\\|\\*" | ||
| 314 | (diary-name-pattern calendar-islamic-month-name-array))) | ||
| 315 | (month "[0-9]+\\|\\*") | ||
| 316 | (day "[0-9]+\\|\\*") | ||
| 317 | (year "[0-9]+\\|\\*") | ||
| 318 | (l (length date-form)) | ||
| 319 | (d-name-pos (- l (length (memq 'dayname date-form)))) | ||
| 320 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) | ||
| 321 | (m-name-pos (- l (length (memq 'monthname date-form)))) | ||
| 322 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) | ||
| 323 | (d-pos (- l (length (memq 'day date-form)))) | ||
| 324 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) | ||
| 325 | (m-pos (- l (length (memq 'month date-form)))) | ||
| 326 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) | ||
| 327 | (y-pos (- l (length (memq 'year date-form)))) | ||
| 328 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) | ||
| 329 | (regexp | ||
| 330 | (concat | ||
| 331 | "\\(\\`\\|\^M\\|\n\\)" | ||
| 332 | (regexp-quote islamic-diary-entry-symbol) | ||
| 333 | "\\(" | ||
| 334 | (mapconcat 'eval date-form "\\)\\(") | ||
| 335 | "\\)")) | ||
| 336 | (case-fold-search t)) | ||
| 337 | (goto-char (point-min)) | ||
| 338 | (while (re-search-forward regexp nil t) | ||
| 339 | (let* ((dd-name | ||
| 340 | (if d-name-pos | ||
| 341 | (buffer-substring | ||
| 342 | (match-beginning d-name-pos) | ||
| 343 | (match-end d-name-pos)))) | ||
| 344 | (mm-name | ||
| 345 | (if m-name-pos | ||
| 346 | (buffer-substring | ||
| 347 | (match-beginning m-name-pos) | ||
| 348 | (match-end m-name-pos)))) | ||
| 349 | (mm (string-to-number | ||
| 350 | (if m-pos | ||
| 351 | (buffer-substring | ||
| 352 | (match-beginning m-pos) | ||
| 353 | (match-end m-pos)) | ||
| 354 | ""))) | ||
| 355 | (dd (string-to-number | ||
| 356 | (if d-pos | ||
| 357 | (buffer-substring | ||
| 358 | (match-beginning d-pos) | ||
| 359 | (match-end d-pos)) | ||
| 360 | ""))) | ||
| 361 | (y-str (if y-pos | ||
| 362 | (buffer-substring | ||
| 363 | (match-beginning y-pos) | ||
| 364 | (match-end y-pos)))) | ||
| 365 | (yy (if (not y-str) | ||
| 366 | 0 | ||
| 367 | (if (and (= (length y-str) 2) | ||
| 368 | abbreviated-calendar-year) | ||
| 369 | (let* ((current-y | ||
| 370 | (extract-calendar-year | ||
| 371 | (calendar-islamic-from-absolute | ||
| 372 | (calendar-absolute-from-gregorian | ||
| 373 | (calendar-current-date))))) | ||
| 374 | (y (+ (string-to-number y-str) | ||
| 375 | (* 100 (/ current-y 100))))) | ||
| 376 | (if (> (- y current-y) 50) | ||
| 377 | (- y 100) | ||
| 378 | (if (> (- current-y y) 50) | ||
| 379 | (+ y 100) | ||
| 380 | y))) | ||
| 381 | (string-to-number y-str))))) | ||
| 382 | (if dd-name | ||
| 383 | (mark-calendar-days-named | ||
| 384 | (cdr (assoc-string dd-name | ||
| 385 | (calendar-make-alist | ||
| 386 | calendar-day-name-array | ||
| 387 | 0 nil calendar-day-abbrev-array) t))) | ||
| 388 | (if mm-name | ||
| 389 | (setq mm (if (string-equal mm-name "*") 0 | ||
| 390 | (cdr (assoc-string | ||
| 391 | mm-name | ||
| 392 | (calendar-make-alist | ||
| 393 | calendar-islamic-month-name-array) t))))) | ||
| 394 | (mark-islamic-calendar-date-pattern mm dd yy))))) | ||
| 395 | (setq d (cdr d))))) | ||
| 396 | |||
| 397 | ;;;###diary-autoload | 286 | ;;;###diary-autoload |
| 398 | (defun mark-islamic-calendar-date-pattern (month day year) | 287 | (defun mark-islamic-calendar-date-pattern (month day year) |
| 399 | "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. | 288 | "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. |
| @@ -415,10 +304,9 @@ A value of 0 in any position is a wildcard." | |||
| 415 | (m (extract-calendar-month islamic-date)) | 304 | (m (extract-calendar-month islamic-date)) |
| 416 | (y (extract-calendar-year islamic-date)) | 305 | (y (extract-calendar-year islamic-date)) |
| 417 | (date)) | 306 | (date)) |
| 418 | (if (< m 1) | 307 | (unless (< m 1) ; Islamic calendar doesn't apply |
| 419 | nil ; Islamic calendar doesn't apply | ||
| 420 | (increment-calendar-month m y (- 10 month)) | 308 | (increment-calendar-month m y (- 10 month)) |
| 421 | (if (> m 7) ; Islamic date might be visible | 309 | (if (> m 7) ; Islamic date might be visible |
| 422 | (let ((date (calendar-gregorian-from-absolute | 310 | (let ((date (calendar-gregorian-from-absolute |
| 423 | (calendar-absolute-from-islamic | 311 | (calendar-absolute-from-islamic |
| 424 | (list month day y))))) | 312 | (list month day y))))) |
| @@ -453,21 +341,126 @@ A value of 0 in any position is a wildcard." | |||
| 453 | (mark-visible-calendar-date | 341 | (mark-visible-calendar-date |
| 454 | (calendar-gregorian-from-absolute date))))))))) | 342 | (calendar-gregorian-from-absolute date))))))))) |
| 455 | 343 | ||
| 344 | (declare-function diary-name-pattern "diary-lib" | ||
| 345 | (string-array &optional abbrev-array paren)) | ||
| 346 | |||
| 347 | (declare-function mark-calendar-days-named "diary-lib" | ||
| 348 | (dayname &optional color)) | ||
| 349 | |||
| 350 | ;;;###diary-autoload | ||
| 351 | (defun mark-islamic-diary-entries () | ||
| 352 | "Mark days in the calendar window that have Islamic date diary entries. | ||
| 353 | Mark each entry in `diary-file' (or included files) visible in the calendar | ||
| 354 | window. Islamic date entries are prefaced by `islamic-diary-entry-symbol' | ||
| 355 | \(normally an `I'). The same `diary-date-forms' govern the style | ||
| 356 | of the Islamic calendar entries, except that the Islamic month | ||
| 357 | names must be spelled in full. The Islamic months are numbered | ||
| 358 | from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. | ||
| 359 | Islamic date diary entries that begin with `diary-nonmarking-symbol' | ||
| 360 | are not marked. This function is provided for use as part of | ||
| 361 | `nongregorian-diary-marking-hook'." | ||
| 362 | (let ((dayname (diary-name-pattern calendar-day-name-array | ||
| 363 | calendar-day-abbrev-array)) | ||
| 364 | (monthname | ||
| 365 | (format "%s\\|\\*" | ||
| 366 | (diary-name-pattern calendar-islamic-month-name-array))) | ||
| 367 | (month "[0-9]+\\|\\*") | ||
| 368 | (day "[0-9]+\\|\\*") | ||
| 369 | (year "[0-9]+\\|\\*") | ||
| 370 | (case-fold-search t)) | ||
| 371 | (dolist (date-form diary-date-forms) | ||
| 372 | (if (eq (car date-form) 'backup) ; ignore 'backup directive | ||
| 373 | (setq date-form (cdr date-form))) | ||
| 374 | (let* ((l (length date-form)) | ||
| 375 | (d-name-pos (- l (length (memq 'dayname date-form)))) | ||
| 376 | (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) | ||
| 377 | (m-name-pos (- l (length (memq 'monthname date-form)))) | ||
| 378 | (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) | ||
| 379 | (d-pos (- l (length (memq 'day date-form)))) | ||
| 380 | (d-pos (if (/= l d-pos) (+ 2 d-pos))) | ||
| 381 | (m-pos (- l (length (memq 'month date-form)))) | ||
| 382 | (m-pos (if (/= l m-pos) (+ 2 m-pos))) | ||
| 383 | (y-pos (- l (length (memq 'year date-form)))) | ||
| 384 | (y-pos (if (/= l y-pos) (+ 2 y-pos))) | ||
| 385 | (regexp | ||
| 386 | (concat | ||
| 387 | "\\(\\`\\|\^M\\|\n\\)" | ||
| 388 | (regexp-quote islamic-diary-entry-symbol) | ||
| 389 | "\\(" | ||
| 390 | (mapconcat 'eval date-form "\\)\\(") | ||
| 391 | "\\)"))) | ||
| 392 | (goto-char (point-min)) | ||
| 393 | (while (re-search-forward regexp nil t) | ||
| 394 | (let* ((dd-name | ||
| 395 | (if d-name-pos | ||
| 396 | (buffer-substring | ||
| 397 | (match-beginning d-name-pos) | ||
| 398 | (match-end d-name-pos)))) | ||
| 399 | (mm-name | ||
| 400 | (if m-name-pos | ||
| 401 | (buffer-substring | ||
| 402 | (match-beginning m-name-pos) | ||
| 403 | (match-end m-name-pos)))) | ||
| 404 | (mm (string-to-number | ||
| 405 | (if m-pos | ||
| 406 | (buffer-substring | ||
| 407 | (match-beginning m-pos) | ||
| 408 | (match-end m-pos)) | ||
| 409 | ""))) | ||
| 410 | (dd (string-to-number | ||
| 411 | (if d-pos | ||
| 412 | (buffer-substring | ||
| 413 | (match-beginning d-pos) | ||
| 414 | (match-end d-pos)) | ||
| 415 | ""))) | ||
| 416 | (y-str (if y-pos | ||
| 417 | (buffer-substring | ||
| 418 | (match-beginning y-pos) | ||
| 419 | (match-end y-pos)))) | ||
| 420 | (yy (if (not y-str) | ||
| 421 | 0 | ||
| 422 | (if (and (= (length y-str) 2) | ||
| 423 | abbreviated-calendar-year) | ||
| 424 | (let* ((current-y | ||
| 425 | (extract-calendar-year | ||
| 426 | (calendar-islamic-from-absolute | ||
| 427 | (calendar-absolute-from-gregorian | ||
| 428 | (calendar-current-date))))) | ||
| 429 | (y (+ (string-to-number y-str) | ||
| 430 | (* 100 (/ current-y 100))))) | ||
| 431 | (if (> (- y current-y) 50) | ||
| 432 | (- y 100) | ||
| 433 | (if (> (- current-y y) 50) | ||
| 434 | (+ y 100) | ||
| 435 | y))) | ||
| 436 | (string-to-number y-str))))) | ||
| 437 | (if dd-name | ||
| 438 | (mark-calendar-days-named | ||
| 439 | (cdr (assoc-string dd-name | ||
| 440 | (calendar-make-alist | ||
| 441 | calendar-day-name-array | ||
| 442 | 0 nil calendar-day-abbrev-array) t))) | ||
| 443 | (if mm-name | ||
| 444 | (setq mm (if (string-equal mm-name "*") 0 | ||
| 445 | (cdr (assoc-string | ||
| 446 | mm-name | ||
| 447 | (calendar-make-alist | ||
| 448 | calendar-islamic-month-name-array) t))))) | ||
| 449 | (mark-islamic-calendar-date-pattern mm dd yy)))))))) | ||
| 450 | |||
| 456 | ;;;###cal-autoload | 451 | ;;;###cal-autoload |
| 457 | (defun insert-islamic-diary-entry (arg) | 452 | (defun insert-islamic-diary-entry (arg) |
| 458 | "Insert a diary entry. | 453 | "Insert a diary entry. |
| 459 | For the Islamic date corresponding to the date indicated by point. | 454 | For the Islamic date corresponding to the date indicated by point. |
| 460 | Prefix argument ARG makes the entry nonmarking." | 455 | Prefix argument ARG makes the entry nonmarking." |
| 461 | (interactive "P") | 456 | (interactive "P") |
| 462 | (let* ((calendar-month-name-array calendar-islamic-month-name-array)) | 457 | (let ((calendar-month-name-array calendar-islamic-month-name-array)) |
| 463 | (make-diary-entry | 458 | (make-diary-entry |
| 464 | (concat | 459 | (concat islamic-diary-entry-symbol |
| 465 | islamic-diary-entry-symbol | 460 | (calendar-date-string |
| 466 | (calendar-date-string | 461 | (calendar-islamic-from-absolute |
| 467 | (calendar-islamic-from-absolute | 462 | (calendar-absolute-from-gregorian (calendar-cursor-to-date t))) |
| 468 | (calendar-absolute-from-gregorian | 463 | nil t)) |
| 469 | (calendar-cursor-to-date t))) | ||
| 470 | nil t)) | ||
| 471 | arg))) | 464 | arg))) |
| 472 | 465 | ||
| 473 | ;;;###cal-autoload | 466 | ;;;###cal-autoload |
| @@ -476,16 +469,15 @@ Prefix argument ARG makes the entry nonmarking." | |||
| 476 | For the day of the Islamic month corresponding to the date indicated by point. | 469 | For the day of the Islamic month corresponding to the date indicated by point. |
| 477 | Prefix argument ARG makes the entry nonmarking." | 470 | Prefix argument ARG makes the entry nonmarking." |
| 478 | (interactive "P") | 471 | (interactive "P") |
| 479 | (let* ((calendar-date-display-form | 472 | (let ((calendar-date-display-form (if european-calendar-style |
| 480 | (if european-calendar-style '(day " * ") '("* " day ))) | 473 | '(day " * ") |
| 481 | (calendar-month-name-array calendar-islamic-month-name-array)) | 474 | '("* " day ))) |
| 475 | (calendar-month-name-array calendar-islamic-month-name-array)) | ||
| 482 | (make-diary-entry | 476 | (make-diary-entry |
| 483 | (concat | 477 | (concat islamic-diary-entry-symbol |
| 484 | islamic-diary-entry-symbol | 478 | (calendar-date-string |
| 485 | (calendar-date-string | 479 | (calendar-islamic-from-absolute |
| 486 | (calendar-islamic-from-absolute | 480 | (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) |
| 487 | (calendar-absolute-from-gregorian | ||
| 488 | (calendar-cursor-to-date t))))) | ||
| 489 | arg))) | 481 | arg))) |
| 490 | 482 | ||
| 491 | ;;;###cal-autoload | 483 | ;;;###cal-autoload |
| @@ -494,18 +486,15 @@ Prefix argument ARG makes the entry nonmarking." | |||
| 494 | For the day of the Islamic year corresponding to the date indicated by point. | 486 | For the day of the Islamic year corresponding to the date indicated by point. |
| 495 | Prefix argument ARG makes the entry nonmarking." | 487 | Prefix argument ARG makes the entry nonmarking." |
| 496 | (interactive "P") | 488 | (interactive "P") |
| 497 | (let* ((calendar-date-display-form | 489 | (let ((calendar-date-display-form (if european-calendar-style |
| 498 | (if european-calendar-style | 490 | '(day " " monthname) |
| 499 | '(day " " monthname) | 491 | '(monthname " " day))) |
| 500 | '(monthname " " day))) | 492 | (calendar-month-name-array calendar-islamic-month-name-array)) |
| 501 | (calendar-month-name-array calendar-islamic-month-name-array)) | ||
| 502 | (make-diary-entry | 493 | (make-diary-entry |
| 503 | (concat | 494 | (concat islamic-diary-entry-symbol |
| 504 | islamic-diary-entry-symbol | 495 | (calendar-date-string |
| 505 | (calendar-date-string | 496 | (calendar-islamic-from-absolute |
| 506 | (calendar-islamic-from-absolute | 497 | (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))) |
| 507 | (calendar-absolute-from-gregorian | ||
| 508 | (calendar-cursor-to-date t))))) | ||
| 509 | arg))) | 498 | arg))) |
| 510 | 499 | ||
| 511 | (defvar date) | 500 | (defvar date) |