emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 559d685: * lisp/calendar/diary-lib.el: Use lexical-


From: Stefan Monnier
Subject: [Emacs-diffs] master 559d685: * lisp/calendar/diary-lib.el: Use lexical-binding
Date: Mon, 4 Dec 2017 17:03:38 -0500 (EST)

branch: master
commit 559d685f68174d0401833a36cdcb573a88ee8e14
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * 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.
---
 lisp/calendar/diary-lib.el | 502 +++++++++++++++++++++++----------------------
 1 file changed, 261 insertions(+), 241 deletions(-)

diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index e45f8b2..4e7cbb3 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]