diff options
-rw-r--r-- | lisp/calendar/iso8601.el | 233 | ||||
-rw-r--r-- | lisp/simple.el | 76 |
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) |