branch: elpa/datetime
commit 1e5191aefe4ac0f1b43cb4f076e60a0ec6b20638
Author: Paul Pogonyshev <pogonys...@gmail.com>
Commit: Paul Pogonyshev <pogonys...@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
