Mercurial > emacs

comparison lisp/calendar/cal-islam.el @ 92926:b87a8e95883b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(displayed-month, displayed-year) (original-date): Move declarations where needed. (islamic-calendar-day-number): Remove unused local variable `day'. (calendar-goto-islamic-date): Doc fix. (holiday-islamic): Use unless. (list-islamic-diary-entries, mark-islamic-diary-entries): Move some constant variables outside the loop. Use dolist. (mark-islamic-calendar-date-pattern): Move definition before use. Use unless. (mark-islamic-diary-entries): Doc fix. (insert-islamic-diary-entry, insert-monthly-islamic-diary-entry) (insert-yearly-islamic-diary-entry): Use let rather than let*.
author Glenn Morris <rgm@gnu.org>
date Fri, 14 Mar 2008 07:13:35 +0000
parents 0f2bf92fe13d
children 56c7e60586c9
comparison
equal deleted inserted replaced
92925:85bb22fa60a0 92926:b87a8e95883b
33 ;; Technical details of all the calendrical calculations can be found in 33 ;; Technical details of all the calendrical calculations can be found in
34 ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold 34 ;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold
35 ;; and Nachum Dershowitz, Cambridge University Press (2001). 35 ;; and Nachum Dershowitz, Cambridge University Press (2001).
36 36
37 ;;; Code: 37 ;;; Code:
38
39 (defvar displayed-month)
40 (defvar displayed-year)
41 (defvar original-date)
42 38
43 (require 'cal-julian) 39 (require 'cal-julian)
44 40
45 (defvar calendar-islamic-month-name-array 41 (defvar calendar-islamic-month-name-array
46 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" 42 ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
62 ((memq month (list 2 4 6 8 10)) 29) 58 ((memq month (list 2 4 6 8 10)) 29)
63 (t (if (islamic-calendar-leap-year-p year) 30 29)))) 59 (t (if (islamic-calendar-leap-year-p year) 30 29))))
64 60
65 (defun islamic-calendar-day-number (date) 61 (defun islamic-calendar-day-number (date)
66 "Return the day number within the year of the Islamic date DATE." 62 "Return the day number within the year of the Islamic date DATE."
67 (let* ((month (extract-calendar-month date)) 63 (let ((month (extract-calendar-month date)))
68 (day (extract-calendar-day date))) 64 (+ (* 30 (/ month 2))
69 (+ (* 30 (/ month 2)) 65 (* 29 (/ (1- month) 2))
70 (* 29 (/ (1- month) 2)) 66 (extract-calendar-day date))))
71 day)))
72 67
73 (defun calendar-absolute-from-islamic (date) 68 (defun calendar-absolute-from-islamic (date)
74 "Absolute date of Islamic DATE. 69 "Absolute date of Islamic DATE.
75 The absolute date is the number of days elapsed since the (imaginary) 70 The absolute date is the number of days elapsed since the (imaginary)
76 Gregorian date Sunday, December 31, 1 BC." 71 Gregorian date Sunday, December 31, 1 BC."
77 (let* ((month (extract-calendar-month date)) 72 (let* ((month (extract-calendar-month date))
78 (day (extract-calendar-day date)) 73 (day (extract-calendar-day date))
79 (year (extract-calendar-year date)) 74 (year (extract-calendar-year date))
80 (y (% year 30)) 75 (y (% year 30))
81 (leap-years-in-cycle 76 (leap-years-in-cycle
82 (cond 77 (cond ((< y 3) 0)
83 ((< y 3) 0) ((< y 6) 1) ((< y 8) 2) ((< y 11) 3) ((< y 14) 4) 78 ((< y 6) 1)
84 ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9) 79 ((< y 8) 2)
85 (t 10)))) 80 ((< y 11) 3)
81 ((< y 14) 4)
82 ((< y 17) 5)
83 ((< y 19) 6)
84 ((< y 22) 7)
85 ((< y 25) 8)
86 ((< y 27) 9)
87 (t 10))))
86 (+ (islamic-calendar-day-number date) ; days so far this year 88 (+ (islamic-calendar-day-number date) ; days so far this year
87 (* (1- year) 354) ; days in all non-leap years 89 (* (1- year) 354) ; days in all non-leap years
88 (* 11 (/ year 30)) ; leap days in complete cycles 90 (* 11 (/ year 30)) ; leap days in complete cycles
89 leap-years-in-cycle ; leap days this cycle 91 leap-years-in-cycle ; leap days this cycle
90 (1- calendar-islamic-epoch)))) ; days before start of calendar 92 (1- calendar-islamic-epoch)))) ; days before start of calendar
140 (message "Date is pre-Islamic") 142 (message "Date is pre-Islamic")
141 (message "Islamic date (until sunset): %s" i)))) 143 (message "Islamic date (until sunset): %s" i))))
142 144
143 ;;;###cal-autoload 145 ;;;###cal-autoload
144 (defun calendar-goto-islamic-date (date &optional noecho) 146 (defun calendar-goto-islamic-date (date &optional noecho)
145 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t." 147 "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is non-nil."
146 (interactive 148 (interactive
147 (let* ((today (calendar-current-date)) 149 (let* ((today (calendar-current-date))
148 (year (calendar-read 150 (year (calendar-read
149 "Islamic calendar year (>0): " 151 "Islamic calendar year (>0): "
150 (lambda (x) (> x 0)) 152 (lambda (x) (> x 0))
167 (list (list month day year)))) 169 (list (list month day year))))
168 (calendar-goto-date (calendar-gregorian-from-absolute 170 (calendar-goto-date (calendar-gregorian-from-absolute
169 (calendar-absolute-from-islamic date))) 171 (calendar-absolute-from-islamic date)))
170 (or noecho (calendar-print-islamic-date))) 172 (or noecho (calendar-print-islamic-date)))
171 173
174 (defvar displayed-month) ; from generate-calendar
175 (defvar displayed-year)
176
172 ;;;###holiday-autoload 177 ;;;###holiday-autoload
173 (defun holiday-islamic (month day string) 178 (defun holiday-islamic (month day string)
174 "Holiday on MONTH, DAY (Islamic) called STRING. 179 "Holiday on MONTH, DAY (Islamic) called STRING.
175 If MONTH, DAY (Islamic) is visible, the value returned is corresponding 180 If MONTH, DAY (Islamic) is visible, the value returned is corresponding
176 Gregorian date in the form of the list (((month day year) STRING)). Returns 181 Gregorian date in the form of the list (((month day year) STRING)). Returns
179 (calendar-absolute-from-gregorian 184 (calendar-absolute-from-gregorian
180 (list displayed-month 15 displayed-year)))) 185 (list displayed-month 15 displayed-year))))
181 (m (extract-calendar-month islamic-date)) 186 (m (extract-calendar-month islamic-date))
182 (y (extract-calendar-year islamic-date)) 187 (y (extract-calendar-year islamic-date))
183 (date)) 188 (date))
184 (if (< m 1) 189 (unless (< m 1) ; Islamic calendar doesn't apply
185 nil ; Islamic calendar doesn't apply
186 (increment-calendar-month m y (- 10 month)) 190 (increment-calendar-month m y (- 10 month))
187 (if (> m 7) ; Islamic date might be visible 191 (if (> m 7) ; Islamic date might be visible
188 (let ((date (calendar-gregorian-from-absolute 192 (let ((date (calendar-gregorian-from-absolute
189 (calendar-absolute-from-islamic (list month day y))))) 193 (calendar-absolute-from-islamic (list month day y)))))
190 (if (calendar-date-is-visible-p date) 194 (if (calendar-date-is-visible-p date)
191 (list (list date string)))))))) 195 (list (list date string))))))))
192 196
193 ;; l-i-d-e should be called from diary code. 197 ;; l-i-d-e should be called from diary code.
194 (declare-function add-to-diary-list "diary-lib" 198 (declare-function add-to-diary-list "diary-lib"
195 (date string specifier &optional marker globcolor literal)) 199 (date string specifier &optional marker globcolor literal))
196 200
197 (defvar number) ; from diary-list-entries 201 (defvar number) ; from diary-list-entries
202 (defvar original-date)
198 203
199 ;;;###diary-autoload 204 ;;;###diary-autoload
200 (defun list-islamic-diary-entries () 205 (defun list-islamic-diary-entries ()
201 "Add any Islamic date entries from the diary file to `diary-entries-list'. 206 "Add any Islamic date entries from the diary file to `diary-entries-list'.
202 Islamic date diary entries must be prefaced by `islamic-diary-entry-symbol' 207 Islamic date diary entries must be prefaced by `islamic-diary-entry-symbol'
212 (let ((buffer-read-only nil) 217 (let ((buffer-read-only nil)
213 (diary-modified (buffer-modified-p)) 218 (diary-modified (buffer-modified-p))
214 (gdate original-date) 219 (gdate original-date)
215 (mark (regexp-quote diary-nonmarking-symbol))) 220 (mark (regexp-quote diary-nonmarking-symbol)))
216 (dotimes (idummy number) 221 (dotimes (idummy number)
217 (let* ((d diary-date-forms) 222 (let* ((idate (calendar-islamic-from-absolute
218 (idate (calendar-islamic-from-absolute
219 (calendar-absolute-from-gregorian gdate))) 223 (calendar-absolute-from-gregorian gdate)))
220 (month (extract-calendar-month idate)) 224 (month (extract-calendar-month idate))
221 (day (extract-calendar-day idate)) 225 (day (extract-calendar-day idate))
222 (year (extract-calendar-year idate))) 226 (year (extract-calendar-year idate))
223 (while d 227 backup)
224 (let* 228 (dolist (date-form diary-date-forms)
225 ((date-form (if (equal (car (car d)) 'backup) 229 (if (setq backup (eq (car date-form) 'backup))
226 (cdr (car d)) 230 (setq date-form (cdr date-form)))
227 (car d))) 231 (let* ((dayname
228 (backup (equal (car (car d)) 'backup)) 232 (format "%s\\|%s\\.?"
229 (dayname 233 (calendar-day-name gdate)
230 (format "%s\\|%s\\.?" 234 (calendar-day-name gdate 'abbrev)))
231 (calendar-day-name gdate) 235 (calendar-month-name-array
232 (calendar-day-name gdate 'abbrev))) 236 calendar-islamic-month-name-array)
233 (calendar-month-name-array 237 (monthname
234 calendar-islamic-month-name-array) 238 (concat "\\*\\|" (calendar-month-name month)))
235 (monthname 239 (month (concat "\\*\\|0*" (int-to-string month)))
236 (concat 240 (day (concat "\\*\\|0*" (int-to-string day)))
237 "\\*\\|" 241 (year
238 (calendar-month-name month))) 242 (concat "\\*\\|0*" (int-to-string year)
239 (month (concat "\\*\\|0*" (int-to-string month))) 243 (if abbreviated-calendar-year
240 (day (concat "\\*\\|0*" (int-to-string day))) 244 (concat "\\|" (int-to-string (% year 100)))
241 (year 245 "")))
242 (concat 246 ;; FIXME ^M can go now.
243 "\\*\\|0*" (int-to-string year) 247 (regexp
244 (if abbreviated-calendar-year 248 (concat
245 (concat "\\|" (int-to-string (% year 100))) 249 "\\(\\`\\|\^M\\|\n\\)" mark "?"
246 ""))) 250 (regexp-quote islamic-diary-entry-symbol)
247 (regexp 251 "\\("
248 (concat 252 (mapconcat 'eval date-form "\\)\\(")
249 "\\(\\`\\|\^M\\|\n\\)" mark "?" 253 "\\)"))
250 (regexp-quote islamic-diary-entry-symbol) 254 (case-fold-search t))
251 "\\("
252 (mapconcat 'eval date-form "\\)\\(")
253 "\\)"))
254 (case-fold-search t))
255 (goto-char (point-min)) 255 (goto-char (point-min))
256 (while (re-search-forward regexp nil t) 256 (while (re-search-forward regexp nil t)
257 (if backup (re-search-backward "\\<" nil t)) 257 (if backup (re-search-backward "\\<" nil t))
258 (if (and (or (char-equal (preceding-char) ?\^M) 258 (if (and (or (char-equal (preceding-char) ?\^M)
259 (char-equal (preceding-char) ?\n)) 259 (char-equal (preceding-char) ?\n))
274 (add-to-diary-list 274 (add-to-diary-list
275 gdate 275 gdate
276 (buffer-substring-no-properties entry-start (point)) 276 (buffer-substring-no-properties entry-start (point))
277 (buffer-substring-no-properties 277 (buffer-substring-no-properties
278 (1+ date-start) (1- entry-start)) 278 (1+ date-start) (1- entry-start))
279 (copy-marker entry-start)))))) 279 (copy-marker entry-start))))))))
280 (setq d (cdr d))))
281 (setq gdate 280 (setq gdate
282 (calendar-gregorian-from-absolute 281 (calendar-gregorian-from-absolute
283 (1+ (calendar-absolute-from-gregorian gdate))))) 282 (1+ (calendar-absolute-from-gregorian gdate)))))
284 (set-buffer-modified-p diary-modified)) 283 (set-buffer-modified-p diary-modified))
285 (goto-char (point-min)))) 284 (goto-char (point-min))))
286
287 (declare-function diary-name-pattern "diary-lib"
288 (string-array &optional abbrev-array paren))
289
290 (declare-function mark-calendar-days-named "diary-lib"
291 (dayname &optional color))
292
293 ;;;###diary-autoload
294 (defun mark-islamic-diary-entries ()
295 "Mark days in the calendar window that have Islamic date diary entries.
296 Each entry in `diary-file' (or included files) visible in the calendar window
297 is marked. Islamic date entries are prefaced by `islamic-diary-entry-symbol'
298 \(normally an `I'). The same `diary-date-forms' govern the style of the Islamic
299 calendar entries, except that the Islamic month names must be spelled in full.
300 The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
301 Dhu al-Hijjah. Islamic date diary entries that begin with a
302 `diary-nonmarking-symbol' will not be marked in the calendar. This function is
303 provided for use as part of the `nongregorian-diary-marking-hook'."
304 (let ((d diary-date-forms))
305 (while d
306 (let*
307 ((date-form (if (equal (car (car d)) 'backup)
308 (cdr (car d))
309 (car d))) ; ignore 'backup directive
310 (dayname (diary-name-pattern calendar-day-name-array
311 calendar-day-abbrev-array))
312 (monthname
313 (format "%s\\|\\*"
314 (diary-name-pattern calendar-islamic-month-name-array)))
315 (month "[0-9]+\\|\\*")
316 (day "[0-9]+\\|\\*")
317 (year "[0-9]+\\|\\*")
318 (l (length date-form))
319 (d-name-pos (- l (length (memq 'dayname date-form))))
320 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
321 (m-name-pos (- l (length (memq 'monthname date-form))))
322 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
323 (d-pos (- l (length (memq 'day date-form))))
324 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
325 (m-pos (- l (length (memq 'month date-form))))
326 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
327 (y-pos (- l (length (memq 'year date-form))))
328 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
329 (regexp
330 (concat
331 "\\(\\`\\|\^M\\|\n\\)"
332 (regexp-quote islamic-diary-entry-symbol)
333 "\\("
334 (mapconcat 'eval date-form "\\)\\(")
335 "\\)"))
336 (case-fold-search t))
337 (goto-char (point-min))
338 (while (re-search-forward regexp nil t)
339 (let* ((dd-name
340 (if d-name-pos
341 (buffer-substring
342 (match-beginning d-name-pos)
343 (match-end d-name-pos))))
344 (mm-name
345 (if m-name-pos
346 (buffer-substring
347 (match-beginning m-name-pos)
348 (match-end m-name-pos))))
349 (mm (string-to-number
350 (if m-pos
351 (buffer-substring
352 (match-beginning m-pos)
353 (match-end m-pos))
354 "")))
355 (dd (string-to-number
356 (if d-pos
357 (buffer-substring
358 (match-beginning d-pos)
359 (match-end d-pos))
360 "")))
361 (y-str (if y-pos
362 (buffer-substring
363 (match-beginning y-pos)
364 (match-end y-pos))))
365 (yy (if (not y-str)
366 0
367 (if (and (= (length y-str) 2)
368 abbreviated-calendar-year)
369 (let* ((current-y
370 (extract-calendar-year
371 (calendar-islamic-from-absolute
372 (calendar-absolute-from-gregorian
373 (calendar-current-date)))))
374 (y (+ (string-to-number y-str)
375 (* 100 (/ current-y 100)))))
376 (if (> (- y current-y) 50)
377 (- y 100)
378 (if (> (- current-y y) 50)
379 (+ y 100)
380 y)))
381 (string-to-number y-str)))))
382 (if dd-name
383 (mark-calendar-days-named
384 (cdr (assoc-string dd-name
385 (calendar-make-alist
386 calendar-day-name-array
387 0 nil calendar-day-abbrev-array) t)))
388 (if mm-name
389 (setq mm (if (string-equal mm-name "*") 0
390 (cdr (assoc-string
391 mm-name
392 (calendar-make-alist
393 calendar-islamic-month-name-array) t)))))
394 (mark-islamic-calendar-date-pattern mm dd yy)))))
395 (setq d (cdr d)))))
396 285
397 ;;;###diary-autoload 286 ;;;###diary-autoload
398 (defun mark-islamic-calendar-date-pattern (month day year) 287 (defun mark-islamic-calendar-date-pattern (month day year)
399 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. 288 "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
400 A value of 0 in any position is a wildcard." 289 A value of 0 in any position is a wildcard."
413 (calendar-absolute-from-gregorian 302 (calendar-absolute-from-gregorian
414 (list displayed-month 15 displayed-year)))) 303 (list displayed-month 15 displayed-year))))
415 (m (extract-calendar-month islamic-date)) 304 (m (extract-calendar-month islamic-date))
416 (y (extract-calendar-year islamic-date)) 305 (y (extract-calendar-year islamic-date))
417 (date)) 306 (date))
418 (if (< m 1) 307 (unless (< m 1) ; Islamic calendar doesn't apply
419 nil ; Islamic calendar doesn't apply
420 (increment-calendar-month m y (- 10 month)) 308 (increment-calendar-month m y (- 10 month))
421 (if (> m 7) ; Islamic date might be visible 309 (if (> m 7) ; Islamic date might be visible
422 (let ((date (calendar-gregorian-from-absolute 310 (let ((date (calendar-gregorian-from-absolute
423 (calendar-absolute-from-islamic 311 (calendar-absolute-from-islamic
424 (list month day y))))) 312 (list month day y)))))
425 (if (calendar-date-is-visible-p date) 313 (if (calendar-date-is-visible-p date)
426 (mark-visible-calendar-date date))))))) 314 (mark-visible-calendar-date date)))))))
451 (or (zerop year) 339 (or (zerop year)
452 (= year i-year)) 340 (= year i-year))
453 (mark-visible-calendar-date 341 (mark-visible-calendar-date
454 (calendar-gregorian-from-absolute date))))))))) 342 (calendar-gregorian-from-absolute date)))))))))
455 343
344 (declare-function diary-name-pattern "diary-lib"
345 (string-array &optional abbrev-array paren))
346
347 (declare-function mark-calendar-days-named "diary-lib"
348 (dayname &optional color))
349
350 ;;;###diary-autoload
351 (defun mark-islamic-diary-entries ()
352 "Mark days in the calendar window that have Islamic date diary entries.
353 Mark each entry in `diary-file' (or included files) visible in the calendar
354 window. Islamic date entries are prefaced by `islamic-diary-entry-symbol'
355 \(normally an `I'). The same `diary-date-forms' govern the style
356 of the Islamic calendar entries, except that the Islamic month
357 names must be spelled in full. The Islamic months are numbered
358 from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah.
359 Islamic date diary entries that begin with `diary-nonmarking-symbol'
360 are not marked. This function is provided for use as part of
361 `nongregorian-diary-marking-hook'."
362 (let ((dayname (diary-name-pattern calendar-day-name-array
363 calendar-day-abbrev-array))
364 (monthname
365 (format "%s\\|\\*"
366 (diary-name-pattern calendar-islamic-month-name-array)))
367 (month "[0-9]+\\|\\*")
368 (day "[0-9]+\\|\\*")
369 (year "[0-9]+\\|\\*")
370 (case-fold-search t))
371 (dolist (date-form diary-date-forms)
372 (if (eq (car date-form) 'backup) ; ignore 'backup directive
373 (setq date-form (cdr date-form)))
374 (let* ((l (length date-form))
375 (d-name-pos (- l (length (memq 'dayname date-form))))
376 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
377 (m-name-pos (- l (length (memq 'monthname date-form))))
378 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
379 (d-pos (- l (length (memq 'day date-form))))
380 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
381 (m-pos (- l (length (memq 'month date-form))))
382 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
383 (y-pos (- l (length (memq 'year date-form))))
384 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
385 (regexp
386 (concat
387 "\\(\\`\\|\^M\\|\n\\)"
388 (regexp-quote islamic-diary-entry-symbol)
389 "\\("
390 (mapconcat 'eval date-form "\\)\\(")
391 "\\)")))
392 (goto-char (point-min))
393 (while (re-search-forward regexp nil t)
394 (let* ((dd-name
395 (if d-name-pos
396 (buffer-substring
397 (match-beginning d-name-pos)
398 (match-end d-name-pos))))
399 (mm-name
400 (if m-name-pos
401 (buffer-substring
402 (match-beginning m-name-pos)
403 (match-end m-name-pos))))
404 (mm (string-to-number
405 (if m-pos
406 (buffer-substring
407 (match-beginning m-pos)
408 (match-end m-pos))
409 "")))
410 (dd (string-to-number
411 (if d-pos
412 (buffer-substring
413 (match-beginning d-pos)
414 (match-end d-pos))
415 "")))
416 (y-str (if y-pos
417 (buffer-substring
418 (match-beginning y-pos)
419 (match-end y-pos))))
420 (yy (if (not y-str)
421 0
422 (if (and (= (length y-str) 2)
423 abbreviated-calendar-year)
424 (let* ((current-y
425 (extract-calendar-year
426 (calendar-islamic-from-absolute
427 (calendar-absolute-from-gregorian
428 (calendar-current-date)))))
429 (y (+ (string-to-number y-str)
430 (* 100 (/ current-y 100)))))
431 (if (> (- y current-y) 50)
432 (- y 100)
433 (if (> (- current-y y) 50)
434 (+ y 100)
435 y)))
436 (string-to-number y-str)))))
437 (if dd-name
438 (mark-calendar-days-named
439 (cdr (assoc-string dd-name
440 (calendar-make-alist
441 calendar-day-name-array
442 0 nil calendar-day-abbrev-array) t)))
443 (if mm-name
444 (setq mm (if (string-equal mm-name "*") 0
445 (cdr (assoc-string
446 mm-name
447 (calendar-make-alist
448 calendar-islamic-month-name-array) t)))))
449 (mark-islamic-calendar-date-pattern mm dd yy))))))))
450
456 ;;;###cal-autoload 451 ;;;###cal-autoload
457 (defun insert-islamic-diary-entry (arg) 452 (defun insert-islamic-diary-entry (arg)
458 "Insert a diary entry. 453 "Insert a diary entry.
459 For the Islamic date corresponding to the date indicated by point. 454 For the Islamic date corresponding to the date indicated by point.
460 Prefix argument ARG makes the entry nonmarking." 455 Prefix argument ARG makes the entry nonmarking."
461 (interactive "P") 456 (interactive "P")
462 (let* ((calendar-month-name-array calendar-islamic-month-name-array)) 457 (let ((calendar-month-name-array calendar-islamic-month-name-array))
463 (make-diary-entry 458 (make-diary-entry
464 (concat 459 (concat islamic-diary-entry-symbol
465 islamic-diary-entry-symbol 460 (calendar-date-string
466 (calendar-date-string 461 (calendar-islamic-from-absolute
467 (calendar-islamic-from-absolute 462 (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))
468 (calendar-absolute-from-gregorian 463 nil t))
469 (calendar-cursor-to-date t)))
470 nil t))
471 arg))) 464 arg)))
472 465
473 ;;;###cal-autoload 466 ;;;###cal-autoload
474 (defun insert-monthly-islamic-diary-entry (arg) 467 (defun insert-monthly-islamic-diary-entry (arg)
475 "Insert a monthly diary entry. 468 "Insert a monthly diary entry.
476 For the day of the Islamic month corresponding to the date indicated by point. 469 For the day of the Islamic month corresponding to the date indicated by point.
477 Prefix argument ARG makes the entry nonmarking." 470 Prefix argument ARG makes the entry nonmarking."
478 (interactive "P") 471 (interactive "P")
479 (let* ((calendar-date-display-form 472 (let ((calendar-date-display-form (if european-calendar-style
480 (if european-calendar-style '(day " * ") '("* " day ))) 473 '(day " * ")
481 (calendar-month-name-array calendar-islamic-month-name-array)) 474 '("* " day )))
475 (calendar-month-name-array calendar-islamic-month-name-array))
482 (make-diary-entry 476 (make-diary-entry
483 (concat 477 (concat islamic-diary-entry-symbol
484 islamic-diary-entry-symbol 478 (calendar-date-string
485 (calendar-date-string 479 (calendar-islamic-from-absolute
486 (calendar-islamic-from-absolute 480 (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
487 (calendar-absolute-from-gregorian
488 (calendar-cursor-to-date t)))))
489 arg))) 481 arg)))
490 482
491 ;;;###cal-autoload 483 ;;;###cal-autoload
492 (defun insert-yearly-islamic-diary-entry (arg) 484 (defun insert-yearly-islamic-diary-entry (arg)
493 "Insert an annual diary entry. 485 "Insert an annual diary entry.
494 For the day of the Islamic year corresponding to the date indicated by point. 486 For the day of the Islamic year corresponding to the date indicated by point.
495 Prefix argument ARG makes the entry nonmarking." 487 Prefix argument ARG makes the entry nonmarking."
496 (interactive "P") 488 (interactive "P")
497 (let* ((calendar-date-display-form 489 (let ((calendar-date-display-form (if european-calendar-style
498 (if european-calendar-style 490 '(day " " monthname)
499 '(day " " monthname) 491 '(monthname " " day)))
500 '(monthname " " day))) 492 (calendar-month-name-array calendar-islamic-month-name-array))
501 (calendar-month-name-array calendar-islamic-month-name-array))
502 (make-diary-entry 493 (make-diary-entry
503 (concat 494 (concat islamic-diary-entry-symbol
504 islamic-diary-entry-symbol 495 (calendar-date-string
505 (calendar-date-string 496 (calendar-islamic-from-absolute
506 (calendar-islamic-from-absolute 497 (calendar-absolute-from-gregorian (calendar-cursor-to-date t)))))
507 (calendar-absolute-from-gregorian
508 (calendar-cursor-to-date t)))))
509 arg))) 498 arg)))
510 499
511 (defvar date) 500 (defvar date)
512 501
513 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound. 502 ;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.