[FIX] InspectInstancesFix (#3)

Robert Hirschfeld hirschfeld at acm.org
Sat Dec 2 16:51:35 UTC 2000


Apparently I wasn't thorough enough in my search for all places
affected by the new selectors. Hopefully I got them all now.

-Robert


Scott Wallace wrote:
> 
> Robert,
> 
> The reason the "inspect instances" items are found in the
> message-list menu rather than in the class-list menu is so that they
> will be available even in the many browsing tools that do not have a
> class-list pane (e.g. recent-message-browsers,
> single-method-browsers, implementors browsers, message-category
> browsers.)
> 
> It's not unreasonable *also* to have "inspect instances", etc.,
> appear in the class-list menu, where a class-list pane is available
> -- indeed we follow that tradition for various other menu items.  But
> let's not remove them from the message-list-pane menu, because that
> will often be the only place where they will be available in certain
> tools.
> 
> Thus, I would recommend removing Browser.messageListMenu:shifted:
> from this change set, but adopting the rest.
> 
> It's been high time to have a shifted branch for the class-list
> menus, so this is a good service!
> 
>   -- Scott
>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: InspectInstancesFix.01Dec2325.cs.gz
Type: application/x-gzip
Size: 5318 bytes
Desc: not available
Url : http://lists.squeakfoundation.org/pipermail/squeak-dev/attachments/20001202/c9b3aabc/InspectInstancesFix.01Dec2325.cs.bin
-------------- next part --------------
'From Squeak2.9alpha of 2 September 2000 [latest update: #3059] on 1 December 2000 at 11:25:29 pm'!
"Change Set:		InspectInstancesFix (#3)
Date:			1 December 2000
Author:			Robert Hirschfeld

Copies the inspect instances menu item and its variants from the message list menu in Browser and moves them from the message menu in ChangeSorter to their class (list) menus. Updates all instances of Browser and ChangeSorter and their subclasses with the new class (list) menu selector."!


!Browser methodsFor: 'class functions' stamp: 'rhi 11/30/2000 01:11'!
classListMenu: aMenu shifted: shifted

	^ aMenu addList: (shifted
		ifFalse: [#(
			-
			('browse full (b)'			browseMethodFull)
			('browse hierarchy (h)'		spawnHierarchy)
			('browse protocol'			spawnProtocol)
			-
			('printOut'					printOutClass)
			('fileOut'					fileOutClass)
			-
			('show hierarchy'			hierarchy)
			('show definition'			editClass)
			('show comment'			editComment)
			-
			('inst var refs...'			browseInstVarRefs)
			('inst var defs...'			browseInstVarDefs)
			-
			('class var refs...'			browseClassVarRefs)
			('class vars'					browseClassVariables)
			('class refs (N)'				browseClassRefs)
			-
			('rename class ...'			renameClass)
			('copy class'				copyClass)
			('remove class (x)'			removeClass)
			-
			('find method...'				findMethod)
			-
			('more...'					shiftedYellowButtonActivity))]
		ifTrue: [#(
			-
			('unsent methods'			browseUnusedMethods)
			('unreferenced inst vars'	showUnreferencedInstVars)
			('subclass template'			makeNewSubclass)
			-
			('sample instance'			makeSampleInstance)
			('inspect instances'			inspectInstances)
			('inspect subinstances'		inspectSubInstances)
			-
			('fetch documentation'		fetchClassDocPane)
			-
			('more...'					unshiftedYellowButtonActivity))])! !

