Packages February 2019

packages@lists.squeakfoundation.org

1 participants
39 discussions

The Trunk: 60Deprecated-tpr.32.mcz
by commits＠source.squeak.org 19 Feb '19

19 Feb '19

tim Rowledge uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-tpr.32.mcz ==================== Summary ==================== Name: 60Deprecated-tpr.32 Author: tpr Time: 18 February 2019, 7:34:39.749893 pm UUID: 563d119b-c74a-42cc-877d-33cb848d66c6 Ancestors: 60Deprecated-tpr.31 Part of deprecating HTTPClient for 6.0 Stop using it, deprecate HTTPClient, URI & subclasses =============== Diff against 60Deprecated-tpr.31 =============== Item was changed: SystemOrganization addCategory: #'60Deprecated-Collections-Streams'! SystemOrganization addCategory: #'60Deprecated-Kernel-Methods'! SystemOrganization addCategory: #'60Deprecated-System-Support'! SystemOrganization addCategory: #'60Deprecated-Tools-Inspector'! SystemOrganization addCategory: #'60Deprecated-Tools-Menus'! + SystemOrganization addCategory: #'60Deprecated-Network-URI'! Item was added: + ----- Method: AutoStart class>>checkForPluginUpdate (in category '*60Deprecated') ----- + checkForPluginUpdate + | pluginVersion updateURL | + HTTPClient isRunningInBrowser + ifFalse: [^false]. + pluginVersion := Smalltalk namedArguments + at: (Smalltalk platformName copyWithout: Character space) asUppercase + ifAbsent: [^false]. + updateURL := Smalltalk namedArguments + at: 'UPDATE_URL' + ifAbsent: [^false]. + ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL! Item was added: + ----- Method: AutoStart class>>checkForUpdates (in category '*60Deprecated') ----- + checkForUpdates + | availableUpdate updateServer | + HTTPClient isRunningInBrowser ifFalse: [ ^ self processUpdates ]. + availableUpdate := (Smalltalk namedArguments + at: 'UPDATE' + ifAbsent: [ '' ]) asInteger. + availableUpdate ifNil: [ ^ false ]. + updateServer := Smalltalk namedArguments + at: 'UPDATESERVER' + ifAbsent: + [ Smalltalk namedArguments + at: 'UPDATE_SERVER' + ifAbsent: [ 'Squeakland' ] ]. + UpdateStreamDownloader default setUpdateServer: updateServer. + ^ SystemVersion checkAndApplyUpdates: availableUpdate! Item was added: + Object subclass: #HTTPClient + instanceVariableNames: '' + classVariableNames: 'BrowserSupportsAPI RunningInBrowser' + poolDictionaries: '' + category: '60Deprecated-System-Support'! Item was added: + ----- Method: HTTPClient class>>browserSupportsAPI (in category 'class initialization') ----- + browserSupportsAPI + ^BrowserSupportsAPI == true! Item was added: + ----- Method: HTTPClient class>>browserSupportsAPI: (in category 'class initialization') ----- + browserSupportsAPI: aBoolean + BrowserSupportsAPI := aBoolean! Item was added: + ----- Method: HTTPClient class>>composeMailTo:subject:body: (in category 'utilities') ----- + composeMailTo: address subject: subject body: body + "HTTPClient composeMailTo: 'michael.rueger(a)squeakland.org' subject: 'test subject' body: 'message' " + | mailTo | + mailTo := WriteStream on: String new. + mailTo nextPutAll: 'mailto:'. + mailTo + nextPutAll: address; + nextPut: $?. + subject isEmptyOrNil + ifFalse: [mailTo nextPutAll: 'subject='; nextPutAll: subject; nextPut: $&]. + body isEmptyOrNil + ifFalse: [mailTo nextPutAll: 'body='; nextPutAll: body]. + + self httpGet: mailTo contents! Item was added: + ----- Method: HTTPClient class>>determineIfRunningInBrowser (in category 'class initialization') ----- + determineIfRunningInBrowser + "HTTPClient determineIfRunningInBrowser" + + RunningInBrowser := StandardFileStream isRunningAsBrowserPlugin + ! Item was added: + ----- Method: HTTPClient class>>exampleMailTo (in category 'examples') ----- + exampleMailTo + "HTTPClient exampleMailTo" + + HTTPClient mailTo: 'm.rueger(a)acm.org' message: 'A test message from within Squeak' + ! Item was added: + ----- Method: HTTPClient class>>examplePostArgs (in category 'examples') ----- + examplePostArgs + "HTTPClient examplePostArgs" + + | args result | + args := Dictionary new + at: 'arg1' put: #('val1'); + at: 'arg2' put: #('val2'); + yourself. + result := HTTPClient httpPostDocument: 'http://www.squeaklet.com/cgi-bin/thrd.pl [^]' args: args. + Transcript show: result content; cr; cr. + + ! Item was added: + ----- Method: HTTPClient class>>examplePostMultipart (in category 'examples') ----- + examplePostMultipart + "HTTPClient examplePostMultipart" + + | args result | + args := Dictionary new + at: 'arg1' put: #('val1'); + at: 'arg2' put: #('val2'); + yourself. + result := HTTPClient httpPostMultipart: 'http://www.squeaklet.com/cgi-bin/thrd.pl' args: args. + Transcript show: result content; cr; cr. + + ! Item was added: + ----- Method: HTTPClient class>>getDirectoryListing: (in category 'utilities') ----- + getDirectoryListing: dirListURL + "HTTPClient getDirectoryListing: 'http://www.squeakalpha.org/uploads' " + | answer ftpEntries | + " answer := self + httpPostDocument: dirListURL + args: Dictionary new." + "Workaround for Mac IE problem" + answer := self httpGetDocument: dirListURL. + answer isString + ifTrue: [^self error: 'Listing failed: ' , answer] + ifFalse: [answer := answer content]. + answer first == $< + ifTrue: [self error: 'Listing failed: ' , answer]. + ftpEntries := answer findTokens: String crlf. + ^ ftpEntries + collect:[:ftpEntry | ServerDirectory parseFTPEntry: ftpEntry] + thenSelect: [:entry | entry notNil]! Item was added: + ----- Method: HTTPClient class>>httpGet: (in category 'post/get') ----- + httpGet: url + | document | + document := self httpGetDocument: url. + ^(document isString) + ifTrue: [ + "strings indicate errors" + document] + ifFalse: [(RWBinaryOrTextStream with: document content) reset]! Item was added: + ----- Method: HTTPClient class>>httpGetDocument: (in category 'post/get') ----- + httpGetDocument: url + | stream content | + ^self shouldUsePluginAPI + ifTrue: [ + stream := FileStream requestURLStream: url ifError: [self error: 'Error in get from ' , url printString]. + stream ifNil: [^'']. + stream position: 0. + content := stream upToEnd. + stream close. + MIMEDocument content: content] + ifFalse: [HTTPSocket httpGetDocument: url]! Item was added: + ----- Method: HTTPClient class>>httpPostDocument:args: (in category 'post/get') ----- + httpPostDocument: url args: argsDict + ^self httpPostDocument: url target: nil args: argsDict! Item was added: + ----- Method: HTTPClient class>>httpPostDocument:target:args: (in category 'post/get') ----- + httpPostDocument: url target: target args: argsDict + | argString stream content | + ^self shouldUsePluginAPI + ifTrue: [ + argString := argsDict + ifNotNil: [argString := HTTPSocket argString: argsDict] + ifNil: ['']. + stream := FileStream post: argString , ' ' target: target url: url , argString ifError: [self error: 'Error in post to ' , url printString]. + stream position: 0. + content := stream upToEnd. + stream close. + MIMEDocument content: content] + ifFalse: [HTTPSocket httpPostDocument: url args: argsDict]! Item was added: + ----- Method: HTTPClient class>>httpPostMultipart:args: (in category 'post/get') ----- + httpPostMultipart: url args: argsDict + " do multipart/form-data encoding rather than x-www-urlencoded " + + ^self shouldUsePluginAPI + ifTrue: [self pluginHttpPostMultipart: url args: argsDict] + ifFalse: [HTTPSocket httpPostMultipart: url args: argsDict accept: nil request: '']! Item was added: + ----- Method: HTTPClient class>>isRunningInBrowser (in category 'testing') ----- + isRunningInBrowser + + RunningInBrowser isNil + ifTrue: [self determineIfRunningInBrowser]. + ^RunningInBrowser! Item was added: + ----- Method: HTTPClient class>>isRunningInBrowser: (in category 'testing') ----- + isRunningInBrowser: aBoolean + "Override the automatic process. + This should be used with caution. + One way to determine it without using the primitive is to check for parameters typically only encountered when running as a plugin." + + RunningInBrowser := aBoolean! Item was added: + ----- Method: HTTPClient class>>mailTo:message: (in category 'utilities') ----- + mailTo: address message: aString + HTTPClient shouldUsePluginAPI + ifFalse: [^self error: 'You need to run inside a web browser.']. + FileStream post: aString url: 'mailto:' , address ifError: [self error: 'Can not send mail']! Item was added: + ----- Method: HTTPClient class>>pluginHttpPostMultipart:args: (in category 'private') ----- + pluginHttpPostMultipart: url args: argsDict + | mimeBorder argsStream crLf resultStream result | + " do multipart/form-data encoding rather than x-www-urlencoded " + + crLf := String crlf. + mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'. + "encode the arguments dictionary" + argsStream := WriteStream on: String new. + argsDict associationsDo: [:assoc | + assoc value do: [ :value | | fieldValue | + "print the boundary" + argsStream nextPutAll: '--', mimeBorder, crLf. + " check if it's a non-text field " + argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'. + (value isKindOf: MIMEDocument) + ifFalse: [fieldValue := value] + ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType. + fieldValue := (value content + ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] + ifNotNil: [value content]) asString]. + " Transcript show: 'field=', key, '; value=', fieldValue; cr. " + argsStream nextPutAll: crLf, crLf, fieldValue, crLf. + ]]. + argsStream nextPutAll: '--', mimeBorder, '--'. + resultStream := FileStream + post: + ('ACCEPT: text/html', crLf, + 'User-Agent: Squeak 3.1', crLf, + 'Content-type: multipart/form-data; boundary=', mimeBorder, crLf, + 'Content-length: ', argsStream contents size printString, crLf, crLf, + argsStream contents) + url: url ifError: [^'Error in post ' url asString]. + "get the header of the reply" + result := resultStream + ifNil: [''] + ifNotNil: [resultStream upToEnd]. + ^MIMEDocument content: result! Item was added: + ----- Method: HTTPClient class>>requestURL:target: (in category 'post/get') ----- + requestURL: url target: target + ^self shouldUsePluginAPI + ifTrue: [FileStream requestURL: url target: target] + ifFalse: [self error: 'Requesting a new URL target is not supported.']! Item was added: + ----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') ----- + shouldUsePluginAPI + "HTTPClient shouldUsePluginAPI" + + self isRunningInBrowser + ifFalse: [^false]. + self browserSupportsAPI + ifFalse: [^false]. + "The Mac plugin calls do not work in full screen mode" + ^((Smalltalk platformName = 'Mac OS') + and: [DisplayScreen displayIsFullScreen]) not! Item was added: + ----- Method: HTTPClient class>>uploadFileNamed:to:user:passwd: (in category 'utilities') ----- + uploadFileNamed: aFilename to: baseUrl user: user passwd: passwd + + | fileContents remoteFilename | + remoteFilename := (baseUrl endsWith: '/') + ifTrue: [baseUrl , '/' , aFilename] + ifFalse: [baseUrl , aFilename]. + fileContents := (StandardFileStream readOnlyFileNamed: aFilename) contentsOfEntireFile. + HTTPSocket httpPut: fileContents to: remoteFilename user: user passwd: passwd! Item was added: + URI subclass: #HierarchicalURI + instanceVariableNames: 'authority query' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Network-URI'! Item was added: + ----- Method: HierarchicalURI>>absoluteFromString:scheme: (in category 'private') ----- + absoluteFromString: aString scheme: schemeName + | remainder | + super absoluteFromString: aString scheme: schemeName. + + "We now have the interesting part in schemeSpecficPart and can parse it further" + + "This check is somewhat redundant, just in case somebody calls this directly." + remainder := schemeSpecificPart. + (remainder isEmpty + or: [remainder first ~~ $/]) + ifTrue: [(IllegalURIException new uriString: remainder) signal: 'Invalid absolute URI']. + + (aString beginsWith: '//') + ifTrue: [remainder := self extractAuthority: (remainder copyFrom: 3 to: remainder size)]. + + self extractSchemeSpecificPartAndFragment: remainder! Item was added: + ----- Method: HierarchicalURI>>absolutePath (in category 'accessing') ----- + absolutePath + ^self schemeSpecificPart isEmpty + ifTrue: ['/'] + ifFalse: [self schemeSpecificPart]! Item was added: + ----- Method: HierarchicalURI>>allButScheme (in category 'printing') ----- + allButScheme + "Answer the entire url except its scheme" + + ^String streamContents:[:s| + authority ifNotNil:[self authority printOn: s]. + s nextPutAll: super allButScheme. + query ifNotNil:[s nextPutAll: query]. + ].! Item was added: + ----- Method: HierarchicalURI>>assureExistance (in category 'directory operations') ----- + assureExistance + ! Item was added: + ----- Method: HierarchicalURI>>authority (in category 'accessing') ----- + authority + ^authority! Item was added: + ----- Method: HierarchicalURI>>baseName (in category 'accessing') ----- + baseName + "returns the last component stripped of its extension" + + | baseName i | + baseName := self pathComponents last. + i := baseName findLast: [:c | c = $.]. + ^i = 0 + ifTrue: [baseName] + ifFalse: [baseName copyFrom: 1 to: i-1]. + ! Item was added: + ----- Method: HierarchicalURI>>buildAbsolutePath: (in category 'private') ----- + buildAbsolutePath: pathComponents + ^String streamContents: [:stream | + stream nextPut: $/. + pathComponents + do: [:pathPart | stream nextPutAll: pathPart] + separatedBy: [stream nextPut: $/]]! Item was added: + ----- Method: HierarchicalURI>>extension (in category 'accessing') ----- + extension + "This method assumes a $. as extension delimiter" + + | i leafName | + leafName := self pathComponents last. + i := leafName findLast: [:c | c = $.]. + ^i = 0 + ifTrue: [''] + ifFalse: [leafName copyFrom: i + 1 to: leafName size]. + ! Item was added: + ----- Method: HierarchicalURI>>extractAuthority: (in category 'private') ----- + extractAuthority: aString + | endAuthorityIndex authorityString | + endAuthorityIndex := (aString indexOf: $/ ) - 1. + endAuthorityIndex < 0 + ifTrue: [endAuthorityIndex := aString size]. + authorityString := aString copyFrom: 1 to: endAuthorityIndex. + authority := URIAuthority fromString: authorityString. + ^aString copyFrom: endAuthorityIndex+1 to: aString size! Item was added: + ----- Method: HierarchicalURI>>extractQuery: (in category 'private') ----- + extractQuery: remainder + | queryIndex | + queryIndex := remainder indexOf: $?. + queryIndex > 0 + ifFalse: [^remainder]. + query := remainder copyFrom: queryIndex to: remainder size. + ^remainder copyFrom: 1 to: queryIndex-1! Item was added: + ----- Method: HierarchicalURI>>extractSchemeSpecificPartAndFragment: (in category 'private') ----- + extractSchemeSpecificPartAndFragment: remainder + super extractSchemeSpecificPartAndFragment: remainder. + schemeSpecificPart := self extractQuery: schemeSpecificPart! Item was added: + ----- Method: HierarchicalURI>>host (in category 'accessing') ----- + host + ^self authority host! Item was added: + ----- Method: HierarchicalURI>>path (in category 'accessing') ----- + path + " ^self schemeSpecificPart isEmpty + ifTrue: ['/'] + ifFalse: [self schemeSpecificPart]" + ^self schemeSpecificPart! Item was added: + ----- Method: HierarchicalURI>>pathComponents (in category 'accessing') ----- + pathComponents + ^self path findTokens: $/! Item was added: + ----- Method: HierarchicalURI>>port (in category 'accessing') ----- + port + ^self authority port! Item was added: + ----- Method: HierarchicalURI>>printSchemeSpecificPartOn: (in category 'printing') ----- + printSchemeSpecificPartOn: stream + self isAbsolute + ifTrue: [stream nextPutAll: '//']. + authority + ifNotNil: [self authority printOn: stream]. + super printSchemeSpecificPartOn: stream. + query + ifNotNil: [stream nextPutAll: query]! Item was added: + ----- Method: HierarchicalURI>>query (in category 'accessing') ----- + query + ^query! Item was added: + ----- Method: HierarchicalURI>>relativeFromString: (in category 'private') ----- + relativeFromString: aString + | remainder authorityEnd | + remainder := (aString beginsWith: '//') + ifTrue: [ + authorityEnd := aString indexOf: $/ startingAt: 3. + authorityEnd = 0 + ifTrue: [authorityEnd := aString size+1]. + self extractAuthority: (aString copyFrom: 3 to: authorityEnd-1)] + ifFalse: [aString]. + self extractSchemeSpecificPartAndFragment: remainder! Item was added: + ----- Method: HierarchicalURI>>removeComponentDotDotPairs: (in category 'private') ----- + removeComponentDotDotPairs: pathComponents + | dotDotIndex | + dotDotIndex := pathComponents indexOf: '..'. + [dotDotIndex > 1] + whileTrue: [ + pathComponents + removeAt: dotDotIndex; + removeAt: dotDotIndex-1. + dotDotIndex := pathComponents indexOf: '..']! Item was added: + ----- Method: HierarchicalURI>>resolveRelativeURI: (in category 'accessing') ----- + resolveRelativeURI: aURI + | relativeURI newAuthority newPath pathComponents newURI relComps | + relativeURI := aURI asURI. + + relativeURI isAbsolute + ifTrue: [^relativeURI]. + + relativeURI authority + ifNil: [ + newAuthority := self authority. + (relativeURI path beginsWith: '/') + ifTrue: [newPath := relativeURI path] + ifFalse: [ + pathComponents := (self path copyUpToLast: $/) findTokens: $/. + relComps := relativeURI pathComponents. + relComps removeAllSuchThat: [:each | each = '.']. + pathComponents addAll: relComps. + pathComponents removeAllSuchThat: [:each | each = '.']. + self removeComponentDotDotPairs: pathComponents. + newPath := self buildAbsolutePath: pathComponents. + ((relComps isEmpty + or: [relativeURI path last == $/ + or: [(relativeURI path endsWith: '/..') + or: [relativeURI path = '..' + or: [relativeURI path endsWith: '/.' ]]]]) + and: [newPath size > 1]) + ifTrue: [newPath := newPath , '/']]] + ifNotNil: [ + newAuthority := relativeURI authority. + newPath := relativeURI path]. + + newURI := String streamContents: [:stream | + stream nextPutAll: self scheme. + stream nextPut: $: . + newAuthority notNil + ifTrue: [ + stream nextPutAll: '//'. + newAuthority printOn: stream]. + newPath notNil + ifTrue: [stream nextPutAll: newPath]. + relativeURI query notNil + ifTrue: [stream nextPutAll: relativeURI query]. + relativeURI fragment notNil + ifTrue: [ + stream nextPut: $# . + stream nextPutAll: relativeURI fragment]]. + ^newURI asURI! Item was added: + ----- Method: HierarchicalURI>>userInfo (in category 'accessing') ----- + userInfo + ^self authority userInfo! Item was added: + URI subclass: #OpaqueURI + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: '60Deprecated-Network-URI'! Item was added: + ----- Method: OpaqueURI>>isOpaque (in category 'testing') ----- + isOpaque + ^true! Item was added: + ----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category '*60Deprecated-testing method dictionary') ----- + check: pluginVersion andRequestPluginUpdate: updateURL + "SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' " + + "We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac." + (self pluginVersion: pluginVersion newerThan: self currentPluginVersion) + ifFalse: [^true]. + (self confirm: 'There is a newer plugin version available. Do you want to install it now?') + ifFalse: [^false]. + HTTPClient + requestURL: updateURL , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html' + target: '_top'. + ^false! Item was added: + Object subclass: #URI + instanceVariableNames: 'fragment scheme schemeSpecificPart' + classVariableNames: 'ClientClasses' + poolDictionaries: '' + category: '60Deprecated-Network-URI'! + + !URI commentStamp: 'tpr 2/18/2019 18:06' prior: 0! + This class is deprecated. Consider using one of the Url classes instead. + + A Uniform Resource Identifier (URI) is a compact string of characters for identifying an abstract or physical resource. + This implementation is based on http://www.ietf.org/rfc/rfc2396.txt. + + ! Item was added: + ----- Method: URI class>>absoluteFromString:scheme: (in category 'instance creation') ----- + absoluteFromString: aString scheme: scheme + | remainder | + remainder := aString copyFrom: scheme size+2 to: aString size. + remainder isEmpty + ifTrue: [(IllegalURIException new uriString: aString) signal: 'Invalid absolute URI']. + ^(remainder first = $/ + ifTrue: [HierarchicalURI] + ifFalse: [OpaqueURI]) new absoluteFromString: remainder scheme: scheme! Item was added: + ----- Method: URI class>>basicNew (in category 'instance creation') ----- + basicNew + self deprecated: 'This class is deprecated. USe one ofthe Url classes instead'. + ^super basicNew! Item was added: + ----- Method: URI class>>extractSchemeFrom: (in category 'instance creation') ----- + extractSchemeFrom: aString + | colonIndex slashIndex | + colonIndex := aString indexOf: $: . + ^colonIndex > 0 + ifTrue: [ + slashIndex := aString indexOf: $/ . + (slashIndex = 0 + or: [colonIndex < slashIndex]) + ifTrue: [aString copyFrom: 1 to: colonIndex-1] + ifFalse: [nil]] + ifFalse: [nil]! Item was added: + ----- Method: URI class>>fromString: (in category 'instance creation') ----- + fromString: aString + | parseString scheme | + parseString := aString withBlanksTrimmed. + scheme := self extractSchemeFrom: parseString. + ^scheme + ifNil: [HierarchicalURI new relativeFromString: aString] + ifNotNil: [self absoluteFromString: aString scheme: scheme] + ! Item was added: + ----- Method: URI class>>initialize (in category 'class initialization') ----- + initialize + "URI initialize" + + ClientClasses := Dictionary new. + ClientClasses + at: 'http' put: #HTTPClient; + at: 'ftp' put: #FTPClient; + at: 'file' put: #FileDirectory + ! Item was added: + ----- Method: URI>>= (in category 'testing') ----- + = otherURI + ^ self class = otherURI class + and: [self asString = otherURI asString]! Item was added: + ----- Method: URI>>absoluteFromString:scheme: (in category 'private') ----- + absoluteFromString: remainder scheme: schemeName + scheme := schemeName. + self extractSchemeSpecificPartAndFragment: remainder! Item was added: + ----- Method: URI>>allButScheme (in category 'printing') ----- + allButScheme + "Answer the entire url except its scheme" + + ^String streamContents:[:s| + s nextPutAll: schemeSpecificPart. + fragment ifNotNil: [ + s nextPut: $# . + s nextPutAll: self fragment] + ].! Item was added: + ----- Method: URI>>asText (in category 'converting') ----- + asText + ^self asString asText! Item was added: + ----- Method: URI>>asURI (in category 'converting') ----- + asURI + ^self! Item was added: + ----- Method: URI>>asUrl (in category 'converting') ----- + asUrl + + ^self asString asUrl! Item was added: + ----- Method: URI>>clientClass (in category 'private') ----- + clientClass + ^Smalltalk at: (ClientClasses at: self scheme ifAbsent: [ClientClasses at: 'file'])! Item was added: + ----- Method: URI>>contentStream (in category 'retrieval') ----- + contentStream + ^self clientClass contentStreamForURI: self! Item was added: + ----- Method: URI>>downloadUrl (in category 'converting') ----- + downloadUrl + self halt! Item was added: + ----- Method: URI>>extractSchemeSpecificPartAndFragment: (in category 'private') ----- + extractSchemeSpecificPartAndFragment: remainder + | fragmentIndex | + fragmentIndex := remainder indexOf: $# . + fragmentIndex > 0 + ifTrue: [ + schemeSpecificPart := remainder copyFrom: 1 to: fragmentIndex-1. + fragment := remainder copyFrom: fragmentIndex+1 to: remainder size] + ifFalse: [schemeSpecificPart := remainder]! Item was added: + ----- Method: URI>>fragment (in category 'accessing') ----- + fragment + ^fragment! Item was added: + ----- Method: URI>>hasRemoteContents (in category 'testing') ----- + hasRemoteContents + self halt! Item was added: + ----- Method: URI>>hash (in category 'testing') ----- + hash + ^ self asString hash! Item was added: + ----- Method: URI>>isAbsolute (in category 'testing') ----- + isAbsolute + ^self scheme notNil! Item was added: + ----- Method: URI>>isOpaque (in category 'testing') ----- + isOpaque + ^false! Item was added: + ----- Method: URI>>isRelative (in category 'testing') ----- + isRelative + ^self isAbsolute not! Item was added: + ----- Method: URI>>printOn: (in category 'printing') ----- + printOn: stream + self isAbsolute + ifTrue: [ + stream nextPutAll: self scheme. + stream nextPut: $: ]. + self printSchemeSpecificPartOn: stream. + fragment + ifNotNil: [ + stream nextPut: $# . + stream nextPutAll: self fragment] + ! Item was added: + ----- Method: URI>>printSchemeSpecificPartOn: (in category 'printing') ----- + printSchemeSpecificPartOn: stream + stream nextPutAll: self schemeSpecificPart! Item was added: + ----- Method: URI>>resolveRelativeURI: (in category 'accessing') ----- + resolveRelativeURI: relativeURI + self shouldNotImplement! Item was added: + ----- Method: URI>>retrieveContentStream (in category 'retrieval') ----- + retrieveContentStream + ^self retrieveMIMEDocument contentStream! Item was added: + ----- Method: URI>>retrieveContents (in category 'retrieval') ----- + retrieveContents + ^self retrieveMIMEDocument contents! Item was added: + ----- Method: URI>>retrieveMIMEDocument (in category 'retrieval') ----- + retrieveMIMEDocument + ^self clientClass retrieveMIMEDocument: self! Item was added: + ----- Method: URI>>scheme (in category 'accessing') ----- + scheme + ^scheme! Item was added: + ----- Method: URI>>schemeSpecificPart (in category 'private') ----- + schemeSpecificPart + ^schemeSpecificPart!

