Packages January 2022

packages@lists.squeakfoundation.org

1 participants
209 discussions

The Trunk: MorphicExtras-ct.305.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of MorphicExtras to project The Trunk: http://source.squeak.org/trunk/MorphicExtras-ct.305.mcz ==================== Summary ==================== Name: MorphicExtras-ct.305 Author: ct Time: 3 January 2022, 11:23:47.016397 pm UUID: 50af01bc-e04f-7441-ac0d-3d7a1fac9363 Ancestors: MorphicExtras-mt.304 Two fixes for MIDI: - Ignore non-red mouse clicks to MIDIPianoKeyboardMorph - Honor users of SimpleSwitchMorph that do not take the new state via the actionSelector. =============== Diff against MorphicExtras-mt.304 =============== Item was added: + ----- Method: PianoKeyboardMorph>>basicMouseDownPitch: (in category 'simple keyboard') ----- + basicMouseDownPitch: midiKey + + | pitch | + pitch := AbstractSound pitchForMIDIKey: midiKey + 23. + soundPlaying ifNotNil: [soundPlaying stopGracefully]. + soundPlaying := soundPrototype soundForPitch: pitch dur: 100.0 loudness: 0.3. + SoundPlayer resumePlaying: soundPlaying quickStart: true.! Item was added: + ----- Method: PianoKeyboardMorph>>basicMouseUpPitch: (in category 'simple keyboard') ----- + basicMouseUpPitch: pitch + + soundPlaying ifNotNil: [soundPlaying stopGracefully].! Item was changed: ----- Method: PianoKeyboardMorph>>mouseDownPitch:event:noteMorph: (in category 'simple keyboard') ----- mouseDownPitch: midiKey event: event noteMorph: noteMorph + - | pitch | event redButtonPressed ifFalse: [^ self]. event hand hasSubmorphs ifTrue: [^ self "no response if drag something over me"]. event hand mouseFocus ifNil: ["If dragged into me, then establish focus so I'll see moves" event hand newMouseFocus: noteMorph event: event]. + noteMorph color: playingKeyColor. + + self basicMouseDownPitch: midiKey.! - pitch := AbstractSound pitchForMIDIKey: midiKey + 23. - soundPlaying ifNotNil: [soundPlaying stopGracefully]. - soundPlaying := soundPrototype soundForPitch: pitch dur: 100.0 loudness: 0.3. - SoundPlayer resumePlaying: soundPlaying quickStart: true. - ! Item was changed: ----- Method: PianoKeyboardMorph>>mouseUpPitch:event:noteMorph: (in category 'simple keyboard') ----- mouseUpPitch: pitch event: event noteMorph: noteMorph + noteMorph color: ((#(0 1 3 5 6 8 10) includes: pitch \\ 12) + ifTrue: [whiteKeyColor] + ifFalse: [blackKeyColor]). + + self basicMouseUpPitch: pitch.! - noteMorph color: ((#(0 1 3 5 6 8 10) includes: pitch\\12) - ifTrue: [whiteKeyColor] - ifFalse: [blackKeyColor]). - soundPlaying ifNotNil: [soundPlaying stopGracefully]. - ! Item was changed: ----- Method: SimpleSwitchMorph>>doButtonAction (in category 'button') ----- doButtonAction "Perform the action of this button. The last argument of the message sent to the target is the new state of this switch." | newState | (target notNil and: [actionSelector notNil]) ifTrue: [newState := color = onColor. target perform: actionSelector + withEnoughArguments: (arguments copyWith: newState)]! - withArguments: (arguments copyWith: newState)]!

1 0

