* lisp/calendar/diary-lib.el: Use lexical-binding
(diary-pull-attrs): Avoid let...setq. (diary-list-entries-2, diary-mark-entries-1) (diary-font-lock-date-forms, diary-fancy-date-pattern): Use calendar-dlet* around uses of diary-date-forms. (list-only, number, date, entry): Don't declare globally. (diary-including): Declare. (diary-saved-point, date-string): Move before first use. (diary-list-entries): Use calendar-dlet* around diary-nongregorian-listing-hook and 'diary-list-entries-hook. (displayed-year, displayed-month): Move before first use. (diary-sexp-entry): Use calendar-let* around evaluation of the sexp. (diary-remind): Use calendar-let* around evaluation of sexp.
This commit is contained in:
Stefan Monnier
parent
2dd14bf725
commit
559d685f68
1 changed files with 261 additions and 241 deletions
|
|
@ -1,4 +1,4 @@
|
|||
;;; diary-lib.el --- diary functions
|
||||
;;; diary-lib.el --- diary functions -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 1989-1990, 1992-1995, 2001-2017 Free Software
|
||||
;; Foundation, Inc.
|
||||
|
|
@ -119,7 +119,7 @@ are: `string', `symbol', `int', `tnil', `stringtnil.'"
|
|||
:type 'boolean
|
||||
:group 'diary)
|
||||
|
||||
(defcustom diary-file-name-prefix-function 'identity
|
||||
(defcustom diary-file-name-prefix-function #'identity
|
||||
"The function that will take a diary file name and return the desired prefix."
|
||||
:type 'function
|
||||
:group 'diary)
|
||||
|
|
@ -156,7 +156,7 @@ Used for example by the appointment package - see `appt-activate'."
|
|||
:type 'hook
|
||||
:group 'diary)
|
||||
|
||||
(defcustom diary-display-function 'diary-fancy-display
|
||||
(defcustom diary-display-function #'diary-fancy-display
|
||||
"Function used to display the diary.
|
||||
The two standard options are `diary-fancy-display' and `diary-simple-display'.
|
||||
|
||||
|
|
@ -185,9 +185,9 @@ diary buffer to be displayed with diary entries from various
|
|||
included files, each day's entries sorted into lexicographic
|
||||
order, add the following to your init file:
|
||||
|
||||
(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 t)
|
||||
(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 t)
|
||||
|
||||
Note how the sort function is placed last, so that it can sort
|
||||
the entries included from other files.
|
||||
|
|
@ -251,7 +251,7 @@ use `diary-mark-entries-hook', which runs only for the main diary file."
|
|||
diary-islamic-mark-entries)
|
||||
:group 'diary)
|
||||
|
||||
(defcustom diary-print-entries-hook 'lpr-buffer
|
||||
(defcustom diary-print-entries-hook #'lpr-buffer
|
||||
"Run by `diary-print-entries' after preparing a temporary diary buffer.
|
||||
The buffer shows only the diary entries currently visible in the
|
||||
diary buffer. The default just does the printing. Other uses
|
||||
|
|
@ -328,7 +328,8 @@ Returns a string using match elements 1-5, where:
|
|||
;; use the standard function calendar-date-string.
|
||||
(concat (if month
|
||||
(calendar-date-string (list month (string-to-number day)
|
||||
(string-to-number year)) nil t)
|
||||
(string-to-number year))
|
||||
nil t)
|
||||
(cond ((eq calendar-date-style 'iso) "\\3 \\1 \\2") ; YMD
|
||||
((eq calendar-date-style 'european) "\\2 \\1 \\3") ; DMY
|
||||
(t "\\1 \\2 \\3"))) ; MDY
|
||||
|
|
@ -552,42 +553,40 @@ If ENTRY is a string, search for matches in that string, and remove them.
|
|||
Returns a list of ENTRY followed by (ATTRIBUTE VALUE) pairs.
|
||||
When ENTRY is non-nil, FILEGLOBATTRS forms the start of the (ATTRIBUTE VALUE)
|
||||
pairs."
|
||||
(let (regexp regnum attrname attrname attrvalue type ret-attr)
|
||||
(let (ret-attr)
|
||||
(if (null entry)
|
||||
(save-excursion
|
||||
(dolist (attr diary-face-attrs)
|
||||
;; FIXME inefficient searching.
|
||||
(goto-char (point-min))
|
||||
(setq regexp (concat diary-glob-file-regexp-prefix (car attr))
|
||||
regnum (cadr attr)
|
||||
attrname (nth 2 attr)
|
||||
type (nth 3 attr)
|
||||
attrvalue (if (re-search-forward regexp nil t)
|
||||
(match-string-no-properties regnum)))
|
||||
(and attrvalue
|
||||
(setq attrvalue (diary-attrtype-convert attrvalue type))
|
||||
(setq ret-attr (append ret-attr
|
||||
(list attrname attrvalue))))))
|
||||
(let* ((regexp (concat diary-glob-file-regexp-prefix (car attr)))
|
||||
(regnum (cadr attr))
|
||||
(attrname (nth 2 attr))
|
||||
(type (nth 3 attr))
|
||||
(attrvalue (if (re-search-forward regexp nil t)
|
||||
(match-string-no-properties regnum))))
|
||||
(and attrvalue
|
||||
(setq attrvalue (diary-attrtype-convert attrvalue type))
|
||||
(setq ret-attr (append ret-attr
|
||||
(list attrname attrvalue)))))))
|
||||
(setq ret-attr fileglobattrs)
|
||||
(dolist (attr diary-face-attrs)
|
||||
(setq regexp (car attr)
|
||||
regnum (cadr attr)
|
||||
attrname (nth 2 attr)
|
||||
type (nth 3 attr)
|
||||
attrvalue nil)
|
||||
;; If multiple matches, replace all, use the last (which may
|
||||
;; be the first instance in the line, if the regexp is
|
||||
;; anchored with $).
|
||||
(while (string-match regexp entry)
|
||||
(setq attrvalue (match-string-no-properties regnum entry)
|
||||
entry (replace-match "" t t entry)))
|
||||
(and attrvalue
|
||||
(setq attrvalue (diary-attrtype-convert attrvalue type))
|
||||
(setq ret-attr (append ret-attr (list attrname attrvalue))))))
|
||||
(let ((regexp (car attr))
|
||||
(regnum (cadr attr))
|
||||
(attrname (nth 2 attr))
|
||||
(type (nth 3 attr))
|
||||
(attrvalue nil))
|
||||
;; If multiple matches, replace all, use the last (which may
|
||||
;; be the first instance in the line, if the regexp is
|
||||
;; anchored with $).
|
||||
(while (string-match regexp entry)
|
||||
(setq attrvalue (match-string-no-properties regnum entry)
|
||||
entry (replace-match "" t t entry)))
|
||||
(and attrvalue
|
||||
(setq attrvalue (diary-attrtype-convert attrvalue type))
|
||||
(setq ret-attr (append ret-attr (list attrname attrvalue)))))))
|
||||
(list entry ret-attr)))
|
||||
|
||||
|
||||
|
||||
(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.
|
||||
|
|
@ -656,9 +655,12 @@ any entries were found."
|
|||
(let* ((month (calendar-extract-month date))
|
||||
(day (calendar-extract-day date))
|
||||
(year (calendar-extract-year date))
|
||||
(dayname (format "%s\\|%s\\.?" (calendar-day-name date)
|
||||
(calendar-day-name date 'abbrev)))
|
||||
(calendar-month-name-array (or months calendar-month-name-array))
|
||||
(case-fold-search t)
|
||||
entry-found)
|
||||
(calendar-dlet*
|
||||
((dayname (format "%s\\|%s\\.?" (calendar-day-name date)
|
||||
(calendar-day-name date 'abbrev)))
|
||||
(monthname (format "\\*\\|%s%s" (calendar-month-name month)
|
||||
(if months ""
|
||||
(format "\\|%s\\.?"
|
||||
|
|
@ -668,61 +670,60 @@ any entries were found."
|
|||
(year (format "\\*\\|0*%d%s" year
|
||||
(if diary-abbreviated-year-flag
|
||||
(format "\\|%02d" (% year 100))
|
||||
"")))
|
||||
(case-fold-search t)
|
||||
entry-found)
|
||||
(dolist (date-form diary-date-forms)
|
||||
(let ((backup (when (eq (car date-form) 'backup)
|
||||
(setq date-form (cdr date-form))
|
||||
t))
|
||||
;; date-form uses day etc as set above.
|
||||
(regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
|
||||
(if symbol (regexp-quote symbol) "")
|
||||
(mapconcat 'eval date-form "\\)\\(?:")))
|
||||
entry-start date-start temp)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(if backup (re-search-backward "\\<" nil t))
|
||||
;; 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.
|
||||
(backward-char 1)
|
||||
;; Found a nonempty diary entry--make it
|
||||
;; visible and add it to the list.
|
||||
(setq date-start (line-end-position 0))
|
||||
;; Actual entry starts on the next-line?
|
||||
(if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
|
||||
(setq entry-found t
|
||||
entry-start (point))
|
||||
(forward-line 1)
|
||||
(while (looking-at "[ \t]") ; continued entry
|
||||
(forward-line 1))
|
||||
(unless (and (eobp) (not (bolp)))
|
||||
(backward-char 1))
|
||||
(unless list-only
|
||||
(remove-overlays date-start (point) 'invisible 'diary))
|
||||
(setq temp (diary-pull-attrs
|
||||
(buffer-substring-no-properties
|
||||
entry-start (point)) globattr))
|
||||
(diary-add-to-list
|
||||
(or gdate date) (car temp)
|
||||
(buffer-substring-no-properties (1+ date-start) (1- entry-start))
|
||||
(copy-marker entry-start) (cadr temp))))))
|
||||
entry-found))
|
||||
""))))
|
||||
(dolist (date-form diary-date-forms)
|
||||
(let ((backup (when (eq (car date-form) 'backup)
|
||||
(setq date-form (cdr date-form))
|
||||
t))
|
||||
;; date-form uses day etc as set above.
|
||||
(regexp (format "^%s?%s\\(%s\\)" (regexp-quote mark)
|
||||
(if symbol (regexp-quote symbol) "")
|
||||
(mapconcat #'eval date-form "\\)\\(?:")))
|
||||
entry-start date-start temp)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(if backup (re-search-backward "\\<" nil t))
|
||||
;; 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.
|
||||
(backward-char 1)
|
||||
;; Found a nonempty diary entry--make it
|
||||
;; visible and add it to the list.
|
||||
(setq date-start (line-end-position 0))
|
||||
;; Actual entry starts on the next-line?
|
||||
(if (looking-at "[ \t]*\n[ \t]") (forward-line 1))
|
||||
(setq entry-found t
|
||||
entry-start (point))
|
||||
(forward-line 1)
|
||||
(while (looking-at "[ \t]") ; continued entry
|
||||
(forward-line 1))
|
||||
(unless (and (eobp) (not (bolp)))
|
||||
(backward-char 1))
|
||||
(unless list-only
|
||||
(remove-overlays date-start (point) 'invisible 'diary))
|
||||
(setq temp (diary-pull-attrs
|
||||
(buffer-substring-no-properties
|
||||
entry-start (point))
|
||||
globattr))
|
||||
(diary-add-to-list
|
||||
(or gdate date) (car temp)
|
||||
(buffer-substring-no-properties
|
||||
(1+ date-start) (1- entry-start))
|
||||
(copy-marker entry-start) (cadr temp))))))
|
||||
entry-found)))
|
||||
|
||||
(defvar original-date) ; from diary-list-entries
|
||||
(defvar file-glob-attrs)
|
||||
(defvar list-only)
|
||||
(defvar number)
|
||||
|
||||
(defun diary-list-entries-1 (months symbol absfunc)
|
||||
"List diary entries of a certain type.
|
||||
MONTHS is an array of month names. SYMBOL marks diary entries of the type
|
||||
in question. ABSFUNC is a function that converts absolute dates to dates
|
||||
of the appropriate type."
|
||||
(with-no-warnings (defvar number) (defvar list-only))
|
||||
(let ((gdate original-date))
|
||||
(dotimes (_idummy number)
|
||||
(dotimes (_ number)
|
||||
(diary-list-entries-2
|
||||
(funcall absfunc (calendar-absolute-from-gregorian gdate))
|
||||
diary-nonmarking-symbol file-glob-attrs list-only months symbol gdate)
|
||||
|
|
@ -735,6 +736,10 @@ of the appropriate type."
|
|||
"List of any diary files included in the last call to `diary-list-entries'.
|
||||
Or to `diary-mark-entries'.")
|
||||
|
||||
(defvar diary-saved-point) ; bound in diary-list-entries
|
||||
(defvar diary-including)
|
||||
(defvar date-string) ; bound in diary-list-entries
|
||||
|
||||
(defun diary-list-entries (date number &optional list-only)
|
||||
"Create and display a buffer containing the relevant lines in `diary-file'.
|
||||
Selects entries for NUMBER days starting with date DATE. Hides any
|
||||
|
|
@ -832,7 +837,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
|
|||
(set (make-local-variable 'diary-selective-display) t)
|
||||
(overlay-put ol 'invisible 'diary)
|
||||
(overlay-put ol 'evaporate t)))
|
||||
(dotimes (_idummy number)
|
||||
(dotimes (_ number)
|
||||
(let ((sexp-found (diary-list-sexp-entries date))
|
||||
(entry-found (diary-list-entries-2
|
||||
date diary-nonmarking-symbol
|
||||
|
|
@ -848,8 +853,10 @@ LIST-ONLY is non-nil, in which case it just returns the list."
|
|||
;; every time, diary-include-other-diary-files
|
||||
;; binds it to nil (essentially) when it runs
|
||||
;; in included files.
|
||||
(run-hooks 'diary-nongregorian-listing-hook
|
||||
'diary-list-entries-hook)
|
||||
(calendar-dlet* ((number number)
|
||||
(list-only list-only))
|
||||
(run-hooks 'diary-nongregorian-listing-hook
|
||||
'diary-list-entries-hook))
|
||||
;; We could make this explicit:
|
||||
;;; (run-hooks 'diary-nongregorian-listing-hook)
|
||||
;;; (if d-incp
|
||||
|
|
@ -878,8 +885,6 @@ LIST-ONLY is non-nil, in which case it just returns the list."
|
|||
(remove-overlays (point-min) (point-max) 'invisible 'diary))
|
||||
(kill-local-variable 'mode-line-format))
|
||||
|
||||
(defvar original-date) ; bound in diary-list-entries
|
||||
;(defvar number) ; already declared above
|
||||
|
||||
(defun diary-include-files (&optional mark)
|
||||
"Process diary entries from included diary files.
|
||||
|
|
@ -894,8 +899,8 @@ This is recursive; that is, included files may include other files."
|
|||
(format "^%s \"\\([^\"]*\\)\"" (regexp-quote diary-include-string))
|
||||
nil t)
|
||||
(let ((diary-file (match-string-no-properties 1))
|
||||
(diary-mark-entries-hook 'diary-mark-included-diary-files)
|
||||
(diary-list-entries-hook 'diary-include-other-diary-files)
|
||||
(diary-mark-entries-hook #'diary-mark-included-diary-files)
|
||||
(diary-list-entries-hook #'diary-include-other-diary-files)
|
||||
(diary-including t)
|
||||
diary-hook diary-list-include-blanks efile)
|
||||
(if (file-exists-p diary-file)
|
||||
|
|
@ -907,6 +912,13 @@ This is recursive; that is, included files may include other files."
|
|||
(append diary-included-files (list efile)))
|
||||
(if mark
|
||||
(diary-mark-entries)
|
||||
;; FIXME: `diary-include-files' can be run from
|
||||
;; diary-mark-entries-hook (via
|
||||
;; diary-mark-included-diary-files) or from
|
||||
;; diary-list-entries-hook (via
|
||||
;; diary-include-other-diary-files). In the "list" case,
|
||||
;; `number' is dynamically bound, but not in the "mark" case!
|
||||
(with-no-warnings (defvar number))
|
||||
(setq diary-entries-list
|
||||
(append diary-entries-list
|
||||
(diary-list-entries original-date number t)))))
|
||||
|
|
@ -929,8 +941,6 @@ For details, see `diary-include-files'.
|
|||
See also `diary-mark-included-diary-files'."
|
||||
(diary-include-files))
|
||||
|
||||
(defvar date-string) ; bound in diary-list-entries
|
||||
|
||||
(defun diary-display-no-entries ()
|
||||
"Common subroutine of `diary-simple-display' and `diary-fancy-display'.
|
||||
Handles the case where there are no diary entries.
|
||||
|
|
@ -940,7 +950,7 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
|
|||
(hol-string (format "%s%s%s"
|
||||
date-string
|
||||
(if holiday-list ": " "")
|
||||
(mapconcat 'identity holiday-list "; ")))
|
||||
(mapconcat #'identity holiday-list "; ")))
|
||||
(msg (format "No diary entries for %s" hol-string))
|
||||
;; Empty list, or single item with no text.
|
||||
;; FIXME multiple items with no text?
|
||||
|
|
@ -957,13 +967,11 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
|
|||
;; holiday-list which is too wide for a message gets a buffer.
|
||||
(calendar-in-read-only-buffer holiday-buffer
|
||||
(calendar-set-mode-line (format "Holidays for %s" date-string))
|
||||
(insert (mapconcat 'identity holiday-list "\n")))
|
||||
(insert (mapconcat #'identity holiday-list "\n")))
|
||||
(message "No diary entries for %s" date-string)))
|
||||
(cons noentries hol-string)))
|
||||
|
||||
|
||||
(defvar diary-saved-point) ; bound in diary-list-entries
|
||||
|
||||
(defun diary-simple-display ()
|
||||
"Display the diary buffer if there are any relevant entries or holidays.
|
||||
Entries that do not apply are made invisible. Holidays are shown
|
||||
|
|
@ -987,7 +995,7 @@ in the mode line. This is an option for `diary-display-function'."
|
|||
(set-window-point window diary-saved-point)
|
||||
(set-window-start window (point-min)))))))
|
||||
|
||||
(defvar diary-goto-entry-function 'diary-goto-entry
|
||||
(defvar diary-goto-entry-function #'diary-goto-entry
|
||||
"Function called to jump to a diary entry.
|
||||
Modes that require special handling of the included file
|
||||
containing the diary entry can assign a suitable function to this
|
||||
|
|
@ -1022,6 +1030,9 @@ variable.")
|
|||
(goto-char (match-beginning 1)))))
|
||||
(message "Unable to locate this diary entry")))))
|
||||
|
||||
(defvar displayed-year) ; bound in calendar-generate
|
||||
(defvar displayed-month)
|
||||
|
||||
(defun diary-fancy-display ()
|
||||
"Prepare a diary buffer with relevant entries in a fancy, noneditable form.
|
||||
Holidays are shown unless `diary-show-holidays-flag' is nil.
|
||||
|
|
@ -1204,7 +1215,7 @@ ensure that all relevant variables are set.
|
|||
(interactive "P")
|
||||
(if (string-equal diary-mail-addr "")
|
||||
(user-error "You must set `diary-mail-addr' to use this command")
|
||||
(let ((diary-display-function 'diary-fancy-display))
|
||||
(let ((diary-display-function #'diary-fancy-display))
|
||||
(diary-list-entries (calendar-current-date) (or ndays diary-mail-days)))
|
||||
(compose-mail diary-mail-addr
|
||||
(concat "Diary entries generated "
|
||||
|
|
@ -1242,109 +1253,111 @@ MARKFUNC is a function that marks entries of the appropriate type
|
|||
matching a given date pattern. MONTHS is an array of month names.
|
||||
SYMBOL marks diary entries of the type in question. ABSFUNC is a
|
||||
function that converts absolute dates to dates of the appropriate type. "
|
||||
(let ((dayname (diary-name-pattern calendar-day-name-array
|
||||
calendar-day-abbrev-array))
|
||||
(monthname (format "%s\\|\\*"
|
||||
(if months
|
||||
(diary-name-pattern months)
|
||||
(diary-name-pattern calendar-month-name-array
|
||||
calendar-month-abbrev-array))))
|
||||
(month "[0-9]+\\|\\*")
|
||||
(day "[0-9]+\\|\\*")
|
||||
(year "[0-9]+\\|\\*")
|
||||
(case-fold-search t)
|
||||
marks)
|
||||
(dolist (date-form diary-date-forms)
|
||||
(if (eq (car date-form) 'backup) ; ignore 'backup directive
|
||||
(setq date-form (cdr date-form)))
|
||||
(let* ((l (length date-form))
|
||||
(d-name-pos (- l (length (memq 'dayname date-form))))
|
||||
(d-name-pos (if (/= l d-name-pos) (1+ d-name-pos)))
|
||||
(m-name-pos (- l (length (memq 'monthname date-form))))
|
||||
(m-name-pos (if (/= l m-name-pos) (1+ m-name-pos)))
|
||||
(d-pos (- l (length (memq 'day date-form))))
|
||||
(d-pos (if (/= l d-pos) (1+ d-pos)))
|
||||
(m-pos (- l (length (memq 'month date-form))))
|
||||
(m-pos (if (/= l m-pos) (1+ m-pos)))
|
||||
(y-pos (- l (length (memq 'year date-form))))
|
||||
(y-pos (if (/= l y-pos) (1+ y-pos)))
|
||||
(regexp (format "^%s\\(%s\\)"
|
||||
(if symbol (regexp-quote symbol) "")
|
||||
(mapconcat 'eval date-form "\\)\\("))))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(let* ((dd-name
|
||||
(if d-name-pos
|
||||
(match-string-no-properties d-name-pos)))
|
||||
(mm-name
|
||||
(if m-name-pos
|
||||
(match-string-no-properties m-name-pos)))
|
||||
(mm (string-to-number
|
||||
(if m-pos
|
||||
(match-string-no-properties m-pos)
|
||||
"")))
|
||||
(dd (string-to-number
|
||||
(if d-pos
|
||||
(match-string-no-properties d-pos)
|
||||
"")))
|
||||
(y-str (if y-pos
|
||||
(match-string-no-properties y-pos)))
|
||||
(yy (if (not y-str)
|
||||
0
|
||||
(if (and (= (length y-str) 2)
|
||||
diary-abbreviated-year-flag)
|
||||
(let* ((current-y
|
||||
(calendar-extract-year
|
||||
(if absfunc
|
||||
(funcall
|
||||
absfunc
|
||||
(calendar-absolute-from-gregorian
|
||||
(calendar-current-date)))
|
||||
(calendar-current-date))))
|
||||
(y (+ (string-to-number y-str)
|
||||
;; Current century, eg 2000.
|
||||
(* 100 (/ current-y 100))))
|
||||
(offset (- y current-y)))
|
||||
;; Add 2-digit year to current century.
|
||||
;; If more than 50 years in the future,
|
||||
;; assume last century. If more than 50
|
||||
;; years in the past, assume next century.
|
||||
(if (> offset 50)
|
||||
(- y 100)
|
||||
(if (< offset -50)
|
||||
(+ y 100)
|
||||
y)))
|
||||
(string-to-number y-str)))))
|
||||
(setq marks (cadr (diary-pull-attrs
|
||||
(buffer-substring-no-properties
|
||||
(point) (line-end-position))
|
||||
file-glob-attrs)))
|
||||
;; Only mark all days of a given name if the pattern
|
||||
;; contains no more specific elements.
|
||||
(if (and dd-name (not (or d-pos m-pos y-pos)))
|
||||
(calendar-mark-days-named
|
||||
(cdr (assoc-string dd-name
|
||||
(calendar-dlet*
|
||||
((dayname (diary-name-pattern calendar-day-name-array
|
||||
calendar-day-abbrev-array))
|
||||
(monthname (format "%s\\|\\*"
|
||||
(if months
|
||||
(diary-name-pattern months)
|
||||
(diary-name-pattern calendar-month-name-array
|
||||
calendar-month-abbrev-array))))
|
||||
(month "[0-9]+\\|\\*")
|
||||
(day "[0-9]+\\|\\*")
|
||||
(year "[0-9]+\\|\\*"))
|
||||
(let* ((case-fold-search t)
|
||||
marks)
|
||||
(dolist (date-form diary-date-forms)
|
||||
(if (eq (car date-form) 'backup) ; ignore 'backup directive
|
||||
(setq date-form (cdr date-form)))
|
||||
(let* ((l (length date-form))
|
||||
(d-name-pos (- l (length (memq 'dayname date-form))))
|
||||
(d-name-pos (if (/= l d-name-pos) (1+ d-name-pos)))
|
||||
(m-name-pos (- l (length (memq 'monthname date-form))))
|
||||
(m-name-pos (if (/= l m-name-pos) (1+ m-name-pos)))
|
||||
(d-pos (- l (length (memq 'day date-form))))
|
||||
(d-pos (if (/= l d-pos) (1+ d-pos)))
|
||||
(m-pos (- l (length (memq 'month date-form))))
|
||||
(m-pos (if (/= l m-pos) (1+ m-pos)))
|
||||
(y-pos (- l (length (memq 'year date-form))))
|
||||
(y-pos (if (/= l y-pos) (1+ y-pos)))
|
||||
(regexp (format "^%s\\(%s\\)"
|
||||
(if symbol (regexp-quote symbol) "")
|
||||
(mapconcat #'eval date-form "\\)\\("))))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward regexp nil t)
|
||||
(let* ((dd-name
|
||||
(if d-name-pos
|
||||
(match-string-no-properties d-name-pos)))
|
||||
(mm-name
|
||||
(if m-name-pos
|
||||
(match-string-no-properties m-name-pos)))
|
||||
(mm (string-to-number
|
||||
(if m-pos
|
||||
(match-string-no-properties m-pos)
|
||||
"")))
|
||||
(dd (string-to-number
|
||||
(if d-pos
|
||||
(match-string-no-properties d-pos)
|
||||
"")))
|
||||
(y-str (if y-pos
|
||||
(match-string-no-properties y-pos)))
|
||||
(yy (if (not y-str)
|
||||
0
|
||||
(if (and (= (length y-str) 2)
|
||||
diary-abbreviated-year-flag)
|
||||
(let* ((current-y
|
||||
(calendar-extract-year
|
||||
(if absfunc
|
||||
(funcall
|
||||
absfunc
|
||||
(calendar-absolute-from-gregorian
|
||||
(calendar-current-date)))
|
||||
(calendar-current-date))))
|
||||
(y (+ (string-to-number y-str)
|
||||
;; Current century, eg 2000.
|
||||
(* 100 (/ current-y 100))))
|
||||
(offset (- y current-y)))
|
||||
;; Add 2-digit year to current century.
|
||||
;; If more than 50 years in the future,
|
||||
;; assume last century. If more than 50
|
||||
;; years in the past, assume next century.
|
||||
(if (> offset 50)
|
||||
(- y 100)
|
||||
(if (< offset -50)
|
||||
(+ y 100)
|
||||
y)))
|
||||
(string-to-number y-str)))))
|
||||
(setq marks (cadr (diary-pull-attrs
|
||||
(buffer-substring-no-properties
|
||||
(point) (line-end-position))
|
||||
file-glob-attrs)))
|
||||
;; Only mark all days of a given name if the pattern
|
||||
;; contains no more specific elements.
|
||||
(if (and dd-name (not (or d-pos m-pos y-pos)))
|
||||
(calendar-mark-days-named
|
||||
(cdr (assoc-string dd-name
|
||||
(calendar-make-alist
|
||||
calendar-day-name-array
|
||||
0 nil calendar-day-abbrev-array
|
||||
(mapcar (lambda (e)
|
||||
(format "%s." e))
|
||||
calendar-day-abbrev-array))
|
||||
t))
|
||||
marks)
|
||||
(if mm-name
|
||||
(setq mm
|
||||
(if (string-equal mm-name "*") 0
|
||||
(cdr (assoc-string
|
||||
mm-name
|
||||
(if months (calendar-make-alist months)
|
||||
(calendar-make-alist
|
||||
calendar-day-name-array
|
||||
0 nil calendar-day-abbrev-array
|
||||
calendar-month-name-array
|
||||
1 nil calendar-month-abbrev-array
|
||||
(mapcar (lambda (e)
|
||||
(format "%s." e))
|
||||
calendar-day-abbrev-array))
|
||||
t)) marks)
|
||||
(if mm-name
|
||||
(setq mm
|
||||
(if (string-equal mm-name "*") 0
|
||||
(cdr (assoc-string
|
||||
mm-name
|
||||
(if months (calendar-make-alist months)
|
||||
(calendar-make-alist
|
||||
calendar-month-name-array
|
||||
1 nil calendar-month-abbrev-array
|
||||
(mapcar (lambda (e)
|
||||
(format "%s." e))
|
||||
calendar-month-abbrev-array)))
|
||||
t)))))
|
||||
(funcall markfunc mm dd yy marks))))))))
|
||||
calendar-month-abbrev-array)))
|
||||
t)))))
|
||||
(funcall markfunc mm dd yy marks)))))))))
|
||||
|
||||
;;;###cal-autoload
|
||||
(defun diary-mark-entries (&optional redraw)
|
||||
|
|
@ -1406,30 +1419,30 @@ marks. This is intended to deal with deleted diary entries."
|
|||
|
||||
(defun diary-sexp-entry (sexp entry date)
|
||||
"Process a SEXP diary ENTRY for DATE."
|
||||
(let ((result (if calendar-debug-sexp
|
||||
(let ((debug-on-error t))
|
||||
(eval (car (read-from-string sexp))))
|
||||
(let (err)
|
||||
(condition-case err
|
||||
(eval (car (read-from-string sexp)))
|
||||
(error
|
||||
(display-warning
|
||||
'diary
|
||||
(format "Bad diary sexp at line %d in %s:\n%s\n\
|
||||
Error: %s\n"
|
||||
(count-lines (point-min) (point))
|
||||
diary-file sexp err)
|
||||
:error)
|
||||
nil))))))
|
||||
(let ((result
|
||||
(calendar-dlet* ((date date)
|
||||
(entry entry))
|
||||
(if calendar-debug-sexp
|
||||
(let ((debug-on-error t))
|
||||
(eval (car (read-from-string sexp))))
|
||||
(condition-case err
|
||||
(eval (car (read-from-string sexp)))
|
||||
(error
|
||||
(display-warning
|
||||
'diary
|
||||
(format "Bad diary sexp at line %d in %s:\n%s\n\
|
||||
Error: %S\n"
|
||||
(count-lines (point-min) (point))
|
||||
diary-file sexp err)
|
||||
:error)
|
||||
nil))))))
|
||||
(cond ((stringp result) result)
|
||||
((and (consp result)
|
||||
(stringp (cdr result))) result)
|
||||
(stringp (cdr result)))
|
||||
result)
|
||||
(result entry)
|
||||
(t nil))))
|
||||
|
||||
(defvar displayed-year) ; bound in calendar-generate
|
||||
(defvar displayed-month)
|
||||
|
||||
(defun diary-mark-sexp-entries ()
|
||||
"Mark days in the calendar window that have sexp diary entries.
|
||||
Each entry in the diary file (or included files) visible in the calendar window
|
||||
|
|
@ -1532,7 +1545,7 @@ passed to `calendar-mark-visible-date' as MARK."
|
|||
(let ((m displayed-month)
|
||||
(y displayed-year))
|
||||
(calendar-increment-month m y -1)
|
||||
(dotimes (_idummy 3)
|
||||
(dotimes (_ 3)
|
||||
(calendar-mark-month m y month day year color)
|
||||
(calendar-increment-month m y 1)))))
|
||||
|
||||
|
|
@ -1814,9 +1827,6 @@ form used internally by the calendar and diary."
|
|||
|
||||
;;; Sexp diary functions.
|
||||
|
||||
(defvar date)
|
||||
(defvar entry)
|
||||
|
||||
;; To be called from diary-sexp-entry, where DATE, ENTRY are bound.
|
||||
(defun diary-date (month day year &optional mark)
|
||||
"Specific date(s) diary entry.
|
||||
|
|
@ -1827,6 +1837,7 @@ of the input parameters changes according to `calendar-date-style'
|
|||
|
||||
An optional parameter MARK specifies a face or single-character string
|
||||
to use when highlighting the day in the calendar."
|
||||
(with-no-warnings (defvar date) (defvar entry))
|
||||
(let* ((ddate (diary-make-date month day year))
|
||||
(dd (calendar-extract-day ddate))
|
||||
(mm (calendar-extract-month ddate))
|
||||
|
|
@ -1855,6 +1866,7 @@ of the input parameters changes according to `calendar-date-style'
|
|||
|
||||
An optional parameter MARK specifies a face or single-character string
|
||||
to use when highlighting the day in the calendar."
|
||||
(with-no-warnings (defvar date) (defvar entry))
|
||||
(let ((date1 (calendar-absolute-from-gregorian
|
||||
(diary-make-date m1 d1 y1)))
|
||||
(date2 (calendar-absolute-from-gregorian
|
||||
|
|
@ -1873,6 +1885,7 @@ DAY defaults to 1 if N>0, and MONTH's last day otherwise.
|
|||
MONTH can be a list of months, an integer, or t (meaning all months).
|
||||
Optional MARK specifies a face or single-character string to use when
|
||||
highlighting the day in the calendar."
|
||||
(with-no-warnings (defvar date) (defvar entry))
|
||||
;; This is messy because the diary entry may apply, but the date on which it
|
||||
;; is based can be in a different month/year. For example, asking for the
|
||||
;; first Monday after December 30. For large values of |n| the problem is
|
||||
|
|
@ -1951,6 +1964,7 @@ is considered to be March 1 in non-leap years.
|
|||
|
||||
An optional parameter MARK specifies a face or single-character
|
||||
string to use when highlighting the day in the calendar."
|
||||
(with-no-warnings (defvar date) (defvar entry))
|
||||
(let* ((ddate (diary-make-date month day year))
|
||||
(dd (calendar-extract-day ddate))
|
||||
(mm (calendar-extract-month ddate))
|
||||
|
|
@ -1975,6 +1989,7 @@ and %s by the ordinal ending of that number (that is, `st', `nd',
|
|||
|
||||
An optional parameter MARK specifies a face or single-character
|
||||
string to use when highlighting the day in the calendar."
|
||||
(with-no-warnings (defvar date) (defvar entry))
|
||||
(or (> n 0)
|
||||
(user-error "Day count must be positive"))
|
||||
(let* ((diff (- (calendar-absolute-from-gregorian date)
|
||||
|
|
@ -1986,6 +2001,7 @@ string to use when highlighting the day in the calendar."
|
|||
|
||||
(defun diary-day-of-year ()
|
||||
"Day of year and number of days remaining in the year of date diary entry."
|
||||
(with-no-warnings (defvar date))
|
||||
(calendar-day-of-year-string date))
|
||||
|
||||
(defun diary-remind (sexp days &optional marking)
|
||||
|
|
@ -2007,11 +2023,12 @@ whether the entry itself is a marking or nonmarking; if optional
|
|||
parameter MARKING is non-nil then the reminders are marked on the
|
||||
calendar."
|
||||
;; `date' has a value at this point, from diary-sexp-entry.
|
||||
(with-no-warnings (defvar date))
|
||||
;; Convert a negative number to a list of days.
|
||||
(and (integerp days)
|
||||
(< days 0)
|
||||
(setq days (number-sequence 1 (- days))))
|
||||
(let ((diary-entry (eval sexp)))
|
||||
(calendar-dlet* ((diary-entry (eval sexp)))
|
||||
(cond
|
||||
;; Diary entry applies on date.
|
||||
((and diary-entry
|
||||
|
|
@ -2027,7 +2044,7 @@ calendar."
|
|||
(when (setq diary-entry (eval sexp))
|
||||
;; Discard any mark portion from diary-anniversary, etc.
|
||||
(if (consp diary-entry) (setq diary-entry (cdr diary-entry)))
|
||||
(mapconcat 'eval diary-remind-message ""))))
|
||||
(mapconcat #'eval diary-remind-message ""))))
|
||||
;; Diary entry may apply to one of a list of days before date.
|
||||
((and (listp days) days)
|
||||
(or (diary-remind sexp (car days) marking)
|
||||
|
|
@ -2224,18 +2241,19 @@ If given, optional SYMBOL must be a prefix to entries. If
|
|||
optional ABBREV-ARRAY is present, also matches the abbreviations
|
||||
from this array (with or without a final `.'), in addition to the
|
||||
full month names."
|
||||
(let ((dayname (diary-name-pattern calendar-day-name-array
|
||||
calendar-day-abbrev-array t))
|
||||
(monthname (format "\\(%s\\|\\*\\)"
|
||||
(diary-name-pattern month-array abbrev-array)))
|
||||
(month "\\([0-9]+\\|\\*\\)")
|
||||
(day "\\([0-9]+\\|\\*\\)")
|
||||
(year "-?\\([0-9]+\\|\\*\\)"))
|
||||
(calendar-dlet*
|
||||
((dayname (diary-name-pattern calendar-day-name-array
|
||||
calendar-day-abbrev-array t))
|
||||
(monthname (format "\\(%s\\|\\*\\)"
|
||||
(diary-name-pattern month-array abbrev-array)))
|
||||
(month "\\([0-9]+\\|\\*\\)")
|
||||
(day "\\([0-9]+\\|\\*\\)")
|
||||
(year "-?\\([0-9]+\\|\\*\\)"))
|
||||
(mapcar (lambda (x)
|
||||
(cons
|
||||
(concat "^" (regexp-quote diary-nonmarking-symbol) "?"
|
||||
(if symbol (regexp-quote symbol) "") "\\("
|
||||
(mapconcat 'eval
|
||||
(mapconcat #'eval
|
||||
;; If backup, omit first item (backup)
|
||||
;; and last item (not part of date).
|
||||
(if (equal (car x) 'backup)
|
||||
|
|
@ -2312,7 +2330,7 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
|
|||
'font-lock-constant-face)
|
||||
(cons
|
||||
(format "^%s?%s" (regexp-quote diary-nonmarking-symbol)
|
||||
(regexp-opt (mapcar 'regexp-quote
|
||||
(regexp-opt (mapcar #'regexp-quote
|
||||
(list diary-hebrew-entry-symbol
|
||||
diary-islamic-entry-symbol
|
||||
diary-bahai-entry-symbol
|
||||
|
|
@ -2345,10 +2363,10 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
|
|||
(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)
|
||||
(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)
|
||||
(add-hook 'after-revert-hook #'diary-redraw-calendar nil t)
|
||||
(if diary-header-line-flag
|
||||
(setq header-line-format diary-header-line-format)))
|
||||
|
||||
|
|
@ -2359,18 +2377,19 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL."
|
|||
"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 "1")
|
||||
(month "2")
|
||||
;; FIXME? This used to be "-?[0-9]+" - what was the "-?" for?
|
||||
(year "3"))
|
||||
(calendar-dlet*
|
||||
((dayname (diary-name-pattern calendar-day-name-array nil t))
|
||||
(monthname (diary-name-pattern calendar-month-name-array nil t))
|
||||
(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 "")
|
||||
(mapconcat #'eval calendar-date-display-form "")
|
||||
nil t))
|
||||
;; Optional ": holiday name" after the date.
|
||||
"\\(: .*\\)?"))
|
||||
|
|
@ -2391,7 +2410,8 @@ This depends on the calendar date style."
|
|||
("^Day.*omer.*$" . font-lock-builtin-face)
|
||||
("^Parashat.*$" . font-lock-comment-face)
|
||||
(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp
|
||||
diary-time-regexp) . 'diary-time))
|
||||
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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue