Function: math-parse-standard-date
math-parse-standard-date is a byte-compiled function defined in
calc-forms.el.gz.
Signature
(math-parse-standard-date PD-STR WITH-TIME)
Source Code
;; Defined in /usr/src/emacs/lisp/calc/calc-forms.el.gz
(defun math-parse-standard-date (pd-str with-time)
(let ((math-pd-str pd-str)
(case-fold-search t)
(okay t) num
(fmt calc-date-format) this next (gnext nil)
(isoyear nil) (isoweek nil) (isoweekday nil)
(year nil) (month nil) (day nil) (bigyear nil) (yearday nil)
(hour nil) (minute nil) (second nil) (bc-flag nil))
(while (and fmt okay)
(setq this (car fmt)
fmt (setq fmt (or (cdr fmt)
(prog1
gnext
(setq gnext nil))))
next (car fmt))
(if (consp next) (setq next (car next)))
(or (cond ((listp this)
(or (not with-time)
(not this)
(setq gnext fmt
fmt this)))
((stringp this)
(if (and (<= (length this) (length math-pd-str))
(equal this
(substring math-pd-str 0 (length this))))
(setq math-pd-str (substring math-pd-str (length this)))))
((eq this 'X)
t)
((memq this '(n N j J))
(and (string-match "\\`[-+]?[0-9.]+\\([eE][-+]?[0-9]+\\)?" math-pd-str)
(setq num (math-match-substring math-pd-str 0)
math-pd-str (substring math-pd-str (match-end 0))
num (math-date-to-dt (math-read-number num))
num (math-sub num
(if (memq this '(n N))
0
(if (or (eq this 'j)
(math-integerp num))
math-julian-date-beginning-int
math-julian-date-beginning)))
hour (or (nth 3 num) hour)
minute (or (nth 4 num) minute)
second (or (nth 5 num) second)
year (car num)
month (nth 1 num)
day (nth 2 num))))
((eq this 'U)
(and (string-match "\\`[-+]?[0-9]+" math-pd-str)
(setq num (math-match-substring math-pd-str 0)
math-pd-str (substring math-pd-str (match-end 0))
num (math-date-to-dt
(math-add math-unix-epoch
(math-div (math-read-number num)
'(float 864 2))))
hour (nth 3 num)
minute (nth 4 num)
second (nth 5 num)
year (car num)
month (nth 1 num)
day (nth 2 num))))
((memq this '(mmm Mmm MMM))
(setq month (math-parse-date-word math-short-month-names t)))
((memq this '(Mmmm MMMM))
(setq month (math-parse-date-word math-long-month-names t)))
((memq this '(www Www WWW))
(math-parse-date-word math-short-weekday-names t))
((memq this '(Wwww WWWW))
(math-parse-date-word math-long-weekday-names t))
((memq this '(p P))
(if (string-match "\\`a" math-pd-str)
(setq hour (if (= hour 12) 0 hour)
math-pd-str (substring math-pd-str 1))
(if (string-match "\\`p" math-pd-str)
(setq hour (if (= hour 12) 12 (% (+ hour 12) 24))
math-pd-str (substring math-pd-str 1)))))
((memq this '(pp PP pppp PPPP))
(if (string-match "\\`am\\|a\\.m\\." math-pd-str)
(setq hour (if (= hour 12) 0 hour)
math-pd-str (substring math-pd-str (match-end 0)))
(if (string-match "\\`pm\\|p\\.m\\." math-pd-str)
(setq hour (if (= hour 12) 12 (% (+ hour 12) 24))
math-pd-str (substring math-pd-str (match-end 0))))))
((memq this '(Y YY BY YYY YYYY ZYYY))
(and (if (memq next '(MM DD ddd hh HH mm ss SS))
(if (memq this '(Y YY BYY))
(string-match "\\` *[0-9][0-9]" math-pd-str)
(string-match "\\`[0-9][0-9][0-9][0-9]" math-pd-str))
(string-match "\\`[-+]?[0-9]+" math-pd-str))
(setq year (math-match-substring math-pd-str 0)
bigyear (or (eq this 'YYY)
(memq (aref math-pd-str 0) '(?\+ ?\-)))
math-pd-str (substring math-pd-str (match-end 0))
year (math-read-number year))
(if (and (eq this 'ZYYY) (eq year 0))
(setq year (math-sub year 1)
bigyear t)
t)))
((eq this 'IYYY)
(if (string-match "\\`[-+]?[0-9]+" math-pd-str)
(setq isoyear (string-to-number (math-match-substring math-pd-str 0))
math-pd-str (substring math-pd-str (match-end 0)))))
((eq this 'Iww)
(if (string-match "W\\([0-9][0-9]\\)" math-pd-str)
(setq isoweek (string-to-number (math-match-substring math-pd-str 1))
math-pd-str (substring math-pd-str 3))))
((eq this 'b)
t)
((eq this 'T)
(if (eq (aref math-pd-str 0) ?T)
(setq math-pd-str (substring math-pd-str 1))
t))
((memq this '(aa AA aaaa AAAA))
(if (string-match "\\` *\\(ad\\|a\\.d\\.\\)" math-pd-str)
(setq math-pd-str (substring math-pd-str (match-end 0)))))
((memq this '(aaa AAA))
(if (string-match "\\` *ad *" math-pd-str)
(setq math-pd-str (substring math-pd-str (match-end 0)))))
((memq this '(bb BB bbb BBB bbbb BBBB))
(if (string-match "\\` *\\(bc\\|b\\.c\\.\\)" math-pd-str)
(setq math-pd-str (substring math-pd-str (match-end 0))
bc-flag t)))
((memq this '(s ss bs SS BS))
(and (if (memq next '(YY YYYY MM DD hh HH mm))
(string-match "\\` *[0-9][0-9]\\(\\.[0-9]+\\)?" math-pd-str)
(string-match "\\` *[0-9][0-9]?\\(\\.[0-9]+\\)?" math-pd-str))
(setq second (math-match-substring math-pd-str 0)
math-pd-str (substring math-pd-str (match-end 0))
second (math-read-number second))))
((eq this 'C)
(if (string-match "\\`:[0-9][0-9]" math-pd-str)
(setq math-pd-str (substring math-pd-str 1))
t))
((or (not (if (and (memq this '(ddd MM DD hh HH mm))
(memq next '(YY YYYY MM DD ddd
hh HH mm ss SS)))
(if (eq this 'ddd)
(string-match "\\` *[0-9][0-9][0-9]" math-pd-str)
(string-match "\\` *[0-9][0-9]" math-pd-str))
(string-match "\\` *[0-9]+" math-pd-str)))
(and (setq num (string-to-number
(math-match-substring math-pd-str 0))
math-pd-str (substring math-pd-str (match-end 0)))
nil))
nil)
((eq this 'W)
(and (>= num 0) (< num 7)))
((eq this 'w)
(setq isoweekday num))
((memq this '(d ddd bdd))
(setq yearday num))
((memq this '(M MM BM))
(setq month num))
((memq this '(D DD BD))
(setq day num))
((memq this '(h hh bh H HH BH))
(setq hour num))
((memq this '(m mm bm))
(setq minute num)))
(setq okay nil)))
(if yearday
(if (and month day)
(setq yearday nil)
(setq month 1 day 1)))
(if (and okay (equal math-pd-str ""))
(if isoyear
(math-parse-iso-date-validate isoyear isoweek isoweekday hour minute second)
(and month day (or (not (or hour minute second))
(and hour minute))
(progn
(or year (setq year (math-this-year)))
(or second (setq second 0))
(if bc-flag
(setq year (math-neg (math-abs year))))
(setq day (math-parse-date-validate year bigyear month day
hour minute second))
(if yearday
(setq day (math-add day (1- yearday))))
day))))))