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