Squeak-dev February 2019

squeak-dev@lists.squeakfoundation.org

37 participants
92 discussions

The Trunk: Morphic-kfr.1478.mcz
by commits＠source.squeak.org 28 Feb '19

28 Feb '19

Karl Ramberg uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-kfr.1478.mcz ==================== Summary ==================== Name: Morphic-kfr.1478 Author: kfr Time: 28 February 2019, 4:09:26.634492 pm UUID: ec9720b3-1097-4cef-989b-8a21a5ac15e8 Ancestors: Morphic-tonyg.1477 A few changes to Project menu in TheWorldMainDocingBar No need for a submenu for only 2 sub entries, so I simplyfied to have the the main menu include all project types. Change so new projects are not automatically entered upon creation, because that is unexpected behavior. =============== Diff against Morphic-tonyg.1477 =============== Item was changed: ----- Method: TheWorldMainDockingBar>>newProject: (in category 'menu actions') ----- newProject: projectClass "Create a new project of the given type" | newProject | "Allow the project to return nil from #new to indicate that it was canceled." newProject := projectClass new ifNil:[^self]. ProjectViewMorph openOn: newProject. + ! - newProject enter.! Item was changed: ----- Method: TheWorldMainDockingBar>>newProjectMenuItemOn: (in category 'submenu - projects') ----- newProjectMenuItemOn: menu + Project allSubclasses do: [ :each | + menu addItem: [ :item | + item + contents: ('New ', each name) translated; + help: ('Start a new ', each name) translated; + target: self; + selector: #newProject:; + arguments: { each } ] ]! - menu addItem: [ :item | - item - contents: 'New Project' translated; - help: 'Start a new MorphicProject' translated; - icon: MenuIcons smallProjectIcon; - target: self; - selector: #newProject:; - arguments: { MorphicProject }; - subMenuUpdater: self - selector: #updateNewProjectSubMenu: ]! Item was removed: - ----- Method: TheWorldMainDockingBar>>updateNewProjectSubMenu: (in category 'submenu - projects') ----- - updateNewProjectSubMenu: menu - - Project allSubclasses do: [ :each | - menu addItem: [ :item | - item - contents: ('New ', each name) translated; - help: ('Start a new ', each name) translated; - target: self; - selector: #newProject:; - arguments: { each } ] ]!

1 0

The Inbox: MorphicExtras-kfr.254.mcz
by commits＠source.squeak.org 28 Feb '19

28 Feb '19

A new version of MorphicExtras was added to project The Inbox: http://source.squeak.org/inbox/MorphicExtras-kfr.254.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.254 Author: kfr Time: 28 February 2019, 3:27:07.129575 pm UUID: 9e0ac524-c2e1-44e1-a258-b2b5a7755fc8 Ancestors: MorphicExtras-kfr.253 Update extent form halo handle. Only grow allow extent to grow. Unlimited undo of SketchMorphEditor. Just add current form to a collection. Redo with holding shift down while undo. This is a memory hog of a change. Must be reviewed =============== Diff against MorphicExtras-kfr.253 =============== Item was changed: Morph subclass: #SketchEditorMorph + instanceVariableNames: 'hostView palette ticksToDwell rotationCenter registrationPoint newPicBlock emptyPicBlock paintingForm dimForm formCanvas rotationButton scaleButton cumRot cumMag undoBuffer enclosingPasteUpMorph forEachHand firstUndoFlag undoBufferIndex' - instanceVariableNames: 'hostView palette ticksToDwell rotationCenter registrationPoint newPicBlock emptyPicBlock paintingForm dimForm formCanvas rotationButton scaleButton cumRot cumMag undoBuffer enclosingPasteUpMorph forEachHand' classVariableNames: 'SketchTimes' poolDictionaries: '' category: 'MorphicExtras-Support'! !SketchEditorMorph commentStamp: '<historical>' prior: 0! Inst vars (converting to morphic events) hostView -- SketchMorph we are working on. stampForm -- Stamp is stored here. canvasRectangle -- later use bounds palette -- the PaintBox interface Morph dirty -- not used currentColor ticksToDwell rotationCenter registrationPoint newPicBlock -- do this after painting action -- selector of painting action paintingForm -- our copy composite -- now paintArea origin. world relative. stop using it. dimForm -- SketchMorph of the dimmed background. Opaque. installed behind the editor morph. buff brush -- 1-bit Form of the brush, paintingFormPen formCanvas -- Aim it at paintingForm to allow it to draw ovals, rectangles, lines, etc. picToComp dimToComp compToDisplay -- used to composite -- obsolete picToBuff brushToBuff buffToBuff buffToPic rotationButton scaleButton -- submorphs, handles to do these actions. strokeOrigin -- During Pickup, origin of rect. cumRot cumMag -- cumulative for multiple operations from same original undoBuffer lastEvent currentNib -- 1 bit deep form. For now, we do not carry the SketchMorph's registration point, rotation center, or ticksToDwell. New -- using transform morphs to rotate the finished player. How get it rotated back and the rotationDegrees to be right? We cancel out rotationDegrees, so how remember it? Registration point convention: In a GraphicFrame, reg point is relative to this image's origin. During painting, it is relative to canvasRectangle origin, and thus us absolute within the canvas. To convert back, subract newBox origin. Be sure to convert back and forth correctly. In deliverPainting. initializeFromFrame:inView: ! Item was changed: + ----- Method: SketchEditorMorph>>extent: (in category 'morphic') ----- + extent: aPoint + | form | + paintingForm ifNil: [^super extent: aPoint]. + super extent: aPoint. - ----- Method: SketchEditorMorph>>extent: (in category 'actions & preps') ----- - extent: aPoint - | form | - super extent: aPoint. - paintingForm ifNotNil:[ form := Form extent: self extent depth: paintingForm depth. paintingForm displayOn: form. paintingForm := form. + forEachHand do: [:i | i at: #changed put: true]. + rotationButton position: bounds topCenter - (6@0). + scaleButton position: bounds rightCenter - ((scaleButton width)@6). + + ! - forEachHand do:[ :i| i at:#changed put: true] - ]! Item was changed: ----- Method: SketchEditorMorph>>initializeFor:inBounds:pasteUpMorph:paintBoxPosition: (in category 'initialization') ----- initializeFor: aSketchMorph inBounds: boundsToUse pasteUpMorph: aPasteUpMorph paintBoxPosition: aPosition "NB: if aPosition is nil, then it's assumed that the paintbox is obtained from a flap or some such, so do nothing special regarding a palette in this case. The palette needs already to be in the world for this to work." | w | (w := aPasteUpMorph world) addMorphInLayer: self. "in back of palette" enclosingPasteUpMorph := aPasteUpMorph. hostView := aSketchMorph. "may be ownerless" self bounds: boundsToUse. palette := w paintBox focusMorph: self. palette beStatic. "give Nebraska whatever help we can" palette addWeakDependent: self. aPosition ifNotNil: [w addMorphFront: palette. "bring to front" palette position: aPosition]. paintingForm := Form extent: bounds extent depth: w assuredCanvas depth. self dimTheWindow. self addRotationScaleHandles. aSketchMorph ifNotNil: [ aSketchMorph form displayOn: paintingForm at: (hostView boundsInWorld origin - bounds origin - hostView form offset) clippingBox: (0@0 extent: paintingForm extent) rule: Form over fillColor: nil. "assume they are the same depth". + undoBuffer := OrderedCollection new. + undoBuffer add: paintingForm deepCopy. - undoBuffer := paintingForm deepCopy. rotationCenter := aSketchMorph rotationCenter]! Item was changed: ----- Method: SketchEditorMorph>>mouseDown: (in category 'morphic') ----- mouseDown: evt "Start a new stroke. Check if any palette setting have changed. 6/11/97 20:30 tk" | cur pfPen myAction | "verify that we are in a good state" self verifyState: evt. "includes prepareToPaint and #scalingOrRotate" pfPen := self get: #paintingFormPen for: evt. + undoBuffer add: paintingForm deepCopy. + firstUndoFlag := true. - paintingForm extent = undoBuffer extent ifTrue: [ - paintingForm displayOn: undoBuffer at: 0@0 rule: Form over. - ] ifFalse: [ - undoBuffer := paintingForm deepCopy. "know we will draw something" - ]. pfPen place: (evt cursorPoint - bounds origin). myAction := self getActionFor: evt. palette colorable ifTrue:[ palette recentColor: (self getColorFor: evt)]. self set: #strokeOrigin for: evt to: evt cursorPoint. "origin point for pickup: rect: ellispe: polygon: line: star:. Always take it." myAction == #pickup: ifTrue: [ cur := Cursor corner shallowCopy. cur offset: 0@0 "cur offset abs". evt hand showTemporaryCursor: cur]. myAction == #polygon: ifTrue: [self polyNew: evt]. "a mode lets you drag vertices" self mouseMove: evt.! Item was changed: ----- Method: SketchEditorMorph>>restoreRect: (in category 'actions & preps') ----- restoreRect: oldRect "Restore the given rectangular area of the painting Form from the undo buffer." + formCanvas drawImage: undoBuffer last - formCanvas drawImage: undoBuffer at: oldRect origin sourceRect: (oldRect translateBy: self topLeft negated). self invalidRect: oldRect. ! Item was changed: ----- Method: SketchEditorMorph>>rotateBy: (in category 'actions & preps') ----- rotateBy: evt "Left-right is rotation. 3/26/97 tk Slider at top of window. 4/3/97 tk" | pt temp amt smooth myBuff | + undoBuffer add: paintingForm deepCopy. + firstUndoFlag := true. - myBuff := self get: #buff for: evt. evt cursorPoint x - self left < 20 ifTrue: [^ self flipHoriz: evt]. "at left end flip horizontal" evt cursorPoint x - self right > -20 ifTrue: [^ self flipVert: evt]. "at right end flip vertical" pt := evt cursorPoint - bounds center. smooth := 2. "paintingForm depth > 8 ifTrue: [2] ifFalse: [1]." "Could go back to 1 for speed" amt := pt x abs < 12 ifTrue: ["detent" 0] ifFalse: [pt x - (12 * pt x abs // pt x)]. amt := amt * 1.8. temp := myBuff rotateBy: amt magnify: cumMag smoothing: smooth. temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset. rotationButton position: evt cursorPoint x - 6 @ rotationButton position y. self render: bounds. cumRot := amt! Item was changed: ----- Method: SketchEditorMorph>>scaleBy: (in category 'actions & preps') ----- scaleBy: evt "up-down is scale. 3/26/97 tk Now a slider on the right." | pt temp cy oldRect amt myBuff | + undoBuffer add: paintingForm deepCopy. + firstUndoFlag := true. - myBuff := self get: #buff for: evt. pt := evt cursorPoint - bounds center. cy := bounds height * 0.5. oldRect := myBuff boundingBox expandBy: myBuff extent * cumMag / 2. amt := pt y abs < 12 ifTrue: ["detent" 1.0] ifFalse: [pt y - (12 * pt y abs // pt x)]. amt := amt asFloat / cy + 1.0. temp := myBuff rotateBy: cumRot magnify: amt smoothing: 2. cumMag > amt ifTrue: ["shrinking" oldRect := oldRect translateBy: paintingForm center - oldRect center + myBuff offset. paintingForm fill: (oldRect expandBy: 1 @ 1) rule: Form over fillColor: Color transparent]. temp displayOn: paintingForm at: paintingForm center - temp center + myBuff offset. scaleButton position: scaleButton position x @ (evt cursorPoint y - 6). self render: bounds. cumMag := amt! Item was added: + ----- Method: SketchEditorMorph>>setExtentFromHalo: (in category 'morphic') ----- + setExtentFromHalo: anExtent + "The user has dragged the grow box such that the receiver's extent would be anExtent. Do what's needed" + + super setExtentFromHalo: ((anExtent x max: paintingForm width) @ (anExtent y max: paintingForm height)). + ! Item was changed: ----- Method: SketchEditorMorph>>undo: (in category 'start & finish') ----- undo: evt "revert to a previous state. " + | poly pen | - | temp poly pen | self flag: #bob. "what is undo in multihand environment?" undoBuffer ifNil: [^Beeper beep]. "nothing to go back to" (poly := self valueOfProperty: #polygon) ifNotNil: [poly delete. self setProperty: #polygon toValue: nil. self polyEditing: false. ^self]. + firstUndoFlag ifTrue:[ + undoBuffer add: paintingForm deepCopy. + firstUndoFlag := false. + undoBufferIndex := undoBuffer size]. + evt shiftPressed + ifTrue:[undoBufferIndex := undoBufferIndex + 1. + paintingForm := undoBuffer at: undoBufferIndex ifAbsent:[^self inform:'Nothing to redo']] + ifFalse:[undoBufferIndex := undoBufferIndex - 1. + paintingForm := undoBuffer at: undoBufferIndex ifAbsent:[^self inform:'Nothing to undo']]. - temp := paintingForm. - paintingForm := undoBuffer. - undoBuffer := temp. "can get back to what you had by undoing again" pen := self get: #paintingFormPen for: evt. pen ifNil: [^Beeper beep]. pen setDestForm: paintingForm. formCanvas := paintingForm getCanvas. "used for lines, ovals, etc." formCanvas := formCanvas copyOrigin: self topLeft negated clipRect: (0 @ 0 extent: bounds extent). self render: bounds!

1 0

Mac OS Mojave bug: 64-bit squeak instantly crashes when OpenGL plug-in installed and then used on Mojave
by Chris Cunnington 28 Feb '19

28 Feb '19

Just thinking out loud: it’s likely 32-bit on a 64-bit machine, crashing, and as OpenGL is likely nobody’s priority, it’ll likely stay that way. But if you’re back experimenting with Cobalt again, perhaps there is an open source version of Terf somewhere you could move to? Again, just some random thoughts. Everything I just said is probably wrong. Chris

1 0

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

25 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!

4 8

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

25 Feb '19

tim Rowledge uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tpr.231.mcz ==================== Summary ==================== Name: Network-tpr.231 Author: tpr Time: 25 February 2019, 2:27:15.218701 pm UUID: 75e4e492-3a02-4d3b-bc97-4b64cd827635 Ancestors: Network-tpr.230 drop the for-deprecation implementation of URI class>>basicNew =============== Diff against Network-tpr.230 =============== Item was removed: - ----- Method: URI class>>basicNew (in category 'instance creation') ----- - basicNew - self deprecated: 'This class is deprecated. USe one ofthe Url classes instead'. - ^super basicNew!

1 0

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

25 Feb '19

tim Rowledge uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-tpr.230.mcz ==================== Summary ==================== Name: Network-tpr.230 Author: tpr Time: 25 February 2019, 1:18:58.682316 pm UUID: e0d4c983-2401-4421-89bd-8ef3d1318d5d Ancestors: Network-tpr.229 De-deprecate the URI class(es) since there is a tiny pinhole leak via String asUri etc. Best option would be to reimplement URI & Url to unify and improve both. Not least to fix the incorrect naming of Url - it's an initialism and should be URL. =============== Diff against Network-tpr.229 =============== Item was added: + URI subclass: #HierarchicalURI + instanceVariableNames: 'authority query' + classVariableNames: '' + poolDictionaries: '' + category: '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: 'Network-URI'! Item was added: + ----- Method: OpaqueURI>>isOpaque (in category 'testing') ----- + isOpaque + ^true! Item was added: + Object subclass: #URI + instanceVariableNames: 'fragment scheme schemeSpecificPart' + classVariableNames: 'ClientClasses' + poolDictionaries: '' + category: '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: 60Deprecated-tpr.33.mcz
by commits＠source.squeak.org 25 Feb '19

25 Feb '19

tim Rowledge uploaded a new version of 60Deprecated to project The Trunk: http://source.squeak.org/trunk/60Deprecated-tpr.33.mcz ==================== Summary ==================== Name: 60Deprecated-tpr.33 Author: tpr Time: 25 February 2019, 1:17:39.079517 pm UUID: 1fb9d494-de7a-4eb8-a0ad-e58a74035cfb Ancestors: 60Deprecated-tpr.32 De-deprecate the URI class(es) since tere is a tiny pinhole leak via String asUri etc. Best option would be to reimplement URI & Url to unify and improve both. Not least to fix the incorrect naming of Url - it's an initialism and should be URL. =============== Diff against 60Deprecated-tpr.32 =============== 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 removed: - URI subclass: #HierarchicalURI - instanceVariableNames: 'authority query' - classVariableNames: '' - poolDictionaries: '' - category: '60Deprecated-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: '60Deprecated-Network-URI'! Item was removed: - ----- Method: OpaqueURI>>isOpaque (in category 'testing') ----- - isOpaque - ^true! Item was removed: - 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 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>>basicNew (in category 'instance creation') ----- - basicNew - self deprecated: 'This class is deprecated. USe one ofthe Url classes instead'. - ^super basicNew! 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 Inbox: Monticello-cmm.1550112371873461.mcz
by commits＠source.squeak.org 24 Feb '19

24 Feb '19

Chris Muller uploaded a new version of Monticello to project The Inbox: http://source.squeak.org/inbox/Monticello-cmm.1550112371873461.mcz ==================== Summary ==================== Name: Monticello-cmm.1550112371873461 Author: cmm Time: 13 February 2019, 8:53:17.238995 pm UUID: 4e5412b2-6fac-4192-846e-40e4c24eb282 Ancestors: Monticello-nice.694 Monticello only requires monotonicity and uniqueness for its version numbers, not consecutiveness. =============== Diff against Monticello-nice.694 =============== Item was added: + ----- Method: MCAncestry>>hasAncestorNamed: (in category 'ancestry') ----- + hasAncestorNamed: aString + self allAncestorsDo: + [ : each | aString asMCVersionName = each name ifTrue: [ ^ true ] ]. + ^ false! Item was changed: MCPackageManager subclass: #MCWorkingCopy + instanceVariableNames: 'versionInfo ancestry repositoryGroup requiredPackages environment' - instanceVariableNames: 'versionInfo ancestry counter repositoryGroup requiredPackages environment' classVariableNames: '' poolDictionaries: '' category: 'Monticello-Versioning'! Item was changed: ----- Method: MCWorkingCopy>>nextVersionName (in category 'private') ----- nextVersionName | branch oldName | ancestry ancestors isEmpty ifTrue: + [ branch := package name ] - [ counter ifNil: [ counter := 0 ]. - branch := package name ] ifFalse: [ oldName := ancestry ancestors first versionName. + branch := oldName packageAndBranchName ]. + ^ branch , '-' , Utilities authorInitials , '.' , DateAndTime now utcMicroseconds asString! - branch := oldName packageAndBranchName. - counter ifNil: - [ counter := (ancestry ancestors detectMax: - [ : eachVersionInfo | eachVersionInfo versionNumber ]) - ifNil: [ 0 ] - ifNotNil: - [ : highestNumbered | highestNumbered versionNumber ] ] ]. - counter := counter + 1. - ^ branch , '-' , Utilities authorInitials , '.' , counter asString! Item was changed: ----- Method: MCWorkingCopy>>uniqueVersionName (in category 'private') ----- uniqueVersionName |versionName| - counter := nil. [versionName := self nextVersionName. + (self repositoryGroup includesVersionNamed: versionName) or: [ ancestry hasAncestorNamed: versionName ]] whileTrue. - self repositoryGroup includesVersionNamed: versionName] whileTrue. ^ versionName!

13 29

Saving from SketchEditor
by Eliot Miranda 24 Feb '19

24 Feb '19

Hi, feeling very dense but I don't see the obvious way to save a drawing back to the file system. I pulled in a jpeg to edit it. I found a way that saved the entire sketch, including the grey border. But couldn't;t find something that just saved the edited image itself. _,,,^..^,,,_ best, Eliot

2 1

The Trunk: MorphicExtras-kfr.253.mcz
by commits＠source.squeak.org 24 Feb '19

24 Feb '19

Karl Ramberg uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-kfr.253.mcz ==================== Summary ==================== Name: MorphicExtras-kfr.253 Author: kfr Time: 24 February 2019, 2:43:46.160328 pm UUID: 4eb29a5a-3d38-4464-bb7d-3b64e2ae2c4d Ancestors: MorphicExtras-kfr.252 Create AnimatedImageMorph from array of images. Setter access for inter image delay to uniform value. =============== Diff against MorphicExtras-kfr.252 =============== Item was added: + ----- Method: AnimatedImageMorph>>fromImages: (in category 'private') ----- + fromImages: anArray + + images := anArray. + self setUniformDelay: 10. + self isOpaque: true. + self reset.! Item was added: + ----- Method: AnimatedImageMorph>>fromImages:delay: (in category 'private') ----- + fromImages: anArray delay: anInteger + + images := anArray. + self setUniformDelay: anInteger. + self isOpaque: true. + self reset.! Item was added: + ----- Method: AnimatedImageMorph>>setUniformDelay: (in category 'private') ----- + setUniformDelay: anInteger + "set delay to a uniform value for all images" + delays := Array new: images size withAll: anInteger.!

1 0

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