X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8f1204db34c0e8380f1eb81c9202520511744be3..43f5aea1d8eed1254c65383f5bbcadf6f7ebd989:/lisp/calendar/cal-dst.el diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index a0830f151a..62327a99c6 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -1,9 +1,11 @@ -;;; 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 ;; Edward M. Reingold +;; Maintainer: Glenn Morris ;; Keywords: calendar ;; Human-Keywords: daylight savings time, calendar, diary, holidays @@ -20,8 +22,9 @@ ;; 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: @@ -37,6 +40,7 @@ ;;; Code: (require 'calendar) +(require 'cal-persia) (defvar calendar-current-time-zone-cache nil "Cache for result of calendar-current-time-zone.") @@ -68,14 +72,14 @@ absolute date ABS-DATE is the equivalent moment to X." (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 @@ -127,7 +131,7 @@ Return nil if no such transition can be found." (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)) @@ -152,7 +156,16 @@ The result has the proper form for calendar-daylight-savings-starts'." (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. @@ -246,11 +259,11 @@ it can't find." (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 @@ -267,7 +280,7 @@ example, -300 for New York City, -480 for Los Angeles.") (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 @@ -279,7 +292,7 @@ For example, \"EST\" in New York City, \"PST\" for Los Angeles.") (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 @@ -304,7 +317,7 @@ If it starts on the first Sunday in April, you would set it to 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)) @@ -320,16 +333,68 @@ For example, if daylight savings time ends on the last Sunday in October: '(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