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

1 files changed, 128 insertions, 19 deletions

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)