Function: calc-date-notation
calc-date-notation is an autoloaded, interactive and byte-compiled
function defined in calc-forms.el.gz.
Signature
(calc-date-notation FMT ARG)
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/calc/calc-forms.el.gz
(defun calc-date-notation (fmt arg)
(interactive "sDate format (e.g., M/D/YY h:mm:ss): \nP")
(calc-wrapper
(if (string-match-p "\\`\\s-*\\'" fmt)
(setq fmt "1"))
(if (string-match "\\` *\\([0-9]\\|10\\|11\\) *\\'" fmt)
(setq fmt (nth (string-to-number fmt) calc-standard-date-formats)))
(or (string-match "[a-zA-Z]" fmt)
(error "Bad date format specifier"))
(and arg
(>= (setq arg (prefix-numeric-value arg)) 0)
(<= arg 11)
(setq calc-standard-date-formats
(copy-sequence calc-standard-date-formats))
(setcar (nthcdr arg calc-standard-date-formats) fmt))
(let ((case-fold-search nil))
(and (not (string-match "<.*>" fmt))
;; Find time part to put in <...>
(string-match "\\`[^hHspPT]*\\([^ac-gi-lnoqrt-zAC-GI-OQRU-Z]*\\(bs\\|bm\\|bh\\|BS\\|BH\\|[hHmpPsST]\\)+[^ac-gi-lnoqrt-zAC-GI-OQRU-Z]*\\)[^hHspPT]*\\'" fmt)
(string-match (concat "[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*"
(regexp-quote (math-match-substring fmt 1))
"[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*") fmt)
(setq fmt (concat (substring fmt 0 (match-beginning 0))
"<"
(substring fmt (match-beginning 0) (match-end 0))
">"
(substring fmt (match-end 0))))))
(let ((lfmt nil)
(fullfmt nil)
(time nil)
pos pos2 sym temp)
(let ((case-fold-search nil))
(and (setq temp (string-match ":[BS]S" fmt))
(aset fmt temp ?C)))
(while (setq pos (string-match "[<>a-zA-Z]" fmt))
(if (> pos 0)
(setq lfmt (cons (substring fmt 0 pos) lfmt)))
(setq pos2 (1+ pos))
(cond ((= (aref fmt pos) ?\<)
(and time (error "Nested <'s not allowed"))
(and lfmt (setq fullfmt (nconc lfmt fullfmt)
lfmt nil))
(setq time t))
((= (aref fmt pos) ?\>)
(or time (error "Misplaced > in format"))
(and lfmt (setq fullfmt (cons (nreverse lfmt) fullfmt)
lfmt nil))
(setq time nil))
(t
(if (string-match "\\`[^a-zA-Z]*[bBZI][a-zA-Z]" fmt)
(setq pos2 (1+ pos2)))
(while (and (< pos2 (length fmt))
(= (upcase (aref fmt pos2))
(upcase (aref fmt (1- pos2)))))
(setq pos2 (1+ pos2)))
(setq sym (intern (substring fmt pos pos2)))
(or (memq sym '(Y YY BY YYY YYYY
ZYYY IYYY Iww w
aa AA aaa AAA aaaa AAAA
bb BB bbb BBB bbbb BBBB
M MM BM mmm Mmm Mmmm MMM MMMM
D DD BD d ddd bdd
W www Www Wwww WWW WWWW
h hh bh H HH BH
p P pp PP pppp PPPP
m mm bm s ss bs SS BS C
N n J j U b T))
(and (eq sym 'X) (not lfmt) (not fullfmt))
(error "Bad format code: %s" sym))
(and (memq sym '(bb BB bbb BBB bbbb BBBB))
(setq lfmt (cons 'b lfmt)))
(setq lfmt (cons sym lfmt))))
(setq fmt (substring fmt pos2)))
(or (equal fmt "")
(setq lfmt (cons fmt lfmt)))
(and lfmt (if time
(setq fullfmt (cons (nreverse lfmt) fullfmt))
(setq fullfmt (nconc lfmt fullfmt))))
(calc-change-mode 'calc-date-format (nreverse fullfmt) t))))