'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6643] on 10 April 2005 at 7:16:33 pm'! "Change Set: ExternalCleanup Date: 10 April 2005 Author: Andreas Raab Various cleanups in external references to string. All of these have been replaced by either isString, isByteString or isMultiByteString."! !BookMorph methodsFor: 'initialization' stamp: 'ar 4/10/2005 18:42'! fromURL: url "Make a book from an index and a bunch of pages on a server. NOT showing any page!!" | strm | Cursor wait showWhile: [ strm _ (ServerFile new fullPath: url) asStream]. strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil]. self setProperty: #url toValue: url. self fromRemoteStream: strm. ^ self! ! !BookMorph methodsFor: 'menu' stamp: 'ar 4/10/2005 18:42'! saveIndexOfOnly: aPage "Modify the index of this book on a server. Read the index, modify the entry for just this page, and write back. See saveIndexOnURL. (page file names must be unique even if they live in different directories.)" | mine sf remoteFile strm remote pageURL num pre index after dict allText allTextUrls fName | mine _ self valueOfProperty: #url. mine ifNil: [^ self saveIndexOnURL]. Cursor wait showWhile: [strm _ (ServerFile new fullPath: mine)]. strm ifNil: [^ self saveIndexOnURL]. strm isString ifTrue: [^ self saveIndexOnURL]. strm exists ifFalse: [^ self saveIndexOnURL]. "write whole thing if missing" strm _ strm asStream. strm isString ifTrue: [^ self saveIndexOnURL]. remote _ strm fileInObjectAndCode. dict _ remote first. allText _ dict at: #allText ifAbsent: [nil]. "remote, not local" allTextUrls _ dict at: #allTextUrls ifAbsent: [nil]. allText size + 1 ~= remote size ifTrue: [self error: '.bo size mismatch. Please tell Ted what you just did to this book.' translated]. (pageURL _ aPage url) ifNil: [self error: 'just had one!!' translated]. fName _ pageURL copyAfterLast: $/. 2 to: remote size do: [:ii | ((remote at: ii) url findString: fName startingAt: 1 caseSensitive: false) > 0 ifTrue: [index _ ii]. "fast" (remote at: ii) xxxReset]. index ifNil: ["new page, what existing page does it follow?" num _ self pageNumberOf: aPage. 1 to: num-1 do: [:ii | (pages at: ii) url ifNotNil: [pre _ (pages at: ii) url]]. pre ifNil: [after _ remote size+1] ifNotNil: ["look for it on disk, put me after" pre _ pre copyAfterLast: $/. 2 to: remote size do: [:ii | ((remote at: ii) url findString: pre startingAt: 1 caseSensitive: false) > 0 ifTrue: [after _ ii+1]]. after ifNil: [after _ remote size+1]]. remote _ remote copyReplaceFrom: after to: after-1 with: #(1). allText ifNotNil: [ dict at: #allText put: (allText copyReplaceFrom: after-1 to: after-2 with: #(())). dict at: #allTextUrls put: (allTextUrls copyReplaceFrom: after-1 to: after-2 with: #(()))]. index _ after]. remote at: index put: (aPage sqkPage copyForSaving). (dict at: #modTime ifAbsent: [0]) < Time totalSeconds ifTrue: [dict at: #modTime put: Time totalSeconds]. allText ifNotNil: [ (dict at: #allText) at: index-1 put: (aPage allStringsAfter: nil). (dict at: #allTextUrls) at: index-1 put: pageURL]. sf _ ServerDirectory new fullPath: mine. Cursor wait showWhile: [ remoteFile _ sf fileNamed: mine. remoteFile fileOutClass: nil andObject: remote. "remoteFile close"]. ! ! !BookMorph methodsFor: 'sorting' stamp: 'ar 4/10/2005 18:42'! acceptSortedContentsFrom: aHolder "Update my page list from the given page sorter." | goodPages rejects toAdd sqPage | goodPages := OrderedCollection new. rejects := OrderedCollection new. aHolder submorphs doWithIndex: [:m :i | toAdd := nil. (m isKindOf: PasteUpMorph) ifTrue: [toAdd := m]. (m isKindOf: BookPageThumbnailMorph) ifTrue: [toAdd := m page. m bookMorph == self ifFalse: ["borrowed from another book. preserve the original" toAdd := toAdd veryDeepCopy. "since we came from elsewhere, cached strings are wrong" self removeProperty: #allTextUrls. self removeProperty: #allText]]. toAdd isString ifTrue: ["a url" toAdd := pages detect: [:aPage | aPage url = toAdd] ifNone: [toAdd]]. toAdd isString ifTrue: [sqPage := SqueakPageCache atURL: toAdd. toAdd := sqPage contentsMorph ifNil: [sqPage copyForSaving "a MorphObjectOut"] ifNotNil: [sqPage contentsMorph]]. toAdd ifNil: [rejects add: m] ifNotNil: [goodPages add: toAdd]]. self newPages: goodPages. goodPages isEmpty ifTrue: [self insertPage]. rejects notEmpty ifTrue: [self inform: rejects size printString , ' objects vanished in this process.']! ! !BookPageThumbnailMorph methodsFor: 'fileIn/Out' stamp: 'ar 4/10/2005 18:45'! objectForDataStream: refStrm "I am about to be written on an object file. It would be bad to write a whole BookMorph out. Store a string that is the url of the book or page in my inst var." | clone bookUrl bb stem ind | (bookMorph isString) & (page isString) ifTrue: [ ^ super objectForDataStream: refStrm]. (bookMorph isNil) & (page isString) ifTrue: [ ^ super objectForDataStream: refStrm]. (bookMorph isNil) & (page url notNil) ifTrue: [ ^ super objectForDataStream: refStrm]. (bookMorph isNil) & (page url isNil) ifTrue: [ self error: 'page should already have a url' translated. "find page's book, and remember it" "bookMorph _ "]. clone _ self clone. (bookUrl _ bookMorph url) ifNil: [bookUrl _ self valueOfProperty: #futureUrl]. bookUrl ifNil: [ bb _ RectangleMorph new. "write out a dummy" bb bounds: bounds. refStrm replace: self with: bb. ^ bb] ifNotNil: [clone instVarNamed: 'bookMorph' put: bookUrl]. page url ifNil: [ "Need to assign a url to a page that will be written later. It might have bookmarks too. Don't want to recurse deeply. Have that page write out a dummy morph to save its url on the server." stem _ SqueakPage stemUrl: bookUrl. ind _ bookMorph pages identityIndexOf: page. page reserveUrl: stem,(ind printString),'.sp']. clone instVarNamed: 'page' put: page url. refStrm replace: self with: clone. ^ clone! ! !BookPageThumbnailMorph methodsFor: 'fileIn/Out' stamp: 'ar 4/10/2005 18:45'! objectsInMemory "See if page or bookMorph need to be brought in from a server." | bookUrl bk wld try | bookMorph ifNil: ["fetch the page" page isString ifFalse: [^ self]. "a morph" try _ (SqueakPageCache atURL: page) fetchContents. try ifNotNil: [page _ try]. ^ self]. bookMorph isString ifTrue: [ bookUrl _ bookMorph. (wld _ self world) ifNil: [wld _ Smalltalk currentWorld]. bk _ BookMorph isInWorld: wld withUrl: bookUrl. bk == #conflict ifTrue: [ ^ self inform: 'This book is already open in some other project' translated]. bk == #out ifTrue: [ (bk _ BookMorph new fromURL: bookUrl) ifNil: [^ self]]. bookMorph _ bk]. page isString ifTrue: [ page _ (bookMorph pages detect: [:pg | pg url = page] ifNone: [bookMorph pages first])]. ! ! !CanvasEncoder methodsFor: 'drawing' stamp: 'ar 4/10/2005 18:04'! drawString: s from: firstIndex to: lastIndex in: boundsRect font: fontOrNil color: c | fontIndex str | fontIndex := self establishFont: (fontOrNil ifNil: [ TextStyle defaultFont ]). str _ s asString. str isMultiByteString ifTrue: [ self sendCommand: { String with: CanvasEncoder codeMultiText. (str copyFrom: firstIndex to: lastIndex) asByteArray asString. self class encodeRectangle: boundsRect. self class encodeInteger: fontIndex. self class encodeColor: c } ] ifFalse: [ self sendCommand: { String with: CanvasEncoder codeText. s asString copyFrom: firstIndex to: lastIndex. self class encodeRectangle: boundsRect. self class encodeInteger: fontIndex. self class encodeColor: c } ]. ! ! !CharacterScanner methodsFor: 'scanning' stamp: 'ar 4/10/2005 18:04'! scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta | startEncoding selector | (sourceString isByteString) ifTrue: [^ self basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta.]. (sourceString isMultiByteString) ifTrue: [ startIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun]. startEncoding _ (sourceString at: startIndex) leadingChar. selector _ (EncodedCharSet charsetAt: startEncoding) scanSelector. ^ self perform: selector withArguments: (Array with: startIndex with: stopIndex with: sourceString with: rightX with: stopConditions with: kernDelta). ]. ^ stops at: EndOfRun ! ! !Color class methodsFor: 'instance creation' stamp: 'ar 4/10/2005 18:45'! colorFrom: parm "Return an instantiated color from parm. If parm is already a color, return it, else return the result of my performing it if it's a symbol or, if it is a list, it can either be an array of three numbers, which will be interpreted as RGB values, or a list of symbols, the first of which is sent to me and then the others of which are in turn sent to the prior result, thus allowing entries of the form #(blue darker). Else just return the thing" | aColor firstParm | (parm isKindOf: Color) ifTrue: [^ parm]. (parm isSymbol) ifTrue: [^ self perform: parm]. (parm isString) ifTrue: [^ self fromString: parm]. ((parm isKindOf: SequenceableCollection) and: [parm size > 0]) ifTrue: [firstParm := parm first. (firstParm isKindOf: Number) ifTrue: [^ self fromRgbTriplet: parm]. aColor := self colorFrom: firstParm. parm doWithIndex: [:sym :ind | ind > 1 ifTrue: [aColor := aColor perform: sym]]. ^ aColor]. ^ parm " Color colorFrom: #(blue darker) Color colorFrom: Color blue darker Color colorFrom: #blue Color colorFrom: #(0.0 0.0 1.0) "! ! !DiskProxy methodsFor: 'as yet unclassified' stamp: 'ar 4/10/2005 18:46'! printOn: aStream "Try to report the name of the project" globalObjectName == #Project ifFalse: [^ super printOn: aStream]. constructorArgs size > 0 ifFalse: [^ super printOn: aStream]. constructorArgs first isString ifFalse: [^ super printOn: aStream]. aStream nextPutAll: constructorArgs first, ' (on server)'! ! !FilePackage methodsFor: 'private' stamp: 'ar 4/10/2005 18:46'! msgClassComment: string with: chgRec | tokens theClass | tokens := Scanner new scanTokens: string. (tokens size = 3 and:[(tokens at: 3) isString]) ifTrue:[ theClass := self getClass: tokens first. ^theClass commentString: tokens last]. (tokens size = 4 and:[(tokens at: 3) asString = 'class' and:[(tokens at: 4) isString]]) ifTrue:[ theClass := self getClass: tokens first. theClass metaClass commentString: tokens last]. ! ! !FilePackage methodsFor: 'private' stamp: 'ar 4/10/2005 18:46'! possibleSystemSource: chgRec | tokens | sourceSystem isEmpty ifTrue:[ tokens := Scanner new scanTokens: chgRec string. (tokens size = 1 and:[tokens first isString]) ifTrue:[ sourceSystem := tokens first. ^self]]. doIts add: chgRec.! ! !GrafPort methodsFor: 'accessing' stamp: 'ar 4/10/2005 18:56'! displayScannerFor: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode ((para isMemberOf: MultiNewParagraph) or: [para text string isByteString]) ifTrue: [ ^ (MultiDisplayScanner new text: para text textStyle: para textStyle foreground: foreColor background: backColor fillBlt: self ignoreColorChanges: shadowMode) setPort: self clone ]. ^ (DisplayScanner new text: para text textStyle: para textStyle foreground: foreColor background: backColor fillBlt: self ignoreColorChanges: shadowMode) setPort: self clone ! ! !GrafPort methodsFor: 'accessing' stamp: 'ar 4/10/2005 18:56'! displayScannerForMulti: para foreground: foreColor background: backColor ignoreColorChanges: shadowMode ((para isMemberOf: MultiNewParagraph) or: [para text string isByteString]) ifTrue: [ ^ (MultiDisplayScanner new text: para presentationText textStyle: para textStyle foreground: foreColor background: backColor fillBlt: self ignoreColorChanges: shadowMode) setPort: self clone ]. ^ (DisplayScanner new text: para text textStyle: para textStyle foreground: foreColor background: backColor fillBlt: self ignoreColorChanges: shadowMode) setPort: self clone ! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ar 4/10/2005 18:47'! httpFileIn: url "Do a regular file-in of a file that is served from a web site. If the file contains an EToy, then open it. Might just be code instead. tk 7/23/97 17:10" "Notes: To store a file on an HTTP server, use the program 'Fetch'. After indicating what file to store, choose 'Raw Data' from the popup menu that has MacBinary/Text/etc. Use any file extension as long as it is not one of the common ones. The server does not have to know about the .sqo extension in order to send your file. (We do not need a new MIME type and .sqo does not have to be registered with the server.)" " HTTPSocket httpFileIn: 'www.webPage.com/~kaehler2/sample.etoy' " " HTTPSocket httpFileIn: '206.18.68.12/squeak/car.sqo' " " HTTPSocket httpFileIn: 'jumbo/tedk/sample.etoy' " | doc eToyHolder | doc _ self httpGet: url accept: 'application/octet-stream'. doc isString ifTrue: [self inform: 'Cannot seem to contact the web site']. doc reset. eToyHolder _ doc fileInObjectAndCode. eToyHolder ifNotNil: [eToyHolder open]. "Later may want to return it, instead of open it" ! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ar 4/10/2005 18:47'! httpFileInNewChangeSet: url "Do a regular file-in of a file that is served from a web site. Put it into a new changeSet." "Notes: To store a file on an HTTP server, use the program 'Fetch'. After indicating what file to store, choose 'Raw Data' from the popup menu that has MacBinary/Text/etc. Use any file extension as long as it is not one of the common ones." " HTTPSocket httpFileInNewChangeSet: '206.18.68.12/squeak/updates/83tk_test.cs' " | doc | doc _ self httpGet: url accept: 'application/octet-stream'. doc isString ifTrue: [self inform: 'Cannot seem to contact the web site']. doc reset. ChangeSorter newChangesFromStream: doc named: (url findTokens: '/') last.! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ar 4/10/2005 18:48'! httpGif: url "Fetch the given URL, parse it using the GIF reader, and return the resulting Form." " HTTPSocket httpShowGif: 'www.altavista.digital.com/av/pix/default/av-adv.gif' " " HTTPSocket httpShowGif: 'www.webPage.com/~kaehler2/ainslie.gif' " | doc ggg | doc _ self httpGet: url accept: 'image/gif'. doc isString ifTrue: [ self inform: 'The server with that GIF is not responding'. ^ ColorForm extent: 20@20 depth: 8]. doc binary; reset. (ggg _ GIFReadWriter new) setStream: doc. ^ ggg nextImage. ! ! !HTTPSocket class methodsFor: 'get the page' stamp: 'ar 4/10/2005 18:48'! httpShowChunk: url "From a Swiki server, get a text chunk in the changes file. Show its text in a window with style. Vertical bar separates class and selector. BE SURE TO USE ; instead of : in selectors!!" " HTTPSocket httpShowChunk: 'http://206.16.12.145:80/OurOwnArea.chunk.Socket|Comment' " " HTTPSocket httpShowChunk: 'http://206.16.12.145:80/OurOwnArea.chunk.Point|class|x;y;' " | doc text | doc _ (self httpGet: url accept: 'application/octet-stream'). " doc size = 0 ifTrue: [doc _ 'The server does not seem to be responding']." doc isString ifTrue: [text _ doc] ifFalse: [text _ doc nextChunkText]. (StringHolder new contents: text) openLabel: url. ! ! !HTTPSocket class methodsFor: 'proxy settings' stamp: 'ar 4/10/2005 18:48'! useProxyServerNamed: proxyServerName port: portNum "Direct all HTTP requests to the HTTP proxy server with the given name and port number." proxyServerName ifNil: [ "clear proxy settings" HTTPProxyServer _ nil. HTTPProxyPort _ 80. ^ self]. proxyServerName isString ifFalse: [self error: 'Server name must be a String or nil']. HTTPProxyServer _ proxyServerName. HTTPProxyPort _ portNum. HTTPProxyPort isString ifTrue: [HTTPProxyPort _ portNum asNumber]. HTTPProxyPort ifNil: [HTTPProxyPort _ self defaultPort].! ! !HTTPSocket class methodsFor: 'utilities' stamp: 'ar 4/10/2005 18:47'! argString: args "Return the args in a long string, as encoded in a url" | argsString first | args isString ifTrue: ["sent in as a string, not a dictionary" ^ (args first = $? ifTrue: [''] ifFalse: ['?']), args]. argsString _ WriteStream on: String new. argsString nextPut: $?. first _ true. args associationsDo: [ :assoc | assoc value do: [ :value | first ifTrue: [ first _ false ] ifFalse: [ argsString nextPut: $& ]. argsString nextPutAll: assoc key encodeForHTTP. argsString nextPut: $=. argsString nextPutAll: value encodeForHTTP. ] ]. ^ argsString contents ! ! !HTTPSocket class methodsFor: 'utilities' stamp: 'ar 4/10/2005 18:47'! argStringUnencoded: args "Return the args in a long string, as encoded in a url" | argsString first | args isString ifTrue: ["sent in as a string, not a dictionary" ^ (args first = $? ifTrue: [''] ifFalse: ['?']), args]. argsString _ WriteStream on: String new. argsString nextPut: $?. first _ true. args associationsDo: [ :assoc | assoc value do: [ :value | first ifTrue: [ first _ false ] ifFalse: [ argsString nextPut: $& ]. argsString nextPutAll: assoc key. argsString nextPut: $=. argsString nextPutAll: value. ] ]. ^ argsString contents ! ! !HTTPSocket class methodsFor: '*monticello-override' stamp: 'ar 4/10/2005 18:47'! httpGetDocument: url args: args accept: mimeType request: requestString "Return the exact contents of a web object. Asks for the given MIME type. If mimeType is nil, use 'text/html'. An extra requestString may be submitted and must end with crlf. The parsed header is saved. Use a proxy server if one has been registered. tk 7/23/97 17:12" "Note: To fetch raw data, you can use the MIME type 'application/octet-stream'." | serverName serverAddr port sock header length bare page list firstData aStream index connectToHost connectToPort type newUrl | Socket initializeNetwork. bare := (url asLowercase beginsWith: 'http://') ifTrue: [url copyFrom: 8 to: url size] ifFalse: [url]. bare := bare copyUpTo: $#. "remove fragment, if specified" serverName := bare copyUpTo: $/. page := bare copyFrom: serverName size + 1 to: bare size. (serverName includes: $:) ifTrue: [index := serverName indexOf: $:. port := (serverName copyFrom: index + 1 to: serverName size) asNumber. serverName := serverName copyFrom: 1 to: index - 1] ifFalse: [port := self defaultPort]. page size = 0 ifTrue: [page := '/']. "add arguments" args ifNotNil: [page := page , (self argString: args)]. (self shouldUseProxy: serverName) ifTrue: [page := 'http://' , serverName , ':' , port printString , page. "put back together" connectToHost := HTTPProxyServer. connectToPort := HTTPProxyPort] ifFalse: [connectToHost := serverName. connectToPort := port]. serverAddr := NetNameResolver addressForName: connectToHost timeout: 20. serverAddr ifNil: [^'Could not resolve the server named: ' , connectToHost]. 3 timesRepeat: [sock := HTTPSocket new. sock connectTo: serverAddr port: connectToPort. (sock waitForConnectionUntil: (self deadlineSecs: 30)) ifFalse: [Socket deadServer: connectToHost. sock destroy. ^'Server ' , connectToHost , ' is not responding']. "Transcript cr;show: url; cr. Transcript show: page; cr." sock sendCommand: 'GET ' , page , ' HTTP/1.0' , CrLf , (mimeType ifNil: [''] ifNotNil: ['ACCEPT: ' , mimeType , CrLf]) , 'ACCEPT: text/html' , CrLf , HTTPBlabEmail , requestString , self userAgentString , CrLf , 'Host: ' , serverName , ':' , port printString , CrLf. "Always accept plain text" "may be empty" "extra user request. Authorization" "blank line automatically added" list := sock getResponseUpTo: CrLf , CrLf ignoring: (String with: CR). "list = header, CrLf, CrLf, beginningOfData" header := list at: 1. "Transcript show: page; cr; show: header; cr." firstData := list at: 3. header isEmpty ifTrue: [aStream := 'server aborted early'] ifFalse: ["dig out some headers" sock header: header. length := sock getHeader: 'content-length'. length ifNotNil: [length := length asNumber]. type := sock getHeader: 'content-type'. sock responseCode first = $3 ifTrue: [newUrl := sock getHeader: 'location'. newUrl ifNotNil: [Transcript show: 'redirecting to ' , newUrl; cr. sock destroy. newUrl := Url combine: url withRelative: newUrl. ^self httpGetDocument: newUrl args: args accept: mimeType request: requestString]]. aStream := sock getRestOfBuffer: firstData totalLength: length. "a 400-series error" sock responseCode first = $4 ifTrue: [^header , aStream contents]]. sock destroy. "Always OK to destroy!!" aStream isString ifFalse: [^MIMEDocument contentType: type content: aStream contents url: url]. aStream = 'server aborted early' ifTrue: [^aStream]]. { 'HTTPSocket class>>httpGetDocument:args:accept:request:'. aStream. url} inspect. ^'some other bad thing happened!!'! ! !LanguageEditor methodsFor: 'stef' stamp: 'ar 4/10/2005 18:48'! identifyUnusedStrings "self new identifyUnusedStrings" translationsList getList do: [:each | Transcript show: each. Transcript show: (Smalltalk allSelect: [:method | method hasLiteralSuchThat: [:lit | lit isString and: [lit includesSubstring: each caseSensitive: true]]]) size printString; cr]! ! !LanguageEditor methodsFor: 'stef' stamp: 'ar 4/10/2005 18:48'! numberOfTimesStringIsUsed: aString ^ (self systemNavigation allSelect: [:method | method hasLiteralSuchThat: [:lit | lit isString and: [lit includesSubstring: aString caseSensitive: true]]]) size! ! !MethodFinder methodsFor: 'initialize' stamp: 'ar 4/10/2005 18:48'! test2: anArray "look for bad association" anArray do: [:sub | sub class == Association ifTrue: [ (#('true' '$a' '2' 'false') includes: sub value printString) ifFalse: [ self error: 'bad assn']. (#('3' '5.6' 'x' '''abcd''') includes: sub key printString) ifFalse: [ self error: 'bad assn']. ]. sub class == Array ifTrue: [ sub do: [:element | element isString ifTrue: [element first asciiValue < 32 ifTrue: [ self error: 'store into string in data']]. element class == Association ifTrue: [ element value class == Association ifTrue: [ self error: 'bad assn']]]]. sub class == Date ifTrue: [sub year isInteger ifFalse: [ self error: 'stored into input date!!!!']]. sub class == Dictionary ifTrue: [ sub size > 0 ifTrue: [ self error: 'store into dictionary']]. sub class == OrderedCollection ifTrue: [ sub size > 4 ifTrue: [ self error: 'store into OC']]. ].! ! !MethodFinder methodsFor: 'search' stamp: 'ar 4/10/2005 18:48'! exceptions "Handle some very slippery selectors. asSymbol -- want to be able to produce it, but do not want to make every string submitted into a Symbol!!" | aSel | answers first class == Symbol ifFalse: [^ self]. thisData first first isString ifFalse: [^ self]. aSel _ #asSymbol. (self testPerfect: aSel) ifTrue: [ selector add: aSel. expressions add: (String streamContents: [:strm | strm nextPutAll: 'data', argMap first printString. aSel keywords doWithIndex: [:key :ind | strm nextPutAll: ' ',key. (key last == $:) | (key first isLetter not) ifTrue: [strm nextPutAll: ' data', (argMap at: ind+1) printString]]])]. ! ! !MethodFinder methodsFor: 'search' stamp: 'ar 4/10/2005 18:48'! findMessage "Control the search." data do: [:alist | (alist isKindOf: SequenceableCollection) ifFalse: [ ^ OrderedCollection with: 'first and third items are not Arrays']]. Approved ifNil: [self initialize]. "Sets of allowed selectors" expressions _ OrderedCollection new. self search: true. "multi" expressions isEmpty ifTrue: [^ OrderedCollection with: 'no single method does that function']. expressions isString ifTrue: [^ OrderedCollection with: expressions]. ^ expressions! ! !MultiCharacterScanner methodsFor: 'scanning' stamp: 'ar 4/10/2005 18:05'! scanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta | startEncoding selector | (sourceString isByteString) ifTrue: [^ self basicScanCharactersFrom: startIndex to: stopIndex in: sourceString rightX: rightX stopConditions: stops kern: kernDelta.]. (sourceString isMultiByteString) ifTrue: [ startIndex > stopIndex ifTrue: [lastIndex _ stopIndex. ^ stops at: EndOfRun]. startEncoding _ (sourceString at: startIndex) leadingChar. selector _ (EncodedCharSet charsetAt: startEncoding) scanSelector. ^ self perform: selector withArguments: (Array with: startIndex with: stopIndex with: sourceString with: rightX with: stopConditions with: kernDelta). ]. ^ stops at: EndOfRun ! ! !NewParagraph methodsFor: 'selection' stamp: 'ar 4/10/2005 18:05'! characterBlockAtPoint: aPoint "Answer a CharacterBlock for the character in the text at aPoint." | line | line _ lines at: (self lineIndexForPoint: aPoint). ^ ((text string isMultiByteString) ifTrue: [ MultiCharacterBlockScanner new text: text textStyle: textStyle ] ifFalse: [CharacterBlockScanner new text: text textStyle: textStyle]) characterBlockAtPoint: aPoint index: nil in: line! ! !NewParagraph methodsFor: 'selection' stamp: 'ar 4/10/2005 18:05'! characterBlockForIndex: index "Answer a CharacterBlock for the character in text at index." | line | line _ lines at: (self lineIndexForCharacter: index). ^ ((text string isMultiByteString) ifTrue: [ MultiCharacterBlockScanner new text: text textStyle: textStyle ] ifFalse: [ CharacterBlockScanner new text: text textStyle: textStyle ]) characterBlockAtPoint: nil index: ((index max: line first) min: text size+1) in: line! ! !Player methodsFor: 'scripts-standard' stamp: 'ar 4/10/2005 18:50'! append: aPlayer "Add aPlayer to the list of objects logically 'within' me. This is visually represented by its morph becoming my costume's last submorph. Also allow text to be appended." | aCostume | (aPlayer isNil or: [aPlayer == self]) ifTrue: [^self]. (aPlayer isText or: [aPlayer isString]) ifTrue: [self costume class == TextFieldMorph ifTrue: [^self costume append: aPlayer] ifFalse: [^self]]. (aCostume := self costume topRendererOrSelf) addMorphNearBack: aPlayer costume. aPlayer costume goHome. "assure it's in view" (aCostume isKindOf: PasteUpMorph) ifTrue: [self setCursor: (aCostume submorphs indexOf: aPlayer costume)]! ! !Player methodsFor: 'scripts-standard' stamp: 'ar 4/10/2005 18:50'! includeAtCursor: aPlayer "Add aPlayer to the list of objects logically 'within' me, at my current cursor position. ." | aCostume | (aPlayer isNil or: [aPlayer == self]) ifTrue: [^self]. (aPlayer isText or: [aPlayer isString]) ifTrue: [^ self costume class == TextFieldMorph ifTrue: [self costume append: aPlayer] ifFalse: [self]]. aCostume := self costume topRendererOrSelf. aPlayer costume goHome. "assure it's in view" (aCostume isKindOf: PasteUpMorph) ifTrue: [aCostume addMorph: aPlayer costume asElementNumber: self getCursor. aCostume invalidRect: aCostume bounds] ifFalse: [aCostume addMorphBack: aPlayer. self setCursor: aCostume submorphs size]! ! !Player methodsFor: 'scripts-standard' stamp: 'ar 4/10/2005 18:51'! prepend: aPlayer "Add aPlayer to the list of objects logically 'within' me. This is visually represented by its morph becoming my costume's first submorph. Also allow text to be prepended." | aCostume | (aPlayer isNil or: [aPlayer == self]) ifTrue: [^self]. (aPlayer isText or: [aPlayer isString]) ifTrue: [^ self costume class == TextFieldMorph ifTrue: [self costume prepend: aPlayer] ifFalse: [self]]. (aCostume := self costume topRendererOrSelf) addMorphFront: aPlayer costume. aPlayer costume goHome. "assure it's in view" (aCostume isKindOf: PasteUpMorph) ifTrue: [self setCursor: (aCostume submorphs indexOf: aPlayer costume)]! ! !Project class methodsFor: 'squeaklet on server' stamp: 'ar 4/10/2005 18:51'! mostRecent: projName onServer: aServerDirectory | stem list max goodName triple num stem1 stem2 rawList nothingFound unEscName | "Find the exact fileName of the most recent version of project with the stem name of projName. Names are of the form 'projName|mm.pr' where mm is a mime-encoded integer version number. File names may or may not be HTTP escaped, %20 on the server." self flag: #bob. "do we want to handle unversioned projects as well?" nothingFound _ {nil. -1}. aServerDirectory ifNil: [^nothingFound]. "23 sept 2000 - some old projects have periods in name so be more careful" unEscName _ projName unescapePercents. triple _ Project parseProjectFileName: unEscName. stem _ triple first. rawList _ aServerDirectory fileNames. rawList isString ifTrue: [self inform: 'server is unavailable'. ^nothingFound]. list _ rawList collect: [:nnn | nnn unescapePercents]. max _ -1. goodName _ nil. list withIndexDo: [:aName :ind | (aName beginsWith: stem) ifTrue: [ num _ (Project parseProjectFileName: aName) second. num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]. max = -1 ifFalse: [^ Array with: goodName with: max]. "try with underbar for spaces on server" (stem includes: $ ) ifTrue: [ stem1 _ stem copyReplaceAll: ' ' with: '_'. list withIndexDo: [:aName :ind | (aName beginsWith: stem1) ifTrue: [ num _ (Project parseProjectFileName: aName) second. num > max ifTrue: [max _ num. goodName _ (rawList at: ind)]]]]. max = -1 ifFalse: [^ Array with: goodName with: max]. "try without the marker | " stem1 _ stem allButLast, '.pr'. stem2 _ stem1 copyReplaceAll: ' ' with: '_'. "and with spaces replaced" list withIndexDo: [:aName :ind | (aName beginsWith: stem1) | (aName beginsWith: stem2) ifTrue: [ (triple _ aName findTokens: '.') size >= 2 ifTrue: [ max _ 0. goodName _ (rawList at: ind)]]]. "no other versions" max = -1 ifFalse: [^ Array with: goodName with: max]. ^nothingFound "no matches" ! ! !Project class methodsFor: 'squeaklet on server' stamp: 'ar 4/10/2005 18:51'! sweep: aServerDirectory | repository list parts ind entry projectName versions | "On the server, move all but the three most recent versions of each Squeaklet to a folder called 'older'" "Project sweep: ((ServerDirectory serverNamed: 'DaniOnJumbo') clone directory: '/vol0/people/dani/Squeaklets/2.7')" "Ensure the 'older' directory" (aServerDirectory includesKey: 'older') ifFalse: [aServerDirectory createDirectory: 'older']. repository _ aServerDirectory clone directory: aServerDirectory directory, '/older'. "Collect each name, and decide on versions" list _ aServerDirectory fileNames. list isString ifTrue: [^ self inform: 'server is unavailable']. list _ list asSortedCollection asOrderedCollection. parts _ list collect: [:en | Project parseProjectFileName: en]. parts _ parts select: [:en | en third = 'pr']. ind _ 1. [entry _ list at: ind. projectName _ entry first asLowercase. versions _ OrderedCollection new. versions add: entry. [(ind _ ind + 1) > list size ifFalse: [(parts at: ind) first asLowercase = projectName ifTrue: [versions add: (parts at: ind). true] ifFalse: [false]] ifTrue: [false]] whileTrue. aServerDirectory moveYoungest: 3 in: versions to: repository. ind > list size] whileFalse. ! ! !RuleDate class methodsFor: 'private' stamp: 'ar 4/10/2005 18:51'! getValidMonthNumber: monthIn "Private - Answer the month number of monthIn if it is a month name String, else monthIn as the month number if it is an Integer, else signal an error. Definition: Parameters monthIn | captured Return Values new Errors Month is not an Integer 1 - 12. or a valid month name String " monthIn isInteger ifTrue: [(monthIn between: 1 and: 12) ifTrue: [^ monthIn]. ^ Error signal: 'Month must be 1 - 12.']. (monthIn isString) ifTrue: [^ self indexOfMonth: monthIn]. ^ Error signal: 'Month must be an Integer 1 - 12 or a month name String.'! ! !RuleDate class methodsFor: 'private' stamp: 'ar 4/10/2005 18:51'! getValidSelectionRule: positionName "Private - Answer the selection position (first, last) in the list of day of the week, Report an error if positionName is not one of (first, last)." | positionSymbol | (positionName isString) ifFalse: [^ Error signal: 'Position name: "' , positionName , '" is not a String.']. positionSymbol := positionName asLowercase asSymbol. (#(first last ) includes: positionSymbol) ifFalse: [^ Error signal: 'Position name: "' , positionName , '" is not valid.']. ^ positionSymbol! ! !RuleDate class methodsFor: 'private' stamp: 'ar 4/10/2005 18:51'! newDayOfWeek: dayName selectionRule: positionName "Private - Answer an uncreated rule date with the dayOfWeek (Sunday, etc) set to dayName, and selectionRule (first, last) set to positionName. Note: Must be updated to create the date. Parameters dayName captured positionName captured Return Values new " | daySymbol newRuleDate positionSymbol | (dayName isString) ifFalse: [^ Error signal: 'Day name: "' , dayName , '" is not a String.']. daySymbol := dayName asLowercase. daySymbol at: 1 put: (daySymbol at: 1) asUppercase. daySymbol := daySymbol asSymbol. (Week dayNames includes: daySymbol) ifFalse: [^ Error signal: 'Day name: "' , dayName , '" is not valid.']. positionSymbol := self getValidSelectionRule: positionName. newRuleDate := super new. newRuleDate setDayOfWeek: daySymbol selectionRule: positionSymbol. ^ newRuleDate! ! !SequenceableCollection methodsFor: 'converting' stamp: 'ar 4/10/2005 18:02'! asStringWithCr "Convert to a string with returns between items. Elements are usually strings. Useful for labels for PopUpMenus." | labelStream | labelStream _ WriteStream on: (String new: 200). self do: [:each | each isString ifTrue: [labelStream nextPutAll: each; cr] ifFalse: [each printOn: labelStream. labelStream cr]]. self size > 0 ifTrue: [labelStream skip: -1]. ^ labelStream contents! ! !Array methodsFor: 'converting' stamp: 'ar 4/10/2005 18:03'! evalStrings "Allows you to construct literal arrays. #(true false nil '5@6' 'Set new' '''text string''') evalStrings gives an array with true, false, nil, a Point, a Set, and a String instead of just a bunch of Symbols" | it | ^ self collect: [:each | it _ each. each == #true ifTrue: [it _ true]. each == #false ifTrue: [it _ false]. each == #nil ifTrue: [it _ nil]. (each isString and:[each isSymbol not]) ifTrue: [ it _ Compiler evaluate: each]. each class == Array ifTrue: [it _ it evalStrings]. it]! ! !MultiString methodsFor: 'testing' stamp: 'ar 4/10/2005 18:04'! isMultiByteString "Answer whether the receiver is a MultiByteString" ^true! ! !ServerDirectory methodsFor: 'accessing' stamp: 'ar 4/10/2005 18:52'! password: pp passwordHolder _ Password new. pp isString ifTrue: [passwordHolder cache: pp. ^ self]. pp isInteger ifTrue: [passwordHolder sequence: pp] ifFalse: [passwordHolder _ pp].! ! !ServerDirectory methodsFor: 'up/download' stamp: 'ar 4/10/2005 18:52'! getFileNamed: fileNameOnServer into: dataStream httpRequest: requestString "Just FTP a file from a server. Return a stream. (Later -- Use a proxy server if one has been registered.)" | resp | 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) args: nil accept: 'application/octet-stream' request: requestString. resp isString ifTrue: [^ dataStream]. "error, no data" dataStream copyFrom: resp. dataStream dataIsValid. ^ dataStream]. client _ self openFTPClient. "Open passive. Do everything up to RETR or STOR" [client getFileNamed: fileNameOnServer into: dataStream] ensure: [self quit]. dataStream dataIsValid. ! ! !SmalltalkImage methodsFor: 'sources, change log' stamp: 'ar 4/10/2005 18:02'! logChange: aStringOrText "Write the argument, aString, onto the changes file." | aString changesFile | (SourceFiles isNil or: [(SourceFiles at: 2) == nil]) ifTrue: [^ self]. self assureStartupStampLogged. aString := aStringOrText asString. (aString findFirst: [:char | char isSeparator not]) = 0 ifTrue: [^ self]. "null doits confuse replay" (changesFile _ SourceFiles at: 2). changesFile isReadOnly ifTrue:[^self]. changesFile setToEnd; cr; cr. changesFile nextChunkPut: aString. "If want style changes in DoIt, use nextChunkPutWithStyle:, and allow Texts to get here" self forceChangesToDisk.! ! !SmartRefStream methodsFor: 'read write' stamp: 'ar 4/10/2005 18:52'! mapClass: incoming "See if the old class named nm exists. If so, return it. If not, map it to a new class, and save the mapping in renamed. " | cls oldVer sel nm | self flag: #bobconv. nm _ renamed at: incoming ifAbsent: [incoming]. "allow pre-mapping around collisions" (nm endsWith: ' class') ifFalse: [cls _ Smalltalk at: nm ifAbsent: [nil]. cls ifNotNil: [^ cls]] "Known class. It will know how to translate the instance." ifTrue: [cls _ Smalltalk at: nm substrings first asSymbol ifAbsent: [nil]. cls ifNotNil: [^ cls class]]. "Known class. It will know how to translate the instance." oldVer _ self versionSymbol: (structures at: nm). sel _ nm asString. sel at: 1 put: (sel at: 1) asLowercase. sel _ sel, oldVer. "i.e. #rectangleoc4" Symbol hasInterned: sel ifTrue: [:symb | (self class canUnderstand: sel asSymbol) ifTrue: [ reshaped ifNil: [reshaped _ Dictionary new]. cls _ self perform: sel asSymbol]]. "This class will take responsibility" cls ifNil: [cls _ self writeClassRenameMethod: sel was: nm fromInstVars: (structures at: nm). cls isString ifTrue: [cls _ nil]]. cls ifNotNil: [renamed at: nm put: cls name]. ^ cls ! ! !SmartRefStream methodsFor: 'read write' stamp: 'ar 4/10/2005 18:52'! verifyStructure "Compare the incoming inst var name lists with the existing classes. Prepare tables that will help to restructure those who need it (renamed, reshaped, steady). If all superclasses are recorded in the file, only compare inst vars of this class, not of superclasses. They will get their turn. " | newClass newList oldList converting | self flag: #bobconv. converting _ OrderedCollection new. structures keysDo: [:nm "an old className (symbol)" | "For missing classes, there needs to be a method in SmartRefStream like #rectangleoc2 that returns the new class." newClass _ self mapClass: nm. "does (renamed at: nm put: newClass name)" newClass isString ifTrue: [^ newClass]. "error, fileIn needed" newList _ (Array with: newClass classVersion), (newClass allInstVarNames). oldList _ structures at: nm. newList = oldList ifTrue: [steady add: newClass] "read it in as written" ifFalse: [converting add: newClass name] ]. false & converting isEmpty not ifTrue: ["debug" self inform: 'These classes are being converted from existing methods:\' withCRs, converting asArray printString]. ! ! !SmartRefStream methodsFor: 'class changed shape' stamp: 'ar 4/10/2005 18:52'! writeClassRenameMethod: sel was: oldName fromInstVars: oldList "The class coming is unknown. Ask the user for the existing class it maps to. If got one, write a method, and restart the obj fileIn. If none, write a dummy method and get the user to complete it later. " | tell choice newName answ code | self flag: #bobconv. tell _ 'Reading an instance of ', oldName, '. Which modern class should it translate to?'. answ _ (PopUpMenu labels: 'Let me type the name now Let me think about it Let me find a conversion file on the disk') startUpWithCaption: tell. answ = 1 ifTrue: [ tell := 'Name of the modern class {1} should translate to:' translated format: {oldName}. choice _ FillInTheBlank request: tell. "class name" (choice size = 0) ifTrue: [answ _ 'conversion method needed'] ifFalse: [newName _ choice. answ _ Smalltalk at: newName asSymbol ifAbsent: ['conversion method needed']. answ isString ifFalse: [renamed at: oldName asSymbol put: answ name]]]. (answ = 3) | (answ = 0) ifTrue: [self close. ^ 'conversion method needed']. answ = 2 ifTrue: [answ _ 'conversion method needed']. answ = 'conversion method needed' ifTrue: [ self close. newName _ 'PutNewClassHere']. code _ WriteStream on: (String new: 500). code nextPutAll: sel; cr. code cr; tab; nextPutAll: '^ ', newName. "Return new class" self class compile: code contents classified: 'conversion'. newName = 'PutNewClassHere' ifTrue: [ self inform: 'Please complete the following method and then read-in the object file again.'. SystemNavigation default browseAllImplementorsOf: sel asSymbol]. "The class version number only needs to change under one specific circumstance. That is when the first letters of the instance variables have stayed the same, but their meaning has changed. A conversion method is needed, but this system does not know it. If this is true for class Foo, define classVersion in Foo class. Beware of previous object fileouts already written after the change in meaning, but before bumping the version number. They have the old (wrong) version number, say 2. If this is true, your method must be able to test the data and successfully read files that say version 2 but are really 3." ^ answ! ! !SqueakPage methodsFor: 'accessing' stamp: 'ar 4/10/2005 18:52'! fetchContentsIfAbsent: failBlock "Make every effort to get contentsMorph. Assume I am in the cache already." | strm page temp temp2 | SqueakPageCache write. "sorry about the pause" Cursor wait showWhile: [ strm _ (ServerFile new fullPath: url) asStream]. strm isString ifTrue: [^ failBlock value]. page _ strm fileInObjectAndCode. page isMorph ifTrue: [contentsMorph _ page]. "may be a bare morph" "copy over the state" temp _ url. temp2 _ policy. self copyAddedStateFrom: page. url _ temp. "don't care what it says" temp2 ifNotNil: [policy _ temp2]. "use mine" contentsMorph setProperty: #pageDirty toValue: nil. self dirty: false. ^ contentsMorph! ! !SqueakPage methodsFor: 'accessing' stamp: 'ar 4/10/2005 18:52'! fetchInformIfError "Make every effort to get contentsMorph. Put up a good notice if can't get it. Assume page is in the cache already. Overwrite the contentsMorph no matter what." | strm page temp temp2 | SqueakPageCache write. "sorry about the pause" Cursor wait showWhile: [ strm _ (ServerFile new fullPath: url) asStream]. strm isString ifTrue: [self inform: 'Sorry, ',strm. ^ nil]. "<<<<< Note Diff" (url beginsWith: 'file:') ifTrue: [Transcript show: 'Fetching ', url; cr]. page _ strm fileInObjectAndCode. page isMorph ifTrue: [contentsMorph _ page] "may be a bare morph" ifFalse: ["copy over the state" temp _ url. temp2 _ policy. self copyFrom: page. "including contentsMorph" url _ temp. "I know best!!" temp2 ifNotNil: [policy _ temp2]]. "use mine" contentsMorph setProperty: #pageDirty toValue: nil. contentsMorph setProperty: #SqueakPage toValue: self. self dirty: false. ^ contentsMorph! ! !StrikeFont methodsFor: 'displaying' stamp: 'ar 4/10/2005 18:06'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta "Draw the given string from startIndex to stopIndex at aPoint on the (already prepared) BitBlt." (aString isByteString) ifFalse: [^ self displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: aPoint y + self ascent.]. ^ aBitBlt displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: self kern: kernDelta.! ! !StrikeFont methodsFor: 'displaying' stamp: 'ar 4/10/2005 18:06'! displayString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY "Draw the given string from startIndex to stopIndex at aPoint on the (already prepared) BitBlt." (aString isByteString) ifFalse:[^ self displayMultiString: aString on: aBitBlt from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY.]. ^ aBitBlt displayString: aString from: startIndex to: stopIndex at: aPoint strikeFont: self kern: kernDelta.! ! !StrikeFontSet methodsFor: 'as yet unclassified' stamp: 'ar 4/10/2005 18:53'! widthOfString: aString aString ifNil:[^0]. "Optimizing" (aString isByteString) ifTrue: [ ^ self fontArray first widthOfString: aString from: 1 to: aString size]. ^ self widthOfString: aString from: 1 to: aString size. " TextStyle default defaultFont widthOfString: 'zort' 21 " ! ! !SyntaxMorph methodsFor: 'type checking' stamp: 'ar 4/10/2005 18:53'! resultType "Look up my result type. If I am a constant, use that class. If I am a message, look up the selector." | list value | parseNode class == BlockNode ifTrue: [^#blockContext]. parseNode class == AssignmentNode ifTrue: [^#command]. parseNode class == ReturnNode ifTrue: [^#command]. "Need more restriction than this" list := submorphs select: [:ss | ss isSyntaxMorph and: [ss parseNode notNil]]. list size > 1 ifTrue: [^self resultTypeFor: self selector]. list size = 1 ifTrue: ["test for levels that are just for spacing in layout" (list first isSyntaxMorph and: [list first nodeClassIs: MessageNode]) ifTrue: [^list first resultType]]. "go down one level" value := self try. value class == Error ifTrue: [^#unknown]. (value isNumber) ifTrue: [^#Number]. (value isKindOf: Boolean) ifTrue: [^#Boolean]. (value isForm) ifTrue: [^#Graphic]. value isString ifTrue: [(SoundService default sampledSoundChoices includes: value) ifTrue: [^#Sound]]. (value isPlayerLike) ifTrue: [^#Player]. ^value class name asLowercase "asSymbol (not needed)"! ! !SystemNavigation methodsFor: 'browse' stamp: 'ar 4/10/2005 18:53'! browseMethodsWithString: aString matchCase: caseSensitive "Launch a browser on all methods that contain string literals with aString as a substring. Make the search case-sensitive or insensitive as dictated by the caseSensitive boolean parameter" self browseAllSelect: [:method | method hasLiteralSuchThat: [:lit | lit isString and: [lit includesSubstring: aString caseSensitive: caseSensitive]]] name: 'Methods with string ', aString printString, (caseSensitive ifTrue: [' (case-sensitive)'] ifFalse: [' (case-insensitive)']) autoSelect: aString. ! ! !TextFieldMorph methodsFor: 'just like textMorph' stamp: 'ar 4/10/2005 18:54'! contents: textOrString "talk to my text" | tm newText atts | (tm _ self findA: TextMorph) ifNil: [^ nil]. textOrString isString ifTrue: [ tm contents ifNotNil: ["Keep previous properties of the field" newText _ textOrString asText. atts _ tm contents attributesAt: 1. atts do: [:each | newText addAttribute: each]. ^ tm contents: newText]]. ^ tm contents: textOrString! ! !URLMorph methodsFor: 'event handling' stamp: 'ar 4/10/2005 18:54'! mouseUp: evt | pg ow newPage mm bookUrl bk | "If url of a book, open it to that page, or bring it in and open to that page." book ifNotNil: [book == false ifFalse: [ (bookUrl _ book) isString ifFalse: [ bookUrl _ (SqueakPage stemUrl: url), '.bo']. (bk _ BookMorph isInWorld: self world withUrl: bookUrl) class ~~ Symbol ifTrue: [^ bk goToPageUrl: url]. bk == #conflict ifTrue: [ ^ self inform: 'This book is already open in some other project']. (bk _ BookMorph new fromURL: bookUrl) ifNil: [^ self]. bk goToPageUrl: url. "turn to the page" ^ HandMorph attach: bk]]. "If inside a SqueakPage, replace it!!" pg _ self enclosingPage. pg ifNotNil: [ (ow _ pg contentsMorph owner) ifNotNil: [ pg contentsMorph delete. "from its owner" newPage _ SqueakPageCache atURL: url. mm _ newPage fetchContents. mm ifNotNil: [ow addMorph: mm. page _ newPage]. ^ self]]. "If I am a project, jump -- not done yet" "For now, just put new page on the hand" newPage _ SqueakPageCache atURL: url. mm _ newPage fetchInformIfError. mm ifNotNil: [self primaryHand attachMorph: mm. page _ newPage]. ! ! !Utilities class methodsFor: 'fetching updates' stamp: 'ar 4/10/2005 18:54'! retrieveUrls: urls ontoQueue: queue withWaitSema: waitSema "download the given list of URLs. The queue will be loaded alternately with url's and with the retrieved contents. If a download fails, the contents will be #failed. If all goes well, a special pair with an empty URL and the contents #finished will be put on the queue. waitSema is waited on every time before a new document is downloaded; this keeps the downloader from getting too far ahead of the main process" "kill the existing downloader if there is one" | doc canPeek front | UpdateDownloader ifNotNil: [UpdateDownloader terminate]. "fork a new downloading process" UpdateDownloader _ [urls do: [:url | waitSema wait. queue nextPut: url. doc _ HTTPClient httpGet: url. doc isString ifTrue: [queue nextPut: #failed. UpdateDownloader _ nil. Processor activeProcess terminate] ifFalse: [canPeek _ 120 min: doc size. front _ doc next: canPeek. doc skip: -1 * canPeek. (front beginsWith: '