FlyByWindowInformation.st
author Patrik Svestka <patrik.svestka@gmail.com>
Wed, 14 Nov 2018 12:07:51 +0100
branchjv
changeset 3630 5e718e0a754e
parent 3358 4e4d637296ba
child 3452 33988b5b625e
permissions -rw-r--r--
Issue #239: Fix all Smalltak/X source files to be in unicode (UTF8 without BOM) and prefixed by "{ Encoding: utf8 }" when any unicode character is present

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