;;; diary-lib.el --- diary functions
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; Copyright (C) 1989-1990, 1992-1995, 2001-2011
;; Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
:type 'string
:group 'diary)
+(defcustom diary-comment-start nil
+ "String marking the start of a comment in the diary, or nil.
+Nil means there are no comments. The diary does not display
+parts of entries that are inside comments. You can use comments
+for whatever you like, e.g. for meta-data that packages such as
+`appt.el' can use.
+See also `diary-comment-end'."
+ :version "24.1"
+ :type '(choice (const :tag "No comment" nil) string)
+ :group 'diary)
+
+(defcustom diary-comment-end ""
+ "String marking the end of a comment in the diary.
+The empty string means comments finish at the end of a line.
+See also `diary-comment-start'."
+ :version "24.1"
+ :type 'string
+ :group 'diary)
+
(defcustom diary-hook nil
"List of functions called after the display of the diary.
Used for example by the appointment package - see `appt-activate'."
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."
+FILENAME being the file containing the diary entry.
+
+Modifies STRING using `diary-modify-entry-list-string-function', if non-nil.
+Also removes the region between `diary-comment-start' and
+`diary-comment-end', if the former is non-nil."
(when (and date string)
;; b-f-n is nil if we are visiting an include file in a temp-buffer.
- (let ((dfile (or (buffer-file-name) diary-file)))
+ (let ((dfile (or (buffer-file-name) diary-file))
+ cstart)
(if diary-file-name-prefix
(let ((prefix (funcall diary-file-name-prefix-function dfile)))
(or (string-equal prefix "")
(and diary-modify-entry-list-string-function
(setq string (funcall diary-modify-entry-list-string-function
string)))
+ (when (and diary-comment-start
+ (string-match (setq cstart (regexp-quote diary-comment-start))
+ string))
+ ;; Preserve the value with the comments.
+ (or literal (setq literal string))
+ (setq string (replace-regexp-in-string
+ (format "%s.*%s" cstart
+ (if (zerop (length diary-comment-end)) "$"
+ (regexp-quote diary-comment-end)))
+ "" string)))
(setq diary-entries-list
(append diary-entries-list
(list (list date string specifier
in question. ABSFUNC is a function that converts absolute dates to dates
of the appropriate type."
(let ((gdate original-date))
- (dotimes (idummy number)
+ (dotimes (_idummy number)
(diary-list-entries-2
(funcall absfunc (calendar-absolute-from-gregorian gdate))
diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate)
(set (make-local-variable 'diary-selective-display) t)
(overlay-put ol 'invisible 'diary)
(overlay-put ol 'evaporate t)))
- (dotimes (idummy number)
+ (dotimes (_idummy number)
(let ((sexp-found (diary-list-sexp-entries date))
(entry-found (diary-list-entries-2
date diary-nonmarking-symbol
(defun diary-sexp-entry (sexp entry date)
"Process a SEXP diary ENTRY for DATE."
(let ((result (if calendar-debug-sexp
- (let ((stack-trace-on-error t))
+ (let ((debug-on-error t))
(eval (car (read-from-string sexp))))
(condition-case nil
(eval (car (read-from-string sexp)))
(let ((m displayed-month)
(y displayed-year))
(calendar-increment-month m y -1)
- (dotimes (idummy 3)
+ (dotimes (_idummy 3)
(calendar-mark-month m y month day year color)
(calendar-increment-month m y 1)))))
'(day " " monthname))
(t '(monthname " " day))))
;; Iso cannot contain "-", because this form used eg by
- ;; insert-anniversary-diary-entry.
+ ;; diary-insert-anniversary-entry.
(t (cond ((eq calendar-date-style 'iso)
'((format "%s %.2d %.2d" year
(string-to-number month) (string-to-number day))))
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'.")
"Major mode for editing the diary file."
(set (make-local-variable 'font-lock-defaults)
'(diary-font-lock-keywords t))
+ (set (make-local-variable 'comment-start) diary-comment-start)
+ (set (make-local-variable 'comment-end) diary-comment-end)
(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
;;; Fancy Diary Mode.
-;; FIXME does not update upon changes to the name-arrays.
-(defvar diary-fancy-date-pattern
+(defun diary-fancy-date-pattern ()
+ "Return a regexp matching the first line of a fancy diary date header.
+This depends on the calendar date style."
(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 ""))
+ (day "1")
+ (month "2")
+ ;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
+ (year "3"))
+ ;; This is ugly. c-d-d-form expects `day' etc to be "numbers in
+ ;; string form"; eg the iso version calls string-to-number on some.
+ ;; Therefore we cannot eg just let day = "[0-9]+". (Bug#8583).
+ ;; Assumes no integers in c-day/month-name-array.
+ (replace-regexp-in-string "[0-9]+" "[0-9]+"
+ (mapconcat 'eval calendar-date-display-form "")
+ nil t))
;; Optional ": holiday name" after the date.
- "\\(: .*\\)?")
- "Regular expression matching a date header in Fancy Diary.")
+ "\\(: .*\\)?"))
+
+(defun diary-fancy-date-matcher (limit)
+ "Search for a fancy diary data header, up to LIMIT."
+ ;; Any number of " other holiday name" lines, followed by "==" line.
+ (when (re-search-forward
+ (format "%s\\(\n +.*\\)*\n=+$" (diary-fancy-date-pattern)) limit t)
+ (put-text-property (match-beginning 0) (match-end 0) 'font-lock-multiline t)
+ t))
(define-obsolete-variable-alias 'fancy-diary-font-lock-keywords
'diary-fancy-font-lock-keywords "23.1")
(defvar diary-fancy-font-lock-keywords
- (list
- (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)
- `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
+ `((diary-fancy-date-matcher . 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)
+ (,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
diary-time-regexp) . 'diary-time))
"Keywords to highlight in fancy diary display.")
(while (and (looking-at " +[^ ]")
(zerop (forward-line -1))))
;; This check not essential.
- (if (looking-at diary-fancy-date-pattern)
+ (if (looking-at (diary-fancy-date-pattern))
(setq beg (line-beginning-position)))
(goto-char end)
(forward-line 0)
(setq end (line-beginning-position 2)))
(font-lock-default-fontify-region beg end verbose))
-(defvar diary-fancy-overriding-map (let ((map (make-sparse-keymap)))
- (define-key map "q" 'quit-window)
- map)
+(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 fundamental-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))
HCoop / bpt / emacs.git / blobdiff