!Browser methodsFor: 'initialize-release' stamp: 'rhi 11/29/2000 23:42'!
openAsMorphClassEditing: editString
	"Create a pluggable version a Browser on just a single class."
	| window switches codePane baseline aTextMorph dragNDropFlag |
	window _ (SystemWindow labelled: 'later') model: self.

	dragNDropFlag _ Preferences browseWithDragNDrop.

	window addMorph: ((PluggableListMorph on: self list: #classListSingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0 at 0 extent: 0.5 at 0.06).
	switches _ self buildMorphicSwitches.
	window addMorph: switches frame: (0.5 at 0 extent: 0.5 at 0.06).
	switches borderWidth: 0.

	window addMorph: ((PluggableMessageCategoryListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: keystroke: #arrowKey:from:	 getRawListSelector: #rawMessageCategoryList)  enableDragNDrop: dragNDropFlag)
		frame: (0 at 0.06 extent: 0.5 at 0.30).

	window addMorph: ((PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0.5 at 0.06 extent: 0.5 at 0.30).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ 0.36]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				frame: (0 at 0.36 corner: 1 at 0.41).
			baseline _ 0.41].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow frame: ((0 at baseline corner: 1 @ (baseline + 0.08))).
			baseline _ baseline + 0.08].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		frame: (0 at baseline corner: 1 at 1).

	window setUpdatablePanesFrom: #(messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'rhi 11/29/2000 23:42'!
openAsMorphEditing: editString
	"Create a pluggable version of all the morphs for a Browser in Morphic"
	| window switches codePane aListMorph baseline aTextMorph dragNDropFlag |
	window _ (SystemWindow labelled: 'later') model: self.

	dragNDropFlag _ Preferences browseWithDragNDrop.
	window addMorph: ((PluggableListMorph on: self list: #systemCategoryList
			selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu: keystroke: #systemCatListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0 at 0 extent: 0.25 at 0.4).
	window addMorph: ((PluggableListMorph on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0.25 at 0 extent: 0.25 at 0.3).
	switches _ self buildMorphicSwitches.
	window addMorph: switches frame: (0.25 at 0.3 extent: 0.25 at 0.1).
	switches borderWidth: 0.
	window addMorph: ((PluggableMessageCategoryListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: keystroke: #arrowKey:from: getRawListSelector: #rawMessageCategoryList) enableDragNDrop: dragNDropFlag)
		frame: (0.5 at 0 extent: 0.25 at 0.4).
	aListMorph _ PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: dragNDropFlag.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0.75 at 0 extent: 0.25 at 0.4).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ 0.4]
		ifTrue:
			[aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				frame: (0 at 0.4 corner: 1 at 0.45).
			baseline _ 0.45].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow frame: ((0 at baseline corner: 1 @ (baseline + 0.08))).
			baseline _ baseline + 0.08].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		frame: (0 @ baseline corner: 1 @ 1).

	window setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'rhi 11/29/2000 23:42'!
openAsMorphSysCatEditing: editString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window switches codePane baseline aTextMorph dragNDropFlag |
	window _ (SystemWindow labelled: 'later') model: self.

	dragNDropFlag _ Preferences browseWithDragNDrop.

	window addMorph: ((PluggableListMorph on: self list: #systemCategorySingleton
			selected: #indexIsOne changeSelected: #indexIsOne:
			menu: #systemCatSingletonMenu: keystroke: #systemCatSingletonKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0 at 0 extent: 1.0 at 0.06).
	window addMorph: ((PluggableListMorph on: self list: #classList
			selected: #classListIndex changeSelected: #classListIndex:
			menu: #classListMenu:shifted: keystroke: #classListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0 at 0.06 extent: 0.3333 at 0.24).
	switches _ self buildMorphicSwitches.
	window addMorph: switches frame: (0 at 0.3 extent: 0.3333 at 0.06).
	switches borderWidth: 0.
	window addMorph: ((PluggableMessageCategoryListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu: keystroke: #arrowKey:from:	 getRawListSelector: #rawMessageCategoryList) enableDragNDrop: dragNDropFlag)
		frame: (0.3333 at 0.06 extent: 0.3333 at 0.30).

	window addMorph: ((PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:) enableDragNDrop: dragNDropFlag)
		frame: (0.6666 at 0.06 extent: 0.3333 at 0.30).

	Preferences useAnnotationPanes
		ifFalse: 	[baseline _ 0.36]
		ifTrue: [baseline _ 0.41.
			aTextMorph _ PluggableTextMorph on: self
					text: #annotation accept: nil
					readSelection: nil menu: nil.
			aTextMorph askBeforeDiscardingEdits: false.
			window addMorph: aTextMorph
				frame: (0 at 0.36 corner: 1 at baseline)].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow frame: ((0 at baseline corner: 1 @ (baseline + 0.08))).
			baseline _ baseline + 0.08].

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	editString ifNotNil: [codePane editString: editString.
					codePane hasUnacceptedEdits: true].
	window addMorph: codePane
		frame: (0 at baseline corner: 1 at 1).

	window setUpdatablePanesFrom: #( classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'initialize-release' stamp: 'rhi 11/29/2000 23:42'!
openEditString: aString
        "Create a pluggable version of all the views for a Browser, including views and controllers."
        | systemCategoryListView classListView 
        messageCategoryListView messageListView browserCodeView topView switchView underPane y optionalButtonsView annotationPane |

        self couldOpenInMorphic ifTrue: [^ self openAsMorphEditing: aString].
        "Sensor leftShiftDown ifTrue: [^ self openAsMorphEditing: aString].
                uncomment-out for testing morphic browser embedded in mvc project"

        topView _ StandardSystemView new model: self.
        topView borderWidth: 1. "label and minSize taken care of by caller"

        systemCategoryListView _ PluggableListView on: self
                list: #systemCategoryList
                selected: #systemCategoryListIndex
                changeSelected: #systemCategoryListIndex:
                menu: #systemCategoryMenu:
                keystroke: #systemCatListKey:from:.
        systemCategoryListView window: (0 @ 0 extent: 50 @ 70).
        topView addSubView: systemCategoryListView.

        classListView _ PluggableListView on: self
                list: #classList
                selected: #classListIndex
                changeSelected: #classListIndex:
                menu: #classListMenu:shifted:
                keystroke: #classListKey:from:.
        classListView window: (0 @ 0 extent: 50 @ 62).
        topView addSubView: classListView toRightOf: systemCategoryListView.

        switchView _ self buildInstanceClassSwitchView.
        switchView borderWidth: 1.
        topView addSubView: switchView below: classListView.

        messageCategoryListView _ PluggableListView on: self
                list: #messageCategoryList
                selected: #messageCategoryListIndex
                changeSelected: #messageCategoryListIndex:
                menu: #messageCategoryMenu:.
        messageCategoryListView window: (0 @ 0 extent: 50 @ 70).
        topView addSubView: messageCategoryListView toRightOf: classListView.

        messageListView _ PluggableListView on: self
                list: #messageList
                selected: #messageListIndex
                changeSelected: #messageListIndex:
                menu: #messageListMenu:shifted:
                keystroke: #messageListKey:from:.
        messageListView window: (0 @ 0 extent: 50 @ 70).
        messageListView menuTitleSelector: #messageListSelectorTitle.
        topView addSubView: messageListView toRightOf: messageCategoryListView.

        Preferences useAnnotationPanes
                ifTrue:
                        [annotationPane _ PluggableTextView on: self
                                text: #annotation accept: nil
                                readSelection: nil menu: nil.
                        annotationPane window: (0 at 0 extent: 200 at self optionalAnnotationHeight).
                        topView addSubView: annotationPane below: systemCategoryListView.
                        underPane _ annotationPane.
                        y _ 110 - self optionalAnnotationHeight]
                ifFalse: [
                        underPane _ systemCategoryListView.
                        y _ 110].

        Preferences optionalButtons ifTrue:
                [optionalButtonsView _ self buildOptionalButtonsView.
                optionalButtonsView borderWidth: 1.
                topView addSubView: optionalButtonsView below: underPane.
                underPane _ optionalButtonsView.
                y _ y - self optionalButtonHeight].

        browserCodeView _ PluggableTextView on: self 
                        text: #contents accept: #contents:notifying:
                        readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
        browserCodeView window: (0 at 0 extent: 200 at y).
        topView addSubView: browserCodeView below: underPane.
        aString ifNotNil: [browserCodeView editString: aString.
                        browserCodeView hasUnacceptedEdits: true].
        topView setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).

        ^ topView! !

!Browser methodsFor: 'initialize-release' stamp: 'rhi 11/29/2000 23:43'!
openOnClassWithEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| classListView messageCategoryListView messageListView browserCodeView topView switchView annotationPane underPane y optionalButtonsView |

	Smalltalk isMorphic ifTrue: [^ self openAsMorphClassEditing: aString].

	topView _ (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	classListView _ PluggableListView on: self
		list: #classListSingleton
		selected: #indexIsOne 
		changeSelected: #indexIsOne:
		menu: #classListMenu:shifted:
		keystroke: #classListKey:from:.
	classListView window: (0 @ 0 extent: 100 @ 12).
	topView addSubView: classListView.

	messageCategoryListView _ PluggableListView on: self
		list: #messageCategoryList
		selected: #messageCategoryListIndex
		changeSelected: #messageCategoryListIndex:
		menu: #messageCategoryMenu:.
	messageCategoryListView window: (0 @ 0 extent: 100 @ 70).
	topView addSubView: messageCategoryListView below: classListView.

	messageListView _ PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	messageListView menuTitleSelector: #messageListSelectorTitle.
	messageListView window: (0 @ 0 extent: 100 @ 70).
	topView addSubView: messageListView toRightOf: messageCategoryListView.

	switchView _ self buildInstanceClassSwitchView.
	switchView borderWidth: 1.
	switchView 
		window: switchView window 
		viewport: (classListView viewport topRight 
					corner: messageListView viewport topRight).
	topView addSubView: switchView toRightOf: classListView.

	Preferences useAnnotationPanes
		ifTrue:
			[annotationPane _ PluggableTextView on: self
				text: #annotation accept: nil
				readSelection: nil menu: nil.
			annotationPane window: (0 at 0 extent: 200 at self optionalAnnotationHeight).
			topView addSubView: annotationPane below: messageCategoryListView.
			underPane _ annotationPane.
			y _ (200-12-70) - self optionalAnnotationHeight]
		ifFalse:
			[underPane _ messageCategoryListView.
			y _ (200-12-70)].

	Preferences optionalButtons ifTrue:
		[optionalButtonsView _ self buildOptionalButtonsView.
		optionalButtonsView borderWidth: 1.
		topView addSubView: optionalButtonsView below: underPane.
		underPane _ optionalButtonsView.
		y _ y - self optionalButtonHeight].

	browserCodeView _ PluggableTextView on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0 at 0 extent: 200 at y).
	topView addSubView: browserCodeView below: underPane.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].

	topView setUpdatablePanesFrom: #(messageCategoryList messageList).
	^ topView
! !

!Browser methodsFor: 'initialize-release' stamp: 'rhi 11/29/2000 23:43'!
openSystemCatEditString: aString
	"Create a pluggable version of all the views for a Browser, including views and controllers.  The top list view is of the currently selected system class category--a single item list."
	| systemCategoryListView classListView messageCategoryListView messageListView browserCodeView topView switchView y annotationPane underPane optionalButtonsView |

	Smalltalk isMorphic ifTrue: [^ self openAsMorphSysCatEditing: aString].

	topView _ (StandardSystemView new) model: self.
	topView borderWidth: 1.
		"label and minSize taken care of by caller"

	systemCategoryListView _ PluggableListView on: self
		list: #systemCategorySingleton
		selected: #indexIsOne 
		changeSelected: #indexIsOne:
		menu: #systemCatSingletonMenu:
		keystroke: #systemCatSingletonKey:from:.
	systemCategoryListView window: (0 @ 0 extent: 200 @ 12).
	topView addSubView: systemCategoryListView.

	classListView _ PluggableListView on: self
		list: #classList
		selected: #classListIndex
		changeSelected: #classListIndex:
		menu: #classListMenu:shifted:
		keystroke: #classListKey:from:.
	classListView window: (0 @ 0 extent: 67 @ 62).
	topView addSubView: classListView below: systemCategoryListView.

	messageCategoryListView _ PluggableListView on: self
		list: #messageCategoryList
		selected: #messageCategoryListIndex
		changeSelected: #messageCategoryListIndex:
		menu: #messageCategoryMenu:.
	messageCategoryListView window: (0 @ 0 extent: 66 @ 70).
	topView addSubView: messageCategoryListView toRightOf: classListView.

	switchView _ self buildInstanceClassSwitchView.
	switchView 
		window: switchView window 
		viewport: (classListView viewport bottomLeft 
					corner: messageCategoryListView viewport bottomLeft).
	switchView borderWidth: 1.
	topView addSubView: switchView below: classListView.

	messageListView _ PluggableListView on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	messageListView menuTitleSelector: #messageListSelectorTitle.
	messageListView window: (0 @ 0 extent: 67 @ 70).
	topView addSubView: messageListView toRightOf: messageCategoryListView.

	Preferences useAnnotationPanes
		ifTrue: [
			annotationPane _ PluggableTextView on: self
				text: #annotation accept: nil
				readSelection: nil menu: nil.
			annotationPane window: (0 at 0 extent: 200 at self optionalAnnotationHeight).
			topView addSubView: annotationPane below: switchView.
			y _ 110 - 12 - self optionalAnnotationHeight.
			underPane _ annotationPane]
		ifFalse: [
			y _ 110 - 12.
			underPane _ switchView].

	Preferences optionalButtons ifTrue:
		[optionalButtonsView _ self buildOptionalButtonsView.
		optionalButtonsView borderWidth: 1.
		topView addSubView: optionalButtonsView below: underPane.
		underPane _ optionalButtonsView.
		y _ y - self optionalButtonHeight].

	browserCodeView _ PluggableTextView on: self 
			text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	browserCodeView window: (0 at 0 extent: 200 at y).
	topView addSubView: browserCodeView below: underPane.
	aString ifNotNil: [browserCodeView editString: aString.
			browserCodeView hasUnacceptedEdits: true].
	topView setUpdatablePanesFrom: #(classList messageCategoryList messageList).
	^ topView! !

!Browser methodsFor: 'message functions' stamp: 'rhi 11/30/2000 09:19'!
messageListMenu: aMenu shifted: shifted

	^ aMenu addList: (shifted
		ifFalse: [#(
			-
			('browse full (b)' 						browseMethodFull)
			('browse hierarchy (h)'					classHierarchy)
			('browse method (O)'					openSingleMessageBrowser)
			-
			('fileOut'								fileOutMessage)
			('printOut'								printOutMessage)
			-
			('senders of... (n)'						browseSendersOfMessages)
			('implementors of... (m)'					browseMessages)
			('inheritance (i)'						methodHierarchy)
			('tile scriptor'							openSyntaxView)
			('versions (v)'							browseVersions)
			-
			('inst var refs...'						browseInstVarRefs)
			('inst var defs...'						browseInstVarDefs)
			('class var refs...'						browseClassVarRefs)
			('class variables'						browseClassVariables)
			('class refs (N)'							browseClassRefs)
			-
			('remove method (x)'					removeMessage)
			-
			('more...'								shiftedYellowButtonActivity))]
		ifTrue: [#(
			-
			('method pane' 							makeIsolatedCodePane)
			"('make a scriptor'						makeScriptor)"
			('toggle diffing'							toggleDiffing)
			('implementors of sent messages'			browseAllMessages)
			-
			('sample instance'						makeSampleInstance)
			('inspect instances'						inspectInstances)
			('inspect subinstances'					inspectSubInstances)
			-
			('remove from this browser'				removeMessageFromBrowser)
			('change category...'					changeCategory)
			-
			('change sets with this method'			findMethodInChangeSets)
			('revert to previous version'				revertToPreviousVersion)
			('remove from current change set'		removeFromCurrentChanges)
			('revert and forget'						revertAndForget)
			-
			('fetch documentation'					fetchDocPane)
			-
			('more...'								unshiftedYellowButtonActivity))])! !


!ChangeSorter methodsFor: 'creation' stamp: 'rhi 12/1/2000 22:27'!
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 at 0. To create a dual change sorter, call it twice with offsets of 0 at 0 and 0.5 at 0."

	| csListHeight msgListHeight baseline csMsgListHeight annoHeight |
	contents _ ''.
	csListHeight _ 0.25.
	msgListHeight _ 0.25.
	annoHeight _ 0.05.
	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 at 0 extent: 0.5 at csListHeight)
			scaleBy: rect extent) translateBy: rect origin).

	window addMorph: (PluggableListMorphByItem on: self
				list: #classList
				selected: #currentClassName
				changeSelected: #currentClassName:
				menu: #classMenu:shifted:
				keystroke: #classListKey:from:)
		frame: (((0.5 at 0 extent: 0.5 at csListHeight)
			scaleBy: rect extent) translateBy: rect origin).

	window addMorph: ((PluggableListMorphByItem on: self
				list: #messageList
				selected: #currentSelector
				changeSelected: #currentSelector:
				menu: #messageMenu:shifted:
				keystroke: #messageListKey:from:)
			menuTitleSelector: #messageListSelectorTitle)
		frame: (((0 at csListHeight extent: 1 at msgListHeight)
			scaleBy: rect extent) translateBy: rect origin).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ csMsgListHeight]
		ifTrue:
			[baseline _ csMsgListHeight + annoHeight.
			window addMorph: (	(PluggableTextMorph on: self
						text: #annotation accept: nil
						readSelection: nil menu: nil)
					askBeforeDiscardingEdits: false)
				frame: (((0 at csMsgListHeight extent: 1 at annoHeight)
					scaleBy: rect extent) translateBy: rect origin)].

	window addMorph: (PluggableTextMorph on: self 
				text: #contents accept: #contents:notifying:
				readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (((0 at baseline extent: 1@(1 - baseline))
			scaleBy: rect extent) translateBy: rect origin).! !

!ChangeSorter methodsFor: 'creation' stamp: 'rhi 12/1/2000 22:32'!
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 at 0. To create a dual change sorter, call it twice with offsets of 0 at 0 and 360 at 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:.
	cngSetListView window: ((0 at 0 extent: 180 at 100) translateBy: offset).
	topView addSubView: cngSetListView.

	classView _ PluggableListViewByItem on: self
		list: #classList
		selected: #currentClassName
		changeSelected: #currentClassName:
		menu: #classMenu:shifted:
		keystroke: #classListKey:from:.
	classView window: ((0 at 0 extent: 180 at 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 at 0 extent: 360 at 100) translateBy: offset).
	topView addSubView: messageView below: cngSetListView.

	Preferences useAnnotationPanes
		ifFalse:
			[basePane _ messageView]
		ifTrue:
			[annoPane _ PluggableTextView on: self
				text: #annotation
				accept: nil
				readSelection: nil
				menu: nil.
			annoPane window: ((0 at 0 extent: 360 at 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: 'class list' stamp: 'rhi 11/30/2000 01:09'!
classMenu: aMenu shifted: shifted

	(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 chgs from this change set'	forgetClass)
			-
			('browse full (b)'						browseMethodFull)
			('browse hierarchy (h)'					spawnHierarchy)
			('browse protocol'						spawnProtocol)
			-
			('printOut'								printOutClass)
			('fileOut'								fileOutClass)
			-
			('inst var refs...'						browseInstVarRefs)
			('inst var defs...'						browseInstVarDefs)
			('class var refs...'						browseClassVarRefs)
			('class vars'								browseClassVariables)
			('class refs (N)'							browseClassRefs)
			-
			('more...'								shiftedYellowButtonActivity))]
		ifTrue: [#(
			-
			('unsent methods'						browseUnusedMethods)
			('unreferenced inst vars'				showUnreferencedInstVars)
			-
			('sample instance'						makeSampleInstance)
			('inspect instances'						inspectInstances)
			('inspect subinstances'					inspectSubInstances)
			-
			('more...'								unshiftedYellowButtonActivity))])! !

!ChangeSorter methodsFor: 'message list' stamp: 'rhi 11/30/2000 00:52'!
shiftedMessageMenu: aMenu

	^ aMenu addList: #(
		-
		('method pane'						makeIsolatedCodePane)
		('toggle diffing'						toggleDiffing)
		('implementors of sent messages'		browseAllMessages)
		('change category...'				changeCategory)
		-
		('change sets with this method'		findMethodInChangeSets)
		('revert to previous version'			revertToPreviousVersion)
		('revert and forget'					revertAndForget)
		-
		('more...'							unshiftedYellowButtonActivity))! !


!PackageBrowser methodsFor: 'initialize-release' stamp: 'rhi 12/1/2000 23:07'!
openAsMorphEditing: editString 
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	"PackageBrowser openBrowser"

	| listHeight buttonHeight window switches codePane dragNDropFlag baseline annoHeight optButtonHeight |
	listHeight _ 0.4.
	buttonHeight _ 0.09.
	annoHeight _ 0.05.
	optButtonHeight _ 0.08.
	dragNDropFlag _ Preferences browseWithDragNDrop.

	(window _ SystemWindow labelled: 'later')
		model: self.

	window addMorph: (PluggableListMorph
				on: self
				list: #packageList
				selected: #packageListIndex
				changeSelected: #packageListIndex:
				menu: #packageMenu:
				keystroke: #packageListKey:from:)
		frame: (0 @ 0 extent: 0.15 @ listHeight).

	window addMorph: ((PluggableListMorph
				on: self
				list: #systemCategoryList
				selected: #systemCategoryListIndex
				changeSelected: #systemCategoryListIndex:
				menu: #systemCategoryMenu:
				keystroke: #systemCatListKey:from:)
			enableDrag: false;
			enableDrop: dragNDropFlag)
		frame: (0.15 @ 0 extent: 0.2 @ listHeight).

	window addMorph: ((PluggableListMorph
				on: self
				list: #classList
				selected: #classListIndex
				changeSelected: #classListIndex:
				menu: #classListMenu:shifted:
				keystroke: #classListKey:from:)
			enableDragNDrop: dragNDropFlag)
		frame: (0.35 @ 0 extent: 0.25 @ (listHeight - buttonHeight)).

	switches _ self buildMorphicSwitches.
	window addMorph: switches
		frame: (0.35 @ (listHeight - buttonHeight) extent: 0.25 @ buttonHeight).
	switches borderWidth: 0.

	window addMorph: ((PluggableListMorph
				on: self
				list: #messageCategoryList
				selected: #messageCategoryListIndex
				changeSelected: #messageCategoryListIndex:
				menu: #messageCategoryMenu:)
			enableDrag: false;
			enableDrop: dragNDropFlag)
		frame: (0.6 @ 0 extent: 0.15 @ listHeight).

	window addMorph: ((PluggableListMorph
				on: self
				list: #messageList
				selected: #messageListIndex
				changeSelected: #messageListIndex:
				menu: #messageListMenu:shifted:
				keystroke: #messageListKey:from:)
			enableDragNDrop: dragNDropFlag;
			menuTitleSelector: #messageListSelectorTitle)
		frame: (0.75 @ 0 extent: 0.25 @ listHeight).

	Preferences useAnnotationPanes
		ifFalse:
			[baseline _ listHeight]
		ifTrue:
			[window addMorph: (	(PluggableTextMorph on: self
						text: #annotation accept: nil
						readSelection: nil menu: nil)
					askBeforeDiscardingEdits: false)
				frame: (0 at listHeight extent: 1 at annoHeight).
			baseline _ listHeight + annoHeight].

	Preferences optionalButtons
		ifTrue:
			[window addMorph: self optionalButtonRow
				frame: (0 at baseline extent: 1 at optButtonHeight).
			baseline _ baseline + optButtonHeight].

	codePane _ PluggableTextMorph
				on: self
				text: #contents
				accept: #contents:notifying:
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:.
	editString
		ifNotNil:
			[codePane editString: editString.
			codePane hasUnacceptedEdits: true].
	window addMorph: codePane frame: (0 @ baseline extent: 1 @(1 - baseline)).
	window setUpdatablePanesFrom:
		#(packageList systemCategoryList classList messageCategoryList messageList ).
	^window! !

!PackageBrowser methodsFor: 'package list' stamp: 'rhi 11/29/2000 23:43'!
openEditString: aString
        "Create a pluggable version of all the views for a Browser, including views and controllers."
        "PackageBrowser openBrowser"

        | packageListView systemCategoryListView classListView messageCategoryListView
          messageListView browserCodeView topView switchView annotationPane underPane y optionalButtonsView |

        self couldOpenInMorphic ifTrue: [^ self openAsMorphEditing: aString].

        topView := (StandardSystemView new) model: self.
        topView borderWidth: 1.
                "label and minSize taken care of by caller"

        packageListView := PluggableListView on: self
                list: #packageList
                selected: #packageListIndex
                changeSelected: #packageListIndex:
                menu: #packageMenu:.
        packageListView window: (0 @ 0 extent: 20 @ 70).
        topView addSubView: packageListView.

        systemCategoryListView := PluggableListView on: self
                list: #systemCategoryList
                selected: #systemCategoryListIndex
                changeSelected: #systemCategoryListIndex:
                menu: #systemCategoryMenu:.
        systemCategoryListView window: (20 @ 0 extent: 30 @ 70).
        topView addSubView: systemCategoryListView.

        classListView := PluggableListView on: self
                list: #classList
                selected: #classListIndex
                changeSelected: #classListIndex:
                menu: #classListMenu:shifted:.
        classListView window: (0 @ 0 extent: 50 @ 62).
        topView addSubView: classListView toRightOf: systemCategoryListView.

        switchView := self buildInstanceClassSwitchView.
        switchView borderWidth: 1.
        topView addSubView: switchView below: classListView.

        messageCategoryListView := PluggableListView on: self
                list: #messageCategoryList
                selected: #messageCategoryListIndex
                changeSelected: #messageCategoryListIndex:
                menu: #messageCategoryMenu:.
        messageCategoryListView window: (0 @ 0 extent: 50 @ 70).
        topView addSubView: messageCategoryListView toRightOf: classListView.

        messageListView := PluggableListView on: self
                list: #messageList
                selected: #messageListIndex
                changeSelected: #messageListIndex:
                menu: #messageListMenu:shifted:
                keystroke: #messageListKey:from:.
        messageListView window: (0 @ 0 extent: 50 @ 70).
        topView addSubView: messageListView toRightOf: messageCategoryListView.

        Preferences useAnnotationPanes
                ifTrue:
                        [annotationPane _ PluggableTextView on: self
                                text: #annotation accept: nil
                                readSelection: nil menu: nil.
                        annotationPane window: (0 at 0 extent: 200 at self optionalAnnotationHeight).
                        topView addSubView: annotationPane below: packageListView.
                        underPane _ annotationPane.
                        y _ 110 - self optionalAnnotationHeight]
                ifFalse: [
                        underPane _ packageListView.
                        y _ 110].

        Preferences optionalButtons ifTrue:
                [optionalButtonsView _ self buildOptionalButtonsView.
                optionalButtonsView borderWidth: 1.
                topView addSubView: optionalButtonsView below: underPane.
                underPane _ optionalButtonsView.
                y _ y - self optionalButtonHeight].

        browserCodeView := PluggableTextView on: self 
                        text: #contents accept: #contents:notifying:
                        readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
        browserCodeView window: (0 at 0 extent: 200 at y).
        topView addSubView: browserCodeView below: underPane.
        aString ifNotNil: [browserCodeView editString: aString.
                        browserCodeView hasUnacceptedEdits: true].
        ^ topView! !

ChangeSorter removeSelector: #classMenu:!
Browser removeSelector: #classListMenu:!
"Postscript:
Updates all instances of Browser and ChangeSorter with the new class list menu selector."

Browser withAllSubclasses do: [:b |
	b allInstances do: [:bi |
		(bi dependents select: [:d |
			((d isKindOf: PluggableListMorph)
				or: [d isKindOf: PluggableListView])
					and: [(d instVarNamed: 'getMenuSelector') == #classListMenu:]]
		) do: [:plm | plm instVarNamed: 'getMenuSelector' put: #classListMenu:shifted:]]].

ChangeSorter withAllSubclasses do: [:b |
	b allInstances do: [:bi |
		(bi dependents select: [:d |
			((d isKindOf: PluggableListMorph)
				or: [d isKindOf: PluggableListView])
					and: [(d instVarNamed: 'getMenuSelector') == #classMenu:]]
		) do: [:plm | plm instVarNamed: 'getMenuSelector' put: #classMenu:shifted:]]].!



More information about the Squeak-dev mailing list