Mercurial > emacs
changeset 92820:693124d99e7c
Re-format comments.
(persian-calendar-month-name-array)
(persian-calendar-epoch, calendar-persian-date-string): Doc fixes.
(persian-prompt-for-date): Remove local variable `today'.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Thu, 13 Mar 2008 03:56:26 +0000 |
| parents | 8863bb0c2832 |
| children | d2480af27611 |
| files | lisp/calendar/cal-persia.el |
| diffstat | 1 files changed, 34 insertions(+), 35 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/calendar/cal-persia.el Thu Mar 13 03:55:15 2008 +0000 +++ b/lisp/calendar/cal-persia.el Thu Mar 13 03:56:26 2008 +0000 @@ -36,10 +36,11 @@ (defconst persian-calendar-month-name-array ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" - "Azar" "Dey" "Bahman" "Esfand"]) + "Azar" "Dey" "Bahman" "Esfand"] + "Names of the months in the Persian calendar.") (defconst persian-calendar-epoch (calendar-absolute-from-julian '(3 19 622)) - "Absolute date of start of Persian calendar = March 19, 622 A.D. (Julian).") + "Absolute date of start of Persian calendar = March 19, 622 AD (Julian).") (defun persian-calendar-leap-year-p (year) "True if YEAR is a leap year on the Persian calendar." @@ -70,51 +71,50 @@ (+ (calendar-absolute-from-persian (list month day (1+ (mod year 2820)))) (* 1029983 (floor year 2820))) - (+ (1- persian-calendar-epoch); Days before epoch - (* 365 (1- year)) ; Days in prior years. - (* 683 ; Leap days in prior 2820-year cycles + (+ (1- persian-calendar-epoch) ; days before epoch + (* 365 (1- year)) ; days in prior years + (* 683 ; leap days in prior 2820-year cycles (floor (+ year 2345) 2820)) - (* 186 ; Leap days in prior 768 year cycles + (* 186 ; leap days in prior 768 year cycles (floor (mod (+ year 2345) 2820) 768)) - (floor; Leap years in current 768 or 516 year cycle + (floor ; leap years in current 768 or 516 year cycle (* 683 (mod (mod (+ year 2345) 2820) 768)) 2820) - -568 ; Leap years in Persian years -2345...-1 - (calendar-sum ; Days in prior months this year. + -568 ; leap years in Persian years -2345...-1 + (calendar-sum ; days in prior months this year m 1 (< m month) (persian-calendar-last-day-of-month m year)) - day)))) ; Days so far this month. + day)))) ; days so far this month (defun calendar-persian-year-from-absolute (date) "Persian year corresponding to the absolute DATE." - (let* ((d0 ; Prior days since start of 2820 cycles + (let* ((d0 ; prior days since start of 2820 cycles (- date (calendar-absolute-from-persian (list 1 1 -2345)))) - (n2820 ; Completed 2820-year cycles + (n2820 ; completed 2820-year cycles (floor d0 1029983)) - (d1 ; Prior days not in n2820 + (d1 ; prior days not in n2820 (mod d0 1029983)) - (n768 ; 768-year cycles not in n2820 + (n768 ; 768-year cycles not in n2820 (floor d1 280506)) - (d2 ; Prior days not in n2820 or n768 + (d2 ; prior days not in n2820 or n768 (mod d1 280506)) - (n1 ; Years not in n2820 or n768 - ; we want is - ; (floor (+ (* 2820 d2) (* 2820 366)) 1029983)) - ; but that causes overflow, so we use - (let ((a (floor d2 366)); we use 366 as the divisor because - ; (2820*366 mod 1029983) is small + (n1 ; years not in n2820 or n768 + ;; Want: + ;; (floor (+ (* 2820 d2) (* 2820 366)) 1029983)) + ;; but that causes overflow, so use the following. + ;; Use 366 as the divisor because (2820*366 mod 1029983) is small. + (let ((a (floor d2 366)) (b (mod d2 366))) (+ 1 a (floor (+ (* 2137 a) (* 2820 b) 2137) 1029983)))) - (year (+ (* 2820 n2820); Complete 2820 year cycles - (* 768 n768) ; Complete 768 year cycles - (if ; Remaining years - ; Last day of 2820 year cycle - (= d1 1029617) + (year (+ (* 2820 n2820) ; complete 2820 year cycles + (* 768 n768) ; complete 768 year cycles + ;; Remaining years. + (if (= d1 1029617) ; last day of 2820 year cycle (1- n1) n1) - -2345))) ; Years before year 1 + -2345))) ; years before year 1 (if (< year 1) - (1- year); No year zero + (1- year) ; no year zero year))) (defun calendar-persian-from-absolute (date) @@ -123,7 +123,7 @@ The absolute date is the number of days elapsed since the imaginary Gregorian date Sunday, December 31, 1 BC." (let* ((year (calendar-persian-year-from-absolute date)) - (month ; Search forward from Farvardin + (month ; search forward from Farvardin (1+ (calendar-sum m 1 (> date (calendar-absolute-from-persian @@ -132,15 +132,14 @@ (persian-calendar-last-day-of-month m year) year))) 1))) - (day ; Calculate the day by subtraction + (day ; calculate the day by subtraction (- date (1- (calendar-absolute-from-persian (list month 1 year)))))) (list month day year))) ;;;###autoload (defun calendar-persian-date-string (&optional date) - "String of Persian date of Gregorian DATE. -Defaults to today's date if DATE is not given." + "String of Persian date of Gregorian DATE, default today." (let* ((persian-date (calendar-persian-from-absolute (calendar-absolute-from-gregorian (or date (calendar-current-date))))) @@ -171,14 +170,14 @@ (defun persian-prompt-for-date () "Ask for a Persian date." - (let* ((today (calendar-current-date)) - (year (calendar-read + (let* ((year (calendar-read "Persian calendar year (not 0): " (lambda (x) (not (zerop x))) (int-to-string (extract-calendar-year (calendar-persian-from-absolute - (calendar-absolute-from-gregorian today)))))) + (calendar-absolute-from-gregorian + (calendar-current-date))))))) (completion-ignore-case t) (month (cdr (assoc (completing-read