'From Squeak3.1alpha of 30 March 2001 [latest update: #4173] on 24 July 2001 at 12:46:55 pm'! Magnitude subclass: #DateAndTime instanceVariableNames: 'seconds offset jdn nanos ' classVariableNames: 'LastDateAndTime LocalOffset ' poolDictionaries: '' category: 'Kernel-Chronology'! !DateAndTime commentStamp: '' prior: 0! I represent a point in UTC time as defined by ISO 8601. I have zero duration. My implementation uses three SmallIntegers jdn - julian day number seconds - number of seconds since midnight offset - number of seconds offset from UTC nanos - the number of nanoseconds since the second. The nanosecond attribute is almost always zero but it defined for full !!SO compliance and makes this class suitable for timestamping. ! Magnitude subclass: #Duration instanceVariableNames: 'nanos seconds ' classVariableNames: 'NanosInSecond SecondsInDay SecondsInHour SecondsInMinute ' poolDictionaries: '' category: 'Kernel-Chronology'! !Duration commentStamp: '' prior: 0! I represent a duration of time. I have nanosecond precision! Error subclass: #InvalidArgument instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Exceptions Kernel'! AlignmentMorph subclass: #MonthMorph instanceVariableNames: 'month todayCache tileRect model ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Dates'! !MonthMorph commentStamp: '' prior: 0! Display a month.! Magnitude subclass: #Timespan instanceVariableNames: 'start duration ' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Chronology'! !Timespan commentStamp: '' prior: 0! I represent a duration starting on a specific DataAndTime.! Timespan subclass: #Month instanceVariableNames: '' classVariableNames: 'DaysInMonth MonthNames ' poolDictionaries: '' category: 'Kernel-Chronology'! Timespan subclass: #Week instanceVariableNames: '' classVariableNames: 'DayNames StartDay StartMonday ' poolDictionaries: '' category: 'Kernel-Chronology'! AlignmentMorph subclass: #WeekMorph instanceVariableNames: 'week month tileRect ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Dates'! !WeekMorph commentStamp: '' prior: 0! Display a Week in a MonthMorph! Timespan subclass: #Year instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Kernel-Chronology'! !Year commentStamp: '' prior: 0! I represent a Year.! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 3/30/2001 19:31'! + aDuration "operand is a Duration or a can be a Duration" | delta | delta _ aDuration asDuration. delta positive ifTrue: [ delta _ self asDuration + delta. ^self class new jdn: (jdn + delta days) seconds: (delta asSeconds \\ 86400) nanos: (delta nanoSeconds) offset: (self offset); yourself. ] ifFalse: [ | newJdn newTime | newJdn _ jdn + delta days. delta _ delta abs - (Duration days: (delta days abs) hours: 0 minutes: 0 seconds: 0). newTime _ self asDuration. delta > newTime ifTrue: [ newJdn _ newJdn - 1. newTime _ Duration day - delta. ] ifFalse: [ newTime _ newTime - delta. ]. ^self class new jdn: newJdn seconds: (newTime asSeconds) nanos: (newTime nanoSeconds) offset: (self offset); yourself. ] ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/17/2000 14:03'! - operand "operand is a DateAndTime or Duration" (operand respondsTo: #asDateAndTime) ifTrue: [ | lutc rutc | lutc _ self asLocal utc. rutc _ operand asDateAndTime asLocal utc. ^Duration seconds: (86400 *(lutc first - rutc first)) + (lutc second - rutc second) nanoSeconds: (lutc third - rutc third) ] ifFalse: [ ^self + operand asDuration negated ]. ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/17/2000 13:35'! < comparand | lutc rutc | lutc _ self asUTC utc. rutc _ comparand asDateAndTime asUTC utc. ^lutc first < rutc first ifTrue: [ true ] ifFalse: [ lutc first > rutc first ifTrue: [ false ] ifFalse: [ lutc second < rutc second ifTrue: [ true ] ifFalse: [ lutc second > rutc second ifTrue: [ false ] ifFalse: [ lutc third < rutc third ] ] ] ]! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/17/2000 13:25'! = comparand "We are value objects so use ==. comparand is a DateAndTime conformant" ^self == comparand ifTrue: [true] ifFalse: [ comparand notNil and: [ self asUTC utc = comparand asDateAndTime asUTC utc ] ] ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:40'! asLocal ^(self offset = self class localOffset) ifTrue: [ self ] ifFalse: [ (self asUTC + self class localOffset) offset: self class localOffset; yourself ]! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/7/2000 16:27'! asUTC ^self offset: Duration zero ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 15:07'! dayOfMonth "Answer which day of the month is represented by the receiver." ^self gregorian first! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/4/2000 14:44'! dayOfWeek "Monday=1, ... , Sunday=7" ^(jdn rem: 7) + 1! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 20:51'! dayOfWeekName ^Week nameOfDay: self dayOfWeek! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/4/2000 14:45'! dayOfYear ^jdn - (Year year: self year) start julianDayNumber + 1 ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 15:05'! hash ^self asUTC utc hash! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 17:12'! hour ^self hour24! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/19/2000 16:20'! hour12 ^self hour24 \\ 12! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/4/2000 14:45'! hour24 ^(Duration seconds: seconds) hours! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 17:40'! isLeapYear ^Year isLeapYear: self year. ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/19/2000 16:20'! meridianAbbreviation ^self hour < 12 ifTrue: ['am'] ifFalse: ['pm']. ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/4/2000 14:44'! minute ^(Duration seconds: seconds) minutes! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 15:12'! month ^self gregorian middle! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/19/2000 16:23'! monthAbbreviation ^self monthName copyFrom: 1 to: 3 ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/7/2000 16:07'! monthName ^Month nameOfMonth: self month! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:46'! offset ^offset! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 4/25/2001 12:02'! offset: anOffset | equiv utc | equiv _ self - (self offset - anOffset asDuration). utc _ equiv utc. equiv jdn: utc first seconds: utc second nanos: utc third offset: anOffset asDuration. ^equiv! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/4/2000 14:45'! second ^(Duration seconds: seconds) seconds! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/19/2000 16:32'! timeZoneAbbreviation self error: 'not yet implemented'! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 8/2/2000 19:02'! timeZoneName self error: 'not yet implemented' ! ! !DateAndTime methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 15:14'! year ^self gregorian last! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:46'! asDate ^Date starting: self ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 14:38'! asDateAndTime ^self! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 20:52'! asDuration ^Duration seconds: seconds nanoSeconds: nanos! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:46'! asMonth ^Month starting: self ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 20:53'! asNanoSeconds ^self asDuration asNanoSeconds ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 3/30/2001 14:55'! asSeconds ^(self - (DateAndTime year: 1901 day: 1) ) asSeconds ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/4/2000 14:44'! asTime ^Time seconds: seconds! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:53'! asWeek ^Week starting: self ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 21:04'! asYear ^Year starting: self ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 19:18'! daysInMonth "Answer the number of days in the month represented by the receiver." ^self asMonth daysInMonth ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 14:28'! daysInYear "Answer the number of days in the year represented by the receiver." ^self asYear daysInYear ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/4/2000 15:22'! daysLeftInYear "Answer the number of days in the year after the date of the receiver." ^366 - self dayOfYear + (self isLeapYear ifTrue: [1] ifFalse: [0])! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/3/2000 15:02'! duration ^Duration zero! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/4/2000 14:46'! julianDayNumber ^jdn! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 20:56'! midnight | gregorian | gregorian _ self gregorian. ^self class year: gregorian third month: gregorian second day: gregorian first. ! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 3/30/2001 13:57'! monthIndex ^self month! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 21:58'! nanoSecond ^nanos! ! !DateAndTime methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 22:01'! printOn: aStream "Print as per ISO 8601 sections 5.3.3 and 5.4.1. -YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z" | gregorian | gregorian _ self gregorian. gregorian first negative ifTrue: [aStream nextPut: $- ]. aStream nextPutAll: (gregorian last asString padded: #left to: 4 with: $0); nextPut: $-; nextPutAll: (gregorian middle asString padded: #left to: 2 with: $0); nextPut: $-; nextPutAll: (gregorian first asString padded: #left to: 2 with: $0); nextPut: $T; nextPutAll: (self hour asString padded: #left to: 2 with: $0); nextPut: $:; nextPutAll: (self minute asString padded: #left to: 2 with: $0); nextPut: $:; nextPutAll: (self second asString padded: #left to: 2 with: $0). self nanoSecond > 0 ifTrue: [ aStream nextPut: $.; nextPutAll: (self nanoSecond asString padded: #left to: 8 with: $0) ]. aStream nextPut: (offset positive ifTrue: [$+] ifFalse: [$-]); nextPutAll: (offset hours asString padded: #left to: 2 with: $0); nextPut: $:; nextPutAll: (offset minutes asString padded: #left to: 2 with: $0). ! ! !DateAndTime methodsFor: 'private' stamp: 'BP 8/4/2000 14:46'! gregorian "Return an array of integers #(dd mm yyyy)" | l n i j dd mm yyyy | l _ jdn + 68569. n _ (4 * l) // 146097. l _ l - ( (146097 * n + 3) // 4 ). i _ (4000 * (l + 1) ) // 1461001. l _ l - ( (1461 * i) // 4 ) + 31. j _ (80 *l) // 2447. dd _ l - ( (2447 * j) // 80 ). l _ j // 11. mm _ j + 2 - (12 * l). yyyy _ 100 * (n - 49) + i + l. ^Array with: dd with: mm with: yyyy.! ! !DateAndTime methodsFor: 'private' stamp: 'BP 8/9/2000 20:03'! jdn: julianDayNumber seconds: secondCount nanos: nanoSeconds offset: utcOffset jdn _ julianDayNumber. seconds _ secondCount. nanos _ nanoSeconds. offset _ utcOffset.! ! !DateAndTime methodsFor: 'private' stamp: 'BP 4/25/2001 11:53'! nanoSeconds: nanoSeconds "Private - only used to ensure unique timestamps" nanos _ nanoSeconds. ! ! !DateAndTime methodsFor: 'private' stamp: 'BP 8/17/2000 13:27'! utc "Private - answer an array with our instance variables. Assumed to be UTC " ^Array with: jdn with: seconds with: nanos! ! !DateAndTime class methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 22:41'! clockPrecision "One second precision" ^Duration nanoSeconds: 1! ! !DateAndTime class methodsFor: 'ansi protocol' stamp: 'BP 4/25/2001 11:54'! now | secondCount dt | secondCount _ self primSecondsClock. dt _ self new jdn: 2415386 + (secondCount quo: 86400) seconds: (secondCount rem: 86400) nanos: 0 offset: self localOffset; yourself. dt = LastDateAndTime ifTrue: [dt nanoSeconds: dt nanoSecond + 1]. ^ LastDateAndTime _ dt! ! !DateAndTime class methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 22:43'! year: year day: dayOfYear hour: hour minute: minute second: second ^self year: year day: dayOfYear hour: hour minute: minute second: second offset: self localOffset. ! ! !DateAndTime class methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 20:05'! year: year day: dayOfYear hour: hour minute: minute second: second offset: offset ^self new jdn: ((year asYear start + (dayOfYear - 1 * 86400)) julianDayNumber) seconds: (Duration days: 0 hours: hour minutes: minute seconds: second) asSeconds nanos: 0 offset: offset; yourself ! ! !DateAndTime class methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 13:44'! year: year month: month day: day hour: hour minute: minute second: second ^self year: year month: month day: day hour: hour minute: minute second: second offset: self localOffset! ! !DateAndTime class methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:55'! year: year month: month day: day hour: hour minute: minute second: second offset: offset ^self year: year month: month day: day hour: hour minute: minute second: second nanoSecond: 0 offset: offset ! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 17:32'! current ^self now! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 20:08'! julianDayNumber: aJulianDayNumber ^self new jdn: aJulianDayNumber seconds: 0 nanos: 0 offset: self localOffset; yourself! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:34'! localOffset "Answer the duration we are offset from UTC" LocalOffset ifNil: [ | answer offset | answer _ FillInTheBlank request: 'What is your offset from UTC in hours ?'. offset _ [ answer asNumber asInteger ] on: Error do: [ 0 ]. (offset between: -12 and: 12) ifFalse: [ offset _ 0 ]. LocalOffset _ Duration seconds: offset * 3600. ]. ^LocalOffset! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:50'! localOffset: anOffset LocalOffset _ anOffset! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 17:32'! today ^self now midnight! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 22:44'! year: year day: dayOfYear ^self year: year day: dayOfYear hour: 0 minute: 0 second: 0 ! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:55'! year: year month: month day: day "Return the required date, set to midnight local time" ^self year: year month: month day: day hour: 0 minute: 0 second: 0 nanoSecond: 0 offset: self localOffset! ! !DateAndTime class methodsFor: 'squeak protocol' stamp: 'BP 3/30/2001 18:39'! year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset | monthIndex p q r s julianDayNumber time | monthIndex _ month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month]. p _ (monthIndex - 14) quo: 12. q _ year + 4800 + p. r _ monthIndex - 2 - (12 * p). s _ (year + 4900 + p) quo: 100. julianDayNumber _ ( (1461 * q) quo: 4 ) + ( (367 * r) quo: 12 ) - ( (3 * s) quo: 4 ) + ( day - 32075 ). time _ Duration days: 0 hours: hour minutes: minute seconds: second. ^self new jdn: julianDayNumber seconds: time asSeconds nanos: nanoCount offset: offset; yourself! ! !DateAndTime class methodsFor: 'private' stamp: 'BP 7/6/2000 18:08'! primMillisecondClock "Primitive. Answer the number of milliseconds since the millisecond clock was last reset or rolled over. Answer zero if the primitive fails. Optional. See Object documentation whatIsAPrimitive." ^ 0! ! !DateAndTime class methodsFor: 'private' stamp: 'BP 7/6/2000 18:08'! primSecondsClock "Answer the number of seconds since 00:00 onJanuary 1, 1901" self primitiveFailed! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 4/25/2001 13:37'! * operand "operand is a Number" ^self class nanoSeconds: ( (self asNanoSeconds * operand) asInteger). ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 4/25/2001 13:45'! + operand "operand is a Duration" ^self class nanoSeconds: (self asNanoSeconds + operand asNanoSeconds) ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 4/25/2001 13:45'! - operand "operand is a Duration" ^self + operand negated ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 12/4/2000 14:11'! / operand "operand is a Duration or a Number" ^operand isNumber ifTrue: [ self class nanoSeconds: (self asNanoSeconds / operand) asInteger ] ifFalse: [ self asNanoSeconds / operand asDuration asNanoSeconds ] ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 22:25'! < comparand ^self asNanoSeconds < comparand asNanoSeconds ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/17/2000 13:23'! = comparand "We are value objects so use ==. comparand is a Number or a Duration" ^self == comparand ifTrue: [true] ifFalse: [ comparand notNil and: [ self asNanoSeconds = comparand asDuration asNanoSeconds ] ] ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 22:28'! abs ^self class seconds: seconds abs nanoSeconds: nanos abs! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 12:16'! asDuration ^self ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 18:36'! asSeconds ^seconds ! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:29'! days "Answer the number of minutes the receiver represents." ^seconds quo: SecondsInDay! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 17:44'! hash ^seconds bitXor: nanos! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:29'! hours "Answer the number of hours the receiver represents." ^(seconds rem: SecondsInDay) quo: SecondsInHour! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:33'! minutes "Answer the number of minutes the receiver represents." ^(seconds rem: SecondsInHour) quo: SecondsInMinute! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 18:55'! negated ^self class seconds: seconds negated nanoSeconds: nanos negated! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:31'! negative ^self positive not! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:31'! positive ^seconds = 0 ifTrue: [ nanos positive ] ifFalse: [ seconds positive ]! ! !Duration methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 19:33'! seconds "Answer the number of seconds the receiver represents." ^seconds rem: SecondsInMinute! ! !Duration methodsFor: 'private' stamp: 'BP 8/15/2000 16:58'! seconds: secondCount nanoSeconds: nanoCount. "Private - only used by Duration class" seconds _ secondCount. nanos _ (secondCount = 0 ifTrue: [ nanoCount ] ifFalse: [ nanoCount abs ]). ! ! !Duration methodsFor: 'squeak protocol' stamp: 'BP 6/7/2001 08:04'! asDelay ^Delay forMilliseconds: self asMilliSeconds ! ! !Duration methodsFor: 'squeak protocol' stamp: 'BP 7/24/2001 12:43'! asHours "Return the number of hours this duration spans." ^seconds / SecondsInHour! ! !Duration methodsFor: 'squeak protocol' stamp: 'BP 6/7/2001 08:02'! asMilliSeconds ^((seconds * NanosInSecond) + nanos) // (10 raisedToInteger: 6)! ! !Duration methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:19'! asNanoSeconds ^(seconds * NanosInSecond) + nanos! ! !Duration methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:19'! nanoSeconds ^nanos! ! !Duration methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 18:29'! printOn: aStream | d h m s n | d _ self days abs. h _ self hours abs. m _ self minutes abs. s _ self seconds abs. n _ self nanoSeconds abs. self negative ifTrue: [ aStream nextPut: $- ]. d ~= 0 ifTrue: [ d printOn: aStream. aStream nextPutAll: ' days ' ]. (d ~= 0 | (h ~= 0)) ifTrue: [ h printOn: aStream. aStream nextPutAll: ' hours ' ]. (d ~= 0 | (h ~= 0) | (m ~= 0)) ifTrue: [ m printOn: aStream. aStream nextPutAll: ' minutes ' ]. s printOn: aStream. aStream nextPutAll: ' second'. s ~= 1 ifTrue: [ aStream nextPut: $s ]. n ~= 0 ifTrue: [ aStream space. n printOn: aStream. aStream nextPutAll: ' nanosecond'. n ~= 1 ifTrue: [ aStream nextPut: $s ] ]. ! ! !Duration class methodsFor: 'ansi protocol' stamp: 'BP 8/17/2000 13:58'! days: days hours: hours minutes: minutes seconds: seconds ^self days: days hours: hours minutes: minutes seconds: seconds nanoSeconds: 0 ! ! !Duration class methodsFor: 'ansi protocol' stamp: 'BP 8/9/2000 18:31'! seconds: secondCount "secondCount must be a Number or a Duration" ^self seconds: secondCount nanoSeconds: 0. ! ! !Duration class methodsFor: 'ansi protocol' stamp: 'BP 7/5/2000 11:19'! zero ^self seconds: 0.! ! !Duration class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:06'! day ^self seconds: SecondsInDay ! ! !Duration class methodsFor: 'squeak protocol' stamp: 'BP 8/17/2000 13:58'! days: days hours: hours minutes: minutes seconds: seconds nanoSeconds: nanoCount ^self seconds: (days*SecondsInDay) + (hours*SecondsInHour) + (minutes*60) + seconds nanoSeconds: nanoCount ! ! !Duration class methodsFor: 'squeak protocol' stamp: 'BP 6/7/2001 17:09'! milliSeconds: milliCount ^self nanoSeconds: (milliCount * (10 raisedToInteger: 6)) ! ! !Duration class methodsFor: 'squeak protocol' stamp: 'BP 8/17/2000 13:57'! nanoSeconds: nanoCount ^self new seconds: (nanoCount quo: NanosInSecond) nanoSeconds: (nanoCount rem: NanosInSecond); yourself. ! ! !Duration class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 18:34'! seconds: secondCount nanoSeconds: nanoCount. ^self new seconds: secondCount nanoSeconds: nanoCount; yourself. ! ! !Duration class methodsFor: 'squeak protocol' stamp: 'BP 8/9/2000 19:07'! week ^self seconds: (7 * SecondsInDay)! ! !Duration class methodsFor: 'initialization' stamp: 'BP 6/7/2001 08:02'! initialize SecondsInDay _ 86400. SecondsInHour _ 3600. SecondsInMinute _ 60. NanosInSecond _ 10 raisedTo: 9. ! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 19:55'! addCustomMenuItems: aCustomMenu hand: aHandMorph super addCustomMenuItems: aCustomMenu hand: aHandMorph. aCustomMenu addLine; addUpdating: #startDayString action: #toggleStartDay; add: 'jump to year...' action: #chooseYear.! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 21:56'! chooseYear | newYear yearString | newYear _ (SelectionMenu selections: {'today'} , (month year - 5 to: month year + 5) , {'other...'}) startUpWithCaption: 'Select year'. newYear ifNil: [^self]. newYear = 'today' ifTrue: [^ self month: Month current]. newYear isNumber ifTrue: [^ self month: (Month starting: (DateAndTime year: newYear month: month index day: 1)) ]. yearString _ FillInTheBlank request: 'Enter the year' initialAnswer: month year printString. yearString ifNil: [^self]. newYear _ yearString asNumber. (newYear between: 0 and: 9999) ifTrue: [^ self month: (Month starting: (DateAndTime year: newYear month: month index day: month dayOfMonth)) ]. ! ! !MonthMorph methodsFor: 'all' stamp: 'BP 3/30/2001 13:33'! initialize super initialize. tileRect _ 0@0 extent: 23@19. self layoutInset: 1; color: Color red; listDirection: #topToBottom; vResizing: #shrinkWrap; hResizing: #shrinkWrap; month: Month current. self rubberBandCells: false. self extent: 160@130.! ! !MonthMorph methodsFor: 'all' stamp: 'BP 3/30/2001 19:43'! initializeWeeks | weeks | self removeAllMorphs. weeks _ OrderedCollection new. month weeksDo: [ :w | weeks add: (WeekMorph month: month week: w) ]. weeks reverseDo: [ :wm | self addMorph: wm ]. self initializeHeader. ! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 20:03'! month ^month! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 20:03'! month: aMonth month _ aMonth. self initializeWeeks! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 19:49'! nextYear self month: (self month asYear next asMonth) ! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 19:50'! previousYear self month: (self month asYear previous asMonth) ! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 21:18'! selectedDates | dates | dates _ SortedCollection new. self submorphsDo: [ :m | (m isKindOf: WeekMorph) ifTrue: [dates addAll: m selectedDates] ]. ^dates! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 21:54'! startDayString ^'start ', (Week startDay = #Monday ifTrue: ['Sunday'] ifFalse: ['Monday']). ! ! !MonthMorph methodsFor: 'all' stamp: 'BP 8/2/2000 19:55'! toggleStartDay Week startDay = #Monday ifTrue: [ Week startDay: #Sunday ] ifFalse: [ Week startDay: #Monday ]. self initializeWeeks ! ! !MonthMorph class methodsFor: 'as yet unclassified' stamp: 'BP 3/30/2001 19:45'! month: aMonth ^self new month: aMonth; yourself.! ! !Number methodsFor: 'converting' stamp: 'BP 8/9/2000 20:20'! asDuration ^Duration nanoSeconds: self asInteger! ! !Integer methodsFor: 'converting' stamp: 'BP 8/4/2000 14:39'! asYear ^Year year: self ! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 8/2/2000 21:35'! < comparand ^self start < comparand ! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 8/2/2000 21:34'! = comparand ^self start = comparand start and: [self duration = comparand duration]! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 3/23/2001 13:08'! day "Answer the day of the year represented by the receiver." ^start day! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 8/6/2000 17:55'! hash ^start hash + duration hash! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 7/12/2000 17:45'! isLeapYear ^start isLeapYear! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 7/12/2000 17:45'! month ^start month! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 7/12/2000 17:45'! monthName ^start monthName! ! !Timespan methodsFor: 'ansi protocol' stamp: 'BP 7/12/2000 17:46'! year ^start year ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:46'! asDate ^start asDate ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 21:57'! asDateAndTime ^start! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:46'! asMonth ^start asMonth ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:47'! asWeek ^start asWeek ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:47'! asYear ^start asYear ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 21:57'! daysInMonth ^start daysInMonth ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:47'! daysInYear "Answer the number of days in the month represented by the receiver." ^start daysInYear ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:53'! duration "Answer the Duration of this timespan" ^duration! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:13'! end ^self next start - DateAndTime clockPrecision ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:47'! includes: aDateAndTime ^(aDateAndTime asDateAndTime between: start and: self end) ifTrue: [ true ] ifFalse: [ (aDateAndTime isKindOf: Timespan) ifTrue: [ self includes: aDateAndTime end ] ifFalse: [ false ] ].! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/24/2001 12:44'! intersect: aTimespan "Return the Timespan both have in common, or nil" | aBegin anEnd | aBegin _ self start max: aTimespan start. anEnd _ self end min: aTimespan end. anEnd < aBegin ifTrue: [^nil]. ^Timespan starting: aBegin ending: anEnd.! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:48'! julianDayNumber ^start julianDayNumber! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/24/2001 12:45'! merge: aTimespan "Return the Timespan spanned by both" | aBegin anEnd | aBegin _ self start min: aTimespan start. anEnd _ self end max: aTimespan end. ^Timespan starting: aBegin ending: anEnd.! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 3/30/2001 13:58'! monthIndex ^self month! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:04'! next ^self class starting: (start + duration) duration: duration! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 19:52'! previous ^self class starting: (start - duration) duration: duration! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 14:35'! printOn: aStream aStream nextPutAll: 'a Timespan starting: '. start printOn: aStream. aStream nextPutAll: ' of '. duration printOn: aStream. ! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:53'! start "Answer the start DateAndTime of this timespan" ^start! ! !Timespan methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:53'! start: aDateAndTime "Store the start DateAndTime of this timespan" start _ aDateAndTime asDateAndTime! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:06'! dates | dates | dates _ OrderedCollection new. self datesDo: [ :m | dates add: m ]. ^dates asArray! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:06'! datesDo: aBlock self do: aBlock with: start asDate. ! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 8/4/2000 14:18'! every: aDuration do: aBlock | element end | element _ self start. end _ self end. [ element <= end ] whileTrue: [ aBlock value: element. element _ element + aDuration. ]! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:06'! months | months | months _ OrderedCollection new: 12. self monthsDo: [ :m | months add: m ]. ^months asArray! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:06'! monthsDo: aBlock self do: aBlock with: start asMonth ! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:06'! weeks | weeks | weeks _ OrderedCollection new. self weeksDo: [ :m | weeks add: m ]. ^weeks asArray! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 8/2/2000 20:05'! weeksDo: aBlock self do: aBlock with: self asWeek ! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 8/7/2000 16:47'! workDatesDo: aBlock "Exclude Saturday and Sunday" self do: aBlock with: start asDate when: [ :d | d dayOfWeek < 6 ]. ! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:07'! years | years | years _ OrderedCollection new. self yearsDo: [ :m | years add: m ]. ^years asArray! ! !Timespan methodsFor: 'enumerating' stamp: 'BP 7/12/2000 18:06'! yearsDo: aBlock self do: aBlock with: start asYear ! ! !Timespan methodsFor: 'private' stamp: 'BP 8/7/2000 16:44'! do: aBlock with: aFirstElement self do: aBlock with: aFirstElement when: [ :t | true ]. ! ! !Timespan methodsFor: 'private' stamp: 'BP 8/7/2000 16:43'! do: aBlock with: aFirstElement when: aConditionBlock | element end | element _ aFirstElement. end _ self end. [ element start <= end ] whileTrue: [ (aConditionBlock value: element) ifTrue: [ aBlock value: element ]. element _ element next ]! ! !Timespan methodsFor: 'private' stamp: 'BP 7/12/2000 17:52'! duration: aDuration "Set the Duration of this timespan" duration _ aDuration! ! !Month methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 23:39'! asMonth ^self! ! !Month methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 19:19'! daysInMonth ^self duration days! ! !Month methodsFor: 'squeak protocol' stamp: 'BP 3/30/2001 19:53'! index ^ self monthIndex! ! !Month methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 18:31'! name ^ self monthName! ! !Month methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 21:31'! previous ^self class starting: (self start - 1) ! ! !Month methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 23:42'! printOn: aStream aStream nextPutAll: self monthName, ' ', self year printString! ! !Timespan class methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:03'! current ^self starting: DateAndTime now! ! !Timespan class methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:57'! starting: aDateAndTime ^self starting: aDateAndTime duration: Duration zero ! ! !Timespan class methodsFor: 'squeak protocol' stamp: 'BP 8/7/2000 16:36'! starting: aDateAndTime duration: aDuration ^self new start: aDateAndTime asDateAndTime; duration: aDuration; yourself ! ! !Timespan class methodsFor: 'squeak protocol' stamp: 'BP 8/17/2000 16:53'! starting: startDateAndTime ending: endDateAndTime ^self starting: startDateAndTime duration: (endDateAndTime asDateAndTime - startDateAndTime). ! ! !Timespan class methodsFor: 'initialization' stamp: 'BP 7/12/2000 18:41'! initialize Week initialize. Month initialize. ! ! !Month class methodsFor: 'instance creation' stamp: 'BP 8/2/2000 19:14'! readFrom: aStream | m y c | m _ (ReadWriteStream with: '') reset. [(c _ aStream next) isSeparator] whileFalse: [m nextPut: c]. [(c _ aStream next) isSeparator] whileTrue. y _ (ReadWriteStream with: '') reset. y nextPut: c. [aStream atEnd] whileFalse: [y nextPut: aStream next]. ^self starting: (DateAndTime year: y contents asNumber month: (Month indexOfMonth: m contents) day: 1). " Month readFrom: (ReadWriteStream with: 'July 1998') reset "! ! !Month class methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 16:50'! daysInMonth: anIndex ^DaysInMonth at: anIndex! ! !Month class methodsFor: 'squeak protocol' stamp: 'BP 7/7/2000 16:14'! indexOfMonth: aMonthName 1 to: 12 do: [ :i | (aMonthName, '*' match: (MonthNames at: i)) ifTrue: [^i] ]. InvalidArgument signal: aMonthName , ' is not a recognized month name' ! ! !Month class methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 18:32'! nameOfMonth: anIndex ^MonthNames at: anIndex! ! !Month class methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:03'! starting: aDateAndTime ^self starting: aDateAndTime duration: nil ! ! !Month class methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 16:51'! starting: aDateAndTime duration: aDuration "secondCount will be set to the number of days in the month Month will start from the first day of the month" | start adjusted duration | start _ aDateAndTime asDateAndTime. adjusted _ DateAndTime year: start year month: start month day: 1. duration _ (self daysInMonth: adjusted month) + ((adjusted month = 2 and: [adjusted isLeapYear]) ifTrue: [1] ifFalse: [0]). ^super starting: adjusted duration: (Duration seconds: duration * 86400). ! ! !Month class methodsFor: 'initialization' stamp: 'BP 7/5/2000 18:39'! initialize MonthNames _ #(January February March April May June July August September October November December). DaysInMonth _ #(31 28 31 30 31 30 31 31 30 31 30 31). ! ! !Week methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 23:39'! asWeek ^self! ! !Week methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 20:21'! printOn: aStream aStream nextPutAll: 'a Week starting: '. self start printOn: aStream. ! ! !Week class methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 20:48'! nameOfDay: anIndex ^DayNames at: anIndex! ! !Week class methodsFor: 'squeak protocol' stamp: 'BP 7/5/2000 20:06'! startDay ^StartDay ! ! !Week class methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 18:09'! startDay: aSymbol (DayNames includes: aSymbol) ifTrue: [ StartDay _ aSymbol ] ifFalse: [ InvalidArgument signal ] ! ! !Week class methodsFor: 'squeak protocol' stamp: 'BP 3/23/2001 12:38'! starting: aDateAndTime "aDuration will be set to the number of days in the month Week will start from the Week class>>startDay" | midnight delta adjusted | midnight _ aDateAndTime asDateAndTime midnight. delta _ ((midnight dayOfWeek + 7 - (DayNames indexOf: StartDay)) rem: 7) abs. adjusted _ midnight - (Duration days: delta hours: 0 minutes: 0 seconds: 0). ^super starting: adjusted duration: Duration week ! ! !Week class methodsFor: 'initialization' stamp: 'BP 7/5/2000 20:06'! initialize DayNames _ #(Monday Tuesday Wednesday Thursday Friday Saturday Sunday). StartDay _ DayNames first.! ! !WeekMorph methodsFor: 'all' stamp: 'BP 8/2/2000 21:43'! blankTile ^Morph new color: Color transparent; extent: 23 @ 19; yourself! ! !WeekMorph methodsFor: 'all' stamp: 'BP 3/30/2001 13:43'! initialize super initialize. self layoutInset: 0; color: Color transparent; listDirection: #leftToRight; hResizing: #shrinkWrap; disableDragNDrop; height: 19. "see #blankTile." ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 3/30/2001 19:53'! initializeDays | days | self removeAllMorphs. days _ OrderedCollection new: 7. week datesDo: [ :d | days add: (d month = month index ifTrue: [self tileForDate: d] ifFalse: [self blankTile]) ]. days reverseDo: [ :dm | self addMorph: dm ] ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 3/30/2001 19:41'! month ^month ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 3/30/2001 19:41'! month: aMonth month _ aMonth. ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 3/30/2001 13:44'! selectedDates | dates | dates _ SortedCollection new. self submorphsDo: [ :m | ((m isKindOf: SimpleSwitchMorph) and: [m color = m onColor]) ifTrue: [ dates add: (Date year: week year month: week month day: m label asNumber) ] ]. ^dates! ! !WeekMorph methodsFor: 'all' stamp: 'BP 8/2/2000 21:41'! tileForDate: aDate | onColor offColor | offColor _ Color r: 0.4 g: 0.8 b: 0.6. onColor _ offColor alphaMixed: 1/2 with: Color white. ^(SimpleSwitchMorph newWithLabel: aDate dayOfMonth printString) offColor: offColor; onColor: onColor; borderWidth: 1; useSquareCorners; extent: 23 @ 19; setBalloonText: aDate printString; yourself ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 3/30/2001 19:01'! title "Answer a title with the names of the days." | title days | title _ AlignmentMorph new layoutInset: 0; color: Color red; listDirection: #leftToRight; vResizing: #shrinkWarp; height: 19. days _ Week startDay = #Monday ifTrue: [7 to: 1 by: -1] ifFalse: [#(6 5 4 3 2 1 7)]. days do: [ :d | | name | name _ Week nameOfDay: d. title addMorph: ((SimpleButtonMorph newWithLabel: (name first: 2)) borderWidth: 1; useSquareCorners; extent: 23 @ 19; setBalloonText: name; yourself) ]. ^title ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 8/2/2000 20:32'! week ^week ! ! !WeekMorph methodsFor: 'all' stamp: 'BP 8/2/2000 19:28'! week: aWeek week _ aWeek. self initializeDays! ! !WeekMorph class methodsFor: 'instance creation' stamp: 'BP 8/2/2000 19:30'! includeInNewMorphMenu "Return true for all classes that can be instantiated from the menu" ^false! ! !WeekMorph class methodsFor: 'instance creation' stamp: 'BP 3/30/2001 19:41'! month: aMonth week: aWeek ^self new month: aMonth; week: aWeek; yourself ! ! !WeekMorph class methodsFor: 'instance creation' stamp: 'BP 3/30/2001 19:42'! week: aWeek ^self month: aWeek month week: aWeek ! ! !Year methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 18:39'! asYear ^self! ! !Year methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 21:59'! daysInMonth self shouldNotImplement ! ! !Year methodsFor: 'squeak protocol' stamp: 'BP 8/6/2000 14:29'! daysInYear ^self duration days! ! !Year methodsFor: 'squeak protocol' stamp: 'BP 8/2/2000 22:05'! printOn: aStream aStream nextPutAll: 'a Year starting: '. self start printOn: aStream. ! ! !Year class methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:54'! current ^self year: DateAndTime now year! ! !Year class methodsFor: 'squeak protocol' stamp: 'BP 7/12/2000 17:55'! isLeapYear: aYearInteger | adjustedYear | adjustedYear _ aYearInteger > 0 ifTrue: [aYearInteger] ifFalse: [(aYearInteger + 1) negated]. "There was no year 0" ^(adjustedYear \\ 4 ~= 0 or: [adjustedYear \\ 100 = 0 and: [adjustedYear \\ 400 ~= 0]]) not ! ! !Year class methodsFor: 'squeak protocol' stamp: 'BP 8/17/2000 13:46'! starting: aDateAndTime duration: aDuration "Override - start from midnight" | midnight duration | midnight _ aDateAndTime asDateAndTime midnight. duration _ 86400 * (365 + ( midnight isLeapYear ifTrue: [1] ifFalse: [0]) ). ^super starting: midnight duration: (Duration seconds: duration)! ! !Year class methodsFor: 'squeak protocol' stamp: 'BP 8/4/2000 14:40'! year: aYear ^self starting: (DateAndTime year: aYear month: 1 day: 1) ! ! WeekMorph class removeSelector: #newWeek:month:tileRect:model:! WeekMorph class removeSelector: #on:! WeekMorph removeSelector: #initializeDays:! WeekMorph removeSelector: #initializeForWeek:month:tileRect:model:! WeekMorph removeSelector: #next! WeekMorph removeSelector: #tile! WeekMorph removeSelector: #tileLabeled:! WeekMorph removeSelector: #week:month:model:! AlignmentMorph subclass: #WeekMorph instanceVariableNames: 'month week ' classVariableNames: '' poolDictionaries: '' category: 'Morphic-Dates'! Week class removeSelector: #fromDate:! Week initialize! Week class removeSelector: #startMonday! Week class removeSelector: #toggleStartMonday! Week removeSelector: #asDate! Week removeSelector: #do:! Week removeSelector: #duration! Week removeSelector: #firstDate! Week removeSelector: #index! Week removeSelector: #indexInMonth:! Week removeSelector: #lastDate! Week removeSelector: #next! Week removeSelector: #previous! Month class removeSelector: #fromDate:! Month initialize! Timespan initialize! Month removeSelector: #asDate! Month removeSelector: #duration! Month removeSelector: #eachWeekDo:! Month removeSelector: #firstDate! Month removeSelector: #lastDate! Month removeSelector: #next! !Timespan reorganize! ('ansi protocol' < = day hash isLeapYear month monthName year) ('squeak protocol' asDate asDateAndTime asMonth asWeek asYear daysInMonth daysInYear duration end includes: intersect: julianDayNumber merge: monthIndex next previous printOn: start start:) ('enumerating' dates datesDo: every:do: months monthsDo: weeks weeksDo: workDatesDo: years yearsDo:) ('private' do:with: do:with:when: duration:) ! MonthMorph removeSelector: #startMondayOrSundayString! MonthMorph removeSelector: #toggleStartMonday! Duration initialize! !DateAndTime class reorganize! ('ansi protocol' clockPrecision now year:day:hour:minute:second: year:day:hour:minute:second:offset: year:month:day:hour:minute:second: year:month:day:hour:minute:second:offset:) ('squeak protocol' current julianDayNumber: localOffset localOffset: today year:day: year:month:day: year:month:day:hour:minute:second:nanoSecond:offset:) ('private' primMillisecondClock primSecondsClock) ! !DateAndTime reorganize! ('ansi protocol' + - < = asLocal asUTC dayOfMonth dayOfWeek dayOfWeekName dayOfYear hash hour hour12 hour24 isLeapYear meridianAbbreviation minute month monthAbbreviation monthName offset offset: second timeZoneAbbreviation timeZoneName year) ('squeak protocol' asDate asDateAndTime asDuration asMonth asNanoSeconds asSeconds asTime asWeek asYear daysInMonth daysInYear daysLeftInYear duration julianDayNumber midnight monthIndex nanoSecond printOn:) ('private' gregorian jdn:seconds:nanos:offset: nanoSeconds: utc) !