The Trunk: Tools-ct.1100.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1100.mcz ==================== Summary ==================== Name: Tools-ct.1100 Author: ct Time: 3 January 2022, 11:12:14.826397 pm UUID: 05076dd9-0a0a-0740-ae13-3f82347e5112 Ancestors: Tools-mt.1099 Improves multilingual support. The dependency browser and all changes tools should be 100-% multilingual now! =============== Diff against Tools-mt.1099 =============== Item was changed: ----- Method: BasicInspector>>labelString (in category 'initialization') ----- labelString ^ '{1} {2}{3}' format: { + '[basic]' translated. - '[basic]'. self basicObjectPrintString. (self object isReadOnlyObject + ifTrue: [' (read-only)' translated] - ifTrue: [' (read-only)'] ifFalse: [''])}! Item was changed: ----- Method: Browser>>dropOnMessageCategories:at: (in category 'drag and drop') ----- dropOnMessageCategories: method at: index | sourceClass destinationClass category copy | copy := Sensor shiftPressed. (method isKindOf: CompiledMethod) ifFalse:[^self inform: 'Can only drop methods']. sourceClass := method methodClass. destinationClass := self selectedClassOrMetaClass. sourceClass == destinationClass ifTrue:[ category := self messageCategoryList at: index. category = ClassOrganizer allCategory ifTrue: [^false]. destinationClass organization classify: method selector under: category suppressIfDefault: false logged: true. self changed: #messageCategoryList. self changed: #messageList. ^true ]. (copy or: [ (destinationClass inheritsFrom: sourceClass) or: [ (sourceClass inheritsFrom: destinationClass) or: [ sourceClass theNonMetaClass == destinationClass theNonMetaClass ] ] ]) ifFalse: [ (self confirm: ( 'Classes "{1}" and "{2}" are unrelated.{3}Are you sure you want to move this method?' + translated format: { sourceClass. destinationClass. Character cr })) - format: { sourceClass. destinationClass. Character cr })) ifFalse: [ ^false ] ]. destinationClass compile: method getSource classified: (self messageCategoryList at: index) withStamp: method timeStamp notifying: nil. copy ifFalse: [ sourceClass removeSelector: method selector ]. ^true! Item was changed: ----- Method: ChangeList class>>browseMethodVersions (in category 'public access') ----- browseMethodVersions | changeList end changesFile filteredRecords | changesFile := (SourceFiles at: 2) readOnlyCopy. changesFile setConverterForCode. end := changesFile size. changeList := self new. Cursor read showWhile: [ [changeList scanFile: changesFile from: 0 to: end] on: InvalidUTF8 do: [:err | err resume: '']]. changesFile close. filteredRecords := Dictionary new. changeList changeList do: [:changeRecord | changeRecord methodSelector ifNotNil: [:selector | | class | class := changeRecord methodClass. "Only collect records that point to not-installed methods." (class isNil or: [(class includesSelector: selector) not]) ifTrue: [ (filteredRecords at: selector ifAbsentPut: [OrderedCollection new]) add: changeRecord]]] + displayingProgress: [:changeRecord | 'Parsing source code at {1}...' translated format: {changeRecord position}]. - displayingProgress: [:changeRecord | 'Parsing source code at {1}...' format: {changeRecord position}]. filteredRecords explore. "Open explorer to allow user to repeat the following step manually." self browseMethodVersions: filteredRecords.! Item was changed: ----- Method: ChangeList class>>browseMethodVersions: (in category 'public access') ----- browseMethodVersions: filteredRecords | changeList sortedKeys choice | sortedKeys := filteredRecords keys sorted. + choice := Project uiManager chooseFrom: sortedKeys values: sortedKeys title: 'Recover method versions' translated. - choice := Project uiManager chooseFrom: sortedKeys values: sortedKeys title: 'Recover method versions'. choice ifNil: [^ self]. "Only ChangeList can handle the mix of (maybe non-existing) class references in records. For example, VersionsBrowser is not supported." changeList := ChangeList new. (filteredRecords at: choice) do: [:changeRecord | changeList addItem: changeRecord text: ('{1} {2}{3}{4} \{{5}\}' format: { changeRecord stamp. changeRecord methodClassName. changeRecord isMetaClassChange ifTrue: [' class '] ifFalse: [' ']. choice. changeRecord category})]. changeList resetListSelections. self open: changeList + name: ('All local versions for {1}' translated format: {choice storeString}) - name: 'All local versions for ', choice storeString multiSelect: false! Item was changed: ----- Method: ChangeList class>>browseRecent:on: (in category 'public access') ----- browseRecent: charCount on: origChangesFile "Opens a changeList on the end of the specified changes log file" | changeList end changesFile | changesFile := origChangesFile readOnlyCopy. changesFile setConverterForCode. end := changesFile size. changeList := Cursor read showWhile: [self new scanFile: changesFile from: (0 max: end - charCount) to: end]. changesFile close. self open: changeList + name: 'Recent changes' translated - name: 'Recent changes' multiSelect: true! Item was changed: ----- Method: ChangeList class>>browseRecentLogOn: (in category 'public access') ----- browseRecentLogOn: origChangesFile "figure out where the last snapshot or quit was, then browse the recent entries." | end done block pos chunk changesFile position prevBlock | changesFile := origChangesFile readOnlyCopy. position := nil. end := changesFile size. prevBlock := end. block := end - 1024 max: 0. done := false. [done or: [position notNil]] whileFalse: [changesFile position: block. "ignore first fragment" changesFile nextChunk. [changesFile position < prevBlock] whileTrue: [pos := changesFile position. chunk := changesFile nextChunk. ((chunk indexOfSubCollection: '----' startingAt: 1) = 1) ifTrue: [ (#('----QUIT' '----SNAPSHOT') anySatisfy: [ :str | chunk beginsWith: str ]) ifTrue: [position := pos]]]. block = 0 ifTrue: [done := true] ifFalse: [prevBlock := block. block := block - 1024 max: 0]]. changesFile close. position + ifNil: [self inform: ('File {1} does not appear to be a changes file' translated format: {changesFile name})] - ifNil: [self inform: 'File ' , changesFile name , ' does not appear to be a changes file'] ifNotNil: [self browseRecentLogOn: origChangesFile startingFrom: position]! Item was changed: ----- Method: ChangeList class>>browseStream: (in category 'public access') ----- browseStream: changesFile "Opens a changeList on a fileStream" | changeList charCount | changesFile readOnly. changesFile setConverterForCode. charCount := changesFile size. charCount > 1000000 ifTrue: + [(self confirm: ('The file {1} + is really long ({2} characters). + Would you prefer to view only the last million characters?' translated format: {changesFile name. charCount})) - [(self confirm: 'The file ', changesFile name , ' - is really long (' , charCount printString , ' characters). - Would you prefer to view only the last million characters?') ifTrue: [charCount := 1000000]]. "changesFile setEncoderForSourceCodeNamed: changesFile name." changeList := Cursor read showWhile: [self new scanFile: changesFile from: changesFile size-charCount to: changesFile size]. changesFile close. self open: changeList name: changesFile localName , ' log' multiSelect: true! Item was changed: ----- Method: ChangeList>>acceptFrom: (in category 'menu actions') ----- acceptFrom: aView aView controller text = aView controller initialText ifFalse: [ aView flash. ^ self inform: 'You can only accept this version as-is. + If you want to edit, copy the text to a browser' translated]. - If you want to edit, copy the text to a browser']. (aView setText: aView controller text from: self) ifTrue: [aView ifNotNil: [aView controller accept]]. "initialText" ! Item was changed: ----- Method: ChangeList>>browseAllVersionsOfSelections (in category 'menu actions') ----- browseAllVersionsOfSelections "Opens a Versions browser on all the currently selected methods, showing each alongside all of their historical versions." | oldSelection aList | oldSelection := self listIndex. aList := OrderedCollection new. Cursor read showWhile: [ 1 to: changeList size do: [:i | (listSelections at: i) ifTrue: [ listIndex := i. self browseVersions. aList add: i. ]]]. listIndex := oldSelection. + aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts' translated].! - aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts']. - ! Item was changed: ----- Method: ChangeList>>browseCurrentVersionsOfSelections (in category 'menu actions') ----- browseCurrentVersionsOfSelections "Opens a message-list browser on the current in-memory versions of all methods that are currently seleted" | aList | aList := OrderedCollection new. Cursor read showWhile: [ 1 to: changeList size do: [:i | (listSelections at: i) ifTrue: [ | aClass aChange | aChange := changeList at: i. (aChange type = #method and: [(aClass := aChange methodClass) notNil and: [aClass includesSelector: aChange methodSelector]]) ifTrue: [ aList add: ( MethodReference class: aClass selector: aChange methodSelector ) ]]]]. + aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts' translated]. - aList size = 0 ifTrue: [^ self inform: 'no selected methods have in-memory counterparts']. ToolSet browseMessageSet: aList + name: ('Current versions of selected methods in {1}' translated format: {file localName}) - name: 'Current versions of selected methods in ', file localName autoSelect: nil! Item was changed: ----- Method: ChangeList>>compareToCurrentSource: (in category 'menu actions') ----- compareToCurrentSource: currentSource "If the current selection corresponds to a method in the system, then spawn a window showing the diffs as text" | change selectedSource | change := changeList at: listIndex ifAbsent: [^ self]. selectedSource := change string. currentSource = selectedSource + ifTrue: [^ self inform: 'Exact Match' translated]. - ifTrue: [^ self inform: 'Exact Match']. (StringHolder new textContents: (TextDiffBuilder buildDisplayPatchFrom: selectedSource to: currentSource inClass: change methodClass prettyDiffs: self showingPrettyDiffs)) + openLabel: 'Comparison to Current Version' translated.! - openLabel: 'Comparison to Current Version'.! Item was changed: ----- Method: ChangeList>>contents: (in category 'viewing access') ----- contents: aString listIndex = 0 ifTrue: [self changed: #flash. ^ false]. lostMethodPointer ifNotNil: [^ self restoreDeletedMethod]. self okToChange "means not dirty" ifFalse: ["is dirty" + self inform: 'This is a view of a method on a file.\Please cancel your changes. You may\accept, but only when the method is untouched.' withCRs translated. ^ false]. - self inform: 'This is a view of a method on a file.\Please cancel your changes. You may\accept, but only when the method is untouched.' withCRs. ^ false]. "Can't accept changes here. Method text must be unchanged!!" (changeList at: listIndex) fileIn. ^ true! Item was changed: ----- Method: ChangeList>>destroyCurrentCodeOfSelections (in category 'menu actions') ----- destroyCurrentCodeOfSelections "Actually remove from the system any in-memory methods with class and selector identical to items current selected. This may seem rather arcane but believe me it has its great uses, when trying to split out code. To use effectively, first file out a change set that you wish to split off. Then open a ChangeList browser on that fileout. Now look through the methods, and select any of them which you want to remove completely from the system, then issue this command. For those methods where you have made changes to pre-existing versions, of course, you won't want to remove them from the system, so use this mechanism with care!!" | aClass aChange aList | aList := OrderedCollection new. 1 to: changeList size do: [:index | (listSelections at: index) ifTrue: [aChange := changeList at: index. (aChange type = #method and: [(aClass := aChange methodClass) notNil and: [aClass includesSelector: aChange methodSelector]]) ifTrue: [aList add: {aClass. aChange methodSelector}]]]. aList size > 0 ifTrue: + [(self confirm: ('Warning!! This will actually remove {1} method(s) from the system!!' translated format: {aList size})) ifFalse: [^ self]]. - [(self confirm: 'Warning!! This will actually remove ', aList size printString, ' method(s) from the system!!') ifFalse: [^ self]]. aList do: [:aPair | Transcript cr; show: 'Removed: ', aPair first printString, '.', aPair second. aPair first removeSelector: aPair second]! Item was changed: ----- Method: ChangeList>>fileInSelections (in category 'menu actions') ----- fileInSelections | any | any := false. self selectedClass environment beCurrentDuring: [ listSelections with: changeList do: [:selected :item | selected ifTrue: [any := true. item fileIn]]]. any ifFalse: + [self inform: 'nothing selected, so nothing done' translated]! - [self inform: 'nothing selected, so nothing done']! Item was changed: ----- Method: ChangeList>>fileOutSelections (in category 'menu actions') ----- fileOutSelections | fileName internalStream | + fileName := Project uiManager request: 'Enter the base of file name' translated initialAnswer: 'Filename' translated. - fileName := UIManager default request: 'Enter the base of file name' initialAnswer: 'Filename'. internalStream := WriteStream on: (String new: 1000). internalStream header; timeStamp. listSelections with: changeList do: [:selected :item | selected ifTrue: [item fileOutOn: internalStream]]. + FileStream writeSourceCodeFrom: internalStream baseName: fileName isSt: true useHtml: false.! - FileStream writeSourceCodeFrom: internalStream baseName: fileName isSt: true useHtml: false. - ! Item was changed: ----- Method: ChangeList>>mainChangeListMenu: (in category 'menu actions') ----- mainChangeListMenu: aMenu "Fill aMenu up so that it comprises the primary changelist-browser menu" <changeListMenu> + aMenu addTitle: 'change list' translated. - aMenu addTitle: 'change list'. aMenu addStayUpItemSpecial. + aMenu addTranslatedList: #( - aMenu addList: #( ('fileIn selections' fileInSelections 'import the selected items into the image') ('fileOut selections...' fileOutSelections 'create a new file containing the selected items') - ('compare to current' compareToCurrentVersion 'open a separate window which shows the text differences between the on-file version and the in-image version.' ) ('toggle diffing (D)' toggleDiffing 'start or stop showing diffs in the code pane.') - ('select conflicts with any changeset' selectAllConflicts 'select methods in the file which also occur in any change-set in the system') ('select conflicts with current changeset' selectConflicts 'select methods in the file which also occur in the current change-set') ('select conflicts with...' selectConflictsWith 'allows you to designate a file or change-set against which to check for code conflicts.') - ('select unchanged definitions' selectUnchangedDefinitions 'select class definitions, class comments and methods in the file whose in-image versions are the same as their in-file counterparts' ) ('select unchanged methods' selectUnchangedMethods 'select methods in the file whose in-image versions are the same as their in-file counterparts' ) ('select new methods' selectNewMethods 'select methods in the file that do not current occur in the image') ('select methods for this class' selectMethodsForThisClass 'select all methods in the file that belong to the currently-selected class') ('select methods for extant classes' selectMethodsForExtantClasses 'select all methods in the file that belong to a class that exists in the image') ('select changes with contents matching' selectContentsMatching 'select all changes in the file whose text includes a pattern') - ('select all (a)' selectAll 'select all the items in the list') ('deselect all' deselectAll 'deselect all the items in the list') ('invert selections' invertSelections 'select every item that is not currently selected, and deselect every item that *is* currently selected') ('select all before' selectAllBefore 'select every item before the current selection') - ('browse all versions of single selection' browseVersions 'open a version browser showing the versions of the currently selected method') ('browse all versions of selections' browseAllVersionsOfSelections 'open a version browser showing all the versions of all the selected methods') ('browse current versions of selections' browseCurrentVersionsOfSelections 'open a message-list browser showing the current (in-image) counterparts of the selected methods') ('destroy current methods of selections' destroyCurrentCodeOfSelections 'remove (*destroy*) the in-image counterparts of all selected methods') - ('remove doIts' removeDoIts 'remove all items that are doIts rather than methods') ('remove older versions' removeOlderMethodVersions 'remove all but the most recent versions of methods in the list') ('remove up-to-date versions' removeExistingMethodVersions 'remove all items whose code is the same as the counterpart in-image code') ('remove selected items' removeSelections 'remove the selected items from the change-list') ('remove unselected items' removeNonSelections 'remove all the items not currently selected from the change-list')). + ^ aMenu! - ^ aMenu - - ! Item was changed: ----- Method: ChangeList>>removeNonSelections (in category 'menu actions') ----- removeNonSelections "Remove the unselected items from the receiver." | newChangeList newList | newChangeList := OrderedCollection new. newList := OrderedCollection new. 1 to: changeList size do: [:i | (listSelections at: i) ifTrue: [newChangeList add: (changeList at: i). newList add: (list at: i)]]. newChangeList size = 0 ifTrue: [^ self inform: 'That would remove everything. + Why would you want to do that?' translated]. - Why would you want to do that?']. newChangeList size < changeList size ifTrue: [changeList := newChangeList. list := newList. listIndex := 0. listSelections := Array new: list size withAll: false]. + self changed: #list! - self changed: #list - - ! Item was changed: ----- Method: ChangeList>>scanFile:from:to: (in category 'scanning') ----- scanFile: aFile from: startPosition to: stopPosition file := aFile. changeList := OrderedCollection new. list := OrderedCollection new. listIndex := 0. file position: startPosition. + ('Scanning {1}...' translated format: {aFile localName}) - 'Scanning ', aFile localName, '...' displayProgressFrom: startPosition to: stopPosition during: [:bar | | prevChar itemPosition item | [file position < stopPosition] whileTrue: [bar value: file position. [file atEnd not and: [file peek isSeparator]] whileTrue: [prevChar := file next]. (file peekFor: $!!) ifTrue: [(prevChar = Character cr or: [prevChar = Character lf]) ifTrue: [self scanCategory]] ifFalse: [itemPosition := file position. item := file nextChunk. file skipStyleChunk. item size > 0 ifTrue: [(item beginsWith: '----') ifTrue: [self addItem: (ChangeRecord new file: file position: itemPosition type: #misc) text: 'misc: ' , (item contractTo: 50)] ifFalse: [self addItem: (ChangeRecord new file: file position: itemPosition type: #doIt) text: 'do it: ' , (item contractTo: 50)]]]]]. self resetListSelections.! Item was changed: ----- Method: ChangeList>>selectContentsMatching (in category 'menu actions') ----- selectContentsMatching | pattern | + pattern := Project uiManager request: 'pattern to match' translated. - pattern := UIManager default request: 'pattern to match'. pattern isEmpty ifTrue: [^self]. ^Cursor execute showWhile: [self selectSuchThat: ((pattern includesAnyOf: '?*') ifTrue: [[ :change | pattern match: change string]] ifFalse: [[ :change | change string includesSubstring: pattern]])]! Item was changed: ----- Method: ChangeList>>selectSuchThat (in category 'menu actions') ----- selectSuchThat "query the user for a selection criterio. By Lex Spoon. NB: the UI for invoking this from a changelist browser is currently commented out; to reenfranchise it, you'll need to mild editing to ChangeList method #changeListMenu:" | code block | + code := Project uiManager request: ('selection criteria for a change named aChangeRecord?\For instance, "{1}"' withCRs translated format: {'aChangeRecord category = ''System-Network'''}). - code := UIManager default request: 'selection criteria for a change named aChangeRecord?\For instance, ''aChangeRecord category = ''System-Network''''' withCRs. code isEmpty ifTrue: [^ self ]. block := Compiler evaluate: '[:aChangeRecord | ', code, ']'. self selectSuchThat: block! Item was changed: ----- Method: ChangeSetBrowser>>addModelItemsToWindowMenu: (in category 'initialization') ----- addModelItemsToWindowMenu: aMenu "Add model-related items to the given window menu" | oldTarget | oldTarget := aMenu defaultTarget. aMenu defaultTarget: self. aMenu addLine. + aMenu add: 'rename change set' translated action: #rename. + aMenu add: 'make changes go to me' translated action: #newCurrent. - aMenu add: 'rename change set' action: #rename. - aMenu add: 'make changes go to me' action: #newCurrent. aMenu addLine. + aMenu add: 'file out' translated action: #fileOut. + aMenu add: 'browse methods' translated action: #browseChangeSet. - aMenu add: 'file out' action: #fileOut. - aMenu add: 'browse methods' action: #browseChangeSet. aMenu addLine. myChangeSet hasPreamble ifTrue: + [aMenu add: 'edit preamble...' translated action: #editPreamble. + aMenu add: 'remove preamble' translated action: #removePreamble] - [aMenu add: 'edit preamble...' action: #editPreamble. - aMenu add: 'remove preamble' action: #removePreamble] ifFalse: + [aMenu add: 'add preamble...' translated action: #editPreamble]. - [aMenu add: 'add preamble...' action: #editPreamble]. myChangeSet hasPostscript ifTrue: + [aMenu add: 'edit postscript...' translated action: #editPostscript. + aMenu add: 'remove postscript' translated action: #removePostscript] - [aMenu add: 'edit postscript...' action: #editPostscript. - aMenu add: 'remove postscript' action: #removePostscript] ifFalse: + [aMenu add: 'add postscript...' translated action: #editPostscript]. - [aMenu add: 'add postscript...' action: #editPostscript]. aMenu addLine. + aMenu add: 'destroy change set' translated action: #remove. - aMenu add: 'destroy change set' action: #remove. aMenu addLine. Smalltalk isMorphic ifTrue: [aMenu addLine. + aMenu add: 'what to show...' translated target: self action: #offerWhatToShowMenu]. - aMenu add: 'what to show...' target: self action: #offerWhatToShowMenu]. aMenu addLine. + aMenu add: 'more...' translated action: #offerShiftedChangeSetMenu. - aMenu add: 'more...' action: #offerShiftedChangeSetMenu. aMenu defaultTarget: oldTarget. ^ aMenu! Item was changed: ----- Method: ChangeSorter class>>browseChangeSetsWithClass:selector: (in category 'browse') ----- browseChangeSetsWithClass: class selector: selector "Put up a menu comprising a list of change sets that hold changes for the given class and selector. If the user selects one, open a single change-sorter onto it" | hits index | hits := ChangeSet allChangeSets select: [:cs | (cs atSelector: selector class: class) ~~ #none]. + hits isEmpty ifTrue: [^ self inform: ('{1}\is not in any change set' withCRs translated format: {class name, ' >> #', selector})]. - hits isEmpty ifTrue: [^ self inform: class name, '.', selector , ' - is not in any change set']. index := hits size = 1 ifTrue: [1] + ifFalse: [(Project uiManager chooseFrom: (hits collect: [:cs | cs name]) - ifFalse: [(UIManager default chooseFrom: (hits collect: [:cs | cs name]) lines: #())]. index = 0 ifTrue: [^ self]. (ChangeSorter new myChangeSet: (hits at: index)) open. ! Item was changed: ----- Method: ChangeSorter class>>browseChangeSetsWithSelector: (in category 'browse') ----- browseChangeSetsWithSelector: aSelector "Put up a list of all change sets that contain an addition, deletion, or change of any method with the given selector" | hits index | hits := ChangeSet allChangeSets select: [:cs | cs hasAnyChangeForSelector: aSelector]. + hits isEmpty ifTrue: [^ self inform: ('{1}\is not in any change set' withCRs translated format: {aSelector})]. - hits isEmpty ifTrue: [^ self inform: aSelector , ' - is not in any change set']. index := hits size = 1 ifTrue: [1] + ifFalse: [(Project uiManager chooseFrom: (hits collect: [:cs | cs name]) - ifFalse: [(UIManager default chooseFrom: (hits collect: [:cs | cs name]) lines: #())]. index = 0 ifTrue: [^ self]. (ChangeSetBrowser new myChangeSet: (hits at: index)) open "ChangeSorter browseChangeSetsWithSelector: #clearPenTrails" ! Item was changed: ----- Method: ChangeSorter>>addPriorVersionsCountForSelector:ofClass:to: (in category 'annotation') ----- addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream "Add an annotation detailing the prior versions count. Specially handled here for the case of a selector no longer in the system, whose prior version is pointed to by the lost-method pointer in the change held on to by the changeset" (aClass includesSelector: aSelector) ifTrue: [^ super addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream]. aStream nextPutAll: ((myChangeSet methodInfoFromRemoval: {aClass name. aSelector}) ifNil: + ['no prior versions' translated] - ['no prior versions'] ifNotNil: + ['version(s) retrievable here' translated]), self annotationSeparator! - ['version(s) retrievable here']), self annotationSeparator! Item was changed: ----- Method: ChangeSorter>>browseMethodConflicts (in category 'changeSet menu') ----- browseMethodConflicts "Check to see if any other change set also holds changes to any methods in the selected change set; if so, open a browser on all such." | aList | aList := myChangeSet messageListForChangesWhich: [ :aClass :aSelector | (ChangesOrganizer allChangeSetsWithClass: aClass selector: aSelector) size > 1 ] ifNone: [^ self inform: 'No other change set has changes + for any method in this change set.' translated]. - for any method in this change set.']. ToolSet browseMessageSet: aList + name: ('Methods in "{1}" that are also in other change sets ({2})' translated format: {myChangeSet name. aList size}) - name: 'Methods in "', myChangeSet name, '" that are also in other change sets (', aList size printString, ')' autoSelect: nil! Item was changed: ----- Method: ChangeSorter>>changeSetMenuForDropInClassCats: (in category 'changeSet menu') ----- changeSetMenuForDropInClassCats: aMenu + aMenu add: 'remove contained in class categories...' translated action: #removeContainedInClassCategories. + aMenu balloonTextForLastItem: ' Drops any changes in given class categories' translated. - aMenu add: 'remove contained in class categories...' action: #removeContainedInClassCategories. - aMenu balloonTextForLastItem: ' Drops any changes in given class categories'. ^ aMenu ! Item was changed: ----- Method: ChangeSorter>>changeSetMenuForModification: (in category 'changeSet menu') ----- changeSetMenuForModification: aMenu aMenu addLine. + + aMenu add: 'file into new...' translated action: #fileIntoNewChangeSet. - - aMenu add: 'file into new...' action: #fileIntoNewChangeSet. aMenu balloonTextForLastItem: + 'Load a fileout from disk and place its changes into a new change set (seldom needed -- much better to do this from a file-list browser these days.)' translated. + + aMenu add: 'reorder all change sets' translated action: #reorderChangeSets. - 'Load a fileout from disk and place its changes into a new change set (seldom needed -- much better to do this from a file-list browser these days.)'. - - aMenu add: 'reorder all change sets' action: #reorderChangeSets. aMenu balloonTextForLastItem: + 'Applies a standard reordering of all change-sets in the system -- at the bottom will come the sets that come with the release; next will come all the numbered updates; finally, at the top, will come all other change sets' translated. + - 'Applies a standard reordering of all change-sets in the system -- at the bottom will come the sets that come with the release; next will come all the numbered updates; finally, at the top, will come all other change sets'. - - ^ aMenu! Item was changed: ----- Method: ChangeSorter>>changeSetMenuForOpposite: (in category 'changeSet menu') ----- changeSetMenuForOpposite: aMenu parent ifNotNil: + [aMenu add: 'conflicts with change set opposite' translated action: #methodConflictsWithOtherSide. - [aMenu add: 'conflicts with change set opposite' action: #methodConflictsWithOtherSide. aMenu balloonTextForLastItem: + 'Browse all methods that occur both in this change set and in the one on the opposite side of the change sorter.' translated]. - 'Browse all methods that occur both in this change set and in the one on the opposite side of the change sorter.'.]. ^ aMenu! Item was changed: ----- Method: ChangeSorter>>changeSetMenuForPromote: (in category 'changeSet menu') ----- changeSetMenuForPromote: aMenu + aMenu add: 'promote to top of list' translated action: #promoteToTopChangeSet. - aMenu add: 'promote to top of list' action: #promoteToTopChangeSet. aMenu balloonTextForLastItem: + 'Make this change set appear first in change-set lists in all change sorters.' translated. - 'Make this change set appear first in change-set lists in all change sorters.'. ^ aMenu! Item was changed: ----- Method: ChangeSorter>>clearChangeSet (in category 'changeSet menu') ----- clearChangeSet "Clear out the current change set, after getting a confirmation." | message | self okToChange ifFalse: [^ self]. myChangeSet isEmpty ifFalse: + [message := 'Are you certain that you want to\forget all the changes in this set?' withCRs translated. - [message := 'Are you certain that you want to\forget all the changes in this set?' withCRs. (self confirm: message) ifFalse: [^ self]]. myChangeSet clear. self changed: #classList. self changed: #messageList. self setContents. self contentsChanged. ! Item was changed: ----- Method: ChangeSorter>>contents:notifying: (in category 'code pane') ----- contents: aString notifying: aController "Compile the code in aString. Notify aController of any syntax errors. Create an error if the category of the selected message is unknown. Answer false if the compilation fails. Otherwise, if the compilation created a new method, deselect the current selection. Then answer true." | category selector class oldSelector | (class := self selectedClassOrMetaClass) ifNil: [(myChangeSet preambleString == nil or: [aString size = 0]) ifTrue: [ ^ false]. (aString count: [:char | char == $"]) odd + ifTrue: [self inform: 'unmatched double quotes in preamble' translated] - ifTrue: [self inform: 'unmatched double quotes in preamble'] ifFalse: [(Scanner new scanTokens: aString) size > 0 ifTrue: [ self inform: 'Part of the preamble is not within double-quotes. To put a double-quote inside a comment, type two double-quotes in a row. + (Ignore this warning if you are including a doIt in the preamble.)' translated]]. - (Ignore this warning if you are including a doIt in the preamble.)']]. myChangeSet preambleString: aString. self currentSelector: nil. "forces update with no 'unsubmitted chgs' feedback" ^ true]. oldSelector := self selectedMessageName. category := class organization categoryOfElement: oldSelector. selector := class compile: aString classified: category notifying: aController. selector ifNil: [^ false]. (self messageList includes: selector) ifTrue: [self currentSelector: selector] ifFalse: [self currentSelector: oldSelector]. self update. ^ true! Item was changed: ----- Method: ChangeSorter>>findCngSet (in category 'changeSet menu') ----- findCngSet "Search for a changeSet by name. Pop up a menu of all changeSets whose name contains the string entered by the user. If only one matches, then the pop-up menu is bypassed" | index pattern candidates nameList | self okToChange ifFalse: [^ self]. + pattern := Project uiManager request: 'ChangeSet name or fragment?' translated. - pattern := UIManager default request: 'ChangeSet name or fragment?'. pattern isEmpty ifTrue: [^ self]. nameList := self changeSetList asSet. candidates := ChangeSet allChangeSets select: [:c | (nameList includes: c name) and: [c name includesSubstring: pattern caseSensitive: false]]. candidates size = 0 ifTrue: [^ Beeper beep]. candidates size = 1 ifTrue: [^ self showChangeSet: candidates first]. + index := Project uiManager chooseFrom: (candidates collect: [:each | each name]). - index := UIManager default chooseFrom: (candidates collect: [:each | each name]). index = 0 ifFalse: [self showChangeSet: (candidates at: index)]. ! Item was changed: ----- Method: ChangeSorter>>goToChangeSetsProject (in category 'changeSet menu') ----- goToChangeSetsProject "Transport the user to a project which bears the selected changeSet as its current changeSet" | aProject | (aProject := myChangeSet correspondingProject) ifNotNil: [aProject enter: false revert: false saveForRevert: false] ifNil: + [self inform: 'Has no project' translated]! - [self inform: 'Has no project']! Item was changed: ----- Method: ChangeSorter>>inspectChangeSet (in category 'changeSet menu') ----- inspectChangeSet "Open a message list browser on the new and changed methods in the current change set" + myChangeSet inspectWithLabel: ('Change set: {1}' translated format: {myChangeSet name}) - myChangeSet inspectWithLabel: 'Change set: ', myChangeSet name ! Item was changed: ----- Method: ChangeSorter>>labelString (in category 'access') ----- labelString "The label for my entire window. The large button that displays my name is gotten via mainButtonName" ^ String streamContents: [:aStream | aStream nextPutAll: (ChangeSet current == myChangeSet + ifTrue: ['Changes go to "{1}"' translated format: {myChangeSet name}] + ifFalse: ['ChangeSet: {1}' translated format: {myChangeSet name}])]! - ifTrue: ['Changes go to "', myChangeSet name, '"'] - ifFalse: ['ChangeSet: ', myChangeSet name])]! Item was changed: ----- Method: ChangeSorter>>mainClassListMenu: (in category 'class list') ----- mainClassListMenu: aMenu "Fill aMenu with items appropriate for the class list" <classListMenuShifted: false> + aMenu title: 'class list' translated. - aMenu title: 'class list'. aMenu addStayUpItemSpecial. parent ifNotNil: [ + aMenu addTranslatedList: #( "These two only apply to dual change sorters" - aMenu addList: #( "These two only apply to dual change sorters" ('copy class chgs to other side' copyClassToOther) ('move class chgs to other side' moveClassToOther))]. + aMenu addTranslatedList: #( - aMenu addList: #( - ('delete class from change set (d)' forgetClass) ('remove class from system (x)' removeClass) - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' spawnHierarchy) ('browse protocol (p)' browseFullProtocol) - ('printOut' printOutClass) ('fileOut' fileOutClass) - ('references... (r)' browseVariableReferences) ('assignments... (a)' browseVariableAssignments) ('class refs (N)' browseClassRefs) - ('more...' offerShiftedClassListMenu)). ^ aMenu! Item was changed: ----- Method: ChangeSorter>>methodConflictsWithOtherSide (in category 'changeSet menu') ----- methodConflictsWithOtherSide "Check to see if the change set on the other side shares any methods with the selected change set; if so, open a browser on all such." | aList other | self checkThatSidesDiffer: [^ self]. other := (parent other: self) changeSet. aList := myChangeSet messageListForChangesWhich: [ :aClass :aSelector | aClass notNil and: [(other methodChangesAtClass: aClass name) includesKey: aSelector] ] ifNone: [^ self inform: 'There are no methods that appear both in this change set and + in the one on the other side.' translated]. - in the one on the other side.']. ToolSet browseMessageSet: aList + name: ('Methods in "{1}" that are also in {2} ({3})' translated format: {myChangeSet name. other name. aList size}) - name: 'Methods in "', myChangeSet name, '" that are also in ', other name,' (', aList size printString, ')' autoSelect: nil! Item was changed: ----- Method: ChangeSorter>>packageNoteForClass:selector: (in category 'annotation') ----- packageNoteForClass: aClass selector: aSelector "return the category name that represents the package name for aClass>>aSelector. when selector is nil or in a normal catagory return " | package | package := (self annotationForPackageforSelector: aSelector + ofClass: aClass) ifNil: ['<class was deleted???>' translated] . - ofClass: aClass) ifNil: ['<class was deleted???>'] . ^ self noteString: package ! Item was changed: ----- Method: ChangeSorter>>removeContainedInClassCategories (in category 'changeSet menu') ----- removeContainedInClassCategories | matchExpression | myChangeSet removePreamble. + matchExpression := Project uiManager request: 'Enter class category name (wildcard is ok)' translated initialAnswer: 'System-*'. - matchExpression := UIManager default request: 'Enter class category name (wildcard is ok)' initialAnswer: 'System-*'. (Smalltalk organization categories select: [:each | matchExpression match: each]) do: [:eachCat | | classNames | classNames := Smalltalk organization listAtCategoryNamed: eachCat. classNames do: [:eachClassName | myChangeSet removeClassChanges: eachClassName. myChangeSet removeClassChanges: eachClassName , ' class']. self showChangeSet: myChangeSet]! Item was changed: ----- Method: ChangeSorter>>removePostscript (in category 'changeSet menu') ----- removePostscript (myChangeSet hasPostscript and: [myChangeSet postscriptHasDependents]) ifTrue: [^ self inform: 'Cannot remove the postscript right now because there is at least one window open on that postscript. + Close that window and try again.' translated]. - Close that window and try again.']. myChangeSet removePostscript.! Item was changed: ----- Method: ChangeSorter>>removePrompting: (in category 'changeSet menu') ----- removePrompting: doPrompt "Completely destroy my change set. Check if it's OK first, and if doPrompt is true, get the user to confirm his intentions first." | message aName changeSetNumber msg | aName := myChangeSet name. myChangeSet okayToRemove ifFalse: [^ self]. "forms current changes for some project" (myChangeSet isEmpty or: [doPrompt not]) ifFalse: [message := 'Are you certain that you want to remove (destroy) the change set + named "{1}" ?' translated format: {aName}. - named "', aName, '" ?'. (self confirm: message) ifFalse: [^ self]]. doPrompt ifTrue: [msg := myChangeSet hasPreamble ifTrue: [myChangeSet hasPostscript ifTrue: + ['a preamble and a postscript' translated] - ['a preamble and a postscript'] ifFalse: + ['a preamble' translated]] - ['a preamble']] ifFalse: [myChangeSet hasPostscript ifTrue: + ['a postscript' translated] - ['a postscript'] ifFalse: ['']]. msg isEmpty ifFalse: [(self confirm: + ('Caution!! This change set has + {1} which will be - 'Caution!! This change set has - ', msg, ' which will be lost if you destroy the change set. + Do you really want to go ahead with this?' translated format: {msg})) ifFalse: [^ self]]]. - Do you really want to go ahead with this?') ifFalse: [^ self]]]. "Go ahead and remove the change set" changeSetNumber := myChangeSet name initialIntegerOrNil. changeSetNumber ifNotNil: [SystemVersion current unregisterUpdate: changeSetNumber]. ChangesOrganizer removeChangeSet: myChangeSet. self changed: #changeSetList. self showChangeSet: ChangeSet current.! Item was changed: ----- Method: ChangeSorter>>rename (in category 'changeSet menu') ----- rename "Store a new name string into the selected ChangeSet. reject duplicate name; allow user to back out" | newName | + newName := Project uiManager request: 'New name for this change set' translated - newName := UIManager default request: 'New name for this change set' initialAnswer: myChangeSet name. (newName = myChangeSet name or: [newName size = 0]) ifTrue: [^ Beeper beep]. (ChangeSet named: newName) ifNotNil: + [^ Project uiManager inform: 'Sorry that name is already used' translated]. - [^ UIManager default inform: 'Sorry that name is already used']. myChangeSet name: newName. self update. self changed: #mainButtonName. self changed: #relabel.! Item was changed: ----- Method: ChangeSorter>>setContents (in category 'code pane') ----- setContents "return the source code that shows in the bottom pane" | sel class strm changeType | self clearUserEditFlag. contentsAreStyleable := false. currentCompiledMethod := nil. myChangeSet ifNil: [^ contents := String empty]. "should not happen but can" currentClassName ifNil: [^ contents := myChangeSet preambleString ifNil: [String empty]]. class := self selectedClassOrMetaClass. (sel := self selectedMessageName) == nil ifFalse: [changeType := (myChangeSet atSelector: (sel := sel asSymbol) class: class). changeType == #remove + ifTrue: [^ contents := 'Method has been removed (see versions)' translated]. - ifTrue: [^ contents := 'Method has been removed (see versions)']. changeType == #addedThenRemoved + ifTrue: [^ contents := 'Added then removed (see versions)' translated]. + class ifNil: [^ contents := 'Method was added, but cannot be found!!' translated]. - ifTrue: [^ contents := 'Added then removed (see versions)']. - class ifNil: [^ contents := 'Method was added, but cannot be found!!']. (class includesSelector: sel) + ifFalse: [^ contents := 'Method was added, but cannot be found!!' translated]. - ifFalse: [^ contents := 'Method was added, but cannot be found!!']. contentsAreStyleable := true. currentCompiledMethod := class compiledMethodAt: sel. contents := class sourceCodeAt: sel. (#(prettyPrint prettyDiffs) includes: contentsSymbol) ifTrue: [contents := class prettyPrinterClass format: contents in: class notifying: nil]. self showingAnyKindOfDiffs ifTrue: [ contentsAreStyleable := false. contents := self diffFromPriorSourceFor: contents]. ^ contents := contents asText makeSelectorBoldIn: class] ifTrue: [strm := WriteStream on: (String new: 100). (myChangeSet classChangeAt: (self withoutItemAnnotation: currentClassName)) do: [:each | + each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.' translated; cr]. + each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.' translated]. + each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.' translated; cr]. + each = #add ifTrue: [strm nextPutAll: 'Class definition was added.' translated; cr]. + each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.' translated; cr]. + each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.' translated; cr]. + each = #comment ifTrue: [strm nextPutAll: 'New class comment.' translated; cr. - each = #remove ifTrue: [strm nextPutAll: 'Entire class was removed.'; cr]. - each = #addedThenRemoved ifTrue: [strm nextPutAll: 'Class was added then removed.']. - each = #rename ifTrue: [strm nextPutAll: 'Class name was changed.'; cr]. - each = #add ifTrue: [strm nextPutAll: 'Class definition was added.'; cr]. - each = #change ifTrue: [strm nextPutAll: 'Class definition was changed.'; cr]. - each = #reorganize ifTrue: [strm nextPutAll: 'Class organization was changed.'; cr]. - each = #comment ifTrue: [strm nextPutAll: 'New class comment.'; cr. ]]. ^ contents := strm contents].! Item was changed: ----- Method: ChangeSorter>>setRecentUpdatesMarker (in category 'changeSet menu') ----- setRecentUpdatesMarker "Allow the user to change the recent-updates marker" | result | + result := Project uiManager request: - result := UIManager default request: ('Enter the lowest change-set number that you wish to consider "recent"? (note: highest change-set number + in this image at this time is {1})' translated format: {ChangeSet highestNumberedChangeSet}) initialAnswer: ChangesOrganizer recentUpdateMarker recentUpdateMarker asString. - in this image at this time is ', ChangeSet highestNumberedChangeSet asString, ')') initialAnswer: ChangesOrganizer recentUpdateMarker recentUpdateMarker asString. (result notNil and: [result startsWithDigit]) ifTrue: [ChangesOrganizer recentUpdateMarker: result asInteger. Smalltalk isMorphic ifTrue: [SystemWindow wakeUpTopWindowUponStartup]]! Item was changed: ----- Method: ChangeSorter>>shiftedChangeSetMenu: (in category 'changeSet menu') ----- shiftedChangeSetMenu: aMenu "Set up aMenu to hold items relating to the change-set-list pane when the shift key is down" <changeSetMenuShifted: true> + aMenu title: 'Change set (shifted)' translated. - aMenu title: 'Change set (shifted)'. aMenu addStayUpItemSpecial. "CONFLICTS SECTION" + aMenu add: 'conflicts with other change sets' translated action: #browseMethodConflicts. - aMenu add: 'conflicts with other change sets' action: #browseMethodConflicts. aMenu balloonTextForLastItem: + 'Browse all methods that occur both in this change set and in at least one other change set.' translated. - 'Browse all methods that occur both in this change set and in at least one other change set.'. self changeSetMenuForOpposite: aMenu. aMenu addLine. "CHECKS SECTION" + aMenu add: 'check for slips' translated action: #lookForSlips. - aMenu add: 'check for slips' action: #lookForSlips. aMenu balloonTextForLastItem: + 'Check this change set for halts and references to Transcript.' translated. - 'Check this change set for halts and references to Transcript.'. + aMenu add: 'check for unsent messages' translated action: #checkForUnsentMessages. - aMenu add: 'check for unsent messages' action: #checkForUnsentMessages. aMenu balloonTextForLastItem: + 'Check this change set for messages that are not sent anywhere in the system' translated. - 'Check this change set for messages that are not sent anywhere in the system'. + aMenu add: 'check for uncommented methods' translated action: #checkForUncommentedMethods. - aMenu add: 'check for uncommented methods' action: #checkForUncommentedMethods. aMenu balloonTextForLastItem: + 'Check this change set for methods that do not have comments' translated. - 'Check this change set for methods that do not have comments'. + aMenu add: 'check for uncommented classes' translated action: #checkForUncommentedClasses. - aMenu add: 'check for uncommented classes' action: #checkForUncommentedClasses. aMenu balloonTextForLastItem: + 'Check for classes with code in this changeset which lack class comments' translated. - 'Check for classes with code in this changeset which lack class comments'. Utilities authorInitialsPerSe isEmptyOrNil ifFalse: + [aMenu add: 'check for other authors' translated action: #checkForAlienAuthorship. - [aMenu add: 'check for other authors' action: #checkForAlienAuthorship. aMenu balloonTextForLastItem: + ('Check this change set for methods whose current authoring stamp does not start with "{1}"' translated format: {Utilities authorInitials}). - 'Check this change set for methods whose current authoring stamp does not start with "', Utilities authorInitials, '"'. + aMenu add: 'check for any other authors' translated action: #checkForAnyAlienAuthorship. - aMenu add: 'check for any other authors' action: #checkForAnyAlienAuthorship. aMenu balloonTextForLastItem: + ('Check this change set for methods any of whose authoring stamps do not start with "{1}"' translated format: {Utilities authorInitials})]. - 'Check this change set for methods any of whose authoring stamps do not start with "', Utilities authorInitials, '"']. + aMenu add: 'check for uncategorized methods' translated action: #checkForUnclassifiedMethods. - aMenu add: 'check for uncategorized methods' action: #checkForUnclassifiedMethods. aMenu balloonTextForLastItem: + 'Check to see if any methods in the selected change set have not yet been assigned to a category. If any are found, open a browser on them.' translated. - 'Check to see if any methods in the selected change set have not yet been assigned to a category. If any are found, open a browser on them.'. aMenu addLine. + aMenu add: 'inspect change set' translated action: #inspectChangeSet. - aMenu add: 'inspect change set' action: #inspectChangeSet. aMenu balloonTextForLastItem: + 'Open an inspector on this change set. (There are some details in a change set which you don''t see in a change sorter.)' translated. - 'Open an inspector on this change set. (There are some details in a change set which you don''t see in a change sorter.)'. + aMenu add: 'update' translated action: #update. - aMenu add: 'update' action: #update. aMenu balloonTextForLastItem: + 'Update the display for this change set. (This is done automatically when you activate this window, so is seldom needed.)' translated. - 'Update the display for this change set. (This is done automatically when you activate this window, so is seldom needed.)'. + aMenu add: 'go to change set''s project' translated action: #goToChangeSetsProject. - aMenu add: 'go to change set''s project' action: #goToChangeSetsProject. aMenu balloonTextForLastItem: + 'If this change set is currently associated with a Project, go to that project right now.' translated. - 'If this change set is currently associated with a Project, go to that project right now.'. self changeSetMenuForPromote: aMenu. + aMenu add: 'trim history' translated action: #trimHistory. - aMenu add: 'trim history' action: #trimHistory. aMenu balloonTextForLastItem: + ' Drops any methods added and then removed, as well as renaming and reorganization of newly-added classes. NOTE: can cause confusion if later filed in over an earlier version of these changes' translated. - ' Drops any methods added and then removed, as well as renaming and reorganization of newly-added classes. NOTE: can cause confusion if later filed in over an earlier version of these changes'. self changeSetMenuForDropInClassCats: aMenu. + aMenu add: 'clear this change set' translated action: #clearChangeSet. - aMenu add: 'clear this change set' action: #clearChangeSet. aMenu balloonTextForLastItem: + 'Reset this change set to a pristine state where it holds no information. CAUTION: this is destructive and irreversible!!' translated. + aMenu add: 'expunge uniclasses' translated action: #expungeUniclasses. - 'Reset this change set to a pristine state where it holds no information. CAUTION: this is destructive and irreversible!!'. - aMenu add: 'expunge uniclasses' action: #expungeUniclasses. aMenu balloonTextForLastItem: + 'Remove from the change set all memory of uniclasses, e.g. classes added on behalf of etoys, fabrik, etc., whose classnames end with a digit.' translated. - 'Remove from the change set all memory of uniclasses, e.g. classes added on behalf of etoys, fabrik, etc., whose classnames end with a digit.'. + aMenu add: 'uninstall this change set' translated action: #uninstallChangeSet. - aMenu add: 'uninstall this change set' action: #uninstallChangeSet. aMenu balloonTextForLastItem: + 'Attempt to uninstall this change set. CAUTION: this may not work completely and is irreversible!!' translated. - 'Attempt to uninstall this change set. CAUTION: this may not work completely and is irreversible!!'. self changeSetMenuForModification: aMenu. aMenu addLine. + aMenu add: 'more...' translated action: #offerUnshiftedChangeSetMenu. - aMenu add: 'more...' action: #offerUnshiftedChangeSetMenu. aMenu balloonTextForLastItem: + 'Takes you back to the primary change-set menu.' translated. - 'Takes you back to the primary change-set menu.'. ^ aMenu! Item was changed: ----- Method: ChangeSorter>>shiftedClassListMenu: (in category 'class list') ----- shiftedClassListMenu: aMenu "Fill aMenu with items appropriate for the class list" <classListMenuShifted: true> + aMenu title: 'class list' translated. - aMenu title: 'class list'. aMenu addStayUpItemSpecial. + aMenu addTranslatedList: #( - aMenu addList: #( - ('unsent methods' browseUnusedMethods) ('unreferenced inst vars' showUnreferencedInstVars) ('unreferenced class vars' showUnreferencedClassVars) - ('sample instance' makeSampleInstance) ('inspect instances' inspectInstances) ('inspect subinstances' inspectSubInstances) - ('more...' offerUnshiftedClassListMenu )). ^ aMenu! Item was changed: ----- Method: ChangeSorter>>shiftedMessageMenu: (in category 'message list') ----- shiftedMessageMenu: aMenu "Arm the menu so that it holds items appropriate to the message-list while the shift key is down. Answer the menu." <messageListMenuShifted: true> + ^ aMenu addTranslatedList: #( - ^ aMenu addList: #( - ('toggle diffing (D)' toggleDiffing) ('implementors of sent messages' browseAllMessages) ('change category...' changeCategory) - ('sample instance' makeSampleInstance) ('inspect instances' inspectInstances) ('inspect subinstances' inspectSubInstances) - ('change sets with this method' findMethodInChangeSets) ('revert to previous version' revertToPreviousVersion) ('revert & remove from changes' revertAndForget)); yourself ! Item was changed: ----- Method: ChangeSorter>>submergeIntoOtherSide (in category 'changeSet menu') ----- submergeIntoOtherSide "Copy the contents of the receiver to the other side, then remove the receiver -- all after checking that all is well." | other message nextToView i all | self checkThatSidesDiffer: [^ self]. self okToChange ifFalse: [^ self]. other := (parent other: self) changeSet. + other == myChangeSet ifTrue: [^ self inform: 'Both sides are the same!!' translated]. - other == myChangeSet ifTrue: [^ self inform: 'Both sides are the same!!']. myChangeSet isEmpty ifTrue: [^ self inform: 'Nothing to copy. To remove, + simply choose "remove".' translated]. - simply choose "remove".']. myChangeSet okayToRemove ifFalse: [^ self]. message := 'Please confirm: copy all changes + in "{1}" into "{2}" - in "', myChangeSet name, '" into "', other name, '" and then destroy the change set + named "{3}"?' translated format: {myChangeSet name. other name. myChangeSet name}. - named "', myChangeSet name, '"?'. (self confirm: message) ifFalse: [^ self]. (myChangeSet hasPreamble or: [myChangeSet hasPostscript]) ifTrue: [(self confirm: 'Caution!! This change set has a preamble or a postscript or both. If you submerge it into the other side, these will be lost. + Do you really want to go ahead with this?' translated) ifFalse: [^ self]]. - Do you really want to go ahead with this?') ifFalse: [^ self]]. other assimilateAllChangesFoundIn: myChangeSet. all := ChangeSet allChangeSets. nextToView := ((all includes: myChangeSet) and: [(i := all indexOf: myChangeSet) < all size]) ifTrue: [all at: i+1] ifFalse: [other]. self removePrompting: false. self showChangeSet: nextToView. + parent modelWakeUp.! - parent modelWakeUp. - ! Item was changed: ----- Method: ChangeSorter>>uninstallChangeSet (in category 'changeSet menu') ----- uninstallChangeSet "Attempt to uninstall the current change set, after confirmation." self okToChange ifFalse: [^ self]. (self confirm: 'Uninstalling a changeSet is unreliable at best. It will only work if the changeSet consists only of single changes, additions and removals of methods, and if no subsequent changes have been to any of them. No changes to classes will be undone. The changeSet will be cleared after uninstallation. + Do you still wish to attempt to uninstall this changeSet? translated') - Do you still wish to attempt to uninstall this changeSet?') ifFalse: [^ self]. myChangeSet uninstall. self changed: #relabel. self changed: #classList. self changed: #messageList. self setContents. + self contentsChanged.! - self contentsChanged. - ! Item was changed: ----- Method: ChangeSorter>>unshiftedChangeSetMenu: (in category 'changeSet menu') ----- unshiftedChangeSetMenu: aMenu "Set up aMenu to hold commands for the change-set-list pane. This could be for a single or double changeSorter" <changeSetMenuShifted: false> Smalltalk isMorphic ifTrue: + [aMenu title: 'Change Set' translated] - [aMenu title: 'Change Set'] ifFalse: [aMenu title: 'Change Set: + ' translated , myChangeSet name]. - ' , myChangeSet name]. aMenu addStayUpItemSpecial. + aMenu add: 'make changes go to me (m)' translated action: #newCurrent. - aMenu add: 'make changes go to me (m)' action: #newCurrent. aMenu addLine. + aMenu add: 'new change set... (n)' translated action: #newSet. + aMenu add: 'find...(f)' translated action: #findCngSet. + aMenu add: 'select change set...' translated action: #chooseCngSet. - aMenu add: 'new change set... (n)' action: #newSet. - aMenu add: 'find...(f)' action: #findCngSet. - aMenu add: 'select change set...' action: #chooseCngSet. aMenu addLine. + aMenu add: 'rename change set (r)' translated action: #rename. + aMenu add: 'file out (o)' translated action: #fileOut. + aMenu add: 'mail to list' translated action: #mailOut. + aMenu add: 'browse methods (b)' translated action: #browseChangeSet. + aMenu add: 'browse change set (B)' translated action: #openChangeSetBrowser. - aMenu add: 'rename change set (r)' action: #rename. - aMenu add: 'file out (o)' action: #fileOut. - aMenu add: 'mail to list' action: #mailOut. - aMenu add: 'browse methods (b)' action: #browseChangeSet. - aMenu add: 'browse change set (B)' action: #openChangeSetBrowser. aMenu addLine. parent ifNotNil: + [aMenu add: 'copy all to other side (c)' translated action: #copyAllToOther. + aMenu add: 'submerge into other side' translated action: #submergeIntoOtherSide. + aMenu add: 'subtract other side (-)' translated action: #subtractOtherSide. - [aMenu add: 'copy all to other side (c)' action: #copyAllToOther. - aMenu add: 'submerge into other side' action: #submergeIntoOtherSide. - aMenu add: 'subtract other side (-)' action: #subtractOtherSide. aMenu addLine]. myChangeSet hasPreamble ifTrue: + [aMenu add: 'edit preamble... (p)' translated action: #editPreamble. + aMenu add: 'remove preamble' translated action: #removePreamble] + ifFalse: [aMenu add: 'add preamble... (p)' translated action: #editPreamble]. - [aMenu add: 'edit preamble... (p)' action: #editPreamble. - aMenu add: 'remove preamble' action: #removePreamble] - ifFalse: [aMenu add: 'add preamble... (p)' action: #editPreamble]. myChangeSet hasPostscript ifTrue: + [aMenu add: 'edit postscript...' translated action: #editPostscript. + aMenu add: 'remove postscript' translated action: #removePostscript] + ifFalse: [aMenu add: 'add postscript...' translated action: #editPostscript]. - [aMenu add: 'edit postscript...' action: #editPostscript. - aMenu add: 'remove postscript' action: #removePostscript] - ifFalse: [aMenu add: 'add postscript...' action: #editPostscript]. aMenu addLine. + aMenu add: 'destroy change set (x)' translated action: #remove. - aMenu add: 'destroy change set (x)' action: #remove. aMenu addLine. + aMenu add: 'more...' translated action: #offerShiftedChangeSetMenu. - aMenu add: 'more...' action: #offerShiftedChangeSetMenu. ^ aMenu! Item was changed: ----- Method: ChangeSorter>>unshiftedMessageMenu: (in category 'message list') ----- unshiftedMessageMenu: aMenu "Fill aMenu with items appropriate for the message list; could be for a single or double changeSorter" <messageListMenuShifted: false> + aMenu title: 'message list' translated. - aMenu title: 'message list'. aMenu addStayUpItemSpecial. parent ifNotNil: + [aMenu addTranslatedList: #( - [aMenu addList: #( ('copy method to other side' copyMethodToOther) ('move method to other side' moveMethodToOther))]. + aMenu addTranslatedList: #( - aMenu addList: #( ('delete method from changeSet (d)' forget) - ('remove method from system (x)' removeMessage) - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' spawnHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions)). + ^ aMenu! - ^ aMenu - ! Item was changed: ----- Method: ChangesOrganizer class>>fileOutChangeSetsNamed: (in category 'utilities') ----- fileOutChangeSetsNamed: nameList "File out the list of change sets whose names are provided" "ChangeSorter fileOutChangeSetsNamed: #('New Changes' 'miscTidies-sw')" | notFound empty infoString | notFound := OrderedCollection new. empty := OrderedCollection new. nameList do: [:aName | | aChangeSet | (aChangeSet := self changeSetNamed: aName) ifNotNil: [aChangeSet isEmpty ifTrue: [empty add: aName] ifFalse: [aChangeSet fileOut]] ifNil: [notFound add: aName]]. + infoString := '{1} change set(s) filed out' translated format: {nameList size - notFound size}. - infoString := (nameList size - notFound size) printString, ' change set(s) filed out'. notFound size > 0 ifTrue: [infoString := infoString, ' + ', ('{1} change set(s) not found:' translated format: {notFound size}). - ', notFound size printString, ' change set(s) not found:'. notFound do: [:aName | infoString := infoString, ' ', aName]]. empty size > 0 ifTrue: [infoString := infoString, ' + ', ('{1} change set(s) were empty:' translated format: {empty size }). - ', empty size printString, ' change set(s) were empty:'. empty do: [:aName | infoString := infoString, ' ', aName]]. self inform: infoString! Item was changed: ----- Method: ChangesOrganizer class>>mostRecentChangeSetWithChangeForClass:selector: (in category 'enumerating') ----- mostRecentChangeSetWithChangeForClass: class selector: selector | hits | hits := self allChangeSets select: [:cs | (cs atSelector: selector class: class) ~~ #none]. + hits isEmpty ifTrue: [^ 'not in any change set' translated]. + ^ 'recent cs: {1}' translated format: {hits last name}! - hits isEmpty ifTrue: [^ 'not in any change set']. - ^ 'recent cs: ', hits last name! Item was changed: ----- Method: ChangesOrganizer class>>newChangeSet (in category 'adding') ----- newChangeSet "Prompt the user for a name, and establish a new change set of that name (if ok), making it the current changeset. Return nil of not ok, else return the actual changeset." | newName newSet | + newName := Project uiManager + request: 'Please name the new change set:' translated - newName := UIManager default - request: 'Please name the new change set:' initialAnswer: ChangeSet defaultName. newName isEmptyOrNil ifTrue: [^ nil]. newSet := self basicNewChangeSet: newName. newSet ifNotNil: + [ChangeSet newChanges: newSet]. - [ChangeSet newChanges: newSet]. ^ newSet! Item was changed: ----- Method: ChangesOrganizer class>>removeEmptyUnnamedChangeSets (in category 'removing') ----- removeEmptyUnnamedChangeSets "Remove all change sets that are empty, whose names start with Unnamed, and which are not nailed down by belonging to a Project." "ChangeSorter removeEmptyUnnamedChangeSets" | toGo | (toGo := (self changeSetsNamedSuchThat: [:csName | csName beginsWith: 'Unnamed']) select: [:cs | cs isEmpty and: [cs okayToRemoveInforming: false]]) do: [:cs | self removeChangeSet: cs]. + self inform: ('{1} change set(s) removed.' translated format: {toGo size}).! - self inform: toGo size printString, ' change set(s) removed.'! Item was changed: ----- Method: ClassCommentVersionsBrowser class>>browseCommentOf: (in category 'instance creation') ----- browseCommentOf: class Cursor read showWhile: [| changeList | changeList := self new scanVersionsOf: class. + changeList ifNil: [^ self inform: 'No versions available' translated]. + self open: changeList name: ('Recent versions of {1}''s comments' translated format: {class name}) multiSelect: false ] - changeList ifNil: [^ self inform: 'No versions available']. - self open: changeList name: 'Recent versions of ',class name,'''s comments' multiSelect: false ] ! Item was changed: ----- Method: ClassCommentVersionsBrowser>>offerVersionsHelp (in category 'menu') ----- offerVersionsHelp (StringHolder new contents: self versionsHelpString) + openLabel: 'Class Comment Versions Browsers' translated! - openLabel: 'Class Comment Versions Browsers'! Item was changed: ----- Method: ClassCommentVersionsBrowser>>scanVersionsOf: (in category 'basic function') ----- scanVersionsOf: class "Scan for all past versions of the class comment of the given class" | oldCommentRemoteStr sourceFilesCopy position prevPos stamp preamble tokens prevFileIndex | classOfMethod := class. oldCommentRemoteStr := class organization commentRemoteStr. currentCompiledMethod := oldCommentRemoteStr. selectorOfMethod := #Comment. changeList := OrderedCollection new. list := OrderedCollection new. listIndex := 0. oldCommentRemoteStr ifNil:[^ nil] ifNotNil: [oldCommentRemoteStr sourcePointer]. sourceFilesCopy := SourceFiles collect: [:x | x isNil ifTrue: [ nil ] ifFalse: [x readOnlyCopy]]. position := oldCommentRemoteStr position. file := sourceFilesCopy at: oldCommentRemoteStr sourceFileNumber. [position notNil & file notNil] whileTrue: [file position: (0 max: position-150). " Skip back to before the preamble" [file position < (position-1)] "then pick it up from the front" whileTrue: [preamble := file nextChunk]. prevPos := nil. stamp := ''. (preamble findString: 'commentStamp:' startingAt: 1) > 0 ifTrue: [tokens := Scanner new scanTokens: preamble. (tokens at: tokens size-3) = #commentStamp: ifTrue: ["New format gives change stamp and unified prior pointer" stamp := tokens at: tokens size-2. prevPos := tokens last. prevFileIndex := sourceFilesCopy fileIndexFromSourcePointer: prevPos. prevPos := sourceFilesCopy filePositionFromSourcePointer: prevPos]] ifFalse: ["The stamp get lost, maybe after a condenseChanges" + stamp := '<historical>' translated]. - stamp := '<historical>']. self addItem: (ChangeRecord new file: file position: position type: #classComment class: class name category: nil meta: class isMeta stamp: stamp) text: stamp , ' ' , class name , ' class comment'. prevPos = 0 ifTrue:[prevPos := nil]. position := prevPos. prevPos notNil ifTrue:[file := sourceFilesCopy at: prevFileIndex]]. sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]. listSelections := Array new: list size withAll: false! Item was changed: ----- Method: DependencyBrowser class>>openInvertedOn: (in category 'opening') ----- openInvertedOn: requiredPackageNames "DependencyBrowser openInvertedOn: #(Monticello)" | model | model := self new. ^ ToolBuilder open: ( model packageList: (model packageList select: [:packageName | model computePackageAndClassDependencies: packageName. model packageDeps includesAnyOf: requiredPackageNames]); + windowTitle: ('Dependency Browser (inverted on {1})' translated format: {requiredPackageNames}); + yourself)! - windowTitle: ('Dependency Browser (inverted on {1})' format: {requiredPackageNames}); - yourself) - ! Item was changed: ----- Method: DependencyBrowser class>>openOn: (in category 'opening') ----- openOn: packageNames "DependencyBrowser openOn: #(Morphic EToys)" ^ ToolBuilder open: (self new packageList: packageNames; + windowTitle: 'Dependency Browser (on selected packages)' translated; - windowTitle: 'Dependency Browser (on selected packages)'; yourself)! Item was changed: ----- Method: DependencyBrowser>>classDepsList (in category 'class dependencies') ----- classDepsList "Class dependencies for the currently selected package" | checkDef checkExt | checkDef := [:mref | mref selector = #Definition]. checkExt := [:mref | mref category notNil and: [mref category first = $*]]. ^ classDepsList ifNil: [ classDepsList := self classDeps. classDepsList := classDepsList collect: [:className | String streamContents: [:label | label nextPutAll: className. (self depsForClassNamed: className allSatisfy: checkDef) + ifTrue: [label nextPutAll: ' (defs only)' translated] - ifTrue: [label nextPutAll: ' (defs only)'] ifFalse: [(self depsForClassNamed: className allSatisfy: checkExt) + ifTrue: [label nextPutAll: ' *exts only' translated] - ifTrue: [label nextPutAll: ' *exts only'] ifFalse: [ (self depsForClassNamed: className anySatisfy: checkDef) ifTrue: [label nextPutAll: ' ()']. (self depsForClassNamed: className anySatisfy: checkExt) ifTrue: [label nextPutAll: ' *']]]]]]! Item was changed: ----- Method: DependencyBrowser>>classList (in category 'class list') ----- classList "List of classes that refer to dependencies" | selectedPackage | classDeps ifNil: [^ #()]. self classDepsSelection ifNil: [^ #()]. selectedPackage := PackageOrganizer default packageNamed: self packageListSelection ifAbsent: [nil]. classList := (classDeps at: self classDepsSelection ifAbsent: [#()]) collect: [:mref | mref selector = #Definition + ifTrue: [mref actualClass name, ' (class definition)' translated] - ifTrue: [mref actualClass name, ' (class definition)'] ifFalse: [mref category first = $* + ifTrue: ['*extensions' translated] - ifTrue: ['*extensions'] ifFalse: [mref actualClass name]]] as: Set. ^ classList := classList asArray sort! Item was changed: ----- Method: DependencyBrowser>>contents:notifying: (in category 'contents') ----- contents: input notifying: aController "The retrieved information has changed and its source must now be updated. The information can be a variety of things, depending on the list selections (such as templates for class or message definition, methods) or the user menu commands (such as definition, comment, hierarchy). Answer the result of updating the source." | aString aText theClass theMethodName | self changed: #annotation. aString := input asString. aText := input asText. theClass := self selectedClassOrMetaClass. theMethodName := self selectedMessageName. (theClass notNil and: [theMethodName notNil]) ifTrue: [ ^ self okayToAccept ifFalse: [false] ifTrue: [self defineMessageFrom: aText notifying: aController]]. + self error: 'unacceptable accept' translated! - self error: 'unacceptable accept' - ! Item was changed: ----- Method: DependencyBrowser>>messageList (in category 'message list') ----- messageList "List of messages creating dependencies" | selectedClass label filter | classDeps ifNil: [^ #()]. classList ifNil: [^ #()]. selectedClass := self classListSelection. label := classList at: classListIndex ifAbsent: ['']. filter := label ifEmpty: [ [:mref | false] ] ifNotEmpty: [ + (label first = $* or: [(label endsWith: '(class definition)' translated) not]) - (label first = $* or: [(label endsWith: '(class definition)') not]) ifTrue: [ [:mref | mref selector ~= #Definition and: [mref actualClass name = selectedClass]] ] ifFalse: [ [:mref | mref selector = #Definition and: [mref actualClass name = selectedClass]] ]]. ^((classDeps at: self classDepsSelection ifAbsent:[#()]) select: filter thenCollect:[:mref| mref methodSymbol]) asSet asArray sort! Item was changed: ----- Method: DependencyBrowser>>packageDepsList (in category 'package dependencies') ----- packageDepsList "Package dependencies for the currently selected package" | checkDef checkExt | checkDef := [:mref | mref selector = #Definition]. checkExt := [:mref | mref category notNil and: [mref category first = $*]]. ^ packageDepsList ifNil: [ packageDepsList := self packageDeps. packageDepsList := packageDepsList collect: [:packageName | String streamContents: [:label | label nextPutAll: packageName. (self depsForPackageNamed: packageName allSatisfy: checkDef) + ifTrue: [label nextPutAll: ' (defs only)' translated] - ifTrue: [label nextPutAll: ' (defs only)'] ifFalse: [(self depsForPackageNamed: packageName allSatisfy: checkExt) + ifTrue: [label nextPutAll: ' *exts only' translated] - ifTrue: [label nextPutAll: ' *exts only'] ifFalse: [ (self depsForPackageNamed: packageName anySatisfy: checkDef) ifTrue: [label nextPutAll: ' ()']. (self depsForPackageNamed: packageName anySatisfy: checkExt) ifTrue: [label nextPutAll: ' *']]]]]]! Item was changed: ----- Method: DependencyBrowser>>selectedClassName (in category 'class list') ----- selectedClassName | idx | idx := classListIndex ifNil: [0]. ^ (classList ifNotNil: [ :l | l at: idx ifAbsent: [nil]]) ifNotNil: [:label | label first = $* ifTrue: [nil "extension methods"] + ifFalse: [(label endsWith: '(class definition)' translated) - ifFalse: [(label endsWith: '(class definition)') ifTrue: [label findTokens first] ifFalse: [label "e.g., 'String' or 'String class'"]]]! Item was changed: ----- Method: DualChangeSorter>>labelString (in category 'other') ----- labelString + + ^ 'Changes go to "{1}"' translated format: {ChangeSet current name}! - "The window label" - ^'Changes go to "', ChangeSet current name, '"'.! Item was changed: ----- Method: FileList>>put: (in category 'private') ----- put: aText "Private - put the supplied text onto the file" + | ff newName contentTypeLabel | - | ff type newName | brevityState == #fullFile ifTrue: [ff := directory newFileNamed: self fullName. Cursor write showWhile: [ff nextPutAll: aText asString; close]. (directory = ff directory and: [fileName = ff localName]) ifTrue: [contents := aText asString] ifFalse: "user changed the directory and/or renamed the file" [self clearUserEditFlag. directory ~= ff directory ifTrue: [self directory: ff directory. self changed: #rootDirectoryList; changed: #selectedPath]. self updateFileList. contents := aText asString. newName := ff localName. listIndex := list findFirst: [:item | (self fileNameFromFormattedItem: item) = newName]. listIndex > 0 ifTrue: [fileName := newName]. brevityState := #needToGetBrief. self changed: #fileListIndex]. self changed: #relabel. ^ true "accepted"]. listIndex = 0 ifTrue: [self inform: 'No fileName is selected' translated. ^ false "failed"]. + contentTypeLabel := 'These contents' translated. + brevityState = #briefFile ifTrue: [contentTypeLabel := 'Abbreviated contents' translated]. + brevityState = #briefHex ifTrue: [contentTypeLabel := 'Abbreviated contents' translated]. + brevityState = #fullHex ifTrue: [contentTypeLabel := 'Hexadecimal contents' translated]. + brevityState = #FileList ifTrue: [contentTypeLabel := 'Directory contents' translated]. + self inform: ('{1} cannot + meaningfully be saved at present.' translated format: {'Abbreviated contents' translated}). - type := 'These'. - brevityState = #briefFile ifTrue: [type := 'Abbreviated']. - brevityState = #briefHex ifTrue: [type := 'Abbreviated']. - brevityState = #fullHex ifTrue: [type := 'Hexadecimal']. - brevityState = #FileList ifTrue: [type := 'Directory']. - self inform: ('{1} contents cannot - meaningfully be saved at present.' translated format:{type translated}). ^ false "failed" ! Item was changed: ----- Method: Inspector>>inspectOneOf: (in category 'menu - commands') ----- inspectOneOf: someKeys | elements labels choice | someKeys size = 0 ifTrue: [^ self inform: 'Nothing to inspect.' translated]. someKeys size = 1 ifTrue: [^ (self elementAt: someKeys first) inspect]. someKeys size > 50 ifTrue: [^ self inspectOneOfFrom: someKeys first to: someKeys last]. elements := someKeys collect: [:key | [self elementAt: key] ifError: ['<???>']]. labels := someKeys with: elements collect: [:key :element | '{1} -> {2}' format: { key printString. [element printString withoutLineEndings withBlanksCondensed truncateWithElipsisTo: 75] ifError: ['<???>']}]. + choice := Project uiManager chooseFrom: labels title: 'Inspect which field?' translated. - choice := Project uiManager chooseFrom: labels title: 'Inspect which field?'. choice = 0 ifTrue: [^ self]. (elements at: choice) inspect.! Item was changed: ----- Method: Inspector>>labelString (in category 'user interface - window') ----- labelString "See #windowTitle. All tools chose to implement #labelString." ^ '{1}{2}' format: { self object defaultLabelForInspector. self object isReadOnlyObject + ifTrue: [' (read-only)' translated] - ifTrue: [' (read-only)'] ifFalse: ['']}! Item was changed: ----- Method: Model>>saveContents:accessMode: (in category '*Tools-file out') ----- saveContents: stringContents accessMode: accessMode "Interactive callback from TextEditor. Ask the user for a file name/path, suggesting a (cleaned-up) default name to accept. Answers whether the save request was successful." ^ (Project uiManager + saveFilenameRequest: 'Save text contents in file...' translated - saveFilenameRequest: 'Save text contents in file...' initialAnswer: self suggestedFileNameForSave) ifNil: [false] ifNotNil: [:answer | answer ifEmpty: [false] ifNotEmpty: [:fileName | self saveContents: stringContents onFileNamed: fileName accessMode: accessMode]].! Item was changed: ----- Method: Model>>saveContents:onFileNamed:accessMode:workBlock: (in category '*Tools-file out') ----- saveContents: stringContents onFileNamed: fileName accessMode: accessMode workBlock: workBlock "Save stringContents on fileName. Answers whether the save request was successful. On success, fileName will exist, including any new directories in the relative/absolute path. accessMode #create ... Prompt the user if file exists. #update ... Replace all contents if file exists. #append ... Append new contents if file exists." (FileDirectory default on: fileName) containingDirectory assureExistence. accessMode caseOf: { [#create] -> [FileStream newFileNamed: fileName do: workBlock]. [#update] -> [FileStream forceNewFileNamed: fileName do: workBlock]. [#append] -> [FileStream fileNamed: fileName do: [:s | s setToEnd. workBlock value: s]] } otherwise: [ + self error: ('Unknown file access mode: {1}' translated format: {accessMode printString}). - self error: 'Unknown file access mode: ', accessMode printString. ^ false]. Transcript showln: ('{1} contents saved (via {2}) to: {3}' format: { self class. accessMode printString. fileName }). ^ true! Item was changed: ----- Method: VersionsBrowser class>>browseVersionsOf:class:meta:category:selector:lostMethodPointer: (in category 'instance creation') ----- browseVersionsOf: method class: class meta: meta category: msgCategory selector: selector lostMethodPointer: sourcePointer | changeList browser | Cursor read showWhile: [changeList := (browser := self new) scanVersionsOf: method class: class meta: meta category: msgCategory selector: selector]. + changeList ifNil: [ self inform: 'No versions available' translated. ^nil ]. - changeList ifNil: [ self inform: 'No versions available'. ^nil ]. sourcePointer ifNotNil: [changeList setLostMethodPointer: sourcePointer]. + self open: changeList name: ('Recent versions of {1}' translated format: {selector}) multiSelect: false. - self open: changeList name: 'Recent versions of ' , - selector multiSelect: false. ^browser! Item was changed: ----- Method: VersionsBrowser>>addPriorVersionsCountForSelector:ofClass:to: (in category 'misc') ----- addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream "Add an annotation detailing the prior versions count. Specially handled here for the case of a selector no longer in the system, whose prior versions are seen in a versions browser -- in this case, the inherited version of this method will not work." (aClass includesSelector: aSelector) ifTrue: [^ super addPriorVersionsCountForSelector: aSelector ofClass: aClass to: aStream]. aStream nextPutAll: ((changeList size > 0 ifTrue: [changeList size = 1 ifTrue: + ['Deleted - one prior version' translated] - ['Deleted - one prior version'] ifFalse: ['Deleted - ', changeList size printString, ' prior versions']] ifFalse: + ['surprisingly, no prior versions' translated]), self annotationSeparator)! - ['surprisingly, no prior versions']), self annotationSeparator)! Item was changed: ----- Method: VersionsBrowser>>fileOutSelection (in category 'menu') ----- fileOutSelection | them it file | them := OrderedCollection new. listSelections with: changeList do: [:selected :item | selected ifTrue: [them add: item]]. them size ~= 1 + ifTrue: [self inform: 'single version not selected, so nothing done' translated] - ifTrue: [self inform: 'single version not selected, so nothing done'] ifFalse: [it := them first. file := FileStream newFileNamed: it methodClassName, (it isMetaClassChange ifTrue: [' class'] ifFalse: ['']), '-' , (it methodSelector copyReplaceAll: ':' with: ''). [file header; timeStamp. it fileOutOn: file] ensure: [file close]]! Item was changed: ----- Method: VersionsBrowser>>findOriginalChangeSet (in category 'menu') ----- findOriginalChangeSet | changeSet | self currentChange ifNil: [^ self]. changeSet := self currentChange originalChangeSetForSelector: self selectedMessageName. changeSet = #sources ifTrue: + [^ self inform: 'This version is in the .sources file.' translated]. - [^ self inform: 'This version is in the .sources file.']. changeSet ifNil: + [^ self inform: 'This version was not found in any changeset nor in the .sources file.' translated]. - [^ self inform: 'This version was not found in any changeset nor in the .sources file.']. (ChangeSorter new myChangeSet: changeSet) open! Item was changed: ----- Method: VersionsBrowser>>versionsHelpString (in category 'menu') ----- versionsHelpString ^ 'Each entry in the list pane represents a version of the source code for the same method; the topmost entry is the current version, the next entry is the next most recent, etc. To revert to an earlier version, select it (in the list pane) and then do any of the following: * Choose "revert to this version" from the list pane menu. * Hit the "revert" button, * Type ENTER in the code pane * Type cmd-s (alt-s) in the code pane. The code pane shows the source for the selected version. If "diffing" is in effect, then differences betwen the selected version and the version before it are pointed out in the pane. Turn diffing on and off by choosing "toggle diffing" from the list pane menu, or hitting the "diffs" button, or hitting cmd-D when the cursor is over the list pane. To get a comparison between the selected version and the current version, choose "compare to current" from the list pane menu or hit the "compare to current" button. (This is meaningless if the current version is selected, and is unnecessary if you''re interested in diffs from between the current version and the next-most-recent version, since the standard in-pane "diff" feature will give you that.) You can also compare the selected version with any other version using the "compare to version..." menu choice. If further versions of the method in question have been submitted elsewhere since you launched a particular Versions Browser, it will still stay nicely up-to-date if you''re in Morphic and have asked that smart updating be maintained; if you''re in mvc or in morphic but with smart-updating turned off, a versions browser is only brought up to date when you activate its window (and when you issue "revert" from within it, of course,) and you can also use the "update list" command to make certain the versions list is up to date. Hit the "remove from changes" button, or choose the corresponding command in the list pane menu, to have the method in question deleted from the current change set. This is useful if you''ve put debugging code into a method, and now want to strip it out and cleanse your current change set of all memory of the excursion. + Note: the annotation pane in versions browsers shows information about the *current* version of the method in the image, not about the selected version.' translated! - Note: the annotation pane in versions browsers shows information about the *current* version of the method in the image, not about the selected version.'!

1 0

The Trunk: UpdateStream-ct.18.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of UpdateStream to project The Trunk: http://source.squeak.org/trunk/UpdateStream-ct.18.mcz ==================== Summary ==================== Name: UpdateStream-ct.18 Author: ct Time: 3 January 2022, 10:33:39.363397 pm UUID: b48f8a5e-509e-324c-8bd6-4f75867a9e93 Ancestors: UpdateStream-dtl.17 Several improvements to multilingual support. =============== Diff against UpdateStream-dtl.17 =============== Item was changed: ----- Method: ImageReadWriter class>>formFromServerFile: (in category '*UpdateStream') ----- formFromServerFile: fileName "Answer a ColorForm stored on the file with the given name. Meant to be called from during the getting of updates from the server. That assures that (UpdateStreamDownloader default serverUrls) returns the right group of servers." | urls | urls := UpdateStreamDownloader default serverUrls collect: [:url | url, fileName]. " fileName starts with: 'updates/' " urls do: [:aURL | | form doc | (fileName findTokens: '.') last asLowercase = 'gif' ifTrue: [ form := HTTPSocket httpGif: aURL. form = (ColorForm extent: 20@20 depth: 8) + ifTrue: [self inform: ('The file {1} is ill-formed.' translated format: {aURL})]. - ifTrue: [self inform: 'The file ',aURL,' is ill formed.']. ^ form]. (fileName findTokens: '.') last asLowercase = 'bmp' ifTrue: [ doc := HTTPSocket httpGet: aURL accept: 'image/bmp'. form := Form fromBMPFile: doc. doc close. + form + ifNil: [ + self inform: ('The file {1} is ill-formed.' translated format: {aURL}). + ^ Form new] - form ifNil: [self inform: 'The file ',aURL,' is ill formed.'. ^ Form new] ifNotNil: [^ form]]. + self inform: ('File {1} does not end with .gif or .bmp' translated format: {fileName})]. + self inform: 'That file not found on any server we know' translated.! - self inform: 'File ', fileName, 'does not end with .gif or .bmp']. - self inform: 'That file not found on any server we know'.! Item was changed: ----- Method: UpdateStreamDownloader class>>applyUpdatesFromDiskToUpdateNumber:stopIfGap: (in category 'fetching updates') ----- applyUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag "To use this mechanism, be sure all updates you want to have considered are in a folder named 'updates' which resides in the same directory as your image. Having done that, simply evaluate: UpdateStreamDownloader applyUpdatesFromDiskToUpdateNumber: 1234 stopIfGap: false and all numbered updates <= lastUpdateNumber not yet in the image will be loaded in numerical order." | previousHighest currentUpdateNumber done fileNames aMessage updateDirectory loaded | updateDirectory := self getUpdateDirectoryOrNil. updateDirectory ifNil: [^ self]. previousHighest := SystemVersion current highestUpdate. currentUpdateNumber := previousHighest. done := false. loaded := 0. [done] whileFalse: [currentUpdateNumber := currentUpdateNumber + 1. currentUpdateNumber > lastUpdateNumber ifTrue: [done := true] ifFalse: [fileNames := updateDirectory fileNamesMatching: currentUpdateNumber printString , '*'. fileNames size > 1 + ifTrue: [^ self inform: ('ambiguity -- two files both start with {1} - ifTrue: [^ self inform: 'ambiguity -- two files both start with ' , currentUpdateNumber printString , ' (at this point it is probably best to remedy + the situation on disk, then try again.)' translated format: {currentUpdateNumber})]. - the situation on disk, then try again.)']. fileNames size = 0 ifTrue: [Transcript cr; show: 'gap in updates from disk for update number '; print: currentUpdateNumber; show: ' found...'. done := stopIfGapFlag] ifFalse: [ChangeSet newChangesFromStream: (updateDirectory readOnlyFileNamed: fileNames first) named: fileNames first. SystemVersion current registerUpdate: currentUpdateNumber. loaded := loaded + 1]]]. aMessage := loaded = 0 + ifTrue: ['No new updates found.' translated] + ifFalse: ['{1} update(s) loaded.' translated format: {loaded printString}]. + self inform: ('{1} + Highest numbered update is now {2}.' translated format: {aMessage. currentUpdateNumber - 1}).! - ifTrue: ['No new updates found.'] - ifFalse: [loaded printString , ' update(s) loaded.']. - self inform: aMessage , ' - Highest numbered update is now ' , (currentUpdateNumber - 1) printString , '.'! Item was changed: ----- Method: UpdateStreamDownloader class>>newUpdatesOn:special:throughNumber: (in category 'fetching updates') ----- newUpdatesOn: serverList special: indexPrefix throughNumber: aNumber "Return a list of fully formed URLs of update files we do not yet have. Go to the listed servers and look at the file 'updates.list' for the names of the last N update files. We look backwards for the first one we have, and make the list from there. tk 9/10/97 No updates numbered higher than aNumber (if it is not nil) are returned " | existing out maxNumber | maxNumber := aNumber ifNil: [99999]. out := OrderedCollection new. existing := SystemVersion current updates. serverList do: [:server | | raw doc list char | doc := HTTPSocket httpGet: 'http://' , server,indexPrefix,'updates.list'. "test here for server being up" doc class == RWBinaryOrTextStream ifTrue: [raw := doc reset; contents. "one file name per line" list := self extractThisVersion: raw. list reverseDo: [:fileName | | ff itsNumber | ff := (fileName findTokens: '/') last. "allow subdirectories" itsNumber := ff initialIntegerOrNil. (existing includes: itsNumber) ifFalse: [ (itsNumber == nil or: [itsNumber <= maxNumber]) ifTrue: [out addFirst: 'http://' , server, fileName]] ifTrue: [^ out]]. ((out size > 0) or: [char := doc reset; skipSeparators; next. (char == $*) | (char == $#)]) ifTrue: [^ out "we have our list"]]. "else got error msg instead of file" "Server was down, try next one"]. + self inform: 'All code update servers seem to be unavailable' translated. - self inform: 'All code update servers seem to be unavailable'. ^ out! Item was changed: ----- Method: UpdateStreamDownloader class>>objectStrmFromUpdates: (in category 'fetching updates') ----- objectStrmFromUpdates: fileName "Go to the known servers and look for this file in the updates folder. It is an auxillery file, like .morph or a .gif. Return a RWBinaryOrTextStream on it. Meant to be called from during the getting of updates from the server. That assures that (UpdateStreamDownloader serverUrls) returns the right group of servers." Cursor wait showWhile: [ | urls | urls := UpdateStreamDownloader serverUrls collect: [:url | url, 'updates/', fileName]. urls do: [:aUrl | | doc | doc := HTTPSocket httpGet: aUrl accept: 'application/octet-stream'. "test here for server being up" doc class == RWBinaryOrTextStream ifTrue: [^ doc reset]]]. + self inform: 'All update servers are unavailable, or bad file name' translated. - self inform: 'All update servers are unavailable, or bad file name'. ^ nil! Item was changed: ----- Method: UpdateStreamDownloader class>>position:atVersion: (in category 'fetching updates') ----- position: updateStrm atVersion: version "Set the stream to the end of the last line of updates names for this version. Usually the end of the file. We will add a new update name. Return the contents of the rest of the file." | char foundIt where data | updateStrm reset; ascii. foundIt := false. [char := updateStrm next. updateStrm atEnd] whileFalse: [ (char == Character cr or: [char == Character lf]) ifTrue: [ updateStrm peek == $# ifTrue: [ foundIt ifTrue: ["Next section" where := updateStrm position. data := updateStrm upTo: (255 asCharacter). updateStrm position: where. ^ data]. "won't be found -- copy all the way to the end" updateStrm next. (updateStrm nextMatchAll: version) ifTrue: [ (updateStrm atEnd or: [(updateStrm peek = Character cr) | (updateStrm peek = Character lf)]) ifTrue: [ foundIt := true ]]]]]. foundIt ifTrue: [ updateStrm setToEnd. ^ '']. + self error: 'The current version does not have a section in the Updates file' translated.! - self error: 'The current version does not have a section in the Updates file'. - !

1 0

The Trunk: XML-Explorer-ct.2.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of XML-Explorer to project The Trunk: http://source.squeak.org/trunk/XML-Explorer-ct.2.mcz ==================== Summary ==================== Name: XML-Explorer-ct.2 Author: ct Time: 3 January 2022, 10:29:11.972397 pm UUID: ab93eaa9-fa48-5f45-a686-beb9d3b8cdcc Ancestors: XML-Explorer-topa.1 Improves multilingual support. =============== Diff against XML-Explorer-topa.1 =============== Item was changed: ----- Method: XMLNodeWithElements>>explorerContents (in category '*XML-Explorer') ----- explorerContents ^ self elementsAndContents collect: [:element | | name | name := element isTag ifTrue: ['<{1}>' format: {element name}] ifFalse: [element isText + ifTrue: ['[character data]' translated] - ifTrue: ['[character data]'] ifFalse: [element]]. ObjectExplorerWrapper with: element name: (name asString contractTo: 32) + model: self ]! - model: self ] - !

1 0

The Trunk: ReleaseBuilder-ct.226.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of ReleaseBuilder to project The Trunk: http://source.squeak.org/trunk/ReleaseBuilder-ct.226.mcz ==================== Summary ==================== Name: ReleaseBuilder-ct.226 Author: ct Time: 3 January 2022, 10:27:10.842397 pm UUID: 3639c022-82ea-7744-b68c-5cc171829185 Ancestors: ReleaseBuilder-mt.225 Improves multilingual support. =============== Diff against ReleaseBuilder-mt.225 =============== Item was changed: ----- Method: ReleaseBuilder class>>assureReleaseRepositoryReadAccess: (in category 'manual') ----- assureReleaseRepositoryReadAccess: repo self releaseLocally ifTrue: [ (FileDirectory on: repo description) assureExistence. ^ true]. [repo allFileNames] on: NetworkError, NotFound do: [ self + inform: ('Release Builder - Manual Step Required\\Please create the release repository:\{1}\...and ensure that you have global read access to it.' translated withCRs - inform: ('Release Builder - Manual Step Required\\Please create the release repository:\{1}\...and ensure that you have global read access to it.' withCRs format: {repo description}). ^ false]. ^ true! Item was changed: ----- Method: ReleaseBuilder class>>assureReleaseRepositoryWriteAccess: (in category 'manual') ----- assureReleaseRepositoryWriteAccess: repo self releaseLocally ifTrue: [^ self]. repo + user: (Project uiManager + request: ('Enter user for {1}' translated format: {repo description}) - user: (UIManager default - request: 'Enter user for ', repo description initialAnswer: (repo user ifEmpty: [Utilities authorInitials])); + password: (Project uiManager + requestPassword: ('Enter password for {1}' translated format: {repo description})).! - password: (UIManager default - requestPassword: 'Enter password for ' , repo description).! Item was changed: ----- Method: ReleaseBuilder class>>checkForDirtyPackages (in category 'scripts - support') ----- checkForDirtyPackages | modifiedWorkingCopies unmergedWorkingCopies | MCWorkingCopy checkModified: true. modifiedWorkingCopies := MCWorkingCopy allManagers select: [:wc | wc ancestors size = 1 and: [wc modified] ]. unmergedWorkingCopies := MCWorkingCopy allManagers select: [:wc | (wc ancestors size = 1) not ]. unmergedWorkingCopies ifNotEmpty: [ "Sort to simplify exploration. MC browser does also show packages sorted." (unmergedWorkingCopies sorted: [:wc1 :wc2 | wc1 packageName <= wc2 packageName]) explore. + Warning signal: 'There are unmerged packages.' translated]. - Warning signal: 'There are unmerged packages.']. modifiedWorkingCopies ifNotEmpty: [ "Sort to simplify exploration. MC browser does also show packages sorted." (modifiedWorkingCopies sorted: [:wc1 :wc2 | wc1 packageName <= wc2 packageName]) explore. (self + confirm: 'Do you want to discard all local changes?' translated + orCancel: [^ Error signal: 'Release building canceled.' translated] + title: 'Dirty Packages Found' translated) - confirm: 'Do you want to discard all local changes?' - orCancel: [^ Error signal: 'Release building canceled.'] - title: 'Dirty Packages Found') ifTrue: [modifiedWorkingCopies do: [:wc | [(self buildRepository versionWithInfo: wc ancestors first) load] on: Warning do: [:warning | warning resume]]]].! Item was changed: ----- Method: ReleaseBuilder class>>checkForNilCategories (in category 'scripts - support') ----- checkForNilCategories | nilClasses nilMethods | nilClasses := OrderedCollection new. nilMethods := OrderedCollection new. SystemNavigation default allClasses do: [:cls | cls category ifNil: [nilClasses add: cls]. {cls. cls class} do: [:b | b selectorsAndMethodsDo: [:selector :method | (method methodClass organization categoryOfElement: selector) in: [:category | (category isNil or: [category = 'nil']) ifTrue: [ nilMethods add: method methodReference]]]]] + displayingProgress: [:behavior | 'Checking for invalid categories...' translated]. - displayingProgress: [:behavior | 'Checking for invalid categories...']. nilMethods ifNotEmpty: [ + SystemNavigation default browseMessageList: nilMethods name: 'Messages with invalid categories' translated autoSelect: nil]. - SystemNavigation default browseMessageList: nilMethods name: 'Messages with invalid categories ', nilMethods size autoSelect: nil]. nilClasses ifNotEmpty: [ nilClasses explore]. (nilClasses notEmpty or: [nilMethods notEmpty]) ifTrue: [ + Warning signal: 'There are classes or methods with invalid categories!!' translated].! - Warning signal: 'There are classes or methods with invalid categories!!'].! Item was changed: ----- Method: ReleaseBuilder class>>checkForUndeclaredSymbols (in category 'scripts - support') ----- checkForUndeclaredSymbols "Parses through all source code in the image and looks for undeclard symbols in those." | msgs | msgs := OrderedCollection new. SystemNavigation default allClasses do: [:cls | {cls. cls class} do: [:b | b selectorsAndMethodsDo: [:selector :method | | parser ranges | parser := SHParserST80 new. parser parseAMethod: true. ranges := parser rangesIn: method getSource classOrMetaClass: method methodClass workspace: nil environment: method methodClass environment. (ranges anySatisfy: [:range | range type = #undefinedIdentifier]) ifTrue: [msgs add: method methodReference]]]] + displayingProgress: [:behavior | 'Checking for undeclared symbols...' translated]. - displayingProgress: [:behavior | 'Checking for undeclared symbols...']. msgs ifNotEmpty: [ + SystemNavigation default browseMessageList: msgs name: 'Invalid Messages' translated autoSelect: nil. + Warning signal: 'There is source code with undeclared symbols!!' translated].! - SystemNavigation default browseMessageList: msgs name: 'Invalid Messages ', msgs size autoSelect: nil. - Warning signal: 'There is source code with undeclared symbols!!'].! Item was changed: ----- Method: ReleaseBuilder class>>configureProjects (in category 'scripts') ----- configureProjects "Set up the desired configuration of projects, which might be a single project, multiple projects..." | homeProject rootProject | homeProject := Project current. rootProject := homeProject. homeProject isMorphic ifFalse: [ + Warning signal: 'The current project is not Morphic. Please create a new Morphic project, enter it, and restart the release building process.' translated]. - Warning signal: 'The current project is not Morphic. Please create a new Morphic project, enter it, and restart the release building process.']. "The home project is a single Morphic project. Let the home project have a parent MVC project as the root of the project tree. The MVC project supports emergency debugging in the event of unrecoverable Morphic problems, and will fall back on the traditional emergency evaluator if MVC debugging fails. If MVC is not installed in the image, then do nothing." Project current removeAllOtherProjects. (Smalltalk classNamed: #MVCProject) + ifNil: [Warning signal: 'MVC must be installed in the release image.' translated] - ifNil: [Warning signal: 'MVC must be installed in the release image.'] ifNotNil: [:mvc | rootProject := mvc new]. rootProject name: 'RootProject'. homeProject name: 'HomeProject'. self assert: homeProject isTopProject; assert: rootProject isTopProject not. rootProject beTopProject. self assert: rootProject isTopProject; assert: homeProject isTopProject not. self assert: rootProject subProjects size = 1; assert: homeProject parent == rootProject; assert: rootProject isMVC.! Item was changed: ----- Method: ReleaseBuilder class>>copyPackagesFrom:to:depth: (in category 'manual') ----- copyPackagesFrom: sourceRepository to: targetRepository depth: historyDepth "Copy the packages currently loaded in the image from the source repository to a target repository. Follow ancestry up to the depth specified." | currentDepth nextVersions currentVersions ignoredVersions | currentDepth := 0. nextVersions := (MCWorkingCopy allManagers gather: [:wc | wc ancestors]) asOrderedCollection. ignoredVersions := OrderedCollection new. [nextVersions notEmpty] whileTrue: [ currentVersions := nextVersions. nextVersions := OrderedCollection new. currentDepth := currentDepth + 1. currentVersions do: [:versionInfo | (targetRepository includesVersionNamed: versionInfo versionName) ifTrue: [Transcript showln: ('[ReleaseBuilder] Version {1} already exists in {2}' format: {versionInfo versionName. targetRepository description})] ifFalse: [(sourceRepository versionWithInfo: versionInfo) ifNil: [ignoredVersions add: versionInfo] ifNotNil: [:version | targetRepository storeVersion: version ] ]. currentDepth < historyDepth ifTrue: [ nextVersions addAll: versionInfo ancestors]]]. ignoredVersions ifNotEmpty: [ ignoredVersions explore. + Warning signal: 'There were versions not found in the source repository.' translated].! - Warning signal: 'There were versions not found in the source repository.'].! Item was changed: ----- Method: ReleaseBuilder class>>doNextStep (in category 'manual - steps') ----- doNextStep "Use this call to perform the manual steps in the release process." | versionString | SystemVersion current isRelease ifTrue: [ + ^ self inform: 'This is a release image. Please use a trunk image to prepare the next release' translated]. - ^ self inform: 'This is a release image. Please use a trunk image to prepare the next release']. versionString := SystemVersion current version. SystemVersion current isAlpha ifTrue: [^ self step1FeatureFreeze]. (SystemVersion current isFeatureFreeze and: [SystemVersion current isCodeFreeze not]) ifTrue: [^ self step2CodeFreeze]. SystemVersion current isReleaseCandidate ifTrue: [ "Still code freeze and another RC? Or do the release?" + (Project uiManager - (UIManager default chooseFrom: #('Create next release candidate' 'Create next release' 'Do nothing') lines: #(2) title: versionString) in: [:answer | answer = 1 ifTrue: [^ self step3NextReleaseCandidate]. answer = 2 ifTrue: [^ self step4Release]]. ^ self].! Item was changed: ----- Method: ReleaseBuilder class>>fileOutChangesBetweenReleases (in category 'scripts - changes') ----- fileOutChangesBetweenReleases "Generate mark-down files with all commit messages by release. To be used to write release notes." | fileNames | fileNames := OrderedCollection new. self changesBetweenReleases keysAndValuesDo: [:location :c | fileNames add: ('commits-{1}.md' format: {(location findTokens: '/') last}). FileStream forceNewFileNamed: fileNames last do: [:strm | c withKeysSortedSafely keysAndValuesDo: [:pkg :changes | strm nextPutAll: '# '; nextPutAll: pkg name; cr. (changes withKeysSorted: #dateAndTime ascending) keysAndValuesDo: [:ver :msg | strm nextPutAll: '- **'; nextPutAll: ver name; nextPutAll: ':** '. msg lines withIndexDo: [:line :index | line ifNotEmpty: [:m | index > 1 ifTrue: [strm nextPutAll: ' ']. strm nextPutAll: m. strm cr]]]]]]. + self inform: 'Files written:' translated translated, String cr, (fileNames joinSeparatedBy: String cr).! - self inform: 'Files written:\' withCRs, (fileNames joinSeparatedBy: String cr).! Item was changed: ----- Method: ReleaseBuilder class>>openWelcomeWorkspacesWith: (in category 'scripts - support') ----- openWelcomeWorkspacesWith: balloonForm | t browser balloon | + t := HelpTopic title: 'Welcome to Squeak' translated readOnlyContents: 'Please choose a topic from the left sidebar.' translated. - t := HelpTopic title: 'Welcome to Squeak' readOnlyContents: 'Please choose a topic from the left sidebar.'. t subtopics add: (SqueakHelp asHelpTopic subtopics detect: [:ea | ea key = #introduction]); add: SqueakLicenseHelp asHelpTopic; add: (SqueakProjectHelp asHelpTopic subtopics detect: [:ea | ea key = #squeakUserInterface]); add: (SqueakProjectHelp asHelpTopic subtopics detect: [:ea | ea key = #workingWithSqueak]); add: SqueakReleaseNotes asHelpTopic. browser := HelpBrowser openOn: t. browser extent: browser world extent * 0.6. browser center: browser world center. browser model showFirstTopic. balloonForm ifNil: [^ self]. balloon := balloonForm asMorph. browser addMorphFront: balloon. balloon layoutFrame: (LayoutFrame fractions: (0@1 corner: 0@1) offsets: (balloon width // 1.7 negated @ (balloon height * 0.9) negated corner: 0@0)).! Item was changed: ----- Method: ReleaseBuilder class>>recompileAll (in category 'scripts - support') ----- recompileAll (Smalltalk classNamed: #EncoderForSistaV1) ifNotNil: [:sistaBytecodeSet| CompiledCode preferredBytecodeSetEncoderClass ~~ sistaBytecodeSet ifTrue: [(self + confirm: 'Do you want to make it the default in this release?' translated - confirm: 'Do you want to make it the default in this release?' orCancel: [false] + title: 'The SistaV1 Bytecode Set Is Available' translated) ifTrue: - title: 'The SistaV1 Bytecode Set Is Available') ifTrue: [CompiledCode installSecondaryBytecodeSet: sistaBytecodeSet; preferredBytecodeSetEncoderClass: sistaBytecodeSet]]]. Compiler recompileAll! Item was changed: ----- Method: ReleaseBuilder class>>releaseRepository (in category 'accessing') ----- releaseRepository (MCRepositoryGroup default repositories detect: [:repo | repo description = self releaseRepositoryUrl] ifNone: [MCRepository location: self releaseRepositoryUrl]) in: [:repo | (self assureReleaseRepositoryReadAccess: repo) + ifFalse: [ReleaseBuilderFailed signal: 'Could not build the release.' translated]. - ifFalse: [ReleaseBuilderFailed signal: 'Could not build the release.']. MCRepositoryGroup default addRepository: repo. ^ repo]! Item was changed: ----- Method: ReleaseBuilder class>>requestNextReleaseVersion (in category 'manual') ----- requestNextReleaseVersion "self requestNextReleaseVersion" | nextMinor nextMajor current next | current := { SystemVersion current majorVersionNumber. SystemVersion current minorVersionNumber}. nextMinor := { current first. current second + 1}. nextMajor := { current first + 1. 0}. next := Project uiManager chooseFromLabeledValues: (OrderedDictionary new at: ('{1}.{2}' format: {nextMinor first. nextMinor second}) put: nextMinor; at: ('{1}.{2}' format: {nextMajor first. nextMajor second}) put: nextMajor; yourself) + title: 'Please Choose Next Version' translated. - title: 'Please Choose Next Version'. next ifNil: [^ self requestNextReleaseVersion]. NextMajorVersion := next first. NextMinorVersion := next second.! Item was changed: ----- Method: ReleaseBuilder class>>saveAsNewClean (in category 'saving') ----- saveAsNewClean "Use this to create clean up the current image and save it under a new name." | fileName | (Project uiManager + confirm: 'This will update and clean-up the current image,\which is then saved under a new name.\\Do you want to continue?' translated withCRs + title: 'Prepare Clean Image' translated) == true ifFalse: [^ self]. - confirm: 'This will update and clean-up the current image,\which is then saved under a new name.\\Do you want to continue?' withCRs - title: 'Prepare Clean Image') == true ifFalse: [^ self]. "Prepare first so that we can propose an appropriate file name." self prepareSourceCode; prepareEnvironment. fileName := ('{1}-{2}-{3}-{4}bit-i{5}.image' format: { SystemVersion current version. SystemVersion current highestUpdate. CompiledCode preferredBytecodeSetEncoderClass name allButFirst: 'EncoderFor' size. Smalltalk wordSize * 8. Smalltalk imageFormatVersion}). fileName := Project uiManager saveFilenameRequest: 'Save clean image as...' translated initialAnswer: fileName. fileName ifNil: [^ self]. Smalltalk saveAs: fileName. self saveAndQuit.! Item was changed: ----- Method: ReleaseBuilder class>>saveClean (in category 'saving') ----- saveClean "Use this to clean up the current image and save it under a new name." (Project uiManager + confirm: 'This will update and clean-up the current (!!) image,\which is then saved under the same (!!) name.\\Do you want to continue?' withCRs translated + title: 'Clean Image' translated) == true ifFalse: [^ self]. - confirm: 'This will update and clean-up the current (!!) image,\which is then saved under the same (!!) name.\\Do you want to continue?' withCRs - title: 'Clean Image') == true ifFalse: [^ self]. self prepareSourceCode; prepareEnvironment. self saveAndQuit.! Item was changed: ----- Method: ReleaseBuilder class>>setDisplayExtent: (in category 'scripts - support') ----- setDisplayExtent: extent [ DisplayScreen fullScreenOff; setNewScreenSize: extent. ] on: Error do: [:err | + Transcript showln: ('[ReleaseBuilder] Failed to set display extent to: {1}. Keep {2}.' translated format: {extent. Display extent})].! - Transcript showln: ('[ReleaseBuilder] Failed to set display extent to: {1}. Keep {2}.' format: {extent. Display extent})].! Item was changed: ----- Method: ReleaseBuilder class>>step1FeatureFreeze (in category 'manual - steps') ----- step1FeatureFreeze + (Project uiManager + confirm: ('Do you really want to feature-freeze the trunk\in preparation for the next release {1}?\Bugfixes only after this.' translated withCRs format: {self versionString}) + title: 'Release Builder Step 1 of 4: Feature Freeze' translated) ifFalse: [^ self]. - (UIManager default - confirm: ('Do you really want to feature-freeze the trunk\in preparation for the next release {1}?\Bugfixes only after this.' withCRs format: {self versionString}) - title: 'Release Builder Step 1 of 4: Feature Freeze') ifFalse: [^ self]. self setNewSystemVersion: self versionString, 'beta'.! Item was changed: ----- Method: ReleaseBuilder class>>step2CodeFreeze (in category 'manual - steps') ----- step2CodeFreeze "Creates the first release candidate." + (Project uiManager + confirm: ('Do you really want to code-freeze the trunk\in preparation for the next release {1}?\Urgent fixes only after this.' translated withCRs format: {self versionString}) - (UIManager default - confirm: ('Do you really want to code-freeze the trunk\in preparation for the next release {1}?\Urgent fixes only after this.' withCRs format: {self versionString}) title: 'Release Builder Step 2 of 4: Code Freeze') ifFalse: [^ self]. self setNewSystemVersion: self versionString, 'rc', (SystemVersion current releaseCandidateNumber + 1) asString.! Item was changed: ----- Method: ReleaseBuilder class>>step3NextReleaseCandidate (in category 'manual - steps') ----- step3NextReleaseCandidate "Creates additional release candidates." "update version, update post load script, add stuff commit" + (Project uiManager + confirm: ('Do you want create another release candidate\for the next release {1}?\Urgent fixes still possible.' translated withCRs format: {self versionString}) + title: 'Release Builder Step 3 of 4: Release Candidate' translated) ifFalse: [^ self]. - (UIManager default - confirm: ('Do you want create another release candidate\for the next release {1}?\Urgent fixes still possible.' withCRs format: {self versionString}) - title: 'Release Builder Step 3 of 4: Release Candidate') ifFalse: [^ self]. self setNewSystemVersion: self versionString, 'rc', (SystemVersion current releaseCandidateNumber + 1) asString.! Item was changed: ----- Method: ReleaseBuilder class>>step4Release (in category 'manual - steps') ----- step4Release "Creates the release. New file, cleaned up." + (Project uiManager + confirm: ('Do you want release {1}{2}?' translated withCRs format: { - (UIManager default - confirm: ('Do you want release {1}{2}?' withCRs format: { self versionString. + (self releaseLocally ifTrue: [' locally' translated] ifFalse: [''])}) + title: 'Release Builder Step 4 of 4: The Release' translated) - (self releaseLocally ifTrue: [' locally'] ifFalse: [''])}) - title: 'Release Builder Step 4 of 4: The Release') ifFalse: [^ self]. "If you re-open the current trunk image again, it will be an alpha version for the next release." DeferredTask := [self step0AssureAlpha]. "We continue with preparing the release image." NextTask := [self saveAsNewRelease]. "Now save it but do not quit." Smalltalk snapshot: true andQuit: false.!

1 0

The Trunk: Network-ct.255.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of Network to project The Trunk: http://source.squeak.org/trunk/Network-ct.255.mcz ==================== Summary ==================== Name: Network-ct.255 Author: ct Time: 3 January 2022, 10:19:21.768397 pm UUID: 50fb6477-19e1-1444-a9ca-697aff405f6e Ancestors: Network-mt.254 Improves multilingual support. =============== Diff against Network-mt.254 =============== Item was changed: ----- Method: Socket>>connectTo:port:waitForConnectionFor: (in category 'connection open/close') ----- connectTo: hostAddress port: port waitForConnectionFor: timeout "Initiate a connection to the given port at the given host address. Waits until the connection is established or time outs." self connectNonBlockingTo: hostAddress port: port. self waitForConnectionFor: timeout + ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {hostAddress})] + ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {hostAddress})]! - ifTimedOut: [ConnectionTimedOut signal: 'Cannot connect to ', hostAddress printString] - ifRefused: [ConnectionRefused signal: 'Cannot connect to ', hostAddress printString]! Item was changed: ----- Method: Socket>>connectTo:waitForConnectionFor: (in category 'ipv6') ----- connectTo: aSocketAddress waitForConnectionFor: timeout self connectNonBlockingTo: aSocketAddress. self waitForConnectionFor: timeout + ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {aSocketAddress})] + ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {aSocketAddress})]! - ifTimedOut: [ConnectionTimedOut signal: 'Cannot connect to ', aSocketAddress printString] - ifRefused: [ConnectionRefused signal: 'Cannot connect to ', aSocketAddress printString]! Item was changed: ----- Method: Socket>>waitForDataFor: (in category 'waiting') ----- waitForDataFor: timeout "Wait for the given nr of seconds for data to arrive. Signal a time out or connection close exception if either happens before data becomes available." ^self waitForDataFor: timeout + ifClosed: [ConnectionClosed signal: 'Connection closed while waiting for data.' translated] + ifTimedOut: [ConnectionTimedOut signal: 'Data receive timed out.' translated] - ifClosed: [ConnectionClosed signal: 'Connection closed while waiting for data.'] - ifTimedOut: [ConnectionTimedOut signal: 'Data receive timed out.'] ! Item was changed: ----- Method: SocketAddressInformation>>connect (in category 'circuit setup') ----- connect | sock | socketType == SocketTypeStream ifFalse: [^nil]. sock := Socket newTCP: addressFamily. sock connectTo: socketAddress. sock waitForConnectionFor: Socket standardTimeout + ifTimedOut: [ConnectionTimedOut signal: ('Cannot connect to {1}' translated format: {self})] + ifRefused: [ConnectionRefused signal: ('Cannot connect to {1}' translated format: {self})]. - ifTimedOut: [ConnectionTimedOut signal: 'Cannot connect to ', self printString] - ifRefused: [ConnectionRefused signal: 'Cannot connect to ', self printString]. ^sock! Item was changed: ----- Method: SocketStream class>>openConnectionToHostNamed:port: (in category 'instance creation') ----- openConnectionToHostNamed: hostName port: portNumber | addressInformations stream | NetNameResolver useOldNetwork ifTrue: [ | hostIP | hostIP := NetNameResolver addressForName: hostName timeout: 20. + hostIP ifNil: [NetworkError signal: ('Cannot resolve {1}.' translated format: {hostName})]. - hostIP ifNil: [NetworkError signal: ('Cannot resolve {1}.' format: {hostName})]. ^self openConnectionToHost: hostIP port: portNumber]. addressInformations := SocketAddressInformation forHost: hostName service: portNumber asString flags: 0 addressFamily: 0 socketType: SocketAddressInformation socketTypeStream protocol: SocketAddressInformation protocolTCP. addressInformations ifEmpty: [ NoNetworkError signal: ('Could not find a network for {1} on port {2}' translated format: {hostName. portNumber})]. stream := addressInformations readStream. ^ [self on: stream next connect] on: NetworkError do: [:exc | stream atEnd ifTrue: ["No more address to retry, pass the exception to upper level" exc pass] ifFalse: ["retry with next address" exc retry]].! Item was changed: ----- Method: SocketStream>>signalClosed (in category 'private-socket') ----- signalClosed self shouldSignal ifFalse: [^ self]. + ConnectionClosed signal: 'Connection closed while waiting for data.' translated.! - ConnectionClosed signal: 'Connection closed while waiting for data.'! Item was changed: ----- Method: SocketStream>>signalTimeout (in category 'private-socket') ----- signalTimeout self shouldSignal ifFalse: [^ self]. + ConnectionTimedOut signal: 'Data receive timed out.' translated.! - ConnectionTimedOut signal: 'Data receive timed out.'!

1 0

The Trunk: Morphic-ct.1841.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-ct.1841.mcz ==================== Summary ==================== Name: Morphic-ct.1841 Author: ct Time: 3 January 2022, 10:12:56.140397 pm UUID: 13c07ce7-f89f-7b48-b5e8-baa520ea1951 Ancestors: Morphic-ct.1840 Improves multilingual support at various places. =============== Diff against Morphic-ct.1840 =============== Item was changed: ----- Method: FontImporterTool>>buildButtonBarWith: (in category 'toolbuilder') ----- buildButtonBarWith: builder "Build the button bar" | panelSpec buttonSpec | panelSpec := builder pluggablePanelSpec new. panelSpec layout: #horizontal; children: OrderedCollection new. buttonSpec := builder pluggableButtonSpec new model: self; label: 'Import' translated; + help: 'Include the font data in the image and provide a TextStyle for the font' translated; - help: 'Include the font data in the image and provide a TextStyle for the font'; action: #import; yourself. panelSpec children addLast: buttonSpec. buttonSpec := builder pluggableButtonSpec new model: self; label: 'Close' translated; action: #close; yourself. panelSpec children addLast: buttonSpec. ^panelSpec! Item was changed: ----- Method: FontImporterTool>>import (in category 'actions') ----- import | megaSize filenames fonts | fonts := self currentSelection. filenames := fonts allFilenames. megaSize := ((filenames inject: 0 into: [ :sum :fn | sum + (FileStream readOnlyFileNamed: fn do: [:file | file size])]) / (1024 * 1024)) asFloat. (UIManager default confirm: ( 'About to import {1}{2}.\\This is at least {3} MB of space required in the image.\ Please respect the copyright and embedding restrictions of the font.\ Proceed?' + withCRs translated format: { - withCRs format: { self currentParent ifNotNil: [:p| p fontname, ' ', self currentSelection fontname] ifNil: [self currentSelection fontname]. + filenames size > 1 ifTrue: [' ({1} font files)' translated format: {filenames size}] ifFalse: ['']. - filenames size > 1 ifTrue: [' (', filenames size, ' font files)'] ifFalse: ['']. megaSize printShowingDecimalPlaces: 2})) ifTrue: [ filenames do: [:filename | | readFonts | readFonts := TTCFontDescription addFromTTFile: filename. readFonts isCollection ifFalse: [TTCFont newTextStyleFromTT: readFonts] ifTrue: [self importFontFamily: readFonts]]]. self allFonts: nil. "force redraw" TTCFont registerAll.! Item was changed: ----- Method: FontImporterTool>>link (in category 'actions') ----- link | filenames fonts | fonts := self currentSelection. self warningSeen ifFalse: [ + (Project uiManager confirm: ( - (UIManager default confirm: ( 'Note that linking a font instead of importing may make the image un-portable, since the linked font must be present on the system the next time the image is run. + This warning is only shown once per session.' translated) trueChoice: 'Proceed' translated falseChoice: 'Cancel' translated) - This warning is only shown once per session.' ) trueChoice: 'Proceed' falseChoice: 'Cancel') ifFalse: [^ self]. self warningSeen: true].. filenames := fonts allFilenames. filenames do: [:filename | | readFonts | readFonts := TTFileDescription readFontsFrom: filename. readFonts isCollection ifFalse: [TTCFont newTextStyleFromTT: readFonts] ifTrue: [self importFontFamily: readFonts]]. self allFonts: nil. "force redraw" TTCFont registerAll.! Item was changed: ----- Method: KeyboardExerciser>>drawOn: (in category 'drawing') ----- drawOn: aCanvas super drawOn: aCanvas. aCanvas + drawString: 'Move your mouse cursor to here and start typing. Try modifiers, too.' translated - drawString: 'Move your mouse cursor to here and start typing. Try modifiers, too.' at: self topLeft font: Preferences standardButtonFont color: Color gray.! Item was changed: ----- Method: KeyboardExerciser>>logEvent: (in category 'event handling') ----- logEvent: evt | eventMorph | evt = self lastEvent ifTrue: [^ self logEventRepetition: evt]. eventMorph := evt asMorph. eventMorph setProperty: #event toValue: evt copy; + balloonText: ('Click to inspect. Shift+click to explore.\\Virtual key: {8}\Virtual modifiers: {5}\\Physical key: {9}\Physical modifiers: {6}\\Key value: 0x{1} ({2}) \Key character: {3}\Key string: {4}\\{7}' withCRs translated format: { - balloonText: ('Click to inspect. Shift+click to explore.\\Virtual key: {8}\Virtual modifiers: {5}\\Physical key: {9}\Physical modifiers: {6}\\Key value: 0x{1} ({2}) \Key character: {3}\Key string: {4}\\{7}' withCRs format: { evt keyValue printPaddedWith: $0 to: 2 base: 16. evt keyValue. evt isKeystroke ifTrue: [evt keyCharacter printString] ifFalse: ['-']. evt isKeystroke ifTrue: [evt keyString printString] ifFalse: ['-']. (evt virtualModifiers joinSeparatedBy: ' ') asUppercase. (evt physicalModifiers joinSeparatedBy: ' ') asUppercase. evt printString. evt virtualKey printString. evt physicalKey asString printString}). eventMorph on: #mouseEnter send: #handleEvent:emphasize: to: self; on: #mouseLeave send: #handleEvent:deemphasize: to: self; on: #mouseDown send: #handleEvent:inspect: to: self. self addMorphBack: eventMorph.! Item was changed: ----- Method: KeyboardExerciser>>logEventRepetition: (in category 'event handling') ----- logEventRepetition: evt | label lastEvents box | (self submorphs last hasProperty: #repetition) ifTrue: [box := self submorphs last. label := box submorphs first] ifFalse: [ box := Morph new setProperty: #repetition toValue: true; color: Color transparent; layoutPolicy: TableLayout new; hResizing: #shrinkWrap; vResizing:#shrinkWrap; yourself. label := '' asText asMorph lock. box addMorph: label. box setProperty: #event toValue: (OrderedCollection with: self lastEvent). self addMorphBack: box]. lastEvents := box valueOfProperty: #event. lastEvents add: evt copy. box setProperty: #event toValue: lastEvents. label newContents: (('x ', (lastEvents size)) asText addAttribute: (TextFontReference toFont: Preferences standardButtonFont); yourself). box balloonText: ('{1}{2}' format: { + lastEvents size > 10 ifTrue: ['... {1} older events and:\' withCRs translated format: {lastEvents size - 10}] ifFalse: ['']. - lastEvents size > 10 ifTrue: ['... ', (lastEvents size - 10), ' older events and:', String cr] ifFalse: ['']. (lastEvents last: (10 min: lastEvents size)) joinSeparatedBy: String cr. }). box on: #mouseEnter send: #handleEvent:emphasize: to: self; on: #mouseLeave send: #handleEvent:deemphasize: to: self; on: #mouseDown send: #handleEvent:inspect: to: self.! Item was changed: ----- Method: MenuItemMorph>>debugAction (in category 'browse') ----- debugAction (Process forBlock: [self doButtonAction] runUntil: [:context | context selector = self effectiveActionSelector]) + debugWithTitle: ('Debug menu action "{1}" in model "{2}"' translated format: {self contents. self target printString}).! - debugWithTitle: ('Debug menu action "{1}" in model "{2}"' format: {self contents. self target printString}).! Item was changed: ----- Method: MenuMorph>>addItem (in category 'menu') ----- addItem | string sel | + string := Project uiManager request: 'Label for new item?' translated. - string := UIManager default request: 'Label for new item?'. string isEmpty ifTrue: [^ self]. + sel := Project uiManager request: 'Selector?' translated. - sel := UIManager default request: 'Selector?'. sel isEmpty ifFalse: [sel := sel asSymbol]. self add: string action: sel. ! Item was changed: ----- Method: MenuMorph>>addTitle (in category 'menu') ----- addTitle | string | + string := Project uiManager request: 'Title for this menu?' translated. - string := UIManager default request: 'Title for this menu?'. string isEmpty ifTrue: [^ self]. self addTitle: string. ! Item was changed: ----- Method: MenuMorph>>detachSubMenu: (in category 'menu') ----- detachSubMenu: evt | possibleTargets item subMenu index | possibleTargets := self items select:[:any| any hasSubMenu]. possibleTargets size > 0 ifTrue:[ + index := Project uiManager - index := UIManager default chooseFrom: (possibleTargets collect:[:t| t contents asString]) + title: 'Which menu?' translated. - title: 'Which menu?'. index = 0 ifTrue:[^self]]. item := possibleTargets at: index. subMenu := item subMenu. subMenu ifNotNil: [ item subMenu: nil. item delete. subMenu stayUp: true. subMenu popUpOwner: nil. subMenu addTitle: item contents. evt hand attachMorph: subMenu]. ! Item was changed: ----- Method: MenuMorph>>showKeyboardHelp (in category 'keystroke helpers') ----- showKeyboardHelp | help | help := self balloonMorphClass + string: 'Enter text to narrow selection\down to matching items ' translated - string: 'Enter text to narrow selection\down to matching items ' withCRs for: self corner: #topLeft. help popUpAt: self topCenter forHand: self activeHand! Item was changed: ----- Method: MenuMorph>>toggleStayUp: (in category 'menu') ----- toggleStayUp: evt "Toggle my 'stayUp' flag and adjust the menu item to reflect its new state." self items do: [:item | item isStayUpItem ifTrue: [self stayUp: stayUp not. stayUp + ifTrue: [item contents: 'dismiss this menu' translated] + ifFalse: [item contents: 'keep this menu up' translated]]]. - ifTrue: [item contents: 'dismiss this menu'] - ifFalse: [item contents: 'keep this menu up']]]. evt hand releaseMouseFocus: self. + stayUp ifFalse: [self topRendererOrSelf delete].! - stayUp ifFalse: [self topRendererOrSelf delete]. - ! Item was changed: ----- Method: MorphicProject>>loadFromServer: (in category 'file in/out') ----- loadFromServer: newerAutomatically "If a newer version of me is on the server, load it." | pair resp server | self assureIntegerVersion. self isCurrentProject ifTrue: ["exit, then do the command" ^ self armsLengthCommand: #loadFromServer withDescription: 'Loading' translated ]. server := self tryToFindAServerWithMe ifNil: [^ nil]. pair := self class mostRecent: self name onServer: server. pair first ifNil: [^ self inform: ('can''t find file on server for {1}' translated format: {self name})]. self currentVersionNumber > pair second ifTrue: [ ^ self inform: ('That server has an older version of the project.' translated)]. version = (Project parseProjectFileName: pair first) second ifTrue: [ resp := (UIManager default chooseFrom: (Array with: 'Reload anyway' translated with: 'Cancel' translated withCRs) title: 'The only changes are the ones you made here.' translated). resp ~= 1 ifTrue: [^ nil] ] ifFalse: [ newerAutomatically ifFalse: [ resp := (UIManager default + chooseFrom: {'Load it' translated. 'Cancel' translated} + title: 'A newer version exists on the server.' translated). - chooseFrom: #('Load it' 'Cancel') - title: 'A newer version exists on the server.'). resp ~= 1 ifTrue: [^ nil] ]. ]. "let's avoid renaming the loaded change set since it will be replacing ours" self projectParameters at: #loadingNewerVersion put: true. ComplexProgressIndicator new targetMorph: nil; historyCategory: 'project loading'; withProgressDo: [ ProjectLoading installRemoteNamed: pair first from: server named: self name in: parentProject + ]! - ] - ! Item was changed: ----- Method: ObjectExplorerWrapper>>asString (in category 'converting') ----- asString | explorerString label separator | explorerString := [self objectString] on: Error + do: ['<error: {1} in {2}: evaluate "{3}" to debug>' translated format: {self object class name. #asExplorerString. self itemName , ' asExplorerString'}]. - do: ['<error: ', self object class name, ' in asExplorerString: evaluate "' , self itemName , ' asExplorerString" to debug>']. (explorerString includes: Character cr) ifTrue: [explorerString := explorerString withSeparatorsCompacted]. label := self itemName ifNil: ['']. (label includes: Character cr) ifTrue: [label := label withSeparatorsCompacted]. separator := self class showContentsInColumns ifTrue: [String tab] ifFalse: [label ifEmpty: [''] ifNotEmpty: [': ']]. ^ '{1}{2}{3}' format: {label. separator. explorerString}! Item was changed: ----- Method: PasteUpMorph>>saveOnFile (in category 'objects from disk') ----- saveOnFile "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out." | aFileName fileStream | self flag: #bob0302. self isWorldMorph ifTrue: [^self project saveAs]. + aFileName := ('my {1}' translated format: {self class name}) , '.project' asFileName. "do better?" - aFileName := ('my {1}.project' translated format: {self class name}) asFileName. "do better?" aFileName := UIManager default saveFilenameRequest: 'File name?' translated initialAnswer: aFileName. aFileName ifNil: [^ Beeper beep]. self allMorphsDo: [:m | m prepareToBeSaved]. fileStream := FileStream newFileNamed: aFileName. fileStream fileOutClass: nil andObject: self. "Puts UniClass definitions out anyway"! Item was changed: ----- Method: PluggableButtonMorph>>debugAction (in category 'debug menu') ----- debugAction self updateArguments. (Process forBlock: [self doButtonAction] runUntil: [:context | context selector = self effectiveActionSelector]) + debugWithTitle: ('Debug button action "{1}" in model "{2}"' translated format: {self label. self target printString}).! - debugWithTitle: ('Debug button action "{1}" in model "{2}"' format: {self label. self target printString}).! Item was changed: ----- Method: PluggableListMorph>>debugGetList (in category 'debug and other') ----- debugGetList (Process forBlock: [model perform: getListSelector] runUntil: [:context | context selector = getListSelector]) + debugWithTitle: ('Debug get-list invocation in model "{1}"' translated format: {model printString}).! - debugWithTitle: ('Debug get-list invocation in model "{1}"' format: {model printString}).! Item was changed: ----- Method: PolygonMorph>>smoothOrSegmentedPhrase (in category 'access') ----- smoothOrSegmentedPhrase - | lineName | - lineName := (closed - ifTrue: ['outline'] - ifFalse: ['line']) translated. + | lineName | + lineName := closed + ifTrue: ['outline' translated] + ifFalse: ['line' translated]. + + ^ self isCurve + ifTrue: ['make segmented {1}' translated format: {lineName}] + ifFalse: ['make smooth {1}' translated format: {lineName}]! - ^ self isCurve - ifTrue: ['make segmented {1}' translated format: {lineName}] - ifFalse: ['make smooth {1}' translated format: {lineName}].! Item was changed: ----- Method: SmalltalkEditor>>tallySelection (in category 'do-its') ----- tallySelection "Treat the current selection as an expression; evaluate it and return the time took for this evaluation" | code result rcvr ctxt v | self lineSelectAndEmptyCheck: [^ self]. (model respondsTo: #doItReceiver) ifTrue: [ rcvr := model doItReceiver. ctxt := model doItContext] ifFalse: [rcvr := ctxt := nil]. result := [ | cm | code := self selectionAsStream. cm := rcvr class evaluatorClass new compiledMethodFor: code in: ctxt to: rcvr notifying: self ifFail: [morph flash. ^ self]. Time millisecondsToRun: [v := cm valueWithReceiver: rcvr arguments: (ctxt ifNil: [#()] ifNotNil: [{ctxt}]) ]. ] on: OutOfScopeNotification do: [ :ex | ex resume: true]. UIManager default + inform: ('Expression{1} {2} Time (compile and execute) {3} ms Result {4}' translated format: { - inform: ('Expression{1} {2} Time (compile and execute) {3} ms Result {4}' format: { rcvr ifNil: [''] ifNotNil: [' (', (rcvr printString truncateWithElipsisTo: 20), ')']. (code contents truncateWithElipsisTo: 200) copyReplaceAll: String cr with: ' '. result printString. v printString truncateWithElipsisTo: 100}) asTextFromHtml.! Item was changed: ----- Method: TextAnchor class>>alignmentExamples (in category 'examples') ----- alignmentExamples "self alignmentExamples" | anchoredMorph textMorph text demoMorph | demoMorph := Morph new changeTableLayout; color: Color white; hResizing: #shrinkWrap; vResizing: #shrinkWrap; yourself. #(top center bottom) do: [:morphAlignment | #(top center baseline bottom) do: [:textAlignment | anchoredMorph := Morph new. anchoredMorph textAnchorProperties verticalAlignment: {morphAlignment . textAlignment}. anchoredMorph textAnchorProperties padding: (anchoredMorph textAnchorProperties padding top: 10). text := Text streamContents: [ :stream | stream + nextPutAll: ('Here is an {1}, {2} example: ' translated format: {morphAlignment . textAlignment}); - nextPutAll: ('Here is an {1}, {2} example: ' format: {morphAlignment . textAlignment}); nextPutAll: (Text string: Character startOfHeader asString attributes: {TextAnchor new anchoredMorph: anchoredMorph. TextColor color: Color transparent}); + nextPutAll: ' with the morph in the text.' translated]. - nextPutAll: ' with the morph in the text.']. textMorph := text asMorph. textMorph height: 100. demoMorph addMorph: textMorph]]. demoMorph openInWorld! Item was changed: ----- Method: TextEditor>>findReplace (in category 'menu messages') ----- findReplace self setSearchFromSelectionOrHistory; setReplacementFromHistory. (Project uiManager + request: 'Find what to replace?' translated - request: 'Find what to replace?' initialAnswer: FindText) ifNotEmpty: [:find | (Project uiManager + request: ('Replace ''{1}'' with?' translated format: {find}) - request: ('Replace ''{1}'' with?' format: {find}) initialAnswer: (ChangeText ifEmpty: [find]) onCancelReturn: nil) ifNotNil: [:replace | FindText := find. ChangeText := replace. self findReplaceAgainNow]]! Item was changed: ----- Method: TheWorldMainDockingBar>>scaleFactorsOn: (in category 'submenu - extras') ----- scaleFactorsOn: menu | presets currentScaleFactor currentPlatformScaleFactor | currentScaleFactor := (Display relativeUiScaleFactor * 100) rounded. currentPlatformScaleFactor := Display platformScaleFactorKnown ifTrue: [(Display platformScaleFactor * 100) rounded]. presets := 100 to: 300 by: 25. presets do: [:scale | scale = 175 ifTrue: [menu addLine]. "TTCFont used after this line..." menu addItem: [:item| item contents: ('{1}{2}%{3}' format: { currentScaleFactor = scale ifTrue: ['<yes>'] ifFalse: ['<no>']. scale. DisplayScreen relativeScaleFactorEnabled ifTrue: ['' "macOS"] ifFalse: [ scale = currentPlatformScaleFactor + ifTrue: [' (recommended)' translated] ifFalse: ['']] - ifTrue: [' (recommended)'] ifFalse: ['']] }); target: Display; selector: #relativeUiScaleFactor:; arguments: {scale / 100}]]. menu addLine. menu addItem: [:item | item + contents: ((presets includes: currentScaleFactor) not ifTrue: ['<yes>' , 'Custom: ' translated, currentScaleFactor, '% ...'] ifFalse: ['<no>' , 'Other scale factor...' translated]); - contents: ((presets includes: currentScaleFactor) not ifTrue: ['<yes> Custom: ', currentScaleFactor, '% ...'] ifFalse: ['<no>Other scale factor...']); target: self; selector: #chooseCustomScaleFactor].!

1 0

The Trunk: MonticelloConfigurations-ct.171.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of MonticelloConfigurations to project The Trunk: http://source.squeak.org/trunk/MonticelloConfigurations-ct.171.mcz ==================== Summary ==================== Name: MonticelloConfigurations-ct.171 Author: ct Time: 3 January 2022, 10:00:53.373397 pm UUID: 40c81102-910c-0348-ba1a-26ee8781b2dc Ancestors: MonticelloConfigurations-mt.170 Improves multilingual support. =============== Diff against MonticelloConfigurations-mt.170 =============== Item was changed: ----- Method: MCConfiguration>>depsSatisfying:versionDo:displayingProgress: (in category 'private') ----- depsSatisfying: selectBlock versionDo: verBlock displayingProgress: progressString | count selectedVersions cleanWorkingCopies | self cacheAllFileNamesDuring: [ self repositories do: [ :eachRepository | MCRepositoryGroup default addRepository: eachRepository ]. "First, download selected versions" count := 0. selectedVersions := OrderedCollection new. self withProgress: progressString in: self dependencies do: [ :dep | | verName repo | verName := dep versionInfo name. self class extraProgressInfo ifTrue: + [ ProgressNotification signal: '' extra: ('Downloading {1}' translated format: {verName}) ]. - [ ProgressNotification signal: '' extra: 'Downloading ' , verName ]. repo := self repositories detect: [ :eachRepository | eachRepository includesVersionNamed: verName ] + ifNone: [ self logError: ('Version {1} not found in any repository' translated format: {verName}). + self logError: 'Aborting' translated. - ifNone: [ self logError: 'Version ' , verName , ' not found in any repository'. - self logError: 'Aborting'. ^ count ]. (selectBlock value: dep) ifTrue: [ | version | version := self versionNamed: verName for: dep from: repo. + version ifNil: [ self logError: ('Could not download version {1} from {2}' translated format: {verName. repo description}). + self logError: 'Aborting' translated. - version ifNil: [ self logError: 'Could not download version ' , verName , ' from ' , repo description. - self logError: 'Aborting'. ^ count ]. dep package workingCopy newRepositoryGroupIfDefault. "fix old working copies" dep package workingCopy repositoryGroup addRepository: repo. selectedVersions add: version]]. "Then, process only those definitions that moved from one package to another, to avoid order dependence" cleanWorkingCopies := MCWorkingCopy allManagers select: [ :wc | wc modified not and: [ selectedVersions anySatisfy: [ :v | wc package = v package ] ] ]. MCReorganizationPreloader preloadMovesBetween: selectedVersions. "Finally, load/merge selected versions" self withProgress: progressString in: selectedVersions do: [ :version | self logUpdate: version package with: version. self class extraProgressInfo ifTrue: + [ ProgressNotification signal: '' extra: ('Installing {1}' translated format: {version info name}) ]. - [ ProgressNotification signal: '' extra: 'Installing ' , version info name ]. verBlock value: version. count := count + 1 ]. "Clean up packages made dirty by MCReorganizationPreloader" cleanWorkingCopies select: [ :wc | wc modified ] thenDo: [ :wc | wc checkModified ]. ]. ^ count! Item was changed: ----- Method: MCConfiguration>>load (in category 'actions') ----- load ^self depsSatisfying: [:dep | dep isCurrent not] versionDo: [:ver | ver load] + displayingProgress: 'loading packages' translated! - displayingProgress: 'loading packages' - ! Item was changed: ----- Method: MCConfiguration>>merge (in category 'actions') ----- merge ^self depsSatisfying: [:dep | dep isFulfilledByAncestors not] versionDo: [:ver | ver merge] + displayingProgress: 'merging packages' translated! - displayingProgress: 'merging packages' - ! Item was changed: ----- Method: MCConfiguration>>updateFromRepositoriesWithoutCaching (in category 'updating') ----- updateFromRepositoriesWithoutCaching | oldNames newNames sortedNames newDeps | oldNames := self dependencies collect: [:dep | dep versionInfo versionName]. newNames := Dictionary new. self repositories do: [:repo | + ProgressNotification signal: '' extra: ('Checking {1}' translated format: {repo description}). - ProgressNotification signal: '' extra: 'Checking ', repo description. (repo possiblyNewerVersionsOfAnyOf: oldNames) do: [:newName | newNames at: newName put: repo]] + displayingProgress: 'Searching new versions' translated. - displayingProgress: 'Searching new versions'. sortedNames := newNames keys asArray sort: [:a :b | a versionNumber > b versionNumber]. newDeps := OrderedCollection new: self dependencies size. self dependencies do: [:dep | newDeps add: (sortedNames detect: [:each | each packageAndBranchName = dep packageAndBranchName] ifFound: [ :newName | | repo | repo := newNames at: newName. (self versionInfoNamed: newName for: dep from: repo) ifNil: [ dep ] ifNotNil: [ :info | MCVersionDependency package: dep package info: info ] ] ifNone: [ dep ]) ] displayingProgress: 'Downloading new versions ...' translated. + self dependencies: newDeps.! - self dependencies: newDeps. - ! Item was changed: ----- Method: MCConfiguration>>updateFromRepositoriesWithoutCaching: (in category 'updating') ----- updateFromRepositoriesWithoutCaching: packageIndex | oldNames newNames sortedNames newDeps dep | dep := dependencies at: packageIndex. oldNames := {dep versionInfo versionName}. newNames := Dictionary new. self repositories do: [:repo | + ProgressNotification signal: '' extra: ('Checking {1}' translated format: {repo description}). - ProgressNotification signal: '' extra: 'Checking ', repo description. (repo possiblyNewerVersionsOfAnyOf: oldNames) do: [:newName | newNames at: newName put: repo]] + displayingProgress: 'Searching new versions' translated. - displayingProgress: 'Searching new versions'. sortedNames := newNames keys asArray sort: [:a :b | a versionNumber > b versionNumber]. newDeps := self dependencies copy. newDeps at: packageIndex put: ( sortedNames detect: [:each | each packageAndBranchName = dep packageAndBranchName] ifFound: [ :newName | | repo | repo := newNames at: newName. (self versionInfoNamed: newName for: dep from: repo) ifNil: [ dep ] ifNotNil: [ :info | MCVersionDependency package: dep package info: info ] ] ifNone: [ dep ]). + self dependencies: newDeps.! - self dependencies: newDeps. - ! Item was changed: ----- Method: MCConfiguration>>upgrade (in category 'actions') ----- upgrade ^self depsSatisfying: [:dep | dep isFulfilledByAncestors not] versionDo: [:ver | (self class upgradeIsMerge and: [ver shouldMerge]) ifFalse: [ver load] ifTrue: [[ver merge] on: MCNoChangesException do: [:req| req resume ] on: MCMergeResolutionRequest do: [:request | request merger conflicts isEmpty ifTrue: [request resume: true] ifFalse: [request pass]] on: Deprecation do: [:req| req resume ]]] + displayingProgress: 'upgrading packages' translated! - displayingProgress: 'upgrading packages'! Item was changed: ----- Method: MCConfiguration>>versionNamed:for:from: (in category 'private') ----- versionNamed: aMCVersionName for: aDependency from: repo | baseName fileName ver | (repo filterFileNames: repo cachedFileNames forVersionNamed: aMCVersionName) ifNotEmptyDo: [:cachedNames | fileName := cachedNames anyOne. self class extraProgressInfo + ifTrue: [ProgressNotification signal: '' extra: ('Using cached {1}' translated format: {fileName})]. - ifTrue:[ProgressNotification signal: '' extra: 'Using cached ', fileName]. ver := repo versionNamed: fileName]. ver ifNil: [ baseName := self diffBaseFor: aDependency. (baseName notNil and: [baseName ~= aMCVersionName and: [repo includesVersionNamed: baseName]]) ifTrue: [ fileName := (MCDiffyVersion nameForVer: aMCVersionName base: baseName), '.mcd'. self class extraProgressInfo + ifTrue: [ProgressNotification signal: '' extra: ('Downloading {1}' translated format: {fileName})]. - ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName]. ver := [repo versionNamed: fileName] ifError: []]]. ver ifNil: [ fileName := aMCVersionName versionName, '.mcz'. self class extraProgressInfo + ifTrue: [ProgressNotification signal: '' extra: ('Downloading {1}' translated format: {fileName})]. - ifTrue:[ProgressNotification signal: '' extra: 'Downloading ', fileName]. ver := repo versionNamed: fileName]. ^ver! Item was changed: ----- Method: MCConfigurationBrowser>>addDependency (in category 'dependencies') ----- addDependency (self pickWorkingCopiesSatisfying: [:each | (self includesPackage: each package) not]) do: [:wc | wc ancestors isEmpty + ifTrue: [self inform: ('You must save {1} first!! + Skipping this package' translated format: {wc packageName})] - ifTrue: [self inform: 'You must save ', wc packageName, ' first!! - Skipping this package'] ifFalse: [ self dependencies add: (MCVersionDependency package: wc package info: wc ancestors first)]]. self changed: #dependencyList; changed: #description! Item was changed: ----- Method: MCConfigurationBrowser>>addRepository (in category 'repositories') ----- addRepository (self pickRepositorySatisfying: [ : ea | (self repositories includes: ea) not ]) ifNotNil: + [ : repo | repo class supportsConfigurations ifFalse: [ ^ self inform: 'Not all of these repositories support MCConfigurations.' translated ]. - [ : repo | repo class supportsConfigurations ifFalse: [ ^ self inform: 'Not all of these repositories support MCConfigurations.' ]. self repositories add: repo. self changed: #repositoryList ]! Item was changed: ----- Method: MCConfigurationBrowser>>changedList (in category 'selection') ----- changedList self dependencyIndex > 0 ifTrue: [^self changed: #dependencyList]. self repositoryIndex > 0 ifTrue: [^self changed: #repositoryList]. + self error: 'nothing selected' translated! - self error: 'nothing selected'! Item was changed: ----- Method: MCConfigurationBrowser>>checkMissing (in category 'dependencies') ----- checkMissing | missing | missing := (self dependencies collect: [ : ea | ea versionInfo name ]) asSet. self repositories do: [ : eachRepository | eachRepository cacheAllFileNamesDuring: [ missing copy do: [ : eachVersionName | (eachRepository includesVersionNamed: eachVersionName) ifTrue: [ missing remove: eachVersionName ] ] ] ]. ^ missing isEmpty or: [ self selectDependency: missing anyOne. self confirm: (String streamContents: [ : strm | strm + nextPutAll: 'No repository found for' translated ; - nextPutAll: 'No repository found for' ; cr. missing do: [ : r | strm nextPutAll: r ; cr ]. + strm nextPutAll: 'Do you still want to store?' translated ]) ]! - strm nextPutAll: 'Do you still want to store?' ]) ]! Item was changed: ----- Method: MCConfigurationBrowser>>checkModified (in category 'dependencies') ----- checkModified | modified | modified := self dependencies select: [:dep | dep isFulfilled and: [dep package workingCopy modified]]. ^modified isEmpty or: [ self selectDependency: modified anyOne. self confirm: (String streamContents: [:strm | + strm nextPutAll: 'These packages are modified:' translated; cr. - strm nextPutAll: 'These packages are modified:'; cr. modified do: [:dep | strm nextPutAll: dep package name; cr]. + strm nextPutAll: 'Do you still want to store?' translated])]! - strm nextPutAll: 'Do you still want to store?'])] - ! Item was changed: ----- Method: MCConfigurationBrowser>>checkRepositories (in category 'repositories') ----- checkRepositories | bad | bad := self repositories reject: [:repo | repo class supportsConfigurations ]. ^bad isEmpty or: [ self selectRepository: bad first. self inform: (String streamContents: [:strm | + strm nextPutAll: 'Please remove these repositories:' translated; cr. - strm nextPutAll: 'Please remove these repositories:'; cr. bad do: [:r | strm nextPutAll: r description; cr]. + strm nextPutAll: '(only HTTP repositories are supported)' translated]). - strm nextPutAll: '(only HTTP repositories are supported)']). false]. ! Item was changed: ----- Method: MCConfigurationBrowser>>checkRepositoryTemplates (in category 'repositories') ----- checkRepositoryTemplates "unused for now - we only do HTTP" | bad | bad := self repositories select: [:repo | repo creationTemplate isNil]. ^bad isEmpty or: [ self selectRepository: bad first. self inform: (String streamContents: [:strm | + strm nextPutAll: 'Creation template missing for' translated; cr. - strm nextPutAll: 'Creation template missing for'; cr. bad do: [:r | strm nextPutAll: r description; cr]. + strm nextPutAll: 'Please fill in the details first!!' translated]). - strm nextPutAll: 'Please fill in the details first!!']). false]. ! Item was changed: ----- Method: MCConfigurationBrowser>>completeStoreAction (in category 'actions') ----- completeStoreAction "The store method will arrange for this to be called after the user has entered a comment for the configuration version being stored." self activeEditWindow: nil. "Close the editor window" self pickRepository ifNotNil: [:repo | configuration authorInitials: Utilities authorInitials. configuration timeStamp: (DateAndTime fromSeconds: DateAndTime now asSeconds) printString. configuration id: UUID new asString. (repo includesVersionNamed: configuration name) ifTrue: [self notify: ('The configuration does already exist in the repository you specified. If you proceed, it will be overwritten.\\Repository: {1}\Configuration: {2}\\Do you want to proceed anyway?' translated withCRs format: { repo description. configuration name })]. repo storeVersion: configuration. + self inform: ('Saved {1}' translated format: {configuration name})]! - self inform: 'Saved ', configuration name]! Item was changed: ----- Method: MCConfigurationBrowser>>description (in category 'description') ----- description self selectedDependency ifNotNil: [:dep | + ^ ('Package: {1}\{2}' withCRs translated format: {dep package name. dep versionInfo summary}) asText]. - ^ ('Package: ', dep package name, String cr, dep versionInfo summary) asText]. self selectedRepository ifNotNil: [:repo | ^repo creationTemplate ifNotNil: [repo creationTemplate asText] ifNil: [repo asCreationTemplate asText addAttribute: TextColor red]]. + ^'A configuration is a set of particular versions of packages. These can be used to manage multiple dependencies amongst packages when an update requires changes to multiple packages. One stores the current configuration and then modifies the various packages needing modification. On load, the image will be updated to at least the versions in the current configuration, hence providing the support needed to load the new packages.\\To create a new configuration first load the most up-to-date configuration in your repository (e.g., {1}), open that repository in the Monticello browser, scroll down to the "update" package, select the first entry in the list on the right hand side and click Browse, which will open the configuration in a new MCConfigurationBrowser. Then in the new MCConfigurationBrowser click Update, and choose "update all from image" from the pop-up menu. Click Store to save back to the repository. If required, one can add repositories to the browser to store the configuration in a different repository.' withCRs translated format: {MCHttpRepository trunkUrlString}! - ^('A configuration is a set of particular versions of packages. These can be used to manage multiple dependencies amongst packages when an update requires changes to multiple packages. One stores the current configuration and then modifies the various packages needing modification. On load, the image will be updated to at least the versions in the current configuration, hence providing the support needed to load the new packages.\\To create a new configuration first load the most up-to-date configuration in your repository (e.g.', MCHttpRepository trunkUrlString, '), open that repository in the Monticello browser, scroll down to the "update" package, select the first entry in the list on the right hand side and click Browse, which will open the configuration in a new MCConfigurationBrowser. Then in the new MCConfigurationBrowser click Update, and choose "update all from image" from the pop-up menu. Click Store to save back to the repository. If required, one can add reposit ories to the browser to store the configuration in a different repository.') withCRs! Item was changed: ----- Method: MCConfigurationBrowser>>description: (in category 'description') ----- description: aText self selectedRepository ifNotNil: [:repo | | new | new := MCRepository readFrom: aText asString. (new class = repo class and: [new description = repo description]) ifTrue: [ repo creationTemplate: aText asString. self changed: #description] ifFalse: [ + self inform: 'This does not match the previous definition!!' translated - self inform: 'This does not match the previous definition!!' ] ]. ! Item was changed: ----- Method: MCConfigurationBrowser>>enterVersionCommentAndCompleteWith:nameForRestore: (in category 'morphic ui') ----- enterVersionCommentAndCompleteWith: aConfigBrowser nameForRestore: originalName "Open an editor for comment entry. When text is accepted from the editor, ask if editing is done. If complete, then proceed to save the MCConfiguration. If cancelled, close the edit window and do nothing further. Otherwise leave the edit window open to allow further edits before proceeding to save the configuration." | editWindow | + editWindow := Project uiManager - editWindow := UIManager default edit: configuration comment + label: ('Enter or edit a comment for {1}' translated format: {configuration name}) - label: 'Enter or edit a comment for ', configuration name accept: [:aText | | editingComplete | editingComplete := UIManager default confirm: 'Comment accepted' translated + title: ('Comment for {1}' translated format: {configuration name}) - title: 'Comment for ' translated, configuration name trueChoice: 'Proceed to save configuration' translated falseChoice: 'Continue editing comment' translated. editingComplete ifNil: [ "cancel button pressed" configuration name: originalName. "cancelling, undo the changed name" Project current addDeferredUIMessage: [aConfigBrowser activeEditWindow ifNotNil: [ :win | win delete ]]] ifNotNil: [ editingComplete ifTrue: [configuration comment: aText asString. Project current addDeferredUIMessage: [aConfigBrowser completeStoreAction]] ifFalse: [ "edit window remains open" ]]]. + aConfigBrowser activeEditWindow: editWindow.! - aConfigBrowser activeEditWindow: editWindow. - ! Item was changed: ----- Method: MCConfigurationBrowser>>index: (in category 'selection') ----- index: anInteger self dependencyIndex > 0 ifTrue: [^self dependencyIndex: anInteger]. self repositoryIndex > 0 ifTrue: [^self repositoryIndex: anInteger]. + anInteger > 0 ifTrue: [self error: 'cannot select' translated]! - anInteger > 0 ifTrue: [self error: 'cannot select']! Item was changed: ----- Method: MCConfigurationBrowser>>pickName (in category 'morphic ui') ----- pickName | name | + name := Project uiManager + request: ('Name ({1} will be appended):' translated format: {'.' , self configuration writerClass extension}) - name := UIManager default - request: 'Name (.', self configuration writerClass extension, ' will be appended):' initialAnswer: self configuration suggestedNameOfNextVersion. ^ name isEmpty ifFalse: [name]! Item was changed: ----- Method: MCConfigurationBrowser>>pickRepositorySatisfying: (in category 'morphic ui') ----- pickRepositorySatisfying: aBlock | index list | list := MCRepositoryGroup default repositories select: aBlock. + index := Project uiManager chooseFrom: (list collect: [:ea | ea description]) + title: 'Repository:' translated. - index := UIManager default chooseFrom: (list collect: [:ea | ea description]) - title: 'Repository:'. ^ index = 0 ifFalse: [list at: index]! Item was changed: ----- Method: MCConfigurationBrowser>>pickWorkingCopiesSatisfying: (in category 'morphic ui') ----- pickWorkingCopiesSatisfying: aBlock | copies item | copies := (MCWorkingCopy allManagers select: aBlock) sort: [:a :b | a packageName <= b packageName]. + item := Project uiManager chooseFrom: #('match ...'),(copies collect: [:ea | ea packageName]) lines: #(1) title: 'Package:' translated. - item := UIManager default chooseFrom: #('match ...'),(copies collect: [:ea | ea packageName]) lines: #(1) title: 'Package:'. item = 1 ifTrue: [ | pattern | + pattern := Project uiManager request: 'Packages matching:' translated initialAnswer: '*'. - pattern := UIManager default request: 'Packages matching:' initialAnswer: '*'. ^pattern isEmptyOrNil ifTrue: [#()] ifFalse: [ (pattern includes: $*) ifFalse: [pattern := '*', pattern, '*']. copies select: [:ea | pattern match: ea packageName]] ]. ^ item = 0 ifTrue: [#()] ifFalse: [{copies at: item - 1}]! Item was changed: ----- Method: MCMcmUpdater class>>defaultUpdateURL (in category 'preferences') ----- defaultUpdateURL "The default update repository URL" <preference: 'Update URL' category: 'updates' description: 'The repository URL for loading updates' type: #String> ^ DefaultUpdateURL ifNil: [ self notify: 'There is no update URL configured. Proceed to use Squeak''s Trunk repository.' translated. + MCHttpRepository trunkUrlString]! - 'http://source.squeak.org/trunk']! Item was changed: ----- Method: MCMcmUpdater>>logUpdateOf:previousUpdateLevel:interactive: (in category 'updating') ----- logUpdateOf: config previousUpdateLevel: previousUpdateLevel interactive: interactive MCMcmUpdater default == self ifTrue: [ config setSystemVersion. interactive ifTrue: [ self inform: (self updateMessageFor: previousUpdateLevel)]. Transcript cr; + show: ('========== Update of {1} completed: ' translated format: {self repositoryName}); - show: '========== Update of ' translated, self repositoryName, ' completed: ' translated; show: previousUpdateLevel; show: ' -> ' ; show: SystemVersion current highestUpdate; show: ' =========='; cr ] ifFalse: [ interactive + ifTrue: [ self inform: ('Update of {1} completed.' translated format: {self repositoryName}) ]. + Transcript cr; show: ('========== Update of {1} completed. ==========' translated format: {self repositoryName}); cr ] - ifTrue: [ self inform: 'Update of ', self repositoryName, ' completed.' ]. - Transcript cr; show: '========== Update of ' translated, self repositoryName, ' completed. ==========' translated; cr ] ! Item was changed: ----- Method: MCMcmUpdater>>updateFromRepository (in category 'updating') ----- updateFromRepository | config repo | repo := self getRepositoryFromRepositoryGroup. repo cacheAllFileNamesDuring: [ | updateList | updateList := self updateListFor: repo. "Proceed only if there are updates available at all." updateList ifNotEmpty: [ updateList := self refreshUpdateMapFor: repo with: updateList. "Now process each update file. Check if we have all dependencies and if not, load the entire configuration (this is mostly to skip older updates quickly)" updateList do:[:assoc| + ProgressNotification signal: '' extra: ('Processing {1}' translated format: {assoc value}). - ProgressNotification signal: '' extra: 'Processing ', assoc value. config := repo versionNamed: assoc value. self updateFromConfig: config. self lastUpdateMap at: repo description put: assoc key. + ] displayingProgress: 'Processing configurations' translated. - ] displayingProgress: 'Processing configurations'. "We've loaded all the provided update configurations. Use the latest configuration to update all the remaining packages." (self useLatestPackagesFrom: repo) ifTrue: [ config updateFromRepositories. config upgrade]. ]]. ^ config ! Item was changed: ----- Method: MCMcmUpdater>>updateFromRepository:upTo: (in category 'updating') ----- updateFromRepository: repository upTo: versionNumber | config | + config := nil. repository cacheAllFileNamesDuring: [ | updateList | updateList := self updateListFor: repository. "Proceed only if there are updates available at all." updateList ifNotEmpty: [ updateList := self refreshUpdateMapFor: repository with: updateList. "Now process each update file. Check if we have all dependencies and if not, load the entire configuration (this is mostly to skip older updates quickly)" updateList do:[:assoc| assoc key > versionNumber ifTrue: [^config]. + ProgressNotification signal: '' extra: ('Processing ' translated format: {assoc value}). - ProgressNotification signal: '' extra: 'Processing ', assoc value. config := repository versionNamed: assoc value. self updateFromConfig: config. self lastUpdateMap at: repository description put: assoc key. + ] displayingProgress: 'Processing configurations' translated. - ] displayingProgress: 'Processing configurations'. ]]. ^config ! Item was changed: ----- Method: MCMcmUpdater>>updateListFor: (in category 'private') ----- updateListFor: repo | updateList allNames minVersion | updateList := OrderedCollection new. minVersion := self lastUpdateMap at: repo description ifAbsent: [0]. "Find all the update-*.mcm files" + allNames := ('Checking {1}' translated format: {repo description}) - allNames := 'Checking ', repo description displayProgressFrom: 0 to: 1 during: [:bar| bar value: 0. repo allFileNamesOrCache ]. allNames do: [:fileName | | version | ((fileName endsWith: '.mcm') and: [fileName packageAndBranchName = self updateMapName and: [(version := fileName versionNumber) >= minVersion]]) ifTrue: [updateList add: version -> fileName]]. ^updateList sort!

1 0

The Trunk: Monticello-ct.729.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.729.mcz ==================== Summary ==================== Name: Monticello-ct.729 Author: ct Time: 17 September 2020, 7:04:53.385813 pm UUID: 5eea47cc-405e-7841-9544-0f57a9b92fa0 Ancestors: Monticello-cmm.726 Proposal: Enhance truncation of "newer versions avaiable" warning (and make it multilingual-ready) =============== Diff against Monticello-cmm.726 =============== Item was changed: ----- Method: MCWorkingCopyBrowser>>checkForNewerVersions (in category 'actions') ----- checkForNewerVersions + "Answer true if there are no newer versions preventing us from saving a version." + | newer | newer := workingCopy possiblyNewerVersionsIn: self repository. + + newer ifEmpty: [^ true]. + + ^ self confirm: ('CAUTION!! {1}:\{2}\Do you really want to save this version?' withCRs translated format: { + newer size = 1 + ifTrue: ['This version in the repository may be newer' translated] + ifFalse: ['These {1} versions in the repository may be newer' translated format: {newer size}]. + (newer size > 3 + ifFalse: [newer] + ifTrue: [(newer first: 3) , {'...'} , {newer last}]) asCommaString withNoLineLongerThan: 150 + })! - ^ newer isEmpty or: [ - self confirm: 'CAUTION!! These versions in the repository may be newer:', - String cr, ((newer asCommaString withNoLineLongerThan: 150) truncateWithElipsisTo: 5 * 149), String cr, - 'Do you really want to save this version?'].!

1 0

The Trunk: Monticello-ct.764.mcz
by commits＠source.squeak.org 03 Jan '22

03 Jan '22

Christoph Thiede uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.764.mcz ==================== Summary ==================== Name: Monticello-ct.764 Author: ct Time: 3 January 2022, 9:40:50.200397 pm UUID: 861868bb-b96a-3144-959b-a00a7e62abb0 Ancestors: Monticello-eem.763, Monticello-ct.729 Improves multilingual support. =============== Diff against Monticello-eem.763 =============== Item was changed: ----- Method: MCVersionHistoryBrowser>>defaultLabel (in category 'morphic ui') ----- defaultLabel + ^ '{1} History' translated format: {ancestry name}! - ^ ancestry name, ' History'! Item was changed: ----- Method: MCVersionHistoryBrowser>>searchHistory (in category 'morphic ui') ----- searchHistory + (Project uiManager - (UIManager default edit: (String streamContents: [:s| self selectedInfo topologicalAncestors do: [:versionInfo | s nextPutAll: versionInfo summary] separatedBy: [s cr; cr]]) + label: ('Version History: {1}' translated format: {self selectedInfo versionName})) + extent: (0.5(a)0.9) * Display height! - label: 'Version History: ', self selectedInfo versionName) - extent: (0.5(a)0.9) * Display height! Item was changed: ----- Method: MCVersionHistoryBrowser>>viewChanges:snapshot:relativeTo:snapshot: (in category 'morphic ui') ----- viewChanges: ancestorInfo snapshot: ancestorSnapshot relativeTo: baseInfo snapshot: baseSnapshot "Note that the patchLabel will be parsed in MCPatchBrowser>>installSelection, so don't translate it!!" | patch patchLabel | + patchLabel := 'changes between {1} and {2}' translated format: { baseInfo name. ancestorInfo name }. - patchLabel := 'changes between {1} and {2}' format: { baseInfo name. ancestorInfo name }. patch := ancestorSnapshot patchRelativeToBase: baseSnapshot. (MCPatchBrowser forPatch: patch) label: patchLabel; show! Item was changed: ----- Method: MCWorkingCopyBrowser>>addWorkingCopy (in category 'actions') ----- addWorkingCopy |name| + name := Project uiManager request: 'Name of package:' translated. - name := UIManager default request: 'Name of package:'. name isEmptyOrNil ifFalse: [PackageInfo registerPackageName: name. workingCopy := MCWorkingCopy forPackage: (MCPackage new name: name). workingCopyWrapper := nil. self repositorySelection: 0]. self workingCopyListChanged; changed: #workingCopySelection; changed: #repositoryList. self changedButtons.! Item was changed: ----- Method: MCWorkingCopyBrowser>>backportChanges (in category 'actions') ----- backportChanges self canBackport ifFalse: [^self]. workingCopy ifNotNil: + [workingCopy needsSaving ifTrue: [^ self inform: 'You must save the working copy before backporting.' translated]. - [workingCopy needsSaving ifTrue: [^ self inform: 'You must save the working copy before backporting.']. self pickAncestorVersionInfo ifNotNil: [:baseVersionInfo | workingCopy backportChangesTo: baseVersionInfo]]! Item was changed: ----- Method: MCWorkingCopyBrowser>>checkForNewerVersions (in category 'actions') ----- checkForNewerVersions + "Answer true if there are no newer versions preventing us from saving a version." + | newer | newer := workingCopy possiblyNewerVersionsIn: self repository. + + newer ifEmpty: [^ true]. + + ^ self confirm: ('CAUTION!! {1}:\\ {2}\\Do you really want to save this version?' withCRs translated format: { + newer size = 1 + ifTrue: ['This version in the repository may be newer' translated] + ifFalse: ['These {1} versions in the repository may be newer' translated format: {newer size}]. + newer asCommaString withNoLineLongerThan: 150})! - ^ newer isEmpty or: [ - self confirm: 'CAUTION!! These versions in the repository may be newer:', - String cr, ((newer asCommaString withNoLineLongerThan: 150) truncateWithElipsisTo: 5 * 149), String cr, - 'Do you really want to save this version?'].! Item was changed: ----- Method: MCWorkingCopyBrowser>>defaultLabel (in category 'morphic ui') ----- defaultLabel + ^ 'Monticello Browser' translated! - ^ 'Monticello Browser'! Item was changed: ----- Method: MCWorkingCopyBrowser>>editRepository (in category 'actions') ----- editRepository | newRepo | newRepo := self repository openAndEditTemplateCopy. newRepo ifNotNil: [ newRepo class = self repository class ifTrue: [ self repository copyFrom: newRepo. self changed: #repositoryList ] + ifFalse: [self inform: 'Must not change repository type!!' translated]]! - ifFalse: [self inform: 'Must not change repository type!!']] - ! Item was changed: ----- Method: MCWorkingCopyBrowser>>editScript: (in category 'morphic ui') ----- editScript: scriptSymbol + | script | + script := workingCopy packageInfo perform: scriptSymbol. + script openLabel: ('{1} of the Package {2}' translated format: {scriptSymbol. workingCopy package name}).! - | script | - script := workingCopy packageInfo perform: scriptSymbol. - script openLabel: scriptSymbol asString, ' of the Package ', workingCopy package name.! Item was changed: ----- Method: MCWorkingCopyBrowser>>flushCachedVersions (in category 'actions') ----- flushCachedVersions | beforeBytes afterBytes beforeVersions afterVersions | Cursor wait showWhile: [ Smalltalk garbageCollect. beforeBytes := Smalltalk bytesLeft: true. beforeVersions := MCVersion allSubInstances size. MCFileBasedRepository flushAllCaches. afterBytes := Smalltalk bytesLeft: true. afterVersions := MCVersion allSubInstances size. ]. + ^self inform: ('{1} versions flushed\{2} bytes reclaimed' translated format: {beforeVersions - afterVersions. beforeBytes - afterBytes})! - ^self inform: (beforeVersions - afterVersions) asString, ' versions flushed', String cr, - (beforeBytes - afterBytes) asBytesDescription, ' bytes reclaimed'! Item was changed: ----- Method: MCWorkingCopyBrowser>>flushCachedVersionsAncestry (in category 'actions') ----- flushCachedVersionsAncestry | beforeBytes afterBytes beforeVersions afterVersions beforeInfos afterInfos | Cursor wait showWhile: [ beforeBytes := Smalltalk garbageCollect. beforeVersions := MCVersion allSubInstances size. beforeInfos := MCVersionInfo instanceCount. MCFileBasedRepository flushAllCaches. MCWorkingCopy stubAllAncestry. afterBytes := Smalltalk garbageCollect. afterVersions := MCVersion allSubInstances size. afterInfos := MCVersionInfo instanceCount ]. self inform: + ('{1} versions flushed\{2\ infos flushed\{3} reclaimed' translated + format: {beforeVersions - afterVersions. beforeInfos - afterInfos. (afterBytes - beforeBytes) asBytesDescription}).! - (beforeVersions-afterVersions) asString, ' versions flushed', - String cr, (beforeInfos-afterInfos), ' infos flushed', - String cr, (afterBytes-beforeBytes) asBytesDescription, ' reclaimed'! Item was changed: ----- Method: MCWorkingCopyBrowser>>newRepository (in category 'actions') ----- newRepository | types index | types := MCRepository allConcreteSubclasses asArray. + index := Project uiManager chooseFrom: (types collect: [:ea | ea description]) + title: 'Repository type:' translated. - index := UIManager default chooseFrom: (types collect: [:ea | ea description]) - title: 'Repository type:'. ^ index = 0 ifFalse: [(types at: index) morphicConfigure]! Item was changed: ----- Method: MCWorkingCopyBrowser>>pickAncestorVersionInfo (in category 'morphic ui') ----- pickAncestorVersionInfo | ancestors index | ancestors := workingCopy ancestry breadthFirstAncestors. + index := Project uiManager chooseFrom: (ancestors collect: [:ea | ea name]) + title: 'Ancestor:' translated. - index := UIManager default chooseFrom: (ancestors collect: [:ea | ea name]) - title: 'Ancestor:'. ^ index = 0 ifFalse: [ ancestors at: index]! Item was changed: ----- Method: MCWorkingCopyBrowser>>pickRepositorySatisfying: (in category 'morphic ui') ----- pickRepositorySatisfying: aBlock | repos index | repos := MCRepositoryGroup default repositories select: aBlock. + index := Project uiManager chooseFrom: (repos collect: [:ea | ea description]) + title: 'Repository:' translated. - index := UIManager default chooseFrom: (repos collect: [:ea | ea description]) - title: 'Repository:'. ^ index = 0 ifFalse: [repos at: index]! Item was changed: ----- Method: MCWorkingCopyBrowser>>pickWorkingCopySatisfying: (in category 'morphic ui') ----- pickWorkingCopySatisfying: aBlock | copies index | copies := self workingCopies select: aBlock. copies isEmpty ifTrue: [ ^nil ]. + index := Project uiManager chooseFrom: (copies collect: [:ea | ea packageName]) + title: 'Package:' translated. - index := UIManager default chooseFrom: (copies collect: [:ea | ea packageName]) - title: 'Package:'. ^ index = 0 ifFalse: [ copies at: index]! Item was changed: ----- Method: MCWorkingCopyBrowser>>recompilePackage (in category 'actions') ----- recompilePackage (workingCopy withEnvironmentActiveDo: [workingCopy package packageInfo methods]) do: [:ea | ea actualClass recompile: ea methodSymbol] + displayingProgress: 'Recompiling...' translated.! - displayingProgress: 'Recompiling...'! Item was changed: ----- Method: MCWorkingCopyBrowser>>renamePackage (in category 'actions') ----- renamePackage | newName | workingCopy ifNil: + [ self inform: 'Please select a package to be renamed.' translated. - [ UIManager inform: 'Please select a package to be renamed.'. ^ self ]. workingCopy modified ifTrue: + [ self inform: 'Only unmodified packages should be renamed.' translated. - [ UIManager inform: 'Only unmodified packages should be renamed.'. ^ self ]. + newName := Project uiManager + request: 'New name of package:' translated - newName := UIManager default - request: 'New name of package:' initialAnswer: workingCopy packageName. newName isEmptyOrNil ifFalse: [ | newWorkingCopy | newWorkingCopy := workingCopy renameToBe: newName. workingCopy package snapshot definitions ifEmpty: [ "It worked." workingCopy unregister. workingCopy := newWorkingCopy. self repositorySelection: 0. self workingCopyListChanged ; changed: #workingCopySelection ; changed: #repositoryList. self changedButtons ] ifNotEmpty: [ "It didn't work, browse the remaining definitions." self browseWorkingCopy ] ]! Item was changed: ----- Method: MCWorkingCopyBrowser>>revertPackage (in category 'actions') ----- revertPackage self pickAncestorVersionInfo ifNotNil: [:info | (self repositoryGroup versionWithInfo: info + ifNone: [^self inform: ('No repository found for {1}' translated format: {info name})] - ifNone: [^self inform: 'No repository found for ', info name] ) load]! Item was changed: ----- Method: MCWorkingCopyBrowser>>searchHistory (in category 'actions') ----- searchHistory workingCopy ifNotNil: [(UIManager default edit: (String streamContents: [:s| "Ignore the initial MCWorkingAncestry instance." workingCopy ancestry topologicalAncestors allButFirst do: [:versionInfo| s nextPutAll: versionInfo summary] separatedBy: [s cr; cr"; next: 32 put: $-; cr; cr"]]) + label: ('Version History: {1}' translated format: {workingCopy packageName})) - label: 'Version History: ', workingCopy packageName) extent: (0.6@1) * Display height * 0.9]! Item was changed: ----- Method: MCWorkingCopyBrowser>>viewChanges (in category 'actions') ----- viewChanges | patch | self canSave ifTrue: [patch := workingCopy changesRelativeToRepository: self repository withCache. patch isNil ifTrue: [ ^self ]. patch isEmpty ifTrue: [ workingCopy modified: false. self inform: ('No changes between your working copy of the package\\ {1}\\ and the repository at location\\ {2}' withCRs translated asText format: { workingCopy packageName asText allBold. self repository description asText allBold })] ifFalse: [ workingCopy modified: true. (MCPatchBrowser forPatch: patch) + label: ('Patch Browser: {1}' translated format: {workingCopy description}); - label: 'Patch Browser: ', workingCopy description; environmentInDisplayingImage: workingCopy environment; show ] ]! Item was changed: ----- Method: MCWorkingCopyBrowser>>viewHistory (in category 'actions') ----- viewHistory workingCopy ifNotNil: [(MCWorkingHistoryBrowser new ancestry: workingCopy ancestry; package: workingCopy package) + label: ('Version History: {1}' translated format: {workingCopy packageName}); - label: 'Version History: ', workingCopy packageName; show]!

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 January 2022