'From Squeak3.1alpha of 28 February 2001 [latest update: #3798] on 6 March 2001 at 2:55:37 pm'! "Change Set: chgSorterMenus-sw Date: 6 March 2001 Author: Scott Wallace Several cleanups and extensions to change-sorter menus. Adds cmd-d shortcuts for delete-method-from-changeset and delete-class-from-changeset. Elevates removeClass to CodeHolder so that code-holders other than browsers can benefit from it, such as ChangeSorters"! !CodeHolder methodsFor: 'commands' stamp: 'sw 3/5/2001 18:15'! removeClass "Remove the selected class from the system, at interactive user request. Make certain the user really wants to do this, since it is not reversible. Answer true if removal actually happened." | message className classToRemove result | self okToChange ifFalse: [^ false]. classToRemove _ self selectedClassOrMetaClass ifNil: [^ self beep]. classToRemove _ classToRemove theNonMetaClass. className _ classToRemove name. message _ 'Are you certain that you want to delete the class ', className, '?'. (result _ self confirm: message) ifTrue: [classToRemove subclasses size > 0 ifTrue: [(self confirm: 'class has subclasses: ' , message) ifFalse: [^ false]]. classToRemove removeFromSystem. self changed: #classList. true]. ^ result ! ! !Browser methodsFor: 'class functions' stamp: 'sw 3/5/2001 18:04'! removeClass "If the user confirms the wish to delete the class, do so" super removeClass ifTrue: [self classListIndex: 0]! ! !ChangeSorter methodsFor: 'creation' stamp: 'sw 2/26/2001 12:00'! openAsMorphIn: window rect: rect "Add a set of change sorter views to the given top view offset by the given amount. To create a single change sorter, call this once with an offset of 0@0. To create a dual change sorter, call it twice with offsets of 0@0 and 0.5@0." | csListHeight msgListHeight csMsgListHeight | contents _ ''. csListHeight _ 0.25. msgListHeight _ 0.25. csMsgListHeight _ csListHeight + msgListHeight. self addDependent: window. "so it will get changed: #relabel" window addMorph: ((PluggableListMorphByItem on: self list: #changeSetList selected: #currentCngSet changeSelected: #showChangeSetNamed: menu: #changeSetMenu:shifted: keystroke: #changeSetListKey:from:) autoDeselect: false) frame: (((0@0 extent: 0.5@csListHeight) scaleBy: rect extent) translateBy: rect origin). window addMorph: (PluggableListMorphByItem on: self list: #classList selected: #currentClassName changeSelected: #currentClassName: menu: #classListMenu:shifted: keystroke: #classListKey:from:) frame: (((0.5@0 extent: 0.5@csListHeight) scaleBy: rect extent) translateBy: rect origin). window addMorph: (PluggableListMorphByItem on: self list: #messageList selected: #currentSelector changeSelected: #currentSelector: menu: #messageMenu:shifted: keystroke: #messageListKey:from:) frame: (((0@csListHeight extent: 1@msgListHeight) scaleBy: rect extent) translateBy: rect origin). self addLowerPanesTo: window at: (((0@csMsgListHeight corner: 1@1) scaleBy: rect extent) translateBy: rect origin) with: nil.! ! !ChangeSorter methodsFor: 'creation' stamp: 'sw 2/26/2001 12:00'! openView: topView offsetBy: offset "Add a set of change sorter views to the given top view offset by the given amount. To create a single change sorter, call this once with an offset of 0@0. To create a dual change sorter, call it twice with offsets of 0@0 and 360@0." | classView messageView codeView cngSetListView basePane annoPane annoHeight | contents _ ''. annoHeight _ 20. self addDependent: topView. "so it will get changed: #relabel" cngSetListView _ PluggableListViewByItem on: self list: #changeSetList selected: #currentCngSet changeSelected: #showChangeSetNamed: menu: #changeSetMenu:shifted: keystroke: #changeSetListKey:from:. cngSetListView window: ((0@0 extent: 180@100) translateBy: offset). topView addSubView: cngSetListView. classView _ PluggableListViewByItem on: self list: #classList selected: #currentClassName changeSelected: #currentClassName: menu: #classListMenu:shifted: keystroke: #classListKey:from:. classView window: ((0@0 extent: 180@100) translateBy: offset). topView addSubView: classView toRightOf: cngSetListView. messageView _ PluggableListViewByItem on: self list: #messageList selected: #currentSelector changeSelected: #currentSelector: menu: #messageMenu:shifted: keystroke: #messageListKey:from:. messageView menuTitleSelector: #messageListSelectorTitle. messageView window: ((0@0 extent: 360@100) translateBy: offset). topView addSubView: messageView below: cngSetListView. self wantsAnnotationPane ifFalse: [basePane _ messageView] ifTrue: [annoPane _ PluggableTextView on: self text: #annotation accept: nil readSelection: nil menu: nil. annoPane window: ((0@0 extent: 360@annoHeight) translateBy: offset). topView addSubView: annoPane below: messageView. basePane _ annoPane]. codeView _ PluggableTextView on: self text: #contents accept: #contents:notifying: readSelection: #contentsSelection menu: #codePaneMenu:shifted:. codeView window: ((0 @ 0 extent: 360 @ 180) translateBy: offset). topView addSubView: codeView below: basePane.! ! !ChangeSorter methodsFor: 'changeSet menu' stamp: 'sw 2/27/2001 21:54'! changeSetMenu: aMenu shifted: isShifted "Set up aMenu to hold commands for the change-set-list pane. This could be for a single or double changeSorter" isShifted ifTrue: [^ self shiftedChangeSetMenu: aMenu]. Smalltalk isMorphic ifTrue: [aMenu title: 'Change Set'. aMenu addStayUpItemSpecial] ifFalse: [aMenu title: 'Change Set: ' , myChangeSet name]. aMenu add: 'make changes go to me (m)' action: #newCurrent. aMenu addLine. aMenu add: 'new change set... (n)' action: #newSet. aMenu add: 'find...(f)' action: #findCngSet. aMenu add: 'show...' action: #chooseCngSet. aMenu add: 'rename change set (r)' action: #rename. aMenu addLine. aMenu add: 'file out (o)' action: #fileOut. aMenu add: 'mail to list' action: #mailOut. aMenu add: 'browse methods (b)' action: #browseChangeSet. aMenu addLine. parent ifNotNil: [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)' action: #addPreamble. aMenu add: 'remove preamble' action: #removePreamble] ifFalse: [aMenu add: 'add preamble (p)' action: #addPreamble]. myChangeSet hasPostscript ifTrue: [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)' action: #remove. aMenu addLine. aMenu add: 'more...' action: #offerShiftedChangeSetMenu. ^ aMenu! ! !ChangeSorter methodsFor: 'changeSet menu' stamp: 'sw 2/27/2001 21:55'! offerShiftedChangeSetMenu "Offer the shifted version of the change set menu" self offerMenuFrom: #changeSetMenu:shifted: shifted: true! ! !ChangeSorter methodsFor: 'changeSet menu' stamp: 'sw 3/6/2001 14:41'! offerUnshiftedChangeSetMenu "Offer the unshifted version of the change set menu" self offerMenuFrom: #changeSetMenu:shifted: shifted: false! ! !ChangeSorter methodsFor: 'changeSet menu' stamp: 'sw 3/6/2001 14:41'! shiftedChangeSetMenu: aMenu "Set up aMenu to hold items relating to the change-set-list pane when the shift key is down" Smalltalk isMorphic ifTrue: [aMenu title: 'Change set (shifted)'. aMenu addStayUpItemSpecial]. 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.'. parent ifNotNil: [aMenu add: 'conflicts with opposite side' 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.'. ]. aMenu addLine. aMenu add: 'check for slips' action: #lookForSlips. aMenu balloonTextForLastItem: 'Check this change set for halts and references to Transcript.'. aMenu add: 'check for unsent messages' action: #checkForUnsentMessages. aMenu balloonTextForLastItem: 'Check this change set for messages that are not sent anywhere in the system'. aMenu add: 'check for uncommented methods' action: #checkForUncommentedMethods. aMenu balloonTextForLastItem: 'Check this change set for methods that do not have comments'. Utilities authorInitialsPerSe isEmptyOrNil ifFalse: [aMenu add: 'check for other authors' action: #checkForAlienAuthorship. aMenu balloonTextForLastItem: 'Check this change set for methods whose current authoring stamp does not start with "', Utilities authorInitials, '"']. aMenu addLine. 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.)'. 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.)'. 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.'. 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.'. 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'. 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!!'. 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.'. 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!!'. aMenu addLine. 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.)'. aMenu add: 'file out all change sets' action: #fileOutUnnumberedChangeSets. aMenu balloonTextForLastItem: 'File out every change set in the system whose name does not begin with a digit, except those that are empty or whose names start with "Play with me". The usual checks for slips are suppressed when this command is done.'. aMenu addLine. aMenu add: 'reorder change sets' action: #reorderChangeSets. aMenu balloonTextForLastItem: 'Applies a standard reordering of change-sets -- 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 whose names do not start with digits'. aMenu addLine. aMenu add: 'more...' action: #offerUnshiftedChangeSetMenu. aMenu balloonTextForLastItem: 'Takes you back to the primary change-set menu.'. ^ aMenu! ! !ChangeSorter methodsFor: 'class list' stamp: 'sw 3/5/2001 18:24'! classListKey: aChar from: view "Respond to a Command key in the class-list pane." aChar == $x ifTrue: [^ self removeClass]. aChar == $d ifTrue: [^ self forgetClass]. ^ self messageListKey: aChar from: view "picks up b,h,p"! ! !ChangeSorter methodsFor: 'class list' stamp: 'sw 3/6/2001 13:01'! classListMenu: aMenu shifted: shifted "Fill aMenu with items appropriate for the class list" aMenu title: 'class list'. (parent notNil and: [shifted not]) ifTrue: [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 addList: (shifted ifFalse: [#( - ('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) - ('inst var refs...' browseInstVarRefs) ('inst var defs...' browseInstVarDefs) ('class var refs...' browseClassVarRefs) ('class vars' browseClassVariables) ('class refs (N)' browseClassRefs) - ('more...' offerShiftedClassListMenu))] ifTrue: [#( - ('unsent methods' browseUnusedMethods) ('unreferenced inst vars' showUnreferencedInstVars) - ('sample instance' makeSampleInstance) ('inspect instances' inspectInstances) ('inspect subinstances' inspectSubInstances) - ('more...' offerUnshiftedClassListMenu ))]). ^ aMenu! ! !ChangeSorter methodsFor: 'class list' stamp: 'sw 2/26/2001 12:00'! classMenu: aMenu "Set up aMenu for the class-list. Retained for backward compatibility with old change sorters in image segments" ^ self classListMenu: aMenu shifted: false! ! !ChangeSorter methodsFor: 'class list' stamp: 'sw 3/6/2001 12:40'! classMenu: aMenu shifted: shifted "Fill aMenu with items appropriate for the class list. Retained for bkwd compatibility" ^ self classListMenu: aMenu shifted: shifted! ! !ChangeSorter methodsFor: 'class list' stamp: 'sw 3/5/2001 18:30'! messageListKey: aChar from: view "Respond to a Command key in the message-list pane." aChar == $d ifTrue: [^ self forget]. super messageListKey: aChar from: view! ! !ChangeSorter methodsFor: 'message list' stamp: 'sw 3/5/2001 18:26'! messageMenu: aMenu shifted: shifted "Fill aMenu with items appropriate for the message list; could be for a single or double changeSorter" shifted ifTrue: [^ self shiftedMessageMenu: aMenu]. aMenu title: 'message list'. Smalltalk isMorphic ifTrue: [aMenu addStayUpItemSpecial]. parent ifNotNil: [aMenu addList: #( ('copy method to other side' copyMethodToOther) ('move method to other side' moveMethodToOther))]. aMenu addList: #( ('delete method from changeSet (d)' forget) - ('remove method from system (x)' removeMessage) - ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' spawnHierarchy) ('browse method (O)' openSingleMessageBrowser) ('browse protocol (p)' browseFullProtocol) - ('fileOut' fileOutMessage) ('printOut' printOutMessage) - ('senders of... (n)' browseSendersOfMessages) ('implementors of... (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) - ('more...' shiftedYellowButtonActivity)). ^ aMenu ! !