[Pkg] The Trunk: Chronology-Core-dtl.1.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Feb 27 23:54:29 UTC 2016


David T. Lewis uploaded a new version of Chronology-Core to project The Trunk:
http://source.squeak.org/trunk/Chronology-Core-dtl.1.mcz

==================== Summary ====================

Name: Chronology-Core-dtl.1
Author: dtl
Time: 27 February 2016, 6:38:44.804572 pm
UUID: 70511d01-c1dc-487b-90cf-7d45458c961a
Ancestors: 

Move Kernel-Chronology to Chronology-Core and KernelTests-Chronology to Chronology-Tests

==================== Snapshot ====================

SystemOrganization addCategory: #'Chronology-Core'!

Magnitude subclass: #Timespan
	instanceVariableNames: 'start duration'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Chronology-Core'!

!Timespan commentStamp: 'bf 2/18/2016 14:43' prior: 0!
I represent a duration starting on a specific DateAndTime.

If my start has an offset identical to my #defaultOffset then comparisons ignore timezone offset.!

Timespan subclass: #Schedule
	instanceVariableNames: 'schedule'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Chronology-Core'!

!Schedule commentStamp: 'brp 5/13/2003 09:48' prior: 0!
I represent a powerful class for implementing recurring schedules.!

----- Method: Schedule>>between:and:do: (in category 'enumerating') -----
between: aStart and: anEnd do: aBlock

	| element end i |
	end := self end min: anEnd.
	element := self start.
	
	i := 1.
	[ element < aStart ] whileTrue:
	
	[ element := element + (schedule at: i).
		i := i + 1. (i > schedule size) ifTrue: [i := 1]].
	i := 1.
	[ element <= end ] whileTrue:
	
	[ aBlock value: element.
		element := element + (schedule at: i).
		i := i + 1.
		(i > schedule size) ifTrue: [i := 1]]
!

----- Method: Schedule>>dateAndTimes (in category 'enumerating') -----
dateAndTimes

	| dateAndTimes |
	dateAndTimes := OrderedCollection new.
	self scheduleDo: [ :e | dateAndTimes add: e ].
	^ dateAndTimes asArray!

----- Method: Schedule>>includes: (in category 'squeak protocol') -----
includes: aDateAndTime

	| dt |
	dt := aDateAndTime asDateAndTime.
	self scheduleDo: [ :e | e = dt ifTrue: [^true] ].
	^ false
!

----- Method: Schedule>>schedule (in category 'enumerating') -----
schedule
	^ schedule!

----- Method: Schedule>>schedule: (in category 'enumerating') -----
schedule: anArrayOfDurations

	schedule := anArrayOfDurations!

----- Method: Schedule>>scheduleDo: (in category 'enumerating') -----
scheduleDo: aBlock

	self between: (self start) and: (self end) do: aBlock
!

----- Method: Timespan class>>current (in category 'squeak protocol') -----
current
	^ self starting: (DateAndTime now offset: self defaultOffset)!

----- Method: Timespan class>>defaultOffset (in category 'configuring') -----
defaultOffset
	"Timespans created in the context of an offset will start in that offset.  When no context is available, the defaultOffset for Timespans must be nil.  For example, two ways to make a Date for today:
	Date today.  'start is midnight without offset.  Will compare successfully to other Date today results.'
	DateAndTime now asDate.  'In this case, the start is midnight of the local time-zone.  It can only compare equally to Dates of its time-zone or Dates without timezone.'"
	^ nil!

----- Method: Timespan class>>new (in category 'squeak protocol') -----
new
	"Answer a Timespan starting on the Squeak epoch: 1 January 1901"
	^ self starting: (DateAndTime new offset: self defaultOffset)!

----- Method: Timespan class>>starting: (in category 'squeak protocol') -----
starting: aDateAndTime


	^ self starting: aDateAndTime duration: Duration zero!

----- Method: Timespan class>>starting:duration: (in category 'squeak protocol') -----
starting: aDateAndTime duration: aDuration

	^ self basicNew
 		start: aDateAndTime asDateAndTime;
		duration: aDuration;
		yourself!

----- Method: Timespan class>>starting:ending: (in category 'squeak protocol') -----
starting: startDateAndTime ending: endDateAndTime

	^ self 
		starting: startDateAndTime 
		duration: (endDateAndTime asDateAndTime - startDateAndTime)
!

----- Method: Timespan>>+ (in category 'ansi protocol') -----
+ operand
	"operand conforms to protocol Duration"
	

	^ self class starting: (self start + operand) duration: self duration!

----- Method: Timespan>>- (in category 'ansi protocol') -----
- operand
	"operand conforms to protocol DateAndTime or protocol Duration"

	^ (operand respondsTo: #asDateAndTime)

	 	ifTrue: [ self start - operand ]
	
	ifFalse: [ self + (operand negated) ]
!

----- Method: Timespan>>< (in category 'ansi protocol') -----
< comparand
	^(self noTimezone or: [comparand noTimezone])
		ifTrue: [self start hasSmallerTicksThan: comparand asDateAndTime]
		ifFalse: [self start < comparand asDateAndTime]
!

----- Method: Timespan>>= (in category 'ansi protocol') -----
= comparand
	^ self class = comparand class 
		and: [((self noTimezone or: [ comparand noTimezone ])
			ifTrue: [ self start hasEqualTicks: comparand start ]
			ifFalse: [ self start = comparand start ])
		and: [ self duration = comparand duration ] ]
.!

----- Method: Timespan>>asDate (in category 'squeak protocol') -----
asDate


	^ start asDate!

----- Method: Timespan>>asDateAndTime (in category 'squeak protocol') -----
asDateAndTime

	^ start!

----- Method: Timespan>>asDuration (in category 'squeak protocol') -----
asDuration

	^ self duration!

----- Method: Timespan>>asMonth (in category 'squeak protocol') -----
asMonth


	^ start asMonth!

----- Method: Timespan>>asTime (in category 'squeak protocol') -----
asTime

	^ start asTime!

----- Method: Timespan>>asTimeStamp (in category 'squeak protocol') -----
asTimeStamp

	^ start asTimeStamp!

----- Method: Timespan>>asWeek (in category 'squeak protocol') -----
asWeek

	^ start asWeek!

----- Method: Timespan>>asYear (in category 'squeak protocol') -----
asYear


	^ start asYear
!

----- Method: Timespan>>dates (in category 'enumerating') -----
dates


	| dates |

	dates := OrderedCollection new.
	self datesDo: [ :m | dates add: m ].
	^ dates asArray!

----- Method: Timespan>>datesDo: (in category 'enumerating') -----
datesDo: aBlock


	self do: aBlock with: start asDate
!

----- Method: Timespan>>day (in category 'smalltalk-80') -----
day
	"Answer the day of the year represented by the receiver."
	^ self dayOfYear!

----- Method: Timespan>>dayOfMonth (in category 'ansi protocol') -----
dayOfMonth
	"Answer the day of the month represented by the receiver."

	^ start dayOfMonth!

----- Method: Timespan>>dayOfWeek (in category 'ansi protocol') -----
dayOfWeek
	"Answer the day of the week represented by the receiver."

	^ start dayOfWeek!

----- Method: Timespan>>dayOfWeekName (in category 'ansi protocol') -----
dayOfWeekName
	"Answer the day of the week represented by the receiver."

	^ start dayOfWeekName!

----- Method: Timespan>>dayOfYear (in category 'ansi protocol') -----
dayOfYear
	"Answer the day of the year represented by the receiver."

	^ start dayOfYear!

----- Method: Timespan>>daysInMonth (in category 'smalltalk-80') -----
daysInMonth


	^ start daysInMonth!

----- Method: Timespan>>daysInYear (in category 'smalltalk-80') -----
daysInYear
	"Answer the number of days in the month represented by the receiver."

	^ start daysInYear!

----- Method: Timespan>>daysLeftInYear (in category 'smalltalk-80') -----
daysLeftInYear
	^ start daysLeftInYear!

----- Method: Timespan>>do:with: (in category 'private') -----
do: aBlock with: aFirstElement

	self do: aBlock with: aFirstElement when: [ :t | true ]
!

----- Method: Timespan>>do:with:when: (in category 'private') -----
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. ]
!

----- Method: Timespan>>duration (in category 'squeak protocol') -----
duration
	"Answer the Duration of this timespan"

	^ duration!

----- Method: Timespan>>duration: (in category 'private') -----
duration: aDuration
	"Set the Duration of this timespan"

	duration := aDuration!

----- Method: Timespan>>end (in category 'squeak protocol') -----
end


	^ self duration asNanoSeconds = 0
		ifTrue: [ self start ]
		ifFalse: [ self next start - DateAndTime clockPrecision ]
!

----- Method: Timespan>>every:do: (in category 'enumerating') -----
every: aDuration do: aBlock

	| element end |
	element := self start.
	end := self end.
	[ element <= end ] whileTrue:
	
	[ aBlock value: element.
		element := element + aDuration. ]!

----- Method: Timespan>>firstDayOfMonth (in category 'smalltalk-80') -----
firstDayOfMonth

	^ start firstDayOfMonth!

----- Method: Timespan>>hash (in category 'ansi protocol') -----
hash

	^ start hash + duration hash!

----- Method: Timespan>>includes: (in category 'squeak protocol') -----
includes: aDateAndTime


	^ (aDateAndTime isKindOf: Timespan)
			ifTrue: [ (self includes: aDateAndTime start)
						and: [ self includes: aDateAndTime end ] ]
			ifFalse: [ aDateAndTime asDateAndTime between: start and: self end ]!

----- Method: Timespan>>includesAllOf: (in category 'squeak protocol') -----
includesAllOf: aCollection 
	"Answer whether all the elements of aCollection are in the receiver."

	aCollection do: [:elem | (self includes: elem) ifFalse: [^ false]].
	^ true
!

----- Method: Timespan>>includesAnyOf: (in category 'squeak protocol') -----
includesAnyOf: aCollection 
	"Answer whether any element of aCollection is included in the receiver"

	aCollection do: [ :elem | (self includes: elem) ifTrue: [^ true]].
	^false
!

----- Method: Timespan>>intersection: (in category 'squeak protocol') -----
intersection: 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].

	 ^ self class starting: aBegin ending: anEnd
!

----- Method: Timespan>>isLeapYear (in category 'ansi protocol') -----
isLeapYear

	^ start isLeapYear!

----- Method: Timespan>>julianDayNumber (in category 'squeak protocol') -----
julianDayNumber


	^ start julianDayNumber!

----- Method: Timespan>>makeUTC (in category 'squeak protocol') -----
makeUTC
	"Change the receiver's timezone to UTC, which affords substantially better hashing performance."
	start makeUTC!

----- Method: Timespan>>month (in category 'ansi protocol') -----
month

	^ start month!

----- Method: Timespan>>monthAbbreviation (in category 'ansi protocol') -----
monthAbbreviation


	^ start monthAbbreviation!

----- Method: Timespan>>monthIndex (in category 'smalltalk-80') -----
monthIndex

	^ self month!

----- Method: Timespan>>monthName (in category 'ansi protocol') -----
monthName


	^ start monthName!

----- Method: Timespan>>months (in category 'enumerating') -----
months

	| months |
	months := OrderedCollection new: 12.
	self monthsDo: [ :m | months add: m ].
	^ months asArray.
!

----- Method: Timespan>>monthsDo: (in category 'enumerating') -----
monthsDo: aBlock

	self do: aBlock with: start asMonth!

----- Method: Timespan>>next (in category 'smalltalk-80') -----
next

	^ self class starting: (start + duration) duration: duration!

----- Method: Timespan>>noTimezone (in category 'private') -----
noTimezone
	^ start noTimezone!

----- Method: Timespan>>previous (in category 'smalltalk-80') -----
previous


	^ self class starting: (start - duration) duration: duration!

----- Method: Timespan>>printOn: (in category 'squeak protocol') -----
printOn: aStream


	super printOn: aStream.
	aStream 
		nextPut: $(;
		print: start;
		nextPut: $D;
		print: duration;
		nextPut: $)
!

----- Method: Timespan>>start (in category 'squeak protocol') -----
start
	"Answer the start DateAndTime of this timespan"

	^ start!

----- Method: Timespan>>start: (in category 'squeak protocol') -----
start: aDateAndTime
	"Store the start DateAndTime of this timespan"

	start := aDateAndTime asDateAndTime!

----- Method: Timespan>>to: (in category 'squeak protocol') -----
to: anEnd
	"Answer an Timespan. anEnd must be aDateAndTime or a Timespan"


	^ Timespan starting: (self start) ending: (anEnd asDateAndTime)
!

----- Method: Timespan>>union: (in category 'squeak protocol') -----
union: 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 + DateAndTime clockPrecision)
!

----- Method: Timespan>>weeks (in category 'enumerating') -----
weeks


	| weeks |
	weeks := OrderedCollection new.
	self weeksDo: [ :m | weeks add: m ].
	^ weeks asArray!

----- Method: Timespan>>weeksDo: (in category 'enumerating') -----
weeksDo: aBlock

	self do: aBlock with: self asWeek.!

----- Method: Timespan>>workDatesDo: (in category 'enumerating') -----
workDatesDo: aBlock
	"Exclude Saturday and Sunday"

	self do: aBlock with: start asDate when: [ :d | d dayOfWeek < 6 ]
!

----- Method: Timespan>>year (in category 'ansi protocol') -----
year


	^ start year!

----- Method: Timespan>>years (in category 'enumerating') -----
years


	| years |
	years := OrderedCollection new.
	self yearsDo: [ :m | years add: m ].
	^ years asArray!

----- Method: Timespan>>yearsDo: (in category 'enumerating') -----
yearsDo: aBlock

	self do: aBlock with: start asYear.!

Timespan subclass: #Year
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Chronology-Core'!

!Year commentStamp: 'cbr 7/28/2010 18:10' prior: 0!
I represent a year.

Try me!! Select the following expression and print it:

Year current daysInYear "Try me again next leap year!!"!

----- Method: Year class>>current (in category 'squeak protocol') -----
current
 
	^ self year: (DateAndTime now year)
!

----- Method: Year class>>daysInYear: (in category 'smalltalk-80') -----
daysInYear: yearInteger

	^ 365 + ((self isLeapYear: yearInteger) ifTrue: [1] ifFalse: [0]).
!

----- Method: Year class>>isLeapYear: (in category 'squeak protocol') -----
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!

----- Method: Year class>>leapYear: (in category 'smalltalk-80') -----
leapYear: yearInteger 

	^ (self isLeapYear: yearInteger)
		ifTrue: [1]
		ifFalse: [0]!

