summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2017-12-04 17:03:32 -0500
committerStefan Monnier <monnier@iro.umontreal.ca>2017-12-04 17:03:32 -0500
commit559d685f68174d0401833a36cdcb573a88ee8e14 (patch)
tree66f69c2a6eed522ebad4f1daecc4b1a107a67a66
parent2dd14bf72504c1ba2b505f70d864b13e0661fc79 (diff)
downloademacs-559d685f68174d0401833a36cdcb573a88ee8e14.tar.gz
* 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.
-rw-r--r--lisp/calendar/diary-lib.el502
1 files changed, 261 insertions, 241 deletions
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index e45f8b27622..4e7cbb313db 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -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