emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/datetime 1e5191aefe 013/147: Implement timestamp formattin


From: ELPA Syncer
Subject: [nongnu] elpa/datetime 1e5191aefe 013/147: Implement timestamp formatting functions; add timezone database for this purpose, extracted from Java.
Date: Fri, 31 Jan 2025 06:59:57 -0500 (EST)

branch: elpa/datetime
commit 1e5191aefe4ac0f1b43cb4f076e60a0ec6b20638
Author: Paul Pogonyshev <pogonyshev@gmail.com>
Commit: Paul Pogonyshev <pogonyshev@gmail.com>

    Implement timestamp formatting functions; add timezone database for this 
purpose, extracted from Java.
---
 .gitignore                |   2 +
 datetime.el               | 371 +++++++++++++++++++++++++++++++++++++++++++++-
 dev/HarvestData.java      | 125 +++++++++++++++-
 generate-extmaps.sh       |  30 ++++
 refresh-extmaps.sh        |  17 ---
 run-tests.sh              |  48 ++++++
 test/FormatTimestamp.java |  36 +++++
 test/format.el            | 151 +++++++++++++++++++
 timezone-data.extmap      | Bin 0 -> 825677 bytes
 9 files changed, 759 insertions(+), 21 deletions(-)

diff --git a/.gitignore b/.gitignore
index 1e20817557..d264bb114f 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,2 +1,4 @@
 *.elc