----- Method: Year class>>starting:duration: (in category 'squeak protocol') -----
starting: aDateAndTime duration: aDuration 
	"Override - start from midnight"
	| midnight |
	midnight := aDateAndTime asDateAndTime midnight.

	^ super
		starting: midnight
		duration: (Duration days: (self daysInYear: midnight year))!

----- Method: Year class>>year: (in category 'squeak protocol') -----
year: aYear 
	^ self starting:
		(DateAndTime
			year: aYear
			month: 1
			day: 1
			hour: 0
			minute: 0
			second: 0
			offset: self defaultOffset)!

----- Method: Year>>asYear (in category 'squeak protocol') -----
asYear


	^ self!

----- Method: Year>>daysInMonth (in category 'squeak protocol') -----
daysInMonth


	self shouldNotImplement!

----- Method: Year>>daysInYear (in category 'squeak protocol') -----
daysInYear

	^ self duration days.!

----- Method: Year>>previous (in category 'smalltalk-80') -----
previous
	"This implementation handles leap years correctly"
	
	^ self class year: (self year - 1)!

----- Method: Year>>printOn: (in category 'squeak protocol') -----
printOn: aStream

	aStream nextPutAll: 'a Year ('.
	self start year printOn: aStream.

	aStream nextPutAll: ')'
!

SharedPool subclass: #ChronologyConstants
	instanceVariableNames: 'seconds offset jdn nanos'
	classVariableNames: 'DayNames DaysInMonth MicrosecondsInDay MonthNames NanosInMillisecond NanosInSecond OneDay SecondsInDay SecondsInHour SecondsInMinute SqueakEpoch Zero'
	poolDictionaries: ''
	category: 'Chronology-Core'!

!ChronologyConstants commentStamp: 'brp 3/12/2004 14:34' prior: 0!
ChronologyConstants is a SharedPool for the constants used by the Kernel-Chronology classes.!

----- Method: ChronologyConstants class>>initialize (in category 'class initialization') -----
initialize
	"ChronologyConstants initialize" 	
		
	SqueakEpoch := 2415386. 		"Julian day number of 1 Jan 1901" 
	SecondsInDay := 86400.
	SecondsInHour := 3600.
	SecondsInMinute := 60.
	MicrosecondsInDay := 24 * 60 * 60 * 1000000.
	NanosInSecond := 10 raisedTo: 9.
	NanosInMillisecond := 10 raisedTo: 6.
	DayNames := #(Sunday Monday Tuesday Wednesday Thursday Friday Saturday).
		
	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)!

Timespan subclass: #Date
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!Date commentStamp: 'cmm 2/3/2012 17:30' prior: 0!
Instances of Date are Timespans with duration of 1 day.

Their default creation assumes a start of midnight of UTC to provide the fast, globalized Dates out of the box.  The legacy behavior that creates Timezone-sensitive Dates can be used by sending #localizedDates.
!

----- Method: Date class>>dateAndTimeNow (in category 'smalltalk-80') -----
dateAndTimeNow
	"Answer an Array whose with Date today and Time now."

	^ Time dateAndTimeNow
!

----- Method: Date class>>dayOfWeek: (in category 'smalltalk-80') -----
dayOfWeek: dayName 

	^ Week indexOfDay: dayName!

----- Method: Date class>>daysInMonth:forYear: (in category 'smalltalk-80') -----
daysInMonth: monthName forYear: yearInteger 

	^ Month daysInMonth: monthName forYear: yearInteger.
!

----- Method: Date class>>daysInYear: (in category 'smalltalk-80') -----
daysInYear: yearInteger 

	^ Year daysInYear: yearInteger.!

