ModalBox.st
author Claus Gittinger <cg@exept.de>
Thu, 20 Feb 2020 10:52:26 +0100
changeset 8995 a54112003192
parent 8986 4fb8947f1047
child 9030 7705b9774577
permissions -rw-r--r--
#DOCUMENTATION by exept class: SimpleView comment/format in: #waitUntilVisible
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
     2
 COPYRIGHT (c) 1990 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
     3
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     4
48194c26a46c Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
48194c26a46c Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
48194c26a46c Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
48194c26a46c Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
48194c26a46c Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
48194c26a46c Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
48194c26a46c Initial revision
claus
parents:
diff changeset
    11
"
3266
4db6dd90cc17 category change
Claus Gittinger <cg@exept.de>
parents: 3093
diff changeset
    12
"{ Package: 'stx:libview' }"
4db6dd90cc17 category change
Claus Gittinger <cg@exept.de>
parents: 3093
diff changeset
    13
6777
8527109b401d class: ModalBox
Claus Gittinger <cg@exept.de>
parents: 6269
diff changeset
    14
"{ NameSpace: Smalltalk }"
8527109b401d class: ModalBox
Claus Gittinger <cg@exept.de>
parents: 6269
diff changeset
    15
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    16
StandardSystemView subclass:#ModalBox
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
    17
	instanceVariableNames:'shadowView exclusiveKeyboard escapeIsCancel
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
    18
		closeOnOutsideButtonPress'
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
    19
	classVariableNames:'UseTransientViews DefaultExtent'
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
    20
	poolDictionaries:''
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
    21
	category:'Views-Basic'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    22
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    23
1232
8106eef0084c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1221
diff changeset
    24
!ModalBox class methodsFor:'documentation'!
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    25
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    26
copyright
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    27
"
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    28
 COPYRIGHT (c) 1990 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    29
	      All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    30
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    31
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    32
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    33
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    34
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    35
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    36
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    37
"
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    38
!
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    39
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    40
documentation
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    41
"
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    42
    this class implements modal boxes; ModalBoxes are different from
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
    43
    others, in that they take control over the current topview, until
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
    44
    all processing is done (i.e. the currently active topview and all of
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
    45
    its subviews will not handle user events while the box is active).
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    46
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    47
    ModalBoxes are either implemented as transient windows
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    48
    (if UseTransientViews := true) or as override redirect views.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    49
    Some window managers have problems with either; so you may want to
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    50
    change the default setting from your display.rc file.
616
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    51
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    52
    [see also:]
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
    53
	StandardSystemView
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
    54
	DialogBox
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
    55
	( introduction to view programming :html: programming/viewintro.html )
616
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    56
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    57
    [author:]
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
    58
	Claus Gittinger
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    59
"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    60
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    61
1232
8106eef0084c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1221
diff changeset
    62
!ModalBox class methodsFor:'initialization'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    63
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    64
initialize
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    65
    UseTransientViews := true.
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    66
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    67
    "
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    68
     UseTransientViews := false
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    69
    "
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    70
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
    71
    "Modified: 24.7.1997 / 15:18:59 / cg"
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    72
! !
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    73
1232
8106eef0084c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1221
diff changeset
    74
!ModalBox class methodsFor:'defaults'!
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    75
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    76
defaultExtent
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    77
    "this defines the defaultExtent for instances of me;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    78
     the value returned here is usually not correct for concrete subclasses,
587
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    79
     so you better redefine this method.
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    80
     The value returned here is usually ignored, and
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    81
     the value from preferredExtent taken instead."
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    82
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
    83
    DefaultExtent notNil ifTrue:[
2193
8ef9d174d111 default extent a bit bigger.
Claus Gittinger <cg@exept.de>
parents: 1970
diff changeset
    84
	^ DefaultExtent
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
    85
    ].
2193
8ef9d174d111 default extent a bit bigger.
Claus Gittinger <cg@exept.de>
parents: 1970
diff changeset
    86
    ^ (Screen current pixelPerMillimeter * (60 @ 20)) rounded
587
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    87
2193
8ef9d174d111 default extent a bit bigger.
Claus Gittinger <cg@exept.de>
parents: 1970
diff changeset
    88
    "Modified: / 27.7.1998 / 20:15:15 / cg"
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    89
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    90
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    91
defaultLabel
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    92
    "return the boxes default window title."
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    93
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    94
    ^ 'PopUp'
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    95
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    96
    "Created: 23.4.1996 / 17:14:21 / cg"
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    97
!
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    98
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
    99
updateStyleCache
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   100
    "extract values from the styleSheet and cache them in class variables"
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   101
1931
27aa9e5b15dd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1915
diff changeset
   102
    <resource: #style (#'modalBox.defaultExtent')>
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   103
1931
27aa9e5b15dd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1915
diff changeset
   104
    DefaultExtent := StyleSheet at:'modalBox.defaultExtent' default:nil.
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   105
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   106
    "
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   107
     self updateStyleCache
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   108
    "
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   109
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   110
    "Modified: 31.8.1995 / 03:01:14 / claus"
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   111
    "Created: 15.8.1997 / 01:40:53 / cg"
1931
27aa9e5b15dd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 1915
diff changeset
   112
    "Modified: 20.10.1997 / 15:07:37 / cg"
1865
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   113
!
43c2eaba229d allow default topViews extends to be overwritten by styleSheet
Claus Gittinger <cg@exept.de>
parents: 1826
diff changeset
   114
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   115
useTransientViews:aBoolean
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   116
    "change the way modalBoxes are created on the Display.
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   117
     If the argument is true, transient views are used;
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   118
     otherwise override redirect views are used.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   119
     Depending on your windowmanager, either one may have problems.
959
a47e44337899 modalBoxes from non-windowGroup processes (background process)
Claus Gittinger <cg@exept.de>
parents: 953
diff changeset
   120
     You may want to change the setting
1397
932c517ad29c moved tranientView setup up in the hierarchy
Claus Gittinger <cg@exept.de>
parents: 1314
diff changeset
   121
     from your display.rc or d_xxx.rc file.
