diff options
| author | Glenn Morris | 2008-03-08 04:18:57 +0000 |
|---|---|---|
| committer | Glenn Morris | 2008-03-08 04:18:57 +0000 |
| commit | b0b671db106f5cdc11a090f046dfd2987a346c73 (patch) | |
| tree | 5aaa81dc9a07b5b0ff6892c3b43c3e43d6212148 | |
| parent | 5fc5b6e16923cad6271ce22608caebb2d92850c0 (diff) | |
| download | emacs-b0b671db106f5cdc11a090f046dfd2987a346c73.tar.gz emacs-b0b671db106f5cdc11a090f046dfd2987a346c73.zip | |
(persian-calendar-month-name-array, persian-calendar-epoch): Make constants.
(persian-prompt-for-date): Use zerop.
| -rw-r--r-- | lisp/calendar/cal-persia.el | 24 |
1 files changed, 12 insertions, 12 deletions
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index c4f80ce80e5..0ad05e99c86 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el | |||
| @@ -1,7 +1,7 @@ | |||
| 1 | ;;; cal-persia.el --- calendar functions for the Persian calendar | 1 | ;;; cal-persia.el --- calendar functions for the Persian calendar |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 | 3 | ;; Copyright (C) 1996, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, |
| 4 | ;; Free Software Foundation, Inc. | 4 | ;; 2008 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> | 6 | ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> |
| 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> | 7 | ;; Maintainer: Glenn Morris <rgm@gnu.org> |
| @@ -32,28 +32,25 @@ | |||
| 32 | 32 | ||
| 33 | ;;; Code: | 33 | ;;; Code: |
| 34 | 34 | ||
| 35 | (defvar date) | ||
| 36 | |||
| 37 | (require 'cal-julian) | 35 | (require 'cal-julian) |
| 38 | 36 | ||
| 39 | (defvar persian-calendar-month-name-array | 37 | (defconst persian-calendar-month-name-array |
| 40 | ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" | 38 | ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban" |
| 41 | "Azar" "Dey" "Bahman" "Esfand"]) | 39 | "Azar" "Dey" "Bahman" "Esfand"]) |
| 42 | 40 | ||
| 43 | (defvar persian-calendar-epoch (calendar-absolute-from-julian '(3 19 622)) | 41 | (defconst persian-calendar-epoch (calendar-absolute-from-julian '(3 19 622)) |
| 44 | "Absolute date of start of Persian calendar = March 19, 622 A.D. (Julian).") | 42 | "Absolute date of start of Persian calendar = March 19, 622 A.D. (Julian).") |
| 45 | 43 | ||
| 46 | (defun persian-calendar-leap-year-p (year) | 44 | (defun persian-calendar-leap-year-p (year) |
| 47 | "True if YEAR is a leap year on the Persian calendar." | 45 | "True if YEAR is a leap year on the Persian calendar." |
| 48 | (< (mod (* (mod (mod (if (<= 0 year) | 46 | (< (mod (* (mod (mod (if (<= 0 year) |
| 49 | ; No year zero | 47 | (+ year 2346) ; no year zero |
| 50 | (+ year 2346) | ||
| 51 | (+ year 2347)) | 48 | (+ year 2347)) |
| 52 | 2820) | 49 | 2820) |
| 53 | 768) | 50 | 768) |
| 54 | 683) | 51 | 683) |
| 55 | 2820) | 52 | 2820) |
| 56 | 683)) | 53 | 683)) |
| 57 | 54 | ||
| 58 | (defun persian-calendar-last-day-of-month (month year) | 55 | (defun persian-calendar-last-day-of-month (month year) |
| 59 | "Return last day of MONTH, YEAR on the Persian calendar." | 56 | "Return last day of MONTH, YEAR on the Persian calendar." |
| @@ -177,7 +174,7 @@ Echo Persian date unless NOECHO is t." | |||
| 177 | (let* ((today (calendar-current-date)) | 174 | (let* ((today (calendar-current-date)) |
| 178 | (year (calendar-read | 175 | (year (calendar-read |
| 179 | "Persian calendar year (not 0): " | 176 | "Persian calendar year (not 0): " |
| 180 | (lambda (x) (/= x 0)) | 177 | (lambda (x) (not (zerop x))) |
| 181 | (int-to-string | 178 | (int-to-string |
| 182 | (extract-calendar-year | 179 | (extract-calendar-year |
| 183 | (calendar-persian-from-absolute | 180 | (calendar-persian-from-absolute |
| @@ -197,6 +194,9 @@ Echo Persian date unless NOECHO is t." | |||
| 197 | (lambda (x) (and (< 0 x) (<= x last)))))) | 194 | (lambda (x) (and (< 0 x) (<= x last)))))) |
| 198 | (list (list month day year)))) | 195 | (list (list month day year)))) |
| 199 | 196 | ||
| 197 | (defvar date) | ||
| 198 | |||
| 199 | ;; To be called from list-sexp-diary-entries, where DATE is bound. | ||
| 200 | (defun diary-persian-date () | 200 | (defun diary-persian-date () |
| 201 | "Persian calendar equivalent of date diary entry." | 201 | "Persian calendar equivalent of date diary entry." |
| 202 | (format "Persian date: %s" (calendar-persian-date-string date))) | 202 | (format "Persian date: %s" (calendar-persian-date-string date))) |