summaryrefslogtreecommitdiff
path: root/lisp/calendar
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calendar')
-rw-r--r--lisp/calendar/cal-bahai.el4
-rw-r--r--lisp/calendar/cal-dst.el18
-rw-r--r--lisp/calendar/cal-julian.el22
-rw-r--r--lisp/calendar/calendar.el24
-rw-r--r--lisp/calendar/diary-lib.el2
-rw-r--r--lisp/calendar/icalendar.el59
-rw-r--r--lisp/calendar/iso8601.el17
-rw-r--r--lisp/calendar/lunar.el44
-rw-r--r--lisp/calendar/parse-time.el98
-rw-r--r--lisp/calendar/solar.el10
-rw-r--r--lisp/calendar/time-date.el38
-rw-r--r--lisp/calendar/timeclock.el8
-rw-r--r--lisp/calendar/todo-mode.el97
13 files changed, 288 insertions, 153 deletions
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index b6bb040dd54..4bfdf3a6cf6 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -57,8 +57,8 @@
(defconst calendar-bahai-month-name-array
["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál"
- "Asmá’" "‘Izzat" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
- "Sharaf" "Sulṭán" "Mulk" "‘Alá’"]
+ "Asmá’" "‘Izzat" "Mas͟híyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
+ "S͟haraf" "Sulṭán" "Mulk" "‘Alá’"]
"Array of the month names in the Bahá’í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
index 3db12e668ab..05768e10c01 100644
--- a/lisp/calendar/cal-dst.el
+++ b/lisp/calendar/cal-dst.el
@@ -350,17 +350,31 @@ If the locale never uses daylight saving time, set this to 0."
:group 'calendar-dst)
(defcustom calendar-standard-time-zone-name
- (or (nth 2 calendar-current-time-zone-cache) "EST")
+ (if (eq calendar-time-zone-style 'numeric)
+ (if calendar-current-time-zone-cache
+ (format-time-string
+ "%z" 0 (* 60 (car calendar-current-time-zone-cache)))
+ "+0000")
+ (or (nth 2 calendar-current-time-zone-cache) "EST"))
"Abbreviated name of standard time zone at `calendar-location-name'.
For example, \"EST\" in New York City, \"PST\" for Los Angeles."
:type 'string
+ :version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-time-zone-name
- (or (nth 3 calendar-current-time-zone-cache) "EDT")
+ (if (eq calendar-time-zone-style 'numeric)
+ (if calendar-current-time-zone-cache
+ (format-time-string
+ "%z" 0 (* 60 (cadr calendar-current-time-zone-cache)))
+ "+0000")
+ (or (nth 3 calendar-current-time-zone-cache) "EDT"))
"Abbreviated name of daylight saving time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles."
:type 'string
+ :version "28.1"
+ :set-after '(calendar-time-zone-style)
:group 'calendar-dst)
(defcustom calendar-daylight-savings-starts-time
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 1c741317803..918995d0f9b 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,4 +1,4 @@
-;;; cal-julian.el --- calendar functions for the Julian calendar
+;;; cal-julian.el --- calendar functions for the Julian calendar -*- lexical-binding:t -*-
;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
@@ -182,23 +182,27 @@ Echo astronomical (Julian) day number unless NOECHO is non-nil."
(calendar-astro-to-absolute daynumber))))
(or noecho (calendar-astro-print-day-number)))
-
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-julian-date ()
"Julian calendar equivalent of date diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Julian date: %s" (calendar-julian-date-string date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-astro-day-number ()
"Astronomical (Julian) day number diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Astronomical (Julian) day number at noon UTC: %s.0"
(calendar-astro-date-string date)))
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
index 83e7976125f..de9b1f3ff53 100644
--- a/lisp/calendar/calendar.el
+++ b/lisp/calendar/calendar.el
@@ -136,14 +136,13 @@
;; - whatever is passed to diary-remind
(defmacro calendar-dlet* (binders &rest body)
- "Like `let*' but using dynamic scoping."
+ "Like `dlet' but without warnings about non-prefixed var names."
(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)))
+ (let ((vars (mapcar (lambda (binder)
+ (if (consp binder) (car binder) binder))
+ binders)))
+ `(with-suppressed-warnings ((lexical ,@vars))
+ (dlet ,binders ,@body))))
;; Avoid recursive load of calendar when loading cal-menu. Yuck.
(provide 'calendar)
@@ -995,7 +994,7 @@ pre-existing calendar windows."
"Set the style of calendar and diary dates to STYLE (a symbol).
The valid styles are described in the documentation of `calendar-date-style'."
(interactive (list (intern
- (completing-read "Date style: "
+ (completing-read (format-prompt "Date style" "american")
'("american" "european" "iso") nil t
nil nil "american"))))
(or (memq style '(american european iso))
@@ -1062,6 +1061,15 @@ calendar."
:type 'boolean
:group 'holidays)
+;; 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\".
+Otherwise, use symbolic time zones like \"CET\"."
+ :type '(choice (const numeric) (other symbolic))
+ :version "28.1"
+ :group 'calendar)
+
;;; End of user options.
(calendar-recompute-layout-variables)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 6d262088479..da98e44926e 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -98,7 +98,7 @@ specifies which face attribute (e.g. `:foreground') to modify, or
that this is a face (`:face') to apply. TYPE is the type of
attribute being applied. Available TYPES (see `diary-attrtype-convert')
are: `string', `symbol', `int', `tnil', `stringtnil'."
- :type '(repeat (list (string :tag "Regular expression")
+ :type '(repeat (list (regexp :tag "Regular expression")
(integer :tag "Sub-expression")
(symbol :tag "Attribute (e.g. :foreground)")
(choice (const string :tag "A string")
diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el
index 6847ba97496..dab277487e2 100644
--- a/lisp/calendar/icalendar.el
+++ b/lisp/calendar/icalendar.el
@@ -6,7 +6,7 @@
;; Created: August 2002
;; Keywords: calendar
;; Human-Keywords: calendar, diary, iCalendar, vCalendar
-;; Version: 0.19
+;; Old-Version: 0.19
;; This file is part of GNU Emacs.
@@ -107,6 +107,7 @@
(defconst icalendar-version "0.19"
"Version number of icalendar.el.")
+(make-obsolete-variable 'icalendar-version nil "28.1")
;; ======================================================================
;; Customizables
@@ -514,9 +515,10 @@ The strings are suitable for assembling into a TZ variable."
(let* ((offsetto (car (cddr (assq 'TZOFFSETTO alist))))
(offsetfrom (car (cddr (assq 'TZOFFSETFROM alist))))
(rrule-value (car (cddr (assq 'RRULE alist))))
+ (rdate-p (and (assq 'RDATE alist) t))
(dtstart (car (cddr (assq 'DTSTART alist))))
- (no-dst (equal offsetto offsetfrom)))
- ;; FIXME: for now we only handle RRULE and not RDATE here.
+ (no-dst (or rdate-p (equal offsetto offsetfrom))))
+ ;; FIXME: the presence of an RDATE is assumed to denote the first day of the year
(when (and offsetto dtstart (or rrule-value no-dst))
(let* ((rrule (icalendar--split-value rrule-value))
(freq (cadr (assq 'FREQ rrule)))
@@ -560,12 +562,13 @@ The strings are suitable for assembling into a TZ variable."
(defun icalendar--parse-vtimezone (alist)
"Turn a VTIMEZONE ALIST into a cons (ID . TZ-STRING).
+Consider only the most recent date specification.
Return nil if timezone cannot be parsed."
(let* ((tz-id (icalendar--convert-string-for-import
(icalendar--get-event-property alist 'TZID)))
- (daylight (cadr (cdar (icalendar--get-children alist 'DAYLIGHT))))
+ (daylight (cadr (cdar (icalendar--get-most-recent-observance alist 'DAYLIGHT))))
(day (and daylight (icalendar--convert-tz-offset daylight t)))
- (standard (cadr (cdar (icalendar--get-children alist 'STANDARD))))
+ (standard (cadr (cdar (icalendar--get-most-recent-observance alist 'STANDARD))))
(std (and standard (icalendar--convert-tz-offset standard nil))))
(if (and tz-id std)
(cons tz-id
@@ -574,6 +577,28 @@ Return nil if timezone cannot be parsed."
"," (cdr day) "," (cdr std))
(car std))))))
+(defun icalendar--get-most-recent-observance (alist sub-comp)
+ "Return the latest observance for SUB-COMP DAYLIGHT or STANDARD.
+ALIST is a VTIMEZONE potentially containing historical records."
+;FIXME?: "most recent" should be relative to a given date
+ (let ((components (icalendar--get-children alist sub-comp)))
+ (list
+ (car
+ (sort components
+ #'(lambda (a b)
+ (let* ((get-recent (lambda (n)
+ (car
+ (sort
+ (delq nil
+ (mapcar (lambda (p)
+ (and (memq (car p) '(DTSTART RDATE))
+ (car (cddr p))))
+ n))
+ 'string-greaterp))))
+ (a-recent (funcall get-recent (car (cddr a))))
+ (b-recent (funcall get-recent (car (cddr b)))))
+ (string-greaterp a-recent b-recent))))))))
+
(defun icalendar--convert-all-timezones (icalendar)
"Convert all timezones in the ICALENDAR into an alist.
Each element of the alist is a cons (ID . TZ-STRING),
@@ -593,15 +618,18 @@ ZONE-MAP is a timezone alist as returned by `icalendar--convert-all-timezones'."
(cdr (assoc id zone-map)))))
(defun icalendar--decode-isodatetime (isodatetimestring &optional day-shift
- zone)
+ source-zone
+ result-zone)
"Return ISODATETIMESTRING in format like `decode-time'.
Converts from ISO-8601 to Emacs representation. If
ISODATETIMESTRING specifies UTC time (trailing letter Z) the
decoded time is given in the local time zone! If optional
parameter DAY-SHIFT is non-nil the result is shifted by DAY-SHIFT
days.
-ZONE, if provided, is the timezone, in any format understood by `encode-time'.
-
+SOURCE-ZONE, if provided, is the timezone for decoding the time,
+in any format understood by `encode-time'.
+RESULT-ZONE, if provided, is the timezone for encoding the result
+in any format understood by `decode-time'.
FIXME: multiple comma-separated values should be allowed!"
(icalendar--dmsg isodatetimestring)
(if isodatetimestring
@@ -623,7 +651,10 @@ FIXME: multiple comma-separated values should be allowed!"
(when (and (> (length isodatetimestring) 15)
;; UTC specifier present
(char-equal ?Z (aref isodatetimestring 15)))
- (setq zone t))
+ (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)
+ ))
;; shift if necessary
(if day-shift
(let ((mdy (calendar-gregorian-from-absolute
@@ -636,9 +667,9 @@ FIXME: multiple comma-separated values should be allowed!"
;; create the decoded date-time
;; FIXME!?!
(let ((decoded-time (list second minute hour day month year
- nil -1 zone)))
+ nil -1 source-zone)))
(condition-case nil
- (decode-time (encode-time decoded-time))
+ (decode-time (encode-time decoded-time) result-zone)
(error
(message "Cannot decode \"%s\"" isodatetimestring)
;; Hope for the best....
@@ -684,9 +715,9 @@ FIXME: multiple comma-separated values should be allowed!"
(setq days (1- days))))
((match-beginning 4) ;days and time
(if (match-beginning 5)
- (setq days (* 7 (read (substring isodurationstring
- (match-beginning 6)
- (match-end 6))))))
+ (setq days (read (substring isodurationstring
+ (match-beginning 6)
+ (match-end 6)))))
(if (match-beginning 7)
(setq hours (read (substring isodurationstring
(match-beginning 8)
diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
index ae1dab17252..906c29b15f4 100644
--- a/lisp/calendar/iso8601.el
+++ b/lisp/calendar/iso8601.el
@@ -69,6 +69,8 @@
"\\([+-]?[0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)")
(defconst iso8601--outdated-date-match
"--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)")
+(defconst iso8601--outdated-reduced-precision-date-match
+ "---?\\([0-9][0-9]\\)")
(defconst iso8601--week-date-match
"\\([+-]?[0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?")
(defconst iso8601--ordinal-date-match
@@ -79,6 +81,7 @@
iso8601--full-date-match
iso8601--without-day-match
iso8601--outdated-date-match
+ iso8601--outdated-reduced-precision-date-match
iso8601--week-date-match
iso8601--ordinal-date-match)))
@@ -136,7 +139,8 @@ See `decode-time' for the meaning of FORM."
(when zone-string
(setf (decoded-time-zone date)
;; The time zone in decoded times are in seconds.
- (* (iso8601-parse-zone zone-string) 60)))
+ (* (iso8601-parse-zone zone-string) 60))
+ (setf (decoded-time-dst date) nil))
date)))
(defun iso8601-parse-date (string)
@@ -201,6 +205,12 @@ See `decode-time' for the meaning of FORM."
(iso8601--decoded-time :year year
:month (decoded-time-month month-day)
:day (decoded-time-day month-day))))
+ ;; Obsolete format with implied year: --MM
+ ((iso8601--match "--\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :month (string-to-number (match-string 1 string))))
+ ;; Obsolete format with implied year and month: ---DD
+ ((iso8601--match "---\\([0-9][0-9]\\)" string)
+ (iso8601--decoded-time :day (string-to-number (match-string 1 string))))
(t
(signal 'wrong-type-argument string))))
@@ -332,6 +342,9 @@ Return the number of minutes."
(list start end
(or duration
;; FIXME: Support subseconds.
+ ;; FIXME: It makes no sense to decode a time difference
+ ;; according to (decoded-time-zone end), or according to
+ ;; any other time zone for that matter.
(decode-time (time-subtract (iso8601--encode-time end)
(iso8601--encode-time start))
(or (decoded-time-zone end) 0) 'integer)))))
@@ -354,7 +367,7 @@ Return the number of minutes."
(iso8601--value month)
(iso8601--value year)
nil
- dst
+ (if (or dst zone) dst -1)
zone))
(defun iso8601--encode-time (time)
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
index 616d2b0c4ed..1c0f4da0f4b 100644
--- a/lisp/calendar/lunar.el
+++ b/lisp/calendar/lunar.el
@@ -1,4 +1,4 @@
-;;; lunar.el --- calendar functions for phases of the moon
+;;; lunar.el --- calendar functions for phases of the moon -*- lexical-binding:t -*-
;; Copyright (C) 1992-1993, 1995, 1997, 2001-2020 Free Software
;; Foundation, Inc.
@@ -91,6 +91,7 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(* -0.0016528 time time)
(* -0.00000239 time time time))
360.0))
+ (eclipse (eclipse-check moon-lat phase))
(adjustment
(if (memq phase '(0 2))
(+ (* (- 0.1734 (* 0.000393 time))
@@ -146,7 +147,26 @@ remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
(time (* 24 (- date (truncate date))))
(date (calendar-gregorian-from-absolute (truncate date)))
(adj (dst-adjust-time date time)))
- (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
+ (list (car adj) (apply 'solar-time-string (cdr adj)) phase eclipse)))
+
+;; from "Astronomy with your Personal Computer", Subroutine Eclipse
+;; Line 7000 Peter Duffett-Smith Cambridge University Press 1990
+(defun eclipse-check (moon-lat phase)
+ (let* ((moon-lat (* (/ float-pi 180) moon-lat))
+ (moon-lat (abs (- moon-lat (* (floor (/ moon-lat float-pi))
+ float-pi))))
+ (moon-lat (if (> moon-lat 0.37)
+ (- float-pi moon-lat)
+ moon-lat))
+ (phase-name (cond ((= phase 0) "Solar")
+ ((= phase 2) "Lunar")
+ (t ""))))
+ (cond ((< moon-lat 2.42600766e-1)
+ (concat "** " phase-name " Eclipse **"))
+ ((< moon-lat 0.37)
+ (concat "** " phase-name " Eclipse possible **"))
+ (t
+ ""))))
(defconst lunar-cycles-per-year 12.3685 ; 365.25/29.530588853
"Mean number of lunar cycles per 365.25 day year.")
@@ -222,9 +242,10 @@ use instead of point."
(insert
(mapconcat
(lambda (x)
- (format "%s: %s %s" (calendar-date-string (car x))
+ (format "%s: %s %s %s" (calendar-date-string (car x))
(lunar-phase-name (nth 2 x))
- (cadr x)))
+ (cadr x)
+ (car (last x))))
(lunar-phase-list m1 y1) "\n")))
(message "Computing phases of the moon...done"))))
@@ -234,6 +255,8 @@ use instead of point."
If called with an optional prefix argument ARG, prompts for month and year.
This function is suitable for execution in an init file."
(interactive "P")
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(save-excursion
(let* ((date (if arg (calendar-read-date t)
(calendar-current-date)))
@@ -241,18 +264,17 @@ This function is suitable for execution in an init file."
(displayed-year (calendar-extract-year date)))
(calendar-lunar-phases))))
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-lunar-phases (&optional mark)
"Moon phases diary entry.
An optional parameter MARK specifies a face or single-character string to
use when highlighting the day in the calendar."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(let* ((index (lunar-index date))
(phase (lunar-phase index)))
(while (calendar-date-compare phase (list date))
diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el
index 7110a81f0de..b199fca2db5 100644
--- a/lisp/calendar/parse-time.el
+++ b/lisp/calendar/parse-time.el
@@ -149,62 +149,62 @@ letters, digits, plus or minus signs or colons."
;;;###autoload
(defun parse-time-string (string)
"Parse the time in STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
-STRING should be something resembling an RFC 822 (or later) date-time, e.g.,
-\"Fri, 25 Mar 2016 16:24:56 +0100\", but this function is
+STRING should be an ISO 8601 time string, e.g., \"2020-01-15T16:12:21-08:00\",
+or something resembling an RFC 822 (or later) date-time, e.g.,
+\"Wed, 15 Jan 2020 16:12:21 -0800\". This function is
somewhat liberal in what format it accepts, and will attempt to
return a \"likely\" value even for somewhat malformed strings.
The values returned are identical to those of `decode-time', but
any unknown values other than DST are returned as nil, and an
unknown DST value is returned as -1."
- (let ((time (list nil nil nil nil nil nil nil -1 nil))
- (temp (parse-time-tokenize (downcase string))))
- (while temp
- (let ((parse-time-elt (pop temp))
- (rules parse-time-rules)
- (exit nil))
- (while (and rules (not exit))
- (let* ((rule (pop rules))
- (slots (pop rule))
- (predicate (pop rule))
- (parse-time-val))
- (when (and (not (nth (car slots) time)) ;not already set
- (setq parse-time-val
- (cond ((and (consp predicate)
- (not (functionp predicate)))
- (and (numberp parse-time-elt)
- (<= (car predicate) parse-time-elt)
- (or (not (cdr predicate))
- (<= parse-time-elt
- (cadr predicate)))
- parse-time-elt))
- ((symbolp predicate)
- (cdr (assoc parse-time-elt
- (symbol-value predicate))))
- ((funcall predicate)))))
- (setq exit t)
- (while slots
- (let ((new-val (if rule
- (let ((this (pop rule)))
- (if (vectorp this)
- (cl-parse-integer
- parse-time-elt
- :start (aref this 0)
- :end (aref this 1))
- (funcall this)))
- parse-time-val)))
- (setf (nth (pop slots) time) new-val))))))))
- time))
+ (condition-case ()
+ (iso8601-parse string)
+ (wrong-type-argument
+ (let ((time (list nil nil nil nil nil nil nil -1 nil))
+ (temp (parse-time-tokenize (downcase string))))
+ (while temp
+ (let ((parse-time-elt (pop temp))
+ (rules parse-time-rules)
+ (exit nil))
+ (while (and rules (not exit))
+ (let* ((rule (pop rules))
+ (slots (pop rule))
+ (predicate (pop rule))
+ (parse-time-val))
+ (when (and (not (nth (car slots) time)) ;not already set
+ (setq parse-time-val
+ (cond ((and (consp predicate)
+ (not (functionp predicate)))
+ (and (numberp parse-time-elt)
+ (<= (car predicate) parse-time-elt)
+ (or (not (cdr predicate))
+ (<= parse-time-elt
+ (cadr predicate)))
+ parse-time-elt))
+ ((symbolp predicate)
+ (cdr (assoc parse-time-elt
+ (symbol-value predicate))))
+ ((funcall predicate)))))
+ (setq exit t)
+ (while slots
+ (let ((new-val (if rule
+ (let ((this (pop rule)))
+ (if (vectorp this)
+ (cl-parse-integer
+ parse-time-elt
+ :start (aref this 0)
+ :end (aref this 1))
+ (funcall this)))
+ parse-time-val)))
+ (setf (nth (pop slots) time) new-val))))))))
+ time))))
(defun parse-iso8601-time-string (date-string)
- "Parse an ISO 8601 time string, such as 2016-12-01T23:35:06-05:00.
-If DATE-STRING cannot be parsed, it falls back to
-`parse-time-string'."
- (when-let ((time
- (if (iso8601-valid-p date-string)
- (decoded-time-set-defaults (iso8601-parse date-string))
- ;; Fall back to having `parse-time-string' do fancy
- ;; things for us.
- (parse-time-string date-string))))
+ "Parse an ISO 8601 time string, such as \"2020-01-15T16:12:21-08:00\".
+Fall back on parsing something resembling an RFC 822 (or later) date-time.
+This function is like `parse-time-string' except that it returns
+a Lisp timestamp when successful."
+ (when-let ((time (parse-time-string date-string)))
(encode-time time)))
(provide 'parse-time)
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
index 6a813e9ee82..05bb3164e12 100644
--- a/lisp/calendar/solar.el
+++ b/lisp/calendar/solar.el
@@ -209,7 +209,6 @@ Returns nil if nothing was entered."
(defun solar-setup ()
"Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'."
- (beep)
(or calendar-longitude
(setq calendar-longitude
(solar-get-number
@@ -840,7 +839,9 @@ This function is suitable for execution in an init file."
"E" "W"))))))
(calendar-standard-time-zone-name
(if (< arg 16) calendar-standard-time-zone-name
- (cond ((zerop calendar-time-zone) "UTC")
+ (cond ((zerop calendar-time-zone)
+ (if (eq calendar-time-zone-style 'numeric)
+ "+0000" "UTC"))
((< calendar-time-zone 0)
(format "UTC%dmin" calendar-time-zone))
(t (format "UTC+%dmin" calendar-time-zone)))))
@@ -1013,7 +1014,10 @@ Requires floating point."
(let* ((m displayed-month)
(y displayed-year)
(calendar-standard-time-zone-name
- (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
+ (cond
+ (calendar-time-zone calendar-standard-time-zone-name)
+ ((eq calendar-time-zone-style 'numeric) "+0000")
+ (t "UTC")))
(calendar-daylight-savings-starts
(if calendar-time-zone calendar-daylight-savings-starts))
(calendar-daylight-savings-ends
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el
index 1e589ece29d..638d8c1f884 100644
--- a/lisp/calendar/time-date.el
+++ b/lisp/calendar/time-date.el
@@ -355,6 +355,8 @@ is output until the first non-zero unit is encountered."
(defun date-days-in-month (year month)
"The number of days in MONTH in YEAR."
+ (unless (and (numberp month) (<= 1 month 12))
+ (error "Month %s is invalid" month))
(if (= month 2)
(if (date-leap-year-p year)
29
@@ -399,10 +401,10 @@ changes in daylight saving time are not taken into account."
(when (decoded-time-year delta)
(cl-incf (decoded-time-year time) (decoded-time-year delta)))
- ;; Months are pretty simple.
+ ;; Months are pretty simple, but start at 1 (for January).
(when (decoded-time-month delta)
- (let ((new (+ (decoded-time-month time) (decoded-time-month delta))))
- (setf (decoded-time-month time) (mod new 12))
+ (let ((new (+ (1- (decoded-time-month time)) (decoded-time-month delta))))
+ (setf (decoded-time-month time) (1+ (mod new 12)))
(cl-incf (decoded-time-year time) (/ new 12))))
;; Adjust for month length (as described in the doc string).
@@ -515,17 +517,31 @@ TIME is modified and returned."
(unless (decoded-time-year time)
(setf (decoded-time-year time) 0))
- ;; When we don't have a time zone and we don't have a DST, then mark
- ;; it as unknown.
- (when (and (not (decoded-time-zone time))
- (not (decoded-time-dst time)))
- (setf (decoded-time-dst time) -1))
+ ;; When we don't have a time zone, default to DEFAULT-ZONE without
+ ;; DST if DEFAULT-ZONE if given, and to unknown DST otherwise.
+ (unless (decoded-time-zone time)
+ (if default-zone
+ (progn (setf (decoded-time-zone time) default-zone)
+ (setf (decoded-time-dst time) nil))
+ (setf (decoded-time-dst time) -1)))
- (when (and (not (decoded-time-zone time))
- default-zone)
- (setf (decoded-time-zone time) 0))
time)
+(defun decoded-time-period (time)
+ "Interpret DECODED as a period and return its length in seconds.
+For computational purposes, years are 365 days long and months
+are 30 days long."
+ (+ (if (consp (decoded-time-second time))
+ ;; Fractional second.
+ (/ (float (car (decoded-time-second time)))
+ (cdr (decoded-time-second time)))
+ (or (decoded-time-second time) 0))
+ (* (or (decoded-time-minute time) 0) 60)
+ (* (or (decoded-time-hour time) 0) 60 60)
+ (* (or (decoded-time-day time) 0) 60 60 24)
+ (* (or (decoded-time-month time) 0) 60 60 24 30)
+ (* (or (decoded-time-year time) 0) 60 60 24 365)))
+
(provide 'time-date)
;;; time-date.el ends here
diff --git a/lisp/calendar/timeclock.el b/lisp/calendar/timeclock.el
index ca9f16ef20b..18ca05af4c5 100644
--- a/lisp/calendar/timeclock.el
+++ b/lisp/calendar/timeclock.el
@@ -193,6 +193,8 @@ to today."
(defcustom timeclock-load-hook nil
"Hook that gets run after timeclock has been loaded."
:type 'hook)
+(make-obsolete-variable 'timeclock-load-hook
+ "use `with-eval-after-load' instead." "28.1")
(defcustom timeclock-in-hook nil
"A hook run every time an \"in\" event is recorded."
@@ -595,9 +597,9 @@ arguments of `completing-read'."
(defun timeclock-ask-for-project ()
"Ask the user for the project they are clocking into."
(completing-read
- (format "Clock into which project (default %s): "
- (or timeclock-last-project
- (car timeclock-project-list)))
+ (format-prompt "Clock into which project"
+ (or timeclock-last-project
+ (car timeclock-project-list)))
timeclock-project-list
nil nil nil nil
(or timeclock-last-project
diff --git a/lisp/calendar/todo-mode.el b/lisp/calendar/todo-mode.el
index a49f428a3c8..3975a9ba6a9 100644
--- a/lisp/calendar/todo-mode.el
+++ b/lisp/calendar/todo-mode.el
@@ -1937,11 +1937,13 @@ their associated keys and their effects."
(find-file-noselect file 'nowarn)
(set-window-buffer (selected-window)
(set-buffer (find-buffer-visiting file)))
- ;; If this command was invoked outside of a Todo mode buffer,
- ;; the call to todo-current-category above returned nil. If
- ;; we just entered Todo mode now, then cat was set to the
- ;; file's first category, but if todo-mode was already
- ;; enabled, cat did not get set, so we have to do that.
+ ;; If FILE is not in Todo mode, set it now, which also sets
+ ;; CAT to the file's first category.
+ (unless (derived-mode-p 'todo-mode) (todo-mode))
+ ;; But if FILE was already in todo-mode and the item insertion
+ ;; command was invoked outside of a Todo mode buffer, the
+ ;; above calls to todo-current-category returned nil, so we
+ ;; have to explicitly set CAT to the current category.
(unless cat
(setq cat (todo-current-category)))
(setq todo-current-todo-file file)
@@ -2169,7 +2171,9 @@ the item at point."
(if comment-delete
(when (todo-y-or-n-p "Delete comment? ")
(delete-region (match-beginning 0) (match-end 0)))
- (replace-match (read-string prompt (cons (match-string 1) 1))
+ (replace-match (save-match-data
+ (read-string prompt
+ (cons (match-string 1) 1)))
nil nil nil 1))
(if comment-delete
(user-error "There is no comment to delete")
@@ -2348,25 +2352,35 @@ made in the number or names of categories."
((or (string= omonth "*") (= mm 13))
(user-error "Cannot increment *"))
(t
- (let ((mminc (+ mm inc (if (< inc 0) 12 0))))
- ;; Increment or decrement month by INC
- ;; modulo 12.
- (setq mm (% mminc 12))
- ;; If result is 0, make month December.
- (setq mm (if (= mm 0) 12 (abs mm)))
+ (let* ((mmo mm)
+ ;; Change by 12 or more months?
+ (bigincp (>= (abs inc) 12))
+ ;; Month number is in range 1..12.
+ (mminc (+ mm (% inc 12)))
+ (mm (% (+ mminc 12) 12))
+ ;; 12n mod 12 = 0, so 0 is December.
+ (mm (if (= mm 0) 12 mm))
+ ;; Does change in month cross year?
+ (mmcmp (cond ((< inc 0) (> mm mmo))
+ ((> inc 0) (< mm mmo))))
+ (yyadjust (if bigincp
+ (+ (abs (/ inc 12))
+ (if mmcmp 1 0))
+ 1)))
;; Adjust year if necessary.
- (setq year (or (and (cond ((> mminc 12)
- (+ yy (/ mminc 12)))
- ((< mminc 1)
- (- yy (/ mminc 12) 1))
- (t yy))
- (number-to-string yy))
- oyear)))
- ;; Return the changed numerical month as
- ;; a string or the corresponding month name.
- (if omonth
- (number-to-string mm)
- (aref tma-array (1- mm))))))
+ (setq yy (cond ((and (< inc 0)
+ (or mmcmp bigincp))
+ (- yy yyadjust))
+ ((and (> inc 0)
+ (or mmcmp bigincp))
+ (+ yy yyadjust))
+ (t yy)))
+ (setq year (number-to-string yy))
+ ;; Return the changed numerical month as
+ ;; a string or the corresponding month name.
+ (if omonth
+ (number-to-string mm)
+ (aref tma-array (1- mm)))))))
;; Since the number corresponding to the arbitrary
;; month name "*" is out of the range of
;; calendar-last-day-of-month, set it to 1
@@ -4062,7 +4076,9 @@ regexp items."
((equal (file-name-extension f) "todt") "top")
((equal (file-name-extension f) "tody") "diary"))))
(push (cons (concat sf-name " (" type ")") f) falist)))
- (setq file (completing-read "Choose a filtered items file: " falist nil t nil
+ (setq file (completing-read (format-prompt "Choose a filtered items file"
+ (caar falist))
+ falist nil t nil
'todo--fifiles-history (caar falist)))
(setq file (cdr (assoc-string file falist)))
(find-file file)
@@ -4710,9 +4726,8 @@ name in `todo-directory'. See also the documentation string of
(todo-convert-legacy-date-time)))
(forward-line))
(setq file (concat todo-directory
- (read-string
- (format "Save file as (default \"%s\"): " default)
- nil nil default)
+ (read-string (format-prompt "Save file as" default)
+ nil nil default)
".todo"))
(unless (file-exists-p todo-directory)
(make-directory todo-directory))
@@ -5923,8 +5938,15 @@ categories from `todo-category-completions-files'."
(todo-absolute-file-name
(let ((files (mapcar #'todo-short-file-name catfil)))
(completing-read (format str cat) files)))))))
- ;; Default to the current file.
- (unless file0 (setq file0 todo-current-todo-file))
+ ;; When called without arg FILE, use fallback todo file.
+ (unless file0 (setq file0 (or todo-current-todo-file
+ ;; If we're outside of todo-mode
+ ;; but there is a current todo
+ ;; file, use it.
+ todo-global-current-todo-file
+ ;; Else, use the default todo file.
+ (todo-absolute-file-name
+ todo-default-todo-file))))
;; First validate only a name passed interactively from
;; todo-add-category, which must be of a nonexistent category.
(unless (and (assoc cat categories) (not add))
@@ -6087,11 +6109,12 @@ Valid time strings are those matching `diary-time-regexp'.
Typing `<return>' at the prompt returns the current time, if the
user option `todo-always-add-time-string' is non-nil, otherwise
the empty string (i.e., no time string)."
- (let (valid answer)
+ (let ((default (when todo-always-add-time-string
+ (format-time-string "%H:%M")))
+ valid answer)
(while (not valid)
- (setq answer (read-string "Enter a clock time: " nil nil
- (when todo-always-add-time-string
- (format-time-string "%H:%M"))))
+ (setq answer (read-string (format-prompt "Enter a clock time" default)
+ nil nil default))
(when (or (string= "" answer)
(string-match diary-time-regexp answer))
(setq valid t)))
@@ -6419,8 +6442,7 @@ Filtered Items mode following todo (not done) items."
("i" todo-insert-item)
("k" todo-delete-item)
("m" todo-move-item)
- ("u" todo-item-undone)
- ([remap newline] newline-and-indent))
+ ("u" todo-item-undone))
"List of key bindings for Todo mode only.")
(defvar todo-key-bindings-t+a+f
@@ -6486,7 +6508,6 @@ Filtered Items mode following todo (not done) items."
(defvar todo-edit-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-x\C-q" 'todo-edit-quit)
- (define-key map [remap newline] 'newline-and-indent)
map)
"Todo Edit mode keymap.")
@@ -6645,7 +6666,6 @@ Added to `window-configuration-change-hook' in Todo mode."
(setq-local font-lock-defaults '(todo-font-lock-keywords t))
(setq-local revert-buffer-function #'todo-revert-buffer)
(setq-local tab-width todo-indent-to-here)
- (setq-local indent-line-function #'todo-indent)
(when todo-wrap-lines
(visual-line-mode)
(setq wrap-prefix (make-string todo-indent-to-here 32))))
@@ -6720,6 +6740,7 @@ Added to `window-configuration-change-hook' in Todo mode."
\\{todo-edit-mode-map}"
(todo-modes-set-1)
+ (setq-local indent-line-function #'todo-indent)
(if (> (buffer-size) (- (point-max) (point-min)))
;; Editing one item in an indirect buffer, so buffer-file-name is nil.
(setq-local todo-current-todo-file todo-global-current-todo-file)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-19 01:35:05 +0000