| MIMEDocument class>>extendedMIMEdatabase: (bolot 9/9/1999 15:41 -> ASF 4/30/2005 17:14) |
extendedMIMEdatabase | d | (d _ self defaultMIMEdatabase) at: 'hqx' put: 'application/mac-binhex40'; at: 'cpt' put: 'application/mac-compactpro'; at: 'pdf' put: 'application/pdf'; at: 'ps' put: 'application/postscript'; at: 'ai' put: 'application/postscript'; at: 'eps' put: 'application/postscript'; at: 'rtf' put: 'text/rtf'; at: 'bin' put: 'application/octet-stream'; at: 'dms' put: 'application/octet-stream'; at: 'lha' put: 'application/octet-stream'; at: 'lzh' put: 'application/octet-stream'; at: 'exe' put: 'application/octet-stream'; at: 'class' put: 'application/octet-stream'; at: 'zip' put: 'application/zip'; at: 'gtar' put: 'application/x-gtar'; at: 'swf' put: 'application/x-shockwave-flash'; at: 'sit' put: 'application/x-stuffit'; at: 'tar' put: 'application/x-tar'; at: 'au' put: 'audio/basic'; at: 'snd' put: 'audio/basic'; at: 'mid' put: 'audio/midi'; at: 'midi' put: 'audio/midi'; at: 'mpga' put: 'audio/mpeg'; at: 'mp2' put: 'audio/mpeg'; at: 'mp3' put: 'audio/mpeg'; at: 'aiff' put: 'audio/x-aiff'; at: 'aif' put: 'audio/x-aiff'; at: 'aifc' put: 'audio/x-aiff'; at: 'rm' put: 'audio/x-pn-realaudio'; at: 'ram' put: 'audio/x-pn-realaudio'; at: 'rpm' put: 'audio/x-pn-realaudio-plugin'; at: 'ra' put: 'audio/x-realaudio'; at: 'wav' put: 'audio/x-wav'; at: 'css' put: 'text/css'; at: 'mpeg' put: 'video/mpeg'; at: 'mpg' put: 'video/mpeg'; at: 'mpe' put: 'video/mpeg'; at: 'qt' put: 'video/quicktime'; at: 'mov' put: 'video/quicktime'; at: 'avi' put: 'video/x-msvideo'; at: 'movie' put: 'video/x-sgi-movie'. ^d |
extendedMIMEdatabase | d | (d := self defaultMIMEdatabase) at: 'hqx' put: 'application/mac-binhex40'; at: 'cpt' put: 'application/mac-compactpro'; at: 'pdf' put: 'application/pdf'; at: 'ps' put: 'application/postscript'; at: 'ai' put: 'application/postscript'; at: 'eps' put: 'application/postscript'; at: 'rtf' put: 'text/rtf'; at: 'ics' put: 'text/calendar'; at: 'bin' put: 'application/octet-stream'; at: 'dms' put: 'application/octet-stream'; at: 'lha' put: 'application/octet-stream'; at: 'lzh' put: 'application/octet-stream'; at: 'exe' put: 'application/octet-stream'; at: 'class' put: 'application/octet-stream'; at: 'zip' put: 'application/zip'; at: 'gtar' put: 'application/x-gtar'; at: 'swf' put: 'application/x-shockwave-flash'; at: 'sit' put: 'application/x-stuffit'; at: 'tar' put: 'application/x-tar'; at: 'au' put: 'audio/basic'; at: 'snd' put: 'audio/basic'; at: 'mid' put: 'audio/midi'; at: 'midi' put: 'audio/midi'; at: 'mpga' put: 'audio/mpeg'; at: 'mp2' put: 'audio/mpeg'; at: 'mp3' put: 'audio/mpeg'; at: 'aiff' put: 'audio/x-aiff'; at: 'aif' put: 'audio/x-aiff'; at: 'aifc' put: 'audio/x-aiff'; at: 'rm' put: 'audio/x-pn-realaudio'; at: 'ram' put: 'audio/x-pn-realaudio'; at: 'rpm' put: 'audio/x-pn-realaudio-plugin'; at: 'ra' put: 'audio/x-realaudio'; at: 'wav' put: 'audio/x-wav'; at: 'css' put: 'text/css'; at: 'mpeg' put: 'video/mpeg'; at: 'mpg' put: 'video/mpeg'; at: 'mpe' put: 'video/mpeg'; at: 'qt' put: 'video/quicktime'; at: 'mov' put: 'video/quicktime'; at: 'avi' put: 'video/x-msvideo'; at: 'movie' put: 'video/x-sgi-movie'. ^ d |
extendedMIMEdatabase | d | (d := self defaultMIMEdatabase) at: 'hqx' put: 'application/mac-binhex40'; at: 'cpt' put: 'application/mac-compactpro'; at: 'pdf' put: 'application/pdf'; at: 'ps' put: 'application/postscript'; at: 'ai' put: 'application/postscript'; at: 'eps' put: 'application/postscript'; at: 'rtf' put: 'text/rtf'; at: 'ics' put: 'text/calendar'; at: 'bin' put: 'application/octet-stream'; at: 'dms' put: 'application/octet-stream'; at: 'lha' put: 'application/octet-stream'; at: 'lzh' put: 'application/octet-stream'; at: 'exe' put: 'application/octet-stream'; at: 'class' put: 'application/octet-stream'; at: 'zip' put: 'application/zip'; at: 'gtar' put: 'application/x-gtar'; at: 'swf' put: 'application/x-shockwave-flash'; at: 'sit' put: 'application/x-stuffit'; at: 'tar' put: 'application/x-tar'; at: 'au' put: 'audio/basic'; at: 'snd' put: 'audio/basic'; at: 'mid' put: 'audio/midi'; at: 'midi' put: 'audio/midi'; at: 'mpga' put: 'audio/mpeg'; at: 'mp2' put: 'audio/mpeg'; at: 'mp3' put: 'audio/mpeg'; at: 'aiff' put: 'audio/x-aiff'; at: 'aif' put: 'audio/x-aiff'; at: 'aifc' put: 'audio/x-aiff'; at: 'rm' put: 'audio/x-pn-realaudio'; at: 'ram' put: 'audio/x-pn-realaudio'; at: 'rpm' put: 'audio/x-pn-realaudio-plugin'; at: 'ra' put: 'audio/x-realaudio'; at: 'wav' put: 'audio/x-wav'; at: 'css' put: 'text/css'; at: 'mpeg' put: 'video/mpeg'; at: 'mpg' put: 'video/mpeg'; at: 'mpe' put: 'video/mpeg'; at: 'qt' put: 'video/quicktime'; at: 'mov' put: 'video/quicktime'; at: 'avi' put: 'video/x-msvideo'; at: 'movie' put: 'video/x-sgi-movie'. ^ d |
| FileUrl>>retrieveContents: (gk 2/10/2004 00:50 -> ASF 4/30/2005 16:37) |
retrieveContents
| file pathString s type entries |
pathString _ self pathForFile.
file _ [FileStream readOnlyFileNamed: pathString]
on: FileDoesNotExistException do:[:ex| ex return: nil].
file ifNotNil: [
type _ file mimeTypes.
type ifNotNil:[type _ type first].
type ifNil:[MIMEDocument guessTypeFromName: self path last].
^MIMELocalFileDocument
contentType: type
contentStream: file].
"see if it's a directory..."
entries _ [(FileDirectory on: pathString) entries]
on: InvalidDirectoryError do:[:ex| ex return: nil].
entries ifNil:[^nil].
s _ WriteStream on: String new.
(pathString endsWith: '/') ifFalse: [ pathString _ pathString, '/' ].
s nextPutAll: '<title>Directory Listing for ', pathString, '</title>'.
s nextPutAll: '<h1>Directory Listing for ', pathString, '</h1>'.
s nextPutAll: '<ul>'.
s cr.
entries do: [ :entry |
s nextPutAll: '<li><a href="'.
s nextPutAll: entry name.
s nextPutAll: '">'.
s nextPutAll: entry name.
s nextPutAll: '</a>'.
s cr. ].
s nextPutAll: '</ul>'.
^MIMEDocument contentType: 'text/html' content: s contents url: ('file://', pathString)
|
retrieveContents
| file pathString s type entries |
pathString _ self pathForFile.
file _ [FileStream readOnlyFileNamed: pathString]
on: FileDoesNotExistException do:[:ex| ex return: nil].
file ifNotNil: [
type _ file mimeTypes.
type ifNotNil:[type _ type first].
type ifNil:[type _ MIMEDocument guessTypeFromName: self path last].
^MIMELocalFileDocument
contentType: type
contentStream: file].
"see if it's a directory..."
entries _ [(FileDirectory on: pathString) entries]
on: InvalidDirectoryError do:[:ex| ex return: nil].
entries ifNil:[^nil].
s _ WriteStream on: String new.
(pathString endsWith: '/') ifFalse: [ pathString _ pathString, '/' ].
s nextPutAll: '<title>Directory Listing for ', pathString, '</title>'.
s nextPutAll: '<h1>Directory Listing for ', pathString, '</h1>'.
s nextPutAll: '<ul>'.
s cr.
entries do: [ :entry |
s nextPutAll: '<li><a href="'.
s nextPutAll: entry name.
s nextPutAll: '">'.
s nextPutAll: entry name.
s nextPutAll: '</a>'.
s cr. ].
s nextPutAll: '</ul>'.
^MIMEDocument contentType: 'text/html' content: s contents url: ('file://', pathString)
|
retrieveContents | file pathString s type entries | pathString _ self pathForFile. file _ [FileStream readOnlyFileNamed: pathString] on: FileDoesNotExistException do:[:ex| ex return: nil]. file ifNotNil: [ type _ file mimeTypes. type ifNotNil:[type _ type first]. type ifNil:[type _ MIMEDocument guessTypeFromName: self path last]. |
| BagTest>>testSortedCounts: (no stamp -> EP 2/28/2006 09:48) |
no previous history |
testSortedCounts "self run: #testSortedCounts" "self debug: #testSortedCounts" | bag sortedCounts| bag := Bag new. bag add: '1' withOccurrences: 10. bag add: '2' withOccurrences: 1. bag add: '3' withOccurrences: 5. sortedCounts := bag sortedCounts. self assert: sortedCounts size = 3. self assert: sortedCounts first = (10->'1'). self assert: sortedCounts second = (5->'3'). self assert: sortedCounts third = (1->'2'). |
| BagTest>>testCreation: (no stamp -> EP 2/28/2006 09:56) |
no previous history |
testCreation "self run: #testCreation" "self debug: #testCreation" | bag | bag := Bag new. self assert: (bag size) = 0. self assert: (bag isEmpty). |
| BagTest>>testCumulativeCounts: (no stamp -> EP 2/28/2006 10:05) |
no previous history |
testCumulativeCounts "self run: #testCumulativeCounts" "self debug: #testCumulativeCounts" | bag cumulativeCounts | bag := Bag new. bag add: '1' withOccurrences: 50. bag add: '2' withOccurrences: 40. bag add: '3' withOccurrences: 10. cumulativeCounts := bag cumulativeCounts. self assert: cumulativeCounts size = 3. self assert: cumulativeCounts first = (50 -> '1'). self assert: cumulativeCounts second = (90 -> '2'). self assert: cumulativeCounts third = (100 -> '3'). |
| BagTest>>testEqual: (no stamp -> EP 3/8/2006 08:39) |
no previous history |
testEqual "(self run: #testEqual)" "(self debug: #testEqual)" | bag1 bag2 | bag1 := Bag new. bag2 := Bag new. self assert: bag1 = bag2. bag1 add: #a; add: #b. bag2 add: #a; add: #a. self deny: bag1 = bag2. self assert: bag1 = bag1. bag1 add: #a. bag2 add: #b. self assert: bag1 = bag2. bag1 add: #c. self deny: bag1 = bag2. bag2 add: #c. self assert: bag1 = bag2 |
| BagTest>>testRemove: (no stamp -> EP 2/28/2006 09:57) |
no previous history |
testRemove "self run: #testRemove" "self debug: #testRemove" | bag item | item := 'test item'. bag := Bag new. bag add: item. self assert: (bag size) = 1. bag remove: item. self assert: bag isEmpty. bag add: item withOccurrences: 2. bag remove: item. bag remove: item. self assert: (bag size) = 0. self should: [bag remove: item.] raise: Error. |
| BagTest>>testSortedElements: (no stamp -> EP 2/28/2006 09:48) |
no previous history |
testSortedElements
"self run: #testSortedElements"
"self debug: #testSortedElements"
| bag sortedElements|
bag := Bag new.
bag add: '2' withOccurrences: 1.
bag add: '1' withOccurrences: 10.
bag add: '3' withOccurrences: 5.
sortedElements := bag sortedElements.
self assert: sortedElements size = 3.
self assert: sortedElements first = ('1'->10).
self assert: sortedElements second = ('2'->1).
self assert: sortedElements third = ('3'->5).
|
| IdentityBagTest>>testIdentity: (no stamp -> EP 3/8/2006 09:50) |
no previous history |
testIdentity "self run:#testIdentity" "self debug:#testIdentity" | bag identityBag aString anOtherString | aString := 'hello'. anOtherString := aString copy. self assert: (aString = anOtherString). self assert: (aString == anOtherString) not. bag := Bag new. bag add: aString. bag add: aString. bag add: anOtherString. self assert: (bag occurrencesOf: aString) = 3. self assert: (bag occurrencesOf: anOtherString) = 3. identityBag := IdentityBag new. identityBag add: aString. identityBag add: aString. identityBag add: anOtherString. self assert: (identityBag occurrencesOf: aString) = 2. self assert: (identityBag occurrencesOf: anOtherString) = 1. |
| HttpUrl>>retrieveContentsArgs:: (mir 7/26/2000 12:56 -> EW 4/30/2006 12:00) |
retrieveContentsArgs: args ^self retrieveContentsArgs: args accept: 'application/octet-stream' |
retrieveContentsArgs: args ^self retrieveContentsArgs: args accept: '*/*; q=1' |
retrieveContentsArgs: args ^self retrieveContentsArgs: args accept: '*/*; q=1' |
| SetTest>>testAdd: (no stamp -> GL 2/28/2006 08:26) |
no previous history |
testAdd empty add: 5. self assert: (empty includes: 5). |
| SetTest>>testDo: (no stamp -> GL 3/8/2006 09:23) |
no previous history |
testDo | newFull result | newFull := Set withAll: (1 to: 5). result := 0. newFull do: [:each | result := (result + each)]. self assert: (result = 15). |
| SetTest>>setUp: (md 4/16/2003 15:03 -> GL 2/27/2006 21:30) |
setUp "I am the method in which your test is initialized. If you have ressources to build, put them here." |
setUp empty := Set new. full := Set with: 5 with: #abc |
setUp empty := Set new. full := Set with: 5 with: #abc |
| SetTest>>testCollect: (no stamp -> GL 3/8/2006 09:09) |
no previous history |
testCollect | newFull result | newFull := Set withAll: (1 to: 10). result := newFull collect: [:each | each >= 1 ifTrue: [each] ifFalse: ['no']]. self assert: (result = newFull). result := newFull collect: [:each | each >= 5 ifTrue: [each] ifFalse: ['no']]. self assert: (result = ((Set withAll: (5 to: 10)) add: 'no'; yourself)). |
| SetTest>>testRemoveIfAbsent: (no stamp -> GL 3/8/2006 08:27) |
no previous history |
testRemoveIfAbsent | result1 result2 | result1 := true. result2 := true. full remove: 8 ifAbsent: [ result1 := false ]. self assert: (result1 = false). full remove: 5 ifAbsent: [ result2 := false ]. self assert: (result2 = true). |
| SetTest>>testRemove: (no stamp -> GL 3/8/2006 08:20) |
no previous history |
testRemove full remove: 5. self assert: (full includes: #abc). self deny: (full includes: 5). |
| SetTest>>testIntersection: (no stamp -> GL 3/8/2006 09:55) |
no previous history |
testIntersection | newFull col | full add: 3; add: 2. col := full intersection: full. self assert: (full = col). newFull := Set with: 8 with: 9 with: #z. col := newFull intersection: full. self assert: (col isEmpty). newFull add: 5; add: #abc; add: 7. col := newFull intersection: full. self assert: ((full select: [:each | (newFull includes: each)]) = col). |
| SetTest>>testCopyWithout: (no stamp -> GL 3/8/2006 00:06) |
no previous history |
testCopyWithout | newFull | full add: 3. full add: 2. newFull := full copyWithout: 3. self assert: (newFull size = (full size - 1)). self deny: (newFull includes: 3). self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty). self assert: ((full select: [:each | (newFull includes: each) not]) = (Set with: 3)). |
| SetTest>>testIllegal: (no stamp -> GL 2/28/2006 08:23) |
no previous history |
testIllegal self should: [empty at: 5] raise: TestResult error. self should: [empty at: 5 put: #abc] raise: TestResult error. |
| SetTest>>testSize: (no stamp -> GL 2/28/2006 09:51) |
no previous history |
testSize self assert: (empty size = 0). self assert: (full size = 2). empty add: 2. empty add: 1. full add: 2. self assert: (empty size = 2). self assert: (full size = 3). empty remove: 2. self assert: (empty size = 1). |
| SetTest>>testCopy: (no stamp -> GL 2/28/2006 09:46) |
no previous history |
testCopy | newFull | full add: 3. full add: 2. newFull := full copy. self assert: (full size = newFull size). self assert: ((full select: [:each | (newFull includes: each) not]) isEmpty). self assert: ((newFull select: [:each | (full includes: each) not]) isEmpty). |
| SetTest>>testGrow: (no stamp -> GL 2/28/2006 08:27) |
no previous history |
testGrow empty addAll: (1 to: 100). self assert: (empty size = 100). |
| SetTest>>testAtRandom: (no stamp -> GL 2/28/2006 09:25) |
no previous history |
testAtRandom | rand | rand := Random new. full add: 3. full add: 2. full add: 4. full add: 1. self assert: (full includes: (full atRandom: rand)). |
| SetTest>>testUnion: (no stamp -> GL 3/8/2006 00:50) |
no previous history |
testUnion | newFull col newCol | full add: 3. full add: 2. col := full union: full. self assert: (full = col). newFull := Set with: 8 with: 9 with: #z. col := newFull union: full. self assert: (col size = (full size + newFull size)). self assert: ((col select: [:each | (full includes: each) not]) = newFull). self assert: ((col select: [:each | (newFull includes: each) not]) = full). full add: 9. col := newFull union: full. newCol := newFull copy. newCol remove: 9. self assert: (col size = (full size + newFull size - 1)). self assert: ((col select: [:each | (full includes: each) not]) = newCol). newCol := full copy. newCol remove: 9. self assert: ((col select: [:each | (newFull includes: each) not]) = newCol). |
| SetTest>>testIncludes: (no stamp -> GL 2/27/2006 21:42) |
no previous history |
testIncludes self assert: (full includes: 5). self assert: (full includes: #abc). self deny: (full includes: 3). |
| SetTest>>testOccurrences: (no stamp -> GL 2/28/2006 08:27) |
no previous history |
testOccurrences self assert: ((empty occurrencesOf: 0) = 0). self assert: ((full occurrencesOf: 5) = 1). full add: 5. self assert: ((full occurrencesOf: 5) = 1). |
| SetTest>>testAsSet: (no stamp -> GL 3/16/2006 10:37) |
no previous history |
testAsSet "could be moved in Array or Collection" | newFull | newFull := #(#abc 5) asSet. newFull add: 5. self assert: (newFull = full). |
| SetTest>>testAddWithOccurences: (no stamp -> GL 3/16/2006 10:36) |
no previous history |
testAddWithOccurences empty add: 2 withOccurrences: 3. self assert: (empty includes: 2). self assert: ((empty occurrencesOf: 2) = 1). |
| SetTest>>testLike: (no stamp -> GL 2/28/2006 09:07) |
no previous history |
testLike self assert: ((full like: 5) = 5). self assert: ((full like: 8) isNil). |
| ChangeList class>>browseRecent:: (di 5/16/1998 21:53 -> HK 4/18/2002 15:02) |
browseRecent: charCount "ChangeList browseRecent: 5000" "Opens a changeList on the end of the changes log file" | changesFile changeList end | changesFile _ (SourceFiles at: 2) readOnlyCopy. end _ changesFile size. Cursor read showWhile: [changeList _ self new scanFile: changesFile from: (0 max: end-charCount) to: end]. changesFile close. self open: changeList name: 'Recent changes' multiSelect: true |
browseRecent: charCount "ChangeList browseRecent: 5000" "Opens a changeList on the end of the changes log file" ^ self browseRecent: charCount on: (SourceFiles at: 2) |
browseRecent: charCount "ChangeList browseRecent: 5000" |
| Integer>>hex: (no stamp -> JPF 6/26/2007 21:11) |
hex ^ self printStringBase: 16 |
hex
"receiver is in range 0 to 255. Returns a two 'digit' hexadecimal representation of the receiver.
If you want no padding use asHexDigit or printStringHex. i.e.
15 printStringHex == 'F'
15 asHexDigit == $F
15 hex == '0F'"
^self printStringBase: 16 length: 2 padded: true
|
hex "receiver is in range 0 to 255. Returns a two 'digit' hexadecimal representation of the receiver. If you want no padding use asHexDigit or printStringHex. i.e. 15 printStringHex == 'F' 15 asHexDigit == $F 15 hex == '0F'" ^self printStringBase: 16 length: 2 padded: true |
| HexTest>>testColorPrintHtmlString: (no stamp -> JPF 6/26/2007 10:39) |
no previous history |
testColorPrintHtmlString self assert: (Color red printHtmlString ) = ( Color red asHTMLColor allButFirst asUppercase). |
| HexTest>>testIntegerHex: (no stamp -> JPF 6/26/2007 10:21) |
no previous history |
testIntegerHex | result | result _ 15 asInteger hex. self assert: result = '0F'. result _ 0 asInteger hex. self assert: result = '00'. result _ 255 asInteger hex. self assert: result = 'FF'. result _ 90 asInteger hex. self assert: result = '5A'. |
| HexTest>>testCharacterHex: (no stamp -> JPF 6/26/2007 10:26) |
no previous history |
testCharacterHex | result | result _ $a hex. self assert: result = '61'. result _ $A hex. self assert: result = '41'. |
| HexTest>>testStringAsHex: (no stamp -> JPF 6/26/2007 10:44) |
no previous history |
testStringAsHex | result | result _ 'abc' asHex. self assert: result = '616263'. |
| StandardFileMenu class>>oldFileFrom:withPattern:: (no stamp -> MM 4/6/2004 22:56) |
no previous history |
oldFileFrom: aDirectory withPattern: aPattern " Select an existing file from a selection conforming to aPattern. " ^(self oldFileMenu: aDirectory withPattern: aPattern) startUpWithCaption: 'Select a File:' translated |
| DictionaryTest>>testAddAssociation: (no stamp -> NDCC 3/8/2006 08:14) |
no previous history |
testAddAssociation "self run:#testAddAssociation" "self debug:#testAddAssociation" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict at: #a) = 1. self assert: (dict at: #b) = 2. dict at: #a put: 10. dict at: #c put: 2. self assert: (dict at: #a) = 10. self assert: (dict at: #b) = 2. self assert: (dict at: #c) = 2 |
| DictionaryTest>>testRemoveKey: (no stamp -> NDCC 3/8/2006 08:56) |
no previous history |
testRemoveKey "self run:#testRemoveKey " | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict keys size) = 2. dict removeKey: #a. self assert: dict keys size = 1. self should: [dict at: #a] raise: Error. self assert: (dict at: #b) = 2 |
| DictionaryTest>>testDictionaryConcatenation: (no stamp -> NDCC 3/8/2006 08:16) |
no previous history |
testDictionaryConcatenation "self run: #testDictionaryConcatenation" | dict1 dict2 dict3 | dict1 := Dictionary new. dict1 at: #a put: 'Nicolas' ; at: #b put: 'Damien'. dict2 := Dictionary new. dict2 at: #a put: 'Christophe' ; at: #c put: 'Anthony'. dict3 := dict1, dict2. self assert: (dict3 at: #a) = 'Christophe'. self assert: (dict3 at: #b) = 'Damien'. self assert: (dict3 at: #c) = 'Anthony'. |
| DictionaryTest>>testAtPutNil: (no stamp -> NDCC 3/8/2006 09:53) |
no previous history |
testAtPutNil "self run: #testAtPut" "self debug: #testAtPut" | dict | dict := Dictionary new. dict at: nil put: 1. self assert: (dict at: nil) = 1. dict at: #a put: nil. self assert: (dict at: #a) = nil. dict at: nil put: nil. self assert: (dict at: nil) = nil. |
| DictionaryTest>>testOccurrencesOf: (no stamp -> NDCC 3/8/2006 09:41) |
no previous history |
testOccurrencesOf "self run:#testOccurrencesOf" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. dict at: #c put: 1. dict at: #d put: 3. dict at: nil put: nil. dict at: #z put: nil. self assert: (dict occurrencesOf: 1 ) = 2. self assert: (dict occurrencesOf: nil ) = 2. |
| DictionaryTest>>testIncludesAssociation: (zz 12/7/2005 19:57 -> NDCC 3/8/2006 09:20) |
testIncludesAssociation | d | d := Dictionary new at: #five put: 5; at: #givemefive put: 5; at: #six put: 6; yourself. self assert: (d includesAssociation: (d associationAt: #five)). self assert: (d includesAssociation: (#five -> 5)). self assert: (d includesAssociation: (#five -> 6)) not. |
testIncludesAssociation "self run:#testIncludesAssociation" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict includesAssociation: (#a -> 1)). self assert: (dict includesAssociation: (#b -> 2)). |
testIncludesAssociation "self run:#testIncludesAssociation" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. self assert: (dict includesAssociation: (#a -> 1)). self assert: (dict includesAssociation: (#b -> 2)). |
| DictionaryTest>>testKeysDo: (no stamp -> NDCC 3/8/2006 09:13) |
no previous history |
testKeysDo "self run: #testKeysDo" "self debug: #testKeysDo" | dict res | dict := Dictionary new. dict at: #a put: 33. dict at: #b put: 66. res := OrderedCollection new. dict keysDo: [ :each | res add: each]. self assert: res asSet = #(a b) asSet. |
| DictionaryTest>>testAtIfAbsent: (no stamp -> NDCC 3/1/2006 14:27) |
no previous history |
testAtIfAbsent "self run: #testAtIfAbsent" | dict | dict := Dictionary new. dict at: #a put: 666. self assert: (dict at: #a ifAbsent: [nil]) = 666. self assert: (dict at: #b ifAbsent: [nil]) isNil. |
| DictionaryTest>>testAtPut: (no stamp -> NDCC 3/8/2006 09:28) |
no previous history |
testAtPut "self run: #testAtPut" "self debug: #testAtPut" | adictionary | adictionary := Dictionary new. adictionary at: #a put: 3. self assert: (adictionary at: #a) = 3. adictionary at: #a put: 3. adictionary at: #a put: 4. self assert: (adictionary at: #a) = 4. adictionary at: nil put: 666. self assert: (adictionary at: nil) = 666 |
| Boolean>>==>: (hg 1/2/2002 13:57 -> PH 10/3/2003 08:10) |
==> aBlock "this is logical implicature, a ==> b, also known as b iff a (if and only if)" ^self not or: [aBlock value] |
==> aBlock "this is material implication, a ==> b, also known as: b if a a implies b if a then b b is a consequence of a a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence). Here is the truth table for material implication (view in a monospaced font): p | q | p ==> q -------|-------|------------- T | T | T T | F | F F | T | T F | F | T " ^self not or: [aBlock value] |
==> aBlock "this is material implication, a ==> b, also known as: b if a a implies b if a then b b is a consequence of a a therefore b (but note: 'it is raining therefore it is cloudy' is implication; 'it is autumn therefore the leaves are falling' is equivalence). Here is the truth table for material implication (view in a monospaced font): p | q | p ==> q -------|-------|------------- T | T | T T | F | F F | T | T F | F | T " |
| Number>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." self = 0 ifTrue: [^self error: 'zero has no reciprocal'] ifFalse: [^1 / self] |
reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. ^ 1 / self |
reciprocal "Answer 1 divided by the receiver. Create an error notification if the receiver is 0." #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. ^ 1 / self |
| Number>>asFloatQ: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloatQ "Answer a floating-point number approximating the receiver." #Numeric. "add 200/01/19 For ANSI <number> protocol." ^ self asFloat |
| Number>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Do any required conversion and then the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ self subclassResponsibility |
| Number>>fractionPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
fractionPart "Answer the fractional part of the receiver." #Numeric. "2000/03/04 Harmon R. Added ANSI <number> protocol" ^ self - self truncated |
| Number>>integerPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
integerPart "Answer the integer part of the receiver." #Numeric. "2000/03/04 Harmon R. Added ANSI <number> protocol" ^ self truncated |
| Number>>asFloatD: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloatD "Answer a d precision floating-point number approximating the receiver." #Numeric. "add 200/01/19 For ANSI <number> protocol." ^ self asFloat |
| Number>>raisedToInteger:: (RJ 3/15/1999 19:32 -> RAH 4/25/2000 19:49) |
raisedToInteger: anInteger "Answer the receiver raised to the power anInteger where the argument must be a kind of Integer. This is a special case of raisedTo:." anInteger isInteger ifFalse: [^self error: 'raisedToInteger: only works for integral arguments']. anInteger = 0 ifTrue: [^ 1]. (self = 0) | (anInteger = 1) ifTrue: [^ self]. anInteger > 1 ifTrue: [^ (self * self raisedToInteger: anInteger // 2) * (self raisedToInteger: anInteger \\ 2)]. ^ (self raisedToInteger: anInteger negated) reciprocal |
raisedToInteger: operand "Answer the receiver raised to the power operand, an Integer." | count result | #Numeric. "Changed 200/01/19 For ANSI <number> support." operand isInteger ifFalse: [^ ArithmeticError signal: 'parameter is not an Integer'"<- Chg"]. operand = 0 ifTrue: [^ self class one]. operand = 1 ifTrue: [^ self]. operand < 0 ifTrue: [^ (self raisedToInteger: operand negated) reciprocal]. count := 1. [(count := count + count) < operand] whileTrue. result := self class one. [count > 0] whileTrue: [result := result * result. (operand bitAnd: count) = 0 ifFalse: [result := result * self]. count := count bitShift: -1]. ^ result |
raisedToInteger: operand "Answer the receiver raised to the power operand, an Integer." | count result | #Numeric. "Changed 200/01/19 For ANSI <number> support." operand isInteger ifFalse: [^ ArithmeticError signal: 'parameter is not an Integer'"<- Chg"]. operand = 0 ifTrue: [^ self class one]. operand = 1 ifTrue: [^ self]. operand < 0 ifTrue: [^ (self raisedToInteger: operand negated) reciprocal]. count := 1. [(count := count + count) < operand] whileTrue. result := self class one. [count > 0] whileTrue: [result := result * result. (operand bitAnd: count) = 0 ifFalse: [result := result * self]. count := count bitShift: -1]. ^ result |
| Number>>asScaledDecimal:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asScaledDecimal: scale "Answer a scaled decimal number, with a fractional precision of scale, approximating the receiver." #Numeric. "add 200/01/19 For number protocol." ^ ScaledDecimal newFromNumber: self scale: scale |
| Number>>asFloatE: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloatE "Answer a floating-point number approximating the receiver." #Numeric. "add 200/01/19 For ANSI <number> protocol." ^ self asFloat |
| Fraction class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one #Numeric. "add 200/01/19 For <number> protocol support." ^ self numerator: 1 denominator: 1 |
| Fraction>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
reciprocal "Refer to the comment in Number|reciprocal." numerator = 0 ifTrue: [self error: '0 has no reciprocal']. numerator = 1 ifTrue: [^denominator]. numerator = -1 ifTrue: [^denominator negated]. ^Fraction numerator: denominator denominator: numerator |
reciprocal "Refer to the comment in Number|reciprocal." #Numeric. "Changed 200/01/19 For ANSI <number> support." numerator = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. numerator = 1 ifTrue: [^ denominator]. numerator = -1 ifTrue: [^ denominator negated]. ^ Fraction numerator: denominator denominator: numerator |
reciprocal |
| Fraction>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Convert receiverScaledDecimal to a Fraction and do the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ receiverScaledDecimal asFraction perform: arithmeticOpSelector with: self |
| Float class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one #Numeric. "add 200/01/19 For <number> protocol support." ^ 1.0 |
| Float>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Convert receiverScaledDecimal to a Float and do the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ receiverScaledDecimal asFloat perform: arithmeticOpSelector with: self |
| Float>>printPaddedWith:to:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printPaddedWith: aCharacter to: aNumber "Answer the string containing the ASCII representation of the receiver padded on the left with aCharacter to be at least on aNumber integerPart characters and padded the right with aCharacter to be at least anInteger fractionPart characters." | aStream digits fPadding fLen iPadding iLen curLen periodIndex | #Numeric. "2000/03/04 Harmon R. Added Date and Time support" aStream := WriteStream on: (String new: 10). self printOn: aStream. digits := aStream contents. periodIndex := digits indexOf: $.. curLen := periodIndex - 1. iLen := aNumber integerPart. curLen < iLen ifTrue: [iPadding := (String new: (iLen - curLen) asInteger) atAllPut: aCharacter; yourself] ifFalse: [iPadding := '']. curLen := digits size - periodIndex. fLen := (aNumber fractionPart * (aNumber asFloat exponent * 10)) asInteger. curLen < fLen ifTrue: [fPadding := (String new: fLen - curLen) atAllPut: aCharacter; yourself] ifFalse: [fPadding := '']. ^ iPadding , digits , fPadding |
| Float>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
reciprocal ^ 1.0 / self |
reciprocal #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: ["<- Chg" ^ (ZeroDivide dividend: self) signal"<- Chg"]. "<- Chg" ^ 1.0 / self |
reciprocal #Numeric. "Changed 200/01/19 For ANSI <number> support." self = 0 ifTrue: ["<- Chg" ^ (ZeroDivide dividend: self) signal"<- Chg"]. "<- Chg" ^ 1.0 / self |
| Float>>sqrt: (no stamp -> RAH 4/25/2000 19:49) |
sqrt "Answer the square root of the receiver. Optional. See Object documentation whatIsAPrimitive." | exp guess eps delta | <primitive: 55> "Newton-Raphson" self <= 0.0 ifTrue: [ self = 0.0 ifTrue: [^ 0.0] ifFalse: [^ self error: 'sqrt is invalid for x < 0']]. "first guess is half the exponent" exp _ self exponent // 2. guess _ self timesTwoPower: (0 - exp). "get eps value" eps _ guess * Epsilon. eps _ eps * eps. delta _ (self - (guess * guess)) / (guess * 2.0). [(delta * delta) > eps] whileTrue: [ guess _ guess + delta. delta _ (self - (guess * guess)) / (guess * 2.0)]. ^ guess |
sqrt "Answer the square root of the receiver. Optional. See Object documentation whatIsAPrimitive." | exp guess eps delta | <primitive: 55> #Numeric. "Changed 200/01/19 For ANSI <number> support." "Newton-Raphson" self <= 0.0 ifTrue: [self = 0.0 ifTrue: [^ 0.0] ifFalse: ["v Chg" ^ FloatingPointException signal: 'undefined if less than zero.']]. "first guess is half the exponent" exp := self exponent // 2. guess := self timesTwoPower: 0 - exp. "get eps value" eps := guess * Epsilon. eps := eps * eps. delta := self - (guess * guess) / (guess * 2.0). [delta * delta > eps] whileTrue: [guess := guess + delta. delta := self - (guess * guess) / (guess * 2.0)]. ^ guess |
sqrt "Answer the square root of the receiver. |
| Integer class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one #Numeric. "add 200/01/19 For <number> protocol support." ^ 1 |
| Integer>>//: (no stamp -> RAH 4/25/2000 19:49) |
// aNumber | q | aNumber = 0 ifTrue: [^self error: 'division by 0']. self = 0 ifTrue: [^0]. q _ self quo: aNumber "Refer to the comment in Number|//.". (q negative ifTrue: [q * aNumber ~= self] ifFalse: [q = 0 and: [self negative ~= aNumber negative]]) ifTrue: [^q - 1"Truncate towards minus infinity"] ifFalse: [^q] |
// aNumber | q | #Numeric. "Changed 200/01/19 For ANSI support." aNumber = 0 ifTrue: [^ (ZeroDivide dividend: self) signal"<- Chg"]. self = 0 ifTrue: [^ 0]. q := self quo: aNumber. "Refer to the comment in Number|//." (q negative ifTrue: [q * aNumber ~= self] ifFalse: [q = 0 and: [self negative ~= aNumber negative]]) ifTrue: [^ q - 1"Truncate towards minus infinity."] ifFalse: [^ q] |
// aNumber |
| Integer>>adaptToScaledDecimal:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToScaledDecimal: receiverScaledDecimal andSend: arithmeticOpSelector "Convert me to a ScaledDecimal and do the arithmetic. receiverScaledDecimal arithmeticOpSelector self." #Numeric. "add 200/01/19 For ScaledDecimal support." ^ receiverScaledDecimal perform: arithmeticOpSelector with: (self asScaledDecimal: 0) |
| Integer>>asScaledDecimal:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asScaledDecimal: scaleNotUsed "The number of significant digits of the answer is the same as the number of decimal digits in the receiver. The scale of the answer is 0." #Numeric. "add 200/01/19 For <integer> protocol." ^ ScaledDecimal newFromNumber: self scale: 0 |
| Integer>>printPaddedWith:to:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printPaddedWith: aCharacter to: anInteger "Answer the string containing the ASCII representation of the receiver padded on the left with aCharacter to be at least anInteger characters." #Numeric. "2000/03/04 Harmon R. Added Date and Time support" ^ self printPaddedWith: aCharacter to: anInteger base: 10 |
| ScaledDecimal class>>one: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
one "Answer the receiver's representation of one." ^ self newFromNumber: 1 scale: 0 |
| ScaledDecimal class>>zero: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
zero "Answer the receiver's representation of zero." ^ self newFromNumber: 0 scale: 0 |
| ScaledDecimal class>>newFromNumber:scale:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
newFromNumber: aNumber scale: scaleIn "Answer a new instance of me." | temp | temp := self basicNew. temp setFraction: aNumber asFraction scale: scaleIn. ^ temp |
| ScaledDecimal>>denominator: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
denominator "Private - Answer an Integer, the denominator part of the receiver." ^ fraction denominator |
| ScaledDecimal>>//: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
// operand "Answer the integer quotient after dividing the receiver by operand with truncation towards negative infinity." ^ fraction // operand |
| ScaledDecimal>>asFraction: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFraction "Implementation - Number 'converting' method." ^ fraction |
| ScaledDecimal>>numerator: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
numerator "Private - Answer an Integer, the numerator part of the receiver." ^ fraction numerator |
| ScaledDecimal>>printString: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printString "Reimplementation - Number 'printing' method." | tempStream | tempStream := WriteStream on: (String new: 10). self printOn: tempStream. ^ tempStream contents |
| ScaledDecimal>>hash: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
hash "Reimplementation of Object 'comparing' method." ^ fraction hash |
| ScaledDecimal>>reciprocal: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
reciprocal "Reimplementation of Number 'arithmetic' method." self = 0 ifTrue: [^ (ZeroDivide dividend: 1) signal]. ^ ScaledDecimal newFromNumber: fraction reciprocal scale: scale |
| ScaledDecimal>>asFloat: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asFloat "Reimplementation - Number 'converting' method." ^ fraction asFloat |
| ScaledDecimal>>printOn:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
printOn: aStream "Reimplementation - Object 'printing' method." | aFraction tmpFractionPart | self < 0 ifTrue: [aStream nextPut: $-]. aFraction := fraction abs. aStream nextPutAll: aFraction truncated printString. scale = 0 ifTrue: [^ aStream nextPutAll: 's0']. aStream nextPut: $.. tmpFractionPart := aFraction fractionPart. 1 to: scale do: [:dummy | tmpFractionPart := tmpFractionPart * 10. aStream nextPut: (Character digitValue: tmpFractionPart truncated). tmpFractionPart := tmpFractionPart fractionPart]. aStream nextPut: $s. scale printOn: aStream |
| ScaledDecimal>>asScaledDecimal:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asScaledDecimal: scaleIn "Reimplementation - Number 'converting' method." ^ ScaledDecimal newFromNumber: fraction scale: scaleIn |
| ScaledDecimal>>setFraction:scale:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
setFraction: fractionIn scale: scaleIn "Private - Set the fraction to fractionIn and the total number of digits used to represent the fraction part of the receiver, including trailing zeroes, to the Integer scaleIn." fraction := fractionIn. scale := scaleIn |
| ScaledDecimal>>asSpecies:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
asSpecies: number "Convert number to a ScaledDecimal." #Numeric. "add 200/01/19 For ANSI <number>support." ^ ScaledDecimal newFromNumber: number scale: scale |
| ScaledDecimal>>squared: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
squared "Reimplementation - Number 'mathematical functions' method." "not used ->" ^ ScaledDecimal newFromNumber: fraction squared scale: scale |
| ScaledDecimal>>negated: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
negated "Reimplementation of Number 'arithmetic' method." ^ ScaledDecimal newFromNumber: fraction negated scale: scale |
| ScaledDecimal>>isZero: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
isZero "Answer whether the receiver is equal to its class' zero" ^ fraction numerator = 0 |
| ScaledDecimal>>truncated: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
truncated "Reimplementation of Number 'truncation and round off' method." ^ fraction truncated |
| ScaledDecimal>>adaptToInteger:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToInteger: receiver andSend: arithmeticOpSelector "Convert receiver to a ScaledDecimal and do the arithmetic. receiver arithmeticOpSelector self." ^ (receiver asScaledDecimal: 0) perform: arithmeticOpSelector with: self |
| ScaledDecimal>>scale: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
scale "Private - Answer a integer which represents the total number of digits used to represent the fraction part of the receiver, including trailing zeroes. " ^ scale |
| ScaledDecimal>>isScaledDecimal: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
isScaledDecimal "Reimplementation - Number 'testing' method." ^ true |
| ScaledDecimal>>fractionPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
fractionPart "Answer the fractional part of the receiver." ^ ScaledDecimal newFromNumber: fraction fractionPart scale: scale |
| ScaledDecimal>>adaptToFraction:andSend:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
adaptToFraction: receiver andSend: arithmeticOpSelector "Convert me to a Fraction and do the arithmetic. receiver arithmeticOpSelector self." ^ receiver perform: arithmeticOpSelector with: fraction |
| ScaledDecimal>>integerPart: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
integerPart "Answer the fractional part of the receiver." ^ ScaledDecimal newFromNumber: fraction integerPart scale: scale |
| Character class>>codePoint:: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
codePoint: integer "Return a character whose encoding value is integer." #Fundmntl. (0 > integer or: [255 < integer]) ifTrue: [self error: 'parameter out of range 0..255']. ^ CharacterTable at: integer + 1 |
| Character>>codePoint: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
codePoint "Return the encoding value of the receiver." #Fundmntl. ^ self asciiValue |
| BlockContext>>argumentCount: (no stamp -> RAH 4/25/2000 19:49) |
no previous history |
argumentCount "Answers the number of arguments needed to evaluate the receiver." #Valuable. ^ self numArgs |
| Model>>veryDeepInner:: (no stamp -> RB 9/20/2001 16:25) |
no previous history |
veryDeepInner: deepCopier "Shallow copy dependents and fix them later" |
| ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock:: (di 2/17/98 12:11 -> RCS 3/16/2000 14:54) |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk start _ strt. stop _ stp. minorTick _ mnt. minorTickLength _ mntLen. majorTick _ mjt. majorTickLength _ mjtLen. caption _ cap. tickPrintBlock_ blk fixTemps. self buildLabels |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: true captionAbove: true. |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: true captionAbove: true. |
| ScaleMorph>>labelsAbove:: (no stamp -> RCS 3/16/2000 00:38) |
no previous history |
labelsAbove: aBoolean labelsAbove _ aBoolean. |
| ScaleMorph>>extent:: (di 2/19/98 21:41 -> RCS 3/16/2000 13:59) |
extent: newExtent | pixPerTick newWidth | pixPerTick _ (newExtent x - (self borderWidth*2) - 1) / ((stop-start) asFloat / minorTick). pixPerTick _ pixPerTick detentBy: 0.1 atMultiplesOf: 1.0 snap: false. newWidth _ pixPerTick * ((stop-start) asFloat / minorTick) + (self borderWidth*2) + 1. super extent: newWidth @ newExtent y. self buildLabels |
extent: newExtent | modExtent | modExtent _ self checkExtent: newExtent. super extent: modExtent. self buildLabels |
extent: newExtent | modExtent | modExtent _ self checkExtent: newExtent. super extent: modExtent. |
| ScaleMorph>>tickPrintBlock:: (no stamp -> RCS 3/15/2000 21:47) |
no previous history |
tickPrintBlock: aBlock tickPrintBlock _ aBlock. |
| ScaleMorph>>start: (no stamp -> RCS 3/15/2000 21:43) |
no previous history |
start ^ start |
| ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:caption:tickPrintBlock:labelsAbove:captionAbove:: (no stamp -> RCS 3/16/2000 15:09) |
no previous history |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: cap tickPrintBlock: blk labelsAbove: aBoolean captionAbove: notherBoolean start _ strt. stop _ stp. minorTick _ mnt. minorTickLength _ mntLen. majorTick _ mjt. majorTickLength _ mjtLen. caption _ cap. tickPrintBlock _ blk. labelsAbove _ aBoolean. captionAbove _ notherBoolean. self buildLabels |
| ScaleMorph>>minorTickLength:: (no stamp -> RCS 3/15/2000 21:46) |
no previous history |
minorTickLength: anInteger minorTickLength _ anInteger. |
| ScaleMorph>>caption: (no stamp -> RCS 3/15/2000 21:41) |
no previous history |
caption ^ caption. |
| ScaleMorph>>stop:: (no stamp -> RCS 3/15/2000 21:44) |
no previous history |
stop: aNumber stop _ aNumber. |
| ScaleMorph>>start:: (no stamp -> RCS 3/15/2000 21:43) |
no previous history |
start: aNumber start _ aNumber. |
| ScaleMorph>>stop: (no stamp -> RCS 3/15/2000 21:43) |
no previous history |
stop ^ stop |
| ScaleMorph>>drawTicksOn:: (no stamp -> RCS 3/16/2000 14:19) |
no previous history |
drawTicksOn: aCanvas self drawMajorTicksOn: aCanvas. self drawMinorTicksOn: aCanvas |
| ScaleMorph>>start:stop:minorTick:minorTickLength:majorTick:majorTickLength:: (no stamp -> RCS 3/16/2000 14:55) |
no previous history |
start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen self start: strt stop: stp minorTick: mnt minorTickLength: mntLen majorTick: mjt majorTickLength: mjtLen caption: nil tickPrintBlock: nil |
| ScaleMorph>>caption:: (no stamp -> RCS 3/15/2000 21:42) |
no previous history |
caption: aString caption _ aString. |
| ScaleMorph>>captionAbove:: (no stamp -> RCS 3/16/2000 00:38) |
no previous history |
captionAbove: aBoolean captionAbove _ aBoolean |
| ScaleMorph>>drawOn:: (RCS 10/25/1999 18:42 -> RCS 3/15/2000 21:36) |
drawOn: aCanvas
| scale x1 y1 y2 x y3 even yy loopStart checkStart |
super drawOn: aCanvas.
scale _ (self innerBounds width-1) / (stop-start) asFloat.
x1 _ self innerBounds left.
y1 _ self innerBounds bottom - 1.
y2 _ y1 - minorTickLength.
loopStart _ ((start / minorTick ) ceiling) * minorTick.
loopStart to: stop by: minorTick do:
[:v | x _ x1 + (scale*(v - start)).
aCanvas line: x@y1 to: x@y2 width: 1 color: Color black].
x1 _ self innerBounds left.
y2 _ y1 - majorTickLength.
y3 _ y1 - (minorTickLength+majorTickLength//2).
even _ true.
"Make sure mjor ticks start drawing on a multiple of majorTick"
loopStart _ ((start / majorTick ) ceiling) * majorTick.
checkStart _ ((start / (majorTick/2.0) ) ceiling) * majorTick.
"Check to see if semimajor tick should be drawn before majorTick"
( checkStart = (loopStart * 2) ) ifFalse:
[ loopStart _ checkStart/2.0.
even _ false. ].
loopStart to: stop by: majorTick/2.0 do:
[:v | x _ x1 + (scale*(v - start)).
yy _ even ifTrue: [y2] ifFalse: [y3].
aCanvas line: x@y1 to: x@yy width: 1 color: Color black.
even _ even not].
|
drawOn: aCanvas | | super drawOn: aCanvas. self drawTicksOn: aCanvas. |
drawOn: aCanvas | | super drawOn: aCanvas. self drawTicksOn: aCanvas. |
| ScaleMorph>>majorTickLength:: (no stamp -> RCS 3/15/2000 21:46) |
no previous history |
majorTickLength: anInteger majorTickLength _ anInteger |
| ScaleMorph>>checkExtent:: (no stamp -> RCS 3/16/2000 13:58) |
no previous history |
checkExtent: newExtent | pixPerTick newWidth | pixPerTick _ newExtent x - (self borderWidth * 2) - 1 / ((stop - start) asFloat / minorTick). pixPerTick _ pixPerTick detentBy: 0.1 atMultiplesOf: 1.0 snap: false. newWidth _ pixPerTick * ((stop - start) asFloat / minorTick) + (self borderWidth * 2) + 1. ^ (newWidth @ newExtent y). |
| Number>>raisedTo:: (no stamp -> RJ 3/15/1999 19:35) |
raisedTo: aNumber "Answer the receiver raised to aNumber." (aNumber isInteger) ifTrue: ["Do the special case of integer power" ^self raisedToInteger: aNumber]. aNumber = 0 ifTrue: [^1]. "Special case of exponent=0" aNumber = 1 ifTrue: [^self]. "Special case of exponent=1" ^(aNumber * self ln) exp "Otherwise raise it to the power using logarithms" |
raisedTo: aNumber "Answer the receiver raised to aNumber." aNumber isInteger ifTrue: ["Do the special case of integer power" ^ self raisedToInteger: aNumber]. self < 0 ifTrue: [ self error: self printString, ' raised to a non-integer power' ]. aNumber = 0 ifTrue: [^ 1]. "Special case of exponent=0" (self = 0) | (aNumber = 1) ifTrue: [^ self]. "Special case of exponent=1" ^ (aNumber * self ln) exp "Otherwise use logarithms" |
raisedTo: aNumber "Answer the receiver raised to aNumber." aNumber isInteger ifTrue: ["Do the special case of integer power" ^ self raisedToInteger: aNumber]. self < 0 ifTrue: [ self error: self printString, ' raised to a non-integer power' ]. aNumber = 0 ifTrue: [^ 1]. "Special case of exponent=0" (self = 0) | (aNumber = 1) ifTrue: [^ self]. "Special case of exponent=1" ^ (aNumber * self ln) exp "Otherwise use logarithms" |
| ChatNotes>>updateNotes: (no stamp -> TBP 2/23/2000 21:07) |
no previous history |
updateNotes "Probably not necessary unless several audio notes are open at the same time" "Clear Notes" self loadNotes. self changed: #notesList. self notesListIndex: 0. self name: ''. |
| ChatNotes>>notesMenu:: (no stamp -> TBP 2/23/2000 21:07) |
no previous history |
notesMenu: aMenu
"Simple menu to delete notes"
^(notesIndex = 0)
ifTrue: [aMenu labels: 'update notes' lines: #() selections: #(updateNotes)]
ifFalse: [aMenu labels: ('delete', String cr, 'update notes') lines: #() selections: #(deleteSelection updateNotes)]
|
| ChatNotes>>stop: (no stamp -> TBP 2/23/2000 21:07) |
no previous history |
stop recorder pause. self isRecording: false |
| ChatNotes>>recorder: (no stamp -> TBP 2/23/2000 21:07) |
no previous history |
recorder ^recorder |
| ChatNotes>>initialExtent: (no stamp -> TBP 2/23/2000 21:07) |
no previous history |
initialExtent "Nice and small--that was the idea. It shouldn't take up much screen real estate." ^200@100 |
| ChatNotes>>defaultBackgroundColor: (no stamp -> TBP 2/23/2000 21:07) |
no previous history |
defaultBackgroundColor "In a better design, this would be handled by preferences." ^Color r: 1.0 g: 0.7 b: 0.8 |
| AlertMorph>>stepTime: (no stamp -> TBP 3/5/2000 13:47) |
no previous history |
stepTime "Answer the desired time between steps in milliseconds." ^ 500 |
| AlertMorph>>canHaveFillStyles: (no stamp -> TBP 3/5/2000 13:47) |
no previous history |
canHaveFillStyles ^false |
| AudioChatGUI>>defaultBackgroundColor: (no stamp -> TBP 3/5/2000 16:22) |
no previous history |
defaultBackgroundColor "In a better design, this would be handled by preferences." ^Color yellow."r: 1.0 g: 0.7 b: 0.8" |
| AudioChatGUI>>initialExtent: (no stamp -> TBP 3/5/2000 16:02) |
no previous history |
initialExtent "Nice and small--that was the idea. It shouldn't take up much screen real estate." ^200@100 |
| AudioChatGUI>>stop: (no stamp -> Tbp 4/11/2000 16:49) |
no previous history |
stop myrecorder stop. self send. |
| SkipListTest>>testRandomLevel: (no stamp -> YE 2/28/2006 09:45) |
no previous history |
testRandomLevel "a randomLevel should not be greater than maxLevel" "self run: #testRandomLevel" | s | s := SkipList new. s maxLevel: 5. self assert: s randomLevel <= 5 |
| SkipListTest>>testIfAbsent: (no stamp -> YE 3/16/2006 10:50) |
no previous history |
testIfAbsent "self run: #testIfAbsent" "self debug: #testIfAbsent" | sk temp | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk add: 7 ifPresent: [sk at: 8 put: '88']. temp := sk at: 9 ifAbsent: [sk at: 8]. self assert: (temp = '88') |
| SkipListTest>>testAtPutAlreadyPresent: (no stamp -> YE 3/8/2006 10:00) |
no previous history |
testAtPutAlreadyPresent "self run: #testAtPutAlreadyPresent" "self debug: #testAtPutAlreadyPresent" | sk | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk at: 3 put: '666'. self assert: (sk at: 7) = '77777'. self assert: (sk includes: 7). self assert: (sk at: 3) = '3333'. self assert: (sk includes: 3). self assert: (sk size) = 3 |
| SkipListTest>>testIfPresent: (no stamp -> YE 3/16/2006 10:49) |
no previous history |
testIfPresent "self run: #testIfPresent" "self debug: #testIfPresent" | sk | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk add: 7 ifPresent: [sk at: 8 put: '88']. self assert: (sk at: 7) = '77777'. self assert: (sk at: 8) = '88'. |
| SkipListTest>>testCreation: (no stamp -> YE 3/8/2006 09:56) |
no previous history |
testCreation "self run: #testCreation" "self debug: #testCreation" | sk | sk := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. self assert: (sk at: 7) = '77777'. self assert: (sk includes: 7). |
| SkipListTest>>testIsEqualTo: (no stamp -> YE 3/16/2006 11:47) |
no previous history |
testIsEqualTo "self run: #testIsEqualTo" "self debug: #testIsEqualTo" | sk sk2 | sk := SkipList new. sk2 := SkipList new. sk at: 11 put: '111111'. sk at: 3 put: '3333'. sk at: 7 put: '77777'. sk at: 9 put: '3333'. sk2 at: 3 put: '3333'. sk2 at: 5 put: '3333'. self assert: (sk is: (sk at: 3) equalTo: (sk at: 9)). self assert: (sk is: (sk at: 3) equalTo: (sk2 at: 3)). self assert: (sk is: (sk at: 3) equalTo: (sk2 at: 5)) |
| MCTestCase>>compileClass:source:category:: (cwp 7/21/2003 22:51 -> abc 2/16/2006 09:24) |
compileClass: aClass source: source category: category aClass compileInobtrusively: source classified: category |
compileClass: aClass source: source category: category aClass compileSilently: source classified: category |
compileClass: aClass source: source category: category aClass compileSilently: source classified: category |
| MCMergeRecord class>>version:: (no stamp -> abc 2/13/2004 15:52) |
no previous history |
version: aVersion ^ self basicNew initializeWithVersion: aVersion |
| MCMergeRecord>>updateWorkingCopy: (no stamp -> abc 2/13/2004 17:14) |
no previous history |
updateWorkingCopy self isAncestorMerge ifFalse: [self imageIsClean ifTrue: [version workingCopy loaded: version] ifFalse: [version workingCopy merged: version]] |
| MCMergeRecord>>isAncestorMerge: (no stamp -> abc 2/13/2004 17:14) |
no previous history |
isAncestorMerge ^ version workingCopy ancestry hasAncestor: version info |
| MCMergeRecord>>version: (no stamp -> abc 2/13/2004 15:52) |
no previous history |
version ^ version |
| MCWorkingCopy>>merged:: (no stamp -> abc 2/13/2004 15:57) |
no previous history |
merged: aVersion ancestry addAncestor: aVersion info. self changed |
| MCRepositoryGroup>>includesVersionNamed:: (no stamp -> abc 11/6/2004 20:32) |
no previous history |
includesVersionNamed: aString self repositoriesDo: [:ea | (ea includesVersionNamed: aString) ifTrue: [^ true]]. ^ false |
| MCVersion>>merge: (no stamp -> abc 2/13/2004 15:58) |
no previous history |
merge MCVersionMerger mergeVersion: self |
| MCVersionMerger>>merge: (no stamp -> abc 2/13/2004 17:15) |
no previous history |
merge records do: [:ea | merger addBaseSnapshot: ea packageSnapshot]. records do: [:ea | merger applyPatch: ea mergePatch]. self resolveConflicts ifTrue: [merger load. records do: [:ea | ea updateWorkingCopy]]. |
| MCPackageLoader>>initialize: (stephaneducasse 2/4/2006 20:47 -> abc 2/26/2007 21:39) |
initialize additions := OrderedCollection new. removals := OrderedCollection new. obsoletions := Dictionary new. |
initialize additions := OrderedCollection new. removals := OrderedCollection new. obsoletions := Dictionary new. methodAdditions := OrderedCollection new. |
initialize
additions := OrderedCollection new.
removals := OrderedCollection new.
obsoletions := Dictionary new.
methodAdditions := OrderedCollection new.
|
| TextPlusMorph>>keyboardFocusChange:: (RAA 5/3/2001 17:47 -> ag 8/19/2004 04:53) |
keyboardFocusChange: aBoolean | parent | "we basically ignore loss of focus unless it is going to one of our siblings" aBoolean ifFalse: [^self]. "A hand is wanting to send us characters..." self hasFocus ifFalse: [self editor "Forces install"]. "Inform our siblings we have taken the focus" parent _ self parentGeeMail ifNil: [^self]. parent allTextPlusMorphs do: [ :each | each == self ifFalse: [each keyboardFocusLostForSure] ]. |
keyboardFocusChange: aBoolean | parent | "we basically ignore loss of focus unless it is going to one of our siblings" aBoolean ifFalse: [^self]. paragraph isNil ifFalse:[paragraph focused: aBoolean]. "A hand is wanting to send us characters..." self hasFocus ifFalse: [self editor "Forces install"]. "Inform our siblings we have taken the focus" parent _ self parentGeeMail ifNil: [^self]. parent allTextPlusMorphs do: [ :each | each == self ifFalse: [each keyboardFocusLostForSure] ]. |
keyboardFocusChange: aBoolean | parent | "we basically ignore loss of focus unless it is going to one of our siblings" aBoolean ifFalse: [^self]. paragraph isNil ifFalse:[paragraph focused: aBoolean]. "A hand is wanting to send us characters..." self hasFocus ifFalse: [self editor "Forces install"]. "Inform our siblings we have taken the focus" parent _ self parentGeeMail ifNil: [^self]. parent allTextPlusMorphs do: [ :each | each == self ifFalse: [each keyboardFocusLostForSure] ]. |
| Browser>>classMessagesIndicated: (no stamp -> ak 11/24/2000 21:46) |
classMessagesIndicated "Answer whether the messages to be presented should come from the metaclass." ^ self metaClassIndicated |
classMessagesIndicated "Answer whether the messages to be presented should come from the metaclass." ^ self metaClassIndicated and: [self classCommentIndicated not] |
classMessagesIndicated "Answer whether the messages to be presented should come from the metaclass." ^ self metaClassIndicated and: [self classCommentIndicated not] |
| SystemWindow>>doFastFrameDrag:: (no stamp -> bmk 3/19/2002 02:09) |
no previous history |
doFastFrameDrag: grabPoint "Do fast frame dragging from the given point" | offset newBounds outerWorldBounds | outerWorldBounds _ self boundsIn: nil. offset _ outerWorldBounds origin - grabPoint. newBounds _ outerWorldBounds newRectFrom: [:f | Sensor cursorPoint + offset extent: outerWorldBounds extent]. self position: (self globalPointToLocal: newBounds topLeft); comeToFront |
| SystemWindow>>mouseMove:: (di 11/30/2001 11:44 -> bmk 3/19/2002 02:11) |
mouseMove: evt | cp | cp _ evt cursorPoint. self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: ["If this is a drag that started in the title bar, then pick me up" ^ self isSticky ifFalse: [self fastFramingOn ifTrue: [self doFastFrameDrag] ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]]. model windowActiveOnFirstClick ifTrue: ["Normally window takes control on first click. Need explicit transmission for first-click activity." submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]] |
mouseMove: evt "Handle a mouse-move event" | cp | cp _ evt cursorPoint. self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: ["If this is a drag that started in the title bar, then pick me up" ^ self isSticky ifFalse: [self fastFramingOn ifTrue: [self doFastFrameDrag: firstClick] ifFalse: [evt hand grabMorph: self topRendererOrSelf]]]]. model windowActiveOnFirstClick ifTrue: ["Normally window takes control on first click. Need explicit transmission for first-click activity." submorphs do: [:m | (m containsPoint: cp) ifTrue: [m mouseMove: evt]]] |
mouseMove: evt "Handle a mouse-move event" | cp | cp _ evt cursorPoint. self valueOfProperty: #clickPoint ifPresentDo: [:firstClick | ((self labelRect containsPoint: firstClick) and: [(cp dist: firstClick) > 3]) ifTrue: ["If this is a drag that started in the title bar, then pick me up" ^ self isSticky ifFalse: [self fastFramingOn ifTrue: [self doFastFrameDrag: firstClick] |
| OrderedCollectionTest>>testWithCollect: (no stamp -> cm 3/8/2006 10:02) |
no previous history |
testWithCollect "Allows one to collect some element of two collections into another collection with element corresponding to the condition in the blocks" "self run: #testWithCollect" | c1 c2 res | c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection. c2 := #(-9 10 -11 12 -13 14 -15 16) asOrderedCollection. res := c1 with: c2 collect: [:each1 :each2 | each1 < each2 ifTrue: [each1] ifFalse: [each2]]. self assert: (res = #(-9 2 -11 4 -13 6 -15 8) asOrderedCollection). |
| OrderedCollectionTest>>testCollectFromTo: (no stamp -> cm 3/8/2006 09:09) |
no previous history |
testCollectFromTo "Allows one to collect some element of a collection into another collection between a first index and an end index for the collect" "self run: #testCollectFromTo" | c1 res | c1 := #(-1 2 -3 4 -5 6 -7 8) asOrderedCollection. res := c1 collect: [:each | each abs] from: 1 to: 3. self assert: (res = #(1 2 3) asOrderedCollection). self should: [c1 collect: [:each | each abs] from: 10 to: 13] raise: Error. self should: [c1 collect: [:each | each abs] from: 5 to: 2] raise: Error. |
| ContextPart>>doPrimitive:method:receiver:args:: (md 2/20/2006 20:59 -> dik 9/3/2007 13:00) |
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message." | value | <primitive: 19> "Simulation guard" "If successful, push result and return resuming context, else ^ PrimitiveFailToken" (primitiveIndex = 19) ifTrue:[ ToolSet debugContext: self label:'Code simulation error' contents: nil]. (primitiveIndex = 80 and: [receiver isKindOf: ContextPart]) ifTrue: [^self push: ((BlockContext newForMethod: receiver home method) home: receiver home startpc: pc + 2 nargs: (arguments at: 1))]. (primitiveIndex = 81 and: [receiver isMemberOf: BlockContext]) ifTrue: [^receiver pushArgs: arguments from: self]. primitiveIndex = 83 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: arguments allButFirst super: false]. primitiveIndex = 84 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: (arguments at: 2) super: false]. primitiveIndex = 186 ifTrue: [ "closure value" | m | m _ receiver method. arguments size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: arguments receiver: receiver class: receiver class]. primitiveIndex = 187 ifTrue: [ "closure valueWithArguments:" | m args | m _ receiver method. args _ arguments first. args size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: args receiver: receiver class: receiver class]. primitiveIndex = 188 ifTrue: [ "object withArgs:executeMethod:" | m args | args _ arguments first. m _ arguments second. args size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: args receiver: receiver class: receiver class]. arguments size > 6 ifTrue: [^ PrimitiveFailToken]. primitiveIndex = 117 ifTrue:[value _ self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse:[value _ receiver tryPrimitive: primitiveIndex withArgs: arguments]. value == PrimitiveFailToken ifTrue: [^ PrimitiveFailToken] ifFalse: [^ self push: value] |
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message." | value | <primitive: 19> "Simulation guard" "If successful, push result and return resuming context, else ^ PrimitiveFailToken" (primitiveIndex = 19) ifTrue:[ ToolSet debugContext: self label:'Code simulation error' contents: nil]. (primitiveIndex = 80 and: [receiver isKindOf: ContextPart]) ifTrue: [^self push: ((BlockContext newForMethod: receiver home method) home: receiver home startpc: pc + 2 nargs: (arguments at: 1))]. (primitiveIndex = 81 and: [receiver isMemberOf: BlockContext]) ifTrue: [^receiver pushArgs: arguments from: self]. (primitiveIndex = 82 and: [receiver isMemberOf: BlockContext]) ifTrue: [^receiver pushArgs: arguments first from: self]. primitiveIndex = 83 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: arguments allButFirst super: false]. primitiveIndex = 84 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: (arguments at: 2) super: false]. primitiveIndex = 186 ifTrue: [ "closure value" | m | m _ receiver method. arguments size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: arguments receiver: receiver class: receiver class]. primitiveIndex = 187 ifTrue: [ "closure valueWithArguments:" | m args | m _ receiver method. args _ arguments first. args size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: args receiver: receiver class: receiver class]. primitiveIndex = 188 ifTrue: [ "object withArgs:executeMethod:" | m args | args _ arguments first. m _ arguments second. args size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: args receiver: receiver class: receiver class]. arguments size > 6 ifTrue: [^ PrimitiveFailToken]. primitiveIndex = 117 ifTrue:[value _ self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse:[value _ receiver tryPrimitive: primitiveIndex withArgs: arguments]. value == PrimitiveFailToken ifTrue: [^ PrimitiveFailToken] ifFalse: [^ self push: value] |
doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message." | value | <primitive: 19> "Simulation guard" "If successful, push result and return resuming context, else ^ PrimitiveFailToken" (primitiveIndex = 19) ifTrue:[ ToolSet debugContext: self label:'Code simulation error' contents: nil]. (primitiveIndex = 80 and: [receiver isKindOf: ContextPart]) ifTrue: [^self push: ((BlockContext newForMethod: receiver home method) home: receiver home startpc: pc + 2 nargs: (arguments at: 1))]. (primitiveIndex = 81 and: [receiver isMemberOf: BlockContext]) ifTrue: [^receiver pushArgs: arguments from: self]. (primitiveIndex = 82 and: [receiver isMemberOf: BlockContext]) ifTrue: [^receiver pushArgs: arguments first from: self]. primitiveIndex = 83 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: arguments allButFirst super: false]. primitiveIndex = 84 "afr 9/11/1998 19:50" ifTrue: [^ self send: arguments first to: receiver with: (arguments at: 2) super: false]. primitiveIndex = 186 ifTrue: [ "closure value" | m | m _ receiver method. arguments size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: arguments receiver: receiver class: receiver class]. primitiveIndex = 187 ifTrue: [ "closure valueWithArguments:" | m args | m _ receiver method. args _ arguments first. args size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: args receiver: receiver class: receiver class]. primitiveIndex = 188 ifTrue: [ "object withArgs:executeMethod:" | m args | args _ arguments first. m _ arguments second. args size = m numArgs ifFalse: [^ PrimitiveFailToken]. ^ self activateMethod: m withArgs: args receiver: receiver class: receiver class]. arguments size > 6 ifTrue: [^ PrimitiveFailToken]. primitiveIndex = 117 ifTrue:[value _ self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse:[value _ receiver tryPrimitive: primitiveIndex withArgs: arguments]. value == PrimitiveFailToken ifTrue: [^ PrimitiveFailToken] ifFalse: [^ self push: value] |
| ArchiveViewer>>initializeToStandAlone: (no stamp -> dls 10/22/2001 07:40) |
no previous history |
initializeToStandAlone self initialize createWindow. |
| Random>>nextInt:: (sma 5/12/2000 12:25 -> dns 8/26/2001 18:43) |
nextInt: anInteger "Answer a random integer in the interval [1, anInteger]." ^ (self next * anInteger) truncated + 1 |
nextInt: anInteger "Answer a random integer in the interval [1, anInteger]." anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ]. ^ (self next * anInteger) truncated + 1 |
nextInt: anInteger
"Answer a random integer in the interval [1, anInteger]."
anInteger strictlyPositive ifFalse: [ self error: 'Range must be positive' ].
^ (self next * anInteger) truncated + 1
|
| SerialPort>>openPort:: (jm 5/18/1998 15:37 -> dns 6/27/2000 19:49) |
openPort: portNumber "Open the given serial port, using the settings specified by my instance variables." self close. self primClosePort: portNumber. self primOpenPort: portNumber baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inputFlowControlType outFlowControlType: outputFlowControlType xOnByte: xOnByte xOffByte: xOffByte. port _ portNumber. |
openPort: portNumber "Open the given serial port, using the settings specified by my instance variables. If the port cannot be opened, such as when it is alreay in use, answer nil." "(DNS)" self close. (self primClosePort: portNumber) isNil ifTrue: [ ^ nil ]. (self primOpenPort: portNumber baudRate: baudRate stopBitsType: stopBitsType parityType: parityType dataBits: dataBits inFlowControlType: inputFlowControlType outFlowControlType: outputFlowControlType xOnByte: xOnByte xOffByte: xOffByte) isNil ifTrue: [ ^ nil ]. port _ portNumber |
openPort: portNumber "Open the given serial port, using the settings specified by my instance variables. If the port cannot be opened, such as when it is alreay in use, answer nil." "(DNS)" |
| SystemWindow>>allowReframeHandles: (no stamp -> dns 2/2/2000 14:20) |
no previous history |
allowReframeHandles ^ allowReframeHandles |
| SystemWindow>>allowReframeHandles:: (no stamp -> dns 2/2/2000 14:20) |
no previous history |
allowReframeHandles: aBoolean allowReframeHandles := aBoolean |
| Browser>>contentsSelection: (dew 7/28/2000 00:44 -> drs 1/6/2003 16:11) |
contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" messageCategoryListIndex > 1 & (messageListIndex = 0) ifTrue: [^ 1 to: 500] "entire empty method template" ifFalse: [^ 1 to: 0] "null selection" |
contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" messageCategoryListIndex > 0 & (messageListIndex = 0) ifTrue: [^ 1 to: 500] "entire empty method template" ifFalse: [^ 1 to: 0] "null selection" |
contentsSelection "Return the interval of text in the code pane to select when I set the pane's contents" messageCategoryListIndex > 0 & (messageListIndex = 0) |
| Integer>>>>: (no stamp -> dwh 8/18/1999 21:57) |
>> shiftAmount "left shift" shiftAmount < 0 ifTrue: [self error: 'negative arg']. ^ self bitShift: 0 - shiftAmount |
>> shiftAmount "right shift" shiftAmount < 0 ifTrue: [self error: 'negative arg']. ^ self bitShift: 0 - shiftAmount |
>> shiftAmount "right shift" |
| Integer>>tinyBenchmarks: (ar 9/10/1999 16:11 -> dwh 11/21/1999 16:40) |
tinyBenchmarks "Report the results of running the two tiny Squeak benchmarks. ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results" "0 tinyBenchmarks" "On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec" "On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec" | t1 t2 r n1 n2 | n1 _ 1. [t1 _ Time millisecondsToRun: [n1 benchmark]. t1 < 1000] whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)" n2 _ 28. [t2 _ Time millisecondsToRun: [r _ n2 benchFib]. t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(n^2)." ^ ((n1 * 500000 * 1000) // t1) printString, ' bytecodes/sec; ', ((r * 1000) // t2) printString, ' sends/sec' |
tinyBenchmarks "Report the results of running the two tiny Squeak benchmarks. ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results" "0 tinyBenchmarks" "On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec" "On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec" | t1 t2 r n1 n2 | n1 _ 1. [t1 _ Time millisecondsToRun: [n1 benchmark]. t1 < 1000] whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)" n2 _ 28. [t2 _ Time millisecondsToRun: [r _ n2 benchFib]. t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(k^n), where k is the golden number = (1 + 5 sqrt) / 2 = 1.618...." ^ ((n1 * 500000 * 1000) // t1) printString, ' bytecodes/sec; ', ((r * 1000) // t2) printString, ' sends/sec' |
tinyBenchmarks "Report the results of running the two tiny Squeak benchmarks. ar 9/10/1999: Adjusted to run at least 1 sec to get more stable results" "0 tinyBenchmarks" "On a 292 MHz G3 Mac: 22727272 bytecodes/sec; 984169 sends/sec" "On a 400 MHz PII/Win98: 18028169 bytecodes/sec; 1081272 sends/sec" | t1 t2 r n1 n2 | n1 _ 1. [t1 _ Time millisecondsToRun: [n1 benchmark]. t1 < 1000] whileTrue:[n1 _ n1 * 2]. "Note: #benchmark's runtime is about O(n)" n2 _ 28. [t2 _ Time millisecondsToRun: [r _ n2 benchFib]. t2 < 1000] whileTrue:[n2 _ n2 + 1]. "Note: #benchFib's runtime is about O(k^n), where k is the golden number = (1 + 5 sqrt) / 2 = 1.618...." |
| Color class>>veryPaleRed: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
veryPaleRed ^VeryPaleRed |
| Color class>>paleTan: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleTan ^PaleTan |
| Color class>>paleYellow: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleYellow ^PaleYellow |
| Color class>>paleMagenta: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleMagenta ^PaleMagenta |
| Color class>>paleGreen: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleGreen ^PaleGreen |
| Color class>>paleOrange: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleOrange ^PaleOrange |
| Color class>>palePeach: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
palePeach ^PalePeach |
| Color class>>paleBlue: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleBlue ^PaleBlue |
| Color class>>paleRed: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleRed ^PaleRed |
| Color class>>paleBuff: (no stamp -> dwh 7/7/1999 23:56) |
no previous history |
paleBuff ^PaleBuff |
| Color class>>initializeNames: (di 1/6/1999 17:44 -> dwh 7/7/1999 23:57) |
initializeNames "Name some colors." "Color initializeNames" ColorNames _ OrderedCollection new. self named: #black put: (Color r: 0 g: 0 b: 0). self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b: 0.125). self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25). self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375). self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5). self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625). self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75). self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b: 0.875). self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0). self named: #red put: (Color r: 1.0 g: 0 b: 0). self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0). self named: #green put: (Color r: 0 g: 1.0 b: 0). self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0). self named: #blue put: (Color r: 0 g: 0 b: 1.0). self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0). self named: #brown put: (Color r: 0.6 g: 0.2 b: 0). self named: #orange put: (Color r: 1.0 g: 0.6 b: 0). self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8). self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8). self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6). self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0). self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0). self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0). self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2). self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4). self named: #transparent put: (TranslucentColor new alpha: 0.0). |
initializeNames "Name some colors." "Color initializeNames" ColorNames _ OrderedCollection new. self named: #black put: (Color r: 0 g: 0 b: 0). self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b: 0.125). self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25). self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375). self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5). self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625). self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75). self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b: 0.875). self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0). self named: #red put: (Color r: 1.0 g: 0 b: 0). self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0). self named: #green put: (Color r: 0 g: 1.0 b: 0). self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0). self named: #blue put: (Color r: 0 g: 0 b: 1.0). self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0). self named: #brown put: (Color r: 0.6 g: 0.2 b: 0). self named: #orange put: (Color r: 1.0 g: 0.6 b: 0). self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8). self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8). self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6). self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0). self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0). self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0). self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2). self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4). self named: #transparent put: (TranslucentColor new alpha: 0.0). self named: #paleBuff put: (Color r: 254 g: 250 b: 235 range: 255). self named: #paleBlue put: (Color r: 222 g: 249 b: 254 range: 255). self named: #paleYellow put: (Color r: 255 g: 255 b: 217 range: 255). self named: #paleGreen put: (Color r: 223 g: 255 b: 213 range: 255). self named: #paleRed put: (Color r: 255 g: 230 b: 230 range: 255). self named: #veryPaleRed put: (Color r: 255 g: 242 b: 242 range: 255). self named: #paleTan put: (Color r: 235 g: 224 b: 199 range: 255). self named: #paleMagenta put: (Color r: 255 g: 230 b: 255 range: 255). self named: #paleOrange put: (Color r: 253 g: 237 b: 215 range: 255). self named: #palePeach put: (Color r: 255 g: 237 b: 213 range: 255). |
initializeNames "Name some colors." "Color initializeNames" ColorNames _ OrderedCollection new. self named: #black put: (Color r: 0 g: 0 b: 0). self named: #veryVeryDarkGray put: (Color r: 0.125 g: 0.125 b: 0.125). self named: #veryDarkGray put: (Color r: 0.25 g: 0.25 b: 0.25). self named: #darkGray put: (Color r: 0.375 g: 0.375 b: 0.375). self named: #gray put: (Color r: 0.5 g: 0.5 b: 0.5). self named: #lightGray put: (Color r: 0.625 g: 0.625 b: 0.625). self named: #veryLightGray put: (Color r: 0.75 g: 0.75 b: 0.75). self named: #veryVeryLightGray put: (Color r: 0.875 g: 0.875 b: 0.875). self named: #white put: (Color r: 1.0 g: 1.0 b: 1.0). self named: #red put: (Color r: 1.0 g: 0 b: 0). self named: #yellow put: (Color r: 1.0 g: 1.0 b: 0). self named: #green put: (Color r: 0 g: 1.0 b: 0). self named: #cyan put: (Color r: 0 g: 1.0 b: 1.0). self named: #blue put: (Color r: 0 g: 0 b: 1.0). self named: #magenta put: (Color r: 1.0 g: 0 b: 1.0). self named: #brown put: (Color r: 0.6 g: 0.2 b: 0). self named: #orange put: (Color r: 1.0 g: 0.6 b: 0). self named: #lightRed put: (Color r: 1.0 g: 0.8 b: 0.8). self named: #lightYellow put: (Color r: 1.0 g: 1.0 b: 0.8). self named: #lightGreen put: (Color r: 0.8 g: 1.0 b: 0.6). self named: #lightCyan put: (Color r: 0.4 g: 1.0 b: 1.0). self named: #lightBlue put: (Color r: 0.8 g: 1.0 b: 1.0). self named: #lightMagenta put: (Color r: 1.0 g: 0.8 b: 1.0). self named: #lightBrown put: (Color r: 1.0 g: 0.6 b: 0.2). self named: #lightOrange put: (Color r: 1.0 g: 0.8 b: 0.4). self named: #transparent put: (TranslucentColor new alpha: 0.0). self named: #paleBuff put: (Color r: 254 g: 250 b: 235 range: 255). self named: #paleBlue put: (Color r: 222 g: 249 b: 254 range: 255). self named: #paleYellow put: (Color r: 255 g: 255 b: 217 range: 255). self named: #paleGreen put: (Color r: 223 g: 255 b: 213 range: 255). self named: #paleRed put: (Color r: 255 g: 230 b: 230 range: 255). self named: #veryPaleRed put: (Color r: 255 g: 242 b: 242 range: 255). self named: #paleTan put: (Color r: 235 g: 224 b: 199 range: 255). self named: #paleMagenta put: (Color r: 255 g: 230 b: 255 range: 255). self named: #paleOrange put: (Color r: 253 g: 237 b: 215 range: 255). self named: #palePeach put: (Color r: 255 g: 237 b: 213 range: 255). |
| Class>>weakSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:: (ar 7/15/1999 18:56 -> dwh 11/20/1999 23:44) |
weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." ^(ClassBuilder new) superclass: self weakSubclass: t instanceVariableNames: d classVariableNames: s poolDictionaries: s category: cat |
weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." ^(ClassBuilder new) superclass: self weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat |
weakSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat "This is the standard initialization message for creating a new class as a subclass of an existing class (the receiver) in which the subclass is to have weak indexable pointer variables." ^(ClassBuilder new) superclass: self weakSubclass: t instanceVariableNames: f classVariableNames: d |
| ObjectExplorerWrapper>>asString: (hg 9/7/2001 19:58 -> edt 5/26/2003 12:36) |
asString | explorerString string | explorerString _ [item asExplorerString] on: Error do: ['<error in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. string _ (itemName ifNotNil: [itemName , ': '] ifNil: ['']) , explorerString. (string includes: Character cr) ifTrue: [^ string withSeparatorsCompacted]. ^ string |
asString | explorerString string | explorerString _ [item asExplorerString] on: Error do: ['<error: ', item class name, ' in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. string _ (itemName ifNotNil: [itemName , ': '] ifNil: ['']) , explorerString. (string includes: Character cr) ifTrue: [^ string withSeparatorsCompacted]. ^ string |
asString | explorerString string | explorerString _ [item asExplorerString] on: Error do: ['<error: ', item class name, ' in asExplorerString: evaluate "' , itemName , ' asExplorerString" to debug>']. |
| PluggableListMorph>>numSelectionsInView: (di 5/22/1998 00:32 -> ge 9/6/2006 19:02) |
numSelectionsInView ^ self height // self listItemHeight |
numSelectionsInView "Answer the scroller's height based on the average number of submorphs." (scroller submorphCount > 0) ifFalse:[ ^0 ]. "ugly hack, due to code smell. PluggableListMorph added another level of indirection, There is always only one submorph - a LazyListMorph which holds the actual list, but TransformMorph doesn't know that and we are left with a breach of interface. see vUnadjustedScrollRange for another bad example." ^scroller numberOfItemsPotentiallyInViewWith: (scroller submorphs last getListSize). |
numSelectionsInView "Answer the scroller's height based on the average number of submorphs." (scroller submorphCount > 0) ifFalse:[ ^0 ]. "ugly hack, due to code smell. PluggableListMorph added another level of indirection, There is always only one submorph - a LazyListMorph which holds the actual list, but TransformMorph doesn't know that and we are left with a breach of interface. see vUnadjustedScrollRange for another bad example." ^scroller numberOfItemsPotentiallyInViewWith: (scroller submorphs last getListSize). |
| TransformMorph>>numberOfItemsPotentiallyInViewWith:: (no stamp -> ge 9/6/2006 17:51) |
no previous history |
numberOfItemsPotentiallyInViewWith: submorphCount "Answer the number of items that could potentially be viewed in full, computed as my visible height divided by the average height of my submorphs. Ignore visibility of submorphs." ^self innerBounds height // (self localSubmorphBounds height / submorphCount) |
| Object>>notify:: (tk 4/16/1998 15:54 -> hg 10/2/2001 20:49) |
notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Debugger openContext: thisContext label: 'Notifier' contents: aString "nil notify: 'confirmation message'" |
notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Warning signal: aString "nil notify: 'confirmation message'" |
notify: aString "Create and schedule a Notifier with the argument as the message in order to request confirmation before a process can proceed." Warning signal: aString |
| Object>>initialDeepCopierSize: (no stamp -> hg 11/23/1999 13:43) |
no previous history |
initialDeepCopierSize "default value is 4096; other classes may override this, esp. for smaller (=faster) sizes" ^4096 |
| BitBlt>>cachedFontColormapFrom:to:: (no stamp -> hg 6/27/2000 12:27) |
no previous history |
cachedFontColormapFrom: sourceDepth to: destDepth | srcIndex map | CachedFontColorMaps class == Array ifFalse: [CachedFontColorMaps _ (1 to: 9) collect: [:i | Array new: 32]]. srcIndex _ sourceDepth. sourceDepth > 8 ifTrue: [srcIndex _ 9]. (map _ (CachedFontColorMaps at: srcIndex) at: destDepth) ~~ nil ifTrue: [^ map]. map _ (Color cachedColormapFrom: sourceDepth to: destDepth) copy. (CachedFontColorMaps at: srcIndex) at: destDepth put: map. ^ map |
| PseudoClass>>fileOutDefinitionOn:: (no stamp -> hg 9/6/2000 12:45) |
fileOutDefinitionOn: aStream self hasDefinition ifFalse:[^self]. aStream nextChunkPut: self definition; cr. self hasComment ifTrue:[ aStream cr; nextPut: $!; nextChunkPut: self name,' comment: '; cr. aStream nextChunkPut: self commentString printString. ]. |
fileOutDefinitionOn: aStream self hasDefinition ifFalse:[^self]. aStream nextChunkPut: self definition; cr. self hasComment ifTrue: [aStream cr. self organization commentRemoteStr fileOutOn: aStream] |
fileOutDefinitionOn: aStream self hasDefinition ifFalse:[^self]. aStream nextChunkPut: self definition; cr. self hasComment ifTrue: [aStream cr. self organization commentRemoteStr fileOutOn: aStream] |
| FileList2>>openProjectFromFile: (no stamp -> hg 8/3/2000 16:55) |
no previous history |
openProjectFromFile "Reconstitute a Morph from the selected file, presumed to be represent a Morph saved via the SmartRefStream mechanism, and open it in an appropriate Morphic world." Project canWeLoadAProjectNow ifFalse: [^ self]. ProjectViewMorph openFromDirectory: directory andFileName: fileName |
| FileContentsBrowser class>>initialize: (no stamp -> hg 8/3/2000 18:17) |
no previous history |
initialize FileList registerFileReader: self |
| ChangeList class>>initialize: (no stamp -> hg 8/3/2000 18:14) |
no previous history |
initialize FileList registerFileReader: self |
| Inspector>>selectedSlotName: (tk 10/27/2000 14:59 -> hg 10/8/2000 14:46) |
selectedSlotName ^ self fieldList at: selectionIndex |
selectedSlotName ^ self fieldList at: self selectionIndex |
selectedSlotName ^ self fieldList at: self selectionIndex |
| ExternalStructureInspector>>fieldList: (no stamp -> hg 2/28/2000 14:20) |
no previous history |
fieldList ^ (Array with: 'self: ', object defaultLabelForInspector with: 'all inst vars'), self recordFieldList |
| ExternalStructureInspector>>replaceSelectionValue:: (no stamp -> hg 2/28/2000 14:12) |
no previous history |
replaceSelectionValue: anObject "Add colon to fieldname to get setter selector, and send it to object with the argument. Refer to the comment in Inspector|replaceSelectionValue:." selectionIndex = 1 ifTrue: [^object] ifFalse: [^object perform: ((self fieldList at: selectionIndex), ':') asSymbol with: anObject] |
| ExternalStructureInspector>>selection: (no stamp -> hg 2/28/2000 14:22) |
no previous history |
selection "Refer to the comment in Inspector|selection." selectionIndex = 0 ifTrue:[^object printString]. selectionIndex = 1 ifTrue: [^object]. selectionIndex = 2 ifTrue:[^object longPrintString]. selectionIndex > 2 ifTrue: [^object perform: (self fieldList at: selectionIndex)] |
| ObjectExplorer>>label: (no stamp -> hg 9/7/2001 12:12) |
no previous history |
label ^ rootObject printStringLimitedTo: 32 |
| SimpleServiceEntry class>>provider:label:selector:: (no stamp -> hg 8/1/2000 18:57) |
no previous history |
provider: anObject label: aString selector: aSymbol ^self new provider: anObject label: aString selector: aSymbol |
| SimpleServiceEntry>>requestSelector: (no stamp -> hg 8/1/2000 19:49) |
no previous history |
requestSelector "send me this message to ask me to perform my service" ^#performServiceFor: |
| SimpleServiceEntry>>useLineAfter: (no stamp -> hg 8/1/2000 19:53) |
no previous history |
useLineAfter ^useLineAfter == true |
| SimpleServiceEntry>>useLineAfter:: (no stamp -> hg 8/1/2000 19:54) |
no previous history |
useLineAfter: aBoolean useLineAfter _ aBoolean |
| SimpleServiceEntry>>label: (no stamp -> hg 8/3/2000 13:06) |
no previous history |
label ^label |
| Collection>>topologicallySortedUsing:: (hg 12/26/2001 23:53 -> hg 12/26/2001 23:53) |
topologicallySortedUsing: aSortBlock "Answer a SortedCollection whose elements are the elements of the receiver, but topologically sorted. The topological order is defined by the argument, aSortBlock." | aSortedCollection | aSortedCollection _ SortedCollection new: self size. aSortedCollection sortBlock: aSortBlock. self do: [:each | aSortedCollection addLast: each]. "avoids sorting" ^ aSortedCollection sortTopologically |
topologicallySortedUsing: aSortBlock "Answer a SortedCollection whose elements are the elements of the receiver, but topologically sorted. The topological order is defined by the argument, aSortBlock." | aSortedCollection | aSortedCollection := SortedCollection new: self size. aSortedCollection sortBlock: aSortBlock. self do: [:each | aSortedCollection addLast: each]. "avoids sorting" ^ aSortedCollection sortTopologically |
topologicallySortedUsing: aSortBlock "Answer a SortedCollection whose elements are the elements of the receiver, but topologically sorted. The topological order is defined by the argument, aSortBlock." | aSortedCollection | aSortedCollection := SortedCollection new: self size. |
| SequenceableCollection>>explorerContents: (no stamp -> hg 9/7/2001 12:01) |
no previous history |
explorerContents ^self asOrderedCollection withIndexCollect: [:value :index | ObjectExplorerWrapper with: value name: index printString model: self] |
| SortedCollection>>sort:to:: (hg 12/17/2001 20:22 -> hg 12/17/2001 20:22) |
sort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock." | di dij dj tt ij k l n | "The prefix d means the data at that index." (n _ j + 1 - i) <= 1 ifTrue: [^self]. "Nothing to sort." "Sort di,dj." di _ array at: i. dj _ array at: j. (self should: di precede: dj) ifFalse: [array swap: i with: j. tt _ di. di _ dj. dj _ tt]. n > 2 ifTrue: "More than two elements." [ij _ (i + j) // 2. "ij is the midpoint of i and j." dij _ array at: ij. "Sort di,dij,dj. Make dij be their median." (self should: di precede: dij) ifTrue: [(self should: dij precede: dj) ifFalse: [array swap: j with: ij. dij _ dj]] ifFalse: [array swap: i with: ij. dij _ di]. n > 3 ifTrue: "More than three elements." ["Find k>i and l<j such that dk,dij,dl are in reverse order. Swap k and l. Repeat this procedure until k and l pass each other." k _ i. l _ j. [[l _ l - 1. k <= l and: [self should: dij precede: (array at: l)]] whileTrue. "i.e. while dl succeeds dij" [k _ k + 1. k <= l and: [self should: (array at: k) precede: dij]] whileTrue. "i.e. while dij succeeds dk" k <= l] whileTrue: [array swap: k with: l]. "Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk through dj. Sort those two segments." self sort: i to: l. self sort: k to: j]] |
sort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock." | di dij dj tt ij k l n | "The prefix d means the data at that index." (n := j + 1 - i) <= 1 ifTrue: [^self]. "Nothing to sort." "Sort di,dj." di := array at: i. dj := array at: j. (self should: di precede: dj) ifFalse: [array swap: i with: j. tt := di. di := dj. dj := tt]. n > 2 ifTrue: "More than two elements." [ij := (i + j) // 2. "ij is the midpoint of i and j." dij := array at: ij. "Sort di,dij,dj. Make dij be their median." (self should: di precede: dij) ifTrue: [(self should: dij precede: dj) ifFalse: [array swap: j with: ij. dij := dj]] ifFalse: [array swap: i with: ij. dij := di]. n > 3 ifTrue: "More than three elements." ["Find k>i and l<j such that dk,dij,dl are in reverse order. Swap k and l. Repeat this procedure until k and l pass each other." k := i. l := j. [[l := l - 1. k <= l and: [self should: dij precede: (array at: l)]] whileTrue. "i.e. while dl succeeds dij" [k := k + 1. k <= l and: [self should: (array at: k) precede: dij]] whileTrue. "i.e. while dij succeeds dk" k <= l] whileTrue: [array swap: k with: l]. "Now l<k (either 1 or 2 less), and di through dl are all less than or equal to dk through dj. Sort those two segments." self sort: i to: l. self sort: k to: j]] |
sort: i to: j "Sort elements i through j of self to be nondescending according to sortBlock." | di dij dj tt ij k l n | "The prefix d means the data at that index." (n := j + 1 - i) <= 1 ifTrue: [^self]. "Nothing to sort." |
| SortedCollection>>sortTopologically: (hg 1/2/2002 13:34 -> hg 1/2/2002 13:34) |
sortTopologically "Plenty of room for increased efficiency in this one." | remaining result pick | remaining _ self asOrderedCollection. result _ OrderedCollection new. [remaining isEmpty] whileFalse: [ pick _ remaining select: [:item | remaining allSatisfy: [:anotherItem | item == anotherItem or: [self should: item precede: anotherItem]]]. pick isEmpty ifTrue: [self error: 'bad topological ordering']. result addAll: pick. remaining removeAll: pick]. ^self copySameFrom: result |
sortTopologically "Plenty of room for increased efficiency in this one." | remaining result pick | remaining := self asOrderedCollection. result := OrderedCollection new. [remaining isEmpty] whileFalse: [ pick := remaining select: [:item | remaining allSatisfy: [:anotherItem | item == anotherItem or: [self should: item precede: anotherItem]]]. pick isEmpty ifTrue: [self error: 'bad topological ordering']. result addAll: pick. remaining removeAll: pick]. ^self copySameFrom: result |
sortTopologically "Plenty of room for increased efficiency in this one." | remaining result pick | remaining := self asOrderedCollection. result := OrderedCollection new. |
| SortedCollection>>should:precede:: (no stamp -> hg 12/17/2001 19:30) |
no previous history |
should: a precede: b ^sortBlock ifNil: [a <= b] ifNotNil: [sortBlock value: a value: b] |
| Set>>hasContentsInExplorer: (bf 3/16/2000 18:06 -> hg 9/7/2001 11:51) |
hasContentsInExplorer ^self isEmpty not |
hasContentsInExplorer ^self isEmpty not |
hasContentsInExplorer ^self isEmpty not |
| Set>>explorerContents: (no stamp -> hg 9/7/2001 11:51) |
no previous history |
explorerContents ^self asOrderedCollection withIndexCollect: [:each :index | ObjectExplorerWrapper with: each name: index printString model: self] |
| Dictionary>>explorerContents: (hg 10/3/2001 20:47 -> hg 10/3/2001 20:47) |
explorerContents | contents | contents _ OrderedCollection new. self keysSortedSafely do: [:key | contents add: (ObjectExplorerWrapper with: (self at: key) name: (key printString contractTo: 32) model: self)]. ^contents |
explorerContents | contents | contents := OrderedCollection new. self keysSortedSafely do: [:key | contents add: (ObjectExplorerWrapper with: (self at: key) name: (key printString contractTo: 32) model: self)]. ^contents |
explorerContents | contents | contents := OrderedCollection new. |
| FileStream class>>initialize: (no stamp -> hg 8/3/2000 18:00) |
no previous history |
initialize FileList registerFileReader: self |
| FileDirectory>>assureExistence: (hg 9/29/2001 14:34 -> hg 2/2/2002 16:37) |
assureExistence "Make sure the current directory exists. If necessary, create all parts inbetween" ^self containingDirectory assurePathExists: self localName |
assureExistence "Make sure the current directory exists. If necessary, create all parts in between" self containingDirectory assureExistenceOfPath: self localName |
assureExistence "Make sure the current directory exists. If necessary, create all parts in between" self containingDirectory assureExistenceOfPath: self localName |
| MacFileDirectory class>>maxFileNameLength: (no stamp -> hg 9/28/2001 15:23) |
no previous history |
maxFileNameLength ^31 |
| Form class>>openAsBackground:: (no stamp -> hg 8/3/2000 16:26) |
no previous history |
openAsBackground: fullName "Set an image as a background image. Support Squeak's common file format (GIF, JPG, PNG, 'Form stoteOn: (run coded)' and BMP)" (self fromFileNamed: fullName) setAsBackground |
| Form class>>rgbMul: (no stamp -> hg 1/29/2001 17:28) |
no previous history |
rgbMul "Answer the integer denoting 'Multiply each color component, their values regarded as fractions of 1' rule." ^ 37 |
| Form class>>initialize: (no stamp -> hg 8/3/2000 16:25) |
no previous history |
initialize FileList registerFileReader: self |
| Morph class>>initialize: (no stamp -> hg 8/3/2000 16:43) |
initialize "Morph initialize" "this empty array object is shared by all morphs with no submorphs:" EmptyArray _ Array new. |
initialize "Morph initialize" "this empty array object is shared by all morphs with no submorphs:" EmptyArray _ Array new. FileList registerFileReader: self |
initialize
"Morph initialize"
"this empty array object is shared by all morphs with no submorphs:"
EmptyArray _ Array new.
FileList registerFileReader: self
|
| ProjectViewMorph class>>initialize: (no stamp -> hg 8/3/2000 16:54) |
no previous history |
initialize FileList registerFileReader: self |
| MenuItemMorph>>isEnabled:: (jm 11/4/97 07:46 -> hg 12/8/2001 13:22) |
isEnabled: aBoolean isEnabled = aBoolean ifTrue: [^ self]. isEnabled _ aBoolean. self color: (aBoolean ifTrue: [Color black] ifFalse: [Color gray]). |
isEnabled: aBoolean isEnabled = aBoolean ifTrue: [^ self]. isEnabled _ aBoolean. self color: (aBoolean ifTrue: [Color black] ifFalse: [Color lightGray]). |
isEnabled: aBoolean isEnabled = aBoolean ifTrue: [^ self]. isEnabled _ aBoolean. self color: (aBoolean ifTrue: [Color black] ifFalse: [Color lightGray]). |
| MenuItemMorph>>deselectItem: (di 2/23/98 16:24 -> hg 8/3/2000 15:21) |
deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. |
deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. |
deselectItem | item | self isSelected: false. subMenu ifNotNil: [subMenu deleteIfPopUp]. (owner isKindOf: MenuMorph) ifTrue: [item _ owner popUpOwner. (item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]]. |
| ScorePlayerMorph class>>initialize: (no stamp -> hg 8/3/2000 17:27) |
no previous history |
initialize FileList registerFileReader: self |
| EventRecorderMorph class>>initialize: (no stamp -> hg 8/3/2000 17:25) |
no previous history |
initialize FileList registerFileReader: self |
| MenuMorph>>add:target:selector:argumentList:: (sw 11/6/2000 13:44 -> hg 8/3/2000 15:22) |
add: aString target: target selector: aSymbol argumentList: argList "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument. Answer the appended menu item." | item | item _ MenuItemMorph new contents: aString; target: target; selector: aSymbol; arguments: argList asArray. self addMorphBack: item. ^ item |
add: aString target: target selector: aSymbol argumentList: argList "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument." | item | item _ MenuItemMorph new contents: aString; target: target; selector: aSymbol; arguments: argList asArray. self addMorphBack: item. |
add: aString target: target selector: aSymbol argumentList: argList "Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument." |
| MenuMorph>>items: (jm 11/4/97 07:46 -> hg 8/3/2000 15:29) |
items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] |
items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] |
items ^ submorphs select: [:m | m isKindOf: MenuItemMorph] |
| MenuMorph>>deleteIfPopUp: (di 10/28/1999 09:50 -> hg 8/3/2000 15:28) |
deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. |
deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. |
deleteIfPopUp "Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu." stayUp ifFalse: [self topRendererOrSelf delete]. (popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [ popUpOwner isSelected: false. (popUpOwner owner isKindOf: MenuMorph) ifTrue: [popUpOwner owner deleteIfPopUp]]. |
| SimpleButtonMorph>>updateVisualState:: (no stamp -> hg 6/27/2000 13:58) |
no previous history |
updateVisualState: evt oldColor ifNotNil: [ self color: ((self containsPoint: evt cursorPoint) ifTrue: [oldColor mixed: 1/2 with: Color white] ifFalse: [oldColor])] |
| HTTPSocket class>>userAgentString: (no stamp -> hg 2/11/2002 11:31) |
no previous history |
userAgentString "self userAgentString" ^'User-Agent: ', SystemVersion current version, '-', SystemVersion current highestUpdate printString |
| HTTPSocket class>>httpGet:args:accept:: (md 9/6/2005 15:59 -> hg 2/12/2002 11:39) |
httpGet: url args: args accept: mimeType ^self httpGet: url args: args accept: mimeType request: '' |
httpGet: url args: args accept: mimeType ^self httpGet: url args: args accept: mimeType request: '' |
httpGet: url args: args accept: mimeType ^self httpGet: url args: args accept: mimeType request: '' |
| HTTPSocket>>getRestOfBuffer:: (mir 6/15/2001 17:51 -> hg 2/11/2002 20:13) |
getRestOfBuffer: beginning "We don't know the length. Keep going until connection is closed. Part of it has already been received. Response is of type text, not binary." | buf response bytesRead | response _ RWBinaryOrTextStream on: (String new: 2000). response nextPutAll: beginning. buf _ String new: 2000. [self isConnected | self dataAvailable] whileTrue: [ (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was slow'; cr]. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size. bytesRead > 0 ifTrue: [ response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ]. Transcript cr; show: 'data byte count: ', response position printString. response reset. "position: 0." ^ response |
getRestOfBuffer: beginning "We don't know the length. Keep going until connection is closed. Part of it has already been received. Response is of type text, not binary." | buf response bytesRead | response _ RWBinaryOrTextStream on: (String new: 2000). response nextPutAll: beginning. buf _ String new: 2000. [self isConnected | self dataAvailable] whileTrue: [ (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was slow'; cr]. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size. bytesRead > 0 ifTrue: [ response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ]. self logToTranscript ifTrue: [ Transcript cr; show: 'data byte count: ', response position printString]. response reset. "position: 0." ^ response |
getRestOfBuffer: beginning "We don't know the length. Keep going until connection is closed. Part of it has already been received. Response is of type text, not binary." | buf response bytesRead | response _ RWBinaryOrTextStream on: (String new: 2000). response nextPutAll: beginning. buf _ String new: 2000. [self isConnected | self dataAvailable] whileTrue: [ (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was slow'; cr]. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size. bytesRead > 0 ifTrue: [ response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ]. self logToTranscript ifTrue: [ Transcript cr; show: 'data byte count: ', response position printString]. |
| HTTPSocket>>getResponseUpTo:: (tk 9/22/1998 11:39 -> hg 2/11/2002 13:55) |
getResponseUpTo: markerString "Keep reading until the marker is seen. Return three parts: header, marker, beginningOfData. Fails if no marker in first 2000 chars." | buf response bytesRead tester mm | buf _ String new: 2000. response _ WriteStream on: buf. tester _ 1. mm _ 1. [tester _ tester - markerString size + 1 max: 1. "rewind a little, in case the marker crosses a read boundary" tester to: response position do: [:tt | (buf at: tt) = (markerString at: mm) ifTrue: [mm _ mm + 1] ifFalse: [mm _ 1]. "Not totally correct for markers like xx0xx" mm > markerString size ifTrue: ["got it" ^ Array with: (buf copyFrom: 1 to: tt+1-mm) with: markerString with: (buf copyFrom: tt+1 to: response position)]]. tester _ 1 max: response position. "OK if mm in the middle" (response position < buf size) & (self isConnected | self dataAvailable)] whileTrue: [ (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was late'; cr]. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: response position + 1 count: buf size - response position. "response position+1 to: response position+bytesRead do: [:ii | response nextPut: (buf at: ii)]. totally redundant, but needed to advance position!" response instVarAt: 2 "position" put: (response position + bytesRead)]. "horrible, but fast" ^ Array with: response contents with: '' with: '' "Marker not found and connection closed" |
getResponseUpTo: markerString "Keep reading until the marker is seen. Return three parts: header, marker, beginningOfData. Fails if no marker in first 2000 chars." | buf response bytesRead tester mm tries | buf _ String new: 2000. response _ WriteStream on: buf. tester _ 1. mm _ 1. tries _ 3. [tester _ tester - markerString size + 1 max: 1. "rewind a little, in case the marker crosses a read boundary" tester to: response position do: [:tt | (buf at: tt) = (markerString at: mm) ifTrue: [mm _ mm + 1] ifFalse: [mm _ 1]. "Not totally correct for markers like xx0xx" mm > markerString size ifTrue: ["got it" ^ Array with: (buf copyFrom: 1 to: tt+1-mm) with: markerString with: (buf copyFrom: tt+1 to: response position)]]. tester _ 1 max: response position. "OK if mm in the middle" (response position < buf size) & (self isConnected | self dataAvailable) & ((tries _ tries - 1) >= 0)] whileTrue: [ (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: ' <response was late> ']. bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: response position + 1 count: buf size - response position. "response position+1 to: response position+bytesRead do: [:ii | response nextPut: (buf at: ii)]. totally redundant, but needed to advance position!" response instVarAt: 2 "position" put: (response position + bytesRead)]. "horrible, but fast" ^ Array with: response contents with: '' with: '' "Marker not found and connection closed" |
getResponseUpTo: markerString "Keep reading until the marker is seen. Return three parts: header, marker, beginningOfData. Fails if no marker in first 2000 chars." | buf response bytesRead tester mm tries | |
| HTTPSocket>>logToTranscript: (no stamp -> hg 2/11/2002 19:47) |
no previous history |
logToTranscript ^LogToTranscript == true |
| SecurityManager>>storeSecurityKeys: (sw 1/25/2002 12:41 -> hg 9/29/2001 14:35) |
storeSecurityKeys
"Store the keys file for the current user"
"SecurityManager default storeSecurityKeys"
| fd loc file |
self isInRestrictedMode ifTrue:[^self]. "no point in even trying"
loc _ self secureUserDirectory. "where to put it"
loc last = FileDirectory pathNameDelimiter ifFalse:
[loc _ loc copyWith: FileDirectory pathNameDelimiter].
fd _ FileDirectory on: loc.
fd assureExistence.
fd deleteFileNamed: self keysFileName ifAbsent:[].
file _ fd newFileNamed: self keysFileName.
{privateKeyPair. trustedKeys} storeOn: file.
file close
|
storeSecurityKeys
"SecurityManager default storeSecurityKeys"
"Store the keys file for the current user"
| fd loc file |
self isInRestrictedMode ifTrue:[^self]. "no point in even trying"
loc _ self secureUserDirectory. "where to put it"
loc last = FileDirectory pathNameDelimiter ifFalse:[
loc _ loc copyWith: FileDirectory pathNameDelimiter.
].
fd _ FileDirectory on: loc.
fd assureExistence.
fd deleteFileNamed: self keysFileName ifAbsent:[].
file _ fd newFileNamed: self keysFileName.
{privateKeyPair. trustedKeys} storeOn: file.
file close.
|
storeSecurityKeys |
| MessageNode>>checkBlock:as:from:: (no stamp -> hg 10/2/2001 21:08) |
checkBlock: node as: nodeName from: encoder node canBeSpecialArgument ifTrue: [^node isMemberOf: BlockNode]. ((node isKindOf: BlockNode) and: [node numberOfArguments > 0]) ifTrue: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be 0-argument block'] ifFalse: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be a block or variable'] |
checkBlock: node as: nodeName from: encoder node canBeSpecialArgument ifTrue: [^node isMemberOf: BlockNode]. ((node isKindOf: BlockNode) and: [node numberOfArguments > 0]) ifTrue: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be a 0-argument block'] ifFalse: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be a block or variable'] |
checkBlock: node as: nodeName from: encoder node canBeSpecialArgument ifTrue: [^node isMemberOf: BlockNode]. ((node isKindOf: BlockNode) and: [node numberOfArguments > 0]) ifTrue: [^encoder notify: '<- ', nodeName , ' of ' , (MacroSelectors at: special) , ' must be a 0-argument block'] |
| DeepCopier>>initialize: (tk 8/22/1998 11:25 -> hg 11/23/1999 13:36) |
initialize references _ IdentityDictionary new: 4096. uniClasses _ IdentityDictionary new. "UniClass -> new UniClass" (self identityHash // 16 bitAnd: 7) = 1 ifTrue: [self checkVariables]. "Just check once in a while" |
initialize self initialize: 4096. |
initialize self initialize: 4096. |
| FileDirectoryTest>>myDirectory: (no stamp -> hg 2/2/2002 16:42) |
no previous history |
myDirectory ^FileDirectory default directoryNamed: self myLocalDirectoryName |
| FileDirectoryTest>>myLocalDirectoryName: (no stamp -> hg 2/2/2002 16:42) |
no previous history |
myLocalDirectoryName ^'zTestDir' |
| FileDirectoryTest>>myAssuredDirectory: (no stamp -> hg 2/2/2002 16:44) |
no previous history |
myAssuredDirectory ^self myDirectory assureExistence |
| FileDirectoryTest>>testDirectoryNamed: (no stamp -> hg 2/2/2002 16:44) |
no previous history |
testDirectoryNamed self should: [(self myDirectory containingDirectory directoryNamed: self myLocalDirectoryName) pathName = self myDirectory pathName] |
| ServerDirectory class>>on:: (no stamp -> hg 9/21/2001 16:40) |
no previous history |
on: pathString ^self new on: pathString |
| ServerDirectory class>>transferServerDefinitionsToExternal: (sw 1/25/2002 12:42 -> hg 9/29/2001 14:35) |
transferServerDefinitionsToExternal "Transfer server definitions to external" "ServerDirectory transferServerDefinitionsToExternal" | serverDir | serverDir _ ExternalSettings assuredPreferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir assureExistence. ServerDirectory storeCurrentServersIn: serverDir |
transferServerDefinitionsToExternal "ServerDirectory transferServerDefinitionsToExternal" | serverDir | serverDir _ ExternalSettings preferenceDirectory directoryNamed: self serverConfDirectoryName. serverDir assureExistence. ServerDirectory storeCurrentServersIn: serverDir |
transferServerDefinitionsToExternal |
| ServerDirectory>>isRoot: (no stamp -> hg 9/29/2001 15:58) |
no previous history |
isRoot ^directory = (String with: self pathNameDelimiter) |
| ServerDirectory>>getFileNamed:into:: (RAA 6/23/2000 09:47 -> hg 2/12/2002 11:44) |
getFileNamed: fileNameOnServer into: dataStream "Just FTP a file from a server. Return a stream. (Later -- Use a proxy server if one has been registered.)" | so dd resp rr | self isTypeFile ifTrue: [ dataStream nextPutAll: (resp _ FileStream oldFileNamed: server,(self serverDelimiter asString), self bareDirectory, (self serverDelimiter asString), fileNameOnServer) contentsOfEntireFile. dataStream dataIsValid. ^ resp]. self isTypeHTTP ifTrue: [ resp _ HTTPSocket httpGet: (self fullNameFor: fileNameOnServer) accept: 'application/octet-stream'. resp class == String ifTrue: [^ dataStream]. "error, no data" dataStream copyFrom: resp. dataStream dataIsValid. ^ dataStream]. so _ self openFTP. "Open passive. Do everything up to RETR or STOR" so class == String ifTrue: ["error, was reported" ^ so]. so sendCommand: 'RETR ', fileNameOnServer. dd _ so dataSocket. dd connectTo: so remoteAddress port: dd portNum. dd waitForConnectionUntil: FTPSocket standardDeadline. Transcript show: 'retrieving file ', fileNameOnServer; cr. "Transcript show: 'retrieve from port ', dd portNum printString; cr." resp _ dd getDataTo: dataStream whileWatching: so. "Later use the length to pre-allocate the buffer" (resp == #error:) ifTrue: [socket _ nil. ^ resp]. dd close. (rr _ so responseOK) == true ifFalse: [ socket _ nil. ^ rr]. "150 Opening binary conn on foo (3113 bytes)" (rr _ so responseOK) == true ifFalse: [ socket _ nil. ^ rr]. "226 Transfer complete." socket ifNil: ["normally leave connection open. Don't quit" so sendCommand: 'QUIT'. (rr _ so responseOK) == true ifFalse: [^ rr]. "221" so destroy]. "Always OK to destroy" dd destroy. dataStream dataIsValid. ^ resp "String with just the data" |
getFileNamed: fileNameOnServer into: dataStream ^self getFileNamed: fileNameOnServer into: dataStream httpRequest: 'Pragma: no-cache', String crlf |
getFileNamed: fileNameOnServer into: dataStream ^self getFileNamed: fileNameOnServer into: dataStream httpRequest: 'Pragma: no-cache', String crlf |
| ServerDirectory>>fileNames: (RAA 6/23/2000 09:46 -> hg 2/8/2002 00:04) |
fileNames "Return a collection of names for the files (but not directories) in this directory." "(ServerDirectory serverNamed: 'UIUCArchive') fileNames" self isTypeFTP | self isTypeFile ifFalse: [ ^ self error: 'To see a directory, use file:// or ftp://' ]. ^ (self entries select: [:entry | (entry at: 4) not]) collect: [:entry | entry first] |
fileNames "Return a collection of names for the files (but not directories) in this directory." "(ServerDirectory serverNamed: 'UIUCArchive') fileNames" ^ self entries select: [:entry | (entry at: 4) not] thenCollect: [:entry | entry first] |
fileNames "Return a collection of names for the files (but not directories) in this directory." "(ServerDirectory serverNamed: 'UIUCArchive') fileNames" ^ self entries select: [:entry | (entry at: 4) not] thenCollect: [:entry | entry first] |
| ServerDirectory>>directoryNamed:: (sbw 8/21/2001 09:36 -> hg 2/8/2002 17:44) |
directoryNamed: localFileName "Return a copy of me pointing at this directory below me" | new newPath | new _ self copy. urlObject ifNotNil: [new urlObject path: new urlObject path copy. new urlObject path removeLast; addLast: localFileName; addLast: ''. ^ new]. "sbw. When working from an FTP server, the first time we access a subdirectory the <directory> variable is empty. In that case we cannot begin with a leading path delimiter since that leads us to the wrong place." newPath _ directory isEmpty ifTrue: [localFileName] ifFalse: [directory , self pathNameDelimiter asString , localFileName]. new directory: newPath. ^ new |
directoryNamed: localFileName "Return a copy of me pointing at this directory below me" | new newPath newAltUrl | new _ self copy. urlObject ifNotNil: [new urlObject path: new urlObject path copy. new urlObject path removeLast; addLast: localFileName; addLast: ''. ^ new]. "sbw. When working from an FTP server, the first time we access a subdirectory the <directory> variable is empty. In that case we cannot begin with a leading path delimiter since that leads us to the wrong place." newPath _ directory isEmpty ifTrue: [localFileName] ifFalse: [directory , self pathNameDelimiter asString , localFileName]. self altUrl ifNotNil: [ newAltUrl _ self altUrl, self pathNameDelimiter asString , localFileName]. new directory: newPath; altUrl: newAltUrl. ^ new |
directoryNamed: localFileName "Return a copy of me pointing at this directory below me" | new newPath newAltUrl | |
| ServerDirectory>>containingDirectory: (no stamp -> hg 9/29/2001 15:23) |
no previous history |
containingDirectory self splitName: directory to: [:parentPath :localName | ^self copy directory: parentPath] |
| ServerDirectory>>fullNameFor:: (tk 9/19/1998 19:29 -> hg 2/8/2002 17:39) |
fullNameFor: aFileName "Convention: If it is an absolute path, directory stored with a leading slash, and url has no user@. If relative path, directory stored with no leading slash, and url begins user@. Should we include ftp:// on the front?" urlObject ifNotNil: [^ urlObject pathString, aFileName]. (aFileName includes: self pathNameDelimiter) ifTrue: [^ aFileName]. directory isEmpty ifTrue: [^ server, self pathNameDelimiter asString, aFileName]. ^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), server, self slashDirectory, self pathNameDelimiter asString, aFileName |
fullNameFor: aFileName "Convention: If it is an absolute path, directory stored with a leading slash, and url has no user@. If relative path, directory stored with no leading slash, and url begins user@. Should we include ftp:// on the front?" urlObject ifNotNil: [^ urlObject pathString, aFileName]. (aFileName includes: self pathNameDelimiter) ifTrue: [^ aFileName]. self isTypeHTTP ifTrue: [ ^ self downloadUrl, aFileName]. directory isEmpty ifTrue: [^ server, self pathNameDelimiter asString, aFileName]. ^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), server, self slashDirectory, self pathNameDelimiter asString, aFileName |
fullNameFor: aFileName "Convention: If it is an absolute path, directory stored with a leading slash, and url has no user@. If relative path, directory stored with no leading slash, and url begins user@. Should we include ftp:// on the front?" urlObject ifNotNil: [^ urlObject pathString, aFileName]. (aFileName includes: self pathNameDelimiter) ifTrue: [^ aFileName]. self isTypeHTTP ifTrue: [ ^ self downloadUrl, aFileName]. directory isEmpty ifTrue: [^ server, self pathNameDelimiter asString, aFileName]. ^ (directory first == $/ ifTrue: [''] ifFalse: [user,'@']), server, self slashDirectory, self pathNameDelimiter asString, aFileName |
| ServerDirectory>>localName: (no stamp -> hg 9/29/2001 15:35) |
no previous history |
localName directory isEmpty ifTrue: [self error: 'no directory']. ^self localNameFor: directory |
| ServerDirectory>>localPathExists:: (no stamp -> hg 9/29/2001 14:57) |
no previous history |
localPathExists: localPath ^self directoryNames includes: localPath |
| ServerDirectory>>fileExists:: (hg 9/29/2001 16:25 -> hg 2/5/2002 16:50) |
fileExists: fileName "Does the file exist on this server directory? fileName must be simple with no / or references to other directories." self isTypeFile ifTrue: [^ self fileNames includes: fileName]. self isTypeHTTP ifTrue: [^ (self readOnlyFileNamed: fileName) class ~~ String]. "ftp" ^ self entries anySatisfy: [:entry | entry name = fileName] |
fileExists: fileName "Does the file exist on this server directory? fileName must be simple with no / or references to other directories." | stream | self isTypeFile ifTrue: [^ self fileNames includes: fileName]. self isTypeHTTP ifTrue: [ stream _ self readOnlyFileNamed: fileName. ^stream contents notEmpty]. "ftp" ^ self entries anySatisfy: [:entry | entry name = fileName] |
fileExists: fileName "Does the file exist on this server directory? fileName must be simple with no / or references to other directories." | stream | self isTypeFile ifTrue: [^ self fileNames includes: fileName]. self isTypeHTTP ifTrue: [ stream _ self readOnlyFileNamed: fileName. ^stream contents notEmpty]. |
| Float>>/: (tfei 4/12/1999 12:45 -> hh 10/3/2000 11:46) |
/ aNumber "Primitive. Answer the result of dividing receiver by aNumber. Fail if the argument is not a Float. Essential. See Object documentation whatIsAPrimitive." <primitive: 50> aNumber = 0 ifTrue: [^(ZeroDivide dividend: self) signal]. ^ aNumber adaptToFloat: self andSend: #/ |
/ aNumber "Primitive. Answer the result of dividing receiver by aNumber. Fail if the argument is not a Float. Essential. See Object documentation whatIsAPrimitive." <primitive: 50> aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. ^ aNumber adaptToFloat: self andSend: #/ |
/ aNumber "Primitive. Answer the result of dividing receiver by aNumber. Fail if the argument is not a Float. Essential. See Object documentation whatIsAPrimitive." <primitive: 50> aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. |
| Integer>>\\\: (no stamp -> hh 8/4/2000 00:39) |
no previous history |
\\\ anInteger "a modulo method for use in DSA. Be careful if you try to use this elsewhere" ^self \\ anInteger |
| Integer>>raisedTo:modulo:: (no stamp -> hh 8/4/2000 01:09) |
no previous history |
raisedTo: y modulo: n "Answer the modular exponential. Code by Jesse Welton." | s t u | s _ 1. t _ self. u _ y. [u = 0] whileFalse: [ u odd ifTrue: [ s _ s * t. s >= n ifTrue: [s _ s \\\ n]]. t _ t * t. t >= n ifTrue: [t _ t \\\ n]. u _ u bitShift: -1]. ^ s |
| SmallInteger>>/: (tfei 4/12/1999 12:45 -> hh 10/3/2000 11:47) |
/ aNumber "Primitive. This primitive (for /) divides the receiver by the argument and returns the result if the division is exact. Fail if the result is not a whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional. No Lookup. See Object documentation whatIsAPrimitive." <primitive: 10> aNumber = 0 ifTrue: [^(ZeroDivide dividend: self) signal]. (aNumber isMemberOf: SmallInteger) ifTrue: [^(Fraction numerator: self denominator: aNumber) reduced] ifFalse: [^super / aNumber] |
/ aNumber "Primitive. This primitive (for /) divides the receiver by the argument and returns the result if the division is exact. Fail if the result is not a whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional. No Lookup. See Object documentation whatIsAPrimitive." <primitive: 10> aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. (aNumber isMemberOf: SmallInteger) ifTrue: [^(Fraction numerator: self denominator: aNumber) reduced] ifFalse: [^super / aNumber] |
/ aNumber "Primitive. This primitive (for /) divides the receiver by the argument and returns the result if the division is exact. Fail if the result is not a whole integer. Fail if the argument is 0 or is not a SmallInteger. Optional. No Lookup. See Object documentation whatIsAPrimitive." <primitive: 10> aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. |
| SelectorBrowser>>selectorMenu:: (tk 5/6/1999 13:57 -> hh 1/20/2000 00:15) |
selectorMenu: aMenu ^ aMenu labels: 'senders implementors copy selector to clipboard' lines: #() selections: #(senders implementors copyName) |
selectorMenu: aMenu ^ aMenu labels: 'senders (n) implementors (m) copy selector to clipboard' lines: #() selections: #(senders implementors copyName) |
selectorMenu: aMenu ^ aMenu labels: 'senders (n) implementors (m) |
| DigitalSignatureAlgorithm>>verifySignature:ofMessageHash:publicKey:: (raa 5/30/2000 15:49 -> hh 8/3/2000 18:18) |
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey "Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)." | p q g y r s w u1 u2 v0 v | p _ publicKey first. q _ publicKey second. g _ publicKey third. y _ publicKey fourth. r _ aSignature first. s _ aSignature last. ((r > 0) and: [r < q]) ifFalse: [^ false]. "reject" ((s > 0) and: [s < q]) ifFalse: [^ false]. "reject" w _ self inverseOf: s mod: q. u1 _ (hash * w) \\ q. u2 _ (r * w) \\ q. v0 _ (self raise: g to: u1 mod: p) * (self raise: y to: u2 mod: p). v _ ( v0 \\ p) \\ q. ^ v = r |
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey "Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)." | p q g y r s w u1 u2 v0 v | p _ publicKey first. q _ publicKey second. g _ publicKey third. y _ publicKey fourth. r _ aSignature first. s _ aSignature last. ((r > 0) and: [r < q]) ifFalse: [^ false]. "reject" ((s > 0) and: [s < q]) ifFalse: [^ false]. "reject" w _ self inverseOf: s mod: q. u1 _ (hash * w) \\ q. u2 _ (r * w) \\ q. v0 _ (g raisedTo: u1 modulo: p) * (y raisedTo: u2 modulo: p). v _ ( v0 \\ p) \\ q. ^ v = r |
verifySignature: aSignature ofMessageHash: hash publicKey: publicKey "Answer true if the given signature is the authentic signature of the given message hash. That is, if the signature must have been computed using the private key set corresponding to the given public key. The public key is an array of four large integers: (p, q, g, y)." | p q g y r s w u1 u2 v0 v | p _ publicKey first. q _ publicKey second. g _ publicKey third. y _ publicKey fourth. r _ aSignature first. s _ aSignature last. ((r > 0) and: [r < q]) ifFalse: [^ false]. "reject" ((s > 0) and: [s < q]) ifFalse: [^ false]. "reject" w _ self inverseOf: s mod: q. u1 _ (hash * w) \\ q. u2 _ (r * w) \\ q. v0 _ (g raisedTo: u1 modulo: p) * (y raisedTo: u2 modulo: p). |
| DigitalSignatureAlgorithm>>computeSignatureForMessageHash:privateKey:: (raa 5/30/2000 15:47 -> hh 8/3/2000 18:17) |
computeSignatureForMessageHash: hash privateKey: privateKey "Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)." | p q g x r s k tmp | p _ privateKey first. q _ privateKey second. g _ privateKey third. x _ privateKey fourth. r _ s _ 0. [r = 0 or: [s = 0]] whileTrue: [ k _ self nextRandom160 \\ q. r _ (self raise: g to: k mod: p) \\ q. tmp _ (hash + (x * r)) \\ q. s _ ((self inverseOf: k mod: q) * tmp) \\ q]. ^ Array with: r with: s |
computeSignatureForMessageHash: hash privateKey: privateKey "Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)." | p q g x r s k tmp | p _ privateKey first. q _ privateKey second. g _ privateKey third. x _ privateKey fourth. r _ s _ 0. [r = 0 or: [s = 0]] whileTrue: [ k _ self nextRandom160 \\ q. r _ (g raisedTo: k modulo: p) \\ q. tmp _ (hash + (x * r)) \\ q. s _ ((self inverseOf: k mod: q) * tmp) \\ q]. ^ Array with: r with: s |
computeSignatureForMessageHash: hash privateKey: privateKey "Answer the digital signature of the given message hash using the given private key. A signature is a pair of large integers. The private key is an array of four large integers: (p, q, g, x)." | p q g x r s k tmp | p _ privateKey first. q _ privateKey second. g _ privateKey third. x _ privateKey fourth. r _ s _ 0. [r = 0 or: [s = 0]] whileTrue: [ k _ self nextRandom160 \\ q. r _ (g raisedTo: k modulo: p) \\ q. |
| DigitalSignatureAlgorithm>>generateKeySet: (jm 12/21/1999 19:05 -> hh 8/3/2000 18:19) |
generateKeySet "Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature." "Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!" | qAndPandS q p exp g h x y | qAndPandS _ self generateQandP. Transcript show: 'Computing g...'. q _ qAndPandS first. p _ qAndPandS second. exp _ (p - 1) / q. h _ 2. [g _ self raise: h to: exp mod: p. g = 1] whileTrue: [h _ h + 1]. Transcript show: 'done.'; cr. Transcript show: 'Computing x and y...'. x _ self nextRandom160. y _ self raise: g to: x mod: p. Transcript show: 'done.'; cr. Transcript show: 'Key generation complete!'; cr. ^ Array with: (Array with: p with: q with: g with: x) with: (Array with: p with: q with: g with: y) |
generateKeySet "Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature." "Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!" | qAndPandS q p exp g h x y | qAndPandS _ self generateQandP. Transcript show: 'Computing g...'. q _ qAndPandS first. p _ qAndPandS second. exp _ (p - 1) / q. h _ 2. [g _ h raisedTo: exp modulo: p. g = 1] whileTrue: [h _ h + 1]. Transcript show: 'done.'; cr. Transcript show: 'Computing x and y...'. x _ self nextRandom160. y _ g raisedTo: x modulo: p. Transcript show: 'done.'; cr. Transcript show: 'Key generation complete!'; cr. ^ Array with: (Array with: p with: q with: g with: x) with: (Array with: p with: q with: g with: y) |
generateKeySet "Generate and answer a key set for DSA. The result is a pair (<private key><public key>). Each key is an array of four large integers. The private key is (p, q, g, x); the public one is (p, q, g, y). The signer must be sure to record (p, q, g, x), and must keep x secret to prevent someone from forging their signature." "Note: Key generation can take some time. Open a transcript so you can see what's happening and take a coffee break!" | qAndPandS q p exp g h x y | qAndPandS _ self generateQandP. Transcript show: 'Computing g...'. q _ qAndPandS first. p _ qAndPandS second. exp _ (p - 1) / q. h _ 2. [g _ h raisedTo: exp modulo: p. g = 1] whileTrue: [h _ h + 1]. |
| DigitalSignatureAlgorithm>>isProbablyPrime:: (raa 5/30/2000 15:47 -> hh 8/3/2000 18:18) |
isProbablyPrime: p "Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)." | iterations factor pMinusOne b m r a j z couldBePrime | iterations _ 50. "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)" "quick elimination: check for p divisible by a small prime" SmallPrimes ifNil: [ "generate list of small primes > 2" SmallPrimes _ Integer primesUpTo: 2000. SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size]. factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil]. factor ifNotNil: [^ p = factor]. pMinusOne _ p - 1. b _ self logOfLargestPowerOfTwoDividing: pMinusOne. m _ pMinusOne // (2 raisedTo: b). "Assert: pMinusOne = m * (2 raisedTo: b) and m is odd" Transcript show: ' Prime test pass '. r _ Random new. 1 to: iterations do: [:i | Transcript show: i printString; space. a _ (r next * 16rFFFFFF) truncated. j _ 0. z _ (self raise: a to: m mod: p) normalize. couldBePrime _ z = 1. [couldBePrime] whileFalse: [ z = 1 ifTrue: [Transcript show: 'failed!'; cr. ^ false]. "not prime" z = pMinusOne ifTrue: [couldBePrime _ true] ifFalse: [ (j _ j + 1) < b ifTrue: [z _ (z * z) \\ p] ifFalse: [Transcript show: 'failed!'; cr. ^ false]]]]. "not prime" Transcript show: 'passed!'; cr. ^ true "passed all tests; probably prime" |
isProbablyPrime: p "Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)." | iterations factor pMinusOne b m r a j z couldBePrime | iterations _ 50. "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)" "quick elimination: check for p divisible by a small prime" SmallPrimes ifNil: [ "generate list of small primes > 2" SmallPrimes _ Integer primesUpTo: 2000. SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size]. factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil]. factor ifNotNil: [^ p = factor]. pMinusOne _ p - 1. b _ self logOfLargestPowerOfTwoDividing: pMinusOne. m _ pMinusOne // (2 raisedTo: b). "Assert: pMinusOne = m * (2 raisedTo: b) and m is odd" Transcript show: ' Prime test pass '. r _ Random new. 1 to: iterations do: [:i | Transcript show: i printString; space. a _ (r next * 16rFFFFFF) truncated. j _ 0. z _ (a raisedTo: m modulo: p) normalize. couldBePrime _ z = 1. [couldBePrime] whileFalse: [ z = 1 ifTrue: [Transcript show: 'failed!'; cr. ^ false]. "not prime" z = pMinusOne ifTrue: [couldBePrime _ true] ifFalse: [ (j _ j + 1) < b ifTrue: [z _ (z * z) \\ p] ifFalse: [Transcript show: 'failed!'; cr. ^ false]]]]. "not prime" Transcript show: 'passed!'; cr. ^ true "passed all tests; probably prime" |
isProbablyPrime: p "Answer true if p is prime with very high probability. Such a number is sometimes called an 'industrial grade prime'--a large number that is so extremely likely to be prime that it can assumed that it actually is prime for all practical purposes. This implementation uses the Rabin-Miller algorithm (Schneier, p. 159)." | iterations factor pMinusOne b m r a j z couldBePrime | iterations _ 50. "Note: The DSA spec requires >50 iterations; Schneier says 5 are enough (p. 260)" "quick elimination: check for p divisible by a small prime" SmallPrimes ifNil: [ "generate list of small primes > 2" SmallPrimes _ Integer primesUpTo: 2000. SmallPrimes _ SmallPrimes copyFrom: 2 to: SmallPrimes size]. factor _ SmallPrimes detect: [:f | (p \\ f) = 0] ifNone: [nil]. factor ifNotNil: [^ p = factor]. pMinusOne _ p - 1. b _ self logOfLargestPowerOfTwoDividing: pMinusOne. m _ pMinusOne // (2 raisedTo: b). "Assert: pMinusOne = m * (2 raisedTo: b) and m is odd" Transcript show: ' Prime test pass '. r _ Random new. 1 to: iterations do: [:i | Transcript show: i printString; space. a _ (r next * 16rFFFFFF) truncated. j _ 0. z _ (a raisedTo: m modulo: p) normalize. |
| EndOfStream>>isResumable: (no stamp -> hh 5/17/2000 00:30) |
no previous history |
isResumable "EndOfStream is resumable, so ReadStream>>next can answer" ^ true |
| Sonogram>>plotColumn:: (jhm 9/16/1999 14:41 -> jdl 3/28/2003 09:30) |
plotColumn: dataArray | chm1 i normVal r | columnForm unhibernate. chm1 _ columnForm height - 1. 0 to: chm1 do: [:y | i _ y*(dataArray size-1)//chm1 + 1. normVal _ ((dataArray at: i) - minVal) / (maxVal - minVal). normVal < 0.0 ifTrue: [normVal _ 0.0]. normVal > 1.0 ifTrue: [normVal _ 1.0]. columnForm bits at: chm1-y+1 put: (pixValMap at: (normVal * 255.0) truncated + 1)]. (lastX _ lastX + 1) > (image width - 1) ifTrue: [self scroll]. image copy: (r _ (lastX@0 extent: 1@image height)) from: (32//image depth-1)@0 in: columnForm rule: Form over. "self changed." self invalidRect: (r translateBy: self position) |
plotColumn: dataArray | chm1 i normVal r | columnForm unhibernate. chm1 := columnForm height - 1. 0 to: chm1 do: [:y | i := y * (dataArray size - 1) // chm1 + 1. normVal := ((dataArray at: i) - minVal) / (maxVal - minVal). normVal := normVal max: 0.0. normVal := normVal min: 1.0. columnForm bits at: chm1 - y + 1 put: (pixValMap at: (normVal * 255.0) truncated + 1)]. (lastX := lastX + 1) > (image width - 1) ifTrue: [self scroll]. image copy: (r := lastX @ 0 extent: 1 @ image height) from: (32 // image depth - 1) @ 0 in: columnForm rule: Form over. "self changed." self invalidRect: (r translateBy: self position) |
plotColumn: dataArray |
| SpeakerMorph>>appendSample:: (jm 4/22/1999 16:45 -> jdl 3/28/2003 09:38) |
appendSample: aFloat "Append the given sample, a number between -100.0 and 100.0, to my buffer. Flush the buffer if it is full." lastConePosition _ aFloat. lastConePosition > 100.0 ifTrue: [lastConePosition _ 100.0]. lastConePosition < -100.0 ifTrue: [lastConePosition _ -100.0]. buffer nextPut: (327.67 * lastConePosition) truncated. buffer position >= bufferSize ifTrue: [self flushBuffer]. |
appendSample: aFloat "Append the given sample, a number between -100.0 and 100.0, to my buffer. Flush the buffer if it is full." lastConePosition := aFloat. lastConePosition := lastConePosition min: 100.0. lastConePosition := lastConePosition max: -100.0. buffer nextPut: (327.67 * lastConePosition) truncated. buffer position >= bufferSize ifTrue: [self flushBuffer] |
appendSample: aFloat |
| PasteUpMorph>>selectedRect: (no stamp -> jdl 3/28/2003 08:17) |
selectedRect "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph." | p | p _ cursor asInteger. p > submorphs size ifTrue: [p _ submorphs size]. p < 1 ifTrue: [p _ 1]. ^ (submorphs at: p) fullBounds expandBy: 2. |
selectedRect "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph." | p | p := cursor asInteger. p := p min: submorphs size. p := p max: 1. ^(submorphs at: p) fullBounds expandBy: 2 |
selectedRect "Return a rectangle enclosing the morph at the current cursor. Note that the cursor may be a float and may be out of range, so pick the nearest morph. Assume there is at least one submorph." | p | p := cursor asInteger. p := p min: submorphs size. p := p max: 1. ^(submorphs at: p) fullBounds expandBy: 2 |
| MovieMorph>>currentFrame: (no stamp -> jdl 3/28/2003 08:03) |
currentFrame frameList isEmpty ifTrue: [^ nil]. currentFrameIndex > frameList size ifTrue: [currentFrameIndex _ frameList size]. currentFrameIndex < 1 ifTrue: [currentFrameIndex _ 1]. ^ frameList at: currentFrameIndex |
currentFrame
frameList isEmpty ifTrue: [^nil].
currentFrameIndex := currentFrameIndex min: (frameList size).
currentFrameIndex := currentFrameIndex max: 1.
^frameList at: currentFrameIndex
|
currentFrame frameList isEmpty ifTrue: [^nil]. currentFrameIndex := currentFrameIndex min: (frameList size). currentFrameIndex := currentFrameIndex max: 1. ^frameList at: currentFrameIndex |
| MovieMorph>>setFrame:: (ar 9/23/2000 12:44 -> jdl 3/28/2003 08:08) |
setFrame: newFrameIndex | oldFrame p newFrame | oldFrame _ self currentFrame. oldFrame ifNil: [^ self]. self changed. p _ oldFrame referencePosition. currentFrameIndex _ newFrameIndex. currentFrameIndex > frameList size ifTrue: [currentFrameIndex _ frameList size]. currentFrameIndex < 1 ifTrue: [currentFrameIndex _ 1]. newFrame _ frameList at: currentFrameIndex. newFrame referencePosition: p. oldFrame delete. self addMorph: newFrame. dwellCount _ newFrame framesToDwell. self layoutChanged. self changed. |
setFrame: newFrameIndex
| oldFrame p newFrame |
oldFrame := self currentFrame.
oldFrame ifNil: [^self].
self changed.
p := oldFrame referencePosition.
currentFrameIndex := newFrameIndex.
currentFrameIndex := currentFrameIndex min: (frameList size).
currentFrameIndex := currentFrameIndex max: 1.
newFrame := frameList at: currentFrameIndex.
newFrame referencePosition: p.
oldFrame delete.
self addMorph: newFrame.
dwellCount := newFrame framesToDwell.
self layoutChanged.
self changed
|
setFrame: newFrameIndex |
| TransformationMorph>>scaleToMatch:: (ar 9/23/2000 13:40 -> jdl 3/28/2003 08:13) |
scaleToMatch: aPoint | scaleFactor tfm originalScale | tfm _ transform withScale: 1.0. originalScale _ ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner - (tfm localPointToGlobal: self renderedMorph referencePosition)) r. "Catch cases where the reference point is on fullBounds corner" originalScale < 1.0 ifTrue:[originalScale _ 1.0]. scaleFactor _ (aPoint - self referencePosition) r / originalScale. scaleFactor _ scaleFactor < 1.0 ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false] ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false]. self adjustAfter:[self scale: ((scaleFactor min: 8.0) max: 0.1)]. |
scaleToMatch: aPoint | scaleFactor tfm originalScale | tfm := transform withScale: 1.0. originalScale := ((tfm localBoundsToGlobal: self renderedMorph fullBounds) corner - (tfm localPointToGlobal: self renderedMorph referencePosition)) r. "Catch cases where the reference point is on fullBounds corner" originalScale := originalScale max: 1.0. scaleFactor := (aPoint - self referencePosition) r / originalScale. scaleFactor := scaleFactor < 1.0 ifTrue: [scaleFactor detentBy: 0.05 atMultiplesOf: 0.25 snap: false] ifFalse: [scaleFactor detentBy: 0.1 atMultiplesOf: 0.5 snap: false]. self adjustAfter: [self scale: ((scaleFactor min: 8.0) max: 0.1)] |
scaleToMatch: aPoint |
| TableLayout>>layoutLeftToRight:in:: (ar 11/14/2000 17:10 -> jdl 3/28/2003 08:48) |
layoutLeftToRight: aMorph in: newBounds "An optimized left-to-right list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint x. extent _ newBounds extent. n _ 0. vFill _ false. sum _ 0. width _ height _ 0. first _ last _ nil. block _ [:m| props _ m layoutProperties ifNil:[m]. props disableTableLayout ifFalse:[ n _ n + 1. cell _ LayoutCell new target: m. (props hResizing == #spaceFill) ifTrue:[ cell hSpaceFill: true. extra _ m spaceFillWeight. cell extraSpace: extra. sum _ sum + extra. ] ifFalse:[cell hSpaceFill: false]. (props vResizing == #spaceFill) ifTrue:[vFill _ true]. size _ m minExtent. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. cell cellSize: sizeX. last ifNil:[first _ cell] ifNotNil:[last nextCell: cell]. last _ cell. width _ width + sizeX. sizeY > height ifTrue:[height _ sizeY]. ]. ]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. n > 1 ifTrue:[width _ width + (n-1 * inset)]. (properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]]) ifTrue:[extent _ width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]]) ifTrue:[extent _ (extent x max: width) @ height]. posX _ newBounds left. posY _ newBounds top. "Compute extra vertical space" extra _ extent y - height. extra < 0 ifTrue:[extra _ 0]. extra > 0 ifTrue:[ vFill ifTrue:[ height _ extent y. ] ifFalse:[ centering _ properties wrapCentering. centering == #bottomRight ifTrue:[posY _ posY + extra]. centering == #center ifTrue:[posY _ posY + (extra // 2)] ]. ]. "Compute extra horizontal space" extra _ extent x - width. extra < 0 ifTrue:[extra _ 0]. extraPerCell _ 0. extra > 0 ifTrue:[ sum isZero ifTrue:["extra space but no #spaceFillers" centering _ properties listCentering. centering == #bottomRight ifTrue:[posX _ posX + extra]. centering == #center ifTrue:[posX _ posX + (extra // 2)]. ] ifFalse:[extraPerCell _ extra asFloat / sum asFloat]. ]. n _ 0. extra _ last _ 0. cell _ first. [cell == nil] whileFalse:[ n _ n + 1. width _ cell cellSize. (extraPerCell > 0 and:[cell hSpaceFill]) ifTrue:[ extra _ (last _ extra) + (extraPerCell * cell extraSpace). amount _ extra truncated - last truncated. width _ width + amount. ]. cell target layoutInBounds: (posX @ posY extent: width @ height). posX _ posX + width + inset. cell _ cell nextCell. ]. |
layoutLeftToRight: aMorph in: newBounds "An optimized left-to-right list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint x. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props hResizing == #spaceFill ifTrue: [cell hSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell hSpaceFill: false]. props vResizing == #spaceFill ifTrue: [vFill := true]. size := m minExtent. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeX. last ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. n > 1 ifTrue: [width := width + ((n - 1) * inset)]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := width @ (extent y max: height)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := (extent x max: width) @ height]. posX := newBounds left. posY := newBounds top. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [height := extent y] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]]]. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. width := cell cellSize. (extraPerCell > 0 and: [cell hSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. width := width + amount]. cell target layoutInBounds: (posX @ posY extent: width @ height). posX := posX + width + inset. cell := cell nextCell] |
layoutLeftToRight: aMorph in: newBounds |
| TableLayout>>minExtentHorizontal:: (ar 1/27/2001 14:42 -> jdl 3/28/2003 08:37) |
minExtentHorizontal: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint. n _ 0. width _ height _ 0. aMorph submorphsDo:[:m| m disableTableLayout ifFalse:[ n _ n + 1. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. width _ width + sizeX. sizeY > height ifTrue:[height _ sizeY]. ]. ]. n > 1 ifTrue:[width _ width + (n-1 * inset x)]. ^minExtentCache _ width @ height |
minExtentHorizontal: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | m disableTableLayout ifFalse: [n := n + 1. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. width := width + sizeX. sizeY > height ifTrue: [height := sizeY]]]. n > 1 ifTrue: [width := width + ((n - 1) * inset x)]. ^minExtentCache := width @ height |
minExtentHorizontal: aMorph |
| TableLayout>>minExtentVertical:: (ar 1/27/2001 14:42 -> jdl 3/28/2003 08:39) |
minExtentVertical: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint. n _ 0. width _ height _ 0. aMorph submorphsDo:[:m| m disableTableLayout ifFalse:[ n _ n + 1. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. height _ height + sizeY. sizeX > width ifTrue:[width _ sizeX]. ]. ]. n > 1 ifTrue:[height _ height + (n-1 * inset y)]. ^minExtentCache _ width @ height |
minExtentVertical: aMorph "Return the minimal size aMorph's children would require given the new bounds" | inset n size width height minX minY maxX maxY sizeX sizeY | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint. n := 0. width := height := 0. aMorph submorphsDo: [:m | m disableTableLayout ifFalse: [n := n + 1. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. n > 1 ifTrue: [height := height + ((n - 1) * inset y)]. ^minExtentCache := width @ height |
minExtentVertical: aMorph |
| TableLayout>>layoutTopToBottom:in:: (ar 11/14/2000 17:12 -> jdl 3/28/2003 08:50) |
layoutTopToBottom: aMorph in: newBounds "An optimized top-to-bottom list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size _ properties minCellSize asPoint. minX _ size x. minY _ size y. size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y. inset _ properties cellInset asPoint y. extent _ newBounds extent. n _ 0. vFill _ false. sum _ 0. width _ height _ 0. first _ last _ nil. block _ [:m| props _ m layoutProperties ifNil:[m]. props disableTableLayout ifFalse:[ n _ n + 1. cell _ LayoutCell new target: m. (props vResizing == #spaceFill) ifTrue:[ cell vSpaceFill: true. extra _ m spaceFillWeight. cell extraSpace: extra. sum _ sum + extra. ] ifFalse:[cell vSpaceFill: false]. (props hResizing == #spaceFill) ifTrue:[vFill _ true]. size _ m minExtent. sizeX _ size x. sizeY _ size y. sizeX < minX ifTrue:[sizeX _ minX] ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]]. sizeY < minY ifTrue:[sizeY _ minY] ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]]. cell cellSize: sizeY. first ifNil:[first _ cell] ifNotNil:[last nextCell: cell]. last _ cell. height _ height + sizeY. sizeX > width ifTrue:[width _ sizeX]. ]. ]. properties reverseTableCells ifTrue:[aMorph submorphsReverseDo: block] ifFalse:[aMorph submorphsDo: block]. n > 1 ifTrue:[height _ height + (n-1 * inset)]. (properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]]) ifTrue:[extent _ (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]]) ifTrue:[extent _ width @ (extent y max: height)]. posX _ newBounds left. posY _ newBounds top. "Compute extra horizontal space" extra _ extent x - width. extra < 0 ifTrue:[extra _ 0]. extra > 0 ifTrue:[ vFill ifTrue:[ width _ extent x. ] ifFalse:[ centering _ properties wrapCentering. centering == #bottomRight ifTrue:[posX _ posX + extra]. centering == #center ifTrue:[posX _ posX + (extra // 2)] ]. ]. "Compute extra vertical space" extra _ extent y - height. extra < 0 ifTrue:[extra _ 0]. extraPerCell _ 0. extra > 0 ifTrue:[ sum isZero ifTrue:["extra space but no #spaceFillers" centering _ properties listCentering. centering == #bottomRight ifTrue:[posY _ posY + extra]. centering == #center ifTrue:[posY _ posY + (extra // 2)]. ] ifFalse:[extraPerCell _ extra asFloat / sum asFloat]. ]. n _ 0. extra _ last _ 0. cell _ first. [cell == nil] whileFalse:[ n _ n + 1. height _ cell cellSize. (extraPerCell > 0 and:[cell vSpaceFill]) ifTrue:[ extra _ (last _ extra) + (extraPerCell * cell extraSpace). amount _ extra truncated - last truncated. height _ height + amount. ]. cell target layoutInBounds: (posX @ posY extent: width @ height). posY _ posY + height + inset. cell _ cell nextCell. ]. |
layoutTopToBottom: aMorph in: newBounds "An optimized top-to-bottom list layout" | inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props | size := properties minCellSize asPoint. minX := size x. minY := size y. size := properties maxCellSize asPoint. maxX := size x. maxY := size y. inset := properties cellInset asPoint y. extent := newBounds extent. n := 0. vFill := false. sum := 0. width := height := 0. first := last := nil. block := [:m | props := m layoutProperties ifNil: [m]. props disableTableLayout ifFalse: [n := n + 1. cell := LayoutCell new target: m. props vResizing == #spaceFill ifTrue: [cell vSpaceFill: true. extra := m spaceFillWeight. cell extraSpace: extra. sum := sum + extra] ifFalse: [cell vSpaceFill: false]. props hResizing == #spaceFill ifTrue: [vFill := true]. size := m minExtent. sizeX := size x. sizeY := size y. sizeX < minX ifTrue: [sizeX := minX] ifFalse: [sizeX := sizeX min: maxX]. sizeY < minY ifTrue: [sizeY := minY] ifFalse: [sizeY := sizeY min: maxY]. cell cellSize: sizeY. first ifNil: [first := cell] ifNotNil: [last nextCell: cell]. last := cell. height := height + sizeY. sizeX > width ifTrue: [width := sizeX]]]. properties reverseTableCells ifTrue: [aMorph submorphsReverseDo: block] ifFalse: [aMorph submorphsDo: block]. n > 1 ifTrue: [height := height + ((n - 1) * inset)]. (properties vResizing == #shrinkWrap and: [properties rubberBandCells or: [sum isZero]]) ifTrue: [extent := (extent x max: width) @ height]. (properties hResizing == #shrinkWrap and: [properties rubberBandCells or: [vFill not]]) ifTrue: [extent := width @ (extent y max: height)]. posX := newBounds left. posY := newBounds top. "Compute extra horizontal space" extra := extent x - width. extra := extra max: 0. extra > 0 ifTrue: [vFill ifTrue: [width := extent x] ifFalse: [centering := properties wrapCentering. centering == #bottomRight ifTrue: [posX := posX + extra]. centering == #center ifTrue: [posX := posX + (extra // 2)]]]. "Compute extra vertical space" extra := extent y - height. extra := extra max: 0. extraPerCell := 0. extra > 0 ifTrue: [sum isZero ifTrue: ["extra space but no #spaceFillers" centering := properties listCentering. centering == #bottomRight ifTrue: [posY := posY + extra]. centering == #center ifTrue: [posY := posY + (extra // 2)]] ifFalse: [extraPerCell := extra asFloat / sum asFloat]]. n := 0. extra := last := 0. cell := first. [cell isNil] whileFalse: [n := n + 1. height := cell cellSize. (extraPerCell > 0 and: [cell vSpaceFill]) ifTrue: [extra := (last := extra) + (extraPerCell * cell extraSpace). amount := extra truncated - last truncated. height := height + amount]. cell target layoutInBounds: (posX @ posY extent: width @ height). posY := posY + height + inset. cell := cell nextCell] |
layoutTopToBottom: aMorph in: newBounds |
| TableLayout>>computeCellArrangement:in:horizontal:target:: (ar 11/13/2000 18:24 -> jdl 3/28/2003 08:18) |
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset | maxCell _ cellHolder key. cells _ cellHolder value. properties wrapDirection == #none ifTrue:[wrap _ SmallInteger maxVal] ifFalse:[wrap _ aBool ifTrue:[newBounds width] ifFalse:[newBounds height]. wrap < maxCell x ifTrue:[wrap _ maxCell x]]. spacing _ properties cellSpacing. (spacing == #globalRect or:[spacing = #globalSquare]) ifTrue:[ "Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. output _ (WriteStream on: Array new). inset _ properties cellInset asPoint. aBool ifFalse:[inset _ inset transposed]. first _ last _ nil. maxExtent _ 0@0. sum _ 0. index _ 1. n _ 0. hFill _ vFill _ false. [index <= cells size] whileTrue:[ w _ sum. cell _ cells at: index. cellMax _ maxExtent max: cell cellSize. "e.g., minSize" (spacing == #localRect or:[spacing == #localSquare]) ifTrue:[ "Recompute entire size of current row" spacing == #localSquare ifTrue:[max _ cellMax x max: cellMax y] ifFalse:[max _ cellMax x]. sum _ (n + 1) * max. ] ifFalse:[ sum _ sum + (cell cellSize x). ]. ((sum + (n * inset x)) > wrap and:[first notNil]) ifTrue:[ "It doesn't fit and we're not starting a new line" (spacing == #localSquare or:[spacing == #localRect]) ifTrue:[ spacing == #localSquare ifTrue:[maxExtent _ (maxExtent x max: maxExtent y) asPoint]. first do:[:c| c cellSize: maxExtent]]. w _ w + ((n - 1) * inset x). "redistribute extra space" first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]]. last _ LayoutCell new. last cellSize: w @ (maxExtent y). last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse:[last addExtraSpace: 0@inset y]. output nextPut: last. first _ nil. maxExtent _ 0@0. sum _ 0. n _ 0. hFill _ vFill _ false. ] ifFalse:[ "It did fit; use next item from input" first ifNil:[first _ last _ cell] ifNotNil:[last nextCell: cell. last _ cell]. index _ index+1. n _ n + 1. maxExtent _ cellMax. hFill _ hFill or:[cell hSpaceFill]. vFill _ vFill or:[cell vSpaceFill]. ]. ]. first ifNotNil:[ last _ LayoutCell new. sum _ sum + ((n - 1) * inset x). first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]]. last cellSize: sum @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse:[last addExtraSpace: 0@inset y]. output nextPut: last]. output _ output contents. properties listSpacing == #equal ifTrue:[ "Make all the heights equal" max _ output inject: 0 into:[:size :c| size max: c cellSize y]. output do:[:c| c cellSize: c cellSize x @ max]. ]. ^output |
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph "Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level. Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row." | cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset | maxCell := cellHolder key. cells := cellHolder value. properties wrapDirection == #none ifTrue: [wrap := SmallInteger maxVal] ifFalse: [wrap := aBool ifTrue: [newBounds width] ifFalse: [newBounds height]. wrap := wrap max: (maxCell x)]. spacing := properties cellSpacing. (spacing == #globalRect or: [spacing = #globalSquare]) ifTrue: ["Globally equal spacing is a very special case here, so get out fast and easy" ^self computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing]. output := WriteStream on: Array new. inset := properties cellInset asPoint. aBool ifFalse: [inset := inset transposed]. first := last := nil. maxExtent := 0 @ 0. sum := 0. index := 1. n := 0. hFill := vFill := false. [index <= cells size] whileTrue: [w := sum. cell := cells at: index. cellMax := maxExtent max: cell cellSize. "e.g., minSize" sum := (spacing == #localRect or: [spacing == #localSquare]) ifTrue: ["Recompute entire size of current row" max := spacing == #localSquare ifTrue: [cellMax x max: cellMax y] ifFalse: [cellMax x]. (n + 1) * max] ifFalse: [sum + cell cellSize x]. (sum + (n * inset x) > wrap and: [first notNil]) ifTrue: ["It doesn't fit and we're not starting a new line" (spacing == #localSquare or: [spacing == #localRect]) ifTrue: [spacing == #localSquare ifTrue: [maxExtent := (maxExtent x max: maxExtent y) asPoint]. first do: [:c | c cellSize: maxExtent]]. w := w + ((n - 1) * inset x). "redistribute extra space" first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last := LayoutCell new. last cellSize: w @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last. first := nil. maxExtent := 0 @ 0. sum := 0. n := 0. hFill := vFill := false] ifFalse: ["It did fit; use next item from input" first ifNil: [first := last := cell] ifNotNil: [last nextCell: cell. last := cell]. index := index + 1. n := n + 1. maxExtent := cellMax. hFill := hFill or: [cell hSpaceFill]. vFill := vFill or: [cell vSpaceFill]]]. first ifNotNil: [last := LayoutCell new. sum := sum + ((n - 1) * inset x). first nextCell ifNotNil: [first nextCell do: [:c | c addExtraSpace: inset x @ 0]]. last cellSize: sum @ maxExtent y. last hSpaceFill: hFill. last vSpaceFill: vFill. last nextCell: first. output position = 0 ifFalse: [last addExtraSpace: 0 @ inset y]. output nextPut: last]. output := output contents. properties listSpacing == #equal ifTrue: ["Make all the heights equal" max := output inject: 0 into: [:size :c | size max: c cellSize y]. output do: [:c | c cellSize: c cellSize x @ max]]. ^output |
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph |
| SoundRecorder>>isActive: (no stamp -> jj 10/20/97 15:30) |
no previous history |
isActive "Return true if I have a recordProcess running." ^ recordProcess ~~ nil |
| HandMorph>>cursorBounds: (di 3/14/1999 10:03 -> jwh 6/5/2000 07:38) |
cursorBounds temporaryCursor == nil ifTrue: [^ self position extent: NormalCursor extent] ifFalse: [^ self position + temporaryCursorOffset extent: temporaryCursor extent] |
cursorBounds ^temporaryCursor ifNil: [self position extent: NormalCursor extent] ifNotNil: [self position + temporaryCursorOffset extent: temporaryCursor extent] |
cursorBounds ^temporaryCursor ifNil: [self position extent: NormalCursor extent] ifNotNil: [self position + temporaryCursorOffset extent: temporaryCursor extent] |
| Installer>>validChangeSetName:: (no stamp -> kb 12/18/2006 13:30) |
no previous history |
validChangeSetName: aFileName " dots in the url confuses the changeset loader. I replace them with dashes" self url ifNotNil: [ | asUrl | asUrl := Url absoluteFromText: aFileName. ^String streamContents: [:stream | stream nextPutAll: (asUrl authority copyReplaceAll: '.' with: '-'). asUrl path allButLastDo: [:each | stream nextPutAll: '/'; nextPutAll: (each copyReplaceAll: '.' with: '-') ]. stream nextPutAll: '/'; nextPutAll: asUrl path last ] ]. ^aFileName |
| Installer>>newChangeSetFromStream:named:: (no stamp -> kb 12/18/2006 13:01) |
no previous history |
newChangeSetFromStream: aStream named: aName "This code is based upon ChangeSet-c-#newChangesFromStream:named: which is in 3.9, implemented here for previous versions. The second branch is for 3.8, where ChangeSets are loaded by ChangeSorter. " | oldChanges newName newSet newStream | (self classChangeSet respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSet newChangesFromStream: aStream named:aName ]. (self classChangeSorter respondsTo: #newChangesFromStream:named:) ifTrue: [ ^self classChangeSorter newChangesFromStream: aStream named: aName ]. oldChanges := ChangeSet current. "so a Bumper update can find it" newName := aName sansPeriodSuffix. newSet := self classChangeSet basicNewNamed: newName. [newSet ifNotNil: [(aStream respondsTo: #converter:) ifTrue: [newStream := aStream] ifFalse: [newStream := self classMultiByteBinaryOrTextStream with: aStream contentsOfEntireFile. newStream reset]. self classChangeSet newChanges: newSet. newStream setConverterForCode. newStream fileInAnnouncing: 'Loading ' , newName , '...'. Transcript cr; show: 'File ' , aName , ' successfully filed in to change set ' , newName]. aStream close] ensure: [self classChangeSet newChanges: oldChanges]. ^ newSet |
| Installer>>classChangeSorter: (no stamp -> kb 12/18/2006 12:40) |
no previous history |
classChangeSorter ^Smalltalk at: #ChangeSorter ifAbsent: [ self error: 'ChangeSorter not present' ] |
| ParagraphEditor>>backspace:: (th 9/19/2002 18:23 -> ktt 11/28/2005 12:16) |
backspace: characterStream "Backspace over the last character." | startIndex | sensor leftShiftDown ifTrue: [^ self backWord: characterStream]. characterStream isEmpty ifTrue: [startIndex _ self markIndex + (self hasCaret ifTrue: [0] ifFalse: [1]). [sensor keyboardPressed and: [sensor keyboardPeek asciiValue = 8]] whileTrue: [ "process multiple backspaces" sensor keyboard. startIndex _ 1 max: startIndex - 1. ]. self backTo: startIndex] ifFalse: [sensor keyboard. characterStream skip: -1]. ^false |
backspace: characterStream "Backspace over the last character." | startIndex | sensor leftShiftDown ifTrue: [^ self backWord: characterStream]. startIndex := self markIndex + (self hasCaret ifTrue: [0] ifFalse: [1]). [sensor keyboardPressed and: [sensor keyboardPeek asciiValue = 8]] whileTrue: [ "process multiple backspaces" sensor keyboard. startIndex := 1 max: startIndex - 1. ]. self backTo: startIndex. ^false |
backspace: characterStream "Backspace over the last character." | startIndex | sensor leftShiftDown ifTrue: [^ self backWord: characterStream]. startIndex := self markIndex + (self hasCaret ifTrue: [0] ifFalse: [1]). [sensor keyboardPressed and: |
| EventRecorderMorph class>>openTapeFromFile:: (hg 8/3/2000 17:24 -> los 2/26/2004 11:46) |
openTapeFromFile: fullName "Open an eventRecorder tape for playback." (EventRecorderMorph new readTape: fullName) rewind openInWorld |
openTapeFromFile: fullName "Open an eventRecorder tape for playback." (self new) readTape: fullName; openInWorld |
openTapeFromFile: fullName "Open an eventRecorder tape for playback." (self new) readTape: fullName; openInWorld |
| ListView>>isSelectionBoxClipped: (no stamp -> mkd 11/4/1999 14:31) |
isSelectionBoxClipped "Answer whether there is a selection and whether the selection is visible on the screen." ^selection ~= 0 & (self selectionBox intersects: self clippingBox) not |
isSelectionBoxClipped
"Answer whether there is a selection and whether the selection is visible
on the screen."
^ selection ~= 0 and:
[(self selectionBox intersects:
(self clippingBox insetBy: (Rectangle left: 0 right: 0 top: 1 bottom: 0))) not]
|
isSelectionBoxClipped "Answer whether there is a selection and whether the selection is visible on the screen." |
| CategorizerTest>>testRemoveNonExistingElement: (no stamp -> mtf 9/10/2007 12:57) |
no previous history |
testRemoveNonExistingElement
categorizer removeElement: #f.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
(''unreal'')
'
|
| CategorizerTest>>testClassifyOldElementNewCategory: (no stamp -> mtf 9/10/2007 10:17) |
no previous history |
testClassifyOldElementNewCategory
categorizer classify: #e under: #nice.
self assert: categorizer printString =
'(''as yet unclassified'' d)
(''abc'' a b c)
(''unreal'')
(''nice'' e)
'
|
| CategorizerTest>>testClassifyOldElementOldCategory: (no stamp -> mtf 9/10/2007 12:54) |
no previous history |
testClassifyOldElementOldCategory
categorizer classify: #e under: #unreal.
self assert: categorizer printString =
'(''as yet unclassified'' d)
(''abc'' a b c)
(''unreal'' e)
'
|
| CategorizerTest>>testRemoveNonEmptyCategory: (no stamp -> mtf 9/10/2007 12:59) |
no previous history |
testRemoveNonEmptyCategory
self should: [categorizer removeCategory: #abc] raise: Error.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
(''unreal'')
'
|
| CategorizerTest>>testClassifyNewElementNewCategory: (no stamp -> mtf 9/10/2007 10:17) |
no previous history |
testClassifyNewElementNewCategory
categorizer classify: #f under: #nice.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
(''unreal'')
(''nice'' f)
'
|
| CategorizerTest>>testDefaultCategoryIsTransient: (no stamp -> mtf 9/10/2007 10:22) |
no previous history |
testDefaultCategoryIsTransient
"Test that category 'as yet unclassified' disapears when all it's elements are removed'"
categorizer classifyAll: #(d e) under: #abc.
self assert: categorizer printString =
'(''abc'' a b c d e)
(''unreal'')
'
|
| CategorizerTest>>testNullCategory: (no stamp -> mtf 9/11/2007 15:15) |
no previous history |
testNullCategory
"Test that category 'as yet unclassified' disapears when all it's elements are removed'"
| aCategorizer |
aCategorizer := Categorizer defaultList: #().
self assert: aCategorizer printString =
'(''as yet unclassified'')
'.
self assert: aCategorizer categories = #('no messages').
aCategorizer classify: #a under: #b.
self assert: aCategorizer printString =
'(''b'' a)
'.
self assert: aCategorizer categories = #(b).
|
| CategorizerTest>>testRemoveThenRename: (no stamp -> mtf 9/11/2007 14:49) |
no previous history |
testRemoveThenRename
categorizer removeCategory: #unreal.
categorizer renameCategory: #abc toBe: #unreal.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''unreal'' a b c)
'
|
| CategorizerTest>>testRemoveExistingElement: (no stamp -> mtf 9/10/2007 12:55) |
no previous history |
testRemoveExistingElement
categorizer removeElement: #a.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' b c)
(''unreal'')
'
|
| CategorizerTest>>testClassifyNewElementOldCategory: (no stamp -> mtf 9/10/2007 10:18) |
no previous history |
testClassifyNewElementOldCategory
categorizer classify: #f under: #unreal.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
(''unreal'' f)
'
|
| CategorizerTest>>testRemoveEmptyCategory: (no stamp -> mtf 9/10/2007 12:57) |
no previous history |
testRemoveEmptyCategory
categorizer removeCategory: #unreal.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
'
|
| CategorizerTest>>setUp: (no stamp -> mtf 9/10/2007 10:10) |
no previous history |
setUp categorizer := Categorizer defaultList: #(a b c d e). categorizer classifyAll: #(a b c) under: 'abc'. categorizer addCategory: 'unreal'. |
| CategorizerTest>>testUnchanged: (no stamp -> mtf 9/10/2007 10:14) |
no previous history |
testUnchanged
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
(''unreal'')
'
|
| CategorizerTest>>testRemoveNonExistingCategory: (no stamp -> mtf 9/10/2007 12:59) |
no previous history |
testRemoveNonExistingCategory
categorizer removeCategory: #nice.
self assert: categorizer printString =
'(''as yet unclassified'' d e)
(''abc'' a b c)
(''unreal'')
'
|
| MethodHistoryChangeList>>scanCategory:class:meta:stamp:: (no stamp -> no stamp) |
no previous history |
not found |
| MyChangeRecord>>class:selector:stamp:text:sourceFile:: (no stamp -> no stamp) |
no previous history |
not found |
| MyChangeRecord>>string: (no stamp -> no stamp) |
no previous history |
not found |
| MyChangeRecord>>class:selector:stamp:text:file:position:: (no stamp -> no stamp) |
no previous history |
not found |
| MyChangeRecord>>text: (no stamp -> no stamp) |
no previous history |
not found |
| MyChangeRecord>>isStoringText: (no stamp -> no stamp) |
no previous history |
not found |
| MethodHistoryChangeRecord>>class:selector:stamp:text:sourceFile:: (no stamp -> no stamp) |
no previous history |
not found |
| MethodHistoryChangeRecord>>string: (no stamp -> no stamp) |
no previous history |
not found |
| MethodHistoryChangeRecord>>class:selector:stamp:text:file:position:: (no stamp -> no stamp) |
no previous history |
not found |
| MethodHistoryChangeRecord>>text: (no stamp -> no stamp) |
no previous history |
not found |
| MethodHistoryChangeRecord>>isStoringText: (no stamp -> no stamp) |
no previous history |
not found |
| MethodContext>>isExecutingBlock: (md 1/20/2006 17:15 -> mvl 3/13/2007 11:42) |
isExecutingBlock "Is this executing a block versus a method" ^ self method isBlockMethod |
isExecutingBlock "Is this executing a block versus a method" ^ self method notNil and: [self method isBlockMethod] |
isExecutingBlock "Is this executing a block versus a method" ^ self method notNil and: [self method isBlockMethod] |
| MethodContext>>printString: (emm 5/30/2002 14:07 -> mvl 3/13/2007 11:40) |
printString "Answer an emphasized string in case of a breakpoint method" ^self method hasBreakpoint ifTrue:[(super printString , ' [break]') asText allBold] ifFalse:[super printString] |
printString "Answer an emphasized string in case of a breakpoint method" ^(self method notNil and: [self method hasBreakpoint]) ifTrue:[(super printString , ' [break]') asText allBold] ifFalse:[super printString] |
printString "Answer an emphasized string in case of a breakpoint method" ^(self method notNil and: [self method hasBreakpoint]) |
| TestCase>>executeShould:inScopeOf:withExceptionDo:: (DF 3/17/2006 01:26 -> mx 3/20/2006 23:32) |
executeShould: aBlock inScopeOf: anExceptionalEvent withExceptionDo: aOneArgBlock ^[aBlock value. false] on: anExceptionalEvent do: [:ex | aOneArgBlock value: ex. ex return: true] |
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock ^[aBlock value. false] on: anException do: [:exception | anotherBlock value: exception. exception return: true] |
executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock |
| TestCase>>fail: (no stamp -> mx 3/13/2006 23:21) |
no previous history |
fail ^self assert: false |
| TestCase>>shouldFix:: (no stamp -> mx 3/20/2006 21:29) |
no previous history |
shouldFix: aBlock ^self should: aBlock raise: Exception |
| TestCase>>should:raise:withExceptionDo:: (DF 3/17/2006 01:27 -> mx 3/20/2006 23:52) |
should: aBlock raise: anExceptionalEvent withExceptionDo: aOneArgBlock ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent withExceptionDo: aOneArgBlock) |
should: aBlock raise: anException withExceptionDo: anotherBlock ^self assert: (self executeShould: aBlock inScopeOf: anException withExceptionDo: anotherBlock) |
should: aBlock raise: anException withExceptionDo: anotherBlock |
| SUnitExtensionsTest>>differentExceptionInShouldRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
differentExceptionInShouldRaiseWithExceptionDoTest [ self should: [ Error signal ] raise: Halt withExceptionDo: [ :anException | self assert: false description: 'should:raise:withExceptionDo: handled an exception that should not handle'] ] on: Error do: [ :anException | anException return: nil ] |
| SUnitExtensionsTest>>testAutoDenyFalse: (no stamp -> mx 3/20/2006 21:16) |
no previous history |
testAutoDenyFalse
| booleanCondition |
self assert: self isLogging.
self should: [ self deny: 1 = 1 description: 'self deny: 1 = 1'.] raise: TestResult failure.
booleanCondition := (self stream contents subStrings: {Character cr}) last = 'self deny: 1 = 1'.
self assert: booleanCondition
|
| SUnitExtensionsTest>>assertionFailedInRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
assertionFailedInRaiseWithExceptionDoTest self should: [ Error signal ] raise: Error withExceptionDo: [ :anException | self assert: false ] |
| SUnitExtensionsTest>>errorInRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
errorInRaiseWithExceptionDoTest self should: [ Error signal ] raise: Error withExceptionDo: [ :anException | Error signal: 'A forced error' ] |
| SUnitExtensionsTest>>testNoExceptionInShouldRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testNoExceptionInShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #noExceptionInShouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult failures includes: testCase). self assert: testResult failures size=1. self assert: testResult passed isEmpty. self assert: testResult errors isEmpty. |
| SUnitExtensionsTest>>testErrorInRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testErrorInRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #errorInRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult errors includes: testCase). self assert: testResult errors size=1. self assert: testResult failures isEmpty. self assert: testResult passed isEmpty. |
| SUnitExtensionsTest>>testAssertionFailedInRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:39) |
no previous history |
testAssertionFailedInRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #assertionFailedInRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult failures includes: testCase). self assert: testResult failures size=1. self assert: testResult passed isEmpty. self assert: testResult errors isEmpty. |
| SUnitExtensionsTest>>testAutoAssertFalse: (no stamp -> mx 3/20/2006 21:15) |
no previous history |
testAutoAssertFalse
| booleanCondition |
self assert: self isLogging.
self should: [ self assert: 1 = 2 description: 'self assert: 1 = 2' ] raise: TestResult failure.
booleanCondition := (self stream contents subStrings: {Character cr}) last = 'self assert: 1 = 2'.
self assert: booleanCondition
|
| SUnitExtensionsTest>>noExceptionInShouldRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
noExceptionInShouldRaiseWithExceptionDoTest self should: [ ] raise: Error withExceptionDo: [ :anException | Error signal: 'Should not get here' ] |
| SUnitExtensionsTest>>shouldRaiseWithExceptionDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
shouldRaiseWithExceptionDoTest self should: [ Error signal: '1' ] raise: Error withExceptionDo: [ :anException | self assert: anException messageText = '1' ] |
| SUnitExtensionsTest>>shouldRaiseWithSignalDoTest: (no stamp -> mx 3/20/2006 23:47) |
no previous history |
shouldRaiseWithSignalDoTest self should: [ Error signal: '1' ] raise: Error withExceptionDo: [ :anException | self assert: anException messageText = '1' ] |
| SUnitExtensionsTest>>testDifferentExceptionInShouldRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testDifferentExceptionInShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #differentExceptionInShouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult errors isEmpty. self assert: testResult failures isEmpty. self assert: testResult passed size=1 |
| SUnitExtensionsTest>>testShouldRaiseWithExceptionDo: (no stamp -> mx 3/20/2006 23:40) |
no previous history |
testShouldRaiseWithExceptionDo | testCase testResult | testCase := self class selector: #shouldRaiseWithExceptionDoTest. testResult := testCase run. self assert: (testResult passed includes: testCase). self assert: testResult passed size=1. self assert: testResult failures isEmpty. self assert: testResult errors isEmpty. |
| DictionaryTest>>testPseudoVariablesAreValidKeys: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:29) |
no previous history |
testPseudoVariablesAreValidKeys "(self run: #testPseudoVariablesAreValidKeys)" "true and false are valid keys" | dict1 | dict1 := Dictionary new. self shouldnt: [dict1 at: true put: #true] raise: Error. self assert: (dict1 at: true) = #true. self shouldnt: [dict1 at: false put: #false] raise: Error. self assert: (dict1 at: false) = #false. |
| DictionaryTest>>testValues: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:23) |
no previous history |
testValues "self run:#testValues " | a1 a2 a3 dict | a1 := Association key: 'France' value: 'Paris'. a2 := Association key: 'Italie' value: 'Rome'. dict := Dictionary new. dict add: a1. dict add: a2. self assert: (dict values size ) = 2. self assert: (dict values includes: 'Paris'). a3 := Association new. dict add: a3. self assert: (dict values size ) = 3. self assert: (dict values includes: nil). |
| DictionaryTest>>testIncludesAssociationNoValue: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:25) |
no previous history |
testIncludesAssociationNoValue "self run:#testIncludesAssociationNoValue" "self debug:#testIncludesAssociationNoValue" | dict a1 a3 | a1 := Association key: #Italie. a3 := Association key: #France value: 'Paris'. self assert: (a1 key = #Italie). self assert: (a1 value isNil). dict := Dictionary new. dict add: a1. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: #Italie). self assert: (dict at: #Italie) isNil. self assert: (dict at: #France) = 'Paris' |
| DictionaryTest>>testAtError: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:26) |
no previous history |
testAtError "self run: #testAtError" | dict | dict := Dictionary new. dict at: #a put: 666. self shouldnt: [ dict at: #a ] raise: Error. self should: [ dict at: #b ] raise: Error. |
| DictionaryTest>>testKeys: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:23) |
no previous history |
testKeys "self run:#testKeys " | a1 a2 dict | a1 := Association key: 'France' value: 'Paris'. a2 := Association key: 'Italie' value: 'Rome'. dict := Dictionary new. dict add: a1. dict add: a2. self assert: (dict keys size) = 2. self assert: (dict keys includes: #France) |
| DictionaryTest>>testKeyAtValue: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:24) |
no previous history |
testKeyAtValue "self run: #testKeyAtValue" "self debug: #testKeyAtValue" | dict | dict := Dictionary new. dict at: #a put: 1. dict at: #b put: 2. dict at: #c put: 1. self assert: (dict keyAtValue: 2) = #b. self assert: (dict keyAtValue: 1) = #c. "ugly may be a bug, why not having a set #a and #c" self should: [dict keyAtValue: 0] raise: Error |
| DictionaryTest>>testAssociationsSelect: (fbs 2/13/2006 22:53 -> ndCollectionsTests-Unordered 3/16/2006 10:30) |
testAssociationsSelect | answer d | d := Dictionary new. d at: (Array with: #hello with: #world) put: #fooBar. d at: Smalltalk put: #'Smalltalk is the key'. d at: #Smalltalk put: Smalltalk. answer := d associationsSelect: [:assoc | assoc key == #Smalltalk and: [assoc value == Smalltalk]]. self should: [answer isKindOf: Dictionary]. self should: [answer size = 1]. self should: [(answer at: #Smalltalk) == Smalltalk]. answer := d associationsSelect: [:assoc | assoc key == #NoSuchKey and: [assoc value == #NoSuchValue]]. self should: [answer isKindOf: Dictionary]. self should: [answer isEmpty] |
testAssociationsSelect | answer d | d := Dictionary new. d at: (Array with: #hello with: #world) put: #fooBar. d at: Smalltalk put: #'Smalltalk is the key'. d at: #Smalltalk put: Smalltalk. answer := d associationsSelect: [:assoc | assoc key == #Smalltalk and: [assoc value == Smalltalk]]. self should: [answer isKindOf: Dictionary]. self should: [answer size == 1]. self should: [(answer at: #Smalltalk) == Smalltalk]. answer := d associationsSelect: [:assoc | assoc key == #NoSuchKey and: [assoc value == #NoSuchValue]]. self should: [answer isKindOf: Dictionary]. self should: [answer size == 0] |
testAssociationsSelect | answer d | d := Dictionary new. d at: (Array with: #hello with: #world) put: #fooBar. |
| DictionaryTest>>testIncludesKey: (no stamp -> ndCollectionsTests-Unordered 3/16/2006 10:24) |
no previous history |
testIncludesKey "self run:#testIncludesKey" "self debug:#testIncludesKey" | dict a1 a2 a3 | a1 := Association key: 'Italie'. a2 := Association new. a3 := Association key: 'France' value: 'Paris'. dict := Dictionary new. dict add: a1 . dict add: a2. dict add: a3. self assert: (dict includesKey: #France). self assert: (dict includesKey: 'France'). self assert: (dict includesKey: #Italie). self assert: (dict includesKey: nil). self assert: (dict at: 'France' ) = 'Paris'. |
| HeapTest>>testRemove: (no stamp -> nm 2/15/2006 09:55) |
no previous history |
testRemove "self run: #testRemove" | heap | heap := Heap new. self should: [heap removeFirst] raise: Error. heap add: 5. self shouldnt: [heap removeFirst] raise: Error. self assert: heap size = 0. heap add: 5. self should: [heap removeAt: 2] raise: Error. |
| HeapTest>>testAdd: (no stamp -> nm 2/28/2006 09:37) |
no previous history |
testAdd "self run: #testAdd" | heap | heap := Heap new. self assert: heap size = 0. heap add: 3. self assert: heap size = 1. self assert: heap isEmpty not. self assert: heap first = 3. self assert: (heap at: 1) = 3. heap add: 2. self assert: heap size = 2. self assert: heap first = 2. self assert: (heap at: 2) = 3. |
| HeapTest>>testHeap: (no stamp -> nm 4/3/2006 11:27) |
no previous history |
testHeap "self run: #testHeap" | heap | heap := Heap new. self assert: heap isHeap. self assert: heap isEmpty. heap add: 1. self assert: heap isEmpty not |
| HeapTest>>testDo: (no stamp -> nm 4/3/2006 11:22) |
no previous history |
testDo "self run: #testDo" | heap coll | heap := Heap withAll: #(1 3 5). coll := OrderedCollection new. heap do: [:each | coll add: each]. self assert: coll = #(1 3 5) asOrderedCollection. |
| HeapTest>>testSortBlock: (no stamp -> nm 4/3/2006 11:17) |
no previous history |
testSortBlock "self run: #testSortBlock" | heap | heap := Heap withAll: #(1 3 5). self assert: heap = #(1 3 5). heap sortBlock: [ :e1 :e2 | e1 >= e2 ]. self assert: heap = #(5 3 1) |
| HeapTest>>testFirst: (no stamp -> nm 2/28/2006 09:36) |
no previous history |
testFirst "self run: #testFirst" | heap | heap := Heap new. heap add: 5. heap add: 12. heap add: 1. self assert: heap first = 1. heap removeFirst. self assert: heap first = 5. |
| MenuMorph>>addTitle:icon:updatingSelector:updateTarget:: (tbn 4/24/2006 19:59 -> pf 11/15/2006 16:42) |
addTitle: aString icon: aForm updatingSelector: aSelector updateTarget: aTarget "Add a title line at the top of this menu Make aString its initial contents. If aSelector is not nil, then periodically obtain fresh values for its contents by sending aSelector to aTarget.." | title titleContainer | title := AlignmentMorph newColumn. self setTitleParametersFor: title. "" aForm isNil ifTrue: [titleContainer := title] ifFalse: [| pair | pair := AlignmentMorph newRow. pair color: Color transparent. pair hResizing: #shrinkWrap. pair layoutInset: 0. "" pair addMorphBack: aForm asMorph. "" titleContainer := AlignmentMorph newColumn. titleContainer color: Color transparent. titleContainer vResizing: #shrinkWrap. titleContainer wrapCentering: #center. titleContainer cellPositioning: #topCenter. titleContainer layoutInset: 0. pair addMorphBack: titleContainer. "" title addMorphBack: pair]. "" aSelector ifNil: ["" aString asString linesDo: [:line | titleContainer addMorphBack: (StringMorph contents: line font: Preferences standardMenuFont)]] ifNotNil: [| usm | usm := UpdatingStringMorph on: aTarget selector: aSelector. usm font: Preferences standardMenuFont. usm useStringFormat. usm lock. titleContainer addMorphBack: usm]. "" title setProperty: #titleString toValue: aString. self addMorphFront: title. "" title borderWidth: 1. title useSquareCorners. (self hasProperty: #needsTitlebarWidgets) ifTrue: [self addStayUpIcons] |
addTitle: aString icon: aForm updatingSelector: aSelector updateTarget: aTarget "Add a title line at the top of this menu Make aString its initial contents. If aSelector is not nil, then periodically obtain fresh values for its contents by sending aSelector to aTarget.." | title titleContainer | title := AlignmentMorph newColumn. self setTitleParametersFor: title. "" aForm isNil ifTrue: [titleContainer := title] ifFalse: [| pair | pair := AlignmentMorph newRow. pair color: Color transparent. pair hResizing: #shrinkWrap. pair layoutInset: 0. "" pair addMorphBack: aForm asMorph. "" titleContainer := AlignmentMorph newColumn. titleContainer color: Color transparent. titleContainer vResizing: #shrinkWrap. titleContainer wrapCentering: #center. titleContainer cellPositioning: #topCenter. titleContainer layoutInset: 0. pair addMorphBack: titleContainer. "" title addMorphBack: pair]. "" aSelector ifNil: ["" aString asString linesDo: [:line | titleContainer addMorphBack: (StringMorph contents: line font: Preferences standardMenuFont)]] ifNotNil: [| usm | usm := UpdatingStringMorph on: aTarget selector: aSelector. usm font: Preferences standardMenuFont. usm useStringFormat. usm lock. titleContainer addMorphBack: usm]. "" title setProperty: #titleString toValue: aString. self addMorphFront: title. "" title useSquareCorners. (self hasProperty: #needsTitlebarWidgets) ifTrue: [self addStayUpIcons] |
addTitle: aString icon: aForm updatingSelector: aSelector updateTarget: aTarget "Add a title line at the top of this menu Make aString its initial contents. If aSelector is not nil, then periodically obtain fresh values for its contents by sending aSelector to aTarget.." | title titleContainer | title := AlignmentMorph newColumn. self setTitleParametersFor: title. "" aForm isNil ifTrue: [titleContainer := title] ifFalse: [| pair | pair := AlignmentMorph newRow. pair color: Color transparent. pair hResizing: #shrinkWrap. pair layoutInset: 0. "" pair addMorphBack: aForm asMorph. "" titleContainer := AlignmentMorph newColumn. titleContainer color: Color transparent. titleContainer vResizing: #shrinkWrap. titleContainer wrapCentering: #center. titleContainer cellPositioning: #topCenter. titleContainer layoutInset: 0. pair addMorphBack: titleContainer. "" title addMorphBack: pair]. "" aSelector ifNil: ["" aString asString linesDo: [:line | titleContainer addMorphBack: (StringMorph contents: line font: Preferences standardMenuFont)]] ifNotNil: [| usm | usm := UpdatingStringMorph on: aTarget selector: aSelector. usm font: Preferences standardMenuFont. usm useStringFormat. usm lock. titleContainer addMorphBack: usm]. "" title setProperty: #titleString toValue: aString. self addMorphFront: title. "" |
| Object>>isTrait: (no stamp -> pmm 7/6/2006 20:46) |
no previous history |
isTrait "Return true if the receiver is a trait. Note: Do not override in any class except TraitBehavior." ^false |
| ParagraphEditor>>browseIt: (pmm 6/3/2006 15:13 -> pmm 7/6/2006 20:50) |
browseIt "Launch a browser for the current selection, if appropriate" | aSymbol anEntry | self flag: #yoCharCases. Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ self]. (aSymbol _ self selectedSymbol) isNil ifTrue: [^ view flash]. self terminateAndInitializeAround: [aSymbol first isUppercase ifTrue: [anEntry _ (Smalltalk at: aSymbol ifAbsent: [ self systemNavigation browseAllImplementorsOf: aSymbol. ^ nil]). anEntry isNil ifTrue: [^ view flash]. ToolSet browse: anEntry theNonMetaClass selector: nil. ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]] |
browseIt "Launch a browser for the current selection, if appropriate" | aSymbol anEntry | self flag: #yoCharCases. Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ self]. (aSymbol _ self selectedSymbol) isNil ifTrue: [^ view flash]. self terminateAndInitializeAround: [aSymbol first isUppercase ifTrue: [anEntry _ (Smalltalk at: aSymbol ifAbsent: [ self systemNavigation browseAllImplementorsOf: aSymbol. ^ nil]). anEntry isNil ifTrue: [^ view flash]. (anEntry isBehavior or: [ anEntry isTrait ]) ifFalse: [ anEntry := anEntry class ]. ToolSet browse: anEntry selector: nil. ] ifFalse:[ self systemNavigation browseAllImplementorsOf: aSymbol]] |
browseIt "Launch a browser for the current selection, if appropriate" | aSymbol anEntry | self flag: #yoCharCases. Preferences alternativeBrowseIt ifTrue: [^ self browseClassFromIt]. self lineSelectAndEmptyCheck: [^ self]. (aSymbol _ self selectedSymbol) isNil ifTrue: [^ view flash]. self terminateAndInitializeAround: [aSymbol first isUppercase ifTrue: [anEntry _ (Smalltalk at: aSymbol ifAbsent: [ self systemNavigation browseAllImplementorsOf: aSymbol. ^ nil]). anEntry isNil ifTrue: [^ view flash]. (anEntry isBehavior or: [ anEntry isTrait ]) ifFalse: [ anEntry := anEntry class ]. ToolSet browse: anEntry selector: nil. |
| Set class>>rehashAllSets: (SqR 8/3/2000 13:18 -> pmm 7/9/2006 11:48) |
rehashAllSets "Set rehashAllSets" | insts | self withAllSubclassesDo: [:c | insts _ c allInstances. insts isEmpty ifFalse: ['Rehashing instances of ' , c name displayProgressAt: Sensor cursorPoint from: 1 to: insts size during: [:bar | 1 to: insts size do: [:x | bar value: x. (insts at: x) rehash]] ] ] |
rehashAllSets "Set rehashAllSets" self withAllSubclassesDo: [ :setClass | | instances | instances := setClass allInstances. instances isEmpty ifFalse: [ 1 to: instances size do: [ :index | (instances at: index) rehash ] ] ] |
rehashAllSets "Set rehashAllSets" self withAllSubclassesDo: [ :setClass | | instances | instances := setClass allInstances. instances isEmpty ifFalse: [ 1 to: instances size do: [ :index | (instances at: index) rehash ] ] ] |
| Set class>>new: (md 2/11/2006 20:48 -> pmm 7/9/2006 11:46) |
new ^ self new: 5 |
new ^ self basicNew initialize: 5 |
new ^ self basicNew initialize: 5 |
| FloatTest>>testInfinity3: (no stamp -> pmm 2/27/2006 10:49) |
no previous history |
testInfinity3 self assert: (Float infinity negated asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '11111111100000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '11111111100000000000000000000000' readStream base: 2)) = Float infinity negated |
| FloatTest>>testNaN5: (no stamp -> pmm 2/27/2006 10:48) |
no previous history |
testNaN5 self assert: (Float nan asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '01111111110000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '01111111110000000000000000000000' readStream base: 2)) isNaN |
| FloatTest>>testZero2: (no stamp -> pmm 2/27/2006 10:49) |
no previous history |
testZero2 self assert: (Float negativeZero asIEEE32BitWord printPaddedWith: $0 to: 32 base: 2) = '10000000000000000000000000000000'. self assert: (Float fromIEEE32Bit: (Integer readFrom: '10000000000000000000000000000000' readStream base: 2)) = Float negativeZero |
| StrikeFont class>>defaultSized:: (no stamp -> rej 9/29/2007 08:50) |
no previous history |
defaultSized: aNumber | fonts f | "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." fonts := (TextConstants at: #Accuny) fontArray. f := fonts first. 1 to: fonts size do: [:i | aNumber > (fonts at: i) height ifTrue: [f _ fonts at: i]. ]. ^f |
| StrikeFont>>setupDefaultFallbackFont: (yo 5/24/2004 23:11 -> rej 9/29/2007 09:02) |
setupDefaultFallbackFont | fonts f | fonts _ TextStyle default fontArray. f _ fonts first. 1 to: fonts size do: [:i | self height > (fonts at: i) height ifTrue: [f _ fonts at: i]. ]. self fallbackFont: f. self reset. |
setupDefaultFallbackFont "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." self fallbackFont: (StrikeFont defaultSized: self height). self reset. |
setupDefaultFallbackFont "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." self fallbackFont: (StrikeFont defaultSized: self height). |
| FixedFaceFont>>initialize: (tak 12/20/2004 10:37 -> rej 9/29/2007 09:04) |
initialize baseFont := TextStyle defaultFont. self passwordFont |
initialize "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." baseFont := StrikeFont defaultSized: 12. self passwordFont |
initialize "This used to be the default textstyle, but it needs to be a StrikeFont and not a TTCFont and sometimes the default textstyle is a TTCFont. So, we use a typical StrikeFont as the default fallback font." baseFont := StrikeFont defaultSized: 12. |
| FloatTest>>testNaN2: (dtl 10/1/2004 18:26 -> rej 10/7/2007 20:40) |
testNaN2 "Two NaN values are always considered to be different. On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000. On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing the bit pattern of the first word of a NaN produces another value that is still considered equal to NaN. This test should work on both little endian and big endian machines. However, it is not guaranteed to work on future 64 bit versions of Squeak, for which Float may have different internal representations." "FloatTest new testNaN2" | nan1 nan2 | nan1 := Float nan copy. nan2 := Float nan copy. "test two instances of NaN with the same bit pattern" self deny: nan1 = nan2. self deny: nan1 == nan2. self deny: nan1 = nan1. self assert: nan1 == nan1. "change the bit pattern of nan1" self assert: nan1 size == 2. self assert: (nan1 at: 2) = 0. nan1 at: 1 put: (nan1 at: 1) + 999. self assert: nan1 isNaN. self assert: nan2 isNaN. self deny: (nan1 at: 1) = (nan2 at: 1). "test two instances of NaN with different bit patterns" self deny: nan1 = nan2. self deny: nan1 == nan2. self deny: nan1 = nan1. self assert: nan1 == nan1 |
testNaN2 "Two NaN values are always considered to be different. On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000. On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing the bit pattern of the first word of a NaN produces another value that is still considered equal to NaN. This test should work on both little endian and big endian machines. However, it is not guaranteed to work on future 64 bit versions of Squeak, for which Float may have different internal representations." "FloatTest new testNaN2" | nan1 nan2 | nan1 := Float nan copy. nan2 := Float nan copy. "test two instances of NaN with the same bit pattern" self deny: nan1 = nan2. self deny: nan1 = nan2. self deny: nan1 = nan1. self assert: nan1 == nan1. "change the bit pattern of nan1" self assert: nan1 size = 2. self assert: (nan1 at: 2) = 0. nan1 at: 1 put: (nan1 at: 1) + 999. self assert: nan1 isNaN. self assert: nan2 isNaN. self deny: (nan1 at: 1) = (nan2 at: 1). "test two instances of NaN with different bit patterns" self deny: nan1 = nan2. self deny: nan1 = nan2. self deny: nan1 = nan1. self assert: nan1 == nan1 |
testNaN2 "Two NaN values are always considered to be different. On an little-endian machine (32 bit Intel), Float nan is 16rFFF80000 16r00000000. On a big-endian machine (PowerPC), Float nan is 16r7FF80000 16r00000000. Changing the bit pattern of the first word of a NaN produces another value that is still considered equal to NaN. This test should work on both little endian and big endian machines. However, it is not guaranteed to work on future 64 bit versions of Squeak, for which Float may have different internal representations." "FloatTest new testNaN2" | nan1 nan2 | nan1 := Float nan copy. nan2 := Float nan copy. "test two instances of NaN with the same bit pattern" self deny: nan1 = nan2. self deny: nan1 = nan2. |
| PCCByCompilationTest>>cExternalCall1: (md 9/6/2005 19:39 -> rej 11/26/2006 21:22) |
cExternalCall1 <primitive: 'prim1' module: 'CPCCT'> |
cExternalCall1 <primitive: 'prim1' module: 'CPCCT'> |
cExternalCall1 <primitive: 'prim1' module: 'CPCCT'> |
| PCCByCompilationTest>>cFailedCall: (md 9/6/2005 19:39 -> rej 11/26/2006 21:22) |
cFailedCall <primitive: 'primGetModuleName' module:'CFailModule'> ^ 'failed call' |
cFailedCall <primitive: 'primGetModuleName' module:'CFailModule'> ^ 'failed call' |
cFailedCall <primitive: 'primGetModuleName' module:'CFailModule'> ^ 'failed call' |
| PCCByCompilationTest>>cExternalCall2: (md 9/6/2005 19:39 -> rej 11/26/2006 21:22) |
cExternalCall2 <primitive:'prim2'module:'CPCCT'> self primitiveFailed |
cExternalCall2 <primitive:'prim2'module:'CPCCT'> self primitiveFailed |
cExternalCall2 <primitive:'prim2'module:'CPCCT'> self primitiveFailed |
| PCCByCompilationTest>>cRealExternalCallOrPrimitiveFailed: (md 9/6/2005 19:39 -> rej 11/26/2006 21:22) |
cRealExternalCallOrPrimitiveFailed <primitive: 'primGetModuleName' module:'LargeIntegers'> self primitiveFailed |
cRealExternalCallOrPrimitiveFailed <primitive: 'primGetModuleName' module:'LargeIntegers'> self primitiveFailed |
cRealExternalCallOrPrimitiveFailed <primitive: 'primGetModuleName' module:'LargeIntegers'> self primitiveFailed |
| PNGReadWriterTest>>tearDown: (nk 2/17/2004 11:29 -> rej 11/24/2006 18:24) |
tearDown World changed. |
tearDown World changed. fileName notNil ifTrue: [FileDirectory default deleteFileNamed: fileName] |
tearDown
World changed.
fileName notNil ifTrue: [FileDirectory default deleteFileNamed: fileName]
|
| ChangeHooksTest>>tearDown: (edc 5/25/2007 09:35 -> rej 9/29/2007 10:24) |
tearDown super tearDown. self removeGeneratedTestClasses. ChangesOrganizer newChangeSet: previousChangeSet name. ChangesOrganizer removeChangeSet: testsChangeSet. previousChangeSet := nil. testsChangeSet := nil. |
tearDown super tearDown. self removeGeneratedTestClasses. ChangeSet newChanges: previousChangeSet. ChangesOrganizer removeChangeSet: testsChangeSet. previousChangeSet := nil. testsChangeSet := nil. |
tearDown super tearDown. self removeGeneratedTestClasses. ChangeSet newChanges: previousChangeSet. |
| MCDefinition>>addMethodAdditionTo:: (no stamp -> rej 2/26/2007 18:45) |
no previous history |
addMethodAdditionTo: aCollection Transcript show: self printString. self load |
| MCMethodDefinition>>addMethodAdditionTo:: (no stamp -> rej 2/26/2007 10:42) |
no previous history |
addMethodAdditionTo: aCollection | methodAddition | methodAddition := MethodAddition new compile: source classified: category withStamp: timeStamp notifying: (SyntaxError new category: category) logSource: true inClass: self actualClass. "This might raise an exception and never return" methodAddition createCompiledMethod. aCollection add: methodAddition. |
| MCFileRepositoryInspector>>refresh: (md 2/28/2006 12:10 -> rej 2/21/2007 21:08) |
refresh | packageNames name latest av | packageNames := Set new. versions := repository readableFileNames collect: [ :each | name := (each copyUpToLast: $.) copyUpTo: $(. name last isDigit ifFalse: [Array with: name with: '' with: '' with: each] ifTrue: [Array with: (packageNames add: (name copyUpToLast: $-)) "pkg name" with: ((name copyAfterLast: $-) copyUpTo: $.) "user" with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version" with: each]]. newer := Set new. inherited := Set new. loaded := Set new. (MCWorkingCopy allManagers " select: [ :each | packageNames includes: each packageName]") do: [:each | each ancestors do: [ :ancestor | loaded add: ancestor name. ancestor ancestorsDoWhileTrue: [:heir | (inherited includes: heir name) ifTrue: [false] ifFalse: [inherited add: heir name. true]]]. latest := (versions select: [:v | v first = each package name]) detectMax: [:v | v third]. (latest notNil and: [ each ancestors allSatisfy: [:ancestor | av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger. av < latest third or: [ av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]]) ifTrue: [newer add: each package name ]]. self changed: #packageList; changed: #versionList |
refresh | packageNames name latest av | packageNames := Set new. versions := repository readableFileNames collect: [ :each | name := (each copyUpToLast: $.) copyUpTo: $(. name last isDigit ifFalse: [Array with: name with: '' with: '' with: each] ifTrue: [Array with: (packageNames add: (name copyUpToLast: $-)) "pkg name" with: ((name copyAfterLast: $-) copyUpTo: $.) "user" with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version" with: each]]. versions := versions select: [:each | (each at: 3) isNumber]. newer := Set new. inherited := Set new. loaded := Set new. (MCWorkingCopy allManagers " select: [ :each | packageNames includes: each packageName]") do: [:each | each ancestors do: [ :ancestor | loaded add: ancestor name. ancestor ancestorsDoWhileTrue: [:heir | (inherited includes: heir name) ifTrue: [false] ifFalse: [inherited add: heir name. true]]]. latest := (versions select: [:v | v first = each package name]) detectMax: [:v | v third]. (latest notNil and: [ each ancestors allSatisfy: [:ancestor | av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger. av < latest third or: [ av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]]) ifTrue: [newer add: each package name ]]. self changed: #packageList; changed: #versionList |
refresh
| packageNames name latest av |
packageNames := Set new.
versions := repository readableFileNames collect: [ :each |
name := (each copyUpToLast: $.) copyUpTo: $(.
name last isDigit ifFalse: [Array with: name with: '' with: '' with: each]
ifTrue:
[Array
with: (packageNames add: (name copyUpToLast: $-)) "pkg name"
with: ((name copyAfterLast: $-) copyUpTo: $.) "user"
with: ((name copyAfterLast: $-) copyAfter: $.) asInteger "version"
with: each]].
versions := versions select: [:each | (each at: 3) isNumber].
newer := Set new.
inherited := Set new.
loaded := Set new.
(MCWorkingCopy allManagers
" select: [ :each | packageNames includes: each packageName]")
do: [:each |
each ancestors do: [ :ancestor |
loaded add: ancestor name.
ancestor ancestorsDoWhileTrue: [:heir |
(inherited includes: heir name)
ifTrue: [false]
ifFalse: [inherited add: heir name. true]]].
latest := (versions select: [:v | v first = each package name])
detectMax: [:v | v third].
(latest notNil and: [
each ancestors allSatisfy: [:ancestor |
av := ((ancestor name copyAfterLast: $-) copyAfter: $.) asInteger.
av < latest third or: [
av = latest third and: [((ancestor name copyAfterLast: $-) copyUpTo: $.) ~= latest second]]]])
ifTrue: [newer add: each package name ]].
self changed: #packageList; changed: #versionList
|
| MCPackageLoader>>basicLoad: (stephaneducasse 2/4/2006 20:47 -> rej 2/26/2007 10:52) |
basicLoad errorDefinitions := OrderedCollection new. [[additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'. removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'. self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. errorDefinitions do: [:ea | ea loadOver: (self obsoletionFor: ea)] displayingProgress: 'Reloading...'. additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...'] on: InMidstOfFileinNotification do: [:n | n resume: true]] ensure: [self flushChangesFile] |
basicLoad errorDefinitions := OrderedCollection new. [[additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'. removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'. self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. errorDefinitions do: [:ea | ea addMethodAdditionTo: methodAdditions] displayingProgress: 'Reloading...'. methodAdditions do: [:each | each installMethod]. methodAdditions do: [:each | each notifyObservers]. additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...'] on: InMidstOfFileinNotification do: [:n | n resume: true]] ensure: [self flushChangesFile] |
basicLoad errorDefinitions := OrderedCollection new. [[additions do: [:ea | self tryToLoad: ea] displayingProgress: 'Loading...'. removals do: [:ea | ea unload] displayingProgress: 'Cleaning up...'. self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. errorDefinitions do: [:ea | ea addMethodAdditionTo: methodAdditions] displayingProgress: 'Reloading...'. methodAdditions do: [:each | each installMethod]. methodAdditions do: [:each | each notifyObservers]. |
| MCPackageLoader>>tryToLoad:: (avi 2/17/2004 13:15 -> rej 2/26/2007 10:41) |
tryToLoad: aDefinition [aDefinition loadOver: (self obsoletionFor: aDefinition)] on: Error do: [errorDefinitions add: aDefinition]. |
tryToLoad: aDefinition [aDefinition addMethodAdditionTo: methodAdditions] on: Error do: [errorDefinitions add: aDefinition]. |
tryToLoad: aDefinition [aDefinition addMethodAdditionTo: methodAdditions] on: Error do: [errorDefinitions add: aDefinition]. |
| MethodAddition>>compile:classified:withStamp:notifying:logSource:inClass:: (no stamp -> rej 2/25/2007 20:36) |
no previous history |
compile: aString classified: aString1 withStamp: aString2 notifying: aRequestor logSource: aBoolean inClass: aClass text := aString. category := aString1. changeStamp := aString2. requestor := aRequestor. logSource := aBoolean. myClass := aClass |
| MethodAddition>>notifyObservers: (no stamp -> rej 2/25/2007 22:12) |
no previous history |
notifyObservers SystemChangeNotifier uniqueInstance doSilently: [myClass organization classify: selector under: category]. priorMethodOrNil isNil ifTrue: [SystemChangeNotifier uniqueInstance methodAdded: compiledMethod selector: selector inProtocol: category class: myClass requestor: requestor] ifFalse: [SystemChangeNotifier uniqueInstance methodChangedFrom: priorMethodOrNil to: compiledMethod selector: selector inClass: myClass requestor: requestor]. "The following code doesn't seem to do anything." myClass instanceSide noteCompilationOf: selector meta: myClass isClassSide. |
| MethodAddition>>writeSourceToLog: (no stamp -> rej 2/25/2007 20:42) |
no previous history |
writeSourceToLog logSource ifTrue: [ myClass logMethodSource: text forMethodWithNode: methodAndNode inCategory: category withStamp: changeStamp notifying: requestor. ]. |
| MethodAddition>>createCompiledMethod: (no stamp -> rej 2/26/2007 05:17) |
no previous history |
createCompiledMethod methodAndNode := myClass compile: text asString classified: category notifying: requestor trailer: myClass defaultMethodTrailer ifFail: [^nil]. selector := methodAndNode selector. compiledMethod := methodAndNode method. self writeSourceToLog. priorMethodOrNil := myClass compiledMethodAt: selector ifAbsent: [nil]. |
| MethodAddition>>compile: (no stamp -> rej 2/26/2007 10:51) |
no previous history |
compile
"This method is the how compiling a method used to work. All these steps were done at once.
This method should not normally be used, because the whole point of MethodAddition is to let
you first create a compiled method and then install the method later."
self createCompiledMethod.
self installMethod.
self notifyObservers.
^selector
|
| MethodAddition>>installMethod: (no stamp -> rej 2/25/2007 22:09) |
no previous history |
installMethod myClass addSelectorSilently: selector withMethod: compiledMethod. |
| LedDigitMorph class>>initialize: (no stamp -> rjf 5/25/2000 00:16) |
no previous history |
initialize
HSegmentOrigins _ {0.2@0.1. 0.2@0.45. 0.2@0.8}.
VSegmentOrigins _ {0.1@0.2. 0.1@0.55. 0.8@0.2. 0.8@0.55}.
HSegments _ {
{true. false. true}.
{false. false. false}.
{true. true. true}.
{true. true. true}.
{false. true. false}.
{true. true. true}.
{true. true. true}.
{true. false. false}.
{true. true. true}.
{true. true. true}.
{false. true. false}}.
VSegments _ {
{true. true. true. true}.
{false. false. true. true}.
{false. true. true. false}.
{false. false. true. true}.
{true. false. true. true}.
{true. false. false. true}.
{true. true. false. true}.
{false. false. true. true}.
{true. true. true. true}.
{true. false. true. true}.
{false. false. false. false}}.
|
| FileDirectory>>oldFileOrNoneNamed:: (tpr 10/13/2003 12:34 -> rop 3/14/2004 13:52) |
oldFileOrNoneNamed: fileName "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." ^ FileStream oldFileOrNoneNamed: fileName |
oldFileOrNoneNamed: localFileName "If the file exists, answer a read-only FileStream on it. If it doesn't, answer nil." ^ FileStream concreteStream oldFileOrNoneNamed: (self fullNameFor: localFileName) |
oldFileOrNoneNamed: localFileName |
| Interval>>includes:: (di 11/10/97 12:22 -> rpj 11/30/1999 11:04) |
includes: aNumber ^ aNumber between: self first and: self last |
includes: aNumber "Determine if aNumber is an element of this interval." ^ (self rangeIncludes: aNumber) and: [ self valuesInclude: aNumber ] |
includes: aNumber "Determine if aNumber is an element of this interval." ^ (self rangeIncludes: aNumber) and: [ self valuesInclude: aNumber ] |
| SkipListNode class>>on:level:: (LC 6/18/2001 10:20 -> sac 1/22/2002 17:57) |
on: element level: maxLevel ^ (self new: maxLevel) object: element |
on: element level: maxLevel
^ self key: element value: element level: maxLevel
|
on: element level: maxLevel ^ self key: element value: element level: maxLevel |
| SkipListNode class>>key:value:level:: (no stamp -> sac 1/22/2002 17:53) |
no previous history |
key: key value: value level: maxLevel
^ (super key: key value: value) initialize: maxLevel
|
| SkipListNode>>printOn:: (sac 1/22/2002 17:22 -> sac 1/22/2002 17:22) |
printOn: aStream
| first |
aStream
nextPut: $[.
super printOn: aStream.
aStream
nextPutAll: ']-->('.
first _ true.
pointers do: [:node |
first ifTrue: [first _ false] ifFalse: [aStream space].
node ifNil: [aStream nextPutAll: '*']
ifNotNil: [node printOn: aStream]].
aStream nextPut: $)
|
printOn: aStream
| first |
aStream
nextPut: $[.
super printOn: aStream.
aStream
nextPutAll: ']-->('.
first := true.
pointers do: [:node |
first ifTrue: [first := false] ifFalse: [aStream space].
node ifNil: [aStream nextPutAll: '*']
ifNotNil: [node printOn: aStream]].
aStream nextPut: $)
|
printOn: aStream
| first |
aStream
nextPut: $[.
super printOn: aStream.
aStream
nextPutAll: ']-->('.
first := true.
|
| SkipList>>keysAndValuesDo:: (no stamp -> sac 1/25/2002 00:18) |
no previous history |
keysAndValuesDo: aBlock
^self associationsDo:[:assoc|
aBlock value: assoc key value: assoc value].
|
| SkipList>>search:updating:: (sac 1/22/2002 18:01 -> sac 1/22/2002 18:01) |
search: element updating: array
| node forward |
node _ self.
level to: 1 by: -1 do: [:i |
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward].
"At this point: node < element <= forward"
array ifNotNil: [array at: i put: node]].
node _ node next.
^ (self is: node theNodeFor: element) ifTrue: [node]
|
search: element updating: array
| node forward |
node := self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward].
"At this point: node < element <= forward"
array ifNotNil: [array at: i put: node]].
node := node next.
^ (self is: node theNodeFor: element) ifTrue: [node]
|
search: element updating: array
| node forward |
node := self.
|
| SkipList>>at:put:ifPresent:: (sac 1/22/2002 18:23 -> sac 1/22/2002 18:23) |
at: key put: value ifPresent: aBlock
| node lvl s |
node _ self search: key updating: splice.
node ifNotNil: [^ aBlock value].
lvl _ self randomLevel.
node _ SkipListNode key: key value: value level: lvl.
level + 1 to: lvl do: [:i | splice at: i put: self].
1 to: lvl do: [:i |
s _ splice at: i.
node atForward: i put: (s forward: i).
s atForward: i put: node].
numElements _ numElements + 1.
splice atAllPut: nil.
^ node
|
at: key put: value ifPresent: aBlock
| node lvl s |
node := self search: key updating: splice.
node ifNotNil: [^ aBlock value].
lvl := self randomLevel.
node := SkipListNode key: key value: value level: lvl.
level + 1 to: lvl do: [:i | splice at: i put: self].
1 to: lvl do: [:i |
s := splice at: i.
node atForward: i put: (s forward: i).
s atForward: i put: node].
numElements := numElements + 1.
splice atAllPut: nil.
^ node
|
at: key put: value ifPresent: aBlock
| node lvl s |
node := self search: key updating: splice.
|
| SkipList>>do:: (LC 6/18/2001 15:39 -> sac 1/23/2002 20:21) |
do: aBlock self nodesDo: [:node | aBlock value: node object] |
do: aBlock
self nodesDo: [:node | aBlock value: node value]
|
do: aBlock self nodesDo: [:node | aBlock value: node value] |
| SkipList>>associationsDo:: (no stamp -> sac 1/23/2002 20:24) |
no previous history |
associationsDo: aBlock
self nodesDo: [:node | aBlock value: node]
|
| SkipList>>remove:ifAbsent:: (sac 1/22/2002 16:58 -> sac 1/22/2002 16:58) |
remove: key ifAbsent: aBlock
| node i s |
"Remove and return th association containing key."
node _ self search: key updating: splice.
node ifNil: [^ aBlock value].
i _ 1.
[s _ splice at: i.
i <= level and: [(s forward: i) == node]]
whileTrue:
[s atForward: i put: (node forward: i).
i _ i + 1].
numElements _ numElements - 1.
splice atAllPut: nil.
^ node.
|
remove: key ifAbsent: aBlock
| node i s |
"Remove and return th association containing key."
node := self search: key updating: splice.
node ifNil: [^ aBlock value].
i := 1.
[s := splice at: i.
i <= level and: [(s forward: i) == node]]
whileTrue:
[s atForward: i put: (node forward: i).
i := i + 1].
numElements := numElements - 1.
splice atAllPut: nil.
^ node.
|
remove: key ifAbsent: aBlock
| node i s |
"Remove and return th association containing key."
node := self search: key updating: splice.
|
| SkipList>>at:ifAbsent:: (sac 1/22/2002 18:18 -> sac 1/22/2002 18:18) |
at: element ifAbsent: aBlock
"Get the key if it exists, or if it doesn't exist, get the key just after it."
| node forward |
node _ self.
level to: 1 by: -1 do: [:i |
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward]].
node _ node next.
(self is: node theNodeFor: element) ifFalse: [^aBlock value].
^node value
|
at: element ifAbsent: aBlock
"Get the key if it exists, or if it doesn't exist, get the key just after it."
| node forward |
node := self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward]].
node := node next.
(self is: node theNodeFor: element) ifFalse: [^aBlock value].
^node value
|
at: element ifAbsent: aBlock
"Get the key if it exists, or if it doesn't exist, get the key just after it."
| node forward |
node := self.
|
| SkipList>>add:ifPresent:: (LC 6/18/2001 20:42 -> sac 1/25/2002 12:26) |
add: element ifPresent: aBlock | node lvl s | node _ self search: element updating: splice. node ifNotNil: [aBlock ifNotNil: [^ aBlock value: node]]. lvl _ self randomLevel. node _ SkipListNode on: element level: lvl. level + 1 to: lvl do: [:i | splice at: i put: self]. 1 to: lvl do: [:i | s _ splice at: i. node atForward: i put: (s forward: i). s atForward: i put: node]. numElements _ numElements + 1. splice atAllPut: nil. ^ element |
add: element ifPresent: aBlock
^self at: element put: element ifPresent: aBlock.
|
add: element ifPresent: aBlock ^self at: element put: element ifPresent: aBlock. |
| SkipList>>keysDo:: (no stamp -> sac 1/23/2002 20:22) |
no previous history |
keysDo: aBlock
self nodesDo: [:node | aBlock value: node key]
|
| SkipList>>at:: (no stamp -> sac 1/22/2002 19:11) |
no previous history |
at: element
^self at: element ifAbsent: []
|
| SkipList>>is:before:: (sac 1/22/2002 17:50 -> sac 1/22/2002 17:50) |
is: node before: element
| key |
node ifNil: [^ false].
key _ node key.
^ sortBlock
ifNil: [key < element]
ifNotNil: [(self is: key equalTo: element) ifTrue: [^ false].
sortBlock value: key value: element]
|
is: node before: element
| key |
node ifNil: [^ false].
key := node key.
^ sortBlock
ifNil: [key < element]
ifNotNil: [(self is: key equalTo: element) ifTrue: [^ false].
sortBlock value: key value: element]
|
is: node before: element
| key |
node ifNil: [^ false].
key := node key.
|
| SkipList>>add:: (LC 6/18/2001 18:30 -> sac 1/22/2002 18:22) |
add: element self add: element ifPresent: nil. ^ element |
add: element
"Add an association or key on to the skiplist"
^self add: element ifPresent: [].
|
add: element "Add an association or key on to the skiplist" ^self add: element ifPresent: []. |
| SkipList>>at:put:: (no stamp -> sac 1/22/2002 18:22) |
no previous history |
at: key put: value
"Add an association or key on to the skiplist"
^self at: key put: value ifPresent: [].
|
| SkipList>>is:theNodeFor:: (LC 6/18/2001 13:19 -> sac 1/22/2002 18:04) |
is: node theNodeFor: element node ifNil: [^ false]. node == self ifTrue: [^ false]. ^ self is: node object equalTo: element |
is: node theNodeFor: key
node ifNil: [^ false].
node == self ifTrue: [^ false].
^ self is: node key equalTo: key
|
is: node theNodeFor: key node ifNil: [^ false]. node == self ifTrue: [^ false]. ^ self is: node key equalTo: key |
| SkipList>>search:: (sac 1/22/2002 18:33 -> sac 1/22/2002 18:33) |
search: element
"Get the key if it exists, or if it doesn't exist, get the key just after it. If no key after it, return nil."
| node forward |
node _ self.
level to: 1 by: -1 do: [:i |
[forward _ node forward: i.
self is: forward before: element] whileTrue: [node _ forward]].
node _ node next.
^node
|
search: element
"Get the key if it exists, or if it doesn't exist, get the key just after it. If no key after it, return nil."
| node forward |
node := self.
level to: 1 by: -1 do: [:i |
[forward := node forward: i.
self is: forward before: element] whileTrue: [node := forward]].
node := node next.
^node
|
search: element
"Get the key if it exists, or if it doesn't exist, get the key just after it. If no key after it, return nil."
| node forward |
node := self.
|
| SkipList>>includes:: (LC 6/18/2001 16:59 -> sac 1/22/2002 17:49) |
includes: element ^ (self search: element updating: nil) notNil |
includes: key
^ (self search: key updating: nil) notNil
|
includes: key ^ (self search: key updating: nil) notNil |
| SkipList>>first: (no stamp -> sac 1/22/2002 17:19) |
no previous history |
first
^pointers first.
|
| WorldState class>>deferredExecutionTimeLimit: (no stamp -> sk 1/26/2003 18:29) |
no previous history |
deferredExecutionTimeLimit "Answer the maximum time in milliseconds that should be spent dispatching deferred UI messages in WorldState>>runStepMethodsIn:." ^ 200 |
| WorldState>>runStepMethodsIn:: (ar 10/22/2000 16:07 -> sk 1/26/2003 18:31) |
runStepMethodsIn: aWorld "Perform periodic activity inbetween event cycles" | queue | queue _ self class deferredUIMessages. [queue isEmpty] whileFalse: [ queue next value ]. self runLocalStepMethodsIn: aWorld. "we are using a normal #step for these now" "aWorld allLowerWorldsDo: [ :each | each runLocalStepMethods ]." |
runStepMethodsIn: aWorld "Perform periodic activity inbetween event cycles" | queue numItems i limit stamp | queue _ self class deferredUIMessages. numItems _ queue size. i _ 0. limit _ self class deferredExecutionTimeLimit. stamp _ Time millisecondClockValue. "Dispatch deferred messages while maintaing rudimentary UI responsiveness." [i < numItems and: [(Time millisecondsSince: stamp) < limit]] whileTrue: [queue next value. i _ i + 1]. self runLocalStepMethodsIn: aWorld. "we are using a normal #step for these now" "aWorld allLowerWorldsDo: [ :each | each runLocalStepMethods ]." |
runStepMethodsIn: aWorld "Perform periodic activity inbetween event cycles" | queue numItems i limit stamp | |
| MethodDictionary>>do:: (no stamp -> to 1/14/98 10:13) |
no previous history |
do: aBlock tally = 0 ifTrue: [^ self]. 1 to: self basicSize do: [:i | (self basicAt: i) == nil ifFalse: [aBlock value: (array at: i)]] |
| DependentsArray>>size: (nk 3/11/2004 09:34 -> tp 7/6/2006 11:11) |
size ^self inject: 0 into: [ :count :dep | dep ifNotNil: [ count _ count + 1 ]] |
size ^self inject: 0 into: [ :count :dep | dep ifNil: [ count ] ifNotNil: [ count + 1 ]] |
size ^self inject: 0 into: [ :count :dep | dep ifNil: [ count ] ifNotNil: [ count + 1 ]] |
| Integer>>bitInvert: (no stamp -> wb 4/28/1998 12:17) |
no previous history |
bitInvert "Answer an Integer whose bits are the logical negation of the receiver's bits. Numbers are interpreted as having 2's-complement representation." ^ -1 - self |
| SmallInteger>>bitShift:: (no stamp -> wb 4/28/1998 12:17) |
bitShift: arg "Primitive. Answer an Integer whose value is the receiver's value shifted left by the number of bits indicated by the argument. Negative arguments shift right. Essential. See Object documentation whatIsAPrimitive." <primitive: 17> self < 0 ifTrue: [^ -1 - (-1-self bitShift: arg)]. ^ super bitShift: arg |
bitShift: arg "Primitive. Answer an Integer whose value is the receiver's value shifted left by the number of bits indicated by the argument. Negative arguments shift right. The receiver is interpreted as having 2's-complement representation. Essential. See Object documentation whatIsAPrimitive." <primitive: 17> self >= 0 ifTrue: [^ super bitShift: arg]. ^ arg >= 0 ifTrue: [(self negated bitShift: arg) negated] ifFalse: [(self bitInvert bitShift: arg) bitInvert] |
bitShift: arg "Primitive. Answer an Integer whose value is the receiver's value shifted left by the number of bits indicated by the argument. Negative arguments shift right. The receiver is interpreted as having 2's-complement representation. |
| SmallInteger>>bitXor:: (no stamp -> wb 4/28/1998 12:17) |
bitXor: arg "Primitive. Answer an Integer whose bits are the logical XOR of the receiver's bits and those of the argument, arg. Negative numbers are interpreted as a 32-bit 2's-complement. Essential. See Object documentation whatIsAPrimitive." <primitive: 16> self < 0 ifTrue: [^ 16rFFFFFFFF + (self+1) bitXor: arg]. ^arg bitXor: self |
bitXor: arg "Primitive. Answer an Integer whose bits are the logical XOR of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. Essential. See Object documentation whatIsAPrimitive." <primitive: 16> self >= 0 ifTrue: [^ arg bitXor: self]. ^ arg < 0 ifTrue: [self bitInvert bitXor: arg bitInvert] ifFalse: [(self bitInvert bitXor: arg) bitInvert] |
bitXor: arg "Primitive. Answer an Integer whose bits are the logical XOR of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. |
| SmallInteger>>bitAnd:: (no stamp -> wb 4/28/1998 12:17) |
bitAnd: arg "Primitive. Answer an Integer whose bits are the logical AND of the receiver's bits and those of the argument, arg. Negative numbers are interpreted as a 32-bit 2's-complement. Essential. See Object documentation whatIsAPrimitive." <primitive: 14> self < 0 ifTrue: [^ 16rFFFFFFFF + (self+1) bitAnd: arg]. ^arg bitAnd: self |
bitAnd: arg "Primitive. Answer an Integer whose bits are the logical OR of the receiver's bits and those of the argument, arg. Numbers are interpreted as having 2's-complement representation. Essential. See Object documentation whatIsAPrimitive." <primitive: 14> self >= 0 ifTrue: [^ arg bitAnd: self]. ^ (self bitInvert bitOr: arg bitInvert) bitInvert |
bitAnd: arg "Primitive. Answer an Integer whose bits are the logical OR of the |
| CollectionTest>>testPrintingArrayWithMetaclass: (no stamp -> wbk 7/26/2007 12:41) |
no previous history |
testPrintingArrayWithMetaclass
self assert: {Array class} printString = '{Array class}'
|
| Metaclass>>isSelfEvaluating: (no stamp -> wbk 7/26/2007 12:41) |
no previous history |
isSelfEvaluating ^ true |
| XBMReadWriter class>>initialize: (no stamp -> wdc 2/2/1999 15:28) |
no previous history |
initialize
"XBMReadWriter initialize"
| flippedByte |
Flipbits _ (0 to: 255) collect:
[:n | "Compute the bit-reversal of the 8-bit value, n"
flippedByte _ 0.
0 to: 7 do:
[:i |
flippedByte _ flippedByte bitOr: ((n >> i bitAnd: 1) << (7-i))].
flippedByte]
|
| XBMReadWriter>>parseByteValue: (no stamp -> wdc 2/2/1999 15:20) |
no previous history |
parseByteValue "skip over separators and return next bytevalue parsed as a C language number: 0ddd is an octal digit. 0xddd is a hex digit. ddd is decimal." | source mybase | stream skipSeparators. source _ ReadWriteStream on: String new. [stream atEnd or: [ stream peek isSeparator ]] whileFalse: [source nextPut: self next asUppercase]. mybase _ 10. "Base 10 default" source reset. (source peek = $0) ifTrue: [ mybase _ 8. "Octal or Hex, say its Octal unless overridden." source next. (source peek = $X) ifTrue: [ mybase _ 16. "Ah. It's Hex." source next. ] ]. ^ Integer readFrom: source base: mybase |
| XBMReadWriter>>nextImage: (no stamp -> wdc 2/1/1999 07:15) |
no previous history |
nextImage "Read in the next xbm image from the stream." | form long incount chunks byteWidth pad fourway outcount total | stream reset. stream ascii. self readHeader. form _ ColorForm extent: width@height depth: 1. incount _ 0. outcount _1. chunks _ Array new: 4. byteWidth _ width + 7 // 8. total _ byteWidth * height. byteWidth > 4 ifTrue: [ pad _ byteWidth \\ 4] ifFalse: [ pad _ 4 - byteWidth ]. fourway _ 0. [(incount = total)] whileFalse: [ incount _ incount + 1. fourway _ fourway + 1. chunks at: fourway put: (Flipbits at: ((self parseByteValue) +1)). (pad > 0 and: [(incount \\ byteWidth) = 0]) ifTrue: [ 1 to: pad do: [:q | fourway _ fourway + 1. chunks at: fourway put: 0] ]. fourway = 4 ifTrue: [ long _ Integer byte1: (chunks at: 4) byte2: (chunks at: 3) byte3: (chunks at: 2) byte4: (chunks at: 1). (form bits) at: outcount put: long. fourway _ 0. outcount _ outcount + 1]. ]. ^ form |