----- Method: Date class>>easterDateFor: (in category 'general inquiries') -----
easterDateFor: year

 "  compute the easter date.
    source: Physikalisch-Technische Bundesanstalt Braunschweig.
    Lichtenberg, H.: Zur Interpretation der Gaussschen Osterformel
                     und ihrer Ausnahmeregeln,
                     Historia Mathematica 24 (1997), pp. 441-444
  
    http://www.ptb.de/de/org/4/44/441/oste.htm
  "

  | k m s a d r og sz oe day |

  k := year // 100.
  m := 15 + (3*k + 3//4) - (8*k + 13//25).
   s := 2 - (3*k + 3// 4).
  a := year \\ 19.
  d := 19*a + m \\ 30.
  r := d//29 + ((d//28) - (d//29)* (a// 11)).

  og := 21 + d - r.
  sz := 7 - (year//4 + year + s\\7).
  oe := 7 - (og - sz\\7).
  day := og + oe.
  ^day <= 31
    ifTrue: [Date newDay: day month: 3 year: year ]
    ifFalse: [Date newDay: day - 31 month: 4 year: year].!

----- Method: Date class>>firstWeekdayOfMonth:year: (in category 'smalltalk-80') -----
firstWeekdayOfMonth: month year: year
	"Answer the weekday index of the first day in <month> in the <year>."

	^ (self newDay: 1 month: month year: year) weekdayIndex
!

----- Method: Date class>>fromDays: (in category 'smalltalk-80') -----
fromDays: dayCount 
	"Days since 1 January 1901"

	^ self julianDayNumber: dayCount + SqueakEpoch!

----- Method: Date class>>fromSeconds: (in category 'smalltalk-80') -----
fromSeconds: seconds
	"Answer an instance of me which is 'seconds' seconds after January 1, 1901."

	^ self fromDays: ((Duration seconds: seconds) days)
!

----- Method: Date class>>fromString: (in category 'squeak protocol') -----
fromString: aString
	"Answer an instance of created from a string with format mm.dd.yyyy."

	^ self readFrom: aString readStream.!

----- Method: Date class>>indexOfMonth: (in category 'smalltalk-80') -----
indexOfMonth: aMonthName 

	^ Month indexOfMonth: aMonthName.
!

----- Method: Date class>>julianDayNumber: (in category 'squeak protocol') -----
julianDayNumber: aJulianDayNumber 
	^ self starting:
		(DateAndTime
			julianDayNumber: aJulianDayNumber
			offset: self defaultOffset)!

----- Method: Date class>>leapYear: (in category 'smalltalk-80') -----
leapYear: yearInteger 

	^ Year leapYear: yearInteger!

----- Method: Date class>>nameOfDay: (in category 'smalltalk-80') -----
nameOfDay: dayIndex 

	^ Week nameOfDay: dayIndex !

----- Method: Date class>>nameOfMonth: (in category 'smalltalk-80') -----
nameOfMonth: anIndex 

	^ Month nameOfMonth: anIndex.
!

----- Method: Date class>>newDay:month:year: (in category 'smalltalk-80') -----
newDay: day month: month year: year 

	^ self year: year month: month day: day
!

----- Method: Date class>>newDay:year: (in category 'smalltalk-80') -----
newDay: dayCount year: yearInteger

	^ self year: yearInteger day: dayCount!

----- Method: Date class>>orthodoxEasterDateFor: (in category 'general inquiries') -----
orthodoxEasterDateFor: year

 "  compute the easter date according to the rules of the orthodox calendar.
    source: 
    http://www.smart.net/~mmontes/ortheast.html 
  "
     | r1 r2 r3 r4 ra rb r5 rc date |

    r1 := year \\ 19.
    r2 := year \\ 4.
    r3 := year \\ 7.
    ra := 19*r1 + 16.
    r4 := ra \\ 30.
    rb := r2 + r2 + (4*r3) + (6*r4).
    r5 := rb \\ 7.
    rc := r4 + r5.
    date := Date newDay: 3 month: 4 year: year.
    ^date addDays: rc.!

----- Method: Date class>>readFrom: (in category 'squeak protocol') -----
readFrom: aStream 
	"Read a Date from the stream in any of the forms:  
		<day> <month> <year>		(15 April 1982; 15-APR-82; 15.4.82; 15APR82)  
		<month> <day> <year>		(April 15, 1982; 4/15/82)
		<year>-<month>-<day>			(1982-04-15) (ISO8601)"
	| day month year parsedNumber prefix |
	aStream peek = $-
		ifTrue: [prefix := -1]
		ifFalse: [prefix := 1].
	[aStream peek isAlphaNumeric]
		whileFalse: [aStream skip: 1].
	aStream peek isDigit
		ifTrue: [
			parsedNumber := (Integer readFrom: aStream) * prefix.
			(parsedNumber < 0 or: [parsedNumber > 31])
				ifTrue: [year := parsedNumber]].
	[aStream peek isAlphaNumeric]
		whileFalse: [aStream skip: 1].
	aStream peek isLetter
		ifTrue: ["MM-DD-YY or DD-MM-YY or YY-MM-DD"
			month := WriteStream on: (String new: 10).
			[aStream peek isLetter]
				whileTrue: [month nextPut: aStream next].
			month := month contents.
			[aStream peek isAlphaNumeric]
				whileFalse: [aStream skip: 1].
			parsedNumber isNil
				ifTrue: ["MM DD YY"
					day := Integer readFrom: aStream]
				ifFalse: [
					year isNil
						ifTrue: ["DD MM YY"
							day := parsedNumber]]]
		ifFalse: ["MM-DD-YY or DD-MM-YY or YY-MM-DD"
			year isNil 
				ifTrue: ["MM-DD-YY or DD-MM-YY"
					parsedNumber > 12
						ifTrue: ["DD-MM-YY"
							day := parsedNumber.
							month := Month nameOfMonth: (Integer readFrom: aStream)]
						ifFalse: ["MM-DD-YY"
							month := Month nameOfMonth: parsedNumber.
							day := Integer readFrom: aStream]]
				ifFalse: ["YY-MM-DD"
					month := Month nameOfMonth: (Integer readFrom: aStream)]].
	[aStream peek isAlphaNumeric]
		whileFalse: [aStream skip: 1].
	year isNil
		ifTrue: [year := Integer readFrom: aStream]
		ifFalse: [day := Integer readFrom: aStream].
	(year < 100 and: [year >= 0]) 
		ifTrue: [
			year < 69 
				ifTrue: [	year := 2000 + year]
				ifFalse: [year := 1900 + year]].

	^ self
		year: year
		month: month
		day: day
!

----- Method: Date class>>readFrom:pattern: (in category 'squeak protocol') -----
readFrom: inputStream pattern: pattern
	"Read a Date from the stream based on the pattern which can include the tokens:
	
		y = A year with 1-n digits
		yy = A year with 2 digits
		yyyy = A year with 4 digits
		m = A month with 1-n digits
		mm = A month with 2 digits
		d = A day with 1-n digits
		dd = A day with 2 digits
		
	...and any other Strings inbetween. Representing $y, $m and $d is done using
	\y, \m and \d and slash itself with \\. Simple example patterns:

		'yyyy-mm-dd'
		'yyyymmdd'
		'yy.mm.dd'
		'y-m-d'

	A year given using only two decimals is considered to be >2000."

	| day month year patternStream char |
	patternStream := pattern readStream.
	[patternStream atEnd] whileFalse: [
		inputStream atEnd ifTrue: [^nil].
		char := patternStream next.
		char = $\
			ifTrue: [inputStream next = patternStream next ifFalse: [^nil]]
			ifFalse: [
				char = $y
					ifTrue: [
						(patternStream nextMatchAll: 'yyy')
							ifTrue: [year := (inputStream next: 4) asInteger]
							ifFalse: [
								(patternStream peekFor: $y)
									ifTrue: [
										year := (inputStream next: 2) asInteger]
									ifFalse: [
										year := Integer readFrom: inputStream]]]
					ifFalse: [
						char = $m
							ifTrue: [
								(patternStream peekFor: $m)
									ifTrue: [
										month := (inputStream next: 2) asInteger]
									ifFalse: [
										month := Integer readFrom: inputStream]]
							ifFalse: [
								char = $d
									ifTrue: [
										(patternStream peekFor: $d)
											ifTrue: [
												day := (inputStream next: 2) asInteger]
											ifFalse: [
												day := Integer readFrom: inputStream]]
									ifFalse: [
										inputStream next = char ifFalse: [^nil]]]]]].
	(year isNil | month isNil | day isNil) ifTrue: [^nil].
	^self year: year month: month day: day!

----- Method: Date class>>starting: (in category 'squeak protocol') -----
starting: aDateAndTime 
	^ self
		starting: aDateAndTime midnight
		duration: Duration oneDay!

----- Method: Date class>>today (in category 'smalltalk-80') -----
today

	^ self current
!

----- Method: Date class>>tomorrow (in category 'squeak protocol') -----
tomorrow

	^ self today next!

----- Method: Date class>>year:day: (in category 'squeak protocol') -----
year: year day: dayOfYear 
	^ self starting:
		(DateAndTime
			year: year
			day: dayOfYear
			hour: 0
			minute: 0
			second: 0
			offset: self defaultOffset)!

----- Method: Date class>>year:month:day: (in category 'squeak protocol') -----
year: year month: month day: day 
	^ self starting:
		(DateAndTime
			year: year
			month: month
			day: day
			hour: 0
			minute: 0
			second: 0
			offset: self defaultOffset)!

----- Method: Date class>>yesterday (in category 'squeak protocol') -----
yesterday

	^ self today previous!

----- Method: Date>>addDays: (in category 'smalltalk-80') -----
addDays: dayCount 

	^ (self asDateAndTime + (dayCount days)) asDate!

----- Method: Date>>addMonths: (in category 'utils') -----
addMonths: monthCount 
	|year month maxDaysInMonth day |
	year := self year + (monthCount + self monthIndex - 1 // 12).
	month := self monthIndex + monthCount - 1 \\ 12 + 1.
	maxDaysInMonth := Month daysInMonth: month forYear: year.
	day := self dayOfMonth > maxDaysInMonth
				ifTrue: [maxDaysInMonth]
				ifFalse: [self dayOfMonth].
	^ Date
		newDay: day
		month: month
		year: year!

----- Method: Date>>asDate (in category 'squeak protocol') -----
asDate

	^ self
!

----- Method: Date>>asSeconds (in category 'smalltalk-80') -----
asSeconds
	"Answer the seconds since the Squeak epoch: 1 January 1901"

	^ start asSeconds
!

----- Method: Date>>dayMonthYearDo: (in category 'squeak protocol') -----
dayMonthYearDo: aBlock 
	"Supply integers for day, month and year to aBlock and return the result"

	^ start dayMonthYearDo: aBlock!

----- Method: Date>>leap (in category 'smalltalk-80') -----
leap
	"Answer whether the receiver's year is a leap year."

	^ start isLeapYear ifTrue: [1] ifFalse: [0].!

----- Method: Date>>mmddyyyy (in category 'printing') -----
mmddyyyy
	"Answer the receiver rendered in standard U.S.A format mm/dd/yyyy.
	Note that the name here is slightly misleading -- the month and day numbers don't show leading zeros, 
	so that for example February 1 1996 is 2/1/96"


	^ self printFormat: #(2 1 3 $/ 1 1)
!

----- Method: Date>>month (in category 'squeak protocol') -----
month
	^ self asMonth!

----- Method: Date>>monthIndex (in category 'squeak protocol') -----
monthIndex
	^ super month!

----- Method: Date>>onNextMonth (in category 'utils') -----
onNextMonth

	^ self addMonths: 1
!

----- Method: Date>>onPreviousMonth (in category 'utils') -----
onPreviousMonth

	^ self addMonths: -1
!

----- Method: Date>>previous: (in category 'smalltalk-80') -----
previous: dayName 
	"Answer the previous date whose weekday name is dayName."

	| days |
	days := 7 + self weekdayIndex - (self class dayOfWeek: dayName) \\ 7.
	days = 0 ifTrue: [ days := 7 ].
	^ self subtractDays: days!

----- Method: Date>>printFormat: (in category 'printing') -----
printFormat: formatArray 
	"Answer a String describing the receiver using the argument formatArray."

	^String new: 17 streamContents: [ :stream |
		self printOn: stream format: formatArray ]!

----- Method: Date>>printOn: (in category 'printing') -----
printOn: aStream

	self printOn: aStream format: #(1 2 3 $  3 1 )
!

----- Method: Date>>printOn:format: (in category 'printing') -----
printOn: aStream format: formatArray 
	"Print a description of the receiver on aStream using the format 
	denoted the argument, formatArray: 
	
		#(item item item sep monthfmt yearfmt twoDigits) 
	
		items: 1=day 2=month 3=year will appear in the order given, 
	
		separated by sep which is eaither an ascii code or character. 
	
		monthFmt: 1=09 2=Sep 3=September 
	
		yearFmt: 1=1996 2=96 
	
		digits: (missing or)1=9 2=09. 
	
	See the examples in printOn: and mmddyy"
	| gregorian twoDigits element monthFormat |
	gregorian := self dayMonthYearDo: [ :d :m :y | {d. m. y} ].
	twoDigits := formatArray size > 6 and: [(formatArray at: 7) > 1].
	1 to: 3 do: 
		[ :i | 
			element := formatArray at: i.
			element = 1
				ifTrue: [twoDigits
						ifTrue: [aStream
								nextPutAll: (gregorian first asString
										padded: #left
										to: 2
										with: $0)]
						ifFalse: [gregorian first printOn: aStream]].
			element = 2
				ifTrue: [monthFormat := formatArray at: 5.
					monthFormat = 1
						ifTrue: [twoDigits
								ifTrue: [aStream
										nextPutAll: (gregorian middle asString
												padded: #left
												to: 2
												with: $0)]
								ifFalse: [gregorian middle printOn: aStream]].
					monthFormat = 2
						ifTrue: [aStream
								nextPutAll: ((Month nameOfMonth: gregorian middle)
										copyFrom: 1
										to: 3)].
					monthFormat = 3
						ifTrue: [aStream
								nextPutAll: (Month nameOfMonth: gregorian middle)]].
			element = 3
				ifTrue: [(formatArray at: 6)
							= 1
						ifTrue: [gregorian last printOn: aStream]
						ifFalse: [aStream
								nextPutAll: ((gregorian last \\ 100) asString
										padded: #left
										to: 2
										with: $0)]].
			i < 3
				ifTrue: [(formatArray at: 4)
							~= 0
						ifTrue: [aStream nextPut: (formatArray at: 4) asCharacter]]]!

----- Method: Date>>storeOn: (in category 'printing') -----
storeOn: aStream

	aStream print: self printString; nextPutAll: ' asDate'
!

----- Method: Date>>subtractDate: (in category 'smalltalk-80') -----
subtractDate: aDate 
	"Answer the number of days between self and aDate"

	^ (self start - aDate asDateAndTime) days!

----- Method: Date>>subtractDays: (in category 'smalltalk-80') -----
subtractDays: dayCount 

	^ (self asDateAndTime - (dayCount days)) asDate!

----- Method: Date>>weekday (in category 'smalltalk-80') -----
weekday
	"Answer the name of the day of the week on which the receiver falls."

	^ self dayOfWeekName!

----- Method: Date>>weekdayIndex (in category 'smalltalk-80') -----
weekdayIndex
	"Sunday=1, ... , Saturday=7"

	^ self dayOfWeek!

----- Method: Date>>yyyymmdd (in category 'printing') -----
yyyymmdd
	"Format the date in ISO 8601 standard like '2002-10-22'."

	^ self printFormat: #(3 2 1 $- 1 1 2)
!

Magnitude subclass: #DateAndTime
	instanceVariableNames: 'seconds offset jdn nanos'
	classVariableNames: 'AutomaticTimezone ClockProvider LastClockValue LocalTimeZone NanoOffset'
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!DateAndTime commentStamp: 'bf 2/18/2016 16:20' prior: 0!
I represent a point in UTC time as defined by ISO 8601. I have zero duration.


My implementation uses three SmallIntegers
 and a Duration:
jdn		- julian day number.
seconds	- number of seconds since midnight.
nanos	- the number of nanoseconds since the second.

offset	- duration from UTC (possibly nil if no timezone information)

The nanosecond attribute is almost always zero but it defined for full ISO compliance and is suitable for timestamping.
!

----- Method: DateAndTime class>>automaticTimezone (in category 'preferences') -----
automaticTimezone
	"Accessor for the system-wide preference"
	
	<preference: 'Automatically set local timezone'
		category: 'general'
		description: 'If enabled, the timezone will automatically be kept in sync with the system''s time (daylight savings changes etc.)'
		type: #Boolean>
	^AutomaticTimezone ifNil: [ true ]!

----- Method: DateAndTime class>>automaticTimezone: (in category 'preferences') -----
automaticTimezone: aBoolean
	"Accessor for the system-wide preference"
	
	AutomaticTimezone := aBoolean!

----- Method: DateAndTime class>>clock (in category 'clock provider') -----
clock 
	 "the provider of real time seconds/milliseconds."

	^ ClockProvider !

----- Method: DateAndTime class>>clockPrecision (in category 'ansi protocol') -----
clockPrecision
	"One nanosecond precision"

	^ Duration seconds: 0 nanoSeconds: 1
!

----- Method: DateAndTime class>>current (in category 'squeak protocol') -----
current


	^ self now!

----- Method: DateAndTime class>>date:time: (in category 'squeak protocol') -----
date: aDate time: aTime

	^ self 
		year: aDate year 
		day: aDate dayOfYear 
		hour: aTime hour 
		minute: aTime minute 
		second: aTime second
		offset: aDate start offset!

----- Method: DateAndTime class>>epoch (in category 'squeak protocol') -----
epoch
	"Answer a DateAndTime representing the Squeak epoch: 1 January 1901"

	^ self julianDayNumber: SqueakEpoch!

----- Method: DateAndTime class>>fromSeconds: (in category 'smalltalk-80') -----
fromSeconds: seconds 
	"Answer a DateAndTime since the Squeak epoch: 1 January 1901"

	| integerSeconds nanos |
	integerSeconds := seconds truncated.
	integerSeconds = seconds
		ifTrue: [nanos := 0]
		ifFalse: [nanos := (seconds - integerSeconds * NanosInSecond) asInteger].
	^ self basicNew
		ticks: (Array
				with: SqueakEpoch
				with: integerSeconds
				with: nanos)
		offset: self localOffset!

----- Method: DateAndTime class>>fromString: (in category 'squeak protocol') -----
fromString: aString


	^ self readFrom: (ReadStream on: aString)!

----- Method: DateAndTime class>>initialize (in category 'initialize-release') -----
initialize
	ClockProvider ifNil: [ClockProvider := Time].
	Smalltalk addToStartUpList: self after: Delay.
	self startUp: true.
!

----- Method: DateAndTime class>>julianDayNumber: (in category 'squeak protocol') -----
julianDayNumber: anInteger 
	^ self
		julianDayNumber: anInteger
		offset: self localOffset!

----- Method: DateAndTime class>>julianDayNumber:offset: (in category 'squeak protocol') -----
julianDayNumber: anInteger offset: aDuration 

	^self basicNew
		setJdn: anInteger
		seconds: 0
		nano: 0
		offset: aDuration!

----- Method: DateAndTime class>>localOffset (in category 'squeak protocol') -----
localOffset
	"Answer the duration we are offset from UTC"

	^ self localTimeZone offset
!

----- Method: DateAndTime class>>localOffset: (in category 'squeak protocol') -----
localOffset: aDuration
	"Set the duration we are offset from UTC (done automatically in #now)"
	self localTimeZone: (TimeZone offset: aDuration name: 'Local Time' abbreviation: 'LT').
!

----- Method: DateAndTime class>>localTimeZone (in category 'accessing') -----
localTimeZone
	"Answer the local time zone"

	^ LocalTimeZone ifNil: [ LocalTimeZone := TimeZone default ]

!

----- Method: DateAndTime class>>localTimeZone: (in category 'accessing') -----
localTimeZone: aTimeZone
	"Set the local time zone"

	"
	DateAndTime localTimeZone: (TimeZone offset:  0 hours name: 'Universal Time' abbreviation: 'UTC').
	DateAndTime localTimeZone: (TimeZone offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST').
	"

	LocalTimeZone := aTimeZone


!

----- Method: DateAndTime class>>midnight (in category 'squeak protocol') -----
midnight

	^ self now midnight!

----- Method: DateAndTime class>>milliSecondsSinceMidnight (in category 'squeak protocol') -----
milliSecondsSinceMidnight
	^Time milliSecondsSinceMidnight!

----- Method: DateAndTime class>>millisecondClockValue (in category 'smalltalk-80') -----
millisecondClockValue

	^ self clock millisecondClockValue!

----- Method: DateAndTime class>>new (in category 'squeak protocol') -----
new
	"Answer a DateAndTime representing the Squeak epoch: 1 January 1901"

	^ self epoch!

----- Method: DateAndTime class>>noon (in category 'squeak protocol') -----
noon

	^ self now noon
!

----- Method: DateAndTime class>>now (in category 'ansi protocol') -----
now
	| clockAndOffset |
	clockAndOffset := self clock localMicrosecondClockWithOffset.
	(self automaticTimezone and:
		[self localOffset asSeconds ~= clockAndOffset second])
			ifTrue: [self localOffset: (Duration seconds: clockAndOffset second)].
	^self now: clockAndOffset first offset: self localOffset!

----- Method: DateAndTime class>>now:offset: (in category 'squeak protocol') -----
now: clockValue offset: aDuration

	| seconds nanos |
	"Ensure that consecutive sends of this method return increasing values, by adding small values to the nanosecond part of the created object. The next few lines are assumed to be executed atomically - having no suspension points."
	((LastClockValue ifNil: [ 0 ]) digitCompare: clockValue) = 0
		ifTrue: [ NanoOffset := NanoOffset + 1 ]
		ifFalse: [ NanoOffset := 0 ].
	LastClockValue := clockValue.
	nanos := clockValue \\ 1000000 * 1000 + NanoOffset.
	seconds := clockValue // 1000000.
	^self basicNew
		setJdn: seconds // SecondsInDay + SqueakEpoch
		seconds: seconds \\ SecondsInDay
		nano: nanos
		offset: aDuration!

----- Method: DateAndTime class>>readFrom: (in category 'squeak protocol') -----
readFrom: aStream

	| offset date time ch |

	date := Date readFrom: aStream.
	[aStream peek isDigit]
		whileFalse: [aStream next].
	time := Time readFrom: aStream.
	(aStream atEnd or: [('+-Z' includes: aStream peek) not])
		ifTrue: [offset := self localOffset]
		ifFalse: [(aStream peekFor: $Z)
			ifTrue: [offset := Duration zero]
			ifFalse: [
				ch := aStream next.
				ch = $+ ifTrue: [ch := Character space].
				offset := Duration fromString: ch asString, '0:', aStream upToEnd, ':0']].
	^ self
		year: date year
		month: date monthIndex
		day: date dayOfMonth
		hour: time hour
		minute: time minute
		second: time second
		nanoSecond: time nanoSecond
		offset: offset


	"	'-1199-01-05T20:33:14.321-05:00' asDateAndTime
		' 2002-05-16T17:20:45.1+01:01' asDateAndTime

		' 2002-05-16T17:20:45.02+01:01' asDateAndTime

		' 2002-05-16T17:20:45.003+01:01' asDateAndTime

		' 2002-05-16T17:20:45.0004+01:01' asDateAndTime
  		' 2002-05-16T17:20:45.00005' asDateAndTime
		' 2002-05-16T17:20:45.000006+01:01' asDateAndTime

		' 2002-05-16T17:20:45.0000007+01:01' asDateAndTime
		' 2002-05-16T17:20:45.00000008-01:01' asDateAndTime   
		' 2002-05-16T17:20:45.000000009+01:01' asDateAndTime  
		' 2002-05-16T17:20:45.0000000001+01:01' asDateAndTime  

 		' 2002-05-16T17:20' asDateAndTime
		' 2002-05-16T17:20:45' asDateAndTime
		' 2002-05-16T17:20:45+01:57' asDateAndTime
 		' 2002-05-16T17:20:45-02:34' asDateAndTime
 		' 2002-05-16T17:20:45+00:00' asDateAndTime
		' 1997-04-26T01:02:03+01:02:3' asDateAndTime 
 	"!

----- Method: DateAndTime class>>startUp: (in category 'system startup') -----
startUp: startingAfresh
	"Set local timezone"
	startingAfresh ifTrue: [self now].
!

----- Method: DateAndTime class>>today (in category 'squeak protocol') -----
today

	^ self midnight!

----- Method: DateAndTime class>>tomorrow (in category 'squeak protocol') -----
tomorrow

	^ self today asDate next asDateAndTime
!

----- Method: DateAndTime class>>totalSeconds (in category 'smalltalk-80') -----
totalSeconds

	^ self clock totalSeconds!

----- Method: DateAndTime class>>unixEpoch (in category 'squeak protocol') -----
unixEpoch
	"Answer a DateAndTime representing the Unix epoch (1 January 1970, midnight UTC)"

	^ self basicNew
		ticks: #(2440588 0 0) offset: Duration zero;
		yourself.
!

----- Method: DateAndTime class>>year:day: (in category 'squeak protocol') -----
year: year day: dayOfYear
	"Return a DateAndTime"

	^ self
		year: year
		day: dayOfYear
		hour: 0
		minute: 0
		second: 0
!

----- Method: DateAndTime class>>year:day:hour:minute:second: (in category 'ansi protocol') -----
year: year day: dayOfYear hour: hour minute: minute second: second

	^ self
		year: year
		day: dayOfYear
		hour: hour
		minute: minute
		second: second
		offset: self localOffset
!

----- Method: DateAndTime class>>year:day:hour:minute:second:offset: (in category 'ansi protocol') -----
year: year day: dayOfYear hour: hour minute: minute second: second offset: offset 
	"Return a DataAndTime"

	| y d |
	y := self
		year: year
		month: 1
		day: 1
		hour: hour
		minute: minute
		second: second
		nanoSecond: 0
		offset: offset.

	d := Duration days: (dayOfYear - 1).

	^ y + d
!

----- Method: DateAndTime class>>year:month:day: (in category 'squeak protocol') -----
year: year month: month day: day
	"Return a DateAndTime, midnight local time"
	
	^self
 		year: year
 		month: month
 		day: day
 		hour: 0
		minute: 0
!

----- Method: DateAndTime class>>year:month:day:hour:minute: (in category 'squeak protocol') -----
year: year month: month day: day hour: hour minute: minute
	"Return a DateAndTime"

	^self
 		year: year
 		month: month
 		day: day
 		hour: hour
		minute: minute
		second: 0
!

----- Method: DateAndTime class>>year:month:day:hour:minute:second: (in category 'ansi protocol') -----
year: year month: month day: day hour: hour minute: minute second: second
	"Return a DateAndTime"

	^ self
		year: year
		month: month
		day: day
		hour: hour
		minute: minute
		second: second
		offset: self localOffset!

----- Method: DateAndTime class>>year:month:day:hour:minute:second:nanoSecond:offset: (in category 'squeak protocol') -----
year: year month: month day: day hour: hour minute: minute second: second nanoSecond: nanoCount offset: offset
	"Return a DateAndTime"

	| monthIndex daysInMonth p q r s julianDayNumber |

	monthIndex := month isInteger ifTrue: [month] ifFalse: [Month indexOfMonth: month].
	daysInMonth := Month
		daysInMonth: monthIndex
		forYear: year.
	day < 1 ifTrue: [self error: 'day may not be zero or negative'].
	day > daysInMonth ifTrue: [self error: 'day is after month ends']. 	
	
	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 ).

	^self basicNew
		setJdn: julianDayNumber 
		seconds: hour * 60 + minute * 60 + second
		nano: nanoCount
		offset: offset;
		yourself!

----- Method: DateAndTime class>>year:month:day:hour:minute:second:offset: (in category 'ansi protocol') -----
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!

----- Method: DateAndTime class>>yesterday (in category 'squeak protocol') -----
yesterday

	^ self today asDate previous asDateAndTime!

----- Method: DateAndTime>>+ (in category 'ansi protocol') -----
+ operand
	"operand conforms to protocol Duration"

	| ticks |
 	ticks := self ticks + (operand asDuration ticks) .

	^ self class basicNew
		ticks: ticks
		offset: self offset; 
		yourself
!

----- Method: DateAndTime>>- (in category 'ansi protocol') -----
- operand
	"operand conforms to protocol DateAndTime or protocol Duration"

	^ (operand respondsTo: #asDateAndTime)
		ifTrue: 
			[ | lticks rticks |
			lticks := self asLocal ticks.
	
		rticks := operand asDateAndTime asLocal ticks.
			Duration
 				seconds: (SecondsInDay *(lticks first - rticks first)) + 
							(lticks second - rticks second)
 				nanoSeconds: (lticks third - rticks third) ]
	
	ifFalse:
		
 	[ self + (operand negated) ]
!

----- Method: DateAndTime>>< (in category 'ansi protocol') -----
< comparand 
	"comparand conforms to protocol DateAndTime,
	or can be converted into something that conforms."
	| lvalue rvalue comparandAsDateAndTime |
	comparandAsDateAndTime _ comparand asDateAndTime.
	self offset = comparandAsDateAndTime offset
		ifTrue:
			[ lvalue := self.
			rvalue := comparandAsDateAndTime ]
		ifFalse:
			[ lvalue := self asUTC.
			rvalue := comparandAsDateAndTime asUTC ].
	^ lvalue julianDayNumber < rvalue julianDayNumber or:
		[ lvalue julianDayNumber > rvalue julianDayNumber
			ifTrue: [ false ]
			ifFalse:
				[ lvalue secondsSinceMidnight < rvalue secondsSinceMidnight or:
					[ lvalue secondsSinceMidnight > rvalue secondsSinceMidnight
						ifTrue: [ false ]
						ifFalse: [ lvalue nanoSecond < rvalue nanoSecond ] ] ] ]!

----- Method: DateAndTime>>= (in category 'ansi protocol') -----
= aDateAndTimeOrTimeStamp 
	self == aDateAndTimeOrTimeStamp ifTrue: [ ^ true ].
	((aDateAndTimeOrTimeStamp isKindOf: self class)
		or: [aDateAndTimeOrTimeStamp isKindOf: DateAndTime orOf: TimeStamp])
			ifFalse: [ ^ false ].
	^ self offset = aDateAndTimeOrTimeStamp offset
		ifTrue: [ self hasEqualTicks: aDateAndTimeOrTimeStamp ]
		ifFalse: [ self asUTC hasEqualTicks: aDateAndTimeOrTimeStamp asUTC ]!

----- Method: DateAndTime>>asDate (in category 'squeak protocol') -----
asDate


	^ Date starting: self asDateAndTime!

----- Method: DateAndTime>>asDateAndTime (in category 'squeak protocol') -----
asDateAndTime

	^ self!

----- Method: DateAndTime>>asDuration (in category 'squeak protocol') -----
asDuration
	"Answer the duration since midnight."

	^ Duration seconds: seconds nanoSeconds: nanos
!

----- Method: DateAndTime>>asLocal (in category 'ansi protocol') -----
asLocal
	

	^ (self offset = self class localOffset)

		ifTrue: [self]
		ifFalse: [self utcOffset: self class localOffset]!

----- Method: DateAndTime>>asMonth (in category 'squeak protocol') -----
asMonth

	^ Month starting: self!

----- Method: DateAndTime>>asNanoSeconds (in category 'squeak protocol') -----
asNanoSeconds
	"Answer the number of nanoseconds since midnight"

	^ self asDuration asNanoSeconds!

----- Method: DateAndTime>>asSeconds (in category 'smalltalk-80') -----
asSeconds
	"Return the number of seconds since the Squeak epoch"
	^ (self - (self class epoch offset: offset)) asSeconds!

----- Method: DateAndTime>>asTime (in category 'squeak protocol') -----
asTime


	^ Time seconds: seconds nanoSeconds: nanos
!

----- Method: DateAndTime>>asTimeStamp (in category 'squeak protocol') -----
asTimeStamp

	^ self as: TimeStamp!

----- Method: DateAndTime>>asUTC (in category 'ansi protocol') -----
asUTC

	^ self offset isZero
		ifTrue: [self]
		ifFalse: [self utcOffset: 0]
!

----- Method: DateAndTime>>asUnixTime (in category 'squeak protocol') -----
asUnixTime
	"answer number of seconds since unix epoch (midnight Jan 1, 1970, UTC)"

	^(self - self class unixEpoch) asSeconds!

----- Method: DateAndTime>>asWeek (in category 'squeak protocol') -----
asWeek

	^ Week starting: self!

----- Method: DateAndTime>>asYear (in category 'squeak protocol') -----
asYear

	^ Year starting: self!

----- Method: DateAndTime>>day (in category 'smalltalk-80') -----
day

	^ self dayOfYear
!

----- Method: DateAndTime>>dayMonthYearDo: (in category 'squeak protocol') -----
dayMonthYearDo: aBlock
	"Evaluation the block with three arguments: day month, year."

	| 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.

	^ aBlock
		value: dd
		value: mm
		value: yyyy!

----- Method: DateAndTime>>dayOfMonth (in category 'ansi protocol') -----
dayOfMonth
	"Answer which day of the month is represented by the receiver."

	^ self
		dayMonthYearDo: [ :d :m :y | d ]
!

----- Method: DateAndTime>>dayOfWeek (in category 'ansi protocol') -----
dayOfWeek

	"Sunday=1, ... , Saturday=7"

	^ (jdn + 1 rem: 7) + 1
!

----- Method: DateAndTime>>dayOfWeekAbbreviation (in category 'ansi protocol') -----
dayOfWeekAbbreviation

	^ self dayOfWeekName copyFrom: 1 to: 3
!

----- Method: DateAndTime>>dayOfWeekName (in category 'ansi protocol') -----
dayOfWeekName

	^ Week nameOfDay: self dayOfWeek!

----- Method: DateAndTime>>dayOfYear (in category 'ansi protocol') -----
dayOfYear
	"This code was contributed by Dan Ingalls. It is equivalent to the terser
		^ jdn - (Year year: self year) start julianDayNumber + 1 but much quicker."

	^ self dayMonthYearDo:
		[ :d :m :y |
			| monthStart |
			monthStart := #(1 32 60 91 121 152 182 213 244 274 305 335) at: m.
			(m > 2 and: [ Year isLeapYear: y ])
				ifTrue: [ monthStart + d ]
				ifFalse: [ monthStart + d - 1 ]]!

----- Method: DateAndTime>>daysInMonth (in category 'smalltalk-80') -----
daysInMonth
	"Answer the number of days in the month represented by the receiver."


	^ self asMonth daysInMonth!

----- Method: DateAndTime>>daysInYear (in category 'smalltalk-80') -----
daysInYear

	"Answer the number of days in the year represented by the receiver."

	^ self asYear daysInYear!

----- Method: DateAndTime>>daysLeftInYear (in category 'smalltalk-80') -----
daysLeftInYear
	"Answer the number of days in the year after the date of the receiver."

	^ self daysInYear - self dayOfYear!

----- Method: DateAndTime>>duration (in category 'squeak protocol') -----
duration

	^ Duration zero!

----- Method: DateAndTime>>firstDayOfMonth (in category 'smalltalk-80') -----
firstDayOfMonth

	^ self asMonth start day
!

----- Method: DateAndTime>>floor (in category 'squeak protocol') -----
floor
	"Answer a copy with magnitude rounded down to the nearest whole second"
	^self class basicNew
		ticks: (self ticks at: 3 put: 0; yourself)
		offset: offset.
!

----- Method: DateAndTime>>hasEqualTicks: (in category 'private') -----
hasEqualTicks: aDateAndTime
	
	^ (jdn = aDateAndTime julianDayNumber)
		and: [ (seconds = aDateAndTime secondsSinceMidnight)
			and: [ nanos = aDateAndTime nanoSecond ] ]

!

----- Method: DateAndTime>>hasSmallerTicksThan: (in category 'private') -----
hasSmallerTicksThan: aDateAndTime
	
	^ jdn < aDateAndTime julianDayNumber or:
		[ jdn > aDateAndTime julianDayNumber
			ifTrue: [ false ]
			ifFalse:
				[ seconds < aDateAndTime secondsSinceMidnight or:
					[ seconds > aDateAndTime secondsSinceMidnight
						ifTrue: [ false ]
						ifFalse: [ nanos < aDateAndTime nanoSecond ] ] ] ]!

----- Method: DateAndTime>>hash (in category 'ansi protocol') -----
hash
	| totalSeconds |
	totalSeconds := seconds - self offset asSeconds.
	^ ((totalSeconds // 86400 + jdn) hashMultiply bitXor: totalSeconds \\
86400) bitXor: nanos!

----- Method: DateAndTime>>hour (in category 'ansi protocol') -----
hour

	^ self hour24!

----- Method: DateAndTime>>hour12 (in category 'ansi protocol') -----
hour12
	"Answer an <integer> between 1 and 12, inclusive, representing the hour 
	of the day in the 12-hour clock of the local time of the receiver."
	^ self hour24 - 1 \\ 12 + 1
!

----- Method: DateAndTime>>hour24 (in category 'ansi protocol') -----
hour24


	^ (Duration seconds: seconds) hours!

----- Method: DateAndTime>>hours (in category 'smalltalk-80') -----
hours

	^ self hour
!

----- Method: DateAndTime>>isLeapYear (in category 'ansi protocol') -----
isLeapYear


	^ Year isLeapYear: self year
!

----- Method: DateAndTime>>julianDayNumber (in category 'squeak protocol') -----
julianDayNumber


	^ jdn!

----- Method: DateAndTime>>makeUTC (in category 'squeak protocol') -----
makeUTC
	"Make the receiver's timezone UTC."
	self primOffset: Duration zero!

----- Method: DateAndTime>>meridianAbbreviation (in category 'ansi protocol') -----
meridianAbbreviation

	^ self asTime meridianAbbreviation
!

----- Method: DateAndTime>>middleOf: (in category 'squeak protocol') -----
middleOf: aDuration
	"Return a Timespan where the receiver is the middle of the Duration"

	| duration |
	duration := aDuration asDuration.

	^ Timespan starting: (self - (duration / 2)) duration: duration
!

----- Method: DateAndTime>>midnight (in category 'squeak protocol') -----
midnight
	"Answer a DateAndTime starting at midnight of the same timezone offset as the receiver."
	^ self class basicNew
		setJdn: jdn
		seconds: 0
		nano: 0
		offset: offset!

----- Method: DateAndTime>>minute (in category 'ansi protocol') -----
minute


	^ (Duration seconds: seconds) minutes!

----- Method: DateAndTime>>minutes (in category 'smalltalk-80') -----
minutes

	^ self minute
!

----- Method: DateAndTime>>month (in category 'ansi protocol') -----
month

	^ self 
		dayMonthYearDo: [ :d :m :y | m ]
!

----- Method: DateAndTime>>monthAbbreviation (in category 'ansi protocol') -----
monthAbbreviation


	^ self monthName copyFrom: 1 to: 3!

----- Method: DateAndTime>>monthIndex (in category 'smalltalk-80') -----
monthIndex


	^ self month!

----- Method: DateAndTime>>monthName (in category 'ansi protocol') -----
monthName


	^ Month nameOfMonth: self month!

----- Method: DateAndTime>>nanoSecond (in category 'squeak protocol') -----
nanoSecond


	^ nanos!

----- Method: DateAndTime>>noTimezone (in category 'private') -----
noTimezone
	^offset == nil!

----- Method: DateAndTime>>noon (in category 'squeak protocol') -----
noon
	"Answer a DateAndTime starting at noon"

	^ self dayMonthYearDo: 
		[ :d :m :y | self class year: y month: m day: d hour: 12 minute: 0 second: 0 ]
!

----- Method: DateAndTime>>normalize:ticks:base: (in category 'private') -----
normalize: i ticks: ticks base: base

	| tick div quo rem |
	tick := ticks at: i.
	div := tick digitDiv: base neg: tick negative.
	quo := (div at: 1) normalize.
	rem := (div at: 2) normalize.
	rem < 0 ifTrue: [ quo := quo - 1. rem := base + rem ].
	ticks at: (i-1) put: ((ticks at: i-1) + quo).
	ticks at: i put: rem
!

----- Method: DateAndTime>>offset (in category 'ansi protocol') -----
offset

	^ offset ifNil: [Duration zero]!

----- Method: DateAndTime>>offset: (in category 'ansi protocol') -----
offset: anOffset

	"Answer a <DateAndTime> equivalent to the receiver but with its local time 
	being offset from UTC by offset."

	^ self class basicNew 
		ticks: self ticks offset: (anOffset ifNotNil: [anOffset asDuration]);
		yourself!

----- Method: DateAndTime>>primOffset: (in category 'private') -----
primOffset: aDuration
	offset := aDuration!

----- Method: DateAndTime>>printHMSOn: (in category 'squeak protocol') -----
printHMSOn: aStream
	"Print just hh:mm:ss"
	aStream
		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).
!

----- Method: DateAndTime>>printOn: (in category 'squeak protocol') -----
printOn: aStream
	"Print as per ISO 8601 sections 5.3.3 and 5.4.1.
	Prints either:
		'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)"

	^self printOn: aStream withLeadingSpace: false
!

----- Method: DateAndTime>>printOn:withLeadingSpace: (in category 'squeak protocol') -----
printOn: aStream withLeadingSpace: printLeadingSpaceToo
	"Print as per ISO 8601 sections 5.3.3 and 5.4.1.
	If printLeadingSpaceToo is false, prints either:
		'YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)
	If printLeadingSpaceToo is true, prints either:
		' YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for positive years) or '-YYYY-MM-DDThh:mm:ss.s+ZZ:zz:z' (for negative years)
	"

	self printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo.
	aStream nextPut: $T.
	self printHMSOn: aStream.
	self nanoSecond ~= 0 ifTrue:
		[ | z ps |
		ps := self nanoSecond printString padded: #left to: 9 with: $0.
		z := ps findLast: [ :c | c asciiValue > $0 asciiValue ].
		(z > 0) ifTrue: [aStream nextPut: $.].
		ps from: 1 to: z do: [ :c | aStream nextPut: c ] ].
	aStream
		nextPut: (self offset positive ifTrue: [$+] ifFalse: [$-]);
		nextPutAll: (self offset hours abs asString padded: #left to: 2 with: $0);
		nextPut: $:;
		nextPutAll: (self offset minutes abs asString padded: #left to: 2 with: $0).
	self offset seconds = 0 ifFalse:
		[ aStream
			nextPut: $:;
			nextPutAll: (self offset seconds abs truncated asString) ].
!

----- Method: DateAndTime>>printYMDOn: (in category 'squeak protocol') -----
printYMDOn: aStream
	"Print just YYYY-MM-DD part.
	If the year is negative, prints out '-YYYY-MM-DD'."

	^self printYMDOn: aStream withLeadingSpace: false.
!

----- Method: DateAndTime>>printYMDOn:withLeadingSpace: (in category 'squeak protocol') -----
printYMDOn: aStream withLeadingSpace: printLeadingSpaceToo
	"Print just the year, month, and day on aStream.

	If printLeadingSpaceToo is true, then print as:
		' YYYY-MM-DD' (if the year is positive) or '-YYYY-MM-DD' (if the year is negative)
	otherwise print as:
		'YYYY-MM-DD' or '-YYYY-MM-DD' "

	| year month day |
	self dayMonthYearDo: [ :d :m :y | year := y. month := m. day := d ].
	year negative
		ifTrue: [ aStream nextPut: $- ]
		ifFalse: [ printLeadingSpaceToo ifTrue: [ aStream space ]].
	aStream
		nextPutAll: (year abs asString padded: #left to: 4 with: $0);
		nextPut: $-;
		nextPutAll: (month asString padded: #left to: 2 with: $0);
		nextPut: $-;
		nextPutAll: (day asString padded: #left to: 2 with: $0)
!

----- Method: DateAndTime>>second (in category 'ansi protocol') -----
second


	^ (Duration seconds: seconds) seconds!

----- Method: DateAndTime>>seconds (in category 'smalltalk-80') -----
seconds

	^ self second
!

----- Method: DateAndTime>>secondsSinceMidnight (in category 'private') -----
secondsSinceMidnight

	^ seconds!

----- Method: DateAndTime>>setJdn:seconds:nano:offset: (in category 'squeak protocol') -----
setJdn: j seconds: s nano: n offset: o

jdn := j.
seconds := s.
nanos :=  n.
offset :=  o
!

----- Method: DateAndTime>>ticks (in category 'private') -----
ticks
	"Private - answer an array with our instance variables. Assumed to be UTC "

	^ Array with: jdn with: seconds with: nanos
!

----- Method: DateAndTime>>ticks:offset: (in category 'private') -----
ticks: ticks offset: utcOffset
	"ticks is {julianDayNumber. secondCount. nanoSeconds}"

	self normalize: 3 ticks: ticks base: NanosInSecond.
	self normalize: 2 ticks: ticks base: SecondsInDay.

	jdn	:= ticks at: 1.
	seconds	:= ticks at: 2.
	nanos := ticks at: 3.
	offset := utcOffset
!

----- Method: DateAndTime>>timeZoneAbbreviation (in category 'ansi protocol') -----
timeZoneAbbreviation

	^ self class localTimeZone abbreviation!

----- Method: DateAndTime>>timeZoneName (in category 'ansi protocol') -----
timeZoneName

	^ self class localTimeZone name!

----- Method: DateAndTime>>to: (in category 'squeak protocol') -----
to: anEnd
	"Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan"

	^ Timespan starting: self ending: (anEnd asDateAndTime)
!

----- Method: DateAndTime>>to:by: (in category 'squeak protocol') -----
to: anEnd by: aDuration
	"Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan"

	^ (Schedule starting: self ending: (anEnd asDateAndTime))
		schedule: (Array with: aDuration asDuration);
		yourself
!

----- Method: DateAndTime>>to:by:do: (in category 'squeak protocol') -----
to: anEnd by: aDuration do: aBlock
	"Answer a Timespan. anEnd conforms to protocol DateAndTime or protocol Timespan"

	^ (self to: anEnd by: aDuration) scheduleDo: aBlock!

----- Method: DateAndTime>>utcOffset: (in category 'squeak protocol') -----
utcOffset: anOffset

	"Answer a <DateAndTime> equivalent to the receiver but offset from UTC by anOffset"

	| equiv |
	equiv := self + (anOffset asDuration - self offset).
	^ equiv ticks: (equiv ticks) offset: anOffset asDuration; yourself!

----- Method: DateAndTime>>year (in category 'ansi protocol') -----
year
	^ self
		dayMonthYearDo: [ :d :m :y | y ]
!

DateAndTime subclass: #TimeStamp
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Chronology-Core'!

!TimeStamp commentStamp: '<historical>' prior: 0!
This represents a duration of 0 length that marks a particular point in time.!

----- Method: TimeStamp class>>current (in category 'squeak protocol') -----
current

	| ts ticks |
	ts := super now asTimeStamp.
	ticks := ts ticks.
	ticks at: 3 put: 0.
	ts ticks: ticks offset: ts offset.
	^ ts
!

----- Method: TimeStamp class>>now (in category 'ansi protocol') -----
now
	"Answer the current date and time as a TimeStamp."

	^self current!

----- Method: TimeStamp>>asDateAndTime (in category 'squeak protocol') -----
asDateAndTime
	"Answer the receiver as an instance of DateAndTime."

	^ DateAndTime new setJdn: jdn seconds: seconds nano: nanos offset: offset!

----- Method: TimeStamp>>asTimeStamp (in category 'squeak protocol') -----
asTimeStamp
	"Answer the receiver as an instance of TimeStamp."

	^ self!

----- Method: TimeStamp>>date (in category 'squeak protocol') -----
date
	"Answer the date of the receiver."

	^ self asDate!

----- Method: TimeStamp>>dateAndTime (in category 'squeak protocol') -----
dateAndTime
	"Answer a two element Array containing the receiver's date and time."

	^ Array with: self date with: self time!

----- Method: TimeStamp>>minusDays: (in category 'squeak protocol') -----
minusDays: anInteger
	"Answer a TimeStamp which is anInteger days before the receiver."

	^ self - (anInteger days)!

----- Method: TimeStamp>>minusSeconds: (in category 'squeak protocol') -----
minusSeconds: anInteger
	"Answer a TimeStamp which is anInteger number of seconds before the receiver."

	^ self - (anInteger seconds)!

----- Method: TimeStamp>>plusDays: (in category 'squeak protocol') -----
plusDays: anInteger
	"Answer a TimeStamp which is anInteger days after the receiver."

	^ self + (anInteger days)!

----- Method: TimeStamp>>plusSeconds: (in category 'squeak protocol') -----
plusSeconds: anInteger
	"Answer a TimeStamp which is anInteger number of seconds after the receiver."

	^ self + (anInteger seconds)!

----- Method: TimeStamp>>printOn: (in category 'squeak protocol') -----
printOn: aStream 
	"Print receiver's date and time on aStream."

	aStream 
		nextPutAll: self date printString;
		space;
		nextPutAll: self time printString.!

----- Method: TimeStamp>>storeOn: (in category 'squeak protocol') -----
storeOn: aStream 

	aStream 
		print: self printString;
		nextPutAll: ' asTimeStamp'!

----- Method: TimeStamp>>time (in category 'squeak protocol') -----
time
	"Answer the time of the receiver."

	^ self asTime!

Magnitude subclass: #Duration
	instanceVariableNames: 'nanos seconds'
	classVariableNames: ''
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!Duration commentStamp: 'dtl 7/11/2009 15:03' prior: 0!
I represent a duration of time. I have nanosecond precision!

----- Method: Duration class>>days: (in category 'squeak protocol') -----
days: aNumber

	^ self seconds: aNumber * SecondsInDay nanoSeconds: 0!

----- Method: Duration class>>days:hours:minutes:seconds: (in category 'ansi protocol') -----
days: days hours: hours minutes: minutes seconds: seconds

	^ self days: days hours: hours minutes: minutes seconds: seconds nanoSeconds: 0!

----- Method: Duration class>>days:hours:minutes:seconds:nanoSeconds: (in category 'squeak protocol') -----
days: days hours: hours minutes: minutes seconds: seconds nanoSeconds: nanos	

 	^self
		seconds: seconds
			+ (minutes * SecondsInMinute) 
			+ (hours * SecondsInHour)
			+ (days * SecondsInDay)
		nanoSeconds: nanos
!

----- Method: Duration class>>days:seconds: (in category 'ansi protocol') -----
days: days seconds: seconds

	^ self basicNew seconds: days * SecondsInDay + seconds nanoSeconds: 0
!

----- Method: Duration class>>fromString: (in category 'squeak protocol') -----
fromString: aString

	^ self readFrom: (ReadStream on: aString)
!

----- Method: Duration class>>hours: (in category 'squeak protocol') -----
hours: aNumber

	^ self seconds: aNumber * SecondsInHour nanoSeconds: 0!

----- Method: Duration class>>initialize (in category 'initialize-release') -----
initialize
	ChronologyConstants classPool
		at: #Zero
		put:
			(self basicNew
				seconds: 0
				nanoSeconds: 0) ;
		at: #OneDay
		put: 1 day!

----- Method: Duration class>>milliSeconds: (in category 'squeak protocol') -----
milliSeconds: milliCount 
	
	^self
		seconds: (milliCount quo: 1000)
		nanoSeconds: (milliCount rem: 1000) * NanosInMillisecond!

----- Method: Duration class>>minutes: (in category 'squeak protocol') -----
minutes: aNumber

	^ self seconds: aNumber * SecondsInMinute nanoSeconds: 0!

----- Method: Duration class>>month: (in category 'squeak protocol') -----
month: aMonth
	"aMonth is an Integer or a String"
	
	^ (Month month: aMonth year: Year current year) duration
!

----- Method: Duration class>>nanoSeconds: (in category 'squeak protocol') -----
nanoSeconds: nanos
	"This method is slow. If you have nanos less than 10^6 you should use #seconds:nanoSeconds: instead."

	| quo |
	quo := nanos quo: NanosInSecond.
	^ self basicNew
		seconds: quo
		nanoSeconds: nanos - (quo * NanosInSecond)
!

----- Method: Duration class>>oneDay (in category 'squeak protocol') -----
oneDay
	"Answer the canonicalized Duration representing length of 1 day.  Used by Dates."
	^ OneDay!

----- Method: Duration class>>readFrom: (in category 'squeak protocol') -----
readFrom: aStream
	"Formatted as per ANSI 5.8.2.16: [-]D:HH:MM:SS[.S]"

	| sign days hours minutes seconds nanos nanosBuffer |
	sign := (aStream peekFor: $-) ifTrue: [-1] ifFalse: [1].
	days := (aStream upTo: $:) asInteger sign: sign.
	hours := (aStream upTo: $:) asInteger sign: sign.
	minutes := (aStream upTo: $:) asInteger sign: sign.
	seconds := (aStream upTo: $.) asInteger sign: sign.
	nanosBuffer := '000000000' copy.
	nanos := WriteStream on: nanosBuffer.
	[aStream atEnd not and: [aStream peek isDigit]]
		whileTrue: [nanos nextPut: aStream next].
		
	^ self 
		days: days 
		hours: hours 
		minutes: minutes 
		seconds: seconds 
		nanoSeconds: (nanosBuffer asInteger sign: sign)

	"	'0:00:00:00' asDuration
		'0:00:00:00.000000001' asDuration
		'0:00:00:00.999999999' asDuration
		'0:00:00:00.100000000' asDuration
		'0:00:00:00.001 ' asDuration
		'0:00:00:00.1' asDuration
		'0:00:00:01 ' asDuration
		'0:12:45:45' asDuration
		'1:00:00:00' asDuration
		'365:00:00:00' asDuration
		'-7:09:12:06.10' asDuration
		'+0:01:02:3' asDuration
 	"!

----- Method: Duration class>>seconds: (in category 'ansi protocol') -----
seconds: seconds

	^ self seconds: seconds nanoSeconds: 0
!

----- Method: Duration class>>seconds:nanoSeconds: (in category 'squeak protocol') -----
seconds: seconds nanoSeconds: nanos

	^ self basicNew
		seconds: seconds truncated
		nanoSeconds: seconds fractionPart * NanosInSecond + nanos!

----- Method: Duration class>>weeks: (in category 'squeak protocol') -----
weeks: aNumber

	^ self days: (aNumber * 7) seconds: 0
!

----- Method: Duration class>>zero (in category 'ansi protocol') -----
zero
	"Answer the canonicalized instance of Duration zero."
	^ Zero!

----- Method: Duration>>* (in category 'ansi protocol') -----
* operand
	"operand is a Number" 	^ self class nanoSeconds: ( (self asNanoSeconds * operand) asInteger)
!

----- Method: Duration>>+ (in category 'ansi protocol') -----
+ operand

	"operand is a Duration" 	^ self class nanoSeconds: (self asNanoSeconds + operand asNanoSeconds)!

----- Method: Duration>>- (in category 'ansi protocol') -----
- operand
	"operand is a Duration" 	^ self + operand negated!

----- Method: Duration>>/ (in category 'ansi protocol') -----
/ operand

	"operand is a Duration or a Number"


	^ operand isNumber
		ifTrue: [ self class nanoSeconds: (self asNanoSeconds / operand) asInteger ]
		ifFalse: [ self asNanoSeconds / operand asDuration asNanoSeconds ]
!

----- Method: Duration>>// (in category 'squeak protocol') -----
// operand

	"operand is a Duration or a Number"


	^ operand isNumber
		ifTrue: [ self class nanoSeconds: (self asNanoSeconds // operand) asInteger ]
		ifFalse: [ self asNanoSeconds // operand asDuration asNanoSeconds ]!

----- Method: Duration>>< (in category 'ansi protocol') -----
< comparand

	^ self asNanoSeconds < comparand asNanoSeconds!

----- Method: Duration>>= (in category 'ansi protocol') -----
= comparand 
	"Answer whether the argument is a <Duration> representing the same 
	period of time as the receiver."

	^ self == comparand
		ifTrue: [true]
		ifFalse: 
			[self species = comparand species 
				ifTrue: [self asNanoSeconds = comparand asNanoSeconds]
				ifFalse: [false] ]
!

----- Method: Duration>>\\ (in category 'squeak protocol') -----
\\ operand

	"modulo. Remainder defined in terms of //. Answer a Duration with the 
	same sign as aDuration. operand is a Duration or a Number."

	^ operand isNumber
		ifTrue: [ self class nanoSeconds: (self asNanoSeconds \\ operand) ]
		ifFalse: [ self - (operand * (self // operand)) ]!

----- Method: Duration>>abs (in category 'ansi protocol') -----
abs

	^ self class seconds: seconds abs nanoSeconds: nanos abs!

----- Method: Duration>>ago (in category 'squeak protocol') -----
ago
	"Answer the DateAndTime which was the receiver's duration ago.
	e.g., 5 minutes ago.  2 days ago."
	^ DateAndTime now - self!

----- Method: Duration>>asDelay (in category 'squeak protocol') -----
asDelay

	^ Delay forDuration: self
!

----- Method: Duration>>asDuration (in category 'ansi protocol') -----
asDuration

	^ self!

----- Method: Duration>>asMilliSeconds (in category 'squeak protocol') -----
asMilliSeconds

	nanos = 0 ifTrue: [ ^seconds * 1000 ].
	^nanos // 1000000 + (seconds * 1000)!

----- Method: Duration>>asNanoSeconds (in category 'squeak protocol') -----
asNanoSeconds

	^seconds * NanosInSecond + nanos!

----- Method: Duration>>asSeconds (in category 'ansi protocol') -----
asSeconds


	^ seconds!

----- Method: Duration>>days (in category 'ansi protocol') -----
days
	"Answer the number of days the receiver represents."

	^ seconds quo: SecondsInDay
!

----- Method: Duration>>fromNow (in category 'squeak protocol') -----
fromNow
	"Answer the DateAndTime which which occurs the receiver's duration from now.
	e.g., 5 minutes fromNow.  2 days fromNow."
	^ DateAndTime now + self!

----- Method: Duration>>hash (in category 'ansi protocol') -----
hash

 	^seconds bitXor: nanos!

----- Method: Duration>>hours (in category 'ansi protocol') -----
hours
	"Answer the number of hours the receiver represents."


	^ (seconds rem: SecondsInDay) quo: SecondsInHour!

----- Method: Duration>>initialize (in category 'initialize-release') -----
initialize
	self seconds: 0 nanoSeconds: 0.
!

----- Method: Duration>>isZero (in category 'squeak protocol') -----
isZero

	^ seconds = 0 and: [ nanos = 0 ]
!

----- Method: Duration>>minutes (in category 'ansi protocol') -----
minutes

	"Answer the number of minutes the receiver represents."


	^ (seconds rem: SecondsInHour) quo: SecondsInMinute!

----- Method: Duration>>nanoSeconds (in category 'squeak protocol') -----
nanoSeconds


	^ nanos!

----- Method: Duration>>negated (in category 'ansi protocol') -----
negated

	^ self class seconds: seconds negated nanoSeconds: nanos negated!

----- Method: Duration>>negative (in category 'ansi protocol') -----
negative


	^ self positive not!

----- Method: Duration>>positive (in category 'ansi protocol') -----
positive


	^ seconds = 0 ifTrue: [ nanos positive ] ifFalse: [ seconds positive ]!

----- Method: Duration>>printOn: (in category 'squeak protocol') -----
printOn: aStream
	"Format as per ANSI 5.8.2.16: [-]D:HH:MM:SS[.S]" 	| d h m s n |
	d := self days abs.
	h := self hours abs.
	m := self minutes abs.
 	s := self seconds abs truncated.
	n := self nanoSeconds abs. 	self negative ifTrue: [ aStream nextPut: $- ].
	d printOn: aStream. aStream nextPut: $:.
	h < 10 ifTrue: [ aStream nextPut: $0. ].
	h printOn: aStream. aStream nextPut: $:.
	m < 10 ifTrue: [ aStream nextPut: $0. ].
	m printOn: aStream. aStream nextPut: $:.
	s < 10 ifTrue: [ aStream nextPut: $0. ].
	s printOn: aStream.
	n = 0 ifFalse:
		[ | z ps |
		aStream nextPut: $..
		ps := n printString padded: #left to: 9 with: $0. 
		z := ps findLast: [ :c | c asciiValue > $0 asciiValue ].
		ps from: 1 to: z do: [ :c | aStream nextPut: c ] ]
!

----- Method: Duration>>roundTo: (in category 'squeak protocol') -----
roundTo: aDuration
	"e.g. if the receiver is 5 minutes, 37 seconds, and aDuration is 2 minutes, answer 6 minutes."

	^ self class nanoSeconds: (self asNanoSeconds roundTo: aDuration asNanoSeconds)
!

----- Method: Duration>>seconds (in category 'ansi protocol') -----
seconds
	"Answer the number of seconds the receiver represents."

	^seconds rem: SecondsInMinute!

----- Method: Duration>>seconds:nanoSeconds: (in category 'private') -----
seconds: secondCount nanoSeconds: nanoCount 
	"Private - only used by Duration class"

	seconds := secondCount.
	nanos := nanoCount rounded.
	"normalize if signs do not match"
	[ nanos < 0 and: [ seconds > 0 ] ]
		whileTrue: [ seconds := seconds - 1.
			nanos := nanos + NanosInSecond ].
	[ seconds < 0 and: [ nanos > 0 ] ]
		whileTrue: [ seconds := seconds + 1.
			nanos := nanos - NanosInSecond ]

!

----- Method: Duration>>storeOn: (in category 'private') -----
storeOn: aStream

	aStream
		nextPut: $(;
		nextPutAll: self className;
		nextPutAll: ' seconds: ';
		print: seconds;
		nextPutAll: ' nanoSeconds: ';
		print: nanos;
		nextPut: $)
!

----- Method: Duration>>ticks (in category 'private') -----
ticks
	"Answer an array {days. seconds. nanoSeconds}. Used by DateAndTime and Time."

	| days |
	days := self days.
	^ Array 
		with: days
		with: seconds - (days * SecondsInDay)
		with: nanos
!

----- Method: Duration>>truncateTo: (in category 'squeak protocol') -----
truncateTo: aDuration
	"e.g. if the receiver is 5 minutes, 37 seconds, and aDuration is 2 minutes, answer 4 minutes."

	^ self class
		nanoSeconds: (self asNanoSeconds truncateTo: aDuration asNanoSeconds)
!

Timespan subclass: #Month
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!Month commentStamp: 'cbr 7/28/2010 18:11' prior: 0!
I represent a month.

For example, to get the number of days this month, you can evaluate the following expression:

Month current daysInMonth!

----- Method: Month class>>daysInMonth:forYear: (in category 'smalltalk-80') -----
daysInMonth: indexOrName forYear: yearInteger 

	| index |
	index := indexOrName isInteger 
				ifTrue: [indexOrName]
				ifFalse: [self indexOfMonth: indexOrName].
	^ (DaysInMonth at: index)
			+ ((index = 2
					and: [Year isLeapYear: yearInteger])
						ifTrue: [1] ifFalse: [0])
!

----- Method: Month class>>indexOfMonth: (in category 'smalltalk-80') -----
indexOfMonth: aMonthName


	1 to: 12 do: [ :i |  (aMonthName, '*' match: (MonthNames at: i)) ifTrue: [^i] ].
	self error: aMonthName , ' is not a recognized month name'.!

----- Method: Month class>>month:year: (in category 'squeak protocol') -----
month: month year: year 
	"Create a Month for the given <year> and <month>.
	<month> may be a number or a String with the
	name of the month. <year> should be with 4 digits."
	^ self starting:
		(DateAndTime
			year: year
			month: month
			day: 1
			hour: 0
			minute: 0
			second: 0
			offset: self defaultOffset)!

----- Method: Month class>>nameOfMonth: (in category 'smalltalk-80') -----
nameOfMonth: anIndex

	^ MonthNames at: anIndex.!

----- Method: Month class>>readFrom: (in category 'squeak protocol') -----
readFrom: aStream
	| m y |
	aStream skipSeparators.
	m := aStream upToAnyOf: CharacterSet separators.
	aStream skipSeparators.
	y := aStream upToEnd.
	^ self 
		month: m
		year: y asInteger

"Month readFrom: 'July 1998' readStream"!

----- Method: Month class>>starting:duration: (in category 'squeak protocol') -----
starting: aDateAndTime duration: aDuration 
	"Override - a each month has a defined duration"
	| start adjusted days |
	start := aDateAndTime asDateAndTime.
	adjusted := DateAndTime
		year: start year
		month: start month
		day: 1
		hour: 0
		minute: 0
		second: 0
		offset: start offset.
	days := self
		daysInMonth: adjusted month
		forYear: adjusted year.
	^ super
		starting: adjusted
		duration: (Duration days: days)!

----- Method: Month>>asMonth (in category 'squeak protocol') -----
asMonth

	^ self!

----- Method: Month>>daysInMonth (in category 'squeak protocol') -----
daysInMonth

	^ self duration days.!

----- Method: Month>>index (in category 'squeak protocol') -----
index

	^ self monthIndex!

----- Method: Month>>name (in category 'squeak protocol') -----
name


	^ self monthName!

----- Method: Month>>previous (in category 'squeak protocol') -----
previous


	^ self class starting: (self start - 1)!

----- Method: Month>>printOn: (in category 'squeak protocol') -----
printOn: aStream


	aStream nextPutAll: self monthName, ' ', self year printString!

Magnitude subclass: #Time
	instanceVariableNames: 'seconds nanos'
	classVariableNames: ''
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!Time commentStamp: 'dew 10/23/2004 17:58' prior: 0!
This represents a particular point in time during any given day.  For example, '5:19:45 pm'.

If you need a point in time on a particular day, use DateAndTime.  If you need a duration of time, use Duration.
!

----- Method: Time class>>benchmarkMillisecondClock (in category 'benchmarks') -----
benchmarkMillisecondClock		"Time benchmarkMillisecondClock"

	"Benchmark the time spent in a call to Time>>millisecondClockValue.

	On the VM level this tests the efficiency of calls to ioMSecs()."

	"PII/400 Windows 98: 0.725 microseconds per call"

	| temp1 temp2 temp3 delayTime nLoops time |

	delayTime := 5000. "Time to run benchmark is approx. 2*delayTime"



	"Don't run the benchmark if we have an active delay since

	we will measure the additional penalty in the primitive dispatch

	mechanism (see #benchmarkPrimitiveResponseDelay)."

	Delay anyActive ifTrue:[

		^self notify:'Some delay is currently active.

Running this benchmark will not give any useful result.'].



	"Flush the cache for this benchmark so we will have

	a clear cache hit for each send to #millisecondClockValue below"

	Object flushCache.

	temp1 := 0.

	temp2 := self. "e.g., temp1 == Time"

	temp3 := self millisecondClockValue + delayTime.



	"Now check how often we can run the following loop in the given time"

	[temp2 millisecondClockValue < temp3]

		whileTrue:[temp1 := temp1 + 1].



	nLoops := temp1. "Remember the loops we have run during delayTime"



	"Setup the second loop"

	temp1 := 0.

	temp3 := nLoops.



	"Now measure how much time we spend without sending #millisecondClockValue"

	time := Time millisecondClockValue.

	[temp1 < temp3]

		whileTrue:[temp1 := temp1 + 1].

	time := Time millisecondClockValue - time.



	"And compute the number of microseconds spent per call to #millisecondClockValue"

	^((delayTime - time * 1000.0 / nLoops) truncateTo: 0.001) printString,

		' microseconds per call to Time>>millisecondClockValue'
!

----- Method: Time class>>benchmarkPrimitiveResponseDelay (in category 'benchmarks') -----
benchmarkPrimitiveResponseDelay	"Time benchmarkPrimitiveResponseDelay"

	"Benchmark the overhead for primitive dispatches with an active Delay.

	On the VM level, this tests the efficiency of ioLowResMSecs."



	"PII/400 Windows98: 0.128 microseconds per prim"



	"ar 9/6/1999: This value is *extremely* important for stuff like sockets etc.

	I had a bad surprise when Michael pointed this particular problem out:

	Using the hardcoded clock() call for ioLowResMSecs on Win32 resulted in an overhead

	of 157.4 microseconds per primitive call - meaning you can't get no more than

	approx. 6000 primitives per second on my 400Mhz PII system with an active delay!!

	BTW, it finally explains why Squeak seemed soooo slow when running PWS or 

	other socket stuff. The new version (not using clock() but some Windows function) 

	looks a lot better (see above; approx. 8,000,000 prims per sec with an active delay)."



	| nLoops bb index baseTime actualTime delayTime |

	delayTime := 5000. "Time to run this test is approx. 3*delayTime"



	Delay anyActive ifTrue:[

		^self notify:'Some delay is currently active.

Running this benchmark will not give any useful result.'].



	bb := Array new: 1. "The object we send the prim message to"



	"Compute the # of loops we'll run in a decent amount of time"

	[(Delay forMilliseconds: delayTime) wait] 

		forkAt: Processor userInterruptPriority.



	nLoops := 0.

	[Delay anyActive] whileTrue:[

		bb basicSize; basicSize; basicSize; basicSize; basicSize; 

			basicSize; basicSize; basicSize; basicSize; basicSize.

		nLoops := nLoops + 1.

	].



	"Flush the cache and make sure #basicSize is in there"

	Object flushCache.

	bb basicSize.



	"Now run the loop without any active delay

	for getting an idea about its actual speed."

	baseTime := self millisecondClockValue.

	index := nLoops.

	[index > 0] whileTrue:[

		bb basicSize; basicSize; basicSize; basicSize; basicSize; 

			basicSize; basicSize; basicSize; basicSize; basicSize.

		index := index - 1.

	].

	baseTime := self millisecondClockValue - baseTime.



	"Setup the active delay but try to never make it active"

	[(Delay forMilliseconds: delayTime + delayTime) wait] 

		forkAt: Processor userInterruptPriority.



	"And run the loop"

	actualTime := self millisecondClockValue.

	index := nLoops.

	[index > 0] whileTrue:[

		bb basicSize; basicSize; basicSize; basicSize; basicSize; 

			basicSize; basicSize; basicSize; basicSize; basicSize.

		index := index - 1.

	].

	actualTime := self millisecondClockValue - actualTime.



	"And get us some result"

	^((actualTime - baseTime) * 1000 asFloat / (nLoops * 10) truncateTo: 0.001) printString,

		' microseconds overhead per primitive call'
!

----- Method: Time class>>condenseBunches: (in category 'general inquiries') -----
condenseBunches: aCollectionOfSeconds
	| secArray now out pause prev bunchEnd |
	"Identify the major intervals in a bunch of numbers.  
	Each number is a seconds since 1901 that represents a date and time.
	We want the last event in a bunch.  Return array of seconds for:
	
	Every event in the last half hour.
		Every bunch separated by 30 min in the last 24 hours.
	
	Every bunch separated by two hours before that."

	"Time condenseBunches: 
		(#(20 400 401  20000 20200 20300 40000 45000  200000 201000 202000) 
			collect: [ :tt | self totalSeconds - tt])
"

	secArray := aCollectionOfSeconds asSortedCollection.
	pause := 1.
	now := self totalSeconds.
	out := OrderedCollection new.
	prev := 0.
	bunchEnd := nil.
	secArray reverseDo: [:secs | | ago | "descending"
		ago := now - secs.
		ago > (60*30) ifTrue: [pause := "60*30" 1800].
		ago > (60*60*24) ifTrue: [pause := "60*120" 7200].
		ago - prev >= pause ifTrue: [out add: bunchEnd.  bunchEnd := secs].
		prev := ago].
	out add: bunchEnd.
	out removeFirst.
	^ out
!

----- Method: Time class>>current (in category 'squeak protocol') -----
current 

	^ self now!

----- Method: Time class>>dateAndTimeFromSeconds: (in category 'smalltalk-80') -----
dateAndTimeFromSeconds: secondCount

	^ Array
		with: (Date fromSeconds: secondCount)
		with: (Time fromSeconds: secondCount \\ 86400)!

----- Method: Time class>>dateAndTimeNow (in category 'smalltalk-80') -----
dateAndTimeNow
	"Answer a two-element Array of (Date today, Time now)."

	^ self dateAndTimeFromSeconds: self totalSeconds
!

----- Method: Time class>>eventMillisecondClock (in category 'clock') -----
eventMillisecondClock
	"In order to make certain event handling code work (cf MouseEvent>asMouseMove) we need access
	to the tick kept by ioMSecs() "
	"Time eventMillisecondClock"
	<primitive: 135>
	^0!

----- Method: Time class>>fromSeconds: (in category 'smalltalk-80') -----
fromSeconds: secondCount 
	"Answer an instance of me that is secondCount number of seconds since midnight."

	| integerSeconds nanos |
	integerSeconds := secondCount truncated.
	integerSeconds = secondCount
		ifTrue: [nanos := 0]
		ifFalse: [nanos := (secondCount - integerSeconds * NanosInSecond) asInteger].
	^ self seconds: integerSeconds nanoSeconds: nanos
!

----- Method: Time class>>hour:minute:second: (in category 'squeak protocol') -----
hour: hour minute: minute second: second
	"Answer a Time"

	^ self hour: hour minute: minute second: second nanoSecond: 0
!

----- Method: Time class>>hour:minute:second:nanoSecond: (in category 'squeak protocol') -----
hour: hour minute: minute second: second  nanoSecond: nanoCount
	"Answer a Time - only second precision for now"

	^ self 
		seconds: (hour * SecondsInHour) + (minute * SecondsInMinute) + second 
		nanoSeconds: nanoCount
!

----- Method: Time class>>humanWordsForSecondsAgo: (in category 'general inquiries') -----
humanWordsForSecondsAgo: secs
	| date today |
	"Return natural language for this date and time in the past."

	secs <= 1 ifTrue: [^ 'a second ago'].
	secs < 45 ifTrue: [^ secs printString, ' seconds ago'].
	secs < 90 ifTrue: [^ 'a minute ago'].
	secs < "45*60" 2700 ifTrue: [^ (secs//60) printString, ' minutes ago'].
	secs < "90*60" 5400 ifTrue: [^ 'an hour ago'].
	secs < "18*60*60" 64800 ifTrue: [^ (secs//3600) printString, ' hours ago'].
	date := Date fromSeconds: self totalSeconds - secs.		"now work with dates"
	today := Date today.
	date > (today subtractDays: 2) ifTrue: [^ 'yesterday'].
	date > (today subtractDays: 8) ifTrue: [^ 'last ', date dayOfWeekName].
	date > (today subtractDays: 13) ifTrue: [^ 'a week ago'].
	date > (today subtractDays: 28) ifTrue: [
		^ ((today subtractDate: date)//7) printString, ' weeks ago'].
	date > (today subtractDays: 45) ifTrue: [^ 'a month ago'].
	date > (today subtractDays: 300) ifTrue: [^ 'last ', date monthName].
	^ date monthName, ', ', date year printString

"Example
#(0.5 30 62 130 4000 10000 60000 90000 345600 864000 1728000 3456000 17280000 34560000 345600000) 
		collect: [:ss | Time humanWordsForSecondsAgo: ss].
"
!

----- Method: Time class>>localMicrosecondClock (in category 'clock') -----
localMicrosecondClock
	"Answer the local microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century).
	 The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds
	 between the two epochs according to RFC 868, and with an offset duration corresponding to the current
	 offset of local time from UTC."
	<primitive: 241>
	^0!

----- Method: Time class>>localMicrosecondClockWithOffset (in category 'clock') -----
localMicrosecondClockWithOffset
	"Answer an array with local microseconds since the Smalltalk epoch and the
	current seconds offset from GMT in the local time zone."

	| result |
	result := self primPosixMicrosecondClockWithOffset.
	"DateAndTime unixEpoch asSeconds"
	result at: 1 put: result first + ((2177452800 + result second) * 1000000).
	^result!

----- Method: Time class>>midnight (in category 'squeak protocol') -----
midnight

	^ self seconds: 0
!

----- Method: Time class>>milliSecondsSinceMidnight (in category 'ansi protocol') -----
milliSecondsSinceMidnight
	^self localMicrosecondClock // 1000 \\ 86400000 "24 * 60 * 60 * 1000"!

----- Method: Time class>>millisecondClockValue (in category 'general inquiries') -----
millisecondClockValue
	"Answer the value of the millisecond clock."

	^self localMicrosecondClock // 1000!

----- Method: Time class>>milliseconds:since: (in category 'squeak protocol') -----
milliseconds: currentTime since: lastTime
	"Answer the elapsed time since last recorded in milliseconds (i.e. of millisecondClockValue).
	 Since the time basis is now a 61-bit or greater UTC microsecond clock, rollover is no longer an issue."

	^currentTime - lastTime!

----- Method: Time class>>millisecondsSince: (in category 'squeak protocol') -----
millisecondsSince: lastTime
	"Answer the elapsed time since last recorded in milliseconds.
	Compensate for rollover."

	^self milliseconds: self millisecondClockValue since: lastTime
!

----- Method: Time class>>millisecondsToRun: (in category 'general inquiries') -----
millisecondsToRun: timedBlock 
	"Answer the number of milliseconds timedBlock takes to return its value."

	| startUsecs |
	startUsecs := self utcMicrosecondClock.
	timedBlock value.
	^self utcMicrosecondClock - startUsecs + 500 // 1000!

----- Method: Time class>>namesForTimes: (in category 'general inquiries') -----
namesForTimes: arrayOfSeconds
	| simpleEnglish final prev |
	"Return English descriptions of the times in the array.  They are each seconds since 1901.  If two names are the same, append the date and time to distinguish them."

	simpleEnglish := arrayOfSeconds collect: [:secsAgo |
		self humanWordsForSecondsAgo: self totalSeconds - secsAgo].
	prev := ''.
	final := simpleEnglish copy.
	simpleEnglish withIndexDo: [:eng :ind | | prevPair myPair | 
		eng = prev ifFalse: [eng]
			ifTrue: ["both say 'a month ago'"
				prevPair := self dateAndTimeFromSeconds: 
						(arrayOfSeconds at: ind-1).
				myPair := self dateAndTimeFromSeconds: 
						(arrayOfSeconds at: ind).
				(final at: ind-1) = prev ifTrue: ["only has 'a month ago'"
					final at: ind-1 put: 
							(final at: ind-1), ', ', prevPair first mmddyyyy].
				final at: ind put: 
							(final at: ind), ', ', myPair first mmddyyyy.
				prevPair first = myPair first 
					ifTrue: [
						(final at: ind-1) last == $m ifFalse: ["date but no time"
							final at: ind-1 put: 
								(final at: ind-1), ', ', prevPair second printMinutes].
						final at: ind put: 
							(final at: ind), ', ', myPair second printMinutes]].
		prev := eng].
	^ final
!

----- Method: Time class>>new (in category 'smalltalk-80') -----
new
	"Answer a Time representing midnight"

	^ self midnight!

----- Method: Time class>>noon (in category 'squeak protocol') -----
noon

	^ self seconds: (SecondsInDay / 2)
!

----- Method: Time class>>now (in category 'ansi protocol') -----
now
	"Answer a Time representing the time right now - this is a 24 hour clock."
	| localUsecs localUsecsToday |
	localUsecs := self localMicrosecondClock.
	localUsecsToday := localUsecs \\ MicrosecondsInDay.
	^ self
		seconds: localUsecsToday // 1000000
		nanoSeconds: localUsecsToday \\ 1000000 * 1000!

----- Method: Time class>>primPosixMicrosecondClockWithOffset (in category 'private') -----
primPosixMicrosecondClockWithOffset
	"Answer an array with UTC microseconds since the Posix epoch and the
	current seconds offset from GMT in the local time zone."

	<primitive: 'primitiveUtcWithOffset'>
	^{0. 0}!

----- Method: Time class>>readFrom: (in category 'smalltalk-80') -----
readFrom: aStream
	"Read a Time from the stream in the form:
		<hour>:<minute>:<second> <am/pm>

	<minute>, <second> or <am/pm> may be omitted.  e.g. 1:59:30 pm; 8AM; 15:30"

	| hour minute second ampm nanos nanosBuffer |
	hour := Integer readFrom: aStream.
	minute := 0.
	second := 0.
	nanosBuffer := '000000000' copy.
	nanos := WriteStream on: nanosBuffer.
	(aStream peekFor: $:) 
		ifTrue: [
			minute := Integer readFrom: aStream.
			(aStream peekFor: $:) 
				ifTrue: [
					second := Integer readFrom: aStream.
					(aStream peekFor: $.)
						ifTrue: [
							[aStream atEnd not and: [aStream peek isDigit]]
								whileTrue: [nanos nextPut: aStream next]]]].
	aStream skipSeparators.
	(aStream atEnd not and: ['PApa' includes: aStream peek]) ifTrue: 
		[ampm := aStream next asLowercase.
		(ampm = $p and: [hour < 12]) ifTrue: [hour := hour + 12].
		(ampm = $a and: [hour = 12]) ifTrue: [hour := 0].
		(aStream peekFor: $m) ifFalse: [aStream peekFor: $M ]].
	^ self 
		hour: hour 
		minute: minute 
		second: second 
		nanoSecond: nanosBuffer asInteger

	"Time readFrom: (ReadStream on: '2:23:09 pm')"!

----- Method: Time class>>seconds: (in category 'squeak protocol') -----
seconds: seconds
	"Answer a Time from midnight."

	^ self basicNew ticks: (Duration seconds: seconds) ticks!

----- Method: Time class>>seconds:nanoSeconds: (in category 'squeak protocol') -----
seconds: seconds nanoSeconds: nanoCount
	"Answer a Time from midnight."

	^ self basicNew
		ticks: (Duration seconds: seconds nanoSeconds: nanoCount) ticks
!

----- Method: Time class>>totalSeconds (in category 'smalltalk-80') -----
totalSeconds
	"Answer the total seconds since the Squeak epoch: 1 January 1901, in local time."

	^self localMicrosecondClock // 1000000!

----- Method: Time class>>utcMicrosecondClock (in category 'clock') -----
utcMicrosecondClock
	"Answer the UTC microseconds since the Smalltalk epoch (January 1st 1901, the start of the 20th century).
	 The value is derived from the Posix epoch with a constant offset corresponding to elapsed microseconds
	 between the two epochs according to RFC 868."
	<primitive: 240>
	^0!

----- Method: Time>>< (in category 'ansi protocol') -----
< aTime

	^ self asDuration < aTime asDuration!

----- Method: Time>>= (in category 'ansi protocol') -----
= aTime

	^ [ self ticks = aTime ticks ]
		on: MessageNotUnderstood do: [false]!

----- Method: Time>>addSeconds: (in category 'smalltalk-80') -----
addSeconds: nSeconds 
	"Answer a Time that is nSeconds after the receiver."

	^ self class seconds: self asSeconds + nSeconds!

----- Method: Time>>addTime: (in category 'smalltalk-80') -----
addTime: timeAmount
	"Answer a Time that is timeInterval after the receiver. timeInterval is an 
	instance of Date or Time."

	^ self class seconds: self asSeconds + timeAmount asSeconds
!

----- Method: Time>>asDate (in category 'squeak protocol') -----
asDate

	^ Date today!

----- Method: Time>>asDateAndTime (in category 'squeak protocol') -----
asDateAndTime

	^ DateAndTime today + self!

----- Method: Time>>asDuration (in category 'squeak protocol') -----
asDuration

	"Answer the duration since midnight"

	^ Duration seconds: seconds nanoSeconds: nanos!

----- Method: Time>>asMonth (in category 'squeak protocol') -----
asMonth

	^ self asDateAndTime asMonth!

----- Method: Time>>asNanoSeconds (in category 'squeak protocol') -----
asNanoSeconds
	"Answer the number of nanoseconds since midnight"

	^ self asDuration asNanoSeconds!

----- Method: Time>>asSeconds (in category 'smalltalk-80') -----
asSeconds
	"Answer the number of seconds since midnight of the receiver."

	^ seconds
!

----- Method: Time>>asTime (in category 'squeak protocol') -----
asTime

	^ self!

----- Method: Time>>asTimeStamp (in category 'squeak protocol') -----
asTimeStamp

	^ self asDateAndTime asTimeStamp!

----- Method: Time>>asWeek (in category 'squeak protocol') -----
asWeek

	^ self asDateAndTime asWeek!

----- Method: Time>>asYear (in category 'squeak protocol') -----
asYear

	^ self asDateAndTime asYear!

----- Method: Time>>duration (in category 'ansi protocol') -----
duration

	^ Duration zero!

----- Method: Time>>hash (in category 'ansi protocol') -----
hash

	^ self ticks hash!

----- Method: Time>>hhmm24 (in category 'printing') -----
hhmm24
	"Return a string of the form 1123 (for 11:23 am), 2154 (for 9:54 pm), of exactly 4 digits"

	^(String streamContents: 
		[ :aStream | self print24: true showSeconds: false on: aStream ])
			copyWithout: $:
!

----- Method: Time>>hour (in category 'ansi protocol') -----
hour

	^ self hour24!

----- Method: Time>>hour12 (in category 'ansi protocol') -----
hour12
	"Answer an <integer> between 1 and 12, inclusive, representing the hour 
	of the day in the 12-hour clock of the local time of the receiver."
	^ self hour24 - 1 \\ 12 + 1
!

----- Method: Time>>hour24 (in category 'ansi protocol') -----
hour24


	^ self asDuration hours!

----- Method: Time>>hours (in category 'smalltalk-80') -----
hours

	^ self hour!

----- Method: Time>>intervalString (in category 'smalltalk-80') -----
intervalString
	"Treat the time as a difference.  Give it in hours and minutes with two digits of accuracy."

	| d |
	d := self asDuration.
	^ String streamContents: [ :s |
		d hours > 0 ifTrue: [s print: d hours; nextPutAll: ' hours'].
		d minutes > 0 ifTrue: [s space; print: d minutes; nextPutAll: ' minutes'].
		d seconds > 0 ifTrue: [s space; print: d seconds; nextPutAll: ' seconds'] ]
!

----- Method: Time>>meridianAbbreviation (in category 'ansi protocol') -----
meridianAbbreviation

	^ self hour < 12 ifTrue: ['AM'] ifFalse: ['PM']
!

----- Method: Time>>minute (in category 'ansi protocol') -----
minute

	^ self asDuration minutes!

----- Method: Time>>minutes (in category 'smalltalk-80') -----
minutes

	^ self asDuration minutes!

----- Method: Time>>nanoSecond (in category 'squeak protocol') -----
nanoSecond


	^ nanos!

----- Method: Time>>print24 (in category 'printing') -----
print24
	"Return as 8-digit string 'hh:mm:ss', with leading zeros if needed"

	^String streamContents:
		[ :aStream | self print24: true on: aStream ]
!

----- Method: Time>>print24:on: (in category 'printing') -----
print24: hr24 on: aStream 
	"Format is 'hh:mm:ss' or 'h:mm:ss am' "

	self print24: hr24 showSeconds: true on: aStream!

----- Method: Time>>print24:showSeconds:on: (in category 'printing') -----
print24: hr24 showSeconds: showSeconds on: aStream 
	"Format is 'hh:mm:ss' or 'h:mm:ss am'  or, if showSeconds is false, 'hh:mm' or 'h:mm am'"

	| h m s |
	h := self hour. m := self minute. s := self second.
	hr24
		ifTrue: 
			[ h < 10 ifTrue: [ aStream nextPutAll: '0' ].
			h printOn: aStream ]
		ifFalse:
			[ h > 12
				ifTrue: [h - 12 printOn: aStream]
				ifFalse: 
					[h < 1
						ifTrue: [ 12 printOn: aStream ]
						ifFalse: [ h printOn: aStream ]]].

	aStream nextPutAll: (m < 10 ifTrue: [':0'] ifFalse: [':']).
	m printOn: aStream.

	showSeconds ifTrue:
		[ aStream nextPutAll: (s < 10 ifTrue: [':0'] ifFalse: [':']).
		self nanoSecond = 0
			ifTrue: [s asInteger printOn: aStream]
			ifFalse: [s asInteger * NanosInSecond + self nanoSecond asInteger 
				printOn: aStream asFixedPoint: NanosInSecond]].

	hr24 ifFalse:
		[ aStream nextPutAll: (h < 12 ifTrue: [' am'] ifFalse: [' pm']) ].
!

----- Method: Time>>printMinutes (in category 'printing') -----
printMinutes
	"Return as string 'hh:mm pm'  "

	^String streamContents:
		[ :aStream | self print24: false showSeconds: false on: aStream ]!

----- Method: Time>>printOn: (in category 'printing') -----
printOn: aStream 

	self print24: false
		showSeconds: (self seconds ~= 0
				or: [self nanoSecond ~= 0])
		on: aStream!

----- Method: Time>>second (in category 'ansi protocol') -----
second


	^ self asDuration seconds
!

----- Method: Time>>seconds (in category 'smalltalk-80') -----
seconds

	^ self second!

----- Method: Time>>seconds: (in category 'private') -----
seconds: secondCount
	"Private - only used by Time class."

	seconds := secondCount.
	nanos := 0
!

----- Method: Time>>seconds:nanoSeconds: (in category 'private') -----
seconds: secondCount nanoSeconds: nanoCount 
	"Private - only used by Time class."

	seconds := secondCount.
	nanos := nanoCount
!

----- Method: Time>>storeOn: (in category 'printing') -----
storeOn: aStream

	aStream print: self printString; nextPutAll: ' asTime'
!

----- Method: Time>>subtractTime: (in category 'smalltalk-80') -----
subtractTime: timeAmount 
	"Answer a Time that is timeInterval before the receiver. timeInterval is  
	an instance of Date or Time."

	^ self class seconds: self asSeconds - timeAmount asSeconds!

----- Method: Time>>ticks (in category 'private') -----
ticks
	"Answer an Array: { seconds. nanoSeconds }"

	^ Array with: 0 with: seconds with: nanos.!

----- Method: Time>>ticks: (in category 'private') -----
ticks: anArray
	"ticks is an Array: { days. seconds. nanoSeconds }"

	seconds := anArray at: 2.
	nanos := anArray at: 3
!

----- Method: Time>>to: (in category 'squeak protocol') -----
to: anEnd
	"Answer a Timespan. anEnd must respond to #asDateAndTime"

	^ self asDateAndTime to: anEnd!

Timespan subclass: #Week
	instanceVariableNames: ''
	classVariableNames: 'StartDay'
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!Week commentStamp: 'cbr 7/28/2010 18:11' prior: 0!
I represent a week.

To find out what days of the week on which Squeak is fun, select the following expression, and print it:

Week dayNames!

----- Method: Week class>>dayNames (in category 'squeak protocol') -----
dayNames

	^ DayNames!

----- Method: Week class>>indexOfDay: (in category 'squeak protocol') -----
indexOfDay: aSymbol

	^ DayNames indexOf: aSymbol!

----- Method: Week class>>nameOfDay: (in category 'smalltalk-80') -----
nameOfDay: anIndex

	^ DayNames at: anIndex!

----- Method: Week class>>startDay (in category 'squeak protocol') -----
startDay

	^ StartDay ifNil: [ StartDay
 := DayNames first ]
!

----- Method: Week class>>startDay: (in category 'squeak protocol') -----
startDay: aSymbol

	(DayNames includes: aSymbol)
		ifTrue: [ StartDay := aSymbol ]
		ifFalse: [ self error: aSymbol, ' is not a recognised day name' ]!

----- Method: Week class>>starting:duration: (in category 'squeak protocol') -----
starting: aDateAndTime duration: aDuration
	"Override - the duration is always one week.
	 Week will start from the Week class>>startDay"

	| midnight delta adjusted |
	midnight := aDateAndTime asDateAndTime midnight.
	delta := ((midnight dayOfWeek + 7 - (DayNames indexOf: self startDay)) rem: 7) abs.
	adjusted := midnight - (Duration days: delta seconds: 0).

	^ super starting: adjusted duration: (Duration weeks: 1)!

----- Method: Week>>asWeek (in category 'squeak protocol') -----
asWeek

	^ self!

----- Method: Week>>index (in category 'squeak protocol') -----
index

	^ self asMonth dayOfWeek + self dayOfMonth - 2  // 7 + 1
!

----- Method: Week>>printOn: (in category 'squeak protocol') -----
printOn: aStream

	aStream nextPutAll: 'a Week starting: '.
	self start printOn: aStream
!

Object subclass: #Stopwatch
	instanceVariableNames: 'timespans state'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Chronology-Core'!

!Stopwatch commentStamp: '<historical>' prior: 0!
A Stopwatch maintains a collection of timespans.!

----- Method: Stopwatch>>activate (in category 'squeak protocol') -----
activate

	self isSuspended ifTrue:
		[self timespans add: 
			(Timespan starting: DateAndTime now duration: Duration zero).
		self state: #active]
!

----- Method: Stopwatch>>duration (in category 'squeak protocol') -----
duration

	| ts last |
	self isSuspended 
		ifTrue:
			[ (ts := self timespans) isEmpty ifTrue: 
				[ ts := { Timespan starting: DateAndTime now duration: Duration zero } ] ]
		ifFalse:
			[ last := self timespans last.
			ts := self timespans allButLast
				add: (last duration: (DateAndTime now - last start); yourself);
				yourself ].
		
	^ (ts collect: [ :t | t duration ]) sum!

----- Method: Stopwatch>>end (in category 'squeak protocol') -----
end

	^ self timespans last next

!

----- Method: Stopwatch>>isActive (in category 'squeak protocol') -----
isActive

	^ self state = #active
!

----- Method: Stopwatch>>isSuspended (in category 'squeak protocol') -----
isSuspended

	^ self state = #suspended

!

----- Method: Stopwatch>>postCopy (in category 'copying') -----
postCopy
	super postCopy.
	timespans := timespans copy!

----- Method: Stopwatch>>printOn: (in category 'squeak protocol') -----
printOn: aStream

	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: self state;
		nextPut: $:;
		print: self duration;
		nextPut: $).

!

----- Method: Stopwatch>>reActivate (in category 'squeak protocol') -----
reActivate

	self 
		suspend;
		activate.
!

----- Method: Stopwatch>>reset (in category 'squeak protocol') -----
reset

	self suspend.
	timespans := nil
!

----- Method: Stopwatch>>start (in category 'squeak protocol') -----
start

	^ self timespans first start

!

----- Method: Stopwatch>>state (in category 'squeak protocol') -----
state

	^ state ifNil: [ state := #suspended ]!

----- Method: Stopwatch>>state: (in category 'squeak protocol') -----
state: aSymbol

	state := aSymbol!

----- Method: Stopwatch>>suspend (in category 'squeak protocol') -----
suspend

	| ts |
	self isActive ifTrue:
		[ ts := self timespans last.
		ts duration: (DateAndTime now - ts start).
		self state: #suspended]!

----- Method: Stopwatch>>timespans (in category 'squeak protocol') -----
timespans

	^ timespans ifNil: [ timespans := OrderedCollection new ]!

Object subclass: #TimeZone
	instanceVariableNames: 'offset abbreviation name'
	classVariableNames: ''
	poolDictionaries: 'ChronologyConstants'
	category: 'Chronology-Core'!

!TimeZone commentStamp: 'dtl 7/11/2009 15:03' prior: 0!
TimeZone is a simple class to colect the information identifying a UTC time zone.

offset			-	Duration	- the time zone's offset from UTC
abbreviation	-	String		- the abbreviated name for the time zone.
name			-	String		- the name of the time zone.

TimeZone class >> #timeZones returns an array of the known time zones
TimeZone class >> #default returns the default time zone (Grenwich Mean Time)
!

----- Method: TimeZone class>>default (in category 'accessing') -----
default
	"Answer the default time zone - GMT"

	^ self timeZones detect: [ :tz | tz offset = Duration zero ]!

----- Method: TimeZone class>>offset:name:abbreviation: (in category 'instance creation') -----
offset: aDuration name: aName abbreviation: anAbbreviation

	^ self new
		offset: aDuration;
		name: aName;
		abbreviation: anAbbreviation;
		yourself
!

----- Method: TimeZone class>>timeZones (in category 'accessing') -----
timeZones
	^{
		self offset:  0 hours name: 'Universal Time' abbreviation: 'UTC'.
		self offset:  0 hours name: 'Greenwich Mean Time' abbreviation: 'GMT'.
		self offset:  1 hours name: 'British Summer Time' abbreviation: 'BST'.
		self offset:  2 hours name: 'South African Standard Time' abbreviation: 'SAST'.
		self offset: -8 hours name: 'Pacific Standard Time' abbreviation: 'PST'.
		self offset: -7 hours name: 'Pacific Daylight Time' abbreviation: 'PDT'.
		self offset: -7 hours name: 'Mountain Standard Time' abbreviation: 'MST'.
		self offset: -6 hours name: 'Mountain Daylight Time' abbreviation: 'MDT'.
		self offset: -6 hours name: 'Central Standard Time' abbreviation: 'CST'.
		self offset: -5 hours name: 'Central Daylight Time' abbreviation: 'CDT'.
		self offset: -5 hours name: 'Eastern Standard Time' abbreviation: 'EST'.
		self offset: -4 hours name: 'Eastern Daylight Time' abbreviation: 'EDT'.
	}!

----- Method: TimeZone>>abbreviation (in category 'accessing') -----
abbreviation

	^ abbreviation!

----- Method: TimeZone>>abbreviation: (in category 'accessing') -----
abbreviation: aString

	abbreviation := aString!

----- Method: TimeZone>>name (in category 'accessing') -----
name

	^ name!

----- Method: TimeZone>>name: (in category 'accessing') -----
name: aString

	name := aString!

----- Method: TimeZone>>offset (in category 'accessing') -----
offset

	^ offset
!

----- Method: TimeZone>>offset: (in category 'accessing') -----
offset: aDuration

	offset := aDuration
!

----- Method: TimeZone>>printOn: (in category 'private') -----
printOn: aStream

	super printOn: aStream.
	aStream
		nextPut: $(;
		nextPutAll: self abbreviation;
		nextPut: $)!



More information about the Packages mailing list