Squeak-dev December 2009

squeak-dev@lists.squeakfoundation.org

97 participants
553 discussions

NanoTraits are go
by Andreas Raab 31 Dec '09

31 Dec '09

Folks - NanoTraits are ready to ship now. I've decided on a loading mechanism which preserves the original Trait classes in the image and reshapes them instead of having a different set of classes. This achieves maximum compatibility with external packages. The loading is done by first loading NanoTraits, converting all traits, reshaping the existing classes, and converting everything back. If you have a fully updated image, you can try the process by executing: MCMcmUpdater updateFromRepositories: #( 'http://www.squeaksource.com/NanoTraits' ). I decided to preserve *all* of the original structure (incl. class TraitBehavior and incl. all of the Kernel traits) since I noticed that various packages have extensions on those classes and would fail to load otherwise. This should provide very good backward compatibility for external packages. Unless people voice concerns about this version I'll be pushing it into the trunk over the next couple of days. Finally, we can measure the differences between the implementations more accurately, for example: Measure 1: Complexity of Kernel-Classes and Traits -------------------------------------------------- #('Traits' 'Kernel-Classes' ) do:[:pkgName| | pkg | pkg := PackageInfo named: pkgName. Transcript cr; show: pkg name; tab; show: pkg classes size; tab; show: pkg methods size. ]. Before Classes Methods Traits 59 873 Kernel-Classes 10 468 Total 69 1341 After Classes Methods Traits 27(*) 188 Kernel-Classes 10 589 Total 37(*) 777 (*) includes 17 otherwise unused compatibility traits Measure 2: Complexity of Behavior --------------------------------- {Behavior. ClassDescription. Class. Metaclass} collect:[:each| each -> each selectors size]. Version Behavior ClassDescription Class Metaclass Total 3.10 244 141 88 48 521 After 190 161 82 44 477 Cheers, - Andreas

6 9

Project entry vs. project rendered
by Jim Rosenberg 30 Dec '09

30 Dec '09

I have some projects containing a PasteUpMorph that is bigger than the screen. (Navigation is via a custom class of my own, where dragging a portal border drags the underlying PasteUpMorph.) When a project containing one of these is first entered, it takes a long time to render. This is OK -- I can live with this -- but I want to show Cursor wait while it's happening. I thought I had this problem nailed -- in a method for the parent project, the button that triggers entry to the "slow" project has Cursor wait show before entering the project, and then Cursor normal show in a block executed with WorldState addDeferredUIMessage:. On my desktop system, which is a 1.6G Atom 330 running Linux, this seemed to be working fine. But when I tried it on my G4 PowerBook, it came out all wrong. The hourglass cursor appeared, as I wanted, but after only a second or so the Cursor normal show method kicked in, even though the "parent" project was still showing, and the long delay rendering the target project happened *afterward*. How do I do a deferred UI message that will only be invoked once the project is rendered? (I tried preceding the Cursor normal show with Project current world doOneCycle in the deferred UI message block. This gives every appearance of working perfectly under Linux, but made no difference on my PowerBook -- the hourglass has gone away while the computation is done to render the project. Is this a Mac VM issue?) -Thanks, Jim --- Jim Rosenberg http://www.well.com/user/jer/ Internet: jr(a)amanue.com

1 0