1 0

The Trunk: EToys-tpr.340.mcz
by commits＠source.squeak.org 19 Feb '19

19 Feb '19

tim Rowledge uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tpr.340.mcz ==================== Summary ==================== Name: EToys-tpr.340 Author: tpr Time: 18 February 2019, 7:30:07.021016 pm UUID: d1ed1a6e-a62f-4178-bcd6-0fb6684301e8 Ancestors: EToys-kfr.339 Part of deprecating HTTPClient for 6.0 Stop using it =============== Diff against EToys-kfr.339 =============== Item was changed: ----- Method: ServerDirectory class>>parseEToyUserListFrom: (in category '*eToys-school support') ----- parseEToyUserListFrom: urlString | url userString userList | urlString ifNil:[^nil]. url := urlString asUrl. userString := ["Note: We need to prevent going through the plugin API when retrieving a local (file) URL, since the plugin API (correctly) rejects file:// downloads." Cursor wait showWhile:[ (url hasRemoteContents) ifTrue:[ "Go through the browser (if present)" + (HTTPSocket httpGet: url asString) contents. - (HTTPClient httpGet: url asString) contents. ] ifFalse:[ "Go grab it directly" url retrieveContents contents. ]. ]. ] on: Error do:[nil]. userString ifNil:[^nil]. userList := userString lines collect: [:each| each withBlanksTrimmed]. userList := userList reject:[:any| any isEmpty]. (userList first = '##user list##') ifFalse:[^nil]. userList := userList copyFrom: 2 to: userList size. ^userList!

