1 "{ Package: 'stx:libtool2' }"

     2 

     3 "{ NameSpace: Tools }"

     4 

     5 ApplicationModel subclass:#ViewTreeApplication

     6 	instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint

     7 		motionAction infoChannel testModeChannel process

     8 		followFocusChannel'

     9 	classVariableNames:''

    10 	poolDictionaries:''

    11 	category:'A-Views-Support'

    12 !

    13 

    14 Object subclass:#MenuDesc

    15 	instanceVariableNames:'title value action'

    16 	classVariableNames:''

    17 	poolDictionaries:''

    18 	privateIn:ViewTreeApplication

    19 !

    20 

    21 !ViewTreeApplication class methodsFor:'documentation'!

    22 

    23 documentation

    24 "

    25      Small application showing a ViewTreeModel use.

    26 

    27      It displays a hierarchical list of a selected TopView and

    28      all its contained subViews.

    29      Useful to have a look at subcomponents - to see how views

    30      are structured.

    31 

    32 

    33     [Instance variables:]

    34         model           <ViewTreeModel>      the used ViewTreeModel

    35         clickedItem     <ViewTreeItem>       item under the clickedPoint (motion action)

    36         clickedPoint    <Point>              point where the motion action started from.

    37         motionAction    <Action>             (oneArg-) action called durring buttonMotion.

    38 

    39 

    40     [author:]

    41         Claus Atzkern

    42 

    43     [see also:]

    44         ViewTreeModel

    45         ViewTreeItem

    46 "

    47 ! !

    48 

    49 !ViewTreeApplication class methodsFor:'initialization'!

    50 

    51 initialize

    52     "add myself to the launcher menu

    53     "

    54     self installInLauncher.

    55 !

    56 

    57 installInLauncher

    58     "add myself to the launcher menu

    59     "

    60     |menuItem icon|

    61 

    62     NewLauncher isNil ifTrue:[^ self].

    63 

    64     icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28.

    65 

    66     menuItem := MenuItem new 

    67                     label: 'View Inspector';

    68                     value: [ ViewTreeApplication open];

    69                     isButton: true;

    70                     icon: icon;

    71                     nameKey: #viewInspect.

    72 

    73     menuItem startGroup:#right.

    74     NewLauncher addMenuItem:menuItem in:'toolbar'

    75                    position:#( #before #help)

    76                       space:false.

    77 

    78 "

    79 self installInLauncher

    80 self removeFromLauncher

    81 "

    82 !

    83 

    84 postAutoload

    85     "add myself to the launcher menu

    86     "

    87     self installInLauncher.

    88 "

    89 self installInLauncher

    90 self removeFromLauncher

    91 "

    92 !

    93 

    94 removeFromLauncher

    95     "remove myself from the launcher menu

    96     "

    97     NewLauncher isNil ifTrue:[^ self].

    98     NewLauncher removeUserTool:#viewInspect

    99 

   100 "

   101 self installInLauncher

   102 self removeFromLauncher

   103 "

   104 !

   105 

   106 unload

   107     "class is about to be unloaded - remove myself from the launcher menu

   108     "

   109     self removeFromLauncher.

   110     super unload.

   111 ! !

   112 

   113 !ViewTreeApplication class methodsFor:'interface specs'!

   114 

   115 windowSpec

   116     "This resource specification was automatically generated

   117      by the UIPainter of ST/X."

   118 

   119     "Do not manually edit this!! If it is corrupted,

   120      the UIPainter may not be able to read the specification."

   121 

   122     "

   123      UIPainter new openOnClass:ViewTreeApplication andSelector:#windowSpec

   124      ViewTreeApplication new openInterface:#windowSpec

   125      ViewTreeApplication open

   126     "

   127 

   128     <resource: #canvas>

   129 

   130     ^ 

   131      #(FullSpec

   132         name: windowSpec

   133         window: 

   134        (WindowSpec

   135           label: 'ViewTreeInspector'

   136           name: 'ViewTreeInspector'

   137           min: (Point 10 10)

   138           max: (Point 1024 9999)

   139           bounds: (Rectangle 0 0 325 654)

   140           menu: menu

   141         )

   142         component: 

   143        (SpecCollection

   144           collection: (

   145            (MenuPanelSpec

   146               name: 'toolbarMenu'

   147               layout: (LayoutFrame 0 0.0 0 0 0 1.0 32 0)

   148               menu: toolbarMenu

   149               textDefault: true

   150             )

   151            (HierarchicalListViewSpec

   152               name: 'List'

   153               layout: (LayoutFrame 0 0.0 32 0.0 0 1.0 -24 1.0)

   154               level: 1

   155               model: model

   156               menu: middleButtonMenu

   157               hasHorizontalScrollBar: true

   158               hasVerticalScrollBar: true

   159               miniScrollerHorizontal: true

   160               miniScrollerVertical: false

   161               backgroundColor: (Color 49.999237048905 49.999237048905 100.0)

   162               listModel: listOfItems

   163               multipleSelectOk: true

   164               useIndex: false

   165               highlightMode: label

   166               doubleClickSelector: doubleClicked:

   167               valueChangeSelector: selectionChanged

   168               showLeftIndicators: false

   169               indicatorSelector: indicatorClicked:

   170               useDefaultIcons: false

   171               postBuildCallback: postBuildTree:

   172             )

   173            (LabelSpec

   174               name: 'infoChannel'

   175               layout: (LayoutFrame 0 0.0 -24 1.0 0 1.0 0 1.0)

   176               level: 1

   177               translateLabel: true

   178               labelChannel: infoChannel

   179               adjust: left

   180             )

   181            )

   182          

   183         )

   184       )

   185 ! !

   186 

   187 !ViewTreeApplication class methodsFor:'menu specs'!

   188 

   189 menu

   190     "This resource specification was automatically generated

   191      by the MenuEditor of ST/X."

   192 

   193     "Do not manually edit this!! If it is corrupted,

   194      the MenuEditor may not be able to read the specification."

   195 

   196     "

   197      MenuEditor new openOnClass:ViewTreeApplication andSelector:#menu

   198      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication menu)) startUp

   199     "

   200 

   201     <resource: #menu>

   202 

   203     ^ 

   204      #(Menu

   205         (

   206          (MenuItem

   207             label: 'File'

   208             translateLabel: true

   209             submenu: 

   210            (Menu

   211               (

   212                (MenuItem

   213                   label: 'Pick a View'

   214                   itemValue: doPickViews

   215                   translateLabel: true

   216                 )

   217                (MenuItem

   218                   enabled: hasPickedView

   219                   label: 'Release Picked View'

   220                   itemValue: doUnpick

   221                   translateLabel: true

   222                 )

   223                (MenuItem

   224                   label: '-'

   225                 )

   226                (MenuItem

   227                   label: 'Exit'

   228                   itemValue: closeRequest

   229                   translateLabel: true

   230                 )

   231                )

   232               nil

   233               nil

   234             )

   235           )

   236          (MenuItem

   237             label: ''

   238           )

   239          (MenuItem

   240             enabled: hasSingleSelectionHolder

   241             label: 'Menu'

   242             translateLabel: true

   243             submenuChannel: middleButtonMenu

   244           )

   245          (MenuItem

   246             label: 'Components'

   247             translateLabel: true

   248             startGroup: right

   249             submenuChannel: submenuComponents:

   250           )

   251          (MenuItem

   252             label: 'Applications'

   253             translateLabel: true

   254             submenuChannel: submenuApplications:

   255           )

   256          )

   257         nil

   258         nil

   259       )

   260 !

   261 

   262 middleButtonMenu

   263     "This resource specification was automatically generated

   264      by the MenuEditor of ST/X."

   265 

   266     "Do not manually edit this!! If it is corrupted,

   267      the MenuEditor may not be able to read the specification."

   268 

   269     "

   270      MenuEditor new openOnClass:ViewTreeApplication andSelector:#middleButtonMenu

   271      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication middleButtonMenu)) startUp

   272     "

   273 

   274     <resource: #menu>

   275 

   276     ^ 

   277      #(Menu

   278         (

   279          (MenuItem

   280             label: 'Geometry'

   281             translateLabel: true

   282             submenuChannel: submenuGeometry:

   283             keepLinkedMenu: true

   284           )

   285          (MenuItem

   286             label: 'Interface'

   287             translateLabel: true

   288             submenuChannel: submenuInterface:

   289             keepLinkedMenu: true

   290           )

   291          (MenuItem

   292             label: 'Visibility'

   293             translateLabel: true

   294             submenuChannel: submenuVisibility:

   295             keepLinkedMenu: true

   296           )

   297          (MenuItem

   298             label: '-'

   299           )

   300          (MenuItem

   301             label: 'Browse View Class'

   302             itemValue: doBrowse:

   303             translateLabel: true

   304             argument: view

   305           )

   306          (MenuItem

   307             label: 'Browse Model Class'

   308             itemValue: doBrowse:

   309             translateLabel: true

   310             isVisible: hasModel

   311             argument: model

   312           )

   313          (MenuItem

   314             label: 'Browse Application Class'

   315             itemValue: doBrowse:

   316             translateLabel: true

   317             isVisible: hasApplication

   318             argument: application

   319           )

   320          (MenuItem

   321             label: 'Browse Controller Class'

   322             itemValue: doBrowse:

   323             translateLabel: true

   324             isVisible: hasController

   325             argument: controller

   326           )

   327          (MenuItem

   328             label: '-'

   329           )

   330          (MenuItem

   331             label: 'Inspect View'

   332             itemValue: doInspect:

   333             translateLabel: true

   334             argument: view

   335           )

   336          (MenuItem

   337             label: 'Inspect Window Group'

   338             itemValue: doInspect:

   339             translateLabel: true

   340             argument: group

   341           )

   342          (MenuItem

   343             label: 'Inspect Model'

   344             itemValue: doInspect:

   345             translateLabel: true

   346             isVisible: hasModel

   347             argument: model

   348           )

   349          (MenuItem

   350             label: 'Inspect Application'

   351             itemValue: doInspect:

   352             translateLabel: true

   353             isVisible: hasApplication

   354             argument: application

   355           )

   356          (MenuItem

   357             label: 'Inspect Controller'

   358             itemValue: doInspect:

   359             translateLabel: true

   360             isVisible: hasController

   361             argument: controller

   362           )

   363          (MenuItem

   364             label: '-'

   365           )

   366          (MenuItem

   367             label: 'Flash'

   368             itemValue: doFlash

   369             translateLabel: true

   370           )

   371          (MenuItem

   372             label: '-'

   373           )

   374          (MenuItem

   375             label: 'Destroy'

   376             itemValue: doDestroy

   377             translateLabel: true

   378           )

   379          (MenuItem

   380             label: '-'

   381           )

   382          (MenuItem

   383             label: 'Instance Variables'

   384             translateLabel: true

   385             submenuChannel: submenuInspector:

   386             keepLinkedMenu: true

   387           )

   388          (MenuItem

   389             label: '='

   390           )

   391          (MenuItem

   392             label: ''

   393           )

   394          (MenuItem

   395             enabled: selectedComponentHasChildren

   396             label: 'Applications'

   397             nameKey: single

   398             translateLabel: true

   399             submenuChannel: submenuApplications:

   400             keepLinkedMenu: true

   401           )

   402          (MenuItem

   403             enabled: selectedComponentHasChildren

   404             label: 'Components'

   405             nameKey: single

   406             translateLabel: true

   407             submenuChannel: submenuComponents:

   408             keepLinkedMenu: true

   409           )

   410          )

   411         nil

   412         nil

   413       )

   414 !

   415 

   416 toolbarMenu

   417     "This resource specification was automatically generated

   418      by the MenuEditor of ST/X."

   419 

   420     "Do not manually edit this!! If it is corrupted,

   421      the MenuEditor may not be able to read the specification."

   422 

   423     "

   424      MenuEditor new openOnClass:ViewTreeApplication andSelector:#toolbarMenu

   425      (Menu new fromLiteralArrayEncoding:(ViewTreeApplication toolbarMenu)) startUp

   426     "

   427 

   428     <resource: #menu>

   429 

   430     ^ 

   431      #(Menu

   432         (

   433          (MenuItem

   434             label: 'Test Mode'

   435             translateLabel: true

   436             indication: testModeChannel

   437           )

   438          (MenuItem

   439             enabled: testModeChannel

   440             label: 'Follow Focus'

   441             translateLabel: true

   442             indication: followFocusChannel

   443           )

   444          (MenuItem

   445             label: 'Select On Click'

   446             translateLabel: true

   447             indication: selectOnClickHolder

   448           )

   449          )

   450         nil

   451         nil

   452       )

   453 ! !

   454 

   455 !ViewTreeApplication methodsFor:'actions'!

   456 

   457 doubleClicked:anIndex

   458     self doInspect:#view.

   459 !

   460 

   461 indicatorClicked:anIndex

   462     |item sensor|

   463 

   464     item := model listOfItems at:anIndex ifAbsent:nil.

   465 

   466     item notNil ifTrue:[

   467         (     (sensor := self window sensor) notNil

   468          and:[(sensor ctrlDown or:[sensor shiftDown])]

   469         ) ifTrue:[

   470             item recursiveToggleExpand

   471         ] ifFalse:[

   472             item toggleExpand

   473         ]

   474     ].

   475 ! !

   476 

   477 !ViewTreeApplication methodsFor:'aspects'!

   478 

   479 followFocusChannel

   480     "boolean holder, which indicates whether selection changed dependend on the focus view

   481     "

   482     ^ followFocusChannel

   483 !

   484 

   485 hasSingleSelectionHolder

   486     "boolean holder, true if one item is selected

   487     "

   488     ^ hasSingleSelectionHolder

   489 !

   490 

   491 infoChannel

   492     "channel, which keeps a printable information

   493     "

   494     ^ infoChannel

   495 !

   496 

   497 listOfItems

   498     "returns the hierarchical list of items

   499     "

   500     ^ model listOfItems

   501 !

   502 

   503 model

   504     "returns my selection model, a ViewTreeModel

   505     "

   506     ^ model

   507 !

   508 

   509 selectOnClickHolder

   510     "boolean holder, which indicates whether the selection will change on click

   511     "

   512     ^ model selectOnClickHolder

   513 !

   514 

   515 testModeChannel

   516     "boolean holder, which indicates whether running in test or edit mode (eat input events)

   517     "

   518     ^ testModeChannel

   519 ! !

   520 

   521 !ViewTreeApplication methodsFor:'change & update'!

   522 

   523 selectionChanged

   524     "called if the selection changed

   525     "

   526     |info view item|

   527 

   528     item := model selectedItem.

   529 

   530     item notNil ifTrue:[ |state|

   531         view := item widget.

   532 

   533         view id isNil ifTrue:[

   534             state := 'no ID'.

   535         ] ifFalse:[

   536             view shown ifTrue:[

   537                 state := 'visible'.

   538             ] ifFalse:[

   539                 state := 'invisible'

   540             ].

   541         ].

   542         info := '%1 [%2] - %3' bindWith:(view class name)

   543                                    with:(view name ? '') with:state allBold.

   544 

   545     ] ifFalse:[

   546         info := ''

   547     ].

   548     hasSingleSelectionHolder value:(view notNil).

   549     infoChannel value:info.

   550 !

   551 

   552 update:something with:someArgument from:aModel

   553 

   554     aModel == testModeChannel ifTrue:[

   555         model testMode:(testModeChannel value).

   556         ^ self

   557     ].

   558     super update:something with:someArgument from:aModel.

   559 ! !

   560 

   561 !ViewTreeApplication methodsFor:'event processing'!

   562 

   563 processButtonMotionEvent:ev

   564     "handle a button motion event

   565     "

   566     |click|

   567 

   568     motionAction notNil ifTrue:[

   569         click := ev view sensor mousePoint.

   570 

   571         click = clickedPoint ifFalse:[

   572             (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[

   573                 motionAction value:click

   574             ]

   575         ]

   576     ].

   577 !

   578 

   579 processButtonPressEvent:ev

   580     "handle a buttopn press event

   581     "

   582     |sensor lastRectangle|

   583 

   584     sensor      := model rootView sensor.

   585     clickedItem := model listOfItems detectItemRespondsToView:(ev view).

   586 

   587     (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[

   588         clickedItem notNil ifTrue:[

   589             self selectOnClickHolder value ifTrue:[

   590                 model toggleSelectItem:clickedItem

   591             ].

   592         ].

   593         clickedItem := motionAction := nil.

   594     ] ifFalse:[

   595         clickedPoint  := ev view sensor mousePoint.

   596         lastRectangle := nil.

   597 

   598         motionAction :=[:p| |rootView|

   599             rootView    := model rootView device rootView.

   600             clickedItem := nil.

   601 

   602             rootView xoring:[

   603                 lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ]

   604                                     ifFalse:[ rootView clippedByChildren:false ].

   605 

   606                 p isNil ifTrue:[

   607                     rootView clippedByChildren:true.

   608                     motionAction := nil.

   609                 ] ifFalse:[

   610                     lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p).

   611                     rootView displayRectangle:lastRectangle.

   612                 ].

   613                 rootView flush.

   614             ].

   615             lastRectangle

   616         ]

   617     ]

   618 !

   619 

   620 processButtonReleaseEvent:anEvent

   621     "handle a button release event

   622     "

   623     |rootView rectangle newItems widget origin|

   624 

   625     motionAction isNil ifTrue:[ ^ self ].

   626     clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ].

   627 

   628     (rectangle := motionAction value:nil) notNil ifTrue:[

   629         rootView  := model rootView device rootView.

   630         newItems := OrderedCollection new.

   631 

   632         model rootItem recursiveDo:[:anItem|

   633             widget := anItem widget.

   634             origin := widget originRelativeTo:rootView.

   635 

   636             (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[

   637                 newItems add:anItem.

   638             ]

   639         ].

   640         model value:newItems.

   641     ].

   642 !

   643 

   644 processEvent:anEvent

   645     "process an event

   646     "

   647     |button menu|

   648 

   649     anEvent isKeyPressEvent ifTrue:[ ^ self processKeyPressEvent:anEvent ].

   650     anEvent isButtonEvent  ifFalse:[ ^ self ].

   651 

   652     button := anEvent button.

   653 

   654     (button == 2 or:[button == #menu]) ifTrue:[

   655         motionAction isNil ifTrue:[

   656             anEvent isButtonPressEvent ifTrue:[

   657                 self selectOnClickHolder value ifTrue:[

   658                     menu := self middleButtonMenu value.

   659                     menu notNil ifTrue:[

   660                         menu := MenuPanel menu:(Menu new fromLiteralArrayEncoding:menu)

   661                                       receiver:self.

   662                         menu startUp.

   663                     ]

   664                 ].

   665             ].

   666             clickedItem := nil.

   667         ].

   668         ^ self

   669     ].

   670 

   671     anEvent isButtonPressEvent  ifTrue:[ ^ self processButtonPressEvent:anEvent  ].

   672     anEvent isButtonMotionEvent ifTrue:[ ^ self processButtonMotionEvent:anEvent ].

   673 

   674     anEvent isButtonReleaseEvent ifTrue:[

   675         self selectOnClickHolder value ifTrue:[

   676             self processButtonReleaseEvent:anEvent

   677         ].

   678     ].

   679     clickedItem := motionAction := nil.

   680 

   681     anEvent type == #'buttonMultiPress:x:y:' ifTrue:[

   682         self selectOnClickHolder value ifTrue:[

   683             self doInspect:#view.

   684         ].

   685     ].

   686 !

   687 

   688 processKeyPressEvent:anEvent

   689     "process an key press event

   690     "

   691     |item prnt idx key max next|

   692 

   693     key := anEvent key.

   694     key isSymbol ifFalse:[^ self].

   695 

   696     key == #Delete    ifTrue:[ ^ self doDestroy ].

   697     key == #InspectIt ifTrue:[ ^ self doInspect:#view ].

   698 

   699     (   key == #CursorUp

   700     or:[key == #CursorDown

   701     or:[key == #CursorLeft

   702     or:[key == #CursorRight]]]

   703     ) ifFalse:[

   704         ^ self

   705     ].

   706     item := model selectedItem.

   707 

   708     item isNil ifTrue:[

   709         ^ model selectedItem:(model first ? model rootItem)

   710     ].

   711 

   712     prnt := item parent.

   713     prnt isNil ifTrue:[

   714         "/ is the root item

   715         (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last]

   716                                                   ifFalse:[item := item at:1 ifAbsent:item].

   717 

   718       ^ model selectedItem:item

   719     ].

   720     key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ].

   721 

   722     key == #CursorRight ifTrue:[

   723         next := item at:1 ifAbsent:nil.

   724         next notNil ifTrue:[ model selectedItem:next ].

   725       ^ self

   726     ].

   727 

   728     max := prnt size.

   729 

   730     key == #CursorUp ifTrue:[

   731         idx := prnt identityIndexOf:item.

   732         idx == 1 ifTrue:[idx := max + 1].

   733         model selectedItem:(prnt at:idx - 1).

   734       ^ self.

   735     ].

   736 

   737     key == #CursorDown ifTrue:[

   738         idx := prnt identityIndexOf:item.

   739         idx == max ifTrue:[idx := 0].

   740         model selectedItem:(prnt at:idx + 1).

   741       ^ self.

   742     ].

   743 !

   744 

   745 processMappedView:aView

   746     "process a mapped event

   747     "

   748     |parent anchor|

   749 

   750     parent := self listOfItems detectItemRespondsToView:aView.

   751     parent isNil ifTrue:[ ^ self ].

   752 

   753     NotFoundSignal handle:[:ex|

   754         "contained subvies used by spec are not yet created;

   755          thus we have to wait until last used subview is build

   756         "

   757         anchor := nil.

   758     ] do:[

   759         anchor := parent class buildViewsFrom:(parent widget).

   760     ].

   761     anchor notNil ifTrue:[

   762         parent updateFromChildren:anchor children.

   763     ].

   764 ! !

   765 

   766 !ViewTreeApplication methodsFor:'initialization & release'!

   767 

   768 closeDownViews

   769     "release the grapped application

   770     "

   771     process := nil.

   772     super closeDownViews.

   773     self doUnpick.

   774 !

   775 

   776 initialize

   777     "setup my model and channels

   778     "

   779     super initialize.

   780 

   781     infoChannel              := ''    asValue.

   782     hasSingleSelectionHolder := false asValue.

   783     followFocusChannel       := false asValue.

   784 

   785     model := ViewTreeModel new.

   786     model inputEventAction:[:ev| self processEvent:ev ].

   787     model mappedViewAction:[:vw| self processMappedView:vw ].

   788     model application:self.

   789 

   790     testModeChannel := model testMode asValue.

   791     testModeChannel addDependent:self.

   792 !

   793 

   794 postBuildTree:aTree

   795     treeView := aTree scrolledView.

   796     treeView hasConstantHeight:true.

   797 ! !

   798 

   799 !ViewTreeApplication methodsFor:'menu queries'!

   800 

   801 hasApplication

   802     "returns true if the current selected view has an application

   803     "

   804     |view|

   805 

   806     view := self selectedView.

   807   ^ (view notNil and:[view application notNil])

   808 !

   809 

   810 hasController

   811     "returns true if the current selected item's view has a controller

   812      other than nil or the view itself

   813     "

   814     |view controller|

   815 

   816     view := self selectedView.

   817 

   818     view notNil ifTrue:[

   819         controller := view controller.

   820       ^ (controller notNil and:[controller ~~ view])

   821     ].

   822     ^ false

   823 !

   824 

   825 hasModel

   826     "returns true if the current selected view has a model

   827     "

   828     |view|

   829 

   830     view := self selectedView.

   831   ^ (view notNil and:[view model notNil])

   832 !

   833 

   834 hasPickedView

   835     "returns true if a view is picked

   836     "

   837     ^ model rootItem notNil

   838 ! !

   839 

   840 !ViewTreeApplication methodsFor:'menu specs'!

   841 

   842 middleButtonMenu

   843     "returns the middleButton menu for the single selected item or nil

   844     "

   845     ^ [ model selectedItem notNil ifTrue:[self class middleButtonMenu]

   846                                  ifFalse:[nil]

   847       ]

   848 !

   849 

   850 submenuApplications:aMenu

   851     |applications menu item list addBlock|

   852 

   853     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]

   854                                               ifFalse:[model rootItem].

   855     item isNil ifTrue:[^ nil].

   856 

   857     applications := IdentityDictionary new.

   858 

   859     addBlock := [:el| |cls ctr|

   860         cls := self resolveApplicationClassFor:el.

   861 

   862         cls notNil ifTrue:[

   863             ctr := applications at:cls ifAbsent:0.

   864             applications at:cls put:(ctr + 1).

   865         ].

   866     ].

   867     item recursiveDo:addBlock.

   868     addBlock value:item.

   869 

   870     applications isEmpty ifTrue:[^ nil ].

   871     list := SortedCollection sortBlock:[:a :b| a title < b title ].

   872 

   873     applications keysAndValuesDo:[:cls :ctr|

   874        list add:(MenuDesc title:(cls name)

   875                           value:(ctr printString)

   876                          action:[self doSelectNextOfApplicationClass:cls startingIn:item]

   877                  ).

   878     ].

   879 

   880     menu := MenuDesc buildFromList:list onGC:aMenu.

   881     menu do:[:el|

   882         el hideMenuOnActivated:false

   883     ].

   884     ^ menu

   885 !

   886 

   887 submenuComponents:aMenu

   888     |widgets list total menu item|

   889 

   890     item := aMenu selection nameKey == #single ifTrue:[model selectedItem]

   891                                               ifFalse:[model rootItem].

   892     item isNil ifTrue:[^ nil].

   893 

   894     widgets := IdentityDictionary new.

   895     total   := 0.

   896 

   897     item recursiveDo:[:el| |cls ctr|

   898         cls := el widget.

   899 

   900         cls notNil ifTrue:[

   901             cls := cls class.

   902             ctr := widgets at:cls ifAbsent:0.

   903             widgets at:cls put:(ctr + 1).

   904             total := total + 1.

   905         ].

   906     ].

   907     total == 0 ifTrue:[^ nil].

   908     list := SortedCollection sortBlock:[:a :b| a title < b title ].

   909 

   910     widgets keysAndValuesDo:[:cls :ctr|

   911         list add:(MenuDesc title:(cls name)

   912                            value:(ctr printString)

   913                           action:[self doSelectNextOfClass:cls startingIn:item]

   914                  ).

   915     ].

   916     list := list asOrderedCollection.

   917     list add:(MenuDesc separator).

   918     list add:(MenuDesc title:'Total' value:(total printString)).

   919     menu := MenuDesc buildFromList:list onGC:aMenu.

   920     menu do:[:el|

   921         el hideMenuOnActivated:false

   922     ].

   923     ^ menu

   924 !

   925 

   926 submenuGeometry:aMenu

   927     "builds and returns the geometry submenu

   928     "

   929     |view point inst list x y|

   930 

   931     view := self selectedView.

   932     view isNil ifTrue:[^ nil].

   933 

   934     list := OrderedCollection new.

   935 

   936     "/ origin

   937     point := view relativeOrigin.

   938     point isNil ifTrue:[ point := view origin ].

   939 

   940     x := view left.

   941     y := view top.

   942 

   943     (x == point x and:[y == point y]) ifTrue:[ inst := point ]

   944                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].

   945 

   946     list add:(MenuDesc title:'origin' value:inst).

   947 

   948     "/ corner

   949     point := view relativeCorner.

   950     point isNil ifTrue:[ point := view corner ].

   951 

   952     x := view right.

   953     y := view bottom.

   954 

   955     (x == point x and:[y == point y]) ifTrue:[ inst := point ]

   956                                      ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ].

   957 

   958     list add:(MenuDesc title:'corner' value:inst).

   959 

   960     "/ extent

   961     (point := view relativeExtent) isNil ifTrue:[point := view extent].

   962     list add:(MenuDesc title:'extent' value:point).

   963 

   964     "/ preferred extent

   965     list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)).

   966     list add:(MenuDesc separator).

   967 

   968     "/ view insets

   969     inst := 'l:%1  r:%2  t:%3  b:%4' bindWith:(view leftInset)

   970                                          with:(view rightInset)

   971                                          with:(view topInset)

   972                                          with:(view bottomInset).

   973 

   974     list add:(MenuDesc title:'insets'      value:inst).

   975     list add:(MenuDesc title:'borderWidth' value:(view borderWidth)).

   976     list add:(MenuDesc title:'level'       value:(view level)).

   977     list add:(MenuDesc separator).

   978 

   979     (inst := view layout) notNil ifTrue:[ inst := inst displayString ].

   980     list add:(MenuDesc title:'layout' value:inst).

   981 

   982     (inst := view transformation) notNil ifTrue:[ inst := inst displayString ].

   983     list add:(MenuDesc title:'transformation' value:inst).

   984 

   985   ^ MenuDesc buildFromList:list onGC:aMenu

   986 !

   987 

   988 submenuInspector:aMenu

   989     "builds and returns the inspector submenu

   990     "

   991     |view list n names label value|

   992 

   993     view := self selectedView.

   994     view isNil ifTrue:[^ nil].

   995 

   996     n := view class instSize.

   997     n > 0 ifFalse:[^ nil ].

   998 

   999     list  := OrderedCollection new:n.

  1000     names := view class allInstVarNames.

  1001 

  1002     1 to:n do:[:i| |action|

  1003         label := (names at:i) printString.

  1004         value := view instVarAt:i.

  1005         value isNil ifTrue:[

  1006             value  := '------'.

  1007             action := nil.

  1008         ] ifFalse:[

  1009             value  := value displayString contractAtEndTo:40.

  1010             action := [(view instVarAt:i) inspect].

  1011         ].

  1012         list add:(MenuDesc title:label value:value action:action).

  1013     ].

  1014 

  1015     ^ MenuDesc buildFromList:list onGC:aMenu

  1016 !

  1017 

  1018 submenuInterface:aMenu

  1019     "builds and returns the interface submenu

  1020     "

  1021     |view label inst value list|

  1022 

  1023     view := self selectedView.

  1024     view isNil ifTrue:[^ nil].

  1025 

  1026     list := OrderedCollection new.

  1027 

  1028     inst  := view controller.

  1029     value := nil.

  1030 

  1031     inst isNil ifTrue:[

  1032         label := nil

  1033     ] ifFalse:[

  1034         inst == view ifTrue:[ label := '== view itself' ]

  1035                     ifFalse:[ label := inst displayString.

  1036                               value := [view controller inspect].

  1037                             ].

  1038     ].

  1039     list add:(MenuDesc title:'controller' value:label action:value).

  1040 

  1041     inst := view delegate.

  1042     inst notNil ifTrue:[

  1043         list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]).

  1044     ].

  1045 

  1046     inst := view application.

  1047 

  1048     inst notNil ifTrue:[ |topAppl|

  1049         list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]).

  1050 

  1051         topAppl := inst topApplication.

  1052 

  1053         (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[

  1054             list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]).

  1055         ].

  1056     ].

  1057     list add:(MenuDesc separator).

  1058 

  1059     (view respondsTo:#'model:') ifTrue:[

  1060         inst := model.

  1061 

  1062         inst isNil ifTrue:[ label := value := nil ]

  1063                   ifFalse:[ label := inst displayString.

  1064                             value := [ view model inspect ].

  1065                           ].

  1066 

  1067         list add:(MenuDesc title:'model' value:label action:value).

  1068 

  1069         (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[

  1070             view modelInterface keysAndValuesDo:[:key : val|

  1071                 val isNil ifTrue:[ label := nil ]

  1072                          ifFalse:[ label := val displayString ].

  1073 

  1074                 list add:(MenuDesc title:('      - ', key) value:label ).

  1075             ]

  1076         ].

  1077     ].

  1078 

  1079     (view respondsTo:#enableChannel) ifTrue:[

  1080         inst := view enableChannel.

  1081 

  1082         inst isNil ifTrue:[ label := value := nil ]

  1083                   ifFalse:[ label := inst displayString.

  1084                             value := [ view enableChannel inspect ].

  1085                           ].

  1086 

  1087         list add:(MenuDesc title:'enableChannel' value:label action:value).

  1088     ].

  1089 

  1090     list last isSeparator ifFalse:[ list add:(MenuDesc separator) ].

  1091 

  1092     (view respondsTo:#listHolder) ifTrue:[

  1093         inst := view listHolder.

  1094 

  1095         inst isNil ifTrue:[ label := value := nil ]

  1096                   ifFalse:[ label := inst class printString.

  1097                             value := [ view listHolder inspect ].

  1098                           ].

  1099         list add:(MenuDesc title:'listHolder' value:label action:value).

  1100     ].

  1101 

  1102     (view respondsTo:#list) ifTrue:[

  1103         inst := view list.

  1104 

  1105         inst isNil ifTrue:[ label := value := nil ]

  1106                   ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size).

  1107                             value := [ view list inspect ].

  1108                           ].

  1109 

  1110         list add:(MenuDesc title:'list' value:label action:value).

  1111     ].

  1112 

  1113     list last isSeparator ifTrue:[ list removeLast ].

  1114   ^ MenuDesc buildFromList:list onGC:aMenu

  1115 !

  1116 

  1117 submenuVisibility:aMenu

  1118     "builds and returns the geometry submenu

  1119     "

  1120     |view list value|

  1121 

  1122     view := self selectedView.

  1123     view isNil ifTrue:[^ nil].

  1124 

  1125     list := OrderedCollection new.

  1126 

  1127     list add:(MenuDesc title:'device'     value:(view device printString)).

  1128     list add:(MenuDesc title:'drawableId' value:(view id)).

  1129     list add:(MenuDesc title:'gcId'       value:(view gcId)).

  1130 

  1131     list add:(MenuDesc separator).

  1132 

  1133     list add:(MenuDesc title:'shown'    value:(view shown)).

  1134     list add:(MenuDesc title:'realized' value:(view realized)).

  1135