# HG changeset patch # User Claus Gittinger # Date 1202739718 -3600 # Node ID b0f6890e73cf74ce54164f95894d75350806f260 # Parent e09282d74ec3ab03b2ef1f622cf63762b04674f1 code generation in CodegeneratorTool diff -r e09282d74ec3 -r b0f6890e73cf MenuEditor.st --- a/MenuEditor.st Mon Feb 11 15:21:20 2008 +0100 +++ b/MenuEditor.st Mon Feb 11 15:21:58 2008 +0100 @@ -630,75 +630,75 @@ ^ #(Menu - ( - (MenuItem - activeHelpKey: addMenuSeparator - label: 'Separator' - itemValue: doCreateSep - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconSeparator '') - ) - (MenuItem - activeHelpKey: addMenuItem - label: 'Item' - itemValue: doCreateItem - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconItem '') - ) - (MenuItem - activeHelpKey: addMenuSliceItem - label: 'Menu Slice' - itemValue: doCreateMenuSliceItem - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconSliceMenu '') - ) - (MenuItem - activeHelpKey: addMenuItem - label: 'Menu' - itemValue: doCreateMenu - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconMenu '') - ) - (MenuItem - activeHelpKey: addSubMenuLink - label: 'Linked Menu' - itemValue: doCreateLinkedMenu - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconLinkedMenu '') - ) - (MenuItem - label: '-' - ) - (MenuItem - activeHelpKey: addDelayedMenu - enabled: canCreateDelayedMenuChannel - label: 'Delayed Menu' - itemValue: doCreateDelayedMenu: - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconDelayedMenu '') - argument: menu - ) - (MenuItem - activeHelpKey: addDelayedSubMenuLink - enabled: canCreateDelayedMenuChannel - label: 'Delayed Linked Menu' - itemValue: doCreateDelayedMenu: - translateLabel: true - labelImage: (ResourceRetriever #'MenuEditor::Item' iconDelayedLinkedMenu '') - argument: linkedMenu - ) - (MenuItem - label: '-' - ) - (MenuItem - label: 'Standard Menus' - translateLabel: true - submenuChannel: standardMenus - keepLinkedMenu: true - ) - ) - nil - nil + ( + (MenuItem + activeHelpKey: addMenuSeparator + label: 'Separator' + itemValue: doCreateSep + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconSeparator '') + ) + (MenuItem + activeHelpKey: addMenuItem + label: 'Item' + itemValue: doCreateItem + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconItem '') + ) + (MenuItem + activeHelpKey: addMenuSliceItem + label: 'Menu Slice' + itemValue: doCreateMenuSliceItem + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconSliceMenu '') + ) + (MenuItem + activeHelpKey: addMenuItem + label: 'Menu' + itemValue: doCreateMenu + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconMenu '') + ) + (MenuItem + activeHelpKey: addSubMenuLink + label: 'Linked Menu' + itemValue: doCreateLinkedMenu + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconLinkedMenu '') + ) + (MenuItem + label: '-' + ) + (MenuItem + activeHelpKey: addDelayedMenu + enabled: canCreateDelayedMenuChannel + label: 'Delayed Menu' + itemValue: doCreateDelayedMenu: + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconDelayedMenu '') + argument: menu + ) + (MenuItem + activeHelpKey: addDelayedSubMenuLink + enabled: canCreateDelayedMenuChannel + label: 'Delayed Linked Menu' + itemValue: doCreateDelayedMenu: + translateLabel: true + labelImage: (ResourceRetriever #'MenuEditor::Item' iconDelayedLinkedMenu '') + argument: linkedMenu + ) + (MenuItem + label: '-' + ) + (MenuItem + label: 'Standard Menus' + translateLabel: true + submenuChannel: standardMenus + keepLinkedMenu: true + ) + ) +"/ nil +"/ nil ) ! @@ -716,97 +716,96 @@ - ^ + ^ #(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 - argument: up - shortcutKey: CtrlCursorUp - labelImage: (ResourceRetriever Icon upIcon 'Move Up') -"/ labelImage: (ResourceRetriever ToolbarIconLibrary up16x16Icon 'Move 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: 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 ) ! @@ -1977,108 +1976,6 @@ ]. ! ! -!MenuEditor methodsFor:'code generation'! - -createActionMethodFor:aSelector in:aClass category:aCategory redefine:redefine - |alreadyInSuperclass numArgs method code| - - (aClass includesSelector:aSelector) ifTrue:[ - ^ nil - ]. - - alreadyInSuperclass := aClass superclass canUnderstand:aSelector. - - (alreadyInSuperclass and:[redefine not]) ifTrue:[ - ^ nil - ]. - - numArgs := aSelector numArgs. - - numArgs == 1 ifTrue:[ - method := aSelector, 'anArgument'. - ] ifFalse:[ - numArgs == 0 ifTrue:[ - method := aSelector - ] ifFalse:[ - method := ''. - aSelector keywords keysAndValuesDo:[:i :key| - method := method, key, 'arg', i printString, ' '. - ]. - ] - ]. - - code := '%1 - "automatically generated by UIEditor ..." - - "*** the code below performs no action" - "*** (except for some feedback on the Transcript)" - "*** Please change as required and accept in the browser." - "*** (and replace this comment by something more useful ;-)" - - "action to be added ..." - - Transcript showCR:self class name, '': action for #%2 ...''. -' bindWith:method with:aSelector. - - alreadyInSuperclass ifTrue:[ - code := code, (('\ super %1\' bindWith:method) withCRs). - ]. - CodeGeneratorTool compile:code forClass:aClass inCategory:(aCategory ? 'actions'). - ^ code -! - -createAspectMethodFor:anAspect in:aClass category:aCategory redefine:redefine - |alreadyInSuperclass numArgs method code text| - - (aClass includesSelector:anAspect) ifTrue:[ - ^ nil - ]. - - alreadyInSuperclass := aClass superclass canUnderstand:anAspect. - - (alreadyInSuperclass and:[redefine not]) ifTrue:[ - ^ nil - ]. - - numArgs := anAspect numArgs. - - numArgs == 1 ifTrue:[ - method := anAspect, 'anArgument'. - ] ifFalse:[ - numArgs == 0 ifTrue:[ - method := anAspect - ] ifFalse:[ - method := ''. - anAspect keywords keysAndValuesDo:[:i :key| - method := method, key, 'arg', i printString, ' '. - ]. - ] - ]. - - code := '%1 - "automatically generated by UIEditor ..." - - "*** the code below creates a default model when invoked" - "*** (which may not be the one you wanted)" - "*** Please change as required and accept in the browser." - "*** (and replace this comment by something more useful ;-)" - - "aspect to be added ..." - - Transcript showCR:self class name, '': aspect for #%2 ...''. - -' bindWith:method with:anAspect. - - alreadyInSuperclass ifTrue:[ - text := ' ^ super %1\' bindWith:method. - ] ifFalse:[ - text := ' ^ builder valueAspectFor:#''%1'' initialValue:true\' bindWith:anAspect. - ]. - code := code, (text withCRs). - CodeGeneratorTool compile:code forClass:aClass inCategory:(aCategory ? 'actions'). - ^ code -! ! - !MenuEditor methodsFor:'defaults'! aboutImage @@ -2241,7 +2138,7 @@ "filter keyboard edit-events typed into the listOfItemsView. Return true, if I have eaten the event" - |evView inView rawKey key| + |evView rawKey key| anEvent isKeyPressEvent ifFalse:[^ false]. @@ -2250,8 +2147,7 @@ "/ only handle keyboard events for the left item list "/ (otherwise, copy-paste would not work in the editFields on the right) - inView := evView isSameOrComponentOf:listOfItemsView. - inView ifFalse:[^ false]. + (evView isSameOrComponentOf:listOfItemsView) ifFalse:[^ false]. key := anEvent key. rawKey := anEvent rawKey. @@ -2364,6 +2260,56 @@ self windowGroup addPreEventHook:self. ! ! +!MenuEditor methodsFor:'menus-dynamic'! + +submenuTest + "returns a menu on the current editing menu + " + |menu indication choice submenu retriever| + + menu := listOfItems root submenu. + menu isNil ifTrue:[^ nil ]. + + menu allItemsDo:[:anItem| + anItem ignoreShortcutKeys:true. + anItem isVisible:true. + anItem enabled:true. + anItem translateLabel:false. + + anItem itemValue notNil ifTrue:[ + anItem itemValue:[ Transcript showCR:(anItem label) ]. + ]. + anItem indication notNil ifTrue:[ + indication isNil ifTrue:[ indication := true asValue ]. + anItem indication:indication + ]. + anItem choice notNil ifTrue:[ + choice isNil ifTrue:[ choice := anItem choiceValue asValue ]. + anItem choice:choice + ]. + anItem isMenuSlice ifTrue:[ + anItem submenuChannel:nil. + anItem label:'... Slice Menu ...'. + ]. + anItem submenuChannel notNil ifTrue:[ + anItem submenuChannel:nil. + anItem submenu isNil ifTrue:[ + submenu isNil ifTrue:[ + submenu := Menu new. + submenu addItem:(MenuItem labeled:'Linked Menu...'). + ]. + anItem submenu:submenu. + ]. + ]. + retriever := anItem resourceRetriever. + retriever notNil ifTrue:[ + retriever labelText notNil ifTrue:[ retriever labelText:(anItem label) ] + ]. + ]. + menu findGuiResourcesIn:(self resolveName:specClass). + ^ menu +! ! + !MenuEditor methodsFor:'private'! addAndSelectValueOf:aBlockOrItem @@ -2428,53 +2374,6 @@ ^ spec contents. ! -submenuTest - "returns a menu on the current editing menu - " - |menu indication choice submenu retriever| - - menu := listOfItems root submenu. - menu isNil ifTrue:[^ nil ]. - - menu allItemsDo:[:anItem| - anItem isVisible:true. - anItem enabled:true. - anItem translateLabel:false. - - anItem itemValue notNil ifTrue:[ - anItem itemValue:[ Transcript showCR:(anItem label) ]. - ]. - anItem indication notNil ifTrue:[ - indication isNil ifTrue:[ indication := true asValue ]. - anItem indication:indication - ]. - anItem choice notNil ifTrue:[ - choice isNil ifTrue:[ choice := anItem choiceValue asValue ]. - anItem choice:choice - ]. - anItem isMenuSlice ifTrue:[ - anItem submenuChannel:nil. - anItem label:'... Slice Menu ...'. - ]. - anItem submenuChannel notNil ifTrue:[ - anItem submenuChannel:nil. - anItem submenu isNil ifTrue:[ - submenu isNil ifTrue:[ - submenu := Menu new. - submenu addItem:(MenuItem labeled:'Linked Menu...'). - ]. - anItem submenu:submenu. - ]. - ]. - retriever := anItem resourceRetriever. - retriever notNil ifTrue:[ - retriever labelText notNil ifTrue:[ retriever labelText:(anItem label) ] - ]. - ]. - menu findGuiResourcesIn:(self resolveName:specClass). - ^ menu -! - withoutNotifyDo:aBlock "evaluate the block; all change notifications are discard during the block is evaluated" @@ -2589,31 +2488,31 @@ |cls redefineAspectMethods category| specClass isNil ifTrue:[ - self warn:'Define the class first !!'. - ^ self + self warn:'Define the class first !!'. + ^ self ]. redefineAspectMethods := self redefineAspectMethodsChannel value. cls := self resolveName:specClass. cls isNil ifTrue:[ - self warn:'Class ', specClass asString, ' does not exist!!'. - ^ self + self warn:'Class ', specClass asString, ' does not exist!!'. + ^ self ]. category := UserPreferences current categoryForMenuActionsMethods. self collectActionSelectors do:[:aSelector| - self - createActionMethodFor:aSelector in:cls - category:category - redefine:redefineAspectMethods. + CodeGeneratorTool + createActionMethodFor:aSelector in:cls + category:category + redefine:redefineAspectMethods. ]. self collectAspectSelectors do:[:anAspect| - self - createAspectMethodFor:anAspect in:cls - category:category - redefine:redefineAspectMethods + CodeGeneratorTool + createAspectMethodFor:anAspect in:cls + category:category + redefine:redefineAspectMethods ]. ! !