Packages March 2020

packages@lists.squeakfoundation.org

1 participants
135 discussions

The Trunk: Tools-ct.945.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Nicolas Cellier uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.945.mcz ==================== Summary ==================== Name: Tools-ct.945 Author: ct Time: 24 February 2020, 1:56:51.392323 pm UUID: cc577466-ca48-484b-9454-11ae7ffde0b2 Ancestors: Tools-mt.940 Fixes a bug/unnecessary limitation in VersionsBrowser class >> #browseMethod: that raised an error when browsing a method that had been removed from the system. You can also reproduce it via: thisContext method browse "on a fresh image". This commit replaces Tools-ct.944, which has been refactored again to reuse the return carat according to Kent Beck ("Format conditionals so their value is used where it clearly expresses the intent of the method"). Thanks to Chris for the reminder! =============== Diff against Tools-mt.940 =============== Item was changed: ----- Method: VersionsBrowser class>>browseMethod: (in category 'instance creation') ----- browseMethod: aCompiledMethod + ^ (self browseVersionsOf: aCompiledMethod) + ifNotNil: [:browser | + browser selectMethod: aCompiledMethod]; - ^ (self browseVersionsForClass: aCompiledMethod methodClass selector: aCompiledMethod selector) - selectMethod: aCompiledMethod; yourself! Item was added: + ----- Method: VersionsBrowser class>>browseVersionsOf: (in category 'instance creation') ----- + browseVersionsOf: aCompiledMethod + + | methodClass methodSelector | + methodClass := aCompiledMethod methodClass. + methodSelector := aCompiledMethod selector. + ^ self + browseVersionsOf: aCompiledMethod + class: methodClass + meta: methodClass isMeta + category: (methodClass organization categoryOfElement: methodSelector) + selector: methodSelector!

1 0

The Trunk: Tools-ct.952.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Nicolas Cellier uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.952.mcz ==================== Summary ==================== Name: Tools-ct.952 Author: ct Time: 2 March 2020, 2:52:00.705976 pm UUID: 3497b3a9-fd0d-d447-8ddf-31b89d99f92a Ancestors: Tools-mt.940 Fixes an invalidation bug in the debugger's stack list display optimization For the full bug report, see http://forum.world.st/BUG-in-Debugger-gt-gt-newStack-optimization-td5112726…. Please review! =============== Diff against Tools-mt.940 =============== Item was changed: ----- Method: Debugger>>newStack: (in category 'private') ----- newStack: stack | oldStack diff | oldStack := contextStack. contextStack := stack. (oldStack == nil or: [oldStack last ~~ stack last]) ifTrue: [contextStackList := contextStack collect: [:ctx | ctx printString]. ^ self]. "May be able to re-use some of previous list" diff := stack size - oldStack size. contextStackList := diff <= 0 ifTrue: [contextStackList copyFrom: 1-diff to: oldStack size] + ifFalse: [(diff = 1 and: [stack second == oldStack first]) + ifTrue: [contextStackList copyWithFirst: stack first printString] + ifFalse: [contextStack collect: [:ctx | ctx printString]]]! - ifFalse: [diff > 1 - ifTrue: [contextStack collect: [:ctx | ctx printString]] - ifFalse: [(Array with: stack first printString) , contextStackList]]!

1 0