1 0

The Trunk: Network-tpr.229.mcz
by commits＠source.squeak.org 19 Feb '19

19 Feb '19

tim Rowledge uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tpr.229.mcz ==================== Summary ==================== Name: Network-tpr.229 Author: tpr Time: 18 February 2019, 7:29:14.360439 pm UUID: 9e7bdfe3-6f36-403b-900e-cd3331bc598c Ancestors: Network-pre.228 Part of deprecating HTTPClient for 6.0 Stop using it, deprecate URI classes as well =============== Diff against Network-pre.228 =============== Item was changed: ----- Method: HTTPServerDirectory>>entries (in category 'file directory') ----- entries + | answer ftpEntries | + answer := HTTPSocket httpGetDocument: self dirListUrl. + answer isString + ifTrue: [^self error: 'Listing failed: ' , answer] + ifFalse: [answer := answer content]. + answer first == $< + ifTrue: [self error: 'Listing failed: ' , answer]. + ftpEntries := answer findTokens: String crlf. + ^ ftpEntries + collect:[:ftpEntry | self class parseFTPEntry: ftpEntry] + thenSelect: [:entry | entry notNil]! - ^HTTPClient getDirectoryListing: self dirListUrl! Item was removed: - URI subclass: #HierarchicalURI - instanceVariableNames: 'authority query' - classVariableNames: '' - poolDictionaries: '' - category: 'Network-URI'! Item was removed: - ----- Method: HierarchicalURI>>absoluteFromString:scheme: (in category 'private') ----- - absoluteFromString: aString scheme: schemeName - | remainder | - super absoluteFromString: aString scheme: schemeName. - - "We now have the interesting part in schemeSpecficPart and can parse it further" - - "This check is somewhat redundant, just in case somebody calls this directly." - remainder := schemeSpecificPart. - (remainder isEmpty - or: [remainder first ~~ $/]) - ifTrue: [(IllegalURIException new uriString: remainder) signal: 'Invalid absolute URI']. - - (aString beginsWith: '//') - ifTrue: [remainder := self extractAuthority: (remainder copyFrom: 3 to: remainder size)]. - - self extractSchemeSpecificPartAndFragment: remainder! Item was removed: - ----- Method: HierarchicalURI>>absolutePath (in category 'accessing') ----- - absolutePath - ^self schemeSpecificPart isEmpty - ifTrue: ['/'] - ifFalse: [self schemeSpecificPart]! Item was removed: - ----- Method: HierarchicalURI>>allButScheme (in category 'printing') ----- - allButScheme - "Answer the entire url except its scheme" - - ^String streamContents:[:s| - authority ifNotNil:[self authority printOn: s]. - s nextPutAll: super allButScheme. - query ifNotNil:[s nextPutAll: query]. - ].! Item was removed: - ----- Method: HierarchicalURI>>assureExistance (in category 'directory operations') ----- - assureExistance - ! Item was removed: - ----- Method: HierarchicalURI>>authority (in category 'accessing') ----- - authority - ^authority! Item was removed: - ----- Method: HierarchicalURI>>baseName (in category 'accessing') ----- - baseName - "returns the last component stripped of its extension" - - | baseName i | - baseName := self pathComponents last. - i := baseName findLast: [:c | c = $.]. - ^i = 0 - ifTrue: [baseName] - ifFalse: [baseName copyFrom: 1 to: i-1]. - ! Item was removed: - ----- Method: HierarchicalURI>>buildAbsolutePath: (in category 'private') ----- - buildAbsolutePath: pathComponents - ^String streamContents: [:stream | - stream nextPut: $/. - pathComponents - do: [:pathPart | stream nextPutAll: pathPart] - separatedBy: [stream nextPut: $/]]! Item was removed: - ----- Method: HierarchicalURI>>extension (in category 'accessing') ----- - extension - "This method assumes a $. as extension delimiter" - - | i leafName | - leafName := self pathComponents last. - i := leafName findLast: [:c | c = $.]. - ^i = 0 - ifTrue: [''] - ifFalse: [leafName copyFrom: i + 1 to: leafName size]. - ! Item was removed: - ----- Method: HierarchicalURI>>extractAuthority: (in category 'private') ----- - extractAuthority: aString - | endAuthorityIndex authorityString | - endAuthorityIndex := (aString indexOf: $/ ) - 1. - endAuthorityIndex < 0 - ifTrue: [endAuthorityIndex := aString size]. - authorityString := aString copyFrom: 1 to: endAuthorityIndex. - authority := URIAuthority fromString: authorityString. - ^aString copyFrom: endAuthorityIndex+1 to: aString size! Item was removed: - ----- Method: HierarchicalURI>>extractQuery: (in category 'private') ----- - extractQuery: remainder - | queryIndex | - queryIndex := remainder indexOf: $?. - queryIndex > 0 - ifFalse: [^remainder]. - query := remainder copyFrom: queryIndex to: remainder size. - ^remainder copyFrom: 1 to: queryIndex-1! Item was removed: - ----- Method: HierarchicalURI>>extractSchemeSpecificPartAndFragment: (in category 'private') ----- - extractSchemeSpecificPartAndFragment: remainder - super extractSchemeSpecificPartAndFragment: remainder. - schemeSpecificPart := self extractQuery: schemeSpecificPart! Item was removed: - ----- Method: HierarchicalURI>>host (in category 'accessing') ----- - host - ^self authority host! Item was removed: - ----- Method: HierarchicalURI>>path (in category 'accessing') ----- - path - " ^self schemeSpecificPart isEmpty - ifTrue: ['/'] - ifFalse: [self schemeSpecificPart]" - ^self schemeSpecificPart! Item was removed: - ----- Method: HierarchicalURI>>pathComponents (in category 'accessing') ----- - pathComponents - ^self path findTokens: $/! Item was removed: - ----- Method: HierarchicalURI>>port (in category 'accessing') ----- - port - ^self authority port! Item was removed: - ----- Method: HierarchicalURI>>printSchemeSpecificPartOn: (in category 'printing') ----- - printSchemeSpecificPartOn: stream - self isAbsolute - ifTrue: [stream nextPutAll: '//']. - authority - ifNotNil: [self authority printOn: stream]. - super printSchemeSpecificPartOn: stream. - query - ifNotNil: [stream nextPutAll: query]! Item was removed: - ----- Method: HierarchicalURI>>query (in category 'accessing') ----- - query - ^query! Item was removed: - ----- Method: HierarchicalURI>>relativeFromString: (in category 'private') ----- - relativeFromString: aString - | remainder authorityEnd | - remainder := (aString beginsWith: '//') - ifTrue: [ - authorityEnd := aString indexOf: $/ startingAt: 3. - authorityEnd = 0 - ifTrue: [authorityEnd := aString size+1]. - self extractAuthority: (aString copyFrom: 3 to: authorityEnd-1)] - ifFalse: [aString]. - self extractSchemeSpecificPartAndFragment: remainder! Item was removed: - ----- Method: HierarchicalURI>>removeComponentDotDotPairs: (in category 'private') ----- - removeComponentDotDotPairs: pathComponents - | dotDotIndex | - dotDotIndex := pathComponents indexOf: '..'. - [dotDotIndex > 1] - whileTrue: [ - pathComponents - removeAt: dotDotIndex; - removeAt: dotDotIndex-1. - dotDotIndex := pathComponents indexOf: '..']! Item was removed: - ----- Method: HierarchicalURI>>resolveRelativeURI: (in category 'accessing') ----- - resolveRelativeURI: aURI - | relativeURI newAuthority newPath pathComponents newURI relComps | - relativeURI := aURI asURI. - - relativeURI isAbsolute - ifTrue: [^relativeURI]. - - relativeURI authority - ifNil: [ - newAuthority := self authority. - (relativeURI path beginsWith: '/') - ifTrue: [newPath := relativeURI path] - ifFalse: [ - pathComponents := (self path copyUpToLast: $/) findTokens: $/. - relComps := relativeURI pathComponents. - relComps removeAllSuchThat: [:each | each = '.']. - pathComponents addAll: relComps. - pathComponents removeAllSuchThat: [:each | each = '.']. - self removeComponentDotDotPairs: pathComponents. - newPath := self buildAbsolutePath: pathComponents. - ((relComps isEmpty - or: [relativeURI path last == $/ - or: [(relativeURI path endsWith: '/..') - or: [relativeURI path = '..' - or: [relativeURI path endsWith: '/.' ]]]]) - and: [newPath size > 1]) - ifTrue: [newPath := newPath , '/']]] - ifNotNil: [ - newAuthority := relativeURI authority. - newPath := relativeURI path]. - - newURI := String streamContents: [:stream | - stream nextPutAll: self scheme. - stream nextPut: $: . - newAuthority notNil - ifTrue: [ - stream nextPutAll: '//'. - newAuthority printOn: stream]. - newPath notNil - ifTrue: [stream nextPutAll: newPath]. - relativeURI query notNil - ifTrue: [stream nextPutAll: relativeURI query]. - relativeURI fragment notNil - ifTrue: [ - stream nextPut: $# . - stream nextPutAll: relativeURI fragment]]. - ^newURI asURI! Item was removed: - ----- Method: HierarchicalURI>>userInfo (in category 'accessing') ----- - userInfo - ^self authority userInfo! Item was removed: - URI subclass: #OpaqueURI - instanceVariableNames: '' - classVariableNames: '' - poolDictionaries: '' - category: 'Network-URI'! Item was removed: - ----- Method: OpaqueURI>>isOpaque (in category 'testing') ----- - isOpaque - ^true! Item was changed: ----- Method: PRServerDirectory>>getLines (in category 'private') ----- getLines "private - answer a collection of lines with the server response" | url lines string | url := self urlFromServer: self server directories: {'programmatic'} , self directories. url := url , self slash. + string := Cursor read + showWhile: [(HTTPSocket httpGetDocument: url) contents]. - "" - string := Cursor read showWhile: [ - (HTTPClient httpGetDocument: url) contents]. (string beginsWith: '--OK--') ifFalse: [^ nil]. - "" lines := OrderedCollection new. (string allButFirst: 6) linesDo: [:line | lines add: line squeakToIso]. + - "" ^ lines! Item was changed: ----- Method: PRServerDirectory>>writeProject:inFileNamed:fromDirectory: (in category 'squeaklets') ----- writeProject: aProject inFileNamed: fileNameString fromDirectory: localDirectory "write aProject (a file version can be found in the file named fileNameString in localDirectory)" | url arguments string | url := self urlFromServer: self server directories: {'programmatic'. 'uploadproject'}. arguments := self getPostArgsFromProject: aProject fileNamed: fileNameString fromDirectory: localDirectory. + - "" string := Cursor read showWhile: [ + (HTTPSocket httpPostDocument: url args: arguments) contents]. - (HTTPClient httpPostDocument: url args: arguments) contents - "(HTTPSocket httpGetDocument: url args: arguments) contents."]. (string beginsWith: '--OK--') ifTrue: [^ true]. + + self inform: ('Server responded: {1}' translated format: {string}). - "" - self - inform: ('Server responded: {1}' translated format: {string}). ^ false! Item was changed: ----- Method: ProtocolClient class>>openOnHostNamed:port: (in category 'instance creation') ----- openOnHostNamed: hostName port: portNumber | serverIP | serverIP := NetNameResolver addressForName: hostName timeout: 20. + serverIP ifNil:[ ^ nil]. + ^ (self openOnHost: serverIP port: portNumber) hostName: hostName; yourself ! Item was changed: ----- Method: ServerDirectory>>openFTPClient (in category 'dis/connect') ----- openFTPClient | loginSuccessful | client ifNotNil: [client isConnected ifTrue: [^client] ifFalse: [client := nil]]. client := FTPClient openOnHostNamed: server. + client ifNil: [^nil]. loginSuccessful := false. [loginSuccessful] whileFalse: [ [loginSuccessful := true. client loginUser: self user password: self password] on: LoginFailedException do: [:ex | | what | passwordHolder := nil. what := UIManager default chooseFrom: #('enter password' 'give up') title: 'Would you like to try another password?'. what = 1 ifFalse: [ ^nil]. loginSuccessful := false]]. client changeDirectoryTo: directory. ^client! Item was removed: - Object subclass: #URI - instanceVariableNames: 'fragment scheme schemeSpecificPart' - classVariableNames: 'ClientClasses' - poolDictionaries: '' - category: 'Network-URI'! - - !URI commentStamp: 'mir 2/20/2002 15:17' prior: 0! - A Uniform Resource Identifier (URI) is a compact string of characters for identifying an abstract or physical resource. - This implementation is based on http://www.ietf.org/rfc/rfc2396.txt. - - ! Item was removed: - ----- Method: URI class>>absoluteFromString:scheme: (in category 'instance creation') ----- - absoluteFromString: aString scheme: scheme - | remainder | - remainder := aString copyFrom: scheme size+2 to: aString size. - remainder isEmpty - ifTrue: [(IllegalURIException new uriString: aString) signal: 'Invalid absolute URI']. - ^(remainder first = $/ - ifTrue: [HierarchicalURI] - ifFalse: [OpaqueURI]) new absoluteFromString: remainder scheme: scheme! Item was removed: - ----- Method: URI class>>extractSchemeFrom: (in category 'instance creation') ----- - extractSchemeFrom: aString - | colonIndex slashIndex | - colonIndex := aString indexOf: $: . - ^colonIndex > 0 - ifTrue: [ - slashIndex := aString indexOf: $/ . - (slashIndex = 0 - or: [colonIndex < slashIndex]) - ifTrue: [aString copyFrom: 1 to: colonIndex-1] - ifFalse: [nil]] - ifFalse: [nil]! Item was removed: - ----- Method: URI class>>fromString: (in category 'instance creation') ----- - fromString: aString - | parseString scheme | - parseString := aString withBlanksTrimmed. - scheme := self extractSchemeFrom: parseString. - ^scheme - ifNil: [HierarchicalURI new relativeFromString: aString] - ifNotNil: [self absoluteFromString: aString scheme: scheme] - ! Item was removed: - ----- Method: URI class>>initialize (in category 'class initialization') ----- - initialize - "URI initialize" - - ClientClasses := Dictionary new. - ClientClasses - at: 'http' put: #HTTPClient; - at: 'ftp' put: #FTPClient; - at: 'file' put: #FileDirectory - ! Item was removed: - ----- Method: URI>>= (in category 'testing') ----- - = otherURI - ^ self class = otherURI class - and: [self asString = otherURI asString]! Item was removed: - ----- Method: URI>>absoluteFromString:scheme: (in category 'private') ----- - absoluteFromString: remainder scheme: schemeName - scheme := schemeName. - self extractSchemeSpecificPartAndFragment: remainder! Item was removed: - ----- Method: URI>>allButScheme (in category 'printing') ----- - allButScheme - "Answer the entire url except its scheme" - - ^String streamContents:[:s| - s nextPutAll: schemeSpecificPart. - fragment ifNotNil: [ - s nextPut: $# . - s nextPutAll: self fragment] - ].! Item was removed: - ----- Method: URI>>asText (in category 'converting') ----- - asText - ^self asString asText! Item was removed: - ----- Method: URI>>asURI (in category 'converting') ----- - asURI - ^self! Item was removed: - ----- Method: URI>>asUrl (in category 'converting') ----- - asUrl - - ^self asString asUrl! Item was removed: - ----- Method: URI>>clientClass (in category 'private') ----- - clientClass - ^Smalltalk at: (ClientClasses at: self scheme ifAbsent: [ClientClasses at: 'file'])! Item was removed: - ----- Method: URI>>contentStream (in category 'retrieval') ----- - contentStream - ^self clientClass contentStreamForURI: self! Item was removed: - ----- Method: URI>>downloadUrl (in category 'converting') ----- - downloadUrl - self halt! Item was removed: - ----- Method: URI>>extractSchemeSpecificPartAndFragment: (in category 'private') ----- - extractSchemeSpecificPartAndFragment: remainder - | fragmentIndex | - fragmentIndex := remainder indexOf: $# . - fragmentIndex > 0 - ifTrue: [ - schemeSpecificPart := remainder copyFrom: 1 to: fragmentIndex-1. - fragment := remainder copyFrom: fragmentIndex+1 to: remainder size] - ifFalse: [schemeSpecificPart := remainder]! Item was removed: - ----- Method: URI>>fragment (in category 'accessing') ----- - fragment - ^fragment! Item was removed: - ----- Method: URI>>hasRemoteContents (in category 'testing') ----- - hasRemoteContents - self halt! Item was removed: - ----- Method: URI>>hash (in category 'testing') ----- - hash - ^ self asString hash! Item was removed: - ----- Method: URI>>isAbsolute (in category 'testing') ----- - isAbsolute - ^self scheme notNil! Item was removed: - ----- Method: URI>>isOpaque (in category 'testing') ----- - isOpaque - ^false! Item was removed: - ----- Method: URI>>isRelative (in category 'testing') ----- - isRelative - ^self isAbsolute not! Item was removed: - ----- Method: URI>>printOn: (in category 'printing') ----- - printOn: stream - self isAbsolute - ifTrue: [ - stream nextPutAll: self scheme. - stream nextPut: $: ]. - self printSchemeSpecificPartOn: stream. - fragment - ifNotNil: [ - stream nextPut: $# . - stream nextPutAll: self fragment] - ! Item was removed: - ----- Method: URI>>printSchemeSpecificPartOn: (in category 'printing') ----- - printSchemeSpecificPartOn: stream - stream nextPutAll: self schemeSpecificPart! Item was removed: - ----- Method: URI>>resolveRelativeURI: (in category 'accessing') ----- - resolveRelativeURI: relativeURI - self shouldNotImplement! Item was removed: - ----- Method: URI>>retrieveContentStream (in category 'retrieval') ----- - retrieveContentStream - ^self retrieveMIMEDocument contentStream! Item was removed: - ----- Method: URI>>retrieveContents (in category 'retrieval') ----- - retrieveContents - ^self retrieveMIMEDocument contents! Item was removed: - ----- Method: URI>>retrieveMIMEDocument (in category 'retrieval') ----- - retrieveMIMEDocument - ^self clientClass retrieveMIMEDocument: self! Item was removed: - ----- Method: URI>>scheme (in category 'accessing') ----- - scheme - ^scheme! Item was removed: - ----- Method: URI>>schemeSpecificPart (in category 'private') ----- - schemeSpecificPart - ^schemeSpecificPart!

