Mercurial > emacs
diff lisp/calendar/cal-islam.el @ 88155:d7ddb3e565de
sync with trunk
author | Henrik Enberg <henrik.enberg@telia.com> |
---|---|
date | Mon, 16 Jan 2006 00:03:54 +0000 |
parents | 0d8b17d428b5 |
children |
line wrap: on
line diff
--- a/lisp/calendar/cal-islam.el Sun Jan 15 23:02:10 2006 +0000 +++ b/lisp/calendar/cal-islam.el Mon Jan 16 00:03:54 2006 +0000 @@ -1,8 +1,10 @@ ;;; cal-islam.el --- calendar functions for the Islamic calendar -;; Copyright (C) 1995, 1997, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005 +;; Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> +;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Islamic calendar, calendar, diary @@ -20,8 +22,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -29,8 +31,8 @@ ;; diary.el that deal with the Islamic calendar. ;; Technical details of all the calendrical calculations can be found in -;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold, -;; Cambridge University Press (1997). +;; ``Calendrical Calculations: The Millennium Edition'' by Edward M. Reingold +;; and Nachum Dershowitz, Cambridge University Press (2001). ;; Comments, corrections, and improvements should be sent to ;; Edward M. Reingold Department of Computer Science @@ -40,11 +42,18 @@ ;;; Code: +(defvar date) +(defvar displayed-month) +(defvar displayed-year) +(defvar number) +(defvar original-date) + (require 'cal-julian) (defvar calendar-islamic-month-name-array ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II" - "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"]) + "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"] +"Array of strings giving the names of the Islamic months.") (defvar calendar-islamic-epoch (calendar-absolute-from-julian '(7 16 622)) "Absolute date of start of Islamic calendar = August 29, 284 A.D. (Julian).") @@ -150,12 +159,12 @@ (calendar-absolute-from-gregorian today)))))) (month-array calendar-islamic-month-name-array) (completion-ignore-case t) - (month (cdr (assoc-ignore-case + (month (cdr (assoc-string (completing-read "Islamic calendar month name: " (mapcar 'list (append month-array nil)) nil t) - (calendar-make-alist month-array 1)))) + (calendar-make-alist month-array 1) t))) (last (islamic-calendar-last-day-of-month month year)) (day (calendar-read (format "Islamic calendar day (1-%d): " last) @@ -221,9 +230,9 @@ (car d))) (backup (equal (car (car d)) 'backup)) (dayname - (concat - (calendar-day-name gdate) "\\|" - (substring (calendar-day-name gdate) 0 3) ".?")) + (format "%s\\|%s\\.?" + (calendar-day-name gdate) + (calendar-day-name gdate 'abbrev))) (calendar-month-name-array calendar-islamic-month-name-array) (monthname @@ -269,7 +278,8 @@ gdate (buffer-substring-no-properties entry-start (point)) (buffer-substring-no-properties - (1+ date-start) (1- entry-start))))))) + (1+ date-start) (1- entry-start)) + (copy-marker entry-start)))))) (setq d (cdr d)))) (setq gdate (calendar-gregorian-from-absolute @@ -293,11 +303,11 @@ ((date-form (if (equal (car (car d)) 'backup) (cdr (car d)) (car d)));; ignore 'backup directive - (dayname (diary-name-pattern calendar-day-name-array)) + (dayname (diary-name-pattern calendar-day-name-array + calendar-day-abbrev-array)) (monthname - (concat - (diary-name-pattern calendar-islamic-month-name-array t) - "\\|\\*")) + (format "%s\\|\\*" + (diary-name-pattern calendar-islamic-month-name-array))) (month "[0-9]+\\|\\*") (day "[0-9]+\\|\\*") (year "[0-9]+\\|\\*") @@ -332,13 +342,13 @@ (buffer-substring (match-beginning m-name-pos) (match-end m-name-pos)))) - (mm (string-to-int + (mm (string-to-number (if m-pos (buffer-substring (match-beginning m-pos) (match-end m-pos)) ""))) - (dd (string-to-int + (dd (string-to-number (if d-pos (buffer-substring (match-beginning d-pos) @@ -357,29 +367,26 @@ (calendar-islamic-from-absolute (calendar-absolute-from-gregorian (calendar-current-date))))) - (y (+ (string-to-int y-str) + (y (+ (string-to-number y-str) (* 100 (/ current-y 100))))) (if (> (- y current-y) 50) (- y 100) (if (> (- current-y y) 50) (+ y 100) y))) - (string-to-int y-str))))) + (string-to-number y-str))))) (if dd-name (mark-calendar-days-named - (cdr (assoc-ignore-case (substring dd-name 0 3) + (cdr (assoc-string dd-name (calendar-make-alist calendar-day-name-array - 0 - '(lambda (x) (substring x 0 3)))))) + 0 nil calendar-day-abbrev-array) t))) (if mm-name - (if (string-equal mm-name "*") - (setq mm 0) - (setq mm - (cdr (assoc-ignore-case - mm-name - (calendar-make-alist - calendar-islamic-month-name-array)))))) + (setq mm (if (string-equal mm-name "*") 0 + (cdr (assoc-string + mm-name + (calendar-make-alist + calendar-islamic-month-name-array) t))))) (mark-islamic-calendar-date-pattern mm dd yy))))) (setq d (cdr d))))) @@ -495,4 +502,5 @@ (provide 'cal-islam) +;;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7 ;;; cal-islam.el ends here