Mercurial > emacs

comparison lisp/calendar/cal-persia.el @ 92606:f49e5129551f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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)