Function: ietf-drums-parse-date-string
ietf-drums-parse-date-string is a byte-compiled function defined in
ietf-drums-date.el.gz.
Signature
(ietf-drums-parse-date-string TIME-STRING &optional ERROR NO-822)
Documentation
Parse an RFC5322 or RFC822 date, passed as TIME-STRING.
The optional ERROR parameter causes syntax errors to be flagged by signaling an instance of the date-parse-error condition. The optional NO-822 parameter disables the more lax RFC822 syntax, which is permitted by default.
The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ),
which can be accessed as a decoded-time defstruct (q.v.),
e.g. decoded-time-year to extract the year, and turned into an
Emacs timestamp by encode-time.
The strict syntax for RFC5322 is as follows:
[ day-of-week "," ] day FWS month-name FWS year FWS time [CFWS]
where the "time" production is:
2DIGIT ":" 2DIGIT [ ":" 2DIGIT ] FWS ( "+" / "-" ) 4DIGIT
and FWS is "folding white space," and CFWS is "comments and/or folding white space", where comments are included in nesting parentheses and are equivalent to white space. RFC822 also accepts comments in random places (all of which is handled by ietf-drums-date--tokenize-string) and two-digit years. For two-digit years, 50 and up are interpreted as 1950 through 1999 and 00 through 49 as 200 through 2049.
We are somewhat more lax in what we accept (specifically, the hours don't have to be two digits, and the TZ and the comma after the DOW are optional), but we do insist that the items that are present do appear in this order. Unspecified/unrecognized elements in the string are returned as nil (except unspecified DST is returned as -1).
Probably introduced at or before Emacs version 29.1.
Source Code
;; Defined in /usr/src/emacs/lisp/mail/ietf-drums-date.el.gz
(defun ietf-drums-parse-date-string (time-string &optional error no-822)
"Parse an RFC5322 or RFC822 date, passed as TIME-STRING.
The optional ERROR parameter causes syntax errors to be flagged
by signaling an instance of the date-parse-error condition. The
optional NO-822 parameter disables the more lax RFC822 syntax,
which is permitted by default.
The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ),
which can be accessed as a decoded-time defstruct (q.v.),
e.g. `decoded-time-year' to extract the year, and turned into an
Emacs timestamp by `encode-time'.
The strict syntax for RFC5322 is as follows:
[ day-of-week \",\" ] day FWS month-name FWS year FWS time [CFWS]
where the \"time\" production is:
2DIGIT \":\" 2DIGIT [ \":\" 2DIGIT ] FWS ( \"+\" / \"-\" ) 4DIGIT
and FWS is \"folding white space,\" and CFWS is \"comments and/or
folding white space\", where comments are included in nesting
parentheses and are equivalent to white space. RFC822 also
accepts comments in random places (all of which is handled by
ietf-drums-date--tokenize-string) and two-digit years. For
two-digit years, 50 and up are interpreted as 1950 through 1999
and 00 through 49 as 200 through 2049.
We are somewhat more lax in what we accept (specifically, the
hours don't have to be two digits, and the TZ and the comma after
the DOW are optional), but we do insist that the items that are
present do appear in this order. Unspecified/unrecognized
elements in the string are returned as nil (except unspecified
DST is returned as -1)."
(let ((tokens (ietf-drums-date--tokenize-string (downcase time-string)
no-822))
(time (list nil nil nil nil nil nil nil -1 nil)))
(cl-labels ((set-matched-slot (slot index token)
;; Assign a slot value from match data if index is
;; non-nil, else from token, signaling an error if
;; enabled and it's out of range.
(let ((value (if index
(cl-parse-integer (match-string index token))
token)))
(when error
(let ((range (nth slot ietf-drums-date--slot-ranges)))
(when (and range
(not (<= (car range) value (cadr range))))
(signal 'date-parse-error
(list "Slot out of range"
(nth slot ietf-drums-date--slot-names)
token (car range) (cadr range))))))
(setf (nth slot time) value)))
(set-numeric (slot token)
;; Only assign the slot if the token is a number.
(cond ((natnump token)
(set-matched-slot slot nil token))
(error
(signal 'date-parse-error
(list "Not a number"
(nth slot ietf-drums-date--slot-names)
token))))))
;; Check for weekday.
(let ((dow (assoc (car tokens) parse-time-weekdays)))
(when dow
;; Day of the week.
(set-matched-slot 6 nil (cdr dow))
(pop tokens)))
;; Day.
(set-numeric 3 (pop tokens))
;; Alphabetic month.
(let* ((month (pop tokens))
(match (assoc month parse-time-months)))
(cond (match
(set-matched-slot 4 nil (cdr match)))
(error
(signal 'date-parse-error
(list "Expected an alphabetic month" month)))
(t
(push month tokens))))
;; Year.
(let ((year (pop tokens)))
;; Check the year for the right number of digits.
(cond ((not (natnump year))
(when error
(signal 'date-parse-error
(list "Expected a year" year)))
(push year tokens))
((>= year 1000)
(set-numeric 5 year))
((or no-822
(>= year 100))
(when error
(signal 'date-parse-error
(list "Four-digit years are required" year)))
(push year tokens))
((>= year 50)
;; second half of the 20th century.
(set-numeric 5 (+ 1900 year)))
(t
;; first half of the 21st century.
(set-numeric 5 (+ 2000 year)))))
;; Time.
(let ((time (pop tokens)))
(cond ((or (null time) (natnump time))
(when error
(signal 'date-parse-error
(list "Expected a time" time)))
(push time tokens))
((string-match
"^\\([0-9][0-9]?\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$"
time)
(set-matched-slot 2 1 time)
(set-matched-slot 1 2 time)
(set-matched-slot 0 3 time))
((string-match "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\)$" time)
;; Time without seconds.
(set-matched-slot 2 1 time)
(set-matched-slot 1 2 time)
(set-matched-slot 0 nil 0))
(error
(signal 'date-parse-error
(list "Expected a time" time)))))
;; Timezone.
(let* ((zone (pop tokens))
(match (assoc zone parse-time-zoneinfo)))
(cond (match
(set-matched-slot 8 nil (cadr match))
(set-matched-slot 7 nil (caddr match)))
((and (stringp zone)
(string-match "^[-+][0-9][0-9][0-9][0-9]$" zone))
;; Numeric time zone.
(set-matched-slot
8 nil
(* 60
(+ (cl-parse-integer zone :start 3 :end 5)
(* 60 (cl-parse-integer zone :start 1 :end 3)))
(if (= (aref zone 0) ?-) -1 1))))
((and zone error)
(signal 'date-parse-error
(list "Expected a timezone" zone)))))
(when (and tokens error)
(signal 'date-parse-error
(list "Extra token(s)" (car tokens)))))
time))