;;; diary-lib.el --- diary functions
;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
-;; 2004, 2005, 2006 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <rgm@gnu.org>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; This collection of functions implements the diary features as described
;; in calendar.el.
-;; Comments, corrections, and improvements should be sent to
-;; Edward M. Reingold Department of Computer Science
-;; (217) 333-6733 University of Illinois at Urbana-Champaign
-;; reingold@cs.uiuc.edu 1304 West Springfield Avenue
-;; Urbana, Illinois 61801
-
;;; Code:
(require 'calendar)
(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"
+(autoload 'calendar-check-holidays "holidays"
"Check the list of holidays for any that occur on DATE.
The value returned is a list of strings of relevant holiday descriptions.
The holidays are those in the list `calendar-holidays'.")
"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)
+(autoload 'diary-bahai-list-entries "cal-bahai"
+ "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)
+(autoload 'diary-bahai-mark-entries "cal-bahai"
+ "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)
+(autoload 'calendar-bahai-mark-date-pattern "cal-bahai"
+ "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.")
(setq attr-list (cdr attr-list)))))
(list entry ret-attr))))
+(defun diary-set-maybe-redraw (symbol value)
+ "Set SYMBOL's value to VALUE, and redraw the diary if necessary.
+Redraws the diary if it is being displayed (note this is not the same as
+just visiting the `diary-file'), and SYMBOL's value is to be changed."
+ (let ((oldvalue (eval symbol)))
+ (custom-set-default symbol value)
+ (and (not (equal value oldvalue))
+ (diary-live-p)
+ ;; Note this assumes diary was called without prefix arg.
+ (diary))))
;; 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, `diary-simple-display' will show a header line.
+ "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
+ :initialize 'custom-initialize-default
+ ;; FIXME overkill.
+ :set 'diary-set-maybe-redraw
:version "22.1")
(defvar diary-selective-display nil)
before edit/copy"
"Diary"))
?\s (frame-width)))
- "Format of the header line displayed by `diary-simple-display'.
+ "Format of the header line displayed by `simple-diary-display'.
Only used if `diary-header-line-flag' is non-nil."
:group 'diary
:type 'sexp
+ :initialize 'custom-initialize-default
+ ;; FIXME overkill.
+ :set 'diary-set-maybe-redraw
:version "22.1")
(defvar diary-saved-point) ; internal
+;; The first version of this also checked for diary-selective-display
+;; in the non-fancy case. This was an attempt to distinguish between
+;; displaying the diary and just visiting the diary file. However,
+;; when using fancy diary, calling diary when there are no entries to
+;; display does not create the fancy buffer, nor does it switch on
+;; selective-display in the diary buffer. This means some
+;; customizations will not take effect, eg:
+;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-03/msg00466.html
+;; So the check for selective-display was dropped. This means the
+;; diary will be displayed if one customizes a diary variable while
+;; just visiting the diary-file. This is i) unlikely, and ii) no great loss.
+(defun diary-live-p ()
+ "Return non-nil if the diary is being displayed."
+ (or (get-buffer fancy-diary-buffer)
+ (and diary-file
+ (find-buffer-visiting (substitute-in-file-name diary-file)))))
(defcustom number-of-diary-entries 1
"Specifies how many days of diary entries are to be displayed initially.
day's and the next day's entries will be displayed.
The value can also be a vector such as [0 2 2 2 2 4 1]; this value
-says to display no diary entries on Sunday, the display the entries
-for the current date and the day after on Monday through Thursday,
-display Friday through Monday's entries on Friday, and display only
-Saturday's entries on Saturday.
+says to display no diary entries on Sunday, the entries for
+the current date and the day after on Monday through Thursday,
+Friday through Monday's entries on Friday, and only Saturday's
+entries on Saturday.
This variable does not affect the diary display with the `d' command
from the calendar; in that case, the prefix argument controls the
(integer :tag "Thursday")
(integer :tag "Friday")
(integer :tag "Saturday")))
+ :initialize 'custom-initialize-default
+ :set 'diary-set-maybe-redraw
: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 &optional list-only)
"Create and display a buffer containing the relevant lines in `diary-file'.
(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))
+ (if (eq major-mode default-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
(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))
- (day (extract-calendar-day date))
- (year (extract-calendar-year date))
- (entry-found (list-sexp-diary-entries date)))
- (dolist (date-form diary-date-forms)
- (let*
- ((backup (when (eq (car date-form) 'backup)
- (setq date-form (cdr date-form))
- t))
- (dayname
- (format "%s\\|%s\\.?"
- (calendar-day-name date)
- (calendar-day-name date 'abbrev)))
- (monthname
- (format "\\*\\|%s\\|%s\\.?"
- (calendar-month-name month)
- (calendar-month-name month 'abbrev)))
- (month (concat "\\*\\|0*" (int-to-string month)))
- (day (concat "\\*\\|0*" (int-to-string day)))
- (year
- (concat
- "\\*\\|0*" (int-to-string year)
- (if abbreviated-calendar-year
- (concat "\\|" (format "%02d" (% year 100)))
- "")))
- (regexp
- (concat
- "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
- (mapconcat 'eval date-form "\\)\\(?:")
- "\\)"))
- (case-fold-search t))
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (if backup (re-search-backward "\\<" nil t))
- (if (and (or (char-equal (preceding-char) ?\^M)
- (char-equal (preceding-char) ?\n))
- (not (looking-at " \\|\^I")))
- ;; Diary entry that consists only of date.
- (backward-char 1)
- ;; Found a nonempty diary entry--make it
- ;; visible and add it to the list.
- (setq entry-found t)
- (let ((entry-start (point))
- date-start temp)
- (re-search-backward "\^M\\|\n\\|\\`")
- (setq date-start (point))
- ;; 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 '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))
- (add-to-diary-list
- date
- entry
- (buffer-substring
- (1+ date-start) (1- entry-start))
- (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 "" "" "" "")))))
- (setq date
- (calendar-gregorian-from-absolute
- (1+ (calendar-absolute-from-gregorian date))))
- (setq entry-found nil)))))
+ (dotimes (idummy number)
+ (let ((month (extract-calendar-month date))
+ (day (extract-calendar-day date))
+ (year (extract-calendar-year date))
+ (entry-found (list-sexp-diary-entries date)))
+ (dolist (date-form diary-date-forms)
+ (let*
+ ((backup (when (eq (car date-form) 'backup)
+ (setq date-form (cdr date-form))
+ t))
+ (dayname
+ (format "%s\\|%s\\.?"
+ (calendar-day-name date)
+ (calendar-day-name date 'abbrev)))
+ (monthname
+ (format "\\*\\|%s\\|%s\\.?"
+ (calendar-month-name month)
+ (calendar-month-name month 'abbrev)))
+ (month (concat "\\*\\|0*" (int-to-string month)))
+ (day (concat "\\*\\|0*" (int-to-string day)))
+ (year
+ (concat
+ "\\*\\|0*" (int-to-string year)
+ (if abbreviated-calendar-year
+ (concat "\\|" (format "%02d" (% year 100)))
+ "")))
+ (regexp
+ (concat
+ "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
+ (mapconcat 'eval date-form "\\)\\(?:")
+ "\\)"))
+ (case-fold-search t))
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (if backup (re-search-backward "\\<" nil t))
+ (if (and (or (char-equal (preceding-char) ?\^M)
+ (char-equal (preceding-char) ?\n))
+ (not (looking-at " \\|\^I")))
+ ;; Diary entry that consists only of date.
+ (backward-char 1)
+ ;; Found a nonempty diary entry--make it
+ ;; visible and add it to the list.
+ (setq entry-found t)
+ (let ((entry-start (point))
+ date-start temp)
+ (re-search-backward "\^M\\|\n\\|\\`")
+ (setq date-start (point))
+ ;; 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 '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))
+ (add-to-diary-list
+ date
+ entry
+ (buffer-substring
+ (1+ date-start) (1- entry-start))
+ (copy-marker entry-start) (nth 1 temp)))))))
+ (or entry-found
+ (not diary-list-include-blanks)
+ (add-to-diary-list date "" "" "" ""))
+ (setq date
+ (calendar-gregorian-from-absolute
+ (1+ (calendar-absolute-from-gregorian date))))
+ (setq entry-found nil)))))
(goto-char (point-min))
(run-hooks 'nongregorian-diary-listing-hook
'list-diary-entries-hook)
(unless list-only
(if diary-display-hook
- (run-hooks 'diary-display-hook)
- (simple-diary-display)))
+ (run-hooks 'diary-display-hook)
+ (simple-diary-display)))
(run-hooks 'diary-hook)
diary-entries-list))))))
(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)
(defun simple-diary-display ()
"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)))
+ (calendar-check-holidays original-date)))
(hol-string (format "%s%s%s"
date-string
(if holiday-list ": " "")
'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.
(and (not (cdr diary-entries-list))
(string-equal (car (cdr (car diary-entries-list))) "")))
(let* ((holiday-list (if holidays-in-diary-buffer
- (check-calendar-holidays original-date)))
+ (calendar-check-holidays original-date)))
(msg (format "No diary entries for %s %s"
(concat date-string (if holiday-list ":" ""))
(mapconcat 'identity 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))
(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))))
(let ((m displayed-month)
(y displayed-year))
(increment-calendar-month m y -1)
- (calendar-for-loop i from 0 to 2 do
- (mark-calendar-month m y month day year color)
- (increment-calendar-month m y 1)))))
+ (dotimes (idummy 3)
+ (mark-calendar-month m y month day year color)
+ (increment-calendar-month m y 1)))))
(defun mark-calendar-month (month year p-month p-day p-year &optional color)
"Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
(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
+ (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)
- (setq entry-found (or entry-found diary-entry)))))
+ (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)
(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
(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."
(eval-when-compile (require 'cal-hebrew)
(require 'cal-islam))
-(defconst diary-time-regexp
- ;; Formats that should be accepted:
- ;; 10:00 10.00 10h00 10h 10am 10:00am 10.00am
- (concat "[0-9]?[0-9]\\([AaPp][mM]\\|\\("
- "[Hh]\\([0-9][0-9]\\)?\\|[:.][0-9][0-9]"
- "\\)\\([AaPp][Mm]\\)?\\)"))
-
-(defvar diary-font-lock-keywords
- (append
- (diary-font-lock-date-forms calendar-month-name-array
- nil calendar-month-abbrev-array)
- (when (or (memq 'mark-hebrew-diary-entries
- nongregorian-diary-marking-hook)
- (memq 'list-hebrew-diary-entries
- nongregorian-diary-listing-hook))
- (require 'cal-hebrew)
- (diary-font-lock-date-forms
- calendar-hebrew-month-name-array-leap-year
- hebrew-diary-entry-symbol))
- (when (or (memq 'mark-islamic-diary-entries
- nongregorian-diary-marking-hook)
- (memq 'list-islamic-diary-entries
- nongregorian-diary-listing-hook))
- (require 'cal-islam)
- (diary-font-lock-date-forms
- calendar-islamic-month-name-array
- islamic-diary-entry-symbol))
- (list
- (cons
- (concat "^" (regexp-quote diary-include-string) ".*$")
- 'font-lock-keyword-face)
- (cons
- (concat "^" (regexp-quote diary-nonmarking-symbol)
- "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
- '(1 font-lock-reference-face))
- (cons
- (concat "^" (regexp-quote diary-nonmarking-symbol))
- 'font-lock-reference-face)
- (cons
- (concat "^" (regexp-quote diary-nonmarking-symbol)
- "?\\(" (regexp-quote hebrew-diary-entry-symbol) "\\)")
- '(1 font-lock-reference-face))
- (cons
- (concat "^" (regexp-quote diary-nonmarking-symbol)
- "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
- '(1 font-lock-reference-face))
- '(diary-font-lock-sexps . font-lock-keyword-face)
- (cons
- (concat ;; "^[ \t]+"
- diary-time-regexp "\\(-" diary-time-regexp "\\)?")
- 'font-lock-function-name-face)))
- "Forms to highlight in `diary-mode'.")
-
+(defun diary-font-lock-keywords ()
+ "Return a value for the variable `diary-font-lock-keywords'."
+ (append
+ (diary-font-lock-date-forms calendar-month-name-array
+ nil calendar-month-abbrev-array)
+ (when (or (memq 'mark-hebrew-diary-entries
+ nongregorian-diary-marking-hook)
+ (memq 'list-hebrew-diary-entries
+ nongregorian-diary-listing-hook))
+ (require 'cal-hebrew)
+ (diary-font-lock-date-forms
+ calendar-hebrew-month-name-array-leap-year
+ hebrew-diary-entry-symbol))
+ (when (or (memq 'mark-islamic-diary-entries
+ nongregorian-diary-marking-hook)
+ (memq 'list-islamic-diary-entries
+ nongregorian-diary-listing-hook))
+ (require 'cal-islam)
+ (diary-font-lock-date-forms
+ calendar-islamic-month-name-array
+ islamic-diary-entry-symbol))
+ (list
+ (cons
+ (concat "^" (regexp-quote diary-include-string) ".*$")
+ 'font-lock-keyword-face)
+ (cons
+ (concat "^" (regexp-quote diary-nonmarking-symbol)
+ "?\\(" (regexp-quote sexp-diary-entry-symbol) "\\)")
+ '(1 font-lock-reference-face))
+ (cons
+ (concat "^" (regexp-quote diary-nonmarking-symbol))
+ 'font-lock-reference-face)
+ (cons
+ (concat "^" (regexp-quote diary-nonmarking-symbol)
+ "?\\(" (regexp-quote hebrew-diary-entry-symbol) "\\)")
+ '(1 font-lock-reference-face))
+ (cons
+ (concat "^" (regexp-quote diary-nonmarking-symbol)
+ "?\\(" (regexp-quote islamic-diary-entry-symbol) "\\)")
+ '(1 font-lock-reference-face))
+ '(diary-font-lock-sexps . font-lock-keyword-face)
+ `(,(concat "\\(^\\|\\s-\\)"
+ diary-time-regexp "\\(-" diary-time-regexp "\\)?")
+ . 'diary-time))))
+
+(defvar diary-font-lock-keywords (diary-font-lock-keywords)
+ "Forms to highlight in `diary-mode'.")
;; Following code from Dave Love <fx@gnu.org>.
;; Import Outlook-format appointments from mail messages in Gnus or