summaryrefslogtreecommitdiff
path: root/lisp/calendar
diff options
context:
space:
mode:
authorKenichi Handa <handa@m17n.org>2004-04-16 12:51:06 +0000
committerKenichi Handa <handa@m17n.org>2004-04-16 12:51:06 +0000
commit63bf36d38628b8adf2a1003279af0807cf692ded (patch)
treedaa5938d31f9f2f956f5d8c509fbe55df4244462 /lisp/calendar
parent9cf9517f0baf5835f64351973ce46d48e7f05a37 (diff)
downloademacs-63bf36d38628b8adf2a1003279af0807cf692ded.tar.gz
Sync to HEAD
Diffstat (limited to 'lisp/calendar')
-rw-r--r--lisp/calendar/appt.el455
-rw-r--r--lisp/calendar/cal-china.el1
-rw-r--r--lisp/calendar/cal-coptic.el5
-rw-r--r--lisp/calendar/cal-dst.el1
-rw-r--r--lisp/calendar/cal-french.el5
-rw-r--r--lisp/calendar/cal-hebrew.el23
-rw-r--r--lisp/calendar/cal-islam.el13
-rw-r--r--lisp/calendar/cal-iso.el1
-rw-r--r--lisp/calendar/cal-julian.el5
-rw-r--r--lisp/calendar/cal-mayan.el9
-rw-r--r--lisp/calendar/cal-menu.el83
-rw-r--r--lisp/calendar/cal-move.el22
-rw-r--r--lisp/calendar/cal-persia.el1
-rw-r--r--lisp/calendar/cal-tex.el1
-rw-r--r--lisp/calendar/cal-x.el13
-rw-r--r--lisp/calendar/calendar.el157
-rw-r--r--lisp/calendar/diary-lib.el144
-rw-r--r--lisp/calendar/holidays.el1
-rw-r--r--lisp/calendar/lunar.el1
-rw-r--r--lisp/calendar/parse-time.el2
-rw-r--r--lisp/calendar/solar.el1
-rw-r--r--lisp/calendar/time-date.el1
-rw-r--r--lisp/calendar/timeclock.el54
-rw-r--r--lisp/calendar/todo-mode.el8
24 files changed, 609 insertions, 398 deletions
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index c3f4d77fcae..002aec878ca 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -1,6 +1,6 @@
;;; appt.el --- appointment notification functions
-;; Copyright (C) 1989, 1990, 1994, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1990, 1994, 1998, 2004 Free Software Foundation, Inc.
;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
;; Maintainer: FSF
@@ -27,7 +27,7 @@
;;
;; appt.el - visible and/or audible notification of
-;; appointments from ~/diary file.
+;; appointments from diary file.
;;
;;;
;;; Thanks to Edward M. Reingold for much help and many suggestions,
@@ -35,62 +35,41 @@
;;;
;;;
;;; This functions in this file will alert the user of a
-;;; pending appointment based on their diary file.
+;;; pending appointment based on his/her diary file. This package
+;;; is documented in the Emacs manual.
;;;
-;;; A message will be displayed in the mode line of the Emacs buffer
-;;; and (if you request) the terminal will beep and display a message
-;;; from the diary in the mini-buffer, or you can choose to
-;;; have a message displayed in a new buffer.
+;;; To activate this package, simply use (appt-activate 1).
+;;; A `diary-file' with appointments of the format described in the
+;;; documentation of the function `appt-check' is required.
+;;; Relevant customizable variables are also listed in the
+;;; documentation of that function.
;;;
-;;; The variable `appt-message-warning-time' allows the
-;;; user to specify how much notice they want before the appointment. The
-;;; variable `appt-issue-message' specifies whether the user wants
-;;; to be notified of a pending appointment.
+;;; Today's appointment list is initialized from the diary when this
+;;; package is activated. Additionally, the appointments list is
+;;; recreated automatically at 12:01am for those who do not logout
+;;; every day or are programming late. It is also updated when the
+;;; `diary-file' is saved. Calling `appt-check' with an argument forces
+;;; a re-initialization at any time.
;;;
-;;; In order to use the appt package, you only need
-;;; to load it---provided you have appointments.
-;;;
-;;; Before that, you can also set some options if you want
-;;; (setq view-diary-entries-initially t)
-;;; (setq appt-issue-message t)
-;;;
-;;; This is an example of what can be in your diary file:
-;;; Monday
-;;; 9:30am Coffee break
-;;; 12:00pm Lunch
-;;;
-;;; Based upon the above lines in your .emacs and diary files,
-;;; the calendar and diary will be displayed when you enter
-;;; Emacs and your appointments list will automatically be created.
-;;; You will then be reminded at 9:20am about your coffee break
-;;; and at 11:50am to go to lunch.
-;;;
-;;; Use describe-function on appt-check for a description of other variables
-;;; that can be used to personalize the notification system.
-;;;
-;;; In order to add or delete items from todays list, use appt-add
-;;; and appt-delete.
-;;;
-;;; Additionally, the appointments list is recreated automatically
-;;; at 12:01am for those who do not logout every day or are programming
-;;; late.
+;;; In order to add or delete items from today's list, without
+;;; changing the diary file, use `appt-add' and `appt-delete'.
;;;
+
;;; Brief internal description - Skip this if you are not interested!
;;;
-;;; The function appt-make-list creates the appointments list which appt-check
-;;; reads. This is all done automatically.
-;;; It is invoked from the function list-diary-entries.
+;;; The function `appt-make-list' creates the appointments list which
+;;; `appt-check' reads.
;;;
;;; You can change the way the appointment window is created/deleted by
-;;; setting the variables
+;;; setting the variables
;;;
;;; appt-disp-window-function
;;; and
;;; appt-delete-window-function
;;;
-;;; For instance, these variables can be set to functions that display
+;;; For instance, these variables could be set to functions that display
;;; appointments in pop-up frames, which are lowered or iconified after
-;;; appt-display-interval minutes.
+;;; `appt-display-interval' minutes.
;;;
;;; Code:
@@ -98,16 +77,19 @@
;; Make sure calendar is loaded when we compile this.
(require 'calendar)
-(provide 'appt)
;;;###autoload
(defcustom appt-issue-message t
"*Non-nil means check for appointments in the diary buffer.
-To be detected, the diary entry must have the time
-as the first thing on a line."
+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." "21.4")
+
;;;###autoload
(defcustom appt-message-warning-time 12
"*Time in minutes before an appointment that the warning begins."
@@ -122,80 +104,157 @@ as the first thing on a line."
;;;###autoload
(defcustom appt-visible t
- "*Non-nil means display appointment message in echo area."
+ "*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 "21.4")
+
;;;###autoload
-(defcustom appt-display-mode-line t
- "*Non-nil means display minutes to appointment and time on the mode line."
+(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 "21.4")
+
+;; TODO - add popup.
+(defcustom appt-display-format 'ignore
+ "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'."
+ :type '(choice
+ (const :tag "Separate window" window)
+ (const :tag "Echo-area" echo)
+ (const :tag "No visible display" nil))
+ :group 'appt
+ :version "21.4")
+
;;;###autoload
-(defcustom appt-msg-window t
- "*Non-nil means display appointment message in another window."
+(defcustom appt-display-mode-line t
+ "*Non-nil means display minutes to appointment and time on the mode line.
+This is in addition to any other display of appointment messages."
:type 'boolean
:group 'appt)
;;;###autoload
(defcustom appt-display-duration 10
- "*The number of seconds an appointment message is displayed."
+ "*The number of seconds an appointment message is displayed.
+Only relevant if reminders are to be displayed in their own window."
:type 'integer
:group 'appt)
;;;###autoload
(defcustom appt-display-diary t
- "*Non-nil means to display the next days diary on the screen.
+ "*Non-nil displays the diary when the appointment list is first initialized.
This will occur at midnight when the appointment list is updated."
:type 'boolean
:group 'appt)
-(defvar appt-time-msg-list nil
- "The list of appointments for today.
-Use `appt-add' and `appt-delete' to add and delete appointments from list.
-The original list is generated from the today's `diary-entries-list'.
-The number before each time/message is the time in minutes from midnight.")
-
-(defconst appt-max-time 1439
- "11:59pm in minutes - number of minutes in a day minus 1.")
-
(defcustom appt-display-interval 3
"*Number of minutes to wait between checking the appointment list."
:type 'integer
:group 'appt)
+(defcustom appt-disp-window-function 'appt-disp-window
+ "Function called to display appointment window.
+Only relevant if reminders are being displayed in a window."
+ :type '(choice (const appt-disp-window)
+ function)
+ :group 'appt)
+
+(defcustom appt-delete-window-function 'appt-delete-window
+ "Function called to remove appointment window and buffer.
+Only relevant if reminders are being displayed in a window."
+ :type '(choice (const appt-delete-window)
+ function)
+ :group 'appt)
+
+
+;;; Internal variables below this point.
+
(defvar appt-buffer-name " *appt-buf*"
"Name of the appointments buffer.")
-(defvar appt-disp-window-function 'appt-disp-window
- "Function called to display appointment window.")
+(defvar appt-time-msg-list nil
+ "The list of appointments for today.
+Use `appt-add' and `appt-delete' to add and delete appointments.
+The original list is generated from today's `diary-entries-list', and
+can be regenerated using the function `appt-check'.
+Each element of the generated list has the form (MINUTES) STRING; where
+MINUTES is the time in minutes of the appointment after midnight, and
+STRING is the description of the appointment.")
-(defvar appt-delete-window-function 'appt-delete-window
- "Function called to remove appointment window and buffer.")
+(defconst appt-max-time 1439
+ "11:59pm in minutes - number of minutes in a day minus 1.")
(defvar appt-mode-string nil
"String being displayed in the mode line saying you have an appointment.
-The actual string includes the amount of time till the appointment.")
+The actual string includes the amount of time till the appointment.
+Only used if `appt-display-mode-line' is non-nil.")
(defvar appt-prev-comp-time nil
- "Time of day (mins since midnight) at which we last checked appointments.")
+ "Time of day (mins since midnight) at which we last checked appointments.
+A nil value forces the diary file to be (re-)checked for appointments.")
(defvar appt-now-displayed nil
"Non-nil when we have started notifying about a appointment that is near.")
-(defvar appt-display-count nil)
+(defvar appt-display-count nil
+ "Internal variable used to count number of consecutive reminders.")
-(defun appt-check ()
- "Check for an appointment and update the mode line.
-Note: the time must be the first thing in the line in the diary
-for a warning to be issued.
+(defvar appt-timer nil
+ "Timer used for diary appointment notifications (`appt-check').
+If this is non-nil, appointment checking is active.")
+
+
+;;; Functions.
+
+(defun appt-display-message (string mins)
+ "Display a reminder about an appointment.
+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 compatability. 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)))
+ (cond ((eq appt-display-format 'window)
+ (funcall appt-disp-window-function
+ (number-to-string mins)
+ (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)))
+ (if appt-audible (beep 1))))
+
+
+(defun appt-check (&optional force)
+ "Check for an appointment and update any reminder display.
+If optional argument FORCE is non-nil, reparse the diary file for
+appointments. Otherwise the diary file is only parsed once per day,
+and when saved.
-The format of the time can be either 24 hour or am/pm.
-Example:
+Note: the time must be the first thing in the line in the diary
+for a warning to be issued. The format of the time can be either
+24 hour or am/pm. For example:
- 02/23/89
- 18:00 Dinner
+ 02/23/89
+ 18:00 Dinner
Thursday
11:45am Lunch meeting.
@@ -203,42 +262,41 @@ Example:
Appointments are checked every `appt-display-interval' minutes.
The following variables control appointment notification:
-`appt-issue-message'
- If t, the diary buffer is checked for appointments.
-
-`appt-message-warning-time'
- Variable used to determine if appointment message
- should be displayed.
+`appt-display-format'
+ Controls the format in which reminders are displayed.
`appt-audible'
- Variable used to determine if appointment is audible.
+ Variable used to determine if reminder is audible.
Default is t.
-`appt-visible'
- Variable used to determine if appointment message should be
- displayed in the mini-buffer. Default is t.
+`appt-message-warning-time'
+ Variable used to determine when appointment message
+ should first be displayed.
+
+`appt-display-mode-line'
+ If non-nil, a generic message giving the time remaining
+ is shown in the mode-line when an appointment is due.
+
+`appt-display-interval'
+ Interval in minutes at which to check for pending appointments.
+
+`appt-display-diary'
+ Display the diary buffer when the appointment list is
+ initialized for the first time in a day.
-`appt-msg-window'
- Variable used to determine if appointment message
- should temporarily appear in another window. Mutually exclusive
- to `appt-visible'.
+The following variables are only relevant if reminders are being
+displayed in a window:
`appt-display-duration'
- The number of seconds an appointment message
- is displayed in another window.
+ The number of seconds an appointment message is displayed.
`appt-disp-window-function'
- Function called to display appointment window. You can customize
- appt.el by setting this variable to a function different from the
- one provided with this package.
+ Function called to display appointment window.
`appt-delete-window-function'
- Function called to remove appointment window and buffer. You can
- customize appt.el by setting this variable to a function different
- from the one provided with this package."
+ Function called to remove appointment window and buffer."
(let* ((min-to-app -1)
- (new-time "")
(prev-appt-mode-string appt-mode-string)
(prev-appt-display-count (or appt-display-count 0))
;; Non-nil means do a full check for pending appointments
@@ -248,7 +306,7 @@ The following variables control appointment notification:
(full-check
(or (not appt-now-displayed)
;; This is true every appt-display-interval minutes.
- (= 0 (mod prev-appt-display-count appt-display-interval))))
+ (zerop (mod prev-appt-display-count appt-display-interval))))
;; Non-nil means only update the interval displayed in the mode line.
(mode-line-only
(and (not full-check) appt-now-displayed)))
@@ -267,19 +325,38 @@ The following variables control appointment notification:
;; At the first check in any given day, update our
;; appointments to today's list.
- (if (or (null appt-prev-comp-time)
- (< cur-comp-time appt-prev-comp-time))
+ (if (or force ; eg initialize, diary save
+ (null appt-prev-comp-time) ; first check
+ (< cur-comp-time appt-prev-comp-time)) ; new day
(condition-case nil
- (progn
- (if (and view-diary-entries-initially appt-display-diary)
- (diary)
- (let ((diary-display-hook 'appt-make-list))
- (diary))))
+ (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-hook 'appt-make-list)
+ (d-buff (find-buffer-visiting
+ (substitute-in-file-name diary-file)))
+ selective)
+ (if d-buff ; diary buffer exists
+ (with-current-buffer d-buff
+ (setq selective selective-display)))
+ (diary)
+ ;; If the diary buffer existed before this command,
+ ;; restore its display state. Otherwise, kill it.
+ (if d-buff
+ ;; Displays the diary buffer.
+ (or selective (show-all-diary-entries))
+ (and
+ (setq d-buff (find-buffer-visiting
+ (substitute-in-file-name diary-file)))
+ (kill-buffer d-buff)))))
(error nil)))
- (setq appt-prev-comp-time cur-comp-time)
- (setq appt-mode-string nil)
- (setq appt-display-count nil)
+ (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,
@@ -317,45 +394,21 @@ The following variables control appointment notification:
(when (and (<= min-to-app appt-message-warning-time)
(>= min-to-app 0))
- (setq appt-now-displayed t)
- (setq appt-display-count
- (1+ prev-appt-display-count))
+ (setq appt-now-displayed t
+ appt-display-count (1+ prev-appt-display-count))
(unless mode-line-only
- (if appt-msg-window
- (progn
- (setq new-time (format-time-string "%a %b %e "
- (current-time)))
- (funcall
- appt-disp-window-function
- (number-to-string min-to-app) new-time
- (car (cdr (car appt-time-msg-list))))
-
- (run-at-time
- (format "%d sec" appt-display-duration)
- nil
- appt-delete-window-function))
- ;;; else
-
- (if appt-visible
- (message "%s"
- (car (cdr (car appt-time-msg-list)))))
-
- (if appt-audible
- (beep 1))))
-
+ (appt-display-message (cadr (car appt-time-msg-list))
+ min-to-app))
(when appt-display-mode-line
(setq appt-mode-string
- (concat " App't in "
- (number-to-string min-to-app)
- " min. ")))
+ (format " App't in %s min." min-to-app)))
;; When an appointment is reached,
;; delete it from the list.
;; Reset the count to 0 in case we display another
;; appointment on the next cycle.
- (if (= min-to-app 0)
- (setq appt-time-msg-list
- (cdr appt-time-msg-list)
+ (if (zerop min-to-app)
+ (setq appt-time-msg-list (cdr appt-time-msg-list)
appt-display-count nil)))))
;; If we have changed the mode line string,
@@ -372,7 +425,9 @@ The following variables control appointment notification:
(defun appt-disp-window (min-to-app new-time appt-msg)
- "Display appointment message APPT-MSG in a separate buffer."
+ "Display appointment message APPT-MSG in a separate buffer.
+The appointment is due in MIN-TO-APP (a string) minutes.
+NEW-TIME is a string giving the date."
(require 'electric)
;; Make sure we're not in the minibuffer
@@ -384,9 +439,8 @@ The following variables control appointment notification:
(if (display-multi-frame-p)
(select-frame (other-frame 1)))))
- (let* ((this-buffer (current-buffer))
- (this-window (selected-window))
- (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
+ (let ((this-window (selected-window))
+ (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
(if (cdr (assq 'unsplittable (frame-parameters)))
;; In an unsplittable frame, use something somewhere else.
@@ -405,9 +459,7 @@ The following variables control appointment notification:
(shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
(set-buffer-modified-p nil)
(raise-frame (selected-frame))
- (select-window this-window)
- (if appt-audible
- (beep 1))))
+ (select-window this-window)))
(defun appt-delete-window ()
"Function called to undisplay appointment messages.
@@ -437,10 +489,9 @@ Usually just deletes the appointment buffer."
The time should be in either 24 hour format or am/pm format."
(interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
- (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
- nil
+ (unless (string-match "[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?"
+ new-appt-time)
(error "Unacceptable time-string"))
-
(let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
(appt-time (list (appt-convert-time new-appt-time)))
(time-msg (cons appt-time (list appt-time-string))))
@@ -451,7 +502,7 @@ The time should be in either 24 hour format or am/pm format."
(defun appt-delete ()
"Delete an appointment from the list of appointments."
(interactive)
- (let* ((tmp-msg-list appt-time-msg-list))
+ (let ((tmp-msg-list appt-time-msg-list))
(while tmp-msg-list
(let* ((element (car tmp-msg-list))
(prompt-string (concat "Delete "
@@ -475,15 +526,11 @@ The time should be in either 24 hour format or am/pm format."
(defvar diary-entries-list))
;;;###autoload
(defun appt-make-list ()
- "Create the appointments list from todays diary buffer.
+ "Create the appointments list from today's diary buffer.
The time must be at the beginning of a line for it to be
-put in the appointments list.
- 02/23/89
- 12:00pm lunch
- Wednesday
- 10:00am group meeting
-We assume that the variables DATE and NUMBER
-hold the arguments that `list-diary-entries' received.
+put in the appointments list (see examples in documentation of
+the function `appt-check'). We assume that the variables DATE and
+NUMBER hold the arguments that `list-diary-entries' received.
They specify the range of dates that the diary is being processed for."
;; We have something to do if the range of dates that the diary is
@@ -519,7 +566,7 @@ They specify the range of dates that the diary is being processed for."
(calendar-current-date) (car (car entry-list))))
(let ((time-string (cadr (car entry-list))))
(while (string-match
- "\\([0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?\\).*"
+ "\\([0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?\\).*"
time-string)
(let* ((beg (match-beginning 0))
;; Get just the time for this appointment.
@@ -527,7 +574,7 @@ They specify the range of dates that the diary is being processed for."
;; Find the end of this appointment
;; (the start of the next).
(end (string-match
- "^[ \t]*[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
+ "^[ \t]*[0-9]?[0-9][:.][0-9][0-9]\\(am\\|pm\\)?"
time-string
(match-end 0)))
;; Get the whole string for this appointment.
@@ -556,47 +603,33 @@ They specify the range of dates that the diary is being processed for."
(cur-hour (nth 2 now))
(cur-min (nth 1 now))
(cur-comp-time (+ (* cur-hour 60) cur-min))
- (appt-comp-time (car (car (car appt-time-msg-list)))))
+ (appt-comp-time (car (caar 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 (car (car (car appt-time-msg-list))))))))))
+ (setq appt-comp-time (car (caar appt-time-msg-list)))))))))
(defun appt-sort-list (appt-list)
- "Simple sort to put the appointments list APPT-LIST in order.
-Scan the list for the smallest element left in the list.
-Append the smallest element left into the new list, and remove
-it from the original list."
- (let ((order-list nil))
- (while appt-list
- (let* ((element (car appt-list))
- (element-time (car (car element)))
- (tmp-list (cdr appt-list)))
- (while tmp-list
- (if (< element-time (car (car (car tmp-list))))
- nil
- (setq element (car tmp-list))
- (setq element-time (car (car element))))
- (setq tmp-list (cdr tmp-list)))
- (setq order-list (nconc order-list (list element)))
- (setq appt-list (delq element appt-list))))
- order-list))
+ "Sort an appointment list, putting earlier items at the front.
+APPT-LIST is a list of the same format as `appt-time-msg-list'."
+(sort appt-list (lambda (e1 e2) (< (caar e1) (caar e2)))))
(defun appt-convert-time (time2conv)
- "Convert hour:min[am/pm] format to minutes from midnight."
-
+ "Convert hour:min[am/pm] format to minutes from midnight.
+A period (.) can be used instead of a colon (:) to separate the
+hour and minute parts."
(let ((conv-time 0)
(hr 0)
(min 0))
- (string-match ":\\([0-9][0-9]\\)" time2conv)
+ (string-match "[:.]\\([0-9][0-9]\\)" time2conv)
(setq min (string-to-int
(match-string 1 time2conv)))
- (string-match "[0-9]?[0-9]:" time2conv)
+ (string-match "[0-9]?[0-9][:.]" time2conv)
(setq hr (string-to-int
(match-string 0 time2conv)))
@@ -614,15 +647,45 @@ it from the original list."
(setq conv-time (+ (* hr 60) min))
conv-time))
-(defvar appt-timer nil
- "Timer used for diary appointment notifications (`appt-check').")
-(unless appt-timer
- (setq appt-timer (run-at-time t 60 'appt-check)))
+(defun appt-update-list ()
+ "If the current buffer is visiting the diary, update appointments.
+This function is intended for use with `write-file-functions'."
+ (and (string-equal buffer-file-name (expand-file-name diary-file))
+ appt-timer
+ (let ((appt-display-diary nil))
+ (appt-check t)))
+ nil)
+
+
+;;;###autoload
+(defun appt-activate (&optional arg)
+"Toggle checking of appointments.
+With optional numeric argument ARG, turn appointment checking on if
+ARG is positive, otherwise off."
+ (interactive "P")
+ (let ((appt-active appt-timer))
+ (setq appt-active (if arg (> (prefix-numeric-value arg) 0)
+ (not appt-active)))
+ (remove-hook 'write-file-functions 'appt-update-list)
+ (or global-mode-string (setq global-mode-string '("")))
+ (delq 'appt-mode-string global-mode-string)
+ (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))))
+
+
+;; This is needed for backwards compatibility. Feh.
+(appt-activate 1)
+
-(or global-mode-string (setq global-mode-string '("")))
-(or (memq 'appt-mode-string global-mode-string)
- (setq global-mode-string
- (append global-mode-string '(appt-mode-string))))
+(provide 'appt)
+;;; arch-tag: bf5791c4-8921-499e-a26f-772b1788d347
;;; appt.el ends here
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
index 3749b4c6287..6e506b93f7d 100644
--- a/lisp/calendar/cal-china.el
+++ b/lisp/calendar/cal-china.el
@@ -501,4 +501,5 @@ Echo Chinese date unless NOECHO is t."
(provide 'cal-china)
+;;; arch-tag: 7e5b7e0d-676c-47e3-8696-93e7ea0ab644
;;; cal-china.el ends here
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
index 13c731f98ff..df1201a23c4 100644
--- a/lisp/calendar/cal-coptic.el
+++ b/lisp/calendar/cal-coptic.el
@@ -151,14 +151,14 @@ Echo Coptic date unless NOECHO is t."
(calendar-coptic-from-absolute
(calendar-absolute-from-gregorian today))))))
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
(format "%s calendar month name: " coptic-name)
(mapcar 'list
(append coptic-calendar-month-name-array nil))
nil t)
(calendar-make-alist coptic-calendar-month-name-array
- 1))))
+ 1) t)))
(last (coptic-calendar-last-day-of-month month year))
(day (calendar-read
(format "%s calendar day (1-%d): " coptic-name last)
@@ -234,4 +234,5 @@ Echo Ethiopic date unless NOECHO is t."
(provide 'cal-coptic)
+;;; arch-tag: 72d49161-25df-4072-9312-b182cdca7627
;;; cal-coptic.el ends here
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 2c6c2a30335..68943b77b28 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -394,4 +394,5 @@ Conversion to daylight savings time is done according to
(provide 'cal-dst)
+;;; arch-tag: a141d204-213c-4ca5-bdc6-f9df3aa92aad
;;; cal-dst.el ends here
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
index c21375e28cd..d988b008f53 100644
--- a/lisp/calendar/cal-french.el
+++ b/lisp/calendar/cal-french.el
@@ -228,12 +228,12 @@ Echo French Revolutionary date unless NOECHO is t."
(concat "Jour " x))
special-days))))))))
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
"Mois ou Sansculottide: "
month-list
nil t)
- (calendar-make-alist month-list 1 'car))))
+ (calendar-make-alist month-list 1 'car) t)))
(day (if (> month 12)
(- month 12)
(calendar-read
@@ -254,4 +254,5 @@ Echo French Revolutionary date unless NOECHO is t."
(provide 'cal-french)
+;;; 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 46d593bae64..776868159be 100644
--- a/lisp/calendar/cal-hebrew.el
+++ b/lisp/calendar/cal-hebrew.el
@@ -236,17 +236,17 @@ Driven by the variable `calendar-date-display-form'."
calendar-hebrew-month-name-array-leap-year
calendar-hebrew-month-name-array-common-year))
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
"Hebrew calendar month name: "
(mapcar 'list (append month-array nil))
(if (= year 3761)
'(lambda (x)
(let ((m (cdr
- (assoc-ignore-case
+ (assoc-string
(car x)
- (calendar-make-alist
- month-array)))))
+ (calendar-make-alist month-array)
+ t))))
(< 0
(calendar-absolute-from-hebrew
(list m
@@ -254,7 +254,7 @@ Driven by the variable `calendar-date-display-form'."
m year)
year))))))
t)
- (calendar-make-alist month-array 1))))
+ (calendar-make-alist month-array 1) t)))
(last (hebrew-calendar-last-day-of-month month year))
(first (if (and (= year 3761) (= month 10))
18 1))
@@ -753,18 +753,18 @@ is provided for use as part of the nongregorian-diary-marking-hook."
(string-to-int y-str)))))
(if dd-name
(mark-calendar-days-named
- (cdr (assoc-ignore-case dd-name
+ (cdr (assoc-string dd-name
(calendar-make-alist
calendar-day-name-array
- 0 nil calendar-day-abbrev-array))))
+ 0 nil calendar-day-abbrev-array) t)))
(if mm-name
(setq mm
(if (string-equal mm-name "*") 0
(cdr
- (assoc-ignore-case
+ (assoc-string
mm-name
(calendar-make-alist
- calendar-hebrew-month-name-array-leap-year))))))
+ calendar-hebrew-month-name-array-leap-year) t)))))
(mark-hebrew-calendar-date-pattern mm dd yy)))))
(setq d (cdr d)))))
@@ -839,12 +839,12 @@ from the cursor position."
(int-to-string (extract-calendar-year today))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
"Month of death (name): "
(mapcar 'list (append month-array nil))
nil t)
- (calendar-make-alist month-array 1))))
+ (calendar-make-alist month-array 1) t)))
(last (calendar-last-day-of-month month year))
(day (calendar-read
(format "Day of death (1-%d): " last)
@@ -1205,4 +1205,5 @@ have 30 days), and has Passover start on Tuesday.")
(provide 'cal-hebrew)
+;;; arch-tag: aaab6718-7712-42ac-a32d-28fe1f944f3c
;;; cal-hebrew.el ends here
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
index c4eb50b4773..8dcf5c29b1f 100644
--- a/lisp/calendar/cal-islam.el
+++ b/lisp/calendar/cal-islam.el
@@ -154,12 +154,12 @@ Driven by the variable `calendar-date-display-form'."
(calendar-absolute-from-gregorian today))))))
(month-array calendar-islamic-month-name-array)
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
"Islamic calendar month name: "
(mapcar 'list (append month-array nil))
nil t)
- (calendar-make-alist month-array 1))))
+ (calendar-make-alist month-array 1) t)))
(last (islamic-calendar-last-day-of-month month year))
(day (calendar-read
(format "Islamic calendar day (1-%d): " last)
@@ -372,16 +372,16 @@ provided for use as part of the nongregorian-diary-marking-hook."
(string-to-int y-str)))))
(if dd-name
(mark-calendar-days-named
- (cdr (assoc-ignore-case dd-name
+ (cdr (assoc-string dd-name
(calendar-make-alist
calendar-day-name-array
- 0 nil calendar-day-abbrev-array))))
+ 0 nil calendar-day-abbrev-array) t)))
(if mm-name
(setq mm (if (string-equal mm-name "*") 0
- (cdr (assoc-ignore-case
+ (cdr (assoc-string
mm-name
(calendar-make-alist
- calendar-islamic-month-name-array))))))
+ calendar-islamic-month-name-array) t)))))
(mark-islamic-calendar-date-pattern mm dd yy)))))
(setq d (cdr d)))))
@@ -497,4 +497,5 @@ Prefix arg will make the entry nonmarking."
(provide 'cal-islam)
+;;; arch-tag: a951b6c1-6f47-48d5-bac3-1b505cd719f7
;;; cal-islam.el ends here
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
index 97c9cbeee62..0d9ad45c7d6 100644
--- a/lisp/calendar/cal-iso.el
+++ b/lisp/calendar/cal-iso.el
@@ -127,4 +127,5 @@ Defaults to today's date if DATE is not given."
(provide 'cal-iso)
+;;; arch-tag: 3c0154cc-d30f-4981-9f60-42bdf7a468f6
;;; cal-iso.el ends here
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 95482cff8a2..67fb8515b24 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -115,12 +115,12 @@ Driven by the variable `calendar-date-display-form'."
today))))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
"Julian calendar month name: "
(mapcar 'list (append month-array nil))
nil t)
- (calendar-make-alist month-array 1))))
+ (calendar-make-alist month-array 1) t)))
(last
(if (and (zerop (% year 4)) (= month 2))
29
@@ -210,4 +210,5 @@ Echo astronomical (Julian) day number unless NOECHO is t."
(provide 'cal-julian)
+;;; arch-tag: 0520acdd-1c60-4188-9aa8-9b8c24d856ae
;;; cal-julian.el ends here
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
index b19d3fac014..c2c3e027c4b 100644
--- a/lisp/calendar/cal-mayan.el
+++ b/lisp/calendar/cal-mayan.el
@@ -256,11 +256,11 @@ Returns nil if such a tzolkin-haab combination is impossible."
(haab-month-list (append calendar-mayan-haab-month-name-array
(and (< haab-day 5) '("Uayeb"))))
(haab-month (cdr
- (assoc-ignore-case
+ (assoc-string
(completing-read "Haab uinal: "
(mapcar 'list haab-month-list)
nil t)
- (calendar-make-alist haab-month-list 1)))))
+ (calendar-make-alist haab-month-list 1) t))))
(cons haab-day haab-month)))
(defun calendar-read-mayan-tzolkin-date ()
@@ -271,11 +271,11 @@ Returns nil if such a tzolkin-haab combination is impossible."
'(lambda (x) (and (> x 0) (< x 14)))))
(tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
(tzolkin-name (cdr
- (assoc-ignore-case
+ (assoc-string
(completing-read "Tzolkin uinal: "
(mapcar 'list tzolkin-name-list)
nil t)
- (calendar-make-alist tzolkin-name-list 1)))))
+ (calendar-make-alist tzolkin-name-list 1) t))))
(cons tzolkin-count tzolkin-name)))
(defun calendar-next-calendar-round-date
@@ -376,4 +376,5 @@ Defaults to today's date if DATE is not given."
(provide 'cal-mayan)
+;;; arch-tag: 54f35144-cd0f-4873-935a-a60129de07df
;;; cal-mayan.el ends here
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
index 3b973586ca0..3c6cc78eb7b 100644
--- a/lisp/calendar/cal-menu.el
+++ b/lisp/calendar/cal-menu.el
@@ -117,6 +117,8 @@
'("Astronomical Date" . calendar-goto-astro-day-number))
(define-key calendar-mode-map [menu-bar goto iso]
'("ISO Date" . calendar-goto-iso-date))
+(define-key calendar-mode-map [menu-bar goto day-of-year]
+ '("Day of Year" . calendar-goto-day-of-year))
(define-key calendar-mode-map [menu-bar goto gregorian]
'("Other Date" . calendar-goto-date))
(define-key calendar-mode-map [menu-bar goto end-of-year]
@@ -164,6 +166,15 @@
(define-key calendar-mode-map [menu-bar scroll fwd-1]
'("Forward 1 Month" . scroll-calendar-left))
+(defun calendar-flatten (list)
+ "Flatten LIST eliminating sublists structure; result is a list of atoms.
+This is the same as the preorder list of leaves in a rooted forest."
+ (if (atom list)
+ (list list)
+ (if (cdr list)
+ (append (calendar-flatten (car list)) (calendar-flatten (cdr list)))
+ (calendar-flatten (car list)))))
+
(defun cal-menu-x-popup-menu (position menu)
"Like `x-popup-menu', but prints an error message if popup menus are
not available."
@@ -307,53 +318,48 @@ ERROR is t, otherwise just returns nil."
(if l l '("None")))))))
(and selection (call-interactively selection))))
-(defun calendar-mouse-view-diary-entries ()
- "Pop up menu of diary entries for mouse selected date."
+(defun calendar-mouse-view-diary-entries (&optional date diary)
+ "Pop up menu of diary entries for mouse-selected date.
+Use optional DATE and alternative file DIARY.
+
+Any holidays are shown if `holidays-in-diary-buffer' is t."
(interactive)
- (let* ((date (calendar-event-to-date))
- (l (mapcar '(lambda (x) (list (car (cdr x))))
- (let ((diary-list-include-blanks nil)
- (diary-display-hook 'ignore))
- (list-diary-entries date 1))))
+ (let* ((date (if date date (calendar-event-to-date)))
+ (diary-file (if diary diary diary-file))
+ (diary-list-include-blanks nil)
+ (diary-display-hook 'ignore)
+ (diary-entries
+ (mapcar '(lambda (x) (split-string (car (cdr x)) "\^M\\|\n"))
+ (list-diary-entries date 1)))
+ (holidays (if holidays-in-diary-buffer
+ (mapcar '(lambda (x) (list x))
+ (check-calendar-holidays date))))
+ (title (concat "Diary entries "
+ (if diary (format "from %s " diary) "")
+ "for "
+ (calendar-date-string date)))
(selection
(cal-menu-x-popup-menu
event
- (list
- (format "Diary entries for %s" (calendar-date-string date))
- (append
- (list (format "Diary entries for %s" (calendar-date-string date)))
- (if l l '("None")))))))
+ (list title
+ (append
+ (list title)
+ (if holidays
+ (mapcar '(lambda (x) (list (concat " " (car x))))
+ holidays))
+ (if holidays
+ (list "--shadow-etched-in" "--shadow-etched-in"))
+ (if diary-entries
+ (mapcar 'list (calendar-flatten diary-entries))
+ '("None")))))))
(and selection (call-interactively selection))))
(defun calendar-mouse-view-other-diary-entries ()
"Pop up menu of diary entries from alternative file on mouse-selected date."
(interactive)
- (let* ((date (calendar-event-to-date))
- (diary-list-include-blanks nil)
- (diary-display-hook 'ignore)
- (diary-file (read-file-name
- "Enter diary file name: "
- default-directory nil t))
- ; The following doesn't really do the right thing. The problem is
- ; that a newline in the diary entry does not give a newline in a
- ; pop-up menu; for that you need a separate list item. When the (car
- ; (cdr x)) contains newlines, the item should be split into a list of
- ; items. Too minor and messy to worry about.
- (l (mapcar '(lambda (x) (list (car (cdr x))))
- (list-diary-entries date 1)))
- (selection
- (cal-menu-x-popup-menu
- event
- (list
- (format "Diary entries from %s for %s"
- diary-file
- (calendar-date-string date))
- (append
- (list (format "Diary entries from %s for %s"
- diary-file
- (calendar-date-string date)))
- (if l l '("None")))))))
- (and selection (call-interactively selection))))
+ (calendar-mouse-view-diary-entries
+ (calendar-event-to-date)
+ (read-file-name "Enter diary file name: " default-directory nil t)))
(defun calendar-mouse-insert-diary-entry ()
"Insert diary entry for mouse-selected date."
@@ -612,4 +618,5 @@ The output is in landscape format, one month to a page."
(provide 'cal-menu)
+;;; arch-tag: aa81cf73-ce89-48a4-97ec-9ef861e87fe9
;;; cal-menu.el ends here
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
index b711e226a0e..045c11ba1d7 100644
--- a/lisp/calendar/cal-move.el
+++ b/lisp/calendar/cal-move.el
@@ -327,6 +327,28 @@ Moves forward if ARG is negative."
(calendar-cursor-to-visible-date date)
(run-hooks 'calendar-move-hook))
+(defun calendar-goto-day-of-year (year day &optional noecho)
+ "Move cursor to YEAR, DAY number; echo DAY/YEAR unless NOECHO is t.
+Negative DAY counts backward from end of year."
+ (interactive
+ (let* ((year (calendar-read
+ "Year (>0): "
+ (lambda (x) (> x 0))
+ (int-to-string (extract-calendar-year
+ (calendar-current-date)))))
+ (last (if (calendar-leap-year-p year) 366 365))
+ (day (calendar-read
+ (format "Day number (+/- 1-%d): " last)
+ '(lambda (x) (and (<= 1 (abs x)) (<= (abs x) last))))))
+ (list year day)))
+ (calendar-goto-date
+ (calendar-gregorian-from-absolute
+ (if (< 0 day)
+ (+ -1 day (calendar-absolute-from-gregorian (list 1 1 year)))
+ (+ 1 day (calendar-absolute-from-gregorian (list 12 31 year))))))
+ (or noecho (calendar-print-day-of-year)))
+
(provide 'cal-move)
+;;; arch-tag: d0883c46-7e16-4914-8ff8-8f67e699b781
;;; cal-move.el ends here
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
index c9b8a2af07d..ff09c14b47d 100644
--- a/lisp/calendar/cal-persia.el
+++ b/lisp/calendar/cal-persia.el
@@ -206,4 +206,5 @@ Echo Persian date unless NOECHO is t."
(provide 'cal-persia)
+;;; arch-tag: 2832383c-e4b4-4dc2-8ee9-cfbdd53e5e2d
;;; cal-persia.el ends here
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 5af65a380bb..ac6fad4ed67 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -1781,4 +1781,5 @@ without erasing current contents."
(provide 'cal-tex)
+;;; arch-tag: ca8168a4-5a00-4508-a565-17e3bccce6d0
;;; cal-tex.el ends here
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
index 416230ef52d..97fbb72af61 100644
--- a/lisp/calendar/cal-x.el
+++ b/lisp/calendar/cal-x.el
@@ -69,7 +69,9 @@ Location and color should be set in .Xdefaults.")
Can be used to change frame parameters, such as font, color, location, etc.")
(defun calendar-one-frame-setup (&optional arg)
- "Start calendar and display it in a dedicated frame together with the diary."
+ "Start calendar and display it in a dedicated frame together with the diary.
+This function requires a display capable of multiple frames, else
+`calendar-basic-setup' is used instead."
(if (not (display-multi-frame-p))
(calendar-basic-setup arg)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
@@ -97,7 +99,9 @@ Can be used to change frame parameters, such as font, color, location, etc.")
'diary))))))
(defun calendar-only-one-frame-setup (&optional arg)
- "Start calendar and display it in a dedicated frame."
+ "Start calendar and display it in a dedicated frame.
+This function requires a display capable of multiple frames, else
+`calendar-basic-setup' is used instead."
(if (not (display-multi-frame-p))
(calendar-basic-setup arg)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
@@ -116,7 +120,9 @@ Can be used to change frame parameters, such as font, color, location, etc.")
(set-window-dedicated-p (selected-window) 'calendar))))))
(defun calendar-two-frame-setup (&optional arg)
- "Start calendar and diary in separate, dedicated frames."
+ "Start calendar and diary in separate, dedicated frames.
+This function requires a display capable of multiple frames, else
+`calendar-basic-setup' is used instead."
(if (not (display-multi-frame-p))
(calendar-basic-setup arg)
(if (frame-live-p calendar-frame) (delete-frame calendar-frame))
@@ -162,4 +168,5 @@ Can be used to change frame parameters, such as font, color, location, etc.")
(provide 'cal-x)
+;;; arch-tag: c6dbddca-ae84-442d-87fc-244b76e38e17
;;; cal-x.el ends here
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 88d389072c2..0d38563e637 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1,7 +1,7 @@
;;; calendar.el --- calendar functions
;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1997,
-;; 2000, 2001, 2003 Free Software Foundation, Inc.
+;; 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Keywords: calendar
@@ -154,10 +154,11 @@ the screen."
;;;###autoload
(defcustom view-diary-entries-initially nil
- "*Non-nil means display current date's diary entries on entry.
+ "*Non-nil means display current date's diary entries on entry to calendar.
The diary is displayed in another window when the calendar is first displayed,
if the current date is visible. The number of days of diary entries displayed
-is governed by the variable `number-of-diary-entries'."
+is governed by the variable `number-of-diary-entries'. This variable can
+be overridden by the value of `calendar-setup'."
:type 'boolean
:group 'diary)
@@ -573,7 +574,10 @@ are
Names can be capitalized or not, written in full (as specified by the
variable `calendar-day-name-array'), or abbreviated (as specified by
-`calendar-day-abbrev-array') with or without a period."
+`calendar-day-abbrev-array') with or without a period. To take effect,
+this variable should be set before the calendar package and its associates
+are loaded. Otherwise, use one of the functions `european-calendar' or
+`american-calendar' to force the appropriate update."
:type 'boolean
:group 'diary)
@@ -753,6 +757,7 @@ in your `.emacs' file to cause the fancy diary buffer to be displayed with
diary entries from various included files, each day's entries sorted into
lexicographic order."
:type 'hook
+ :options '(include-other-diary-files sort-diary-entries)
:group 'diary)
;;;###autoload
@@ -785,6 +790,7 @@ diary buffer will not show days for which there are no diary entries, even
if that day is a holiday; if you want such days to be shown in the fancy
diary buffer, set the variable `diary-list-include-blanks' to t."
:type 'hook
+ :options '(fancy-diary-display)
:group 'diary)
;;;###autoload
@@ -795,6 +801,7 @@ relevant entries. You can use either or both of `list-hebrew-diary-entries'
and `list-islamic-diary-entries'. The documentation for these functions
describes the style of such diary entries."
:type 'hook
+ :options '(list-hebrew-diary-entries list-islamic-diary-entries)
:group 'diary)
;;;###autoload
@@ -812,6 +819,7 @@ variable `diary-include-string'. When you use `mark-included-diary-files' as
part of the mark-diary-entries-hook, you will probably also want to use the
function `include-other-diary-files' as part of `list-diary-entries-hook'."
:type 'hook
+ :options '(mark-included-diary-files)
:group 'diary)
;;;###autoload
@@ -822,6 +830,7 @@ relevant entries. You can use either or both of `mark-hebrew-diary-entries'
and `mark-islamic-diary-entries'. The documentation for these functions
describes the style of such diary entries."
:type 'hook
+ :options '(mark-hebrew-diary-entries mark-islamic-diary-entries)
:group 'diary)
;;;###autoload
@@ -1155,7 +1164,7 @@ example, to include American presidential elections, which occur on the first
Tuesday after the first Monday in November of years divisible by 4, add
(holiday-sexp
- (if (zerop (% year 4))
+ '(if (zerop (% year 4))
(calendar-gregorian-from-absolute
(1+ (calendar-dayname-on-or-before
1 (+ 6 (calendar-absolute-from-gregorian
@@ -1201,11 +1210,16 @@ with descriptive strings such as
"Name of the buffer used for the lunar phases.")
(defmacro increment-calendar-month (mon yr n)
- "Move the variables MON and YR to the month and year by N months.
-Forward if N is positive or backward if N is negative."
- `(let ((macro-y (+ (* ,yr 12) ,mon -1 ,n)))
- (setq ,mon (1+ (% macro-y 12)))
- (setq ,yr (/ macro-y 12))))
+ "Increment the variables MON and YR by N months.
+Forward if N is positive or backward if N is negative.
+A negative YR is interpreted as BC; -1 being 1 BC, and so on."
+ `(let (macro-y)
+ (if (< ,yr 0) (setq ,yr (1+ ,yr))) ; -1 BC -> 0 AD, etc
+ (setq macro-y (+ (* ,yr 12) ,mon -1 ,n)
+ ,mon (1+ (mod macro-y 12))
+ ,yr (/ macro-y 12))
+ (and (< macro-y 0) (> ,mon 1) (setq ,yr (1- ,yr)))
+ (if (< ,yr 1) (setq ,yr (1- ,yr))))) ; 0 AD -> -1 BC, etc
(defmacro calendar-for-loop (var from init to final do &rest body)
"Execute a for loop."
@@ -1265,7 +1279,10 @@ Forward if N is positive or backward if N is negative."
(car (cdr (cdr date))))
(defsubst calendar-leap-year-p (year)
- "Return t if YEAR is a Gregorian leap year."
+ "Return t if YEAR is a Gregorian leap year.
+A negative year is interpreted as BC; -1 being 1 BC, and so on."
+ ;; 1 BC = 0 AD, 2 BC acts like 1 AD, etc.
+ (if (< year 0) (setq year (1- (abs year))))
(and (zerop (% year 4))
(or (not (zerop (% year 100)))
(zerop (% year 400)))))
@@ -1305,13 +1322,30 @@ while (calendar-day-number '(12 31 1980)) returns 366."
(defsubst calendar-absolute-from-gregorian (date)
"The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
-The Gregorian date Sunday, December 31, 1 BC is imaginary."
- (let ((prior-years (1- (extract-calendar-year date))))
- (+ (calendar-day-number date);; Days this year
- (* 365 prior-years);; + Days in prior years
- (/ prior-years 4);; + Julian leap years
- (- (/ prior-years 100));; - century years
- (/ prior-years 400))));; + Gregorian leap years
+The Gregorian date Sunday, December 31, 1 BC is imaginary.
+DATE is a list of the form (month day year). A negative year is
+interpreted as BC; -1 being 1 BC, and so on. Dates before 12/31/1 BC
+return negative results."
+ (let ((year (extract-calendar-year date))
+ offset-years)
+ (cond ((= year 0)
+ (error "There was no year zero"))
+ ((> year 0)
+ (setq offset-years (1- year))
+ (+ (calendar-day-number date) ; Days this year
+ (* 365 offset-years) ; + Days in prior years
+ (/ offset-years 4) ; + Julian leap years
+ (- (/ offset-years 100)) ; - century years
+ (/ offset-years 400))) ; + Gregorian leap years
+ (t
+ ;; Years between date and 1 BC, excluding 1 BC (1 for 2 BC, etc).
+ (setq offset-years (abs (1+ year)))
+ (- (calendar-day-number date)
+ (* 365 offset-years)
+ (/ offset-years 4)
+ (- (/ offset-years 100))
+ (/ offset-years 400)
+ (calendar-day-number '(12 31 -1))))))) ; days in year 1 BC
(autoload 'calendar-goto-today "cal-move"
"Reposition the calendar window so the current date is visible."
@@ -1401,6 +1435,10 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
"Move cursor to DATE."
t)
+(autoload 'calendar-goto-day-of-year "cal-move"
+ "Move cursor to day of year."
+ t)
+
(autoload 'calendar-only-one-frame-setup "cal-x"
"Start calendar and display it in a dedicated frame.")
@@ -1411,12 +1449,19 @@ The Gregorian date Sunday, December 31, 1 BC is imaginary."
"Start calendar and diary in separate, dedicated frames.")
;;;###autoload
-(defvar calendar-setup nil
- "The frame set up of the calendar.
-The choices are `one-frame' (calendar and diary together in one separate,
-dedicated frame), `two-frames' (calendar and diary in separate, dedicated
-frames), `calendar-only' (calendar in a separate, dedicated frame); with
-any other value the current frame is used.")
+(defcustom calendar-setup nil
+ "The frame setup of the calendar.
+The choices are: `one-frame' (calendar and diary together in one separate,
+dedicated frame); `two-frames' (calendar and diary in separate, dedicated
+frames); `calendar-only' (calendar in a separate, dedicated frame); with
+any other value the current frame is used. Using any of the first
+three options overrides the value of `view-diary-entries-initially'."
+ :type '(choice
+ (const :tag "calendar and diary in separate frame" one-frame)
+ (const :tag "calendar and diary each in own frame" two-frames)
+ (const :tag "calendar in separate frame" calendar-only)
+ (const :tag "use current frame" nil))
+ :group 'calendar)
;;;###autoload
(defun calendar (&optional arg)
@@ -1870,6 +1915,7 @@ Or, for optional MON, YR."
font-lock-mode)
(font-lock-fontify-buffer))
(and mark-holidays-in-calendar
+;;; (calendar-date-is-legal-p today) ; useful for BC dates
(mark-calendar-holidays)
(sit-for 0))
(unwind-protect
@@ -1880,10 +1926,14 @@ Or, for optional MON, YR."
(defun generate-calendar (month year)
"Generate a three-month Gregorian calendar centered around MONTH, YEAR."
+;;; A negative YEAR is interpreted as BC; -1 being 1 BC, and so on.
+;;; Note that while calendars for years BC could be displayed as it
+;;; stands, almost all other calendar functions (eg holidays) would
+;;; at best have unpredictable results for such dates.
(if (< (+ month (* 12 (1- year))) 2)
(error "Months before February, 1 AD are not available"))
- (setq displayed-month month)
- (setq displayed-year year)
+ (setq displayed-month month
+ displayed-year year)
(erase-buffer)
(increment-calendar-month month year -1)
(calendar-for-loop i from 0 to 2 do
@@ -2011,6 +2061,7 @@ the inserted text. Value is always t."
(define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
(define-key calendar-mode-map "\e=" 'calendar-count-days-region)
(define-key calendar-mode-map "gd" 'calendar-goto-date)
+ (define-key calendar-mode-map "gD" 'calendar-goto-day-of-year)
(define-key calendar-mode-map "gj" 'calendar-goto-julian-date)
(define-key calendar-mode-map "ga" 'calendar-goto-astro-day-number)
(define-key calendar-mode-map "gh" 'calendar-goto-hebrew-date)
@@ -2385,7 +2436,8 @@ ERROR is t, otherwise just returns nil."
(defun calendar-gregorian-from-absolute (date)
"Compute the list (month day year) corresponding to the absolute DATE.
The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
+Gregorian date Sunday, December 31, 1 BC. This function does not
+handle dates in years BC."
;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
;; Three Historical Calendars'' by E. M. Reingold, N. Dershowitz, and S. M.
;; Clamen, Software--Practice and Experience, Volume 23, Number 4
@@ -2496,12 +2548,12 @@ If optional NODAY is t, does not ask for day, but just returns
(calendar-current-date)))))
(month-array calendar-month-name-array)
(completion-ignore-case t)
- (month (cdr (assoc-ignore-case
+ (month (cdr (assoc-string
(completing-read
"Month name: "
(mapcar 'list (append month-array nil))
nil t)
- (calendar-make-alist month-array 1))))
+ (calendar-make-alist month-array 1) t)))
(last (calendar-last-day-of-month month year)))
(if noday
(if (eq noday t)
@@ -2513,7 +2565,11 @@ If optional NODAY is t, does not ask for day, but just returns
year))))
(defun calendar-interval (mon1 yr1 mon2 yr2)
- "The number of months difference between MON1, YR1 and MON2, YR2."
+ "The number of months difference between MON1, YR1 and MON2, YR2.
+The result is positive if the second date is later than the first.
+Negative years are interpreted as years BC; -1 being 1 BC, and so on."
+ (if (< yr1 0) (setq yr1 (1+ yr1))) ; -1 BC -> 0 AD, etc
+ (if (< yr2 0) (setq yr2 (1+ yr2)))
(+ (* 12 (- yr2 yr1))
(- mon2 mon1)))
@@ -2564,10 +2620,12 @@ of full names. The return value is the ABBREV array, with any nil
elements replaced by the first three characters taken from the
corresponding element of FULL. If optional argument PERIOD is non-nil,
each element returned has a final `.' character."
- (let (elem array)
+ (let (elem array name)
(dotimes (i (length full))
- (setq elem (or (aref abbrev i)
- (substring (aref full i) 0 calendar-abbrev-length))
+ (setq name (aref full i)
+ elem (or (aref abbrev i)
+ (substring name 0
+ (min calendar-abbrev-length (length name))))
elem (format "%s%s" elem (if period "." ""))
array (append array (list elem))))
(vconcat array)))
@@ -2615,7 +2673,7 @@ If FILTER is provided, apply it to each key in the alist."
(aseqp (if abbrevs (calendar-abbrev-construct abbrevs sequence
'period)))
alist elem)
- (dotimes (i (1- (length sequence)) (reverse alist))
+ (dotimes (i (length sequence) (reverse alist))
(setq index (+ i offset)
elem (elt sequence i)
alist
@@ -2642,8 +2700,10 @@ argument ABBREV is non-nil, in which case
(1- month)))
(defun calendar-day-of-week (date)
- "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
- (% (calendar-absolute-from-gregorian date) 7))
+ "Return the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc.
+DATE is a list of the form (month day year). A negative year is
+interpreted as BC; -1 being 1 BC, and so on."
+ (mod (calendar-absolute-from-gregorian date) 7))
(defun calendar-unmark ()
"Delete all diary/holiday marks/highlighting from the calendar."
@@ -2666,6 +2726,9 @@ argument ABBREV is non-nil, in which case
(year (extract-calendar-year date)))
(and (<= 1 month) (<= month 12)
(<= 1 day) (<= day (calendar-last-day-of-month month year))
+ ;; BC dates left as non-legal, to suppress errors from
+ ;; complex holiday algorithms not suitable for years BC.
+ ;; Note there are side effects on calendar navigation.
(<= 1 year))))
(defun calendar-date-equal (date1 date2)
@@ -2698,16 +2761,16 @@ MARK defaults to `diary-entry-marker'."
(delete-char 1)
(insert mark)
(forward-char -2))
- (progn ; attr list
- (setq temp-face
- (make-symbol (apply 'concat "temp-face-"
- (mapcar '(lambda (sym)
- (cond ((symbolp sym) (symbol-name sym))
- ((numberp sym) (int-to-string sym))
- (t sym))) mark))))
+ (let ; attr list
+ ((temp-face
+ (make-symbol (apply 'concat "temp-face-"
+ (mapcar '(lambda (sym)
+ (cond ((symbolp sym) (symbol-name sym))
+ ((numberp sym) (int-to-string sym))
+ (t sym))) mark))))
+ (faceinfo mark))
(make-face temp-face)
;; Remove :face info from the mark, copy the face info into temp-face
- (setq faceinfo mark)
(while (setq faceinfo (memq :face faceinfo))
(copy-face (read (nth 1 faceinfo)) temp-face)
(setcar faceinfo nil)
@@ -2871,7 +2934,10 @@ Defaults to today's date if DATE is not given."
(defun calendar-set-mode-line (str)
"Set mode line to STR, centered, surrounded by dashes."
(setq mode-line-format
- (calendar-string-spread (list str) ?- (frame-width))))
+ (calendar-string-spread
+ (list str) ?-
+ ;; As per doc of window-width, total visible mode-line length.
+ (let ((edges (window-edges))) (- (nth 2 edges) (nth 0 edges))))))
(defun calendar-mod (m n)
"Non-negative remainder of M/N with N instead of 0."
@@ -2885,4 +2951,5 @@ Defaults to today's date if DATE is not given."
;;; byte-compile-dynamic: t
;;; End:
+;;; arch-tag: 19c61596-c8fb-4c69-bcf1-7dd739919cd8
;;; calendar.el ends here
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 3e516aed3b9..eba932847c0 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -1,6 +1,6 @@
;;; diary-lib.el --- diary functions
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2003
+;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
@@ -52,8 +52,8 @@ If so, return the expanded file name, otherwise signal an error."
(defun diary (&optional arg)
"Generate the diary window for ARG days starting with the current date.
If no argument is provided, the number of days of diary entries is governed
-by the variable `number-of-diary-entries'. This function is suitable for
-execution in a `.emacs' file."
+by the variable `number-of-diary-entries'. A value of ARG less than 1
+does nothing. This function is suitable for execution in a `.emacs' file."
(interactive "P")
(diary-check-diary-file)
(let ((date (calendar-current-date)))
@@ -258,12 +258,33 @@ search."
(list entry ret-attr))))
+;; This can be removed once the kill/yank treatment of invisible text
+;; (see etc/TODO) is fixed. -- gm
+(defcustom diary-header-line-flag t
+ "*If non-nil, `simple-diary-display' will show a header line.
+The format of the header is specified by `diary-header-line-format'."
+ :group 'diary
+ :type 'boolean
+ :version "21.4")
+
+(defcustom diary-header-line-format
+ '(:eval (calendar-string-spread
+ (list (if selective-display
+ "Selective display active - press \"s\" in calendar \
+before edit/copy"
+ "Diary"))
+ ?\ (frame-width)))
+ "*Format of the header line displayed by `simple-diary-display'.
+Only used if `diary-header-line-flag' is non-nil."
+ :group 'diary
+ :type 'sexp
+ :version "21.4")
(defun list-diary-entries (date number)
"Create and display a buffer containing the relevant lines in diary-file.
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.
+using selective display. If NUMBER is less than 1, this function does nothing.
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 specifier) where
@@ -293,27 +314,29 @@ These hooks have the following distinct roles:
`diary-hook' is run last. This can be used for an appointment
notification function."
- (if (< 0 number)
- (let ((original-date date);; save for possible use in the hooks
- old-diary-syntax-table
- diary-entries-list
- file-glob-attrs
- (date-string (calendar-date-string date))
- (d-file (substitute-in-file-name diary-file)))
- (message "Preparing diary...")
- (save-excursion
- (let ((diary-buffer (find-buffer-visiting d-file)))
- (if (not diary-buffer)
- (set-buffer (find-file-noselect d-file t))
- (set-buffer diary-buffer)
- (or (verify-visited-file-modtime diary-buffer)
- (revert-buffer t t))))
- (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
- (setq selective-display t)
- (setq selective-display-ellipses nil)
- (setq old-diary-syntax-table (syntax-table))
- (set-syntax-table diary-syntax-table)
- (unwind-protect
+ (when (> number 0)
+ (let ((original-date date);; save for possible use in the hooks
+ old-diary-syntax-table
+ diary-entries-list
+ file-glob-attrs
+ (date-string (calendar-date-string date))
+ (d-file (substitute-in-file-name diary-file)))
+ (message "Preparing diary...")
+ (save-excursion
+ (let ((diary-buffer (find-buffer-visiting d-file)))
+ (if (not diary-buffer)
+ (set-buffer (find-file-noselect d-file t))
+ (set-buffer diary-buffer)
+ (or (verify-visited-file-modtime diary-buffer)
+ (revert-buffer t t))))
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil "")))
+ (setq selective-display t)
+ (setq selective-display-ellipses nil)
+ (if diary-header-line-flag
+ (setq header-line-format diary-header-line-format))
+ (setq old-diary-syntax-table (syntax-table))
+ (set-syntax-table diary-syntax-table)
+ (unwind-protect
(let ((buffer-read-only nil)
(diary-modified (buffer-modified-p))
(mark (regexp-quote diary-nonmarking-symbol)))
@@ -409,7 +432,6 @@ These hooks have the following distinct roles:
'list-diary-entries-hook)
(if diary-display-hook
(run-hooks 'diary-display-hook)
- ;; FIXME Error if calendar-setup 'calendar-only -- gm.
(simple-diary-display))
(run-hooks 'diary-hook)
diary-entries-list))))
@@ -466,17 +488,19 @@ changing the variable `diary-include-string'."
"Display the diary buffer if there are any relevant entries or holidays."
(let* ((holiday-list (if holidays-in-diary-buffer
(check-calendar-holidays original-date)))
- (msg (format "No diary entries for %s %s"
- (concat 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 "; ")))
+ (hol-string (format "%s%s%s"
+ date-string
+ (if holiday-list ": " "")
+ (mapconcat 'identity holiday-list "; ")))
+ (msg (format "No diary entries for %s" hol-string))
+ ;; If selected window is dedicated (to the calendar),
+ ;; need a new one to display the diary.
+ (pop-up-frames (window-dedicated-p (selected-window))))
+ (calendar-set-mode-line (format "Diary for %s" hol-string))
(if (or (not diary-entries-list)
(and (not (cdr diary-entries-list))
(string-equal (car (cdr (car diary-entries-list))) "")))
- (if (<= (length msg) (frame-width))
+ (if (< (length msg) (frame-width))
(message "%s" msg)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
@@ -530,7 +554,6 @@ This function is provided for optional use as the `diary-display-hook'."
(message "%s" msg)
(set-buffer (get-buffer-create holiday-buffer))
(setq buffer-read-only nil)
- (calendar-set-mode-line date-string)
(erase-buffer)
(insert (mapconcat 'identity holiday-list "\n"))
(goto-char (point-min))
@@ -563,8 +586,10 @@ This function is provided for optional use as the `diary-display-hook'."
(extract-calendar-month date))
(setq holiday-list-last-year
(extract-calendar-year date))
- (increment-calendar-month
- holiday-list-last-month holiday-list-last-year 1)
+ (progn
+ (increment-calendar-month
+ holiday-list-last-month holiday-list-last-year 1)
+ t)
(setq holiday-list
(let ((displayed-month holiday-list-last-month)
(displayed-year holiday-list-last-year))
@@ -611,10 +636,10 @@ This function is provided for optional use as the `diary-display-hook'."
sym
(symbol-name sym)))
marks))))
- faceinfo)
- ;; Remove :face info from the marks,
+ (faceinfo marks))
+ (make-face temp-face)
+ ;; Remove :face info from the marks,
;; copy the face info into temp-face
- (setq faceinfo marks)
(while (setq faceinfo (memq :face faceinfo))
(copy-face (read (nth 1 faceinfo)) temp-face)
(setcar faceinfo nil)
@@ -632,6 +657,7 @@ This function is provided for optional use as the `diary-display-hook'."
(setq buffer-read-only t)
(display-buffer fancy-diary-buffer)
(fancy-diary-display-mode)
+ (calendar-set-mode-line date-string)
(message "Preparing diary...done"))))
(defun make-fancy-diary-buffer ()
@@ -691,7 +717,8 @@ This function gets rid of the selective display of the diary file so that
all entries, not just some, are visible. If there is no diary buffer, one
is created."
(interactive)
- (let ((d-file (diary-check-diary-file)))
+ (let ((d-file (diary-check-diary-file))
+ (pop-up-frames (window-dedicated-p (selected-window))))
(save-excursion
(set-buffer (or (find-buffer-visiting d-file)
(find-file-noselect d-file t)))
@@ -881,19 +908,19 @@ After the entries are marked, the hooks `nongregorian-diary-marking-hook' and
marks (nth 1 temp))))
(if dd-name
(mark-calendar-days-named
- (cdr (assoc-ignore-case
+ (cdr (assoc-string
dd-name
(calendar-make-alist
calendar-day-name-array
- 0 nil calendar-day-abbrev-array))) marks)
+ 0 nil calendar-day-abbrev-array) t)) marks)
(if mm-name
(setq mm
(if (string-equal mm-name "*") 0
- (cdr (assoc-ignore-case
+ (cdr (assoc-string
mm-name
(calendar-make-alist
calendar-month-name-array
- 1 nil calendar-month-abbrev-array))))))
+ 1 nil calendar-month-abbrev-array) t)))))
(mark-calendar-date-pattern mm dd yy marks))))
(setq d (cdr d))))
(mark-sexp-diary-entries)
@@ -1073,12 +1100,15 @@ after those with times."
(defun diary-entry-time (s)
"Return time at the beginning of the string S as a military-style integer.
For example, returns 1325 for 1:25pm.
-Returns `diary-unknown-time' (default value -9999) if no time is recognized. The recognized forms are XXXX, X:XX, or
-XX:XX (military time), and XXam, XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm,
-or XX:XXPM."
+
+Returns `diary-unknown-time' (default value -9999) if no time is recognized.
+The recognized forms are XXXX, X:XX, or XX:XX (military time), and XXam,
+XXAM, XXpm, XXPM, XX:XXam, XX:XXAM XX:XXpm, or XX:XXPM. A period (.) can
+be used instead of a colon (:) to separate the hour and minute parts."
(let ((case-fold-search nil))
(cond ((string-match ; Military time
- "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
+ "\\`[ \t\n\\^M]*\\([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)))))
@@ -1090,7 +1120,7 @@ or XX:XXPM."
(if (equal ?a (downcase (aref s (match-beginning 2))))
0 1200)))
((string-match ; Hour and minute XX:XXam or XX:XXpm
- "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
+ "\\`[ \t\n\\^M]*\\([0-9]?[0-9]\\)[:.]\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
(+ (* 100 (% (string-to-int
(substring s (match-beginning 1) (match-end 1)))
12))
@@ -1262,7 +1292,7 @@ A number of built-in functions are available for this type of diary entry:
Marking these entries is *extremely* time consuming, so these entries are
best if they are nonmarking."
- (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)"
+ (let ((s-entry (concat "\\(\\`\\|\^M\\|\n\\)"
(regexp-quote diary-nonmarking-symbol)
"?"
(regexp-quote sexp-diary-entry-symbol)
@@ -1589,7 +1619,8 @@ Do nothing if DATE or STRING is nil."
(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 (or file diary-file)))
+ (let ((pop-up-frames (window-dedicated-p (selected-window))))
+ (find-file-other-window (substitute-in-file-name (or file diary-file))))
(widen)
(goto-char (point-max))
(when (let ((case-fold-search t))
@@ -1696,13 +1727,13 @@ Prefix arg will make the entry nonmarking."
arg)))
;;;###autoload
-(define-derived-mode diary-mode text-mode
+(define-derived-mode diary-mode fundamental-mode
"Diary"
"Major mode for editing the diary file."
(set (make-local-variable 'font-lock-defaults)
'(diary-font-lock-keywords t)))
-(define-derived-mode fancy-diary-display-mode text-mode
+(define-derived-mode fancy-diary-display-mode fundamental-mode
"Diary"
"Major mode used while displaying diary entries using Fancy Display."
(set (make-local-variable 'font-lock-defaults)
@@ -1728,7 +1759,7 @@ Prefix arg will make the entry nonmarking."
'("^\\(Erev \\)?Rosh Hodesh.*" . font-lock-function-name-face)
'("^Day.*omer.*$" . font-lock-builtin-face)
'("^Parashat.*$" . font-lock-comment-face)
- '("^[ \t]*[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?"
+ '("^[ \t]*[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)?\\)?"
. font-lock-variable-name-face))
"Keywords to highlight in fancy diary display")
@@ -1823,11 +1854,12 @@ names."
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
'(1 font-lock-reference-face))
'(font-lock-diary-sexps . font-lock-keyword-face)
- '("[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\(:?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
+ '("[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\(-[0-9]?[0-9]\\([:.]?[0-9][0-9]\\)?\\(am\\|pm\\|AM\\|PM\\)\\)?"
. font-lock-function-name-face)))
"Forms to highlight in diary-mode")
(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 0678135e2ce..b262ac50a38 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -510,4 +510,5 @@ date. If date is nil, or if the date is not visible, there is no holiday."
(provide 'holidays)
+;;; arch-tag: 48eb3117-75a7-4dbe-8fd9-873c3cbb0d37
;;; holidays.el ends here
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 183e28b5b6f..7efed3ff275 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -398,4 +398,5 @@ calendar-time-zone."
(provide 'lunar)
+;;; arch-tag: 72f0b8a4-7bcc-4a1b-b67a-ff53c4a1d222
;;; lunar.el ends here
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 7020e490b4b..bf75b186211 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -174,6 +174,7 @@
((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
"(slots predicate extractor...)")
+;;;###autoload
(defun parse-time-string (string)
"Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
The values are identical to those of `decode-time', but any values that are
@@ -216,4 +217,5 @@ 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 51558d9d128..8a514fa6415 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1096,4 +1096,5 @@ Requires floating point."
(provide 'solar)
+;;; arch-tag: bc0ff693-df58-4666-bde4-2a7837ccb8fe
;;; solar.el ends here
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index c3a738a9932..b36d5ab2f31 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -186,4 +186,5 @@ If DATE is malformed, return a time value of zeros."
(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 f4b68764d0d..0507ddab64a 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -1,6 +1,6 @@
;;; timeclock.el --- mode for keeping track of how much you work
-;; Copyright (C) 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw@gnu.org>
;; Created: 25 Mar 1999
@@ -60,7 +60,7 @@
;; `timeclock-modeline-display' again.
;; You may also want Emacs to ask you before exiting, if you are
-;; current working on a project. This can be done either by setting
+;; currently working on a project. This can be done either by setting
;; `timeclock-ask-before-exiting' to t using M-x customize (this is
;; the default), or by adding the following to your .emacs file:
;;
@@ -94,7 +94,7 @@
:group 'timeclock)
(defcustom timeclock-relative t
- "*When reporting time, make it relative to `timeclock-workday'?
+ "*Whether to maken reported time relative to `timeclock-workday'.
For example, if the length of a normal workday is eight hours, and you
work four hours on Monday, then the amount of time \"remaining\" on
Tuesday is twelve hours -- relative to an averaged work period of
@@ -107,7 +107,7 @@ previous days. This only affects the timeclock modeline display."
(defcustom timeclock-get-project-function 'timeclock-ask-for-project
"*The function used to determine the name of the current project.
When clocking in, and no project is specified, this function will be
-called to determine what the current project to be worked on is.
+called to determine what is the current project to be worked on.
If this variable is nil, no questions will be asked."
:type 'function
:group 'timeclock)
@@ -115,7 +115,7 @@ If this variable is nil, no questions will be asked."
(defcustom timeclock-get-reason-function 'timeclock-ask-for-reason
"*A function used to determine the reason for clocking out.
When clocking out, and no reason is specified, this function will be
-called to determine what the reason is.
+called to determine what is the reason.
If this variable is nil, no questions will be asked."
:type 'function
:group 'timeclock)
@@ -123,17 +123,17 @@ If this variable is nil, no questions will be asked."
(defcustom timeclock-get-workday-function nil
"*A function used to determine the length of today's workday.
The first time that a user clocks in each day, this function will be
-called to determine what the length of the current workday is. If
+called to determine what is the length of the current workday. If
the return value is nil, or equal to `timeclock-workday', nothing special
will be done. If it is a quantity different from `timeclock-workday',
however, a record will be output to the timelog file to note the fact that
-that day has a different length from the norm."
+that day has a length that is different from the norm."
:type '(choice (const nil) function)
:group 'timeclock)
(defcustom timeclock-ask-before-exiting t
"*If non-nil, ask if the user wants to clock out before exiting Emacs.
-This variable only has an effect if set with \\[customize]."
+This variable only has effect if set with \\[customize]."
:set (lambda (symbol value)
(if value
(add-hook 'kill-emacs-query-functions 'timeclock-query-out)
@@ -151,9 +151,9 @@ This variable only has an effect if set with \\[customize]."
(defcustom timeclock-use-display-time t
"*If non-nil, use `display-time-hook' for doing modeline updates.
-The advantage to this is that it means one less timer has to be set
-running amok in Emacs' process space. The disadvantage is that it
-requires you to have `display-time' running. If you don't want to use
+The advantage of this is that one less timer has to be set running
+amok in Emacs' process space. The disadvantage is that it requires
+you to have `display-time' running. If you don't want to use
`display-time', but still want the modeline to show how much time is
left, set this variable to nil. Changing the value of this variable
while timeclock information is being displayed in the modeline has no
@@ -240,7 +240,7 @@ The format of this list is (CODE TIME PROJECT).")
Normally, timeclock assumes that you intend to work for
`timeclock-workday' seconds every day. Any days in which you work
more or less than this amount is considered either a positive or
-negative discrepancy. If you work in such a manner that the
+a negative discrepancy. If you work in such a manner that the
discrepancy is always brought back to zero, then you will by
definition have worked an average amount equal to `timeclock-workday'
each day.")
@@ -254,8 +254,8 @@ will be the same as `timeclock-discrepancy'.") ; ? gm
(defvar timeclock-last-period nil
"Integer representing the number of seconds in the last period.
-Note that you shouldn't access this value, but should use the function
-`timeclock-last-period' instead.")
+Note that you shouldn't access this value, but instead should use the
+function `timeclock-last-period'.")
(defvar timeclock-mode-string nil
"The timeclock string (optionally) displayed in the modeline.
@@ -343,7 +343,7 @@ weekend). *If not called interactively, ARG should be the number of
_seconds_ worked today*. This feature only has effect the first time
this function is called within a day.
-PROJECT as the project being clocked into. If PROJECT is nil, and
+PROJECT is the project being clocked into. If PROJECT is nil, and
FIND-PROJECT is non-nil -- or the user calls `timeclock-in'
interactively -- call the function `timeclock-get-project-function' to
discover the name of the project."
@@ -446,17 +446,18 @@ worked today, ignoring the time worked on previous days."
;;;###autoload
(defun timeclock-change (&optional arg project)
- "Change to working on a different project, by clocking in then out.
-With a prefix ARG, consider the previous project as having been
-finished at the time of changeover. PROJECT is the name of the last
-project you were working on."
+ "Change to working on a different project.
+This clocks out of the current project, then clocks in on a new one.
+With a prefix ARG, consider the previous project as finished at the
+time of changeover. PROJECT is the name of the last project you were
+working on."
(interactive "P")
(timeclock-out arg)
(timeclock-in nil project (interactive-p)))
;;;###autoload
(defun timeclock-query-out ()
- "Ask the user before clocking out.
+ "Ask the user whether to clock out.
This is a useful function for adding to `kill-emacs-query-functions'."
(and (equal (car timeclock-last-event) "i")
(y-or-n-p "You're currently clocking time, clock out? ")
@@ -550,7 +551,7 @@ non-nil, the amount returned will be relative to past time worked."
;; Should today-only be removed in favour of timeclock-relative? - gm
(defsubst timeclock-when-to-leave (&optional today-only)
- "Return a time value representing at when the workday ends today.
+ "Return a time value representing the end of today's workday.
If TODAY-ONLY is non-nil, the value returned will be relative only to
the time worked today, and not to past time."
(timeclock-seconds-to-time
@@ -565,7 +566,7 @@ the time worked today, and not to past time."
;;;###autoload
(defun timeclock-when-to-leave-string (&optional show-seconds
today-only)
- "Return a string representing at what time the workday ends today.
+ "Return a string representing the end of today's workday.
This string is relative to the value of `timeclock-workday'. If
SHOW-SECONDS is non-nil, the value printed/returned will include
seconds. If TODAY-ONLY is non-nil, the value returned will be
@@ -852,8 +853,8 @@ i, o or O. The meanings of the codes are:
h Set the required working time for the given day. This must
be the first entry for that day. The COMMENT in this case is
- the number of hours that must be worked. Floating point
- amounts are allowed.
+ the number of hours in this workday. Floating point amounts
+ are allowed.
i Clock in. The COMMENT in this case should be the name of the
project worked on.
@@ -1144,7 +1145,7 @@ If optional argument TIME is non-nil, use that instead of the current time."
(apply 'encode-time decoded)))
(defun timeclock-geometric-mean (l)
- "Compute the geometric mean of the list L."
+ "Compute the geometric mean of the values in the list L."
(let ((total 0)
(count 0))
(while l
@@ -1158,7 +1159,7 @@ If optional argument TIME is non-nil, use that instead of the current time."
(defun timeclock-generate-report (&optional html-p)
"Generate a summary report based on the current timelog file.
By default, the report is in plain text, but if the optional argument
-HTML-P is non-nil html markup is added."
+HTML-P is non-nil, HTML markup is added."
(interactive)
(let ((log (timeclock-log-data))
(today (timeclock-day-base)))
@@ -1363,4 +1364,5 @@ 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 884e547b2d5..0caedee7c8a 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -5,7 +5,6 @@
;; Author: Oliver Seidel <os10000@seidel-space.de>
;; [Not clear the above works, July 2000]
;; Created: 2 Aug 1997
-;; Version: $Id: todo-mode.el,v 1.49 2001/11/17 04:01:31 rms Exp $
;; Keywords: calendar, todo
;; This file is part of GNU Emacs.
@@ -93,12 +92,6 @@
;; extensions that are not explicitly listed in the above quick
;; installation.
;;
-;; Version
-;;
-;; Which version of todo-mode.el does this documentation refer to?
-;;
-;; $Id: todo-mode.el,v 1.49 2001/11/17 04:01:31 rms Exp $
-;;
;; Pre-Requisites
;;
;; This package will require the following packages to be
@@ -961,4 +954,5 @@ Number of entries for each category is given by `todo-print-priorities'."
(provide 'todo-mode)
+;;; arch-tag: 6fd91be5-776e-4464-a109-da4ea0e4e497
;;; todo-mode.el ends here
View Lorry Controller Status