FlyByWindowInformation.st
author Claus Gittinger <cg@exept.de>
Sun, 16 Jul 2017 14:05:41 +0200
changeset 3452 33988b5b625e
parent 3358 4e4d637296ba
child 3576 e62c95ddd17b
permissions -rw-r--r--
#DOCUMENTATION by cg
class: FlyByWindowInformation
changed: #buttonMotion:x:y:view:
boolean/non-boolean return
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@2699
   271
cg@2300
   272
        s cr.
cg@2300
   273
        s nextPutLine:'Press:'.
cg@3212
   274
cg@3212
   275
        "/ use smalltalk at, to avoid dependency on libTool
cg@3212
   276
        (Smalltalk at:#'Tools::ViewTreeInspectorApplication') notNil ifTrue:[
cg@3212
   277
            s nextPutLine:'    ? to show the view''s tree'.
cg@3212
   278
        ].
cg@2314
   279
        applicationToInspect notNil ifTrue:[
cg@2300
   280
            s nextPutLine:'    a to inspect application (A to browse)'.
cg@2314
   281
            masterApplicationToInspect notNil ifTrue:[
cg@2300
   282
                s nextPutLine:'    m to inspect masterApplication (M to browse)'.
cg@2824
   283
                topApplicationToInspect notNil ifTrue:[
sv@3358
   284
                    s nextPutLine:'    t to inspect topApplication (T to browse)'.
cg@2824
   285
                ]
cg@2300
   286
            ].
cg@2300
   287
        ].
cg@3212
   288
        s nextPutLine:'    h to inspect view''s hierarchy'.
cg@2823
   289
        s nextPutLine:'    v to inspect view (V to browse)'.
cg@2823
   290
        topViewToInspect notNil ifTrue:[
cg@2824
   291
            s nextPutLine:'    w to inspect topWindow (W to browse)'.
cg@2823
   292
        ].
cg@2939
   293
        aView windowGroup notNil ifTrue:[
cg@2939
   294
            s nextPutLine:'    g to inspect windowGroup'.
cg@2939
   295
        ].
cg@2823
   296
        modelToInspect notNil ifTrue:[
cg@2823
   297
            s nextPutLine:'    o to inspect model (O to browse)'.
cg@2823
   298
        ].
cg@2823
   299
        s cr.
cg@2823
   300
        s nextPutLine:'RETURN to browse application.'.
cg@2823
   301
        s nextPutAll:'ESC or click to leave flyBy-info mode.'.
cg@2300
   302
    ]
cg@2300
   303
cg@2300
   304
    "
cg@2300
   305
     self shownInformationOfViewUnderMouseUntilButtonIsPressed
cg@2300
   306
    "
cg@2823
   307
cg@2824
   308
    "Modified: / 12-11-2010 / 11:54:59 / cg"
cg@2300
   309
! !
cg@2300
   310
cg@2710
   311
!FlyByWindowInformation methodsFor:'private'!
cg@2710
   312
cg@3058
   313
activeHelpViewForApplication:applicationOrNil text:helpText onDevice:aDevice
cg@3058
   314
    ^ (ActiveHelpView for:helpText onDevice:aDevice) shapeStyle:nil.
cg@3058
   315
!
cg@3058
   316
cg@2847
   317
handleMouseIn:aView x:x y:y
cg@2847
   318
    finished == true ifTrue:[^ self].
cg@2847
   319
    super handleMouseIn:aView x:x y:y
cg@2847
   320
!
cg@2847
   321
cg@2710
   322
targetViewInitiatesHelpViaSensor
cg@2710
   323
    ^ false
cg@2710
   324
! !
cg@2710
   325
cg@2300
   326
!FlyByWindowInformation methodsFor:'queries'!
cg@2300
   327
cg@2300
   328
toolTipFollowsMouse
cg@3297
   329
    "if true, the tooltip-window moves with the pointer
cg@3297
   330
     so that it stays away from (does not cover) the mouse pointer"
cg@3297
   331
cg@2300
   332
    ^ true
cg@2300
   333
! !
cg@2300
   334
cg@2300
   335
!FlyByWindowInformation methodsFor:'start & stop'!
cg@2300
   336
cg@2699
   337
initiateHelpFor:aView at:aPointOrNil
cg@2710
   338
    self initiateHelpFor:aView at:aPointOrNil now:true
cg@2699
   339
!
cg@2699
   340
cg@2699
   341
initiateHelpFor:aView at:aPointOrNil now:showItNow
cg@2702
   342
    finished == true ifTrue:[^ self].
cg@2699
   343
    super initiateHelpFor:aView at:aPointOrNil now:showItNow
cg@2699
   344
!
cg@2699
   345
cg@2300
   346
start
cg@2300
   347
    |l|
cg@2300
   348
cg@2702
   349
    finished == true ifTrue:[^ self].
cg@2702
   350
cg@2300
   351
    l := FlyByHelp currentHelpListener.
cg@2300
   352
    l notNil ifTrue:[
cg@2300
   353
        FlyByHelp stop.
cg@2300
   354
        cleanupAction := [ FlyByHelp start ].
cg@2300
   355
    ].
cg@2300
   356
    finishSemaphore := Semaphore new.
cg@2699
   357
    finished := false.
cg@2300
   358
    super start.
cg@2300
   359
!
cg@2300
   360
cg@2300
   361
stop
cg@2699
   362
    finished := true.
cg@2300
   363
    super stop.
cg@2300
   364
    cleanupAction value.
cg@2300
   365
    finishSemaphore notNil ifTrue:[
cg@2300
   366
        finishSemaphore signalIf.
cg@2300
   367
    ].
cg@2300
   368
!
cg@2300
   369
cg@2300
   370
waitUntilFinished
cg@2300
   371
    finishSemaphore wait.
cg@2300
   372
! !
cg@2300
   373
cg@2300
   374
!FlyByWindowInformation class methodsFor:'documentation'!
cg@2300
   375
cg@2587
   376
version_CVS
cg@2587
   377
    ^ '$Header$'
cg@2300
   378
! !
cg@2943
   379