-;;; cal-dst.el --- calendar functions for daylight savings rules.
+;;; cal-dst.el --- calendar functions for daylight savings rules
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1996, 2001, 2002, 2003, 2004, 2005,
+;; 2006 Free Software Foundation, Inc.
;; Author: Paul Eggert <eggert@twinsun.com>
;; Edward M. Reingold <reingold@cs.uiuc.edu>
+;; Maintainer: Glenn Morris <rgm@gnu.org>
;; Keywords: calendar
;; Human-Keywords: daylight savings time, calendar, diary, holidays
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;; Code:
(require 'calendar)
+(require 'cal-persia)
(defvar calendar-current-time-zone-cache nil
"Cache for result of calendar-current-time-zone.")
(defun calendar-time-from-absolute (abs-date s)
"Time of absolute date ABS-DATE, S seconds after midnight.
-Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low
+Returns the list (HIGH LOW) where HIGH and LOW are the high and low
16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC,
ignoring leap seconds, that is the equivalent moment to S seconds after
midnight UTC on absolute date ABS-DATE."
(let* ((a (- abs-date calendar-system-time-basis))
(u (+ (* 163 (mod a 512)) (floor s 128))))
;; Overflow is a terrible thing!
- (cons
+ (list
;; floor((60*60*24*a + s) / 2^16)
(+ a (* 163 (floor a 512)) (floor u 512))
;; (60*60*24*a + s) mod 2^16
(defun calendar-time-zone-daylight-rules (abs-date utc-diff)
"Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC.
-ABS-DIFF must specify a day that contains a daylight savings transition.
+ABS-DATE must specify a day that contains a daylight savings transition.
The result has the proper form for calendar-daylight-savings-starts'."
(let* ((date (calendar-gregorian-from-absolute abs-date))
(weekday (% abs-date 7))
(cons
(list 'calendar-nth-named-day 1 weekday m 'year j)
l)))
- l)))
+ l)
+ ;; 01-01 and 07-01 for this year's Persian calendar.
+ (if (and (= m 3) (<= 20 d) (<= d 21))
+ '((calendar-gregorian-from-absolute
+ (calendar-absolute-from-persian
+ (list 1 1 (- year 621))))))
+ (if (and (= m 9) (<= 22 d) (<= d 23))
+ '((calendar-gregorian-from-absolute
+ (calendar-absolute-from-persian
+ (list 7 1 (- year 621))))))))
(prevday-sec (- -1 utc-diff)) ;; last sec of previous local day
(year (1+ y)))
;; Scan through the next few years until only one rule remains.
(cons
(/ (abs (- t0-utc-diff t1-utc-diff)) 60)
(if (< t0-utc-diff t1-utc-diff)
- (list t0-name t1-name t1-rules t2-rules t2-time t1-time)
- (list t1-name t0-name t2-rules t1-rules t1-time t2-time)
+ (list t0-name t1-name t1-rules t2-rules t1-time t2-time)
+ (list t1-name t0-name t2-rules t1-rules t2-time t1-time)
)))))))))))
-;;; The following six defvars relating to daylight savings time should NOT be
+;;; The following eight defvars relating to daylight savings time should NOT be
;;; marked to go into loaddefs.el where they would be evaluated when Emacs is
;;; dumped. These variables' appropriate values depend on the conditions under
;;; which the code is INVOKED; so it's inappropriate to initialize them when
(defvar calendar-daylight-time-offset
(or (car (cdr calendar-current-time-zone-cache)) 60)
"*Number of minutes difference between daylight savings and standard time.
-
+
If the locale never uses daylight savings time, set this to 0.")
(defvar calendar-standard-time-zone-name
(or (car (nthcdr 3 calendar-current-time-zone-cache)) "EDT")
"*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
-
+
;;;###autoload
(put 'calendar-daylight-savings-starts 'risky-local-variable t)
(defvar calendar-daylight-savings-starts
If the locale never uses daylight savings time, set this to nil.")
;;;###autoload
-(put 'calendar-daylight-savings-starts 'risky-local-variable t)
+(put 'calendar-daylight-savings-ends 'risky-local-variable t)
(defvar calendar-daylight-savings-ends
(or (car (nthcdr 5 calendar-current-time-zone-cache))
(and (not (zerop calendar-daylight-time-offset))
'(calendar-nth-named-day -1 0 10 year)
If the locale never uses daylight savings time, set this to nil.")
-
+
(defvar calendar-daylight-savings-starts-time
(or (car (nthcdr 6 calendar-current-time-zone-cache)) 120)
"*Number of minutes after midnight that daylight savings time starts.")
-
+
(defvar calendar-daylight-savings-ends-time
(or (car (nthcdr 7 calendar-current-time-zone-cache))
calendar-daylight-savings-starts-time)
"*Number of minutes after midnight that daylight savings time ends.")
+(defun dst-in-effect (date)
+ "True if on absolute DATE daylight savings time is in effect.
+Fractional part of DATE is local standard time of day."
+ (let* ((year (extract-calendar-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-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))))))
+
+(defun dst-adjust-time (date time &optional style)
+ "Adjust, to account for dst on DATE, decimal fraction standard TIME.
+Returns a list (date adj-time zone) where `date' and `adj-time' are the values
+adjusted for `zone'; here `date' is a list (month day year), `adj-time' is a
+decimal fraction time, and `zone' is a string.
+
+Optional parameter STYLE forces the result time to be standard time when its
+value is 'standard and daylight savings time (if available) when its value is
+'daylight.
+
+Conversion to daylight savings time is done according to
+`calendar-daylight-savings-starts', `calendar-daylight-savings-ends',
+`calendar-daylight-savings-starts-time',
+`calendar-daylight-savings-ends-time', and
+`calendar-daylight-savings-offset'."
+
+ (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date)
+ (/ (round (* 60 time)) 60.0 24.0)))
+ (dst (dst-in-effect rounded-abs-date))
+ (time-zone (if dst
+ calendar-daylight-time-zone-name
+ calendar-standard-time-zone-name))
+ (time (+ rounded-abs-date
+ (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0))))
+ (list (calendar-gregorian-from-absolute (truncate time))
+ (* 24.0 (- time (truncate time)))
+ time-zone)))
+
(provide 'cal-dst)
+;;; arch-tag: a141d204-213c-4ca5-bdc6-f9df3aa92aad
;;; cal-dst.el ends here