[squeak-dev] The Trunk: Tools-ct.1100.mczcommits at source.squeak.org commits at source.squeak.orgMon Jan 3 22:12:17 UTC 2022
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.'!
More information about the Squeak-dev mailing list |