diff options
| author | Glenn Morris | 2008-03-13 03:56:26 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-13 03:56:26 +0000 |
| commit | d01890eee3b6ac6134c4319e26060dbff86bec13 (patch) | |
| tree | fb75c781808075ebf912089f055f10fda51b0b8c | |
| parent | 863ad01b09b51e2047643ef83c03e32a83612e12 (diff) | |
| download | emacs-d01890eee3b6ac6134c4319e26060dbff86bec13.tar.gz emacs-d01890eee3b6ac6134c4319e26060dbff86bec13.zip | |
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'.
| -rw-r--r-- | lisp/calendar/cal-persia.el | 69 |
1 files changed, 34 insertions, 35 deletions
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index 0ad05e99c86..24be5b557ee 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el | |||
| @@ -36,10 +36,11 @@ | |||
| 36 | 36 | ||
| 37 | (defconst persian-calendar-month-name-array | 37 | (defconst persian-calendar-month-name-array |
| 38 | ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" | 38 | ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" |
| 39 | "Azar" "Dey" "Bahman" "Esfand"]) | 39 | "Azar" "Dey" "Bahman" "Esfand"] |
| 40 | "Names of the months in the Persian calendar.") | ||
| 40 | 41 | ||
| 41 | (defconst persian-calendar-epoch (calendar-absolute-from-julian '(3 19 622)) | 42 | (defconst persian-calendar-epoch (calendar-absolute-from-julian '(3 19 622)) |
| 42 | "Absolute date of start of Persian calendar = March 19, 622 A.D. (Julian).") | 43 | "Absolute date of start of Persian calendar = March 19, 622 AD (Julian).") |
| 43 | 44 | ||
| 44 | (defun persian-calendar-leap-year-p (year) | 45 | (defun persian-calendar-leap-year-p (year) |
| 45 | "True if YEAR is a leap year on the Persian calendar." | 46 | "True if YEAR is a leap year on the Persian calendar." |
| @@ -70,51 +71,50 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 70 | (+ (calendar-absolute-from-persian | 71 | (+ (calendar-absolute-from-persian |
| 71 | (list month day (1+ (mod year 2820)))) | 72 | (list month day (1+ (mod year 2820)))) |
| 72 | (* 1029983 (floor year 2820))) | 73 | (* 1029983 (floor year 2820))) |
| 73 | (+ (1- persian-calendar-epoch); Days before epoch | 74 | (+ (1- persian-calendar-epoch) ; days before epoch |
| 74 | (* 365 (1- year)) ; Days in prior years. | 75 | (* 365 (1- year)) ; days in prior years |
| 75 | (* 683 ; Leap days in prior 2820-year cycles | 76 | (* 683 ; leap days in prior 2820-year cycles |
| 76 | (floor (+ year 2345) 2820)) | 77 | (floor (+ year 2345) 2820)) |
| 77 | (* 186 ; Leap days in prior 768 year cycles | 78 | (* 186 ; leap days in prior 768 year cycles |
| 78 | (floor (mod (+ year 2345) 2820) 768)) | 79 | (floor (mod (+ year 2345) 2820) 768)) |
| 79 | (floor; Leap years in current 768 or 516 year cycle | 80 | (floor ; leap years in current 768 or 516 year cycle |
| 80 | (* 683 (mod (mod (+ year 2345) 2820) 768)) | 81 | (* 683 (mod (mod (+ year 2345) 2820) 768)) |
| 81 | 2820) | 82 | 2820) |
| 82 | -568 ; Leap years in Persian years -2345...-1 | 83 | -568 ; leap years in Persian years -2345...-1 |
| 83 | (calendar-sum ; Days in prior months this year. | 84 | (calendar-sum ; days in prior months this year |
| 84 | m 1 (< m month) | 85 | m 1 (< m month) |
| 85 | (persian-calendar-last-day-of-month m year)) | 86 | (persian-calendar-last-day-of-month m year)) |
| 86 | day)))) ; Days so far this month. | 87 | day)))) ; days so far this month |
| 87 | 88 | ||
| 88 | (defun calendar-persian-year-from-absolute (date) | 89 | (defun calendar-persian-year-from-absolute (date) |
| 89 | "Persian year corresponding to the absolute DATE." | 90 | "Persian year corresponding to the absolute DATE." |
| 90 | (let* ((d0 ; Prior days since start of 2820 cycles | 91 | (let* ((d0 ; prior days since start of 2820 cycles |
| 91 | (- date (calendar-absolute-from-persian (list 1 1 -2345)))) | 92 | (- date (calendar-absolute-from-persian (list 1 1 -2345)))) |
| 92 | (n2820 ; Completed 2820-year cycles | 93 | (n2820 ; completed 2820-year cycles |
| 93 | (floor d0 1029983)) | 94 | (floor d0 1029983)) |
| 94 | (d1 ; Prior days not in n2820 | 95 | (d1 ; prior days not in n2820 |
| 95 | (mod d0 1029983)) | 96 | (mod d0 1029983)) |
| 96 | (n768 ; 768-year cycles not in n2820 | 97 | (n768 ; 768-year cycles not in n2820 |
| 97 | (floor d1 280506)) | 98 | (floor d1 280506)) |
| 98 | (d2 ; Prior days not in n2820 or n768 | 99 | (d2 ; prior days not in n2820 or n768 |
| 99 | (mod d1 280506)) | 100 | (mod d1 280506)) |
| 100 | (n1 ; Years not in n2820 or n768 | 101 | (n1 ; years not in n2820 or n768 |
| 101 | ; we want is | 102 | ;; Want: |
| 102 | ; (floor (+ (* 2820 d2) (* 2820 366)) 1029983)) | 103 | ;; (floor (+ (* 2820 d2) (* 2820 366)) 1029983)) |
| 103 | ; but that causes overflow, so we use | 104 | ;; but that causes overflow, so use the following. |
| 104 | (let ((a (floor d2 366)); we use 366 as the divisor because | 105 | ;; Use 366 as the divisor because (2820*366 mod 1029983) is small. |
| 105 | ; (2820*366 mod 1029983) is small | 106 | (let ((a (floor d2 366)) |
| 106 | (b (mod d2 366))) | 107 | (b (mod d2 366))) |
| 107 | (+ 1 a (floor (+ (* 2137 a) (* 2820 b) 2137) 1029983)))) | 108 | (+ 1 a (floor (+ (* 2137 a) (* 2820 b) 2137) 1029983)))) |
| 108 | (year (+ (* 2820 n2820); Complete 2820 year cycles | 109 | (year (+ (* 2820 n2820) ; complete 2820 year cycles |
| 109 | (* 768 n768) ; Complete 768 year cycles | 110 | (* 768 n768) ; complete 768 year cycles |
| 110 | (if ; Remaining years | 111 | ;; Remaining years. |
| 111 | ; Last day of 2820 year cycle | 112 | (if (= d1 1029617) ; last day of 2820 year cycle |
| 112 | (= d1 1029617) | ||
| 113 | (1- n1) | 113 | (1- n1) |
| 114 | n1) | 114 | n1) |
| 115 | -2345))) ; Years before year 1 | 115 | -2345))) ; years before year 1 |
| 116 | (if (< year 1) | 116 | (if (< year 1) |
| 117 | (1- year); No year zero | 117 | (1- year) ; no year zero |
| 118 | year))) | 118 | year))) |
| 119 | 119 | ||
| 120 | (defun calendar-persian-from-absolute (date) | 120 | (defun calendar-persian-from-absolute (date) |
| @@ -123,7 +123,7 @@ The result is a list of the form (MONTH DAY YEAR). | |||
| 123 | The absolute date is the number of days elapsed since the imaginary | 123 | The absolute date is the number of days elapsed since the imaginary |
| 124 | Gregorian date Sunday, December 31, 1 BC." | 124 | Gregorian date Sunday, December 31, 1 BC." |
| 125 | (let* ((year (calendar-persian-year-from-absolute date)) | 125 | (let* ((year (calendar-persian-year-from-absolute date)) |
| 126 | (month ; Search forward from Farvardin | 126 | (month ; search forward from Farvardin |
| 127 | (1+ (calendar-sum m 1 | 127 | (1+ (calendar-sum m 1 |
| 128 | (> date | 128 | (> date |
| 129 | (calendar-absolute-from-persian | 129 | (calendar-absolute-from-persian |
| @@ -132,15 +132,14 @@ Gregorian date Sunday, December 31, 1 BC." | |||
| 132 | (persian-calendar-last-day-of-month m year) | 132 | (persian-calendar-last-day-of-month m year) |
| 133 | year))) | 133 | year))) |
| 134 | 1))) | 134 | 1))) |
| 135 | (day ; Calculate the day by subtraction | 135 | (day ; calculate the day by subtraction |
| 136 | (- date (1- (calendar-absolute-from-persian | 136 | (- date (1- (calendar-absolute-from-persian |
| 137 | (list month 1 year)))))) | 137 | (list month 1 year)))))) |
| 138 | (list month day year))) | 138 | (list month day year))) |
| 139 | 139 | ||
| 140 | ;;;###autoload | 140 | ;;;###autoload |
| 141 | (defun calendar-persian-date-string (&optional date) | 141 | (defun calendar-persian-date-string (&optional date) |
| 142 | "String of Persian date of Gregorian DATE. | 142 | "String of Persian date of Gregorian DATE, default today." |
| 143 | Defaults to today's date if DATE is not given." | ||
| 144 | (let* ((persian-date (calendar-persian-from-absolute | 143 | (let* ((persian-date (calendar-persian-from-absolute |
| 145 | (calendar-absolute-from-gregorian | 144 | (calendar-absolute-from-gregorian |
| 146 | (or date (calendar-current-date))))) | 145 | (or date (calendar-current-date))))) |
| @@ -171,14 +170,14 @@ Echo Persian date unless NOECHO is t." | |||
| 171 | 170 | ||
| 172 | (defun persian-prompt-for-date () | 171 | (defun persian-prompt-for-date () |
| 173 | "Ask for a Persian date." | 172 | "Ask for a Persian date." |
| 174 | (let* ((today (calendar-current-date)) | 173 | (let* ((year (calendar-read |
| 175 | (year (calendar-read | ||
| 176 | "Persian calendar year (not 0): " | 174 | "Persian calendar year (not 0): " |
| 177 | (lambda (x) (not (zerop x))) | 175 | (lambda (x) (not (zerop x))) |
| 178 | (int-to-string | 176 | (int-to-string |
| 179 | (extract-calendar-year | 177 | (extract-calendar-year |
| 180 | (calendar-persian-from-absolute | 178 | (calendar-persian-from-absolute |
| 181 | (calendar-absolute-from-gregorian today)))))) | 179 | (calendar-absolute-from-gregorian |
| 180 | (calendar-current-date))))))) | ||
| 182 | (completion-ignore-case t) | 181 | (completion-ignore-case t) |
| 183 | (month (cdr (assoc | 182 | (month (cdr (assoc |
| 184 | (completing-read | 183 | (completing-read |