mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2025-01-21 18:23:59 +00:00
* lisp/calendar/calendar.el: Use lexical-binding
(calendar-generate-window): Remove unused variable `day'. (calendar-generate-month): Use calendar-dlet* to provide the dynbind vars promised by the respective docstrings. (calendar-update-mode-line): Use calendar-dlet* to provide `date' to calendar-mode-line-format. Don't call `eval' here since it's called in calendar-string-spread anyway! (calendar-date-string): Use calendar-dlet* to provide the dynbind vars promised by the docstring of calendar-date-display-form. * lisp/calendar/diary-lib.el (diary--date-string): Rename from date-string.
This commit is contained in:
parent
47019a521f
commit
ffeb1164d4
@ -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.
|
||||
@ -403,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:
|
||||
@ -497,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")
|
||||
|
||||
@ -508,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
|
||||
@ -517,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
|
||||
@ -537,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
|
||||
@ -550,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
|
||||
@ -574,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.
|
||||
@ -746,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)
|
||||
|
||||
@ -971,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'.
|
||||
|
||||
@ -1136,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))
|
||||
@ -1388,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)))
|
||||
@ -1490,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.
|
||||
@ -1506,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.
|
||||
@ -1526,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."
|
||||
@ -1790,18 +1793,18 @@ For a complete description, see the info node `Calendar/Diary'.
|
||||
|
||||
(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))
|
||||
@ -1818,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 ()
|
||||
@ -2060,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"]
|
||||
@ -2282,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)))
|
||||
@ -2343,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."
|
||||
@ -2446,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)
|
||||
@ -2518,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.
|
||||
@ -2627,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."
|
||||
|
@ -740,7 +740,7 @@ 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
|
||||
(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'.
|
||||
@ -794,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))
|
||||
@ -952,7 +952,7 @@ 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 "; ")))
|
||||
(msg (format "No diary entries for %s" hol-string))
|
||||
@ -970,9 +970,10 @@ 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))
|
||||
(calendar-set-mode-line (format "Holidays for %s"
|
||||
diary--date-string))
|
||||
(insert (mapconcat #'identity holiday-list "\n")))
|
||||
(message "No diary entries for %s" date-string)))
|
||||
(message "No diary entries for %s" diary--date-string)))
|
||||
(cons noentries hol-string)))
|
||||
|
||||
|
||||
@ -1126,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 ()
|
||||
@ -1668,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
|
||||
|
Loading…
Reference in New Issue
Block a user