Start implementing a real ISO 8601 parser

2 files changed, 309 insertions, 0 deletions

diff --git a/lisp/calendar/iso8601.el b/lisp/calendar/iso8601.el
new file mode 100644
index 00000000000..52b69025906
--- /dev/null
+++ b/lisp/calendar/iso8601.el
@@ -0,0 +1,233 @@
+;;; iso8601.el --- parse ISO 8601 date/time strings  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Keywords: dates
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(cl-defmethod make-decoded-time (&key second minute hour
+                                      day month year
+                                      dst zone)
+  (list (or second 0)
+        (or minute 0)
+        (or hour 0)
+        (or day 1)
+        (or month 1)
+        (or year 0)
+        nil
+        dst
+        zone))
+
+(defun iso8601-parse-date (string)
+  "Parse STRING (which should be on ISO 8601 format) and return a time value."
+  (cond
+   ;; Just a year: [-+]YYYY.
+   ((string-match "\\`\\([-+]\\)?\\([0-9][0-9][0-9][0-9]\\)\\'" string)
+    (let ((year (string-to-number (match-string 2 string)))
+          (sign (match-string 1 string)))
+      (make-decoded-time
+       :year (if (string= sign "-")
+                 ;; -0001 is 2 BCE.
+                 (- year 1)
+               year))))
+   ;; Calendar dates: YYY-MM-DD and variants.
+   ((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)\\'"
+                  string)
+    (make-decoded-time
+     :year (string-to-number (match-string 1 string))
+     :month (string-to-number (match-string 2 string))
+     :day (string-to-number (match-string 3 string))))
+   ;; Calendar date without day: YYYY-MM.
+   ((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-\\([0-9][0-9]\\)\\'" string)
+    (make-decoded-time
+     :year (string-to-number (match-string 1 string))
+     :month (string-to-number (match-string 2 string))))
+   ;; Outdated date without year: --MM-DD
+   ((string-match "\\`--\\([0-9][0-9]\\)-?\\([0-9][0-9]\\)\\'" string)
+    (make-decoded-time
+     :month (string-to-number (match-string 1 string))
+     :day (string-to-number (match-string 2 string))))
+   ;; Week dates: YYYY-Www-D
+   ((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-?W\\([0-9][0-9]\\)-?\\([0-9]\\)?\\'"
+                  string)
+    (let* ((year (string-to-number (match-string 1 string)))
+           (week (string-to-number (match-string 2 string)))
+           (day-of-week (and (match-string 3 string)
+                             (string-to-number (match-string 3 string))))
+           (jan-start (decoded-time-weekday
+                       (decode-time
+                        (encode-time
+                         (make-decoded-time :year year
+                                            :month 1
+                                            :day 4)))))
+           (correction (+ (if (zerop jan-start) 7 jan-start)
+                          3))
+           (ordinal (+ (* week 7) (or day-of-week 0) (- correction))))
+      (cond
+       ;; Monday 29 December 2008 is written "2009-W01-1".
+       ((< ordinal 1)
+        (setq year (1- year)
+              ordinal (+ ordinal (iso8601-days-in-year year))))
+       ;; Sunday 3 January 2010 is written "2009-W53-7".
+       ((> ordinal (iso8601-days-in-year year))
+        (setq ordinal (- ordinal (iso8601-days-in-year year))
+              year (1+ year))))
+      (let ((month-day (iso8601-ordinal-to-date year ordinal)))
+        (make-decoded-time :year year
+                           :month (car month-day)
+                           :day (cdr month-day)))))
+   ;; Ordinal dates: YYYY-DDD
+   ((string-match "\\`\\([0-9][0-9][0-9][0-9]\\)-?\\([0-9][0-9][0-9]\\)\\'"
+                  string)
+    (let* ((year (string-to-number (match-string 1 string)))
+           (ordinal (string-to-number (match-string 2 string)))
+           (month-day (iso8601-ordinal-to-date year ordinal)))
+      (make-decoded-time :year year
+                         :month (car month-day)
+                         :day (cdr month-day))))))
+
+(defun iso8601-parse-time (string)
+  "Parse STRING, which should be an ISO 8601 time string, and return a time value."
+  (when (string-match "\\`\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?:?\\([0-9][0-9]\\)?\\.?\\([0-9][0-9][0-9]\\)?\\'"
+                      string)
+    (let ((hour (string-to-number (match-string 1 string)))
+          (minute (and (match-string 2 string)
+                       (string-to-number (match-string 2 string))))
+          (second (and (match-string 3 string)
+                       (string-to-number (match-string 3 string))))
+          ;; Hm...
+          (_millisecond (and (match-string 4 string)
+                             (string-to-number (match-string 4 string)))))
+      (make-decoded-time :hour hour
+                         :minute (or minute 0)
+                         :second (or second 0)))))
+
+(defun iso8601-parse-zone (string)
+  "Parse STRING, which should be an ISO 8601 time zone.
+Return the number of minutes."
+  (when (string-match "\\`\\(Z\\|\\([-+]\\)?\\([0-9][0-9]\\):?\\([0-9][0-9]\\)?\\)\\'"
+                      string)
+    (if (match-string 1 string)
+        ;; HH:MM-ish.
+        (let ((hour (string-to-number (match-string 3 string)))
+              (minute (and (match-string 4 string)
+                           (string-to-number (match-string 5 string)))))
+          (+ (* (if (equal (match-string 1 string) "-")
+                    (- hour)
+                  hour)
+                60
+                (or minute 0))))
+      ;; "Z".
+      0)))
+
+(defun iso8601-parse (string)
+  "Parse a time string."
+  (when (string-match "\\`\\([^T]+\\)\\(T\\([:0-9]+\\)\\(.+\\)?\\)?\\'" string)
+    (let* ((date-string (match-string 1 string))
+           (time-string (match-string 3 string))
+           (zone-string (match-string 4 string))
+           (date (iso8601-parse-date date-string)))
+      (when time-string
+        (let ((time (iso8601-parse-time time-string)))
+          (setf (decoded-time-hour date) (decoded-time-hour time))
+          (setf (decoded-time-minute date) (decoded-time-minute time))
+          (setf (decoded-time-second date) (decoded-time-second time))))
+      (when zone-string
+        (setf (decoded-time-zone date)
+              ;; The time zone in decoded times are in seconds.
+              (* (iso8601-parse-zone zone-string) 60)))
+      date)))
+
+(defun iso8601-days-in-year (year)
+  (if (and (zerop (% year 4))
+           (if (zerop (% year 100))
+               (not (zerop (% year 400)))
+             t))
+      366
+    365))
+
+(defun iso8601-days-in-month (year month)
+  (if (= month 2)
+      (if (= (iso8601-days-in-year year) 365)
+          28
+        29)
+    (if (memq month '(1 3 5 7 8 10 12))
+        31
+     30)))
+
+(defun iso8601-ordinal-to-date (year ordinal)
+  (let ((month 1))
+    (while (> ordinal (iso8601-days-in-month year month))
+      (setq ordinal (- ordinal (iso8601-days-in-month year month))
+            month (1+ month)))
+    (cons month ordinal)))
+
+(defun iso8601-parse-duration (string)
+  "Parse ISO 8601 durations on the form P3Y6M4DT12H30M5S."
+  (cond
+   ((string-match "\\`P\\([0-9]+Y\\)?\\([0-9]+M\\)?\\([0-9]+D\\)?\\(T\\([0-9]+H\\)?\\([0-9]+M\\)?\\([0-9]+S\\)?\\)?\\'"
+                  string)
+    (let ((year (match-string 1 string))
+          (month (match-string 2 string))
+          (day (match-string 3 string))
+          (hour (match-string 5 string))
+          (minute (match-string 6 string))
+          (second (match-string 7 string)))
+      (when (> (length (match-string 0 string)) 2)
+        (make-decoded-time :year (if year (string-to-number year) 0)
+                           :month (if month (string-to-number month) 0)
+                           :day (if day (string-to-number day) 0)
+                           :hour (if hour (string-to-number hour) 0)
+                           :minute (if minute (string-to-number minute) 0)
+                           :second (if second (string-to-number second) 0)))))
+   ;; PnW: Weeks.
+   ((string-match "\\`P\\([0-9]+\\)W\\'" string)
+    (let ((weeks (string-to-number (match-string 1 string))))
+      ;; Does this make sense?  Hm...
+      (make-decoded-time :day (* weeks 7))))
+   ;; P<date>T<time>
+   ((string-match "\\`P[-0-9W]+T[:0-9]+\\'" string)
+    (iso8601-parse (substring string 1)))))
+
+(defun iso8601-parse-interval (string)
+  "Parse ISO 8601 intervals."
+  (let ((bits (split-string string "/"))
+        start end duration)
+    (when (= (length bits) 2)
+      (cond
+       ((string-match "\\`P" (car bits))
+        (setq duration (iso8601-parse-duration (car bits))
+              end (encode-time (iso8601-parse (cadr bits)))
+              start (time-subtract end (encode-time duration))))
+       ((string-match "\\`P" (cadr bits))
+        (setq duration (iso8601-parse-duration (cadr bits))
+              start (encode-time (iso8601-parse (car bits)))
+              end (time-add start (encode-time duration))))
+       (t
+        (setq start (encode-time (iso8601-parse (car bits)))
+              end (encode-time (iso8601-parse (cadr bits)))))))
+    (list start end)))
+
+(provide 'iso8601)
+
+;;; iso8601.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 5f27b75a4c7..888d0462029 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -9054,6 +9054,82 @@ to capitalize ARG words."
       (capitalize-region (region-beginning) (region-end))
     (capitalize-word arg)))
 
