Function: org-read-date-analyze
org-read-date-analyze is a byte-compiled function defined in
org.el.gz.
Signature
(org-read-date-analyze ANS DEF DEFDECODE)
Documentation
Analyze the combined answer of the date prompt.
Source Code
;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(defun org-read-date-analyze (ans def defdecode)
"Analyze the combined answer of the date prompt."
;; FIXME: cleanup and comment
(let ((org-def def)
(org-defdecode defdecode)
(nowdecode (decode-time))
delta deltan deltaw deltadef year month day
hour minute second wday pm h2 m2 tl wday1
iso-year iso-weekday iso-week iso-date futurep kill-year)
(setq org-read-date-analyze-futurep nil
org-read-date-analyze-forced-year nil)
(when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans)
(setq ans "+0"))
(when (setq delta (org-read-date-get-relative ans nil org-def))
(setq ans (replace-match "" t t ans)
deltan (car delta)
deltaw (nth 1 delta)
deltadef (nth 2 delta)))
;; Check if there is an iso week date in there. If yes, store the
;; info and postpone interpreting it until the rest of the parsing
;; is done.
(when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans)
(setq iso-year (when (match-end 1)
(org-small-year-to-year
(string-to-number (match-string 1 ans))))
iso-weekday (when (match-end 3)
(string-to-number (match-string 3 ans)))
iso-week (string-to-number (match-string 2 ans)))
(setq ans (replace-match "" t t ans)))
;; Help matching ISO dates with single digit month or day, like 2006-8-11.
(when (string-match
"^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans)
(setq year (if (match-end 2)
(string-to-number (match-string 2 ans))
(progn (setq kill-year t)
(string-to-number (format-time-string "%Y"))))
month (string-to-number (match-string 3 ans))
day (string-to-number (match-string 4 ans)))
(setq year (org-small-year-to-year year))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
;; Help matching dotted european dates
(when (string-match
"^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans)
(setq year (if (match-end 3) (string-to-number (match-string 3 ans))
(setq kill-year t)
(string-to-number (format-time-string "%Y")))
day (string-to-number (match-string 1 ans))
month (string-to-number (match-string 2 ans))
ans (replace-match (format "%04d-%02d-%02d" year month day)
t nil ans)))
;; Help matching american dates, like 5/30 or 5/30/7
(when (string-match
"^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans)
(setq year (if (match-end 4)
(string-to-number (match-string 4 ans))
(progn (setq kill-year t)
(string-to-number (format-time-string "%Y"))))
month (string-to-number (match-string 1 ans))
day (string-to-number (match-string 2 ans)))
(setq year (org-small-year-to-year year))
(setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day)
t nil ans)))
;; Help matching am/pm times, because `parse-time-string' does not do that.
;; If there is a time with am/pm, and *no* time without it, we convert
;; so that matching will be successful.
(cl-loop for i from 1 to 2 do ; twice, for end time as well
(when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
(string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans))
(setq hour (string-to-number (match-string 1 ans))
minute (if (match-end 3)
(string-to-number (match-string 3 ans))
0)
pm (equal ?p
(string-to-char (downcase (match-string 4 ans)))))
(if (and (= hour 12) (not pm))
(setq hour 0)
(when (and pm (< hour 12)) (setq hour (+ 12 hour))))
(setq ans (replace-match (format "%02d:%02d" hour minute)
t t ans))))
;; Help matching HHhMM times, similarly as for am/pm times.
(cl-loop for i from 1 to 2 do ; twice, for end time as well
(when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans))
(string-match "\\(?:\\(?1:[012]?[0-9]\\)?h\\(?2:[0-5][0-9]\\)\\)\\|\\(?:\\(?1:[012]?[0-9]\\)h\\(?2:[0-5][0-9]\\)?\\)\\>" ans))
(setq hour (if (match-end 1)
(string-to-number (match-string 1 ans))
0)
minute (if (match-end 2)
(string-to-number (match-string 2 ans))
0))
(setq ans (replace-match (format "%02d:%02d" hour minute)
t t ans))))
;; Check if a time range is given as a duration
(when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans)
(setq hour (string-to-number (match-string 1 ans))
h2 (+ hour (string-to-number (match-string 3 ans)))
minute (string-to-number (match-string 2 ans))
m2 (+ minute (if (match-end 5) (string-to-number
(match-string 5 ans))0)))
(when (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60)))
(setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2)
t t ans)))
;; Check if there is a time range
(when (boundp 'org-end-time-was-given)
(setq org-time-was-given nil)
(when (and (string-match org-plain-time-of-day-regexp ans)
(match-end 8))
(setq org-end-time-was-given (match-string 8 ans))
(setq ans (concat (substring ans 0 (match-beginning 7))
(substring ans (match-end 7))))))
(setq tl (parse-time-string ans)
day (or (nth 3 tl) (nth 3 org-defdecode))
month
(cond ((nth 4 tl))
((not org-read-date-prefer-future) (nth 4 org-defdecode))
;; Day was specified. Make sure DAY+MONTH
;; combination happens in the future.
((nth 3 tl)
(setq futurep t)
(if (< day (nth 3 nowdecode)) (1+ (nth 4 nowdecode))
(nth 4 nowdecode)))
(t (nth 4 org-defdecode)))
year
(cond ((and (not kill-year) (nth 5 tl)))
((not org-read-date-prefer-future) (nth 5 org-defdecode))
;; Month was guessed in the future and is at least
;; equal to NOWDECODE's. Fix year accordingly.
(futurep
(if (or (> month (nth 4 nowdecode))
(>= day (nth 3 nowdecode)))
(nth 5 nowdecode)
(1+ (nth 5 nowdecode))))
;; Month was specified. Make sure MONTH+YEAR
;; combination happens in the future.
((nth 4 tl)
(setq futurep t)
(cond ((> month (nth 4 nowdecode)) (nth 5 nowdecode))
((< month (nth 4 nowdecode)) (1+ (nth 5 nowdecode)))
((< day (nth 3 nowdecode)) (1+ (nth 5 nowdecode)))
(t (nth 5 nowdecode))))
(t (nth 5 org-defdecode)))
hour (or (nth 2 tl) (nth 2 org-defdecode))
minute (or (nth 1 tl) (nth 1 org-defdecode))
second (or (nth 0 tl) 0)
wday (nth 6 tl))
(when (and (eq org-read-date-prefer-future 'time)
(not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl))
(equal day (nth 3 nowdecode))
(equal month (nth 4 nowdecode))
(equal year (nth 5 nowdecode))
(nth 2 tl)
(or (< (nth 2 tl) (nth 2 nowdecode))
(and (= (nth 2 tl) (nth 2 nowdecode))
(nth 1 tl)
(< (nth 1 tl) (nth 1 nowdecode)))))
(setq day (1+ day)
futurep t))
;; Special date definitions below
(cond
(iso-week
;; There was an iso week
(require 'cal-iso)
(setq futurep nil)
(setq year (or iso-year year)
day (or iso-weekday wday 1)
wday nil ; to make sure that the trigger below does not match
iso-date (calendar-gregorian-from-absolute
(calendar-iso-to-absolute
(list iso-week day year))))
; FIXME: Should we also push ISO weeks into the future?
; (when (and org-read-date-prefer-future
; (not iso-year)
; (< (calendar-absolute-from-gregorian iso-date)
; (time-to-days nil)))
; (setq year (1+ year)
; iso-date (calendar-gregorian-from-absolute
; (calendar-iso-to-absolute
; (list iso-week day year)))))
(setq month (car iso-date)
year (nth 2 iso-date)
day (nth 1 iso-date)))
(deltan
(setq futurep nil)
(unless deltadef
(let ((now (decode-time)))
(setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
;; FIXME: Duplicated value in ‘cond’: ""
(cond ((member deltaw '("h" ""))
(when (boundp 'org-time-was-given)
(setq org-time-was-given t))
(setq hour (+ hour deltan)))
((member deltaw '("d" "")) (setq day (+ day deltan)))
((equal deltaw "w") (setq day (+ day (* 7 deltan))))
((equal deltaw "m") (setq month (+ month deltan)))
((equal deltaw "y") (setq year (+ year deltan)))))
((and wday (not (nth 3 tl)))
;; Weekday was given, but no day, so pick that day in the week
;; on or after the derived date.
(setq wday1 (nth 6 (decode-time (org-encode-time 0 0 0 day month year))))
(unless (equal wday wday1)
(setq day (+ day (% (- wday wday1 -7) 7))))))
(when (and (boundp 'org-time-was-given)
(nth 2 tl))
(setq org-time-was-given t))
(when (< year 100) (setq year (+ 2000 year)))
;; Check of the date is representable
(if org-read-date-force-compatible-dates
(progn
(when (< year 1970)
(setq year 1970 org-read-date-analyze-forced-year t))
(when (> year 2037)
(setq year 2037 org-read-date-analyze-forced-year t)))
(condition-case nil
(ignore (org-encode-time second minute hour day month year))
(error
(setq year (nth 5 org-defdecode))
(setq org-read-date-analyze-forced-year t))))
(setq org-read-date-analyze-futurep futurep)
(list second minute hour day month year nil -1 nil)))