932c517ad29c moved tranientView setup up in the hierarchy
Claus Gittinger <cg@exept.de>
parents: 1314
diff changeset
   122
     This is now obsolete - transient views work and are always used."
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   123
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   124
    UseTransientViews := aBoolean.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   125
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   126
    "
144
claus
parents: 141
diff changeset
   127
     ModalBox useTransientViews:false
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   128
     ModalBox useTransientViews:true
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   129
    "
959
a47e44337899 modalBoxes from non-windowGroup processes (background process)
Claus Gittinger <cg@exept.de>
parents: 953
diff changeset
   130
1397
932c517ad29c moved tranientView setup up in the hierarchy
Claus Gittinger <cg@exept.de>
parents: 1314
diff changeset
   131
    "Modified: 28.2.1997 / 22:27:46 / cg"
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   132
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   133
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   134
!ModalBox methodsFor:'accessing'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   135
3460
d60f9cd59bdb optionBox: cancel-value corrected
Claus Gittinger <cg@exept.de>
parents: 3440
diff changeset
   136
escapeIsCancel
d60f9cd59bdb optionBox: cancel-value corrected
Claus Gittinger <cg@exept.de>
parents: 3440
diff changeset
   137
    "return the escapeIsCancel setting - defaults to true for modalMox here."
d60f9cd59bdb optionBox: cancel-value corrected
Claus Gittinger <cg@exept.de>
parents: 3440
diff changeset
   138
d60f9cd59bdb optionBox: cancel-value corrected
Claus Gittinger <cg@exept.de>
parents: 3440
diff changeset
   139
    ^ escapeIsCancel
d60f9cd59bdb optionBox: cancel-value corrected
Claus Gittinger <cg@exept.de>
parents: 3440
diff changeset
   140
!
d60f9cd59bdb optionBox: cancel-value corrected
Claus Gittinger <cg@exept.de>
parents: 3440
diff changeset
   141
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   142
exclusiveKeyboard:aBoolean
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   143
    "set/clear exclusive locking of the keyboard;
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   144
     If set, the box will take total control over the
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   145
     keyboard, not allowing input to other views/boxes
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   146
     while active.
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   147
     DANGER:
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   148
	only use this for very very urgent boxes, since
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   149
	no interaction with ANY view on the screen is possible then."
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   150
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   151
    exclusiveKeyboard := aBoolean
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   152
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   153
    "Modified: 12.5.1996 / 21:55:09 / cg"
8732
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   154
!
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   155
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   156
windowTitle
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   157
    ^ super label
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   158
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   159
    "Created: / 26-08-2018 / 17:03:56 / Claus Gittinger"
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   160
!
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   161
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   162
windowTitle:windowTitleString
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   163
    "set the boxes window title string"
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   164
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   165
    super label:windowTitleString.
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   166
2126b6c5f654 #FEATURE by cg
Claus Gittinger <cg@exept.de>
parents: 8465
diff changeset
   167
    "Created: / 26-08-2018 / 17:01:23 / Claus Gittinger"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   168
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   169
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   170
!ModalBox methodsFor:'event handling'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   171
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   172
coveredBy:aView
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   173
    "the receiver has been covered by another view.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   174
     If the other view is a non-modal one, raise"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   175
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   176
    |mainGroup topViews|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   177
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   178
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   179
     if the other view is not a modal- (or shadow-, or popup-) -view,
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   180
     bring myself to the front again.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   181
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   182
    aView isPopUpView ifFalse:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   183
	"
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   184
	 if I have a mainGroup,
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   185
	 only raise if it's one of my maingroup-views
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   186
	"
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   187
	windowGroup notNil ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   188
	    mainGroup := windowGroup mainGroup.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   189
	    mainGroup notNil ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   190
		topViews := mainGroup topViews.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   191
		topViews notNil ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   192
		    topViews do:[:eachTopView |
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   193
			aView == eachTopView ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   194
			    self raise.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   195
			    ^ self
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   196
			]
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   197
		    ]
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   198
		].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   199
		^ self
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   200
	    ]
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   201
	].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   202
	self raise
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   203
    ]
7891
8cc23e3f937f #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7848
diff changeset
   204
