cg@2748: " cg@2748: COPYRIGHT (c) 2007 by eXept Software AG cg@3524: All Rights Reserved cg@2748: cg@2748: This software is furnished under a license and may be used cg@2748: only in accordance with the terms of that license and with the cg@2748: inclusion of the above copyright notice. This software may not cg@2748: be provided or otherwise made available to, or used by, any cg@2748: other person. No title to or ownership of the software is cg@2748: hereby transferred. cg@2748: " ca@2177: "{ Package: 'stx:libtool2' }" ca@2177: ca@2177: "{ NameSpace: Tools }" ca@2177: cg@2744: ToolApplicationModel subclass:#ViewTreeInspectorApplication ca@2177: instanceVariableNames:'model treeView hasSingleSelectionHolder clickedItem clickedPoint cg@2770: motionAction process followFocusChannel showNamesHolder cg@3124: inspectorView inspectorModeIndexHolder path cg@3302: isCatchingEventsChannel browser' ca@2177: classVariableNames:'' ca@2177: poolDictionaries:'' cg@2744: category:'Interface-Smalltalk' ca@2177: ! ca@2177: ca@2177: Object subclass:#MenuDesc ca@2177: instanceVariableNames:'title value action' ca@2177: classVariableNames:'' ca@2177: poolDictionaries:'' cg@2744: privateIn:ViewTreeInspectorApplication cg@2744: ! cg@2744: cg@2744: HierarchicalItem subclass:#ViewTreeItem cg@3456: instanceVariableNames:'widget menuItem isDrawnShown exists xOffsetAdditionalName' cg@2744: classVariableNames:'HandleExtent' cg@2744: poolDictionaries:'' cg@2744: privateIn:ViewTreeInspectorApplication ca@2177: ! ca@2177: cg@2744: ValueModel subclass:#ViewTreeModel cg@2744: instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems cg@2744: inputEventAction mappedViewAction beforeSelectionChangedAction cg@2744: icons timedUpdateTask selectOnClickHolder testModeChannel cg@2978: hasTargetWidgetChannel catchEvents' cg@2744: classVariableNames:'' cg@2744: poolDictionaries:'' cg@2744: privateIn:ViewTreeInspectorApplication cg@2744: ! cg@2744: cg@2744: HierarchicalList subclass:#ItemList cg@2744: instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames' cg@2744: classVariableNames:'' cg@2744: poolDictionaries:'' cg@2744: privateIn:ViewTreeInspectorApplication::ViewTreeModel cg@2744: ! cg@2744: cg@2744: !ViewTreeInspectorApplication class methodsFor:'documentation'! ca@2177: cg@2748: copyright cg@2748: " cg@2748: COPYRIGHT (c) 2007 by eXept Software AG cg@3524: All Rights Reserved cg@2748: cg@2748: This software is furnished under a license and may be used cg@2748: only in accordance with the terms of that license and with the cg@2748: inclusion of the above copyright notice. This software may not cg@2748: be provided or otherwise made available to, or used by, any cg@2748: other person. No title to or ownership of the software is cg@2748: hereby transferred. cg@2748: " cg@2748: ! cg@2748: ca@2177: documentation ca@2177: " ca@2177: Small application showing a ViewTreeModel use. ca@2177: ca@2177: It displays a hierarchical list of a selected TopView and ca@2177: all its contained subViews. ca@2177: Useful to have a look at subcomponents - to see how views ca@2177: are structured. ca@2177: ca@2177: ca@2177: [Instance variables:] cg@3524: model the used ViewTreeModel cg@3524: clickedItem item under the clickedPoint (motion action) cg@3524: clickedPoint point where the motion action started from. cg@3524: motionAction (oneArg-) action called durring buttonMotion. ca@2177: ca@2177: ca@2177: [author:] cg@3524: Claus Atzkern ca@2177: ca@2177: [see also:] cg@3524: ViewTreeModel cg@3524: ViewTreeItem ca@2177: " ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication class methodsFor:'initialization'! ca@2177: ca@2177: initialize ca@2177: "add myself to the launcher menu ca@2177: " ca@2177: self installInLauncher. ca@2177: ! ca@2177: ca@2177: installInLauncher cg@2744: "add myself to the launcher menu" cg@2744: ca@2177: |menuItem icon| ca@2177: ca@2177: NewLauncher isNil ifTrue:[^ self]. cg@2744: "/ cg - disabled. the icon is too ugly. cg@2744: ^ self. ca@2177: cg@3341: "/ icon := ToolbarIconLibrary inspectLocals20x20Icon magnifiedTo:28@28. cg@3341: "/ cg@3524: "/ menuItem := MenuItem new cg@3341: "/ label: 'View Tree Inspector'; cg@3341: "/ value: [ ViewTreeInspectorApplication open]; cg@3341: "/ isButton: true; cg@3341: "/ icon: icon; cg@3341: "/ nameKey: #viewInspect. cg@3341: "/ cg@3341: "/ menuItem startGroup:#right. cg@3341: "/ NewLauncher addMenuItem:menuItem in:'toolbar' cg@3341: "/ position:#( #before #help) cg@3341: "/ space:false. cg@3341: cg@3341: " cg@3341: self installInLauncher cg@3341: self removeFromLauncher cg@3341: " ca@2177: ! ca@2177: ca@2177: postAutoload ca@2177: "add myself to the launcher menu ca@2177: " ca@2177: self installInLauncher. ca@2177: " ca@2177: self installInLauncher ca@2177: self removeFromLauncher ca@2177: " ca@2177: ! ca@2177: ca@2177: removeFromLauncher ca@2177: "remove myself from the launcher menu ca@2177: " ca@2177: NewLauncher isNil ifTrue:[^ self]. ca@2177: NewLauncher removeUserTool:#viewInspect ca@2177: ca@2177: " ca@2177: self installInLauncher ca@2177: self removeFromLauncher ca@2177: " ca@2177: ! ca@2177: ca@2177: unload ca@2177: "class is about to be unloaded - remove myself from the launcher menu ca@2177: " ca@2177: self removeFromLauncher. ca@2177: super unload. ca@2177: ! ! ca@2177: cg@3070: !ViewTreeInspectorApplication class methodsFor:'help specs'! cg@3070: cg@3524: helpSpec cg@3070: cg@3070: cg@3524: ^super helpSpec addPairsFrom:#( cg@3070: cg@3186: #doRedraw cg@3186: 'Force the application to redraw its windows' cg@3186: cg@3070: #doUncatchEvents cg@3524: 'Release picked view and uncatch events\(currently locked for widget selection)' cg@3070: cg@3070: #doCatchEvents cg@3524: 'Lock view and catch events for widget selection\(currently unlocked)' cg@3070: cg@3186: #doInspectApplication cg@3524: 'Inspect the selected view''s application' cg@3186: cg@3186: #doBrowseApplication cg@3524: 'Browse the selected view''s application' cg@3186: cg@3186: #doPickView cg@3524: 'Pick a widget with the mouse and inspect its view hierarchy' cg@3186: cg@3070: ) cg@3070: ! ! cg@3070: cg@2744: !ViewTreeInspectorApplication class methodsFor:'image specs'! cg@2744: cg@2759: crossHairIcon cg@3185: ^ ToolbarIconLibrary bigCrossHairIcon cg@2759: ! cg@2759: cg@3070: lockViewIcon cg@3070: "This resource specification was automatically generated cg@3070: by the ImageEditor of ST/X." cg@3070: cg@3070: "Do not manually edit this!! If it is corrupted, cg@3070: the ImageEditor may not be able to read the specification." cg@3070: cg@3070: " cg@3070: self lockViewIcon inspect cg@3070: ImageEditor openOnClass:self andSelector:#lockViewIcon cg@3070: Icon flushCachedIcons cg@3070: " cg@3070: cg@3070: cg@3070: cg@3070: ^Icon cg@3524: constantNamed:'Tools::ViewTreeInspectorApplication lockViewIcon' cg@3524: ifAbsentPut:[(Depth8Image new) width: 24; height: 24; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:' cg@3070: @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ cg@3070: @@@@@@@@@@@@@@A8^G!!7O3ACP5*P@@A8^G @@@@@@@@@@@A8^@@@OE0/!!P0S#0@@^G @@@@@@@@@@@B (@D''D#48"1.CX5H@(J@@@@@@@@@@@@B (B(>SAT" cg@3070: ''%!!/P7,@(J@@@@@@@@@@@@@%IB0#M"H%IRTQV5P@IRT@@@@@@@@@@@ANSX:U]PANS$8:T80@S$8@@@@@@@@@@@AN&UYWK(EYQ@\FUPQHXT8@@@@@@@@@@@AN cg@3070: HC2!!TVY:Y#-%I*IKMD8@@@@@@@@@@@A$\@83XBEG%).GGX _!!&P@@@@@@@@@@@AO[P5+ &(WPYN@["!!E\$<@@@@@@@@@@@B_F''FQPAXX_!!&TGH4HB9<@@@@@ cg@3070: @@@@@@B_%3HCJ7=BKPU,Q)01B9<@@@@@@@@@@@@PBP8T_F!!''JPI)_Y"D&!!@@@@@@@@@@@@@$B)I9TGXO''WQIWQ93W0@@@@@@@@@@@@@$"U=JR$)JR$)JR$)_ cg@3070: "P@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ cg@3070: @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@') ; colorMapFromArray:#[132 141 152 147 150 154 250 223 1 246 214 0 205 172 133 238 195 0 213 180 146 217 186 150 188 136 0 206 151 0 183 125 9 208 208 202 196 204 214 255 255 210 255 255 219 210 178 65 242 242 235 106 112 117 96 107 126 250 255 255 255 241 0 154 154 151 255 227 0 67 35 0 52 17 0 253 211 0 208 159 0 167 178 193 222 168 0 248 231 45 208 174 26 199 152 26 225 184 36 255 249 75 220 220 215 77 88 108 241 241 235 245 245 239 255 250 109 242 249 255 255 255 142 255 237 1 142 148 162 242 212 1 143 154 176 174 133 0 222 189 144 169 179 192 177 184 193 184 129 0 255 255 194 253 241 60 210 210 205 214 214 209 77 83 92 230 230 225 98 106 114 243 243 238 117 117 114 255 252 115 255 255 255 115 123 147 130 140 156 152 156 159 241 210 0 53 18 0 151 116 0 162 170 184 218 187 150 193 143 4 220 165 0 206 188 46 181 130 21 204 173 44 206 206 201 208 167 44 72 84 108 240 240 234 244 244 238 243 243 237 212 182 79 255 255 126 131 135 141 119 133 159 132 141 163 195 162 126 219 188 133 218 185 135 180 180 176 221 190 150 175 181 191 176 183 196 181 189 201 202 170 38 209 209 204 207 207 202 251 241 74 229 229 224 238 238 233 226 234 245 244 244 237 255 251 113 255 255 124 255 241 2 255 234 3 249 219 0 255 249 29 252 243 30 227 181 0 212 165 5 222 170 0 173 179 194 216 171 19 255 255 198 208 208 203 156 90 7 206 175 50 91 91 95 211 180 71 242 242 237 246 246 241 212 182 80 255 255 123 129 137 152 255 239 8 251 223 0 59 25 0 251 215 0 228 183 0 222 191 149 249 238 43 177 186 197 187 129 0 186 194 206 209 209 203 249 238 67 255 255 211 226 226 221 235 235 229 100 103 111 76 93 127 255 255 112 88 104 139 130 135 148 149 155 158 247 218 0 224 194 126 255 217 0 228 184 0 13 30 68 161 138 32 204 152 0 255 255 53 206 155 18 207 207 201 255 250 72 255 255 82 209 176 59 232 232 227 243 243 236 245 245 240 255 255 115 255 255 251]; mask:((Depth1Image new) width: 24; height: 24; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@G8@@O<@@_>@@^^@@\N@@\N@@?? @?? @?? @?? @?? @?? @?? @?? @_?@@@@@@@@@@@@@@@@@@@@@') ; yourself); yourself] cg@3070: ! cg@3070: cg@3000: releaseViewIcon cg@3000: "This resource specification was automatically generated cg@3000: by the ImageEditor of ST/X." cg@3000: cg@3000: "Do not manually edit this!! If it is corrupted, cg@3000: the ImageEditor may not be able to read the specification." cg@3000: cg@3000: " cg@3000: self releaseViewIcon inspect cg@3000: ImageEditor openOnClass:self andSelector:#releaseViewIcon cg@3000: Icon flushCachedIcons cg@3000: " cg@3000: cg@3000: cg@3000: ^Icon cg@3524: constantNamed:'Tools::ViewTreeInspectorApplication releaseViewIcon' cg@3524: ifAbsentPut:[(Depth8Image new) width: 24; height: 24; photometric:(#palette); bitsPerSample:(#[8]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:' cg@3000: @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ cg@3000: @@@@@@@@@@@@@@A8^G!!7O3ACP5*P@@A8^G @@@@@@@@@@@A8^@@@OE0/!!P0S#0@@^G @@@@@@@@@@@B (@@''D#48"1.CX5H@(J@@@@@@@@@@@@B (@@@@@@" cg@3000: ''%!!/P7,@(J@@@@@@@@@@@@@%I@@@@BH%IRTQV5P@IRT@@@@@@@@@@@ANSP@@@@ANS$8:T80@S$8@@@@@@@@@@@AN&UYWK(EYQ@\FUPQHXT8@@@@@@@@@@@AN cg@3000: HC2!!TVY:Y#-%I*IKMD8@@@@@@@@@@@A$\@83XBEG%).GGX _!!&P@@@@@@@@@@@AO[P5+ &(WPYN@["!!E\$<@@@@@@@@@@@B_F''FQPAXX_!!&TGH4HB9<@@@@@ cg@3000: @@@@@@B_%3HCJ7=BKPU,Q)01B9<@@@@@@@@@@@@PBP8T_F!!''JPI)_Y"D&!!@@@@@@@@@@@@@$B)I9TGXO''WQIWQ93W0@@@@@@@@@@@@@$"U=JR$)JR$)JR$)_ cg@3000: "P@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ cg@3000: @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@') ; colorMapFromArray:#[132 141 152 147 150 154 250 223 1 246 214 0 205 172 133 238 195 0 213 180 146 217 186 150 188 136 0 206 151 0 183 125 9 208 208 202 196 204 214 255 255 210 255 255 219 210 178 65 242 242 235 106 112 117 96 107 126 250 255 255 255 241 0 154 154 151 255 227 0 67 35 0 52 17 0 253 211 0 208 159 0 167 178 193 222 168 0 248 231 45 208 174 26 199 152 26 225 184 36 255 249 75 220 220 215 77 88 108 241 241 235 245 245 239 255 250 109 242 249 255 255 255 142 255 237 1 142 148 162 242 212 1 143 154 176 174 133 0 222 189 144 169 179 192 177 184 193 184 129 0 255 255 194 253 241 60 210 210 205 214 214 209 77 83 92 230 230 225 98 106 114 243 243 238 117 117 114 255 252 115 255 255 255 115 123 147 130 140 156 152 156 159 241 210 0 53 18 0 151 116 0 162 170 184 218 187 150 193 143 4 220 165 0 206 188 46 181 130 21 204 173 44 206 206 201 208 167 44 72 84 108 240 240 234 244 244 238 243 243 237 212 182 79 255 255 126 131 135 141 119 133 159 132 141 163 195 162 126 219 188 133 218 185 135 180 180 176 221 190 150 175 181 191 176 183 196 181 189 201 202 170 38 209 209 204 207 207 202 251 241 74 229 229 224 238 238 233 226 234 245 244 244 237 255 251 113 255 255 124 255 241 2 255 234 3 249 219 0 255 249 29 252 243 30 227 181 0 212 165 5 222 170 0 173 179 194 216 171 19 255 255 198 208 208 203 156 90 7 206 175 50 91 91 95 211 180 71 242 242 237 246 246 241 212 182 80 255 255 123 129 137 152 255 239 8 251 223 0 59 25 0 251 215 0 228 183 0 222 191 149 249 238 43 177 186 197 187 129 0 186 194 206 209 209 203 249 238 67 255 255 211 226 226 221 235 235 229 100 103 111 76 93 127 255 255 112 88 104 139 130 135 148 149 155 158 247 218 0 224 194 126 255 217 0 228 184 0 13 30 68 161 138 32 204 152 0 255 255 53 206 155 18 207 207 201 255 250 72 255 255 82 209 176 59 232 232 227 243 243 236 245 245 240 255 255 115 255 255 251]; mask:((Depth1Image new) width: 24; height: 24; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@@@@@@@@@@@@@G8@@O<@@O>@@@^@@@N@@@N@@?? @?? @?? @?? @?? @?? @?? @?? @_?@@@@@@@@@@@@@@@@@@@@@') ; yourself); yourself] cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication class methodsFor:'interface specs'! ca@2177: ca@2177: windowSpec ca@2177: "This resource specification was automatically generated ca@2177: by the UIPainter of ST/X." ca@2177: ca@2177: "Do not manually edit this!! If it is corrupted, ca@2177: the UIPainter may not be able to read the specification." ca@2177: ca@2177: " cg@2757: UIPainter new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#windowSpec cg@2757: Tools::ViewTreeInspectorApplication new openInterface:#windowSpec cg@2757: Tools::ViewTreeInspectorApplication open ca@2177: " ca@2177: ca@2177: ca@2177: cg@3524: ^ cg@3037: #(FullSpec cg@3037: name: windowSpec cg@3524: window: cg@3037: (WindowSpec cg@3524: label: 'View Tree Inspector' cg@3524: name: 'View Tree Inspector' cg@3524: min: (Point 10 10) cg@3524: max: (Point 1024 9999) cg@3524: bounds: (Rectangle 0 0 693 643) cg@3524: menu: menu cg@3037: ) cg@3524: component: cg@3037: (SpecCollection cg@3524: collection: ( cg@3524: (MenuPanelSpec cg@3524: name: 'toolbarMenu' cg@3524: layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0) cg@3524: menu: toolbarMenu cg@3524: textDefault: true cg@3524: ) cg@3524: (VariableVerticalPanelSpec cg@3524: name: 'VariableVerticalPanel1' cg@3524: layout: (LayoutFrame 0 0.0 40 0.0 0 1.0 0 1.0) cg@3524: component: cg@3524: (SpecCollection cg@3524: collection: ( cg@3524: (ViewSpec cg@3524: name: 'PathAndListPane' cg@3524: component: cg@3524: (SpecCollection cg@3524: collection: ( cg@3524: (ViewSpec cg@3524: name: 'PathPane' cg@3524: layout: (LayoutFrame 0 0 0 0 0 1 25 0) cg@3524: component: cg@3524: (SpecCollection cg@3524: collection: ( cg@3524: (InputFieldSpec cg@3524: name: 'Path' cg@3524: layout: (LayoutFrame 0 0 0 0 0 1 0 1) cg@3524: model: path cg@3524: acceptOnReturn: true cg@3524: acceptOnTab: true cg@3524: acceptOnPointerLeave: true cg@3524: emptyFieldReplacementText: 'No View Selected' cg@3524: ) cg@3524: ) cg@3524: cg@3524: ) cg@3524: ) cg@3524: (HierarchicalListViewSpec cg@3524: name: 'List' cg@3524: layout: (LayoutFrame 0 0 25 0 0 1 0 1) cg@3524: level: 1 cg@3524: model: model cg@3524: menu: middleButtonMenu cg@3524: hasHorizontalScrollBar: true cg@3524: hasVerticalScrollBar: true cg@3524: miniScrollerHorizontal: true cg@3524: miniScrollerVertical: false cg@3524: listModel: listOfItems cg@3524: multipleSelectOk: true cg@3524: useIndex: false cg@3524: highlightMode: label cg@3524: showLeftIndicators: false cg@3524: indicatorSelector: indicatorClicked: cg@3524: useDefaultIcons: false cg@3524: postBuildCallback: postBuildTree: cg@3524: ) cg@3524: ) cg@3524: cg@3524: ) cg@3524: ) cg@3524: (ViewSpec cg@3524: name: 'Box2' cg@3524: component: cg@3524: (SpecCollection cg@3524: collection: ( cg@3524: (TabViewSpec cg@3524: name: 'TabHeader1' cg@3524: layout: (LayoutFrame 0 0.0 0 0 0 1.0 25 0) cg@3524: model: inspectorModeIndexHolder cg@3524: menu: inspectorModes cg@3524: useIndex: true cg@3524: translateLabel: true cg@3524: ) cg@3524: (SubCanvasSpec cg@3524: name: 'Browser' cg@3524: layout: (LayoutFrame 0 0 26 0 0 1 0 1) cg@3524: visibilityChannel: browserVisibleHolder cg@3524: hasHorizontalScrollBar: true cg@3524: hasVerticalScrollBar: true cg@3524: majorKey: #'Tools::NewSystemBrowser' cg@3524: minorKey: singleClassWithoutVariableListBrowserSpec cg@3524: createNewApplication: true cg@3524: createNewBuilder: true cg@3524: postBuildCallback: postBuildBrowserCanvas: cg@3524: ) cg@3524: (ViewSpec cg@3524: name: 'Inspector' cg@3524: layout: (LayoutFrame 0 0 26 0 0 1 0 1) cg@3524: visibilityChannel: inspectorVisibleHolder cg@3524: postBuildCallback: postBuildInspectorView: cg@3524: viewClassName: 'InspectorView' cg@3524: ) cg@3524: ) cg@3524: cg@3524: ) cg@3524: ) cg@3524: ) cg@3524: cg@3524: ) cg@3524: handles: (Any 0.5 1.0) cg@3524: ) cg@3524: ) cg@3524: cg@3037: ) cg@3037: ) ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication class methodsFor:'menu specs'! ca@2177: ca@2177: menu ca@2177: "This resource specification was automatically generated ca@2177: by the MenuEditor of ST/X." ca@2177: ca@2177: "Do not manually edit this!! If it is corrupted, cg@3524: the MenuEditor may not be able to read the specification." ca@2177: cg@2978: ca@2177: " cg@2978: MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#menu cg@2978: (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication menu)) startUp ca@2177: " ca@2177: ca@2177: ca@2177: cg@3524: ^ ca@2177: #(Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'File' cg@3524: submenu: cg@3524: (Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'Pick a View' cg@3524: itemValue: doPickView cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasTargetWidgetChannel cg@3524: label: 'Release Picked View' cg@3524: itemValue: doUnpick cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Settings' cg@3524: submenu: cg@3524: (Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'Test Mode' cg@3524: hideMenuOnActivated: false cg@3524: indication: testModeChannel cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: testModeChannel cg@3524: label: 'Follow Focus' cg@3524: hideMenuOnActivated: false cg@3524: indication: followFocusChannel cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Select on Click' cg@3524: hideMenuOnActivated: false cg@3524: indication: selectOnClickHolder cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Show Name of Widgets' cg@3524: hideMenuOnActivated: false cg@3524: indication: showNamesHolder cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3524: ) cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Exit' cg@3524: itemValue: closeRequest cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3524: ) cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Selection' cg@3524: submenuChannel: middleButtonMenu cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Widget' cg@3524: submenu: cg@3524: (Menu cg@3524: ( cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Browse' cg@3524: itemValue: doBrowse: cg@3524: argument: view cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Inspect' cg@3524: itemValue: doInspect: cg@3524: argument: view cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasTargetWidgetChannel cg@3524: label: 'All Components' cg@3524: startGroup: right cg@3524: submenuChannel: submenuComponents: cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3524: ) cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Application' cg@3524: submenu: cg@3524: (Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'Redraw' cg@3524: itemValue: doRedraw cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Browse' cg@3524: itemValue: doBrowse: cg@3524: argument: application cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Inspect' cg@3524: itemValue: doInspect: cg@3524: argument: application cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: canBrowseWindowSpecMethod cg@3524: label: 'Browse Window Spec Method' cg@3524: itemValue: doBrowseWindowSpecMethod cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: canEditWindowSpec cg@3524: label: 'Edit Window Spec' cg@3524: itemValue: doEditWindowSpec cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasTargetWidgetChannel cg@3524: label: 'All Applications' cg@3524: submenuChannel: submenuApplications: cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3524: ) cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Process' cg@3524: submenu: cg@3524: (Menu cg@3524: ( cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Debug' cg@3524: itemValue: doDebugProcess cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Inspect' cg@3524: itemValue: doInspect: cg@3524: argument: process cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Open Process Monitor' cg@3524: itemValue: doOpenProcessMonitor cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3524: ) cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Help' cg@3524: startGroup: conditionalRight cg@3524: submenu: cg@3524: (Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'Documentation' cg@3524: itemValue: openDocumentation cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'About this Application...' cg@3524: itemValue: openAboutThisApplication cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3524: ) cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil ca@2177: ) ca@2177: ! ca@2177: ca@2177: middleButtonMenu ca@2177: "This resource specification was automatically generated ca@2177: by the MenuEditor of ST/X." ca@2177: ca@2177: "Do not manually edit this!! If it is corrupted, ca@2177: the MenuEditor may not be able to read the specification." ca@2177: cg@3213: ca@2177: " cg@3213: MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#middleButtonMenu cg@3213: (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication middleButtonMenu)) startUp ca@2177: " ca@2177: ca@2177: ca@2177: cg@3524: ^ ca@2177: #(Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'Browse View Class' cg@3524: itemValue: doBrowse: cg@3524: argument: view cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Browse Model Class' cg@3524: itemValue: doBrowse: cg@3524: isVisible: hasModel cg@3524: argument: model cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Browse Application Class' cg@3524: itemValue: doBrowse: cg@3524: isVisible: hasApplication cg@3524: argument: application cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Browse Controller Class' cg@3524: itemValue: doBrowse: cg@3524: isVisible: hasController cg@3524: argument: controller cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Inspect View' cg@3524: itemValue: doInspect: cg@3524: argument: view cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Inspect Window Group' cg@3524: itemValue: doInspect: cg@3524: argument: group cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Inspect Model' cg@3524: itemValue: doInspect: cg@3524: isVisible: hasModel cg@3524: argument: model cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Inspect Application' cg@3524: itemValue: doInspect: cg@3524: isVisible: hasApplication cg@3524: argument: application cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Inspect Controller' cg@3524: itemValue: doInspect: cg@3524: isVisible: hasController cg@3524: argument: controller cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Flash' cg@3524: itemValue: doFlash cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Destroy' cg@3524: itemValue: doDestroy cg@3524: labelImage: (ResourceRetriever ToolbarIconLibrary erase16x16Icon 'Destroy') cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Geometry' cg@3524: submenuChannel: submenuGeometry: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Interface' cg@3524: submenuChannel: submenuInterface: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Visibility' cg@3524: submenuChannel: submenuVisibility: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Instance Variables' cg@3524: submenuChannel: submenuInspector: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: (MenuItem cg@3524: label: '=' cg@3524: ) cg@3524: (MenuItem cg@3524: label: '' cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: selectedComponentHasChildren cg@3524: label: 'Applications' cg@3524: nameKey: single cg@3524: submenuChannel: submenuApplications: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: selectedComponentHasChildren cg@3524: label: 'Components' cg@3524: nameKey: single cg@3524: submenuChannel: submenuComponents: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil ca@2177: ) ca@2177: ! ca@2177: cg@3456: middleButtonMenuForMenuItems cg@3456: "This resource specification was automatically generated cg@3456: by the MenuEditor of ST/X." cg@3456: cg@3456: "Do not manually edit this!! If it is corrupted, cg@3456: the MenuEditor may not be able to read the specification." cg@3456: cg@3456: cg@3456: " cg@3456: MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#middleButtonMenu cg@3456: (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication middleButtonMenu)) startUp cg@3456: " cg@3456: cg@3456: cg@3456: cg@3524: ^ cg@3456: #(Menu cg@3524: ( cg@3524: (MenuItem cg@3524: label: 'Browse Menu Item''s Class' cg@3524: itemValue: doBrowse: cg@3524: argument: menuItem cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Inspect Menu Item' cg@3524: itemValue: doInspect: cg@3524: argument: menuItem cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Interface' cg@3524: submenuChannel: submenuMenuItemInterface: cg@3524: keepLinkedMenu: true cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil cg@3456: ) cg@3456: cg@3456: "Created: / 16-08-2017 / 13:48:49 / cg" cg@3456: ! cg@3456: ca@2177: toolbarMenu ca@2177: "This resource specification was automatically generated ca@2177: by the MenuEditor of ST/X." ca@2177: ca@2177: "Do not manually edit this!! If it is corrupted, ca@2177: the MenuEditor may not be able to read the specification." ca@2177: cg@2978: ca@2177: " cg@2757: MenuEditor new openOnClass:Tools::ViewTreeInspectorApplication andSelector:#toolbarMenu cg@2757: (Menu new fromLiteralArrayEncoding:(Tools::ViewTreeInspectorApplication toolbarMenu)) startUp ca@2177: " ca@2177: ca@2177: ca@2177: cg@3524: ^ ca@2177: #(Menu cg@3524: ( cg@3524: (MenuItem cg@3524: enabled: hasTargetWidgetChannel cg@3524: label: 'Redraw' cg@3524: itemValue: doRedraw cg@3524: isButton: true cg@3524: labelImage: (ResourceRetriever ToolbarIconLibrary reloadIcon) cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: label: 'Pick a View and Catch Events' cg@3524: itemValue: doPickView cg@3524: translateLabel: false cg@3524: isButton: true cg@3524: hideMenuOnActivated: false cg@3524: labelImage: (ResourceRetriever ToolbarIconLibrary pickWindowIcon) cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasTargetWidgetChannel cg@3524: isVisible: isNotCatchingEventsChannel cg@3524: label: 'Catch Events of Picked View' cg@3524: activeHelpKey: doCatchEvents cg@3524: itemValue: doCatchEvents cg@3524: nameKey: doCatchEvents cg@3524: isButton: true cg@3524: labelImage: (ResourceRetriever nil releaseViewIcon) cg@3524: ) cg@3524: (MenuItem cg@3524: enabled: hasTargetWidgetChannel cg@3524: isVisible: isCatchingEventsChannel cg@3524: label: 'Release Picked View and Uncatch Events' cg@3524: activeHelpKey: doUncatchEvents cg@3524: itemValue: doUncatchEvents cg@3524: nameKey: doUncatchEvents cg@3524: isButton: true cg@3524: labelImage: (ResourceRetriever nil lockViewIcon) cg@3524: ) cg@3524: (MenuItem cg@3524: label: '-' cg@3524: ) cg@3524: (MenuItem cg@3524: activeHelpKey: doBrowseApplication cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Browse Application' cg@3524: itemValue: doBrowse: cg@3524: translateLabel: false cg@3524: isButton: true cg@3524: hideMenuOnActivated: false cg@3524: labelImage: (ResourceRetriever ToolbarIconLibrary systemBrowser24x24Icon2) cg@3524: argument: application cg@3524: ) cg@3524: (MenuItem cg@3524: activeHelpKey: doInspectApplication cg@3524: enabled: hasSingleSelectionHolder cg@3524: label: 'Inspect Application' cg@3524: itemValue: doInspect: cg@3524: translateLabel: false cg@3524: isButton: true cg@3524: hideMenuOnActivated: false cg@3524: labelImage: (ResourceRetriever ToolbarIconLibrary inspect22x24Icon) cg@3524: argument: application cg@3524: ) cg@3524: ) cg@3524: nil cg@3524: nil ca@2177: ) ca@2177: ! ! ca@2177: cg@2747: !ViewTreeInspectorApplication class methodsFor:'startup'! cg@2747: cg@2747: openInPickMode cg@2747: |app| cg@2747: cg@2747: app := self new. cg@2747: app open. cg@2762: app doPickView. cg@3124: ^ app cg@3124: ! cg@3124: cg@3124: openInPickModeAndRelease cg@3124: "release the pick-lock after picking" cg@3124: cg@3124: |app| cg@3124: cg@3124: app := self openInPickMode. cg@3124: app doUncatchEvents. cg@3124: ^ app cg@3014: ! cg@3014: cg@3014: openOn:aView cg@3014: "show a particular window's topView hierarchy, cg@3014: select the given view" cg@3014: cg@3014: |app| cg@3014: cg@3014: app := self new. cg@3014: app open. cg@3014: app showWindow:aView. cg@3124: ^ app cg@2747: ! ! cg@2747: cg@2744: !ViewTreeInspectorApplication methodsFor:'actions'! ca@2177: ca@2177: indicatorClicked:anIndex ca@2177: |item sensor| ca@2177: ca@2177: item := model listOfItems at:anIndex ifAbsent:nil. ca@2177: ca@2177: item notNil ifTrue:[ cg@3524: ( (sensor := self window sensor) notNil cg@3524: and:[(sensor ctrlDown or:[sensor shiftDown])] cg@3524: ) ifTrue:[ cg@3524: item recursiveToggleExpand cg@3524: ] ifFalse:[ cg@3524: item toggleExpand cg@3524: ] ca@2177: ]. ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'aspects'! ca@2177: cg@3302: browserVisibleHolder cg@3302: "what is shown in the inspector: cg@3302: 1->Widget cg@3302: 2->Application cg@3302: 3->WindowGroup cg@3302: 4->Sensor cg@3524: 5->Model cg@3524: 6->Widget Class cg@3524: 7->Application Class cg@3302: " cg@3302: cg@3302: ^ BlockValue cg@3524: with:[:v | self inspectorMode == #widgetClass or:[self inspectorMode == #applicationClass] ] cg@3524: argument:self inspectorModeIndexHolder cg@3302: ! cg@3302: cg@3174: canBrowseWindowSpecMethod cg@3174: ^ self hasSingleSelectionHolder value and:[ self windowSpecMethodOfSelection notNil ] cg@3174: ! cg@3174: cg@3174: canEditWindowSpec cg@3174: ^ self hasSingleSelectionHolder value and:[ self windowSpecMethodOfSelection notNil ] cg@3174: ! cg@3174: ca@2177: followFocusChannel ca@2455: "boolean holder, which indicates whether selection changed dependend on the focus view" ca@2455: ca@2177: ^ followFocusChannel ca@2177: ! ca@2177: ca@2177: hasSingleSelectionHolder ca@2455: "boolean holder, true if one item is selected" ca@2455: ca@2177: ^ hasSingleSelectionHolder ca@2177: ! ca@2177: ca@2455: hasTargetWidgetChannel ca@2455: "answer the channel which is set to true if a target widget exists" ca@2455: ca@2455: ^ model hasTargetWidgetChannel ca@2455: ! ca@2455: cg@3037: inspectorMode cg@3049: "what is shown in the inspector: cg@3037: 1->widget cg@3049: 2->application cg@3049: 3->WindowGroup cg@3049: 4->Sensor cg@3524: 5->Model cg@3524: 6->Widget Class cg@3524: 7->Application Class cg@3049: " cg@3049: cg@3302: |mode| cg@3302: mode := inspectorModeIndexHolder value. cg@3302: ^ #( widget application group sensor model widgetClass applicationClass) at:mode ifAbsent:#widget cg@3037: cg@3037: "Created: / 30-07-2013 / 07:44:59 / cg" cg@3037: ! cg@3037: cg@3037: inspectorModeIndexHolder cg@3049: "what is shown in the inspector: cg@3049: 1->Widget cg@3049: 2->Application cg@3049: 3->WindowGroup cg@3049: 4->Sensor cg@3524: 5->Model cg@3524: 6->Widget Class cg@3524: 7->Application Class cg@3049: " cg@3037: cg@3037: ^ inspectorModeIndexHolder cg@3037: cg@3037: "Created: / 30-07-2013 / 07:44:07 / cg" cg@3037: ! cg@3037: cg@3037: inspectorModes cg@3302: "/ labels of tabs cg@3302: ^ #('Widget' 'Application' 'WindowGroup' 'Sensor' 'Model' 'Widget Class' 'App Class') cg@3037: cg@3037: "Created: / 30-07-2013 / 09:42:16 / cg" cg@3037: ! cg@3037: cg@3302: inspectorVisibleHolder cg@3302: "what is shown in the inspector: cg@3302: 1->Widget cg@3302: 2->Application cg@3302: 3->WindowGroup cg@3302: 4->Sensor cg@3524: 5->Model cg@3524: 6->Widget Class cg@3524: 7->Application Class cg@3302: " cg@3302: cg@3302: ^ BlockValue cg@3524: with:[:v | v not ] cg@3524: argument:self browserVisibleHolder cg@3302: ! cg@3302: cg@3124: isCatchingEventsChannel cg@3124: ^ isCatchingEventsChannel cg@3124: ! cg@3124: cg@3124: isNotCatchingEventsChannel cg@3124: ^ BlockValue forLogicalNot:self isCatchingEventsChannel cg@3124: ! cg@3124: ca@2177: listOfItems ca@2455: "returns the hierarchical list of items" ca@2455: ca@2177: ^ model listOfItems ca@2177: ! ca@2177: ca@2177: model ca@2455: "returns my selection model, a ViewTreeModel" ca@2455: ca@2177: ^ model ca@2177: ! ca@2177: jan@3112: path jan@3112: jan@3112: jan@3112: path isNil ifTrue:[ cg@3524: path := PluggableAdaptor cg@3524: on: self model cg@3524: getter:[ :model | model path ] cg@3524: setter:[ :model :newValue | ] jan@3112: ]. jan@3112: ^ path. jan@3112: jan@3112: "Modified: / 19-05-2014 / 18:40:51 / Jan Vrany " jan@3112: ! jan@3112: ca@2177: selectOnClickHolder ca@2455: "boolean holder, which indicates whether the selection will change on click" ca@2455: ca@2177: ^ model selectOnClickHolder ca@2177: ! ca@2177: ca@2451: showNamesHolder ca@2451: "boolean holder, which indicates whether application names or widget names ca@2455: as additional text are shown for the items" ca@2455: ca@2451: ^ showNamesHolder ca@2451: ! ca@2451: ca@2177: testModeChannel ca@2455: "answer a boolean channel which describes the behaviour how to process ca@2455: events on the target view. ca@2455: ca@2455: false: all input events are eaten and the selection is shown on the target view. ca@2455: true: no input events are eaten and no selection is shown on the target view." ca@2455: ca@2455: ^ model testModeChannel cg@3174: ! cg@3174: cg@3174: windowSpecMethodOfSelection cg@3302: |item view app nonMeta meta masterApp cg@3302: spec builder specSelector implementors| cg@3174: cg@3174: item := model selectedItem. cg@3524: item isNil ifTrue:[^ nil]. cg@3174: cg@3174: view := item widget. cg@3524: view isNil ifTrue:[^ nil]. cg@3174: cg@3174: app := view application. cg@3524: app isNil ifTrue:[^ nil]. cg@3524: cg@3174: builder := app builder. cg@3524: builder isNil ifTrue:[^ nil]. cg@3174: cg@3174: spec := builder spec. cg@3174: spec isNil ifTrue:[^ nil]. cg@3174: cg@3174: specSelector := spec name. cg@3174: specSelector isNil ifTrue:[^ nil]. cg@3174: cg@3302: ((nonMeta := app class theNonMetaclass) canUnderstand:specSelector) ifTrue:[ cg@3524: ^ nonMeta lookupMethodFor:specSelector. cg@3174: ]. cg@3302: ((meta := app class theMetaclass) canUnderstand:specSelector) ifTrue:[ cg@3524: ^ meta lookupMethodFor:specSelector. cg@3174: ]. cg@3174: cg@3174: "/ maybe a simple dialog given a spec cg@3302: (masterApp := app masterApplication) notNil ifTrue:[ cg@3524: ((nonMeta := masterApp class theNonMetaclass) canUnderstand:specSelector) ifTrue:[ cg@3524: ^ nonMeta lookupMethodFor:specSelector. cg@3524: ]. cg@3524: ((meta := masterApp class theMetaclass) canUnderstand:specSelector) ifTrue:[ cg@3524: ^ meta lookupMethodFor:specSelector. cg@3524: ]. cg@3174: ]. cg@3174: cg@3174: implementors := Smalltalk allImplementorsOf: specSelector. cg@3174: implementors size == 1 ifTrue:[ cg@3524: ^ implementors first compiledMethodAt:specSelector. cg@3174: ]. cg@3174: cg@3174: ^ nil ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'change & update'! ca@2177: cg@3037: inspectorModeIndexHolderChanged cg@3037: self updateInspector cg@3037: cg@3037: "Created: / 30-07-2013 / 09:21:51 / cg" cg@3037: ! cg@3037: ca@2177: selectionChanged ca@2177: |info view item| ca@2177: ca@2177: item := model selectedItem. cg@3524: item notNil ifTrue:[ cg@3524: |state| cg@3524: cg@3524: view := item widget. cg@3524: view isNil ifTrue:[ cg@3524: info := '%1 [%2]' bindWith:(item menuItem label asString) cg@3524: with:(item menuItem value asString). cg@3524: ] ifFalse:[ cg@3524: view id isNil ifTrue:[ cg@3524: state := 'no ID'. cg@3524: ] ifFalse:[ cg@3524: view shown ifTrue:[ cg@3524: state := 'visible'. cg@3524: ] ifFalse:[ cg@3524: state := 'invisible' cg@3524: ]. cg@3524: ]. cg@3524: info := '%1 [%2] - %3' bindWith:(view class name) cg@3524: with:(view name ? '') with:state allBold. cg@3524: ] ca@2177: ] ifFalse:[ cg@3524: info := '' ca@2177: ]. ca@2177: hasSingleSelectionHolder value:(view notNil). cg@3037: self updateInspector cg@3037: cg@3456: "Modified: / 16-08-2017 / 13:44:59 / cg" ca@2177: ! ca@2177: ca@2177: update:something with:someArgument from:aModel ca@2454: |oldSelection| ca@2454: ca@2451: aModel == showNamesHolder ifTrue:[ cg@3524: oldSelection := model selectedItem. cg@3524: model selectedItem:nil. cg@3524: self listOfItems showWidgetNames:(aModel value). cg@3524: model selectedItem:oldSelection. cg@3524: ^ self ca@2451: ]. ca@2458: ca@2458: aModel == model ifTrue:[ cg@3524: self selectionChanged. cg@3524: ^ self ca@2458: ]. ca@2458: ca@2177: super update:something with:someArgument from:aModel. cg@3037: ! cg@3037: cg@3302: updateBrowser cg@3302: |cls widget| cg@3302: cg@3302: widget := self selectedView. cg@3524: cg@3302: "/ update the browser cg@3302: self inspectorMode == #widgetClass ifTrue:[ cg@3524: cls := widget class. cg@3302: ] ifFalse:[ cg@3524: cls := widget application class cg@3524: ]. cg@3302: browser switchToClass:cls selector:nil. cg@3302: ! cg@3302: cg@3037: updateInspector cg@3302: |view mode obj| cg@3037: cg@3037: view := self selectedView. cg@3302: mode := self inspectorMode. cg@3524: cg@3302: ((mode == #widgetClass) or:[(mode == #applicationClass)]) ifTrue:[ cg@3524: "/ update the browser cg@3524: view notNil ifTrue:[ cg@3524: self updateBrowser. cg@3524: ]. cg@3524: ^ self. cg@3302: ]. cg@3524: cg@3302: (view isNil or:[mode == #widget]) ifTrue:[ cg@3524: obj := view. cg@3302: ] ifFalse:[ (mode == #group) ifTrue:[ cg@3524: obj := view windowGroup cg@3302: ] ifFalse:[ (mode == #sensor) ifTrue:[ cg@3524: obj := view sensor cg@3302: ] ifFalse:[ (mode == #model) ifTrue:[ cg@3524: obj := view model cg@3037: ] ifFalse:[ cg@3524: obj := view application. cg@3049: ]]]]. cg@3037: inspectorView inspect:obj. cg@3037: inspectorView headLineLabel:(obj class nameWithoutPrefix) cg@3037: cg@3037: "Created: / 30-07-2013 / 09:21:16 / cg" ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'event processing'! ca@2177: ca@2177: processButtonMotionEvent:ev ca@2455: |click rootView| ca@2455: ca@2455: motionAction isNil ifTrue:[^ self]. ca@2177: ca@2455: (rootView := model rootView) isNil ifTrue:[ cg@3524: clickedItem := motionAction := nil. cg@3524: ^ self ca@2455: ]. ca@2177: ca@2455: click := rootView device cg@3524: translatePoint:((ev x)@ (ev y)) cg@3524: fromView:(ev view) cg@3524: toView:rootView. ca@2455: ca@2455: click = clickedPoint ifFalse:[ cg@3524: (clickedItem isNil or:[(click dist:clickedPoint) > 5.0]) ifTrue:[ cg@3524: motionAction value:click cg@3524: ] ca@2177: ]. ca@2177: ! ca@2177: ca@2177: processButtonPressEvent:ev ca@2455: |rootView sensor lastRectangle| ca@2455: ca@2455: rootView := model rootView. ca@2177: sensor := model rootView sensor. ca@2177: clickedItem := model listOfItems detectItemRespondsToView:(ev view). ca@2177: ca@2177: (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[ cg@3524: clickedItem notNil ifTrue:[ cg@3524: self selectOnClickHolder value ifTrue:[ cg@3524: model toggleSelectItem:clickedItem cg@3524: ]. cg@3524: ]. cg@3524: clickedItem := motionAction := nil. cg@3524: ^ self ca@2455: ]. ca@2177: ca@2455: clickedPoint := rootView device translatePoint:((ev x)@ (ev y)) fromView:(ev view) toView:rootView. ca@2455: lastRectangle := nil. ca@2177: ca@2455: motionAction :=[:p| cg@3524: rootView := model rootView device rootView. cg@3524: rootView := model rootView. cg@3524: clickedItem := nil. cg@3524: cg@3524: rootView xoring:[ cg@3524: lastRectangle notNil ifTrue:[ rootView displayRectangle:lastRectangle ] cg@3524: ifFalse:[ rootView clippedByChildren:false ]. cg@3524: cg@3524: p isNil ifTrue:[ cg@3524: rootView clippedByChildren:true. cg@3524: motionAction := nil. cg@3524: ] ifFalse:[ cg@3524: lastRectangle := Rectangle origin:(clickedPoint min:p) corner:(clickedPoint max:p). cg@3524: rootView displayRectangle:lastRectangle. cg@3524: ]. cg@3524: rootView flush. cg@3524: ]. cg@3524: lastRectangle ca@2455: ]. ca@2177: ! ca@2177: ca@2177: processButtonReleaseEvent:anEvent ca@2177: |rootView rectangle newItems widget origin| ca@2177: ca@2455: (rootView := model rootView) isNil ifTrue:[ cg@3524: clickedItem := motionAction := nil. cg@3524: ^ self ca@2455: ]. ca@2177: motionAction isNil ifTrue:[ ^ self ]. ca@2177: clickedItem notNil ifTrue:[ ^ model selectItem:clickedItem ]. ca@2177: ca@2455: rectangle := motionAction value:nil. ca@2455: rectangle isNil ifTrue:[^ self]. ca@2455: ca@2455: newItems := OrderedCollection new. ca@2177: ca@2455: model rootItem recursiveDo:[:anItem| cg@3524: widget := anItem widget. cg@3524: widget notNil ifTrue:[ cg@3524: origin := widget originRelativeTo:rootView. cg@3524: cg@3524: (rectangle containsRect:(Rectangle origin:origin extent:(widget extent))) ifTrue:[ cg@3524: newItems add:anItem. cg@3524: ] cg@3524: ]. ca@2177: ]. ca@2455: model value:newItems. cg@3500: cg@3500: "Modified: / 11-11-2017 / 17:24:59 / cg" ca@2177: ! ca@2177: ca@2177: processEvent:anEvent ca@2177: |button menu| ca@2177: cg@2758: anEvent isKeyPressEvent ifTrue:[ self processKeyPressEvent:anEvent. ^ self ]. ca@2177: anEvent isButtonEvent ifFalse:[ ^ self ]. ca@2177: ca@2177: button := anEvent button. ca@2177: ca@2177: (button == 2 or:[button == #menu]) ifTrue:[ cg@3524: motionAction isNil ifTrue:[ cg@3524: anEvent isButtonPressEvent ifTrue:[ cg@3524: self selectOnClickHolder value ifTrue:[ cg@3524: menu := self middleButtonMenu value. cg@3524: menu notNil ifTrue:[ cg@3524: menu := MenuPanel cg@3524: menu:(Menu new fromLiteralArrayEncoding:menu) cg@3524: receiver:self. cg@3524: menu startUp. cg@3524: ] cg@3524: ]. cg@3524: ]. cg@3524: clickedItem := nil. cg@3524: ]. cg@3524: ^ self ca@2177: ]. ca@2177: cg@2758: anEvent isButtonPressEvent ifTrue:[ self processButtonPressEvent:anEvent. ^ self ]. cg@2758: anEvent isButtonMotionEvent ifTrue:[ self processButtonMotionEvent:anEvent. ^ self ]. ca@2177: ca@2177: anEvent isButtonReleaseEvent ifTrue:[ cg@3524: self selectOnClickHolder value ifTrue:[ cg@3524: self processButtonReleaseEvent:anEvent cg@3524: ]. ca@2177: ]. ca@2177: clickedItem := motionAction := nil. ca@2177: ca@2177: anEvent type == #'buttonMultiPress:x:y:' ifTrue:[ cg@3524: self selectOnClickHolder value ifTrue:[ cg@3524: self doInspect:#view. cg@3524: ]. ca@2177: ]. ca@2177: ! ca@2177: ca@2177: processKeyPressEvent:anEvent ca@2177: |item prnt idx key max next| ca@2177: ca@2177: key := anEvent key. ca@2177: key isSymbol ifFalse:[^ self]. ca@2177: ca@2177: key == #Delete ifTrue:[ ^ self doDestroy ]. ca@2177: key == #InspectIt ifTrue:[ ^ self doInspect:#view ]. ca@2177: ca@2177: ( key == #CursorUp ca@2177: or:[key == #CursorDown ca@2177: or:[key == #CursorLeft ca@2177: or:[key == #CursorRight]]] ca@2177: ) ifFalse:[ cg@3524: ^ self ca@2177: ]. ca@2177: item := model selectedItem. ca@2177: ca@2177: item isNil ifTrue:[ cg@3524: ^ model selectedItem:(model first ? model rootItem) ca@2177: ]. ca@2177: ca@2177: prnt := item parent. ca@2177: prnt isNil ifTrue:[ cg@3524: "/ is the root item cg@3524: (key == #CursorUp or:[key == #CursorLeft]) ifTrue:[item := model listOfItems last] cg@3524: ifFalse:[item := item at:1 ifAbsent:item]. cg@3524: cg@3524: ^ model selectedItem:item ca@2177: ]. ca@2177: key == #CursorLeft ifTrue:[ ^ model selectedItem:prnt ]. ca@2177: ca@2177: key == #CursorRight ifTrue:[ cg@3524: next := item at:1 ifAbsent:nil. cg@3524: next notNil ifTrue:[ model selectedItem:next ]. cg@3524: ^ self ca@2177: ]. ca@2177: ca@2177: max := prnt size. ca@2177: ca@2177: key == #CursorUp ifTrue:[ cg@3524: idx := prnt identityIndexOf:item. cg@3524: idx == 1 ifTrue:[idx := max + 1]. cg@3524: model selectedItem:(prnt at:idx - 1). cg@3524: ^ self. ca@2177: ]. ca@2177: ca@2177: key == #CursorDown ifTrue:[ cg@3524: idx := prnt identityIndexOf:item. cg@3524: idx == max ifTrue:[idx := 0]. cg@3524: model selectedItem:(prnt at:idx + 1). cg@3524: ^ self. ca@2177: ]. ca@2177: ! ca@2177: ca@2177: processMappedView:aView ca@2177: |parent anchor| ca@2177: ca@2177: parent := self listOfItems detectItemRespondsToView:aView. ca@2177: parent isNil ifTrue:[ ^ self ]. ca@2177: ca@2177: NotFoundSignal handle:[:ex| cg@3524: "contained subvies used by spec are not yet created; cg@3524: thus we have to wait until last used subview is build cg@3524: " cg@3524: anchor := nil. ca@2177: ] do:[ cg@3524: anchor := parent class buildViewsFrom:(parent widget). ca@2177: ]. ca@2177: anchor notNil ifTrue:[ cg@3524: parent updateFromChildren:anchor children. ca@2177: ]. ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'initialization & release'! ca@2177: ca@2177: closeDownViews ca@2455: "release the grapped application" ca@2455: ca@2177: process := nil. ca@2177: super closeDownViews. ca@2177: self doUnpick. ca@2177: ! ca@2177: ca@2177: initialize ca@2455: "setup my model and channels" ca@2455: ca@2177: super initialize. ca@2177: ca@2177: hasSingleSelectionHolder := false asValue. ca@2177: followFocusChannel := false asValue. cg@3124: isCatchingEventsChannel := false asValue. cg@3037: inspectorModeIndexHolder := 1 asValue. cg@3037: inspectorModeIndexHolder onChangeSend:#inspectorModeIndexHolderChanged to:self. ca@2177: ca@2177: model := ViewTreeModel new. ca@2177: model inputEventAction:[:ev| self processEvent:ev ]. ca@2177: model mappedViewAction:[:vw| self processMappedView:vw ]. ca@2177: model application:self. ca@2458: model addDependent:self. ca@2458: ca@2177: ca@2451: showNamesHolder := false asValue. ca@2451: showNamesHolder addDependent:self. cg@3037: cg@3037: "Modified: / 30-07-2013 / 09:20:08 / cg" ca@2177: ! ca@2177: cg@3302: postBuildBrowserCanvas:aSubCanvas cg@3302: browser := aSubCanvas application. cg@3302: cg@3302: "/ browser navigationState meta onChangeEvaluate:(self updateBrowser). cg@3302: "/ self updateBrowser. cg@3302: ! cg@3302: cg@2770: postBuildInspectorView:anInspector cg@2770: inspectorView := anInspector. cg@2770: ! cg@2770: ca@2177: postBuildTree:aTree ca@2177: treeView := aTree scrolledView. cg@3105: "/ treeView hasConstantHeight:true. cg@3104: ! cg@3104: cg@3104: release cg@3104: "release the grapped application" cg@3104: cg@3104: super release. cg@3104: self doUnpick. ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'menu queries'! ca@2177: ca@2177: hasApplication ca@2455: "returns true if the current selected view has an application" ca@2455: ca@2177: |view| ca@2177: ca@2177: view := self selectedView. ca@2177: ^ (view notNil and:[view application notNil]) ca@2177: ! ca@2177: ca@2177: hasController ca@2177: "returns true if the current selected item's view has a controller ca@2455: other than nil or the view itself" ca@2455: ca@2177: |view controller| ca@2177: ca@2177: view := self selectedView. ca@2177: ca@2177: view notNil ifTrue:[ cg@3524: controller := view controller. ca@2177: ^ (controller notNil and:[controller ~~ view]) ca@2177: ]. ca@2177: ^ false ca@2177: ! ca@2177: ca@2177: hasModel ca@2455: "returns true if the current selected view has a model" ca@2455: ca@2177: |view| ca@2177: ca@2177: view := self selectedView. ca@2177: ^ (view notNil and:[view model notNil]) ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'menu specs'! ca@2177: ca@2177: middleButtonMenu ca@2455: "returns the middleButton menu for the single selected item or nil" ca@2455: cg@3524: ^ [ cg@3524: model selectedItem notNil ifTrue:[ cg@3524: model selectedItem isView ifTrue:[ cg@3524: self class middleButtonMenu cg@3524: ] ifFalse:[ cg@3524: self class middleButtonMenuForMenuItems cg@3524: ]. cg@3524: ] ifFalse:[ cg@3524: nil cg@3524: ] ca@2177: ] cg@3456: cg@3456: "Modified: / 16-08-2017 / 13:48:31 / cg" ca@2177: ! ca@2177: ca@2177: submenuApplications:aMenu ca@2177: |applications menu item list addBlock| ca@2177: ca@2177: item := aMenu selection nameKey == #single ifTrue:[model selectedItem] cg@3524: ifFalse:[model rootItem]. ca@2177: item isNil ifTrue:[^ nil]. ca@2177: ca@2177: applications := IdentityDictionary new. ca@2177: ca@2177: addBlock := [:el| |cls ctr| cg@3524: cls := self resolveApplicationClassFor:el. cg@3524: cg@3524: cls notNil ifTrue:[ cg@3524: ctr := applications at:cls ifAbsent:0. cg@3524: applications at:cls put:(ctr + 1). cg@3524: ]. ca@2177: ]. ca@2177: item recursiveDo:addBlock. ca@2177: addBlock value:item. ca@2177: ca@2177: applications isEmpty ifTrue:[^ nil ]. ca@2177: list := SortedCollection sortBlock:[:a :b| a title < b title ]. ca@2177: ca@2177: applications keysAndValuesDo:[:cls :ctr| ca@2177: list add:(MenuDesc title:(cls name) cg@3524: value:(ctr printString) cg@3524: action:[self doSelectNextOfApplicationClass:cls startingIn:item] cg@3524: ). ca@2177: ]. ca@2177: ca@2177: menu := MenuDesc buildFromList:list onGC:aMenu. ca@2177: menu do:[:el| cg@3524: el hideMenuOnActivated:false ca@2177: ]. ca@2177: ^ menu ca@2177: ! ca@2177: ca@2177: submenuComponents:aMenu ca@2177: |widgets list total menu item| ca@2177: ca@2177: item := aMenu selection nameKey == #single ifTrue:[model selectedItem] cg@3524: ifFalse:[model rootItem]. ca@2177: item isNil ifTrue:[^ nil]. ca@2177: ca@2177: widgets := IdentityDictionary new. ca@2177: total := 0. ca@2177: ca@2177: item recursiveDo:[:el| |cls ctr| cg@3524: cls := el widget. cg@3524: cg@3524: cls notNil ifTrue:[ cg@3524: cls := cls class. cg@3524: ctr := widgets at:cls ifAbsent:0. cg@3524: widgets at:cls put:(ctr + 1). cg@3524: total := total + 1. cg@3524: ]. ca@2177: ]. ca@2177: total == 0 ifTrue:[^ nil]. ca@2177: list := SortedCollection sortBlock:[:a :b| a title < b title ]. ca@2177: ca@2177: widgets keysAndValuesDo:[:cls :ctr| cg@3524: list add:(MenuDesc title:(cls name) cg@3524: value:(ctr printString) cg@3524: action:[self doSelectNextOfClass:cls startingIn:item] cg@3524: ). ca@2177: ]. ca@2177: list := list asOrderedCollection. ca@2177: list add:(MenuDesc separator). ca@2177: list add:(MenuDesc title:'Total' value:(total printString)). ca@2177: menu := MenuDesc buildFromList:list onGC:aMenu. ca@2177: menu do:[:el| cg@3524: el hideMenuOnActivated:false ca@2177: ]. ca@2177: ^ menu ca@2177: ! ca@2177: ca@2177: submenuGeometry:aMenu ca@2455: "builds and returns the geometry submenu" ca@2455: ca@2177: |view point inst list x y| ca@2177: ca@2177: view := self selectedView. ca@2177: view isNil ifTrue:[^ nil]. ca@2177: ca@2177: list := OrderedCollection new. ca@2177: ca@2177: "/ origin ca@2177: point := view relativeOrigin. ca@2177: point isNil ifTrue:[ point := view origin ]. ca@2177: ca@2177: x := view left. ca@2177: y := view top. ca@2177: ca@2177: (x == point x and:[y == point y]) ifTrue:[ inst := point ] cg@3524: ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ]. ca@2177: ca@2177: list add:(MenuDesc title:'origin' value:inst). ca@2177: ca@2177: "/ corner ca@2177: point := view relativeCorner. ca@2177: point isNil ifTrue:[ point := view corner ]. ca@2177: ca@2177: x := view right. ca@2177: y := view bottom. ca@2177: ca@2177: (x == point x and:[y == point y]) ifTrue:[ inst := point ] cg@3524: ifFalse:[ inst := '%1 --> (%2@%3)' bindWith:point with:x with:y ]. ca@2177: ca@2177: list add:(MenuDesc title:'corner' value:inst). ca@2177: ca@2177: "/ extent ca@2177: (point := view relativeExtent) isNil ifTrue:[point := view extent]. ca@2177: list add:(MenuDesc title:'extent' value:point). ca@2177: ca@2177: "/ preferred extent ca@2177: list add:(MenuDesc title:'pref. extent' value:(view preferredExtent)). ca@2177: list add:(MenuDesc separator). ca@2177: ca@2177: "/ view insets ca@2177: inst := 'l:%1 r:%2 t:%3 b:%4' bindWith:(view leftInset) cg@3524: with:(view rightInset) cg@3524: with:(view topInset) cg@3524: with:(view bottomInset). ca@2177: ca@2177: list add:(MenuDesc title:'insets' value:inst). ca@2177: list add:(MenuDesc title:'borderWidth' value:(view borderWidth)). ca@2177: list add:(MenuDesc title:'level' value:(view level)). ca@2177: list add:(MenuDesc separator). ca@2177: ca@2177: (inst := view layout) notNil ifTrue:[ inst := inst displayString ]. ca@2177: list add:(MenuDesc title:'layout' value:inst). ca@2177: ca@2177: (inst := view transformation) notNil ifTrue:[ inst := inst displayString ]. ca@2177: list add:(MenuDesc title:'transformation' value:inst). ca@2177: cg@3183: (view isKindOf:Label) ifTrue:[ cg@3524: list add:(MenuDesc separator). cg@3524: (inst := view adjust) notNil ifTrue:[ inst := inst displayString ]. cg@3524: list add:(MenuDesc title:'adjust' value:inst). cg@3183: ]. cg@3183: (view isKindOf:PanelView) ifTrue:[ cg@3524: list add:(MenuDesc separator). cg@3524: (inst := view horizontalLayout ) notNil ifTrue:[ inst := inst displayString ]. cg@3524: list add:(MenuDesc title:'horizontalLayout' value:inst). cg@3524: (inst := view verticalLayout ) notNil ifTrue:[ inst := inst displayString ]. cg@3524: list add:(MenuDesc title:'verticalLayout' value:inst). cg@3183: ]. cg@3183: cg@3183: ^ MenuDesc buildFromList:list onGC:aMenu ca@2177: ! ca@2177: ca@2177: submenuInspector:aMenu ca@2455: "builds and returns the inspector submenu" ca@2455: cg@3040: |view list n names label value indices| ca@2177: ca@2177: view := self selectedView. ca@2177: view isNil ifTrue:[^ nil]. ca@2177: ca@2177: n := view class instSize. ca@2177: n > 0 ifFalse:[^ nil ]. ca@2177: ca@2177: list := OrderedCollection new:n. ca@2177: names := view class allInstVarNames. cg@3040: indices := (1 to:names size) asArray. cg@3040: names sortWith:indices. ca@2177: ca@2177: 1 to:n do:[:i| |action| cg@3524: label := (names at:i) printString. cg@3524: value := view instVarAt:(indices at:i). cg@3524: value isNil ifTrue:[ cg@3524: value := '------'. cg@3524: action := nil. cg@3524: ] ifFalse:[ cg@3524: value := value displayString contractAtEndTo:40. cg@3524: action := [(view instVarAt:i) inspect]. cg@3524: ]. cg@3524: list add:(MenuDesc title:label value:value action:action). ca@2177: ]. ca@2177: ca@2177: ^ MenuDesc buildFromList:list onGC:aMenu cg@3040: cg@3040: "Modified: / 31-07-2013 / 13:12:52 / cg" ca@2177: ! ca@2177: ca@2177: submenuInterface:aMenu ca@2455: "builds and returns the interface submenu" ca@2455: ca@2177: |view label inst value list| ca@2177: ca@2177: view := self selectedView. ca@2177: view isNil ifTrue:[^ nil]. ca@2177: ca@2177: list := OrderedCollection new. ca@2177: ca@2177: inst := view controller. ca@2177: value := nil. ca@2177: ca@2177: inst isNil ifTrue:[ cg@3524: label := nil ca@2177: ] ifFalse:[ cg@3524: inst == view ifTrue:[ cg@3524: label := '== view itself' cg@3524: ] ifFalse:[ cg@3524: label := inst displayString. cg@3524: value := [view controller inspect]. cg@3524: ]. ca@2177: ]. ca@2177: list add:(MenuDesc title:'controller' value:label action:value). ca@2177: ca@2177: inst := view delegate. ca@2177: inst notNil ifTrue:[ cg@3524: list add:(MenuDesc title:'delegate' value:(inst displayString) action:[ view delegate inspect ]). ca@2177: ]. ca@2177: ca@2177: inst := view application. ca@2177: cg@3524: inst notNil ifTrue:[ cg@3524: |topAppl| cg@3524: cg@3524: list add:(MenuDesc title:'application' value:inst action:[ view application inspect ]). cg@3524: cg@3524: topAppl := inst topApplication. cg@3524: cg@3524: (topAppl notNil and:[topAppl ~~ inst]) ifTrue:[ cg@3524: list add:(MenuDesc title:'topApplication' value:topAppl action:[ inst topApplication inspect ]). cg@3524: ]. ca@2177: ]. ca@2177: list add:(MenuDesc separator). ca@2177: cg@2888: (view respondsTo:#'model') ifTrue:[ cg@3524: inst := view model. cg@3524: cg@3524: inst isNil cg@3524: ifTrue:[ label := value := nil ] cg@3524: ifFalse:[ label := inst displayString. cg@3524: label := label,(self aspectLabelFor:inst inApplicationOf:view). cg@3524: value := [ view model inspect ]. cg@3524: ]. cg@3524: cg@3524: list add:(MenuDesc title:'model' value:label action:value). cg@3524: cg@3524: (inst notNil and:[view respondsTo:#modelInterface]) ifTrue:[ cg@3524: view modelInterface keysAndValuesDo:[:key : val| cg@3524: val isNil ifTrue:[ label := nil ] cg@3524: ifFalse:[ label := val displayString ]. cg@3524: cg@3524: list add:(MenuDesc title:(' - ', key) value:label ). cg@3524: ] cg@3524: ]. ca@2177: ]. ca@2177: ca@2177: (view respondsTo:#enableChannel) ifTrue:[ cg@3524: inst := view enableChannel. cg@3524: cg@3524: inst isNil ifTrue:[ label := value := nil ] cg@3524: ifFalse:[ label := inst displayString. cg@3524: label := label,(self aspectLabelFor:inst inApplicationOf:view). cg@3524: value := [ view enableChannel inspect ]. cg@3524: ]. cg@3524: cg@3524: list add:(MenuDesc title:'enableChannel' value:label action:value). ca@2177: ]. ca@2177: cg@2888: #( #action #pressAction #releaseAction ) do:[:actionSelector | cg@3524: (view respondsTo:actionSelector) ifTrue:[ cg@3524: inst := view perform:actionSelector. cg@3524: cg@3524: inst isNil cg@3524: ifTrue:[ label := value := nil ] cg@3524: ifFalse:[ label := inst displayString. cg@3524: value := [ (view perform:actionSelector) inspect ]. cg@3524: ]. cg@3524: cg@3524: list add:(MenuDesc title:actionSelector"'action'" value:label action:value). cg@3524: ]. cg@2779: ]. cg@2779: ca@2177: list last isSeparator ifFalse:[ list add:(MenuDesc separator) ]. ca@2177: ca@2177: (view respondsTo:#listHolder) ifTrue:[ cg@3524: inst := view listHolder. cg@3524: cg@3524: inst isNil ifTrue:[ label := value := nil ] cg@3524: ifFalse:[ label := inst class printString. cg@3524: label := label,(self aspectLabelFor:inst inApplicationOf:view). cg@3524: value := [ view listHolder inspect ]. cg@3524: ]. cg@3524: list add:(MenuDesc title:'listHolder' value:label action:value). ca@2177: ]. ca@2177: ca@2177: (view respondsTo:#list) ifTrue:[ cg@3524: inst := view list. cg@3524: cg@3524: inst isNil ifTrue:[ label := value := nil ] cg@3524: ifFalse:[ label := '%1 [%2]' bindWith:(inst class printString) with:(inst size). cg@3524: label := label,(self aspectLabelFor:inst inApplicationOf:view). cg@3524: value := [ view list inspect ]. cg@3524: ]. cg@3524: cg@3524: list add:(MenuDesc title:'list' value:label action:value). ca@2177: ]. ca@2177: ca@2177: list last isSeparator ifTrue:[ list removeLast ]. cg@2888: ^ MenuDesc buildFromList:list onGC:aMenu cg@2888: cg@3040: "Modified: / 31-07-2013 / 13:09:55 / cg" ca@2177: ! ca@2177: cg@3456: submenuMenuItemInterface:aMenu cg@3456: "builds and returns the menuItem interface submenu" cg@3456: cg@3456: |item list| cg@3456: cg@3456: item := self selectedMenuItem. cg@3456: item isNil ifTrue:[^ nil]. cg@3456: cg@3456: list := OrderedCollection new. cg@3456: cg@3524: list add:(MenuDesc cg@3524: title:'itemValue' cg@3524: value:(item itemValue) cg@3524: action:[ cg@3524: UserPreferences systemBrowserClass cg@3524: browseImplementorsOf:item itemValue cg@3524: ]). cg@3456: cg@3456: ^ MenuDesc buildFromList:list onGC:aMenu cg@3456: cg@3456: "Created: / 16-08-2017 / 13:51:05 / cg" cg@3456: ! cg@3456: ca@2177: submenuVisibility:aMenu ca@2455: "builds and returns the geometry submenu" ca@2455: ca@2177: |view list value| ca@2177: ca@2177: view := self selectedView. ca@2177: view isNil ifTrue:[^ nil]. ca@2177: ca@2177: list := OrderedCollection new. ca@2177: ca@2177: list add:(MenuDesc title:'device' value:(view device printString)). ca@2177: list add:(MenuDesc title:'drawableId' value:(view id)). ca@2177: list add:(MenuDesc title:'gcId' value:(view gcId)). ca@2177: ca@2177: list add:(MenuDesc separator). ca@2177: ca@2177: list add:(MenuDesc title:'shown' value:(view shown)). ca@2177: list add:(MenuDesc title:'realized' value:(view realized)). ca@2177: ca@2177: list add:(MenuDesc separator). ca@2177: ca@2177: list add:(MenuDesc title:'hiddenOnRealize' value:(view isHiddenOnRealize)). ca@2177: ca@2177: (value := view visibilityChannel) isNil ifTrue:[ cg@3524: list add:(MenuDesc title:'visibilityChannel' value:'------'). ca@2177: ] ifFalse:[ cg@3524: list add:(MenuDesc title:'visibilityChannel' cg@3524: value:(value displayString) cg@3524: action:[view visibilityChannel inspect]). ca@2177: ]. ca@2177: cg@2758: ^ MenuDesc buildFromList:list onGC:aMenu ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'private'! ca@2177: cg@2888: aspectLabelFor:aModel inApplicationOf:aView cg@2888: |app| cg@2888: cg@2888: aModel isNil ifTrue:[^ '']. cg@2888: aView isNil ifTrue:[^ '']. cg@2888: (app := aView application) isNil ifTrue:[^ '']. cg@2888: app builder bindings keysAndValuesDo:[:aspect :value | cg@3524: value == aModel ifTrue:[^ ' [aspect: ',aspect,']']. cg@2888: ]. cg@3524: app class allInstVarNames do:[:nm | cg@3524: (app instVarNamed:nm) == aModel ifTrue:[^ ' [instvar: ',nm,']'] cg@2888: ]. cg@2888: cg@2888: ^ '' cg@2888: cg@2888: "Created: / 27-04-2012 / 14:22:09 / cg" cg@2888: ! cg@2888: ca@2177: selectFocusView cg@2762: |rootView focusView| ca@2177: ca@2177: rootView := model rootView. ca@2177: ca@2177: (rootView notNil and:[rootView shown]) ifTrue:[ cg@3524: focusView := rootView windowGroup focusView. ca@2177: ]. ca@2177: focusView isNil ifTrue:[^ self ]. ca@2177: cg@2762: self selectView:focusView cg@2762: ! cg@2762: cg@2762: selectView:aView cg@2762: |currentItem viewItem| cg@2762: cg@2762: currentItem := model selectedItem. cg@2762: cg@2762: (currentItem notNil and:[currentItem widget == aView]) ifTrue:[ cg@3524: ^ self ca@2177: ]. cg@2762: viewItem := model listOfItems recursiveDetect:[:el| el widget == aView ]. cg@2762: cg@2762: viewItem notNil ifTrue:[ cg@3524: model selectItem:viewItem. cg@3524: ]. ca@2177: ! ca@2177: ca@2177: setRootItem:aRootItemOrNil ca@2177: |theProcess| ca@2177: ca@2177: aRootItemOrNil isNil ifTrue:[ cg@3524: process := nil. ca@2177: ] ifFalse:[ cg@3524: "/ expand tree to level 3 cg@3524: aRootItemOrNil do:[:aRootChild| cg@3524: aRootChild do:[:aSubChild| aSubChild expand ]. cg@3524: aRootChild expand. cg@3524: ]. cg@3524: aRootItemOrNil expand. cg@3524: cg@3524: process isNil ifTrue:[ cg@3524: theProcess := process := cg@3524: Process cg@3524: for:[ cg@3524: |update testModeChannel| cg@3524: cg@3524: update := false. cg@3524: testModeChannel := model testModeChannel. cg@3524: cg@3524: [process == theProcess] whileTrue:[ cg@3524: Delay waitForSeconds:0.5. cg@3524: cg@3524: (treeView notNil and:[process == theProcess and:[treeView shown]]) ifTrue:[ cg@3524: (testModeChannel value == true and:[followFocusChannel value == true]) ifTrue:[ cg@3524: self selectFocusView. cg@3524: ]. cg@3524: update ifTrue:[ cg@3524: self updateShownStatus. cg@3524: ]. cg@3524: update := update not. cg@3524: ]. cg@3524: ]. cg@3524: ] cg@3524: priority:(Processor userSchedulingPriority). cg@3524: theProcess name:'ViewTreeInspector - Focus Follower'. cg@3524: theProcess resume. cg@3524: ]. ca@2177: ]. ca@2177: model rootItem:aRootItemOrNil. cg@3034: cg@3034: "Modified: / 25-07-2013 / 12:03:44 / cg" ca@2177: ! ca@2177: ca@2177: updateShownStatus ca@2177: |rootItem min max visState listIdx visY0 visY1 height damage| ca@2177: ca@2177: rootItem := model rootItem. ca@2177: (rootItem notNil and:[rootItem widget shown]) ifFalse:[^ self]. ca@2177: ca@2177: max := 0. ca@2177: min := 9999999. ca@2177: ca@2177: rootItem recursiveEachVisibleItemDo:[:anItem| cg@3524: anItem widget notNil ifTrue:[ cg@3524: visState := (anItem widget shown). cg@3524: cg@3524: visState ~~ anItem isDrawnShown ifTrue:[ cg@3524: anItem isDrawnShown:visState. cg@3524: listIdx := treeView identityIndexOf:anItem. cg@3524: cg@3524: listIdx > 0 ifTrue:[ cg@3524: max := max max:listIdx. cg@3524: min := min min:listIdx. cg@3524: ]. cg@3524: ]. cg@3524: ]. ca@2177: ]. ca@2177: max < min ifTrue:[^ self]. ca@2177: max := max + 1. ca@2177: ca@2177: visY0 := (treeView yVisibleOfLine:min) max:0. ca@2177: visY1 := (treeView yVisibleOfLine:max) min:(treeView height). ca@2177: height := visY1 - visY0. cg@3524: ca@2177: height > 2 ifTrue:[ cg@3524: treeView shown ifTrue:[ cg@3524: damage := Rectangle left:0 top:visY0 width:(treeView width) height:height. cg@3524: treeView invalidateDeviceRectangle:damage repairNow:false. cg@3524: ]. ca@2177: ]. cg@3456: cg@3456: "Modified: / 16-08-2017 / 12:29:15 / cg" ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'selection'! ca@2177: cg@3456: selectedMenuItem cg@3456: "answer the selected menuItem or nil" cg@3456: cg@3456: |item| cg@3456: cg@3456: item := model selectedItem. cg@3456: item notNil ifTrue:[ ^ item menuItem ]. cg@3456: ^ nil cg@3456: cg@3456: "Created: / 16-08-2017 / 13:50:35 / cg" cg@3456: ! cg@3456: ca@2177: selectedView ca@2455: "answer the selected view or nil" ca@2455: ca@2177: |item| ca@2177: ca@2177: item := model selectedItem. ca@2177: item notNil ifTrue:[ ^ item widget ]. cg@3457: ^ nil cg@3457: cg@3457: "Modified (format): / 16-08-2017 / 13:57:30 / cg" ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'testing'! ca@2177: ca@2177: resolveApplicationClassFor:aTreeItem ca@2177: aTreeItem isApplicationClass ifTrue:[ ca@2177: ^ aTreeItem applicationClass ca@2177: ]. ca@2177: ^ nil ca@2177: ! ca@2177: ca@2177: selectedComponentHasChildren ca@2177: |item| ca@2177: ca@2177: item := model selectedItem. ca@2177: ^ (item notNil and:[item hasChildren]) ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication methodsFor:'user operations'! ca@2177: ca@2177: doBrowse:what ca@2177: "open browser on: cg@3524: #view browse class cg@3524: #model browse model class cg@3524: #application browse application class cg@3524: #controller browse controller class ca@2177: " cg@3167: |inst| cg@3167: cg@3167: (inst := self objectToInspectOrBrowse:what) isNil ifTrue:[^ self]. cg@3167: inst class browserClass openInClass:(inst class) selector:nil cg@3049: cg@3049: "Modified: / 28-08-2013 / 23:57:42 / cg" ca@2177: ! ca@2177: cg@3174: doBrowseWindowSpecMethod cg@3174: |mthd| cg@3174: cg@3174: mthd := self windowSpecMethodOfSelection. cg@3174: NewSystemBrowser openInClass:mthd mclass selector:mthd selector cg@3174: ! cg@3174: cg@3124: doCatchEvents cg@3124: model catchEvents:true. cg@3124: isCatchingEventsChannel value:true. cg@3524: "/ ((builder componentAt:'toolbarMenu') itemAt:#doUncatchEvents) cg@3124: "/ enabled:true; cg@3124: "/ label:(self class releaseViewIcon); cg@3124: "/ activeHelpKey:#doUncatchEvents. cg@3124: ! cg@3124: cg@3171: doDebugProcess cg@3171: "open debugger on the window process" cg@3171: cg@3171: |view| cg@3171: cg@3171: view := self selectedView. cg@3171: view isNil ifTrue:[^ nil]. cg@3171: cg@3171: Debugger openOn:view windowGroup process cg@3171: ! cg@3171: ca@2177: doDestroy ca@2455: "destroy the current selected view" ca@2455: ca@2177: |item parent| ca@2177: ca@2177: item := model selectedItem. ca@2177: item isNil ifTrue:[ ^ self]. ca@2177: ca@2177: parent := item parent. ca@2177: ca@2177: parent isNil ifTrue:[ cg@3524: "/ the root cg@3524: model withSelectionHiddenDo:[item deleteAll]. ca@2177: ^ self ca@2177: ]. ca@2177: ca@2177: model withSelectionHiddenDo:[ cg@3524: |idx nsel| cg@3524: cg@3524: idx := parent identityIndexOf:item. cg@3524: cg@3524: idx == parent size ifTrue:[ cg@3524: nsel := parent at:(idx - 1) ifAbsent:parent cg@3524: ] ifFalse:[ cg@3524: nsel := parent at:(idx + 1) cg@3524: ]. cg@3524: model setValue:nil. cg@3524: item delete. cg@3524: cg@3524: parent isLayoutContainer ifTrue:[ cg@3524: parent widget sizeChanged:nil cg@3524: ]. cg@3524: model value:nsel. ca@2177: ]. ca@2177: ! ca@2177: cg@3174: doEditWindowSpec cg@3174: |mthd| cg@3174: cg@3174: mthd := self windowSpecMethodOfSelection. cg@3174: UIPainter openOnClass:mthd mclass andSelector:mthd selector cg@3174: ! cg@3174: ca@2177: doFlash ca@2455: "flash the selected view" ca@2455: ca@2177: |view| ca@2177: ca@2177: view := self selectedView. ca@2177: view isNil ifTrue:[ ^ self]. ca@2177: ca@2177: view shown ifTrue:[ cg@3524: model withSelectionHiddenDo:[ cg@3524: view perform:#flash ifNotUnderstood:nil. cg@3524: ]. ca@2177: ]. ca@2177: ! ca@2177: ca@2177: doInspect:what ca@2177: "open inspector on: cg@3524: #view inspect class cg@3524: #group inspect windowGroup cg@3524: #model inspect model cg@3524: #application inspect application cg@3524: #controller inspect controller cg@3524: #process inspect application's process ca@2177: " cg@3167: ca@2177: |inst| ca@2177: cg@3167: (inst := self objectToInspectOrBrowse:what) isNil ifTrue:[^ self]. cg@3167: inst inspect. cg@3049: cg@3049: "Modified: / 28-08-2013 / 23:58:27 / cg" ca@2177: ! ca@2177: cg@3034: doOpenProcessMonitor cg@3034: (ProcessMonitorV2 ? ProcessMonitor) open cg@3034: cg@3034: "Created: / 25-07-2013 / 12:34:23 / cg" cg@3034: ! cg@3034: cg@2762: doPickView ca@2455: "pick a window's topView" ca@2455: cg@2762: |screen clickedView topWindow cursor| ca@2177: ca@2177: self doUnpick. ca@2177: cg@2759: cursor := Cursor fromImage:(self class crossHairIcon). cg@2759: cg@2759: screen := Screen current. cg@2762: clickedView := screen viewFromPoint:(screen pointFromUserShowing:cursor). cg@2762: clickedView isNil ifTrue:[^ self]. cg@2762: cg@2762: topWindow := clickedView topView. cg@2762: cg@2762: ( topWindow == Screen current rootView cg@2762: or:[topWindow == self window topView] ca@2177: ) ifTrue:[ cg@3524: ^ self ca@2177: ]. cg@2978: cg@3070: self showWindow:clickedView. ca@2177: ! ca@2177: cg@2978: doRedraw cg@2978: "redraw the app" cg@2978: cg@3456: |rootView| cg@3524: cg@3456: (rootView := model rootView) notNil ifTrue:[ cg@3524: rootView withAllSubViewsDo:[:v | v "redraw; "invalidate]. cg@3124: ] cg@3456: cg@3456: "Modified: / 16-08-2017 / 12:02:11 / cg" cg@2978: ! cg@2978: cg@3168: doSelectNextElementStartingIn:anItem forWhich:aBlock ca@2177: |startItem firstFound searchNext| ca@2177: ca@2177: startItem := model last. cg@3524: searchNext := startItem notNil. ca@2177: firstFound := nil. ca@2177: ca@2177: anItem recursiveDo:[:el| cg@3525: el == startItem ifTrue:[ cg@3525: searchNext := false cg@3525: ] ifFalse:[ cg@3525: (aBlock value:el) ifTrue:[ cg@3525: searchNext ifFalse:[^ model selectItem:el]. cg@3525: cg@3525: firstFound isNil ifTrue:[ cg@3525: firstFound := el cg@3525: ] cg@3525: ] cg@3525: ] ca@2177: ]. ca@2177: firstFound notNil ifTrue:[ cg@3525: self beepInEditor. cg@3525: model selectItem:firstFound ca@2177: ]. ca@2177: ! ca@2177: cg@3168: doSelectNextOfApplicationClass:aClass startingIn:anItem cg@3168: self doSelectNextElementStartingIn:anItem forWhich:[:el | (self resolveApplicationClassFor:el) == aClass]. cg@3168: ! cg@3168: ca@2177: doSelectNextOfClass:aClass startingIn:anItem cg@3168: self doSelectNextElementStartingIn:anItem forWhich:[:el | el widget class == aClass]. ca@2177: ! ca@2177: cg@2978: doUncatchEvents cg@3124: "release the inspected window (no longer catch its events)" cg@3124: cg@2978: model catchEvents:false. cg@3124: isCatchingEventsChannel value:false. cg@3524: "/ ((builder componentAt:'toolbarMenu') itemAt:#doUncatchEvents) cg@3124: "/ label:(self class releaseViewIcon); cg@3124: "/ enabled:false; cg@3124: "/ activeHelpKey:#doCatchEvents. cg@2978: self doRedraw cg@2978: ! cg@2978: ca@2177: doUnpick ca@2455: "release current picked window and contained subwindows" ca@2455: ca@2177: self setRootItem:nil. cg@2744: ! cg@2744: cg@3167: objectToInspectOrBrowse:what cg@3167: "return one of: cg@3524: #view for inspect/browse view/widget cg@3524: #group for inspect/browse windowGroup cg@3524: #model for inspect/browse model cg@3524: #application for inspect/browse application cg@3524: #controller for inspect/browse controller cg@3524: #process for inspect/browse application's process cg@3524: #widgetClass for inspect/browse widget's class cg@3524: #menuItem for inspect/browse menuItem cg@3167: " cg@3302: |view| cg@3167: cg@3524: what == #menuItem ifTrue:[ cg@3524: ^ model selectedItem menuItem cg@3457: ]. cg@3457: cg@3167: view := self selectedView. cg@3167: view isNil ifTrue:[^ nil]. cg@3167: cg@3302: what == #group ifTrue:[ ^ view windowGroup ]. cg@3302: what == #model ifTrue:[ ^ view model ]. cg@3302: what == #controller ifTrue:[ ^ view controller ]. cg@3302: what == #process ifTrue:[ ^ view windowGroup process ]. cg@3302: what == #sensor ifTrue:[ ^ view sensor ]. cg@3302: what == #application ifTrue:[ ^ view application ? view topView ]. cg@3302: what == #applicationClass ifTrue:[ ^ view application ? view topView ]. cg@3302: cg@3302: ^ view cg@3167: cg@3457: "Modified: / 16-08-2017 / 13:57:36 / cg" cg@3167: ! cg@3167: cg@2744: openDocumentation cg@2744: HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#VIEWTREEINSPECTOR' cg@3014: ! cg@3014: cg@3014: showWindow:aView cg@3014: "show a particular window's topView hierarchy, cg@3014: select the given view" cg@3014: cg@3014: | topWindow | cg@3014: cg@3014: topWindow := aView topView. cg@3014: cg@3124: self doCatchEvents. cg@3014: self setRootItem:(ViewTreeItem buildViewsFrom:topWindow). cg@3014: self selectView:aView. ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::MenuDesc class methodsFor:'building'! ca@2177: ca@2177: buildFromList:aList onGC:aMenu ca@2177: |tabSpec menu w menuPanel| ca@2177: ca@2177: w := 0. ca@2177: aList do:[:el| w := w max:(el widthOn:aMenu) ]. ca@2177: ca@2177: tabSpec := TabulatorSpecification new. ca@2177: tabSpec unit:#pixel. ca@2177: tabSpec positions:#(0 1.5 ). ca@2177: tabSpec align:#(#left #left). ca@2177: ca@2177: w := w + 15. ca@2177: tabSpec positions:(Array with:0 with:w). ca@2177: ca@2177: menu := Menu new. ca@2177: ca@2177: aList do:[:el| cg@3524: menu addItem:(el asMenuItemWithTabulatorSpecification:tabSpec). ca@2177: ]. ca@2177: menuPanel := MenuPanel menu:menu. ca@2177: ^ menuPanel ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::MenuDesc class methodsFor:'instance creation'! ca@2177: ca@2177: separator ca@2177: ^ self new ca@2177: ! ca@2177: ca@2177: title:aTitle value:aValue ca@2177: ^ self title:aTitle value:aValue action:nil ca@2177: ! ca@2177: ca@2177: title:aTitle value:aValue action:anAction ca@2177: ^ self new title:aTitle value:aValue action:anAction ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::MenuDesc methodsFor:'accessing'! ca@2177: ca@2177: title ca@2177: ^ title ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::MenuDesc methodsFor:'building'! ca@2177: ca@2177: asMenuItemWithTabulatorSpecification:aTabSpec ca@2177: |array| ca@2177: ca@2177: title isNil ifTrue:[ ^ MenuItem label:value ]. "/ separator ca@2177: ca@2177: array := Array with:(title, ':') with:'------'. ca@2177: ca@2177: value notNil ifTrue:[ cg@3524: array at:2 put:(value printString, ' ') ca@2177: ]. ca@2177: cg@3524: ^ MenuItem cg@3524: label:(MultiColListEntry fromStrings:array tabulatorSpecification:aTabSpec) cg@3524: value:action ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::MenuDesc methodsFor:'instance creation'! ca@2177: ca@2177: title:aTitle value:aValue action:anAction ca@2177: "test for separator ca@2177: " ca@2177: title := aTitle withoutSeparators. ca@2177: action := anAction. ca@2177: ca@2177: aValue notNil ifTrue:[ cg@3524: value := aValue printString. cg@3524: cg@3524: value size > 70 ifTrue:[ cg@3524: value := value copyFrom:1 to:70. cg@3524: value := value, '...' cg@3524: ] ca@2177: ]. ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'! ca@2177: ca@2177: isSeparator ca@2177: ^ title isNil ca@2177: ! ca@2177: ca@2177: widthOn:aGC ca@2177: title isNil ifTrue:[^ 5]. "/ separator cg@2758: ^ title widthOn:aGC ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'! cg@2744: cg@3456: buildMenuItemsFrom:aMenuItem cg@3456: "build the items starting from a source menu item; cg@3456: returns the anchor. cg@3456: " cg@3456: |item subMenu subItems| cg@3456: cg@3456: aMenuItem isNil ifTrue:[^ nil]. cg@3456: cg@3456: item := self forMenuItem:aMenuItem. cg@3456: subItems := OrderedCollection new. cg@3456: (subMenu := aMenuItem submenuOrNil) notNil ifTrue:[ cg@3524: subMenu items do:[:eachMenuItem | cg@3524: subItems add:(self buildMenuItemsFrom:eachMenuItem) cg@3524: ]. cg@3456: ]. cg@3456: item children:subItems. cg@3456: ^ item cg@3456: cg@3456: "Created: / 16-08-2017 / 12:23:02 / cg" cg@3456: ! cg@3456: cg@2744: buildViewsFrom:aView cg@2744: "build the items starting from a source view; cg@3456: returns the anchor. cg@2744: " cg@2744: |item subViews subItems| cg@2744: cg@2744: aView isNil ifTrue:[^ nil]. cg@2744: cg@2744: item := self forView:aView. cg@2744: subViews := aView subViews. cg@3456: subItems := OrderedCollection new. cg@2744: cg@2744: subViews notEmptyOrNil ifTrue:[ cg@3524: subViews do:[:aSubView| cg@3524: subItems add:(self buildViewsFrom:aSubView). cg@3524: ]. cg@2744: ]. cg@3456: cg@3456: (aView isKindOf:MenuPanel) ifTrue:[ cg@3524: (aView items ? #()) do:[:eachMenuItem | cg@3524: subItems add:(self buildMenuItemsFrom:eachMenuItem) cg@3524: ]. cg@3524: ]. cg@3456: item children:subItems. cg@3524: cg@2744: ^ item cg@3456: cg@3456: "Modified: / 16-08-2017 / 12:43:35 / cg" cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'! cg@2744: cg@2744: documentation cg@2744: " cg@2744: ViewTreeItems represants a pickable object within a ViewTreeModel. cg@2744: The class is used to build up the hierarchical tree. cg@2744: cg@2744: [Instance variables:] cg@3524: widget the widget represented by the item cg@3524: spec the UISpecification or nil cg@2744: cg@2744: [Class variables:] cg@3524: HandleExtent keeps the extent of a handle cg@2744: cg@2744: cg@2744: [author:] cg@3524: Claus Atzkern cg@2744: cg@2744: [see also:] cg@3524: HierarchicalItem cg@3524: ViewTreeModel cg@2744: " cg@2744: ! ca@2177: ca@2177: version ca@2177: ^ '$Header$' ca@2177: ! ! ca@2177: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'! cg@2744: cg@2744: initialize cg@2744: "set the extent of the Handle cg@2744: " cg@2744: HandleExtent := 6@6. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'! cg@2744: cg@3456: forMenuItem:aMenuItem cg@3456: |item| cg@3456: cg@3456: item := self basicNew initialize. cg@3456: item forMenuItem:aMenuItem. cg@3456: ^ item cg@3456: cg@3456: "Created: / 16-08-2017 / 12:07:55 / cg" cg@3456: ! cg@3456: cg@2744: forView:aView cg@2744: |item| cg@2744: cg@2744: item := self basicNew initialize. cg@2744: item forView:aView. cg@3456: ^ item cg@3456: cg@3456: "Modified (format): / 16-08-2017 / 12:07:40 / cg" cg@2744: ! cg@2744: cg@2744: new cg@2744: self error:'not allowed'. cg@2744: ^ nil cg@2744: ! cg@2744: cg@2744: on:aView withSpec:aSpec cg@2744: |item| cg@2744: cg@2744: item := self basicNew initialize. cg@2744: item on:aView withSpec:aSpec. cg@2744: ^ item cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'! cg@2744: cg@2744: applicationClass cg@2744: |appl| cg@2744: cg@2744: widget notNil ifTrue:[ cg@3524: appl := widget application. cg@3524: appl notNil ifTrue:[^ appl class ]. cg@2744: ]. cg@2744: ^ nil cg@2744: ! cg@2744: cg@2744: isDrawnShown cg@2744: "returns true if the last display operations was done during the widget was shown cg@2744: " cg@2744: ^ isDrawnShown cg@2744: ! cg@2744: cg@2744: isDrawnShown:aBoolean cg@2744: isDrawnShown := aBoolean. cg@2744: ! cg@2744: cg@3456: menuItem cg@3456: ^ menuItem cg@3456: ! cg@3456: cg@3456: parent:aParent cg@3456: super parent:aParent. cg@3456: cg@3456: "Created: / 16-08-2017 / 12:40:26 / cg" cg@3456: ! cg@3456: cg@2744: rootView cg@2744: "returns the widget assigned to the root or nil cg@2744: " cg@3216: parent isNil ifTrue:[^ nil]. cg@3216: cg@2744: ^ parent rootView cg@2744: ! cg@2744: cg@2744: specClass cg@2744: "returns the spec-class assigned to the item cg@2744: " cg@3456: widget isNil ifTrue:[ cg@3524: ^ MenuPanelSpec cg@3456: ]. cg@2744: ^ widget specClass cg@3456: cg@3456: "Modified (format): / 16-08-2017 / 12:31:36 / cg" cg@2744: ! cg@2744: cg@2744: treeModel cg@2744: "returns the assigned treeModel, an instance of ViewTreeModel cg@2744: " cg@2744: ^ parent treeModel cg@2744: ! cg@2744: cg@2744: widget cg@2744: "returns the widget assigned to the item cg@2744: " cg@2744: ^ widget cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'! cg@2744: cg@2744: boundsRelativeToRoot cg@2744: "returns the bounds relative to the root widget cg@2744: " cg@2744: ^ self originRelativeToRoot extent:(widget extent) cg@2744: ! cg@2744: cg@2744: cornerRelativeToRoot cg@2744: "returns the corner relative to the root widget cg@2744: " cg@2744: ^ self originRelativeToRoot + (widget extent) cg@2744: ! cg@2744: cg@2744: extent cg@2744: "returns the extent of the widget cg@2744: " cg@2744: ^ widget extent cg@2744: ! cg@2744: cg@2744: layoutType cg@2744: "returns the type of layout assigned to the wiget; nil if the cg@2744: superView cannot resize its sub widgets cg@2744: " cg@2744: |layout specClass superView| cg@2744: cg@2744: (superView := widget superView) isNil ifTrue:[ cg@3524: ^ #Extent cg@2744: ]. cg@3524: cg@2744: specClass := superView specClass. cg@2744: cg@2744: (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[ cg@3524: ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil] cg@2744: ]. cg@2744: cg@2744: (layout := widget geometryLayout) isNil ifTrue:[ cg@3524: ^ #Extent cg@2744: ]. cg@2744: cg@2744: layout isLayout ifTrue:[ cg@3524: layout isLayoutFrame ifTrue:[ ^ #LayoutFrame ]. cg@3524: layout isAlignmentOrigin ifTrue:[ ^ #AlignmentOrigin ]. cg@3524: layout isLayoutOrigin ifTrue:[ ^ #LayoutOrigin ]. cg@2744: ] ifFalse:[ cg@3524: layout isRectangle ifTrue:[ ^ #Rectangle ]. cg@3524: layout isPoint ifTrue:[ ^ #Point ]. cg@2744: cg@2744: ]. cg@2744: Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString. cg@2744: ^ nil cg@2744: ! cg@2744: cg@2744: originRelativeToRoot cg@2744: "returns the origin relative to the root widget cg@2744: " cg@2744: ^ widget originRelativeTo:(self rootView) cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'! cg@2744: cg@2744: children cg@2744: "redefined: optimize cg@2744: " cg@2744: ^ children cg@2744: ! cg@2744: cg@2744: hasChildren cg@3456: "not only a query; also builds" cg@3456: cg@3456: |subViews list item subMenu| cg@3456: cg@3456: children isNil ifTrue:[ cg@3524: isExpanded := false. cg@3524: cg@3524: list := OrderedCollection new. cg@3524: cg@3524: "/ it's either a widget or a menuItem cg@3524: widget notNil ifTrue:[ cg@3524: subViews := widget subViews. cg@3524: subViews notEmptyOrNil ifTrue:[ cg@3524: subViews do:[:aSubView| cg@3524: item := self class buildViewsFrom:aSubView. cg@3524: item parent:self. cg@3524: list add:item. cg@3524: ]. cg@3524: ]. cg@3524: ]. cg@3524: cg@3524: menuItem notNil ifTrue:[ cg@3524: (subMenu := menuItem submenuOrNil) notNil ifTrue:[ cg@3524: subMenu items do:[:aSubItem| cg@3524: item := self class buildMenuItemsFrom:aSubItem. cg@3524: item parent:self. cg@3524: list add:item. cg@3524: ]. cg@3524: ]. cg@3524: ]. cg@3524: children := list. cg@2744: ]. cg@3456: ^ children notEmpty cg@3456: cg@3456: "Modified: / 16-08-2017 / 12:27:23 / cg" cg@2744: ! cg@2744: cg@2744: size cg@2744: "redefined: returns list of children cg@2744: " cg@2744: ^ children size cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'! cg@2744: cg@2744: additionalLabelForItem:anItem cg@3017: "answer an additional label for an Item" cg@2744: cg@2744: parent notNil ifTrue:[ cg@3524: ^ parent additionalLabelForItem:anItem cg@2744: ]. cg@2744: ^ nil cg@2744: ! cg@2744: cg@2744: displayIcon:anIcon atX:x y:y on:aGC cg@2744: |x0 y0 y1 w| cg@2744: cg@2744: super displayIcon:anIcon atX:x y:y on:aGC. cg@2744: cg@2744: self exists ifFalse:[ cg@3524: aGC paint:(Color red). cg@3524: cg@3524: y0 := y + 1. cg@3524: y1 := y + anIcon height - 2. cg@3524: cg@3524: x0 := x - 1. cg@3524: w := anIcon width. cg@3524: cg@3524: 2 timesRepeat:[ cg@3524: aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1. cg@3524: aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0. cg@3524: x0 := x0 + 1. cg@3524: ]. cg@2744: ]. cg@2744: ! cg@2744: cg@3184: displayOn:aGC x:x y:y h:h isHighlightedAsSelected:isHighlightedAsSelected cg@2744: |labelHeight additionalName label isValidAndShown| cg@2744: cg@2744: label := self label. cg@2744: label isEmptyOrNil ifTrue:[^ self]. cg@2744: cg@3456: widget isNil ifTrue:[ cg@3524: isValidAndShown := true. cg@3456: ] ifFalse:[ cg@3524: widget id isNil ifTrue:[ cg@3524: isDrawnShown := false. cg@3524: cg@3524: self exists ifFalse:[ cg@3524: xOffsetAdditionalName := nil. cg@3524: ]. cg@3524: isValidAndShown := false. cg@3524: ] ifFalse:[ cg@3524: isValidAndShown := widget shown. cg@3524: ]. cg@2744: ]. cg@3524: cg@2744: isValidAndShown ifFalse:[ cg@3524: label := Text string:label emphasis:#italic. cg@3524: label colorizeAllWith:Color gray. cg@2744: ]. cg@2744: cg@2744: labelHeight := self heightOn:aGC. cg@3184: self displayLabel:label h:labelHeight on:aGC x:x y:y h:h isHighlightedAsSelected:isHighlightedAsSelected. cg@2744: cg@2744: xOffsetAdditionalName notNil ifTrue:[ cg@3524: additionalName := self additionalLabelForItem:self. cg@3524: cg@3524: additionalName notNil ifTrue:[ cg@3524: self displayLabel:additionalName cg@3524: h:labelHeight on:aGC cg@3524: x:(x + xOffsetAdditionalName) y:y cg@3524: h:h. cg@3524: ] ifFalse:[ cg@3524: xOffsetAdditionalName := nil. cg@3524: ]. cg@2744: ]. cg@3456: cg@3456: "Modified (format): / 16-08-2017 / 12:57:39 / cg" cg@2744: ! cg@2744: cg@2744: recursiveAdditionalNameBehaviourChanged cg@2744: width := xOffsetAdditionalName := nil. cg@2744: cg@2744: children notNil ifTrue:[ cg@3524: children do:[:each| each recursiveAdditionalNameBehaviourChanged ] cg@2744: ]. cg@2744: ! cg@2744: cg@2744: widthOn:aGC cg@2744: "return the width of the receiver, if it is to be displayed on aGC cg@2744: " cg@2744: |additionalName| cg@2744: cg@2744: width isNil ifTrue:[ cg@3524: width := self widthOf:(self label) on:aGC. cg@3524: width := width + 2. cg@3524: cg@3524: additionalName := self additionalLabelForItem:self. cg@3524: cg@3524: additionalName notNil ifTrue:[ cg@3524: xOffsetAdditionalName := width + 10. cg@3524: width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC). cg@3524: width := width + 2. cg@3524: ] ifFalse:[ cg@3524: xOffsetAdditionalName := nil. cg@3524: ]. cg@2744: ]. cg@2744: ^ width cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'! cg@2744: cg@2744: handlesDo:aTwoArgAction cg@2744: "evaluate the two arg block on each handle; the arguments to the block is cg@2744: the rectangle relative to the rootView and the handle type which is cg@2744: set to nil if not resizeable. cg@2744: cg@2744: TYPES: type position( X - Y ) cg@3524: ------------------------- cg@3524: #LT Left - Top cg@3524: #LC Left - Center cg@3524: #LB Left - Bottom cg@3524: #CT Center - Top cg@3524: #CB Center - Bottom cg@3524: #RT Right - Top cg@3524: #RC Right - Center cg@3524: #RB Right - Bottom cg@3524: cg@3524: nil ** handle not pickable ** cg@2744: " cg@2744: |type relOrg relCrn maxExt rootView w h cg@2744: xL "{ Class:SmallInteger }" cg@2744: xC "{ Class:SmallInteger }" cg@2744: xR "{ Class:SmallInteger }" cg@2744: yT "{ Class:SmallInteger }" cg@2744: yC "{ Class:SmallInteger }" cg@2744: yB "{ Class:SmallInteger }" cg@2744: | cg@2744: rootView := self rootView. cg@3217: rootView isNil ifTrue:[^ self ]. cg@3217: cg@3456: widget isNil ifTrue:[^ self]. cg@3456: cg@2744: relOrg := widget originRelativeTo:rootView. cg@2744: relOrg isNil ifTrue:[ ^ self ]. "/ widget destroyed cg@2744: cg@2744: relOrg := relOrg - (HandleExtent // 2). cg@2744: relCrn := relOrg + widget extent. cg@2744: maxExt := rootView extent - HandleExtent. cg@2744: cg@2744: xL := relOrg x max:0. cg@2744: xR := relCrn x min:(maxExt x). cg@2744: xC := xR + xL // 2. cg@2744: cg@2744: yT := relOrg y max:0. cg@2744: yB := relCrn y min:(maxExt y). cg@2744: yC := yB + yT // 2. cg@2744: cg@2744: type := self layoutType. cg@2744: w := HandleExtent x. cg@2744: h := HandleExtent y. cg@2744: cg@2744: (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[ cg@3524: aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT. cg@3524: aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC. cg@3524: aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB. cg@3524: aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT. cg@3524: aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB. cg@3524: aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT. cg@3524: aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC. cg@3524: aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB. cg@2744: ^ self cg@2744: ]. cg@2744: cg@2744: aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil. cg@2744: aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil. cg@2744: aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil. cg@2744: cg@2744: type == #Extent ifTrue:[ cg@3524: aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB. cg@3524: aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC. cg@3524: aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB. cg@2744: ^ self cg@2744: ]. cg@2744: aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil. cg@3456: cg@3456: "Modified: / 16-08-2017 / 13:04:27 / cg" cg@2744: ! cg@2744: cg@2744: recursiveEachVisibleItemDo:anOneArgBlock cg@2744: "recursive evaluate the block on each child which is visible cg@2744: " cg@2744: (isExpanded and:[children size > 0]) ifTrue:[ cg@3524: children do:[:aChild| cg@3524: anOneArgBlock value:aChild. cg@3524: aChild recursiveEachVisibleItemDo:anOneArgBlock. cg@3524: ] cg@2744: ]. cg@2744: ! cg@2744: cg@2744: subViewsDo:aOneArgBlock cg@3524: "evaluate aBlock for all subviews other than InputView's cg@2744: " cg@2744: |subViews| cg@2744: cg@2744: subViews := widget subViews. cg@2744: cg@2744: subViews notNil ifTrue:[ cg@3524: subViews do:aOneArgBlock cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'! cg@2744: cg@3456: forMenuItem:aMenuItem cg@3456: menuItem := aMenuItem. cg@3456: cg@3456: "Created: / 16-08-2017 / 12:08:50 / cg" cg@3456: ! cg@3456: cg@2744: forView:aView cg@2744: widget := aView. cg@2744: ! cg@2744: cg@2744: initialize cg@2744: "setup default attributes cg@2744: " cg@2744: super initialize. cg@2744: isDrawnShown := false. cg@2744: isExpanded := false. cg@2744: children := OrderedCollection new. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'! cg@2744: cg@2744: delete cg@2744: "delete self and all contained items; the assigned views are destroyed cg@2744: in case of rootView, only the children are deleted cg@2744: " cg@2744: parent isHierarchicalItem ifTrue:[ cg@3524: self criticalDo:[ cg@3524: parent remove:self. cg@3524: widget destroy. cg@3524: ] cg@2744: ] ifFalse:[ cg@3524: self deleteAll cg@2744: ]. cg@2744: ! cg@2744: cg@2744: deleteAll cg@2744: "delete all contained items; the assigned views are destroyed cg@2744: " cg@2744: children size == 0 ifTrue:[^ self]. cg@2744: cg@2744: self criticalDo:[ cg@3524: self nonCriticalDo:[:el| el widget destroy ]. cg@3524: self removeAll cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'! cg@2744: cg@2744: asLayoutFrame cg@2744: "convert the layout of the widget to a LayoutFrame; cg@2744: " cg@2744: |extent layout newLyt lftFrc lftOff topFrc topOff| cg@2744: cg@2744: layout := widget geometryLayout. cg@2744: cg@2744: layout isNil ifTrue:[ cg@3524: ^ widget bounds asLayout cg@2744: ]. cg@2744: cg@2744: layout isLayout ifFalse:[ cg@3524: layout isRectangle ifTrue:[ cg@3524: ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right) cg@3524: topOffset:(layout top) bottomOffset:(layout bottom) cg@3524: ]. cg@3524: layout isPoint ifTrue:[ cg@3524: extent := widget extent. cg@3524: ^ LayoutFrame leftOffset:(layout x) rightOffset:(layout x + extent x) cg@3524: topOffset:(layout y) bottomOffset:(layout y + extent y) cg@3524: ]. cg@3524: cg@3524: Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString. cg@2744: ^ nil cg@2744: ]. cg@2744: cg@3524: layout isLayoutFrame ifTrue:[ ^ layout copy ]. cg@2744: cg@2744: lftFrc := layout leftFraction. cg@2744: lftOff := layout leftOffset. cg@2744: topFrc := layout topFraction. cg@2744: topOff := layout topOffset. cg@2744: extent := widget extent. cg@2744: cg@2744: newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff cg@3524: rightFraction:lftFrc offset:(lftOff + extent x) cg@3524: topFraction:topFrc offset:topOff cg@3524: bottomFraction:topFrc offset:(topOff + extent y). cg@2744: cg@2744: ( layout isAlignmentOrigin cg@2744: and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])] cg@2744: ) ifTrue:[ cg@3524: |svRc prBd dlta| cg@3524: cg@3524: svRc := widget superView viewRectangle. cg@3524: prBd := widget preferredBounds. cg@3524: cg@3524: dlta := ( ((layout rectangleRelativeTo:svRc preferred:prBd) corner) cg@3524: - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner) cg@3524: ) rounded. cg@3524: cg@3524: newLyt leftOffset:(lftOff + dlta x). cg@3524: newLyt rightOffset:(lftOff + extent x + dlta x). cg@3524: newLyt topOffset:(topOff + dlta y). cg@3524: newLyt bottomOffset:(topOff + extent y + dlta y). cg@2744: ]. cg@2744: ^ newLyt cg@2744: ! cg@2744: cg@2744: moveLeft:l top:t cg@2744: "move the widget n pixele left and right cg@2744: " cg@2744: |layout| cg@2744: cg@2744: self isMoveable ifFalse:[ ^ self ]. cg@2744: cg@2744: (layout := widget geometryLayout) isNil ifTrue:[ cg@3524: "Extent" cg@3524: widget origin:(widget origin + (l@t)). cg@2744: ^ self cg@2744: ]. cg@2744: cg@2744: layout := layout copy. cg@2744: cg@2744: layout isLayout ifTrue:[ cg@3524: layout leftOffset:(layout leftOffset + l) cg@3524: topOffset:(layout topOffset + t). cg@3524: cg@3524: layout isLayoutFrame ifTrue:[ cg@3524: layout rightOffset:(layout rightOffset + l). cg@3524: layout bottomOffset:(layout bottomOffset + t). cg@3524: ] cg@2744: cg@2744: ] ifFalse:[ cg@3524: layout isRectangle ifTrue:[ cg@3524: layout setLeft:(layout left + l). cg@3524: layout setTop:(layout top + t). cg@3524: ] ifFalse:[ cg@3524: layout isPoint ifFalse:[^ self]. cg@3524: layout x:(layout x + l) y:(layout y + t). cg@3524: ] cg@2744: ]. cg@2744: widget geometryLayout:layout. cg@2744: ! cg@2744: cg@2744: resizeLeft:l top:t right:r bottom:b cg@2744: "resize the widget measured in pixels cg@2744: " cg@2744: |layout| cg@2744: cg@2744: self isResizeable ifFalse:[ cg@3524: ^ self cg@2744: ]. cg@2744: cg@2744: (layout := widget geometryLayout) isNil ifTrue:[ cg@3524: "Extent" cg@3524: (r == l and:[b == t]) ifFalse:[ cg@3524: widget extent:(widget computeExtent + ((r-l) @ (b-t))). cg@3524: ]. cg@3524: ^ self cg@2744: ]. cg@2744: cg@2744: layout isLayout ifTrue:[ cg@3524: layout := layout copy. cg@3524: cg@3524: layout leftOffset:(layout leftOffset + l) cg@3524: topOffset:(layout topOffset + t). cg@3524: cg@3524: layout isLayoutFrame ifTrue:[ cg@3524: layout bottomOffset:(layout bottomOffset + b). cg@3524: layout rightOffset:(layout rightOffset + r). cg@3524: ] cg@2744: ] ifFalse:[ cg@3524: layout isRectangle ifFalse:[^ self]. cg@3524: layout := layout copy. cg@3524: cg@3524: layout left:(layout left + l) cg@3524: right:(layout right + r) cg@3524: top:(layout top + t) cg@3524: bottom:(layout bottom + b). cg@2744: ]. cg@2744: widget geometryLayout:layout. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'! cg@2744: cg@2744: updateChildren cg@3209: |queue| cg@3209: cg@3209: queue := OrderedCollection new. cg@3209: queue add:self. cg@3209: cg@3209: self criticalDo:[ cg@3524: [queue notEmpty] whileTrue:[ cg@3524: |toRemove elProcessed| cg@3524: cg@3524: elProcessed := queue removeFirst. cg@3524: toRemove := nil. cg@3524: elProcessed nonCriticalDo:[:el| cg@3524: el exists ifTrue:[ cg@3524: queue add:el. cg@3524: ] ifFalse:[ cg@3524: toRemove isNil ifTrue:[toRemove := OrderedCollection new]. cg@3524: toRemove add:el. cg@3524: ] cg@3524: ]. cg@3524: toRemove notNil ifTrue:[ cg@3524: toRemove do:[:el| elProcessed remove:el ]. cg@3524: ]. cg@3524: ]. cg@2744: ]. cg@2744: ! cg@2744: cg@2744: updateFromChildren:mergedList cg@2744: "update my children against the list of items derived from cg@2744: the merged list. cg@2744: " cg@2744: cg@2744: mergedList size == 0 ifTrue:[ ^ self removeAll ]. cg@2744: children size == 0 ifTrue:[ ^ self addAll:mergedList ]. cg@2744: cg@2744: self criticalDo:[ cg@3524: self nonCriticalDo:[:el| |wdg| cg@3524: wdg := el widget. cg@3524: mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ]. cg@3524: ]. cg@3524: cg@3524: mergedList keysAndValuesDo:[:i :el| |wdg e2| cg@3524: wdg := el widget. cg@3524: cg@3524: e2 := self at:i ifAbsent:nil. cg@3524: cg@3524: (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[ cg@3524: self add:el beforeIndex:i cg@3524: ] cg@3524: ] cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'! cg@2744: cg@2744: icon cg@3456: "get the icon used for presentation" cg@3456: cg@2744: |specClass model| cg@2744: cg@3456: menuItem notNil ifTrue:[ cg@3524: menuItem label isImage ifTrue:[ cg@3524: ^ menuItem label magnifiedTo:20@20. cg@3524: ]. cg@3456: ]. cg@3524: cg@2744: specClass := self specClass. cg@2744: specClass isNil ifTrue:[^ nil]. cg@2744: cg@2744: model := self treeModel. cg@2744: model notNil ifTrue:[ cg@3524: ^ model iconAt:specClass ifNonePut:[specClass icon] cg@2744: ]. cg@2744: ^ specClass icon cg@3456: cg@3456: "Modified: / 16-08-2017 / 13:00:35 / cg" cg@2744: ! cg@2744: cg@2744: label cg@2744: "get the label used for presentation cg@2744: " cg@2744: ^ self string cg@2744: ! cg@2744: cg@2744: printOn:aStream cg@2744: "append a a printed representation of the item to aStream cg@2744: " cg@2744: aStream nextPutAll:(self string) cg@2744: ! cg@2744: cg@2744: string cg@2744: "get the string cg@2744: " cg@3456: widget isNil ifTrue:[ cg@3524: ^ menuItem class name cg@3524: ]. cg@2744: ^ widget class name. cg@3456: cg@3456: "Modified: / 16-08-2017 / 13:45:39 / cg" cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'! cg@2744: cg@2744: canChangeLayout cg@2744: "returns true if the layout of the widget can be changed and the cg@2744: layout is not organized by its superView cg@2744: " cg@2744: ^ self isResizeable cg@2744: ! cg@2744: cg@2744: canResizeSubComponents cg@2744: "returns true if the widget can resize its sub components cg@2744: " cg@2744: |specClass| cg@2744: cg@2744: specClass := self specClass. cg@2744: cg@2744: specClass notNil ifTrue:[ cg@3524: ^ specClass canResizeSubComponents cg@2744: ]. cg@2744: ^ false cg@2744: ! cg@2744: cg@2744: exists cg@3456: widget isNil ifTrue:[^ menuItem notNil]. cg@2744: widget id notNil ifTrue:[^ true ]. cg@2744: cg@2744: exists ~~ false ifTrue:[ cg@3524: exists := false. cg@3524: cg@3524: widget superView notNil ifTrue:[ cg@3524: (parent isHierarchicalItem and:[parent exists]) ifTrue:[ cg@3524: exists := (parent widget subViews includesIdentical:widget). cg@3524: ]. cg@3524: ]. cg@2744: ]. cg@2744: ^ exists cg@3456: cg@3456: "Modified: / 16-08-2017 / 12:47:50 / cg" cg@2744: ! cg@2744: cg@2744: isApplicationClass cg@2744: |cls| cg@2744: cg@2744: cls := widget class. cg@2744: cg@2744: ^ ( cls == ApplicationSubView cg@3524: or:[cls == ApplicationWindow cg@3524: or:[cls == SubCanvas]] cg@3524: ) cg@2744: ! cg@2744: cg@2744: isSelected cg@2744: |model| cg@2744: cg@2744: model := self treeModel. cg@2744: model notNil ifTrue:[^ model isSelected:self]. cg@2744: ^ false cg@2744: ! cg@2744: cg@2744: supportsSubComponents cg@2744: "returns true if the widget supports sub components cg@2744: " cg@2744: |specClass| cg@2744: cg@2744: widget isScrollWrapper ifTrue:[ cg@3524: ^ false cg@2744: ]. cg@2744: specClass := self specClass. cg@2744: cg@2744: specClass notNil ifTrue:[ cg@3524: ^ specClass supportsSubComponents cg@2744: ]. cg@2744: ^ false cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'! cg@2744: cg@2744: isInLayoutContainer cg@2744: "returns true if the widget is in a layout container cg@2744: " cg@2744: |sv specClass| cg@2744: cg@2744: sv := widget superView. cg@2744: cg@2744: sv notNil ifTrue:[ cg@3524: specClass := sv specClass. cg@3524: cg@3524: specClass notNil ifTrue:[ cg@3524: ^ specClass isLayoutContainer cg@3524: ]. cg@2744: ]. cg@2744: ^ false cg@2744: ! cg@2744: cg@2744: isLayoutContainer cg@2744: "answer whether corresponding view instances of the spec class can contain cg@2744: (and arrange) other view cg@2744: " cg@2744: |specClass| cg@2744: cg@2744: specClass := self specClass. cg@2744: cg@2744: specClass notNil ifTrue:[ cg@3524: ^ specClass isLayoutContainer cg@2744: ]. cg@2744: ^ false cg@2744: ! cg@2744: cg@2744: isMoveable cg@2744: "returns true if the widget is not in a layout container cg@2744: " cg@2744: self isInLayoutContainer ifFalse:[ cg@3524: ^ widget superView notNil cg@2744: ]. cg@2744: ^ false cg@2744: ! cg@2744: cg@2744: isResizeable cg@2744: "returns true if the widget is resizeable cg@2744: " cg@2744: |sv specClass| cg@2744: cg@2744: sv := widget superView. cg@2744: cg@2744: sv notNil ifTrue:[ cg@3524: specClass := sv specClass. cg@3524: cg@3524: specClass notNil ifTrue:[ cg@3524: ^ specClass canResizeSubComponents cg@3524: ]. cg@2744: ]. cg@2744: ^ false cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'! cg@2744: cg@2744: documentation cg@2744: " cg@2744: Instances of ViewTreeModel can be used as model on a View and all cg@2744: it contained subviews for a HierarchicalListView. cg@2744: The model keeps two values, the hierarchical representation of the views cg@2744: and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's. cg@2744: It shows the selected items highlighted. cg@2744: cg@2744: cg@2744: [Instance variables:] cg@3524: lockSema lock selection notifications and redraws cg@3524: cg@3524: testModeChannel true, than running in test mode. cg@3524: cg@3524: hasTargetWidgetChannel true, than any target view is grapped cg@3524: cg@3524: selection selected items or nil cg@3524: cg@3524: hiddenLevel internal use; redrawing the selection cg@3524: only is done if the counter is 0. cg@3524: cg@3524: listOfItems hiearchical list build from existing items. cg@3524: cg@3524: selectedSuperItems list of selected super items; items selected cg@3524: but not contained in another selected item. cg@3524: cg@3524: inputEventAction called for each InputEvent cg@3524: cg@3524: mappedViewAction called for a new mapped view which cg@3524: can not be found in the current item list. cg@3524: cg@3524: beforeSelectionChangedAction called before the selection changed cg@2744: cg@2744: [author:] cg@3524: Claus Atzkern cg@2744: cg@2744: [see also:] cg@3524: ViewTreeItem cg@2744: " cg@2744: ! cg@2744: cg@2744: examples cg@2744: " cg@2744: example 1: pick any window and show views and contained views cg@3524: [exBegin] cg@2744: |top sel model panel| cg@2744: cg@2744: model := ViewTreeModel new. cg@2744: top := StandardSystemView new; extent:440@400. cg@2744: sel := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top. cg@2744: sel bottomInset:24. cg@2744: cg@2744: panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top. cg@2744: panel topInset:-24. cg@2744: panel horizontalLayout:#fitSpace. cg@2744: cg@2744: Button label:'Exit' action:[model rootItem:nil. top destroy] in:panel. cg@2744: Button label:'Pick Views' action:[ |win| cg@3524: ( (win := Screen current viewFromUser) notNil cg@3524: and:[(win := win topView) ~~ Screen current rootView cg@3524: and:[win ~~ top]] cg@3524: ) ifTrue:[ cg@3524: model rootItem:(ViewTreeItem buildViewsFrom:win) cg@3524: ] ifFalse:[ cg@3524: model rootItem:nil cg@3524: ] cg@3524: ] in:panel. cg@2744: cg@2744: sel multipleSelectOk:true. cg@2744: sel list:model listOfItems. cg@2744: sel model:model. cg@2744: sel useIndex:false. cg@2744: cg@2744: sel doubleClickAction:[:i| |el| cg@3524: el := model listOfItems at:i. cg@3524: el spec notNil ifTrue:[ el spec inspect ] ifFalse:[ el widget inspect ] cg@2744: ]. cg@2744: sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ]. cg@2744: cg@2744: model inputEventAction:[:anEvent| |item| cg@3524: anEvent isButtonEvent ifTrue:[ cg@3524: anEvent isButtonPressEvent ifTrue:[ cg@3524: model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)). cg@3524: ] ifFalse:[ cg@3524: anEvent type == #'buttonMultiPress:x:y:' ifTrue:[ cg@3524: (item := model selectedItem) notNil ifTrue:[item widget inspect] cg@3524: ] cg@3524: ] cg@3524: ] cg@2744: ]. cg@2744: cg@2744: top openAndWait. cg@2744: [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8 cg@2744: cg@3524: [exEnd] cg@2744: " cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'! cg@2744: cg@2744: application:anApplication cg@2744: listOfItems application:anApplication. cg@2744: ! cg@2744: cg@2978: catchEvents:aBoolean cg@2978: catchEvents := aBoolean. cg@2978: aBoolean ifFalse:[ cg@3524: self redrawUnselected:selection andLock:false checkTestMode:false. cg@2978: ]. cg@2978: ! cg@2978: jan@3112: path jan@3112: "Return a XPath like path to this item" jan@3112: jan@3112: | view views| jan@3112: jan@3112: selection isNil ifTrue:[ ^ nil ]. cg@3524: selection isCollection ifTrue:[ cg@3524: selection size ~~ 1 ifTrue:[ ^ nil ]. cg@3524: view := selection anElement widget. cg@3524: ] ifFalse:[ cg@3524: view := selection widget. jan@3112: ]. cg@3456: view isNil ifTrue:[^ nil]. cg@3524: jan@3112: views := OrderedCollection new. cg@3524: [ view notNil ] whileTrue:[ cg@3524: views add: view. cg@3524: view := view superView. jan@3112: ]. jan@3112: views removeLast. jan@3112: ^ String streamContents:[ :s| cg@3524: views reverseDo:[:each | cg@3524: s nextPutAll:'/'. cg@3524: s nextPutAll: each name asString "storeString". cg@3524: ]. jan@3112: ] jan@3112: jan@3112: "Created: / 19-05-2014 / 18:15:53 / Jan Vrany " cg@3456: "Modified: / 16-08-2017 / 13:03:47 / cg" jan@3112: ! jan@3112: cg@2744: rootItem cg@2744: "get the rootItem the event viewer is established on cg@2744: " cg@2744: ^ listOfItems root cg@2744: ! cg@2744: cg@2744: rootItem:anItem cg@2744: "set the rootItem the event viewer is established on cg@2744: " cg@2744: |expanded| cg@2744: cg@2744: timedUpdateTask := nil. cg@2744: self deselect. cg@2744: cg@2744: lockSema critical:[ cg@3524: anItem notNil ifTrue:[ expanded := anItem isExpanded ] cg@3524: ifFalse:[ expanded := false ]. cg@3524: cg@3524: self value:nil. cg@3524: listOfItems root:anItem. cg@3524: cg@3524: anItem notNil ifTrue:[ cg@3524: timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8. cg@3524: timedUpdateTask name:'Update'. cg@3524: timedUpdateTask resume. cg@3524: ]. cg@2744: ]. cg@2744: cg@2744: (expanded and:[anItem notNil]) ifTrue:[ cg@3524: anItem expand cg@2744: ]. cg@2744: ^ anItem cg@2744: ! cg@2744: cg@2744: rootView cg@2744: "get the top widget the event viewer is established on, a View cg@2744: " cg@2744: ^ listOfItems rootView cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'! cg@2744: cg@2744: beforeSelectionChangedAction cg@2744: "none argument action which is called before cg@2744: the selection changed cg@2744: " cg@2744: ^ beforeSelectionChangedAction cg@2744: ! cg@2744: cg@2744: beforeSelectionChangedAction:aNoneArgBlock cg@2744: "none argument action which is called before cg@2744: the selection changed cg@2744: " cg@2744: beforeSelectionChangedAction := aNoneArgBlock. cg@2744: ! cg@2744: cg@2744: inputEventAction cg@2744: "called for each input event; the argument to the action is the WindowEvent cg@2744: " cg@2744: ^ inputEventAction cg@2744: ! cg@2744: cg@2744: inputEventAction:aOneArgActionTheEvent cg@2744: "called for each input event; the argument to the action is the WindowEvent cg@2744: " cg@2744: inputEventAction := aOneArgActionTheEvent. cg@2744: ! cg@2744: cg@2744: mappedViewAction cg@2744: "called for a new mapped view which can not be found cg@2744: in the current item list cg@2744: " cg@2744: ^ mappedViewAction cg@2744: ! cg@2744: cg@2744: mappedViewAction:aOneArgBlockTheMappedView cg@2744: "called for a new mapped view which can not be found cg@2744: in the current item list cg@2744: " cg@2744: mappedViewAction := aOneArgBlockTheMappedView cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'! cg@2744: cg@2744: iconAt:aKey ifNonePut:aNoneArgBlock cg@2744: |icon view| cg@2744: cg@2744: icon := icons at:aKey ifAbsent:nil. cg@2744: icon notNil ifTrue:[^ icon]. cg@2744: cg@2744: icon := aNoneArgBlock value. cg@2744: icon isNil ifTrue:[^ nil]. cg@2744: cg@2744: view := self rootView. cg@2744: view isNil ifTrue:[^ icon]. cg@2744: cg@2744: icon := icon copy onDevice:(view device). cg@2744: icon isImage ifTrue:[ cg@3524: icon clearMaskedPixels. cg@2744: ]. cg@2744: icons at:aKey put:icon. cg@2744: ^ icon cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'! cg@2744: cg@2744: signalHiddenLevel cg@2744: "show the selection if signaled; increments hiddenLevel cg@2744: see: #waitHiddenLevel cg@2744: " cg@2744: (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[ cg@3524: hiddenLevel := 0. cg@3524: self invalidateSelection. cg@2744: ]. cg@2744: ! cg@2744: cg@2744: waitHiddenLevel cg@2744: "hide the selection until signaled; increments hiddenLevel cg@2744: see: #signalHiddenLevel cg@2744: " cg@2744: self redrawUnselected:selection andLock:true cg@2744: ! cg@2744: cg@3453: withSelectionHiddenDo:aZeroArgumentBlock cg@2744: "apply block with selection hidden cg@2744: " cg@2744: cg@3524: [ cg@3524: self waitHiddenLevel. cg@3524: aZeroArgumentBlock value cg@3453: ] ensure:[ cg@3524: self signalHiddenLevel. cg@2744: ]. cg@3453: cg@3453: "Modified (format): / 17-07-2017 / 10:44:01 / cg" cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'! cg@2744: cg@2744: hasTargetWidgetChannel cg@2744: "answer the channel which is set to true if a target widget exists" cg@2744: cg@2744: ^ hasTargetWidgetChannel cg@2744: ! cg@2744: cg@2744: listOfItems cg@2744: "hiearchical list build from existing items" cg@2744: cg@2744: ^ listOfItems cg@2744: ! cg@2744: cg@2744: selectOnClickHolder cg@2744: "boolean holder, which indicates whether the selection will change on click cg@2744: " cg@2744: ^ selectOnClickHolder cg@2744: ! cg@2744: cg@2744: testModeChannel cg@2744: "answer a boolean channel which describes the behaviour how to process cg@2744: events on the target view. cg@2744: cg@2744: false: all input events are eaten and the selection is shown on the target view. cg@2744: true: no input events are eaten and no selection is shown on the target view." cg@2744: cg@2744: ^ testModeChannel cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'! cg@2744: cg@2744: targetWidgetChanged cg@2744: hasTargetWidgetChannel value:(self rootItem notNil). cg@2744: ! cg@2744: cg@2744: timedUpdateTaskCycle cg@2744: |view myTaskId| cg@2744: cg@2744: myTaskId := timedUpdateTask. cg@2744: cg@2744: listOfItems root notNil ifTrue:[ cg@3524: view := listOfItems root widget. cg@2744: ]. cg@2744: cg@2744: [ view notNil ] whileTrue:[ cg@3524: Delay waitForSeconds:0.5. cg@3524: cg@3524: (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[ cg@3524: view := nil. cg@3524: ] ifTrue:[ cg@3524: (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[ cg@3524: view sensor pushUserEvent:#updateChildren for:self. cg@3524: ]. cg@3524: ]. cg@2744: ]. cg@2744: timedUpdateTask == myTaskId ifTrue:[ cg@3524: timedUpdateTask := nil. cg@3524: listOfItems root:nil. cg@2744: ]. cg@2744: ! cg@2744: cg@2744: update:something with:someArgument from:aModel cg@2744: cg@2744: aModel == testModeChannel ifTrue:[ cg@3524: (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[ cg@3524: testModeChannel value ifTrue:[ cg@3524: self redrawUnselected:selection andLock:false checkTestMode:false. cg@3524: ] ifFalse:[ cg@3524: self invalidateSelection. cg@3524: ]. cg@3524: ]. cg@3524: ^ self cg@2744: ]. cg@2744: super update:something with:someArgument from:aModel. cg@2744: ! cg@2744: cg@2744: updateChildren cg@2744: |rootItem| cg@2744: cg@2744: rootItem := listOfItems root. cg@2744: rootItem isNil ifTrue:[^ self]. cg@2744: cg@2744: rootItem exists ifFalse:[ cg@3524: listOfItems root:nil. cg@2744: ] ifTrue:[ cg@3524: rootItem updateChildren. cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'! cg@2744: cg@2744: processEvent:anEvent cg@2744: "catch and process all WindowEvents for the rootComponent and its contained cg@2757: widgets; redraw selection in case of damage... cg@2757: return true, if the event was eaten" cg@2757: cg@2744: |evView item rootView testMode| cg@2744: cg@2978: catchEvents ifFalse:[^ false]. cg@2978: cg@2744: evView := anEvent view. cg@2744: evView isNil ifTrue:[ cg@3524: (anEvent isMessageSendEvent not or:[anEvent receiver ~~ self]) ifTrue:[ cg@3524: ^ false cg@3524: ]. cg@3524: anEvent value. cg@3524: ^ true. cg@2744: ]. cg@2744: rootView := listOfItems rootView. cg@2744: rootView isNil ifTrue:[ ^ false ]. cg@2744: cg@2744: anEvent isConfigureEvent ifTrue:[ cg@3524: hiddenLevel == 0 ifTrue:[ cg@3524: self redrawUnselected:selection andLock:false. cg@3524: ]. cg@3524: ^ false cg@2744: ]. cg@2744: cg@2744: "/ check whether view is contained within the rootView cg@2744: (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[ cg@3524: ^ false cg@2744: ]. cg@2744: cg@2744: anEvent isInputEvent ifFalse:[ cg@3524: anEvent isDamage ifTrue:[ cg@3524: hiddenLevel == 0 ifTrue:[self invalidateSelection]. cg@3524: ^ false cg@3524: ]. cg@3524: cg@3524: anEvent isMapEvent ifTrue:[ cg@3524: mappedViewAction notNil ifTrue:[ cg@3524: item := listOfItems recursiveDetect:[:el| el widget == evView]. cg@3524: item isNil ifTrue:[ mappedViewAction value:evView ] cg@3524: ]. cg@3524: ^ false cg@3524: ]. cg@3524: cg@3524: anEvent type == #terminate ifTrue:[ cg@3524: item := listOfItems recursiveDetect:[:el| el widget == evView]. cg@3524: item notNil ifTrue:[ self processTerminateForItem:item ]. cg@3524: ^ false cg@3524: ]. cg@3524: ^ false cg@2744: ]. cg@2744: testMode := testModeChannel value. cg@2744: cg@2744: anEvent isFocusEvent ifTrue:[ cg@3524: evView == rootView ifTrue:[ cg@3524: self invalidateSelection cg@3524: ]. cg@3524: ^ testMode not. cg@2744: ]. cg@2744: anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ]. cg@2744: cg@2744: testMode ifFalse:[ cg@3524: inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ]. cg@2744: ] ifTrue:[ cg@3524: anEvent isButtonPressEvent ifTrue:[ cg@3524: selectOnClickHolder value ifTrue:[ cg@3524: self selectItem:(listOfItems detectItemRespondsToView:evView). cg@3524: ]. cg@3524: ] cg@2744: ]. cg@2744: cg@2744: (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[ cg@3524: hiddenLevel := 1. cg@3524: self signalHiddenLevel. cg@2744: ]. cg@2744: cg@2744: ^ testMode not cg@2744: ! cg@2744: cg@2744: processTerminateForItem:anItem cg@2744: "received terminate for an item cg@2744: " cg@2744: anItem remove. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'! cg@2744: cg@2744: initialize cg@2744: "setup the default attributes cg@2744: " cg@2744: super initialize. cg@2744: cg@2744: hiddenLevel := 0. cg@2744: lockSema := RecursionLock new. cg@2744: listOfItems := ItemList new on:self. cg@2744: selectedSuperItems := #(). cg@2744: icons := IdentityDictionary new. cg@2978: catchEvents := true. cg@2744: cg@2744: hasTargetWidgetChannel := false asValue. cg@2744: selectOnClickHolder := true asValue. cg@2744: cg@2744: testModeChannel := false asValue. cg@2744: testModeChannel addDependent:self. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'! cg@2744: cg@2744: invalidateSelection cg@3319: "invalidate (force async redraw) the current selection cg@2744: " cg@2744: |topView| cg@2744: cg@2744: testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode cg@2744: cg@2744: ( hiddenLevel == 0 cg@2744: and:[selection notNil cg@2744: and:[(topView := listOfItems rootView) notNil cg@2744: and:[topView shown]]] cg@2744: ) ifTrue:[ cg@3524: topView sensor pushUserEvent:#redrawSelection for:self withArguments:#() cg@2744: ] cg@2744: ! cg@2744: cg@2744: recursiveRepair:theDamages startIn:aView relativeTo:aRootView cg@2744: "repair all views and contained views, which intersects the damage. cg@2744: !!!! all damages repaired are removed from the list of damages !!!! cg@2744: " cg@2744: |color relOrg damage subViews repaired cg@2744: bwWidth "{ Class:SmallInteger }" cg@2744: x "{ Class:SmallInteger }" cg@2744: y "{ Class:SmallInteger }" cg@2744: w "{ Class:SmallInteger }" cg@2744: h "{ Class:SmallInteger }" cg@2744: relOrgX "{ Class:SmallInteger }" cg@2744: relOrgY "{ Class:SmallInteger }" cg@2744: width "{ Class:SmallInteger }" cg@2744: height "{ Class:SmallInteger }" cg@2744: size "{ Class:SmallInteger }" cg@2744: | cg@2744: (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ]. cg@2744: cg@2744: subViews := aView subViews. cg@2744: cg@2744: subViews size ~~ 0 ifTrue:[ cg@3524: subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ]. cg@3524: theDamages isEmpty ifTrue:[ ^ self ]. cg@2744: ]. cg@2744: cg@2744: relOrg := aView originRelativeTo:aRootView. cg@2744: bwWidth := aView borderWidth. cg@2744: size := theDamages size. cg@2744: cg@2744: "/ compute relative origin starting from border left@top cg@2744: relOrgX := relOrg x - bwWidth. cg@2744: relOrgY := relOrg y - bwWidth. cg@2744: width := aView width + bwWidth + bwWidth. cg@2744: height := aView height + bwWidth + bwWidth. cg@2744: cg@2744: size to:1 by:-1 do:[:anIndex| cg@3524: repaired := damage := theDamages at:anIndex. cg@3524: cg@3524: "/ compute the rectangle into the view cg@3524: y := damage top - relOrgY. cg@3524: x := damage left - relOrgX. cg@3524: w := damage width. cg@3524: h := damage height. cg@3524: cg@3524: x < 0 ifTrue:[ w := w + x. x := 0. repaired := nil ]. cg@3524: y < 0 ifTrue:[ h := h + y. y := 0. repaired := nil ]. cg@3524: x + w > width ifTrue:[ w := width - x. repaired := nil ]. cg@3524: y + h > height ifTrue:[ h := height - y. repaired := nil ]. cg@3524: cg@3524: (w > 0 and:[h > 0]) ifTrue:[ cg@3524: bwWidth ~~ 0 ifTrue:[ cg@3524: color isNil ifTrue:[ cg@3524: "/ must force redraw of border cg@3524: color := aView borderColor. cg@3524: aView borderColor:(Color colorId:1). cg@3524: aView borderColor:color. cg@3524: ]. cg@3524: w := w - bwWidth. cg@3524: h := h - bwWidth. cg@3524: cg@3524: (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0]. cg@3524: (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0]. cg@3524: cg@3524: h > 0 ifFalse:[w := 0]. "/ later testing on width only cg@3524: ]. cg@3524: cg@3524: w > 0 ifTrue:[ cg@3524: aView clearRectangleX:x y:y width:w height:h. cg@3524: aView exposeX:x y:y width:w height:h cg@3524: ]. cg@3524: repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ]. cg@3524: ] cg@2744: ]. cg@2744: ! cg@2744: cg@2744: redrawSelection cg@2744: "redraw all items selected cg@2744: " cg@2744: |topView size| cg@2744: cg@2744: testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode cg@2744: cg@2744: ( hiddenLevel == 0 cg@2744: and:[(size := selection size) > 0 cg@2744: and:[(topView := listOfItems rootView) notNil cg@2744: and:[topView shown cg@2744: and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]] cg@2744: ) ifFalse:[ cg@3524: ^ self cg@2744: ]. cg@2744: cg@2744: lockSema critical:[ cg@3524: |list| cg@3524: cg@3524: list := selection. cg@3524: cg@3524: list size > 0 ifTrue:[ cg@3524: topView paint:(Color black). cg@3524: topView clippedByChildren:false. cg@3524: cg@3524: list keysAndValuesReverseDo:[:anIndex :anItem| cg@3524: (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ]. cg@3524: cg@3524: anItem handlesDo:[:aRect :what| cg@3524: what isNil ifTrue:[topView displayRectangle:aRect] cg@3524: ifFalse:[topView fillRectangle:aRect] cg@3524: ] cg@3524: ]. cg@3524: topView clippedByChildren:true. cg@3524: ]. cg@2744: ]. cg@2744: ! cg@2744: cg@2744: redrawUnselected:aList andLock:doLock cg@2744: "redraw all items unselected; if doLock is true, the hiddenLevel cg@2744: is incremented and thus the select mechanism is locked. cg@2744: " cg@2744: self redrawUnselected:aList andLock:doLock checkTestMode:true. cg@2744: ! cg@2744: cg@2744: redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode cg@2744: "redraw all items unselected; if doLock is true, the hiddenLevel cg@2744: is incremented and thus the select mechanism is locked. cg@2744: " cg@2744: |rootView damages subViews x y w h| cg@2744: cg@2744: doLock ifTrue:[ cg@3524: hiddenLevel := hiddenLevel + 1. cg@3524: hiddenLevel ~~ 1 ifTrue:[^ self]. cg@2744: ] ifFalse:[ cg@3524: hiddenLevel ~~ 0 ifTrue:[^ self]. cg@2744: ]. cg@2744: checkTestMode ifTrue:[ cg@3524: testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode cg@2744: ]. cg@2744: cg@2744: ( aList size ~~ 0 cg@2744: and:[(rootView := listOfItems rootView) notNil cg@2744: and:[rootView shown]] cg@2744: ) ifFalse:[ cg@3524: ^ self cg@2744: ]. cg@2744: cg@2744: lockSema critical:[ cg@3524: damages := OrderedCollection new:(8 * aList size). cg@3524: cg@3524: aList do:[:item| cg@3524: item handlesDo:[:handle :what| cg@3524: damages reverseDo:[:el| cg@3524: (el intersects:handle) ifTrue:[ cg@3524: damages removeIdentical:el. cg@3524: cg@3524: handle left:(handle left min:el left) cg@3524: right:(handle right max:el right) cg@3524: top:(handle top min:el top) cg@3524: bottom:(handle bottom max:el bottom) cg@3524: ] cg@3524: ]. cg@3524: damages add:handle cg@3524: ] cg@3524: ]. cg@3524: cg@3524: damages do:[:el| cg@3524: x := el left. cg@3524: y := el top. cg@3524: w := el width. cg@3524: h := el height. cg@3524: cg@3524: rootView clearRectangleX:x y:y width:w height:h. cg@3524: rootView exposeX:x y:y width:w height:h. cg@3524: ]. cg@3524: cg@3524: (subViews := rootView subViews) notNil ifTrue:[ cg@3524: subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ]. cg@3524: ]. cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'! cg@2744: cg@2744: isInTestMode cg@2744: "answer false, all input events are eaten and the selection is shown on the target view. cg@2744: answer true, no input events are eaten and no selection is shown on the target view." cg@2744: cg@2744: ^ testModeChannel value cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'! cg@2744: cg@2744: at:anIndex cg@2744: "returns the selected item at an index or nil cg@2744: " cg@2744: selection notNil ifTrue:[ cg@3524: ^ selection at:anIndex ifAbsent:nil cg@2744: ]. cg@2744: ^ nil cg@2744: ! cg@2744: cg@2744: at:anIndex ifAbsent:aBlock cg@2744: "returns the selected item at an index or the result of the block cg@2744: " cg@2744: selection notNil ifTrue:[ cg@3524: ^ selection at:anIndex ifAbsent:aBlock cg@2744: ]. cg@2744: ^ aBlock value cg@2744: ! cg@2744: cg@2744: first cg@2744: "returns the first selected item or nil cg@2744: " cg@2744: ^ self at:1 cg@2744: ! cg@2744: cg@2744: last cg@2744: "returns the last selected item or nil cg@2744: " cg@2744: ^ selection notNil ifTrue:[selection last] ifFalse:[nil] cg@2744: ! cg@2744: cg@2744: selectedItem cg@2744: "returns the single selected item or nil (size ~~ 1 nil is returned) cg@2744: " cg@2744: ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil] cg@2744: ! cg@2744: cg@2744: selectedSuperItems cg@2744: "returs the list of selected superItems; items selected cg@2744: but not contained in another selected item. cg@2744: " cg@2744: ^ selectedSuperItems cg@2744: ! cg@2744: cg@2744: size cg@2744: "returns the number of items selected cg@2744: " cg@2744: ^ selection size cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'! cg@2744: cg@2744: add:item cg@2744: "add an item to the current selection cg@2744: " cg@2744: |newSelect| cg@2744: cg@2744: item isNil ifTrue:[^ item]. cg@2744: cg@2744: lockSema critical:[ cg@3524: selection isNil ifTrue:[ cg@3524: newSelect := Array with:item. cg@3524: ] ifFalse:[ cg@3524: (self includes:item) ifFalse:[ cg@3524: newSelect := selection copyWith:item cg@3524: ] cg@3524: ]. cg@3524: cg@3524: newSelect size ~~ selection size ifTrue:[ cg@3524: item makeVisible. cg@3524: self value:newSelect cg@3524: ] cg@2744: ]. cg@2744: ^ item cg@2744: ! cg@2744: cg@2744: addAll:aCollectionOfItems cg@2744: "add a collection of items to the current selection cg@2744: " cg@2744: |newSelect| cg@2744: cg@2744: aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ]. cg@2744: cg@2744: lockSema critical:[ cg@3524: selection isNil ifTrue:[ cg@3524: newSelect := Array withAll:aCollectionOfItems. cg@3524: ] ifFalse:[ cg@3524: newSelect := OrderedCollection withAll:selection. cg@3524: cg@3524: aCollectionOfItems do:[:el| cg@3524: (selection includesIdentical:el) ifFalse:[newSelect add:el] cg@3524: ]. cg@3524: ]. cg@3524: self value:newSelect. cg@2744: ]. cg@2744: ^ aCollectionOfItems cg@2744: ! cg@2744: cg@2744: deselect cg@2744: "clear the selection cg@2744: " cg@2744: self value:nil. cg@2744: ! cg@2744: cg@2744: remove:item cg@2744: "remove the item from the current selection cg@2744: " cg@2744: |newSelect| cg@2744: cg@2744: item isNil ifTrue:[^ nil]. cg@2744: cg@2744: lockSema critical:[ cg@3524: (selection notNil and:[selection includesIdentical:item]) ifTrue:[ cg@3524: selection size == 1 ifTrue:[ newSelect := nil ] cg@3524: ifFalse:[ newSelect := selection copyWithout:item ]. cg@3524: cg@3524: self value:newSelect cg@3524: ]. cg@2744: ]. cg@2744: ^ item cg@2744: ! cg@2744: cg@2744: removeAll cg@2744: "clear the selection cg@2744: " cg@2744: self deselect. cg@2744: ! cg@2744: cg@2744: removeAll:loItems cg@2744: "remove all items of the collection from the current selection cg@2744: " cg@2744: |newSelect| cg@2744: cg@2744: selection isNil ifTrue:[ ^ loItems ]. cg@2744: loItems size == 0 ifTrue:[ ^ loItems ]. cg@2744: cg@2744: lockSema critical:[ cg@3524: selection notNil ifTrue:[ cg@3524: newSelect := selection select:[:el| (loItems includesIdentical:el) not ]. cg@3524: self value:newSelect. cg@3524: ] cg@2744: ]. cg@2744: ^ loItems cg@2744: ! cg@2744: cg@2744: selectAll cg@2744: "select all items cg@2744: " cg@2744: |root newSelection| cg@2744: cg@2744: root := listOfItems root. cg@2744: cg@2744: root isNil ifTrue:[ cg@3524: newSelection := nil cg@2744: ] ifFalse:[ cg@3524: newSelection := OrderedCollection new. cg@3524: root recursiveDo:[:el| newSelection add:el ]. cg@2744: ]. cg@2744: self value:newSelection. cg@2744: ! cg@2744: cg@2744: selectItem:anItem cg@2744: "set the current selection to the item cg@2744: " cg@2744: self value:anItem cg@2744: ! cg@2744: cg@2744: selectRootItem cg@2744: "set the current selection to the root item cg@2744: " cg@2744: self value:(self rootItem). cg@2744: ! cg@2744: cg@2744: selectedItem:anItem cg@2744: "set the current selection to the item cg@2744: " cg@2744: self selectItem:anItem. cg@2744: ! cg@2744: cg@2744: toggleSelectItem:anItem cg@2744: "toggle selection-state of the item; add or remove the item from the cg@2744: current selection. cg@2744: " cg@2744: anItem notNil ifTrue:[ cg@3524: (self includes:anItem) ifTrue:[self remove:anItem] cg@3524: ifFalse:[self add:anItem] cg@2744: ]. cg@2744: ^ anItem cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'! cg@2744: cg@2744: collect:aBlock cg@2744: "for each element in the selection, evaluate the argument, aBlock cg@2744: and return a new collection with the results cg@2744: " cg@2744: |res| cg@2744: cg@2744: res := OrderedCollection new. cg@2744: self do:[:el| res add:(aBlock value:el)]. cg@2744: ^ res cg@2744: ! cg@2744: cg@2744: do:aOneArgBlock cg@2744: "evaluate the argument, aBlock for each item in the selection cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[^ nil]. cg@3398: ^ keptSelection do:aOneArgBlock cg@3398: cg@3398: "Modified (format): / 12-02-2017 / 11:53:23 / cg" cg@2744: ! cg@2744: cg@2744: from:start do:aOneArgBlock cg@2744: "evaluate the argument, aBlock for the items starting at index start cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[^ nil]. cg@3398: "/ but if so, then start may no longer be valid here?? cg@3398: ^ keptSelection from:start do:aOneArgBlock cg@3398: cg@3398: "Modified (comment): / 12-02-2017 / 11:52:57 / cg" cg@2744: ! cg@2744: cg@2744: from:start to:stop do:aOneArgBlock cg@2744: "evaluate the argument, aBlock for the items with index start to cg@2744: stop in the selection. cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[^ nil]. cg@3398: "/ but if so, then start and stop may no longer be valid here?? cg@3398: ^ keptSelection from:start to:stop do:aOneArgBlock cg@3398: cg@3398: "Modified (comment): / 12-02-2017 / 11:52:25 / cg" cg@2744: ! cg@2744: cg@2744: reverseDo:aOneArgBlock cg@2744: "evaluate the argument, aBlock for each item in the selection cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[^ nil]. cg@3398: ^ keptSelection reverseDo:aOneArgBlock cg@3398: cg@3398: "Modified: / 12-02-2017 / 11:50:02 / cg" cg@2744: ! cg@2744: cg@2744: select:aBlock cg@2744: "return a new collection with all elements from the selection, for which cg@2744: the argument aBlock evaluates to true. cg@2744: " cg@2744: |res| cg@2744: cg@2744: res := OrderedCollection new. cg@2744: self do:[:el| (aBlock value:el) ifTrue:[res add:el] ]. cg@2744: ^ res cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'! cg@2744: cg@2744: changed:aParameter with:oldSelection cg@2744: "update the visibility staus of the current selection cg@2744: " cg@2744: |unselected rootView rootItem selSize| cg@2744: cg@2744: selSize := selection size. cg@2744: cg@2744: selSize == 0 ifTrue:[ cg@3524: selectedSuperItems := #(). cg@2744: ] ifFalse:[ cg@3524: selSize == 1 ifTrue:[ cg@3524: selectedSuperItems := Array with:(selection at:1). cg@3524: ] ifFalse:[ cg@3524: rootItem := listOfItems root. cg@3524: cg@3524: (selection includesIdentical:rootItem) ifTrue:[ cg@3524: selectedSuperItems := Array with:rootItem. cg@3524: ] ifFalse:[ cg@3524: selectedSuperItems := OrderedCollection new:selSize. cg@3524: cg@3524: selection do:[:anItem| cg@3524: anItem parentsDetect:[:el| selection includesIdentical:el ] cg@3524: ifNone:[ selectedSuperItems add:anItem ]. cg@3524: ]. cg@3524: ] cg@3524: ] cg@2744: ]. cg@2744: cg@2744: ( hiddenLevel == 0 cg@2744: and:[(rootView := listOfItems rootView) notNil cg@2744: and:[rootView shown]] cg@2744: ) ifTrue:[ cg@3524: selSize == 0 ifTrue:[ cg@3524: "/ must redraw the old selection unselected cg@3524: self redrawUnselected:oldSelection andLock:false cg@3524: ] ifFalse:[ cg@3524: self invalidateSelection. cg@3524: cg@3524: oldSelection size ~~ 0 ifTrue:[ cg@3524: "/ must redraw all elements no longer in the selection cg@3524: unselected := oldSelection select:[:el| (selection includesIdentical:el) not ]. cg@3524: self redrawUnselected:unselected andLock:false. cg@3524: ] cg@3524: ] cg@2744: ]. cg@2744: super changed:aParameter with:oldSelection. cg@2744: ! cg@2744: cg@3524: setValue:aNewSelection cg@2744: "set the selection without notifying cg@2744: " cg@2744: |newSelect idx| cg@2744: cg@2744: newSelect := nil. cg@2744: cg@2744: aNewSelection notNil ifTrue:[ cg@3524: lockSema critical:[ cg@3524: aNewSelection isCollection ifFalse:[ cg@3524: (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[ cg@3524: newSelect := selection cg@3524: ] ifFalse:[ cg@3524: newSelect := Array with:aNewSelection. cg@3524: ] cg@3524: ] ifTrue:[ cg@3524: aNewSelection notEmpty ifTrue:[ cg@3524: aNewSelection size ~~ selection size ifTrue:[ cg@3524: newSelect := aNewSelection copy. cg@3524: ] ifFalse:[ cg@3524: idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ]. cg@3524: cg@3524: idx ~~ 0 ifTrue:[newSelect := aNewSelection copy] cg@3524: ifFalse:[newSelect := selection ]. cg@3524: ] cg@3524: ] cg@3524: ] cg@3524: ]. cg@2744: ]. cg@2744: newSelect ~~ selection ifTrue:[ cg@3524: beforeSelectionChangedAction value. cg@3524: selection := newSelect. cg@3524: selection notNil ifTrue:[selection do:[:el| el makeVisible]] cg@2744: ]. cg@2744: ! cg@2744: cg@2744: triggerValue:aValue cg@2744: "set my value & send change notifications to my dependents. cg@2744: Send the change message even if the value didn't change. cg@2744: " cg@2744: |oldSelection| cg@2744: cg@2744: lockSema critical:[ cg@3524: oldSelection := selection. cg@3524: self setValue:aValue. cg@3524: self changed:#value with:oldSelection cg@2744: ] cg@2744: ! cg@2744: cg@2744: value cg@2744: "returns the current selection cg@2744: " cg@2744: ^ selection ? #() cg@2744: ! cg@2744: cg@2744: value:aValue cg@2744: "change the current selection and send change notifications to my cg@2744: dependents if it changed. cg@2744: " cg@2744: |oldSelection| cg@2744: cg@2744: lockSema critical:[ cg@3524: oldSelection := selection. cg@3524: self setValue:aValue. cg@3524: cg@3524: oldSelection == selection ifFalse:[ cg@3524: self changed:#value with:oldSelection cg@3524: ] cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'! cg@2744: cg@2744: detect:aBlock cg@2744: "evaluate the argument, aBlock for each item in the selection until cg@2744: the block returns true; in this case return the element which caused cg@2744: the true evaluation. cg@2744: If none of the evaluations returns true, an error is raised cg@2744: " cg@2744: ^ self detect:aBlock ifNone:[self errorNotFound] cg@2744: ! cg@2744: cg@2744: detect:aBlock ifNone:exceptionBlock cg@2744: "evaluate the argument, aBlock for each item in the selection until the cg@2744: block returns true; in this case return the element which caused the cg@2744: true evaluation. cg@2744: If none of the evaluations returns true, the result of the evaluation cg@2744: of the exceptionBlock is returned cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[ ^ exceptionBlock value ]. cg@3398: ^ keptSelection detect:aBlock ifNone:exceptionBlock cg@3398: cg@3398: "Modified (format): / 12-02-2017 / 11:54:13 / cg" cg@2744: ! cg@2744: cg@2744: detectLast:aBlock cg@2744: "evaluate the argument, aBlock for each item in the selection until cg@2744: the block returns true; in this case return the element which caused cg@2744: the true evaluation. The items are processed in reverse order. cg@2744: If none of the evaluations returns true, an error is raised cg@2744: " cg@2744: ^ self detectLast:aBlock ifNone:[self errorNotFound] cg@2744: ! cg@2744: cg@2744: detectLast:aBlock ifNone:exceptionBlock cg@2744: "evaluate the argument, aBlock for each item in the selection until cg@2744: the block returns true; in this case return the element which caused cg@2744: the true evaluation. The items are processed in reverse order. cg@2744: If none of the evaluations returns true, the result of the evaluation cg@2744: of the exceptionBlock is returned cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[ ^ exceptionBlock value ]. cg@3398: ^ keptSelection detectLast:aBlock ifNone:exceptionBlock cg@3398: cg@3398: "Modified (format): / 12-02-2017 / 11:53:49 / cg" cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'! cg@2744: cg@2744: includes:anItem cg@2744: "returns true if the item is in the current selection cg@2744: " cg@3398: |keptSelection| cg@3398: cg@3398: "/ the selection may change at any time (may it?) cg@3398: (keptSelection := selection) isNil ifTrue:[^ false]. cg@3398: ^ keptSelection includesIdentical:anItem cg@3398: cg@3398: "Modified: / 12-02-2017 / 11:51:34 / cg" cg@2744: ! cg@2744: cg@2744: includesAll:aCollection cg@2744: "return true, if all items of the collection are included in the current selection cg@2744: " cg@3398: |keptSelection| cg@2744: cg@2744: aCollection size ~~ 0 ifTrue:[ cg@3524: "/ the selection may change at any time (may it?) cg@3524: (keptSelection := selection) isNil ifTrue:[ ^ false ]. cg@3524: cg@3524: ^ aCollection contains:[:el| (keptSelection includesIdentical:el)] cg@2744: ]. cg@2744: ^ true cg@3398: cg@3398: "Modified (format): / 12-02-2017 / 11:51:14 / cg" cg@2744: ! cg@2744: cg@2744: includesAny:aCollection cg@3398: "return true, if any item of the collection is in the current selection cg@2744: " cg@3398: |keptSelection| cg@2744: cg@2744: aCollection notNil ifTrue:[ cg@3524: "/ the selection may change at any time (may it?) cg@3524: (keptSelection := selection) notNil ifTrue:[ cg@3524: ^ aCollection contains:[:el| (keptSelection includesIdentical:el)] cg@3524: ] cg@2744: ]. cg@2744: ^ false cg@3398: cg@3398: "Modified (format): / 12-02-2017 / 11:50:26 / cg" cg@2744: ! cg@2744: cg@2744: includesIdentical:anItem cg@2744: "returns true if the item is in the current selection cg@2744: " cg@2744: ^ self includes:anItem cg@2744: ! cg@2744: cg@2744: isEmpty cg@2744: "returns true if the current selection is empty cg@2744: " cg@2744: ^ selection size == 0 cg@2744: ! cg@2744: cg@2744: isSelected:anItem cg@2744: "returns true if the item is in the current selection cg@2744: " cg@2744: ^ self includes:anItem cg@2744: ! cg@2744: cg@2744: notEmpty cg@2744: "returns true if the current selection is not empty cg@2744: " cg@2744: ^ selection size ~~ 0 cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'! cg@2744: cg@2744: documentation cg@2744: " cg@2744: Kind of HierarchicalList class which contains all the visible cg@2744: ViewTreeItem's and the root, the anchor of the hierarchical list. cg@2744: cg@2744: [Instance variables:] cg@3524: treeModel all events are delegated to cg@3524: eventHook save and resore the pre/post -EventHook cg@2744: cg@2744: cg@2744: [author:] cg@3524: Claus Atzkern cg@2744: cg@2744: [see also:] cg@3524: HierarchicalList cg@3524: ViewTreeModel cg@3524: ViewTreeItem cg@2744: " cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'! cg@2744: cg@2744: root:theRoot cg@2744: "set the root item; delegate events to my treeModel cg@2744: " cg@2744: |rootView| cg@2744: cg@2744: theRoot == root ifTrue:[^ self]. cg@2744: cg@2744: rootView := self rootView. cg@2744: super root:theRoot. cg@2744: cg@2744: rootView notNil ifTrue:[ |wgrp| cg@3524: wgrp := rootView windowGroup. cg@3524: cg@3524: wgrp notNil ifTrue:[ cg@3524: wgrp removePreEventHook:treeModel. cg@3524: wgrp removePostEventHook:self. cg@3524: ]. cg@2744: ]. cg@2744: cg@2744: super root:theRoot. cg@2744: rootView := self rootView. cg@2744: cg@2744: rootView notNil ifTrue:[ cg@3524: "must setup a task because there might not exist a windowGroup at the moment cg@3524: " cg@3524: [ |wgrp| cg@3524: cg@3524: [rootView == self rootView] whileTrue:[ cg@3524: wgrp := rootView windowGroup. cg@3524: wgrp notNil ifTrue:[ cg@3524: rootView := nil. cg@3524: wgrp addPreEventHook:treeModel. cg@3524: wgrp addPostEventHook:self. cg@3524: ] ifFalse:[ cg@3524: Delay waitForMilliseconds:100. cg@3524: ]. cg@3524: ]. cg@3524: cg@3524: ] forkAt:(Processor userSchedulingPriority + 2). cg@2744: ]. cg@2744: treeModel notNil ifTrue:[ cg@3524: treeModel targetWidgetChanged. cg@2744: ]. cg@3524: cg@2744: ^ root. cg@2744: ! cg@2744: cg@2744: rootView cg@2744: "returns the widget assigned to the root or nil cg@2744: " cg@2744: ^ root notNil ifTrue:[root widget] ifFalse:[nil] cg@2744: ! cg@2744: cg@2744: treeModel cg@2744: "returne the treeModel, a ViewTreeModel cg@2744: " cg@2744: ^ treeModel cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'! cg@2744: cg@2744: additionalLabelForItem:anItem cg@2744: "answer the additional lable for an item or nil" cg@2744: cg@3017: |widget l applClass applClassName key| cg@3017: cg@2762: l := nil. cg@2744: showWidgetNames == true ifTrue:[ cg@3524: (widget := anItem widget) notNil ifTrue:[ cg@3524: l := '"', widget name, '"' cg@3524: ] ifFalse:[ cg@3524: l := '"', anItem menuItem label asString, '"' cg@3524: ]. cg@2744: ]. cg@2744: cg@2744: anItem isApplicationClass ifTrue:[ cg@3524: applClass := anItem applicationClass. cg@3524: applClass notNil ifTrue:[ cg@3524: applClassName := '[', applClass name allBold, ']'. cg@3524: l := (l isNil ifTrue:[''] ifFalse:[l , ' ']) , applClassName cg@3524: ]. cg@2744: ]. cg@3017: cg@3017: application notNil ifTrue:[ cg@3524: key := application builder namedComponents keyAtValue:widget ifAbsent:nil. cg@3524: key notNil ifTrue:[ cg@3524: l := l , ' #',key cg@3524: ]. cg@3017: ]. cg@3017: cg@2762: ^ l cg@3456: cg@3456: "Modified: / 16-08-2017 / 12:47:12 / cg" cg@2744: ! cg@2744: cg@2744: showWidgetNames cg@2744: "answer true if the additional text is the widget name cg@2744: otherwise the name of the application" cg@2744: cg@2762: ^ showWidgetNames ? true cg@2744: ! cg@2744: cg@2744: showWidgetNames:aBoolean cg@2744: "set true if the additional text is the widget name cg@2744: otherwise the name of the application" cg@2744: cg@2744: self showWidgetNames == aBoolean ifFalse:[ cg@3524: showWidgetNames := aBoolean. cg@3524: cg@3524: root notNil ifTrue:[ cg@3524: root recursiveAdditionalNameBehaviourChanged. cg@3524: self changed. cg@3524: ]. cg@2744: ]. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'! cg@2744: cg@2744: processEvent:anEvent cg@2744: "post process event cg@2744: " cg@2744: ^ treeModel isInTestMode not cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'! cg@2744: cg@2744: on:aModel cg@2744: "set the model, a ViewTreeModel cg@2744: " cg@2744: treeModel := aModel. cg@2744: showRoot := true. cg@2762: "/ showWidgetNames := false. cg@2762: showWidgetNames := true. cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'! cg@2744: cg@2744: detectItemRespondsToView:aView cg@2744: "returns the bottom-most item which contains the view cg@2744: " cg@2744: |view item topView| cg@2744: cg@2744: root notNil ifTrue:[ cg@3524: view := aView. cg@3524: topView := root widget. cg@3524: cg@3524: [ view notNil ] whileTrue:[ cg@3524: topView == view ifTrue:[^ root]. cg@3524: item := root recursiveDetect:[:el| el widget == view ]. cg@3524: item notNil ifTrue:[^ item]. cg@3524: view := view superView cg@3524: ] cg@2744: ]. cg@2744: ^ nil cg@2744: ! cg@2744: cg@2744: recursiveDetect:aOneOrgBlock cg@3524: "recursive find the first child, for which evaluation cg@2744: of the block returns true; if none nil is returned cg@2744: " cg@2744: root notNil ifTrue:[ cg@3524: (aOneOrgBlock value:root) ifTrue:[ ^ root ]. cg@2744: ^ root recursiveDetect:aOneOrgBlock cg@2744: ]. cg@2744: ^ nil cg@2744: ! ! cg@2744: cg@2744: !ViewTreeInspectorApplication class methodsFor:'documentation'! cg@2744: cg@2744: version cg@2744: ^ '$Header$' cg@2744: ! cg@2744: cg@2744: version_CVS cg@2744: ^ '$Header$' cg@2744: ! ! cg@2744: cg@2978: cg@2744: ViewTreeInspectorApplication initialize! cg@2744: ViewTreeInspectorApplication::ViewTreeItem initialize!