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