8cc23e3f937f #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7848
diff changeset
   205
    "Modified (format): / 13-02-2017 / 20:27:00 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   206
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   207
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   208
terminate
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   209
    "this is the close from a windowmanager
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   210
     (only if UseTransientViews == true)"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   211
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   212
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   213
     if I am a dialog, make the receiver invisible and leave control.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   214
     But, do not destroy the underlying view resources, to allow for
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   215
     another open/show to occur later.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   216
     if I have been opened modeLess, perform the normal destroy operation.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   217
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   218
    (windowGroup isNil or:[windowGroup isModal]) ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   219
	self hide
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   220
    ] ifFalse:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   221
	super terminate
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   222
    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   223
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   224
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   225
visibilityChange:how
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   226
    "raise when covered - this should not be needed, since we
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   227
     have been created as override-redirect window (which should
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   228
     stay on top - but some window managers (fvwm) seem to ignore
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   229
     this ..."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   230
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   231
    "the code below is not good, since it will lead to
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   232
     oscillating raises when two modalBoxes are going to cover
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   233
     each other - see coveredBy:-handling ..."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   234
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   235
"/    how ~~ #fullyVisible ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   236
"/        self raise
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   237
"/    ]
7133
Stefan Vogel <sv@exept.de>
parents: 6777
diff changeset
   238
Stefan Vogel <sv@exept.de>
parents: 6777
diff changeset
   239
     super visibilityChange:how.
1970
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   240
!
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   241
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   242
xxxpointerEnter:state x:x y:y
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   243
    "mhmh: this seems to be a special X kludge;
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   244
     without the following, we will not regain input focus after
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   245
     pointer is reentered."
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   246
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   247
"/
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   248
"/ experimental: disabled; bad behavior with some windowManagers,
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   249
"/ if enter/leave events are processed late.
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   250
"/
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   251
    self getKeyboardFocus.
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   252
    super pointerEnter:state x:x y:y
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   253
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   254
    "Created: / 8.12.1997 / 19:18:45 / cg"
5b602928ee03 experimental: no longer grab the keyboardFocus in a dialogs
Claus Gittinger <cg@exept.de>
parents: 1931
diff changeset
   255
    "Modified: / 8.12.1997 / 19:19:39 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   256
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   257
3884
dc9ea4cfc963 method category rename
Claus Gittinger <cg@exept.de>
parents: 3881
diff changeset
   258
!ModalBox methodsFor:'initialization & release'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   259
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   260
addToCurrentProject
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   261
    "ignored here"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   262
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   263
    ^ self
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   264
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   265
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   266
create
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   267
    super create.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   268
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   269
	self saveUnder:true
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   270
    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   271
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   272
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   273
destroy
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   274
    "destroy the view.
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   275
     redefined to also destroy my shadow, if there is one,
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   276
     and to release the global keyboard grab (if there is one)"
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   277
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   278
    shadowView notNil ifTrue:[
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   279
	shadowView destroy.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   280
	shadowView := nil
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   281
    ].
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   282
    exclusiveKeyboard ifTrue:[
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   283
	self forceUngrabKeyboard
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   284
    ].
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   285
    super destroy.
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   286
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   287
    "Modified: 12.5.1996 / 21:56:10 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   288
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   289
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   290
initEvents
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   291
    "initialize event handling; redefined to enable visibility changes"
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   292
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   293
    super initEvents.
1221
7ae7d7a901de added escapeIsCancel flag (ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 965
diff changeset
   294
    self enableEvent:#visibilityChange.
7ae7d7a901de added escapeIsCancel flag (ST-80 compatibility)
Claus Gittinger <cg@exept.de>
parents: 965
diff changeset
   295
    escapeIsCancel := true.
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   296
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   297
    "Modified: 12.5.1996 / 21:56:31 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   298
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   299
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   300
initStyle
1263
f5af4e2abd71 commentary
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   301
    "setup viewStyle specifics"
f5af4e2abd71 commentary
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   302
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   303
    |style|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   304
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   305
    super initStyle.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   306
    style := styleSheet name.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   307
    ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   308
	self borderWidth:0.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   309
	UseTransientViews ifFalse:[
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   310
	    self level:2
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   311
	]
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   312
    ]
1263
f5af4e2abd71 commentary
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   313
f5af4e2abd71 commentary
Claus Gittinger <cg@exept.de>
parents: 1232
diff changeset
   314
    "Modified: 22.1.1997 / 11:57:35 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   315
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   316
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   317
initialize
7848
bccc2879a64e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7661
diff changeset
   318
    <modifier: #super> "must be called if redefined"
bccc2879a64e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7661
diff changeset
   319
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   320
    |form resizeButton moveButton|
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   321
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   322
    super initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   323
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   324
    "/ self beDialogView.
4272
ecdbad167dfd default windowStyle is now toolDialog
ca
parents: 4197
diff changeset
   325
    self beToolDialog.
ecdbad167dfd default windowStyle is now toolDialog
ca
parents: 4197
diff changeset
   326
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   327
    exclusiveKeyboard := false.
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   328
"/    label := ' '.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   329
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   330
"/    label := 'Popup'.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   331
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   332
    UseTransientViews ifFalse:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   333
	(PopUpView shadowsOnDevice:device) ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   334
	    shadowView := (ShadowView onDevice:device) for:self
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   335
	].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   336
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   337
	form := Form width:8 height:8
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   338
		     fromArray:#[2r00000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   339
				 2r00000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   340
				 2r00000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   341
				 2r00000001
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   342
				 2r00000011
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   343
				 2r00000111
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   344
				 2r00001111
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   345
				 2r00011111
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   346
				]
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   347
		     onDevice:device.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   348
	resizeButton := Button label:form in:self.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   349
	resizeButton origin:1.0 @ 1.0 corner:1.0@1.0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   350
	resizeButton activeForegroundColor:(resizeButton foregroundColor).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   351
	resizeButton activeBackgroundColor:(resizeButton backgroundColor).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   352
	resizeButton enteredBackgroundColor:(resizeButton backgroundColor).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   353
	resizeButton leftInset:-8; topInset:-8.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   354
	resizeButton releaseAction:[].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   355
	resizeButton pressAction:[resizeButton turnOff; redraw. self doResize].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   356
	resizeButton borderWidth:0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   357
	resizeButton activeLevel:0; passiveLevel:0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   358
	resizeButton cursor:(Cursor corner).
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   359
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   360
	form := Form width:8 height:8
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   361
		     fromArray:#[2r11111000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   362
				 2r11110000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   363
				 2r11100000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   364
				 2r11000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   365
				 2r10000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   366
				 2r00000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   367
				 2r00000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   368
				 2r00000000
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   369
				]
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   370
		     onDevice:device.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   371
	moveButton := Button label:form in:self.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   372
	moveButton origin:0.0 @ 0.0 corner:0.0@0.0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   373
	moveButton activeForegroundColor:(moveButton foregroundColor).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   374
	moveButton activeBackgroundColor:(moveButton backgroundColor).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   375
	moveButton enteredBackgroundColor:(moveButton backgroundColor).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   376
	moveButton rightInset:-8; bottomInset:-8.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   377
	moveButton releaseAction:[].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   378
	moveButton pressAction:[moveButton turnOff; redraw. self doMove].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   379
	moveButton borderWidth:0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   380
	moveButton activeLevel:0; passiveLevel:0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   381
	moveButton cursor:(Cursor origin)
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   382
    ].
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   383
7848
bccc2879a64e #OTHER by cg
Claus Gittinger <cg@exept.de>
parents: 7661
diff changeset
   384
    "Modified (format): / 08-02-2017 / 00:26:36 / cg"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   385
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   386
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   387
isPopUpView
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   388
    "return true, if I want to come up without decoration
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   389
     and popUp to top immediately."
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   390
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   391
    ^ UseTransientViews not
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   392
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   393
    "Modified: 24.7.1997 / 15:20:14 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   394
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   395
2480
b4ffc5f3377f when realized, automatically assign the focus to the
Claus Gittinger <cg@exept.de>
parents: 2193
diff changeset
   396
