|
1 " |
|
2 COPYRIGHT (c) 1989-92 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 |
|
12 |
|
13 ---------------------------------------------------------------- |
|
14 For code marked as (GNU) the following applies: |
|
15 |
|
16 Copyright (C) 1988, 1989 Free Software Foundation, Inc. |
|
17 Written by Steve Byrne. |
|
18 |
|
19 This file is part of GNU Smalltalk. |
|
20 |
|
21 GNU Smalltalk is free software; you can redistribute it and/or modify it |
|
22 under the terms of the GNU General Public License as published by the Free |
|
23 Software Foundation; either version 1, or (at your option) any later version. |
|
24 |
|
25 GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT |
|
26 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
|
27 FOR A PARTICULAR PURPOSE. See the GNU General Public License for more |
|
28 details. |
|
29 |
|
30 You should have received a copy of the GNU General Public License along with |
|
31 GNU Smalltalk; see the file LICENSE. If not, write to the Free Software |
|
32 Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
|
33 ---------------------------------------------------------------- |
|
34 " |
|
35 |
|
36 Magnitude subclass:#Date |
|
37 instanceVariableNames:'unixTimeLow unixTimeHi' |
|
38 classVariableNames:'dayNames monthNames dayAbbrevs monthAbbrevs |
|
39 environmentChange' |
|
40 poolDictionaries:'' |
|
41 category:'Magnitude-General' |
|
42 ! |
|
43 |
|
44 Date comment:' |
|
45 |
|
46 COPYRIGHT (c) 1989-92 by Claus Gittinger |
|
47 All Rights Reserved |
|
48 |
|
49 date represents a particular second in a day; since we depend on |
|
50 unix, the second is counted from 1. Jan 1970 NOT as in Smalltalk-80 |
|
51 from 1. Jan 1901 ! |
|
52 |
|
53 %W% %E% |
|
54 |
|
55 written Spring 89 by claus |
|
56 '! |
|
57 |
|
58 !Date class methodsFor:'private'! |
|
59 |
|
60 initNames |
|
61 "read the language specific names" |
|
62 |
|
63 dayNames := Resource array:#('DAY_MONDAY' |
|
64 'DAY_TUESDAY' |
|
65 'DAY_WEDNESDAY' |
|
66 'DAY_THURSDAY' |
|
67 'DAY_FRIDAY' |
|
68 'DAY_SATURDAY' |
|
69 'DAY_SUNDAY') |
|
70 defaults:#('monday' |
|
71 'tuesday' |
|
72 'wednesday' |
|
73 'thursday' |
|
74 'friday' |
|
75 'saturday' |
|
76 'sunday') |
|
77 fromFile:'Smalltalk.rs'. |
|
78 |
|
79 dayAbbrevs := Resource array:#('DAY_MON' |
|
80 'DAY_TUE' |
|
81 'DAY_WED' |
|
82 'DAY_THU' |
|
83 'DAY_FRI' |
|
84 'DAY_SAT' |
|
85 'DAY_SUN') |
|
86 defaults:#('mon' |
|
87 'tue' |
|
88 'wed' |
|
89 'thu' |
|
90 'fri' |
|
91 'sat' |
|
92 'sun') |
|
93 fromFile:'Smalltalk.rs'. |
|
94 |
|
95 monthNames := Resource array:#('MON_JANUARY' |
|
96 'MON_FEBRUARY' |
|
97 'MON_MARCH' |
|
98 'MON_APRIL' |
|
99 'MON_MAY' |
|
100 'MON_JUNE' |
|
101 'MON_JULY' |
|
102 'MON_AUGUST' |
|
103 'MON_SEPTEMBER' |
|
104 'MON_OCTOBER' |
|
105 'MON_NOVEMBER' |
|
106 'MON_DECEMBER') |
|
107 defaults:#('january' |
|
108 'february' |
|
109 'march' |
|
110 'april' |
|
111 'may' |
|
112 'june' |
|
113 'july' |
|
114 'august' |
|
115 'september' |
|
116 'october' |
|
117 'november' |
|
118 'december') |
|
119 fromFile:'Smalltalk.rs'. |
|
120 |
|
121 monthAbbrevs := Resource array:#('MON_JAN' |
|
122 'MON_FEB' |
|
123 'MON_MAR' |
|
124 'MON_APR' |
|
125 'MON_MAY_ABBREV' |
|
126 'MON_JUN' |
|
127 'MON_JUL' |
|
128 'MON_AUG' |
|
129 'MON_SEP' |
|
130 'MON_OCT' |
|
131 'MON_NOV' |
|
132 'MON_DEC') |
|
133 defaults:#('jan' |
|
134 'feb' |
|
135 'mar' |
|
136 'apr' |
|
137 'may' |
|
138 'jun' |
|
139 'jul' |
|
140 'aug' |
|
141 'sep' |
|
142 'oct' |
|
143 'nov' |
|
144 'dec') |
|
145 fromFile:'Smalltalk.rs'. |
|
146 |
|
147 environmentChange := false |
|
148 ! ! |
|
149 |
|
150 !Date class methodsFor:'handling language changes'! |
|
151 |
|
152 initialize |
|
153 super initialize. |
|
154 Smalltalk addDependent:self. |
|
155 environmentChange := true |
|
156 ! |
|
157 |
|
158 update:something |
|
159 ((something == #Language) or:[something == #LanguageTerritory]) ifTrue:[ |
|
160 "just remember change for next access" |
|
161 environmentChange := true |
|
162 ] |
|
163 ! ! |
|
164 |
|
165 !Date class methodsFor:'general queries'! |
|
166 |
|
167 dayOfWeek:dayName |
|
168 "given the name of a day (either string or symbol), |
|
169 return the day-index (1 for monday; 7 for sunday). |
|
170 Return 0 for invalid day name" |
|
171 |
|
172 environmentChange ifTrue:[ |
|
173 self initNames |
|
174 ]. |
|
175 ^ dayNames indexOf:dayName |
|
176 |
|
177 "Date dayOfWeek:'wednesday'" |
|
178 ! |
|
179 |
|
180 indexOfMonth:aMonthString |
|
181 "given the name of a month (either string or symbol), |
|
182 return the month-index (1 for jan; 12 for december). |
|
183 Return 0 for invalid month name" |
|
184 |
|
185 |idx name| |
|
186 |
|
187 environmentChange ifTrue:[ |
|
188 self initNames |
|
189 ]. |
|
190 name := aMonthString asLowercase. |
|
191 idx := monthAbbrevs indexOf:name. |
|
192 idx ~~ 0 ifTrue:[^ idx]. |
|
193 idx := monthNames indexOf:name. |
|
194 idx ~~ 0 ifTrue:[^ idx]. |
|
195 |
|
196 name at:1 put:(name at:1) asUppercase. |
|
197 idx := monthAbbrevs indexOf:name. |
|
198 idx ~~ 0 ifTrue:[^ idx]. |
|
199 idx := monthNames indexOf:name. |
|
200 idx ~~ 0 ifTrue:[^ idx]. |
|
201 |
|
202 ^ idx |
|
203 |
|
204 "Date indexOfMonth:'jan'" |
|
205 "Date indexOfMonth:'Jan'" |
|
206 "Date indexOfMonth:'December'" |
|
207 ! |
|
208 |
|
209 nameOfDay:dayIndex |
|
210 "given a day index (1..7), return the name of the day |
|
211 as a symbol" |
|
212 |
|
213 environmentChange ifTrue:[ |
|
214 self initNames |
|
215 ]. |
|
216 ^ (dayNames at:dayIndex) asSymbol |
|
217 |
|
218 "Date nameOfDay:4" |
|
219 ! |
|
220 |
|
221 nameOfMonth:monthIndex |
|
222 "given a month index (1..12), return the name of the month |
|
223 as a symbol" |
|
224 |
|
225 environmentChange ifTrue:[ |
|
226 self initNames |
|
227 ]. |
|
228 ^ (monthNames at:monthIndex) asSymbol |
|
229 |
|
230 "Date nameOfMonth:11" |
|
231 "Date nameOfMonth:12" |
|
232 "Date nameOfMonth:4" |
|
233 ! |
|
234 |
|
235 abbreviatedNameOfDay:dayIndex |
|
236 "given a day index (1..7), return the abbreviated name |
|
237 of the day as a symbol" |
|
238 |
|
239 environmentChange ifTrue:[ |
|
240 self initNames |
|
241 ]. |
|
242 ^ (dayAbbrevs at:dayIndex) asSymbol |
|
243 ! |
|
244 |
|
245 abbreviatedNameOfMonth:monthIndex |
|
246 "given a month index (1..12), return the abbreviated name |
|
247 of the month as a symbol" |
|
248 |
|
249 environmentChange ifTrue:[ |
|
250 self initNames |
|
251 ]. |
|
252 ^ (monthAbbrevs at:monthIndex) asSymbol |
|
253 ! |
|
254 |
|
255 daysInMonth:monthName forYear:yearInteger |
|
256 "given the name of a minth and a year, return the number |
|
257 of days this month has (modified GNU). |
|
258 return 0 if the month name was invalid." |
|
259 |
|
260 |monthIndex| |
|
261 |
|
262 monthIndex := self indexOfMonth:monthName. |
|
263 (monthIndex == 0) ifTrue:[ |
|
264 ^ 0 |
|
265 ]. |
|
266 ^ self daysInMonthIndex:monthIndex forYear:yearInteger |
|
267 |
|
268 "Date daysInMonth:2 forYear:1980" |
|
269 "Date daysInMonth:2 forYear:1981" |
|
270 ! |
|
271 |
|
272 daysUntilMonth:monthName forYear:yearInteger |
|
273 "given the name of a month and a year, return the number |
|
274 of days from 1st of january to last of prev month. |
|
275 return 0 if the month name was invalid." |
|
276 |
|
277 |monthIndex sumDays| |
|
278 |
|
279 monthIndex := self indexOfMonth:monthName. |
|
280 (monthIndex == 0) ifTrue:[ |
|
281 ^ 0 |
|
282 ]. |
|
283 sumDays := 0. |
|
284 1 to:monthIndex-1 do:[:m | |
|
285 sumDays := sumDays + (self daysInMonthIndex:m forYear:yearInteger) |
|
286 ]. |
|
287 ^ sumDays |
|
288 |
|
289 "Date daysUntilMonth:'feb' forYear:1993" |
|
290 "Date daysUntilMonth:'jan' forYear:1993" |
|
291 ! |
|
292 |
|
293 daysInYear:yearInteger |
|
294 "return the number of days in a year" |
|
295 |
|
296 (self isLeapYear:yearInteger) ifTrue:[^ 366]. |
|
297 ^ 365 |
|
298 |
|
299 "Date daysInYear:1980" |
|
300 "Date daysInYear:1981" |
|
301 ! |
|
302 |
|
303 yearAsDays: yearInteger |
|
304 "Returns the number of days since Jan 1, 1901. (GNU)" |
|
305 |
|
306 |y| |
|
307 |
|
308 y := yearInteger - 1900. |
|
309 ^ (y - 1) * 365 |
|
310 + (y // 4) |
|
311 - (y // 100) |
|
312 + (y // 400) |
|
313 ! |
|
314 |
|
315 isLeapYear:yearInteger |
|
316 "return true, if a year is a leap year" |
|
317 |
|
318 (yearInteger \\ 4 == 0) ifTrue:[ |
|
319 (yearInteger \\ 100 ~~ 0) ifTrue:[^ true]. |
|
320 (yearInteger \\ 400 == 0) ifTrue:[^ true] |
|
321 ]. |
|
322 ^ false |
|
323 ! |
|
324 |
|
325 daysInMonthIndex: monthIndex forYear: yearInteger |
|
326 "return the number of days in month monthIndex of |
|
327 year yearInteger (GNU)" |
|
328 |
|
329 |days| |
|
330 |
|
331 days := #(31 28 31 "Jan Feb Mar" |
|
332 30 31 30 "Apr May Jun" |
|
333 31 31 30 "Jul Aug Sep" |
|
334 31 30 31 "Oct Nov Dec" |
|
335 ) at: monthIndex. |
|
336 |
|
337 (monthIndex == 2) ifTrue:[ |
|
338 (self isLeapYear:yearInteger) ifTrue:[ |
|
339 ^ days + 1 |
|
340 ] |
|
341 ]. |
|
342 ^ days |
|
343 ! ! |
|
344 |
|
345 !Date class methodsFor:'instance creation'! |
|
346 |
|
347 dateAndTimeNow |
|
348 "return an array with the current date and time" |
|
349 |
|
350 ^ Array with:(Date today) with:(Time now) |
|
351 ! |
|
352 |
|
353 today |
|
354 "return a date, representing today" |
|
355 |
|
356 ^ self basicNew setTimeLow:(OperatingSystem getTimeLow) |
|
357 and:(OperatingSystem getTimeHi) |
|
358 ! |
|
359 |
|
360 fromDays:dayCount |
|
361 ^ self new setDays:dayCount |
|
362 ! |
|
363 |
|
364 newDay:dayCount year:yearInteger |
|
365 ^ self new setDays:(dayCount + self yearAsDays:yearInteger) |
|
366 ! |
|
367 |
|
368 newDay:day month:monthName year:yearInteger |
|
369 ^self new setDays: |
|
370 (day + (self daysUntilMonth: monthName forYear: yearInteger) |
|
371 + (self yearAsDays: yearInteger)) |
|
372 |
|
373 "Date newDay:8 month:'may' year:1993" |
|
374 ! ! |
|
375 |
|
376 !Date methodsFor:'comparing'! |
|
377 |
|
378 |
|
379 > aDate |
|
380 "return true, if the date represented by the receiver |
|
381 is after the argument, aDate" |
|
382 |
|
383 |other| |
|
384 |
|
385 OperatingSystem computeDatePartsOf:unixTimeLow and:unixTimeHi |
|
386 for:[:year :month :day | |
|
387 other := aDate year. |
|
388 (year > other) ifTrue:[^ true]. |
|
389 (year < other) ifTrue:[^ false]. |
|
390 other := aDate month. |
|
391 (month > other) ifTrue:[^ true]. |
|
392 (month < other) ifTrue:[^ false]. |
|
393 ^ day > aDate day |
|
394 ] |
|
395 ! |
|
396 |
|
397 = aDate |
|
398 "return true, if the date represented by the receiver |
|
399 is the same as the one represented by argument, aDate" |
|
400 |
|
401 OperatingSystem computeDatePartsOf:unixTimeLow and:unixTimeHi |
|
402 for:[:year :month :day | |
|
403 (year ~~ aDate year) ifTrue:[^ false]. |
|
404 (month ~~ aDate month) ifTrue:[^ false]. |
|
405 ^ (day == aDate day) |
|
406 ] |
|
407 ! ! |
|
408 |
|
409 !Date methodsFor:'accessing'! |
|
410 |
|
411 day |
|
412 "return the day-in-month of the receiver (1..31)" |
|
413 |
|
414 OperatingSystem computeDatePartsOf:unixTimeLow and:unixTimeHi |
|
415 for:[:year :month :day | |
|
416 ^ day |
|
417 ] |
|
418 ! |
|
419 |
|
420 month |
|
421 "return the month of the receiver (1..12)" |
|
422 |
|
423 OperatingSystem computeDatePartsOf:unixTimeLow and:unixTimeHi |
|
424 for:[:year :month :day | |
|
425 ^ month |
|
426 ] |
|
427 ! |
|
428 |
|
429 year |
|
430 "return the year of the receiver i.e. 1992" |
|
431 |
|
432 OperatingSystem computeDatePartsOf:unixTimeLow and:unixTimeHi |
|
433 for:[:year :month :day | |
|
434 ^ year |
|
435 ] |
|
436 ! ! |
|
437 |
|
438 !Date methodsFor:'printing'! |
|
439 |
|
440 printString |
|
441 |string| |
|
442 |
|
443 OperatingSystem computeDatePartsOf:unixTimeLow and:unixTimeHi |
|
444 for:[:year :month :day | |
|
445 string := day printString |
|
446 , '-' |
|
447 , (Date abbreviatedNameOfMonth:month) |
|
448 , '-' |
|
449 , year printString |
|
450 ]. |
|
451 ^ string |
|
452 ! ! |
|
453 |
|
454 !Date methodsFor:'storing'! |
|
455 |
|
456 storeString |
|
457 |string| |
|
458 string := '(' , self class name , ' new settimeLow:'. |
|
459 string := string , unixTimeLow storeString. |
|
460 string := string , ' and:' , unixTimeHi storeString. |
|
461 string := string , ')'. |
|
462 ^ string |
|
463 ! ! |
|
464 |
|
465 !Date methodsFor:'private'! |
|
466 |
|
467 setTimeLow:timeLow and:timeHi |
|
468 unixTimeLow := timeLow. |
|
469 unixTimeHi := timeHi |
|
470 ! ! |
|
471 |
|
472 !Date methodsFor:'converting'! |
|
473 |
|
474 asSeconds |
|
475 ^ (unixTimeHi * 16r10000) + unixTimeLow |
|
476 ! ! |