Commit 6bd7c8eb authored by Glenn Morris's avatar Glenn Morris
Browse files

(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.
parent 6cd61ebd
...@@ -3,6 +3,15 @@ ...@@ -3,6 +3,15 @@
* startup.el (command-line-1): Rename -internal-script back to * startup.el (command-line-1): Rename -internal-script back to
-scriptload (reverts previous change). -scriptload (reverts previous change).
   
* calendar/cal-bahai.el (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.
(holiday-bahai, calendar-bahai-mark-date-pattern): Use unless.
* calendar/cal-china.el: Re-order so that functions are defined before * calendar/cal-china.el: Re-order so that functions are defined before
use. use.
(displayed-month, displayed-year): Move declarations where needed. (displayed-month, displayed-year): Move declarations where needed.
......
...@@ -60,7 +60,8 @@ ...@@ -60,7 +60,8 @@
(defconst calendar-bahai-month-name-array (defconst calendar-bahai-month-name-array
["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál" ["Bahá" "Jalál" "Jamál" "`Azamat" "Núr" "Rahmat" "Kalimát" "Kamál"
"Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il" "Asmá" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masá'il"
"Sharaf" "Sultán" "Mulk" "`Alá"]) "Sharaf" "Sultán" "Mulk" "`Alá"]
"Array of the month names in the Bahá'í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844)) (defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
"Absolute date of start of Bahá'í calendar = March 19, 622 A.D. (Julian).") "Absolute date of start of Bahá'í calendar = March 19, 622 A.D. (Julian).")
...@@ -70,7 +71,8 @@ ...@@ -70,7 +71,8 @@
(calendar-leap-year-p (+ year 1844))) (calendar-leap-year-p (+ year 1844)))
(defconst calendar-bahai-leap-base (defconst calendar-bahai-leap-base
(+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400))) (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400))
"Used by `calendar-absolute-from-bahai'.")
(defun calendar-absolute-from-bahai (date) (defun calendar-absolute-from-bahai (date)
"Compute absolute date from Bahá'í date DATE. "Compute absolute date from Bahá'í date DATE.
...@@ -145,15 +147,6 @@ Defaults to today's date if DATE is not given." ...@@ -145,15 +147,6 @@ Defaults to today's date if DATE is not given."
(message "Bahá'í date: %s" (message "Bahá'í date: %s"
(calendar-bahai-date-string (calendar-cursor-to-date t)))) (calendar-bahai-date-string (calendar-cursor-to-date t))))
;;;###cal-autoload
(defun calendar-bahai-goto-date (date &optional noecho)
"Move cursor to Bahá'í date DATE.
Echo Bahá'í date unless NOECHO is t."
(interactive (calendar-bahai-prompt-for-date))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai date)))
(or noecho (calendar-bahai-print-date)))
(defun calendar-bahai-prompt-for-date () (defun calendar-bahai-prompt-for-date ()
"Ask for a Bahá'í date." "Ask for a Bahá'í date."
(let* ((today (calendar-current-date)) (let* ((today (calendar-current-date))
...@@ -177,6 +170,15 @@ Echo Bahá'í date unless NOECHO is t." ...@@ -177,6 +170,15 @@ Echo Bahá'í date unless NOECHO is t."
(lambda (x) (and (< 0 x) (<= x 19)))))) (lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year)))) (list (list month day year))))
;;;###cal-autoload
(defun calendar-bahai-goto-date (date &optional noecho)
"Move cursor to Bahá'í date DATE.
Echo Bahá'í date unless NOECHO is non-nil."
(interactive (calendar-bahai-prompt-for-date))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai date)))
(or noecho (calendar-bahai-print-date)))
(defvar displayed-month) (defvar displayed-month)
(defvar displayed-year) (defvar displayed-year)
...@@ -211,14 +213,13 @@ nil if it is not visible in the current calendar window." ...@@ -211,14 +213,13 @@ nil if it is not visible in the current calendar window."
;;;###diary-autoload ;;;###diary-autoload
(defun diary-bahai-list-entries () (defun diary-bahai-list-entries ()
"Add any Bahá'í date entries from the diary file to `diary-entries-list'. "Add any Bahá'í date entries from the diary file to `diary-entries-list'.
Bahá'í date diary entries must be prefaced by an Bahá'í date diary entries must be prefaced by `bahai-diary-entry-symbol'
`bahai-diary-entry-symbol' (normally a `B'). The same diary date \(normally a `B'). The same diary date forms govern the style of the
forms govern the style of the Bahá'í calendar entries, except that the Bahá'í calendar entries, except that the Bahá'í month names must be given
Bahá'í month names must be given numerically. The Bahá'í months are numerically. The Bahá'í months are numbered from 1 to 19 with Bahá being
numbered from 1 to 19 with Bahá being 1 and 19 being `Alá. If a 1 and 19 being `Alá. If a Bahá'í date diary entry begins with
Bahá'í date diary entry begins with a `diary-nonmarking-symbol', the `diary-nonmarking-symbol', the entry will appear in the diary listing, but
entry will appear in the diary listing, but will not be marked in the will not be marked in the calendar. This function is provided for use with
calendar. This function is provided for use with the
`nongregorian-diary-listing-hook'." `nongregorian-diary-listing-hook'."
(if (< 0 number) (if (< 0 number)
(let ((buffer-read-only nil) (let ((buffer-read-only nil)
...@@ -226,44 +227,42 @@ calendar. This function is provided for use with the ...@@ -226,44 +227,42 @@ calendar. This function is provided for use with the
(gdate original-date) (gdate original-date)
(mark (regexp-quote diary-nonmarking-symbol))) (mark (regexp-quote diary-nonmarking-symbol)))
(dotimes (idummy number) (dotimes (idummy number)
(let* ((d diary-date-forms) (let* ((bdate (calendar-bahai-from-absolute
(bdate (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian gdate))) (calendar-absolute-from-gregorian gdate)))
(month (extract-calendar-month bdate)) (month (extract-calendar-month bdate))
(day (extract-calendar-day bdate)) (day (extract-calendar-day bdate))
(year (extract-calendar-year bdate))) (year (extract-calendar-year bdate))
(while d backup)
(let* (dolist (date-form diary-date-forms)
((date-form (if (equal (car (car d)) 'backup) (if (setq backup (eq (car date-form) 'backup))
(cdr (car d)) (setq date-form (cdr date-form)))
(car d))) (let* ((dayname
(backup (equal (car (car d)) 'backup)) (concat
(dayname (calendar-day-name gdate) "\\|"
(concat (substring (calendar-day-name gdate) 0 3) ".?"))
(calendar-day-name gdate) "\\|" (calendar-month-name-array
(substring (calendar-day-name gdate) 0 3) ".?")) calendar-bahai-month-name-array)
(calendar-month-name-array (monthname
calendar-bahai-month-name-array) (concat
(monthname "\\*\\|"
(concat (calendar-month-name month)))
"\\*\\|" (month (concat "\\*\\|0*" (int-to-string month)))
(calendar-month-name month))) (day (concat "\\*\\|0*" (int-to-string day)))
(month (concat "\\*\\|0*" (int-to-string month))) (year
(day (concat "\\*\\|0*" (int-to-string day))) (concat
(year "\\*\\|0*" (int-to-string year)
(concat (if abbreviated-calendar-year
"\\*\\|0*" (int-to-string year) (concat "\\|" (int-to-string (% year 100)))
(if abbreviated-calendar-year "")))
(concat "\\|" (int-to-string (% year 100))) ;; FIXME get rid of the ^M stuff.
""))) (regexp
(regexp (concat
(concat "\\(\\`\\|\^M\\|\n\\)" mark "?"
"\\(\\`\\|\^M\\|\n\\)" mark "?" (regexp-quote bahai-diary-entry-symbol)
(regexp-quote bahai-diary-entry-symbol) "\\("
"\\(" (mapconcat 'eval date-form "\\)\\(")
(mapconcat 'eval date-form "\\)\\(") "\\)"))
"\\)")) (case-fold-search t))
(case-fold-search t))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(if backup (re-search-backward "\\<" nil t)) (if backup (re-search-backward "\\<" nil t))
...@@ -287,14 +286,73 @@ calendar. This function is provided for use with the ...@@ -287,14 +286,73 @@ calendar. This function is provided for use with the
gdate gdate
(buffer-substring-no-properties entry-start (point)) (buffer-substring-no-properties entry-start (point))
(buffer-substring-no-properties (buffer-substring-no-properties
(1+ date-start) (1- entry-start))))))) (1+ date-start) (1- entry-start)))))))))
(setq d (cdr d))))
(setq gdate (setq gdate
(calendar-gregorian-from-absolute (calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian gdate))))) (1+ (calendar-absolute-from-gregorian gdate)))))
(set-buffer-modified-p diary-modified)) (set-buffer-modified-p diary-modified))
(goto-char (point-min)))) (goto-char (point-min))))
;;;###diary-autoload
(defun calendar-bahai-mark-date-pattern (month day year)
"Mark dates in calendar window that conform to Bahá'í 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 Bahá'í date.
(let ((date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai
(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* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(m (extract-calendar-month bahai-date))
(y (extract-calendar-year bahai-date))
(date))
(if (< m 1)
nil ; Bahá'í calendar doesn't apply
(increment-calendar-month m y (- 10 month))
(if (> m 7) ; Bahá'í date might be visible
(let ((date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai
(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* ((b-date (calendar-bahai-from-absolute date))
(i-month (extract-calendar-month b-date))
(i-day (extract-calendar-day b-date))
(i-year (extract-calendar-year b-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)))))))))
(declare-function diary-name-pattern "diary-lib" (declare-function diary-name-pattern "diary-lib"
(string-array &optional abbrev-array paren)) (string-array &optional abbrev-array paren))
...@@ -313,39 +371,36 @@ Bahá'í months are numbered from 1 to 12 with Bahá being 1 and 12 being ...@@ -313,39 +371,36 @@ Bahá'í months are numbered from 1 to 12 with Bahá being 1 and 12 being
`Alá. Bahá'í date diary entries that begin with `diary-nonmarking-symbol' `Alá. Bahá'í date diary entries that begin with `diary-nonmarking-symbol'
will not be marked in the calendar. This function is provided for use as will not be marked in the calendar. This function is provided for use as
part of `nongregorian-diary-marking-hook'." part of `nongregorian-diary-marking-hook'."
(let ((d diary-date-forms)) (let ((dayname (diary-name-pattern calendar-day-name-array))
(while d (monthname
(let* (concat
((date-form (if (equal (car (car d)) 'backup) (diary-name-pattern calendar-bahai-month-name-array t)
(cdr (car d)) "\\|\\*"))
(car d))) ; ignore 'backup directive (month "[0-9]+\\|\\*")
(dayname (diary-name-pattern calendar-day-name-array)) (day "[0-9]+\\|\\*")
(monthname (year "[0-9]+\\|\\*")
(concat (case-fold-search t))
(diary-name-pattern calendar-bahai-month-name-array t) (dolist (date-form diary-date-forms)
"\\|\\*")) (if (eq (car date-form) 'backup) ; ignore 'backup directive
(month "[0-9]+\\|\\*") (setq date-form (cdr date-form)))
(day "[0-9]+\\|\\*") (let* ((l (length date-form))
(year "[0-9]+\\|\\*") (d-name-pos (- l (length (memq 'dayname date-form))))
(l (length date-form)) (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
(d-name-pos (- l (length (memq 'dayname date-form)))) (m-name-pos (- l (length (memq 'monthname date-form))))
(d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos))) (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
(m-name-pos (- l (length (memq 'monthname date-form)))) (d-pos (- l (length (memq 'day date-form))))
(m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos))) (d-pos (if (/= l d-pos) (+ 2 d-pos)))
(d-pos (- l (length (memq 'day date-form)))) (m-pos (- l (length (memq 'month date-form))))
(d-pos (if (/= l d-pos) (+ 2 d-pos))) (m-pos (if (/= l m-pos) (+ 2 m-pos)))
(m-pos (- l (length (memq 'month date-form)))) (y-pos (- l (length (memq 'year date-form))))
(m-pos (if (/= l m-pos) (+ 2 m-pos))) (y-pos (if (/= l y-pos) (+ 2 y-pos)))
(y-pos (- l (length (memq 'year date-form)))) (regexp
(y-pos (if (/= l y-pos) (+ 2 y-pos))) (concat
(regexp "\\(\\`\\|\^M\\|\n\\)"
(concat (regexp-quote bahai-diary-entry-symbol)
"\\(\\`\\|\^M\\|\n\\)" "\\("
(regexp-quote bahai-diary-entry-symbol) (mapconcat 'eval date-form "\\)\\(")
"\\(" "\\)")))
(mapconcat 'eval date-form "\\)\\(")
"\\)"))
(case-fold-search t))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward regexp nil t) (while (re-search-forward regexp nil t)
(let* ((dd-name (let* ((dd-name
...@@ -408,68 +463,7 @@ part of `nongregorian-diary-marking-hook'." ...@@ -408,68 +463,7 @@ part of `nongregorian-diary-marking-hook'."
(calendar-make-alist (calendar-make-alist
calendar-bahai-month-name-array) calendar-bahai-month-name-array)
t))))) t)))))
(calendar-bahai-mark-date-pattern mm dd yy))))) (calendar-bahai-mark-date-pattern mm dd yy))))))))
(setq d (cdr d)))))
;;;###diary-autoload
(defun calendar-bahai-mark-date-pattern (month day year)
"Mark dates in calendar window that conform to Bahá'í 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 Bahá'í date.
(let ((date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai
(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* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(m (extract-calendar-month bahai-date))
(y (extract-calendar-year bahai-date))
(date))
(if (< m 1)
nil ; Bahá'í calendar doesn't apply
(increment-calendar-month m y (- 10 month))
(if (> m 7) ; Bahá'í date might be visible
(let ((date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai
(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* ((b-date (calendar-bahai-from-absolute date))
(i-month (extract-calendar-month b-date))
(i-day (extract-calendar-day b-date))
(i-year (extract-calendar-year b-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)))))))))
;;;###cal-autoload ;;;###cal-autoload
(defun diary-bahai-insert-entry (arg) (defun diary-bahai-insert-entry (arg)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment