Commit 71ea27ee authored by Glenn Morris's avatar Glenn Morris

Whitespace only.

parent 6eb61c70
......@@ -77,36 +77,36 @@
The absolute date is the number of days elapsed since the (imaginary)
Gregorian date Sunday, December 31, 1 BC."
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(prior-years (+ (1- year) 1844))
(leap-days (- (+ (/ prior-years 4) ; leap days in prior years
(- (/ prior-years 100))
(/ prior-years 400))
calendar-bahai-leap-base)))
(+ (1- calendar-bahai-epoch) ; days before epoch
(* 365 (1- year)) ; days in prior years
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(prior-years (+ (1- year) 1844))
(leap-days (- (+ (/ prior-years 4) ; leap days in prior years
(- (/ prior-years 100))
(/ prior-years 400))
calendar-bahai-leap-base)))
(+ (1- calendar-bahai-epoch) ; days before epoch
(* 365 (1- year)) ; days in prior years
leap-days
(calendar-sum m 1 (< m month) 19)
(if (= month 19) 4 0)
day))) ; days so far this month
day))) ; days so far this month
(defun calendar-bahai-from-absolute (date)
"Bahá'í year corresponding to the absolute DATE."
(if (< date calendar-bahai-epoch)
(list 0 0 0) ; pre-Bahá'í date
(let* ((greg (calendar-gregorian-from-absolute date))
(year (+ (- (extract-calendar-year greg) 1844)
(if (or (> (extract-calendar-month greg) 3)
(and (= (extract-calendar-month greg) 3)
(>= (extract-calendar-day greg) 21)))
1 0)))
(year (+ (- (extract-calendar-year greg) 1844)
(if (or (> (extract-calendar-month greg) 3)
(and (= (extract-calendar-month greg) 3)
(>= (extract-calendar-day greg) 21)))
1 0)))
(month ; search forward from Baha
(1+ (calendar-sum m 1
(> date
(calendar-absolute-from-bahai
(list m 19 year)))
1)))
(> date
(calendar-absolute-from-bahai
(list m 19 year)))
1)))
(day ; calculate the day by subtraction
(- date
(1- (calendar-absolute-from-bahai (list month 1 year))))))
......@@ -117,25 +117,25 @@ Gregorian date Sunday, December 31, 1 BC."
"String of Bahá'í date of Gregorian DATE.
Defaults to today's date if DATE is not given."
(let* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(calendar-absolute-from-gregorian
(or date (calendar-current-date)))))
(y (extract-calendar-year bahai-date))
(m (extract-calendar-month bahai-date))
(d (extract-calendar-day bahai-date)))
(let ((monthname
(if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
(aref calendar-bahai-month-name-array (1- m))))
(day (int-to-string
(if (<= d 0)
(if (calendar-bahai-leap-year-p y)
(+ d 5)
(+ d 4))
d)))
(dayname nil)
(month (int-to-string m))
(year (int-to-string y)))
(if (and (= m 19)
(<= d 0))
"Ayyám-i-Há"
(aref calendar-bahai-month-name-array (1- m))))
(day (int-to-string
(if (<= d 0)
(if (calendar-bahai-leap-year-p y)
(+ d 5)
(+ d 4))
d)))
(dayname nil)
(month (int-to-string m))
(year (int-to-string y)))
(mapconcat 'eval calendar-date-display-form ""))))
;;;###cal-autoload
......@@ -166,15 +166,15 @@ Echo Bahá'í date unless NOECHO is t."
(calendar-absolute-from-gregorian today))))))
(completion-ignore-case t)
(month (cdr (assoc
(completing-read
"Bahá'í calendar month name: "
(mapcar 'list
(append calendar-bahai-month-name-array nil))
nil t)
(completing-read
"Bahá'í calendar month name: "
(mapcar 'list
(append calendar-bahai-month-name-array nil))
nil t)
(calendar-make-alist calendar-bahai-month-name-array
1))))
(day (calendar-read "Bahá'í calendar day (1-19): "
(lambda (x) (and (< 0 x) (<= x 19))))))
(lambda (x) (and (< 0 x) (<= x 19))))))
(list (list month day year))))
(defvar displayed-month)
......@@ -187,15 +187,15 @@ If MONTH, DAY (Bahá'í) is visible, the value returned is corresponding
Gregorian date in the form of the list (((month day year) STRING)). Returns
nil if it is not visible in the current calendar window."
(let* ((bahai-date (calendar-bahai-from-absolute
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(calendar-absolute-from-gregorian
(list displayed-month 15 displayed-year))))
(m (extract-calendar-month bahai-date))
(y (extract-calendar-year bahai-date))
(date))
(date))
(if (< m 1)
nil ; Bahá'í calendar doesn't apply
nil ; Bahá'í calendar doesn't apply
(increment-calendar-month m y (- 10 month))
(if (> m 7) ; Bahá'í date might be visible
(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)
......@@ -406,7 +406,7 @@ part of `nongregorian-diary-marking-hook'."
(cdr (assoc-string
mm-name
(calendar-make-alist
calendar-bahai-month-name-array)
calendar-bahai-month-name-array)
t)))))
(calendar-bahai-mark-date-pattern mm dd yy)))))
(setq d (cdr d)))))
......@@ -427,15 +427,15 @@ A value of 0 in any position is a wildcard."
(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))))
(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
nil ; Bahá'í calendar doesn't apply
(increment-calendar-month m y (- 10 month))
(if (> m 7) ; Bahá'í date might be visible
(if (> m 7) ; Bahá'í date might be visible
(let ((date (calendar-gregorian-from-absolute
(calendar-absolute-from-bahai
(list month day y)))))
......@@ -457,18 +457,19 @@ A value of 0 in any position is a wildcard."
(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)))))))))
(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
(defun diary-bahai-insert-entry (arg)
......
This diff is collapsed.
......@@ -44,10 +44,10 @@
(defun french-calendar-accents ()
"True if diacritical marks are available."
(and (or window-system
(terminal-coding-system))
(terminal-coding-system))
(or enable-multibyte-characters
(and (char-table-p standard-display-table)
(equal (aref standard-display-table 161) [161])))))
(and (char-table-p standard-display-table)
(equal (aref standard-display-table 161) [161])))))
(defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
"Absolute date of start of French Revolutionary calendar = September 22, 1792.")
......@@ -145,20 +145,22 @@ The absolute date is the number of days elapsed since the
(year ; search forward from the approximation
(+ approx
(calendar-sum y approx
(>= date (calendar-absolute-from-french (list 1 1 (1+ y))))
1)))
(>= date (calendar-absolute-from-french
(list 1 1 (1+ y))))
1)))
(month ; search forward from Vendemiaire
(1+ (calendar-sum m 1
(> date
(calendar-absolute-from-french
(list m
(french-calendar-last-day-of-month m year)
year)))
1)))
(> date
(calendar-absolute-from-french
(list m
(french-calendar-last-day-of-month
m year)
year)))
1)))
(day ; calculate the day by subtraction
(- date
(1- (calendar-absolute-from-french (list month 1 year))))))
(list month day year))))
(list month day year))))
;;;###cal-autoload
(defun calendar-french-date-string (&optional date)
......@@ -201,47 +203,47 @@ Defaults to today's date if DATE is not given."
Echo French Revolutionary date unless NOECHO is t."
(interactive
(let ((accents (french-calendar-accents))
(months (french-calendar-month-name-array))
(special-days (french-calendar-special-days-array)))
(months (french-calendar-month-name-array))
(special-days (french-calendar-special-days-array)))
(let* ((year
(progn
(calendar-read
(if accents
"Anne de la Rvolution (>0): "
"Anne'e de la Re'volution (>0): ")
(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-french-from-absolute
(calendar-absolute-from-gregorian
(calendar-current-date))))))))
(month-list
(mapcar 'list
(append months
(if (french-calendar-leap-year-p year)
(mapcar
(lambda (x) (concat "Jour " x))
french-calendar-special-days-array)
(reverse
(cdr ; we don't want rev. day in a non-leap yr
(reverse
(mapcar
(lambda (x)
(concat "Jour " x))
special-days))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
(progn
(calendar-read
(if accents
"Anne de la Rvolution (>0): "
"Anne'e de la Re'volution (>0): ")
(lambda (x) (> x 0))
(int-to-string
(extract-calendar-year
(calendar-french-from-absolute
(calendar-absolute-from-gregorian
(calendar-current-date))))))))
(month-list
(mapcar 'list
(append months
(if (french-calendar-leap-year-p year)
(mapcar
(lambda (x) (concat "Jour " x))
french-calendar-special-days-array)
(reverse
(cdr ; we don't want rev. day in a non-leap yr
(reverse
(mapcar
(lambda (x)
(concat "Jour " x))
special-days))))))))
(completion-ignore-case t)
(month (cdr (assoc-string
(completing-read
"Mois ou Sansculottide: "
month-list
nil t)
(calendar-make-alist month-list 1 'car) t)))
(day (if (> month 12)
(- month 12)
(calendar-read
"Jour (1-30): "
(lambda (x) (and (<= 1 x) (<= x 30))))))
(month (if (> month 12) 13 month)))
(calendar-make-alist month-list 1 'car) t)))
(day (if (> month 12)
(- month 12)
(calendar-read
"Jour (1-30): "
(lambda (x) (and (<= 1 x) (<= x 30))))))
(month (if (> month 12) 13 month)))
(list (list month day year)))))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-french date)))
......
This diff is collapsed.
......@@ -4,7 +4,7 @@
;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; Human-Keywords: Mayan calendar, Maya, calendar, diary
......@@ -100,12 +100,12 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(condition-case condition
(progn
(while (< cc c)
(let* ((start (string-match "[0-9]+" str cc))
(end (match-end 0))
datum)
(setq datum (read (substring str start end)))
(setq rlc (cons datum rlc))
(setq cc end)))
(let* ((start (string-match "[0-9]+" str cc))
(end (match-end 0))
datum)
(setq datum (read (substring str start end)))
(setq rlc (cons datum rlc))
(setq cc end)))
(if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil)))
(invalid-read-syntax nil))
(reverse rlc)))
......@@ -125,16 +125,16 @@ but some use 1137140. Using 1232041 gives you Spinden's correlation; using
(defun calendar-mayan-haab-difference (date1 date2)
"Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2."
(mod (+ (* 20 (- (cdr date2) (cdr date1)))
(- (car date2) (car date1)))
(- (car date2) (car date1)))
365))
(defun calendar-mayan-haab-on-or-before (haab-date date)
"Absolute date of latest HAAB-DATE on or before absolute DATE."
(- date
(% (- date
(calendar-mayan-haab-difference
(calendar-mayan-haab-from-absolute 0) haab-date))
365)))
(calendar-mayan-haab-difference
(calendar-mayan-haab-from-absolute 0) haab-date))
365)))
;;;###cal-autoload
(defun calendar-next-haab-date (haab-date &optional noecho)
......@@ -165,12 +165,12 @@ Echo Mayan date if NOECHO is t."
"Convert Mayan HAAB date (a pair) into its traditional written form."
(let ((month (cdr haab))
(day (car haab)))
;; 19th month consists of 5 special days
(if (= month 19)
(format "%d Uayeb" day)
(format "%d %s"
day
(aref calendar-mayan-haab-month-name-array (1- month))))))
;; 19th month consists of 5 special days
(if (= month 19)
(format "%d Uayeb" day)
(format "%d %s"
day
(aref calendar-mayan-haab-month-name-array (1- month))))))
(defun calendar-mayan-tzolkin-from-absolute (date)
"Convert absolute DATE into a Mayan tzolkin date (a pair)."
......@@ -188,17 +188,17 @@ Echo Mayan date if NOECHO is t."
(let ((number-difference (- (car date2) (car date1)))
(name-difference (- (cdr date2) (cdr date1))))
(mod (+ number-difference
(* 13 (mod (* 3 (- number-difference name-difference))
20)))
260)))
(* 13 (mod (* 3 (- number-difference name-difference))
20)))
260)))
(defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date)
"Absolute date of latest TZOLKIN-DATE on or before absolute DATE."
(- date
(% (- date (calendar-mayan-tzolkin-difference
(calendar-mayan-tzolkin-from-absolute 0)
tzolkin-date))
260)))
(calendar-mayan-tzolkin-from-absolute 0)
tzolkin-date))
260)))
;;;###cal-autoload
(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
......@@ -247,8 +247,8 @@ Returns nil if such a tzolkin-haab combination is impossible."
(if (= (% difference 5) 0)
(- date
(mod (- date
(+ haab-difference (* 365 difference)))
18980))
(+ haab-difference (* 365 difference)))
18980))
nil)))
(defun calendar-read-mayan-haab-date ()
......@@ -276,9 +276,9 @@ Returns nil if such a tzolkin-haab combination is impossible."
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
(assoc-string
(completing-read "Tzolkin uinal: "
(mapcar 'list tzolkin-name-list)
nil t)
(completing-read "Tzolkin uinal: "
(mapcar 'list tzolkin-name-list)
nil t)
(calendar-make-alist tzolkin-name-list 1) t))))
(cons tzolkin-count tzolkin-name)))
......@@ -321,12 +321,12 @@ Echo Mayan date if NOECHO is t."
(defun calendar-absolute-from-mayan-long-count (c)
"Compute the absolute date corresponding to the Mayan Long Count C.
Long count is a list (baktun katun tun uinal kin)"
(+ (* (nth 0 c) 144000) ; baktun
(* (nth 1 c) 7200) ; katun
(* (nth 2 c) 360) ; tun
(* (nth 3 c) 20) ; uinal
(nth 4 c) ; kin (days)
(- ; days before absolute date 0
(+ (* (nth 0 c) 144000) ; baktun
(* (nth 1 c) 7200) ; katun
(* (nth 2 c) 360) ; tun
(* (nth 3 c) 20) ; uinal
(nth 4 c) ; kin (days)
(- ; days before absolute date 0
calendar-mayan-days-before-absolute-zero)))
;;;###cal-autoload
......@@ -338,10 +338,10 @@ Defaults to today's date if DATE is not given."
(tzolkin (calendar-mayan-tzolkin-from-absolute d))
(haab (calendar-mayan-haab-from-absolute d))
(long-count (calendar-mayan-long-count-from-absolute d)))
(format "Long count = %s; tzolkin = %s; haab = %s"
(calendar-mayan-long-count-to-string long-count)
(calendar-mayan-tzolkin-to-string tzolkin)
(calendar-mayan-haab-to-string haab))))
(format "Long count = %s; tzolkin = %s; haab = %s"
(calendar-mayan-long-count-to-string long-count)
(calendar-mayan-tzolkin-to-string tzolkin)
(calendar-mayan-haab-to-string haab))))
;;;###cal-autoload
(defun calendar-print-mayan-date ()
......@@ -361,8 +361,8 @@ Defaults to today's date if DATE is not given."
(read-string "Mayan long count (baktun.katun.tun.uinal.kin): "
(calendar-mayan-long-count-to-string
(calendar-mayan-long-count-from-absolute
(calendar-absolute-from-gregorian
(calendar-current-date))))))))
(calendar-absolute-from-gregorian
(calendar-current-date))))))))
(if (calendar-mayan-long-count-common-era datum)
(setq lc datum))))
(list lc)))
......
......@@ -4,7 +4,7 @@
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Lara Rios <lrios@coewl.cen.uiuc.edu>
;; Lara Rios <lrios@coewl.cen.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; Human-Keywords: calendar, popup menus, menu bar
......
......@@ -318,21 +318,21 @@ Moves forward if ARG is negative."
(defun calendar-cursor-to-visible-date (date)
"Move the cursor to DATE that is on the screen."
(let* ((month (extract-calendar-month date))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(first-of-month-weekday (calendar-day-of-week (list month 1 year))))
(day (extract-calendar-day date))
(year (extract-calendar-year date))
(first-of-month-weekday (calendar-day-of-week (list month 1 year))))
(goto-line (+ 3
(/ (+ day -1
(/ (+ day -1
(mod
(- (calendar-day-of-week (list month 1 year))
calendar-week-start-day)
7))
7)))
(move-to-column (+ 6
(* 25
(1+ (calendar-interval
displayed-month displayed-year month year)))
(* 3 (mod
(* 25
(1+ (calendar-interval
displayed-month displayed-year month year)))
(* 3 (mod
(- (calendar-day-of-week date)
calendar-week-start-day)
7))))))
......
......@@ -1280,7 +1280,7 @@ are non-nil. Pages are ruled if `cal-tex-rules' is non-nil."
(cal-tex-list-diary-entries
;; FIXME d1?
(calendar-absolute-from-gregorian (list month 1 year))
d2))))
d2))))
(cal-tex-preamble "twoside")
(cal-tex-cmd "\\textwidth 3.25in")
(cal-tex-cmd "\\textheight 6.5in")
......
......@@ -4,7 +4,7 @@
;; 2008 Free Software Foundation, Inc.
;; Author: Michael Kifer <kifer@cs.sunysb.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; Human-Keywords: calendar, dedicated frames, X Window System
......@@ -91,11 +91,11 @@ passed to `calendar-basic-setup'."
(save-window-excursion
(save-excursion
(setq calendar-frame
(make-frame calendar-and-diary-frame-parameters))
(make-frame calendar-and-diary-frame-parameters))
(run-hooks 'calendar-after-frame-setup-hooks)
(select-frame calendar-frame)
(if (eq 'icon (cdr (assoc 'visibility
(frame-parameters calendar-frame))))
(frame-parameters calendar-frame))))
(iconify-or-deiconify-frame))
(calendar-basic-setup arg)
(set-window-dedicated-p (selected-window) t)
......@@ -122,11 +122,11 @@ ARG is passed to `calendar-basic-setup'."
(save-window-excursion
(save-excursion
(setq calendar-frame
(make-frame calendar-frame-parameters))
(make-frame calendar-frame-parameters))
(run-hooks 'calendar-after-frame-setup-hooks)
(select-frame calendar-frame)
(if (eq 'icon (cdr (assoc 'visibility
(frame-parameters calendar-frame))))
(frame-parameters calendar-frame))))
(iconify-or-deiconify-frame))
(calendar-basic-setup arg)
(set-window-dedicated-p (selected-window) t))))))
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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