1 0

The Trunk: System-tpr.1055.mcz
by commits＠source.squeak.org 19 Feb '19

19 Feb '19

tim Rowledge uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-tpr.1055.mcz ==================== Summary ==================== Name: System-tpr.1055 Author: tpr Time: 18 February 2019, 7:27:45.328716 pm UUID: e5a22b14-e481-4ca2-bb73-06c231538511 Ancestors: System-tonyg.1054 Part of deprecating HTTPClient for 6.0 Stop using it and deprecate the actual class =============== Diff against System-tonyg.1054 =============== Item was removed: - ----- Method: AutoStart class>>checkForPluginUpdate (in category 'updating') ----- - checkForPluginUpdate - | pluginVersion updateURL | - HTTPClient isRunningInBrowser - ifFalse: [^false]. - pluginVersion := Smalltalk namedArguments - at: (Smalltalk platformName copyWithout: Character space) asUppercase - ifAbsent: [^false]. - updateURL := Smalltalk namedArguments - at: 'UPDATE_URL' - ifAbsent: [^false]. - ^SystemVersion check: pluginVersion andRequestPluginUpdate: updateURL! Item was changed: ----- Method: AutoStart class>>processUpdates (in category 'updating') ----- processUpdates "Process update files from a well-known update server. This method is called at system startup time, Only if the preference #updateFromServerAtStartup is true is the actual update processing undertaken automatically" | choice | (MCMcmUpdater updateFromServerAtStartup) ifTrue: [choice := UIManager default chooseFrom: #('Yes, Update' 'No, Not now' 'Don''t ask again') title: 'Shall I look for new code\updates on the server?' withCRs. choice = 1 ifTrue: [ MCMcmUpdater updateFromServer]. choice = 3 ifTrue: [ MCMcmUpdater updateFromServerAtStartup: false. + self inform: 'Remember to save your image to make this setting permant']]! - self inform: 'Remember to save your image to make this setting permant.']]. - ^false! Item was changed: ----- Method: AutoStart class>>startUp: (in category 'initialization') ----- startUp: resuming "The image is either being newly started (resuming is true), or it's just been snapshotted. If this has just been a snapshot, skip all the startup stuff." | startupParameters launchers | self active ifTrue: [^self]. self active: true. resuming ifFalse: [^self]. - HTTPClient determineIfRunningInBrowser. startupParameters := Smalltalk namedArguments. - (startupParameters includesKey: 'apiSupported' asUppercase ) - ifTrue: [ - HTTPClient browserSupportsAPI: ((startupParameters at: 'apiSupported' asUppercase) asUppercase = 'TRUE'). - HTTPClient isRunningInBrowser - ifFalse: [HTTPClient isRunningInBrowser: true]]. Project current world ifNotNil: [:w | w install. w firstHand position: 100 @ 100 ]. + self processUpdates. + - "Some images might not have the UpdateStream package." - ((self respondsTo: #checkForUpdates) and: [self checkForUpdates]) ifTrue: [^self]. - self checkForPluginUpdate. launchers := self installedLaunchers collect: [:launcher | launcher new]. launchers do: [:launcher | launcher parameters: startupParameters]. launchers do: [:launcher | Project current addDeferredUIMessage: [launcher startUp]]! Item was removed: - Object subclass: #HTTPClient - instanceVariableNames: '' - classVariableNames: 'BrowserSupportsAPI RunningInBrowser' - poolDictionaries: '' - category: 'System-Support'! Item was removed: - ----- Method: HTTPClient class>>browserSupportsAPI (in category 'class initialization') ----- - browserSupportsAPI - ^BrowserSupportsAPI == true! Item was removed: - ----- Method: HTTPClient class>>browserSupportsAPI: (in category 'class initialization') ----- - browserSupportsAPI: aBoolean - BrowserSupportsAPI := aBoolean! Item was removed: - ----- Method: HTTPClient class>>composeMailTo:subject:body: (in category 'utilities') ----- - composeMailTo: address subject: subject body: body - "HTTPClient composeMailTo: 'michael.rueger(a)squeakland.org' subject: 'test subject' body: 'message' " - | mailTo | - mailTo := WriteStream on: String new. - mailTo nextPutAll: 'mailto:'. - mailTo - nextPutAll: address; - nextPut: $?. - subject isEmptyOrNil - ifFalse: [mailTo nextPutAll: 'subject='; nextPutAll: subject; nextPut: $&]. - body isEmptyOrNil - ifFalse: [mailTo nextPutAll: 'body='; nextPutAll: body]. - - self httpGet: mailTo contents! Item was removed: - ----- Method: HTTPClient class>>determineIfRunningInBrowser (in category 'class initialization') ----- - determineIfRunningInBrowser - "HTTPClient determineIfRunningInBrowser" - - RunningInBrowser := StandardFileStream isRunningAsBrowserPlugin - ! Item was removed: - ----- Method: HTTPClient class>>exampleMailTo (in category 'examples') ----- - exampleMailTo - "HTTPClient exampleMailTo" - - HTTPClient mailTo: 'm.rueger(a)acm.org' message: 'A test message from within Squeak' - ! Item was removed: - ----- Method: HTTPClient class>>examplePostArgs (in category 'examples') ----- - examplePostArgs - "HTTPClient examplePostArgs" - - | args result | - args := Dictionary new - at: 'arg1' put: #('val1'); - at: 'arg2' put: #('val2'); - yourself. - result := HTTPClient httpPostDocument: 'http://www.squeaklet.com/cgi-bin/thrd.pl [^]' args: args. - Transcript show: result content; cr; cr. - - ! Item was removed: - ----- Method: HTTPClient class>>examplePostMultipart (in category 'examples') ----- - examplePostMultipart - "HTTPClient examplePostMultipart" - - | args result | - args := Dictionary new - at: 'arg1' put: #('val1'); - at: 'arg2' put: #('val2'); - yourself. - result := HTTPClient httpPostMultipart: 'http://www.squeaklet.com/cgi-bin/thrd.pl' args: args. - Transcript show: result content; cr; cr. - - ! Item was removed: - ----- Method: HTTPClient class>>getDirectoryListing: (in category 'utilities') ----- - getDirectoryListing: dirListURL - "HTTPClient getDirectoryListing: 'http://www.squeakalpha.org/uploads' " - | answer ftpEntries | - " answer := self - httpPostDocument: dirListURL - args: Dictionary new." - "Workaround for Mac IE problem" - answer := self httpGetDocument: dirListURL. - answer isString - ifTrue: [^self error: 'Listing failed: ' , answer] - ifFalse: [answer := answer content]. - answer first == $< - ifTrue: [self error: 'Listing failed: ' , answer]. - ftpEntries := answer findTokens: String crlf. - ^ ftpEntries - collect:[:ftpEntry | ServerDirectory parseFTPEntry: ftpEntry] - thenSelect: [:entry | entry notNil]! Item was removed: - ----- Method: HTTPClient class>>httpGet: (in category 'post/get') ----- - httpGet: url - | document | - document := self httpGetDocument: url. - ^(document isString) - ifTrue: [ - "strings indicate errors" - document] - ifFalse: [(RWBinaryOrTextStream with: document content) reset]! Item was removed: - ----- Method: HTTPClient class>>httpGetDocument: (in category 'post/get') ----- - httpGetDocument: url - | stream content | - ^self shouldUsePluginAPI - ifTrue: [ - stream := FileStream requestURLStream: url ifError: [self error: 'Error in get from ' , url printString]. - stream ifNil: [^'']. - stream position: 0. - content := stream upToEnd. - stream close. - MIMEDocument content: content] - ifFalse: [HTTPSocket httpGetDocument: url]! Item was removed: - ----- Method: HTTPClient class>>httpPostDocument:args: (in category 'post/get') ----- - httpPostDocument: url args: argsDict - ^self httpPostDocument: url target: nil args: argsDict! Item was removed: - ----- Method: HTTPClient class>>httpPostDocument:target:args: (in category 'post/get') ----- - httpPostDocument: url target: target args: argsDict - | argString stream content | - ^self shouldUsePluginAPI - ifTrue: [ - argString := argsDict - ifNotNil: [argString := HTTPSocket argString: argsDict] - ifNil: ['']. - stream := FileStream post: argString , ' ' target: target url: url , argString ifError: [self error: 'Error in post to ' , url printString]. - stream position: 0. - content := stream upToEnd. - stream close. - MIMEDocument content: content] - ifFalse: [HTTPSocket httpPostDocument: url args: argsDict]! Item was removed: - ----- Method: HTTPClient class>>httpPostMultipart:args: (in category 'post/get') ----- - httpPostMultipart: url args: argsDict - " do multipart/form-data encoding rather than x-www-urlencoded " - - ^self shouldUsePluginAPI - ifTrue: [self pluginHttpPostMultipart: url args: argsDict] - ifFalse: [HTTPSocket httpPostMultipart: url args: argsDict accept: nil request: '']! Item was removed: - ----- Method: HTTPClient class>>isRunningInBrowser (in category 'testing') ----- - isRunningInBrowser - - RunningInBrowser isNil - ifTrue: [self determineIfRunningInBrowser]. - ^RunningInBrowser! Item was removed: - ----- Method: HTTPClient class>>isRunningInBrowser: (in category 'testing') ----- - isRunningInBrowser: aBoolean - "Override the automatic process. - This should be used with caution. - One way to determine it without using the primitive is to check for parameters typically only encountered when running as a plugin." - - RunningInBrowser := aBoolean! Item was removed: - ----- Method: HTTPClient class>>mailTo:message: (in category 'utilities') ----- - mailTo: address message: aString - HTTPClient shouldUsePluginAPI - ifFalse: [^self error: 'You need to run inside a web browser.']. - FileStream post: aString url: 'mailto:' , address ifError: [self error: 'Can not send mail']! Item was removed: - ----- Method: HTTPClient class>>pluginHttpPostMultipart:args: (in category 'private') ----- - pluginHttpPostMultipart: url args: argsDict - | mimeBorder argsStream crLf resultStream result | - " do multipart/form-data encoding rather than x-www-urlencoded " - - crLf := String crlf. - mimeBorder := '----squeak-', Time millisecondClockValue printString, '-stuff-----'. - "encode the arguments dictionary" - argsStream := WriteStream on: String new. - argsDict associationsDo: [:assoc | - assoc value do: [ :value | | fieldValue | - "print the boundary" - argsStream nextPutAll: '--', mimeBorder, crLf. - " check if it's a non-text field " - argsStream nextPutAll: 'Content-disposition: form-data; name="', assoc key, '"'. - (value isKindOf: MIMEDocument) - ifFalse: [fieldValue := value] - ifTrue: [argsStream nextPutAll: ' filename="', value url pathForFile, '"', crLf, 'Content-Type: ', value contentType. - fieldValue := (value content - ifNil: [(FileStream fileNamed: value url pathForFile) contentsOfEntireFile] - ifNotNil: [value content]) asString]. - " Transcript show: 'field=', key, '; value=', fieldValue; cr. " - argsStream nextPutAll: crLf, crLf, fieldValue, crLf. - ]]. - argsStream nextPutAll: '--', mimeBorder, '--'. - resultStream := FileStream - post: - ('ACCEPT: text/html', crLf, - 'User-Agent: Squeak 3.1', crLf, - 'Content-type: multipart/form-data; boundary=', mimeBorder, crLf, - 'Content-length: ', argsStream contents size printString, crLf, crLf, - argsStream contents) - url: url ifError: [^'Error in post ' url asString]. - "get the header of the reply" - result := resultStream - ifNil: [''] - ifNotNil: [resultStream upToEnd]. - ^MIMEDocument content: result! Item was removed: - ----- Method: HTTPClient class>>requestURL:target: (in category 'post/get') ----- - requestURL: url target: target - ^self shouldUsePluginAPI - ifTrue: [FileStream requestURL: url target: target] - ifFalse: [self error: 'Requesting a new URL target is not supported.']! Item was removed: - ----- Method: HTTPClient class>>shouldUsePluginAPI (in category 'testing') ----- - shouldUsePluginAPI - "HTTPClient shouldUsePluginAPI" - - self isRunningInBrowser - ifFalse: [^false]. - self browserSupportsAPI - ifFalse: [^false]. - "The Mac plugin calls do not work in full screen mode" - ^((Smalltalk platformName = 'Mac OS') - and: [DisplayScreen displayIsFullScreen]) not! Item was removed: - ----- Method: HTTPClient class>>uploadFileNamed:to:user:passwd: (in category 'utilities') ----- - uploadFileNamed: aFilename to: baseUrl user: user passwd: passwd - - | fileContents remoteFilename | - remoteFilename := (baseUrl endsWith: '/') - ifTrue: [baseUrl , '/' , aFilename] - ifFalse: [baseUrl , aFilename]. - fileContents := (StandardFileStream readOnlyFileNamed: aFilename) contentsOfEntireFile. - HTTPSocket httpPut: fileContents to: remoteFilename user: user passwd: passwd! Item was changed: ----- Method: HTTPLoader class>>httpRequestClass (in category 'accessing') ----- httpRequestClass + ^HTTPDownloadRequest! - ^HTTPClient shouldUsePluginAPI - ifTrue: [PluginHTTPDownloadRequest] - ifFalse: [HTTPDownloadRequest]! Item was changed: ----- Method: Project>>tellAFriend: (in category 'SuperSwiki') ----- + tellAFriend: emailAddressOrNil + " + Project current tellAFrien + " - tellAFriend: emailAddressOrNil | urlForLoading | + (urlForLoading := self urlForLoading) + ifNil: [urlForLoading := self url + "fallback for dtp servers"]. + urlForLoading isEmptyOrNil + ifTrue: [^ self inform: 'Since this project has not been saved yet, + I cannot tell someone where it is.' translated]. + FancyMailComposition new + celeste: nil + to: (emailAddressOrNil + ifNil: ['RECIPIENT.GOESHERE']) + subject: 'New/Updated Squeak project' + initialText: 'This is a link to the Squeak project ' , self name , ': ' , String crlf + theLinkToInclude: urlForLoading; + open! - " - Project current tellAFriend - " - - (urlForLoading := self urlForLoading) ifNil: [ - urlForLoading := self url "fallback for dtp servers" - ]. - urlForLoading isEmptyOrNil ifTrue: [ - ^self inform: 'Since this project has not been saved yet, - I cannot tell someone where it is.' translated - ]. - HTTPClient tellAFriend: emailAddressOrNil url: urlForLoading name: self name! Item was changed: ----- Method: ProjectLauncher>>initialize (in category 'initialization') ----- initialize super initialize. + showSplash := true! - showSplash := true. - HTTPClient isRunningInBrowser - ifTrue: [whichFlaps := 'etoy']! Item was changed: ----- Method: ProjectLauncher>>startUpAfterLogin (in category 'running') ----- startUpAfterLogin | scriptName loader isUrl | self setupFlaps. + Preferences readDocumentAtStartup + ifTrue: [scriptName := Smalltalk documentPath + ifNil: ['']. - Preferences readDocumentAtStartup ifTrue: [ - HTTPClient isRunningInBrowser ifTrue:[ - self setupFromParameters. - scriptName := self parameterAt: 'src'. - CodeLoader defaultBaseURL: (self parameterAt: 'Base'). - ] ifFalse:[ - scriptName := (Smalltalk documentPath) ifNil:['']. scriptName := scriptName convertFromSystemString. + scriptName isEmpty + ifFalse: ["figure out if script name is a URL by itself" + isUrl := (scriptName asLowercase beginsWith: 'http://') + or: [(scriptName asLowercase beginsWith: 'file://') + or: [scriptName asLowercase beginsWith: 'ftp://']]. + isUrl + ifFalse: [| encodedPath pathTokens | + "Allow for ../dir/scriptName arguments" + pathTokens := scriptName splitBy: FileDirectory slash. + pathTokens := pathTokens + collect: [:s | s encodeForHTTP]. + encodedPath := pathTokens + reduce: [:acc :each | acc , FileDirectory slash , each]. + scriptName := (FileDirectory default uri resolveRelativeURI: encodedPath) asString]]] + ifFalse: [scriptName := '']. - scriptName isEmpty ifFalse:[ - "figure out if script name is a URL by itself" - isUrl := (scriptName asLowercase beginsWith:'http://') or:[ - (scriptName asLowercase beginsWith:'file://') or:[ - (scriptName asLowercase beginsWith:'ftp://')]]. - isUrl ifFalse:[ | encodedPath pathTokens | - "Allow for ../dir/scriptName arguments" - pathTokens := scriptName splitBy: FileDirectory slash. - pathTokens := pathTokens collect: [:s | s encodeForHTTP]. - encodedPath := pathTokens reduce: [:acc :each | acc , FileDirectory slash , each]. - scriptName := (FileDirectory default uri - resolveRelativeURI: encodedPath) asString]]. - ]. ] - ifFalse: [ scriptName := '' ]. - scriptName isEmptyOrNil + ifTrue: [^ Preferences eToyFriendly + ifTrue: [self currentWorld addGlobalFlaps]]. - ifTrue:[^Preferences eToyFriendly ifTrue: [self currentWorld addGlobalFlaps]]. loader := CodeLoader new. + loader + loadSourceFiles: (Array with: scriptName). + (scriptName asLowercase endsWith: '.pr') + ifTrue: [self installProjectFrom: loader] + ifFalse: [loader installSourceFiles]! - loader loadSourceFiles: (Array with: scriptName). - (scriptName asLowercase endsWith: '.pr') - ifTrue:[self installProjectFrom: loader] - ifFalse:[loader installSourceFiles]. - ! Item was changed: ----- Method: ResourceCollector>>writeResourceForm:fromLocator: (in category 'resource writing') ----- writeResourceForm: aForm fromLocator: aLocator "The given form has been externalized before. If it was reasonably compressed, use the bits of the original data - this allows us to recycle GIF, JPEG, PNG etc. data without using the internal compression (which is in most cases inferior). If necessary the data will be retrieved from its URL location. This retrieval is done only if the resouce comes from either * the local disk (in which case the file has never been published) * the browser cache (in which case we don't cache the resource locally) In any other case we will *not* attempt to retrieve it, because doing so can cause the system to connect to the network which is probably not what we want. It should be a rare case anyways; could only happen if one clears the squeak cache selectively." | fName fStream url data | "Try to be smart about the name of the file" fName := (aLocator urlString includes: $:) ifTrue: [ url := aLocator urlString asUrl. url path last] ifFalse: [aLocator urlString]. fName isEmptyOrNil ifFalse:[fName := fName asFileName]. (fName isEmptyOrNil or:[localDirectory isAFileNamed: fName]) ifTrue:[ "bad luck -- duplicate name" fName := localDirectory nextNameFor:'resource' extension: (FileDirectory extensionFor: aLocator urlString)]. "Let's see if we have cached it locally" ResourceManager lookupCachedResource: self baseUrl , aLocator urlString ifPresentDo:[:stream | data := stream upToEnd]. "Check if the cache entry is without qualifying baseUrl. Workaround for older versions." data ifNil:[ ResourceManager lookupCachedResource: aLocator urlString ifPresentDo:[:stream | data := stream upToEnd]]. data ifNil:[ "We don't have it cached locally. Retrieve it from its original location." + (url notNil and: [url hasRemoteContents]) - ((url notNil and: [url hasRemoteContents]) and:[HTTPClient isRunningInBrowser not]) ifTrue:[^nil]. "see note above" (Url schemeNameForString: aLocator urlString) ifNil: [^nil]. data := HTTPLoader default retrieveContentsFor: aLocator urlString. data ifNil:[^nil]. data := data content. ]. "data size > aForm bits byteSize ifTrue:[^nil]." fStream := localDirectory newFileNamed: fName. fStream binary. fStream nextPutAll: data. fStream close. ^{fName. data size}! Item was changed: ----- Method: ResourceManager class>>cacheResource:stream: (in category 'resource caching') ----- cacheResource: urlString stream: aStream | fd localName file buf | + - HTTPClient shouldUsePluginAPI ifTrue:[^self]. "use browser cache" (self resourceCache at: urlString ifAbsent:[#()]) size > 0 ifTrue:[^self]. "don't waste space" fd := Project squeakletDirectory. localName := fd nextNameFor: 'resource' extension:'cache'. file := fd forceNewFileNamed: localName. buf := ByteArray new: 10000. aStream binary. file binary. [aStream atEnd] whileFalse:[ buf := aStream next: buf size into: buf. file nextPutAll: buf. ]. file close. "update cache" file := [fd oldFileNamed: self resourceCacheName] on: FileDoesNotExistException do:[:ex| fd forceNewFileNamed: self resourceCacheName]. file setToEnd. file nextPutAll: urlString; cr. file nextPutAll: localName; cr. file close. self addCacheLocation: localName for: urlString. aStream position: 0. ! Item was removed: - ----- Method: SystemVersion class>>check:andRequestPluginUpdate: (in category 'updating') ----- - check: pluginVersion andRequestPluginUpdate: updateURL - "SystemVersion check: 'zzz' andRequestPluginUpdate: 'http://www.squeakland.org/installers/update.html' " - - "We don't have a decent versioning scheme yet, so we are basically checking for a nil VM version on the mac." - (self pluginVersion: pluginVersion newerThan: self currentPluginVersion) - ifFalse: [^true]. - (self confirm: 'There is a newer plugin version available. Do you want to install it now?') - ifFalse: [^false]. - HTTPClient - requestURL: updateURL , (Smalltalk platformName copyWithout: Character space) asLowercase , '.html' - target: '_top'. - ^false!

1 0

The Trunk: UpdateStream-tpr.11.mcz
by commits＠source.squeak.org 19 Feb '19

19 Feb '19

tim Rowledge uploaded a new version of UpdateStream to project The Trunk: http://source.squeak.org/trunk/UpdateStream-tpr.11.mcz ==================== Summary ==================== Name: UpdateStream-tpr.11 Author: tpr Time: 18 February 2019, 7:25:41.894118 pm UUID: 00e59d34-daaf-40f8-b4ee-306f21613bfc Ancestors: UpdateStream-ul.10 Part of deprecating HTTPClient for 6.0 Stop using it =============== Diff against UpdateStream-ul.10 =============== Item was removed: - ----- Method: AutoStart class>>checkForUpdates (in category '*UpdateStream') ----- - checkForUpdates - | availableUpdate updateServer | - HTTPClient isRunningInBrowser ifFalse: [ ^ self processUpdates ]. - availableUpdate := (Smalltalk namedArguments - at: 'UPDATE' - ifAbsent: [ '' ]) asInteger. - availableUpdate ifNil: [ ^ false ]. - updateServer := Smalltalk namedArguments - at: 'UPDATESERVER' - ifAbsent: - [ Smalltalk namedArguments - at: 'UPDATE_SERVER' - ifAbsent: [ 'Squeakland' ] ]. - UpdateStreamDownloader default setUpdateServer: updateServer. - ^ SystemVersion checkAndApplyUpdates: availableUpdate! Item was changed: ----- Method: UpdateStreamDownloader class>>newUpdatesOn:special:throughNumber: (in category 'fetching updates') ----- newUpdatesOn: serverList special: indexPrefix throughNumber: aNumber "Return a list of fully formed URLs of update files we do not yet have. Go to the listed servers and look at the file 'updates.list' for the names of the last N update files. We look backwards for the first one we have, and make the list from there. tk 9/10/97 No updates numbered higher than aNumber (if it is not nil) are returned " | existing out maxNumber | maxNumber := aNumber ifNil: [99999]. out := OrderedCollection new. existing := SystemVersion current updates. serverList do: [:server | | raw doc list char | + doc := HTTPSocket httpGet: 'http://' , server,indexPrefix,'updates.list'. - doc := HTTPClient httpGet: 'http://' , server,indexPrefix,'updates.list'. "test here for server being up" doc class == RWBinaryOrTextStream ifTrue: [raw := doc reset; contents. "one file name per line" list := self extractThisVersion: raw. list reverseDo: [:fileName | | ff itsNumber | ff := (fileName findTokens: '/') last. "allow subdirectories" itsNumber := ff initialIntegerOrNil. (existing includes: itsNumber) ifFalse: [ (itsNumber == nil or: [itsNumber <= maxNumber]) ifTrue: [out addFirst: 'http://' , server, fileName]] ifTrue: [^ out]]. ((out size > 0) or: [char := doc reset; skipSeparators; next. (char == $*) | (char == $#)]) ifTrue: [^ out "we have our list"]]. "else got error msg instead of file" "Server was down, try next one"]. self inform: 'All code update servers seem to be unavailable'. ^ out! Item was changed: ----- Method: UpdateStreamDownloader class>>retrieveUrls:ontoQueue:withWaitSema: (in category 'fetching updates') ----- 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" | updateCounter | UpdateDownloader ifNotNil: [UpdateDownloader terminate]. updateCounter := 0. "fork a new downloading process" UpdateDownloader := [ 'Downloading updates' displayProgressFrom: 0 to: urls size during: [:bar | urls do: [:url | | front canPeek doc | waitSema wait. queue nextPut: url. + doc := HTTPSocket httpGet: 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: '<!!DOCTYPE') ifTrue: [ (front includesSubstring: 'Not Found') ifTrue: [ queue nextPut: #failed. UpdateDownloader := nil. Processor activeProcess terminate]]]. UpdateDownloader ifNotNil: [queue nextPut: doc. updateCounter := updateCounter + 1. bar value: updateCounter]]]. queue nextPut: ''. queue nextPut: #finished. UpdateDownloader := nil] newProcess. UpdateDownloader priority: Processor userInterruptPriority. "start the process running" UpdateDownloader resume!

1 0

The Trunk: Collections-dtl.821.mcz
by commits＠source.squeak.org 17 Feb '19

17 Feb '19

David T. Lewis uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-dtl.821.mcz ==================== Summary ==================== Name: Collections-dtl.821 Author: dtl Time: 16 February 2019, 6:18:27.925895 pm UUID: 9bfa29b3-5e9f-4c61-b19b-e0bb05403589 Ancestors: Collections-nice.820 Classes are expected to be unique in the system, but in some cases (e.g. Magma) it is also useful to expect a proxy for a class to test equivalent to the actual class. Therefore, in SequenceableCollection>>= use #= rather than #== for the class comparison. =============== Diff against Collections-nice.820 =============== Item was changed: ----- Method: SequenceableCollection>>= (in category 'comparing') ----- = otherCollection "Answer true if the receiver is equivalent to the otherCollection. First test for identity, then rule out different class and sizes of collections. As a last resort, examine each element of the receiver and the otherCollection." self == otherCollection ifTrue: [^ true]. + self class = otherCollection class ifFalse: [^ false]. - self class == otherCollection class ifFalse: [^ false]. ^ self hasEqualElements: otherCollection!

1 0

The Trunk: Monticello-nice.695.mcz
by commits＠source.squeak.org 14 Feb '19

14 Feb '19

Nicolas Cellier uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-nice.695.mcz ==================== Summary ==================== Name: Monticello-nice.695 Author: nice Time: 14 February 2019, 1:46:52.89164 pm UUID: 1933b192-0ab2-bc46-af47-b06f031516b9 Ancestors: Monticello-nice.694 Add a utility for finding last merge of two versions. A use case: | mcw allBF540 | mcw := (MCPackage named: 'Monticello') workingCopy ancestry. allBF540 := (mcw allAncestors select: [:e | e versionName = 'Monticello-bf.540' ]) asArray. ^mcw lastMergeOf: allBF540 first and: allBF540 last. Note: implementation is sub-optimal but just works =============== Diff against Monticello-nice.694 =============== Item was added: + ----- Method: MCAncestry>>lastMergeOf:and: (in category 'progeny') ----- + lastMergeOf: aNode and: anotherNode + "Find the last merge of two Nodes starting from myself. + Answer nil if there is none. + Note: there might have been several merges, in which case we take the common merge of merges. + Example: if c is a merge of a and b, d is also a merge of a and b, and e is a merge of c and d, then asnwer e." + + | common | + (self hasAncestor: aNode) ifFalse: [^nil]. + (self hasAncestor: anotherNode) ifFalse: [^nil]. + common := ancestors collect: [:e | e lastMergeOf: aNode and: anotherNode] as: Set. + common remove: nil ifAbsent: []. + common size = 1 ifTrue: [^common anyOne]. + ^self + !

1 0

The Trunk: Tests-pre.341.mcz
by commits＠source.squeak.org 13 Feb '19

13 Feb '19

Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-pre.341.mcz ==================== Summary ==================== Name: Tests-pre.341 Author: pre Time: 19 May 2016, 5:34:18.672168 pm UUID: 0209ce70-2b8b-4d53-b743-ed1024d367ea Ancestors: Tests-eem.340 By moving the PBColorPreferenceView from the EToys package to the PreferenceBrowser package, the PB package now depends on etyos through the UpdatingRectangleMorph. If this is intentional we should make the following modification to the PackageDependencyTests. =============== Diff against Tests-eem.340 =============== Item was changed: ----- Method: PackageDependencyTest>>testPreferenceBrowser (in category 'tests') ----- testPreferenceBrowser self testPackage: #PreferenceBrowser dependsExactlyOn: #( #'Chronology-Core' Collections Graphics Kernel Morphic MorphicExtras System Tools + #'ToolBuilder-Morphic' + EToys + Balloon ).!

1 0

The Trunk: Tests-pre.347.mcz
by commits＠source.squeak.org 13 Feb '19

13 Feb '19

Nicolas Cellier uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-pre.347.mcz ==================== Summary ==================== Name: Tests-pre.347 Author: pre Time: 23 July 2016, 2:20:08.768962 pm UUID: 8272055d-5600-c34b-aac4-9c29a9fda5e5 Ancestors: Tests-pre.346 Adds a Compiler test to the list of expected failures as it can not currently work in an image only using the V3PlusClosures encoder. The test is expected to be executable in an image which uses the V3Encoder. =============== Diff against Tests-pre.346 =============== Item was changed: ----- Method: ClosureCompilerTest>>expectedFailures (in category 'failures') ----- expectedFailures + + ^#(testDebuggerTempAccess testInjectIntoDecompilations testInjectIntoDecompiledDebugs) , + (({CompiledMethod classPool at: #SecondaryBytecodeSetEncoderClass . + CompiledMethod classPool at: #PrimaryBytecodeSetEncoderClass} + includes: EncoderForV3) + ifFalse: [#(testSourceRangeAccessForBlueBookInjectInto)] + ifTrue: [#()]) + ! - ^#(testDebuggerTempAccess testInjectIntoDecompilations testInjectIntoDecompiledDebugs)! Item was changed: ----- Method: ClosureCompilerTest>>testSourceRangeAccessForBlueBookInjectInto (in category 'tests') ----- testSourceRangeAccessForBlueBookInjectInto "Test debugger source range selection for inject:into: for a version compiled with closures" "self new testSourceRangeAccessForBlueBookInjectInto" | source method | + [source := (Collection sourceCodeAt: #inject:into:) asString. - source := (Collection sourceCodeAt: #inject:into:) asString. method := (Parser new encoderClass: EncoderForV3; parse: source class: Collection) generate: (Collection compiledMethodAt: #inject:into:) trailer. + self supportTestSourceRangeAccessForInjectInto: method source: source.] + on: Error + do: [:e | self fail: e.]! - self supportTestSourceRangeAccessForInjectInto: method source: source!

1 0

The Trunk: EToys-tpr.321.mcz
by commits＠source.squeak.org 13 Feb '19

13 Feb '19

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-tpr.321.mcz ==================== Summary ==================== Name: EToys-tpr.321 Author: tpr Time: 6 March 2018, 12:47:26.51527 pm UUID: 082ac20c-c54a-4c29-b5a1-af5f91ca4418 Ancestors: EToys-dtl.320 Change CrosticPanel & FileInput to use the new file dialogues instead of the nasty old StandardFileMenu. Submitted to inbox because EToys is not my world and it may be important to others to do sometihng different. =============== Diff against EToys-dtl.320 =============== Item was changed: ----- Method: CrosticPanel>>openFile (in category 'menu') ----- openFile + | fileName crostic file | + + fileName := FileChooserDialog openOn: FileDirectory default suffixList: { 'crostic' } label: 'Select a Crostic file...' translated. + fileName ifNil: [^nil]. + + file := FileStream readOnlyFileNamed: fileName. - | stdFileMenuResult crostic file | - stdFileMenuResult := (StandardFileMenu new pattern: '*.crostic'; - oldFileFrom: FileDirectory default) startUpWithCaption: 'Select a Crostic File...' translated. - stdFileMenuResult - ifNil: [^ nil]. - file := stdFileMenuResult directory readOnlyFileNamed: stdFileMenuResult name. crostic := CrosticPanel newFromFile: file. file close. (self isClean or: [self confirm: 'Is it OK to discard this crostic?' translated]) ifTrue: [self world addMorphFront: (crostic position: self position). self delete] ifFalse: [self world addMorphFront: crostic]! Item was changed: ----- Method: FileInput>>browse (in category 'accessing') ----- browse + | fileName | + fileName := (FileChooserDialog openOn: self directory) ifNil: [^nil]. - | file | - file := (StandardFileMenu oldFileFrom: self directory) ifNil: [^nil]. - file directory isNil ifTrue: [^ nil]. + textMorph setText: fileName; - textMorph setText: (file directory pathName, FileDirectory slash, file name); hasUnacceptedEdits: true; accept!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2019