Mercurial > emacs
comparison lisp/calendar/cal-persia.el @ 92606:f49e5129551f
(persian-calendar-month-name-array, persian-calendar-epoch): Make constants.
(persian-prompt-for-date): Use zerop.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Sat, 08 Mar 2008 04:18:57 +0000 |
parents | dc0c296afd7e |
children | 693124d99e7c |
comparison
equal
deleted
inserted
replaced
92605:5fb3b5d72071 | 92606:f49e5129551f |
---|---|
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> |
8 ;; Keywords: calendar | 8 ;; Keywords: calendar |
9 ;; Human-Keywords: Persian calendar, calendar, diary | 9 ;; Human-Keywords: Persian calendar, calendar, diary |
30 ;; This collection of functions implements the features of calendar.el and | 30 ;; This collection of functions implements the features of calendar.el and |
31 ;; diary.el that deal with the Persian calendar. | 31 ;; diary.el that deal with the Persian calendar. |
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." |
60 (cond | 57 (cond |
61 ((< month 7) 31) | 58 ((< month 7) 31) |
175 (defun persian-prompt-for-date () | 172 (defun persian-prompt-for-date () |
176 "Ask for a Persian date." | 173 "Ask for a Persian date." |
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 |
184 (calendar-absolute-from-gregorian today)))))) | 181 (calendar-absolute-from-gregorian today)))))) |
185 (completion-ignore-case t) | 182 (completion-ignore-case t) |
195 (day (calendar-read | 192 (day (calendar-read |
196 (format "Persian calendar day (1-%d): " last) | 193 (format "Persian calendar day (1-%d): " last) |
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))) |
203 | 203 |
204 (provide 'cal-persia) | 204 (provide 'cal-persia) |