Mercurial > emacs
annotate lisp/timezone.el @ 4413:5a00cec8e9b0
(fill-region-as-paragraph): When we take one word
after the fill column, don't stop at period with just one space.
When checking whether at beginning of line, if no fill prefix,
ignore intervening whitespace.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 02 Aug 1993 05:55:56 +0000 |
parents | 1489eda1a90b |
children | 10baf5e7550f |
rev | line source |
---|---|
2908 | 1 ;;; Timezone package for GNU Emacs |
2 | |
2910
74b7994f2d20
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2908
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
74b7994f2d20
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2908
diff
changeset
|
4 |
74b7994f2d20
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2908
diff
changeset
|
5 ;;; Author: Masanobu Umeda |
74b7994f2d20
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2908
diff
changeset
|
6 ;;; Maintainer: umerin@mse.kyutech.ac.jp |
2908 | 7 |
8 ;; This file is part of GNU Emacs. | |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
12 ;; the Free Software Foundation; either version 2, or (at your option) | |
13 ;; any later version. | |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
24 ;;; Code: | |
25 | |
26 (provide 'timezone) | |
27 | |
28 (defvar timezone-world-timezones | |
29 '(("PST" . -800) | |
30 ("PDT" . -700) | |
31 ("MST" . -700) | |
32 ("MDT" . -600) | |
33 ("CST" . -600) | |
34 ("CDT" . -500) | |
35 ("EST" . -500) | |
36 ("EDT" . -400) | |
37 ("AST" . -400) ;by <clamen@CS.CMU.EDU> | |
38 ("NST" . -330) ;by <clamen@CS.CMU.EDU> | |
39 ("GMT" . +000) | |
40 ("BST" . +100) | |
41 ("MET" . +100) | |
42 ("EET" . +200) | |
43 ("JST" . +900) | |
44 ("GMT+1" . +100) ("GMT+2" . +200) ("GMT+3" . +300) | |
45 ("GMT+4" . +400) ("GMT+5" . +500) ("GMT+6" . +600) | |
46 ("GMT+7" . +700) ("GMT+8" . +800) ("GMT+9" . +900) | |
47 ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300) | |
48 ("GMT-1" . -100) ("GMT-2" . -200) ("GMT-3" . -300) | |
49 ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) | |
50 ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) | |
51 ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
52 "*Time differentials of timezone from GMT in +-HHMM form. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
53 This list is obsolescent, and is present only for backwards compatibility, |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
54 because time zone names are ambiguous in practice. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
55 Use `current-time-zone' instead.") |
2908 | 56 |
57 (defvar timezone-months-assoc | |
58 '(("JAN" . 1)("FEB" . 2)("MAR" . 3) | |
59 ("APR" . 4)("MAY" . 5)("JUN" . 6) | |
60 ("JUL" . 7)("AUG" . 8)("SEP" . 9) | |
61 ("OCT" . 10)("NOV" . 11)("DEC" . 12)) | |
62 "Alist of first three letters of a month and its numerical representation.") | |
63 | |
64 (defun timezone-make-date-arpa-standard (date &optional local timezone) | |
65 "Convert DATE to an arpanet standard date. | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
66 Optional 1st argument LOCAL specifies the default local timezone of the DATE; |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
67 if nil, GMT is assumed. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
68 Optional 2nd argument TIMEZONE specifies a time zone to be represented in; |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
69 if nil, the local time zone is assumed." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
70 (let ((new (timezone-fix-time date local timezone))) |
2908 | 71 (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) |
72 (timezone-make-time-string | |
73 (aref new 3) (aref new 4) (aref new 5)) | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
74 (aref new 6)) |
2908 | 75 )) |
76 | |
77 (defun timezone-make-date-sortable (date &optional local timezone) | |
78 "Convert DATE to a sortable date string. | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
79 Optional 1st argument LOCAL specifies the default local timezone of the DATE; |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
80 if nil, GMT is assumed. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
81 Optional 2nd argument TIMEZONE specifies a timezone to be represented in; |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
82 if nil, the local time zone is assumed." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
83 (let ((new (timezone-fix-time date local timezone))) |
2908 | 84 (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) |
85 (timezone-make-time-string | |
86 (aref new 3) (aref new 4) (aref new 5))) | |
87 )) | |
88 | |
89 | |
90 ;; | |
91 ;; Parsers and Constructors of Date and Time | |
92 ;; | |
93 | |
94 (defun timezone-make-arpa-date (year month day time &optional timezone) | |
95 "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. | |
96 Optional argument TIMEZONE specifies a time zone." | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
97 (let ((zone |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
98 (if (listp timezone) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
99 (let* ((m (timezone-zone-to-minute timezone)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
100 (absm (if (< m 0) (- m) m))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
101 (format "%c%02d%02d" |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
102 (if (< m 0) ?- ?+) (/ absm 60) (% absm 60))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
103 timezone))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
104 (format "%02d %s %04d %s %s" |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
105 day |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
106 (capitalize (car (rassq month timezone-months-assoc))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
107 year |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
108 time |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
109 zone))) |
2908 | 110 |
111 (defun timezone-make-sortable-date (year month day time) | |
112 "Make sortable date string from YEAR, MONTH, DAY, and TIME." | |
113 (format "%4d%02d%02d%s" | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
114 year month day time)) |
2908 | 115 |
116 (defun timezone-make-time-string (hour minute second) | |
117 "Make time string from HOUR, MINUTE, and SECOND." | |
118 (format "%02d:%02d:%02d" hour minute second)) | |
119 | |
120 (defun timezone-parse-date (date) | |
121 "Parse DATE and return a vector [year month day time timezone]. | |
122 19 is prepended to year if necessary. Timezone may be NIL if nothing. | |
123 Understand the following styles: | |
124 (1) 14 Apr 89 03:20[:12] [GMT] | |
125 (2) Fri, 17 Mar 89 4:01[:33] [GMT] | |
126 (3) Mon Jan 16 16:12[:37] [GMT] 1989 | |
127 (4) 6 May 1992 1641-JST (Wednesday)" | |
128 (let ((date (or date "")) | |
129 (year nil) | |
130 (month nil) | |
131 (day nil) | |
132 (time nil) | |
133 (zone nil)) ;This may be nil. | |
134 (cond ((string-match | |
135 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date) | |
136 ;; Styles: (1) and (2) without timezone | |
137 (setq year 3 month 2 day 1 time 4 zone nil)) | |
138 ((string-match | |
139 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) | |
140 ;; Styles: (1) and (2) with timezone and buggy timezone | |
141 (setq year 3 month 2 day 1 time 4 zone 5)) | |
142 ((string-match | |
143 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date) | |
144 ;; Styles: (3) without timezone | |
145 (setq year 4 month 1 day 2 time 3 zone nil)) | |
146 ((string-match | |
147 "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date) | |
148 ;; Styles: (3) with timezoen | |
149 (setq year 5 month 1 day 2 time 3 zone 4)) | |
150 ((string-match | |
151 "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) | |
152 ;; Styles: (4) with timezone | |
153 (setq year 3 month 2 day 1 time 4 zone 5)) | |
154 ) | |
155 (if year | |
156 (progn | |
157 (setq year | |
158 (substring date (match-beginning year) (match-end year))) | |
159 ;; It is now Dec 1992. 8 years before the end of the World. | |
160 (if (< (length year) 4) | |
161 (setq year (concat "19" (substring year -2 nil)))) | |
162 (setq month | |
163 (int-to-string | |
164 (cdr | |
165 (assoc | |
166 (upcase | |
167 ;; Don't use `match-end' in order to take 3 | |
168 ;; letters from the beginning. | |
169 (substring date | |
170 (match-beginning month) | |
171 (+ (match-beginning month) 3))) | |
172 timezone-months-assoc)))) | |
173 (setq day | |
174 (substring date (match-beginning day) (match-end day))) | |
175 (setq time | |
176 (substring date (match-beginning time) (match-end time))))) | |
177 (if zone | |
178 (setq zone | |
179 (substring date (match-beginning zone) (match-end zone)))) | |
180 ;; Return a vector. | |
181 (if year | |
182 (vector year month day time zone) | |
183 (vector "0" "0" "0" "0" nil)) | |
184 )) | |
185 | |
186 (defun timezone-parse-time (time) | |
187 "Parse TIME (HH:MM:SS) and return a vector [hour minute second]. | |
188 Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." | |
189 (let ((time (or time "")) | |
190 (hour nil) | |
191 (minute nil) | |
192 (second nil)) | |
193 (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) | |
194 ;; HH:MM:SS | |
195 (setq hour 1 minute 2 second 3)) | |
196 ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time) | |
197 ;; HH:MM | |
198 (setq hour 1 minute 2 second nil)) | |
199 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) | |
200 ;; HHMMSS | |
201 (setq hour 1 minute 2 second 3)) | |
202 ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) | |
203 ;; HHMM | |
204 (setq hour 1 minute 2 second nil)) | |
205 ) | |
206 ;; Return [hour minute second] | |
207 (vector | |
208 (if hour | |
209 (substring time (match-beginning hour) (match-end hour)) "0") | |
210 (if minute | |
211 (substring time (match-beginning minute) (match-end minute)) "0") | |
212 (if second | |
213 (substring time (match-beginning second) (match-end second)) "0")) | |
214 )) | |
215 | |
216 | |
217 ;; Miscellaneous | |
218 | |
219 (defun timezone-zone-to-minute (timezone) | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
220 "Translate TIMEZONE to an integer minute offset from GMT. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
221 TIMEZONE can be a cons cell containing the output of current-time-zone, |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
222 or an integer of the form +-HHMM, or a time zone name." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
223 (cond |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
224 ((consp timezone) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
225 (/ (car timezone) 60)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
226 (timezone |
2908 | 227 (progn |
228 (setq timezone | |
229 (or (cdr (assoc (upcase timezone) timezone-world-timezones)) | |
230 ;; +900 | |
231 timezone)) | |
232 (if (stringp timezone) | |
233 (setq timezone (string-to-int timezone))) | |
234 ;; Taking account of minute in timezone. | |
235 ;; HHMM -> MM | |
236 ;;(+ (* 60 (/ timezone 100)) (% timezone 100)) | |
237 ;; ANSI C compliance about truncation of integer division | |
238 ;; by eggert@twinsun.com (Paul Eggert) | |
239 (let* ((abszone (max timezone (- timezone))) | |
240 (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
241 (if (< timezone 0) (- minutes) minutes)))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
242 (t 0))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
243 |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
244 (defun timezone-time-from-absolute (date seconds) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
245 "Compute the UTC time equivalent to DATE at time SECONDS after midnight. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
246 Return a list suitable as an argument to current-time-zone, |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
247 or nil if the date cannot be thus represented. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
248 DATE is the number of days elapsed since the (imaginary) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
249 Gregorian date Sunday, December 31, 1 BC." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
250 (let* ((current-time-origin 719162) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
251 ;; (timezone-absolute-from-gregorian 1 1 1970) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
252 (days (- date current-time-origin)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
253 (seconds-per-day (float 86400)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
254 (seconds (+ seconds (* days seconds-per-day))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
255 (current-time-arithmetic-base (float 65536)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
256 (hi (floor (/ seconds current-time-arithmetic-base))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
257 (hibase (* hi current-time-arithmetic-base)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
258 (lo (floor (- seconds hibase)))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
259 (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
260 (cons hi lo)))) |
2908 | 261 |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
262 (defun timezone-time-zone-from-absolute (date seconds) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
263 "Compute the local time zone for DATE at time SECONDS after midnight. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
264 Return a list in the same format as current-time-zone's result, |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
265 or nil if the local time zone could not be computed. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
266 DATE is the number of days elapsed since the (imaginary) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
267 Gregorian date Sunday, December 31, 1 BC." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
268 (and (fboundp 'current-time-zone) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
269 (let ((utc-time (timezone-time-from-absolute date seconds))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
270 (and utc-time |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
271 (let ((zone (current-time-zone utc-time))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
272 (and (car zone) zone)))))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
273 |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
274 (defun timezone-fix-time (date local timezone) |
3505 | 275 "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector. |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
276 If LOCAL is nil, it is assumed to be GMT. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
277 If TIMEZONE is nil, use the local time zone." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
278 (let* ((date (timezone-parse-date date)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
279 (year (string-to-int (aref date 0))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
280 (year (if (< year 100) (+ year 1900) year)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
281 (month (string-to-int (aref date 1))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
282 (day (string-to-int (aref date 2))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
283 (time (timezone-parse-time (aref date 3))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
284 (hour (string-to-int (aref time 0))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
285 (minute (string-to-int (aref time 1))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
286 (second (string-to-int (aref time 2))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
287 (local (or (aref date 4) local)) ;Use original if defined |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
288 (timezone |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
289 (or timezone |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
290 (timezone-time-zone-from-absolute |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
291 (timezone-absolute-from-gregorian month day year) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
292 (+ second (* 60 (+ minute (* 60 hour))))))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
293 (diff (- (timezone-zone-to-minute timezone) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
294 (timezone-zone-to-minute local))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
295 (minute (+ minute diff)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
296 (hour-fix |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
297 (if (< minute 0) |
2908 | 298 ;;(/ (- minute 59) 60) (/ minute 60) |
299 ;; ANSI C compliance about truncation of integer division | |
300 ;; by eggert@twinsun.com (Paul Eggert) | |
301 (- (/ (- 59 minute) 60)) (/ minute 60)))) | |
302 (setq hour (+ hour hour-fix)) | |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
303 (setq minute (- minute (* 60 hour-fix))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
304 ;; HOUR may be larger than 24 or smaller than 0. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
305 (cond ((<= 24 hour) ;24 -> 00 |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
306 (setq hour (- hour 24)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
307 (setq day (1+ day)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
308 (if (< (timezone-last-day-of-month month year) day) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
309 (progn |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
310 (setq month (1+ month)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
311 (setq day 1) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
312 (if (< 12 month) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
313 (progn |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
314 (setq month 1) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
315 (setq year (1+ year)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
316 )) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
317 ))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
318 ((> 0 hour) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
319 (setq hour (+ hour 24)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
320 (setq day (1- day)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
321 (if (> 1 day) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
322 (progn |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
323 (setq month (1- month)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
324 (if (> 1 month) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
325 (progn |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
326 (setq month 12) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
327 (setq year (1- year)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
328 )) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
329 (setq day (timezone-last-day-of-month month year)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
330 ))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
331 ) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
332 (vector year month day hour minute second timezone))) |
2908 | 333 |
334 ;; Partly copied from Calendar program by Edward M. Reingold. | |
335 ;; Thanks a lot. | |
336 | |
337 (defun timezone-last-day-of-month (month year) | |
338 "The last day in MONTH during YEAR." | |
339 (if (and (= month 2) (timezone-leap-year-p year)) | |
340 29 | |
341 (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) | |
342 | |
343 (defun timezone-leap-year-p (year) | |
344 "Returns t if YEAR is a Gregorian leap year." | |
345 (or (and (zerop (% year 4)) | |
346 (not (zerop (% year 100)))) | |
347 (zerop (% year 400)))) | |
2910
74b7994f2d20
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2908
diff
changeset
|
348 |
3494
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
349 (defun timezone-day-number (month day year) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
350 "Return the day number within the year of the date month/day/year." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
351 (let ((day-of-year (+ day (* 31 (1- month))))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
352 (if (> month 2) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
353 (progn |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
354 (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
355 (if (timezone-leap-year-p year) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
356 (setq day-of-year (1+ day-of-year))))) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
357 day-of-year)) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
358 |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
359 (defun timezone-absolute-from-gregorian (month day year) |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
360 "The number of days between the Gregorian date 12/31/1 BC and month/day/year. |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
361 The Gregorian date Sunday, December 31, 1 BC is imaginary." |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
362 (+ (timezone-day-number month day year);; Days this year |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
363 (* 365 (1- year));; + Days in prior years |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
364 (/ (1- year) 4);; + Julian leap years |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
365 (- (/ (1- year) 100));; - century years |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
366 (/ (1- year) 400)));; + Gregorian leap years |
ddc7da3f66d1
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2910
diff
changeset
|
367 |
2910
74b7994f2d20
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
2908
diff
changeset
|
368 ;;; timezone.el ends here |