annotate lisp/calendar/cal-bahai.el @ 73405:7009c1377caf

*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Tue, 17 Oct 2006 19:39:43 +0000
parents 8daf7d9a0771
children 7a3f13e2dd57
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
1 ;;; cal-bahai.el --- calendar functions for the Baha'i calendar.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
2
68721
8daf7d9a0771 Add 2006 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 67465
diff changeset
3 ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006
8daf7d9a0771 Add 2006 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 67465
diff changeset
4 ;; Free Software Foundation, Inc.
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
5
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
6 ;; Author: John Wiegley <johnw@gnu.org>
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
7 ;; Keywords: calendar
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
8 ;; Human-Keywords: Baha'i calendar, Baha'i, Bahai, calendar, diary
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
9
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
10 ;; This file is part of GNU Emacs.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
11
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
12 ;; GNU Emacs is free software; you can redistribute it and/or modify
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
13 ;; it under the terms of the GNU General Public License as published by
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
14 ;; the Free Software Foundation; either version 2, or (at your option)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
15 ;; any later version.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
16
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
17 ;; GNU Emacs is distributed in the hope that it will be useful,
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
20 ;; GNU General Public License for more details.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
21
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
22 ;; You should have received a copy of the GNU General Public License
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
23 ;; along with GNU Emacs; see the file COPYING. If not, write to the
64085
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62402
diff changeset
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18a818a2ee7c Update FSF's address.
Lute Kamstra <lute@gnu.org>
parents: 62402
diff changeset
25 ;; Boston, MA 02110-1301, USA.
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
26
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
27 ;;; Commentary:
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
28
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
29 ;; This collection of functions implements the features of calendar.el
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
30 ;; and diary.el that deal with the Baha'i calendar.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
31
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
32 ;; The Baha'i (http://www.bahai.org) calendar system is based on a
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
33 ;; solar cycle of 19 months with 19 days each. The four remaining
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
34 ;; "intercalary" days are called the Ayyam-i-Ha (days of Ha), and are
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
35 ;; placed between the 18th and 19th months. They are meant as a time
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
36 ;; of festivals preceding the 19th month, which is the month of
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
37 ;; fasting. In Gregorian leap years, there are 5 of these days (Ha
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
38 ;; has the numerical value of 5 in the arabic abjad, or
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
39 ;; letter-to-number, reckoning).
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
40
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
41 ;; Each month is named after an attribute of God, as are the 19 days
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
42 ;; -- which have the same names as the months. There is also a name
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
43 ;; for each year in every 19 year cycle. These cycles are called
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
44 ;; Vahids. A cycle of 19 Vahids (361 years) is called a Kullu-Shay,
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
45 ;; which means "all things".
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
46
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
47 ;; The calendar was named the "Badi calendar" by its author, the Bab.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
48 ;; It uses a week of seven days, corresponding to the Gregorian week,
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
49 ;; each of which has its own name, again patterned after the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
50 ;; attributes of God.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
51
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
52 ;; Note: The days of Ayyam-i-Ha are encoded as zero and negative
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
53 ;; offsets from the first day of the final month. So, (19 -3 157) is
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
54 ;; the first day of Ayyam-i-Ha, in the year 157 BE.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
55
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
56 ;;; Code:
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
57
65141
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
58 (defvar date)
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
59 (defvar displayed-month)
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
60 (defvar displayed-year)
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
61 (defvar number)
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
62 (defvar original-date)
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
63
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
64 (require 'cal-julian)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
65
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
66 (defvar bahai-calendar-month-name-array
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
67 ["Baha" "Jalal" "Jamal" "`Azamat" "Nur" "Rahmat" "Kalimat" "Kamal"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
68 "Asma" "`Izzat" "Mashiyyat" "`Ilm" "Qudrat" "Qawl" "Masa'il"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
69 "Sharaf" "Sultan" "Mulk" "`Ala"])
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
70
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
71 (defvar calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
72 "Absolute date of start of Baha'i calendar = March 19, 622 A.D. (Julian).")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
73
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
74 (defun bahai-calendar-leap-year-p (year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
75 "True if YEAR is a leap year on the Baha'i calendar."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
76 (calendar-leap-year-p (+ year 1844)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
77
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
78 (defvar bahai-calendar-leap-base
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
79 (+ (/ 1844 4) (- (/ 1844 100)) (/ 1844 400)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
80
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
81 (defun calendar-absolute-from-bahai (date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
82 "Compute absolute date from Baha'i date DATE.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
83 The absolute date is the number of days elapsed since the (imaginary)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
84 Gregorian date Sunday, December 31, 1 BC."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
85 (let* ((month (extract-calendar-month date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
86 (day (extract-calendar-day date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
87 (year (extract-calendar-year date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
88 (prior-years (+ (1- year) 1844))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
89 (leap-days (- (+ (/ prior-years 4) ; Leap days in prior years.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
90 (- (/ prior-years 100))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
91 (/ prior-years 400))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
92 bahai-calendar-leap-base)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
93 (+ (1- calendar-bahai-epoch) ; Days before epoch
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
94 (* 365 (1- year)) ; Days in prior years.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
95 leap-days
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
96 (calendar-sum m 1 (< m month) 19)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
97 (if (= month 19) 4 0)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
98 day))) ; Days so far this month.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
99
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
100 (defun calendar-bahai-from-absolute (date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
101 "Baha'i year corresponding to the absolute DATE."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
102 (if (< date calendar-bahai-epoch)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
103 (list 0 0 0) ;; pre-Baha'i date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
104 (let* ((greg (calendar-gregorian-from-absolute date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
105 (year (+ (- (extract-calendar-year greg) 1844)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
106 (if (or (> (extract-calendar-month greg) 3)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
107 (and (= (extract-calendar-month greg) 3)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
108 (>= (extract-calendar-day greg) 21)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
109 1 0)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
110 (month ;; Search forward from Baha.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
111 (1+ (calendar-sum m 1
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
112 (> date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
113 (calendar-absolute-from-bahai
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
114 (list m 19 year)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
115 1)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
116 (day ;; Calculate the day by subtraction.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
117 (- date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
118 (1- (calendar-absolute-from-bahai (list month 1 year))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
119 (list month day year))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
120
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
121 (defun calendar-bahai-date-string (&optional date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
122 "String of Baha'i date of Gregorian DATE.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
123 Defaults to today's date if DATE is not given."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
124 (let* ((bahai-date (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
125 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
126 (or date (calendar-current-date)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
127 (y (extract-calendar-year bahai-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
128 (m (extract-calendar-month bahai-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
129 (d (extract-calendar-day bahai-date)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
130 (let ((monthname
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
131 (if (and (= m 19)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
132 (<= d 0))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
133 "Ayyam-i-Ha"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
134 (aref bahai-calendar-month-name-array (1- m))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
135 (day (int-to-string
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
136 (if (<= d 0)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
137 (if (bahai-calendar-leap-year-p y)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
138 (+ d 5)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
139 (+ d 4))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
140 d)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
141 (dayname nil)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
142 (month (int-to-string m))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
143 (year (int-to-string y)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
144 (mapconcat 'eval calendar-date-display-form ""))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
145
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
146 (defun calendar-print-bahai-date ()
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
147 "Show the Baha'i calendar equivalent of the selected date."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
148 (interactive)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
149 (message "Baha'i date: %s"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
150 (calendar-bahai-date-string (calendar-cursor-to-date t))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
151
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
152 (defun calendar-goto-bahai-date (date &optional noecho)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
153 "Move cursor to Baha'i date DATE.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
154 Echo Baha'i date unless NOECHO is t."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
155 (interactive (bahai-prompt-for-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
156 (calendar-goto-date (calendar-gregorian-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
157 (calendar-absolute-from-bahai date)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
158 (or noecho (calendar-print-bahai-date)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
159
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
160 (defun bahai-prompt-for-date ()
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
161 "Ask for a Baha'i date."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
162 (let* ((today (calendar-current-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
163 (year (calendar-read
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
164 "Baha'i calendar year (not 0): "
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
165 '(lambda (x) (/= x 0))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
166 (int-to-string
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
167 (extract-calendar-year
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
168 (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
169 (calendar-absolute-from-gregorian today))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
170 (completion-ignore-case t)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
171 (month (cdr (assoc
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
172 (completing-read
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
173 "Baha'i calendar month name: "
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
174 (mapcar 'list
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
175 (append bahai-calendar-month-name-array nil))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
176 nil t)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
177 (calendar-make-alist bahai-calendar-month-name-array
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
178 1))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
179 (day (calendar-read "Baha'i calendar day (1-19): "
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
180 '(lambda (x) (and (< 0 x) (<= x 19))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
181 (list (list month day year))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
182
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
183 (defun diary-bahai-date ()
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
184 "Baha'i calendar equivalent of date diary entry."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
185 (format "Baha'i date: %s" (calendar-bahai-date-string date)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
186
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
187 (defun holiday-bahai (month day string)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
188 "Holiday on MONTH, DAY (Baha'i) called STRING.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
189 If MONTH, DAY (Baha'i) is visible, the value returned is corresponding
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
190 Gregorian date in the form of the list (((month day year) STRING)). Returns
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
191 nil if it is not visible in the current calendar window."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
192 (let* ((bahai-date (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
193 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
194 (list displayed-month 15 displayed-year))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
195 (m (extract-calendar-month bahai-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
196 (y (extract-calendar-year bahai-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
197 (date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
198 (if (< m 1)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
199 nil ;; Baha'i calendar doesn't apply.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
200 (increment-calendar-month m y (- 10 month))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
201 (if (> m 7) ;; Baha'i date might be visible
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
202 (let ((date (calendar-gregorian-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
203 (calendar-absolute-from-bahai (list month day y)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
204 (if (calendar-date-is-visible-p date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
205 (list (list date string))))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
206
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
207 (defun list-bahai-diary-entries ()
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
208 "Add any Baha'i date entries from the diary file to `diary-entries-list'.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
209 Baha'i date diary entries must be prefaced by an
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
210 `bahai-diary-entry-symbol' (normally a `B'). The same diary date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
211 forms govern the style of the Baha'i calendar entries, except that the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
212 Baha'i month names must be given numerically. The Baha'i months are
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
213 numbered from 1 to 19 with Baha being 1 and 19 being `Ala. If a
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
214 Baha'i date diary entry begins with a `diary-nonmarking-symbol', the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
215 entry will appear in the diary listing, but will not be marked in the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
216 calendar. This function is provided for use with the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
217 `nongregorian-diary-listing-hook'."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
218 (if (< 0 number)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
219 (let ((buffer-read-only nil)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
220 (diary-modified (buffer-modified-p))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
221 (gdate original-date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
222 (mark (regexp-quote diary-nonmarking-symbol)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
223 (calendar-for-loop i from 1 to number do
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
224 (let* ((d diary-date-forms)
65141
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
225 (bdate (calendar-bahai-from-absolute
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
226 (calendar-absolute-from-gregorian gdate)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
227 (month (extract-calendar-month bdate))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
228 (day (extract-calendar-day bdate))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
229 (year (extract-calendar-year bdate)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
230 (while d
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
231 (let*
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
232 ((date-form (if (equal (car (car d)) 'backup)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
233 (cdr (car d))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
234 (car d)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
235 (backup (equal (car (car d)) 'backup))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
236 (dayname
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
237 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
238 (calendar-day-name gdate) "\\|"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
239 (substring (calendar-day-name gdate) 0 3) ".?"))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
240 (calendar-month-name-array
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
241 bahai-calendar-month-name-array)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
242 (monthname
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
243 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
244 "\\*\\|"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
245 (calendar-month-name month)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
246 (month (concat "\\*\\|0*" (int-to-string month)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
247 (day (concat "\\*\\|0*" (int-to-string day)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
248 (year
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
249 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
250 "\\*\\|0*" (int-to-string year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
251 (if abbreviated-calendar-year
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
252 (concat "\\|" (int-to-string (% year 100)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
253 "")))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
254 (regexp
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
255 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
256 "\\(\\`\\|\^M\\|\n\\)" mark "?"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
257 (regexp-quote bahai-diary-entry-symbol)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
258 "\\("
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
259 (mapconcat 'eval date-form "\\)\\(")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
260 "\\)"))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
261 (case-fold-search t))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
262 (goto-char (point-min))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
263 (while (re-search-forward regexp nil t)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
264 (if backup (re-search-backward "\\<" nil t))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
265 (if (and (or (char-equal (preceding-char) ?\^M)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
266 (char-equal (preceding-char) ?\n))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
267 (not (looking-at " \\|\^I")))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
268 ;; Diary entry that consists only of date.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
269 (backward-char 1)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
270 ;; Found a nonempty diary entry--make it visible and
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
271 ;; add it to the list.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
272 (let ((entry-start (point))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
273 (date-start))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
274 (re-search-backward "\^M\\|\n\\|\\`")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
275 (setq date-start (point))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
276 (re-search-forward "\^M\\|\n" nil t 2)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
277 (while (looking-at " \\|\^I")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
278 (re-search-forward "\^M\\|\n" nil t))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
279 (backward-char 1)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
280 (subst-char-in-region date-start (point) ?\^M ?\n t)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
281 (add-to-diary-list
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
282 gdate
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
283 (buffer-substring-no-properties entry-start (point))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
284 (buffer-substring-no-properties
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
285 (1+ date-start) (1- entry-start)))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
286 (setq d (cdr d))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
287 (setq gdate
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
288 (calendar-gregorian-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
289 (1+ (calendar-absolute-from-gregorian gdate)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
290 (set-buffer-modified-p diary-modified))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
291 (goto-char (point-min))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
292
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
293 (defun mark-bahai-diary-entries ()
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
294 "Mark days in the calendar window that have Baha'i date diary entries.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
295 Each entry in diary-file (or included files) visible in the calendar
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
296 window is marked. Baha'i date entries are prefaced by a
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
297 bahai-diary-entry-symbol \(normally a B`I'). The same
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
298 diary-date-forms govern the style of the Baha'i calendar entries,
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
299 except that the Baha'i month names must be spelled in full. The
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
300 Baha'i months are numbered from 1 to 12 with Baha being 1 and 12 being
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
301 `Ala. Baha'i date diary entries that begin with a
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
302 diary-nonmarking-symbol will not be marked in the calendar. This
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
303 function is provided for use as part of the
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
304 nongregorian-diary-marking-hook."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
305 (let ((d diary-date-forms))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
306 (while d
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
307 (let*
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
308 ((date-form (if (equal (car (car d)) 'backup)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
309 (cdr (car d))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
310 (car d)));; ignore 'backup directive
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
311 (dayname (diary-name-pattern calendar-day-name-array))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
312 (monthname
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
313 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
314 (diary-name-pattern bahai-calendar-month-name-array t)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
315 "\\|\\*"))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
316 (month "[0-9]+\\|\\*")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
317 (day "[0-9]+\\|\\*")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
318 (year "[0-9]+\\|\\*")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
319 (l (length date-form))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
320 (d-name-pos (- l (length (memq 'dayname date-form))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
321 (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
322 (m-name-pos (- l (length (memq 'monthname date-form))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
323 (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
324 (d-pos (- l (length (memq 'day date-form))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
325 (d-pos (if (/= l d-pos) (+ 2 d-pos)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
326 (m-pos (- l (length (memq 'month date-form))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
327 (m-pos (if (/= l m-pos) (+ 2 m-pos)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
328 (y-pos (- l (length (memq 'year date-form))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
329 (y-pos (if (/= l y-pos) (+ 2 y-pos)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
330 (regexp
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
331 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
332 "\\(\\`\\|\^M\\|\n\\)"
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
333 (regexp-quote bahai-diary-entry-symbol)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
334 "\\("
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
335 (mapconcat 'eval date-form "\\)\\(")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
336 "\\)"))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
337 (case-fold-search t))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
338 (goto-char (point-min))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
339 (while (re-search-forward regexp nil t)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
340 (let* ((dd-name
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
341 (if d-name-pos
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
342 (buffer-substring
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
343 (match-beginning d-name-pos)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
344 (match-end d-name-pos))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
345 (mm-name
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
346 (if m-name-pos
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
347 (buffer-substring
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
348 (match-beginning m-name-pos)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
349 (match-end m-name-pos))))
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62123
diff changeset
350 (mm (string-to-number
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
351 (if m-pos
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
352 (buffer-substring
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
353 (match-beginning m-pos)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
354 (match-end m-pos))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
355 "")))
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62123
diff changeset
356 (dd (string-to-number
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
357 (if d-pos
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
358 (buffer-substring
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
359 (match-beginning d-pos)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
360 (match-end d-pos))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
361 "")))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
362 (y-str (if y-pos
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
363 (buffer-substring
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
364 (match-beginning y-pos)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
365 (match-end y-pos))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
366 (yy (if (not y-str)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
367 0
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
368 (if (and (= (length y-str) 2)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
369 abbreviated-calendar-year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
370 (let* ((current-y
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
371 (extract-calendar-year
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
372 (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
373 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
374 (calendar-current-date)))))
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62123
diff changeset
375 (y (+ (string-to-number y-str)
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
376 (* 100 (/ current-y 100)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
377 (if (> (- y current-y) 50)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
378 (- y 100)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
379 (if (> (- current-y y) 50)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
380 (+ y 100)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
381 y)))
62402
a7e02ef1e3d6 Replace `string-to-int' by `string-to-number'.
Juanma Barranquero <lekktu@gmail.com>
parents: 62123
diff changeset
382 (string-to-number y-str)))))
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
383 (if dd-name
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
384 (mark-calendar-days-named
62123
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
385 (cdr (assoc-string (substring dd-name 0 3)
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
386 (calendar-make-alist
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
387 calendar-day-name-array
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
388 0
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
389 '(lambda (x) (substring x 0 3)))
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
390 t)))
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
391 (if mm-name
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
392 (if (string-equal mm-name "*")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
393 (setq mm 0)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
394 (setq mm
62123
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
395 (cdr (assoc-string
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
396 mm-name
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
397 (calendar-make-alist
62123
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
398 bahai-calendar-month-name-array)
8c992d4395d2 (mark-bahai-diary-entries): Replace `assoc-ignore-case' by `assoc-string'.
Juanma Barranquero <lekktu@gmail.com>
parents: 55461
diff changeset
399 t)))))
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
400 (mark-bahai-calendar-date-pattern mm dd yy)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
401 (setq d (cdr d)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
402
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
403 (defun mark-bahai-calendar-date-pattern (month day year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
404 "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
405 A value of 0 in any position is a wildcard."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
406 (save-excursion
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
407 (set-buffer calendar-buffer)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
408 (if (and (/= 0 month) (/= 0 day))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
409 (if (/= 0 year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
410 ;; Fully specified Baha'i date.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
411 (let ((date (calendar-gregorian-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
412 (calendar-absolute-from-bahai
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
413 (list month day year)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
414 (if (calendar-date-is-visible-p date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
415 (mark-visible-calendar-date date)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
416 ;; Month and day in any year--this taken from the holiday stuff.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
417 (let* ((bahai-date (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
418 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
419 (list displayed-month 15 displayed-year))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
420 (m (extract-calendar-month bahai-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
421 (y (extract-calendar-year bahai-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
422 (date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
423 (if (< m 1)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
424 nil;; Baha'i calendar doesn't apply.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
425 (increment-calendar-month m y (- 10 month))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
426 (if (> m 7);; Baha'i date might be visible
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
427 (let ((date (calendar-gregorian-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
428 (calendar-absolute-from-bahai
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
429 (list month day y)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
430 (if (calendar-date-is-visible-p date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
431 (mark-visible-calendar-date date)))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
432 ;; Not one of the simple cases--check all visible dates for match.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
433 ;; Actually, the following code takes care of ALL of the cases, but
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
434 ;; it's much too slow to be used for the simple (common) cases.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
435 (let ((m displayed-month)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
436 (y displayed-year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
437 (first-date)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
438 (last-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
439 (increment-calendar-month m y -1)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
440 (setq first-date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
441 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
442 (list m 1 y)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
443 (increment-calendar-month m y 2)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
444 (setq last-date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
445 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
446 (list m (calendar-last-day-of-month m y) y)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
447 (calendar-for-loop date from first-date to last-date do
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
448 (let* ((b-date (calendar-bahai-from-absolute date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
449 (i-month (extract-calendar-month b-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
450 (i-day (extract-calendar-day b-date))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
451 (i-year (extract-calendar-year b-date)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
452 (and (or (zerop month)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
453 (= month i-month))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
454 (or (zerop day)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
455 (= day i-day))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
456 (or (zerop year)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
457 (= year i-year))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
458 (mark-visible-calendar-date
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
459 (calendar-gregorian-from-absolute date)))))))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
460
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
461 (defun insert-bahai-diary-entry (arg)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
462 "Insert a diary entry.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
463 For the Baha'i date corresponding to the date indicated by point.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
464 Prefix arg will make the entry nonmarking."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
465 (interactive "P")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
466 (let* ((calendar-month-name-array bahai-calendar-month-name-array))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
467 (make-diary-entry
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
468 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
469 bahai-diary-entry-symbol
65141
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
470 (calendar-date-string
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
471 (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
472 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
473 (calendar-cursor-to-date t)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
474 nil t))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
475 arg)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
476
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
477 (defun insert-monthly-bahai-diary-entry (arg)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
478 "Insert a monthly diary entry.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
479 For the day of the Baha'i month corresponding to the date indicated by point.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
480 Prefix arg will make the entry nonmarking."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
481 (interactive "P")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
482 (let* ((calendar-date-display-form
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
483 (if european-calendar-style '(day " * ") '("* " day )))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
484 (calendar-month-name-array bahai-calendar-month-name-array))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
485 (make-diary-entry
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
486 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
487 bahai-diary-entry-symbol
65141
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
488 (calendar-date-string
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
489 (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
490 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
491 (calendar-cursor-to-date t)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
492 arg)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
493
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
494 (defun insert-yearly-bahai-diary-entry (arg)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
495 "Insert an annual diary entry.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
496 For the day of the Baha'i year corresponding to the date indicated by point.
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
497 Prefix arg will make the entry nonmarking."
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
498 (interactive "P")
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
499 (let* ((calendar-date-display-form
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
500 (if european-calendar-style
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
501 '(day " " monthname)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
502 '(monthname " " day)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
503 (calendar-month-name-array bahai-calendar-month-name-array))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
504 (make-diary-entry
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
505 (concat
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
506 bahai-diary-entry-symbol
65141
fad69800a5b0 (date, displayed-month, displayed-year, number, original-date):
Juanma Barranquero <lekktu@gmail.com>
parents: 64085
diff changeset
507 (calendar-date-string
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
508 (calendar-bahai-from-absolute
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
509 (calendar-absolute-from-gregorian
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
510 (calendar-cursor-to-date t)))))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
511 arg)))
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
512
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
513 (provide 'cal-bahai)
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
514
55461
34b5f4f934df Changes from arch/CVS synchronization
Miles Bader <miles@gnu.org>
parents: 55431
diff changeset
515 ;;; arch-tag: c1cb1d67-862a-4264-a01c-41cb4df01f14
55431
b278cb498cc8 2004-05-08 John Wiegley <johnw@newartisans.com>
John Wiegley <johnw@newartisans.com>
parents:
diff changeset
516 ;;; cal-bahai.el ends here