Packages May 2022

packages@lists.squeakfoundation.org

1 participants
142 discussions

The Trunk: Tools-ct.1160.mcz
by commits＠source.squeak.org 20 May '22

20 May '22

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1160.mcz ==================== Summary ==================== Name: Tools-ct.1160 Author: ct Time: 20 May 2022, 2:24:04.560206 pm UUID: 6d318114-13ab-2d43-ad0a-258807421ff7 Ancestors: Tools-mt.1158, Tools-ct.1158 Merges and comments Tools-ct.1158 (do not update process browsers from inactive projects). =============== Diff against Tools-mt.1158 =============== Item was changed: ----- Method: ProcessBrowser>>startAutoUpdate (in category 'updating') ----- startAutoUpdate self isAutoUpdatingPaused ifTrue: [^ autoUpdateProcess resume]. + + self isAutoUpdating ifFalse: + [| project | + project := Project current. + autoUpdateProcess := + [[[self hasView] whileTrue: + [2 seconds wait. + project addDeferredUIMessage: [self updateProcessList]]. + autoUpdateProcess := nil] + ensure: [self removeActionsForEvent: #aboutToEnterWorld]] fork. + + "Do not update process browsers from inactive projects. Otherwise, an auto-updating process browser from a Morphic project would raise periodic errors after entering an MVC project, or an auto-updating process browser from a MVC project would cause spooky screen updates after entering a Morphic project." + self flag: #startStepping:. "A better solution strategy would use something like StepMessages for MVC, which however do not exist as of today." + project world + when: #aboutToLeaveWorld send: #pauseAutoUpdate to: self; + when: #aboutToEnterWorld send: #startAutoUpdate to: self]. + + self updateProcessList.! - self isAutoUpdating - ifFalse: [autoUpdateProcess := [[self hasView] - whileTrue: [(Delay forSeconds: 2) wait. - Project current addDeferredUIMessage: [self updateProcessList]]. - autoUpdateProcess := nil] fork]. - self updateProcessList - !

1 0

The Trunk: Tools-ct.1158.mcz
by commits＠source.squeak.org 20 May '22

20 May '22

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1158.mcz ==================== Summary ==================== Name: Tools-ct.1158 Author: ct Time: 17 May 2022, 1:04:37.206327 pm UUID: 1cb879ce-2df7-174b-b4ba-d443e4fdc011 Ancestors: Tools-mt.1157 Do not update process browsers from inactive projects. Before this fix, an auto-updating process browser from a Morphic project would raise periodic errors after entering an MVC project, and an auto-updating process browser from a MVC project would cause spooky screen updates after entering a Morphic project. Note that a better solution strategy would consist of something like StepMessages for MVC, which however do not exist as of today. =============== Diff against Tools-mt.1157 =============== Item was changed: ----- Method: ProcessBrowser>>startAutoUpdate (in category 'updating') ----- startAutoUpdate self isAutoUpdatingPaused ifTrue: [^ autoUpdateProcess resume]. + self isAutoUpdating ifFalse: + [| project | + project := Project current. + autoUpdateProcess := + [[[self hasView] whileTrue: + [2 seconds wait. + project addDeferredUIMessage: [self updateProcessList]]. + autoUpdateProcess := nil] + ensure: [self removeActionsForEvent: #aboutToEnterWorld]] fork. + project world + when: #aboutToLeaveWorld send: #pauseAutoUpdate to: self; + when: #aboutToEnterWorld send: #startAutoUpdate to: self]. + self updateProcessList.! - self isAutoUpdating - ifFalse: [autoUpdateProcess := [[self hasView] - whileTrue: [(Delay forSeconds: 2) wait. - Project current addDeferredUIMessage: [self updateProcessList]]. - autoUpdateProcess := nil] fork]. - self updateProcessList - !

1 0

The Trunk: SUnitTools-ct.8.mcz
by commits＠source.squeak.org 19 May '22

19 May '22

Christoph Thiede uploaded a new version of SUnitTools to project The Trunk: http://source.squeak.org/trunk/SUnitTools-ct.8.mcz ==================== Summary ==================== Name: SUnitTools-ct.8 Author: ct Time: 19 May 2022, 3:27:28.23078 pm UUID: f0974632-3f1a-9645-acb5-b3549da9493f Ancestors: SUnitTools-mt.7 Fixes redundant dialog when finding a test case, there is no one, and you already have declined to create one. Improves multilingual support. =============== Diff against SUnitTools-mt.7 =============== Item was changed: ----- Method: CodeHolder>>testAskToCreateNewTest: (in category '*SUnitTools-running') ----- testAskToCreateNewTest: className | newClass | + (self confirm: 'Test class not found. Create one?' translated) ifFalse: [^ false]. - (self confirm: 'Test class not found. Create one?') ifFalse: [^ false]. (ClassBuilder new) name: className asSymbol inEnvironment: self selectedClass environment subclassOf: TestCase type: #normal instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: ((self selectedClass category includes: $-) ifTrue: [((self selectedClass category copyUpToLast: $-), '-Tests')] ifFalse: [(self selectedClass category, 'Tests')]) asSymbol. newClass := self selectedClass environment classNamed: className asSymbol. newClass organization addCategory: #tests. ^ true! Item was changed: ----- Method: CodeHolder>>testFindTest (in category '*SUnitTools-running') ----- testFindTest | cls destClassName destMessage | cls := self selectedClass ifNil: [^ self]. destClassName := cls name asString, 'Test'. destMessage := self selectedMessageName ifNotNil: [:name | self testSelectorFrom: name]. + self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage.! - (self testBrowseClassNamed: destClassName possibleMessageNamed: destMessage) - ifFalse: [self inform: ('There is no test for {1}' translated - format: {self selectedMessageName ifNil: [cls]})].!

1 0

The Trunk: Morphic-ct.1996.mcz
by commits＠source.squeak.org 19 May '22

19 May '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1996.mcz ==================== Summary ==================== Name: Morphic-ct.1996 Author: ct Time: 19 May 2022, 1:40:21.91678 pm UUID: c5d98422-2327-ec47-be89-46b500eded98 Ancestors: Morphic-ct.1995 Adds missing clean up to FontImporter. =============== Diff against Morphic-ct.1995 =============== Item was added: + ----- Method: FontImporterTool class>>cleanUp: (in category 'initialize-release') ----- + cleanUp: aggressive + + aggressive ifTrue: [CustomPreviewTexts := nil].!

1 0

The Trunk: Morphic-ct.1995.mcz
by commits＠source.squeak.org 19 May '22

19 May '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1995.mcz ==================== Summary ==================== Name: Morphic-ct.1995 Author: ct Time: 19 May 2022, 1:37:52.24378 pm UUID: 1038219c-e48a-6a4b-a241-07e6a9d2ec25 Ancestors: Morphic-ct.1993 Fixes canceling (Cmd + L) in FontImporter's custom preview text pane. In the past, the custom text did not disappear but only the change indication disappeared. =============== Diff against Morphic-ct.1993 =============== Item was added: + ----- Method: FontImporterTool>>okToRevertChanges: (in category 'preview text') ----- + okToRevertChanges: aspect + + aspect = #editCustomPreviewText: ifTrue: [self editCustomPreviewText: nil]. + ^ true!

1 0

The Trunk: Morphic-ct.1993.mcz
by commits＠source.squeak.org 19 May '22

19 May '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1993.mcz ==================== Summary ==================== Name: Morphic-ct.1993 Author: ct Time: 19 May 2022, 1:16:17.15278 pm UUID: c13fb281-6fda-5840-8e1f-c731f8d692c8 Ancestors: Morphic-ct.1992, Morphic-ct.1991 Merge commit. =============== Diff against Morphic-ct.1992 =============== Item was changed: ----- Method: PasteUpMorph>>windowEvent: (in category 'event handling') ----- windowEvent: anEvent + self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. + - anEvent type caseOf: { [#windowClose] -> [ Preferences eToyFriendly ifTrue: [ProjectNavigationMorph basicNew quitSqueak] ifFalse: [TheWorldMenu basicNew quitSession]]. [#windowDeactivated] -> [ + "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the externally controlled keyboard focus." + (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | + "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." + hostFocus active: false]. + self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new + in: [:hostFocus | + hostFocus previousFocus: anEvent hand keyboardFocus. + anEvent hand newKeyboardFocus: hostFocus. + Preferences mouseOverForKeyboardFocus ifTrue: [ + hostFocus previousMouseOverForKeyboardFocus: true. + Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]]; + yourself)]. - "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the keyboard focus." - (self valueOfProperty: #windowHostFocusMorph ifAbsentPut: [ - Morph new - name: #windowHostFocusMorph; - yourself]) in: [:hostFocus | - hostFocus setProperty: #previousFocus toValue: anEvent hand keyboardFocus. - anEvent hand newKeyboardFocus: hostFocus. - Preferences mouseOverForKeyboardFocus ifTrue: [ - hostFocus setProperty: #previousMouseOverForKeyboardFocus toValue: true. - Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]]]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder and the #mouseOverForKeyboardFocus preference." + (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | + hostFocus active: false. + (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue: + [anEvent hand newKeyboardFocus: hostFocus previousFocus]. + hostFocus previousMouseOverForKeyboardFocus ifNotNil: [:value | + Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]]]. } - self valueOfProperty: #windowHostFocusMorph ifPresentDo: [:hostFocus | - hostFocus abandon. - (hostFocus valueOfProperty: #previousFocus) ifNotNil: [:previousFocus | - anEvent hand newKeyboardFocus: previousFocus]. - (hostFocus valueOfProperty: #previousMouseOverForKeyboardFocus) ifNotNil: [:value | - Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]. - self removeProperty: #windowHostFocusMorph]]. } otherwise: []! Item was added: + Morph subclass: #WindowHostFocusMorph + instanceVariableNames: 'active previousFocus previousMouseOverForKeyboardFocus' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Worlds'! + + !WindowHostFocusMorph commentStamp: 'ct 5/18/2022 12:41' prior: 0! + I represent the host system as a focus holder, i.e., I receive the keyboard focus when the VM looses the keyboard focus. See PasteUpMorph>>#windowEvent:.! Item was added: + ----- Method: WindowHostFocusMorph>>active (in category 'accessing') ----- + active + + ^ active! Item was added: + ----- Method: WindowHostFocusMorph>>active: (in category 'accessing') ----- + active: aBoolean + + active := aBoolean.! Item was added: + ----- Method: WindowHostFocusMorph>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self active: true.! Item was added: + ----- Method: WindowHostFocusMorph>>keyboardFocusDelegate (in category 'event handling') ----- + keyboardFocusDelegate + "When the receiver was remembered as a prior keyboard focus in place of the previous focus morph, answer that previous morph as a keyboard focus delegate so that re-passing the focus to it works. For instance, this happens when a DialogWindow is invoked while the VM does not have the keyboard focus (e.g., when attempting to close the VM window from the outside)." + + self flag: #forLater. "Preferably, we would even *prevent* other morphs from receiving the keyboard focus through this surrogate. However, there is currently no hook #okToChangeKeyboardFocus: in HandMorph>>#newKeyboardFocus: and re-setting the focus unagreedly might cause trouble in other focus holders." + + self active ifTrue: [^ self]. + ^ self previousFocus ifNotNil: [:morph | morph keyboardFocusDelegate]! Item was added: + ----- Method: WindowHostFocusMorph>>previousFocus (in category 'accessing') ----- + previousFocus + + ^ previousFocus! Item was added: + ----- Method: WindowHostFocusMorph>>previousFocus: (in category 'accessing') ----- + previousFocus: aMorph + + previousFocus := aMorph.! Item was added: + ----- Method: WindowHostFocusMorph>>previousMouseOverForKeyboardFocus (in category 'accessing') ----- + previousMouseOverForKeyboardFocus + + ^ previousMouseOverForKeyboardFocus! Item was added: + ----- Method: WindowHostFocusMorph>>previousMouseOverForKeyboardFocus: (in category 'accessing') ----- + previousMouseOverForKeyboardFocus: aBoolean + + previousMouseOverForKeyboardFocus := aBoolean.!

1 0

The Trunk: Morphic-ct.1991.mcz
by commits＠source.squeak.org 19 May '22

19 May '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1991.mcz ==================== Summary ==================== Name: Morphic-ct.1991 Author: ct Time: 18 May 2022, 1:15:26.246371 pm UUID: 8c165900-282b-4b69-93c0-e61b23b4f6fd Ancestors: Morphic-nice.1989 Increases robustness of #windowHostFocusMorph to honor some facts: - Currently, there is no exact-once guarantee by the VM for the recording of #windowActivated and #windowDeactived events. - It is also possible that new morphs temporarily change the keyboard focus while the host focus morph is active, e.g., dialog windows due to an asynchronous operation or an attempt to close the VM window while it is not active (actually, some window managers always disable the window when closing it via the taskbar/Alt + F4). To fix this, extract the host focus as a class (WindowHostFocusMorph) that overrides #keyboardFocusDelegate. When another client stores the keyboard focus before changing it (for instance, see priorKeyboardFocus in DialogWindow>>#getUserResponse), any attempt to restore that focus later will pass it back to the original previousFocus. Before resetting the keyboard focus on #windowActivate:, make sure that the host focus morph still has the keyboard focus. Please test again with all your crazy window managers and shortcuts out there. =) Thanks to Chris (cmm) for the report and Marcel (mt) for the help! =============== Diff against Morphic-nice.1989 =============== Item was changed: ----- Method: PasteUpMorph>>windowEvent: (in category 'event handling') ----- windowEvent: anEvent + self windowEventHandler ifNotNil: [^self windowEventHandler windowEvent: anEvent]. + - anEvent type caseOf: { [#windowClose] -> [ Preferences eToyFriendly ifTrue: [ProjectNavigationMorph basicNew quitSqueak] ifFalse: [TheWorldMenu basicNew quitSession]]. [#windowDeactivated] -> [ + "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the externally controlled keyboard focus." + (self valueOfProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | + "There is currently no exact-once guarantee for this event type from the VM. Mark any older host focus morph as inactive, it will be held as the previousFocus of the next host focus morph." + hostFocus active: false]. + self setProperty: #windowHostFocusMorph toValue: (WindowHostFocusMorph new + in: [:hostFocus | + hostFocus previousFocus: anEvent hand keyboardFocus. + anEvent hand newKeyboardFocus: hostFocus. + Preferences mouseOverForKeyboardFocus ifTrue: [ + hostFocus previousMouseOverForKeyboardFocus: true. + Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]]; + yourself)]. - "The host window has been deactivated. Until it regains the focus, honor the fact that we will not receive keyboard events again by changing the current keyboard focus morph. windowHostFocusMorph represents the host system which now holds the keyboard focus instead of the previousFocus. If enabled, disable #mouseOverForKeyboardFocus temporarily because when inactive, we *can't* set the keyboard focus." - (self valueOfProperty: #windowHostFocusMorph ifAbsentPut: [ - Morph new - name: #windowHostFocusMorph; - yourself]) in: [:hostFocus | - hostFocus setProperty: #previousFocus toValue: anEvent hand keyboardFocus. - anEvent hand newKeyboardFocus: hostFocus. - Preferences mouseOverForKeyboardFocus ifTrue: [ - hostFocus setProperty: #previousMouseOverForKeyboardFocus toValue: true. - Preferences setPreference: #mouseOverForKeyboardFocus toValue: false]]]. [#windowActivated] -> [ "Alright, the spook is over!! We have back control over the keyboard focus, delete the windowHostFocusMorph and restore the previous focus holder and the #mouseOverForKeyboardFocus preference." + (self removeProperty: #windowHostFocusMorph) ifNotNil: [:hostFocus | + hostFocus active: false. + (anEvent hand keyboardFocus == hostFocus and: [hostFocus previousFocus notNil]) ifTrue: + [anEvent hand newKeyboardFocus: hostFocus previousFocus]. + hostFocus previousMouseOverForKeyboardFocus ifNotNil: [:value | + Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]]]. } - self valueOfProperty: #windowHostFocusMorph ifPresentDo: [:hostFocus | - hostFocus abandon. - (hostFocus valueOfProperty: #previousFocus) ifNotNil: [:previousFocus | - anEvent hand newKeyboardFocus: previousFocus]. - (hostFocus valueOfProperty: #previousMouseOverForKeyboardFocus) ifNotNil: [:value | - Preferences setPreference: #mouseOverForKeyboardFocus toValue: value]. - self removeProperty: #windowHostFocusMorph]]. } otherwise: []! Item was added: + Morph subclass: #WindowHostFocusMorph + instanceVariableNames: 'active previousFocus previousMouseOverForKeyboardFocus' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Worlds'! + + !WindowHostFocusMorph commentStamp: 'ct 5/18/2022 12:41' prior: 0! + I represent the host system as a focus holder, i.e., I receive the keyboard focus when the VM looses the keyboard focus. See PasteUpMorph>>#windowEvent:.! Item was added: + ----- Method: WindowHostFocusMorph>>active (in category 'accessing') ----- + active + + ^ active! Item was added: + ----- Method: WindowHostFocusMorph>>active: (in category 'accessing') ----- + active: aBoolean + + active := aBoolean.! Item was added: + ----- Method: WindowHostFocusMorph>>initialize (in category 'initialization') ----- + initialize + + super initialize. + + self active: true.! Item was added: + ----- Method: WindowHostFocusMorph>>keyboardFocusDelegate (in category 'event handling') ----- + keyboardFocusDelegate + "When the receiver was remembered as a prior keyboard focus in place of the previous focus morph, answer that previous morph as a keyboard focus delegate so that re-passing the focus to it works. For instance, this happens when a DialogWindow is invoked while the VM does not have the keyboard focus (e.g., when attempting to close the VM window from the outside)." + + self flag: #forLater. "Preferably, we would even *prevent* other morphs from receiving the keyboard focus through this surrogate. However, there is currently no hook #okToChangeKeyboardFocus: in HandMorph>>#newKeyboardFocus: and re-setting the focus unagreedly might cause trouble in other focus holders." + + self active ifTrue: [^ self]. + ^ self previousFocus ifNotNil: [:morph | morph keyboardFocusDelegate]! Item was added: + ----- Method: WindowHostFocusMorph>>previousFocus (in category 'accessing') ----- + previousFocus + + ^ previousFocus! Item was added: + ----- Method: WindowHostFocusMorph>>previousFocus: (in category 'accessing') ----- + previousFocus: aMorph + + previousFocus := aMorph.! Item was added: + ----- Method: WindowHostFocusMorph>>previousMouseOverForKeyboardFocus (in category 'accessing') ----- + previousMouseOverForKeyboardFocus + + ^ previousMouseOverForKeyboardFocus! Item was added: + ----- Method: WindowHostFocusMorph>>previousMouseOverForKeyboardFocus: (in category 'accessing') ----- + previousMouseOverForKeyboardFocus: aBoolean + + previousMouseOverForKeyboardFocus := aBoolean.!

1 0

The Trunk: Morphic-ct.1992.mcz
by commits＠source.squeak.org 19 May '22

19 May '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1992.mcz ==================== Summary ==================== Name: Morphic-ct.1992 Author: ct Time: 19 May 2022, 1:05:51.720811 pm UUID: e34ae1a2-84eb-1b44-99b2-fbac49184200 Ancestors: Morphic-nice.1989 Complements Morphic-ct.1659 and has dialog windows' menu box act on mouseDown as well. =============== Diff against Morphic-nice.1989 =============== Item was changed: ----- Method: DialogWindow>>createTitle: (in category 'initialization') ----- createTitle: aString "Mimick behavior of MenuMorph title creation." | box closeButton menuButton | box := Morph new name: #title; changeTableLayout; listDirection: #leftToRight; yourself. titleMorph := aString asText asMorph lock. closeButton := SystemWindowButton new color: Color transparent; target: self; extent: 12@12; actionSelector: #cancelDialog; balloonText: 'Cancel this dialog' translated; borderWidth: 0; visible: self class includeCloseButton; yourself. SystemWindow closeBoxImage scaleIconToDisplay in: [:icon | closeButton labelGraphic: icon; extent: icon extent]. menuButton := SystemWindowButton new color: Color transparent; target: self; actionSelector: #offerDialogMenu; balloonText: 'Dialog menu' translated; + actWhen: #buttonDown; borderWidth: 0; visible: self class includeControlMenu; yourself. SystemWindow menuBoxImage scaleIconToDisplay in: [:icon | menuButton labelGraphic: icon; extent: icon extent]. box addAllMorphs: {closeButton. titleMorph. menuButton}. self addMorphBack: box. self setTitleParameters.!

1 0

The Trunk: SMLoader-ct.98.mcz
by commits＠source.squeak.org 18 May '22

18 May '22

Christoph Thiede uploaded a new version of SMLoader to project The Trunk: http://source.squeak.org/trunk/SMLoader-ct.98.mcz ==================== Summary ==================== Name: SMLoader-ct.98 Author: ct Time: 18 May 2022, 7:28:33.967874 pm UUID: 86668f56-4011-d34c-bc66-a69a58e6898d Ancestors: SMLoader-mt.97 Improves multilingual support and fixes broken link to swiki. Moves from UIManager default to Project uiManager. =============== Diff against SMLoader-mt.97 =============== Item was changed: ----- Method: SMClient>>ensurePassword (in category 'private') ----- ensurePassword + self password isEmptyOrNil ifTrue: [ self password: (Project uiManager requestPassword: 'Please enter your SqueakMap password.' translated) ]. - self password isEmptyOrNil ifTrue: [ self password: (UIManager default requestPassword: 'Please enter your SqueakMap password.') ]. self password isEmptyOrNil ifTrue: [ self error: 'authentication failure' ]! Item was changed: ----- Method: SMLoader>>cachePackageReleaseAndOfferToCopy (in category 'actions') ----- cachePackageReleaseAndOfferToCopy "Cache package release, then offer to copy it somewhere. Answer the chosen file's location after copy, or the cache location if no directory was chosen." | release installer newDir newName newFile oldFile oldName | release := self selectedPackageOrRelease. release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. installer := SMInstaller forPackageRelease: release. [Cursor wait showWhile: [installer cache]] on: Error do: [:ex | | msg | msg := ex messageText ifNil: [ex asString]. + self informException: ex msg: ('Error occurred during download:\\{1}' translated format: {msg}). - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs. ^nil ]. + installer isCached ifFalse: [self inform: 'Download failed, see transcript for details' translated. ^nil]. - installer isCached ifFalse: [self inform: 'Download failed, see transcript for details'. ^nil]. oldName := installer fullFileName. + newDir := Project uiManager chooseDirectoryFrom: installer directory. - newDir := UIManager default chooseDirectoryFrom: installer directory. newDir ifNil: [ ^oldName ]. newDir = installer directory ifTrue: [ ^oldName ]. newName := newDir fullNameFor: installer fileName. newFile := FileStream newFileNamed: newName. newFile ifNil: [ ^oldName ]. newFile binary. oldFile := FileStream readOnlyFileNamed: oldName. oldFile ifNil: [ ^nil ]. oldFile binary. [[ newDir copyFile: oldFile toFile: newFile ] ensure: [ oldFile close. newFile close ]] on: Error do: [ :ex | ^oldName ]. ^newName! Item was changed: ----- Method: SMLoaderCategoricalPlus>>defaultLabel (in category 'interface') ----- defaultLabel + ^ 'Categorical {1}' translated format: {super defaultLabel}! - ^ 'Categorical ' , super defaultLabel! Item was changed: ----- Method: SMLoaderCategoricalPlus>>installButtonLabel (in category 'interface') ----- installButtonLabel ^ self currentPackageList = #notInstalled + ifTrue: ['Install the above package' translated] + ifFalse: ['Remove the above package' translated]! - ifTrue: ['Install the above package'] - ifFalse: ['Remove the above package']! Item was changed: ----- Method: SMLoaderPlus>>addFiltersToMenu: (in category 'menus') ----- addFiltersToMenu: aMenu | filterSymbol help | self filterSpecs do: [:filterArray | filterSymbol := filterArray second. help := filterArray third. aMenu addUpdating: #showFilterString: target: self selector: #toggleFilterState: argumentList: (Array with: filterSymbol). aMenu balloonTextForLastItem: help]. aMenu addLine; + addTranslatedList: #(('Clear all filters' uncheckFilters 'Unchecks all filters to list all packages')) - addList: #(('Clear all filters' uncheckFilters 'Unchecks all filters to list all packages')) ! Item was changed: ----- Method: SMLoaderPlus>>buildPackagePaneWith: (in category 'interface') ----- buildPackagePaneWith: aBuilder "Create the text area to the right in the loader." ^ aBuilder pluggableTextSpec new model: self; getText: #itemDescription; name: #packagePane; + help: 'Select a package to view its description.' translated; - help: 'Select a package to view its description.'; yourself! Item was changed: ----- Method: SMLoaderPlus>>buildSearchPaneWith: (in category 'interface') ----- buildSearchPaneWith: aBuilder ^ aBuilder pluggableInputFieldSpec new model: self; selection: #searchSelection; setText: #findPackage:notifying:; + help: 'Search packages...' translated; - help: 'Search packages...'; name: #search; yourself! Item was changed: ----- Method: SMLoaderPlus>>cachePackageReleaseAndOfferToCopy (in category 'actions') ----- cachePackageReleaseAndOfferToCopy "Cache package release, then offer to copy it somewhere. Answer the chosen file's location after copy, or the cache location if no directory was chosen." | release installer newDir newName newFile oldFile oldName | release := self selectedPackageOrRelease. + release isPackageRelease ifFalse: [ self error: 'Should be a package release!!' translated]. - release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. installer := SMInstaller forPackageRelease: release. + [Project uiManager informUser: ('Caching {1}' translated format: {release}) during: [installer cache]] on: Error do: [:ex | - [UIManager default informUser: 'Caching ' , release asString during: [installer cache]] on: Error do: [:ex | | msg | msg := ex messageText ifNil: [ex asString]. + self informException: ex msg: ('Error occurred during download:\\{1}' withCRs translated format: {msg}). - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs. ^nil ]. + installer isCached ifFalse: [self inform: 'Download failed, see transcript for details' translated. ^nil]. - installer isCached ifFalse: [self inform: 'Download failed, see transcript for details'. ^nil]. oldName := installer fullFileName. + newDir := Project uiManager chooseDirectoryFrom: installer directory. - newDir := UIManager default chooseDirectoryFrom: installer directory. newDir ifNil: [ ^oldName ]. newDir = installer directory ifTrue: [ ^oldName ]. newName := newDir fullNameFor: installer fileName. newFile := FileStream newFileNamed: newName. newFile ifNil: [ ^oldName ]. newFile binary. oldFile := FileStream readOnlyFileNamed: oldName. oldFile ifNil: [ ^nil ]. oldFile binary. [[ newDir copyFile: oldFile toFile: newFile ] ensure: [ oldFile close. newFile close ]] on: Error do: [ :ex | ^oldName ]. ^newName! Item was changed: ----- Method: SMLoaderPlus>>defaultLabel (in category 'lists') ----- defaultLabel + ^ 'SqueakMap Package Loader' translated! - ^ 'SqueakMap Package Loader'! Item was changed: ----- Method: SMLoaderPlus>>downloadPackageRelease (in category 'actions') ----- downloadPackageRelease "Force a download of the selected package release into the cache." | release | release := self selectedPackageOrRelease. + release isPackageRelease ifFalse: [ self error: 'Should be a package release!!' translated]. + [Project uiManager informUser: ('Downloading {1}' translated format: {release}) during: [ - release isPackageRelease ifFalse: [ self error: 'Should be a package release!!']. - [UIManager default informUser: 'Downloading ' , release asString during: [ (SMInstaller forPackageRelease: release) download] ] on: Error do: [:ex | | msg | msg := ex messageText ifNil: [ex asString]. + self informException: ex msg: ('Error occurred during download:\\{1}' translated format: {msg})]! - self informException: ex msg: ('Error occurred during download:\', msg, '\') withCRs]! Item was changed: ----- Method: SMLoaderPlus>>findPackage:notifying: (in category 'actions') ----- findPackage: aString notifying: aView "Search and select a package with the given (sub) string in the name or description. " | index list match descriptions | match := aString asString asLowercase. index := self packagesListIndex. list := self packageNameList. list isEmpty ifTrue: [^ self]. descriptions := self packageList collect: [:e | e description]. index + 1 to: list size do: [:i | (((list at: i) includesSubstring: match caseSensitive: false) or: [(descriptions at: i) includesSubstring: match caseSensitive: false]) ifTrue: [^ self packagesListIndex: i]]. "wrap around" 1 to: index do: [:i | (((list at: i) includesSubstring: match caseSensitive: false) or: [(descriptions at: i) includesSubstring: match caseSensitive: false]) ifTrue: [^ self packagesListIndex: i]]. + self inform: ('No package matching {1}' translated format: {aString})! - self inform: 'No package matching ' , aString asString! Item was changed: ----- Method: SMLoaderPlus>>help (in category 'interface') ----- help "Present help text. If there is a web server available, offer to open it. Use the WebBrowser registry if possible, or Scamper if available." | message browserClass | + message := 'Welcome to the SqueakMap package loader. The names of packages are followed by versions: (installed -> latest). If there is no arrow, your installed version of the package is the latest. Bold packages and releases have been installed. The checkbox menu items modify which packages you''ll see. + Take a look at them - only some packages are shown initially. The options available for a package depend on how it was packaged. Comment on a package by emailing the author or the squeak list.' translated. - message := 'Welcome to the SqueakMap package loader. - The names of packages are followed by versions: (installed -> latest). - If there is no arrow, your installed version of the package is the latest. - Bold packages and releases have been installed. - The checkbox menu items modify which packages you''ll see. - Take a look at them - only some packages are shown initially. - The options available for a package depend on how it was packaged. - Comment on a package by emailing the author or the squeak list.'. browserClass := Smalltalk at: #WebBrowser ifPresent: [ :registry | registry default ]. browserClass := browserClass ifNil: [ Smalltalk at: #Scamper ifAbsent: [ ^self inform: message ]]. + (self confirm: ('{1}\\Would you like to view more detailed help on the SqueakMap swiki page?' translated format: {message})) + ifTrue: [ browserClass openOnUrl: 'http://wiki.squeak.org/squeak/2726' asUrl]! - (self confirm: message, ' - Would you like to view more detailed help on the SqueakMap swiki page?') - ifTrue: [ browserClass openOnUrl: 'http://wiki.squeak.org/2726' asUrl]! Item was changed: ----- Method: SMLoaderPlus>>informException:msg: (in category 'private') ----- informException: ex msg: msg "Tell the user that an error has occurred. Offer to open debug notifier." + (self confirm: ('{1}\\Would you like to open a debugger?' translated format: {msg})) - (self confirm: msg, 'Would you like to open a debugger?') ifTrue: [ex pass]! Item was changed: ----- Method: SMLoaderPlus>>installPackageRelease (in category 'actions') ----- installPackageRelease "Install selected package or release. The cache is used." | item release | item := self selectedPackageOrRelease ifNil: [^ nil]. item isPackageRelease ifTrue: [^ self installPackageRelease: item] ifFalse: [release := item lastReleaseForCurrentSystemVersion. release + ifNil: [(self confirm: 'The package has no published release for your Squeak version, try releases for any Squeak version?' translated) - ifNil: [(self confirm: 'The package has no published release for your Squeak version, try releases for any Squeak version?') ifTrue: [release := item lastPublishedRelease. release + ifNil: [(self confirm: 'The package has no published release at all, take the latest of the unpublished releases?' translated) - ifNil: [(self confirm: 'The package has no published release at all, take the latest of the unpublished releases?') ifTrue: [release := item lastRelease]]]]. release ifNotNil: [^ self installPackageRelease: release]]! Item was changed: ----- Method: SMLoaderPlus>>installPackageRelease: (in category 'private') ----- installPackageRelease: aRelease "Install a package release. The cache is used." | myRelease installer | aRelease isCompatibleWithCurrentSystemVersion ifFalse: [(self confirm: + ('The package you are about to install is not listed as being compatible with your image version ({1}), so the package may not work properly. + + Do you still want to proceed with the install?' translated format: {SystemVersion current majorMinorVersion})) - 'The package you are about to install is not listed as - being compatible with your image version (', SystemVersion current majorMinorVersion, '), - so the package may not work properly. - Do you still want to proceed with the install?') ifFalse: [^ self]]. myRelease := self installedReleaseOfMe. installer := SMInstaller forPackageRelease: aRelease. + [Project uiManager + informUser: ('Downloading {1}' translated format: {aRelease}) during: + [installer download]; + informUser: ('Installing {1}' translated format: {aRelease}) during: + [installer install. + myRelease = self installedReleaseOfMe + ifFalse: [self reOpen] + ifTrue: [self noteChanged]] - [UIManager default informUser: 'Downloading ' , aRelease asString during: - [installer download]. - UIManager default informUser: 'Installing ' , aRelease asString during: [ - installer install. - myRelease = self installedReleaseOfMe - ifFalse: [self reOpen] - ifTrue: [self noteChanged]] ] on: Error do: [:ex | | msg | msg := ex messageText ifNil:[ex asString]. + self informException: ex msg: ('Error occurred during install:\\{1}' withCRs translated format: {msg})].! - self informException: ex msg: ('Error occurred during install:\', msg, '\') withCRs].! Item was changed: ----- Method: SMLoaderPlus>>labelForShown: (in category 'lists') ----- labelForShown: packagesShown "Update the label of the window." + ^ (packagesShown size < map packages size + ifTrue: ['{1} ({2} shown out of {2} packages)' translated] + ifFalse: ['{1} ({3} packages)' translated]) + format: + {self defaultLabel. + packagesShown size. + map packages size}! - ^ self defaultLabel , ' (', - (packagesShown size < map packages size ifTrue: [packagesShown size printString, - ' shown out of '] ifFalse: ['']) , map packages size printString, ' packages)'! Item was changed: ----- Method: SMLoaderPlus>>loadUpdates (in category 'actions') ----- loadUpdates + [Project uiManager informUser: 'Loading updates' translated during: [ - [UIManager default informUser: 'Loading Updates' during: [ map loadUpdates. self noteChanged ] ] on: Error do: [:ex | + self informException: ex msg: ('Error occurred when updating map:\\{1}' translated format: {ex messageText})]! - self informException: ex msg: ('Error occurred when updating map:\', ex messageText, '\') withCRs]! Item was changed: ----- Method: SMLoaderPlus>>reOpen (in category 'private') ----- reOpen "Close this package loader, probably because it has been updated, and open a new one." + self inform: 'This package loader has been upgraded and will be closed and reopened to avoid strange side effects.' translated. - self inform: 'This package loader has been upgraded and will be closed and reopened to avoid strange side effects.'. window delete. (Smalltalk at: self class name) open! Item was changed: ----- Method: SMLoaderPlus>>upgradeInstalledPackages (in category 'actions') ----- upgradeInstalledPackages "Tries to upgrade all installed packages to the latest published release for this version of Squeak. So this is a conservative approach." | installed old myRelease toUpgrade info | installed := map installedPackages. old := map oldPackages. old isEmpty ifTrue: [ + ^self inform: ('All {1} installed packages are up to date.' translated format: {installed size})]. - ^self inform: 'All ', installed size printString, ' installed packages are up to date.']. toUpgrade := map upgradeableAndOldPackages. toUpgrade isEmpty ifTrue: [ + ^self inform: ('None of the {1} old packages of the {2} installed can be automatically upgraded. You need to upgrade them manually.' translated format: {old size. installed size})]. - ^self inform: 'None of the ', old size printString, ' old packages of the ', installed size printString, ' installed can be automatically upgraded. You need to upgrade them manually.']. info := old size < toUpgrade size ifTrue: [ + 'Of the {1} old packages only {2} can be upgraded. The following packages will not be upgraded:\\{3}' withCRs translated format: {old size. toUpgrade size. String streamContents: [:s | (old removeAll: toUpgrade; yourself) + do: [:p | s nextPutAll: p nameWithVersionLabel; cr]]}] + ifFalse: ['All old packages upgradeable.' translated]. + (self confirm: ('{1}\\About to upgrade the following packages:\\{2}\\Proceed?' translated format: {info. String streamContents: [:s | toUpgrade do: [:p | s nextPutAll: p nameWithVersionLabel; cr]]})) ifTrue: [ - 'Of the ', old size printString, ' old packages only ', toUpgrade size printString, ' can be upgraded. - The following packages will not be upgraded: - ', (String streamContents: [:s | (old removeAll: toUpgrade; yourself) - do: [:p | s nextPutAll: p nameWithVersionLabel; cr]])] - ifFalse: ['All old packages upgradeable.']. - (self confirm: info, ' - About to upgrade the following packages: - ', (String streamContents: [:s | toUpgrade do: [:p | s nextPutAll: p nameWithVersionLabel; cr]]), 'Proceed?') ifTrue: [ myRelease := self installedReleaseOfMe. + [Project uiManager informUser: 'Upgrading installed packages' translated during: [ - [UIManager default informUser: 'Upgrading Installed Packages' during: [ map upgradeOldPackages. + self inform: ('{1} packages successfully upgraded.' translated format: {toUpgrade size}). - self inform: toUpgrade size printString, ' packages successfully upgraded.'. myRelease = self installedReleaseOfMe ifFalse: [self reOpen] ifTrue: [self noteChanged]] ] on: Error do: [:ex | + self informException: ex msg: ('Error occurred when upgrading old packages:\\{1}' withCRs translated format: {ex messageText})]]! - self informException: ex msg: ('Error occurred when upgrading old packages:\', ex messageText, '\') withCRs]]! Item was changed: ----- Method: SMLoaderPlus>>upgradeInstalledPackagesConfirm: (in category 'private') ----- upgradeInstalledPackagesConfirm: confirmEach "Tries to upgrade all installed packages to the latest published release for this version of Squeak. If confirmEach is true we ask for every upgrade. " | installed old myRelease toUpgrade info | installed := map installedPackages. old := map oldPackages. old isEmpty + ifTrue: [^ self inform: ('All {1} installed packages are up to date.' translated format: {installed size})]. - ifTrue: [^ self inform: 'All ' , installed size printString , ' installed packages are up to date.']. toUpgrade := map upgradeableAndOldPackages. toUpgrade isEmpty + ifTrue: [^ self inform: ('None of the {1} old packages of the {1} installed can be automatically upgraded. You need to upgrade them manually.' translated format: {old size. installed size})]. - ifTrue: [^ self inform: 'None of the ' , old size printString , ' old packages of the ' , installed size printString , ' installed can be automatically upgraded. You need to upgrade them manually.']. info := old size < toUpgrade size + ifTrue: [('Of the {1} old packages only {2} can be upgraded.\\The following packages will not be upgraded:\\{3}' withCRs translated format: {old size. toUpgrade size. String - ifTrue: ['Of the ' , old size printString , ' old packages only ' , toUpgrade size printString , ' can be upgraded. - The following packages will not be upgraded: - ' - , (String streamContents: [:s | (old removeAll: toUpgrade; yourself) do: [:p | s nextPutAll: p nameWithVersionLabel; + cr]]})] + ifFalse: ['All old packages upgradeable.' translated]. + (self confirm: ('{1}\\About to upgrade the following packages:\\{2}\\Proceed?' withCRs translated format: {info. String - cr]])] - ifFalse: ['All old packages upgradeable.']. - (self confirm: info , ' - About to upgrade the following packages: - ' - , (String streamContents: [:s | toUpgrade do: [:p | s nextPutAll: p nameWithVersionLabel; + cr]]})) - cr]]) , 'Proceed?') ifTrue: [myRelease := self installedReleaseOfMe. + [Project uiManager informUser: 'Upgrading installed packages' translated during: - [UIManager default informUser: 'Upgrading Installed Packages' during: [confirmEach ifTrue: [map + upgradeOldPackagesConfirmBlock: [:p | self confirm: ('Upgrade {1} to {2}?' translated format: {p installedRelease packageNameWithVersion. (p lastPublishedReleaseForCurrentSystemVersionNewerThan: p installedRelease) listName})]] - upgradeOldPackagesConfirmBlock: [:p | self confirm: 'Upgrade ' , p installedRelease packageNameWithVersion , ' to ' , (p lastPublishedReleaseForCurrentSystemVersionNewerThan: p installedRelease) listName , '?']] ifFalse: [map upgradeOldPackages]. + self inform: ('{1} packages successfully processed.' translated format: {toUpgrade size}). - self inform: toUpgrade size printString , ' packages successfully processed.'. myRelease = self installedReleaseOfMe ifTrue: [self noteChanged] ifFalse: [self reOpen]]] on: Error + do: [:ex | self informException: ex msg: ('Error occurred when upgrading old packages:\\{1}' withCRs translated format: {ex messageText})]]! - do: [:ex | self informException: ex msg: ('Error occurred when upgrading old packages:\' , ex messageText , '\') withCRs]]! Item was changed: ----- Method: SMReleaseBrowser>>userError: (in category 'private') ----- userError: aString + Project uiManager inform: aString! - UIManager default inform: aString!

1 0

The Trunk: SMBase-ct.146.mcz
by commits＠source.squeak.org 18 May '22

18 May '22

Christoph Thiede uploaded a new version of SMBase to project The Trunk: http://source.squeak.org/trunk/SMBase-ct.146.mcz ==================== Summary ==================== Name: SMBase-ct.146 Author: ct Time: 18 May 2022, 7:29:27.534874 pm UUID: e0aa203f-bb34-d942-8f8b-f8f3ebd212be Ancestors: SMBase-tpr.145 Improves multilingual support and moves from UIManager default to Project uiManager. =============== Diff against SMBase-tpr.145 =============== Item was changed: ----- Method: SMSimpleInstaller>>fileIntoChangeSetNamed:fromStream: (in category 'services') ----- fileIntoChangeSetNamed: aString fromStream: stream "We let the user confirm filing into an existing ChangeSet or specify another ChangeSet name if the name derived from the filename already exists." | changeSet newName oldChanges global | newName := aString. changeSet := SMInstaller changeSetNamed: newName. changeSet ifNotNil: [ + newName := self silent ifNil: [Project uiManager + request: 'ChangeSet already present, just confirm to overwrite or enter a new name:' translated - newName := self silent ifNil: [UIManager default - request: 'ChangeSet already present, just confirm to overwrite or enter a new name:' initialAnswer: newName] ifNotNil: [newName]. newName isEmpty ifTrue:[self error: 'Cancelled by user']. changeSet := SMInstaller changeSetNamed: newName]. changeSet ifNil:[changeSet := SMInstaller basicNewChangeSet: newName]. changeSet ifNil:[self error: 'User did not specify a valid ChangeSet name']. oldChanges := (SystemVersion current highestUpdate < 5302) ifFalse: [global := ChangeSet. ChangeSet current] ifTrue: [global := Smalltalk. Smalltalk changes]. [global newChanges: changeSet. + stream fileInAnnouncing: ('Loading {1} into change set {2}' translated format: {newName. newName}). - stream fileInAnnouncing: 'Loading ', newName, ' into change set ''', newName, ''''. stream close] ensure: [global newChanges: oldChanges]! Item was changed: ----- Method: SMUtilities class>>mailUserName (in category 'private') ----- mailUserName "Answer the mail user's name, but deal with some historical mail senders." | mailSender | mailSender := (Smalltalk at: #MailSender ifAbsent: [ Smalltalk at: #Celeste ifAbsent: []]). ^mailSender + ifNil: [ Project uiManager request: 'What is your email address?' translated ] - ifNil: [ UIManager default request: 'What is your email address?' ] ifNotNil: [ mailSender userName ]! Item was changed: ----- Method: SMUtilities class>>sendMail: (in category 'utilities') ----- sendMail: aString "Send the given mail message, but check for modern mail senders." Smalltalk at: #MailSender ifPresent: [ :mailSender | ^mailSender sendMessage: ((Smalltalk at: #MailMessage) from: aString). ]. Smalltalk at: #MailComposition ifPresent: [ :mailComposition | ^mailComposition new messageText: aString; open ]. Smalltalk at: #Celeste ifPresent: [ :celeste | celeste isSmtpServerSet ifTrue: [ Smalltalk at: #CelesteComposition ifPresent: [ :celesteComposition | ^celesteComposition openForCeleste: celeste current initialText: aString ] ] ]. Smalltalk at: #AdHocComposition ifPresent: [ :adHocComposition | | server | + server := Project uiManager request: 'What is your mail server for outgoing mail?' translated. - server := UIManager default request: 'What is your mail server for outgoing mail?'. ^adHocComposition openForCeleste: server initialText: aString ]. + ^self inform: 'Sorry, no known way to send the message' translated! - ^self inform: 'Sorry, no known way to send the message'. - !

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages May 2022