changeset 92926:b87a8e95883b

(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*.

--- a/lisp/calendar/cal-islam.el	Fri Mar 14 07:09:03 2008 +0000
+++ b/lisp/calendar/cal-islam.el	Fri Mar 14 07:13:35 2008 +0000
@@ -36,10 +36,6 @@
 
 ;;; Code:
 
-(defvar displayed-month)
-(defvar displayed-year)
-(defvar original-date)
-
 (require 'cal-julian)
 
 (defvar calendar-islamic-month-name-array
@@ -64,11 +60,10 @@
 
 (defun islamic-calendar-day-number (date)
   "Return the day number within the year of the Islamic date DATE."
-    (let* ((month (extract-calendar-month date))
-           (day (extract-calendar-day date)))
-      (+ (* 30 (/ month 2))
-         (* 29 (/ (1- month) 2))
-         day)))
+  (let ((month (extract-calendar-month date)))
+    (+ (* 30 (/ month 2))
+       (* 29 (/ (1- month) 2))
+       (extract-calendar-day date))))
 
 (defun calendar-absolute-from-islamic (date)
   "Absolute date of Islamic DATE.
@@ -79,10 +74,17 @@
          (year (extract-calendar-year date))
          (y (% year 30))
          (leap-years-in-cycle
-          (cond
-           ((< y 3) 0)  ((< y 6) 1)  ((< y 8) 2)  ((< y 11) 3) ((< y 14) 4)
-           ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9)
-           (t 10))))
+          (cond ((< y 3) 0)
+                ((< y 6) 1)
+                ((< y 8) 2)
+                ((< y 11) 3)
+                ((< y 14) 4)
+                ((< y 17) 5)
+                ((< y 19) 6)
+                ((< y 22) 7)
+                ((< y 25) 8)
+                ((< y 27) 9)
+                (t 10))))
     (+ (islamic-calendar-day-number date) ; days so far this year
        (* (1- year) 354)                  ; days in all non-leap years
        (* 11 (/ year 30))             ; leap days in complete cycles
@@ -142,7 +144,7 @@
 
 ;;;###cal-autoload
 (defun calendar-goto-islamic-date (date &optional noecho)
-  "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t."
+  "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
   (interactive
    (let* ((today (calendar-current-date))
           (year (calendar-read
@@ -169,6 +171,9 @@
                        (calendar-absolute-from-islamic date)))
   (or noecho (calendar-print-islamic-date)))
 
+(defvar displayed-month)                ; from generate-calendar
+(defvar displayed-year)
+
 ;;;###holiday-autoload
 (defun holiday-islamic (month day string)
   "Holiday on MONTH, DAY (Islamic) called STRING.
@@ -181,10 +186,9 @@
          (m (extract-calendar-month islamic-date))
          (y (extract-calendar-year islamic-date))
         (date))
-    (if (< m 1)
-        nil                        ;   Islamic calendar doesn't apply
+    (unless (< m 1)                   ; Islamic calendar doesn't apply
       (increment-calendar-month m y (- 10 month))
-      (if (> m 7)                     ;  Islamic date might be visible
+      (if (> m 7)                      ; Islamic date might be visible
           (let ((date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-islamic (list month day y)))))
             (if (calendar-date-is-visible-p date)
@@ -195,6 +199,7 @@
                   (date string specifier &optional marker globcolor literal))
 
 (defvar number)                         ; from diary-list-entries
+(defvar original-date)
 
 ;;;###diary-autoload
 (defun list-islamic-diary-entries ()
@@ -214,44 +219,39 @@
             (gdate original-date)
             (mark (regexp-quote diary-nonmarking-symbol)))
         (dotimes (idummy number)
-          (let* ((d diary-date-forms)
-                 (idate (calendar-islamic-from-absolute
+          (let* ((idate (calendar-islamic-from-absolute
                          (calendar-absolute-from-gregorian gdate)))
                  (month (extract-calendar-month idate))
                  (day (extract-calendar-day idate))
-                 (year (extract-calendar-year idate)))
-            (while d
-              (let*
-                  ((date-form (if (equal (car (car d)) 'backup)
-                                  (cdr (car d))
-                                (car d)))
-                   (backup (equal (car (car d)) 'backup))
-                   (dayname
-                    (format "%s\\|%s\\.?"
-                            (calendar-day-name gdate)
-                            (calendar-day-name gdate 'abbrev)))
-                   (calendar-month-name-array
-                    calendar-islamic-month-name-array)
-                   (monthname
-                    (concat
-                     "\\*\\|"
-                     (calendar-month-name month)))
-                   (month (concat "\\*\\|0*" (int-to-string month)))
-                   (day (concat "\\*\\|0*" (int-to-string day)))
-                   (year
-                    (concat
-                     "\\*\\|0*" (int-to-string year)
-                     (if abbreviated-calendar-year
-                         (concat "\\|" (int-to-string (% year 100)))
-                       "")))
-                   (regexp
-                    (concat
-                     "\\(\\`\\|\^M\\|\n\\)" mark "?"
-                     (regexp-quote islamic-diary-entry-symbol)
-                     "\\("
-                     (mapconcat 'eval date-form "\\)\\(")
-                     "\\)"))
-                   (case-fold-search t))
+                 (year (extract-calendar-year idate))
+                 backup)
+            (dolist (date-form diary-date-forms)
+              (if (setq backup (eq (car date-form) 'backup))
+                  (setq date-form (cdr date-form)))
+              (let* ((dayname
+                      (format "%s\\|%s\\.?"
+                              (calendar-day-name gdate)
+                              (calendar-day-name gdate 'abbrev)))
+                     (calendar-month-name-array
+                      calendar-islamic-month-name-array)
+                     (monthname
+                      (concat "\\*\\|" (calendar-month-name month)))
+                     (month (concat "\\*\\|0*" (int-to-string month)))
+                     (day (concat "\\*\\|0*" (int-to-string day)))
+                     (year
+                      (concat "\\*\\|0*" (int-to-string year)
+                              (if abbreviated-calendar-year
+                                  (concat "\\|" (int-to-string (% year 100)))
+                                "")))
+                     ;; FIXME ^M can go now.
+                     (regexp
+                      (concat
+                       "\\(\\`\\|\^M\\|\n\\)" mark "?"
+                       (regexp-quote islamic-diary-entry-symbol)
+                       "\\("
+                       (mapconcat 'eval date-form "\\)\\(")
+                       "\\)"))
+                     (case-fold-search t))
                 (goto-char (point-min))
                 (while (re-search-forward regexp nil t)
                   (if backup (re-search-backward "\\<" nil t))
@@ -276,124 +276,13 @@
                        (buffer-substring-no-properties entry-start (point))
                        (buffer-substring-no-properties
                         (1+ date-start) (1- entry-start))
-                       (copy-marker entry-start))))))
-              (setq d (cdr d))))
+                       (copy-marker entry-start))))))))
           (setq gdate
                 (calendar-gregorian-from-absolute
                  (1+ (calendar-absolute-from-gregorian gdate)))))
         (set-buffer-modified-p diary-modified))
     (goto-char (point-min))))
 
-(declare-function diary-name-pattern "diary-lib"
-                  (string-array &optional abbrev-array paren))
-
-(declare-function mark-calendar-days-named "diary-lib"
-                  (dayname &optional color))
-
-;;;###diary-autoload
-(defun mark-islamic-diary-entries ()
-  "Mark days in the calendar window that have Islamic date diary entries.
-Each entry in `diary-file' (or included files) visible in the calendar window
-is marked.  Islamic date entries are prefaced by `islamic-diary-entry-symbol'
-\(normally an `I').  The same `diary-date-forms' govern the style of the Islamic
-calendar entries, except that the Islamic month names must be spelled in full.
-The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
-Dhu al-Hijjah.  Islamic date diary entries that begin with a
-`diary-nonmarking-symbol' will not be marked in the calendar.  This function is
-provided for use as part of the `nongregorian-diary-marking-hook'."
-  (let ((d diary-date-forms))
-    (while d
-      (let*
-          ((date-form (if (equal (car (car d)) 'backup)
-                          (cdr (car d))
-                        (car d)))       ; ignore 'backup directive
-           (dayname (diary-name-pattern calendar-day-name-array
-                                        calendar-day-abbrev-array))
-           (monthname
-            (format "%s\\|\\*"
-                    (diary-name-pattern calendar-islamic-month-name-array)))
-           (month "[0-9]+\\|\\*")
-           (day "[0-9]+\\|\\*")
-           (year "[0-9]+\\|\\*")
-           (l (length date-form))
-           (d-name-pos (- l (length (memq 'dayname date-form))))
-           (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-           (m-name-pos (- l (length (memq 'monthname date-form))))
-           (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-           (d-pos (- l (length (memq 'day date-form))))
-           (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-           (m-pos (- l (length (memq 'month date-form))))
-           (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-           (y-pos (- l (length (memq 'year date-form))))
-           (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-           (regexp
-            (concat
-             "\\(\\`\\|\^M\\|\n\\)"
-             (regexp-quote islamic-diary-entry-symbol)
-             "\\("
-             (mapconcat 'eval date-form "\\)\\(")
-             "\\)"))
-           (case-fold-search t))
-        (goto-char (point-min))
-        (while (re-search-forward regexp nil t)
-          (let* ((dd-name
-                  (if d-name-pos
-                      (buffer-substring
-                       (match-beginning d-name-pos)
-                       (match-end d-name-pos))))
-                 (mm-name
-                  (if m-name-pos
-                      (buffer-substring
-                       (match-beginning m-name-pos)
-                       (match-end m-name-pos))))
-                 (mm (string-to-number
-                      (if m-pos
-                          (buffer-substring
-                           (match-beginning m-pos)
-                           (match-end m-pos))
-                        "")))
-                 (dd (string-to-number
-                      (if d-pos
-                          (buffer-substring
-                           (match-beginning d-pos)
-                           (match-end d-pos))
-                        "")))
-                 (y-str (if y-pos
-                            (buffer-substring
-                             (match-beginning y-pos)
-                             (match-end y-pos))))
-                 (yy (if (not y-str)
-                         0
-                       (if (and (= (length y-str) 2)
-                                abbreviated-calendar-year)
-                           (let* ((current-y
-                                   (extract-calendar-year
-                                    (calendar-islamic-from-absolute
-                                     (calendar-absolute-from-gregorian
-                                      (calendar-current-date)))))
-                                  (y (+ (string-to-number y-str)
-                                        (* 100 (/ current-y 100)))))
-                             (if (> (- y current-y) 50)
-                                 (- y 100)
-                               (if (> (- current-y y) 50)
-                                   (+ y 100)
-                                 y)))
-                         (string-to-number y-str)))))
-            (if dd-name
-                (mark-calendar-days-named
-                 (cdr (assoc-string dd-name
-                                         (calendar-make-alist
-                                          calendar-day-name-array
-                                          0 nil calendar-day-abbrev-array) t)))
-              (if mm-name
-                  (setq mm (if (string-equal mm-name "*") 0
-                             (cdr (assoc-string
-                                   mm-name
-                                   (calendar-make-alist
-                                    calendar-islamic-month-name-array) t)))))
-              (mark-islamic-calendar-date-pattern mm dd yy)))))
-      (setq d (cdr d)))))
-
 ;;;###diary-autoload
 (defun mark-islamic-calendar-date-pattern (month day year)
   "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
@@ -415,10 +304,9 @@
                  (m (extract-calendar-month islamic-date))
                  (y (extract-calendar-year islamic-date))
                  (date))
-            (if (< m 1)
-                nil                ;   Islamic calendar doesn't apply
+            (unless (< m 1)           ; Islamic calendar doesn't apply
               (increment-calendar-month m y (- 10 month))
-              (if (> m 7)             ;  Islamic date might be visible
+              (if (> m 7)              ; Islamic date might be visible
                   (let ((date (calendar-gregorian-from-absolute
                                (calendar-absolute-from-islamic
                                 (list month day y)))))
@@ -453,21 +341,126 @@
                  (mark-visible-calendar-date
                   (calendar-gregorian-from-absolute date)))))))))
 
+(declare-function diary-name-pattern "diary-lib"
+                  (string-array &optional abbrev-array paren))
+
+(declare-function mark-calendar-days-named "diary-lib"
+                  (dayname &optional color))
+
+;;;###diary-autoload
+(defun mark-islamic-diary-entries ()
+  "Mark days in the calendar window that have Islamic date diary entries.
+Mark each entry in `diary-file' (or included files) visible in the calendar
+window.  Islamic date entries are prefaced by `islamic-diary-entry-symbol'
+\(normally an `I').  The same `diary-date-forms' govern the style
+of the Islamic calendar entries, except that the Islamic month
+names must be spelled in full.  The Islamic months are numbered
+from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah.
+Islamic date diary entries that begin with `diary-nonmarking-symbol'
+are not marked.  This function is provided for use as part of
+`nongregorian-diary-marking-hook'."
+  (let ((dayname (diary-name-pattern calendar-day-name-array
+                                     calendar-day-abbrev-array))
+        (monthname
+         (format "%s\\|\\*"
+                 (diary-name-pattern calendar-islamic-month-name-array)))
+        (month "[0-9]+\\|\\*")
+        (day "[0-9]+\\|\\*")
+        (year "[0-9]+\\|\\*")
+        (case-fold-search t))
+    (dolist (date-form diary-date-forms)
+      (if (eq (car date-form) 'backup)  ; ignore 'backup directive
+          (setq date-form (cdr date-form)))
+      (let* ((l (length date-form))
+             (d-name-pos (- l (length (memq 'dayname date-form))))
+             (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
+             (m-name-pos (- l (length (memq 'monthname date-form))))
+             (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
+             (d-pos (- l (length (memq 'day date-form))))
+             (d-pos (if (/= l d-pos) (+ 2 d-pos)))
+             (m-pos (- l (length (memq 'month date-form))))
+             (m-pos (if (/= l m-pos) (+ 2 m-pos)))
+             (y-pos (- l (length (memq 'year date-form))))
+             (y-pos (if (/= l y-pos) (+ 2 y-pos)))
+             (regexp
+              (concat
+               "\\(\\`\\|\^M\\|\n\\)"
+               (regexp-quote islamic-diary-entry-symbol)
+               "\\("
+               (mapconcat 'eval date-form "\\)\\(")
+               "\\)")))
+        (goto-char (point-min))
+        (while (re-search-forward regexp nil t)
+          (let* ((dd-name
+                  (if d-name-pos
+                      (buffer-substring
+                       (match-beginning d-name-pos)
+                       (match-end d-name-pos))))
+                 (mm-name
+                  (if m-name-pos
+                      (buffer-substring
+                       (match-beginning m-name-pos)
+                       (match-end m-name-pos))))
+                 (mm (string-to-number
+                      (if m-pos
+                      (buffer-substring
+                       (match-beginning m-pos)
+                       (match-end m-pos))
+                      "")))
+                 (dd (string-to-number
+                      (if d-pos
+                      (buffer-substring
+                       (match-beginning d-pos)
+                       (match-end d-pos))
+                      "")))
+                 (y-str (if y-pos
+                            (buffer-substring
+                             (match-beginning y-pos)
+                             (match-end y-pos))))
+                 (yy (if (not y-str)
+                         0
+                       (if (and (= (length y-str) 2)
+                                abbreviated-calendar-year)
+                       (let* ((current-y
+                               (extract-calendar-year
+                                (calendar-islamic-from-absolute
+                                 (calendar-absolute-from-gregorian
+                                  (calendar-current-date)))))
+                              (y (+ (string-to-number y-str)
+                                    (* 100 (/ current-y 100)))))
+                         (if (> (- y current-y) 50)
+                             (- y 100)
+                           (if (> (- current-y y) 50)
+                               (+ y 100)
+                             y)))
+                       (string-to-number y-str)))))
+            (if dd-name
+                (mark-calendar-days-named
+                 (cdr (assoc-string dd-name
+                 (calendar-make-alist
+                  calendar-day-name-array
+                  0 nil calendar-day-abbrev-array) t)))
+              (if mm-name
+                  (setq mm (if (string-equal mm-name "*") 0
+                             (cdr (assoc-string
+                                   mm-name
+                                   (calendar-make-alist
+                                    calendar-islamic-month-name-array) t)))))
+              (mark-islamic-calendar-date-pattern mm dd yy))))))))
+
 ;;;###cal-autoload
 (defun insert-islamic-diary-entry (arg)
   "Insert a diary entry.
 For the Islamic date corresponding to the date indicated by point.
 Prefix argument ARG makes the entry nonmarking."
   (interactive "P")
-  (let* ((calendar-month-name-array calendar-islamic-month-name-array))
+  (let ((calendar-month-name-array calendar-islamic-month-name-array))
     (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))
-       nil t))
+     (concat islamic-diary-entry-symbol
+             (calendar-date-string
+              (calendar-islamic-from-absolute
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))
+              nil t))
      arg)))
 
 ;;;###cal-autoload
@@ -476,16 +469,15 @@
 For the day of the Islamic month corresponding to the date indicated by point.
 Prefix argument ARG makes the entry nonmarking."
   (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style '(day " * ") '("* " day )))
-         (calendar-month-name-array calendar-islamic-month-name-array))
+  (let ((calendar-date-display-form (if european-calendar-style
+                                        '(day " * ")
+                                      '("* " day )))
+        (calendar-month-name-array calendar-islamic-month-name-array))
     (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
+     (concat islamic-diary-entry-symbol
+             (calendar-date-string
+              (calendar-islamic-from-absolute
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
      arg)))
 
 ;;;###cal-autoload
@@ -494,18 +486,15 @@
 For the day of the Islamic year corresponding to the date indicated by point.
 Prefix argument ARG makes the entry nonmarking."
   (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day)))
-         (calendar-month-name-array calendar-islamic-month-name-array))
+  (let ((calendar-date-display-form (if european-calendar-style
+                                        '(day " " monthname)
+                                      '(monthname " " day)))
+        (calendar-month-name-array calendar-islamic-month-name-array))
     (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
+     (concat islamic-diary-entry-symbol
+             (calendar-date-string
+              (calendar-islamic-from-absolute
+               (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
      arg)))
 
 (defvar date)