MenuEditor.st
changeset 218 5c88856b360f
parent 215 d3c66fe05b12
child 220 8f0065e7a83d
equal deleted inserted replaced
217:354ba46948b4 218:5c88856b360f
    11 "
    11 "
    12 
    12 
    13 
    13 
    14 
    14 
    15 ApplicationModel subclass:#MenuEditor
    15 ApplicationModel subclass:#MenuEditor
    16 	instanceVariableNames:'specClass tabSelection aspects slices'
    16         instanceVariableNames:'specClass tabSelection aspects slices activeHelpTool'
    17 	classVariableNames:''
    17         classVariableNames:''
    18 	poolDictionaries:''
    18         poolDictionaries:''
    19 	category:'Interface-UIPainter'
    19         category:'Interface-UIPainter'
    20 !
    20 !
    21 
    21 
    22 Object subclass:#Item
    22 Object subclass:#Item
    23 	instanceVariableNames:'activeHelpKey enabled label value nameKey indication shortcutKey
    23         instanceVariableNames:'activeHelpKey enabled label value nameKey indication shortcutKey
    24 		accessCharaterPos retriever icon iconAndLabel'
    24                 accessCharaterPos retriever icon iconAndLabel submenuChannel'
    25 	classVariableNames:''
    25         classVariableNames:''
    26 	poolDictionaries:''
    26         poolDictionaries:''
    27 	privateIn:MenuEditor
    27         privateIn:MenuEditor
    28 !
    28 !
    29 
    29 
    30 SelectionInTreeView subclass:#Painter
    30 SelectionInTreeView subclass:#Painter
    31 	instanceVariableNames:''
    31         instanceVariableNames:'imageDirSelect'
    32 	classVariableNames:'CopyBuffer'
    32         classVariableNames:'CopyBuffer'
    33 	poolDictionaries:''
    33         poolDictionaries:''
    34 	privateIn:MenuEditor
    34         privateIn:MenuEditor
    35 !
    35 !
    36 
    36 
    37 !MenuEditor class methodsFor:'documentation'!
    37 !MenuEditor class methodsFor:'documentation'!
    38 
    38 
    39 copyright
    39 copyright
    69 
    69 
    70     [author:]
    70     [author:]
    71         Claus Atzkern
    71         Claus Atzkern
    72 "
    72 "
    73 
    73 
       
    74 ! !
       
    75 
       
    76 !MenuEditor class methodsFor:'icons'!
       
    77 
       
    78 iconStepDown
       
    79     ^ ((Image fromFile:'stepOver.xpm') rotated:90) flipHorizontal
       
    80 !
       
    81 
       
    82 iconStepIn
       
    83     ^ ((Image fromFile:'stepIn.xpm') rotated:90) flipHorizontal
       
    84 !
       
    85 
       
    86 iconStepOut
       
    87     ^ ((Image fromFile:'stepOut.xpm') rotated:90) flipHorizontal
       
    88 !
       
    89 
       
    90 iconStepUp
       
    91     ^ ((Image fromFile:'stepOver.xpm') rotated:90) flipHorizontal flipVertical
    74 ! !
    92 ! !
    75 
    93 
    76 !MenuEditor class methodsFor:'interface specs'!
    94 !MenuEditor class methodsFor:'interface specs'!
    77 
    95 
    78 classAndMethodSpec
    96 classAndMethodSpec
   248               )
   266               )
   249           )
   267           )
   250       )
   268       )
   251 !
   269 !
   252 
   270 
       
   271 menuDefaultLink
       
   272     "this window spec was automatically generated by the ST/X MenuEditor"
       
   273 
       
   274     "do not manually edit this - the builder may not be able to
       
   275      handle the specification if its corrupted."
       
   276 
       
   277     "
       
   278      MenuEditor new openOnClass:MenuEditor andSelector:#menuDefaultLink
       
   279      (Menu new fromLiteralArrayEncoding:(MenuEditor menuDefaultLink)) startUp
       
   280     "
       
   281 
       
   282     <resource: #menu>
       
   283 
       
   284     ^
       
   285      
       
   286        #(#Menu
       
   287           
       
   288            #(
       
   289              #(#MenuItem
       
   290                 #'label:' '!! derives from application !!'
       
   291             )
       
   292           ) nil
       
   293           nil
       
   294       )
       
   295 !
       
   296 
   253 menuPullDown
   297 menuPullDown
   254     "this window spec was automatically generated by the ST/X MenuEditor"
   298     "this window spec was automatically generated by the ST/X MenuEditor"
   255 
   299 
   256     "do not manually edit this - the builder may not be able to
   300     "do not manually edit this - the builder may not be able to
   257      handle the specification if its corrupted."
   301      handle the specification if its corrupted."
   280                           #'value:' #doNew
   324                           #'value:' #doNew
   281                       )
   325                       )
   282                        #(#MenuItem
   326                        #(#MenuItem
   283                           #'label:' 'from class ...'
   327                           #'label:' 'from class ...'
   284                           #'value:' #doFromClass
   328                           #'value:' #doFromClass
       
   329                           #'enabled:' #isOwnerOfHelpTool
   285                       )
   330                       )
   286                        #(#MenuItem
   331                        #(#MenuItem
   287                           #'label:' 'pick a menu'
   332                           #'label:' 'pick a menu'
   288                           #'value:' #doPickAMenu
   333                           #'value:' #doPickAMenu
       
   334                           #'enabled:' #isOwnerOfHelpTool
   289                       )
   335                       )
   290                        #(#MenuItem
   336                        #(#MenuItem
   291                           #'label:' '='
   337                           #'label:' '='
   292                       )
   338                       )
   293                        #(#MenuItem
   339                        #(#MenuItem
   306                     
   352                     
   307                      #(
   353                      #(
   308                        #(#MenuItem
   354                        #(#MenuItem
   309                           #'label:' 'class'
   355                           #'label:' 'class'
   310                           #'value:' #doDefineClass
   356                           #'value:' #doDefineClass
       
   357                           #'enabled:' #isOwnerOfHelpTool
   311                       )
   358                       )
   312                        #(#MenuItem
   359                        #(#MenuItem
   313                           #'label:' '-'
   360                           #'label:' '-'
   314                       )
   361                       )
   315                        #(#MenuItem
   362                        #(#MenuItem
   317                           #'value:' #doInstallSpec
   364                           #'value:' #doInstallSpec
   318                       )
   365                       )
   319                        #(#MenuItem
   366                        #(#MenuItem
   320                           #'label:' 'install help spec.'
   367                           #'label:' 'install help spec.'
   321                           #'value:' #doInstallHelp
   368                           #'value:' #doInstallHelp
       
   369                           #'enabled:' #isOwnerOfHelpTool
   322                       )
   370                       )
   323                        #(#MenuItem
   371                        #(#MenuItem
   324                           #'label:' '='
   372                           #'label:' '='
   325                       )
   373                       )
   326                        #(#MenuItem
   374                        #(#MenuItem
   331                     nil
   379                     nil
   332                 )
   380                 )
   333             )
   381             )
   334              #(#MenuItem
   382              #(#MenuItem
   335                 #'label:' 'test'
   383                 #'label:' 'test'
   336                 #'value:' #doTest
   384                 #'submenuChannel:' #submenuTest
       
   385             )
       
   386              #(#MenuItem
       
   387                 #'label:' ''
       
   388             )
       
   389              #(#MenuItem
       
   390                 #'label:' '-'
       
   391             )
       
   392              #(#MenuItem
       
   393                 #'label:' 'stepUp'
       
   394                 #'value:' #doStepUp
       
   395                 #'enabled:' #enabledStepOver
       
   396                 #'labelImage:' 
       
   397                  #(#ResourceRetriever
       
   398                     #MenuEditor #iconStepUp
       
   399                 )
       
   400             )
       
   401              #(#MenuItem
       
   402                 #'label:' '-'
       
   403             )
       
   404              #(#MenuItem
       
   405                 #'label:' 'stepDown'
       
   406                 #'value:' #doStepDown
       
   407                 #'enabled:' #enabledStepOver
       
   408                 #'labelImage:' 
       
   409                  #(#ResourceRetriever
       
   410                     #MenuEditor #iconStepDown
       
   411                 )
       
   412             )
       
   413              #(#MenuItem
       
   414                 #'label:' '-'
       
   415             )
       
   416              #(#MenuItem
       
   417                 #'label:' ''
       
   418             )
       
   419              #(#MenuItem
       
   420                 #'label:' '-'
       
   421             )
       
   422              #(#MenuItem
       
   423                 #'label:' 'stepIn'
       
   424                 #'value:' #doStepIn
       
   425                 #'enabled:' #enabledStepIn
       
   426                 #'labelImage:' 
       
   427                  #(#ResourceRetriever
       
   428                     #MenuEditor #iconStepIn
       
   429                 )
       
   430             )
       
   431              #(#MenuItem
       
   432                 #'label:' '-'
       
   433             )
       
   434              #(#MenuItem
       
   435                 #'label:' 'stepOut'
       
   436                 #'value:' #doStepOut
       
   437                 #'enabled:' #enabledStepOut
       
   438                 #'labelImage:' 
       
   439                  #(#ResourceRetriever
       
   440                     #MenuEditor #iconStepOut
       
   441                 )
       
   442             )
       
   443              #(#MenuItem
       
   444                 #'label:' '-'
   337             )
   445             )
   338           ) nil
   446           ) nil
   339           nil
   447           nil
   340       )
   448       )
   341 !
   449 !
   435             (Help       help)
   543             (Help       help)
   436       )
   544       )
   437 
   545 
   438 !
   546 !
   439 
   547 
       
   548 slicesLink
       
   549     ^#(
       
   550             (Basics     basicsLinkSpec)
       
   551             (Details    detailsEditSpec)
       
   552             (Misc       miscEditSpec)
       
   553             (Help       help)
       
   554       )
       
   555 
       
   556 !
       
   557 
   440 slicesMenu
   558 slicesMenu
   441     ^#(
   559     ^#(
   442             (Basics     basicsMenuSpec)
   560             (Basics     basicsMenuSpec)
   443             (Details    detailsEditSpec)
   561             (Details    detailsEditSpec)
   444             (Misc       miscEditSpec)
   562             (Misc       miscEditSpec)
   452             (Basics   basicsRootSpec)
   570             (Basics   basicsRootSpec)
   453       )
   571       )
   454 
   572 
   455 !
   573 !
   456 
   574 
   457 slicesSeperatorMenu
   575 slicesSeparatorMenu
   458     ^#(
   576     ^#(
   459             (Basics   basicsSeperatorMenu)
   577             (Basics   basicsSeparatorSpec)
   460       )
   578       )
   461 
   579 
   462 ! !
   580 ! !
   463 
   581 
   464 !MenuEditor class methodsFor:'specs'!
   582 !MenuEditor class methodsFor:'specs'!
   544               )
   662               )
   545           )
   663           )
   546       )
   664       )
   547 !
   665 !
   548 
   666 
   549 basicsMenuSpec
   667 basicsLinkSpec
   550     "this window spec was automatically generated by the ST/X UIPainter"
   668     "this window spec was automatically generated by the ST/X UIPainter"
   551 
   669 
   552     "do not manually edit this - the painter/builder may not be able to
   670     "do not manually edit this - the painter/builder may not be able to
   553      handle the specification if its corrupted."
   671      handle the specification if its corrupted."
   554 
   672 
   555     "
   673     "
   556      UIPainter new openOnClass:MenuEditor andSelector:#basicsMenuSpec
   674      UIPainter new openOnClass:MenuEditor andSelector:#basicsLinkSpec
   557      MenuEditor new openInterface:#basicsMenuSpec
   675      MenuEditor new openInterface:#basicsLinkSpec
   558     "
   676     "
   559 
   677 
   560     <resource: #canvas>
   678     <resource: #canvas>
   561 
   679 
   562     ^
   680     ^
   596                     #'name:' 'itemLabel'
   714                     #'name:' 'itemLabel'
   597                     #'layout:' #(#LayoutFrame 91 0 42 0 -5 1.0 64 0)
   715                     #'layout:' #(#LayoutFrame 91 0 42 0 -5 1.0 64 0)
   598                     #'tabable:' true
   716                     #'tabable:' true
   599                     #'model:' #label
   717                     #'model:' #label
   600                 )
   718                 )
       
   719                  #(#InputFieldSpec
       
   720                     #'name:' 'submenuChannel'
       
   721                     #'layout:' #(#LayoutFrame 91 0 69 0 -5 1.0 91 0)
       
   722                     #'tabable:' true
       
   723                     #'model:' #submenuChannel
       
   724                     #'type:' #symbolOrNil
       
   725                 )
       
   726                  #(#LabelSpec
       
   727                     #'name:' 'menuLabel'
       
   728                     #'layout:' #(#AlignmentOrigin 87 0 80 0 1 0.5)
       
   729                     #'label:' 'Menu:'
       
   730                     #'resizeForLabel:' true
       
   731                 )
       
   732               )
       
   733           )
       
   734       )
       
   735 !
       
   736 
       
   737 basicsMenuSpec
       
   738     "this window spec was automatically generated by the ST/X UIPainter"
       
   739 
       
   740     "do not manually edit this - the painter/builder may not be able to
       
   741      handle the specification if its corrupted."
       
   742 
       
   743     "
       
   744      UIPainter new openOnClass:MenuEditor andSelector:#basicsMenuSpec
       
   745      MenuEditor new openInterface:#basicsMenuSpec
       
   746     "
       
   747 
       
   748     <resource: #canvas>
       
   749 
       
   750     ^
       
   751      
       
   752        #(#FullSpec
       
   753           #'window:' 
       
   754            #(#WindowSpec
       
   755               #'name:' 'uIPainterView'
       
   756               #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
       
   757               #'label:' 'unnamed canvas'
       
   758               #'bounds:' #(#Rectangle 0 0 267 319)
       
   759           )
       
   760           #'component:' 
       
   761            #(#SpecCollection
       
   762               #'collection:' 
       
   763                #(
       
   764                  #(#LabelSpec
       
   765                     #'name:' 'nameKeyLabel'
       
   766                     #'layout:' #(#AlignmentOrigin 87 0 26 0 1 0.5)
       
   767                     #'label:' 'NameKey:'
       
   768                     #'resizeForLabel:' true
       
   769                 )
       
   770                  #(#InputFieldSpec
       
   771                     #'name:' 'itemNameKey'
       
   772                     #'layout:' #(#LayoutFrame 91 0 15 0 -5 1.0 37 0)
       
   773                     #'tabable:' true
       
   774                     #'model:' #nameKey
       
   775                     #'type:' #symbolOrNil
       
   776                 )
       
   777                  #(#LabelSpec
       
   778                     #'name:' 'labelLabel'
       
   779                     #'layout:' #(#AlignmentOrigin 87 0 53 0 1 0.5)
       
   780                     #'label:' 'Label'
       
   781                     #'resizeForLabel:' true
       
   782                 )
       
   783                  #(#InputFieldSpec
       
   784                     #'name:' 'itemLabel'
       
   785                     #'layout:' #(#LayoutFrame 91 0 42 0 -5 1.0 64 0)
       
   786                     #'tabable:' true
       
   787                     #'model:' #label
       
   788                 )
   601               )
   789               )
   602           )
   790           )
   603       )
   791       )
   604 !
   792 !
   605 
   793 
   645               )
   833               )
   646           )
   834           )
   647       )
   835       )
   648 !
   836 !
   649 
   837 
   650 basicsSeperatorMenu
   838 basicsSeparatorSpec
   651     "this window spec was automatically generated by the ST/X UIPainter"
   839     "this window spec was automatically generated by the ST/X UIPainter"
   652 
   840 
   653     "do not manually edit this - the painter/builder may not be able to
   841     "do not manually edit this - the painter/builder may not be able to
   654      handle the specification if its corrupted."
   842      handle the specification if its corrupted."
   655 
   843 
   656     "
   844     "
   657      UIPainter new openOnClass:MenuEditor andSelector:#basicsSeperatorMenu
   845      UIPainter new openOnClass:MenuEditor andSelector:#basicsSeparatorSpec
   658      MenuEditor new openInterface:#basicsSeperatorMenu
   846      MenuEditor new openInterface:#basicsSeparatorSpec
   659     "
   847     "
   660 
   848 
   661     <resource: #canvas>
   849     <resource: #canvas>
   662 
   850 
   663     ^
   851     ^
   672           )
   860           )
   673           #'component:' 
   861           #'component:' 
   674            #(#SpecCollection
   862            #(#SpecCollection
   675               #'collection:' 
   863               #'collection:' 
   676                #(
   864                #(
   677                  #(#CheckBoxSpec
   865                  #(#LabelSpec
   678                     #'name:' 'seperator'
   866                     #'name:' 'separatorLabel'
   679                     #'layout:' #(#AlignmentOrigin 19 0 48 0 0 0)
   867                     #'layout:' #(#AlignmentOrigin 127 0 22 0 1 0.5)
   680                     #'tabable:' true
   868                     #'label:' 'Separator Type:'
   681                     #'model:' #doubleSeperator
   869                     #'resizeForLabel:' true
   682                     #'label:' 'Double Seperator'
   870                 )
       
   871                  #(#ComboListSpec
       
   872                     #'name:' 'comboList1'
       
   873                     #'layout:' #(#LayoutFrame 132 0 11 0 -6 1.0 33 0)
       
   874                     #'model:' #seperatorSelection
       
   875                     #'useIndex:' false
   683                 )
   876                 )
   684               )
   877               )
   685           )
   878           )
   686       )
   879       )
   687 !
   880 !
   818                     #'label:' 'Icon & Label'
  1011                     #'label:' 'Icon & Label'
   819                 )
  1012                 )
   820               )
  1013               )
   821           )
  1014           )
   822       )
  1015       )
   823 !
       
   824 
       
   825 seperatorSpec
       
   826     "this window spec was automatically generated by the ST/X UIPainter"
       
   827 
       
   828     "do not manually edit this - the painter/builder may not be able to
       
   829      handle the specification if its corrupted."
       
   830 
       
   831     "
       
   832      UIPainter new openOnClass:MenuEditor andSelector:#seperatorSpec
       
   833      MenuEditor new openInterface:#seperatorSpec
       
   834     "
       
   835 
       
   836     <resource: #canvas>
       
   837 
       
   838     ^
       
   839      
       
   840        #(#FullSpec
       
   841           #'window:' 
       
   842            #(#WindowSpec
       
   843               #'name:' 'uIPainterView'
       
   844               #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
       
   845               #'label:' 'unnamed canvas'
       
   846               #'bounds:' #(#Rectangle 0 0 267 319)
       
   847           )
       
   848           #'component:' 
       
   849            #(#SpecCollection
       
   850               #'collection:' 
       
   851                #(
       
   852                  #(#CheckBoxSpec
       
   853                     #'name:' 'seperator'
       
   854                     #'layout:' #(#AlignmentOrigin 19 0 48 0 0 0)
       
   855                     #'tabable:' true
       
   856                     #'model:' #doubleSeperator
       
   857                     #'label:' 'Double Seperator'
       
   858                 )
       
   859               )
       
   860           )
       
   861       )
       
   862 ! !
  1016 ! !
   863 
  1017 
   864 !MenuEditor class methodsFor:'startup'!
  1018 !MenuEditor class methodsFor:'startup'!
   865 
  1019 
   866 openModalOnClass:aClass andSelector:aSelector
  1020 openModalOnClass:aClass andSelector:aSelector
   874 
  1028 
   875 
  1029 
   876 ! !
  1030 ! !
   877 
  1031 
   878 !MenuEditor methodsFor:'accessing'!
  1032 !MenuEditor methodsFor:'accessing'!
       
  1033 
       
  1034 menuDefaultLink
       
  1035     ^ self class menuDefaultLink
       
  1036 !
   879 
  1037 
   880 specClass
  1038 specClass
   881     ^ specClass
  1039     ^ specClass
   882 !
  1040 !
   883 
  1041 
   884 specClass:aClass
  1042 specClass:aClass
   885     aClass isBehavior ifTrue:[specClass := aClass name]
  1043     aClass isBehavior ifTrue:[specClass := aClass name]
   886                      ifFalse:[specClass := aClass].
  1044                      ifFalse:[specClass := aClass].
       
  1045 !
       
  1046 
       
  1047 submenuTest
       
  1048     "returns submenu assigned to item test
       
  1049     "
       
  1050     |menu|
       
  1051 
       
  1052     menu := self painter asMenu.
       
  1053 
       
  1054     menu allItemsDo:[:anItem|
       
  1055         anItem value:nil.
       
  1056         anItem enabled:true.
       
  1057     ].
       
  1058   ^ menu
   887 ! !
  1059 ! !
   888 
  1060 
   889 !MenuEditor methodsFor:'actions'!
  1061 !MenuEditor methodsFor:'actions'!
   890 
  1062 
   891 accept
  1063 accept
   895 
  1067 
   896     node := self painter selectedNode.
  1068     node := self painter selectedNode.
   897 
  1069 
   898     node notNil ifTrue:[
  1070     node notNil ifTrue:[
   899         self isHelpToolSelected ifTrue:[
  1071         self isHelpToolSelected ifTrue:[
   900             self helpTool accept
  1072             self activeHelpTool accept
   901         ].
  1073         ].
   902         cont := node contents buildFromAspects:aspects.
  1074         cont := node contents buildFromAspects:aspects.
   903         self painter selectedNodeChanged
  1075         self painter selectedNodeChanged
   904     ].
  1076     ].
   905     self modifiedChannel value:false.
  1077     self modifiedChannel value:false.
   914     ].
  1086     ].
   915     self modifiedChannel value:false.
  1087     self modifiedChannel value:false.
   916 
  1088 
   917 ! !
  1089 ! !
   918 
  1090 
       
  1091 !MenuEditor methodsFor:'active help'!
       
  1092 
       
  1093 activeHelpTool
       
  1094     "access current active help editor
       
  1095     "
       
  1096     activeHelpTool isNil ifTrue:[
       
  1097         self activeHelpTool:(UIHelpTool new)
       
  1098     ].
       
  1099   ^ activeHelpTool
       
  1100 !
       
  1101 
       
  1102 activeHelpTool:anApplication
       
  1103     "change current active help editor
       
  1104     "
       
  1105     activeHelpTool := anApplication.
       
  1106 
       
  1107     activeHelpTool masterApplication isNil ifTrue:[
       
  1108         activeHelpTool masterApplication:self.
       
  1109     ].
       
  1110 !
       
  1111 
       
  1112 isOwnerOfHelpTool
       
  1113     "returns true in case of owner of the helptool
       
  1114     "
       
  1115   ^ self activeHelpTool masterApplication == self
       
  1116 ! !
       
  1117 
   919 !MenuEditor methodsFor:'aspects'!
  1118 !MenuEditor methodsFor:'aspects'!
   920 
  1119 
   921 aspectFor:aKey
  1120 aspectFor:aKey
   922     "returns aspect for a key or nil
  1121     "returns aspect for a key or nil
   923     "
  1122     "
   924   ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ]
  1123   ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ]
   925 
  1124 
   926 
  1125 
       
  1126 !
       
  1127 
       
  1128 enabledStepIn
       
  1129     |holder|
       
  1130 
       
  1131     (holder := builder bindingAt:#enabledStepIn) isNil ifTrue:[
       
  1132         builder aspectAt:#enabledStepIn put:(holder :=  false asValue).
       
  1133     ].
       
  1134     ^ holder
       
  1135 
       
  1136 !
       
  1137 
       
  1138 enabledStepOut
       
  1139     |holder|
       
  1140 
       
  1141     (holder := builder bindingAt:#enabledStepOut) isNil ifTrue:[
       
  1142         builder aspectAt:#enabledStepOut put:(holder :=  false asValue).
       
  1143     ].
       
  1144     ^ holder
       
  1145 
       
  1146 !
       
  1147 
       
  1148 enabledStepOver
       
  1149     |holder|
       
  1150 
       
  1151     (holder := builder bindingAt:#enabledStepOver) isNil ifTrue:[
       
  1152         builder aspectAt:#enabledStepOver put:(holder :=  false asValue).
       
  1153     ].
       
  1154     ^ holder
   927 !
  1155 !
   928 
  1156 
   929 menuPullDown
  1157 menuPullDown
   930     |menu|
  1158     |menu|
   931 
  1159 
   987 
  1215 
   988 update:something with:aParameter from:changedObject
  1216 update:something with:aParameter from:changedObject
   989     "one of my models changed its value
  1217     "one of my models changed its value
   990     "
  1218     "
   991     self modifiedChannel value:true
  1219     self modifiedChannel value:true
       
  1220 !
       
  1221 
       
  1222 updateEnabledChannels
       
  1223     "update enabled channels
       
  1224     "
       
  1225     |node parent next|
       
  1226 
       
  1227     node := self painter selectedNode.
       
  1228 
       
  1229     (node notNil and:[(parent := node parent) notNil]) ifTrue:[
       
  1230         next := parent childAt:((parent indexOfChild:node) + 1).
       
  1231         self enabledStepIn   value:(next notNil and:[next hasChildren]).
       
  1232         self enabledStepOver value:(parent children size > 1).
       
  1233         self enabledStepOut  value:(parent parent notNil).
       
  1234     ] ifFalse:[
       
  1235         self enabledStepOver value:false.
       
  1236         self enabledStepIn   value:false.
       
  1237         self enabledStepOut  value:false.
       
  1238     ]
   992 ! !
  1239 ! !
   993 
  1240 
   994 !MenuEditor methodsFor:'queries'!
  1241 !MenuEditor methodsFor:'queries'!
   995 
  1242 
   996 isHelpToolSelected
  1243 isHelpToolSelected
  1010     (node := self painter selectedNode) notNil ifTrue:[
  1257     (node := self painter selectedNode) notNil ifTrue:[
  1011         aspects do:[:anAspect| anAspect value:nil ].
  1258         aspects do:[:anAspect| anAspect value:nil ].
  1012         item := node contents.
  1259         item := node contents.
  1013         item toAspects:aspects.
  1260         item toAspects:aspects.
  1014 
  1261 
  1015         item isSeperator ifFalse:[
  1262         item isSeparator ifFalse:[
  1016             node parent isNil ifFalse:[
  1263             node parent isNil ifFalse:[
  1017                 node hasChildren ifTrue:[slc := #slicesMenu]
  1264                 node hasChildren ifTrue:[
  1018                                 ifFalse:[slc := #slicesItem].
  1265                     slc := #slicesMenu
       
  1266                 ] ifFalse:[
       
  1267                     item submenuChannel isNil ifTrue:[slc := #slicesItem]
       
  1268                                              ifFalse:[slc := #slicesLink]
       
  1269                 ].
  1019             ] ifTrue:[
  1270             ] ifTrue:[
  1020                 slc := #slicesRootMenu
  1271                 slc := #slicesRootMenu
  1021             ]
  1272             ]
  1022         ] ifTrue:[
  1273         ] ifTrue:[
  1023             slc := #slicesSeperatorMenu
  1274             slc := #slicesSeparatorMenu
  1024         ].
  1275         ].
  1025         slc := self class perform:slc.
  1276         slc := self class perform:slc.
  1026     ].
  1277     ].
  1027     self modifiedChannel value:false.
  1278     self modifiedChannel value:false.
  1028 
  1279 
  1037         ] ifFalse:[
  1288         ] ifFalse:[
  1038             self tabList value:nil.
  1289             self tabList value:nil.
  1039             self tabSelection:nil.
  1290             self tabSelection:nil.
  1040         ]
  1291         ]
  1041     ].
  1292     ].
       
  1293     self updateEnabledChannels
  1042 !
  1294 !
  1043 
  1295 
  1044 tabSelection
  1296 tabSelection
  1045     ^ tabSelection
  1297     ^ tabSelection
  1046 !
  1298 !
  1054 
  1306 
  1055     (tabSelection := aSelection) isNil ifTrue:[
  1307     (tabSelection := aSelection) isNil ifTrue:[
  1056       ^ self tabCanvas client:nil
  1308       ^ self tabCanvas client:nil
  1057     ].
  1309     ].
  1058     self isHelpToolSelected ifTrue:[
  1310     self isHelpToolSelected ifTrue:[
  1059         self tabCanvas client:(tool := self helpTool).
  1311         self tabCanvas client:(tool := self activeHelpTool).
  1060         tool model:(self aspectFor:#activeHelpKey)
  1312         tool model:(self aspectFor:#activeHelpKey)
  1061     ] ifFalse:[
  1313     ] ifFalse:[
  1062         sel := (slices at:tabSelection) last.
  1314         sel := (slices at:tabSelection) last.
  1063         self tabCanvas client:self spec:(self class perform:sel) builder:builder
  1315         self tabCanvas client:self spec:(self class perform:sel) builder:builder
  1064     ]    
  1316     ]    
  1065 ! !
  1317 ! !
  1066 
  1318 
  1067 !MenuEditor methodsFor:'startup / release'!
  1319 !MenuEditor methodsFor:'startup / release'!
  1068 
  1320 
  1069 buildFrom:aClass andSelector:aSelector
  1321 buildFrom:aClass andSelector:aSelector
  1070     |oldClass newClass|
  1322     |oldClass newClass helpTool|
  1071 
  1323 
  1072     oldClass := self specClass.
  1324     oldClass := self specClass.
  1073     self specClass:aClass.
  1325     self specClass:aClass.
  1074     newClass := self specClass.
  1326     newClass := self specClass.
  1075 
  1327 
  1076     oldClass ~= newClass ifTrue:[
  1328     (self isOwnerOfHelpTool and:[oldClass ~= newClass]) ifTrue:[
  1077         self helpTool helpSpecFrom:newClass
  1329         self activeHelpTool helpSpecFrom:newClass
  1078     ].
  1330     ].
  1079     self painter buildFrom:newClass andSelector:aSelector.
  1331     self painter buildFrom:newClass andSelector:aSelector.
  1080 !
  1332 !
  1081 
  1333 
  1082 initialize
  1334 initialize
  1083     "initialize channels
  1335     "initialize channels
  1084     "
  1336     "
       
  1337     |holder|
       
  1338 
  1085     super initialize.
  1339     super initialize.
  1086     aspects := IdentityDictionary new.
  1340     aspects := IdentityDictionary new.
  1087 
  1341 
  1088     #(
  1342     #(
  1089         label
  1343         label
  1090         accessCharaterPos
  1344         accessCharaterPos
       
  1345         submenuChannel
  1091         activeHelpKey
  1346         activeHelpKey
  1092         enabled
  1347         enabled
  1093         value
  1348         value
  1094         nameKey
  1349         nameKey
  1095         indication
  1350         indication
  1096         shortcutKey
  1351         shortcutKey
  1097         doubleSeperator
       
  1098         retriever
  1352         retriever
  1099         iconAndLabel
  1353         iconAndLabel
  1100         icon
  1354         icon
  1101 
  1355 
  1102      ) do:[:aKey||holder|
  1356      ) do:[:aKey|
  1103         holder := ValueHolder new.
  1357         aspects at:aKey put:(holder := ValueHolder new).
  1104         holder addDependent:self.
  1358         holder addDependent:self.
  1105         aspects at:aKey put:holder.
  1359     ].
  1106     ].
  1360 
  1107 
  1361     aspects at:#seperatorSelection put:(holder := SelectionInList new).
       
  1362     holder list:(Item separatorList).
       
  1363     holder addDependent:self.
  1108 
  1364 
  1109 
  1365 
  1110 !
  1366 !
  1111 
  1367 
  1112 openModalOnClass:aClass andSelector:aSelector
  1368 openModalOnClass:aClass andSelector:aSelector
  1175 !
  1431 !
  1176 
  1432 
  1177 doInstallHelp
  1433 doInstallHelp
  1178     "install help text
  1434     "install help text
  1179     "
  1435     "
  1180     self helpTool installHelpSpecInto:(self specClass)
  1436     self activeHelpTool installHelpSpecInto:(self specClass)
  1181 !
  1437 !
  1182 
  1438 
  1183 doInstallSpec
  1439 doInstallSpec
  1184     |cls selector painter menu spec mthd category code|
  1440     |cls selector painter menu spec mthd category code|
  1185 
  1441 
  1236             , '\\'.
  1492             , '\\'.
  1237 
  1493 
  1238     code := code withCRs.
  1494     code := code withCRs.
  1239     (ReadStream on:code) fileIn.
  1495     (ReadStream on:code) fileIn.
  1240 
  1496 
       
  1497     (cls compiledMethodAt:selector) isNil ifTrue:[
       
  1498         category := 'accessing menu'.
       
  1499         code := Character excla asString 
       
  1500                 , cls name , ' methodsFor:' , category storeString
       
  1501                 , Character excla asString , '\\'
       
  1502 
       
  1503                 , selector , '\'
       
  1504                 , '    "this window spec was automatically generated by the ST/X MenuEditor"\\'
       
  1505                 , '    ^ self class ', selector, '\\'
       
  1506                 , '\'
       
  1507                 , Character excla asString
       
  1508                 , ' '
       
  1509                 , Character excla asString
       
  1510                 , '\\'.
       
  1511 
       
  1512         code := code withCRs.
       
  1513         (ReadStream on:code) fileIn.
       
  1514     ].
       
  1515 
       
  1516 
  1241 !
  1517 !
  1242 
  1518 
  1243 doNew
  1519 doNew
  1244     self buildFrom:nil andSelector:(self painter selectorName)
  1520     self buildFrom:nil andSelector:(self painter selectorName)
  1245 !
  1521 !
  1246 
  1522 
  1247 doPickAMenu
  1523 doPickAMenu
  1248 
  1524 
  1249     |menu|
  1525     |view menu|
  1250 
  1526 
  1251     menu := Screen current viewFromUser.
  1527     view := Screen current viewFromUser.
  1252 
  1528 
  1253     (menu isNil or:[menu == Screen current rootView]) ifTrue:[
  1529     (view isNil or:[view == Screen current rootView]) ifTrue:[
  1254         ^ self
  1530         ^ self
  1255     ].
  1531     ].
  1256     (menu isKindOf:MenuPanel) ifTrue:[
  1532     (view isKindOf:MenuPanel) ifTrue:[
  1257         ^ self painter buildFromMenu:(menu asMenu)
  1533         ^ self painter buildFromMenu:(view asMenu)
  1258     ].
  1534     ].
  1259 !
  1535     (view isKindOf:PullDownMenu) ifTrue:[
  1260 
  1536         ^ self painter buildFromMenu:(self doPickPopupMenu:view)
  1261 doTest
  1537     ].
  1262     "open current editing menu
  1538 !
  1263     "
  1539 
  1264     |menu value|
  1540 doPickPopupMenu:aMenu
  1265 
  1541     "pick a popup menu
  1266     menu := self painter asMenu.
  1542     "
  1267 
  1543     |menu label values item subM|
  1268     menu notNil ifTrue:[
  1544 
  1269         menu receiver:nil.
  1545     menu   := Menu new.
  1270         value := menu startUp.
  1546     values := aMenu selectors.
  1271         Transcript showCR:'result from test: ', value printString
  1547 
  1272     ]
  1548     aMenu labels keysAndValuesDo:[:anIndex :aLabel|
  1273 
  1549         item := MenuItem labeled:(aLabel printString).
  1274 
  1550         subM := aMenu subMenuAt:anIndex.
       
  1551 
       
  1552         subM notNil ifTrue:[
       
  1553             item submenu:(self doPickPopupMenu:subM)
       
  1554         ].
       
  1555         menu addItem:item value:(values at:anIndex).
       
  1556     ].
       
  1557   ^ menu
       
  1558 !
       
  1559 
       
  1560 doStepDown
       
  1561     "move selected child after next child
       
  1562     "
       
  1563     self painter doStepOver:1
       
  1564 !
       
  1565 
       
  1566 doStepIn
       
  1567     self painter doStepIn
       
  1568 
       
  1569 !
       
  1570 
       
  1571 doStepOut
       
  1572     self painter doStepOut
       
  1573 !
       
  1574 
       
  1575 doStepUp
       
  1576     "move selected child after next child
       
  1577     "
       
  1578     self painter doStepOver:-1
  1275 ! !
  1579 ! !
  1276 
  1580 
  1277 !MenuEditor methodsFor:'values'!
  1581 !MenuEditor methodsFor:'values'!
  1278 
       
  1279 helpTool
       
  1280     |tool|
       
  1281 
       
  1282     (tool := builder bindingAt:#helpTool) isNil ifTrue:[
       
  1283         tool := UIHelpTool new.
       
  1284         tool masterApplication:self.
       
  1285         builder aspectAt:#helpTool put:tool
       
  1286     ].
       
  1287   ^ tool
       
  1288 !
       
  1289 
  1582 
  1290 painter
  1583 painter
  1291     "automatically generated by UIPainter ..."
  1584     "automatically generated by UIPainter ..."
  1292 
  1585 
  1293     |painter|
  1586     |painter|
  1298         builder aspectAt:#painter put:painter.
  1591         builder aspectAt:#painter put:painter.
  1299     ].
  1592     ].
  1300   ^ painter
  1593   ^ painter
  1301 ! !
  1594 ! !
  1302 
  1595 
       
  1596 !MenuEditor::Item class methodsFor:'constants'!
       
  1597 
       
  1598 separatorList
       
  1599    ^ #( 'blank' 'single line' 'double line' )
       
  1600 !
       
  1601 
       
  1602 separatorSlices
       
  1603    ^ #(
       
  1604         ( #blank        ''  )
       
  1605         ( #single       '-' )
       
  1606         ( #double       '=' )
       
  1607       )
       
  1608 ! !
       
  1609 
  1303 !MenuEditor::Item class methodsFor:'documentation'!
  1610 !MenuEditor::Item class methodsFor:'documentation'!
  1304 
  1611 
  1305 documentation
  1612 documentation
  1306 "
  1613 "
  1307     implements the contents assigned to a TreeItem. An instance
  1614     implements the contents assigned to a TreeItem. An instance
  1326     ^ label!
  1633     ^ label!
  1327 
  1634 
  1328 label:something
  1635 label:something
  1329     "set the value of the instance variable 'label' (automatically generated)"
  1636     "set the value of the instance variable 'label' (automatically generated)"
  1330 
  1637 
  1331     label := something.! !
  1638     label := something ? '-'.
       
  1639 !
       
  1640 
       
  1641 separatorType
       
  1642     "returns separator type assigned to item or nil
       
  1643     "
       
  1644     |c|
       
  1645 
       
  1646     label size > 1 ifFalse:[
       
  1647         label size == 0 ifTrue:[
       
  1648             ^ #blank
       
  1649         ].
       
  1650         c := label first.
       
  1651         c == $- ifTrue:[^ #single].
       
  1652         c == $= ifTrue:[^ #double].
       
  1653     ].    
       
  1654   ^ nil
       
  1655 
       
  1656 !
       
  1657 
       
  1658 submenuChannel
       
  1659     "return the value of the instance variable 'submenuChannel' (automatically generated)"
       
  1660 
       
  1661     ^ submenuChannel
       
  1662 !
       
  1663 
       
  1664 submenuChannel:aChannel
       
  1665     "return the value of the instance variable 'submenuChannel' (automatically generated)"
       
  1666 
       
  1667     submenuChannel := aChannel
       
  1668 ! !
  1332 
  1669 
  1333 !MenuEditor::Item methodsFor:'conversion'!
  1670 !MenuEditor::Item methodsFor:'conversion'!
  1334 
  1671 
  1335 asMenuItem
  1672 asMenuItem
  1336     "converts self to a menu item
  1673     "converts self to a menu item
  1337     "
  1674     "
  1338     |item rcv|
  1675     |item rcv|
  1339 
  1676 
  1340     item := MenuItem labeled:(label ? '-').
  1677     item := MenuItem labeled:label.
  1341 
  1678 
  1342     self isSeperator ifFalse:[
  1679     self isSeparator ifFalse:[
  1343         item activeHelpKey:activeHelpKey.
  1680         item activeHelpKey:activeHelpKey.
  1344         item enabled:enabled.
  1681         item enabled:enabled.
  1345         item accessCharacterPosition:accessCharaterPos.
  1682         item accessCharacterPosition:accessCharaterPos.
       
  1683         item submenuChannel:submenuChannel.
  1346         item nameKey:nameKey.
  1684         item nameKey:nameKey.
  1347         item shortcutKeyCharacter:shortcutKey.
  1685         item shortcutKeyCharacter:shortcutKey.
  1348         item value:value.
  1686         item value:value.
  1349         item indication:indication.
  1687         item indication:indication.
  1350 
  1688 
  1360     ].
  1698     ].
  1361   ^ item.
  1699   ^ item.
  1362 !
  1700 !
  1363 
  1701 
  1364 buildFromAspects:aspects
  1702 buildFromAspects:aspects
  1365     |name|
  1703     |name slice|
  1366 
  1704 
  1367     self isSeperator ifFalse:[
  1705     self isSeparator ifFalse:[
  1368         name  := label.
  1706         name  := label.
  1369         label := (aspects at:#label) value.
  1707         label := (aspects at:#label) value.
  1370 
  1708 
  1371         self isSeperator ifTrue:[
  1709         (label isNil or:[self isSeparator]) ifTrue:[
  1372             (aspects at:#label) value:(label := name)
  1710             (aspects at:#label) value:(label := name)
  1373         ].
  1711         ].
  1374 
  1712 
  1375         activeHelpKey       := (aspects at:#activeHelpKey) value.
  1713         activeHelpKey       := (aspects at:#activeHelpKey) value.
  1376         enabled             := (aspects at:#enabled) value.
  1714         enabled             := (aspects at:#enabled) value.
  1377         value               := (aspects at:#value) value.
  1715         value               := (aspects at:#value) value.
  1378         nameKey             := (aspects at:#nameKey) value.
  1716         nameKey             := (aspects at:#nameKey) value.
  1379         indication          := (aspects at:#indication) value.
  1717         indication          := (aspects at:#indication) value.
  1380         shortcutKey         := (aspects at:#shortcutKey) value.
  1718         shortcutKey         := (aspects at:#shortcutKey) value.
  1381         accessCharaterPos   := (aspects at:#accessCharaterPos) value.
  1719         accessCharaterPos   := (aspects at:#accessCharaterPos) value.
       
  1720         submenuChannel      := (aspects at:#submenuChannel)    value.
  1382         retriever           := (aspects at:#retriever) value.
  1721         retriever           := (aspects at:#retriever) value.
  1383         icon                := (aspects at:#icon) value.
  1722         icon                := (aspects at:#icon) value.
  1384         iconAndLabel        := (aspects at:#iconAndLabel) value.
  1723         iconAndLabel        := (aspects at:#iconAndLabel) value.
  1385     ] ifTrue:[
  1724     ] ifTrue:[
  1386         (aspects at:#doubleSeperator) value ifTrue:[label := '=']
  1725         name  := (aspects at:#seperatorSelection) selectionIndex.
  1387                                            ifFalse:[label := nil].
  1726         label := (self class separatorSlices at:name) last.
  1388     ]
  1727     ]
  1389 !
  1728 !
  1390 
  1729 
  1391 buildFromMenuItem:anItem
  1730 buildFromMenuItem:anItem
  1392     |rtv|
  1731     |rtv|
  1393 
  1732 
  1394     label               := anItem label.
  1733     self label:(anItem label).
  1395     activeHelpKey       := anItem activeHelpKey.
  1734     activeHelpKey := anItem activeHelpKey.
  1396 
  1735 
  1397     (enabled := anItem enabled) isSymbol ifFalse:[
  1736     (enabled := anItem enabled) isSymbol ifFalse:[
  1398         enabled := nil
  1737         enabled := nil
  1399     ].
  1738     ].
  1400 
  1739 
  1407     ].
  1746     ].
  1408 
  1747 
  1409     nameKey           := anItem nameKey.
  1748     nameKey           := anItem nameKey.
  1410     shortcutKey       := anItem shortcutKeyCharacter.
  1749     shortcutKey       := anItem shortcutKeyCharacter.
  1411     accessCharaterPos := anItem accessCharacterPosition.
  1750     accessCharaterPos := anItem accessCharacterPosition.
       
  1751     submenuChannel    := anItem submenuChannel.
  1412 
  1752 
  1413     (    ((rtv := anItem adornment) notNil)
  1753     (    ((rtv := anItem adornment) notNil)
  1414      and:[(rtv := rtv labelImage) isKindOf:ResourceRetriever]
  1754      and:[(rtv := rtv labelImage) isKindOf:ResourceRetriever]
  1415     ) ifTrue:[
  1755     ) ifTrue:[
  1416         retriever := rtv className.
  1756         retriever := rtv className.
  1421         ]
  1761         ]
  1422     ]
  1762     ]
  1423 !
  1763 !
  1424 
  1764 
  1425 toAspects:aspects
  1765 toAspects:aspects
  1426 
  1766     |type idx slice|
  1427     self isSeperator ifTrue:[
  1767 
  1428         (aspects at:#doubleSeperator) value:(label notNil).
  1768     (type := self separatorType) notNil ifTrue:[
       
  1769         type := self class separatorSlices findFirst:[:el| el first == type ].
       
  1770         (aspects at:#seperatorSelection) selectionIndex:type.
  1429     ] ifFalse:[
  1771     ] ifFalse:[
  1430         (aspects at:#label)                 value:label.
  1772         (aspects at:#label)                 value:label.
  1431         (aspects at:#activeHelpKey)         value:activeHelpKey.
  1773         (aspects at:#activeHelpKey)         value:activeHelpKey.
  1432         (aspects at:#enabled)               value:enabled.
  1774         (aspects at:#enabled)               value:enabled.
  1433         (aspects at:#value)                 value:value.
  1775         (aspects at:#value)                 value:value.
  1434         (aspects at:#nameKey)               value:nameKey.
  1776         (aspects at:#nameKey)               value:nameKey.
  1435         (aspects at:#indication)            value:indication.
  1777         (aspects at:#indication)            value:indication.
  1436         (aspects at:#shortcutKey)           value:shortcutKey.
  1778         (aspects at:#shortcutKey)           value:shortcutKey.
  1437         (aspects at:#accessCharaterPos)     value:accessCharaterPos.
  1779         (aspects at:#accessCharaterPos)     value:accessCharaterPos.
       
  1780         (aspects at:#submenuChannel)        value:submenuChannel.
  1438         (aspects at:#retriever)             value:retriever.
  1781         (aspects at:#retriever)             value:retriever.
  1439         (aspects at:#icon)                  value:icon.
  1782         (aspects at:#icon)                  value:icon.
  1440         (aspects at:#iconAndLabel)          value:iconAndLabel.
  1783         (aspects at:#iconAndLabel)          value:iconAndLabel.
  1441     ]
  1784     ]
  1442 ! !
  1785 ! !
  1443 
  1786 
  1444 !MenuEditor::Item methodsFor:'queries'!
  1787 !MenuEditor::Item methodsFor:'queries'!
  1445 
  1788 
  1446 isSeperator
  1789 isSeparator
  1447     |c|
  1790     "returns true if item is a seperator
  1448 
  1791     "
  1449     label size > 1 ifTrue:[^ false].
  1792     ^ self separatorType notNil
  1450     label size == 1 ifTrue:[
       
  1451         (c := label first) == $= ifTrue:[
       
  1452             ^ true
       
  1453         ].
       
  1454         c == $- ifFalse:[
       
  1455             ^ false
       
  1456         ].
       
  1457     ].
       
  1458     label := nil.
       
  1459   ^ true
       
  1460 
       
  1461 !
       
  1462 
       
  1463 isSimpleSeperator
       
  1464     ^ label isNil
       
  1465 ! !
  1793 ! !
  1466 
  1794 
  1467 !MenuEditor::Painter class methodsFor:'defaults'!
  1795 !MenuEditor::Painter class methodsFor:'defaults'!
  1468 
  1796 
  1469 defaultMenuMessage   
  1797 defaultMenuMessage   
  1612 !MenuEditor::Painter methodsFor:'drawing basics'!
  1940 !MenuEditor::Painter methodsFor:'drawing basics'!
  1613 
  1941 
  1614 drawLabelIndex:anIndex atX:x y:yCenter
  1942 drawLabelIndex:anIndex atX:x y:yCenter
  1615     "draw text label assigned to a node at x y( center)
  1943     "draw text label assigned to a node at x y( center)
  1616     "
  1944     "
  1617     |y w item|
  1945     |y type item|
  1618 
  1946 
  1619     item := (listOfNodes at:anIndex) contents.
  1947     item := (listOfNodes at:anIndex) contents.
  1620 
  1948     type := item separatorType.
  1621     item isSeperator ifFalse:[
  1949 
  1622         ^ super drawLabelIndex:anIndex atX:x y:yCenter
  1950     type isNil ifTrue:[
  1623     ].
  1951         super drawLabelIndex:anIndex atX:x y:yCenter
  1624     self displayLineFromX:x y:yCenter toX:(x + 80) y:yCenter.
  1952     ] ifFalse:[
  1625 
  1953         type == #blank ifFalse:[
  1626     item isSimpleSeperator ifFalse:[
  1954             self displayLineFromX:x y:yCenter toX:(x + 80) y:yCenter.
  1627         self displayLineFromX:x y:(yCenter + 2) toX:(x + 80) y:(yCenter + 2).
  1955 
  1628     ]    
  1956             type == #double ifTrue:[
  1629 
  1957                 self displayLineFromX:x y:(yCenter + 2) toX:(x + 80) y:(yCenter + 2).
       
  1958             ]    
       
  1959         ]
       
  1960     ]
       
  1961 !
       
  1962 
       
  1963 figureFor:aNode
       
  1964     "access figure for a node
       
  1965     "
       
  1966     (aNode hasChildren or:[aNode contents submenuChannel isNil]) ifTrue:[
       
  1967         ^ super figureFor:aNode
       
  1968     ].
       
  1969     imageDirSelect isNil ifTrue:[
       
  1970         imageDirSelect := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_link.xpm').
       
  1971         imageDirSelect := imageDirSelect onDevice:device.
       
  1972     ].
       
  1973   ^ imageDirSelect
  1630 ! !
  1974 ! !
  1631 
  1975 
  1632 !MenuEditor::Painter methodsFor:'initialization'!
  1976 !MenuEditor::Painter methodsFor:'initialization'!
  1633 
  1977 
  1634 initialize
  1978 initialize
  1635     super initialize.
  1979     super initialize.
  1636     self multipleSelectOk:true.
  1980     self multipleSelectOk:true.
  1637     self model:(SelectionInTree new).
  1981     self model:(SelectionInTree new).
  1638 
       
  1639 ! !
  1982 ! !
  1640 
  1983 
  1641 !MenuEditor::Painter methodsFor:'menus'!
  1984 !MenuEditor::Painter methodsFor:'menus'!
  1642 
  1985 
  1643 doCopy
  1986 doCopy
  1649 
  1992 
  1650 doCreateItem
  1993 doCreateItem
  1651     self addElement:(self nodeLabel:'undefined')
  1994     self addElement:(self nodeLabel:'undefined')
  1652 !
  1995 !
  1653 
  1996 
       
  1997 doCreateLink
       
  1998     |node item|
       
  1999 
       
  2000     node := self nodeLabel:'undefined'.
       
  2001     item := node contents.
       
  2002     item submenuChannel:#menuDefaultLink.
       
  2003     self addElement:node
       
  2004 
       
  2005 
       
  2006 
       
  2007 !
       
  2008 
  1654 doCreateMenu
  2009 doCreateMenu
  1655     |node|
  2010     |node|
  1656 
  2011 
  1657     node := self nodeLabel:'undefined'.
  2012     node := self nodeLabel:'undefined'.
  1658     node add:(self nodeLabel:'undefined').
  2013     node add:(self nodeLabel:'undefined').
  1678     (CopyBuffer notNil and:[self selectedNode notNil]) ifTrue:[
  2033     (CopyBuffer notNil and:[self selectedNode notNil]) ifTrue:[
  1679         self addElement:(CopyBuffer collect:[:el| el copy])
  2034         self addElement:(CopyBuffer collect:[:el| el copy])
  1680     ]
  2035     ]
  1681 !
  2036 !
  1682 
  2037 
       
  2038 doStepIn
       
  2039     |idx node cprt nprt|
       
  2040 
       
  2041     (    (node := self selectedNode) isNil
       
  2042      or:[(cprt := node parent) isNil]
       
  2043     ) ifTrue:[
       
  2044         ^ self
       
  2045     ].
       
  2046 
       
  2047     idx := cprt indexOfChild:node.
       
  2048 
       
  2049     idx == cprt children size ifTrue:[
       
  2050         ^ self
       
  2051     ].
       
  2052     nprt := cprt childAt:(idx + 1).
       
  2053 
       
  2054     (nprt notNil and:[nprt hasChildren]) ifFalse:[
       
  2055        ^ self
       
  2056     ].
       
  2057 
       
  2058     model removeDependent:self.
       
  2059     model removeSelection.
       
  2060     selection := nil.
       
  2061     model expand:nprt.
       
  2062     model addDependent:self.
       
  2063 
       
  2064     model add:node beforeIndex:1 below:nprt.
       
  2065     self selectNode:node.
       
  2066 !
       
  2067 
       
  2068 doStepOut
       
  2069     |node cprt nprt|
       
  2070 
       
  2071     (    (node := self selectedNode) isNil
       
  2072      or:[(cprt := node parent) isNil
       
  2073      or:[(nprt := cprt parent) isNil]]
       
  2074     ) ifFalse:[
       
  2075         model removeDependent:self.
       
  2076         model removeSelection.
       
  2077         selection := nil.
       
  2078         model addDependent:self.
       
  2079 
       
  2080         model add:node afterIndex:(nprt indexOfChild:cprt) below:nprt.
       
  2081         self selectNode:node.
       
  2082     ]
       
  2083 !
       
  2084 
       
  2085 doStepOver:anOffset
       
  2086     "move child 'anOffset' forward or backward in list of children
       
  2087     "
       
  2088     |idx node size parent|
       
  2089 
       
  2090     (      (node   := self selectedNode) notNil
       
  2091       and:[(parent := node parent) notNil
       
  2092       and:[(size   := parent children size) > 1]]
       
  2093     ) ifTrue:[
       
  2094         idx := parent indexOfChild:node.
       
  2095 
       
  2096         model removeDependent:self.
       
  2097         model removeSelection.
       
  2098         selection := nil.
       
  2099         model addDependent:self.
       
  2100 
       
  2101         (idx := idx + anOffset) < 1 ifTrue:[
       
  2102             idx := size
       
  2103         ] ifFalse:[
       
  2104             idx > size ifTrue:[idx := 1]
       
  2105         ].
       
  2106         model add:node beforeIndex:idx below:parent.
       
  2107         self selectNode:node.
       
  2108     ]
       
  2109 !
       
  2110 
  1683 menu
  2111 menu
  1684     |menu subm sz inclRoot|
  2112     |menu subm sz inclRoot|
  1685 
  2113 
  1686     (sz := self numberOfSelections) == 0 ifTrue:[
  2114     (sz := self numberOfSelections) == 0 ifTrue:[
  1687         ^ nil
  2115         ^ nil
  1703 
  2131 
  1704     inclRoot ifTrue:[
  2132     inclRoot ifTrue:[
  1705         menu disable:#doCopy.
  2133         menu disable:#doCopy.
  1706         menu disable:#doCut.
  2134         menu disable:#doCut.
  1707     ].
  2135     ].
  1708     subm :=  PopUpMenu labels:#( 'menu'        'item'        'seperator'  )
  2136     subm :=  PopUpMenu labels:#( 'menu static' 'menu dynamic' '-' 'item'         '-' 'separator'  )
  1709                     selectors:#( #doCreateMenu #doCreateItem #doCreateSep )
  2137                     selectors:#( #doCreateMenu #doCreateLink  nil #doCreateItem  nil #doCreateSep )
  1710                      receiver:self.
  2138                      receiver:self.
  1711 
  2139 
  1712     menu subMenuAt:#create put:subm.
  2140     menu subMenuAt:#create put:subm.
  1713   ^ menu.
  2141   ^ menu.
  1714 
  2142 
  1739    ^ TreeItem name:aLabel contents:(MenuEditor::Item new label:aLabel).
  2167    ^ TreeItem name:aLabel contents:(MenuEditor::Item new label:aLabel).
  1740 ! !
  2168 ! !
  1741 
  2169 
  1742 !MenuEditor::Painter methodsFor:'selection'!
  2170 !MenuEditor::Painter methodsFor:'selection'!
  1743 
  2171 
       
  2172 selectNode:aNode
       
  2173     "change selection to a node
       
  2174     "
       
  2175     self selection:(listOfNodes findFirst:[:el| el == aNode])
       
  2176 !
       
  2177 
  1744 selectedNodeChanged
  2178 selectedNodeChanged
  1745     |node name index|
  2179     |node name index|
  1746 
  2180 
  1747     (index := self selectedIndex) ~~ 0 ifTrue:[
  2181     (index := self selectedIndex) ~~ 0 ifTrue:[
  1748         node := listOfNodes at:index.
  2182         node := listOfNodes at:index.