emacs: lisp/calendar/cal-persia.el comparison

comparison lisp/calendar/cal-persia.el @ 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	f49e5129551f
children	2bcff1e54131

comparison

equal deleted inserted replaced

-:8863bb0c2832
+:693124d99e7c
 (require 'cal-julian)
 (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."
 (< (mod (* (mod (mod (if (<= 0 year)
 (+ year 2346) ; no year zero
 (year (extract-calendar-year date)))
 (if (< year 0)
 (+ (calendar-absolute-from-persian
 (list month day (1+ (mod year 2820))))
 (* 1029983 (floor year 2820)))
-(+ (1- persian-calendar-epoch); Days before epoch
+(+ (1- persian-calendar-epoch)    ; days before epoch
-(* 365 (1- year)) ; Days in prior years.
+(* 365 (1- year))              ; days in prior years
-(* 683        ; Leap days in prior 2820-year cycles
+(* 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
+-568                 ; leap years in Persian years -2345...-1
-(calendar-sum ; Days in prior months this year.
+(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
+(n1           ; years not in n2820 or n768
-; we want is
+;; Want:
-; (floor (+ (* 2820 d2) (* 2820 366)) 1029983))
+;; (floor (+ (* 2820 d2) (* 2820 366)) 1029983))
-; but that causes overflow, so we use
+;; but that causes overflow, so use the following.
-(let ((a (floor d2 366)); we use 366 as the divisor because
+;; Use 366 as the divisor because (2820*366 mod 1029983) is small.
-; (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
+(year (+ (* 2820 n2820)        ; complete 2820 year cycles
-(* 768 n768)  ; Complete 768 year cycles
+(* 768 n768)          ; complete 768 year cycles
-(if           ; Remaining years
+;; Remaining years.
-; Last day of 2820 year cycle
+(if (= d1 1029617)    ; last day of 2820 year cycle
-(= d1 1029617)
 (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)
 "Compute the Persian equivalent for absolute date DATE.
 The result is a list of the form (MONTH DAY YEAR).
 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
 (list
 m
 (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.
+"String of Persian date of Gregorian DATE, default today."
-Defaults to today's date if DATE is not given."
 (let* ((persian-date (calendar-persian-from-absolute
 (calendar-absolute-from-gregorian
 (or date (calendar-current-date)))))
 (y (extract-calendar-year persian-date))
 (m (extract-calendar-month persian-date)))
 (calendar-absolute-from-persian date)))
 (or noecho (calendar-print-persian-date)))
 (defun persian-prompt-for-date ()
 "Ask for a Persian date."
-(let* ((today (calendar-current-date))
+(let* ((year (calendar-read
-(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
 "Persian calendar month name: "
 (mapcar 'list

Mercurial > emacs

comparison lisp/calendar/cal-persia.el @ 92820:693124d99e7c