;;; diary.el --- diary functions.
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Last-Modified: 30 Jun 1992
+;; Copyright (C) 1989, 1990, 1992 Free Software Foundation, Inc.
-;; Copyright (C) 1989, 1990 Free Software Foundation, Inc.
+;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Keywords: diary, calendar
;; This file is part of GNU Emacs.
(autoload 'check-calendar-holidays "holidays"
"Check the list of holidays for any that occur on DATE.
The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list calendar-holidays.")
+The holidays are those in the list calendar-holidays."
+ t)
+
(autoload 'calendar-holiday-list "holidays"
"Form the list of holidays that occur on dates in the calendar window.
-The holidays are those in the list calendar-holidays.")
+The holidays are those in the list calendar-holidays."
+ t)
+
+(autoload 'diary-french-date "cal-french"
+ "French calendar equivalent of date diary entry."
+ t)
+
+(autoload 'diary-mayan-date "cal-mayan"
+ "Mayan calendar equivalent of date diary entry."
+ t)
+
+(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
+
+(autoload 'diary-sunrise-sunset "solar"
+ "Local time of sunrise and sunset as a diary entry."
+ t)
+
+(autoload 'diary-sabbath-candles "solar"
+ "Local time of candle lighting diary entry--applies if date is a Friday.
+No diary entry if there is no sunset on that date."
+ t)
(defvar diary-syntax-table
(standard-syntax-table)
(defun list-diary-entries (date number)
"Create and display a buffer containing the relevant lines in diary-file.
-All lines that apply to DATE and the next NUMBER-1 days are included.
-
-Makes all diary entries in the diary file invisible (using selective display),
-*except* those that are relevant.
+The arguments are DATE and NUMBER; the entries selected are those
+for NUMBER days starting with date DATE. The other entries are hidden
+using selective display.
Returns a list of all relevant diary entries found, if any, in order by date.
The list entries have the form ((month day year) string). If the variable
-`diary-list-include-blanks' is t, this list will include a dummy diary entry
-\(consisting of the empty string\) for a date with no diary entries.
+`diary-list-include-blanks' is t, this list includes a dummy diary entry
+\(consisting of the empty string) for a date with no diary entries.
After the list is prepared, the hooks `nongregorian-diary-listing-hook',
`list-diary-entries-hook', and `diary-display-hook' are run. These hooks
(message msg)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
- (setq mode-line-format
- (format "--------------------------%s%%-" date-string))
+ (calendar-set-mode-line date-string)
(erase-buffer)
(insert (mapconcat 'identity holiday-list "\n"))
(goto-char (point-min))
(setq buffer-read-only t)
(display-buffer holiday-buffer)
(message "No diary entries for %s" date-string))
- (setq mode-line-format
- (format "%%*--%sDiary %s %s%s%s%%-"
- (if holiday-list "" "---------------")
- (if holiday-list "for" "entries for")
- date-string
- (if holiday-list ": " "")
- (mapconcat 'identity holiday-list "; ")))
+ (calendar-set-mode-line
+ (concat "Diary for " date-string
+ (if holiday-list ": " "")
+ (mapconcat 'identity holiday-list "; ")))
(display-buffer (get-file-buffer d-file))
(message "Preparing diary...done"))))
(message msg)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
- (setq mode-line-format
- (format "--------------------------%s%%-" date-string))
+ (calendar-set-mode-line date-string)
(erase-buffer)
(insert (mapconcat 'identity holiday-list "\n"))
(goto-char (point-min))
(set-buffer (get-buffer-create fancy-diary-buffer))
(setq buffer-read-only nil)
(make-local-variable 'mode-line-format)
- (setq mode-line-format "---------------------------Diary Entries%-")
+ (calendar-set-mode-line "Diary Entries")
(erase-buffer)
(let ((entry-list diary-entries-list)
(holiday-list)
(message "Preparing diary...done"))))
(defun print-diary-entries ()
- "Print a hard copy of the entries visible in the diary window.
-The hooks given by the variable `print-diary-entries-hook' are called after
-the temporary buffer of visible diary entries is prepared; it is the hooks
-that do the actual printing and kill the buffer."
+ "Print a hard copy of the diary display.
+
+If the simple diary display is being used, prepare a temp buffer with the
+visible lines of the diary buffer, add a heading line composed from the mode
+line, print the temp buffer, and destroy it.
+
+If the fancy diary display is being used, just print the buffer.
+
+The hooks given by the variable `print-diary-entries-hook' are called to do
+the actual printing."
(interactive)
- (let ((diary-buffer (get-file-buffer (substitute-in-file-name diary-file))))
- (if diary-buffer
- (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*")))
- (save-excursion
- (set-buffer diary-buffer)
- (copy-to-buffer temp-buffer (point-min) (point-max))
- (set-buffer temp-buffer)
- (while (re-search-forward "\^M.*$" nil t)
- (replace-match ""))
- (run-hooks 'print-diary-entries-hook)))
- (error "You don't have a diary buffer!"))))
-
-(defun add-diary-heading ()
- "Add a heading to the diary entries for printing.
-The heading is formed from the mode line of the diary buffer. This function
-is used in the default value of the variable `print-diary-entry-hooks'."
- (save-excursion
- (let ((heading))
- (set-buffer diary-buffer)
- (setq heading mode-line-format)
- (string-match "%\\*-*\\([^-].*\\)%-$" heading)
- (setq heading
- (substring heading (match-beginning 1) (match-end 1)))
- (set-buffer temp-buffer)
- (goto-char (point-min))
- (insert heading "\n"
- (make-string (length heading) ?=) "\n"))))
+ (if (bufferp (get-buffer fancy-diary-buffer))
+ (save-excursion
+ (set-buffer (get-buffer fancy-diary-buffer))
+ (run-hooks 'print-diary-entries-hook))
+ (let ((diary-buffer
+ (get-file-buffer (substitute-in-file-name diary-file))))
+ (if diary-buffer
+ (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
+ (heading))
+ (save-excursion
+ (set-buffer diary-buffer)
+ (setq heading
+ (if (not (stringp mode-line-format))
+ "All Diary Entries"
+ (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
+ (substring mode-line-format
+ (match-beginning 1) (match-end 1))))
+ (copy-to-buffer temp-buffer (point-min) (point-max))
+ (set-buffer temp-buffer)
+ (while (re-search-forward "\^M.*$" nil t)
+ (replace-match ""))
+ (goto-char (point-min))
+ (insert heading "\n"
+ (make-string (length heading) ?=) "\n")
+ (run-hooks 'print-diary-entries-hook)
+ (kill-buffer temp-buffer)))
+ (error "You don't have a diary buffer!")))))
(defun show-all-diary-entries ()
"Show all of the diary entries in the diary-file.
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
(setq selective-display nil)
(make-local-variable 'mode-line-format)
- (setq mode-line-format
- "%*---------------------------All Diary Entries%-")
+ (setq mode-line-format default-mode-line-format)
(display-buffer (current-buffer))
(set-buffer-modified-p diary-modified))))
(error "Your diary file is not readable!"))
(mark-visible-calendar-date (list month i year)))
(mark-visible-calendar-date (list month p-day year)))))
+(defun sort-diary-entries ()
+ "Sort the list of diary entries by time of day."
+ (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
+
(defun diary-entry-compare (e1 e2)
"Returns t if E1 is earlier than E2."
(or (calendar-date-compare e1 e2)
(defun list-hebrew-diary-entries ()
"Add any Hebrew date entries from the diary-file to diary-entries-list.
Hebrew date diary entries must be prefaced by a hebrew-diary-entry-symbol
-\(normally an `H'\). The same diary-date-forms govern the style of the Hebrew
+(normally an `H'). The same diary-date-forms govern the style of the Hebrew
calendar entries, except that the Hebrew month names must be spelled in full.
The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
"Mark days in the calendar window that have Hebrew date diary entries.
Each entry in diary-file (or included files) visible in the calendar window
is marked. Hebrew date entries are prefaced by a hebrew-diary-entry-symbol
-\(normally an `H'\). The same diary-date-forms govern the style of the Hebrew
+(normally an `H'). The same diary-date-forms govern the style of the Hebrew
calendar entries, except that the Hebrew month names must be spelled in full.
The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
(setq d (cdr d)))))
(defun mark-hebrew-calendar-date-pattern (month day year)
- "Mark all dates in the calendar window that conform to the Hebrew date
-MONTH/DAY/YEAR. A value of 0 in any position is a wild-card."
+ "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
+A value of 0 in any position is a wild-card."
(save-excursion
(set-buffer calendar-buffer)
(if (and (/= 0 month) (/= 0 day))
made every day. Note that since there is no text, it
makes sense only if the fancy diary display is used.
+ %%(diary-astro-day-number) Diary entries giving the corresponding
+ astronomical (Julian) day number will be made every day.
+ Note that since there is no text, it makes sense only if the
+ fancy diary display is used.
+
+ %%(diary-julian-date) Diary entries giving the corresponding
+ Julian date will be made every day. Note that since
+ there is no text, it makes sense only if the fancy diary
+ display is used.
+
+ %%(diary-sunrise-sunset)
+ Diary entries giving the local times of sunrise and sunset
+ will be made every day. Note that since there is no text,
+ it makes sense only if the fancy diary display is used.
+ Floating point required.
+
+ %%(diary-phases-of-moon)
+ Diary entries giving the times of the phases of the moon
+ will be when appropriate. Note that since there is no text,
+ it makes sense only if the fancy diary display is used.
+ Floating point required.
+
%%(diary-yahrzeit MONTH DAY YEAR) text
Text is assumed to be the name of the person; the date is
the date of death on the *civil* calendar. The diary entry
day before. (If `european-calendar-style' is t, the order
of the parameters should be changed to DAY, MONTH, YEAR.)
+ %%(diary-sunrise-sunset)
+ Diary entries giving the local times of Sabbath candle
+ lighting will be made every day. Note that since there is
+ no text, it makes sense only if the fancy diary display is
+ used. Floating point required.
+
%%(diary-rosh-hodesh)
Diary entries will be made on the dates of Rosh Hodesh on
the Hebrew calendar. Note that since there is no text, it
nil))))
(defun diary-block (m1 d1 y1 m2 d2 y2)
- "Block diary entry--entry applies if date is between two dates. Order of
-the parameters is M1, D1, Y1, M2, D2, Y2 `european-calendar-style' is nil, and
+ "Block diary entry.
+Entry applies if date is between two dates. Order of the parameters is
+M1, D1, Y1, M2, D2, Y2 `european-calendar-style' is nil, and
D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t."
(let ((date1 (calendar-absolute-from-gregorian
(if european-calendar-style
entry)))
(defun diary-anniversary (month day year)
- "Anniversary diary entry--entry applies if date is the anniversary of
-MONTH, DAY, YEAR if `european-calendar-style' is nil, and DAY, MONTH, YEAR
-if `european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the
+ "Anniversary diary entry.
+Entry applies if date is the anniversary of MONTH, DAY, YEAR if
+`european-calendar-style' is nil, and DAY, MONTH, YEAR if
+`european-calendar-style' is t. Diary entry can contain `%d' or `%d%s'; the
%d will be replaced by the number of years since the MONTH DAY, YEAR and the
%s will be replaced by the ordinal ending of that number (that is, `st', `nd',
`rd' or `th', as appropriate. The anniversary of February 29 is considered
(defun diary-islamic-date ()
"Islamic calendar equivalent of date diary entry."
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname " " year)
- '(monthname " " day ", " year)))
- (i-date (calendar-islamic-from-absolute
+ (let* ((i-date (calendar-islamic-from-absolute
(calendar-absolute-from-gregorian date)))
(calendar-month-name-array calendar-islamic-month-name-array))
(if (>= (extract-calendar-year i-date) 1)
- (format "Islamic date: %s" (calendar-date-string i-date)))))
+ (format "Islamic date: %s" (calendar-date-string i-date nil t)))))
(defun diary-hebrew-date ()
"Hebrew calendar equivalent of date diary entry."
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname " " year)
- '(monthname " " day ", " year)))
- (h-date (calendar-hebrew-from-absolute
+ (let* ((h-date (calendar-hebrew-from-absolute
(calendar-absolute-from-gregorian date)))
(calendar-month-name-array
(if (hebrew-calendar-leap-year-p
(extract-calendar-year h-date))
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year)))
- (format "Hebrew date: %s" (calendar-date-string h-date))))
+ (format "Hebrew date: %s" (calendar-date-string h-date nil t))))
-(defun diary-french-date ()
- "French calendar equivalent of date diary entry."
- (let* ((french-date (calendar-french-from-absolute
- (calendar-absolute-from-gregorian date)))
- (y (extract-calendar-year french-date))
- (m (extract-calendar-month french-date))
- (d (extract-calendar-day french-date)))
- (if (> y 0)
- (if (= m 13)
- (format "Jour %s de l'Annee %d de la Revolution"
- (aref french-calendar-special-days-array (1- d))
- y)
- (format "Decade %s, %s de %s de l'Annee %d de la Revolution"
- (make-string (1+ (/ (1- d) 10)) ?I)
- (aref french-calendar-day-name-array (% (1- d) 10))
- (aref french-calendar-month-name-array (1- m))
- y)))))
+(defun diary-julian-date ()
+ "Julian calendar equivalent of date diary entry."
+ (format "Julian date: %s"
+ (calendar-date-string
+ (calendar-julian-from-absolute
+ (calendar-absolute-from-gregorian date)))
+ nil t))
+
+(defun diary-astro-day-number ()
+ "Astronomical (Julian) day number diary entry."
+ (format "Astronomical (Julian) day number %d"
+ (+ 1721425 (calendar-absolute-from-gregorian date))))
(defun diary-omer ()
- "Omer count diary entry--entry applies if date is within 50 days after
-Passover."
+ "Omer count diary entry.
+Entry applies if date is within 50 days after Passover."
(let* ((passover
(calendar-absolute-from-hebrew
(list 1 15 (+ (extract-calendar-year date) 3760))))
(t "th"))))))
(defun diary-rosh-hodesh ()
- "Rosh Hodesh diary entry--entry applies if date is Rosh Hodesh, the day
-before, or the Saturday before."
+ "Rosh Hodesh diary entry.
+Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
(let* ((d (calendar-absolute-from-gregorian date))
(h-date (calendar-hebrew-from-absolute d))
(h-month (extract-calendar-month h-date))
(if (= h-yesterday 30)
(format "%s (second day)" this-month)
this-month)))
- (if (= (mod d 7) 6);; Saturday--check for Shabbat Mevarhim
+ (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
(cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
(format "Mevarhim Rosh Hodesh %s (%s)"
(aref h-month-names
"tomorrow"
(aref calendar-day-name-array (- 29 h-day)))
(aref calendar-day-name-array
- (mod (- 30 h-day) 7)))))
+ (% (- 30 h-day) 7)))))
(if (and (= h-day 29) (/= h-month 6))
(format "Erev Rosh Hodesh %s"
(aref h-month-names
(defconst hebrew-calendar-year-Monday-complete-Thursday
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
- 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34.35) (35.36)
- (36.37) (37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
+ 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
+ (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
"The structure of the parashiot in a Hebrew year that starts on Monday,
is `complete' (Heshvan and Kislev each have 30 days), and has Passover
start on Thursday.")
(defconst hebrew-calendar-year-Tuesday-regular-Thursday
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
- 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34.35) (35.36)
- (36.37) (37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
+ 23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
+ (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
"The structure of the parashiot in a Hebrew year that starts on Tuesday,
is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover
start on Thursday.")
(defconst hebrew-calendar-year-Thursday-regular-Saturday
- [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
- 23 24 nil (nil . 25) (25.[26 27]) ([26 27].[28 29]) ([28 29].30) (30.31)
- ([31 32].32) 33 34 35 36 37 38 39 40 [41 42]
- 43 44 45 46 47 48 49 50]
+ [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23
+ 24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
+ (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
+ 49 50]
"The structure of the parashiot in a Hebrew year that starts on Thursday,
is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover
start on Saturday.")
(defconst hebrew-calendar-year-Saturday-complete-Thursday
[nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
- 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34.35) (35.36) (36.37)
- (37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
+ 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
+ (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
"The structure of the parashiot in a Hebrew year that starts on Saturday,
is `complete' (Heshvan and Kislev each have 30 days), and has Passover
start on Thursday.")
(defconst hebrew-calendar-year-Monday-incomplete-Thursday
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
- 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34.35) (35.36) (36.37)
- (37.38) ([38 39].39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
+ 23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
+ (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
"The structure of the parashiot in a Hebrew year that starts on Monday,
is `incomplete' (Heshvan and Kislev each have 29 days), and has Passover
start on Thursday.")
(defconst hebrew-calendar-year-Monday-complete-Saturday
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
- 23 24 25 26 27 nil (nil . 28) (28.29) (29.30) (30.31) (31.32) (32.33)
- (33.34) (34.35) (35.36) (36.37) (37.38) (38.39) (39.40) (40.41) ([41 42].42)
- 43 44 45 46 47 48 49 50]
+ 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
+ (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
+ (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
"The structure of the parashiot in a Hebrew year that starts on Monday,
is `complete' (Heshvan and Kislev each have 30 days), and has Passover
start on Saturday.")
(defconst hebrew-calendar-year-Tuesday-regular-Saturday
[51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
- 23 24 25 26 27 nil (nil . 28) (28.29) (29.30) (30.31) (31.32) (32.33)
- (33.34) (34.35) (35.36) (36.37) (37.38) (38.39) (39.40) (40.41) ([41 42].42)
- 43 44 45 46 47 48 49 50]
+ 23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
+ (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
+ (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
"The structure of the parashiot in a Hebrew year that starts on Tuesday,
is `regular' (Heshvan has 29 days and Kislev has 30 days), and has Passover
start on Saturday.")
(defun list-islamic-diary-entries ()
"Add any Islamic date entries from the diary-file to diary-entries-list.
Islamic date diary entries must be prefaced by an islamic-diary-entry-symbol
-\(normally an `I'\). The same diary-date-forms govern the style of the Islamic
+(normally an `I'). The same diary-date-forms govern the style of the Islamic
calendar entries, except that the Islamic month names must be spelled in full.
The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
Dhu al-Hijjah. If an Islamic date diary entry begins with a
"Mark days in the calendar window that have Islamic date diary entries.
Each entry in diary-file (or included files) visible in the calendar window
is marked. Islamic date entries are prefaced by a islamic-diary-entry-symbol
-\(normally an `I'\). The same diary-date-forms govern the style of the Islamic
+(normally an `I'). The same diary-date-forms govern the style of the Islamic
calendar entries, except that the Islamic month names must be spelled in full.
The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
Dhu al-Hijjah. Islamic date diary entries that begin with a
(setq d (cdr d)))))
(defun mark-islamic-calendar-date-pattern (month day year)
- "Mark all dates in the calendar window that conform to the Islamic date
-MONTH/DAY/YEAR. A value of 0 in any position is a wild-card."
+ "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
+A value of 0 in any position is a wild-card."
(save-excursion
(set-buffer calendar-buffer)
(if (and (/= 0 month) (/= 0 day))
(mark-visible-calendar-date
(calendar-gregorian-from-absolute date)))))))))
-(defun make-diary-entry (string &optional nonmarking file)
- "Insert a diary entry STRING which may be NONMARKING in FILE.
-If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
- (find-file-other-window
- (substitute-in-file-name (if file file diary-file)))
- (goto-char (point-max))
- (insert
- (if (bolp) "" "\n")
- (if nonmarking diary-nonmarking-symbol "")
- string " "))
-
-(defun insert-diary-entry (arg)
- "Insert a diary entry for the date indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname " " year)
- '(monthname " " day ", " year))))
- (make-diary-entry
- (calendar-date-string
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))
- t)
- arg)))
-
-(defun insert-weekly-diary-entry (arg)
- "Insert a weekly diary entry for the day of the week indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (make-diary-entry
- (calendar-day-name
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!")))
- arg))
-
-(defun insert-monthly-diary-entry (arg)
- "Insert a monthly diary entry for the day of the month indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " * ")
- '("* " day))))
- (make-diary-entry
- (calendar-date-string
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))
- t)
- arg)))
-
-(defun insert-yearly-diary-entry (arg)
- "Insert an annual diary entry for the day of the year indicated by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname)
- '(monthname " " day))))
- (make-diary-entry
- (calendar-date-string
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))
- t)
- arg)))
-
-(defun insert-anniversary-diary-entry (arg)
- "Insert an anniversary diary entry for the date given by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " month " " year)
- '(month " " day " " year))))
- (make-diary-entry
- (format "%s(diary-anniversary %s)"
- sexp-diary-entry-symbol
- (calendar-date-string
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))
- arg)))
-
-(defun insert-block-diary-entry (arg)
- "Insert a block diary entry for the days between the point and marked date.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " month " " year)
- '(month " " day " " year)))
- (cursor (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!")))
- (mark (or (car calendar-mark-ring)
- (error "No mark set in this buffer")))
- (start)
- (end))
- (if (< (calendar-absolute-from-gregorian mark)
- (calendar-absolute-from-gregorian cursor))
- (setq start mark
- end cursor)
- (setq start cursor
- end mark))
- (make-diary-entry
- (format "%s(diary-block %s %s)"
- sexp-diary-entry-symbol
- (calendar-date-string start)
- (calendar-date-string end))
- arg)))
-
-(defun insert-cyclic-diary-entry (arg)
- "Insert a cyclic diary entry starting at the date given by point.
-Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " month " " year)
- '(month " " day " " year))))
- (make-diary-entry
- (format "%s(diary-cyclic %d %s)"
- sexp-diary-entry-symbol
- (calendar-read "Repeat every how many days: "
- '(lambda (x) (> x 0)))
- (calendar-date-string
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))
- arg)))
-
-(defun insert-hebrew-diary-entry (arg)
- "Insert a diary entry for the Hebrew date corresponding to the date
-indicated by point. Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname " " year)
- '(monthname " " day ", " year)))
- (calendar-month-name-array
- calendar-hebrew-month-name-array-leap-year))
- (make-diary-entry
- (concat
- hebrew-diary-entry-symbol
- (calendar-date-string
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))))
- arg)))
-
-(defun insert-monthly-hebrew-diary-entry (arg)
- "Insert a monthly diary entry for the day of the Hebrew month corresponding
-to the date indicated by point. Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style '(day " * ") '("* " day )))
- (calendar-month-name-array
- calendar-hebrew-month-name-array-leap-year))
- (make-diary-entry
- (concat
- hebrew-diary-entry-symbol
- (calendar-date-string
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))))
- arg)))
-
-(defun insert-yearly-hebrew-diary-entry (arg)
- "Insert an annual diary entry for the day of the Hebrew year corresponding
-to the date indicated by point. Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname)
- '(monthname " " day)))
- (calendar-month-name-array
- calendar-hebrew-month-name-array-leap-year))
- (make-diary-entry
- (concat
- hebrew-diary-entry-symbol
- (calendar-date-string
- (calendar-hebrew-from-absolute
- (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))))
- arg)))
-
-(defun insert-islamic-diary-entry (arg)
- "Insert a diary entry for the Islamic date corresponding to the date
-indicated by point. Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname " " year)
- '(monthname " " day ", " year)))
- (calendar-month-name-array calendar-islamic-month-name-array))
- (make-diary-entry
- (concat
- islamic-diary-entry-symbol
- (calendar-date-string
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))))
- arg)))
-
-(defun insert-monthly-islamic-diary-entry (arg)
- "Insert a monthly diary entry for the day of the Islamic month corresponding
-to the date indicated by point. Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style '(day " * ") '("* " day )))
- (calendar-month-name-array calendar-islamic-month-name-array))
- (make-diary-entry
- (concat
- islamic-diary-entry-symbol
- (calendar-date-string
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))))
- arg)))
-
-(defun insert-yearly-islamic-diary-entry (arg)
- "Insert an annual diary entry for the day of the Islamic year corresponding
-to the date indicated by point. Prefix arg will make the entry nonmarking."
- (interactive "P")
- (let* ((calendar-date-display-form
- (if european-calendar-style
- '(day " " monthname)
- '(monthname " " day)))
- (calendar-month-name-array calendar-islamic-month-name-array))
- (make-diary-entry
- (concat
- islamic-diary-entry-symbol
- (calendar-date-string
- (calendar-islamic-from-absolute
- (calendar-absolute-from-gregorian
- (or (calendar-cursor-to-date)
- (error "Cursor is not on a date!"))))))
- arg)))
-
(provide 'diary)
;;; diary.el ends here