Menu plugins
Andres Valloud
sqrmax at cvtci.com.ar
Mon Mar 15 18:07:14 UTC 1999
Hi.
This change set includes the plugin manager and standard menu plugins for 3
browsers. It's now possible to change the menues of those browsers on the fly,
and updating such menues is now very easy because each class has a menu plugin
manager that dictates how should the menues be.
Think you'll like this.
Andres.
'From Squeak 2.3 of January 14, 1999 on 15 March 1999 at 3:04:51 pm'!
Browser class
instanceVariableNames: 'menuManager '!
Object subclass: #Cluster
instanceVariableNames: 'contents '
classVariableNames: ''
poolDictionaries: ''
category: 'Interface-Pluggable Menues'!
Object subclass: #MenuPlugin
instanceVariableNames: 'itemList name linesAt '
classVariableNames: ''
poolDictionaries: ''
category: 'Interface-Pluggable Menues'!
Object subclass: #MenuPluginManager
instanceVariableNames: 'menues '
classVariableNames: ''
poolDictionaries: ''
category: 'Interface-Pluggable Menues'!
!Browser methodsFor: 'system category functions' stamp: 'SqR!!!! 3/12/1999 17:31'!
systemCategoryMenu: aMenu
self class menuManager build: #SystemCategory on: aMenu.
^aMenu
"^ aMenu labels:
'find class... (f)
recent classes...
browse all
browse
printOut
fileOut
reorganize
update
add item...
rename...
remove'
lines: #(2 4 6 8)
selections:
#(findClass recent browseAllClasses buildSystemCategoryBrowser
printOutSystemCategory fileOutSystemCategory
editSystemCategories updateSystemCategories
addSystemCategory renameSystemCategory removeSystemCategory )
"! !
!Browser methodsFor: 'class functions' stamp: 'SqR!!!! 3/12/1999 17:55'!
classListMenu: aMenu
self class menuManager build: #ClassList on: aMenu.
^aMenu
"^ aMenu labels:
'browse class
browse full (b)
printOut
fileOut
hierarchy
definition
comment
spawn hierarchy
spawn protocol
inst var refs..
inst var defs..
class var refs...
class vars
class refs (N)
rename...
remove
unsent methods
find method...'
lines: #(4 7 9 11 14 16)
selections:
#(buildClassBrowser browseMethodFull printOutClass fileOutClass
hierarchy editClass editComment
spawnHierarchy spawnProtocol
browseInstVarRefs browseInstVarDefs browseClassVarRefs
browseClassVariables browseClassRefs
renameClass removeClass browseUnusedMethods findMethod)"! !
!Browser methodsFor: 'message category functions' stamp: 'SqR!!!! 3/12/1999 18:12'!
messageCategoryMenu: aMenu
self class menuManager build: #MessageCategory on: aMenu.
^aMenu
"^ aMenu labels:
'browse
printOut
fileOut
reorganize
add item...
rename...
remove
TeX fileOut'
lines: #(3 4 7)
selections:
#(buildMessageCategoryBrowser printOutMessageCategories fileOutMessageCategories
editMessageCategories
addCategory renameCategory removeMessageCategory
texFileOutMessageCategories)"! !
!Browser methodsFor: 'message functions' stamp: 'SqR!!!! 3/15/1999 14:31'!
messageListMenu: aMenu shifted: shifted
self class menuManager
build: (shifted ifTrue: [#ShiftedMessageList] ifFalse: [#MessageList])
on: aMenu.
^aMenu
" ^ shifted ifFalse: [aMenu labels:
'browse full (b)
fileOut
printOut
senders of... (n)
implementors of... (m)
method inheritance
versions (v)
inst var refs...
inst var defs...
class var refs...
class variables
class refs (N)
remove
more...'
lines: #(3 7 12)
selections:
#(browseMethodFull fileOutMessage printOutMessage
browseSendersOfMessages browseMessages methodHierarchy browseVersions
browseInstVarRefs browseInstVarDefs browseClassVarRefs
browseClassVariables browseClassRefs
removeMessage shiftedYellowButtonActivity )]
ifTrue: [aMenu labels: 'browse class hierarchy
browse class
browse method
implementors of sent messages
change sets with this method
inspect instances
inspect subinstances
remove from this browser
annotations in this browser
revert to previous version
remove from current change set
revert and forget
more...'
lines: #(5 7 9 12)
selections: #(classHierarchy browseClass
buildMessageBrowser browseAllMessages findMethodInChangeSets
inspectInstances inspectSubInstances
removeMessageFromBrowser chooseAnnotations
revertToPreviousVersion
removeFromCurrentChanges revertAndForget
unshiftedYellowButtonActivity)]
"! !
!Browser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:21'!
classListPlugin
| classListPlugin |
classListPlugin _ MenuPlugin new.
classListPlugin name: #StdClassListPlugin.
classListPlugin
addItemLabel: 'browse class' action: #buildClassBrowser;
addItemLabel: 'browse full (b)' action: #browseFullMethod;
addItemLabel: 'printOut' action: #printOutClass;
addItemLabel: 'fileOut' action: #fileOutClass;
addItemLabel: 'hierarchy' action: #hierarchy;
addItemLabel: 'definition' action: #editClass;
addItemLabel: 'comment' action: #editComment;
addItemLabel: 'spawn hierarchy' action: #spawnHierarchy;
addItemLabel: 'spawn protocol' action: #spawnProtocol;
addItemLabel: 'inst var refs..' action: #browseInstVarRefs;
addItemLabel: 'inst var defs..' action: #browseInstVarDefs;
addItemLabel: 'class var refs...' action: #browseClassVarRefs;
addItemLabel: 'class vars' action: #browseClassVariables;
addItemLabel: 'class refs (N)' action: #browseClassRefs;
addItemLabel: 'rename...' action: #renameClass;
addItemLabel: 'remove' action: #removeClass;
addItemLabel: 'unsent methods' action: #browseUnusedMethods;
addItemLabel: 'find method...' action: #findMethod.
classListPlugin linesAt: #(4 7 9 11 14 16).
^classListPlugin! !
!Browser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:22'!
messageCategoryPlugin
| messageCategoryPlugin |
messageCategoryPlugin _ MenuPlugin new.
messageCategoryPlugin name: #StdMessageCategoryPlugin.
messageCategoryPlugin
addItemLabel: 'browse' action: #buildMessageCategoryBrowser;
addItemLabel: 'printOut' action: #printOutMessageCategories;
addItemLabel: 'fileOut' action: #fileOutMessageCategories;
addItemLabel: 'reorganize' action: #editMessageCategories;
addItemLabel: 'add item...' action: #addCategory;
addItemLabel: 'rename...' action: #renameCategory;
addItemLabel: 'remove' action: #removeMessageCategory.
messageCategoryPlugin linesAt: #(3 4).
^messageCategoryPlugin! !
!Browser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:24'!
messageListPlugin
| messageListPlugin |
messageListPlugin _ MenuPlugin new.
messageListPlugin name: #StdMessageListPlugin.
messageListPlugin
addItemLabel: 'browse full (b)' action: #browseMethodFull;
addItemLabel: 'fileOut' action: #fileOutMessage;
addItemLabel: 'printOut' action: #printOutMessage;
addItemLabel: 'senders of... (n)' action: #browseSendersOfMessages;
addItemLabel: 'implementors of... (m)' action: #browseMessages;
addItemLabel: 'method inheritance' action: #methodHierarchy;
addItemLabel: 'versions (v)' action: #browseVersions;
addItemLabel: 'inst var refs...' action: #browseInstVarRefs;
addItemLabel: 'inst var defs...' action: #browseInstVarDefs;
addItemLabel: 'class var refs...' action: #browseClassVarRefs;
addItemLabel: 'class variables' action: #browseClassVariables;
addItemLabel: 'class refs (N)' action: #browseClassRefs;
addItemLabel: 'remove' action: #removeMessage;
addItemLabel: 'more...' action: #shiftedYellowButtonActivity.
messageListPlugin linesAt: #(3 7 12).
^messageListPlugin! !
!Browser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:24'!
shiftedMessageListPlugin
| shiftedMessageListPlugin |
shiftedMessageListPlugin _ MenuPlugin new.
shiftedMessageListPlugin name: #StdShiftedMessageList.
shiftedMessageListPlugin
addItemLabel: 'browse class hierarchy' action: #classHierarchy;
addItemLabel: 'browse class' action: #browseClass;
addItemLabel: 'browse method' action: #buildMessageBrowser;
addItemLabel: 'implementors of sent messages' action: #browseAllMessages;
addItemLabel: 'change sets with this method' action: #findMethodInChangeSets;
addItemLabel: 'inspect instances' action: #inspectInstances;
addItemLabel: 'inspect subinstances' action: #inspectSubInstances;
addItemLabel: 'remove from this browser' action: #removeMessageFromBrowser;
addItemLabel: 'annotations in this browser' action: #chooseAnnotations;
addItemLabel: 'revert to previous version' action: #revertToPreviousVersion;
addItemLabel: 'remove from current change set' action: #removeFromCurrentChanges;
addItemLabel: 'revert and forget' action: #revertAndForget;
addItemLabel: 'more...' action: #unshiftedYellowButtonActivity.
shiftedMessageListPlugin linesAt: #(5 7 9 12).
^shiftedMessageListPlugin! !
!Browser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:20'!
systemCategoryPlugin
| systemCategoryPlugin |
systemCategoryPlugin _ MenuPlugin new.
systemCategoryPlugin name: #StdSystemCategoryPlugin.
systemCategoryPlugin
addItemLabel: 'find class... (f)' action: #findClass;
addItemLabel: 'recent classes... ' action: #recent;
addItemLabel: 'browse all' action: #browseAllClasses;
addItemLabel: 'browse' action: #buildSystemCategoryBrowser;
addItemLabel: 'printOut' action: #printOutSystemCategory;
addItemLabel: 'fileOut' action: #fileOutSystemCategory;
addItemLabel: 'reorganize' action: #editSystemCategories;
addItemLabel: 'update' action: #updateSystemCategories;
addItemLabel: 'add item...' action: #addSystemCategory;
addItemLabel: 'rename...' action: #renameSystemCategory;
addItemLabel: 'remove' action: #removeSystemCategory.
systemCategoryPlugin linesAt: #(2 4 6 8).
^systemCategoryPlugin! !
!Browser class methodsFor: 'class initialization' stamp: 'SqR!!!! 3/15/1999 14:23'!
initialize
"Browser initialize"
| |
RecentClasses _ OrderedCollection new.
menuManager _ MenuPluginManager new.
menuManager addMenu: #SystemCategory.
menuManager menu: #SystemCategory addPlugin: self systemCategoryPlugin.
menuManager addMenu: #ClassList.
menuManager menu: #ClassList addPlugin: self classListPlugin.
menuManager addMenu: #MessageCategory.
menuManager menu: #MessageCategory addPlugin: self messageCategoryPlugin.
menuManager addMenu: #MessageList.
menuManager menu: #MessageList addPlugin: self messageListPlugin.
menuManager addMenu: #ShiftedMessageList.
menuManager menu: #ShiftedMessageList addPlugin: self shiftedMessageListPlugin! !
!Browser class methodsFor: 'class initialization' stamp: 'SqR!!!! 3/12/1999 17:29'!
menuManager
^menuManager! !
!Cluster reorganize!
('accessing' doesNotUnderstand:)
!
!Cluster methodsFor: 'accessing' stamp: 'SqR!!!! 3/9/1999 22:51'!
doesNotUnderstand: aMessage
| selector |
"Not initialized, huh?"
contents isNil ifTrue: [contents _ Dictionary new].
"Check unary selector"
aMessage arguments isEmpty ifTrue: [^contents at: aMessage selector].
"Check 1 argument"
aMessage arguments size = 1 ifTrue:
[
selector _ aMessage selector.
"Skip binary messages"
selector last = $: ifFalse: [^super doesNotUnderstand: aMessage].
selector _ (selector copyFrom: 1 to: selector size - 1) asSymbol.
^contents at: selector put: aMessage arguments first.
].
"The rest, well thank you"
^super doesNotUnderstand: aMessage! !
!Cluster class reorganize!
('as yet unclassified')
!
!Collection methodsFor: 'enumerating' stamp: 'SqR 10/28/97 00:14'!
do: aBlock andBetweenDo: aSeparatorBlock
"Evaluate aBlock for each element of the receiver, evaluating aSeparatorBlock
between each pair of evaluations of aBlock"
| first |
first := true.
self do:
[:each |
first
ifTrue: [first := false]
ifFalse: [aSeparatorBlock value].
aBlock value: each.
]! !
!FileContentsBrowser methodsFor: 'menus' stamp: 'SqR!!!! 3/15/1999 14:41'!
classListMenu: aMenu
^super classListMenu: aMenu
" ^ aMenu
labels:
'definition
comment
class refs
fileIn
fileOut
rename...
remove
remove existing'
lines: #(2 3 5 7)
selections: #(editClass editComment browseClassRefs fileInClass fileOutClass renameClass removeClass removeUnmodifiedCategories)
"! !
!FileContentsBrowser methodsFor: 'menus' stamp: 'SqR!!!! 3/15/1999 14:44'!
messageCategoryMenu: aMenu
^super messageCategoryMenu: aMenu
" ^ aMenu
labels:
'fileIn
fileOut
reorganize
add item...
rename...
remove
remove existing'
lines: #(2 3 6)
selections: #(fileInMessageCategories fileOutMessageCategories editMessageCategories addCategory renameCategory removeMessageCategory removeUnmodifiedMethods)"! !
!FileContentsBrowser methodsFor: 'menus' stamp: 'SqR!!!! 3/15/1999 14:55'!
messageListMenu: aMenu
self class menuManager build: #MessageList on: aMenu.
^aMenu
" ^ aMenu
labels:
'fileIn
fileOut
senders
implementors
versions
remove'
lines: #(2 5)
selections: #(fileInMessage fileOutMessage
browseSenders browseImplementors browseVersions
removeMessage)."! !
!FileContentsBrowser methodsFor: 'menus' stamp: 'SqR!!!! 3/15/1999 14:48'!
packageListMenu: aMenu
self class menuManager build: #PackageList on: aMenu.
^aMenu
" ^ aMenu
labels:
'find class...
fileIn
fileOut
remove
remove existing'
lines: #(1 3 4)
selections: #(findClass fileInPackage fileOutPackage removePackage removeUnmodifiedClasses)"! !
!FileContentsBrowser class methodsFor: 'initialization' stamp: 'SqR!!!! 3/15/1999 14:53'!
initialize
super initialize.
menuManager addMenu: #PackageList.
menuManager menu: #PackageList addPlugin: self packageListPlugin! !
!FileContentsBrowser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:38'!
classListPlugin
| classListPlugin |
classListPlugin _ MenuPlugin new.
classListPlugin name: #StdFileClassListMenu.
classListPlugin
addItemLabel: 'definition' action: #editClass;
addItemLabel: 'comment' action: #editComment;
addItemLabel: 'class refs' action: #browseClassRefs;
addItemLabel: 'fileIn' action: #fileInClass;
addItemLabel: 'fileOut' action: #fileOutClass;
addItemLabel: 'rename...' action: #renameClass;
addItemLabel: 'remove' action: #removeClass;
addItemLabel: 'remove existing' action: #removeUnmodifiedCategories.
classListPlugin linesAt: #(2 3 5 7).
^classListPlugin! !
!FileContentsBrowser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:44'!
messageCategoryPlugin
| messageCategoryPlugin |
messageCategoryPlugin _ MenuPlugin new.
messageCategoryPlugin name: #StdFileMessageCategory.
messageCategoryPlugin
addItemLabel: 'fileIn' action: #fileInMessageCategories;
addItemLabel: 'fileOut' action: #fileOutMessageCategories;
addItemLabel: 'reorganize' action: #editMessageCategories;
addItemLabel: 'add item...' action: #addCategory;
addItemLabel: 'rename...' action: #renameCategory;
addItemLabel: 'remove' action: #removeMessageCategory;
addItemLabel: 'remove existing' action: #removeUnmodifiedMethods.
messageCategoryPlugin linesAt: #(2 3 6).
^messageCategoryPlugin! !
!FileContentsBrowser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:46'!
messageListPlugin
| messageListPlugin |
messageListPlugin _ MenuPlugin new.
messageListPlugin name: #StdFileMessageList.
messageListPlugin
addItemLabel: 'fileIn' action: #fileInMessage;
addItemLabel: 'fileOut' action: #fileOutMessage;
addItemLabel: 'senders' action: #browseSenders;
addItemLabel: 'implementors' action: #browseImplementors;
addItemLabel: 'versions' action: #browseVersions;
addItemLabel: 'remove' action: #removeMessage.
messageListPlugin linesAt: #(2 5).
^messageListPlugin! !
!FileContentsBrowser class methodsFor: 'menu plugins' stamp: 'SqR!!!! 3/15/1999 14:51'!
packageListPlugin
| packageListPlugin |
packageListPlugin _ MenuPlugin new.
packageListPlugin name: #StdFilePackageList.
packageListPlugin
addItemLabel: 'find class...' action: #findClass;
addItemLabel: 'fileIn' action: #fileInPackage;
addItemLabel: 'fileOut' action: #fileOutPackage;
addItemLabel: 'remove' action: #removePackage;
addItemLabel: 'remove existing' action: #removeUnmodifiedClasses.
packageListPlugin linesAt: #(1 3 4).
^packageListPlugin! !
!MenuPlugin reorganize!
('accessing' addItemLabel:action: itemList linesAt linesAt: name name: removeItemAt:)
('printing' printOn:)
('private' initialize)
!
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/12/1999 17:31'!
addItemLabel: aLabel action: anAction
itemList add:
(
Cluster new
label: aLabel;
action: anAction;
yourself
)! !
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/9/1999 22:53'!
itemList
^itemList! !
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/12/1999 15:38'!
linesAt
^linesAt! !
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/12/1999 15:38'!
linesAt: anArray
linesAt _ anArray! !
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/9/1999 22:50'!
name
^name! !
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/9/1999 22:50'!
name: aString
name _ aString! !
!MenuPlugin methodsFor: 'accessing' stamp: 'SqR!!!! 3/9/1999 22:53'!
removeItemAt: anInteger
itemList removeAt: anInteger! !
!MenuPlugin methodsFor: 'printing' stamp: 'SqR!!!! 3/12/1999 17:36'!
printOn: aStream
aStream nextPutAll: self class name.
aStream nextPut: $(.
name printOn: aStream.
aStream nextPut: $)! !
!MenuPlugin methodsFor: 'private' stamp: 'SqR!!!! 3/12/1999 15:38'!
initialize
itemList _ OrderedCollection new.
linesAt _ Array new! !
!MenuPlugin class reorganize!
('instance creation' new)
!
!MenuPlugin class methodsFor: 'instance creation' stamp: 'SqR!!!! 3/9/1999 22:49'!
new
^super new initialize! !
!MenuPluginManager reorganize!
('menu filling' menu:addFirstPlugin: menu:addPlugin: menu:removePlugin: pluginsInMenu:)
('menu management' addMenu: build:on: buildPlugin:on: menues removeMenu:)
('printing' printOn:)
('private' initialize)
!
!MenuPluginManager methodsFor: 'menu filling' stamp: 'SqR!!!! 3/12/1999 17:09'!
menu: aSymbol addFirstPlugin: aMenuPlugin
(menues at: aSymbol) add: aMenuPlugin beforeIndex: 0! !
!MenuPluginManager methodsFor: 'menu filling' stamp: 'SqR!!!! 3/12/1999 15:57'!
menu: aSymbol addPlugin: aMenuPlugin
(menues at: aSymbol) add: aMenuPlugin! !
!MenuPluginManager methodsFor: 'menu filling' stamp: 'SqR!!!! 3/12/1999 15:58'!
menu: aSymbol removePlugin: aMenuPluginName
menues at: aSymbol put:
((menues at: aSymbol) reject:
[:one | one name = aMenuPluginName])! !
!MenuPluginManager methodsFor: 'menu filling' stamp: 'SqR!!!! 3/12/1999 15:58'!
pluginsInMenu: aMenuName
(menues at: aMenuName) collect: [:each | each name]! !
!MenuPluginManager methodsFor: 'menu management' stamp: 'SqR!!!! 3/12/1999 15:55'!
addMenu: aSymbol
(menues keys includes: aSymbol) ifTrue:
[^self notify: 'Menu already exists'].
menues at: aSymbol put: OrderedCollection new! !
!MenuPluginManager methodsFor: 'menu management' stamp: 'SqR!!!! 3/12/1999 18:06'!
build: aMenuName on: aMenu
"Build aMenu from the plugin list at aMenuName"
(menues at: aMenuName)
do: [:each | self buildPlugin: each on: aMenu]
andBetweenDo: [aMenu addLine]! !
!MenuPluginManager methodsFor: 'menu management' stamp: 'SqR!!!! 3/12/1999 16:08'!
buildPlugin: aMenuPlugin on: aMenu
"Build aMenuPlugin on aMenu"
| index |
index _ 1.
aMenuPlugin itemList do:
[:each |
aMenu add: each label action: each action.
(aMenuPlugin linesAt includes: index) ifTrue:
[aMenu addLine].
index _ index + 1.
]! !
!MenuPluginManager methodsFor: 'menu management' stamp: 'SqR!!!! 3/12/1999 15:47'!
menues
^menues keys! !
!MenuPluginManager methodsFor: 'menu management' stamp: 'SqR!!!! 3/12/1999 15:56'!
removeMenu: aSymbol
menues removeKey: aSymbol ifAbsent:
[self inform: 'The menu ', aSymbol, ' does not exist']! !
!MenuPluginManager methodsFor: 'printing' stamp: 'SqR!!!! 3/12/1999 17:38'!
printOn: aStream
aStream nextPutAll: self class name.
self menues asArray printOn: aStream! !
!MenuPluginManager methodsFor: 'private' stamp: 'SqR!!!! 3/12/1999 15:44'!
initialize
menues _ Dictionary new! !
!MenuPluginManager class reorganize!
('instance creation' new)
!
!MenuPluginManager class methodsFor: 'instance creation' stamp: 'SqR!!!! 3/12/1999 15:44'!
new
^super new initialize! !
Browser initialize!
Cluster removeSelector: #initialize!
Cluster class removeSelector: #new!
FileContentsBrowser initialize!
MenuPlugin removeSelector: #addItemLabel:selection:!
Smalltalk removeClassNamed: #MenuItem!
Browser initialize.
HierarchyBrowser initialize.
FileContentsBrowser initialize.
self inform: 'Pluggable Menu Structure added to the system.'!
More information about the Squeak-dev
mailing list
|