diff options
Diffstat (limited to 'lisp/calendar')
| -rw-r--r-- | lisp/calendar/appt.el | 10 | ||||
| -rw-r--r-- | lisp/calendar/cal-hebrew.el | 11 | ||||
| -rw-r--r-- | lisp/calendar/calendar.el | 13 | ||||
| -rw-r--r-- | lisp/calendar/diary-lib.el | 13 | ||||
| -rw-r--r-- | lisp/calendar/holidays.el | 62 | ||||
| -rw-r--r-- | lisp/calendar/icalendar.el | 14 | ||||
| -rw-r--r-- | lisp/calendar/time-date.el | 74 |
7 files changed, 129 insertions, 68 deletions
diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index ebdafb438e3..a7d13cff9a1 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -510,9 +510,13 @@ The time should be in either 24 hour format or am/pm format. Optional argument WARNTIME is an integer (or string) giving the number of minutes before the appointment at which to start warning. The default is `appt-message-warning-time'." - (interactive "sTime (hh:mm[am/pm]): \nsMessage: \n\ -sMinutes before the appointment to start warning: ") - (unless (string-match appt-time-regexp time) + (interactive (list (let ((time (read-string "Time (hh:mm[am/pm]): "))) + (unless (string-match-p appt-time-regexp time) + (user-error "Unacceptable time-string")) + time) + (read-string "Message: ") + (read-string "Minutes before the appointment to start warning: "))) + (unless (string-match-p appt-time-regexp time) (user-error "Unacceptable time-string")) (and (stringp warntime) (setq warntime (unless (string-equal warntime "") diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 61ce029e077..1c08de53fbd 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -798,6 +798,10 @@ In this case, the following civil date corresponds to the Hebrew birthday." (diary-ordinal-suffix age) (if (= b-date d) "" " (evening)"))))) +(defvar diary-hebrew-omer-sefirot + ["Hesed" "Gevurah" "Tiferet" "Netzach" "Hod" "Yesod" "Malchut"] + "The order of Sefirot for counting the Omer. +See https://opensiddur.org/prayers/solilunar/solar-cycles/sefirat-haomer/the-order-of-counting-the-omer-in-the-spring/") ;;;###diary-autoload (defun diary-hebrew-omer (&optional mark) "Omer count diary entry. @@ -813,7 +817,7 @@ use when highlighting the day in the calendar." (day (% omer 7))) (if (and (> omer 0) (< omer 50)) (cons mark - (format "Day %d%s of the omer (until sunset)" + (format "Day %d%s of the omer (until sunset) %s she'be'%s" omer (if (zerop week) "" @@ -823,7 +827,10 @@ use when highlighting the day in the calendar." (if (zerop day) "" (format " and %d day%s" - day (if (= day 1) "" "s")))))))))) + day (if (= day 1) "" "s"))))) + (aref diary-hebrew-omer-sefirot (% (+ 6 day) 7)) + (aref diary-hebrew-omer-sefirot + (+ (if (zerop day) -1 0) week))))))) (autoload 'diary-make-date "diary-lib") diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 48d308afade..9a77ae72d02 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el @@ -1066,7 +1066,7 @@ calendar." ;; fixme should have a :set that changes calendar-standard-time-zone-name etc. (defcustom calendar-time-zone-style 'symbolic "Your preferred style for time zones. -If 'numeric, use numeric time zones like \"+0100\". +If `numeric', use numeric time zones like \"+0100\". Otherwise, use symbolic time zones like \"CET\"." :type '(choice (const numeric) (other symbolic)) :version "28.1" @@ -1861,7 +1861,9 @@ concatenated and the result truncated." buffs)) (defun calendar-exit (&optional kill) - "Get out of the calendar window and hide it and related buffers." + "Get out of the calendar window and hide it and related buffers. +If KILL (interactively, the prefix), kill the buffers instead of +hiding them." (interactive "P") (let ((diary-buffer (get-file-buffer diary-file)) (calendar-buffers (calendar-buffer-list))) @@ -1880,7 +1882,12 @@ concatenated and the result truncated." (iconify-frame (window-frame w))) (quit-window kill w)))) (dolist (b calendar-buffers) - (quit-windows-on b kill)))))) + (quit-windows-on b kill))) + ;; Finally, kill non-displayed buffers (if requested). + (when kill + (dolist (b calendar-buffers) + (when (buffer-live-p b) + (kill-buffer b))))))) (defun calendar-current-date (&optional offset) "Return the current date in a list (month day year). diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 45df0c6259c..48dbf33adff 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -1,7 +1,6 @@ ;;; diary-lib.el --- diary functions -*- lexical-binding:t -*- -;; Copyright (C) 1989-1990, 1992-1995, 2001-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1989-2022 Free Software Foundation, Inc. ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: emacs-devel@gnu.org @@ -2246,12 +2245,10 @@ Prefix argument ARG makes the entry nonmarking." ;; Return value suitable for `write-contents-functions'. nil) -(defvar diary-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-s" 'diary-show-all-entries) - (define-key map "\C-c\C-q" 'quit-window) - map) - "Keymap for `diary-mode'.") +(defvar-keymap diary-mode-map + :doc "Keymap for `diary-mode'." + "C-c C-s" #'diary-show-all-entries + "C-c C-q" #'quit-window) (defun diary-font-lock-sexps (limit) "Recognize sexp diary entry up to LIMIT for font-locking." diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 2afa667a56c..7e11044dbc0 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -400,6 +400,36 @@ This function is suitable for execution in an init file." (displayed-year (calendar-extract-year date))) (calendar-list-holidays)))) +(defun holiday-available-holiday-lists () + "Return a list of all holiday lists. +This is used by `list-holidays', and you can customize the return +value by using `add-function'." + (delq + nil + (list + (cons "All" calendar-holidays) + (cons "Equinoxes/Solstices" + (list (list 'solar-equinoxes-solstices))) + (if holiday-general-holidays + (cons "General" holiday-general-holidays)) + (if holiday-local-holidays + (cons "Local" holiday-local-holidays)) + (if holiday-other-holidays + (cons "Other" holiday-other-holidays)) + (if holiday-christian-holidays + (cons "Christian" holiday-christian-holidays)) + (if holiday-hebrew-holidays + (cons "Hebrew" holiday-hebrew-holidays)) + (if holiday-islamic-holidays + (cons "Islamic" holiday-islamic-holidays)) + (if holiday-bahai-holidays + (cons "Bahá’í" holiday-bahai-holidays)) + (if holiday-oriental-holidays + (cons "Oriental" holiday-oriental-holidays)) + (if holiday-solar-holidays + (cons "Solar" holiday-solar-holidays)) + (cons "Ask" nil)))) + ;; rms: "Emacs commands to display a list of something generally start ;; with `list-'. Please make `list-holidays' the principal name." ;;;###autoload @@ -421,7 +451,12 @@ documentation of `calendar-holidays' for a list of the variables that control the choices, as well as a description of the format of a holiday list. -The optional LABEL is used to label the buffer created." +The optional LABEL is used to label the buffer created. + +The list of holiday lists is computed by the +`holiday-available-holiday-lists' and you can alter the results +by redefining that function, or use `add-function' to add +values." (interactive (let* ((start-year (calendar-read-sexp "Starting year of holidays (>0)" @@ -433,30 +468,7 @@ The optional LABEL is used to label the buffer created." start-year start-year)) (completion-ignore-case t) - (lists - (list - (cons "All" calendar-holidays) - (cons "Equinoxes/Solstices" - (list (list 'solar-equinoxes-solstices))) - (if holiday-general-holidays - (cons "General" holiday-general-holidays)) - (if holiday-local-holidays - (cons "Local" holiday-local-holidays)) - (if holiday-other-holidays - (cons "Other" holiday-other-holidays)) - (if holiday-christian-holidays - (cons "Christian" holiday-christian-holidays)) - (if holiday-hebrew-holidays - (cons "Hebrew" holiday-hebrew-holidays)) - (if holiday-islamic-holidays - (cons "Islamic" holiday-islamic-holidays)) - (if holiday-bahai-holidays - (cons "Bahá’í" holiday-bahai-holidays)) - (if holiday-oriental-holidays - (cons "Oriental" holiday-oriental-holidays)) - (if holiday-solar-holidays - (cons "Solar" holiday-solar-holidays)) - (cons "Ask" nil))) + (lists (holiday-available-holiday-lists)) (choice (capitalize (completing-read "List (TAB for choices): " lists nil t))) (which (if (string-equal choice "Ask") diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 439fb6dd29a..1a5a071e202 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -644,13 +644,13 @@ FIXME: multiple comma-separated values should be allowed!" ;; seconds present (setq second (read (substring isodatetimestring 13 15)))) ;; FIXME: Support subseconds. - (when (and (> (length isodatetimestring) 15) - ;; UTC specifier present - (char-equal ?Z (aref isodatetimestring 15))) - (setq source-zone t - ;; decode to local time unless result-zone is explicitly given, - ;; i.e. do not decode to UTC, i.e. do not (setq result-zone t) - )) + (when (> (length isodatetimestring) 15) + (pcase (aref isodatetimestring 15) + (?Z + (setq source-zone t)) + ((or ?- ?+) + (setq source-zone + (concat "UTC" (substring isodatetimestring 15)))))) ;; shift if necessary (if day-shift (let ((mdy (calendar-gregorian-from-absolute diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 83a57751474..ba7c48b290d 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -69,7 +69,7 @@ list (HIGH LOW MICRO PICO)." (pop elt))) (time-value (car elt)) (gensym (make-symbol "time"))) - `(let* ,(append `((,gensym (or ,time-value (current-time))) + `(let* ,(append `((,gensym (or ,time-value (time-convert nil 'list))) (,gensym (cond ((integerp ,gensym) @@ -154,7 +154,10 @@ it is assumed that PICO was omitted and should be treated as zero." DATE should be in one of the forms recognized by `parse-time-string'. If DATE lacks timezone information, GMT is assumed." (condition-case err - (encode-time (parse-time-string date)) + (let ((parsed (parse-time-string date))) + (when (decoded-time-year parsed) + (decoded-time-set-defaults parsed)) + (encode-time parsed)) (error (let ((overflow-error '(error "Specified time is not representable"))) (if (equal err overflow-error) @@ -284,17 +287,23 @@ use. \"%,1s\" means \"use one decimal\". The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing -is output until the first non-zero unit is encountered." +is output until the first non-zero unit is encountered. + +The \"%x\" specifier does not print anything. When it is used, +specifiers must be given in order of decreasing size. To the +right of \"%x\", trailing zero units are not output." (let ((start 0) (units '(("y" "year" 31536000) ("d" "day" 86400) ("h" "hour" 3600) ("m" "minute" 60) ("s" "second" 1) - ("z"))) + ("z") + ("x"))) (case-fold-search t) - spec match usedunits zeroflag larger prev name unit num zeropos - fraction) + spec match usedunits zeroflag larger prev name unit num + leading-zeropos trailing-zeropos fraction + chop-leading chop-trailing) (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start) (setq start (match-end 0) spec (match-string 2 string)) @@ -303,15 +312,16 @@ is output until the first non-zero unit is encountered." (error "Bad format specifier: `%s'" spec)) (if (assoc (downcase spec) usedunits) (error "Multiple instances of specifier: `%s'" spec)) - (if (string-equal (car match) "z") + (if (or (string-equal (car match) "z") + (string-equal (car match) "x")) (setq zeroflag t) (unless larger (setq unit (nth 2 match) larger (and prev (> unit prev)) prev unit))) (push match usedunits))) - (and zeroflag larger - (error "Units are not in decreasing order of size")) + (when (and zeroflag larger) + (error "Units are not in decreasing order of size")) (unless (numberp seconds) (setq seconds (float-time seconds))) (setq fraction (mod seconds 1) @@ -323,18 +333,28 @@ is output until the first non-zero unit is encountered." (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec) string) - (if (string-equal spec "z") ; must be last in units - (setq string - (replace-regexp-in-string - "%z" "" - (substring string (min (or zeropos (match-end 0)) - (match-beginning 0))))) + (cond + ((string-equal spec "z") + (setq chop-leading (and leading-zeropos + (min leading-zeropos (match-beginning 0))))) + ((string-equal spec "x") + (setq chop-trailing t)) + (t ;; Cf article-make-date-line in gnus-art. (setq num (floor seconds unit) seconds (- seconds (* num unit))) - ;; Start position of the first non-zero unit. - (or zeropos - (setq zeropos (unless (zerop num) (match-beginning 0)))) + (let ((is-zero (zerop (if (= unit 1) + (+ num fraction) + num)))) + ;; Start position of the first non-zero unit. + (when (and (not leading-zeropos) + (not is-zero)) + (setq leading-zeropos (match-beginning 0))) + (unless is-zero + (setq trailing-zeropos nil)) + (when (and (not trailing-zeropos) + is-zero) + (setq trailing-zeropos (match-beginning 0)))) (setq string (replace-match (format (if (match-string 2 string) @@ -357,7 +377,17 @@ is output until the first non-zero unit is encountered." (format " %s%s" name (if (= num 1) "" "s")))) t t string)))))) - (string-replace "%%" "%" string)) + (let ((pre string)) + (when (and chop-trailing trailing-zeropos) + (setq string (substring string 0 trailing-zeropos))) + (when chop-leading + (setq string (substring string chop-leading))) + ;; If we ended up removing everything, return the formatted + ;; string in full. + (when (equal string "") + (setq string pre))) + (setq string (replace-regexp-in-string "%[zx]" "" string))) + (string-trim (string-replace "%%" "%" string))) (defvar seconds-to-string (list (list 1 "ms" 0.001) @@ -406,7 +436,11 @@ entries only for the values that should be altered. For instance, if you want to \"add two months\" to TIME, then leave all other fields but the month field in DELTA nil, and make -the month field 2. The values in DELTA can be negative. +the month field 2. For instance: + + (decoded-time-add (decode-time) (make-decoded-time :month 2)) + +The values in DELTA can be negative. If applying a month/year delta leaves the time spec invalid, it is decreased to be valid (\"add one month\" to January 31st 2019 |