FlyByWindowInformation.st
author Claus Gittinger <cg@exept.de>
Tue, 14 May 2019 09:46:21 +0200
changeset 3663 9d49ecf8661a
parent 3583 8eb5579befae
child 3673 b7e9a220c733
permissions -rw-r--r--
#UI_ENHANCEMENT by cg
class: TabListEditor class
changed:
#canvasSpec
#menu
#windowSpec
     1 "
     2  COPYRIGHT (c) 2008 by eXept Software AG
     3               All Rights Reserved
     4 
     5  This software is furnished under a license and may be used
     6  only in accordance with the terms of that license and with the
     7  inclusion of the above copyright notice.   This software may not
     8  be provided or otherwise made available to, or used by, any
     9  other person.  No title to or ownership of the software is
    10  hereby transferred.
    11 "
    12 "{ Package: 'stx:libtool2' }"
    13 
    14 "{ NameSpace: Smalltalk }"
    15 
    16 FlyByHelp subclass:#FlyByWindowInformation
    17 	instanceVariableNames:'lastApplication lastView cleanupAction finishSemaphore finished
    18 		toBrowseAction'
    19 	classVariableNames:''
    20 	poolDictionaries:''
    21 	category:'Interface-Help'
    22 !
    23 
    24 !FlyByWindowInformation class methodsFor:'documentation'!
    25 
    26 copyright
    27 "
    28  COPYRIGHT (c) 2008 by eXept Software AG
    29               All Rights Reserved
    30 
    31  This software is furnished under a license and may be used
    32  only in accordance with the terms of that license and with the
    33  inclusion of the above copyright notice.   This software may not
    34  be provided or otherwise made available to, or used by, any
    35  other person.  No title to or ownership of the software is
    36  hereby transferred.
    37 "
    38 !
    39 
    40 documentation
    41 "
    42     I implement a tooltip, which presents a number of interesting facts
    43     about the window under the mouse pointer, and also offer keyboard
    44     shortcuts to quickly open browsers and/or inspectors on the view under the
    45     pointer.
    46     Enabled via the Launcher's 'FlyBy Window Information' menu item.
    47 "
    48 !
    49 
    50 examples
    51 "
    52     self shownInformationOfViewUnderMouseUntilButtonIsPressed
    53 "
    54 !
    55 
    56 shownInformationOfViewUnderMouseUntilButtonIsPressed
    57     self start waitUntilFinished
    58 
    59     "
    60      self shownInformationOfViewUnderMouseUntilButtonIsPressed
    61     "
    62 ! !
    63 
    64 !FlyByWindowInformation methodsFor:'accessing'!
    65 
    66 cleanupAction:something 
    67     cleanupAction := something.
    68 !
    69 
    70 lastApplication
    71     ^ lastApplication
    72 !
    73 
    74 lastView
    75     ^ lastView
    76 ! !
    77 
    78 !FlyByWindowInformation methodsFor:'defaults'!
    79 
    80 flyByHelpTimeoutMillis
    81     ^ 1000
    82 ! !
    83 
    84 !FlyByWindowInformation methodsFor:'event handling'!
    85 
    86 buttonMotion:buttonAndModifierState x:x y:y view:aView
    87     finished == true ifTrue:[^ true].
    88 
    89     super buttonMotion:buttonAndModifierState x:x y:y view:aView.
    90     ^ true
    91 
    92     "Modified: / 16-07-2017 / 13:49:57 / cg"
    93 !
    94 
    95 buttonPress:button x:x y:y view:aView
    96     self stop.
    97     ^ true
    98 !
    99 
   100 keyPress:key x:x y:y view:aView
   101     <resource: #keyboard (#Escape #Return)>
   102 
   103     |obj objToInspect objToBrowse lcKey|
   104 
   105     key == #Escape ifTrue:[
   106         self stop.
   107         ^ true
   108     ].
   109 
   110     key == $? ifTrue:[
   111         [
   112             WindowTreeView notNil ifTrue:[
   113                 WindowTreeView openOn:(lastView topView) initialSelection:lastView.
   114             ] ifFalse:[
   115                 self warn:'WindowTreeView class is not present!!'.
   116             ].
   117         ] fork.
   118         self stop.
   119         ^ true.
   120     ].
   121 
   122     key == #Return ifTrue:[
   123         objToBrowse := lastApplication ? lastView
   124     ].
   125 
   126     key isCharacter ifTrue:[
   127         lcKey := key asLowercase.
   128 
   129         lcKey == $h ifTrue:[
   130             "/ use smalltalk at, to avoid dependency on libTool
   131             [ (Smalltalk at:#'Tools::ViewTreeInspectorApplication') openOn:lastView ] fork.
   132             ^ true.
   133         ].
   134         lcKey == $a ifTrue:[
   135             obj := lastApplication
   136         ].
   137         lcKey == $o ifTrue:[
   138             lastView notNil ifTrue:[
   139                 obj := lastView model
   140             ].
   141         ].
   142         lcKey == $m ifTrue:[
   143             lastApplication notNil ifTrue:[
   144                 obj := lastApplication masterApplication
   145             ]
   146         ].
   147         lcKey == $t ifTrue:[
   148             lastApplication notNil ifTrue:[
   149                 obj := lastApplication topApplication
   150             ].
   151         ].
   152         lcKey == $v ifTrue:[
   153             obj := lastView
   154         ].
   155         lcKey == $g ifTrue:[
   156             obj := lastView windowGroup
   157         ].
   158         lcKey == $w ifTrue:[
   159             lastView notNil ifTrue:[
   160                 obj := lastView topView
   161             ]
   162         ].
   163         lcKey == $u ifTrue:[
   164             toBrowseAction notNil ifTrue:[
   165                 toBrowseAction value:(SystemBrowser default)
   166             ].    
   167         ].
   168         
   169         obj notNil ifTrue:[
   170             key isLowercase ifTrue:[
   171                 objToInspect := obj
   172             ] ifFalse:[
   173                 objToBrowse := obj
   174             ].
   175         ].
   176     ].
   177 
   178     objToInspect notNil ifTrue:[
   179         [ objToInspect inspect ] forkAt:(Processor userSchedulingPriority).
   180     ].
   181     objToBrowse notNil ifTrue:[
   182         [ objToBrowse browse ] forkAt:(Processor userSchedulingPriority).
   183     ].
   184 
   185     ^ true
   186 
   187     "Modified: / 12-11-2010 / 11:51:04 / cg"
   188     "Modified: / 01-08-2018 / 07:42:15 / Claus Gittinger"
   189 ! !
   190 
   191 !FlyByWindowInformation methodsFor:'help texts'!
   192 
   193 helpTextFor:aView at:aPointOrNil
   194     "generate the text to be shown as popup-flyby info"
   195 
   196     |resources|
   197 
   198     lastView := aView.
   199     lastApplication := aView application.
   200 
   201     resources := self class classResources.
   202 
   203     ^ Text streamContents:[:s |
   204         |topViewToInspect applicationToInspect 
   205          masterApplicationToInspect topApplicationToInspect modelToInspect
   206          genComponentNameForApplication windowGroupToInspect|
   207 
   208         toBrowseAction := nil. 
   209         genComponentNameForApplication := 
   210             [:app :s |
   211                 (app notNil 
   212                 and:[ app builder notNil ]) ifTrue:[
   213                     |components v|
   214 
   215                     components := app builder namedComponents.
   216 
   217                     v := aView.
   218                     [   (components includes:v) not
   219                         and:[v container notNil]
   220                     ] whileTrue:[
   221                         v := v container.
   222                     ].
   223                     (components includes:v) ifTrue:[
   224                         |k|
   225 
   226                         k := components keyAtValue:v.
   227                         v == aView ifTrue:[
   228                             s nextPutLine:('       component: ' , k).
   229                         ] ifFalse:[
   230                             s nextPutLine:('       subview of component: ' , k).
   231                         ].
   232                     ].
   233                 ].
   234             ].
   235 
   236         aView topView ~~ aView ifTrue:[
   237             topViewToInspect := aView topView.
   238         ].
   239         lastApplication notNil ifTrue:[
   240             applicationToInspect := lastApplication.
   241             masterApplicationToInspect := lastApplication masterApplication.
   242             masterApplicationToInspect notNil ifTrue:[
   243                 masterApplicationToInspect == applicationToInspect ifTrue:[
   244                     masterApplicationToInspect := nil
   245                 ] ifFalse:[
   246                     topApplicationToInspect := masterApplicationToInspect topApplication.
   247                     topApplicationToInspect == masterApplicationToInspect ifTrue:[
   248                         topApplicationToInspect := nil
   249                     ]
   250                 ].
   251             ]
   252         ].
   253         aView model notNil ifTrue:[
   254             modelToInspect := aView model.
   255             ((modelToInspect == applicationToInspect)
   256             or:[ modelToInspect == masterApplicationToInspect ]) ifTrue:[
   257                 modelToInspect := nil.
   258             ].
   259         ].
   260 
   261         applicationToInspect notNil ifTrue:[
   262             s nextPutLine:(resources string:'Application: %1' with:applicationToInspect class name allBold).
   263             genComponentNameForApplication value:applicationToInspect value:s.
   264         ].
   265         masterApplicationToInspect notNil ifTrue:[
   266             s nextPutLine:(resources string:'Master-Application: %1' with:masterApplicationToInspect class name allBold).
   267             "/ genComponentNameForApplication value:masterApplicationToInspect value:s.
   268         ].
   269         topApplicationToInspect notNil ifTrue:[
   270             s nextPutLine:(resources string:'Top-Application: %1' with:topApplicationToInspect class name allBold).
   271             "/ genComponentNameForApplication value:topApplicationToInspect value:s.
   272         ].
   273         s nextPutLine:(resources string:'View: %1 "%2"' with:aView class name allBold with:aView name).
   274         topViewToInspect notNil ifTrue:[
   275             s nextPutLine:(resources string:'Topview: %1' with:topViewToInspect class name allBold).
   276         ].
   277         modelToInspect notNil ifTrue:[
   278             s nextPutLine:(resources string:'Model: %1' with:modelToInspect class name allBold).
   279         ].
   280         aPointOrNil notNil ifTrue:[
   281             (aView isKindOf:MenuPanel) ifTrue:[
   282                 |item itemValue helpKey|
   283                 
   284                 (item := aView itemAt:aPointOrNil) notNil ifTrue:[
   285                     (helpKey := item activeHelpKey) notNil ifTrue:[
   286                         s nextPutLine:(resources string:'HelpKey: %1' with:helpKey allBold).
   287                     ].
   288                     (itemValue := item itemValue) isSymbol ifTrue:[
   289                         s nextPutLine:(resources string:'Action: %1' with:itemValue allBold).
   290                         (applicationToInspect class implements:itemValue) ifTrue:[
   291                             toBrowseAction := [:b | b browseClass:applicationToInspect class selector:itemValue].
   292                         ] ifFalse:[    
   293                             toBrowseAction := [:b | b browseImplementorsOf:itemValue].
   294                         ]
   295                     ] ifFalse:[    
   296                         itemValue isBlock ifTrue:[
   297                             s nextPutLine:(resources string:'Action: %1' with:itemValue printString).
   298                         ]    
   299                     ].
   300                 ].
   301             ] ifFalse:[
   302                 |helpKey|
   303                 
   304                 (helpKey := aView helpKey) notNil ifTrue:[
   305                     s nextPutLine:(resources string:'HelpKey: %1' with:helpKey allBold).
   306                 ].
   307             ].    
   308         ].
   309         
   310         s cr.
   311         s nextPutLine:'Press:'.
   312 
   313         "/ use Smalltalk-at, to avoid dependency on libTool
   314         (Smalltalk at:#'Tools::ViewTreeInspectorApplication') notNil ifTrue:[
   315             s nextPutLine:'    ? to show the view''s tree'.
   316         ].        
   317         applicationToInspect notNil ifTrue:[
   318             s nextPutLine:'    a to inspect application (A to browse)'.
   319             masterApplicationToInspect notNil ifTrue:[
   320                 s nextPutLine:'    m to inspect masterApplication (M to browse)'.
   321                 topApplicationToInspect notNil ifTrue:[
   322                     s nextPutLine:'    t to inspect topApplication (T to browse)'.
   323                 ]
   324             ].
   325         ].
   326         s nextPutLine:'    h to inspect view''s hierarchy'.
   327         s nextPutLine:'    v to inspect view (V to browse)'.
   328         topViewToInspect notNil ifTrue:[
   329             s nextPutLine:'    w to inspect topWindow (W to browse)'.
   330         ].
   331         aView windowGroup notNil ifTrue:[
   332             s nextPutLine:'    g to inspect windowGroup'.
   333         ].
   334         modelToInspect notNil ifTrue:[
   335             s nextPutLine:'    o to inspect model (O to browse)'.
   336         ].
   337         toBrowseAction notNil ifTrue:[
   338             s nextPutLine:'    u to browse the called user action'.
   339         ].    
   340         s cr.
   341         s nextPutLine:'RETURN to browse application.'.
   342         s nextPutAll:'ESC or click to leave flyBy-info mode.'.
   343     ]
   344 
   345     "
   346      self shownInformationOfViewUnderMouseUntilButtonIsPressed
   347     "
   348 
   349     "Modified: / 12-11-2010 / 11:54:59 / cg"
   350     "Modified: / 01-08-2018 / 07:43:22 / Claus Gittinger"
   351 ! !
   352 
   353 !FlyByWindowInformation methodsFor:'private'!
   354 
   355 activeHelpViewForApplication:applicationOrNil text:helpText onDevice:aDevice
   356     ^ (ActiveHelpView for:helpText onDevice:aDevice) shapeStyle:nil.
   357 !
   358 
   359 handleMouseIn:aView x:x y:y
   360     finished == true ifTrue:[^ self].
   361     super handleMouseIn:aView x:x y:y
   362 !
   363 
   364 targetViewInitiatesHelpViaSensor
   365     ^ false
   366 ! !
   367 
   368 !FlyByWindowInformation methodsFor:'queries'!
   369 
   370 toolTipFollowsMouse
   371     "if true, the tooltip-window moves with the pointer
   372      so that it stays away from (does not cover) the mouse pointer"
   373 
   374     ^ true
   375 ! !
   376 
   377 !FlyByWindowInformation methodsFor:'start & stop'!
   378 
   379 initiateHelpFor:aView at:aPointOrNil
   380     self initiateHelpFor:aView at:aPointOrNil now:true
   381 !
   382 
   383 initiateHelpFor:aView at:aPointOrNil now:showItNow
   384     finished == true ifTrue:[^ self].
   385     super initiateHelpFor:aView at:aPointOrNil now:showItNow
   386 !
   387 
   388 start
   389     |l|
   390 
   391     finished == true ifTrue:[^ self].
   392 
   393     l := FlyByHelp currentHelpListener.
   394     l notNil ifTrue:[
   395         FlyByHelp stop.
   396         cleanupAction := [ FlyByHelp start ].
   397     ].
   398     finishSemaphore := Semaphore new.
   399     finished := false.
   400     super start.
   401 !
   402 
   403 stop
   404     finished := true.
   405     super stop.
   406     cleanupAction value.
   407     finishSemaphore notNil ifTrue:[
   408         finishSemaphore signalIf.
   409     ].
   410 !
   411 
   412 waitUntilFinished
   413     finishSemaphore wait.
   414 ! !
   415 
   416 !FlyByWindowInformation class methodsFor:'documentation'!
   417 
   418 version_CVS
   419     ^ '$Header$'
   420 ! !
   421