* 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.

2 files changed, 138 insertions, 19 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 59622c72678..1fd8fffa8a8 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2012-12-03  Jay Belanger  <jay.p.belanger@gmail.com>
+
+        * 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  <dgutov@yandex.ru>
 
         * vc/vc.el (vc-delete-file, vc-rename-file): Default to the
diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el
index 15a153059a8..9915799002f 100644
--- a/lisp/calc/calc-forms.el
+++ b/lisp/calc/calc-forms.el
@@ -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 @@ in the Gregorian calendar and the remaining part determines the time."
                (% (/ 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 @@ in the Gregorian calendar and the remaining part determines the time."
                             '(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 @@ in the Gregorian calendar."
 ;; 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 @@ in the Gregorian calendar."
 (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 @@ in the Gregorian calendar."
   (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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
                               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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
          (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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
          (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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
   (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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
   (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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
                    (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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
                           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 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)."
             (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)