summaryrefslogtreecommitdiff
path: root/lisp/calendar
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calendar')
-rw-r--r--lisp/calendar/appt.el44
-rw-r--r--lisp/calendar/cal-dst.el102
-rw-r--r--lisp/calendar/cal-tex.el2
-rw-r--r--lisp/calendar/calendar.el144
-rw-r--r--lisp/calendar/diary-lib.el534
-rw-r--r--lisp/calendar/holidays.el1
-rw-r--r--lisp/calendar/icalendar.el80
-rw-r--r--lisp/calendar/solar.el21
-rw-r--r--lisp/calendar/todo-mode.el55
9 files changed, 515 insertions, 468 deletions
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el
index 5841cb6a3a3..0259dd1e1e5 100644
--- a/lisp/calendar/appt.el
+++ b/lisp/calendar/appt.el
@@ -1,4 +1,4 @@
-;;; appt.el --- appointment notification functions
+;;; appt.el --- appointment notification functions -*- lexical-binding:t -*-
;; Copyright (C) 1989-1990, 1994, 1998, 2001-2018 Free Software
;; Foundation, Inc.
@@ -90,8 +90,7 @@ The first subexpression matches the time in minutes (an integer).
This overrides the default `appt-message-warning-time'.
You may want to put this inside a diary comment (see `diary-comment-start').
For example, to be warned 30 minutes in advance of an appointment:
- 2011/06/01 12:00 Do something ## warntime 30
-"
+ 2011/06/01 12:00 Do something ## warntime 30"
:version "24.1"
:type 'regexp
:group 'appt)
@@ -150,7 +149,7 @@ always updates every minute."
:type 'integer
:group 'appt)
-(defcustom appt-disp-window-function 'appt-disp-window
+(defcustom appt-disp-window-function #'appt-disp-window
"Function called to display appointment window.
Only relevant if reminders are being displayed in a window.
It should take three string arguments: the number of minutes till
@@ -160,7 +159,7 @@ relevant at any one time."
:type 'function
:group 'appt)
-(defcustom appt-delete-window-function 'appt-delete-window
+(defcustom appt-delete-window-function #'appt-delete-window
"Function called to remove appointment window and buffer.
Only relevant if reminders are being displayed in a window."
:type 'function
@@ -228,12 +227,11 @@ also calls `beep' for an audible reminder."
string (car string)))
(cond ((eq appt-display-format 'window)
;; TODO use calendar-month-abbrev-array rather than %b?
- (let ((time (format-time-string "%a %b %e "))
- err)
+ (let ((time (format-time-string "%a %b %e ")))
(condition-case err
(funcall appt-disp-window-function
(if (listp mins)
- (mapcar 'number-to-string mins)
+ (mapcar #'number-to-string mins)
(number-to-string mins))
time string)
(wrong-type-argument
@@ -250,7 +248,7 @@ update it for multiple appts?")
appt-delete-window-function))
((eq appt-display-format 'echo)
(message "%s" (if (listp string)
- (mapconcat 'identity string "\n")
+ (mapconcat #'identity string "\n")
string)))))
(defun appt-mode-line (min-to-app &optional abbrev)
@@ -267,7 +265,7 @@ If ABBREV is non-nil, abbreviates some text."
(if multiple "s" "")
(if (equal imin "0") "now"
(format "in %s %s"
- (or imin (mapconcat 'identity min-to-app ","))
+ (or imin (mapconcat #'identity min-to-app ","))
(if abbrev "min."
(format "minute%s" (if (equal imin "1") "" "s"))))))))
@@ -335,9 +333,9 @@ displayed in a window:
(null appt-prev-comp-time) ; first check
(< now-mins appt-prev-comp-time)) ; new day
(ignore-errors
- (let ((diary-hook (if (assoc 'appt-make-list diary-hook)
+ (let ((diary-hook (if (memq #'appt-make-list diary-hook)
diary-hook
- (cons 'appt-make-list diary-hook))))
+ (cons #'appt-make-list diary-hook))))
(if appt-display-diary
(diary)
;; Not displaying the diary, so we can ignore
@@ -405,8 +403,9 @@ displayed in a window:
(when appt-display-mode-line
(setq appt-mode-string
(concat " " (propertize
- (appt-mode-line (mapcar 'number-to-string
- min-list) t)
+ (appt-mode-line (mapcar #'number-to-string
+ min-list)
+ t)
'face 'mode-line-emphasis))))
;; Reset count to 0 in case we display another appt on the next cycle.
(setq appt-display-count (if (eq '(0) min-list) 0
@@ -458,14 +457,14 @@ separate appointment."
;; FIXME Link to diary entry?
(calendar-set-mode-line
(format " %s. %s" (appt-mode-line min-to-app)
- (mapconcat 'identity new-time ", ")))
+ (mapconcat #'identity new-time ", ")))
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
;; If we have appointments at different times, prepend the times.
(if (or (= 1 (length min-to-app))
(not (delete (car min-to-app) min-to-app)))
- (insert (mapconcat 'identity appt-msg "\n"))
+ (insert (mapconcat #'identity appt-msg "\n"))
(dotimes (i (length appt-msg))
(insert (format "%s%sm: %s" (if (> i 0) "\n" "")
(nth i min-to-app) (nth i appt-msg)))))
@@ -547,19 +546,18 @@ sMinutes before the appointment to start warning: ")
(message ""))
-(defvar number)
-(defvar original-date)
(defvar diary-entries-list)
(defun appt-make-list ()
"Update the appointments list from today's diary buffer.
The time must be at the beginning of a line for it to be
put in the appointments list (see examples in documentation of
-the function `appt-check'). We assume that the variables DATE and
-NUMBER hold the arguments that `diary-list-entries' received.
+the function `appt-check'). We assume that the variables `original-date' and
+`number' hold the arguments that `diary-list-entries' received.
They specify the range of dates that the diary is being processed for.
Any appointments made with `appt-add' are not affected by this function."
+ (with-no-warnings (defvar number) (defvar original-date))
;; We have something to do if the range of dates that the diary is
;; considering includes the current date.
(if (and (not (calendar-date-compare
@@ -701,7 +699,7 @@ ARG is positive, otherwise off."
(let ((appt-active appt-timer))
(setq appt-active (if arg (> (prefix-numeric-value arg) 0)
(not appt-active)))
- (remove-hook 'write-file-functions 'appt-update-list)
+ (remove-hook 'write-file-functions #'appt-update-list)
(or global-mode-string (setq global-mode-string '("")))
(delq 'appt-mode-string global-mode-string)
(when appt-timer
@@ -709,8 +707,8 @@ ARG is positive, otherwise off."
(setq appt-timer nil))
(if appt-active
(progn
- (add-hook 'write-file-functions 'appt-update-list)
- (setq appt-timer (run-at-time t 60 'appt-check)
+ (add-hook 'write-file-functions #'appt-update-list)
+ (setq appt-timer (run-at-time t 60 #'appt-check)
global-mode-string
(append global-mode-string '(appt-mode-string)))
(appt-check t)
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 508ae2c995f..00a8e7498af 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -1,4 +1,4 @@
-;;; cal-dst.el --- calendar functions for daylight saving rules
+;;; cal-dst.el --- calendar functions for daylight saving rules -*- lexical-binding:t -*-
;; Copyright (C) 1993-1996, 2001-2018 Free Software Foundation, Inc.
@@ -220,29 +220,30 @@ The result has the proper form for `calendar-daylight-savings-starts'."
'((calendar-gregorian-from-absolute
(calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
(prevday-sec (- -1 utc-diff)) ; last sec of previous local day
- (year (1+ y))
new-rules)
- ;; Scan through the next few years until only one rule remains.
- (while (cdr candidate-rules)
- (dolist (rule candidate-rules)
- ;; The rule we return should give a Gregorian date, but here
- ;; we require an absolute date. The following is for efficiency.
- (setq date (cond ((eq (car rule) 'calendar-nth-named-day)
- (eval (cons 'calendar-nth-named-absday (cdr rule))))
- ((eq (car rule) 'calendar-gregorian-from-absolute)
- (eval (cadr rule)))
- (t (calendar-absolute-from-gregorian (eval rule)))))
- (or (equal (current-time-zone
- (calendar-time-from-absolute date prevday-sec))
- (current-time-zone
- (calendar-time-from-absolute (1+ date) prevday-sec)))
- (setq new-rules (cons rule new-rules))))
- ;; If no rules remain, just use the first candidate rule;
- ;; it's wrong in general, but it's right for at least one year.
- (setq candidate-rules (if new-rules (nreverse new-rules)
- (list (car candidate-rules)))
- new-rules nil
- year (1+ year)))
+ (calendar-dlet* ((year (1+ y)))
+ ;; Scan through the next few years until only one rule remains.
+ (while (cdr candidate-rules)
+ (dolist (rule candidate-rules)
+ ;; The rule we return should give a Gregorian date, but here
+ ;; we require an absolute date. The following is for efficiency.
+ (setq date (cond ((eq (car rule) #'calendar-nth-named-day)
+ (eval (cons #'calendar-nth-named-absday
+ (cdr rule))))
+ ((eq (car rule) #'calendar-gregorian-from-absolute)
+ (eval (cadr rule)))
+ (t (calendar-absolute-from-gregorian (eval rule)))))
+ (or (equal (current-time-zone
+ (calendar-time-from-absolute date prevday-sec))
+ (current-time-zone
+ (calendar-time-from-absolute (1+ date) prevday-sec)))
+ (setq new-rules (cons rule new-rules))))
+ ;; If no rules remain, just use the first candidate rule;
+ ;; it's wrong in general, but it's right for at least one year.
+ (setq candidate-rules (if new-rules (nreverse new-rules)
+ (list (car candidate-rules)))
+ new-rules nil
+ year (1+ year))))
(car candidate-rules)))
;; TODO it might be better to extract this information directly from
@@ -279,14 +280,11 @@ for `calendar-current-time-zone'."
(car t2-date-sec) t1-utc-diff))
(t1-time (/ (cdr t1-date-sec) 60))
(t2-time (/ (cdr t2-date-sec) 60)))
- (cons
- (/ (min t0-utc-diff t1-utc-diff) 60)
- (cons
- (/ (abs (- t0-utc-diff t1-utc-diff)) 60)
- (if (< t0-utc-diff t1-utc-diff)
- (list t0-name t1-name t1-rules t2-rules t1-time t2-time)
- (list t1-name t0-name t2-rules t1-rules t2-time t1-time)
- )))))))))
+ (if (nth 7 (decode-time t1))
+ (list (/ t0-utc-diff 60) (/ (- t1-utc-diff t0-utc-diff) 60)
+ t0-name t1-name t1-rules t2-rules t1-time t2-time)
+ (list (/ t1-utc-diff 60) (/ (- t0-utc-diff t1-utc-diff) 60)
+ t1-name t0-name t2-rules t1-rules t2-time t1-time))))))))
(defvar calendar-dst-transition-cache nil
"Internal cal-dst variable storing date of daylight saving time transitions.
@@ -405,7 +403,8 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
+ (calendar-dlet* ((year year))
+ (if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 2 0 3 year))))
@@ -416,7 +415,8 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(or (let ((expr (if calendar-dst-check-each-year-flag
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
+ (calendar-dlet* ((year year))
+ (if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 1 0 11 year))))
@@ -425,25 +425,25 @@ This function respects the value of `calendar-dst-check-each-year-flag'."
(defun dst-in-effect (date)
"True if on absolute DATE daylight saving time is in effect.
Fractional part of DATE is local standard time of day."
- (let* ((year (calendar-extract-year
- (calendar-gregorian-from-absolute (floor date))))
- (dst-starts-gregorian (eval calendar-daylight-savings-starts))
- (dst-ends-gregorian (eval calendar-daylight-savings-ends))
- (dst-starts (and dst-starts-gregorian
+ (calendar-dlet* ((year (calendar-extract-year
+ (calendar-gregorian-from-absolute (floor date)))))
+ (let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts))
+ (dst-ends-gregorian (eval calendar-daylight-savings-ends))
+ (dst-starts (and dst-starts-gregorian
+ (+ (calendar-absolute-from-gregorian
+ dst-starts-gregorian)
+ (/ calendar-daylight-savings-starts-time
+ 60.0 24.0))))
+ (dst-ends (and dst-ends-gregorian
(+ (calendar-absolute-from-gregorian
- dst-starts-gregorian)
- (/ calendar-daylight-savings-starts-time
- 60.0 24.0))))
- (dst-ends (and dst-ends-gregorian
- (+ (calendar-absolute-from-gregorian
- dst-ends-gregorian)
- (/ (- calendar-daylight-savings-ends-time
- calendar-daylight-time-offset)
- 60.0 24.0)))))
- (and dst-starts dst-ends
- (if (< dst-starts dst-ends)
- (and (<= dst-starts date) (< date dst-ends))
- (or (<= dst-starts date) (< date dst-ends))))))
+ dst-ends-gregorian)
+ (/ (- calendar-daylight-savings-ends-time
+ calendar-daylight-time-offset)
+ 60.0 24.0)))))
+ (and dst-starts dst-ends
+ (if (< dst-starts dst-ends)
+ (and (<= dst-starts date) (< date dst-ends))
+ (or (<= dst-starts date) (< date dst-ends)))))))
;; used by calc, lunar, solar.
(defun dst-adjust-time (date time)
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 552832b4834..7ae0ecb7670 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -246,8 +246,6 @@ This definition is the heart of the calendar!")
(autoload 'holiday-in-range "holidays")
-(define-obsolete-function-alias 'cal-tex-list-holidays 'holiday-in-range "24.3")
-
(autoload 'diary-list-entries "diary-lib")
(defun cal-tex-list-diary-entries (d1 d2)
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index dae7b9dc005..4bf8b67ee53 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -1,4 +1,4 @@
-;;; calendar.el --- calendar functions
+;;; calendar.el --- calendar functions -*- lexical-binding:t -*-
;; Copyright (C) 1988-1995, 1997, 2000-2018 Free Software Foundation,
;; Inc.
@@ -115,6 +115,37 @@
(load "cal-loaddefs" nil t)
+;; Calendar has historically relied heavily on dynamic scoping.
+;; Concretely, this manifests in the use of references to let-bound variables
+;; in Custom vars as well as code in diary files.
+;; `eval` is hence the core of the culprit. It's used on:
+;; - calendar-date-display-form
+;; - calendar-time-display-form
+;; - calendar-chinese-time-zone
+;; - in cal-dst's there are various calls to `eval' but they seem not to refer
+;; to let-bound variables, surprisingly.
+;; - calendar-date-echo-text
+;; - calendar-mode-line-format
+;; - cal-tex-daily-string
+;; - diary-date-forms
+;; - diary-remind-message
+;; - calendar-holidays
+;; - calendar-location-name
+;; - whatever is passed to calendar-string-spread
+;; - whatever is passed to calendar-insert-at-column
+;; - whatever is passed to diary-sexp-entry
+;; - whatever is passed to diary-remind
+
+(defmacro calendar-dlet* (binders &rest body)
+ "Like `let*' but using dynamic scoping."
+ (declare (indent 1) (debug let))
+ `(progn
+ (with-no-warnings ;Silence "lacks a prefix" warnings!
+ ,@(mapcar (lambda (binder)
+ `(defvar ,(if (consp binder) (car binder) binder)))
+ binders))
+ (let* ,binders ,@body)))
+
;; Avoid recursive load of calendar when loading cal-menu. Yuck.
(provide 'calendar)
(require 'cal-menu)
@@ -372,7 +403,7 @@ redisplays the diary for whatever date the cursor is moved to."
(defcustom calendar-date-echo-text
"mouse-2: general menu\nmouse-3: menu for this date"
"String displayed when the cursor is over a date in the calendar.
-Can be either a fixed string, or a lisp expression that returns one.
+Can be either a fixed string, or a Lisp expression that returns one.
When this expression is evaluated, DAY, MONTH, and YEAR are
integers appropriate to the relevant date. For example, to
display the ISO date:
@@ -466,8 +497,8 @@ Then redraw the calendar, if necessary."
(defcustom calendar-left-margin 5
"Empty space to the left of the first month in the calendar."
:group 'calendar
- :initialize 'custom-initialize-default
- :set 'calendar-set-layout-variable
+ :initialize #'custom-initialize-default
+ :set #'calendar-set-layout-variable
:type 'integer
:version "23.1")
@@ -477,7 +508,7 @@ Then redraw the calendar, if necessary."
(defcustom calendar-intermonth-spacing 4
"Space between months in the calendar. Minimum value is 1."
:group 'calendar
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val)
(calendar-set-layout-variable sym val 1))
:type 'integer
@@ -486,7 +517,7 @@ Then redraw the calendar, if necessary."
;; FIXME calendar-month-column-width?
(defcustom calendar-column-width 3
"Width of each day column in the calendar. Minimum value is 3."
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val)
(calendar-set-layout-variable sym val 3))
:type 'integer
@@ -506,7 +537,7 @@ WIDTH defaults to `calendar-day-header-width'."
"Width of the day column headers in the calendar.
Must be at least one less than `calendar-column-width'."
:group 'calendar
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val)
(or (calendar-customized-p 'calendar-day-header-array)
(setq calendar-day-header-array
@@ -519,7 +550,7 @@ Must be at least one less than `calendar-column-width'."
(defcustom calendar-day-digit-width 2
"Width of the day digits in the calendar. Minimum value is 2."
:group 'calendar
- :initialize 'custom-initialize-default
+ :initialize #'custom-initialize-default
:set (lambda (sym val)
(calendar-set-layout-variable sym val 2))
:type 'integer
@@ -543,8 +574,8 @@ See `calendar-intermonth-text'."
(defcustom calendar-intermonth-text nil
"Text to display in the space to the left of each calendar month.
-Can be nil, a fixed string, or a lisp expression that returns a string.
-When the expression is evaluated, the variables DAY, MONTH and YEAR
+Can be nil, a fixed string, or a Lisp expression that returns a string.
+When the expression is evaluated, the variables `day', `month' and `year'
are integers appropriate for the first day in each week.
Will be truncated to the smaller of `calendar-left-margin' and
`calendar-intermonth-spacing'. The last character is forced to be a space.
@@ -715,7 +746,7 @@ calendar package is already loaded). Rather, use either
(const european :tag "Day/Month/Year")
(const iso :tag "Year/Month/Day"))
:initialize 'custom-initialize-default
- :set (lambda (symbol value)
+ :set (lambda (_symbol value)
(calendar-set-date-style value))
:group 'calendar)
@@ -940,7 +971,7 @@ Normally you should not customize this, but `calendar-month-header'."
calendar-european-month-header)
(t calendar-american-month-header))
"Expression to evaluate to return the calendar month headings.
-When this expression is evaluated, the variables MONTH and YEAR are
+When this expression is evaluated, the variables `month' and `year' are
integers appropriate to the relevant month. The result is padded
to the width of `calendar-month-digit-width'.
@@ -1105,7 +1136,7 @@ MON defaults to `displayed-month'. YR defaults to `displayed-year'."
(defmacro calendar-in-read-only-buffer (buffer &rest body)
"Switch to BUFFER and execute the forms in BODY.
First creates or erases BUFFER as needed. Leaves BUFFER read-only,
-with disabled undo. Leaves point at point-min, displays BUFFER."
+with disabled undo. Leaves point at `point-min', displays BUFFER."
(declare (indent 1) (debug t))
`(progn
(set-buffer (get-buffer-create ,buffer))
@@ -1357,7 +1388,7 @@ Optional integers MON and YR are used instead of today's date."
(let* ((inhibit-read-only t)
(today (calendar-current-date))
(month (calendar-extract-month today))
- (day (calendar-extract-day today))
+ ;; (day (calendar-extract-day today))
(year (calendar-extract-year today))
(today-visible (or (not mon)
(<= (abs (calendar-interval mon yr month year)) 1)))
@@ -1459,8 +1490,9 @@ line."
(goto-char (point-min))
(calendar-move-to-column indent)
(insert
- (calendar-string-spread (list calendar-month-header)
- ?\s calendar-month-digit-width))
+ (calendar-dlet* ((month month) (year year))
+ (calendar-string-spread (list calendar-month-header)
+ ?\s calendar-month-digit-width)))
(calendar-ensure-newline)
(calendar-insert-at-column indent calendar-intermonth-header trunc)
;; Use the first N characters of each day to head the columns.
@@ -1475,7 +1507,8 @@ line."
calendar-day-header-width nil ?\s)
(make-string (- calendar-column-width calendar-day-header-width) ?\s)))
(calendar-ensure-newline)
- (calendar-insert-at-column indent calendar-intermonth-text trunc)
+ (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-insert-at-column indent calendar-intermonth-text trunc))
;; Add blank days before the first of the month.
(insert (make-string (* blank-days calendar-column-width) ?\s))
;; Put in the days of the month.
@@ -1495,7 +1528,8 @@ line."
(/= day last))
(calendar-ensure-newline)
(setq day (1+ day)) ; first day of next week
- (calendar-insert-at-column indent calendar-intermonth-text trunc)))))
+ (calendar-dlet* ((day day) (month month) (year year))
+ (calendar-insert-at-column indent calendar-intermonth-text trunc))))))
(defun calendar-redraw ()
"Redraw the calendar display, if `calendar-buffer' is live."
@@ -1755,25 +1789,22 @@ For a complete description, see the info node `Calendar/Diary'.
;; so let's make sure they're always set. Most likely, this will be reset
;; soon in calendar-generate, but better safe than sorry.
(unless (boundp 'displayed-month) (setq displayed-month 1))
- (unless (boundp 'displayed-year) (setq displayed-year 2001))
- (if (bound-and-true-p calendar-font-lock-keywords)
- (set (make-local-variable 'font-lock-defaults)
- '(calendar-font-lock-keywords t))))
+ (unless (boundp 'displayed-year) (setq displayed-year 2001)))
(defun calendar-string-spread (strings char length)
"Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
-The effect is like mapconcat but the separating pieces are as balanced as
+The effect is like `mapconcat' but the separating pieces are as balanced as
possible. Each item of STRINGS is evaluated before concatenation so it can
actually be an expression that evaluates to a string. If LENGTH is too short,
the STRINGS are just concatenated and the result truncated."
-;; The algorithm is based on equation (3.25) on page 85 of Concrete
-;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
-;; Addison-Wesley, Reading, MA, 1989.
- (let* ((strings (mapcar 'eval
+ ;; The algorithm is based on equation (3.25) on page 85 of Concrete
+ ;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
+ ;; Addison-Wesley, Reading, MA, 1989.
+ (let* ((strings (mapcar #'eval
(if (< (length strings) 2)
(append (list "") strings (list ""))
strings)))
- (n (- length (string-width (apply 'concat strings))))
+ (n (- length (string-width (apply #'concat strings))))
(m (* (1- (length strings)) (char-width char)))
(s (car strings))
(strings (cdr strings))
@@ -1790,17 +1821,18 @@ the STRINGS are just concatenated and the result truncated."
(if (and calendar-mode-line-format
(bufferp (get-buffer calendar-buffer)))
(with-current-buffer calendar-buffer
- (let ((start (- calendar-left-margin 2))
- (date (condition-case nil
- (calendar-cursor-to-nearest-date)
- (error (calendar-current-date)))))
- (setq mode-line-format
- (concat (make-string (max 0 (+ start
- (- (car (window-inside-edges))
- (car (window-edges))))) ?\s)
- (calendar-string-spread
- (mapcar 'eval calendar-mode-line-format)
- ?\s (- calendar-right-margin (1- start))))))
+ (let ((start (- calendar-left-margin 2)))
+ (calendar-dlet* ((date (condition-case nil
+ (calendar-cursor-to-nearest-date)
+ (error (calendar-current-date)))))
+ (setq mode-line-format
+ (concat (make-string (max 0 (+ start
+ (- (car (window-inside-edges))
+ (car (window-edges)))))
+ ?\s)
+ (calendar-string-spread
+ calendar-mode-line-format
+ ?\s (- calendar-right-margin (1- start)))))))
(force-mode-line-update))))
(defun calendar-buffer-list ()
@@ -2032,11 +2064,11 @@ is a string to insert in the minibuffer before reading."
Each abbreviation is no longer than MAXLEN (default `calendar-abbrev-length')
characters."
(or maxlen (setq maxlen calendar-abbrev-length))
- (apply 'vector (mapcar
- (lambda (f)
- ;; TODO? truncate-string-to-width?
- (substring f 0 (min maxlen (length f))))
- full)))
+ (apply #'vector (mapcar
+ (lambda (f)
+ ;; TODO? truncate-string-to-width?
+ (substring f 0 (min maxlen (length f))))
+ full)))
(defcustom calendar-day-name-array
["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"]
@@ -2254,7 +2286,7 @@ If optional NODAY is t, does not ask for day, but just returns
(month (cdr (assoc-string
(completing-read
"Month name: "
- (mapcar 'list (append month-array nil))
+ (mapcar #'list (append month-array nil))
nil t)
(calendar-make-alist month-array 1) t)))
(last (calendar-last-day-of-month month year)))
@@ -2276,13 +2308,6 @@ Negative years are interpreted as years BC; -1 being 1 BC, and so on."
(+ (* 12 (- yr2 yr1))
(- mon2 mon1)))
-(defvar calendar-font-lock-keywords nil
- "Default keywords to highlight in Calendar mode.")
-
-(make-obsolete-variable 'calendar-font-lock-keywords
- "set font-lock keywords in `calendar-mode-hook', \
-or customize calendar faces." "24.4")
-
(defun calendar-day-name (date &optional abbrev absolute)
"Return a string with the name of the day of the week of DATE.
DATE should be a list in the format (MONTH DAY YEAR), unless the
@@ -2322,7 +2347,7 @@ interpreted as BC; -1 being 1 BC, and so on."
(setq calendar-mark-holidays-flag nil
calendar-mark-diary-entries-flag nil)
(with-current-buffer calendar-buffer
- (mapc 'delete-overlay (overlays-in (point-min) (point-max)))))
+ (mapc #'delete-overlay (overlays-in (point-min) (point-max)))))
(defun calendar-date-is-visible-p (date)
"Return non-nil if DATE is valid and is visible in the calendar window."
@@ -2425,7 +2450,7 @@ ATTRLIST is a list with elements of the form :face face :foreground color."
(make-face temp-face)
(copy-face face temp-face)
;; Apply the font aspects.
- (apply 'set-face-attribute temp-face nil (nreverse faceinfo))
+ (apply #'set-face-attribute temp-face nil (nreverse faceinfo))
temp-face)))
(defun calendar-mark-visible-date (date &optional mark)
@@ -2497,13 +2522,14 @@ and day names to be abbreviated as specified by
`calendar-month-abbrev-array' and `calendar-day-abbrev-array',
respectively. An optional parameter NODAYNAME, when t, omits the
name of the day of the week."
- (let* ((dayname (unless nodayname (calendar-day-name date abbreviate)))
- (month (calendar-extract-month date))
+ (let ((month (calendar-extract-month date)))
+ (calendar-dlet*
+ ((dayname (unless nodayname (calendar-day-name date abbreviate)))
(monthname (calendar-month-name month abbreviate))
(day (number-to-string (calendar-extract-day date)))
(month (number-to-string month))
(year (number-to-string (calendar-extract-year date))))
- (mapconcat 'eval calendar-date-display-form "")))
+ (mapconcat #'eval calendar-date-display-form ""))))
(defun calendar-dayname-on-or-before (dayname date)
"Return the absolute date of the DAYNAME on or before absolute DATE.
@@ -2606,11 +2632,11 @@ If called by a mouse-event, pops up a menu with the result."
selection)
(if (mouse-event-p event)
(and (setq selection (cal-menu-x-popup-menu event title
- (mapcar 'list others)))
+ (mapcar #'list others)))
(call-interactively selection))
(calendar-in-read-only-buffer calendar-other-calendars-buffer
(calendar-set-mode-line title)
- (insert (mapconcat 'identity others "\n"))))))
+ (insert (mapconcat #'identity others "\n"))))))
(defun calendar-print-day-of-year ()
"Show day number in year/days remaining in year for date under the cursor."
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 9f2a3334efd..acf4b20d779 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-2018 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)
@@ -151,12 +151,14 @@ See also `diary-comment-start'."
:group 'diary)
(defcustom diary-hook nil
- "List of functions called after the display of the diary.
-Used for example by the appointment package - see `appt-activate'."
+ "Hook run after displaying the diary.
+Used for example by the appointment package - see `appt-activate'.
+The variables `number' and `original-date' are dynamically bound around
+the call."
: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 +187,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 +253,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 +330,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 +555,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 +657,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 +672,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 +738,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 diary--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
@@ -774,10 +781,10 @@ After preparing the initial list, hooks run in this order:
`diary-hook' runs last, after the diary is displayed.
This is used e.g. by `appt-check'.
-Functions called by these hooks may use the variables ORIGINAL-DATE
-and NUMBER, which are the arguments with which this function was called.
-Note that hook functions should _not_ use DATE, but ORIGINAL-DATE.
-\(Sexp diary entries may use DATE - see `diary-list-sexp-entries'.)
+Functions called by these hooks may use the variables `original-date'
+and `number', which are the arguments with which this function was called.
+Note that hook functions should _not_ use `date', but `original-date'.
+\(Sexp diary entries may use `date' - see `diary-list-sexp-entries'.)
This function displays the list using `diary-display-function', unless
LIST-ONLY is non-nil, in which case it just returns the list."
@@ -787,7 +794,7 @@ LIST-ONLY is non-nil, in which case it just returns the list."
diary-number-of-entries)))
(when (> number 0)
(let* ((original-date date) ; save for possible use in the hooks
- (date-string (calendar-date-string date))
+ (diary--date-string (calendar-date-string date))
(diary-buffer (find-buffer-visiting diary-file))
;; Dynamically bound in diary-include-files.
(d-incp (and (boundp 'diary-including) diary-including))
@@ -832,7 +839,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 +855,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
@@ -865,7 +874,9 @@ LIST-ONLY is non-nil, in which case it just returns the list."
(copy-sequence
(car display-buffer-fallback-action))))))
(funcall diary-display-function)))
- (run-hooks 'diary-hook)))))
+ (calendar-dlet* ((number number)
+ (original-date original-date))
+ (run-hooks 'diary-hook))))))
(and temp-buff (buffer-name temp-buff) (kill-buffer temp-buff)))
(or d-incp (message "Preparing diary...done"))
diary-entries-list)))
@@ -878,8 +889,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 +903,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 +916,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 +945,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.
@@ -938,9 +952,9 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
(let* ((holiday-list (if diary-show-holidays-flag
(calendar-check-holidays original-date)))
(hol-string (format "%s%s%s"
- date-string
+ diary--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?
@@ -956,14 +970,13 @@ Returns a cons (NOENTRIES . HOLIDAY-STRING)."
(message "%s" msg)
;; 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")))
- (message "No diary entries for %s" date-string)))
+ (calendar-set-mode-line (format "Holidays for %s"
+ diary--date-string))
+ (insert (mapconcat #'identity holiday-list "\n")))
+ (message "No diary entries for %s" diary--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 +1000,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 +1035,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.
@@ -1111,7 +1127,7 @@ This is an option for `diary-display-function'."
(if (eq major-mode 'diary-fancy-display-mode)
(run-hooks 'diary-fancy-display-mode-hook)
(diary-fancy-display-mode))
- (calendar-set-mode-line date-string))))
+ (calendar-set-mode-line diary--date-string))))
;; FIXME modernize?
(defun diary-print-entries ()
@@ -1204,7 +1220,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 +1258,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 +1424,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 +1550,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)))))
@@ -1651,7 +1669,7 @@ Sexp diary entries must be prefaced by a `diary-sexp-entry-symbol'
%%(SEXP) ENTRY
-Both ENTRY and DATE are available when the SEXP is evaluated. If
+Both `entry' and `date' are available when the SEXP is evaluated. If
the SEXP returns nil, the diary entry does not apply. If it
returns a non-nil value, ENTRY will be taken to apply to DATE; if
the value is a string, that string will be the diary entry in the
@@ -1814,9 +1832,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 +1842,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 +1871,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 +1890,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 +1969,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 +1994,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 +2006,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 +2028,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 +2049,8 @@ 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 ""))))
+ (calendar-dlet* ((days days))
+ (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 +2247,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 +2336,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 +2369,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 +2383,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 +2416,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
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
index 4ba49a9acb1..f38308378d6 100644
--- a/lisp/calendar/holidays.el
+++ b/lisp/calendar/holidays.el
@@ -522,7 +522,6 @@ strings describing those holidays that apply on DATE, or nil if none do."
(setq holiday-list (append holiday-list (cdr h)))))))
-;; Formerly cal-tex-list-holidays.
(defun holiday-in-range (d1 d2)
"Generate a list of all holidays in range from absolute date D1 to D2."
(let* ((start (calendar-gregorian-from-absolute d1))
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index a725a4e916b..ca3adfaeeb5 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -1048,12 +1048,10 @@ written into the buffer `*icalendar-errors*'."
(interactive "r
FExport diary data into iCalendar file: ")
(let ((result "")
- (start 0)
(entry-main "")
(entry-rest "")
(entry-full "")
(header "")
- (contents-n-summary)
(contents)
(alarm)
(found-error nil)
@@ -1073,7 +1071,8 @@ FExport diary data into iCalendar file: ")
;; possibly ignore hidden entries beginning with "&"
(if icalendar-export-hidden-diary-entries
"^\\([^ \t\n#].+\\)\\(\\(\n[ \t].*\\)*\\)"
- "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)") max t)
+ "^\\([^ \t\n&#].+\\)\\(\\(\n[ \t].*\\)*\\)")
+ max t)
(setq entry-main (match-string 1))
(if (match-beginning 2)
(setq entry-rest (match-string 2))
@@ -1095,7 +1094,7 @@ FExport diary data into iCalendar file: ")
(loc (cdr (assoc 'loc other-elements)))
(org (cdr (assoc 'org other-elements)))
(sta (cdr (assoc 'sta other-elements)))
- (sum (cdr (assoc 'sum other-elements)))
+ ;; (sum (cdr (assoc 'sum other-elements)))
(url (cdr (assoc 'url other-elements)))
(uid (cdr (assoc 'uid other-elements))))
(if cla
@@ -1202,7 +1201,7 @@ Returns an alist."
(p-uid (or (string-match "%U" icalendar-import-format) -1))
(p-list (sort (list p-cla p-des p-loc p-org p-sta p-sum p-url p-uid) '<))
(ct 0)
- pos-cla pos-des pos-loc pos-org pos-sta pos-sum pos-url pos-uid)
+ pos-cla pos-des pos-loc pos-org pos-sta pos-url pos-uid) ;pos-sum
(dotimes (i (length p-list))
;; Use 'ct' to keep track of current position in list
(cond ((and (>= p-cla 0) (= (nth i p-list) p-cla))
@@ -1222,7 +1221,8 @@ Returns an alist."
(setq pos-sta (* 2 ct)))
((and (>= p-sum 0) (= (nth i p-list) p-sum))
(setq ct (+ ct 1))
- (setq pos-sum (* 2 ct)))
+ ;; (setq pos-sum (* 2 ct))
+ )
((and (>= p-url 0) (= (nth i p-list) p-url))
(setq ct (+ ct 1))
(setq pos-url (* 2 ct)))
@@ -1254,11 +1254,11 @@ Returns an alist."
(icalendar--rris "%s" "\\(.*?\\)" s nil t)
"\\'"))
(if (string-match s summary-and-rest)
- (let (cla des loc org sta sum url uid)
- (if (and pos-sum (match-beginning pos-sum))
- (setq sum (substring summary-and-rest
- (match-beginning pos-sum)
- (match-end pos-sum))))
+ (let (cla des loc org sta url uid) ;; sum
+ ;; (if (and pos-sum (match-beginning pos-sum))
+ ;; (setq sum (substring summary-and-rest
+ ;; (match-beginning pos-sum)
+ ;; (match-end pos-sum))))
(if (and pos-cla (match-beginning pos-cla))
(setq cla (substring summary-and-rest
(match-beginning pos-cla)
@@ -1763,8 +1763,8 @@ entries. ENTRY-MAIN is the first line of the diary entry."
;;BUT remove today if `diary-float'
;;expression does not hold true for today:
(when
- (null (let ((date (calendar-current-date))
- (entry entry-main))
+ (null (calendar-dlet* ((date (calendar-current-date))
+ (entry entry-main))
(diary-float month dayname n)))
(concat
"\nEXDATE;VALUE=DATE:"
@@ -1975,13 +1975,13 @@ P")
(icalendar-import-buffer diary-filename t non-marking)))
;;;###autoload
-(defun icalendar-import-buffer (&optional diary-file do-not-ask
+(defun icalendar-import-buffer (&optional diary-filename do-not-ask
non-marking)
"Extract iCalendar events from current buffer.
This function searches the current buffer for the first iCalendar
object, reads it and adds all VEVENT elements to the diary
-DIARY-FILE.
+DIARY-FILENAME.
It will ask for each appointment whether to add it to the diary
unless DO-NOT-ASK is non-nil. When called interactively,
@@ -2011,10 +2011,10 @@ buffer `*icalendar-errors*'."
(message "Converting iCalendar...")
(setq ical-errors (icalendar--convert-ical-to-diary
ical-contents
- diary-file do-not-ask non-marking))
- (when diary-file
+ diary-filename do-not-ask non-marking))
+ (when diary-filename
;; save the diary file if it is visited already
- (let ((b (find-buffer-visiting diary-file)))
+ (let ((b (find-buffer-visiting diary-filename)))
(when b
(save-current-buffer
(set-buffer b)
@@ -2066,12 +2066,12 @@ buffer `*icalendar-errors*'."
conversion-list)
string)))
-(defun icalendar--convert-ical-to-diary (ical-list diary-file
+(defun icalendar--convert-ical-to-diary (ical-list diary-filename
&optional do-not-ask
non-marking)
"Convert iCalendar data to an Emacs diary file.
Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a
-DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event
+DIARY-FILENAME. If DO-NOT-ASK is nil the user is asked for each event
whether to actually import it. NON-MARKING determines whether diary
events are created as non-marking.
This function attempts to return t if something goes wrong. In this
@@ -2164,7 +2164,7 @@ written into the buffer `*icalendar-errors*'."
(rdate
(icalendar--dmsg "rdate event")
(setq diary-string "")
- (mapc (lambda (datestring)
+ (mapc (lambda (_datestring)
(setq diary-string
(concat diary-string
(format "......"))))
@@ -2174,14 +2174,14 @@ written into the buffer `*icalendar-errors*'."
((not (string= start-d end-d))
(setq diary-string
(icalendar--convert-non-recurring-all-day-to-diary
- e start-d end-1-d))
+ start-d end-1-d))
(setq event-ok t))
;; not all-day
((and start-t (or (not end-t)
(not (string= start-t end-t))))
(setq diary-string
(icalendar--convert-non-recurring-not-all-day-to-diary
- e dtstart-dec dtend-dec start-t end-t))
+ dtstart-dec start-t end-t))
(setq event-ok t))
;; all-day event
(t
@@ -2199,8 +2199,8 @@ written into the buffer `*icalendar-errors*'."
(if do-not-ask (setq summary nil))
;; add entry to diary and store actual name of diary
;; file (in case it was nil)
- (setq diary-file
- (icalendar--add-diary-entry diary-string diary-file
+ (setq diary-filename
+ (icalendar--add-diary-entry diary-string diary-filename
non-marking summary)))
;; event was not ok
(setq found-error t)
@@ -2217,8 +2217,8 @@ written into the buffer `*icalendar-errors*'."
(message "%s" error-string))))
;; insert final newline
- (if diary-file
- (let ((b (find-buffer-visiting diary-file)))
+ (if diary-filename
+ (let ((b (find-buffer-visiting diary-filename)))
(when b
(save-current-buffer
(set-buffer b)
@@ -2467,7 +2467,7 @@ END-T is the event's end time in diary format."
e 'EXRULE))))
result))
-(defun icalendar--convert-non-recurring-all-day-to-diary (event start-d end-d)
+(defun icalendar--convert-non-recurring-all-day-to-diary (start-d end-d)
"Convert non-recurring iCalendar EVENT to diary format.
DTSTART is the decoded DTSTART property of E.
@@ -2476,14 +2476,12 @@ Argument END-D gives the last day."
(icalendar--dmsg "non-recurring all-day event")
(format "%%%%(and (diary-block %s %s))" start-d end-d))
-(defun icalendar--convert-non-recurring-not-all-day-to-diary (event dtstart-dec
- dtend-dec
- start-t
- end-t)
+(defun icalendar--convert-non-recurring-not-all-day-to-diary (dtstart-dec
+ start-t
+ end-t)
"Convert recurring icalendar EVENT to diary format.
DTSTART-DEC is the decoded DTSTART property of E.
-DTEND-DEC is the decoded DTEND property of E.
START-T is the event's start time in diary format.
END-T is the event's end time in diary format."
(icalendar--dmsg "not all day event")
@@ -2498,9 +2496,9 @@ END-T is the event's end time in diary format."
dtstart-dec "/")
start-t))))
-(defun icalendar--add-diary-entry (string diary-file non-marking
+(defun icalendar--add-diary-entry (string diary-filename non-marking
&optional summary)
- "Add STRING to the diary file DIARY-FILE.
+ "Add STRING to the diary file DIARY-FILENAME.
STRING must be a properly formatted valid diary entry. NON-MARKING
determines whether diary events are created as non-marking. If
SUMMARY is not nil it must be a string that gives the summary of the
@@ -2513,21 +2511,21 @@ the entry."
(setq non-marking
(y-or-n-p (format "Make appointment non-marking? "))))
(save-window-excursion
- (unless diary-file
- (setq diary-file
+ (unless diary-filename
+ (setq diary-filename
(read-file-name "Add appointment to this diary file: ")))
;; Note: diary-make-entry will add a trailing blank char.... :(
(funcall (if (fboundp 'diary-make-entry)
'diary-make-entry
'make-diary-entry)
- string non-marking diary-file)))
+ string non-marking diary-filename)))
;; Würgaround to remove the trailing blank char
- (with-current-buffer (find-file diary-file)
+ (with-current-buffer (find-file diary-filename)
(goto-char (point-max))
(if (= (char-before) ? )
(delete-char -1)))
- ;; return diary-file in case it has been changed interactively
- diary-file)
+ ;; return diary-filename in case it has been changed interactively
+ diary-filename)
;; ======================================================================
;; Examples
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 1e1656cd319..ddaf7451bd9 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -1,4 +1,4 @@
-;;; solar.el --- calendar functions for solar events
+;;; solar.el --- calendar functions for solar events -*- lexical-binding:t -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2018 Free Software
;; Foundation, Inc.
@@ -552,12 +552,14 @@ degrees to find out if polar regions have 24 hours of sun or only night."
"Printable form for decimal fraction TIME in TIME-ZONE.
Format used is given by `calendar-time-display-form'."
(let* ((time (round (* 60 time)))
- (24-hours (/ time 60))
+ (24-hours (/ time 60)))
+ (calendar-dlet*
+ ((time-zone time-zone)
(minutes (format "%02d" (% time 60)))
(12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
(am-pm (if (>= 24-hours 12) "pm" "am"))
(24-hours (format "%02d" 24-hours)))
- (mapconcat 'eval calendar-time-display-form "")))
+ (mapconcat #'eval calendar-time-display-form ""))))
(defun solar-daylight (time)
"Printable form for TIME expressed in hours."
@@ -661,10 +663,10 @@ Optional NOLOCATION non-nil means do not print the location."
(format
"%s, %s%s (%s hrs daylight)"
(if (car l)
- (concat "Sunrise " (apply 'solar-time-string (car l)))
+ (concat "Sunrise " (apply #'solar-time-string (car l)))
"No sunrise")
(if (cadr l)
- (concat "sunset " (apply 'solar-time-string (cadr l)))
+ (concat "sunset " (apply #'solar-time-string (cadr l)))
"no sunset")
(if nolocation ""
(format " at %s" (eval calendar-location-name)))
@@ -749,7 +751,7 @@ The values of `calendar-daylight-savings-starts',
(+ 4.9353929
(* 62833.1961680 U)
(* 0.0000001
- (apply '+
+ (apply #'+
(mapcar (lambda (x)
(* (car x)
(sin (mod
@@ -889,13 +891,12 @@ Accurate to a few seconds."
(insert (format "%s %2d: " (calendar-month-name month t) (1+ i))
(solar-sunrise-sunset-string date t) "\n")))))
-(defvar date)
-
-;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-sunrise-sunset ()
"Local time of sunrise and sunset as a diary entry.
Accurate to a few seconds."
+ ;; To be called from diary-list-sexp-entries, where DATE is bound.
+ (with-no-warnings (defvar date))
(or (and calendar-latitude calendar-longitude calendar-time-zone)
(solar-setup))
(solar-sunrise-sunset-string date))
@@ -938,7 +939,7 @@ Accurate to within a minute between 1951 and 2050."
(W (- (* 35999.373 T) 2.47))
(Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
(* 0.0007 (solar-cosine-degrees (* 2 W)))))
- (S (apply '+ (mapcar (lambda(x)
+ (S (apply #'+ (mapcar (lambda(x)
(* (car x) (solar-cosine-degrees
(+ (* (nth 2 x) T) (cadr x)))))
solar-seasons-data)))
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index c1c8e196eaf..5161ae8d668 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -188,25 +188,17 @@ The final element is \"*\", indicating an unspecified month.")
"Array of abbreviated month names, in order.
The final element is \"*\", indicating an unspecified month.")
-(with-no-warnings
- ;; FIXME: These vars lack a prefix, but this is out of our control, because
- ;; they're defined by Calendar, e.g. for calendar-date-display-form.
- (defvar dayname)
- (defvar monthname)
- (defvar day)
- (defvar month)
- (defvar year))
-
(defconst todo-date-pattern
(let ((dayname (diary-name-pattern calendar-day-name-array nil t)))
(concat "\\(?4:\\(?5:" dayname "\\)\\|"
- (let ((dayname)
- (monthname (format "\\(?6:%s\\)" (diary-name-pattern
- todo-month-name-array
- todo-month-abbrev-array)))
- (month "\\(?7:[0-9]+\\|\\*\\)")
- (day "\\(?8:[0-9]+\\|\\*\\)")
- (year "-?\\(?9:[0-9]+\\|\\*\\)"))
+ (calendar-dlet*
+ ((dayname)
+ (monthname (format "\\(?6:%s\\)" (diary-name-pattern
+ todo-month-name-array
+ todo-month-abbrev-array)))
+ (month "\\(?7:[0-9]+\\|\\*\\)")
+ (day "\\(?8:[0-9]+\\|\\*\\)")
+ (year "-?\\(?9:[0-9]+\\|\\*\\)"))
(mapconcat #'eval calendar-date-display-form ""))
"\\)"))
"Regular expression matching a todo item date header.")
@@ -2274,8 +2266,8 @@ made in the number or names of categories."
;; `todo-edit-item' as e.g. `-' or `C-u'.
(inc (prefix-numeric-value inc))
(buffer-read-only nil)
- ndate ntime year monthname month day
- dayname) ; Needed by calendar-date-display-form.
+ ndate ntime
+ year monthname month day dayname)
(when marked (todo--user-error-if-marked-done-item))
(save-excursion
(or (and marked (goto-char (point-min))) (todo-item-start))
@@ -2416,7 +2408,15 @@ made in the number or names of categories."
;; If year, month or day date string components were
;; changed, rebuild the date string.
(when (memq what '(year month day))
- (setq ndate (mapconcat #'eval calendar-date-display-form ""))))
+ (setq ndate
+ (calendar-dlet*
+ ;; Needed by calendar-date-display-form.
+ ((year year)
+ (monthname monthname)
+ (month month)
+ (day day)
+ (dayname dayname))
+ (mapconcat #'eval calendar-date-display-form "")))))
(when ndate (replace-match ndate nil nil nil 1))
;; Add new time string to the header, if it was supplied.
(when ntime
@@ -4613,12 +4613,13 @@ strings built using the default value of
(defun todo-convert-legacy-date-time ()
"Return converted date-time string.
Helper function for `todo-convert-legacy-files'."
- (let* ((year (match-string 1))
- (month (match-string 2))
- (monthname (calendar-month-name (string-to-number month) t))
- (day (match-string 3))
- (time (match-string 4))
- dayname)
+ (calendar-dlet*
+ ((year (match-string 1))
+ (month (match-string 2))
+ (monthname (calendar-month-name (string-to-number month) t))
+ (day (match-string 3))
+ (time (match-string 4))
+ dayname)
(replace-match "")
(insert (mapconcat #'eval calendar-date-display-form "")
(when time (concat " " time)))))
@@ -5990,8 +5991,8 @@ indicating an unspecified month, day, or year.
When ARG is `day', non-nil arguments MO and YR determine the
number of the last the day of the month."
- (let (year monthname month day
- dayname) ; Needed by calendar-date-display-form.
+ (calendar-dlet*
+ (year monthname month day dayname) ;Needed by calendar-date-display-form.
(when (or (not arg) (eq arg 'year))
(while (if (natnump year) (< year 1) (not (eq year '*)))
(setq year (read-from-minibuffer
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-27 00:51:33 +0000