[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r111067: * lisp/calc/calc-forms.el (m
|
From: |
Jay Belanger |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r111067: * lisp/calc/calc-forms.el (math-absolute-from-iso-dt) |
|
Date: |
Sun, 02 Dec 2012 18:54:11 -0600 |
|
User-agent: |
Bazaar (2.5.0) |
------------------------------------------------------------
revno: 111067
committer: Jay Belanger <address@hidden>
branch nick: trunk
timestamp: Sun 2012-12-02 18:54:11 -0600
message:
* lisp/calc/calc-forms.el (math-absolute-from-iso-dt)
(math-date-to-iso-dt, math-parse-iso-date-validate)
(math-iso-dt-to-date): New functions.
(math-fd-iso-dt, math-fd-isoyear, math-fd-isoweek)
(math-fd-isoweekday): New variables.
(calc-date-notation, math-parse-standard-date, math-format-date)
(math-format-date-part): Add support for more formatting codes.
modified:
lisp/ChangeLog
lisp/calc/calc-forms.el
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2012-12-02 21:12:31 +0000
+++ b/lisp/ChangeLog 2012-12-03 00:54:11 +0000
@@ -1,3 +1,13 @@
+2012-12-03 Jay Belanger <address@hidden>
+
+ * calc/calc-forms.el (math-absolute-from-iso-dt)
+ (math-date-to-iso-dt, math-parse-iso-date-validate)
+ (math-iso-dt-to-date): New functions.
+ (math-fd-iso-dt, math-fd-isoyear, math-fd-isoweek)
+ (math-fd-isoweekday): New variables.
+ (calc-date-notation, math-parse-standard-date, math-format-date)
+ (math-format-date-part): Add support for more formatting codes.
+
2012-12-02 Dmitry Gutov <address@hidden>
* vc/vc.el (vc-delete-file, vc-rename-file): Default to the
=== modified file 'lisp/calc/calc-forms.el'
--- a/lisp/calc/calc-forms.el 2012-11-28 04:51:13 +0000
+++ b/lisp/calc/calc-forms.el 2012-12-03 00:54:11 +0000
@@ -95,7 +95,7 @@
(let ((case-fold-search nil))
(and (not (string-match "<.*>" fmt))
;; Find time part to put in <...>
- (string-match
"\\`[^hHspP]*\\([^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*\\(bs\\|bm\\|bh\\|BS\\|BH\\|[hHmpPsS]\\)+[^ac-gi-lnoqrt-zAC-GI-OQRT-Z]*\\)[^hHspP]*\\'"
fmt)
+ (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)
@@ -126,7 +126,7 @@
lfmt nil))
(setq time nil))
(t
- (if (string-match "\\`[^a-zA-Z]*[bB][a-zA-Z]" fmt)
+ (if (string-match "\\`[^a-zA-Z]*[bBZI][a-zA-Z]" fmt)
(setq pos2 (1+ pos2)))
(while (and (< pos2 (length fmt))
(= (upcase (aref fmt pos2))
@@ -134,6 +134,7 @@
(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
@@ -142,7 +143,7 @@
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))
+ 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))
@@ -455,6 +456,26 @@
(% (/ time 60) 60)
(math-add (% time 60) (nth 2 parts)))))))
+(defun math-date-to-iso-dt (date)
+ "Return the ISO8601 date (year week day) of DATE."
+ (unless (Math-integerp date)
+ (setq date (math-floor date)))
+ (let* ((approx (nth 0 (math-date-to-gregorian-dt (math-sub date 3))))
+ (year (math-add approx
+ (let ((y approx)
+ (sum 0))
+ (while (>= (math-compare date
+ (math-iso-dt-to-absolute
(setq y (math-add y 1)) 1 1)) 0)
+ (setq sum (+ sum 1)))
+ sum))))
+ (list
+ year
+ (math-add (car (math-idivmod
+ (math-sub date (math-iso-dt-to-absolute year 1 1))
+ 7))
+ 1)
+ (cdr (math-idivmod date 7)))))
+
(defun math-dt-to-date (dt)
(or (integerp (nth 1 dt))
(math-reject-arg (nth 1 dt) 'fixnump))
@@ -473,6 +494,16 @@
'(float 864 2)))
date)))
+(defun math-iso-dt-to-date (dt)
+ (let ((date (math-absolute-from-iso-dt (car dt) (nth 1 dt) (nth 2 dt))))
+ (if (nth 3 dt)
+ (math-add (math-float date)
+ (math-div (math-add (+ (* (nth 3 dt) 3600)
+ (* (nth 4 dt) 60))
+ (nth 5 dt))
+ '(float 864 2)))
+ date)))
+
(defun math-date-parts (value &optional offset)
(let* ((date (math-floor value))
(time (math-round (math-mul (math-sub value (or offset date)) 86400)
@@ -594,6 +625,14 @@
;; calc-gregorian-switch is a customizable variable defined in calc.el
(defvar calc-gregorian-switch)
+(defun math-absolute-from-iso-dt (year week day)
+ "Return the DATE of the day given by the iso8601 day YEAR WEEK DAY."
+ (let* ((janfour (math-absolute-from-gregorian-dt year 1 4))
+ (prevmon (math-sub janfour
+ (cdr (math-idivmod (math-sub janfour 1) 7)))))
+ (math-add
+ (math-add prevmon (* (1- week) 7))
+ (if (zerop day) 6 (1- day)))))
(defun math-absolute-from-dt (year month day)
"Return the DATE of the day given by the day YEAR MONTH DAY.
@@ -638,6 +677,10 @@
(defvar math-fd-minute)
(defvar math-fd-second)
(defvar math-fd-bc-flag)
+(defvar math-fd-iso-dt)
+(defvar math-fd-isoyear)
+(defvar math-fd-isoweek)
+(defvar math-fd-isoweekday)
(defun math-format-date (math-fd-date)
(if (eq (car-safe math-fd-date) 'date)
@@ -645,12 +688,14 @@
(let ((entry (list math-fd-date calc-internal-prec calc-date-format)))
(or (cdr (assoc entry math-format-date-cache))
(let* ((math-fd-dt nil)
+ (math-fd-iso-dt nil)
(calc-group-digits nil)
(calc-leading-zeros nil)
(calc-number-radix 10)
(calc-twos-complement-mode nil)
math-fd-year math-fd-month math-fd-day math-fd-weekday
math-fd-hour math-fd-minute math-fd-second
+ math-fd-isoyear math-fd-isoweek math-fd-isoweekday
(math-fd-bc-flag nil)
(fmt (apply 'concat (mapcar 'math-format-date-part
calc-date-format))))
@@ -690,6 +735,25 @@
math-julian-date-beginning-int)))
((eq x 'U)
(math-format-number (nth 1 (math-date-parts math-fd-date 719164))))
+ ((memq x '(IYYY Iww w))
+ (progn
+ (or math-fd-iso-dt
+ (setq math-fd-iso-dt (math-date-to-iso-dt math-fd-date)
+ jpb math-fd-date
+ jpbb math-fd-iso-dt
+ math-fd-isoyear (car math-fd-iso-dt)
+ math-fd-isoweek (nth 1 math-fd-iso-dt)
+ math-fd-isoweekday (nth 2 math-fd-iso-dt)))
+ (cond ((eq x 'IYYY)
+ (let* ((neg (Math-negp math-fd-isoyear))
+ (pyear (calcFunc-abs math-fd-isoyear)))
+ (if (and (natnump pyear) (< pyear 10000))
+ (concat (if neg "-" "") (format "%04d" pyear))
+ (concat (if neg "-" "+") (math-format-number pyear)))))
+ ((eq x 'Iww)
+ (concat "W" (format "%02d" math-fd-isoweek)))
+ ((eq x 'w)
+ (format "%d" math-fd-isoweekday)))))
((progn
(or math-fd-dt
(progn
@@ -720,6 +784,15 @@
(if (and (natnump math-fd-year) (< math-fd-year 100))
(format "+%d" math-fd-year)
(math-format-number math-fd-year)))
+ ((eq x 'ZYYY)
+ (let* ((year (if (Math-negp math-fd-year)
+ (math-add math-fd-year 1)
+ math-fd-year))
+ (neg (Math-negp year))
+ (pyear (calcFunc-abs year)))
+ (if (and (natnump pyear) (< pyear 10000))
+ (concat (if neg "-" "") (format "%04d" pyear))
+ (concat (if neg "-" "+") (math-format-number pyear)))))
((eq x 'b) "")
((eq x 'aa)
(and (not math-fd-bc-flag) "ad"))
@@ -745,6 +818,7 @@
(and math-fd-bc-flag "b.c."))
((eq x 'BBBB)
(and math-fd-bc-flag "B.C."))
+ ((eq x 'T) "T")
((eq x 'M)
(format "%d" math-fd-month))
((eq x 'MM)
@@ -1009,6 +1083,20 @@
(list 'date (math-dt-to-date (append (list year month day)
(and hour (list hour minute second))))))
+(defun math-parse-iso-date-validate (isoyear isoweek isoweekday hour minute
second)
+ (if (or (< isoweek 1) (> isoweek 53))
+ (throw 'syntax "Week value is out of range"))
+ (and hour
+ (progn
+ (if (or (< hour 0) (> hour 23))
+ (throw 'syntax "Hour value is out of range"))
+ (if (or (< minute 0) (> minute 59))
+ (throw 'syntax "Minute value is out of range"))
+ (if (or (math-negp second) (not (Math-lessp second 60)))
+ (throw 'syntax "Seconds value is out of range"))))
+ (list 'date (math-iso-dt-to-date (append (list isoyear isoweek isoweekday)
+ (and hour (list hour minute second))))))
+
(defun math-parse-date-word (names &optional front)
(let ((n 1))
(while (and names (not (string-match (if (equal (car names) "Sep")
@@ -1029,6 +1117,7 @@
(let ((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)
@@ -1105,19 +1194,35 @@
(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))
+ ((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)
+ 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))))
+ 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)))))
@@ -1152,7 +1257,9 @@
nil))
nil)
((eq this 'W)
- (and (>= num 0) (< num 7)))
+ (and (>= num 0) (< num 7)))
+ ((eq this 'w)
+ (setq isoweekday num))
((memq this '(d ddd bdd))
(setq yearday num))
((memq this '(M MM BM))
@@ -1169,18 +1276,20 @@
(setq yearday nil)
(setq month 1 day 1)))
(if (and okay (equal math-pd-str ""))
- (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)))))
+ (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))))))
(defun calcFunc-now (&optional zone)
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r111067: * lisp/calc/calc-forms.el (math-absolute-from-iso-dt),
Jay Belanger <=