-;;; cal-dst.el --- calendar functions for daylight saving rules
+;;; cal-dst.el --- calendar functions for daylight saving rules -*- lexical-binding:t -*-
;; Copyright (C) 1993-1996, 2001-2017 Free Software Foundation, Inc.
'((calendar-gregorian-from-absolute
(calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
(prevday-sec (- -1 utc-diff)) ; last sec of previous local day
- (year (1+ y))
new-rules)
- ;; Scan through the next few years until only one rule remains.
- (while (cdr candidate-rules)
- (dolist (rule candidate-rules)
- ;; The rule we return should give a Gregorian date, but here
- ;; we require an absolute date. The following is for efficiency.
- (setq date (cond ((eq (car rule) 'calendar-nth-named-day)
- (eval (cons 'calendar-nth-named-absday (cdr rule))))
- ((eq (car rule) 'calendar-gregorian-from-absolute)
- (eval (cadr rule)))
- (t (calendar-absolute-from-gregorian (eval rule)))))
- (or (equal (current-time-zone
- (calendar-time-from-absolute date prevday-sec))
- (current-time-zone
- (calendar-time-from-absolute (1+ date) prevday-sec)))
- (setq new-rules (cons rule new-rules))))
- ;; If no rules remain, just use the first candidate rule;
- ;; it's wrong in general, but it's right for at least one year.
- (setq candidate-rules (if new-rules (nreverse new-rules)
- (list (car candidate-rules)))
- new-rules nil
- year (1+ year)))
+ (calendar-dlet* ((year (1+ y)))
+ ;; Scan through the next few years until only one rule remains.
+ (while (cdr candidate-rules)
+ (dolist (rule candidate-rules)
+ ;; The rule we return should give a Gregorian date, but here
+ ;; we require an absolute date. The following is for efficiency.
+ (setq date (cond ((eq (car rule) #'calendar-nth-named-day)
+ (eval (cons #'calendar-nth-named-absday
+ (cdr rule))))
+ ((eq (car rule) #'calendar-gregorian-from-absolute)
+ (eval (cadr rule)))
+ (t (calendar-absolute-from-gregorian (eval rule)))))
+ (or (equal (current-time-zone
+ (calendar-time-from-absolute date prevday-sec))
+ (current-time-zone
+ (calendar-time-from-absolute (1+ date) prevday-sec)))
+ (setq new-rules (cons rule new-rules))))
+ ;; If no rules remain, just use the first candidate rule;
+ ;; it's wrong in general, but it's right for at least one year.
+ (setq candidate-rules (if new-rules (nreverse new-rules)
+ (list (car candidate-rules)))
+ new-rules nil
+ year (1+ year))))
(car candidate-rules)))
;; TODO it might be better to extract this information directly from
(or (let ((expr (if calendar-dst-check-each-year-flag
(cadr (calendar-dst-find-startend year))
(nth 4 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
+ (calendar-dlet* ((year year))
+ (if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 2 0 3 year))))
(or (let ((expr (if calendar-dst-check-each-year-flag
(nth 2 (calendar-dst-find-startend year))
(nth 5 calendar-current-time-zone-cache))))
- (if expr (eval expr)))
+ (calendar-dlet* ((year year))
+ (if expr (eval expr))))
;; New US rules commencing 2007. https://www.iana.org/time-zones
(and (not (zerop calendar-daylight-time-offset))
(calendar-nth-named-day 1 0 11 year))))
(defun dst-in-effect (date)
"True if on absolute DATE daylight saving time is in effect.
Fractional part of DATE is local standard time of day."
- (let* ((year (calendar-extract-year
- (calendar-gregorian-from-absolute (floor date))))
- (dst-starts-gregorian (eval calendar-daylight-savings-starts))
- (dst-ends-gregorian (eval calendar-daylight-savings-ends))
- (dst-starts (and dst-starts-gregorian
+ (calendar-dlet* ((year (calendar-extract-year
+ (calendar-gregorian-from-absolute (floor date)))))
+ (let* ((dst-starts-gregorian (eval calendar-daylight-savings-starts))
+ (dst-ends-gregorian (eval calendar-daylight-savings-ends))
+ (dst-starts (and dst-starts-gregorian
+ (+ (calendar-absolute-from-gregorian
+ dst-starts-gregorian)
+ (/ calendar-daylight-savings-starts-time
+ 60.0 24.0))))
+ (dst-ends (and dst-ends-gregorian
(+ (calendar-absolute-from-gregorian
- dst-starts-gregorian)
- (/ calendar-daylight-savings-starts-time
- 60.0 24.0))))
- (dst-ends (and dst-ends-gregorian
- (+ (calendar-absolute-from-gregorian
- dst-ends-gregorian)
- (/ (- calendar-daylight-savings-ends-time
- calendar-daylight-time-offset)
- 60.0 24.0)))))
- (and dst-starts dst-ends
- (if (< dst-starts dst-ends)
- (and (<= dst-starts date) (< date dst-ends))
- (or (<= dst-starts date) (< date dst-ends))))))
+ dst-ends-gregorian)
+ (/ (- calendar-daylight-savings-ends-time
+ calendar-daylight-time-offset)
+ 60.0 24.0)))))
+ (and dst-starts dst-ends
+ (if (< dst-starts dst-ends)
+ (and (<= dst-starts date) (< date dst-ends))
+ (or (<= dst-starts date) (< date dst-ends)))))))
;; used by calc, lunar, solar.
(defun dst-adjust-time (date time)