class: MenuEditor
authorClaus Gittinger <cg@exept.de>
Tue, 01 Jul 2014 22:02:18 +0200
changeset 3135 ddfd8044f87c
parent 3134 e09d9f88442c
child 3136 146b6f9e139c
class: MenuEditor added:5 methods changed: #doSave #editMenu #generateMenuSpec #generateMenuSpecString new menu function: convert a regular menu item to a linked menu
MenuEditor.st
--- 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'!