Function: math-parse-date

math-parse-date is an autoloaded and byte-compiled function defined in calc-forms.el.gz.

Signature

(math-parse-date PD-STR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-forms.el.gz
(defun math-parse-date (pd-str)
  (catch 'syntax
    (or (math-parse-standard-date pd-str t)
	(math-parse-standard-date pd-str nil)
        (and (string-match "W[0-9][0-9]" pd-str)
             (math-parse-iso-date pd-str))
	(and (string-match "\\`[^-+/0-9a-zA-Z]*\\([-+]?[0-9]+\\.?[0-9]*\\([eE][-+]?[0-9]+\\)?\\)[^-+/0-9a-zA-Z]*\\'" pd-str)
	     (list 'date (math-read-number (math-match-substring pd-str 1))))
	(let ((case-fold-search t)
	      (math-pd-str pd-str)
	      (year nil) (month nil) (day nil) (weekday nil)
	      (hour nil) (minute nil) (second nil) (bc-flag nil)
	      (a nil) (b nil) (c nil) (bigyear nil) temp)

	  ;; Extract the time, if any.
	  (if (or (string-match "\\([0-9][0-9]?\\):\\([0-9][0-9]?\\)\\(:\\([0-9][0-9]?\\(\\.[0-9]+\\)?\\)\\)? *\\([ap]\\>\\|[ap]m\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)?" math-pd-str)
		  (string-match "\\([0-9][0-9]?\\)\\(\\)\\(\\(\\(\\)\\)\\) *\\([ap]\\>\\|[ap]m\\|[ap]\\. *m\\.\\|noon\\|n\\>\\|midnight\\|mid\\>\\|m\\>\\)" math-pd-str))
	      (let ((ampm (math-match-substring math-pd-str 6)))
		(setq hour (string-to-number (math-match-substring math-pd-str 1))
		      minute (math-match-substring math-pd-str 2)
		      second (math-match-substring math-pd-str 4)
		      math-pd-str (concat (substring math-pd-str 0 (match-beginning 0))
				  (substring math-pd-str (match-end 0))))
		(if (equal minute "")
		    (setq minute 0)
		  (setq minute (string-to-number minute)))
		(if (equal second "")
		    (setq second 0)
		  (setq second (math-read-number second)))
		(if (equal ampm "")
		    (if (or
                         (> hour 24)
                         (and (= hour 24)
                              (not (= minute 0))
                              (not (eq second 0))))
			(throw 'syntax "Hour value is out of range"))
		  (setq ampm (upcase (aref ampm 0)))
		  (if (memq ampm '(?N ?M))
		      (if (and (= hour 12) (= minute 0) (eq second 0))
			  (if (eq ampm ?M) (setq hour 0))
			(throw 'syntax
			       "Time must be 12:00:00 in this context"))
		    (if (or (= hour 0) (> hour 12))
			(throw 'syntax "Hour value is out of range"))
		    (if (eq (= ampm ?A) (= hour 12))
			(setq hour (% (+ hour 12) 24)))))))

	  ;; Rewrite xx-yy-zz to xx/yy/zz to avoid seeing "-" as a minus sign.
	  (while (string-match "[0-9a-zA-Z]\\(-\\)[0-9a-zA-Z]" math-pd-str)
	    (progn
	      (setq math-pd-str (copy-sequence math-pd-str))
	      (aset math-pd-str (match-beginning 1) ?\/)))

	  ;; Extract obvious month or weekday names.
	  (if (string-match "[a-zA-Z]" math-pd-str)
	      (progn
		(setq month (math-parse-date-word math-long-month-names))
		(setq weekday (math-parse-date-word math-long-weekday-names))
		(or month (setq month
				(math-parse-date-word math-short-month-names)))
		(or weekday (math-parse-date-word math-short-weekday-names))
		(or hour
		    (if (setq temp (math-parse-date-word
				    '( "noon" "midnight" "mid" )))
			(setq hour (if (= temp 1) 12 0) minute 0 second 0)))
		(or (math-parse-date-word '( "ad" "a.d." ))
		    (if (math-parse-date-word '( "bc" "b.c." ))
			(setq bc-flag t)))
		(if (string-match "[a-zA-Z]+" math-pd-str)
		    (throw 'syntax (format "Bad word in date: \"%s\""
					   (math-match-substring math-pd-str 0))))))

	  ;; If there is a huge number other than the year, ignore it.
	  (while (and (string-match "[-+]?0*[1-9][0-9][0-9][0-9][0-9]+" math-pd-str)
		      (setq temp (concat (substring math-pd-str 0 (match-beginning 0))
					 (substring math-pd-str (match-end 0))))
		      (string-match
                       "[4-9][0-9]\\|[0-9][0-9][0-9]\\|[-+][0-9]+[^-]*\\'" temp))
	    (setq math-pd-str temp))

	  ;; If there is a number with a sign or a large number, it is a year.
	  (if (or (string-match "\\([-+][0-9]+\\)[^-]*\\'" math-pd-str)
		  (string-match "\\(0*[1-9][0-9][0-9]+\\)" math-pd-str))
	      (setq year (math-match-substring math-pd-str 1)
		    math-pd-str (concat (substring math-pd-str 0 (match-beginning 1))
				(substring math-pd-str (match-end 1)))
		    year (math-read-number year)
		    bigyear t))

	  ;; Collect remaining numbers.
	  (setq temp 0)
	  (while (string-match "[0-9]+" math-pd-str temp)
	    (and c (throw 'syntax "Too many numbers in date"))
	    (setq c (string-to-number (math-match-substring math-pd-str 0)))
	    (or b (setq b c c nil))
	    (or a (setq a b b nil))
	    (setq temp (match-end 0)))

	  ;; Check that we have the right amount of information.
	  (setq temp (+ (if year 1 0) (if month 1 0) (if day 1 0)
			(if a 1 0) (if b 1 0) (if c 1 0)))
	  (if (> temp 3)
	      (throw 'syntax "Too many numbers in date")
	    (if (or (< temp 2) (and year (= temp 2)))
		(throw 'syntax "Not enough numbers in date")
	      (if (= temp 2)   ; if year omitted, assume current year
		  (setq year (math-this-year)))))

	  ;; A large number must be a year.
	  (or year
	      (if (and a (or (> a 31) (< a 1)))
		  (setq year a a b b c c nil)
		(if (and b (or (> b 31) (< b 1)))
		    (setq year b b c c nil)
		  (if (and c (or (> c 31) (< c 1)))
		      (setq year c c nil)))))

	  ;; A medium-large number must be a day.
	  (if year
	      (if (and a (> a 12))
		  (setq day a a b b c c nil)
		(if (and b (> b 12))
		    (setq day b b c c nil)
		  (if (and c (> c 12))
		      (setq day c c nil)))))

	  ;; We may know enough to sort it out now.
	  (if (and year day)
	      (or month (setq month a))
	    (if (and year month)
		(setq day a)

	      ;; Interpret order of numbers as same as for display format.
	      (setq temp calc-date-format)
	      (while temp
		(cond ((not (symbolp (car temp))))
		      ((memq (car temp) '(Y YY BY YYY YYYY))
		       (or year (setq year a a b b c)))
		      ((memq (car temp) '(M MM BM mmm Mmm Mmmm MMM MMMM))
		       (or month (setq month a a b b c)))
		      ((memq (car temp) '(D DD BD))
		       (or day (setq day a a b b c))))
		(setq temp (cdr temp)))

	      ;; If display format was not complete, assume American style.
	      (or month (setq month a a b b c))
	      (or day (setq day a a b b c))
	      (or year (setq year a a b b c))))

	  (if bc-flag
	      (setq year (math-neg (math-abs year))))

	  (math-parse-date-validate year bigyear month day
				    hour minute second)))))