;;; Code:
-(defvar displayed-month)
-(defvar displayed-year)
-(defvar original-date)
-
(require 'cal-julian)
(defvar calendar-islamic-month-name-array
(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.
(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
;;;###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
(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.
(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)
(date string specifier &optional marker globcolor literal))
(defvar number) ; from diary-list-entries
+(defvar original-date)
;;;###diary-autoload
(defun list-islamic-diary-entries ()
(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))
(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.
(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)))))
(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
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
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)
projects / emacs.git / commitdiff