class: MenuEditor
added:5 methods
changed:
#doSave
#editMenu
#generateMenuSpec
#generateMenuSpecString
new menu function: convert a regular menu item to a linked menu
--- a/MenuEditor.st Tue Jul 01 13:00:06 2014 +0200
+++ b/MenuEditor.st Tue Jul 01 22:02:18 2014 +0200
@@ -694,94 +694,104 @@
^
#(Menu
- (
- (MenuItem
- activeHelpKey: editCut
- enabled: hasSelectionChannel
- label: 'Cut'
- itemValue: doCut
- translateLabel: true
- shortcutKey: Cut
- )
- (MenuItem
- activeHelpKey: editCopy
- enabled: hasSelectionChannel
- label: 'Copy'
- itemValue: doCopy
- translateLabel: true
- shortcutKey: Copy
- )
- (MenuItem
- activeHelpKey: editPaste
- enabled: canPasteHolder
- label: 'Paste'
- itemValue: doPaste
- translateLabel: true
- shortcutKey: Paste
- )
- (MenuItem
- activeHelpKey: editDelete
- enabled: hasSelectionChannel
- label: 'Delete'
- itemValue: doDelete
- translateLabel: true
- isVisible: false
- )
- (MenuItem
- label: '-'
- )
- (MenuItem
- activeHelpKey: editMoveUp
- enabled: enableMovingUpOrDownHolder
- label: 'Move Up'
- itemValue: doMoveUpOrDown:
- translateLabel: true
- startGroup: right
- shortcutKey: CtrlCursorUp
- labelImage: (ResourceRetriever Icon upIcon 'Move Up')
- argument: up
- )
- (MenuItem
- activeHelpKey: editMoveDown
- enabled: enableMovingUpOrDownHolder
- label: 'Move Down'
- itemValue: doMoveUpOrDown:
- translateLabel: true
- shortcutKey: CtrlCursorDown
- labelImage: (ResourceRetriever Icon downIcon 'Move Down')
- argument: down
- )
- (MenuItem
- activeHelpKey: editMoveIn
- enabled: enableMovingInHolder
- label: 'Move Into Next'
- itemValue: doMoveIn:
- translateLabel: true
- shortcutKey: CtrlCursorRight
- labelImage: (ResourceRetriever Icon downRightIcon 'Move Into Next')
- argument: inNext
- )
- (MenuItem
- activeHelpKey: editMoveInAbove
- enabled: enableMovingInAboveHolder
- label: 'Move Into Previous'
- itemValue: doMoveIn:
- translateLabel: true
- labelImage: (ResourceRetriever Icon upRightIcon 'Move Into Previous' )
- argument: inPrev
- )
- (MenuItem
- activeHelpKey: editMoveOut
- enabled: enableMovingOutHolder
- label: 'Move Out'
- itemValue: doMoveOut
- translateLabel: true
- shortcutKey: CtrlCursorLeft
- labelImage: (ResourceRetriever Icon leftDownIcon 'Move Out' )
- )
- )
- nil
- nil
+ (
+ (MenuItem
+ activeHelpKey: editCut
+ enabled: hasSelectionChannel
+ label: 'Cut'
+ itemValue: doCut
+ translateLabel: true
+ shortcutKey: Cut
+ )
+ (MenuItem
+ activeHelpKey: editCopy
+ enabled: hasSelectionChannel
+ label: 'Copy'
+ itemValue: doCopy
+ translateLabel: true
+ shortcutKey: Copy
+ )
+ (MenuItem
+ activeHelpKey: editPaste
+ enabled: canPasteHolder
+ label: 'Paste'
+ itemValue: doPaste
+ translateLabel: true
+ shortcutKey: Paste
+ )
+ (MenuItem
+ activeHelpKey: editDelete
+ enabled: hasSelectionChannel
+ label: 'Delete'
+ itemValue: doDelete
+ translateLabel: true
+ isVisible: false
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ activeHelpKey: makeLinkedMenu
+ enabled: hasNonLinkedMenuSelectedHolder
+ label: 'Make Linked Menu...'
+ itemValue: doMakeLinkedMenu
+ translateLabel: true
+ )
+ (MenuItem
+ label: '-'
+ )
+ (MenuItem
+ activeHelpKey: editMoveUp
+ enabled: enableMovingUpOrDownHolder
+ label: 'Move Up'
+ itemValue: doMoveUpOrDown:
+ translateLabel: true
+ startGroup: right
+ shortcutKey: CtrlCursorUp
+ labelImage: (ResourceRetriever Icon upIcon 'Move Up')
+ argument: up
+ )
+ (MenuItem
+ activeHelpKey: editMoveDown
+ enabled: enableMovingUpOrDownHolder
+ label: 'Move Down'
+ itemValue: doMoveUpOrDown:
+ translateLabel: true
+ shortcutKey: CtrlCursorDown
+ labelImage: (ResourceRetriever Icon downIcon 'Move Down')
+ argument: down
+ )
+ (MenuItem
+ activeHelpKey: editMoveIn
+ enabled: enableMovingInHolder
+ label: 'Move Into Next'
+ itemValue: doMoveIn:
+ translateLabel: true
+ shortcutKey: CtrlCursorRight
+ labelImage: (ResourceRetriever Icon downRightIcon 'Move Into Next')
+ argument: inNext
+ )
+ (MenuItem
+ activeHelpKey: editMoveInAbove
+ enabled: enableMovingInAboveHolder
+ label: 'Move Into Previous'
+ itemValue: doMoveIn:
+ translateLabel: true
+ labelImage: (ResourceRetriever Icon upRightIcon 'Move Into Previous' )
+ argument: inPrev
+ )
+ (MenuItem
+ activeHelpKey: editMoveOut
+ enabled: enableMovingOutHolder
+ label: 'Move Out'
+ itemValue: doMoveOut
+ translateLabel: true
+ shortcutKey: CtrlCursorLeft
+ labelImage: (ResourceRetriever Icon leftDownIcon 'Move Out' )
+ )
+ )
+ nil
+ nil
)
!
@@ -1755,6 +1765,21 @@
"Modified: / 08-03-2007 / 22:59:42 / cg"
!
+hasNonLinkedMenuSelectedHolder
+ "boolean holder, true if a single non linked menu item is selected
+ "
+ ^ BlockValue
+ with:[:m |
+ |items|
+
+ items := self selectionHolder value.
+ (items size == 1)
+ and:[items first isKindOfNonLinkedMenu
+ and:[items first isRootItem not]]
+ ]
+ argument:(self selectionHolder)
+!
+
hasSelectionChannel
"boolean holder, true if any item is selected
"
@@ -2425,9 +2450,15 @@
generateMenuSpec
"generate and returns the current menu spec or nil"
+ ^ self generateMenuSpecFor:listOfItems root
+!
+
+generateMenuSpecFor:aMenuItem
+ "generate and returns a menu spec or nil"
+
|menu|
- menu := listOfItems root submenu.
+ menu := aMenuItem submenu.
menu isNil ifTrue:[^ nil].
^ menu literalArrayEncoding.
@@ -2436,9 +2467,15 @@
generateMenuSpecString
"generate and returns the current menu spec as string or nil"
+ ^ self generateMenuSpecStringFor:listOfItems root
+!
+
+generateMenuSpecStringFor:aMenuItem
+ "generate and returns the current menu spec as string or nil"
+
|menu specStream|
- menu := self generateMenuSpec.
+ menu := self generateMenuSpecFor:aMenuItem.
menu isNil ifTrue:[^ nil].
specStream := WriteStream on:String new.
@@ -2711,6 +2748,55 @@
!MenuEditor methodsFor:'user actions-building'!
+compileSpecMethodFor:aMenuItem selector:specSelector
+ "save current editing menu to
+ class: specClass
+ selector: specSelector
+ "
+ |cls specCode mthd category s|
+
+ specCode := self generateMenuSpecStringFor:aMenuItem.
+ specCode isNil ifTrue:[^ nil].
+
+ cls := self resolveName:specClass.
+
+ "/ if that method already exists, do not overwrite the category
+
+ category := 'menu specs'.
+ (mthd := cls theMetaclass compiledMethodAt:specSelector) notNil ifTrue:[
+ category := mthd category.
+ ].
+
+ s := '' writeStream.
+
+ s nextPutChunkSeparator;
+ nextPutAll:(cls name);
+ nextPutAll:' class methodsFor:';
+ nextPutAll:category storeString;
+ nextPutChunkSeparator;
+ cr; cr;
+ nextPutAll:specSelector;
+ cr;
+ nextPutAllAsChunk:(self class codeGenerationComment) withCRs;
+ cr; cr;
+ nextPutLine:' "';
+ nextPutLine:(' MenuEditor new openOnClass:' , cls name , ' andSelector:#' , specSelector);
+ nextPutLine:(' (Menu new fromLiteralArrayEncoding:(' , cls name , ' ' , specSelector , ')) startUp');
+ nextPutLine:' "';
+ cr;
+ nextPutLine:' <resource: #menu>';
+ cr;
+ nextPutAll:' ^ ';
+ nextChunkPut:specCode;
+ space;
+ nextPutChunkSeparator;
+ cr.
+
+ Class packageQuerySignal answer:cls package do:[
+ (ReadStream on:s contents) fileIn.
+ ].
+!
+
doChooseAMenu
"pick a menu and edit its spec method"
@@ -2796,8 +2882,6 @@
class: specClass
selector: specSelector
"
- |cls specCode mthd category s|
-
self isEditingSpecOnly ifTrue:[
savedSpec := self generateMenuSpec.
hasSaved := true.
@@ -2806,46 +2890,8 @@
].
super doSave ifFalse: [^nil].
- specCode := self generateMenuSpecString.
- specCode isNil ifTrue:[^ nil].
-
- cls := self resolveName:specClass.
-
- "/ if that method already exists, do not overwrite the category
-
- category := 'menu specs'.
- (mthd := cls class compiledMethodAt:specSelector) notNil ifTrue:[
- category := mthd category.
- ].
-
- s := '' writeStream.
-
- s nextPutChunkSeparator;
- nextPutAll:(cls name);
- nextPutAll:' class methodsFor:';
- nextPutAll:category storeString;
- nextPutChunkSeparator;
- cr; cr;
- nextPutAll:specSelector;
- cr;
- nextPutAllAsChunk:(self class codeGenerationComment) withCRs;
- cr; cr;
- nextPutLine:' "';
- nextPutLine:(' MenuEditor new openOnClass:' , cls name , ' andSelector:#' , specSelector);
- nextPutLine:(' (Menu new fromLiteralArrayEncoding:(' , cls name , ' ' , specSelector , ')) startUp');
- nextPutLine:' "';
- cr;
- nextPutLine:' <resource: #menu>';
- cr;
- nextPutAll:' ^ ';
- nextChunkPut:specCode;
- space;
- nextPutChunkSeparator;
- cr.
-
- Class packageQuerySignal answer:cls package do:[
- (ReadStream on:s contents) fileIn.
- ].
+
+ self compileSpecMethodFor:listOfItems root selector:specSelector.
self isStandAlone ifTrue:[
self helpTool doSave
].
@@ -3067,6 +3113,41 @@
!MenuEditor methodsFor:'user actions-hierarchy'!
+doMakeLinkedMenu
+ "the selected item must be a regular submenu.
+ create a new menuspec for it,
+ and chenge the item to a linke menu item."
+
+ |cls subSelector oldMenuItem newLinkedMenuItem index|
+
+ oldMenuItem := self selectionHolder value first.
+
+ subSelector := Dialog
+ request:'Name of spec method for submenu:'
+ initialAnswer:((oldMenuItem label reject:[:ch | ch isLetterOrDigit not]),'MenuSpec') asLowercaseFirst.
+ subSelector isEmptyOrNil ifTrue:[^ self].
+ subSelector := subSelector asSymbol.
+
+ cls := self resolveName:specClass.
+ (cls theMetaclass compiledMethodAt:subSelector) notNil ifTrue:[
+ (Dialog confirm:'Overwrite existing spec?') ifFalse:[^ self].
+ ].
+
+ self compileSpecMethodFor:oldMenuItem selector:subSelector.
+
+ newLinkedMenuItem := LinkedMenuItem new.
+ newLinkedMenuItem submenuChannel:subSelector.
+ newLinkedMenuItem menuItem nameKey:(oldMenuItem menuItem nameKey).
+ newLinkedMenuItem menuItem label:oldMenuItem menuItem label.
+ newLinkedMenuItem menuItem rawLabel:oldMenuItem menuItem rawLabel.
+ newLinkedMenuItem menuItem translateLabel:(oldMenuItem menuItem translateLabel).
+
+ index := oldMenuItem parent identityIndexOf:oldMenuItem.
+ oldMenuItem parent at:index put:newLinkedMenuItem.
+
+ self selectedItem:newLinkedMenuItem.
+!
+
doMoveDown
"move selected item down"
@@ -3918,12 +3999,24 @@
^ parent isAction
!
+isKindOfLinkedMenu
+ "returns true if the item is a Linked Menu
+ "
+ ^ false
+!
+
isKindOfMenu
"returns true if the item is a Linked Menu or Menu
"
^ false
!
+isKindOfNonLinkedMenu
+ "returns true if the item is a Linked Menu
+ "
+ ^ false
+!
+
isMenuEditItem
^ true
!
@@ -5420,6 +5513,10 @@
!MenuEditor::LinkedMenuItem methodsFor:'queries'!
+isKindOfLinkedMenu
+ ^ true
+!
+
isKindOfMenu
^ true
! !
@@ -5902,6 +5999,10 @@
isKindOfMenu
^ true
+!
+
+isKindOfNonLinkedMenu
+ ^ true
! !
!MenuEditor::RootItem class methodsFor:'defaults'!