aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGlenn Morris2008-03-13 03:56:26 +0000
committerGlenn Morris2008-03-13 03:56:26 +0000
commitd01890eee3b6ac6134c4319e26060dbff86bec13 (patch)
treefb75c781808075ebf912089f055f10fda51b0b8c
parent863ad01b09b51e2047643ef83c03e32a83612e12 (diff)
downloademacs-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.el69
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).
123The absolute date is the number of days elapsed since the imaginary 123The absolute date is the number of days elapsed since the imaginary
124Gregorian date Sunday, December 31, 1 BC." 124Gregorian 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."
143Defaults 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