This adds keystrokes to the DualChangeSorter.

$t for toggle (to move a class or method to the other side)
$c for copy (to copy a class or method to the other side)

Regards
            Chris Burkert
-- 
http://www.chrisburkert.de/
-------------- next part --------------
'From Squeak3.6 of ''6 October 2003'' [latest update: #5424] on 21 October 2003 at 10:32:52 am'!

!ChangeSorter methodsFor: 'class list' stamp: 'chbu 10/21/2003 10:27'!
classListKey: aChar from: view
	"Respond to a Command key in the class-list pane."

	aChar == $x ifTrue: [^ self removeClass].
	aChar == $d ifTrue: [^ self forgetClass]. 
	aChar == $t ifTrue: [^ self moveClassToOther]. "toogle to the other side ($m is #implementors)"
	aChar == $c ifTrue: [^ self copyClassToOther]. "copy to the other side"

	^ self messageListKey: aChar from: view "picks up b,h,p"! !

!ChangeSorter methodsFor: 'class list' stamp: 'chbu 10/21/2003 10:31'!
classListMenu: aMenu shifted: shifted
	"Fill aMenu with items appropriate for the class list"

	aMenu title: 'class list'.
	Smalltalk isMorphic ifTrue: [aMenu addStayUpItemSpecial].
	(parent notNil and: [shifted not])
		ifTrue: [aMenu addList: #( "These two only apply to dual change sorters"
			('copy class chgs to other side (c)'			copyClassToOther)	
			('move (toggle) class chgs to other side (t)'		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)
			('unreferenced class vars'				showUnreferencedClassVars)
			-
			('sample instance'						makeSampleInstance)
			('inspect instances'						inspectInstances)
			('inspect subinstances'					inspectSubInstances)
			-
			('more...'								offerUnshiftedClassListMenu ))]).
	^ aMenu! !

!ChangeSorter methodsFor: 'message list' stamp: 'chbu 10/21/2003 10:30'!
messageListKey: aChar from: view
	"Respond to a Command key in the message-list pane."

	aChar == $d ifTrue: [^ self forget].
	aChar == $t ifTrue: [^ self moveMethodToOther ]. "toogle to the other side ($m is #implementors)"
	aChar == $c ifTrue: [^ self copyMethodToOther ]. "copy to the other side"
	super messageListKey: aChar from: view! !

!ChangeSorter methodsFor: 'message list' stamp: 'chbu 10/21/2003 10:32'!
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 (c)'			copyMethodToOther)
			('move (toggle) method to other side (t)'			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
! !