realize
2690
f3d660bbe4a3 changed initial focus assignment
Claus Gittinger <cg@exept.de>
parents: 2644
diff changeset
   397
    super realize.
4179
d3a1cfe411db initial focus
Claus Gittinger <cg@exept.de>
parents: 4178
diff changeset
   398
    self assignInitialKeyboardFocus.
2690
f3d660bbe4a3 changed initial focus assignment
Claus Gittinger <cg@exept.de>
parents: 2644
diff changeset
   399
f3d660bbe4a3 changed initial focus assignment
Claus Gittinger <cg@exept.de>
parents: 2644
diff changeset
   400
    "Modified: / 3.5.1996 / 23:48:04 / stefan"
f3d660bbe4a3 changed initial focus assignment
Claus Gittinger <cg@exept.de>
parents: 2644
diff changeset
   401
    "Modified: / 20.5.1999 / 18:17:34 / cg"
2480
b4ffc5f3377f when realized, automatically assign the focus to the
Claus Gittinger <cg@exept.de>
parents: 2193
diff changeset
   402
!
b4ffc5f3377f when realized, automatically assign the focus to the
Claus Gittinger <cg@exept.de>
parents: 2193
diff changeset
   403
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   404
reinitialize
2644
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   405
    "if I have already been reinited - return"
6269
703a7c20f524 class: ModalBox
Stefan Vogel <sv@exept.de>
parents: 5968
diff changeset
   406
    self drawableId notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   407
	^ self
2644
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   408
    ].
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   409
    "physically create the view & subviews"
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   410
    self recreate.
644
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   411
2644
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   412
"/   super reinitialize.
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   413
"/   self unmap.
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   414
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   415
    "Modified: / 3.5.1996 / 23:48:04 / stefan"
bb15778539af oops - restart with iconified views recreated them
Claus Gittinger <cg@exept.de>
parents: 2589
diff changeset
   416
    "Modified: / 6.5.1999 / 09:38:06 / cg"
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   417
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   418
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   419
resize
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   420
    "resize myself to make everything visible"
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   421
4197
1984b2ba83de Do not set maxExtent (to the Screen size) in StandartSystemView.
Stefan Vogel <sv@exept.de>
parents: 4179
diff changeset
   422
    |newExtent maxExtent|
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   423
151
claus
parents: 144
diff changeset
   424
    newExtent := self preferredExtent.
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   425
    newExtent := newExtent min:(device extent).
5678
414d0473ad21 force the extent to be no bigger than the screen
Claus Gittinger <cg@exept.de>
parents: 5626
diff changeset
   426
4197
1984b2ba83de Do not set maxExtent (to the Screen size) in StandartSystemView.
Stefan Vogel <sv@exept.de>
parents: 4179
diff changeset
   427
    maxExtent := self maxExtent.
1984b2ba83de Do not set maxExtent (to the Screen size) in StandartSystemView.
Stefan Vogel <sv@exept.de>
parents: 4179
diff changeset
   428
    maxExtent notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   429
	newExtent := newExtent min:maxExtent.
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   430
    ].
4197
1984b2ba83de Do not set maxExtent (to the Screen size) in StandartSystemView.
Stefan Vogel <sv@exept.de>
parents: 4179
diff changeset
   431
    newExtent ~= self extent ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   432
	(shown and:[shadowView notNil]) ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   433
	    shadowView unmap.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   434
	    self extent:newExtent.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   435
	    shadowView realize.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   436
	    self raise
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   437
	] ifFalse:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   438
	    self extent:newExtent.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   439
	].
4197
1984b2ba83de Do not set maxExtent (to the Screen size) in StandartSystemView.
Stefan Vogel <sv@exept.de>
parents: 4179
diff changeset
   440
    ].
5678
414d0473ad21 force the extent to be no bigger than the screen
Claus Gittinger <cg@exept.de>
parents: 5626
diff changeset
   441
414d0473ad21 force the extent to be no bigger than the screen
Claus Gittinger <cg@exept.de>
parents: 5626
diff changeset
   442
    "Modified: / 21-01-2011 / 13:50:11 / cg"
180
claus
parents: 157
diff changeset
   443
!
claus
parents: 157
diff changeset
   444
claus
parents: 157
diff changeset
   445
resizeUnderPointer
claus
parents: 157
diff changeset
   446
    "resize myself to make everything visible, AND possibly change the origin
claus
parents: 157
diff changeset
   447
     to have the mouse pointer stay within my bounds.
claus
parents: 157
diff changeset
   448
     This is used for self-resizing enterBoxes, to avoid moving
claus
parents: 157
diff changeset
   449
     the box away from the cursor."
claus
parents: 157
diff changeset
   450
7981
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   451
    |newExtent newWidth newHeight newLeft newRight newTop newBottom delta screenWidth|
180
claus
parents: 157
diff changeset
   452
claus
parents: 157
diff changeset
   453
    newExtent := self preferredExtent.
claus
parents: 157
diff changeset
   454
    newExtent = self extent ifTrue:[^ self].
claus
parents: 157
diff changeset
   455
claus
parents: 157
diff changeset
   456
    shown ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   457
	"/ new code (after 15.3.2017)
7981
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   458
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   459
	newWidth := newExtent x.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   460
	newHeight := newExtent y.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   461
	newLeft := left.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   462
	newTop := top.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   463
	newRight := left + newWidth.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   464
	newBottom := top + newHeight.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   465
	newRight > device usableWidth ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   466
	    newLeft := device usableWidth - newWidth.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   467
	    newLeft < 0 ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   468
		newLeft := 0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   469
		newRight := newWidth := device usableWidth.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   470
	    ].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   471
	].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   472
	newBottom > device usableHeight ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   473
	    newTop := device usableHeight - newHeight.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   474
	    newTop < 0 ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   475
		newTop := 0.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   476
		newBottom := newHeight := device usableHeight.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   477
	    ].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   478
	].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   479
	newExtent := newWidth @ newHeight.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   480
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   481
"/ old code (before 15.3.2017).
7981
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   482
"/        delta := width - newExtent x.
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   483
"/        newLeft := left + delta.
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   484
"/        (((newLeft @ top) extent:newExtent) containsPoint:device pointerPosition
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   485
"/        ) ifFalse:[
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   486
"/            newLeft := left
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   487
"/        ].
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   488
"/        newLeft < 0 ifTrue:[newLeft := 0].
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   489
"/        screenWidth := device usableWidth.
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   490
"/        newLeft + newExtent x > screenWidth ifTrue:[
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   491
"/            newLeft := screenWidth - newExtent x
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   492
"/        ].
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   493
	shadowView notNil ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   494
	    shadowView unmap.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   495
	].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   496
	self origin:(newLeft @ newTop) extent:newExtent.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   497
	shadowView notNil ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   498
	    shadowView realize.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   499
	    self raise.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   500
	].
180
claus
parents: 157
diff changeset
   501
    ] ifFalse:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   502
	self extent:newExtent.
180
claus
parents: 157
diff changeset
   503
    ].
claus
parents: 157
diff changeset
   504
7981
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   505
    "Modified: / 06-09-1995 / 15:31:21 / claus"
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   506
    "Modified: / 03-05-1996 / 23:48:17 / stefan"
d3b4f232af3b #UI_ENHANCEMENT by cg
Claus Gittinger <cg@exept.de>
parents: 7891
diff changeset
   507
    "Modified (comment): / 15-03-2017 / 19:37:03 / cg"
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   508
! !
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   509
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   510
!ModalBox methodsFor:'move & resize'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   511
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   512
doMove
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   513
    "the move button was pressed.
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   514
     This method is only used with non-transient views
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   515
     (UseTransientViews == false)."
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   516
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   517
    |r|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   518
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   519
    r := device rectangleFromUser:(self origin corner:self corner) keepExtent:true.
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   520
    shadowView notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   521
	shadowView unmap
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   522
    ].
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   523
    self origin:r origin extent:(self extent).
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   524
    shadowView notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   525
	shadowView realize.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   526
	self raise.
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   527
    ].
644
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   528
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   529
    "Modified: 3.5.1996 / 23:47:38 / stefan"
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   530
    "Modified: 24.7.1997 / 16:07:18 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   531
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   532
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   533
doResize
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   534
    "the resize button was pressed.
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   535
     This method is only used with non-transient views
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   536
     (UseTransientViews == false)."
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   537
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   538
    |r|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   539
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   540
    r := device rectangleFromUser:(self origin corner:self corner).
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   541
    shadowView notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   542
	shadowView unmap
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   543
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   544
    self origin:r origin extent:(r extent max:(100@100)).
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   545
    shadowView notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   546
	shadowView realize.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   547
	self raise
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   548
    ].
644
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   549
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   550
    "Modified: 3.5.1996 / 23:47:47 / stefan"
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   551
    "Modified: 24.7.1997 / 15:18:46 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   552
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   553
3266
4db6dd90cc17 category change
Claus Gittinger <cg@exept.de>
parents: 3093
diff changeset
   554
!ModalBox methodsFor:'queries-internal'!
1700
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   555
1915
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   556
windowLabelFor:labelString
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   557
    "dialogs do not include the hostname in the window label"
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   558
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   559
    ^ labelString
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   560
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   561
    "Created: 22.9.1997 / 10:14:02 / cg"
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   562
!
f86162de1a2f extracted windowLabel generation into a separate method
Claus Gittinger <cg@exept.de>
parents: 1865
diff changeset
   563
1700
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   564
windowStyle
3715
70eea03a8d8d comment
Claus Gittinger <cg@exept.de>
parents: 3649
diff changeset
   565
    "return a symbol describing my style (one of: #dialog, #popUp or #normal)
1700
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   566
     (may be used internally by the device as a decoration hint)"
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   567
4272
ecdbad167dfd default windowStyle is now toolDialog
ca
parents: 4197
diff changeset
   568
    UseTransientViews ifFalse:[
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   569
	^ #popUp
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   570
    ].
4272
ecdbad167dfd default windowStyle is now toolDialog
ca
parents: 4197
diff changeset
   571
    ^ super windowStyle
1700
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   572
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   573
    "Created: 2.5.1997 / 14:34:17 / cg"
1825
c6f133f38dff fixed non-transient mode
Claus Gittinger <cg@exept.de>
parents: 1700
diff changeset
   574
    "Modified: 24.7.1997 / 15:22:39 / cg"
1700
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   575
! !
ea1abaa7901d preps for native window support
Claus Gittinger <cg@exept.de>
parents: 1400
diff changeset
   576
3881
6661ab0fa781 method category rename
Claus Gittinger <cg@exept.de>
parents: 3859
diff changeset
   577
!ModalBox methodsFor:'show & hide'!
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   578
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   579
autoHideAfter:seconds with:anAction
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   580
    "install a background process, which hides the box
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   581
     after some time. Also, if non-nil, anAction will be
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   582
     evaluated then. The action will not be evaluated if
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   583
     the box is closed by the user pressing a button."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   584
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   585
    "the implementation is simple: just fork of a process
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   586
     to hide me."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   587
    [
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   588
	Delay waitForSeconds:seconds.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   589
	self shown ifTrue:[
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   590
	    self hide.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   591
	    anAction value
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   592
	]
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   593
    ] forkAt:4.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   594
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   595
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   596
     |b|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   597
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   598
     b := InfoBox title:'hello there'.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   599
     b autoHideAfter:5 with:[].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   600
     b showAtCenter.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   601
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   602
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   603
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   604
fixSize
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   605
    "this is sent right before the modalBox is made visible;
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   606
     If the size is not fixed, adjust my size."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   607
5945
52161987f2f1 changed: #fixSize
Claus Gittinger <cg@exept.de>
parents: 5889
diff changeset
   608
    sizeFixed ifFalse:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   609
	self resize.
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   610
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   611
    super fixSize.
5945
52161987f2f1 changed: #fixSize
Claus Gittinger <cg@exept.de>
parents: 5889
diff changeset
   612
52161987f2f1 changed: #fixSize
Claus Gittinger <cg@exept.de>
parents: 5889
diff changeset
   613
    "Modified: / 27-10-2012 / 12:16:58 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   614
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   615
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   616
hide
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   617
    "make the receiver invisible and leave control"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   618
2579
774e6fb33dde checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2577
diff changeset
   619
    |masterGroup|
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   620
1314
99e3347abb6c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1263
diff changeset
   621
    realized ifFalse:[^ self].
99e3347abb6c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1263
diff changeset
   622
644
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   623
    shadowView notNil ifTrue:[shadowView unmap].
3313
acf38fcda6e9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3266
diff changeset
   624
    windowGroup notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   625
	windowGroup focusView:nil.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   626
	masterGroup := windowGroup previousGroup.
3313
acf38fcda6e9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3266
diff changeset
   627
    ].
acf38fcda6e9 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3266
diff changeset
   628
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   629
    exclusiveKeyboard ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   630
	self forceUngrabKeyboard
675
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   631
    ].
fc15e8886089 removed leaveCOntrol (not used); added comments
Claus Gittinger <cg@exept.de>
parents: 644
diff changeset
   632
644
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   633
    self unmap.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   634
2579
774e6fb33dde checkin from browser
Claus Gittinger <cg@exept.de>
parents: 2577
diff changeset
   635
    masterGroup notNil ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   636
	"
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   637
	 this is a kludge for IRIS and others which do not provide backingstore:
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   638
	 when we hide a modalbox (such as a searchbox) which covered
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   639
	 a scrollbar, the scrollbars bitblt-method will copy from the
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   640
	 not-yet redrawn area - effectively clearing the scroller.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   641
	 We need a short delay here, since at this time, the expose event has
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   642
	 not yet arrived.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   643
	"
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   644
	device sync.     "/ that's a round trip, to ensure that all expose events are present..."
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   645
	Delay waitForSeconds:0.05.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   646
	masterGroup processExposeEvents
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   647
    ].
644
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   648
85ce9499c925 Rename unrealize-->unmap.
Stefan Vogel <sv@exept.de>
parents: 616
diff changeset
   649
    "Modified: 3.5.1996 / 23:47:57 / stefan"
1314
99e3347abb6c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1263
diff changeset
   650
    "Modified: 8.2.1997 / 17:41:16 / cg"
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   651
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   652
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   653
hideRequest
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   654
    "hide request from windowGroup (i.e. via Escape key).
7661
fa9faa4f9526 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7584
diff changeset
   655
     Can be redefined in subclasses which don't like this"
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   656
3440
33d132092b22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3351
diff changeset
   657
    self hide
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   658
!
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   659
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   660
mapped
48194c26a46c Initial revision
claus
parents:
diff changeset
   661
    "wait till visible for grabbing"
48194c26a46c Initial revision
claus
parents:
diff changeset
   662
48194c26a46c Initial revision
claus
parents:
diff changeset
   663
    super mapped.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   664
3344
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   665
"/    "take it away from any popup menu possibly still active"
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   666
"/
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   667
"/    self forceUngrabKeyboard.
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   668
"/    self forceUngrabPointer.
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   669
"/
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   670
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   671
     if I am a super-modal box, take the keyboard
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   672
    "
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   673
    exclusiveKeyboard ifTrue:[
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   674
	self forceUngrabKeyboard.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   675
	self grabKeyboard.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   676
    ].
3344
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   677
"/
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   678
"/"/    UseTransientViews ifFalse:[
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   679
"/        "
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   680
"/         get the focus
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   681
"/        "
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   682
"/        self getKeyboardFocus.
4c3428823365 moved focus & grabHandling to TopViews openModal handling
ca
parents: 3328
diff changeset
   683
"/        self enableEnterLeaveEvents
3351
458b3f245e69 *** empty log message ***
ca
parents: 3344
diff changeset
   684
"/"/    ]
3440
33d132092b22 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 3351
diff changeset
   685
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   686
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   687
open
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   688
    "default for modalboxes is to come up modal at the pointer position"
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   689
3520
d434192f89f6 honor forceModalToCenter
Claus Gittinger <cg@exept.de>
parents: 3460
diff changeset
   690
    ForceModalBoxesToOpenAtCenter == true ifTrue:[
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   691
	^ self showAtCenter
3520
d434192f89f6 honor forceModalToCenter
Claus Gittinger <cg@exept.de>
parents: 3460
diff changeset
   692
    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   693
    ^ self showAtPointer
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   694
!
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   695
953
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   696
openAt:aPoint
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   697
    "default for modalboxes is to come up modal at the pointer position"
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   698
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   699
    ^ self openModalAt:aPoint
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   700
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   701
    "Created: 17.7.1996 / 14:50:44 / cg"
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   702
!
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   703
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   704
openAtCenter
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   705
    "default for modalboxes is to come up modal at the pointer position"
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   706
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   707
    ^ self openModalAtCenter
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   708
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   709
    "Created: 17.7.1996 / 14:50:35 / cg"
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   710
!
226d5ccde5fd *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 922
diff changeset
   711
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   712
openModal:aBlock
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   713
    "open the box modal;
8464
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   714
     In addition to the basic (inherited) modalloop, possibly show a shadow.
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   715
     (these days, the shadow-view is usually disabled, as modern graphics do it now for us)
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   716
     Stay in the modal loop while aBlock evaluates to true AND the receiver is visible.
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   717
     (i.e. control is returned to the sender when the receiver is closed)
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   718
     This makes any interaction with the current window impossible -
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   719
     however, other views (in other windowgroups) still work."
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   720
1397
932c517ad29c moved tranientView setup up in the hierarchy
Claus Gittinger <cg@exept.de>
parents: 1314
diff changeset
   721
    shadowView notNil ifTrue:[shadowView realize].
932c517ad29c moved tranientView setup up in the hierarchy
Claus Gittinger <cg@exept.de>
parents: 1314
diff changeset
   722
    super openModal:aBlock.
300
6a63af1fec3e passing group to avoid multiple activeGroup searches
Claus Gittinger <cg@exept.de>
parents: 296
diff changeset
   723
8464
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   724
    "Created: / 10-12-1995 / 14:07:01 / cg"
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   725
    "Modified: / 28-02-1997 / 22:32:49 / cg"
0af00aa05d74 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 7981
diff changeset
   726
    "Modified (comment): / 14-09-2018 / 18:12:00 / Claus Gittinger"
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   727
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   728
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   729
show
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   730
    "make myself visible (at the last or default position) and take control.
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   731
     If that position is out of the screen area, moves the receiver to make
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   732
     it fully visible."
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   733
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   734
    self fixSize.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   735
    self makeFullyVisible.
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   736
    [
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   737
        self openModal
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   738
    ] ensure:[
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   739
        self destroy.
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   740
    ]    
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   741
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   742
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   743
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   744
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   745
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   746
     b show.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   747
    "
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   748
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   749
    "Modified: / 07-03-1996 / 17:57:49 / cg"
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   750
    "Modified: / 05-02-2020 / 13:40:53 / Stefan Vogel"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   751
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   752
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   753
showAt:aPoint
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   754
    "make myself visible at aPoint.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   755
     Fix position to make box fully visible"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   756
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   757
    self fixSize.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   758
    self fixPosition:aPoint.
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   759
    [
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   760
        self openModal
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   761
    ] ensure:[
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   762
        self destroy.
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   763
    ]    
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   764
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   765
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   766
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   767
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   768
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   769
     b showAt:(0 @ 0).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   770
     b showAt:(400 @ 400).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   771
    "
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   772
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   773
    "Modified: / 05-02-2020 / 13:41:05 / Stefan Vogel"
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   774
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   775
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   776
showAt:aPoint center:center
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   777
    "make myself visible at aPoint. center specifies
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   778
     if the view should show up centered around aPoint."
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   779
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   780
    self showAt:aPoint centerX:center centerY:center
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   781
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   782
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   783
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   784
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   785
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   786
     b showAt:(100 @ 100) center:true.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   787
     b showAt:(100 @ 100) center:false.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   788
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   789
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   790
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   791
showAt:aPoint centerX:centerX centerY:centerY
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   792
    "make myself visible at aPoint. centerX/centerY specify
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   793
     if the view should show up centered around aPoint.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   794
     Fix position to make box fully visible"
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   795
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   796
    |dx dy|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   797
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   798
    self fixSize.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   799
    centerX ifTrue:[
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   800
        dx := self width // 2.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   801
    ] ifFalse:[
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   802
        dx := 0
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   803
    ].
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   804
    centerY ifTrue:[
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   805
        dy := self height // 2.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   806
    ] ifFalse:[
8985
b4d006b79f84 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8956
diff changeset
   807
        dy := 0
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   808
    ].
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   809
    self origin:(aPoint - (dx @ dy)).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   810
    self makeFullyVisible.
8986
4fb8947f1047 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8985
diff changeset
   811
    self openModal
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   812
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   813
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   814
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   815
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   816
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   817
     b showAt:(100 @ 100).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   818
     b showAt:(100 @ 100) centerX:true centerY:false.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   819
    "
5678
414d0473ad21 force the extent to be no bigger than the screen
Claus Gittinger <cg@exept.de>
parents: 5626
diff changeset
   820
414d0473ad21 force the extent to be no bigger than the screen
Claus Gittinger <cg@exept.de>
parents: 5626
diff changeset
   821
    "Modified: / 21-01-2011 / 13:58:29 / cg"
8986
4fb8947f1047 #BUGFIX by stefan
Stefan Vogel <sv@exept.de>
parents: 8985
diff changeset
   822
    "Modified: / 06-02-2020 / 12:04:27 / Stefan Vogel"
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   823
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   824
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   825
showAtCenter
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   826
    "make myself visible at the screen center."
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   827
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   828
    self showAt:(device centerOfMonitorHavingPointer) center:true
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   829
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   830
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   831
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   832
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   833
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   834
     b showAtCenter.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   835
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   836
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   837
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   838
showAtPointer
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   839
    "make myself visible at mouse pointer shifted to have
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   840
     convenient button under cursor.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   841
     self positionOffset should return that offset
8850
aa69e3c0cc85 #DOCUMENTATION by exept
Claus Gittinger <cg@exept.de>
parents: 8732
diff changeset
   842
     (usually redefined, since we don't know here, which button should be under cursor)."
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   843
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   844
    |first pointerPosition positionOffset pos monitorBounds alignedPos|
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   845
5626
0d7703a9eef6 changed: #showAtPointer
Claus Gittinger <cg@exept.de>
parents: 5616
diff changeset
   846
    "/ ****** MULTI SCREEN
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   847
    pointerPosition := device pointerPosition.
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   848
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   849
    self fixSize.
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   850
    positionOffset := self positionOffset.
5626
0d7703a9eef6 changed: #showAtPointer
Claus Gittinger <cg@exept.de>
parents: 5616
diff changeset
   851
    pos := alignedPos := pointerPosition - positionOffset.
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   852
5626
0d7703a9eef6 changed: #showAtPointer
Claus Gittinger <cg@exept.de>
parents: 5616
diff changeset
   853
    UserPreferences current forceWindowsIntoMonitorBounds ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   854
	monitorBounds := device monitorBoundsAt:pointerPosition.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   855
	alignedPos := (pos x max:monitorBounds left) @ (pos y max:monitorBounds top).
5626
0d7703a9eef6 changed: #showAtPointer
Claus Gittinger <cg@exept.de>
parents: 5616
diff changeset
   856
    ].
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   857
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   858
    positionOffset := pointerPosition - alignedPos.
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   859
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   860
    self fixPosition:alignedPos.
5513
9af55a873ca9 changed: #showAtPointer
Claus Gittinger <cg@exept.de>
parents: 5495
diff changeset
   861
    pos := self origin.
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   862
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   863
    "We have got a problem here:
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   864
	X11 adds some window decoration. The size of the decoration is only known
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   865
	after the view is visible!!
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   866
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   867
	So there is a (hopefully) small offset from the pointer to the requested
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   868
	position. The only way to resolve this, is to move the pointer to
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   869
	the requested position after the view is visible"
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   870
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   871
    first := true.
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   872
    self openModal:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   873
	(first and:[shown]) ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   874
	    first := false.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   875
	    false ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   876
		"/ cg: no longer move the mouse to the OK button!!
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   877
		"/ the mouse will fall down the desk if we do that too often... ;-)
8465
dfd6ad20c612 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 8464
diff changeset
   878
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   879
		"in Linux - SuSe Tumbleweed 2016-01 the Delay is required, otherwise the pointer
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   880
		 is shown relative to the root window. No idea why this is needed.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   881
		 Maybe the window manager (kwin) does something."
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   882
		Delay waitForMilliseconds:10.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   883
		self setPointerPosition:positionOffset.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   884
	    ].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   885
	].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   886
	true
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   887
    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   888
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   889
    "/ cannot use:
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   890
    "/    self showAt:(device pointerPosition - self positionOffset).
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   891
    "/ because the resizing must be done before the
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   892
    "/ positionOffset is grabbed (it may change due to the resize)
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   893
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   894
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   895
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   896
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   897
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   898
     b showAtPointer.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   899
    "
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   900
5626
0d7703a9eef6 changed: #showAtPointer
Claus Gittinger <cg@exept.de>
parents: 5616
diff changeset
   901
    "Modified: / 22-10-2010 / 11:20:05 / cg"
