X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/4f7198840590049feed6db54ee787b4abb452458..231f989be9425a463c2f500a47c29e1954d83bcf:/lisp/diary-lib.el diff --git a/lisp/diary-lib.el b/lisp/diary-lib.el index 65a5af638a..a78475bc91 100644 --- a/lisp/diary-lib.el +++ b/lisp/diary-lib.el @@ -1,26 +1,25 @@ -;;; diary.el --- diary functions. +;;; diary-lib.el --- diary functions. -;; Copyright (C) 1989, 1990, 1992 Free Software Foundation, Inc. +;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc. ;; Author: Edward M. Reingold ;; Keywords: calendar ;; This file is part of GNU Emacs. +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + ;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY. No author or distributor -;; accepts responsibility to anyone for the consequences of using it -;; or for whether it serves any particular purpose or works at all, -;; unless he says so in writing. Refer to the GNU Emacs General Public -;; License for full details. - -;; Everyone is granted permission to copy, modify and redistribute -;; GNU Emacs, but only under the conditions described in the -;; GNU Emacs General Public License. A copy of this license is -;; supposed to have been given to you along with GNU Emacs so you -;; can know your rights and responsibilities. It should be in a -;; file named COPYING. Among other things, the copyright notice -;; and this notice must be preserved on all copies. +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: @@ -67,19 +66,29 @@ in the displayed three-month calendar." (let ((d-file (substitute-in-file-name diary-file))) (if (and d-file (file-exists-p d-file)) (if (file-readable-p d-file) - (list-diary-entries (or (calendar-cursor-to-date) - (error "Cursor is not on a date!")) - arg) - (error "Your diary file is not readable!")) + (list-diary-entries (calendar-cursor-to-date t) arg) + (error "Diary file is not readable!")) (error "You don't have a diary file!")))) +(defun view-other-diary-entries (arg diary-file) + "Prepare and display buffer of diary entries from an alternative diary file. +Prompts for a file name and searches that file for entries that match ARG +days starting with the date indicated by the cursor position in the displayed +three-month calendar." + (interactive + (list (cond ((null current-prefix-arg) 1) + ((listp current-prefix-arg) (car current-prefix-arg)) + (t current-prefix-arg)) + (setq diary-file (read-file-name "Enter diary file name: " + default-directory nil t)))) + (view-diary-entries arg)) + (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'." 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'." @@ -320,6 +329,13 @@ changing the variable `diary-include-string'." (defun fancy-diary-display () "Prepare a diary buffer with relevant entries in a fancy, noneditable form. This function is provided for optional use as the `diary-display-hook'." + (save-excursion;; Turn off selective-display in the diary file's buffer. + (set-buffer (get-file-buffer (substitute-in-file-name diary-file))) + (let ((diary-modified (buffer-modified-p))) + (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) + (setq selective-display nil) + (kill-local-variable 'mode-line-format) + (set-buffer-modified-p diary-modified))) (if (or (not diary-entries-list) (and (not (cdr diary-entries-list)) (string-equal (car (cdr (car diary-entries-list))) ""))) @@ -340,19 +356,9 @@ This function is provided for optional use as the `diary-display-hook'." (setq buffer-read-only t) (display-buffer holiday-buffer) (message "No diary entries for %s" date-string))) - (save-excursion;; Turn off selective-display in the diary file's buffer. - (set-buffer (get-file-buffer (substitute-in-file-name diary-file))) - (let ((diary-modified (buffer-modified-p))) - (subst-char-in-region (point-min) (point-max) ?\^M ?\n t) - (setq selective-display nil) - (kill-local-variable 'mode-line-format) - (set-buffer-modified-p diary-modified))) (save-excursion;; Prepare the fancy diary buffer. - (set-buffer (get-buffer-create fancy-diary-buffer)) + (set-buffer (make-fancy-diary-buffer)) (setq buffer-read-only nil) - (make-local-variable 'mode-line-format) - (calendar-set-mode-line "Diary Entries") - (erase-buffer) (let ((entry-list diary-entries-list) (holiday-list) (holiday-list-last-month 1) @@ -409,6 +415,18 @@ This function is provided for optional use as the `diary-display-hook'." (display-buffer fancy-diary-buffer) (message "Preparing diary...done")))) +(defun make-fancy-diary-buffer () + "Create and return the initial fancy diary buffer." + (save-excursion + (set-buffer (get-buffer-create fancy-diary-buffer)) + (setq buffer-read-only nil) + (make-local-variable 'mode-line-format) + (calendar-set-mode-line "Diary Entries") + (erase-buffer) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (get-buffer fancy-diary-buffer))) + (defun print-diary-entries () "Print a hard copy of the diary display. @@ -764,12 +782,12 @@ For example, returns 1325 for 1:25pm. Returns -9999 if no time is recognized. The recognized forms are XXXX or X:XX or XX:XX (military time), XXam or XXpm, and XX:XXam or XX:XXpm." (cond ((string-match;; Military time - "^ *\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s) + "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s) (+ (* 100 (string-to-int (substring s (match-beginning 1) (match-end 1)))) (string-to-int (substring s (match-beginning 2) (match-end 2))))) ((string-match;; Hour only XXam or XXpm - "^ *\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) + "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s) (+ (* 100 (% (string-to-int (substring s (match-beginning 1) (match-end 1))) 12)) @@ -777,7 +795,7 @@ and XX:XXam or XX:XXpm." (substring s (match-beginning 2) (match-end 2))) 0 1200))) ((string-match;; Hour and minute XX:XXam or XX:XXpm - "^ *\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) + "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s) (+ (* 100 (% (string-to-int (substring s (match-beginning 1) (match-end 1))) 12)) @@ -790,7 +808,7 @@ and XX:XXam or XX:XXpm." (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 `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 @@ -874,7 +892,7 @@ not be marked in the calendar. This function is provided for use with the "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 @@ -1167,12 +1185,6 @@ A number of built-in functions are available for this type of 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 @@ -1331,59 +1343,37 @@ ending of that number (that is, `st', `nd', `rd' or `th', as appropriate." (defun diary-ordinal-suffix (n) "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)" (if (or (memq (% n 100) '(11 12 13)) - (< 3 (% n 10))) + (< 3 (% n 10))) "th" (aref ["th" "st" "nd" "rd"] (% n 10)))) (defun diary-day-of-year () "Day of year and number of days remaining in the year of date diary entry." - (let* ((year (extract-calendar-year date)) - (day (calendar-day-number date)) - (days-remaining (- (calendar-day-number (list 12 31 year)) day))) - (format "Day %d of %d; %d day%s remaining in the year" - day year days-remaining (if (= days-remaining 1) "" "s")))) + (calendar-day-of-year-string date)) (defun diary-iso-date () "ISO calendar equivalent of date diary entry." - (let ((day (% (calendar-absolute-from-gregorian date) 7)) - (iso-date (calendar-iso-from-absolute - (calendar-absolute-from-gregorian date)))) - (format "ISO date: Day %s of week %d of %d." - (if (zerop day) 7 day) - (extract-calendar-month iso-date) - (extract-calendar-year iso-date)))) + (format "ISO date: %s" (calendar-iso-date-string date))) (defun diary-islamic-date () "Islamic calendar equivalent of date diary entry." - (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 nil t))))) + (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t)))) + (if (string-equal i "") + "Date is pre-Islamic" + (format "Islamic date (until sunset): %s" i)))) (defun diary-hebrew-date () "Hebrew calendar equivalent of date diary entry." - (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 nil t)))) + (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date))) (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)) + (format "Julian date: %s" (calendar-julian-date-string date))) (defun diary-astro-day-number () "Astronomical (Julian) day number diary entry." - (format "Astronomical (Julian) day number %d" - (+ 1721425 (calendar-absolute-from-gregorian date)))) + (format "Astronomical (Julian) day number %s" + (calendar-astro-date-string date))) (defun diary-omer () "Omer count diary entry. @@ -1539,7 +1529,7 @@ Do nothing if DATE or STRING is nil." (setq diary-entries-list (append diary-entries-list (list (list date string)))))) -(defconst hebrew-calendar-parashiot-names +(defvar hebrew-calendar-parashiot-names ["Bereshith" "Noah" "Lech L'cha" "Vayera" "Hayei Sarah" "Toledoth" "Vayetze" "Vayishlah" "Vayeshev" "Mikketz" "Vayiggash" "Vayhi" "Shemoth" "Vaera" "Bo" "Beshallah" "Yithro" "Mishpatim" @@ -1681,7 +1671,7 @@ have 30 days), and has Passover start on Tuesday.") (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 @@ -1764,7 +1754,7 @@ not be marked in the calendar. This function is provided for use with the "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 @@ -1924,6 +1914,6 @@ A value of 0 in any position is a wildcard." (mark-visible-calendar-date (calendar-gregorian-from-absolute date))))))))) -(provide 'diary) +(provide 'diary-lib) -;;; diary.el ends here +;;; diary-lib.el ends here