;;; diary-lib.el --- diary functions
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1989-1990, 1992-1995, 2001-2011
+;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;;; Code:
(require 'calendar)
-(require 'diary-loaddefs)
+(eval-and-compile (load "diary-loaddefs" nil t))
(defgroup diary nil
"Emacs diary."
(define-obsolete-variable-alias 'diary-display-hook 'diary-display-function
"23.1")
-(defcustom diary-display-function 'diary-simple-display
+(defcustom diary-display-function 'diary-fancy-display
"Function used to display the diary.
-The default is `diary-simple-display'; `diary-fancy-display' is
-an alternative.
+The two standard options are `diary-fancy-display' and `diary-simple-display'.
For historical reasons, `nil' is the same as `diary-simple-display'
\(so you must use `ignore' for no display). Also for historical
entry for the given date. This can be used, for example, to
produce a different buffer for display (perhaps combined with
holidays), or hard copy output."
- :type '(choice (const diary-simple-display :tag "Basic display")
- (const diary-fancy-display :tag "Fancy display")
+ :type '(choice (const diary-fancy-display :tag "Fancy display")
+ (const diary-simple-display :tag "Basic display")
(const ignore :tag "No display")
(const nil :tag "Obsolete way to choose basic display")
(hook :tag "Obsolete form with list of display functions"))
:initialize 'custom-initialize-default
:set 'diary-set-maybe-redraw
- :version "23.1"
+ :version "23.2" ; simple->fancy
:group 'diary)
(define-obsolete-variable-alias 'list-diary-entries-hook
(setq diary-display-function 'diary-fancy-display)
(add-hook 'diary-list-entries-hook 'diary-include-other-diary-files)
- (add-hook 'diary-list-entries-hook 'diary-sort-entries)
+ (add-hook 'diary-list-entries-hook 'diary-sort-entries t)
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."
+lexicographic order. Note how the sort function is placed last,
+so that it can sort the entries included from other files."
:type 'hook
:options '(diary-include-other-diary-files diary-sort-entries)
:group 'diary)
: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
(defun diary-set-header (symbol value)
"Set SYMBOL's value to VALUE, and redraw the diary header if necessary."
(let ((oldvalue (symbol-value symbol))
- (dbuff (and diary-file
- (find-buffer-visiting
- (substitute-in-file-name diary-file)))))
+ (dbuff (and diary-file (find-buffer-visiting diary-file))))
(custom-set-default symbol value)
(and dbuff
(not (equal value oldvalue))
"Some text is hidden - press \"s\" in calendar \
before edit/copy"
"Diary"))
- ?\s (frame-width)))
+ ?\s (window-width)))
"Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
:initialize 'custom-initialize-default
:set 'diary-set-header
- :version "22.1")
+ :version "23.3") ; frame-width -> window-width
;; The first version of this also checked for diary-selective-display
;; in the non-fancy case. This was an attempt to distinguish between
(defun diary-live-p ()
"Return non-nil if the diary is being displayed."
(or (get-buffer diary-fancy-buffer)
- (and diary-file
- (find-buffer-visiting (substitute-in-file-name diary-file)))))
+ (and diary-file (find-buffer-visiting diary-file))))
;;;###cal-autoload
(defun diary-set-maybe-redraw (symbol value)
(defun diary-check-diary-file ()
"Check that the file specified by `diary-file' exists and is readable.
If so, return the expanded file name, otherwise signal an error."
- (let ((d-file (substitute-in-file-name diary-file)))
- (if (and d-file (file-exists-p d-file))
- (if (file-readable-p d-file)
- d-file
- (error "Diary file `%s' is not readable" diary-file))
- (error "Diary file `%s' does not exist" diary-file))))
+ (if (and diary-file (file-exists-p diary-file))
+ (if (file-readable-p diary-file)
+ diary-file
+ (error "Diary file `%s' is not readable" diary-file))
+ (error "Diary file `%s' does not exist" diary-file)))
;;;###autoload
(defun diary (&optional arg)
(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)
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")
;; regexp moves us past the end of date, onto the next line.
;; Trailing whitespace after date not allowed (see diary-file).
(if (and (bolp) (not (looking-at "[ \t]")))
- ;; Diary entry that consists only of date.
+ ;; Diary entry that consists only of date.
(backward-char 1)
;; Found a nonempty diary entry--make it
;; visible and add it to the list.
(1+ (calendar-absolute-from-gregorian gdate))))))
(goto-char (point-min)))
+(defvar diary-included-files nil
+ "List of any diary files included in the last call to `diary-list-entries'.")
+
;; FIXME non-greg and list hooks run same number of times?
(defun diary-list-entries (date number &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'.
for NUMBER days starting with date DATE. The other entries are hidden
using overlays. 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.
+Returns a list of all relevant diary entries found.
The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where
\(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and
SPECIFIER is the applicability. If the variable `diary-list-include-blanks'
is non-nil, this list includes a dummy diary entry consisting of the empty
string for a date with no diary entries.
-After the list is prepared, the following hooks are run:
+If entries are being produced for multiple dates (i.e., NUMBER > 1),
+then this function normally returns the entries from any given
+diary file in date order. The entries for any given day are in
+the order in which they were found in the file, not necessarily
+in time-of-day order. Note that any functions present on the
+hooks (see below) may add entries, or change the order. For
+example, `diary-include-other-diary-files' adds entries from any
+include files that it finds to the end of the original list. The
+entries from each file will be in date order, but the overall
+list will not be. If you want the entire list to be in time order,
+add `diary-sort-entries' to the end of `diary-list-entries-hook'.
+
+After the initial list is prepared, the following hooks are run:
`diary-nongregorian-listing-hook' can cull dates from the diary
and each included file, for example to process Islamic diary
(when (> number 0)
(let* ((original-date date) ; save for possible use in the hooks
(date-string (calendar-date-string date))
- (d-file (substitute-in-file-name diary-file))
- (diary-buffer (find-buffer-visiting d-file))
- diary-entries-list file-glob-attrs)
- (message "Preparing diary...")
- (save-excursion
- (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)))
- ;; 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
- (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")
+ (diary-buffer (find-buffer-visiting diary-file))
+ ;; 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."
(kill-local-variable 'diary-selective-display)
- (remove-overlays (point-min) (point-max) 'invisible 'diary)
+ (save-restriction ; bug#5477
+ (widen)
+ (remove-overlays (point-min) (point-max) 'invisible 'diary))
(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'.
(while (re-search-forward
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
nil t)
- (let ((diary-file (substitute-in-file-name
- (match-string-no-properties 1)))
- (diary-list-include-blanks nil)
+ (let ((diary-file (match-string-no-properties 1))
(diary-list-entries-hook 'diary-include-other-diary-files)
- (diary-display-function 'ignore)
- (diary-hook nil))
+ (diary-including t)
+ diary-hook diary-list-include-blanks efile)
(if (file-exists-p diary-file)
(if (file-readable-p diary-file)
- (unwind-protect
- (setq 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))
;; to display the diary.
(let* ((pop-up-frames (or pop-up-frames
(window-dedicated-p (selected-window))))
- (dbuff (find-buffer-visiting (substitute-in-file-name diary-file)))
+ (dbuff (find-buffer-visiting diary-file))
(empty (diary-display-no-entries)))
;; This may be too wide, but when simple diary is used there is
;; nowhere else for the holidays to go. Also, it is documented in
(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")
-(define-button-type 'diary-entry
- 'action #'diary-goto-entry
- 'face 'diary-button)
+(define-button-type 'diary-entry 'action #'diary-goto-entry
+ 'face 'diary-button 'help-echo "Find this diary entry"
+ 'follow-link t)
(defun diary-goto-entry (button)
"Jump to the diary entry for the BUTTON at point."
This is an option for `diary-display-function'."
;; Turn off selective-display in the diary file's buffer.
- (with-current-buffer
- (find-buffer-visiting (substitute-in-file-name diary-file))
+ (with-current-buffer (find-buffer-visiting diary-file)
(diary-unhide-everything))
(unless (car (diary-display-no-entries)) ; no entries
;; Prepare the fancy diary buffer.
this-loc marks temp-face)
(unless (zerop (length this-entry))
(if (setq this-loc (nth 3 entry))
- (insert-button (concat this-entry "\n")
+ (insert-button this-entry
;; (MARKER FILENAME SPECIFIER LITERAL)
'locator (list (car this-loc)
(cadr this-loc)
(or (nth 2 this-loc)
(nth 1 entry)))
:type 'diary-entry)
- (insert this-entry ?\n))
+ (insert this-entry))
+ (insert ?\n)
;; Doesn't make sense to check font-lock-mode - see
;; comments above diary-entry-marker in calendar.el.
(and ; font-lock-mode
(overlay-put
(make-overlay (match-beginning 0) (match-end 0))
'face temp-face)))))))
- (diary-fancy-display-mode)
- (calendar-set-mode-line date-string)
- (message "Preparing diary...done"))))
+ ;; FIXME can't remember what this check was for.
+ ;; To prevent something looping, or a minor optimization?
+ (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))))
(define-obsolete-function-alias 'fancy-diary-display
'diary-fancy-display "23.1")
(if diary-buffer
(with-current-buffer diary-buffer
(run-hooks 'diary-print-entries-hook))
- (or (setq diary-buffer
- (find-buffer-visiting (substitute-in-file-name diary-file)))
+ (or (setq diary-buffer (find-buffer-visiting diary-file))
(error "You don't have a diary buffer!"))
;; Name affects printing?
(setq temp-buffer (get-buffer-create " *Printable Diary Entries*"))
all entries, not just some, are visible. If there is no diary buffer, one
is created."
(interactive)
- (let ((d-file (diary-check-diary-file))
- (pop-up-frames (or pop-up-frames
- (window-dedicated-p (selected-window)))))
+ (let* ((d-file (diary-check-diary-file))
+ (pop-up-frames (or pop-up-frames
+ (window-dedicated-p (selected-window))))
+ (win (selected-window))
+ (height (window-height)))
(with-current-buffer (or (find-buffer-visiting d-file)
(find-file-noselect d-file t))
(when (eq major-mode (default-value 'major-mode)) (diary-mode))
(diary-unhide-everything)
- (display-buffer (current-buffer)))))
-
-(define-obsolete-function-alias 'show-all-diary-entries
- 'diary-show-all-entries "22.1")
+ (display-buffer (current-buffer))
+ (when (and (/= height (window-height win))
+ (with-current-buffer (window-buffer win)
+ (derived-mode-p 'calendar-mode)))
+ (fit-window-to-buffer win)))))
;;;###autoload
(defun diary-mail-entries (&optional ndays)
(while (re-search-forward
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
nil t)
- (let* ((diary-file (substitute-in-file-name
- (match-string-no-properties 1)))
+ (let* ((diary-file (match-string-no-properties 1))
(diary-mark-entries-hook 'diary-mark-included-diary-files)
(dbuff (find-buffer-visiting diary-file)))
(if (file-exists-p diary-file)
The function FROMABS converts absolute dates to the appropriate date system.
The function TOABS carries out the inverse operation. Optional argument
COLOR is passed to `calendar-mark-visible-date' as MARK."
- (save-excursion
- (set-buffer calendar-buffer)
+ (with-current-buffer calendar-buffer
(if (and (not (zerop month)) (not (zerop day)))
(if (not (zerop year))
;; Fully specified date.
(string-lessp ts1 ts2)))))))
(defun diary-sort-entries ()
- "Sort the list of diary entries by time of day."
+ "Sort the list of diary entries by time of day.
+If you add this function to `diary-list-entries-hook', it should
+be the last item in the hook, in case earlier items add diary
+entries, or change the order."
(setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
(define-obsolete-function-alias 'sort-diary-entries 'diary-sort-entries "23.1")
sexp-start sexp entry specifier entry-start line-start
diary-entry temp literal)
(goto-char (point-min))
- (save-excursion
- (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '()))))
+ (setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(while (re-search-forward s-entry nil t)
(backward-char 1)
(setq sexp-start (point))
(forward-line 1)
(while (looking-at "[ \t]")
(forward-line 1))
- (backward-char 1)
+ (if (bolp) (backward-char 1))
(setq entry (buffer-substring-no-properties entry-start (point))))
(setq diary-entry (diary-sexp-entry sexp entry date)
literal entry ; before evaluation
`diary-file'."
(let ((pop-up-frames (or pop-up-frames
(window-dedicated-p (selected-window)))))
- (find-file-other-window (substitute-in-file-name (or file diary-file))))
+ (find-file-other-window (or file diary-file)))
(when (eq major-mode (default-value 'major-mode)) (diary-mode))
(widen)
(diary-unhide-everything)
t))
'(1 font-lock-reference-face))
'(diary-font-lock-sexps . font-lock-keyword-face)
+ ;; Don't need to worry about space around "-" because the first
+ ;; match takes care of that. It does mean the "-" itself may or
+ ;; may not be fontified though.
+ ;; diary-date-forms often include a final character that is not
+ ;; part of the date (eg a non-digit to mark the end of the year).
+ ;; This can use up the only space char between a date and time (b#7891).
+ ;; Hence we use OVERRIDE, which can only override whitespace.
+ ;; FIXME it's probably better to tighten up the diary-time-regexp
+ ;; and drop the whitespace requirement below.
`(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
diary-time-regexp)
- . 'diary-time))))
+ . (0 'diary-time t)))))
+; . 'diary-time))))
(defvar diary-font-lock-keywords (diary-font-lock-keywords)
"Forms to highlight in `diary-mode'.")
'(diary-font-lock-keywords t))
(add-to-invisibility-spec '(diary . nil))
(add-hook 'after-save-hook 'diary-redraw-calendar nil t)
+ ;; In case the file was modified externally, refresh the calendar
+ ;; after refreshing the diary buffer.
+ (add-hook 'after-revert-hook 'diary-redraw-calendar nil t)
(if diary-header-line-flag
(setq header-line-format diary-header-line-format)))
;;; 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))
(setq end (line-beginning-position 2)))
(font-lock-default-fontify-region beg end verbose))
-(define-derived-mode diary-fancy-display-mode fundamental-mode
+(defvar diary-fancy-overriding-map (make-sparse-keymap)
+ "Keymap overriding minor-mode maps in `diary-fancy-display-mode'.")
+
+(define-derived-mode diary-fancy-display-mode special-mode
"Diary"
"Major mode used while displaying diary entries using Fancy Display."
(set (make-local-variable 'font-lock-defaults)
t nil nil nil
(font-lock-fontify-region-function
. diary-fancy-font-lock-fontify-region-function)))
- (local-set-key "q" 'quit-window))
+ (set (make-local-variable 'minor-mode-overriding-map-alist)
+ (list (cons t diary-fancy-overriding-map)))
+ (view-mode 1))
(define-obsolete-function-alias 'fancy-diary-display-mode
'diary-fancy-display-mode "23.1")
;; 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
+;; 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))
(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)
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)
(provide 'diary-lib)
-;; arch-tag: 22dd506e-2e33-410d-9ae1-095a0c1b2010
;;; diary-lib.el ends here
HCoop / bpt / emacs.git / blobdiff