The Trunk: MonticelloConfigurations-ar.71.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of MonticelloConfigurations to project The Trunk: http://source.squeak.org/trunk/MonticelloConfigurations-ar.71.mcz ==================== Summary ==================== Name: MonticelloConfigurations-ar.71 Author: ar Time: 30 December 2009, 5:35:52 am UUID: 908da779-6dd4-c34b-8be4-757825367db3 Ancestors: MonticelloConfigurations-ar.70 With the additional progress info from MC, configs are a bit noisy when updating. Suppress a good chunk of progress depending (for now) on a preference. The result are smoother and less noisy progress notifications during updates. =============== Diff against MonticelloConfigurations-ar.70 =============== Item was changed: ----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') ----- versionNamed: verName for: aDependency from: repo | baseName fileName ver | (repo filterFileNames: repo cachedFileNames forVersionNamed: verName) ifNotEmptyDo: [:cachedNames | fileName := cachedNames anyOne. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Using cached ', fileName]. - ProgressNotification signal: '' extra: 'Using cached ', fileName. ver := repo versionFromFileNamed: fileName]. ver ifNil: [ baseName := self diffBaseFor: aDependency. (baseName notNil and: [baseName ~= verName and: [repo includesVersionNamed: baseName]]) ifTrue: [ fileName := (MCDiffyVersion nameForVer: verName base: baseName), '.mcd'. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName]. - ProgressNotification signal: '' extra: 'Downloading ', fileName. ver := repo versionFromFileNamed: fileName]]. ver ifNil: [ fileName := verName, '.mcz'. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName]. - ProgressNotification signal: '' extra: 'Downloading ', fileName. ver := repo versionFromFileNamed: fileName]. ^ver! Item was added: + ----- Method: MCConfiguration class>>extraProgressInfo: (in category 'preferences') ----- + extraProgressInfo: aBool + "Whether to display for additional progress info during load." + ExtraProgressInfo := aBool. + ! Item was changed: ----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') ----- depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString + | repoMap count action | - | repoMap count | repoMap := Dictionary new. self repositories do: [:repo | MCRepositoryGroup default addRepository: repo. repo allVersionNames ifEmpty: [self logWarning: 'cannot read from ', repo description] ifNotEmptyDo: [:all | all do: [:ver | repoMap at: ver put: repo]]]. count := 0. + action := [:dep | - self dependencies do: [:dep | | ver repo | ver := dep versionInfo name. repo := repoMap at: ver ifAbsent: [ self logError: 'Version ', ver, ' not found in any repository'. self logError: 'Aborting'. ^count]. (selectBlock value: dep) ifTrue: [ | new | new := self versionNamed: ver for: dep from: repo. new ifNil: [ self logError: 'Could not download version ', ver, ' from ', repo description. self logError: 'Aborting'. ^count] ifNotNil: [ self logUpdate: dep package with: new. + self class extraProgressInfo + ifTrue:[ProgressNotification signal: '' extra: 'Installing ', ver]. - ProgressNotification signal: '' extra: 'Installing ', ver. verBlock value: new. count := count + 1. ] ]. dep package workingCopy repositoryGroup addRepository: repo. + ]. + self class extraProgressInfo + ifTrue:[self dependencies do: action displayingProgress: progressString] + ifFalse:[self dependencies do: action]. - ] displayingProgress: progressString. - ^count! Item was changed: Object subclass: #MCConfiguration instanceVariableNames: 'name dependencies repositories log' + classVariableNames: 'DefaultLog ExtraProgressInfo LogToFile' - classVariableNames: 'DefaultLog LogToFile' poolDictionaries: '' category: 'MonticelloConfigurations'! Item was added: + ----- Method: MCConfiguration class>>extraProgressInfo (in category 'preferences') ----- + extraProgressInfo + "Answer true for additional progress info during load. + With the newly added MC down/upload operations this seems unnecessary + but some people might disagree, so let's leave it as a preference right now" + <preference: 'Extra Progress Info' + category: 'Monticello' + description: 'If true, additional progress information is displayed when loading MC configurations (i.e., during updates)' + type: #Boolean> + ^ExtraProgressInfo ifNil:[false]!

1 0