+local-environment.el
 dev/*.class
+test/*.class
diff --git a/datetime.el b/datetime.el
index 6bf0382408..5c3041cb5b 100644
--- a/datetime.el
+++ b/datetime.el
@@ -118,7 +118,10 @@
 ;;   - all patterns have the following fallbacks: `:short' defaults to
 ;;     `:medium', `:long' defaults to `:medium', `:full' defaults to
 ;;     `:long'.
-(defvar datetime--locale-extmap (extmap-init (expand-file-name 
"locale-data.extmap" datetime--directory)))
+(defvar datetime--locale-extmap (extmap-init (expand-file-name 
"locale-data.extmap" datetime--directory) :auto-reload t))
+
+;; Extracted from Java using `dev/HarvestData.java'.
+(defvar datetime--timezone-extmap (extmap-init (expand-file-name 
"timezone-data.extmap" datetime--directory) :weak-data t :auto-reload t))
 
 (defvar datetime--pattern-parsers '((parsed . (lambda (pattern options) 
pattern))
                                     (java   . datetime--parse-java-pattern)))
@@ -127,6 +130,59 @@
                                        (java   . 
datetime--format-java-pattern)))
 
 
+(defgroup datetime nil
+  "Date-time handling library."
+  :group 'i18n)
+
+(defcustom datetime-locale nil
+  "Default locale for date-time formatting and parsing.
+Leave unset to let the library auto-determine it from your OS
+when necessary."
+  :group 'datetime
+  :type  'symbol)
+
+(defcustom datetime-timezone nil
+  "Default timezone for date-time formatting and parsing.
+Leave unset to let the library auto-determine it from your OS
+when necessary."
+  :group 'datetime
+  :type  'symbol)
+
+
+(defun datetime--get-locale (options)
+  (let ((locale (plist-get options :locale)))
+    (if (eq locale 'system)
+        (or (when datetime-locale
+              (if (extmap-contains-key datetime--locale-extmap datetime-locale)
+                  datetime-locale
+                (warn "Locale `%S' (value of `datetime-locale' variable) is 
not known")
+                nil))
+            (let ((system-locale (or (getenv "LC_ALL") (getenv "LC_TIME") 
(getenv "LANG")))
+                  as-symbol)
+              (when system-locale
+                (save-match-data
+                  (when (string-match "^[a-zA-Z_]+" system-locale)
+                    (setq as-symbol (intern (replace-regexp-in-string "_" "-" 
(match-string 0 system-locale) t t))))))
+              (if (extmap-contains-key datetime--locale-extmap as-symbol)
+                  as-symbol
+                (error "Failed to determine system locale; consider 
customizing `datetime-locale' variable"))))
+      (or locale 'en))))
+
+(defun datetime--get-timezone (options)
+  (let ((timezone (plist-get options :timezone)))
+    (if (eq timezone 'system)
+        (or (when datetime-timezone
+              (if (extmap-contains-key datetime--timezone-extmap 
datetime-timezone)
+                  datetime-timezone
+                (warn "Timezone `%S' (value of `datetime-timezone' variable) 
is not known")
+                nil))
+            (let ((system-timezone (intern (or (cadr (current-time-zone)) 
"?"))))
+              (if (extmap-contains-key datetime--timezone-extmap 
system-timezone)
+                  system-timezone
+                (error "Failed to determine system timezone; consider 
customizing `datetime-timezone' variable"))))
+      (or timezone 'UTC))))
+
+
 (defun datetime--parse-pattern (type pattern options)
   (let ((parser (cdr (assq type datetime--pattern-parsers))))
     (if parser
@@ -294,6 +350,289 @@
     (apply #'concat (nreverse strings))))
 
 
+(defsubst datetime--gregorian-leap-year-p (year)
+  (aref (eval-when-compile (let (result)
+                             (dotimes (year 400)
+                               (push (and (= (% year 4) 0) (or (/= (% year 
100) 0) (= (% year 400) 0))) result))
+                             (apply #'bool-vector (nreverse result))))
+        (mod year 400)))
+
+(defconst datetime--gregorian-cumulative-year-days (let ((days 0)
+                                                         result)
+                                                     (dotimes (year 400)
+                                                       (push days result)
+                                                       (setq days (+ days (if 
(datetime--gregorian-leap-year-p year) 366 365))))
+                                                     (push days result)
+                                                     (apply #'vector (nreverse 
result))))
+(defconst datetime--gregorian-days-in-400-years (aref 
datetime--gregorian-cumulative-year-days 400))
+
+;; Conveniently, this also has a loop size of 400 years.
+(defconst datetime--gregorian-first-day-of-year (let ((first-day 5)
+                                                      result)
+                                                  (dotimes (year 400)
+                                                    (push first-day result)
+                                                    (setq first-day (% (+ 
first-day (if (datetime--gregorian-leap-year-p year) 2 1)) 7)))
+                                                  (apply #'vector (nreverse 
result))))
+
+(defconst datetime--average-seconds-in-year (/ (* 
datetime--gregorian-days-in-400-years 24 60 60) 400))
+
+;; For non-leap years.
+(defconst datetime--gregorian-cumulative-month-days (let ((days   0)
+                                                          (result (list 0)))
+                                                      (dolist (month-days '(31 
28 31 30 31 30 31 31 30 31 30 31))
+                                                        (push (setq days (+ 
days month-days)) result))
+                                                      (apply #'vector 
(nreverse result))))
+
+
+(defsubst datetime--digits-format (num-repetitions)
+  (if (> num-repetitions 1) (format "%%0%dd" num-repetitions) "%d"))
+
+(defun datetime-float-formatter (type pattern &rest options)
+  "Return a function that formats date-time expressed as a float.
+The returned function accepts single argument---a floating-point
+number---and returns a string with given time formatted according
+to given PATTERN of given TYPE.  Rest of the arguments must be a
+property list, i.e. keywords interleaved with values.
+
+OPTIONS should be any keyword arguments understood by
+`datetime-recode-pattern' plus any from the list below, specific
+to this function.
+
+  :locale
+
+    Locale (language) used for month, weekday etc. names.  Always
+    defaults to English, even if system locale is different.  You
+    can use special value \\='system to let the library find it.
+
+  :timezone
+
+    Timezone for time values to be formatted in.  Always defaults
+    to UTC.  You can use special value \\='system to let the
+    library find the value, suitable for the current machine.
+
+  :debug
+
+    Don't byte-compile the formatter function, leave it in the
+    form of a Lisp lambda."
+  (let* ((locale        (datetime--get-locale options))
+         (timezone      (datetime--get-timezone options))
+         (timezone-data (or (extmap-get datetime--timezone-extmap timezone t)
+                            (error "Unknown timezone `%s'" timezone)))
+         need-year need-month need-weekday need-day need-hour need-time
+         format-parts
+         format-arguments)
+    (dolist (part (datetime--parse-pattern type pattern options))
+      (if (stringp part)
+          (push (replace-regexp-in-string "%" "%%" part t t) format-parts)
+        (let ((type    (car part))
+              (details (cdr part)))
+          (pcase type
+            (`era
+             (setq need-year t)
+             (push "%s" format-parts)
+             (push `(aref ,(datetime-locale-field locale :eras) (if (> year 0) 
1 0)) format-arguments))
+            ((or `year `year-for-week)
+             (setq need-year t)
+             (when (eq type 'year-for-week)
+               (setq need-day t))
+             (push (pcase details
+                     (`add-century-when-parsing "%d")
+                     (`always-two-digits        "%02d")
+                     (_                         (datetime--digits-format 
details)))
+                   format-parts)
+             (push (if (eq type 'year)
+                       `(if (> year 0) year (- 1 year))
+                     (error "Formatting `%s' is currently not implemented" 
type))
+                   format-arguments)
+             (when (eq details 'always-two-digits)
+               (setcar format-arguments `(mod ,(car format-arguments) 100))))
+            (`month
+             (setq need-month t)
+             (push (datetime--digits-format details) format-parts)
+             (push `(1+ month) format-arguments))
+            ((or `month-context-name `month-standalone-name)
+             (setq need-month t)
+             (push "%s" format-parts)
+             (push `(aref ,(datetime-locale-field locale
+                                                  (if (eq type 
'month-context-name)
+                                                      (if (eq details 'full) 
:month-context-names    :month-context-abbr)
+                                                    (if   (eq details 'full) 
:month-standalone-names :month-standalone-abbr)))
+                          month)
+                   format-arguments))
+            (`week-in-year
+             (error "Formatting `%s' is currently not implemented" type))
+            (`week-in-month
+             (error "Formatting `%s' is currently not implemented" type))
+            (`day-in-year
+             (setq need-day t)
+             (push (datetime--digits-format details) format-parts)
+             (push `(1+ year-day) format-arguments))
+            (`day-in-month
+             (setq need-day t)
+             (push (datetime--digits-format details) format-parts)
+             (push `(1+ day) format-arguments))
+            (`weekday-in-month
+             (error "Formatting `%s' is currently not implemented" type))
+            (`weekday
+             (setq need-weekday t)
+             (push (datetime--digits-format details) format-parts)
+             (push `(1+ weekday) format-arguments))
+            ((or `weekday-context-name `weekday-standalone-name)
+             (setq need-weekday t)
+             (push "%s" format-parts)
+             (push `(aref ,(datetime-locale-field locale
+                                                  (if (eq type 
'weekday-context-name)
+                                                      (if (eq details 'full) 
:weekday-context-names    :weekday-context-abbr)
+                                                    (if   (eq details 'full) 
:weekday-standalone-names :weekday-standalone-abbr)))
+                          weekday)
+                   format-arguments))
+            (`am-pm
+             (setq need-hour t)
+             (push "%s" format-parts)
+             (push `(aref ,(datetime-locale-field locale :am-pm) (if (>= hour 
12) 1 0)) format-arguments))
+            ((or `hour-0-23 `hour-1-24 `hour-am-pm-0-11 `hour-am-pm-1-12)
+             (setq need-hour t)
+             (push (datetime--digits-format details) format-parts)
+             (push (pcase type
+                     (`hour-0-23       `hour)
+                     (`hour-1-24       `(if (> hour 0) hour 24))
+                     (`hour-am-pm-0-11 `(% hour 12))
+                     (`hour-am-pm-1-12 `(let ((hour (% hour 12))) (if (> hour 
0) hour 12))))
+                   format-arguments))
+            (`minute
+             (setq need-time t)
+             (push (datetime--digits-format details) format-parts)
+             (push `(/ (mod time ,(* 60 60)) 60) format-arguments))
+            (`second
+             (setq need-time t)
+             (push (datetime--digits-format details) format-parts)
+             (push `(mod time 60) format-arguments))
+            ((or `millisecond `second-fractional)
+             (setq need-time t)
+             (push (datetime--digits-format details) format-parts)
+             (let ((scale (if (eq type 'millisecond) 1000 (expt 10 details))))
+               (push `(mod (* time ,scale) ,scale) format-arguments)))
+            (`timezone
+             (signal 'datetime-unsupported-timezone nil))
+            (_ (error "Unexpected value %s" type))))))
+    ;; 400 is the size of Gregorian calendar leap year loop.
+    (let* ((days-in-400-years datetime--gregorian-days-in-400-years)
+           (formatter `(lambda (date-time)
+                         (setq date-time ,(pcase timezone-data
+                                            (`(,constant-offset)
+                                             (if (/= constant-offset 0)
+                                                 `(+ (float date-time) 
,constant-offset)
+                                               `(float date-time)))
+                                            (_
+                                             `(datetime--convert-to-utc-float 
(float date-time) ,(macroexp-quote timezone-data)))))
+                         (let* (,@(when (or need-year need-month need-weekday 
need-day)
+                                    ;; Date in days, rebased from 1970-01-01 
to 0000-01-01.
+                                    `((date-0           (+ (floor (/ date-time 
,(* 24 60 60)))
+                                                           ,(+ (* 
days-in-400-years (/ 1970 400)) (aref datetime--gregorian-cumulative-year-days 
(% 1970 400)))))
+                                      (date-%-400-years (mod date-0 
,days-in-400-years))
+                                      (full-400-years   (/ (- date-0 
date-%-400-years) ,days-in-400-years))
+                                      (year             (+ (* full-400-years 
400)
+                                                           (let ((year-%-400 
(/ date-%-400-years 366)))
+                                                             (if (< 
date-%-400-years (aref ,datetime--gregorian-cumulative-year-days (1+ 
year-%-400)))
+                                                                 year-%-400
+                                                               (1+ 
year-%-400)))))))
+                                ,@(when (or need-month need-weekday need-day)
+                                    `((year-day         (- date-0 (* 
full-400-years ,days-in-400-years) (aref 
,datetime--gregorian-cumulative-year-days (mod year 400))))
+                                      (day              year-day)
+                                      (month            (let ((july-days (if 
(datetime--gregorian-leap-year-p year) ,(+ 31 29 31 30 31 30) ,(+ 31 28 31 30 
31 30))))
+                                                          (if (>= day 
july-days)
+                                                              (if (>= (setq 
day (- day july-days)) ,(+ 31 31 30))
+                                                                  (cond ((< 
(setq day (- day ,(+ 31 31 30))) 31)  9)           ; October
+                                                                        ((< 
(setq day (- day 31)) 30)            10)           ; November
+                                                                        (t  
(setq day (- day 30))                11))          ; December
+                                                                (cond ((< day 
31)                                 6)           ; July
+                                                                      ((< 
(setq day (- day 31)) 31)               7)           ; August
+                                                                      (t  
(setq day (- day 31))                   8)))         ; September
+                                                            (let 
((february-days (- july-days ,(+ 31 30 31 30))))
+                                                              (cond ((< day 
february-days)
+                                                                     (cond ((< 
day 31)                            0)           ; January
+                                                                           (t 
(setq day (- day 31))               1)))         ; February
+                                                                    ((< (setq 
day (- day february-days)) ,(+ 31 30))
+                                                                     (cond ((< 
day 31)                            2)           ; March
+                                                                           (t 
(setq day (- day 31))               3)))         ; April
+                                                                    (t
+                                                                     (cond ((< 
(setq day (- day ,(+ 31 30))) 31)  4)           ; May
+                                                                           (t 
(setq day (- day 31))               5))))))))))  ; June
+                                ,@(when need-weekday
+                                    `((weekday          (% (+ year-day (aref 
,datetime--gregorian-first-day-of-year (mod year 400))) 7))))
+                                ,@(when (or need-time need-hour)
+                                    `((time (mod date-time ,(* 24 60 60)))))
+                                ,@(when need-hour
+                                    `((hour (/ (mod (floor time) ,(* 24 60 
60)) ,(* 60 60))))))
+                           (format ,(apply #'concat (nreverse format-parts)) 
,@(nreverse format-arguments))))))
+      (if (plist-get options :debug)
+          formatter
+        (byte-compile formatter)))))
+
+(defun datetime--convert-to-utc-float (date-time timezone-data)
+  (let ((year-offset          (floor (/ (- date-time (car timezone-data)) 
datetime--average-seconds-in-year)))
+        (all-year-transitions (nth 1 timezone-data)))
+    (if (>= year-offset 0)
+        (let* ((year-transitions (or (when (< year-offset (length 
all-year-transitions))
+                                       (aref all-year-transitions year-offset))
+                                     (datetime--calculate-year-transitions 
timezone-data year-offset)))
+               (offset           (pop year-transitions)))
+          (when year-transitions
+            (let ((offset-in-year (floor (- date-time (car timezone-data) (* 
year-offset datetime--average-seconds-in-year)))))
+              (while (and (>= offset-in-year (car year-transitions))
+                          (setq offset           (cadr year-transitions)
+                                year-transitions (cddr year-transitions))))))
+          (+ date-time offset))
+      ;; Offset before the very first transition.
+      (+ date-time (car (aref all-year-transitions 0))))))
+
+;; 146097 is the value of `datetime--gregorian-days-in-400-years'.
+;; `eval-when-compile' doesn't allow referring to the mnemonic name.
+;;
+;; Likewise, 135140 is the value of
+;; `(aref datetime--gregorian-cumulative-year-days (mod 1970 400))'.
+(defsubst datetime--start-of-day (year year-day)
+  (* (eval-when-compile (* 24 60 60.0))
+     (+ (* (floor (/ (float year) 400)) (eval-when-compile 146097))
+        (aref datetime--gregorian-cumulative-year-days (mod year 400))
+        (eval-when-compile (- (+ (* (floor (/ (float 1970) 400)) 146097) 
135140)))
+        year-day)))
+
+(defun datetime--calculate-year-transitions (timezone-data year-offset)
+  (let* ((all-year-transitions (nth 1 timezone-data))
+         (num-years            (length all-year-transitions))
+         transitions)
+    (when (>= year-offset num-years)
+      (setcar (cdr timezone-data) (setq all-year-transitions (vconcat 
all-year-transitions (make-vector (max (1+ (- year-offset num-years)) (/ 
num-years 2) 10) nil)))))
+    (let ((year      (+ (nth 2 timezone-data) year-offset))
+          (year-base (+ (nth 0 timezone-data) (* year-offset 
datetime--average-seconds-in-year))))
+      (dolist (rule (nth 3 timezone-data))
+        (let* ((month           (plist-get rule :month))
+               (day-of-month    (plist-get rule :day-of-month))
+               (effective-month (if (< day-of-month 0) month (1- month)))
+               (day-of-week     (plist-get rule :day-of-week))
+               (year-day        (+ (aref 
datetime--gregorian-cumulative-month-days effective-month)
+                                   (if (and (>= effective-month 2) 
(datetime--gregorian-leap-year-p year)) 1 0)
+                                   day-of-month -1))
+               (offset-before   (plist-get rule :before)))
+          (unless transitions
+            (push offset-before transitions))
+          (when day-of-week
+            (let ((current-weekday (% (+ year-day (aref 
datetime--gregorian-first-day-of-year (mod year 400))) 7)))
+              (setq year-day (if (< day-of-month 0) (- year-day (mod (- 
day-of-week current-weekday) 7)) (+ year-day (mod (- day-of-week 
current-weekday) 7))))))
+          (when (plist-get rule :end-of-day)
+            (setq year-day (1+ year-day)))
+          (push (- (+ (datetime--start-of-day year year-day) (plist-get rule 
:time))
+                   (pcase-exhaustive (plist-get rule :time-definition)
+                     (`utc      0)
+                     (`standard (plist-get rule :standard-offset))
+                     (`wall     offset-before))
+                   year-base)
+                transitions)
+          (push (plist-get rule :after) transitions))))
+    (aset all-year-transitions year-offset (nreverse transitions))))
+
+
 (defun datetime-matching-regexp (type pattern &rest options)
   "Return a regexp that matches date-time according to the PATTERN.
 Argument TYPE defines how the pattern should be interpreted, see
@@ -325,7 +664,8 @@ specified otherwise.
   :locale
 
     Locale (language) used for month, weekday etc. names.  Always
-    defaults to English, even if system locale is different.
+    defaults to English, even if system locale is different.  You
+    can use special value \\='system to let the library find it.
 
   :only-4-digit-years
 
@@ -356,7 +696,7 @@ specified otherwise.
     E.g. \"030 September\" is a valid date, but no-one writes it
     like that and with this flag such strings are not matched."
   (let* ((lax-whitespace (plist-get options :lax-whitespace))
-         (locale         (or (plist-get options :locale) 'en))
+         (locale         (datetime--get-locale options))
          regexp-parts)
     (dolist (part (datetime--parse-pattern type pattern options))
       (if (stringp part)
@@ -486,6 +826,16 @@ In other words, return non-nil if PATTERN includes any 
textual
 names."
   (datetime--pattern-includes-p type pattern era month-context-name 
month-standalone-name weekday-context-name weekday-standalone-name am-pm))
 
+(defun datetime-pattern-includes-date-p (type pattern)
+  "Determine if PATTERN includes any date parts."
+  (datetime--pattern-includes-p type pattern
+                                era year year-for-week month 
month-context-name month-standalone-name week-in-year week-in-month
+                                day-in-year day-in-month weekday-in-month 
weekday weekday-context-name weekday-standalone-name))
+
+(defun datetime-pattern-includes-time-p (type pattern)
+  "Determine if PATTERN includes any time parts."
+  (datetime--pattern-includes-p type pattern am-pm hour-0-23 hour-1-24 
hour-am-pm-0-11 hour-am-pm-1-12 minute second millisecond second-fractional))
+
 (defun datetime-pattern-includes-era-p (type pattern)
   "Determine if PATTERN includes the date era."
   (datetime--pattern-includes-p type pattern era))
@@ -498,10 +848,18 @@ names."
   "Determine if PATTERN includes the month."
   (datetime--pattern-includes-p type pattern month month-context-name 
month-standalone-name))
 
+(defun datetime-pattern-includes-week-p (type pattern)
+  "Determine if PATTERN includes the week."
+  (datetime--pattern-includes-p type pattern week-in-year week-in-month))
+
 (defun datetime-pattern-includes-day-p (type pattern)
   "Determine if PATTERN includes the day."
   (datetime--pattern-includes-p type pattern day-in-year day-in-month))
 
+(defun datetime-pattern-includes-weekday-p (type pattern)
+  "Determine if PATTERN includes the weekday."
+  (datetime--pattern-includes-p type pattern weekday-in-month weekday 
weekday-context-name weekday-standalone-name))
+
 (defun datetime-pattern-includes-hour-p (type pattern)
   "Determine if PATTERN includes hours."
   (datetime--pattern-includes-p type pattern hour-0-23 hour-1-24 
hour-am-pm-0-11 hour-am-pm-1-12))
@@ -540,6 +898,13 @@ be modified freely."
       (extmap-mapc datetime--locale-extmap (lambda (locale data) (unless 
(plist-get (cdr data) :parent) (push locale locales))))
       locales)))
 
+(defun datetime-list-timezones ()
+  "List all timezones for which the library has information.
+
+Return value is a list of symbols in no particular order; it can
+be modified freely."
+  (extmap-keys datetime--timezone-extmap))
+
 
 (defsubst datetime--do-get-locale-pattern (patterns variant)
   (or (plist-get patterns variant)
diff --git a/dev/HarvestData.java b/dev/HarvestData.java
index f66475d156..17363f2b40 100644
--- a/dev/HarvestData.java
+++ b/dev/HarvestData.java
@@ -1,4 +1,7 @@
 import java.text.*;
+import java.time.*;
+import java.time.temporal.*;
+import java.time.zone.*;
 import java.util.*;
 import java.util.function.*;
 import java.util.stream.*;
@@ -6,7 +9,21 @@ import java.util.stream.*;
 
 public class HarvestData
 {
+    private static long  DAYS_IN_400_YEARS       = IntStream.range (0, 
400).map ((year) -> isLeapYear (year) ? 366 : 365).sum ();
+    private static long  SECONDS_IN_400_YEARS    = (DAYS_IN_400_YEARS * 24 * 
60 * 60);
+    private static long  AVERAGE_SECONDS_IN_YEAR = (SECONDS_IN_400_YEARS / 
400);
+
+
     public static void main (String[] args) throws Exception
+    {
+        if (Arrays.asList (args).contains ("--locales"))
+            printLocaleData ();
+
+        if (Arrays.asList (args).contains ("--timezones"))
+            printTimezoneData ();
+    }
+
+    protected static void printLocaleData () throws Exception
     {
         List <Locale>  locales = new ArrayList <> (Arrays.asList 
(Locale.getAvailableLocales ()));
         locales.sort ((a, b) -> a.toLanguageTag ().compareToIgnoreCase 
(b.toLanguageTag ()));
@@ -164,6 +181,102 @@ public class HarvestData
             properties.remove (standalone_key);
     }
 
+    protected static void printTimezoneData () throws Exception
+    {
+        List <ZoneId>  timezones = ZoneId.getAvailableZoneIds ().stream ().map 
((id) -> ZoneId.of (id)).collect (Collectors.toList ());
+        timezones.sort ((a, b) -> a.getId ().compareToIgnoreCase (b.getId ()));
+
+        Map <ZoneId, List <Object>>  data = new LinkedHashMap <> ();
+
+        for (ZoneId timezone : timezones) {
+            ZoneRules  rules = timezone.getRules ();
+
+            if (rules.isFixedOffset ())
+                data.put (timezone, Collections.singletonList (rules.getOffset 
(Instant.now ()).getTotalSeconds ()));
+            else {
+                // They are probably already ordered, but I cannot find a 
confirmation in
+                // the documentation.
+                List <ZoneOffsetTransition>  transitions = new ArrayList <> 
(rules.getTransitions ());
+                transitions.sort ((a, b) -> a.getInstant ().compareTo 
(b.getInstant ()));
+
+                LocalDateTime         first           = 
LocalDateTime.ofInstant (transitions.get (0).getInstant (), ZoneOffset.UTC);
+                int                   base_year       = Year.of (first.get 
(ChronoField.YEAR)).getValue ();
+                long                  base            = Year.of (first.get 
(ChronoField.YEAR)).atDay (1).atStartOfDay ().toInstant 
(ZoneOffset.UTC).getEpochSecond ();
+                int                   last_offset     = transitions.get 
(0).getOffsetBefore ().getTotalSeconds ();
+                List <Object>         zone_data       = new ArrayList <> ();
+                List <List <Object>>  transition_data = new ArrayList <> ();
+
+                for (ZoneOffsetTransition transition : transitions) {
+                    int  year_offset = (int) ((transition.getInstant 
().getEpochSecond () - base) / AVERAGE_SECONDS_IN_YEAR);
+                    if ((transition.getInstant ().getEpochSecond () + 1 - 
base) % AVERAGE_SECONDS_IN_YEAR < 1)
+                        System.err.println (String.format ("*Warning*: 
timezone '%s', offset transition at %s would be a potential rounding error", 
timezone.getId (), transition.getInstant ()));
+
+                    while (year_offset >= transition_data.size ())
+                        transition_data.add (new ArrayList <> (Arrays.asList 
(last_offset)));
+
+                    transition_data.get (year_offset).add 
(transition.getInstant ().getEpochSecond () - (base + year_offset * 
AVERAGE_SECONDS_IN_YEAR));
+                    transition_data.get (year_offset).add (last_offset = 
transition.getOffsetAfter ().getTotalSeconds ());
+                }
+
+                List <Object>  transition_rule_data = new ArrayList <> ();
+                for (ZoneOffsetTransitionRule transition_rule : 
rules.getTransitionRules ()) {
+                    Map <String, String>  rule = new LinkedHashMap <> ();
+
+                    rule.put (":month",        String.valueOf 
(transition_rule.getMonth ().getValue ()));
+                    rule.put (":day-of-month", String.valueOf 
(transition_rule.getDayOfMonthIndicator ()));
+
+                    if (transition_rule.getDayOfWeek () != null)
+                        rule.put (":day-of-week", String.valueOf 
(transition_rule.getDayOfWeek ().getValue () - 1));
+
+                    if (transition_rule.isMidnightEndOfDay ())
+                        rule.put (":end-of-day", "t");
+
+                    rule.put (":time", String.valueOf 
(transition_rule.getLocalTime ().toSecondOfDay ()));
+
+                    switch (transition_rule.getTimeDefinition ()) {
+                    case UTC:
+                        rule.put (":time-definition", "utc");
+                        break;
+                    case WALL:
+                        rule.put (":time-definition", "wall");
+                        break;
+                    case STANDARD:
+                        rule.put (":time-definition", "standard");
+                        rule.put (":standard-offset", String.valueOf 
(transition_rule.getStandardOffset ().getTotalSeconds ()));
+                        break;
+                    default:
+                        throw new IllegalStateException 
(transition_rule.getTimeDefinition ().name ());
+                    }
+
+                    rule.put (":before", String.valueOf 
(transition_rule.getOffsetBefore ().getTotalSeconds ()));
+                    rule.put (":after",  String.valueOf 
(transition_rule.getOffsetAfter  ().getTotalSeconds ()));
+
+                    transition_rule_data.add (toLispPlist (rule, false));
+                }
+
+                zone_data.add (String.valueOf (base));
+                zone_data.add (toLispVector (transition_data.stream ().map 
(HarvestData::toLispList).collect (Collectors.toList ()), false));
+                zone_data.add (String.valueOf (base_year));
+                zone_data.add (toLispList (transition_rule_data));
+
+                data.put (timezone, zone_data);
+            }
+        }
+
+        System.out.println ("(");
+        for (Map.Entry <ZoneId, List <Object>> entry : data.entrySet ())
+            System.out.format ("(%s\n %s)\n", entry.getKey (), entry.getValue 
().stream ().map (String::valueOf).collect (Collectors.joining ("\n ")));
+        System.out.println (")");
+    }
+
+    protected static String toLispList (List <?> list)
+    {
+        if (list == null || list.isEmpty ())
+            return "nil";
+        else
+            return String.format ("(%s)", list.stream ().map 
(String::valueOf).collect (Collectors.joining (" ")));
+    }
+
     protected static String toLispPlist (Map <String, String> properties, 
boolean quote_value_strings)
     {
         return toLispPlist (null, properties, quote_value_strings);
@@ -181,7 +294,12 @@ public class HarvestData
 
     protected static String toLispVector (List <String> strings)
     {
-        return String.format ("[%s]", strings.stream ().map ((string) -> 
quoteString (string)).collect (Collectors.joining (" ")));
+        return toLispVector (strings, true);
+    }
+
+    protected static String toLispVector (List <String> strings, boolean 
quote_value_strings)
+    {
+        return String.format ("[%s]", strings.stream ().map ((string) -> 
quote_value_strings ? quoteString (string) : string).collect 
(Collectors.joining (" ")));
     }
 
     protected static Map <String, String> toPatternPlist (Function <Integer, 
SimpleDateFormat> format)
@@ -200,4 +318,9 @@ public class HarvestData
     {
         return string != null ? String.format ("\"%s\"", string.replaceAll 
("\\\\", "\\\\").replaceAll ("\"", "\\\"")) : "nil";
     }
+
+    protected static boolean isLeapYear (int year)
+    {
+        return year % 4 == 0 && (year % 100 != 0 || year % 400 == 0);
+    }
 }
diff --git a/generate-extmaps.sh b/generate-extmaps.sh
new file mode 100755
index 0000000000..11a45312b8
--- /dev/null
+++ b/generate-extmaps.sh
@@ -0,0 +1,30 @@
+#! /usr/bin/env bash
+
+set -e
+
+OWN_DIRECTORY=$(dirname $0)
+
+if [ -z "$EMACS" ] ; then
+    EMACS=emacs
+fi
+
+cd dev
+javac HarvestData.java
+cd ..
+
+# Emacs only reads single lines from stdin...
+java -cp dev HarvestData --locales | tr "\n" " "                               
                                                 \
+  | $EMACS -batch                                                              
                                                 \
+          --eval "(progn (require 'package) (package-initialize))"             
                                                 \
+          --directory "$OWN_DIRECTORY"                                         
                                                 \
+          --eval "(when (locate-file \"local-environment.el\" (list (car 
load-path))) (load \"local-environment.el\" nil t t))" \
+          --eval "(require 'extmap)"                                           
                                                 \
+          --eval "(extmap-from-alist \"locale-data.extmap\" (read-minibuffer 
\"\") :overwrite t)"
+
+java -cp dev HarvestData --timezones | tr "\n" " "                             
                                                 \
+  | $EMACS -batch                                                              
                                                 \
+          --eval "(progn (require 'package) (package-initialize))"             
                                                 \
+          --directory "$OWN_DIRECTORY"                                         
                                                 \
+          --eval "(when (locate-file \"local-environment.el\" (list (car 
load-path))) (load \"local-environment.el\" nil t t))" \
+          --eval "(require 'extmap)"                                           
                                                 \
+          --eval "(extmap-from-alist \"timezone-data.extmap\" (read-minibuffer 
\"\") :overwrite t)"
diff --git a/refresh-extmaps.sh b/refresh-extmaps.sh
deleted file mode 100755
index 15afa42e76..0000000000
--- a/refresh-extmaps.sh
+++ /dev/null
@@ -1,17 +0,0 @@
-#! /usr/bin/env bash
-
-set -e
-
-if [ -z "$EMACS" ] ; then
-    EMACS=emacs
-fi
-
-cd dev
-javac HarvestData.java
-cd ..
-
-# Emacs only reads single lines from stdin...
-java -cp dev HarvestData | tr "\n" " "                                         
                   \
-  | $EMACS -batch                                                              
                   \
-          --eval "(progn (require 'package) (package-initialize) (require 
'extmap))"              \
-          --eval "(extmap-from-alist \"locale-data.extmap\" (read-minibuffer 
\"\") :overwrite t)"
diff --git a/run-tests.sh b/run-tests.sh
new file mode 100755
index 0000000000..5bee85906a
--- /dev/null
+++ b/run-tests.sh
@@ -0,0 +1,48 @@
+#! /bin/sh
+
+# Usage: ./run-tests.sh [ERT-SELECTOR]
+#
+# You can also set EMACS and ERT_SELECTOR variables in the
+# environment.  If ERT_SELECTOR is empty (both on command line and in
+# environment), it defaults to t (i.e., everything).
+
+# If `local-environment.el' exists, it is loaded before `datetime.el'.
+# Can be used e.g. to make `extmap' package loadable.  By the time
+# `local-environment.el' is loaded, Emacs packaging system is already
+# initialized.
+
+set -e
+
+OWN_DIRECTORY=$(dirname $0)
+
+if [ -z "$EMACS" ]; then
+    EMACS=emacs
+fi
+
+if [ -n "$1" ]; then
+    ERT_SELECTOR=$1
+fi
+
+if [ -z "$ERT_SELECTOR" ]; then
+    ERT_SELECTOR=t
+fi
+
+cd test
+javac FormatTimestamp.java
+cd ..
+
+$EMACS --batch                                                                 
                                              \
+       --eval "(message \"Using Emacs %s\" (emacs-version))"                   
                                              \
+       --eval "(progn (require 'package) (package-initialize))"                
                                              \
+       --directory "$OWN_DIRECTORY"                                            
                                              \
+       --eval "(when (locate-file \"local-environment.el\" (list (car 
load-path))) (load \"local-environment.el\" nil t t))" \
+       -l datetime.el                                                          
                                              \
+       -l test/format.el                                                       
                                              \
+       --eval "(ert-run-tests-batch-and-exit (quote ${ERT_SELECTOR}))"
+
+$EMACS --batch                                                                 
                                              \
+       --eval "(progn (require 'package) (package-initialize))"                
                                              \
+       --directory "$OWN_DIRECTORY"                                            
                                              \
+       --eval "(when (locate-file \"local-environment.el\" (list (car 
load-path))) (load \"local-environment.el\" nil t t))" \
+       --eval "(setq byte-compile-error-on-warn t)"                            
                                              \
+       --eval "(batch-byte-compile)" datetime.el
diff --git a/test/FormatTimestamp.java b/test/FormatTimestamp.java
new file mode 100644
index 0000000000..e3da3dcc33
--- /dev/null
+++ b/test/FormatTimestamp.java
@@ -0,0 +1,36 @@
+import java.time.*;
+import java.time.format.*;
+import java.util.*;
+
+
+public class FormatTimestamp
+{
+    /**
+     *  Usage (e.g.): echo TIMESTAMP TIMEZONE LOCALE PATTERN | java 
FormatTimestamp
+     *
+     *  where:
+     *    TIMESTAMP is a double number of seconds since epoch time UTC;
+     *    TIMEZONE and LOCALE are string identifiers;
+     *    PATTERN is according to SimpleDateFormat documentation and is taken 
until
+     *      the end of line with starting and ending whitespace removed.
+     *
+     *  The four tokens can be repeated as many times as needed.  Output is 
one formatted
+     *  timestamp per line, corresponding to each quadruplet in the input.
+     */
+    public static void main (String[] args) throws Exception
+    {
+        Scanner  input = new Scanner (System.in).useLocale (Locale.ENGLISH);
+
+        while (input.hasNext ()) {
+            double  timestamp = input.nextDouble ();
+            ZoneId  timezone  = ZoneId.of (input.next ());
+            Locale  locale    = Locale.forLanguageTag (input.next ());
+            String  pattern   = input.nextLine ().trim ();
+
+            System.out.println (DateTimeFormatter.ofPattern (pattern, locale)
+                                .format (LocalDateTime.ofInstant 
(Instant.ofEpochSecond ((long) Math.floor (timestamp),
+                                                                               
          (int) Math.floor ((timestamp - Math.floor (timestamp))  * 
1_000_000_000)),
+                                                                  timezone)));
+        }
+    }
+}
diff --git a/test/format.el b/test/format.el
new file mode 100644
index 0000000000..60df54aebe
--- /dev/null
+++ b/test/format.el
@@ -0,0 +1,151 @@
+;;; -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Paul Pogonyshev
+
+;; This program 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.
+
+;; This program 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 this program.  If not, see http://www.gnu.org/licenses.
+
+
+(require 'datetime)
+(require 'ert)
+
+
+(defvar datetime--test-timezone  nil)
+(defvar datetime--test-locale    nil)
+(defvar datetime--test-pattern   nil)
+(defvar datetime--test-formatter nil)
+
+(defvar datetime--test-java-formatting-process nil)
+
+(defvar datetime--test-directory (file-name-directory (or load-file-name 
(buffer-file-name))))
+
+
+(defmacro datetime--test-set-up (timezone locale pattern &rest body)
+  (declare (debug (form form form body))
+           (indent 3))
+  `(let* ((datetime--test-timezone  ,timezone)
+          (datetime--test-locale    ,locale)
+          (datetime--test-pattern   ,pattern)
+          (datetime--test-formatter (datetime-float-formatter 'java 
datetime--test-pattern :timezone datetime--test-timezone :locale 
datetime--test-locale)))
+     ,@body))
+
+(defun datetime--test (times)
+  (unless (listp times)
+    (setq times (list times)))
+  (unless (process-live-p datetime--test-java-formatting-process)
+    (let ((default-directory datetime--test-directory))
+      (setq datetime--test-java-formatting-process (start-process 
"java-formatter" "java-formatter" "java" "FormatTimestamp"))))
+  (let* ((marker        (process-mark datetime--test-java-formatting-process))
+         (position      (marker-position marker))
+         (num-times     (length times))
+         (num-formatted 0)
+         formatted)
+    (save-excursion
+      (set-buffer (marker-buffer marker))
+      ;; It is much faster to give "tasks" to the remote process in
+      ;; batch, then fetch the results.
+      (dolist (time times)
+        (process-send-string datetime--test-java-formatting-process
+                             (format "%s %s %s %s\n" time 
datetime--test-timezone datetime--test-locale datetime--test-pattern)))
+      (while (< num-formatted num-times)
+        (while (or (= (marker-position marker) position) (/= (char-before 
marker) ?\n))
+          (accept-process-output datetime--test-java-formatting-process))
+        (while (> (marker-position marker) position)
+          (goto-char position)
+          (end-of-line)
+          (push (buffer-substring position (point)) formatted)
+          (beginning-of-line 2)
+          (setq position      (point)
+                num-formatted (1+ num-formatted))))
+      (setq formatted (nreverse formatted))
+      (while times
+        (let ((time     (pop times))
+              (expected (pop formatted)))
+          (eval `(should (progn ,time (string= ,(funcall 
datetime--test-formatter time) ,expected)))))))))
+
+(defun datetime--test-transition (time)
+  (datetime--test (list time
+                        (+ time  0.5) (- time  0.5)     ; half a second
+                        (+ time   30) (- time   30)     ; half a minute
+                        (+ time 1800) (- time 1800)     ; half an hour
+                        (+ time 3600) (- time 3600)     ; one hour
+                        (+ time 7200) (- time 7200))))  ; two hours
+
+
+(ert-deftest datetime-test-formatting-now ()
+  (datetime--test-set-up 'UTC 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    (datetime--test (float-time))))
+
+(ert-deftest datetime-test-formatting-now-standard-formats ()
+  (let ((now (float-time)))
+    (dolist (locale (datetime-list-locales t))
+      (dolist (variant '(:short :medium :long :full))
+        (let ((pattern (datetime-locale-date-time-pattern locale variant)))
+          (unless (datetime-pattern-includes-timezone-p 'java pattern)
+            (datetime--test-set-up 'UTC locale pattern
+              (datetime--test now))))))))
+
+(ert-deftest datetime-test-formatting-various-timestamps-1 ()
+  (datetime--test-set-up 'UTC 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Roughly from 400 AD till 3500 AD with 4 month step.
+    (datetime--test (mapcar (lambda (k) (* k 10000000.123)) (number-sequence 
-5000 5000)))))
+
+(ert-deftest 
datetime-test-formatting-various-timestamps-with-fixed-offset-timezone-1 ()
+  (datetime--test-set-up 'Etc/GMT+1 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Roughly from 400 AD till 3500 AD with 4 month step.
+    (datetime--test (mapcar (lambda (k) (* k 10000000.123)) (number-sequence 
-5000 5000)))))
+
+(ert-deftest 
datetime-test-formatting-various-timestamps-with-shifting-timezone-1 ()
+  (datetime--test-set-up 'Europe/Madrid 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Roughly from 400 AD till 3500 AD with 4 month step.
+    (datetime--test (mapcar (lambda (k) (* k 10000000.123)) (number-sequence 
-5000 5000)))))
+
+(ert-deftest 
datetime-test-formatting-various-timestamps-with-shifting-timezone-2 ()
+  (datetime--test-set-up 'America/Anchorage 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Roughly from 400 AD till 3500 AD with 4 month step.
+    (datetime--test (mapcar (lambda (k) (* k 10000000.123)) (number-sequence 
-5000 5000)))))
+
+(ert-deftest 
datetime-test-formatting-various-timestamps-with-shifting-timezone-3 ()
+  (datetime--test-set-up 'Australia/Hobart 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Roughly from 400 AD till 3500 AD with 4 month step.
+    (datetime--test (mapcar (lambda (k) (* k 10000000.123)) (number-sequence 
-5000 5000)))))
+
+(ert-deftest datetime-test-formatting-text-1 ()
+  (datetime--test-set-up 'UTC 'en "'on' EEEE 'the' d MMMM 'of' yyyy G, 'at' 
h:mm:ss a"
+    ;; Roughly from 1200 BC till 5100 AD with 6 and a half year step.
+    (datetime--test (mapcar (lambda (k) (* k 200000000.123)) (number-sequence 
-500 500)))))
+
+(ert-deftest datetime-test-formatting-around-offset-transition-1 ()
+  (datetime--test-set-up 'Europe/Madrid 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; First historical transition.
+    (datetime--test-transition -2177452800)))
+
+(ert-deftest datetime-test-formatting-around-offset-transition-2 ()
+  (datetime--test-set-up 'Europe/Madrid 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Rule-based transition on 2010-03-25.
+    (datetime--test-transition 1269738000)))
+
+(ert-deftest datetime-test-formatting-around-offset-transition-3 ()
+  (datetime--test-set-up 'Europe/Madrid 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Future transition on 2480-10-27 (according to the rules as of 2018).
+    (datetime--test-transition 16119997200)))
+
+(ert-deftest datetime-test-formatting-around-offset-transition-4 ()
+  (datetime--test-set-up 'America/Anchorage 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Rule-based transition on 2009-03-08.
+    (datetime--test-transition 1236510000)))
+
+(ert-deftest datetime-test-formatting-around-offset-transition-5 ()
+  (datetime--test-set-up 'Australia/Hobart 'en "yyyy-MM-dd HH:mm:ss.SSS"
+    ;; Rule-based transition on 2014-10-05.
+    (datetime--test-transition 1412438400)))
diff --git a/timezone-data.extmap b/timezone-data.extmap
new file mode 100644
index 0000000000..42f51f781b
Binary files /dev/null and b/timezone-data.extmap differ



reply via email to

[Prev in Thread] Current Thread [Next in Thread]