+;;; Accessors for `decode-time' values.
+
+(defsubst decoded-time-second (time)
+  "The seconds in TIME, which is a value returned by `decode-time'.
+This is an integer between 0 and 60 (inclusive).  (60 is a leap
+second, which only some operating systems support.)"
+  (nth 0 time))
+
+(defsubst decoded-time-minute (time)
+  "The minutes in TIME, which is a value returned by `decode-time'.
+This is an integer between 0 and 59 (inclusive)."
+  (nth 1 time))
+
+(defsubst decoded-time-hour (time)
+  "The hours in TIME, which is a value returned by `decode-time'.
+This is an integer between 0 and 23 (inclusive)."
+  (nth 2 time))
+
+(defsubst decoded-time-day (time)
+  "The day-of-the-month in TIME, which is a value returned by `decode-time'.
+This is an integer between 1 and 31 (inclusive)."
+  (nth 3 time))
+
+(defsubst decoded-time-month (time)
+  "The month in TIME, which is a value returned by `decode-time'.
+This is an integer between 1 and 12 (inclusive).  January is 1."
+  (nth 4 time))
+
+(defsubst decoded-time-year (time)
+  "The year in TIME, which is a value returned by `decode-time'.
+This is a four digit integer."
+  (nth 5 time))
+
+(defsubst decoded-time-weekday (time)
+  "The day-of-the-week in TIME, which is a value returned by `decode-time'.
+This is a number between 0 and 6, and 0 is Sunday."
+  (nth 6 time))
+
+(defsubst decoded-time-dst (time)
+  "The daylight saving time in TIME, which is a value returned by `decode-time'.
+This is t if daylight saving time is in effect, and nil if not."
+  (nth 7 time))
+
+(defsubst decoded-time-zone (time)
+  "The time zone in TIME, which is a value returned by `decode-time'.
+This is an integer indicating the UTC offset in seconds, i.e.,
+the number of seconds east of Greenwich."
+  (nth 8 time))
+
+(gv-define-setter decoded-time-second (second time)
+  `(setf (nth 0 ,time) ,second))
+
+(gv-define-setter decoded-time-minute (minute time)
+  `(setf (nth 1 ,time) ,minute))
+
+(gv-define-setter decoded-time-hour (hour time)
+  `(setf (nth 2 ,time) ,hour))
+
+(gv-define-setter decoded-time-day (day time)
+  `(setf (nth 3 ,time) ,day))
+
+(gv-define-setter decoded-time-month (month time)
+  `(setf (nth 4 ,time) ,month))
+
+(gv-define-setter decoded-time-year (year time)
+  `(setf (nth 5 ,time) ,year))
+
+;; No setter for weekday, which is the 6th element.
+
+(gv-define-setter decoded-time-dst (dst time)
+  `(setf (nth 7 ,time) ,dst))
+
+(gv-define-setter decoded-time-zone (zone time)
+  `(setf (nth 8 ,time) ,zone))
+
+
 
 
 (provide 'simple)