The Trunk: Monticello-ar.347.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ar.347.mcz ==================== Summary ==================== Name: Monticello-ar.347 Author: ar Time: 30 December 2009, 5:25:47 am UUID: f5913c41-3f80-e44c-b1a6-e04e9a18b30d Ancestors: Monticello-ar.346 Have MCPackageLoader use the best guess about the package being installed in progress notifications. =============== Diff against Monticello-ar.346 =============== Item was changed: ----- Method: MCPackageLoader>>basicLoad (in category 'private') ----- basicLoad + "Load the contents of some package. This is the core loading method + in Monticello. Be wary about modifying it unless you understand the details + and dependencies of the various entities being modified." + | pkgName | errorDefinitions := OrderedCollection new. + "Obviously this isn't the package name but we don't have anything else + to use here. ChangeSet current name will generally work since a CS is + usually installed prior to installation." + pkgName := ChangeSet current name. - [["Pass 1: Load everything but the methods, which are collected in methodAdditions." - additions do: [:ea | - [ea isMethodDefinition - ifTrue:[methodAdditions add: ea asMethodAddition] - ifFalse:[ea load]]on: Error do: [errorDefinitions add: ea]. - ] displayingProgress: 'Reshaping classes...'. - - "Pass 2: We compile new / changed methods" - methodAdditions do:[:ea| ea createCompiledMethod] displayingProgress: 'Compiling...'. - - 'Installing...' displayProgressAt: Sensor cursorPoint from: 0 to: 2 during:[:bar| - "There is progress *during* installation since a progress bar update - will redraw the world and potentially call methods that we're just trying to install." - bar value: 1. - - "Pass 3: Install the new / changed methods - (this is a separate pass to allow compiler changes to be loaded)" - methodAdditions do:[:ea| ea installMethod]. - - "Pass 4: Remove the obsolete methods" - removals do:[:ea| ea unload]. - ]. - - "Try again any delayed definitions" - self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. - errorDefinitions do: [:ea | ea load] displayingProgress: 'Reloading...'. - - "Finally, notify observers for the method additions" - methodAdditions do: [:each | each notifyObservers] - "the message is fake but actually telling people how much time we spend - in the notifications is embarrassing so lie instead" - displayingProgress: 'Installing...'. + [["Pass 1: Load everything but the methods, which are collected in methodAdditions." + additions do: [:ea | + [ea isMethodDefinition + ifTrue:[methodAdditions add: ea asMethodAddition] + ifFalse:[ea load]]on: Error do: [errorDefinitions add: ea]. + ] displayingProgress: 'Reshaping ', pkgName. + + "Pass 2: We compile new / changed methods" + methodAdditions do:[:ea| ea createCompiledMethod] + displayingProgress: 'Compiling ', pkgName. + + 'Installing ', pkgName displayProgressAt: Sensor cursorPoint from: 0 to: 2 during:[:bar| + "There is no progress *during* installation since a progress bar update + will redraw the world and potentially call methods that we're just trying to install." + bar value: 1. + + "Pass 3: Install the new / changed methods + (this is a separate pass to allow compiler changes to be loaded)" + methodAdditions do:[:ea| ea installMethod]. + + "Pass 4: Remove the obsolete methods" + removals do:[:ea| ea unload]. + ]. + + "Try again any delayed definitions" + self shouldWarnAboutErrors ifTrue: [self warnAboutErrors]. + errorDefinitions do: [:ea | ea load] + displayingProgress: 'Reloading ', pkgName. + + "Finally, notify observers for the method additions" + methodAdditions do: [:each | each notifyObservers] + "the message is fake but actually telling people how much time we spend + in the notifications is embarrassing so lie instead" + displayingProgress: 'Installing ', pkgName. + + additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] + displayingProgress: 'Initializing ', pkgName. + - additions do: [:ea | ea postloadOver: (self obsoletionFor: ea)] displayingProgress: 'Initializing...' ] on: InMidstOfFileinNotification do: [:n | n resume: true] ] ensure: [self flushChangesFile]!

1 0

The Trunk: Monticello-ar.346.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ar.346.mcz ==================== Summary ==================== Name: Monticello-ar.346 Author: ar Time: 30 December 2009, 5:04:52 am UUID: 305a6619-474d-314a-9331-9a03c6d97588 Ancestors: Monticello-ar.345 Include names of repository and package in up and download progress. =============== Diff against Monticello-ar.345 =============== Item was changed: ----- Method: MCHttpRepository>>readStreamForFileNamed:do: (in category 'required') ----- readStreamForFileNamed: aString do: aBlock | contents | + self displayProgress: 'Downloading ', aString during:[ + contents := HTTPSocket httpGet: (self urlForFileNamed: aString) args: nil user: self user passwd: self password. + ]. - contents := HTTPSocket httpGet: (self urlForFileNamed: aString) args: nil user: self user passwd: self password. ^ contents isString ifFalse: [aBlock value: contents]! Item was changed: ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream response | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. + self displayProgress: 'Uploading ', aString during:[ - self displayProgress: 'Uploading package' during:[ response := HTTPSocket httpPut: stream contents to: (self urlForFileNamed: aString) user: self user passwd: self password. ]. (#( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ') anySatisfy: [:code | response beginsWith: code ]) ifFalse: [self error: response].! Item was changed: ----- Method: MCHttpRepository>>allFileNames (in category 'required') ----- allFileNames | index | + self displayProgress: 'Updating ', self description during:[ - self displayProgress: 'Updating repository' during:[ index := HTTPSocket httpGet: self locationWithTrailingSlash, '?C=M;O=D' args: nil user: self user passwd: self password. ]. index isString ifTrue: [self error: 'Could not access ', location]. ^ self parseFileNamesFromStream: index !

1 0

The Trunk: Network-ar.47.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ar.47.mcz ==================== Summary ==================== Name: Network-ar.47 Author: ar Time: 30 December 2009, 4:40:24 am UUID: 429af7d7-a121-3342-a5c5-2f6c27f10bbe Ancestors: Network-ar.46 Add HTTPProgress for put operations (uploads). =============== Diff against Network-ar.46 =============== Item was added: + ----- Method: HTTPSocket>>sendCommandWithProgress: (in category 'as yet unclassified') ----- + sendCommandWithProgress: commandString + "Send the given command as a single line followed by a <CR><LF> terminator." + + self sendDataWithProgress: commandString, CrLf. + ! Item was changed: ----- Method: HTTPSocket class>>httpPut:to:user:passwd: (in category 'get the page') ----- httpPut: contents to: url user: user passwd: passwd "Upload the contents of the stream to a file on the server" | bare serverName specifiedServer port page serverAddr authorization s list header firstData length aStream command digest | Socket initializeNetwork. "parse url" bare := (url asLowercase beginsWith: 'http://') ifTrue: [url copyFrom: 8 to: url size] ifFalse: [url]. serverName := bare copyUpTo: $/. specifiedServer := serverName. (serverName includes: $:) ifFalse: [ port := self defaultPort ] ifTrue: [ port := (serverName copyFrom: (serverName indexOf: $:) + 1 to: serverName size) asNumber. serverName := serverName copyUpTo: $:. ]. page := bare copyFrom: (bare indexOf: $/) to: bare size. page size = 0 ifTrue: [page := '/']. (self shouldUseProxy: serverName) ifTrue: [ page := 'http://', serverName, ':', port printString, page. "put back together" serverName := self httpProxyServer. port := self httpProxyPort]. "make the request" serverAddr := NetNameResolver addressForName: serverName timeout: 20. serverAddr ifNil: [ ^ 'Could not resolve the server named: ', serverName]. authorization := ' Basic ', (user , ':' , passwd) base64Encoded. [ s := HTTPSocket new. s connectTo: serverAddr port: port. s waitForConnectionUntil: self standardDeadline. Transcript cr; show: url; cr. command := 'PUT ', page, ' HTTP/1.0', CrLf, self userAgentString, CrLf, 'Host: ', specifiedServer, CrLf, 'ACCEPT: */*', CrLf, HTTPProxyCredentials, 'Authorization: ' , authorization , CrLf , 'Content-length: ', contents size printString, CrLf , CrLf , contents. + s sendCommandWithProgress: command. - s sendCommand: command. "get the header of the reply" list := s getResponseUpTo: CrLf, CrLf ignoring: String cr. "list = header, CrLf, CrLf, beginningOfData" header := list at: 1. "Transcript show: page; cr; show: argsStream contents; cr; show: header; cr." firstData := list at: 3. "dig out some headers" s header: header. (authorization beginsWith: 'Digest ') not and: [(digest := self digestFrom: s method: 'PUT' url: url user: user password: passwd) notNil]] whileTrue: [authorization := 'Digest ', digest]. length := s getHeader: 'content-length'. length ifNotNil: [ length := length asNumber ]. + "Suppress progress during response handling" + [aStream := s getRestOfBuffer: firstData totalLength: length] + on: HTTPProgress do:[:ex| ex resume]. - aStream := s getRestOfBuffer: firstData totalLength: length. s destroy. "Always OK to destroy!!" ^ header, aStream contents! Item was added: + ----- Method: HTTPSocket>>sendDataWithProgress: (in category 'as yet unclassified') ----- + sendDataWithProgress: aStringOrByteArray + "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent." + + "An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts." + + | bytesSent bytesToSend count | + bytesToSend := aStringOrByteArray size. + bytesSent := 0. + [bytesSent < bytesToSend] whileTrue: [ + (HTTPProgress new) + total: bytesToSend; + amount: bytesSent; + signal: 'Uploading...'. + (self waitForSendDoneUntil: (Socket deadlineSecs: 60)) + ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent']. + count := self primSocket: socketHandle + sendData: aStringOrByteArray + startIndex: bytesSent + 1 + count: (bytesToSend - bytesSent min: 5000). + bytesSent := bytesSent + count]. + + ^ bytesSent + !

1 0

The Trunk: Monticello-ar.345.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ar.345.mcz ==================== Summary ==================== Name: Monticello-ar.345 Author: ar Time: 30 December 2009, 4:43:26 am UUID: 41d6d7f1-8398-464f-afa8-9d67fa71271f Ancestors: Monticello-ar.344 Display progress during common MC operations on HTTP repositories. =============== Diff against Monticello-ar.344 =============== Item was added: + ----- Method: MCHttpRepository>>displayProgress:during: (in category 'required') ----- + displayProgress: label during: workBlock + | nextUpdateTime | + nextUpdateTime := 0. + ^UIManager default displayProgress: label at: Display center + from: 0.0 to: 1.0 during:[:bar| + [workBlock value] on: HTTPProgress do:[:ex| + (ex total == nil or:[ex amount == nil]) ifFalse:[ + (nextUpdateTime < Time millisecondClockValue + or:[ex total = ex amount]) ifTrue:[ + bar value: ex amount asFloat / ex total asFloat. + nextUpdateTime := Time millisecondClockValue + 100. + ]. + ]. + ex resume. + ] + ]. + ! Item was changed: ----- Method: MCHttpRepository>>writeStreamForFileNamed:replace:do: (in category 'required') ----- writeStreamForFileNamed: aString replace: ignoreBoolean do: aBlock | stream response | stream := RWBinaryOrTextStream on: String new. aBlock value: stream. + self displayProgress: 'Uploading package' during:[ + response := HTTPSocket - response := HTTPSocket httpPut: stream contents to: (self urlForFileNamed: aString) user: self user passwd: self password. + ]. - (#( 'HTTP/1.1 201 ' 'HTTP/1.1 200 ' 'HTTP/1.0 201 ' 'HTTP/1.0 200 ') anySatisfy: [:code | response beginsWith: code ]) ifFalse: [self error: response].! Item was changed: ----- Method: MCHttpRepository>>allFileNames (in category 'required') ----- allFileNames | index | + self displayProgress: 'Updating repository' during:[ + index := HTTPSocket httpGet: self locationWithTrailingSlash, '?C=M;O=D' args: nil user: self user passwd: self password. + ]. - index := HTTPSocket httpGet: self locationWithTrailingSlash, '?C=M;O=D' args: nil user: self user passwd: self password. index isString ifTrue: [self error: 'Could not access ', location]. ^ self parseFileNamesFromStream: index !

1 0

The Trunk: Network-ar.46.mcz
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Andreas Raab uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ar.46.mcz ==================== Summary ==================== Name: Network-ar.46 Author: ar Time: 30 December 2009, 4:23:24 am UUID: 62689cdd-d137-f546-acfb-840508ca3502 Ancestors: Network-ar.45 Add an HTTPProgress notification that can be used to display progress during HTTPSocket httpGet: operations. =============== Diff against Network-ar.45 =============== Item was changed: ----- Method: HTTPSocket class>>httpGetDocument:args:accept:request: (in category 'get the page') ----- 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 bare page index connectToHost connectToPort aStream portSuffix | 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. portSuffix := ':', port printString. serverName := serverName copyFrom: 1 to: index-1. ] ifFalse: [ port := self defaultPort. portSuffix := ''. ]. page size = 0 ifTrue: [page := '/']. "add arguments" args ifNotNil: [page := page, (self argString: args) ]. (self shouldUseProxy: serverName) ifFalse: [ connectToHost := serverName. connectToPort := port ] ifTrue: [ page := 'http://', serverName, portSuffix, page. "put back together" connectToHost := self httpProxyServer. connectToPort := self httpProxyPort]. + HTTPProgress signal: 'Looking up ', connectToHost. serverAddr := NetNameResolver addressForName: connectToHost timeout: 20. + serverAddr ifNil: [^ 'Could not resolve the server named: ', connectToHost]. - serverAddr ifNil: [ - ^ 'Could not resolve the server named: ', connectToHost]. 3 timesRepeat: [ | sock length firstData list type header newUrl | 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 ifNotNil: ['ACCEPT: ', mimeType, CrLf] ifNil: ['']), 'ACCEPT: text/html', CrLf, "Always accept plain text" HTTPBlabEmail, "may be empty" requestString, "extra user request. Authorization" self userAgentString, CrLf, 'Host: ', serverName, portSuffix, CrLf. "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 := self expandUrl: newUrl ip: serverAddr port: connectToPort. ^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 class ~~ String ifTrue: [ ^ 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!!'! Item was added: + Notification subclass: #HTTPProgress + instanceVariableNames: 'total amount' + classVariableNames: '' + poolDictionaries: '' + category: 'Network-Protocols'! + + !HTTPProgress commentStamp: 'ar 12/30/2009 16:16' prior: 0! + HTTP progress notification. Includes: + - total: The total size of the download (if known) + - amount: The completed amount of the download (if known) + ! Item was changed: ----- Method: HTTPSocket>>getRestOfBuffer:totalLength: (in category 'as yet unclassified') ----- getRestOfBuffer: beginning totalLength: length "Reel in a string of a fixed length. Part of it has already been received. Close the connection after all chars are received. We do not strip out linefeed chars. tk 6/16/97 22:32" "if length is nil, read until connection close. Response is of type text, not binary." | buf response bytesRead | length ifNil: [^ self getRestOfBuffer: beginning]. buf := String new: length. response := RWBinaryOrTextStream on: buf. response nextPutAll: beginning. buf := String new: length. [(response position < length) & (self isConnected | self dataAvailable)] whileTrue: [ + (HTTPProgress new) + total: length; + amount: response position; + signal: 'Downloading...'. (self waitForDataUntil: (Socket deadlineSecs: 5)) ifFalse: [ Transcript show: 'data was slow'; cr]. bytesRead := self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: (length - response position). bytesRead > 0 ifTrue: [ response nextPutAll: (buf copyFrom: 1 to: bytesRead)] ]. "Transcript cr; show: 'data byte count: ', response position printString." "Transcript cr; show: ((self isConnected) ifTrue: ['Over length by: ', bytesRead printString] ifFalse: ['Socket closed'])." response position < length ifTrue: [^ 'server aborted early']. response reset. "position: 0." ^ response! Item was added: + ----- Method: HTTPProgress>>total (in category 'accessing') ----- + total + "Answer the total size of the download, if known" + ^total! Item was added: + ----- Method: HTTPProgress>>amount: (in category 'accessing') ----- + amount: bytes + "Set the completed amount of the download (if known)" + amount := bytes! Item was added: + ----- Method: HTTPProgress>>total: (in category 'accessing') ----- + total: bytes + "Answer the total size of the download, if known" + total := bytes! Item was added: + ----- Method: HTTPProgress>>amount (in category 'accessing') ----- + amount + "Answer the completed amount of the download (if known)" + ^amount!

1 0

UTF8 methods and portability
by K. K. Subramaniam 30 Dec '09

30 Dec '09

Hi, The methods named squeakToUTF8 appears regressive in the light of forks and variants of Squeak and Smalltalk. Is there any specific reason against calling it asUTF8" and so on? The methods are not widely used yet to deserve leaving them in the image with a deprecated flag. Is there any idiomatic way to bulk rename a method (implementation and senders) in an image? Doing a search and replace is tediously slow. TIA .. Subbu

2 1

Daily Commit Log
by commits＠source.squeak.org 30 Dec '09

30 Dec '09

Changes to Trunk (http://source.squeak.org/trunk.html) in the last 24 hours: http://lists.squeakfoundation.org/pipermail/packages/2009-December/002215.h… Name: Morphic-dtl.278 Ancestors: Morphic-dtl.277 Move #restoreDisplay implementation from ScreenController to Project to eliminate #isMorphic sends. Eliminate #isMorphic from #snapshot:andQuit:embedded: by adding #startUpComplete to Project and MorphicProject. Move #offerMenuFrom:shifted: from StringHolder to Project to eliminate #isMorphic send. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002216.h… Name: ST80-dtl.80 Ancestors: ST80-nice.79 Move #restoreDisplay implementation from ScreenController to Project to eliminate #isMorphic sends. Move #offerMenuFrom:shifted: from StringHolder to Project to eliminate #isMorphic send. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002217.h… Name: System-dtl.210 Ancestors: System-dtl.209 Move #restoreDisplay implementation from ScreenController to Project to eliminate #isMorphic sends. Eliminate #isMorphic from #snapshot:andQuit:embedded: by adding #startUpComplete to Project and MorphicProject. Move #offerMenuFrom:shifted: from StringHolder to Project to eliminate #isMorphic send. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002218.h… Name: Tools-dtl.153 Ancestors: Tools-ar.152 Remove unnecessary #isMorphic sends in SelectorBrowser>>selectorList: and SelectorBrowser>>searchResult: Move #offerMenuFrom:shifted: from StringHolder to Project to eliminate #isMorphic send. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002219.h… Name: Morphic-dtl.279 Ancestors: Morphic-dtl.278 Rename #startUpComplete to #wakeUpTopWindow because it is used in contexts other than image startup. Change ChangesOrganizer class>>reorderChangesSets to use 'Project current wakeUpTopWindow' rather than an #isMorphic test. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002220.h… Name: System-dtl.211 Ancestors: System-dtl.210 Rename #startUpComplete to #wakeUpTopWindow because it is used in contexts other than image startup. Change ChangesOrganizer class>>reorderChangesSets to use 'Project current wakeUpTopWindow' rather than an #isMorphic test. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002221.h… Name: Tools-dtl.154 Ancestors: Tools-dtl.153 Change ChangesOrganizer class>>reorderChangesSets to use 'Project current wakeUpTopWindow' rather than an #isMorphic test. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002222.h… Name: Network-ar.45 Ancestors: Network-nice.44, Network-tonyg.35 Merging Network-tonyg.35: Do not specify ':80' (or other port number) in HTTP request 'Host' header unless a port number was explicitly specified, because doing so changes the meaning of the request when HTTP virtual-hosts are being used. ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002223.h… Name: System-ul.212 Ancestors: System-dtl.211, System-klub.210 - new TextDiffBuilder implementation ============================================= http://lists.squeakfoundation.org/pipermail/packages/2009-December/002224.h… Name: Monticello-ar.344 Ancestors: Monticello-ar.343 Fixes a bug preventing Monticello to load a class definition with traits removed over one containing traits. =============================================

1 0

← Newer
1
2
3
4
5
6
7
8
9
...
56
Older →

Jump to page: