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
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@2702
    86
    finished == true ifTrue:[^ self].
cg@2702
    87
cg@2340
    88
    super buttonMotion:buttonAndModifierState x:x y:y view:aView.
cg@2300
    89
    ^ true
cg@2300
    90
!
cg@2300
    91
cg@2300
    92
buttonPress:button x:x y:y view:aView
cg@2300
    93
    self stop.
cg@2300
    94
    ^ true
cg@2300
    95
!
cg@2300
    96
cg@2300
    97
keyPress:key x:x y:y view:aView
cg@2943
    98
    <resource: #keyboard (#Escape #Return)>
cg@2943
    99
cg@2823
   100
    |obj objToInspect objToBrowse lcKey|
cg@2300
   101
cg@2300
   102
    key == #Escape ifTrue:[
cg@2300
   103
        self stop.
cg@2300
   104
        ^ true
cg@2300
   105
    ].
cg@2300
   106
cg@2435
   107
    key == $? ifTrue:[
cg@2435
   108
        [
sv@2836
   109
            WindowTreeView notNil ifTrue:[
sv@2836
   110
                WindowTreeView openOn:(lastView topView) initialSelection:lastView.
sv@2836
   111
            ] ifFalse:[
sv@2836
   112
                self warn:'WindowTreeView class is not present!!'.
sv@2836
   113
            ].
cg@2435
   114
        ] fork.
cg@2435
   115
        self stop.
cg@2435
   116
        ^ true.
cg@2300
   117
    ].
cg@2435
   118
cg@2823
   119
    key == #Return ifTrue:[
cg@2823
   120
        objToBrowse := lastApplication ? lastView
cg@2823
   121
    ].
cg@2823
   122
cg@2435
   123
    key isCharacter ifTrue:[
cg@2435
   124
        lcKey := key asLowercase.
cg@2435
   125
cg@3212
   126
        lcKey == $h ifTrue:[
cg@3212
   127
            "/ use smalltalk at, to avoid dependency on libTool
cg@3212
   128
            [ (Smalltalk at:#'Tools::ViewTreeInspectorApplication') openOn:lastView ] fork.
cg@3212
   129
            ^ true.
cg@3212
   130
        ].
cg@2435
   131
        lcKey == $a ifTrue:[
cg@2435
   132
            obj := lastApplication
cg@2300
   133
        ].
cg@2435
   134
        lcKey == $o ifTrue:[
cg@2824
   135
            lastView notNil ifTrue:[
cg@2824
   136
                obj := lastView model
cg@2824
   137
            ].
cg@2435
   138
        ].
cg@2435
   139
        lcKey == $m ifTrue:[
cg@2824
   140
            lastApplication notNil ifTrue:[
cg@2824
   141
                obj := lastApplication masterApplication
cg@2824
   142
            ]
cg@2824
   143
        ].
cg@2824
   144
        lcKey == $t ifTrue:[
cg@2824
   145
            lastApplication notNil ifTrue:[
cg@2824
   146
                obj := lastApplication topApplication
cg@2824
   147
            ].
cg@2435
   148
        ].
cg@2435
   149
        lcKey == $v ifTrue:[
cg@2435
   150
            obj := lastView
cg@2435
   151
        ].
cg@2939
   152
        lcKey == $g ifTrue:[
cg@2939
   153
            obj := lastView windowGroup
cg@2939
   154
        ].
cg@2824
   155
        lcKey == $w ifTrue:[
cg@2824
   156
            lastView notNil ifTrue:[
cg@2824
   157
                obj := lastView topView
cg@2824
   158
            ]
cg@2435
   159
        ].
cg@2435
   160
        obj notNil ifTrue:[
cg@2435
   161
            key isLowercase ifTrue:[
cg@2823
   162
                objToInspect := obj
cg@2435
   163
            ] ifFalse:[
cg@2823
   164
                objToBrowse := obj
cg@2435
   165
            ].
cg@2435
   166
        ].
cg@2300
   167
    ].
cg@2300
   168
cg@2823
   169
    objToInspect notNil ifTrue:[
cg@2823
   170
        [ objToInspect inspect ] forkAt:(Processor userSchedulingPriority).
cg@2823
   171
    ].
cg@2823
   172
    objToBrowse notNil ifTrue:[
cg@2823
   173
        [ objToBrowse browse ] forkAt:(Processor userSchedulingPriority).
cg@2823
   174
    ].
cg@2823
   175
cg@2300
   176
    ^ true
cg@2823
   177
cg@2824
   178
    "Modified: / 12-11-2010 / 11:51:04 / cg"
cg@2300
   179
! !
cg@2300
   180
cg@2300
   181
!FlyByWindowInformation methodsFor:'help texts'!
cg@2300
   182
cg@2300
   183
helpTextFor:aView at:aPointOrNil
cg@2699
   184
    "generate the text to be shown as popup-flyby info"
cg@2699
   185
cg@2824
   186
    |resources|
cg@2824
   187
cg@2300
   188
    lastView := aView.
cg@2300
   189
    lastApplication := aView application.
cg@2300
   190
cg@2824
   191
    resources := self class classResources.
cg@2824
   192
cg@2824
   193
    ^ Text streamContents:[:s |
cg@2824
   194
        |topViewToInspect applicationToInspect 
cg@2824
   195
         masterApplicationToInspect topApplicationToInspect modelToInspect
cg@2939
   196
         genComponentNameForApplication windowGroupToInspect|
cg@2700
   197
cg@2824
   198
        genComponentNameForApplication := 
cg@2824
   199
            [:app :s |
cg@2700
   200
                (app notNil 
cg@2700
   201
                and:[ app builder notNil ]) ifTrue:[
cg@2700
   202
                    |components v|
cg@2700
   203
cg@2700
   204
                    components := app builder namedComponents.
cg@2700
   205
cg@2700
   206
                    v := aView.
cg@2700
   207
                    [   (components includes:v) not
cg@2700
   208
                        and:[v container notNil]
cg@2700
   209
                    ] whileTrue:[
cg@2700
   210
                        v := v container.
cg@2700
   211
                    ].
cg@2700
   212
                    (components includes:v) ifTrue:[
cg@2700
   213
                        |k|
cg@2700
   214
cg@2700
   215
                        k := components keyAtValue:v.
cg@2700
   216
                        v == aView ifTrue:[
cg@2824
   217
                            s nextPutLine:('       component: ' , k).
cg@2700
   218
                        ] ifFalse:[
cg@2824
   219
                            s nextPutLine:('       subview of component: ' , k).
cg@2700
   220
                        ].
cg@2700
   221
                    ].
cg@2700
   222
                ].
cg@2700
   223
            ].
cg@2314
   224
cg@2300
   225
        aView topView ~~ aView ifTrue:[
cg@2314
   226
            topViewToInspect := aView topView.
cg@2300
   227
        ].
cg@2300
   228
        lastApplication notNil ifTrue:[
cg@2314
   229
            applicationToInspect := lastApplication.
cg@2314
   230
            masterApplicationToInspect := lastApplication masterApplication.
cg@2824
   231
            masterApplicationToInspect notNil ifTrue:[
cg@2824
   232
                masterApplicationToInspect == applicationToInspect ifTrue:[
cg@2824
   233
                    masterApplicationToInspect := nil
cg@2824
   234
                ] ifFalse:[
cg@2824
   235
                    topApplicationToInspect := masterApplicationToInspect topApplication.
cg@2824
   236
                    topApplicationToInspect == masterApplicationToInspect ifTrue:[
cg@2824
   237
                        topApplicationToInspect := nil
cg@2824
   238
                    ]
cg@2824
   239
                ].
cg@2824
   240
            ]
cg@2314
   241
        ].
cg@2314
   242
        aView model notNil ifTrue:[
cg@2314
   243
            modelToInspect := aView model.
cg@2314
   244
            ((modelToInspect == applicationToInspect)
cg@2314
   245
            or:[ modelToInspect == masterApplicationToInspect ]) ifTrue:[
cg@2314
   246
                modelToInspect := nil.
cg@2300
   247
            ].
cg@2300
   248
        ].
cg@2314
   249
cg@2824
   250
        applicationToInspect notNil ifTrue:[
cg@2824
   251
            s nextPutLine:(resources string:'Application: %1' with:applicationToInspect class name allBold).
cg@2824
   252
            genComponentNameForApplication value:applicationToInspect value:s.
cg@2314
   253
        ].
cg@2700
   254
        masterApplicationToInspect notNil ifTrue:[
cg@2824
   255
            s nextPutLine:(resources string:'Master-Application: %1' with:masterApplicationToInspect class name allBold).
cg@2824
   256
            "/ genComponentNameForApplication value:masterApplicationToInspect value:s.
cg@2700
   257
        ].
cg@2824
   258
        topApplicationToInspect notNil ifTrue:[
cg@2824
   259
            s nextPutLine:(resources string:'Top-Application: %1' with:topApplicationToInspect class name allBold).
cg@2824
   260
            "/ genComponentNameForApplication value:topApplicationToInspect value:s.
cg@2314
   261
        ].
cg@2824
   262
        s nextPutLine:(resources string:'View: %1 "%2"' with:aView class name allBold with:aView name).
cg@2824
   263
        topViewToInspect notNil ifTrue:[
cg@2824
   264
            s nextPutLine:(resources string:'Topview: %1' with:topViewToInspect class name allBold).
cg@2824
   265
        ].
cg@2824
   266
        modelToInspect notNil ifTrue:[
cg@2824
   267
            s nextPutLine:(resources string:'Model: %1' with:modelToInspect class name allBold).
cg@2824
   268
        ].
cg@2699
   269
cg@2300
   270
        s cr.
cg@2300
   271
        s nextPutLine:'Press:'.
cg@3212
   272
cg@3212
   273
        "/ use smalltalk at, to avoid dependency on libTool
cg@3212
   274
        (Smalltalk at:#'Tools::ViewTreeInspectorApplication') notNil ifTrue:[
cg@3212
   275
            s nextPutLine:'    ? to show the view''s tree'.
cg@3212
   276
        ].
cg@2314
   277
        applicationToInspect notNil ifTrue:[
cg@2300
   278
            s nextPutLine:'    a to inspect application (A to browse)'.
cg@2314
   279
            masterApplicationToInspect notNil ifTrue:[
cg@2300
   280
                s nextPutLine:'    m to inspect masterApplication (M to browse)'.
cg@2824
   281
                topApplicationToInspect notNil ifTrue:[
sv@3358
   282
                    s nextPutLine:'    t to inspect topApplication (T to browse)'.
cg@2824
   283
                ]
cg@2300
   284
            ].
cg@2300
   285
        ].
cg@3212
   286
        s nextPutLine:'    h to inspect view''s hierarchy'.
cg@2823
   287
        s nextPutLine:'    v to inspect view (V to browse)'.
cg@2823
   288
        topViewToInspect notNil ifTrue:[
cg@2824
   289
            s nextPutLine:'    w to inspect topWindow (W to browse)'.
cg@2823
   290
        ].
cg@2939
   291
        aView windowGroup notNil ifTrue:[
cg@2939
   292
            s nextPutLine:'    g to inspect windowGroup'.
cg@2939
   293
        ].
cg@2823
   294
        modelToInspect notNil ifTrue:[
cg@2823
   295
            s nextPutLine:'    o to inspect model (O to browse)'.
cg@2823
   296
        ].
cg@2823
   297
        s cr.
cg@2823
   298
        s nextPutLine:'RETURN to browse application.'.
cg@2823
   299
        s nextPutAll:'ESC or click to leave flyBy-info mode.'.
cg@2300
   300
    ]
cg@2300
   301
cg@2300
   302
    "
cg@2300
   303
     self shownInformationOfViewUnderMouseUntilButtonIsPressed
cg@2300
   304
    "
cg@2823
   305
cg@2824
   306
    "Modified: / 12-11-2010 / 11:54:59 / cg"
cg@2300
   307
! !
cg@2300
   308
cg@2710
   309
!FlyByWindowInformation methodsFor:'private'!
cg@2710
   310
cg@3058
   311
activeHelpViewForApplication:applicationOrNil text:helpText onDevice:aDevice
cg@3058
   312
    ^ (ActiveHelpView for:helpText onDevice:aDevice) shapeStyle:nil.
cg@3058
   313
!
cg@3058
   314
cg@2847
   315
handleMouseIn:aView x:x y:y
cg@2847
   316
    finished == true ifTrue:[^ self].
cg@2847
   317
    super handleMouseIn:aView x:x y:y
cg@2847
   318
!
cg@2847
   319
cg@2710
   320
targetViewInitiatesHelpViaSensor
cg@2710
   321
    ^ false
cg@2710
   322
! !
cg@2710
   323
cg@2300
   324
!FlyByWindowInformation methodsFor:'queries'!
cg@2300
   325
cg@2300
   326
toolTipFollowsMouse
cg@3297
   327
    "if true, the tooltip-window moves with the pointer
cg@3297
   328
     so that it stays away from (does not cover) the mouse pointer"
cg@3297
   329
cg@2300
   330
    ^ true
cg@2300
   331
! !
cg@2300
   332
cg@2300
   333
!FlyByWindowInformation methodsFor:'start & stop'!
cg@2300
   334
cg@2699
   335
initiateHelpFor:aView at:aPointOrNil
cg@2710
   336
    self initiateHelpFor:aView at:aPointOrNil now:true
cg@2699
   337
!
cg@2699
   338
cg@2699
   339
initiateHelpFor:aView at:aPointOrNil now:showItNow
cg@2702
   340
    finished == true ifTrue:[^ self].
cg@2699
   341
    super initiateHelpFor:aView at:aPointOrNil now:showItNow
cg@2699
   342
!
cg@2699
   343
cg@2300
   344
start
cg@2300
   345
    |l|
cg@2300
   346
cg@2702
   347
    finished == true ifTrue:[^ self].
cg@2702
   348
cg@2300
   349
    l := FlyByHelp currentHelpListener.
cg@2300
   350
    l notNil ifTrue:[
cg@2300
   351
        FlyByHelp stop.
cg@2300
   352
        cleanupAction := [ FlyByHelp start ].
cg@2300
   353
    ].
cg@2300
   354
    finishSemaphore := Semaphore new.
cg@2699
   355
    finished := false.
cg@2300
   356
    super start.
cg@2300
   357
!
cg@2300
   358
cg@2300
   359
stop
cg@2699
   360
    finished := true.
cg@2300
   361
    super stop.
cg@2300
   362
    cleanupAction value.
cg@2300
   363
    finishSemaphore notNil ifTrue:[
cg@2300
   364
        finishSemaphore signalIf.
cg@2300
   365
    ].
cg@2300
   366
!
cg@2300
   367
cg@2300
   368
waitUntilFinished
cg@2300
   369
    finishSemaphore wait.
cg@2300
   370
! !
cg@2300
   371
cg@2300
   372
!FlyByWindowInformation class methodsFor:'documentation'!
cg@2300
   373
cg@2587
   374
version_CVS
cg@2587
   375
    ^ '$Header$'
cg@2300
   376
! !
cg@2943
   377