diff options
Diffstat (limited to 'lisp/calendar')
27 files changed, 522 insertions, 580 deletions
diff --git a/lisp/calendar/.arch-inventory b/lisp/calendar/.arch-inventory deleted file mode 100644 index c70974836a5..00000000000 --- a/lisp/calendar/.arch-inventory +++ /dev/null @@ -1,4 +0,0 @@ -# Auto-generated lisp files, which ignore -precious ^(.*-loaddefs)\.el$ - -# arch-tag: 6246cac0-cd69-4d59-8677-c1451a4d5831 diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 8dae260ca39..d6f4f9862d6 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -6,6 +6,7 @@ ;; Author: Neil Mager <neilm@juliet.ll.mit.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar +;; Package: calendar ;; This file is part of GNU Emacs. @@ -82,17 +83,6 @@ :prefix "appt-" :group 'calendar) -(defcustom appt-issue-message t - "Non-nil means check for appointments in the diary buffer. -To be detected, the diary entry must have the format described in the -documentation of the function `appt-check'." - :type 'boolean - :group 'appt) - -(make-obsolete-variable 'appt-issue-message - "use the function `appt-activate', and the \ -variable `appt-display-format' instead." "22.1") - (defcustom appt-message-warning-time 12 "Time in minutes before an appointment that the warning begins." :type 'integer @@ -103,41 +93,20 @@ variable `appt-display-format' instead." "22.1") :type 'boolean :group 'appt) -(defcustom appt-visible t - "Non-nil means display appointment message in echo area. -This variable is only relevant if `appt-msg-window' is nil." - :type 'boolean - :group 'appt) - -(make-obsolete-variable 'appt-visible 'appt-display-format "22.1") - -(defcustom appt-msg-window t - "Non-nil means display appointment message in another window. -If non-nil, this variable overrides `appt-visible'." - :type 'boolean - :group 'appt) - -(make-obsolete-variable 'appt-msg-window 'appt-display-format "22.1") - ;; TODO - add popup. -(defcustom appt-display-format 'ignore +(defcustom appt-display-format 'window "How appointment reminders should be displayed. The options are: window - use a separate window echo - use the echo area nil - no visible reminder. -See also `appt-audible' and `appt-display-mode-line'. - -The default value is 'ignore, which means to fall back on the value -of the (obsolete) variables `appt-msg-window' and `appt-visible'." +See also `appt-audible' and `appt-display-mode-line'." :type '(choice (const :tag "Separate window" window) (const :tag "Echo-area" echo) - (const :tag "No visible display" nil) - (const :tag "Backwards compatibility setting - choose another value" - ignore)) + (const :tag "No visible display" nil)) :group 'appt - :version "22.1") + :version "24.1") ; no longer inherit from deleted obsolete variables (defcustom appt-display-mode-line t "Non-nil means display minutes to appointment and time on the mode line. @@ -235,28 +204,19 @@ If this is non-nil, appointment checking is active.") The string STRING describes the appointment, due in integer MINS minutes. The format of the visible reminder is controlled by `appt-display-format'. The variable `appt-audible' controls the audible reminder." - ;; Let-binding for backwards compatibility. Remove when obsolete - ;; vars appt-msg-window and appt-visible are dropped. - (let ((appt-display-format - (if (eq appt-display-format 'ignore) - (cond (appt-msg-window 'window) - (appt-visible 'echo)) - appt-display-format))) - (if appt-audible (beep 1)) - (cond ((eq appt-display-format 'window) - (funcall appt-disp-window-function - (number-to-string mins) - ;; TODO - use calendar-month-abbrev-array rather than %b? - (format-time-string "%a %b %e " (current-time)) - string) - (run-at-time (format "%d sec" appt-display-duration) - nil - appt-delete-window-function)) - ((eq appt-display-format 'echo) - (message "%s" string))))) - - -(defvar diary-selective-display) + (if appt-audible (beep 1)) + (cond ((eq appt-display-format 'window) + (funcall appt-disp-window-function + (number-to-string mins) + ;; TODO - use calendar-month-abbrev-array rather than %b? + (format-time-string "%a %b %e " (current-time)) + string) + (run-at-time (format "%d sec" appt-display-duration) + nil + appt-delete-window-function)) + ((eq appt-display-format 'echo) + (message "%s" string)))) + (defun appt-check (&optional force) "Check for an appointment and update any reminder display. @@ -325,7 +285,7 @@ displayed in a window: (mode-line-only (unless full-check appt-now-displayed)) now cur-comp-time appt-comp-time appt-warn-time) (when (or full-check mode-line-only) - (save-excursion + (save-excursion ; FIXME ? ;; Convert current time to minutes after midnight (12.01am = 1). (setq now (decode-time) cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now))) @@ -334,48 +294,22 @@ displayed in a window: (null appt-prev-comp-time) ; first check (< cur-comp-time appt-prev-comp-time)) ; new day (ignore-errors - (if appt-display-diary - (let ((diary-hook - (if (assoc 'appt-make-list diary-hook) - diary-hook - (cons 'appt-make-list diary-hook)))) - (diary)) - (let* ((diary-display-function 'appt-make-list) - (d-buff (find-buffer-visiting diary-file)) - (selective - (if d-buff ; diary buffer exists - (with-current-buffer d-buff - diary-selective-display))) - d-buff2) + (let ((diary-hook (if (assoc 'appt-make-list diary-hook) + diary-hook + (cons 'appt-make-list diary-hook)))) + (if appt-display-diary + (diary) ;; Not displaying the diary, so we can ignore ;; diary-number-of-entries. Since appt.el only ;; works on a daily basis, no need for more entries. - ;; FIXME why not using diary-list-entries with - ;; non-nil LIST-ONLY? - (diary 1) - ;; If the diary buffer existed before this command, - ;; restore its display state. Otherwise, kill it. - (and (setq d-buff2 (find-buffer-visiting diary-file)) - (if d-buff - (or selective - (with-current-buffer d-buff2 - (if diary-selective-display - ;; diary-show-all-entries displays - ;; the diary buffer. - (diary-unhide-everything)))) - ;; FIXME does not kill any included diary files. - ;; The real issue is that (diary) should not - ;; have the side effect of visiting all the - ;; diary files. It is not really appt.el's job to - ;; clean up this mess... - (kill-buffer d-buff2))))))) + (diary-list-entries (calendar-current-date) 1 t))))) (setq appt-prev-comp-time cur-comp-time appt-mode-string nil appt-display-count nil) ;; If there are entries in the list, and the user wants a ;; message issued, get the first time off of the list and ;; calculate the number of minutes until the appointment. - (when (and appt-issue-message appt-time-msg-list) + (when appt-time-msg-list (setq appt-comp-time (caar (car appt-time-msg-list)) appt-warn-time (or (nth 3 (car appt-time-msg-list)) appt-message-warning-time) @@ -512,6 +446,7 @@ sMinutes before the appointment to start warning: ") (and warntime (not (integerp warntime)) (error "Argument WARNTIME must be an integer, or nil")) + (or appt-timer (appt-activate)) (let ((time-msg (list (list (appt-convert-time time)) (concat time " " msg) t))) ;; It is presently non-sensical to have multiple warnings about @@ -522,7 +457,6 @@ sMinutes before the appointment to start warning: ") (setq appt-time-msg-list (appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) -;;;###autoload (defun appt-delete () "Delete an appointment from the list of appointments." (interactive) @@ -542,8 +476,7 @@ sMinutes before the appointment to start warning: ") (defvar number) (defvar original-date) (defvar diary-entries-list) -;; Autoload for the old way of using this package. Can be removed sometime. -;;;###autoload + (defun appt-make-list () "Update the appointments list from today's diary buffer. The time must be at the beginning of a line for it to be @@ -552,92 +485,86 @@ the function `appt-check'). We assume that the variables DATE and NUMBER hold the arguments that `diary-list-entries' received. They specify the range of dates that the diary is being processed for. -Any appointments made with `appt-add' are not affected by this function. - -For backwards compatibility, this function activates the -appointment package (if it is not already active)." - ;; See comments above appt-activate defun. - (if (not appt-timer) - (appt-activate 1) - ;; We have something to do if the range of dates that the diary is - ;; considering includes the current date. - (if (and (not (calendar-date-compare - (list (calendar-current-date)) - (list original-date))) - (calendar-date-compare - (list (calendar-current-date)) - (list (calendar-gregorian-from-absolute - (+ (calendar-absolute-from-gregorian original-date) - number))))) - (save-excursion - ;; Clear the appointments list, then fill it in from the diary. - (dolist (elt appt-time-msg-list) - ;; Delete any entries that were not made with appt-add. - (unless (nth 2 elt) - (setq appt-time-msg-list - (delq elt appt-time-msg-list)))) - (if diary-entries-list - ;; Cycle through the entry-list (diary-entries-list) - ;; looking for entries beginning with a time. If the - ;; entry begins with a time, add it to the - ;; appt-time-msg-list. Then sort the list. - (let ((entry-list diary-entries-list) - (new-time-string "") - time-string) - ;; Below, we assume diary-entries-list was in date - ;; order. It is, unless something on - ;; diary-list-entries-hook has changed it, eg - ;; diary-include-other-files (bug#7019). It must be - ;; in date order if number = 1. - (and diary-list-entries-hook - appt-display-diary - (not (eq diary-number-of-entries 1)) - (not (memq (car (last diary-list-entries-hook)) - '(diary-sort-entries sort-diary-entries))) - (setq entry-list (sort entry-list 'diary-entry-compare))) - ;; Skip diary entries for dates before today. - (while (and entry-list - (calendar-date-compare - (car entry-list) (list (calendar-current-date)))) - (setq entry-list (cdr entry-list))) - ;; Parse the entries for today. - (while (and entry-list - (calendar-date-equal - (calendar-current-date) (caar entry-list))) - (setq time-string (cadr (car entry-list))) - (while (string-match appt-time-regexp time-string) - (let* ((beg (match-beginning 0)) - ;; Get just the time for this appointment. - (only-time (match-string 0 time-string)) - ;; Find the end of this appointment - ;; (the start of the next). - (end (string-match - (concat "\n[ \t]*" appt-time-regexp) - time-string - (match-end 0))) - ;; Get the whole string for this appointment. - (appt-time-string - (substring time-string beg end)) - (appt-time (list (appt-convert-time only-time))) - (time-msg (list appt-time appt-time-string))) - ;; Add this appointment to appt-time-msg-list. - (setq appt-time-msg-list - (nconc appt-time-msg-list (list time-msg)) - ;; Discard this appointment from the string. - time-string - (if end (substring time-string end) "")))) - (setq entry-list (cdr entry-list))))) - (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) - ;; Convert current time to minutes after midnight (12:01am = 1), - ;; so that elements in the list that are earlier than the - ;; present time can be removed. - (let* ((now (decode-time)) - (cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now))) - (appt-comp-time (caar (car appt-time-msg-list)))) - (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) - (setq appt-time-msg-list (cdr appt-time-msg-list)) - (if appt-time-msg-list - (setq appt-comp-time (caar (car appt-time-msg-list)))))))))) +Any appointments made with `appt-add' are not affected by this function." + ;; We have something to do if the range of dates that the diary is + ;; considering includes the current date. + (if (and (not (calendar-date-compare + (list (calendar-current-date)) + (list original-date))) + (calendar-date-compare + (list (calendar-current-date)) + (list (calendar-gregorian-from-absolute + (+ (calendar-absolute-from-gregorian original-date) + number))))) + (save-excursion + ;; Clear the appointments list, then fill it in from the diary. + (dolist (elt appt-time-msg-list) + ;; Delete any entries that were not made with appt-add. + (unless (nth 2 elt) + (setq appt-time-msg-list + (delq elt appt-time-msg-list)))) + (if diary-entries-list + ;; Cycle through the entry-list (diary-entries-list) + ;; looking for entries beginning with a time. If the + ;; entry begins with a time, add it to the + ;; appt-time-msg-list. Then sort the list. + (let ((entry-list diary-entries-list) + (new-time-string "") + time-string) + ;; Below, we assume diary-entries-list was in date + ;; order. It is, unless something on + ;; diary-list-entries-hook has changed it, eg + ;; diary-include-other-files (bug#7019). It must be + ;; in date order if number = 1. + (and diary-list-entries-hook + appt-display-diary + (not (eq diary-number-of-entries 1)) + (not (memq (car (last diary-list-entries-hook)) + '(diary-sort-entries sort-diary-entries))) + (setq entry-list (sort entry-list 'diary-entry-compare))) + ;; Skip diary entries for dates before today. + (while (and entry-list + (calendar-date-compare + (car entry-list) (list (calendar-current-date)))) + (setq entry-list (cdr entry-list))) + ;; Parse the entries for today. + (while (and entry-list + (calendar-date-equal + (calendar-current-date) (caar entry-list))) + (setq time-string (cadr (car entry-list))) + (while (string-match appt-time-regexp time-string) + (let* ((beg (match-beginning 0)) + ;; Get just the time for this appointment. + (only-time (match-string 0 time-string)) + ;; Find the end of this appointment + ;; (the start of the next). + (end (string-match + (concat "\n[ \t]*" appt-time-regexp) + time-string + (match-end 0))) + ;; Get the whole string for this appointment. + (appt-time-string + (substring time-string beg end)) + (appt-time (list (appt-convert-time only-time))) + (time-msg (list appt-time appt-time-string))) + ;; Add this appointment to appt-time-msg-list. + (setq appt-time-msg-list + (nconc appt-time-msg-list (list time-msg)) + ;; Discard this appointment from the string. + time-string + (if end (substring time-string end) "")))) + (setq entry-list (cdr entry-list))))) + (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)) + ;; Convert current time to minutes after midnight (12:01am = 1), + ;; so that elements in the list that are earlier than the + ;; present time can be removed. + (let* ((now (decode-time)) + (cur-comp-time (+ (* 60 (nth 2 now)) (nth 1 now))) + (appt-comp-time (caar (car appt-time-msg-list)))) + (while (and appt-time-msg-list (< appt-comp-time cur-comp-time)) + (setq appt-time-msg-list (cdr appt-time-msg-list)) + (if appt-time-msg-list + (setq appt-comp-time (caar (car appt-time-msg-list))))))))) (defun appt-sort-list (appt-list) @@ -677,30 +604,6 @@ It is intended for use with `write-file-functions'." (appt-check t))) nil) -;; In Emacs-21.3, the manual documented the following procedure to -;; activate this package: -;; (display-time) -;; (add-hook 'diary-hook 'appt-make-list) -;; (diary 0) -;; The display-time call was not necessary, AFAICS. -;; What was really needed was to add the hook and load this file. -;; Calling (diary 0) once the hook had been added was in some sense a -;; roundabout way of loading this file. This file used to have code at -;; the top-level that set up the appt-timer and global-mode-string. -;; One way to maintain backwards compatibility would be to call -;; (appt-activate 1) at top-level. However, this goes against the -;; convention that just loading an Emacs package should not activate -;; it. Instead, we make appt-make-list activate the package (after a -;; suggestion from rms). This means that one has to call diary in -;; order to get it to work, but that is in line with the old (weird, -;; IMO) documented behavior for activating the package. -;; Actually, since (diary 0) does not run diary-hook, I don't think -;; the documented behavior in Emacs-21.3 would ever have worked. -;; Oh well, at least with the changes to appt-make-list it will now -;; work as well as it ever did. -;; The new method is just to use (appt-activate 1). -;; -- gmorris - ;;;###autoload (defun appt-activate (&optional arg) "Toggle checking of appointments. @@ -716,15 +619,21 @@ ARG is positive, otherwise off." (when appt-timer (cancel-timer appt-timer) (setq appt-timer nil)) - (when appt-active - (add-hook 'write-file-functions 'appt-update-list) - (setq appt-timer (run-at-time t 60 'appt-check) - global-mode-string - (append global-mode-string '(appt-mode-string))) - (appt-check t)))) + (if appt-active + (progn + (add-hook 'write-file-functions 'appt-update-list) + (setq appt-timer (run-at-time t 60 'appt-check) + global-mode-string + (append global-mode-string '(appt-mode-string))) + (appt-check t) + (message "Appointment reminders enabled%s" + ;; Someone might want to use appt-add without a diary. + (if (ignore-errors (diary-check-diary-file)) + "" + " (no diary file found)"))) + (message "Appointment reminders disabled")))) (provide 'appt) -;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347 ;;; appt.el ends here diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 7270d423409..7b8f61a7a84 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -6,6 +6,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Bahá'à calendar, Bahá'Ã, Baha'i, Bahai, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index f9946c18045..0fc63e7eaac 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Chinese calendar, calendar, holidays, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el index 16cc6672727..69612edab38 100644 --- a/lisp/calendar/cal-coptic.el +++ b/lisp/calendar/cal-coptic.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Coptic calendar, Ethiopic calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index c541caa5696..d27bc8480a7 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: daylight saving time, calendar, diary, holidays +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 1ee290f5aa9..98a118f232f 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -1,12 +1,14 @@ ;;; cal-french.el --- calendar functions for the French Revolutionary calendar ;; Copyright (C) 1988, 1989, 1992, 1994, 1995, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: French Revolutionary calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. @@ -40,8 +42,8 @@ "Array of month names in the French calendar.") (defconst calendar-french-multibyte-month-name-array - ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" - "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] + ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" + "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] "Array of multibyte month names in the French calendar.") (defconst calendar-french-day-name-array @@ -55,8 +57,8 @@ "Array of special day names in the French calendar.") (defconst calendar-french-multibyte-special-days-array - ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses" - "de la Révolution"] + ["de la Vertu" "du Génie" "du Travail" "de la Raison" "des Récompenses" + "de la Révolution"] "Array of multibyte special day names in the French calendar.") (defun calendar-french-accents-p () @@ -174,13 +176,13 @@ Defaults to today's date if DATE is not given." (cond ((< y 1) "") ((= m 13) (format (if (calendar-french-accents-p) - "Jour %s de l'Année %d de la Révolution" + "Jour %s de l'Année %d de la Révolution" "Jour %s de l'Anne'e %d de la Re'volution") (aref (calendar-french-special-days-array) (1- d)) y)) (t (format (if (calendar-french-accents-p) - "%d %s an %d de la Révolution" + "%d %s an %d de la Révolution" "%d %s an %d de la Re'volution") d (aref (calendar-french-month-name-array) (1- m)) @@ -208,7 +210,7 @@ Echo French Revolutionary date unless NOECHO is non-nil." (year (progn (calendar-read (if (calendar-french-accents-p) - "Année de la Révolution (>0): " + "Année de la Révolution (>0): " "Anne'e de la Re'volution (>0): ") (lambda (x) (> x 0)) (number-to-string @@ -264,5 +266,9 @@ Echo French Revolutionary date unless NOECHO is non-nil." (provide 'cal-french) +;; Local Variables: +;; coding: utf-8 +;; End: + ;; arch-tag: 7e8045a3-8609-46b5-9cde-cf40ce541cf9 ;;; cal-french.el ends here diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 2a7556ff322..366fb2396fc 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Hebrew calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. @@ -375,7 +376,7 @@ or ALL is non-nil." (list (calendar-gregorian-from-absolute (1+ abs-r-h)) "Rosh HaShanah (second day)") (list (calendar-gregorian-from-absolute - (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2))) + (+ abs-r-h (if (= (% abs-r-h 7) 4) 3 2))) "Tzom Gedaliah") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (+ 7 abs-r-h))) @@ -453,70 +454,71 @@ or ALL is non-nil." (list (calendar-gregorian-from-absolute (+ abs-p 50)) "Shavuot")) (when (or all calendar-hebrew-all-holidays-flag) - (list - (list (calendar-gregorian-from-absolute - (calendar-dayname-on-or-before 6 (- abs-p 43))) - "Shabbat Shekalim") - (list (calendar-gregorian-from-absolute - (calendar-dayname-on-or-before 6 (- abs-p 30))) - "Shabbat Zachor") - (list (calendar-gregorian-from-absolute - (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31))) - "Fast of Esther") - (list (calendar-gregorian-from-absolute (- abs-p 31)) - "Erev Purim") - (list (calendar-gregorian-from-absolute (- abs-p 30)) - "Purim") - (list (calendar-gregorian-from-absolute - (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29))) - "Shushan Purim") - (list (calendar-gregorian-from-absolute - (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7)) - "Shabbat Parah") - (list (calendar-gregorian-from-absolute - (calendar-dayname-on-or-before 6 (- abs-p 14))) - "Shabbat HaHodesh") - (list (calendar-gregorian-from-absolute - (calendar-dayname-on-or-before 6 (1- abs-p))) - "Shabbat HaGadol") - (list (calendar-gregorian-from-absolute (1- abs-p)) - "Erev Passover") - (list (calendar-gregorian-from-absolute (1+ abs-p)) - "Passover (second day)") - (list (calendar-gregorian-from-absolute (+ abs-p 2)) - "Hol Hamoed Passover (first day)") - (list (calendar-gregorian-from-absolute (+ abs-p 3)) - "Hol Hamoed Passover (second day)") - (list (calendar-gregorian-from-absolute (+ abs-p 4)) - "Hol Hamoed Passover (third day)") - (list (calendar-gregorian-from-absolute (+ abs-p 5)) - "Hol Hamoed Passover (fourth day)") - (list (calendar-gregorian-from-absolute (+ abs-p 6)) - "Passover (seventh day)") - (list (calendar-gregorian-from-absolute (+ abs-p 7)) - "Passover (eighth day)") - (list (calendar-gregorian-from-absolute - (if (zerop (% (+ abs-p 12) 7)) - (+ abs-p 13) - (+ abs-p 12))) - "Yom HaShoah") - (list (calendar-gregorian-from-absolute - (if (zerop (% abs-p 7)) - (+ abs-p 18) - (if (= (% abs-p 7) 6) - (+ abs-p 19) - (if (= (% abs-p 7) 2) - (+ abs-p 21) - (+ abs-p 20))))) - "Yom HaAtzma'ut") - (list (calendar-gregorian-from-absolute (+ abs-p 33)) - "Lag BaOmer") - (list (calendar-gregorian-from-absolute (+ abs-p 43)) - "Yom Yerushalaim") - (list (calendar-gregorian-from-absolute (+ abs-p 49)) - "Erev Shavuot") - (list (calendar-gregorian-from-absolute (+ abs-p 51)) - "Shavuot (second day)")))))))) + (let ((wday (% abs-p 7))) + (list + (list (calendar-gregorian-from-absolute + (calendar-dayname-on-or-before 6 (- abs-p 43))) + "Shabbat Shekalim") + (list (calendar-gregorian-from-absolute + (calendar-dayname-on-or-before 6 (- abs-p 30))) + "Shabbat Zachor") + (list (calendar-gregorian-from-absolute + (- abs-p (if (= wday 2) 33 31))) + "Fast of Esther") + (list (calendar-gregorian-from-absolute (- abs-p 31)) + "Erev Purim") + (list (calendar-gregorian-from-absolute (- abs-p 30)) + "Purim") + (list (calendar-gregorian-from-absolute + (- abs-p (if (zerop wday) 28 29))) + "Shushan Purim") + (list (calendar-gregorian-from-absolute + (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7)) + "Shabbat Parah") + (list (calendar-gregorian-from-absolute + (calendar-dayname-on-or-before 6 (- abs-p 14))) + "Shabbat HaHodesh") + (list (calendar-gregorian-from-absolute + (calendar-dayname-on-or-before 6 (1- abs-p))) + "Shabbat HaGadol") + (list (calendar-gregorian-from-absolute (1- abs-p)) + "Erev Passover") + (list (calendar-gregorian-from-absolute (1+ abs-p)) + "Passover (second day)") + (list (calendar-gregorian-from-absolute (+ abs-p 2)) + "Hol Hamoed Passover (first day)") + (list (calendar-gregorian-from-absolute (+ abs-p 3)) + "Hol Hamoed Passover (second day)") + (list (calendar-gregorian-from-absolute (+ abs-p 4)) + "Hol Hamoed Passover (third day)") + (list (calendar-gregorian-from-absolute (+ abs-p 5)) + "Hol Hamoed Passover (fourth day)") + (list (calendar-gregorian-from-absolute (+ abs-p 6)) + "Passover (seventh day)") + (list (calendar-gregorian-from-absolute (+ abs-p 7)) + "Passover (eighth day)") + (list (calendar-gregorian-from-absolute + (+ abs-p (if (zerop (% (+ abs-p 12) 7)) + 13 + 12))) + "Yom HaShoah") + (list (calendar-gregorian-from-absolute + (+ abs-p + ;; If falls on Sat or Fri, moves to preceding Thurs. + ;; If falls on Mon, moves to Tues (since 2004). + (cond ((zerop wday) 18) ; Sat + ((= wday 6) 19) ; Fri + ((= wday 2) 21) ; Mon + (t 20)))) + "Yom HaAtzma'ut") + (list (calendar-gregorian-from-absolute (+ abs-p 33)) + "Lag BaOmer") + (list (calendar-gregorian-from-absolute (+ abs-p 43)) + "Yom Yerushalaim") + (list (calendar-gregorian-from-absolute (+ abs-p 49)) + "Erev Shavuot") + (list (calendar-gregorian-from-absolute (+ abs-p 51)) + "Shavuot (second day)"))))))))) ;;;###holiday-autoload (define-obsolete-function-alias 'holiday-passover-etc @@ -526,18 +528,19 @@ or ALL is non-nil." (defun holiday-hebrew-tisha-b-av () "List of dates around Tisha B'Av, as visible in calendar window." (when (memq displayed-month '(5 6 7 8 9)) - (let ((abs-t-a (calendar-hebrew-to-absolute - (list 5 9 (+ displayed-year 3760))))) + (let* ((abs-t-a (calendar-hebrew-to-absolute + (list 5 9 (+ displayed-year 3760)))) + (wday (% abs-t-a 7))) (holiday-filter-visible-calendar (list (list (calendar-gregorian-from-absolute - (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21))) + (- abs-t-a (if (= wday 6) 20 21))) "Tzom Tammuz") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 abs-t-a)) "Shabbat Hazon") (list (calendar-gregorian-from-absolute - (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a)) + (if (= wday 6) (1+ abs-t-a) abs-t-a)) "Tisha B'Av") (list (calendar-gregorian-from-absolute (calendar-dayname-on-or-before 6 (+ abs-t-a 7))) @@ -556,7 +559,7 @@ Includes: Tal Umatar, Tzom Teveth, Tu B'Shevat, Shabbat Shirah, and Kiddush HaHamah." (let ((m displayed-month) (y displayed-year) - year h-year s-s) + year h-year) (append (holiday-julian 11 @@ -590,20 +593,17 @@ Kiddush HaHamah." (calendar-extract-year (calendar-hebrew-from-absolute (calendar-absolute-from-gregorian - (list m (calendar-last-day-of-month m y) y))))) - s-s - (calendar-hebrew-from-absolute - (if (= 6 - (% (calendar-hebrew-to-absolute - (list 7 1 h-year)) - 7)) - (calendar-dayname-on-or-before - 6 (calendar-hebrew-to-absolute - (list 11 17 h-year))) - (calendar-dayname-on-or-before - 6 (calendar-hebrew-to-absolute - (list 11 16 h-year)))))) - (calendar-extract-day s-s)) + (list m (calendar-last-day-of-month m y) y)))))) + (calendar-extract-day + (calendar-hebrew-from-absolute + (calendar-dayname-on-or-before + 6 (calendar-hebrew-to-absolute + (list 11 + (if (= 6 + (% (calendar-hebrew-to-absolute + (list 7 1 h-year)) + 7)) + 17 16) h-year)))))) "Shabbat Shirah") (and (progn (setq m displayed-month @@ -1161,5 +1161,4 @@ use when highlighting the day in the calendar." (provide 'cal-hebrew) -;; arch-tag: aaab6718-7712-42ac-a32d-28fe1f944f3c ;;; cal-hebrew.el ends here diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el index 33066b201bf..d4210027600 100644 --- a/lisp/calendar/cal-html.el +++ b/lisp/calendar/cal-html.el @@ -7,6 +7,7 @@ ;; Keywords: calendar ;; Human-Keywords: calendar, diary, HTML ;; Created: 23 Aug 2002 +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index 1c09f1db113..da631a9710a 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Islamic calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index 0762860b0ba..3c5055defb6 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: ISO calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index d1cea19be40..0cf9388a4b0 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Julian calendar, Julian day number, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index de079b122c7..d2e4810fa82 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Mayan calendar, Maya, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 521cd2dce2d..877be9556fb 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: calendar, popup menus, menu bar +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index 89e45bef779..e569e8c424c 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: calendar +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index 95ae2f165bb..5c624ddcf01 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Persian calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 46fb0869787..e6ba1ad3439 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Calendar, LaTeX +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 90a4c5d33b8..377646147b9 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: calendar, dedicated frames +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 219e489a2eb..231c92f417d 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1,7 +1,8 @@ ;;; diary-lib.el --- diary functions ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> @@ -304,28 +305,48 @@ If this variable is nil, years must be written in full." :type 'boolean :group 'diary) +(defun diary-outlook-format-1 (body) + "Return a replace-match template for an element of `diary-outlook-formats'. +Returns a string using match elements 1-5, where: +1 = month name, 2 = day, 3 = year, 4 = time, 5 = location; also uses +%s = message subject. BODY is the string from which the matches derive." + (let* ((monthname (match-string 1 body)) + (day (match-string 2 body)) + (year (match-string 3 body)) + ;; Blech. + (month (catch 'found + (dotimes (i (length calendar-month-name-array)) + (if (string-equal (aref calendar-month-name-array i) + monthname) + (throw 'found (1+ i)))) + nil))) + ;; If we could convert the monthname to a numeric month, we can + ;; use the standard function calendar-date-string. + (concat (if month + (calendar-date-string (list month (string-to-number day) + (string-to-number year))) + (cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD + ((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY + (t "\\1 \\2 \\3"))) ; MDY + "\n \\4 %s, \\5"))) +;; TODO Sometimes the time is in a different time-zone to the one you +;; are in. Eg in PST, you might still get an email referring to: +;; "7:00 PM-8:00 PM. Greenwich Standard Time". +;; Note that it doesn't use a standard abbreviation for the timezone, +;; or anything helpful like that. +;; Sigh, this could cause the meeting to even be on a different day +;; to that given in the When: string. +;; These things seem to come in a multipart mail with a calendar part, +;; it's probably better to use that rather than this whole thing. +;; So this is unlikely to get improved. + +;; TODO Is the format of these messages actually documented anywhere? (defcustom diary-outlook-formats - '( - ;; When: 11 October 2001 12:00-14:00 (GMT) Greenwich Mean Time : Dublin, ... - ;; [Current UK format? The timezone is meaningless. Sometimes the - ;; Where is missing.] - ("When: \\([0-9]+ [[:alpha:]]+ [0-9]+\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\n+\\)? -\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*~\\*" - . "\\1\n \\2 %s, \\3") - ;; When: Tuesday, April 30, 2002 03:00 PM-03:30 PM (GMT) Greenwich Mean ... - ;; [Old UK format?] - ("^When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \\([0-9]\\{4\\}\\) \ -\\([^ ]+\\) [^\n]+ -\[^\n]+ -\\(?:Where: \\([^\n]+\\)\\)?\n+" - . "\\2 \\1 \\3\n \\4 %s, \\5") - ( - ;; German format, apparently. - "^Zeit: [^ ]+, +\\([0-9]+\\)\. +\\([[:upper:]][[:lower:]][[:lower:]]\\)[^ ]* +\\([0-9]+\\) +\\([^ ]+\\).*$" - . "\\1 \\2 \\3\n \\4 %s")) + '(;; When: Tuesday, November 9, 2010 7:00 PM-8:00 PM. Greenwich Standard Time + ;; Where: Meeting room B + ("[ \t\n]*When: [[:alpha:]]+, \\([[:alpha:]]+\\) \\([0-9][0-9]*\\), \ +\\([0-9]\\{4\\}\\),? \\(.+\\)\n\ +\\(?:Where: \\(.+\n\\)\\)?" . diary-outlook-format-1)) "Alist of regexps matching message text and replacement text. The regexp must match the start of the message text containing an @@ -487,8 +508,6 @@ in the displayed three-month calendar." (diary-check-diary-file) (diary-list-entries (calendar-cursor-to-date t) arg)) -(define-obsolete-function-alias 'view-diary-entries 'diary-view-entries "22.1") - ;;;###cal-autoload (defun diary-view-other-diary-entries (arg dfile) @@ -594,19 +613,20 @@ The entry is added to the list as (DATE STRING SPECIFIER LOCATOR GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL), FILENAME being the file containing the diary entry." (when (and date string) - (if diary-file-name-prefix - (let ((prefix (funcall diary-file-name-prefix-function - (buffer-file-name)))) - (or (string-equal prefix "") - (setq string (format "[%s] %s" prefix string))))) - (and diary-modify-entry-list-string-function - (setq string (funcall diary-modify-entry-list-string-function - string))) - (setq diary-entries-list - (append diary-entries-list - (list (list date string specifier - (list marker (buffer-file-name) literal) - globcolor)))))) + ;; b-f-n is nil if we are visiting an include file in a temp-buffer. + (let ((dfile (or (buffer-file-name) diary-file))) + (if diary-file-name-prefix + (let ((prefix (funcall diary-file-name-prefix-function dfile))) + (or (string-equal prefix "") + (setq string (format "[%s] %s" prefix string))))) + (and diary-modify-entry-list-string-function + (setq string (funcall diary-modify-entry-list-string-function + string))) + (setq diary-entries-list + (append diary-entries-list + (list (list date string specifier + (list marker dfile literal) + globcolor))))))) (define-obsolete-function-alias 'add-to-diary-list 'diary-add-to-list "23.1") @@ -700,7 +720,6 @@ of the appropriate type." (1+ (calendar-absolute-from-gregorian gdate)))))) (goto-char (point-min))) -(defvar diary-including) ; dynamically bound in diary-include-other-diary-files (defvar diary-included-files nil "List of any diary files included in the last call to `diary-list-entries'.") @@ -759,66 +778,74 @@ LIST-ONLY is non-nil, in which case it just returns the list." (let* ((original-date date) ; save for possible use in the hooks (date-string (calendar-date-string date)) (diary-buffer (find-buffer-visiting diary-file)) - diary-entries-list file-glob-attrs) - (or (bound-and-true-p diary-including) - (setq diary-included-files nil)) - (message "Preparing diary...") - (save-current-buffer - (if (not diary-buffer) - (set-buffer (find-file-noselect diary-file t)) - (set-buffer diary-buffer) - (or (verify-visited-file-modtime diary-buffer) - (revert-buffer t t))) - ;; Setup things like the header-line-format and invisibility-spec. - (if (eq major-mode (default-value 'major-mode)) - (diary-mode) - ;; This kludge is to make customizations to - ;; diary-header-line-flag after diary has been displayed - ;; take effect. Unconditionally calling (diary-mode) - ;; clobbers file local variables. - ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html - ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html - (if (eq major-mode 'diary-mode) - (setq header-line-format (and diary-header-line-flag - diary-header-line-format)))) - ;; d-s-p is passed to the diary display function. - (let ((diary-saved-point (point))) - (save-excursion - (save-restriction - (widen) ; bug#5093 - (setq file-glob-attrs (cadr (diary-pull-attrs nil ""))) - (with-syntax-table diary-syntax-table - (goto-char (point-min)) - (unless list-only - (let ((ol (make-overlay (point-min) (point-max) nil t nil))) - (set (make-local-variable 'diary-selective-display) t) - (overlay-put ol 'invisible 'diary) - (overlay-put ol 'evaporate t))) - (dotimes (idummy number) - (let ((sexp-found (diary-list-sexp-entries date)) - (entry-found (diary-list-entries-2 - date diary-nonmarking-symbol - file-glob-attrs list-only))) - (if diary-list-include-blanks - (or sexp-found entry-found - (diary-add-to-list date "" "" "" ""))) - (setq date - (calendar-gregorian-from-absolute - (1+ (calendar-absolute-from-gregorian date))))))) - (goto-char (point-min)) - (run-hooks 'diary-nongregorian-listing-hook - 'diary-list-entries-hook) - (unless list-only - (if (and diary-display-function - (listp diary-display-function)) - ;; Backwards compatibility. - (run-hooks 'diary-display-function) - (funcall (or diary-display-function - 'diary-simple-display)))) - (run-hooks 'diary-hook) - diary-entries-list))))))) - -(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries "22.1") + ;; Dynamically bound in diary-include-other-diary-files. + (d-incp (and (boundp 'diary-including) diary-including)) + diary-entries-list file-glob-attrs temp-buff) + (unless d-incp + (setq diary-included-files nil) + (message "Preparing diary...")) + (unwind-protect + (with-current-buffer (or diary-buffer + (if list-only + (setq temp-buff (generate-new-buffer + " *diary-temp*")) + (find-file-noselect diary-file t))) + (if diary-buffer + (or (verify-visited-file-modtime diary-buffer) + (revert-buffer t t))) + (if temp-buff + ;; If including, caller has already verified it is readable. + (insert-file-contents diary-file) + ;; Setup things like the header-line-format and invisibility-spec. + (if (eq major-mode (default-value 'major-mode)) + (diary-mode) + ;; This kludge is to make customizations to + ;; diary-header-line-flag after diary has been displayed + ;; take effect. Unconditionally calling (diary-mode) + ;; clobbers file local variables. + ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00363.html + ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00404.html + (if (eq major-mode 'diary-mode) + (setq header-line-format (and diary-header-line-flag + diary-header-line-format))))) + ;; d-s-p is passed to the diary display function. + (let ((diary-saved-point (point))) + (save-excursion + (save-restriction + (widen) ; bug#5093 + (setq file-glob-attrs (cadr (diary-pull-attrs nil ""))) + (with-syntax-table diary-syntax-table + (goto-char (point-min)) + (unless list-only + (let ((ol (make-overlay (point-min) (point-max) nil t nil))) + (set (make-local-variable 'diary-selective-display) t) + (overlay-put ol 'invisible 'diary) + (overlay-put ol 'evaporate t))) + (dotimes (idummy number) + (let ((sexp-found (diary-list-sexp-entries date)) + (entry-found (diary-list-entries-2 + date diary-nonmarking-symbol + file-glob-attrs list-only))) + (if diary-list-include-blanks + (or sexp-found entry-found + (diary-add-to-list date "" "" "" ""))) + (setq date + (calendar-gregorian-from-absolute + (1+ (calendar-absolute-from-gregorian date))))))) + (goto-char (point-min)) + (run-hooks 'diary-nongregorian-listing-hook + 'diary-list-entries-hook) + (unless list-only + (if (and diary-display-function + (listp diary-display-function)) + ;; Backwards compatibility. + (run-hooks 'diary-display-function) + (funcall (or diary-display-function + 'diary-simple-display)))) + (run-hooks 'diary-hook))))) + (and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff))) + (or d-incp (message "Preparing diary...done")) + diary-entries-list))) (defun diary-unhide-everything () "Show all invisible text in the diary." @@ -829,7 +856,7 @@ LIST-ONLY is non-nil, in which case it just returns the list." (kill-local-variable 'mode-line-format)) (defvar original-date) ; bound in diary-list-entries -(defvar number) +;(defvar number) ; already declared above (defun diary-include-other-diary-files () "Include the diary entries from other diary files with those of `diary-file'. @@ -846,20 +873,18 @@ the variable `diary-include-string'." nil t) (let ((diary-file (match-string-no-properties 1)) (diary-list-entries-hook 'diary-include-other-diary-files) - (diary-display-function 'ignore) (diary-including t) - diary-hook diary-list-include-blanks) + diary-hook diary-list-include-blanks efile) (if (file-exists-p diary-file) (if (file-readable-p diary-file) - (unwind-protect - (setq diary-included-files - (append diary-included-files - (list (expand-file-name diary-file))) - diary-entries-list - (append diary-entries-list - (diary-list-entries original-date number))) - (with-current-buffer (find-buffer-visiting diary-file) - (diary-unhide-everything))) + (if (member (setq efile (expand-file-name diary-file)) + diary-included-files) + (error "Recursive diary include for %s" diary-file) + (setq diary-included-files + (append diary-included-files (list efile)) + diary-entries-list + (append diary-entries-list + (diary-list-entries original-date number t)))) (beep) (message "Can't read included diary file %s" diary-file) (sleep-for 2)) @@ -928,8 +953,7 @@ in the mode line. This is an option for `diary-display-function'." (let ((window (display-buffer (current-buffer)))) ;; d-s-p is passed from diary-list-entries. (set-window-point window diary-saved-point) - (set-window-start window (point-min)))) - (message "Preparing diary...done")))) + (set-window-start window (point-min))))))) (define-obsolete-function-alias 'simple-diary-display 'diary-simple-display "23.1") @@ -1051,8 +1075,7 @@ This is an option for `diary-display-function'." (if (eq major-mode 'diary-fancy-display-mode) (run-hooks 'diary-fancy-display-mode-hook) (diary-fancy-display-mode)) - (calendar-set-mode-line date-string) - (message "Preparing diary...done")))) + (calendar-set-mode-line date-string)))) (define-obsolete-function-alias 'fancy-diary-display 'diary-fancy-display "23.1") @@ -1126,9 +1149,6 @@ is created." (derived-mode-p 'calendar-mode))) (fit-window-to-buffer win))))) -(define-obsolete-function-alias 'show-all-diary-entries - 'diary-show-all-entries "22.1") - ;;;###autoload (defun diary-mail-entries (&optional ndays) "Send a mail message showing diary entries for next NDAYS days. @@ -2332,6 +2352,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." ;;; Fancy Diary Mode. +;; FIXME does not update upon changes to the name-arrays. (defvar diary-fancy-date-pattern (concat (let ((dayname (diary-name-pattern calendar-day-name-array nil t)) @@ -2413,37 +2434,27 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." ;; functions `diary-from-outlook-gnus' and `diary-from-outlook-rmail', ;; could be run from hooks to notice appointments automatically (in ;; which case they will prompt about adding to the diary). The -;; message formats recognized are customizable through -;; `diary-outlook-formats'. - -(defvar subject) ; bound in diary-from-outlook-gnus -(defvar body) +;; message formats recognized are customizable through `diary-outlook-formats'. -(defun diary-from-outlook-internal (&optional test-only) +(defun diary-from-outlook-internal (subject body &optional test-only) "Snarf a diary entry from a message assumed to be from MS Outlook. -Assumes `body' is bound to a string comprising the body of the message and -`subject' is bound to a string comprising its subject. +SUBJECT and BODY are strings giving the message subject and body. Arg TEST-ONLY non-nil means return non-nil if and only if the message contains an appointment, don't make a diary entry." (catch 'finished (let (format-string) - (dotimes (i (length diary-outlook-formats)) - (when (eq 0 (string-match (car (nth i diary-outlook-formats)) - body)) + (dolist (fmt diary-outlook-formats) + (when (eq 0 (string-match (car fmt) body)) (unless test-only - (setq format-string (cdr (nth i diary-outlook-formats))) + (setq format-string (cdr fmt)) (save-excursion (save-window-excursion - ;; Fixme: References to optional fields in the format - ;; are treated literally, not replaced by the empty - ;; string. I think this is an Emacs bug. (diary-make-entry (format (replace-match (if (functionp format-string) (funcall format-string body) format-string) t nil (match-string 0 body)) - subject)) - (save-buffer)))) + subject))))) (throw 'finished t)))) nil)) @@ -2471,9 +2482,9 @@ automatically." (save-restriction (gnus-narrow-to-body) (buffer-string))))) - (when (diary-from-outlook-internal t) + (when (diary-from-outlook-internal subject body t) (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) + (diary-from-outlook-internal subject body) (message "Diary entry added")))))) (custom-add-option 'gnus-article-prepare-hook 'diary-from-outlook-gnus) @@ -2486,15 +2497,17 @@ Unless the optional argument NOCONFIRM is non-nil (which is the case when this function is called interactively), then if an entry is found the user is asked to confirm its addition." (interactive "p") + ;; FIXME maybe the body needs rmail-mm decoding, in which case + ;; there is no single buffer with both body and subject, sigh. (with-current-buffer rmail-buffer (let ((subject (mail-fetch-field "subject")) (body (buffer-substring (save-excursion (rfc822-goto-eoh) (point)) (point-max)))) - (when (diary-from-outlook-internal t) + (when (diary-from-outlook-internal subject body t) (when (or noconfirm (y-or-n-p "Snarf diary entry? ")) - (diary-from-outlook-internal) + (diary-from-outlook-internal subject body) (message "Diary entry added")))))) (defun diary-from-outlook (&optional noconfirm) @@ -2514,5 +2527,4 @@ user is asked to confirm its addition." (provide 'diary-lib) -;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010 ;;; diary-lib.el ends here diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 0cafc85a24b..275c8a5ca29 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -1,11 +1,13 @@ ;;; holidays.el --- holiday functions for the calendar package ;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1997, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: holidays, calendar +;; Package: calendar ;; This file is part of GNU Emacs. @@ -42,6 +44,9 @@ ;; explicitly load this file. ;;;###autoload +(define-obsolete-variable-alias 'general-holidays + 'holiday-general-holidays "23.1") +;;;###autoload (defcustom holiday-general-holidays (mapcar 'purecopy '((holiday-fixed 1 1 "New Year's Day") @@ -67,11 +72,11 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-general-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'general-holidays - 'holiday-general-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'oriental-holidays + 'holiday-oriental-holidays "23.1") +;;;###autoload (defcustom holiday-oriental-holidays (mapcar 'purecopy '((holiday-chinese-new-year) @@ -92,11 +97,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-oriental-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'oriental-holidays - 'holiday-oriental-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") +;;;###autoload (defcustom holiday-local-holidays nil "Local holidays. See the documentation for `calendar-holidays' for details." @@ -104,10 +108,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-local-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'local-holidays 'holiday-local-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") +;;;###autoload (defcustom holiday-other-holidays nil "User defined holidays. See the documentation for `calendar-holidays' for details." @@ -115,8 +119,6 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-other-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'other-holidays 'holiday-other-holidays "23.1") ;;;###autoload (defvar hebrew-holidays-1 @@ -218,6 +220,9 @@ See the documentation for `calendar-holidays' for details." (make-obsolete-variable 'hebrew-holidays-4 'hebrew-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'hebrew-holidays + 'holiday-hebrew-holidays "23.1") +;;;###autoload (defcustom holiday-hebrew-holidays (mapcar 'purecopy '((holiday-hebrew-passover) @@ -234,11 +239,11 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-hebrew-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'hebrew-holidays - 'holiday-hebrew-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'christian-holidays + 'holiday-christian-holidays "23.1") +;;;###autoload (defcustom holiday-christian-holidays (mapcar 'purecopy '((holiday-easter-etc) ; respects calendar-christian-all-holidays-flag @@ -256,11 +261,11 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-christian-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'christian-holidays - 'holiday-christian-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'islamic-holidays + 'holiday-islamic-holidays "23.1") +;;;###autoload (defcustom holiday-islamic-holidays (mapcar 'purecopy '((holiday-islamic-new-year) @@ -280,11 +285,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-islamic-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'islamic-holidays - 'holiday-islamic-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") +;;;###autoload (defcustom holiday-bahai-holidays (mapcar 'purecopy '((holiday-bahai-new-year) @@ -304,10 +308,10 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-bahai-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'bahai-holidays 'holiday-bahai-holidays "23.1") ;;;###autoload +(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") +;;;###autoload (defcustom holiday-solar-holidays (mapcar 'purecopy '((solar-equinoxes-solstices) @@ -327,8 +331,6 @@ See the documentation for `calendar-holidays' for details." :group 'holidays) ;;;###autoload (put 'holiday-solar-holidays 'risky-local-variable t) -;;;###autoload -(define-obsolete-variable-alias 'solar-holidays 'holiday-solar-holidays "23.1") ;; This one should not be autoloaded, else .emacs changes of ;; holiday-general-holidays etc have no effect. @@ -918,5 +920,4 @@ is non-nil)." (provide 'holidays) -;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37 ;;; holidays.el ends here diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index a07402aa031..0be138906b6 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -7,6 +7,7 @@ ;; Created: August 2002 ;; Keywords: calendar ;; Human-Keywords: calendar, diary, iCalendar, vCalendar +;; Version: 0.19 ;; This file is part of GNU Emacs. @@ -212,15 +213,15 @@ if nil they are ignored." (defcustom icalendar-uid-format "emacs%t%c" - "Format of unique ID code (UID) for each iCalendar object. -The following specifiers are available: + "Format of unique ID code (UID) for each iCalendar object. +The following specifiers are available: %c COUNTER, an integer value that is increased each time a uid is - generated. This may be necessary for systems which do not + generated. This may be necessary for systems which do not provide time-resolution finer than a second. %h HASH, a hash value of the diary entry, %s DTSTART, the start date (excluding time) of the diary entry, %t TIMESTAMP, a unique creation timestamp, -%u USERNAME, the user-login-name. +%u USERNAME, the variable `user-login-name'. For example, a value of \"%s_%h@mydomain.com\" will generate a UID code for each entry composed of the time of the event, a hash @@ -427,7 +428,7 @@ children." (goto-char (point-min)) (while (re-search-forward - "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" + "\\([A-Za-z0-9-]+\\)=\\(\\([^;:]+\\)\\|\"\\([^\"]+\\)\"\\);?" nil t) (setq param-name (intern (match-string 1))) (setq param-value (match-string 2)) @@ -744,6 +745,20 @@ Note that this silently ignores seconds." ;; Error: -1)) +(defun icalendar--get-weekday-numbers (abbrevweekdays) + "Return the list of numbers for the comma-separated ABBREVWEEKDAYS." + (when abbrevweekdays + (let* ((num -1) + (weekday-alist (mapcar (lambda (day) + (progn + (setq num (1+ num)) + (cons (downcase day) num))) + icalendar--weekday-array))) + (delq nil + (mapcar (lambda (abbrevday) + (cdr (assoc abbrevday weekday-alist))) + (split-string (downcase abbrevweekdays) ",")))))) + (defun icalendar--get-weekday-abbrev (weekday) "Return the abbreviated WEEKDAY." (catch 'found @@ -912,21 +927,21 @@ current iCalendar object, as a string. Increase `icalendar--uid-count'. Returns the UID string." (let ((uid icalendar-uid-format)) - (setq uid (replace-regexp-in-string - "%c" + (setq uid (replace-regexp-in-string + "%c" (format "%d" icalendar--uid-count) uid t t)) (setq icalendar--uid-count (1+ icalendar--uid-count)) - (setq uid (replace-regexp-in-string + (setq uid (replace-regexp-in-string "%t" (format "%d%d%d" (car (current-time)) (cadr (current-time)) - (car (cddr (current-time)))) + (car (cddr (current-time)))) uid t t)) - (setq uid (replace-regexp-in-string - "%h" + (setq uid (replace-regexp-in-string + "%h" (format "%d" (abs (sxhash entry-full))) uid t t)) - (setq uid (replace-regexp-in-string + (setq uid (replace-regexp-in-string "%u" (or user-login-name "UNKNOWN_USER") uid t t)) (let ((dtstart (if (string-match "^DTSTART[^:]*:\\([0-9]*\\)" contents) (substring contents (match-beginning 1) (match-end 1)) @@ -1008,7 +1023,7 @@ FExport diary data into iCalendar file: ") (if url (setq contents (concat contents "\nURL:" url)))) - (setq header (concat "\nBEGIN:VEVENT\nUID:" + (setq header (concat "\nBEGIN:VEVENT\nUID:" (icalendar--create-uid entry-full contents))) (setq result (concat result header contents "\nEND:VEVENT"))) ;; handle errors @@ -1126,7 +1141,7 @@ Returns an alist." (list "%u" (concat "\\(" icalendar-import-format-url "\\)??")))) ;; Need the \' regexp in order to detect multi-line items - (setq s (concat "\\`" + (setq s (concat "\\`" (icalendar--rris "%s" "\\(.*?\\)" s nil t) "\\'")) (if (string-match s summary-and-rest) @@ -2057,39 +2072,48 @@ END-T is the event's end time in diary format." )) ) (cond ((string-equal frequency "WEEKLY") - (if (not start-t) - (progn - ;; weekly and all-day - (icalendar--dmsg "weekly all-day") - (if until - (setq result - (format - (concat "%%%%(and " - "(diary-cyclic %d %s) " - "(diary-block %s %s))") - (* interval 7) - dtstart-conv - dtstart-conv - (if count until-1-conv until-conv) - )) - (setq result - (format "%%%%(and (diary-cyclic %d %s))" - (* interval 7) - dtstart-conv)))) - ;; weekly and not all-day - (let* ((byday (cadr (assoc 'BYDAY rrule-props))) - (weekday - (icalendar--get-weekday-number byday))) + (let* ((byday (cadr (assoc 'BYDAY rrule-props))) + (weekdays + (icalendar--get-weekday-numbers byday)) + (weekday-clause + (when (> (length weekdays) 1) + (format "(memq (calendar-day-of-week date) '%s) " + weekdays)))) + (if (not start-t) + (progn + ;; weekly and all-day + (icalendar--dmsg "weekly all-day") + (if until + (setq result + (format + (concat "%%%%(and " + "%s" + "(diary-block %s %s))") + (or weekday-clause + (format "(diary-cyclic %d %s) " + (* interval 7) + dtstart-conv)) + dtstart-conv + (if count until-1-conv until-conv) + )) + (setq result + (format "%%%%(and %s(diary-cyclic %d %s))" + (or weekday-clause "") + (if weekday-clause 1 (* interval 7)) + dtstart-conv)))) + ;; weekly and not all-day (icalendar--dmsg "weekly not-all-day") (if until (setq result (format (concat "%%%%(and " - "(diary-cyclic %d %s) " + "%s" "(diary-block %s %s)) " "%s%s%s") - (* interval 7) - dtstart-conv + (or weekday-clause + (format "(diary-cyclic %d %s) " + (* interval 7) + dtstart-conv)) dtstart-conv until-conv (or start-t "") @@ -2100,10 +2124,11 @@ END-T is the event's end time in diary format." ;; DTEND;VALUE=DATE-TIME:20030919T113000 (setq result (format - "%%%%(and (diary-cyclic %s %s)) %s%s%s" - (* interval 7) - dtstart-conv - (or start-t "") + "%%%%(and %s(diary-cyclic %d %s)) %s%s%s" + (or weekday-clause "") + (if weekday-clause 1 (* interval 7)) + dtstart-conv + (or start-t "") (if end-t "-" "") (or end-t ""))))))) ;; yearly ((string-equal frequency "YEARLY") diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 37a68888854..58111a036d1 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: moon, lunar phases, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index fd62d909f36..71e32b9db4c 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -220,5 +220,4 @@ unknown are returned as nil." (provide 'parse-time) -;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103 ;;; parse-time.el ends here diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 8116597ad02..b7a728461f0 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 914d2d33928..1bd04d7ed3b 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -39,9 +39,6 @@ ;;; Code: -;; Only necessary for `declare' when compiling Gnus with Emacs 21. -(eval-when-compile (require 'cl)) - (defmacro with-decoded-time-value (varlist &rest body) "Decode a time value and bind it according to VARLIST, then eval BODY. @@ -97,45 +94,42 @@ and type 2 is the list (HIGH LOW MICRO)." (autoload 'timezone-make-date-arpa-standard "timezone") ;;;###autoload +;; `parse-time-string' isn't sufficiently general or robust. It fails +;; to grok some of the formats that timezone does (e.g. dodgy +;; post-2000 stuff from some Elms) and either fails or returns bogus +;; values. timezone-make-date-arpa-standard should help. (defun date-to-time (date) "Parse a string DATE that represents a date-time and return a time value. If DATE lacks timezone information, GMT is assumed." (condition-case () - (apply 'encode-time - (parse-time-string - ;; `parse-time-string' isn't sufficiently general or - ;; robust. It fails to grok some of the formats that - ;; timezone does (e.g. dodgy post-2000 stuff from some - ;; Elms) and either fails or returns bogus values. Lars - ;; reverted this change, but that loses non-trivially - ;; often for me. -- fx - (timezone-make-date-arpa-standard date))) - (error (error "Invalid date: %s" date)))) + (apply 'encode-time (parse-time-string date)) + (error (condition-case () + (apply 'encode-time + (parse-time-string + (timezone-make-date-arpa-standard date))) + (error (error "Invalid date: %s" date)))))) ;; Bit of a mess. Emacs has float-time since at least 21.1. ;; This file is synced to Gnus, and XEmacs packages may have been written ;; using time-to-seconds from the Gnus library. -;;;###autoload(if (and (fboundp 'float-time) -;;;###autoload (subrp (symbol-function 'float-time))) +;;;###autoload(if (or (featurep 'emacs) +;;;###autoload (and (fboundp 'float-time) +;;;###autoload (subrp (symbol-function 'float-time)))) ;;;###autoload (progn ;;;###autoload (defalias 'time-to-seconds 'float-time) ;;;###autoload (make-obsolete 'time-to-seconds 'float-time "21.1")) ;;;###autoload (autoload 'time-to-seconds "time-date")) -(eval-and-compile - (unless (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) - (defun time-to-seconds (time) - "Convert time value TIME to a floating point number." - (with-decoded-time-value ((high low micro time)) - (+ (* 1.0 high 65536) - low - (/ micro 1000000.0)))))) - (eval-when-compile - (unless (fboundp 'with-no-warnings) - (defmacro with-no-warnings (&rest body) - `(progn ,@body)))) + (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time))) + (defun time-to-seconds (time) + "Convert time value TIME to a floating point number." + (with-decoded-time-value ((high low micro time)) + (+ (* 1.0 high 65536) + low + (/ micro 1000000.0)))))) ;;;###autoload (defun seconds-to-time (seconds) @@ -146,7 +140,7 @@ If DATE lacks timezone information, GMT is assumed." ;;;###autoload (defun time-less-p (t1 t2) - "Say whether time value T1 is less than time value T2." + "Return non-nil if time value T1 is earlier than time value T2." (with-decoded-time-value ((high1 low1 micro1 t1) (high2 low2 micro2 t2)) (or (< high1 high2) @@ -259,17 +253,15 @@ The Gregorian date Sunday, December 31, 1bce is imaginary." (- (/ (1- year) 100)) ; - century years (/ (1- year) 400)))) ; + Gregorian leap years -(eval-and-compile - (if (and (fboundp 'float-time) - (subrp (symbol-function 'float-time))) - (defun time-to-number-of-days (time) - "Return the number of days represented by TIME. -The number of days will be returned as a floating point number." - (/ (float-time time) (* 60 60 24))) - (defun time-to-number-of-days (time) - "Return the number of days represented by TIME. -The number of days will be returned as a floating point number." - (/ (with-no-warnings (time-to-seconds time)) (* 60 60 24))))) +(defun time-to-number-of-days (time) + "Return the number of days represented by TIME. +Returns a floating point number." + (/ (funcall (eval-when-compile + (if (or (featurep 'emacs) + (and (fboundp 'float-time) + (subrp (symbol-function 'float-time)))) + 'float-time + 'time-to-seconds)) time) (* 60 60 24))) ;;;###autoload (defun safe-date-to-time (date) @@ -317,10 +309,10 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." (setq start (match-end 0) spec (match-string 1 string)) (unless (string-equal spec "%") - ;; `assoc-string' is not available in Emacs 21. So when compiling - ;; Gnus (`time-date.el' is part of Gnus) with Emacs 21, we get a - ;; warning here. But `format-seconds' is not used anywhere in Gnus so - ;; it's not a real problem. --rsteib + ;; `assoc-string' is not available in XEmacs. So when compiling + ;; Gnus (`time-date.el' is part of Gnus) with XEmacs, we get + ;; a warning here. But `format-seconds' is not used anywhere in + ;; Gnus so it's not a real problem. --rsteib (or (setq match (assoc-string spec units t)) (error "Bad format specifier: `%s'" spec)) (if (assoc-string spec usedunits t) @@ -364,5 +356,4 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." (provide 'time-date) -;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f ;;; time-date.el ends here diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el index 32e0bf61380..d28b0a56c3f 100644 --- a/lisp/calendar/timeclock.el +++ b/lisp/calendar/timeclock.el @@ -543,11 +543,8 @@ non-nil, the amount returned will be relative to past time worked." (message "%s" string) string))) -(defsubst timeclock-time-to-seconds (time) - "Convert TIME to a floating point number." - (+ (* (car time) 65536.0) - (cadr time) - (/ (or (nth 2 time) 0) 1000000.0))) +(defalias 'timeclock-time-to-seconds (if (fboundp 'float-time) 'float-time + 'time-to-seconds)) (defsubst timeclock-seconds-to-time (seconds) "Convert SECONDS (a floating point number) to an Emacs time structure." @@ -1419,5 +1416,4 @@ HTML-P is non-nil, HTML markup is added." (if (file-readable-p timeclock-file) (timeclock-reread-log)) -;; arch-tag: a0be3377-deb6-44ec-b9a2-a7be28436a40 ;;; timeclock.el ends here diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el index 6e8aac171c1..8fd41163eaf 100644 --- a/lisp/calendar/todo-mode.el +++ b/lisp/calendar/todo-mode.el @@ -918,17 +918,9 @@ If INCLUDE-SEP is non-nil, return point after the separator." ;; As calendar reads .todo-do before todo-mode is loaded. ;;;###autoload -(defun todo-mode () - "Major mode for editing TODO lists. - -\\{todo-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'todo-mode) - (setq mode-name "TODO") - (use-local-map todo-mode-map) - (easy-menu-add todo-menu) - (run-mode-hooks 'todo-mode-hook)) +(define-derived-mode todo-mode nil "TODO" + "Major mode for editing TODO lists." + (easy-menu-add todo-menu)) (defvar date) (defvar entry) |