The Trunk: MorphicExtras-mt.272.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Marcel Taeumel uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-mt.272.mcz ==================== Summary ==================== Name: MorphicExtras-mt.272 Author: mt Time: 5 March 2020, 9:08:23.933327 am UUID: 9405455d-b08e-8747-97f3-7a3e3614ed26 Ancestors: MorphicExtras-mt.271 Removes more deprecated message sends. =============== Diff against MorphicExtras-mt.271 =============== Item was changed: ----- Method: BookPageSorterMorph>>book:morphsToSort: (in category 'initialization') ----- book: aBookMorph morphsToSort: morphList | innerBounds scrollPane newHeight | book := aBookMorph. newHeight := self currentWorld height. pageHolder removeAllMorphs. pageHolder addAllMorphs: morphList. pageHolder extent: pageHolder width@pageHolder fullBounds height. innerBounds := Rectangle merging: (morphList collect: [:m | m bounds]). pageHolder extent: innerBounds extent + pageHolder borderWidth + 6. (pageHolder height > newHeight) ifTrue: [ scrollPane := ScrollPane new. self height: newHeight. scrollPane model: pageHolder. scrollPane extent: pageHolder width@(newHeight - aBookMorph submorphs first height - 28). self addMorph: scrollPane inFrontOf: pageHolder. scrollPane scroller addMorph: pageHolder. scrollPane scrollBarOnLeft: false. scrollPane retractable: false. + scrollPane hScrollBarPolicy: #never. - scrollPane hideHScrollBarIndefinitely: true. scrollPane borderWidth: 1; borderColor: Color gray. ]. !

1 0

The Trunk: EToys-mt.385.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.385.mcz ==================== Summary ==================== Name: EToys-mt.385 Author: mt Time: 5 March 2020, 9:07:20.219327 am UUID: 940d62a0-8c84-a642-b6ff-b449e679723c Ancestors: EToys-nice.384 Removes more deprecated message sends. =============== Diff against EToys-nice.384 =============== Item was changed: ----- Method: EventRollMorph>>formulate (in category 'processing') ----- formulate "Given that all my relevant inst vars are now filled,build the structures that constitute the tool." "Replace the parts of the tool that change" | outer scrollAreaWidth | submorphs size > 1 ifFalse: [scrollAreaWidth := 600] ifTrue: [scrollAreaWidth := submorphs second width]. [submorphs size > 1] whileTrue: [submorphs last delete]. actualRoll := EventTimeline new extent: ( (self totalDuration / millisecondsPerPixel) @ 160). actualRoll color: Color yellow muchLighter. actualRoll beSticky. outer := ScrollPane new extent: scrollAreaWidth @ 160. outer model: self. outer useRoundedCorners. outer scrollBarOnLeft: false. outer scroller addMorph: actualRoll. outer retractable: false. + outer vScrollBarPolicy: #never. + outer hScrollBarPolicy: #always. - outer hideVScrollBarIndefinitely: true. - outer alwaysShowHScrollBar: true. self addMorphBack: outer. self setMouseEventMorphs. self setKeyboardEventMorphs. self setMediaEventMorphs. self setTimeIndicators. actualRoll addMorphFront: eventPlaybackCursor. eventPlaybackCursor bounds: (actualRoll topLeft extent: (2 @ actualRoll height)). self setVerticalGrid: (1000/millisecondsPerPixel) rounded backgroundColor: Color blue veryMuchLighter lineColor: Color gray darker. self updateScrollbar!

1 0

The Trunk: ST80Tools-mt.12.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Marcel Taeumel uploaded a new version of ST80Tools to project The Trunk: http://source.squeak.org/trunk/ST80Tools-mt.12.mcz ==================== Summary ==================== Name: ST80Tools-mt.12 Author: mt Time: 5 March 2020, 9:05:58.968327 am UUID: 05db32d3-3285-2d4a-bb84-a2c466af4e01 Ancestors: ST80Tools-mt.11 Removes more deprecated message sends. =============== Diff against ST80Tools-mt.11 =============== Item was changed: ----- Method: FileList class>>openInMVC (in category '*ST80Tools-instance creation') ----- openInMVC "Open a view of an instance of me on the default directory." | dir aFileList topView volListView templateView fileListView fileContentsView underPane pHeight | dir := FileDirectory default. aFileList := self new directory: dir. topView := StandardSystemView new. topView model: aFileList; label: dir pathName; minimumSize: 200@200. topView borderWidth: 1. volListView := PluggableListView on: aFileList list: #volumeList selected: #volumeListIndex changeSelected: #volumeListIndex: menu: #volumeMenu:. volListView autoDeselect: false. volListView window: (0@0 extent: 80@45). topView addSubView: volListView. templateView := PluggableTextView on: aFileList text: #pattern accept: #pattern:. templateView askBeforeDiscardingEdits: false. templateView window: (0@0 extent: 80@15). topView addSubView: templateView below: volListView. aFileList wantsOptionalButtons ifTrue: [underPane := aFileList optionalButtonViewForMVC. underPane isNil ifTrue: [pHeight := 60] ifFalse: [ topView addSubView: underPane toRightOf: volListView. + pHeight := 60 - 10 "optionalButtonHeight"]] - pHeight := 60 - aFileList optionalButtonHeight]] ifFalse: [underPane := nil. pHeight := 60]. fileListView := PluggableListView on: aFileList list: #fileList selected: #fileListIndex changeSelected: #fileListIndex: menu: #fileListMenu:. fileListView window: (0@0 extent: 120@pHeight). underPane isNil ifTrue: [topView addSubView: fileListView toRightOf: volListView] ifFalse: [topView addSubView: fileListView below: underPane]. fileListView controller terminateDuringSelect: true. "Pane to left may change under scrollbar" fileContentsView := PluggableTextView on: aFileList text: #contents accept: #put: readSelection: #contentsSelection menu: #fileContentsMenu:shifted:. fileContentsView window: (0@0 extent: 200@140). topView addSubView: fileContentsView below: templateView. topView controller open! Item was changed: ----- Method: FileList>>optionalButtonViewForMVC (in category '*ST80Tools-initialization') ----- optionalButtonViewForMVC "Answer a view of optional buttons" | aView bHeight windowWidth offset previousView aButtonView wid services sel allServices | aView := View new model: self. + bHeight := 10. "optionalButtonHeight". - bHeight := self optionalButtonHeight. windowWidth := 120. aView window: (0 @ 0 extent: windowWidth @ bHeight). offset := 0. allServices := self universalButtonServices. services := allServices copyFrom: 1 to: (allServices size min: 5). previousView := nil. services do: [:service | sel := service selector. aButtonView := sel asString numArgs = 0 ifTrue: [PluggableButtonView on: service provider getState: (service extraSelector == #none ifFalse: [service extraSelector]) action: sel] ifFalse: [PluggableButtonView on: service provider getState: (service extraSelector == #none ifFalse: [service extraSelector]) action: sel getArguments: #fullName from: self]. service selector = services last selector ifTrue: [wid := windowWidth - offset] ifFalse: [aButtonView borderWidthLeft: 0 right: 1 top: 0 bottom: 0. wid := windowWidth // services size - 2]. aButtonView label: service buttonLabel asParagraph; window: (offset @ 0 extent: wid @ bHeight). offset := offset + wid. service selector = services first selector ifTrue: [aView addSubView: aButtonView] ifFalse: [aView addSubView: aButtonView toRightOf: previousView]. previousView := aButtonView]. ^ aView!

1 0

The Trunk: Environments-dtl.77.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Nicolas Cellier uploaded a new version of Environments to project The Trunk: http://source.squeak.org/trunk/Environments-dtl.77.mcz ==================== Summary ==================== Name: Environments-dtl.77 Author: dtl Time: 20 December 2019, 12:39:42.803984 pm UUID: 015242d9-b4ac-4abc-a2d3-2e1123587ef3 Ancestors: Environments-eem.76 Fix the uninstall script =============== Diff against Environments-eem.76 =============== Item was changed: ----- Method: Environment class>>uninstall (in category 'class initialization') ----- uninstall | globals sysdict | self environment class == self ifFalse: [Transcript cr; show: 'Can''t uninstall environments; they''re not currently installed'. ^ self]. + globals := Smalltalk globals declarations. - globals := Smalltalk globals instVarNamed: 'contents'. sysdict := SystemDictionary new: globals size. + globals do: [:ea | sysdict add: ea]. - globals associationsDo: [:ea | sysdict add: ea]. Smalltalk globals becomeForward: sysdict.!

1 0

The Trunk: EToys-nice.384.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-nice.384.mcz ==================== Summary ==================== Name: EToys-nice.384 Author: nice Time: 5 March 2020, 12:45:59.080204 am UUID: 40d0d063-daeb-4b6e-8d94-d2415ce3128a Ancestors: EToys-mt.383, EToys-ct.377 Merge EToys-ct.377 Remove missspelled extension selector from FilePath. The thing is named #converter: and already located in Files with exactly the same implementation. Cherry pick SameGame changes from: EToys-kfr.379 Fix longstanding visual bug in SameGame. Cascade had wrong order so deselection could not work. EToys-kfr.380 SameGameTile borderColor must be updated as well as main tile color. =============== Diff against EToys-mt.383 =============== Item was removed: - ----- Method: FilePath>>coverter: (in category '*Etoys-Squeakland-conversion') ----- - coverter: aTextConverter - - converter class ~= aTextConverter class ifTrue: [ - converter := aTextConverter. - vmPathName := squeakPathName convertToWithConverter: converter - ]. - ! Item was changed: ----- Method: SameGameBoard>>removeSelection (in category 'actions') ----- removeSelection selection ifNil: [^ self]. self rememberUndoableAction: [selection + do: [:loc | (self tileAt: loc) setSwitchState: false; disabled: true]. - do: [:loc | (self tileAt: loc) disabled: true; - setSwitchState: false]. self collapseColumns: (selection collect: [:loc | loc x] as: Set) sorted. selection := nil. flash := false. (target notNil and: [actionSelector notNil]) ifTrue: [target perform: actionSelector withArguments: arguments]] named: 'remove selection' translated! Item was changed: ----- Method: SameGameTile>>color: (in category 'accessing') ----- color: aColor super color: aColor. + self borderColor: aColor. onColor := aColor. offColor := aColor. self changed!

1 0

The Trunk: EToys-ct.377.mcz
by commits＠source.squeak.org 05 Mar '20

05 Mar '20

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-ct.377.mcz ==================== Summary ==================== Name: EToys-ct.377 Author: ct Time: 13 February 2020, 12:27:22.215118 am UUID: 4d199888-b48f-c345-b111-301883c0ba91 Ancestors: EToys-dtl.376 Remove missspelled extension selector from FilePath. The thing is named #converter: and already located in Files with exactly the same implementation. =============== Diff against EToys-dtl.376 =============== Item was removed: - ----- Method: FilePath>>coverter: (in category '*Etoys-Squeakland-conversion') ----- - coverter: aTextConverter - - converter class ~= aTextConverter class ifTrue: [ - converter := aTextConverter. - vmPathName := squeakPathName convertToWithConverter: converter - ]. - !

1 0

The Trunk: 45Deprecated-mt.28.mcz
by commits＠source.squeak.org 04 Mar '20

04 Mar '20

Marcel Taeumel uploaded a new version of 45Deprecated to project The Trunk: http://source.squeak.org/trunk/45Deprecated-mt.28.mcz ==================== Summary ==================== Name: 45Deprecated-mt.28 Author: mt Time: 4 March 2020, 5:06:56.255827 pm UUID: dbdb6251-7f68-124a-9f9e-faed918752eb Ancestors: 45Deprecated-ct.27 Fix typo. =============== Diff against 45Deprecated-ct.27 =============== Item was changed: ----- Method: Utilities class>>getterSelectorFor: (in category '*45Deprecated-etoys') ----- getterSelectorFor: identifier + self deprecated: 'Use String >> #asGetterSelector'. - self deprecated: 'Use String >> #asSetterSelector'. ^ identifier asGetterSelector.!

1 0

The Trunk: UpdateStream-mt.15.mcz
by commits＠source.squeak.org 04 Mar '20

04 Mar '20

Marcel Taeumel uploaded a new version of UpdateStream to project The Trunk: http://source.squeak.org/trunk/UpdateStream-mt.15.mcz ==================== Summary ==================== Name: UpdateStream-mt.15 Author: mt Time: 4 March 2020, 5:06:14.872827 pm UUID: 167f4a6a-e41e-ab4d-9eea-1cfcd2d23dfb Ancestors: UpdateStream-mt.14 Removes more deprecated message sends. =============== Diff against UpdateStream-mt.14 =============== Item was changed: ----- Method: ServerDirectory>>copyUpdatesNumbered:toVersion: (in category '*UpdateStream-updating') ----- copyUpdatesNumbered: selectList toVersion: otherVersion "Into the section of updates.list corresponding to otherVersion, copy all the fileNames from this version matching the selectList." " (ServerDirectory serverInGroupNamed: 'Disney Internal Updates*') copyUpdatesNumbered: #(4411 4412) to version: 'Squeak3.1beta'. " | myServers updateStrm indexPrefix version versIndex lastNum otherVersIndex additions outOfOrder listContents | self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" myServers := self checkServersWithPrefix: indexPrefix andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" otherVersIndex := (listContents collect: [:pair | pair first]) indexOf: otherVersion. otherVersIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for the target version'. self closeGroup. ^ nil]. "abort" versIndex < listContents size ifTrue: [(self confirm: 'This system, ', version , ' is not the latest version.\OK to copy updates from that old version?' withCRs) ifFalse: [self closeGroup. ^ nil]]. "abort" "Append all fileNames in my list that are not in the export list" additions := OrderedCollection new. outOfOrder := OrderedCollection new. lastNum := (listContents at: otherVersIndex) last isEmpty ifTrue: [0] "no checking if the current list is empty" ifFalse: [(listContents at: otherVersIndex) last last initialIntegerOrNil]. (listContents at: versIndex) last do: [:fileName | | seq | seq := fileName initialIntegerOrNil. (selectList includes: seq) ifTrue: [seq > lastNum ifTrue: [additions addLast: fileName] ifFalse: [outOfOrder addLast: seq]]]. outOfOrder isEmpty ifFalse: [UIManager default inform: 'Updates numbered ' , outOfOrder asArray printString, ' are out of order.\ The last update in ' withCRs, otherVersion, ' is ', lastNum printString, '.\No update will take place.' withCRs. self closeGroup. ^ nil]. "abort" "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: indexPrefix , 'updates.list.bk'. UpdateStreamDownloader default writeList: listContents toStream: (FileStream fileNamed: indexPrefix , 'updates.list.bk'). "Write a new copy of updates.list on all servers..." listContents at: otherVersIndex put: {otherVersion. (listContents at: otherVersIndex) last , additions}. updateStrm := ReadStream on: + (String streamContents: [:s | UpdateStreamDownloader default writeList: listContents toStream: s]). - (String streamContents: [:s | Utilities writeList: listContents toStream: s]). myServers do: [:aServer | updateStrm reset. aServer putFile: updateStrm named: indexPrefix , 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. ! Item was changed: ----- Method: ServerDirectory>>exportUpdatesExcept: (in category '*UpdateStream-updating') ----- exportUpdatesExcept: skipList "Into the section of updates.list corresponding to this version, copy all the fileNames in the named updates.list for this group that are more recently numbered." " (ServerDirectory serverInGroupNamed: 'Disney Internal Updates*') exportUpdatesExcept: #(3959). " | myServers updateStrm response indexPrefix version versIndex lastNum expContents expVersIndex additions listContents | self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" myServers := self checkServersWithPrefix: indexPrefix andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" versIndex < listContents size ifTrue: [response := UIManager default chooseFrom: #('Make update from an older version' 'Cancel update') title: 'This system, ', SystemVersion current version, ' is not the latest version'. response = 1 ifFalse: [self closeGroup. ^ nil]]. "abort" "Get the old export updates.list." expContents := UpdateStreamDownloader default parseListContents: (myServers first getFileNamed: 'updates.list'). expVersIndex := (expContents collect: [:pair | pair first]) indexOf: version. expVersIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" lastNum := (expContents at: expVersIndex) last isEmpty ifTrue: [0] "no checking if the current list is empty" ifFalse: [(expContents at: expVersIndex) last last initialIntegerOrNil]. "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: 'updates.list.bk'. UpdateStreamDownloader default writeList: expContents toStream: (FileStream fileNamed: 'updates.list.bk'). "Append all fileNames in my list that are not in the export list" additions := OrderedCollection new. (listContents at: versIndex) last do: [:fileName | | seq | seq := fileName initialIntegerOrNil. (seq > lastNum and: [(skipList includes: seq) not]) ifTrue: [additions addLast: fileName]]. expContents at: expVersIndex put: {version. (expContents at: expVersIndex) last , additions}. (self confirm: 'Do you really want to export ' , additions size printString , ' recent updates?') ifFalse: [self closeGroup. ^ nil]. "abort" "Write a new copy of updates.list on all servers..." updateStrm := ReadStream on: + (String streamContents: [:s | UpdateStreamDownloader default writeList: expContents toStream: s]). - (String streamContents: [:s | Utilities writeList: expContents toStream: s]). myServers do: [:aServer | updateStrm reset. aServer putFile: updateStrm named: 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. ! Item was changed: ----- Method: ServerDirectory>>putUpdate: (in category '*UpdateStream-updating') ----- putUpdate: fileStrm "Put this file out as an Update on the servers of my group. Each version of the system may have its own set of update files, or they may all share the same files. 'updates.list' holds the master list. Each update is a fileIn whose name begins with a number. See Utilities class readServerUpdatesThrough:saveLocally:updateImage:. When two sets of updates are stored on the same directory, one of them has a * in its serverUrls description. When that is true, the first word of the description is put on the front of 'updates.list', and that index file is used." | myServers updateStrm newName response localName seq indexPrefix listContents version versIndex lastNum stripped | localName := fileStrm localName. fileStrm size = 0 ifTrue: [^ self inform: 'That file has zero bytes!! May have a new name.']. (fileStrm contentsOfEntireFile includes: Character linefeed) ifTrue: [self notify: 'That file contains linefeeds. Proceed if... you know that this is okay (e.g. the file contains raw binary data).']. fileStrm reset. (self checkNames: {localName}) ifFalse: [^ nil]. "illegal characters" response := UIManager default chooseFrom: #('Install update' 'Cancel update') title: 'Do you really want to broadcast the file ', localName, '\to every Squeak user who updates from ' withCRs, self groupName, '?'. response = 1 ifFalse: [^ nil]. "abort" self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" myServers := self checkServersWithPrefix: indexPrefix andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" "A few affirmations..." versIndex < listContents size ifTrue: [(self confirm: 'This system, ', version , ' is not the latest version.\Make update for an older version?' withCRs) ifFalse: [self closeGroup. ^ nil]]. "abort" (listContents at: versIndex) last isEmpty ifTrue: [(self confirm: 'Please confirm that you mean to issue the first update for ' , version , '\(otherwise something is wrong).' withCRs) ifFalse: [self closeGroup. ^ nil]]. "We now determine next update number to be max of entire index" lastNum := listContents inject: 0 into: [:max :pair | pair last isEmpty ifTrue: [max] ifFalse: [max max: pair last last initialIntegerOrNil]]. "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: indexPrefix , 'updates.list.bk'. UpdateStreamDownloader default writeList: listContents toStream: (FileStream fileNamed: indexPrefix , 'updates.list.bk'). "append name to updates with new sequence number" seq := (lastNum + 1) printString padded: #left to: 4 with: $0. "strip off any old seq number" stripped := localName copyFrom: (localName findFirst: [:c | c isDigit not]) to: localName size. newName := seq , stripped. listContents at: versIndex put: {version. (listContents at: versIndex) last copyWith: newName}. "Write a new copy on all servers..." updateStrm := ReadStream on: + (String streamContents: [:s | UpdateStreamDownloader default writeList: listContents toStream: s]). - (String streamContents: [:s | Utilities writeList: listContents toStream: s]). myServers do: [:aServer | fileStrm reset. "reopen" aServer putFile: fileStrm named: newName retry: true. updateStrm reset. aServer putFile: updateStrm named: indexPrefix , 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. "rename the file locally (may fail)" fileStrm directory rename: localName toBe: newName. ! Item was changed: ----- Method: ServerDirectory>>putUpdateMulti:fromDirectory: (in category '*UpdateStream-updating') ----- putUpdateMulti: list fromDirectory: updateDirectory "Put these files out as an Update on the servers of my group. List is an array of local file names with or without number prefixes. Each version of the system has its own set of update files. 'updates.list' holds the master list. Each update is a fileIn whose name begins with a number. See Utilities class absorbUpdatesFromServer." | myServers updateStrm lastNum response newNames numStr indexPrefix version versIndex listContents | (self checkNames: (list collect: "Check the names without their numbers" [:each | each copyFrom: (each findFirst: [:c | c isDigit not]) to: each size])) ifFalse: [^ nil]. response := UIManager default chooseFrom: #('Install update' 'Cancel update') title: 'Do you really want to broadcast ', list size printString, ' updates', '\to every Squeak user who updates from ' withCRs, self groupName, '?'. response = 1 ifFalse: [^ nil]. "abort" self openGroup. indexPrefix := (self groupName includes: $*) ifTrue: [(self groupName findTokens: ' ') first] "special for internal updates" ifFalse: ['']. "normal" myServers := self checkServersWithPrefix: indexPrefix andParseListInto: [:x | listContents := x]. myServers size = 0 ifTrue: [self closeGroup. ^ self]. version := SystemVersion current version. versIndex := (listContents collect: [:pair | pair first]) indexOf: version. versIndex = 0 ifTrue: [self inform: 'There is no section in updates.list for your version'. self closeGroup. ^ nil]. "abort" lastNum := (listContents at: versIndex) last last initialIntegerOrNil. versIndex < listContents size ifTrue: [response := UIManager default chooseFrom: #('Make update for an older version' 'Cancel update') title: 'This system, ', SystemVersion current version, ' is not the latest version'. response = 1 ifFalse: [self closeGroup. ^ nil]. numStr := UIManager default request: 'Please confirm or change the starting update number' initialAnswer: (lastNum+1) printString. lastNum := numStr asNumber - 1]. "abort" "Save old copy of updates.list on local disk" FileDirectory default deleteFileNamed: indexPrefix , 'updates.list.bk'. UpdateStreamDownloader default writeList: listContents toStream: (FileStream fileNamed: indexPrefix , 'updates.list.bk'). "Append names to updates with new sequence numbers" newNames := list with: (lastNum+1 to: lastNum+list size) collect: [:each :num | | stripped seq | seq := num printString padded: #left to: 4 with: $0. "strip off any old seq number" stripped := each copyFrom: (each findFirst: [:c | c isDigit not]) to: each size. seq , stripped]. listContents at: versIndex put: {version. (listContents at: versIndex) second , newNames}. "Write a new copy on all servers..." updateStrm := ReadStream on: + (String streamContents: [:s | UpdateStreamDownloader default writeList: listContents toStream: s]). - (String streamContents: [:s | Utilities writeList: listContents toStream: s]). myServers do: [:aServer | list doWithIndex: [:local :ind | | file | file := updateDirectory oldFileNamed: local. aServer putFile: file named: (newNames at: ind) retry: true. file close]. updateStrm reset. aServer putFile: updateStrm named: indexPrefix , 'updates.list' retry: true. Transcript show: 'Update succeeded on server ', aServer moniker; cr]. self closeGroup. Transcript cr; show: 'Be sure to test your new update!!'; cr. "rename the file locally" list with: newNames do: [:local :newName | updateDirectory rename: local toBe: newName]. !

1 0

← Newer
1
...
7
8
9
10
11
12
13
14
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages March 2020