Function: calendar-time-zone-daylight-rules

calendar-time-zone-daylight-rules is a byte-compiled function defined in cal-dst.el.gz.

Signature

(calendar-time-zone-daylight-rules ABS-DATE UTC-DIFF)

Documentation

Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC.

ABS-DATE must specify a day that contains a daylight saving transition. The result has the proper form for calendar-daylight-savings-starts.

Source Code

;; Defined in /usr/src/emacs/lisp/calendar/cal-dst.el.gz
(defun calendar-time-zone-daylight-rules (abs-date utc-diff)
  "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC.
ABS-DATE must specify a day that contains a daylight saving transition.
The result has the proper form for `calendar-daylight-savings-starts'."
  (let* ((date (calendar-gregorian-from-absolute abs-date))
         (weekday (% abs-date 7))
         (m (calendar-extract-month date))
         (d (calendar-extract-day date))
         (y (calendar-extract-year date))
         (last (calendar-last-day-of-month m y))
         j rlist
         (candidate-rules               ; these return Gregorian dates
          (append
           ;; Day D of month M.
           `((list ,m ,d year))
           ;; The first WEEKDAY of month M.
           (if (< d 8)
               `((calendar-nth-named-day 1 ,weekday ,m year)))
           ;; The last WEEKDAY of month M.
           (if (> d (- last 7))
               `((calendar-nth-named-day -1 ,weekday ,m year)))
           (progn
             ;; The first WEEKDAY after day J of month M, for D-6 < J <= D.
             (setq j (1- (max 2 (- d 6))))
             (while (<= (setq j (1+ j)) (min d (- last 8)))
               (push `(calendar-nth-named-day 1 ,weekday ,m year ,j) rlist))
             rlist)
           ;; 01-01 and 07-01 for this year's Persian calendar.
           ;; FIXME what does the Persian calendar have to do with this?
           (and (= m 3) (memq d '(20 21))
                '((calendar-gregorian-from-absolute
                   (calendar-persian-to-absolute `(1 1 ,(- year 621))))))
           (and (= m 9) (memq d '(22 23))
                '((calendar-gregorian-from-absolute
                   (calendar-persian-to-absolute `(7 1 ,(- year 621))))))))
         (prevday-sec (- -1 utc-diff)) ; last sec of previous local day
         new-rules)
    (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)))