[Emacs-diffs] Changes to emacs/lisp/calendar/cal-islam.el,v

[Glenn Morris]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Glenn Morris <gm>       08/03/16 01:24:22

Index: cal-islam.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/calendar/cal-islam.el,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- cal-islam.el        15 Mar 2008 03:01:13 -0000      1.36
+++ cal-islam.el        16 Mar 2008 01:24:21 -0000      1.37
@@ -73,8 +73,7 @@
          (day (extract-calendar-day date))
          (year (extract-calendar-year date))
          (y (% year 30))
-         (leap-years-in-cycle
-          (cond ((< y 3) 0)
+         (leap-years-in-cycle (cond ((< y 3) 0)
                 ((< y 6) 1)
                 ((< y 8) 2)
                 ((< y 11) 3)
@@ -142,10 +141,8 @@
         (message "Date is pre-Islamic")
       (message "Islamic date (until sunset): %s" i))))
 
-;;;###cal-autoload
-(defun calendar-goto-islamic-date (date &optional noecho)
-  "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
-  (interactive
+(defun calendar-islamic-prompt-for-date ()
+  "Ask for an Islamic date."
    (let* ((today (calendar-current-date))
           (year (calendar-read
                  "Islamic calendar year (>0): "
@@ -167,6 +164,11 @@
                 (format "Islamic calendar day (1-%d): " last)
                 (lambda (x) (and (< 0 x) (<= x last))))))
      (list (list month day year))))
+
+;;;###cal-autoload
+(defun calendar-goto-islamic-date (date &optional noecho)
+  "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
+  (interactive (calendar-islamic-prompt-for-date))
   (calendar-goto-date (calendar-gregorian-from-absolute
                        (calendar-absolute-from-islamic date)))
   (or noecho (calendar-print-islamic-date)))
@@ -212,63 +214,15 @@
                         islamic-diary-entry-symbol
                         'calendar-islamic-from-absolute))
 
+(autoload 'calendar-mark-1 "diary-lib")
+
 ;;;###diary-autoload
-(defun mark-islamic-calendar-date-pattern (month day year)
+(defun mark-islamic-calendar-date-pattern (month day year &optional color)
   "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (if (and (not (zerop month)) (not (zerop day)))
-        (if (not (zerop year))
-            ;; Fully specified Islamic date.
-            (let ((date (calendar-gregorian-from-absolute
-                         (calendar-absolute-from-islamic
-                          (list month day year)))))
-              (if (calendar-date-is-visible-p date)
-                  (mark-visible-calendar-date date)))
-          ;; Month and day in any year--this taken from the holiday stuff.
-          (let* ((islamic-date (calendar-islamic-from-absolute
-                                (calendar-absolute-from-gregorian
-                                 (list displayed-month 15 displayed-year))))
-                 (m (extract-calendar-month islamic-date))
-                 (y (extract-calendar-year islamic-date))
-                 (date))
-            (unless (< m 1)           ; Islamic calendar doesn't apply
-              (increment-calendar-month m y (- 10 month))
-              (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)
-                        (mark-visible-calendar-date date)))))))
-      ;; Not one of the simple cases--check all visible dates for match.
-      ;; Actually, the following code takes care of ALL of the cases, but
-      ;; it's much too slow to be used for the simple (common) cases.
-      (let ((m displayed-month)
-            (y displayed-year)
-            (first-date)
-            (last-date))
-        (increment-calendar-month m y -1)
-        (setq first-date
-              (calendar-absolute-from-gregorian
-               (list m 1 y)))
-        (increment-calendar-month m y 2)
-        (setq last-date
-              (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))
-        (calendar-for-loop date from first-date to last-date do
-          (let* ((i-date (calendar-islamic-from-absolute date))
-                 (i-month (extract-calendar-month i-date))
-                 (i-day (extract-calendar-day i-date))
-                 (i-year (extract-calendar-year i-date)))
-            (and (or (zerop month)
-                     (= month i-month))
-                 (or (zerop day)
-                     (= day i-day))
-                 (or (zerop year)
-                     (= year i-year))
-                 (mark-visible-calendar-date
-                  (calendar-gregorian-from-absolute date)))))))))
+A value of 0 in any position is a wildcard.  Optional argument COLOR is
+passed to `mark-visible-calendar-date' as MARK."
+  (calendar-mark-1 month day year 'calendar-islamic-from-absolute
+                   'calendar-absolute-from-islamic color))
 
 (autoload 'diary-mark-entries-1 "diary-lib")