8465
dfd6ad20c612 #DOCUMENTATION by cg
Claus Gittinger <cg@exept.de>
parents: 8464
diff changeset
   902
    "Modified (format): / 14-09-2018 / 18:15:13 / Claus Gittinger"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   903
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   904
48194c26a46c Initial revision
claus
parents:
diff changeset
   905
showAtPointerNotCovering:aView
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   906
    "make myself visible at mouse pointer shifted to have
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   907
     convenient button under cursor.
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   908
     Fix position to make the box fully visible AND to make sure that
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   909
     aView is not covered."
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   910
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   911
    |pos newX|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   912
7264
84b62bae4dc0 device access
Claus Gittinger <cg@exept.de>
parents: 7133
diff changeset
   913
    pos := device pointerPosition - self positionOffset.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   914
5611
4c8229c880fd Multi Screen Support
Michael Beyl <mb@exept.de>
parents: 5609
diff changeset
   915
    ((Rectangle origin:pos extent:self extent)
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   916
	intersects: (aView origin corner: aView corner))
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   917
    ifTrue:[
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   918
	"
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   919
	 try to the right of the untouchable view
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   920
	"
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   921
	newX := (aView origin x + aView width).
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   922
	newX + width > device usableWidth ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   923
	    newX := device usableWidth - width
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   924
	].
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   925
	pos x:newX.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   926
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   927
8956
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   928
	((Rectangle origin:pos extent:self extent)
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   929
	    intersects: (aView origin corner: aView corner))
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   930
	ifTrue:[
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   931
	    "
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   932
	     try to the left of the untouchable view
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   933
	    "
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   934
	    newX := aView origin x - width.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   935
	    "
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   936
	     should look for vertical possibilities too ...
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   937
	    "
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   938
	    pos x:newX.
66f452418af2 feature
Claus Gittinger <cg@exept.de>
parents: 8850
diff changeset
   939
	]
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   940
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   941
    ].
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   942
    self showAt:pos
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   943
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   944
    "Modified: 7.3.1996 / 17:58:10 / cg"
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   945
!
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   946
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   947
showCenteredIn:aView
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   948
    "make myself visible at the center if aView."
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   949
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   950
    |top|
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   951
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   952
    top := aView topView.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   953
    top raise.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   954
    self showAt:(top center + (aView originRelativeTo:top)) center:true
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   955
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   956
    "
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   957
     |b|
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   958
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   959
     b := InfoBox title:'hello'.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   960
     b showCenteredIn:Transcript.
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   961
    "
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   962
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   963
    "Modified: 7.3.1996 / 17:58:53 / cg"
2577
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   964
!
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   965
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   966
unmapped
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   967
    "mhmh - unmapped by the windowManager - if realized (i.e. not closing),
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   968
     keep the realized flag true (to avoid exiting the modal event loop).
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   969
     Consider this a kludge."
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   970
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   971
    |r|
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   972
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   973
    r := realized.
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   974
    super unmapped.
c7c9b49a3794 kludge workaround - keep realized flag value when unmapped
Claus Gittinger <cg@exept.de>
parents: 2480
diff changeset
   975
    realized := r.
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   976
! !
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   977
1232
8106eef0084c checkin from browser
Claus Gittinger <cg@exept.de>
parents: 1221
diff changeset
   978
!ModalBox class methodsFor:'documentation'!
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   979
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   980
version
7133
Stefan Vogel <sv@exept.de>
parents: 6777
diff changeset
   981
    ^ '$Header$'
5386
7bb5b24b9bb2 no more direct accesses to borderWidth and borderColor
Claus Gittinger <cg@exept.de>
parents: 5226
diff changeset
   982
!
7bb5b24b9bb2 no more direct accesses to borderWidth and borderColor
Claus Gittinger <cg@exept.de>
parents: 5226
diff changeset
   983
7bb5b24b9bb2 no more direct accesses to borderWidth and borderColor
Claus Gittinger <cg@exept.de>
parents: 5226
diff changeset
   984
version_CVS
7133
Stefan Vogel <sv@exept.de>
parents: 6777
diff changeset
   985
    ^ '$Header$'
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   986
! !
3859
a11d876ebc26 Fix #showAtPointer to take care of window manager title bars.
Stefan Vogel <sv@exept.de>
parents: 3715
diff changeset
   987
6269
703a7c20f524 class: ModalBox
Stefan Vogel <sv@exept.de>
parents: 5968
diff changeset
   988
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   989
ModalBox initialize!