;;; diary-lib.el --- diary functions
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2003, 2004, 2005
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
+;; 2004, 2005, 2006 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; This file is part of GNU Emacs.
(list (prefix-numeric-value current-prefix-arg)
(read-file-name "Enter diary file name: " default-directory nil t)))
(let ((diary-file d-file))
- (view-diary-entries arg)))
+ (diary-view-entries arg)))
(autoload 'check-calendar-holidays "holidays"
"Check the list of holidays for any that occur on DATE.
"Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.")
(autoload 'diary-bahai-date "cal-bahai"
- "Baha'i calendar equivalent of date diary entry."
- t)
+ "Baha'i calendar equivalent of date diary entry.")
(autoload 'list-bahai-diary-entries "cal-bahai"
- "Add any Baha'i date entries from the diary file to `diary-entries-list'."
- t)
+ "Add any Baha'i date entries from the diary file to `diary-entries-list'.")
(autoload 'mark-bahai-diary-entries "cal-bahai"
- "Mark days in the calendar window that have Baha'i date diary entries."
- t)
+ "Mark days in the calendar window that have Baha'i date diary entries.")
(autoload 'mark-bahai-calendar-date-pattern "cal-bahai"
- "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR."
- t)
+ "Mark dates in calendar window that conform to Baha'i date MONTH/DAY/YEAR.")
(autoload 'diary-hebrew-date "cal-hebrew"
"Hebrew calendar equivalent of date diary entry.")
;; 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.
+ "If non-nil, `diary-simple-display' will show a header line.
The format of the header is specified by `diary-header-line-format'."
:group 'diary
:type 'boolean
:version "22.1")
+(defvar diary-selective-display nil)
+
(defcustom diary-header-line-format
'(:eval (calendar-string-spread
- (list (if selective-display
+ (list (if diary-selective-display
"Selective display active - press \"s\" in calendar \
before edit/copy"
"Diary"))
?\s (frame-width)))
- "*Format of the header line displayed by `simple-diary-display'.
+ "Format of the header line displayed by `diary-simple-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
(integer :tag "Saturday")))
:group 'diary)
+
+(defvar diary-modify-entry-list-string-function nil
+ "Function applied to entry string before putting it into the entries list.
+Can be used by programs integrating a diary list into other buffers (e.g.
+org.el and planner.el) to modify the string or add properties to it.
+The function takes a string argument and must return a string.")
+
+(defun add-to-diary-list (date string specifier &optional marker
+ globcolor literal)
+ "Add an entry to `diary-entries-list'.
+Do nothing if DATE or STRING is nil. DATE is the (MONTH DAY
+YEAR) for which the entry applies; STRING is the text of the
+entry as it will appear in the diary (i.e. with any format
+strings such as \"%d\" expanded); SPECIFIER is the date part of
+the entry as it appears in the diary-file; LITERAL is the entry
+as it appears in the diary-file (i.e. before expansion). If
+LITERAL is nil, it is taken to be the same as STRING.
+
+The entry is added to the list as (DATE STRING SPECIFIER LOCATOR
+GLOBCOLOR), where LOCATOR has the form (MARKER FILENAME LITERAL),
+FILENAME being the file containing the diary entry."
+ (when (and date string)
+ (if diary-file-name-prefix
+ (let ((prefix (funcall diary-file-name-prefix-function
+ (buffer-file-name))))
+ (or (string= 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))))))
+
(define-obsolete-function-alias 'list-diary-entries 'diary-list-entries)
-(defun diary-list-entries (date number)
+(defun diary-list-entries (date number &optional list-only)
"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. 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
-\(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 t, this list includes a dummy diary entry consisting of the empty string)
+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 t, this list includes a dummy diary entry consisting of the empty string
for a date with no diary entries.
After the list is prepared, the hooks `nongregorian-diary-listing-hook',
add-hook to set this to ignore.
`diary-hook' is run last. This can be used for an appointment
- notification function."
+ notification function.
+
+If LIST-ONLY is non-nil don't modify or display the buffer, only return a list."
(unless number
(setq number (if (vectorp number-of-diary-entries)
(aref number-of-diary-entries (calendar-day-of-week date))
(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.
+ (when (eq major-mode default-major-mode) (diary-mode))
;; d-s-p is passed to the diary display function.
(let ((diary-saved-point (point)))
(save-excursion
(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))
(with-syntax-table diary-syntax-table
- (let ((buffer-read-only nil)
- (diary-modified (buffer-modified-p))
- (mark (regexp-quote diary-nonmarking-symbol)))
- ;; First and last characters must be ^M or \n for
- ;; selective display to work properly
- (goto-char (1- (point-max)))
- (if (not (looking-at "\^M\\|\n"))
- (progn
- (goto-char (point-max))
- (insert "\^M")))
+ (let ((mark (regexp-quote diary-nonmarking-symbol)))
(goto-char (point-min))
- (if (not (looking-at "\^M\\|\n"))
- (insert "\^M"))
- (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
+ (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)))
(calendar-for-loop
i from 1 to number do
(let ((month (extract-calendar-month date))
(regexp
(concat
"\\(\\`\\|\^M\\|\n\\)" mark "?\\("
- (mapconcat 'eval date-form "\\)\\(")
+ (mapconcat 'eval date-form "\\)\\(?:")
"\\)"))
(case-fold-search t))
(goto-char (point-min))
date-start temp)
(re-search-backward "\^M\\|\n\\|\\`")
(setq date-start (point))
- (re-search-forward "\^M\\|\n" nil t 2)
+ ;; When selective display (rather than
+ ;; overlays) was used, diary file used to
+ ;; start in a blank line and end in a
+ ;; newline. Now that neither of these
+ ;; need be true, 'move handles the latter
+ ;; and 1/2 kludge the former.
+ (re-search-forward
+ "\^M\\|\n" nil 'move
+ (if (and (bobp) (not (looking-at "\^M\\|\n")))
+ 1
+ 2))
(while (looking-at " \\|\^I")
- (re-search-forward "\^M\\|\n" nil t))
- (backward-char 1)
- (subst-char-in-region date-start
- (point) ?\^M ?\n t)
+ (re-search-forward "\^M\\|\n" nil 'move))
+ (unless (and (eobp) (not (bolp)))
+ (backward-char 1))
+ (unless list-only
+ (remove-overlays date-start (point)
+ 'invisible 'diary))
(setq entry (buffer-substring entry-start (point))
temp (diary-pull-attrs entry file-glob-attrs)
entry (nth 0 temp))
(copy-marker entry-start) (nth 1 temp)))))))
(or entry-found
(not diary-list-include-blanks)
- (setq diary-entries-list
- (append diary-entries-list
- (list (list date "" "" "" "")))))
+ (add-to-diary-list date "" "" "" ""))
(setq date
(calendar-gregorian-from-absolute
(1+ (calendar-absolute-from-gregorian date))))
- (setq entry-found nil)))
- (set-buffer-modified-p diary-modified)))
+ (setq entry-found nil)))))
(goto-char (point-min))
(run-hooks 'nongregorian-diary-listing-hook
'list-diary-entries-hook)
- (if diary-display-hook
- (run-hooks 'diary-display-hook)
- (simple-diary-display))
+ (unless list-only
+ (if diary-display-hook
+ (run-hooks 'diary-display-hook)
+ (simple-diary-display)))
(run-hooks 'diary-hook)
diary-entries-list))))))
(defun diary-unhide-everything ()
- (setq selective-display nil)
- (let ((inhibit-read-only t)
- (modified (buffer-modified-p)))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
- (set-buffer-modified-p modified))
+ (kill-local-variable 'diary-selective-display)
+ (remove-overlays (point-min) (point-max) 'invisible 'diary)
(kill-local-variable 'mode-line-format))
(defun include-other-diary-files ()
(unwind-protect
(setq diary-entries-list
(append diary-entries-list
- (list-diary-entries original-date number)))
+ (diary-list-entries original-date number)))
(with-current-buffer (find-buffer-visiting diary-file)
(diary-unhide-everything)))
(beep)
'face 'diary-button)
(defun diary-goto-entry (button)
- (let ((marker (button-get button 'marker)))
- (when marker
- (pop-to-buffer (marker-buffer marker))
- (goto-char (marker-position marker)))))
+ (let* ((locator (button-get button 'locator))
+ (marker (car locator))
+ markbuf file)
+ ;; If marker pointing to diary location is valid, use that.
+ (if (and marker (setq markbuf (marker-buffer marker)))
+ (progn
+ (pop-to-buffer markbuf)
+ (goto-char (marker-position marker)))
+ ;; Marker is invalid (eg buffer has been killed).
+ (or (and (setq file (cadr locator))
+ (file-exists-p file)
+ (find-file-other-window file)
+ (progn
+ (when (eq major-mode default-major-mode) (diary-mode))
+ (goto-char (point-min))
+ (if (re-search-forward (format "%s.*\\(%s\\)"
+ (regexp-quote (nth 2 locator))
+ (regexp-quote (nth 3 locator)))
+ nil t)
+ (goto-char (match-beginning 1)))))
+ (message "Unable to locate this diary entry")))))
(defun fancy-diary-display ()
"Prepare a diary buffer with relevant entries in a fancy, noneditable form.
(setq buffer-read-only t)
(display-buffer holiday-buffer)
(message "No diary entries for %s" date-string)))
- (save-excursion;; Prepare the fancy diary buffer.
- (set-buffer (make-fancy-diary-buffer))
+ (with-current-buffer;; Prepare the fancy diary buffer.
+ (make-fancy-diary-buffer)
(setq buffer-read-only nil)
(let ((entry-list diary-entries-list)
(holiday-list)
(setq entry (car (cdr (car entry-list))))
(if (< 0 (length entry))
- (progn
- (if (nth 3 (car entry-list))
+ (let ((this-entry (car entry-list))
+ this-loc)
+ (if (setq this-loc (nth 3 this-entry))
(insert-button (concat entry "\n")
- 'marker (nth 3 (car entry-list))
+ ;; (MARKER FILENAME SPECIFIER LITERAL)
+ 'locator (list (car this-loc)
+ (cadr this-loc)
+ (nth 2 this-entry)
+ (or (nth 2 this-loc)
+ (nth 1 this-entry)))
:type 'diary-entry)
(insert entry ?\n))
(save-excursion
- (let* ((marks (nth 4 (car entry-list)))
- (temp-face (make-symbol
- (apply
- 'concat "temp-face-"
- (mapcar '(lambda (sym)
- (if (stringp sym)
- sym
- (symbol-name sym)))
- marks))))
- (faceinfo marks))
- (make-face temp-face)
- ;; Remove :face info from the marks,
- ;; copy the face info into temp-face
- (while (setq faceinfo (memq :face faceinfo))
- (copy-face (read (nth 1 faceinfo)) temp-face)
- (setcar faceinfo nil)
- (setcar (cdr faceinfo) nil))
- (setq marks (delq nil marks))
- ;; Apply the font aspects
- (apply 'set-face-attribute temp-face nil marks)
- (search-backward entry)
- (overlay-put
- (make-overlay (match-beginning 0) (match-end 0))
- 'face temp-face)))))
+ (let* ((marks (nth 4 this-entry))
+ (faceinfo marks)
+ temp-face)
+ (when marks
+ (setq temp-face (make-symbol
+ (apply
+ 'concat "temp-face-"
+ (mapcar (lambda (sym)
+ (if (stringp sym)
+ sym
+ (symbol-name sym)))
+ marks))))
+ (make-face temp-face)
+ ;; Remove :face info from the marks,
+ ;; copy the face info into temp-face
+ (while (setq faceinfo (memq :face faceinfo))
+ (copy-face (read (nth 1 faceinfo)) temp-face)
+ (setcar faceinfo nil)
+ (setcar (cdr faceinfo) nil))
+ (setq marks (delq nil marks))
+ ;; Apply the font aspects.
+ (apply 'set-face-attribute temp-face nil marks)
+ (search-backward entry)
+ (overlay-put
+ (make-overlay (match-beginning 0) (match-end 0))
+ 'face temp-face))))))
(setq entry-list (cdr entry-list))))
(set-buffer-modified-p nil)
(goto-char (point-min))
(defun make-fancy-diary-buffer ()
"Create and return the initial fancy diary buffer."
- (save-excursion
- (set-buffer (get-buffer-create fancy-diary-buffer))
+ (with-current-buffer (get-buffer-create fancy-diary-buffer)
(setq buffer-read-only nil)
(calendar-set-mode-line "Diary Entries")
(erase-buffer)
the actual printing."
(interactive)
(if (bufferp (get-buffer fancy-diary-buffer))
- (save-excursion
- (set-buffer (get-buffer fancy-diary-buffer))
+ (with-current-buffer (get-buffer fancy-diary-buffer)
(run-hooks 'print-diary-entries-hook))
(let ((diary-buffer
(find-buffer-visiting (substitute-in-file-name diary-file))))
(if diary-buffer
- (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
+ (let ((temp-buffer (get-buffer-create " *Printable Diary Entries*"))
(heading))
- (save-excursion
- (set-buffer diary-buffer)
+ (with-current-buffer diary-buffer
(setq heading
(if (not (stringp mode-line-format))
"All Diary Entries"
(string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
- (substring mode-line-format
- (match-beginning 1) (match-end 1))))
- (copy-to-buffer temp-buffer (point-min) (point-max))
+ (match-string 1 mode-line-format)))
+ (let ((start (point-min))
+ end)
+ (while
+ (progn
+ (setq end (next-single-char-property-change
+ start 'invisible))
+ (if (get-char-property start 'invisible)
+ nil
+ (with-current-buffer temp-buffer
+ (insert-buffer-substring diary-buffer
+ start (or end (point-max)))))
+ (setq start end)
+ (and end (< end (point-max))))))
(set-buffer temp-buffer)
- (while (re-search-forward "\^M.*$" nil t)
- (replace-match ""))
(goto-char (point-min))
(insert heading "\n"
(make-string (length heading) ?=) "\n")
(pop-up-frames (window-dedicated-p (selected-window))))
(with-current-buffer (or (find-buffer-visiting d-file)
(find-file-noselect d-file t))
+ (when (eq major-mode default-major-mode) (diary-mode))
(diary-unhide-everything)
(display-buffer (current-buffer)))))
(defcustom diary-mail-addr
(if (boundp 'user-mail-address) user-mail-address "")
- "*Email address that `diary-mail-entries' will send email to."
+ "Email address that `diary-mail-entries' will send email to."
:group 'diary
:type 'string
:version "20.3")
(defcustom diary-mail-days 7
- "*Default number of days for `diary-mail-entries' to check."
+ "Default number of days for `diary-mail-entries' to check."
:group 'diary
:type 'integer
:version "20.3")
(if (string-equal diary-mail-addr "")
(error "You must set `diary-mail-addr' to use this command")
(let ((diary-display-hook 'fancy-diary-display))
- (list-diary-entries (calendar-current-date) (or ndays diary-mail-days)))
+ (diary-list-entries (calendar-current-date) (or ndays diary-mail-days)))
(compose-mail diary-mail-addr
(concat "Diary entries generated "
(calendar-date-string (calendar-current-date))))
file-glob-attrs marks)
(with-current-buffer (find-file-noselect (diary-check-diary-file) t)
(save-excursion
+ (when (eq major-mode default-major-mode) (diary-mode))
(setq mark-diary-entries-in-calendar t)
(message "Marking diary entries...")
(setq file-glob-attrs (nth 1 (diary-pull-attrs nil '())))
(defcustom diary-unknown-time
-9999
- "*Value returned by diary-entry-time when no time is found.
+ "Value returned by diary-entry-time when no time is found.
The default value -9999 causes entries with no recognizable time to be placed
before those with times; 9999 would place entries with no recognizable time
after those with times."
(setq line-start (point)))
(setq specifier
(buffer-substring-no-properties (1+ line-start) (point))
- entry-start (1+ line-start))
+ entry-start (1+ line-start))
(forward-char 1)
(if (and (or (char-equal (preceding-char) ?\^M)
(char-equal (preceding-char) ?\n))
(while (string-match "[\^M]" entry)
(aset entry (match-beginning 0) ?\n )))
(let ((diary-entry (diary-sexp-entry sexp entry date))
- temp)
- (setq entry (if (consp diary-entry)
- (cdr diary-entry)
- diary-entry))
+ temp literal)
+ (setq literal entry ; before evaluation
+ entry (if (consp diary-entry)
+ (cdr diary-entry)
+ diary-entry))
(if diary-entry
- (progn
- (subst-char-in-region line-start (point) ?\^M ?\n t)
- (if (< 0 (length entry))
- (setq temp (diary-pull-attrs entry file-glob-attrs)
- entry (nth 0 temp)
- marks (nth 1 temp)))))
- (add-to-diary-list date
- entry
- specifier
- (if entry-start (copy-marker entry-start)
- nil)
- marks)
- (setq entry-found (or entry-found diary-entry)))))
+ (progn
+ (remove-overlays line-start (point) 'invisible 'diary)
+ (if (< 0 (length entry))
+ (setq temp (diary-pull-attrs entry file-glob-attrs)
+ entry (nth 0 temp)
+ marks (nth 1 temp)))))
+ (add-to-diary-list date
+ entry
+ specifier
+ (if entry-start (copy-marker entry-start)
+ nil)
+ marks
+ literal)
+ (setq entry-found (or entry-found diary-entry)))))
entry-found))
(defun diary-sexp-entry (sexp entry date)
(cons mark entry)))))
-(defun diary-anniversary (month day year &optional mark)
+(defun diary-anniversary (month day &optional year mark)
"Anniversary diary entry.
Entry applies if date is the anniversary of MONTH, DAY, YEAR if
`european-calendar-style' is nil, and DAY, MONTH, YEAR if
day
month))
(y (extract-calendar-year date))
- (diff (- y year)))
+ (diff (if year (- y year) 100)))
(if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
(setq m 3
d 1))
(concat (int-to-string days) (if (= 1 days) " day" " days")))
" until "
diary-entry)
- "*Pseudo-pattern giving form of reminder messages in the fancy diary
+ "Pseudo-pattern giving form of reminder messages in the fancy diary
display.
Used by the function `diary-remind', a pseudo-pattern is a list of
(or (diary-remind sexp (car days) marking)
(diary-remind sexp (cdr days) marking))))))
-(defvar diary-modify-entry-list-string-function nil
- "Function applied to entry string before putting it into the entries list.
-Can be used by programs integrating a diary list into other buffers (e.g.
-org.el and planner.el) to modify the string or add properties to it.
-The function takes a string argument and must return a string.")
-
-(defun add-to-diary-list (date string specifier &optional marker globcolor)
- "Add the entry (DATE STRING SPECIFIER MARKER GLOBCOLOR) to `diary-entries-list'.
-Do nothing if DATE or STRING is nil."
- (when (and date string)
- (if diary-file-name-prefix
- (let ((prefix (funcall diary-file-name-prefix-function
- (buffer-file-name))))
- (or (string= 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 marker globcolor))))))
-
(defun diary-redraw-calendar ()
"If `calendar-buffer' is live and diary entries are marked, redraw it."
(and mark-diary-entries-in-calendar
(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'. Adds `diary-redraw-calendar' to
-`write-contents-functions' for FILE, so that the calendar will be
-redrawn with the new entry marked, if necessary."
+`diary-file'."
(let ((pop-up-frames (window-dedicated-p (selected-window))))
(find-file-other-window (substitute-in-file-name (or file diary-file))))
- (add-hook 'after-save-hook 'diary-redraw-calendar nil t)
+ (when (eq major-mode default-major-mode) (diary-mode))
(widen)
(diary-unhide-everything)
(goto-char (point-max))
(if diary-header-line-flag
(setq header-line-format diary-header-line-format)))
-(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)
- '(fancy-diary-font-lock-keywords t))
- (local-set-key "q" 'quit-window))
+(defvar diary-fancy-date-pattern
+ (concat
+ (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
+ (monthname (diary-name-pattern calendar-month-name-array nil t))
+ (day "[0-9]+")
+ (month "[0-9]+")
+ (year "-?[0-9]+"))
+ (mapconcat 'eval calendar-date-display-form ""))
+ ;; Optional ": holiday name" after the date.
+ "\\(: .*\\)?")
+ "Regular expression matching a date header in Fancy Diary.")
+
+(defconst diary-time-regexp
+ ;; Accepted formats: 10:00 10.00 10h00 10h 10am 10:00am 10.00am
+ ;; Use of "." as a separator annoyingly matches numbers, eg "123.45".
+ ;; Hence often prefix this with "\\(^\\|\\s-\\)."
+ (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
+ "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
+ "\\)\\([AaPp][Mm]\\)?\\)")
+ "Regular expression matching a time of day.")
+
+(defface diary-anniversary '((t :inherit font-lock-keyword-face))
+ "Face used for anniversaries in the diary."
+ :version "22.1"
+ :group 'diary)
+
+(defface diary-time '((t :inherit font-lock-variable-name-face))
+ "Face used for times of day in the diary."
+ :version "22.1"
+ :group 'diary)
(defvar fancy-diary-font-lock-keywords
(list
- (cons
- (concat
- (let ((dayname (diary-name-pattern calendar-day-name-array nil t))
- (monthname (diary-name-pattern calendar-month-name-array nil t))
- (day "[0-9]+")
- (month "[0-9]+")
- (year "-?[0-9]+"))
- (mapconcat 'eval calendar-date-display-form ""))
- "\\(\\(: .*\\)\\|\\(\n +.*\\)\\)*\n=+$")
- 'diary-face)
- '("^.*anniversary.*$" . font-lock-keyword-face)
- '("^.*birthday.*$" . font-lock-keyword-face)
+ (list
+ ;; Any number of " other holiday name" lines, followed by "==" line.
+ (concat diary-fancy-date-pattern "\\(\n +.*\\)*\n=+$")
+ '(0 (progn (put-text-property (match-beginning 0) (match-end 0)
+ 'font-lock-multiline t)
+ diary-face)))
+ '("^.*\\([aA]nniversary\\|[bB]irthday\\).*$" . 'diary-anniversary)
'("^.*Yahrzeit.*$" . font-lock-reference-face)
'("^\\(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\\)?\\)?"
- . font-lock-variable-name-face))
+ `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
+ diary-time-regexp) . 'diary-time))
"Keywords to highlight in fancy diary display")
+;; If region looks like it might start or end in the middle of a
+;; multiline pattern, extend the region to encompass the whole pattern.
+(defun diary-fancy-font-lock-fontify-region-function (beg end &optional verbose)
+ "Function to use for `font-lock-fontify-region-function' in Fancy Diary.
+Needed to handle multiline keyword in `fancy-diary-font-lock-keywords'."
+ (goto-char beg)
+ (forward-line 0)
+ (if (looking-at "=+$") (forward-line -1))
+ (while (and (looking-at " +[^ ]")
+ (zerop (forward-line -1))))
+ ;; This check not essential.
+ (if (looking-at diary-fancy-date-pattern)
+ (setq beg (line-beginning-position)))
+ (goto-char end)
+ (forward-line 0)
+ (while (and (looking-at " +[^ ]")
+ (zerop (forward-line 1))))
+ (if (looking-at "=+$")
+ (setq end (line-beginning-position 2)))
+ (font-lock-default-fontify-region beg end verbose))
+
+(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)
+ '(fancy-diary-font-lock-keywords
+ t nil nil nil
+ (font-lock-fontify-region-function
+ . diary-fancy-font-lock-fontify-region-function)))
+ (local-set-key "q" 'quit-window))
+
(defun diary-font-lock-sexps (limit)
"Recognize sexp diary entry for font-locking."
"?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
'(1 font-lock-reference-face))
'(diary-font-lock-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\\)\\)?"
- . font-lock-function-name-face)))
+ `(,(concat "\\(^\\|\\s-\\)"
+ diary-time-regexp "\\(-" diary-time-regexp "\\)?")
+ . 'diary-time)))
"Forms to highlight in `diary-mode'.")