ModalBox.st
author Claus Gittinger <cg@exept.de>
Thu, 25 Apr 1996 19:17:58 +0200
changeset 616 56cf67c82664
parent 596 e196ea43d242
child 644 85ce9499c925
permissions -rw-r--r--
documentation
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
"
48194c26a46c Initial revision
claus
parents:
diff changeset
    12
48194c26a46c Initial revision
claus
parents:
diff changeset
    13
StandardSystemView subclass:#ModalBox
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
    14
	instanceVariableNames:'shadowView exclusiveKeyboard'
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
    15
	classVariableNames:'UseTransientViews'
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
    16
	poolDictionaries:''
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
    17
	category:'Views-Basic'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    18
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    19
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    20
!ModalBox class methodsFor:'documentation'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    21
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    22
copyright
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    23
"
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    24
 COPYRIGHT (c) 1990 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
    25
	      All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    26
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    27
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    28
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    29
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    30
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    31
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    32
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    33
"
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    34
!
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    35
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    36
documentation
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    37
"
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
    38
    this class implements modal boxes; ModalBoxes are different from
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
    39
    others, in that they take control over the current topview, until 
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
    40
    all processing is done (i.e. the currently active topview and all of
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
    41
    its subviews will not handle user events while the box is active).
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    42
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    43
    ModalBoxes are either implemented as transient windows
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    44
    (if UseTransientViews := true) or as override redirect views.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    45
    Some window managers have problems with either; so you may want to
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    46
    change the default setting from your display.rc file.
616
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    47
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    48
    [see also:]
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    49
        StandardSystemView 
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    50
        DialogBox
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    51
        ( introduction to view programming :html: programming/viewintro.html )
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    52
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    53
    [author:]
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
    54
        Claus Gittinger
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    55
"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    56
! !
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    57
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    58
!ModalBox class methodsFor:'initialization'!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    59
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    60
initialize
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    61
    UseTransientViews := true.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    62
! !
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    63
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    64
!ModalBox class methodsFor:'defaults'!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    65
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    66
defaultExtent
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    67
    "this defines the defaultExtent for instances of me;
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    68
     the value returned here is usually not correct for concrete subclasses,
587
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    69
     so you better redefine this method.
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    70
     The value returned here is usually ignored, and
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    71
     the value from preferredExtent taken instead."
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    72
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    73
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    74
    ^ (Display pixelPerMillimeter * (60 @ 30)) rounded
587
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    75
c0fb8bc13596 commentary
Claus Gittinger <cg@exept.de>
parents: 514
diff changeset
    76
    "Modified: 22.4.1996 / 23:37:06 / cg"
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    77
!
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    78
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    79
defaultLabel
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    80
    "return the boxes default window title."
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    81
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    82
    ^ 'PopUp'
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    83
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    84
    "Created: 23.4.1996 / 17:14:21 / cg"
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    85
!
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
    86
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    87
useTransientViews:aBoolean 
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    88
    "change the way modalBoxes are created on the Display.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    89
     If the argument is true, transient views are used; otherwise
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    90
     override redirect views are used. Depending on your windowmanager,
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    91
     either one may have problems. You may want to change the setting
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    92
     from your display.rc or d_xxx.rc file."
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    93
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    94
    UseTransientViews := aBoolean.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    95
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    96
    "
144
claus
parents: 141
diff changeset
    97
     ModalBox useTransientViews:false
claus
parents: 141
diff changeset
    98
     ModalBox useTransientViews:true 
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
    99
    "
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   100
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   101
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   102
!ModalBox methodsFor:'accessing'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   103
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   104
exclusiveKeyboard:aBoolean
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   105
    "set/clear exclusive locking of the keyboard;
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   106
     If set, the box will take total control over the
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   107
     keyboard, not allowing input to other views/boxes
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   108
     while active.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   109
     Danger: only use this for very very urgent boxes, since
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   110
     no interaction with any view on the screen is possible then."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   111
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   112
    exclusiveKeyboard := aBoolean
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   113
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   114
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   115
!ModalBox methodsFor:'event handling'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   116
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   117
coveredBy:aView
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   118
    "the receiver has been covered by another view.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   119
     If the other view is a non-modal one, raise"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   120
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   121
    |mainGroup topViews|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   122
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   123
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   124
     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
   125
     bring myself to the front again.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   126
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   127
    aView isPopUpView ifFalse:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   128
	"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   129
	 if I have a mainGroup,
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   130
	 only raise if its one of my maingroup-views
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   131
	"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   132
	windowGroup notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   133
	    mainGroup := windowGroup mainGroup.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   134
	    mainGroup notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   135
		topViews := mainGroup topViews.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   136
		topViews notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   137
		    topViews do:[:aTopView |
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   138
			aView == aTopView ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   139
			    self raise.     
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   140
			    ^ self
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   141
			]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   142
		    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   143
		].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   144
		^ self
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   145
	    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   146
	].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   147
	self raise
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   148
    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   149
!
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
pointerEnter:state x:x y:y
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   152
    "mhmh: this seems to be a special X kludge;
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   153
     without the following, we will not regain input focus after
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   154
     pointer is reentered."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   155
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   156
    self getKeyboardFocus.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   157
    super pointerEnter:state x:x y:y
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   158
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   159
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   160
terminate
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   161
    "this is the close from a windowmanager
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   162
     (only if UseTransientViews == true)"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   163
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   164
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   165
     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
   166
     But, do not destroy the underlying view resources, to allow for
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   167
     another open/show to occur later.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   168
     if I have been opened modeLess, perform the normal destroy operation.
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
    (windowGroup isNil or:[windowGroup isModal]) ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   171
	self hide
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   172
    ] ifFalse:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   173
	super terminate
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   174
    ]
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
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   177
visibilityChange:how
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   178
    "raise when covered - this should not be needed, since we
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   179
     have been created as override-redirect window (which should
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   180
     stay on top - but some window managers (fvwm) seem to ignore
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   181
     this ..."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   182
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   183
    "the code below is not good, since it will lead to
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   184
     oscillating raises when two modalBoxes are going to cover
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   185
     each other - see coveredBy:-handling ..."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   186
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   187
"/    how ~~ #fullyVisible ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   188
"/        self raise
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   189
"/    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   190
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   191
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   192
!ModalBox methodsFor:'initialize / release'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   193
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   194
addToCurrentProject
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   195
    "ignored here"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   196
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   197
    ^ self
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   198
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   199
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   200
create
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   201
    super create.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   202
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   203
	self saveUnder:true
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   204
    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   205
!
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
destroy
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   208
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   209
	shadowView destroy.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   210
	shadowView := nil
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
    self leaveControl. "just to make sure"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   213
    super destroy.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   214
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   215
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   216
initEvents
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   217
    super initEvents.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   218
    self enableEvent:#visibilityChange
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   219
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   220
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   221
initStyle
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   222
    |style|
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
    super initStyle.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   225
    style := styleSheet name.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   226
    ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   227
	borderWidth := 0.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   228
	UseTransientViews ifFalse:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   229
	    self level:2
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
    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   232
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   233
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   234
initialize
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   235
    |form resizeButton moveButton|
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   236
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   237
    super initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   238
141
claus
parents: 138
diff changeset
   239
    type := #dialog. 
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   240
    exclusiveKeyboard := false.
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   241
"/    label := ' '.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   242
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   243
"/    label := 'Popup'.
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   244
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   245
    UseTransientViews ifFalse:[
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   246
        PopUpView shadows ifTrue:[
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   247
            shadowView := (ShadowView onDevice:device) for:self
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   248
        ].
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   249
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   250
        form := Form width:8 height:8 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   251
                     fromArray:#[2r00000000
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   252
                                 2r00000000 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   253
                                 2r00000000 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   254
                                 2r00000001
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   255
                                 2r00000011
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   256
                                 2r00000111 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   257
                                 2r00001111
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   258
                                 2r00011111 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   259
                                ]
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   260
                     on:device.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   261
        resizeButton := Button form:form in:self.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   262
        resizeButton origin:1.0 @ 1.0 corner:1.0@1.0.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   263
        resizeButton activeForegroundColor:(resizeButton foregroundColor).
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   264
        resizeButton activeBackgroundColor:(resizeButton backgroundColor).
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   265
        resizeButton enteredBackgroundColor:(resizeButton backgroundColor).
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   266
        resizeButton leftInset:-8; topInset:-8.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   267
        resizeButton releaseAction:[].
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   268
        resizeButton pressAction:[resizeButton turnOff; redraw. self doResize].
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   269
        resizeButton borderWidth:0.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   270
        resizeButton onLevel:0; offLevel:0.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   271
        resizeButton cursor:(Cursor corner).
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   272
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   273
        form := Form width:8 height:8 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   274
                     fromArray:#[2r11111000
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   275
                                 2r11110000 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   276
                                 2r11100000 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   277
                                 2r11000000
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   278
                                 2r10000000
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   279
                                 2r00000000 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   280
                                 2r00000000
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   281
                                 2r00000000 
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   282
                                ]
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   283
                     on:device.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   284
        moveButton := Button form:form in:self.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   285
        moveButton origin:0.0 @ 0.0 corner:0.0@0.0.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   286
        moveButton activeForegroundColor:(moveButton foregroundColor).
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   287
        moveButton activeBackgroundColor:(moveButton backgroundColor).
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   288
        moveButton enteredBackgroundColor:(moveButton backgroundColor).
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   289
        moveButton rightInset:-8; bottomInset:-8.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   290
        moveButton releaseAction:[].
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   291
        moveButton pressAction:[moveButton turnOff; redraw. self doMove].
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   292
        moveButton borderWidth:0.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   293
        moveButton onLevel:0; offLevel:0.
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   294
        moveButton cursor:(Cursor origin)
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   295
    ].
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   296
596
e196ea43d242 checkin from browser
Claus Gittinger <cg@exept.de>
parents: 587
diff changeset
   297
    "Modified: 23.4.1996 / 17:15:37 / cg"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   298
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   299
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   300
isPopUpView
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   301
    ^ UseTransientViews not
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   302
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   303
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   304
reinitialize
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   305
   super reinitialize.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   306
   self unrealize.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   307
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   308
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   309
resize
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   310
    "resize myself to make everything visible"
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   311
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   312
    |newExtent|
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   313
151
claus
parents: 144
diff changeset
   314
    newExtent := self preferredExtent.
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   315
    newExtent = self extent ifTrue:[^ self].
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   316
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   317
    (shown and:[shadowView notNil]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   318
	shadowView unrealize.
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   319
	self extent:newExtent.
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   320
	shadowView realize.
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   321
	self raise
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   322
    ] ifFalse:[
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   323
	self extent:newExtent.
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   324
    ].
180
claus
parents: 157
diff changeset
   325
!
claus
parents: 157
diff changeset
   326
claus
parents: 157
diff changeset
   327
resizeUnderPointer
claus
parents: 157
diff changeset
   328
    "resize myself to make everything visible, AND possibly change the origin
claus
parents: 157
diff changeset
   329
     to have the mouse pointer stay within my bounds.
claus
parents: 157
diff changeset
   330
     This is used for self-resizing enterBoxes, to avoid moving
claus
parents: 157
diff changeset
   331
     the box away from the cursor."
claus
parents: 157
diff changeset
   332
claus
parents: 157
diff changeset
   333
    |newExtent newLeft delta|
claus
parents: 157
diff changeset
   334
claus
parents: 157
diff changeset
   335
    newExtent := self preferredExtent.
claus
parents: 157
diff changeset
   336
    newExtent = self extent ifTrue:[^ self].
claus
parents: 157
diff changeset
   337
claus
parents: 157
diff changeset
   338
    shown ifTrue:[
claus
parents: 157
diff changeset
   339
	delta := width - newExtent x.
claus
parents: 157
diff changeset
   340
	newLeft := left + delta.
claus
parents: 157
diff changeset
   341
	(((newLeft @ top) extent:newExtent) 
claus
parents: 157
diff changeset
   342
	    containsPoint:device pointerPosition)
claus
parents: 157
diff changeset
   343
	ifFalse:[newLeft := left].
claus
parents: 157
diff changeset
   344
	newLeft < 0 ifTrue:[newLeft := 0].
claus
parents: 157
diff changeset
   345
	newLeft + newExtent x > device width ifTrue:[
claus
parents: 157
diff changeset
   346
	    newLeft := device width - newExtent x
claus
parents: 157
diff changeset
   347
	].
claus
parents: 157
diff changeset
   348
	shadowView notNil ifTrue:[
claus
parents: 157
diff changeset
   349
	    shadowView unrealize.
claus
parents: 157
diff changeset
   350
	].
claus
parents: 157
diff changeset
   351
	self origin:(newLeft @ top) extent:newExtent.
claus
parents: 157
diff changeset
   352
	shadowView notNil ifTrue:[
claus
parents: 157
diff changeset
   353
	    shadowView realize.
claus
parents: 157
diff changeset
   354
	    self raise.
claus
parents: 157
diff changeset
   355
	].
claus
parents: 157
diff changeset
   356
    ] ifFalse:[
claus
parents: 157
diff changeset
   357
	self extent:newExtent.
claus
parents: 157
diff changeset
   358
    ].
claus
parents: 157
diff changeset
   359
claus
parents: 157
diff changeset
   360
    "Modified: 6.9.1995 / 15:31:21 / claus"
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   361
! !
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   362
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   363
!ModalBox methodsFor:'move & resize'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   364
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   365
doMove
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   366
    "the move button was pressed"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   367
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   368
    |r|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   369
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   370
    r := device rectangleFromUser:(self origin corner:self corner).
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   371
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   372
	shadowView unrealize
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   373
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   374
    self origin:r origin extent:(r extent max:(100@100)).
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   375
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   376
	shadowView realize.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   377
	self raise
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   378
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   379
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   380
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   381
doResize
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   382
    "the resize button was pressed"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   383
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   384
    |r|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   385
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   386
    r := device rectangleFromUser:(self origin corner:self corner).
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   387
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   388
	shadowView unrealize
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   389
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   390
    self origin:r origin extent:(r extent max:(100@100)).
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   391
    shadowView notNil ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   392
	shadowView realize.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   393
	self raise
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   394
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   395
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   396
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   397
!ModalBox methodsFor:'private'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   398
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   399
leaveControl
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   400
    exclusiveKeyboard ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   401
	device ungrabKeyboard
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   402
    ]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   403
! !
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   404
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   405
!ModalBox methodsFor:'queries'!
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   406
151
claus
parents: 144
diff changeset
   407
preferredExtent
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   408
    "return the extent required to make all components
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   409
     visible in myself. This should be redefined in
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   410
     subclasses."
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   411
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   412
    ^ self class defaultExtent
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   413
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   414
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   415
!ModalBox methodsFor:'show / hide'!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   416
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   417
autoHideAfter:seconds with:anAction
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   418
    "install a background process, which hides the box
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   419
     after some time. Also, if non-nil, anAction will be
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   420
     evaluated then. The action will not be evaluated if
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   421
     the box is closed by the user pressing a button."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   422
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   423
    "the implementation is simple: just fork of a process
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   424
     to hide me."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   425
    [
371
cc32d8f8bc8d use new Delay-wait
Claus Gittinger <cg@exept.de>
parents: 300
diff changeset
   426
	Delay waitForSeconds:seconds.
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   427
	self shown ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   428
	    self hide. 
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   429
	    anAction notNil ifTrue:[anAction value]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   430
	]
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   431
    ] forkAt:4.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   432
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   433
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   434
     |b|
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   435
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   436
     b := InfoBox title:'hello there'.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   437
     b autoHideAfter:5 with:[].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   438
     b showAtCenter.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   439
    "
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   440
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   441
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   442
fixPosition:aPoint
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   443
    "set origin to aPoint, but make sure, that the box is fully visible 
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   444
     by shifting it into the visible screen area if nescessary.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   445
     This prevents invisible modalBoxes (which you could never close)."
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   446
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   447
    self origin:aPoint.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   448
    self makeFullyVisible
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   449
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   450
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   451
fixSize
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   452
    "this is sent right before the modalBox is made visible;
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   453
     If the size is not fixed, adjust my size."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   454
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   455
    sizeFixed == true ifFalse:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   456
	self resize.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   457
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   458
    super fixSize.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   459
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   460
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   461
hide
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   462
    "make the receiver invisible and leave control"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   463
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   464
    |p|
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   465
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   466
    shadowView notNil ifTrue:[shadowView unrealize].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   467
    windowGroup notNil ifTrue:[windowGroup focusView:nil].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   468
    self leaveControl.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   469
    self unrealize.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   470
    device flush. 
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   471
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   472
    (windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   473
	"
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   474
	 this is a kludge for IRIS which does not provide backingstore:
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   475
	 when we hide a modalbox (such as a searchbox) which covered
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   476
	 a scrollbar, the scrollbars bitblt-method will copy from the
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   477
	 not-yet redrawn area - effectively clearing the scroller.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   478
	 We need a short delay here, since at this time, the expose event has
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   479
	 not yet arrived.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   480
	"
371
cc32d8f8bc8d use new Delay-wait
Claus Gittinger <cg@exept.de>
parents: 300
diff changeset
   481
	Delay waitForSeconds:0.1.
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   482
	p processExposeEvents   
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   483
    ].
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   484
!
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   485
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   486
hideRequest
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   487
    "hide request from windowGroup (i.e. via Escape key).
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   488
     Can be redefined in subclasses which dont like this"
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   489
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   490
    self hide
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   491
!
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   492
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   493
mapped
48194c26a46c Initial revision
claus
parents:
diff changeset
   494
    "wait till visible for grabbing"
48194c26a46c Initial revision
claus
parents:
diff changeset
   495
48194c26a46c Initial revision
claus
parents:
diff changeset
   496
    super mapped.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   497
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   498
    "take it away from any popup menu possibly still active"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   499
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   500
    device ungrabKeyboard.
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   501
    device ungrabPointer.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   502
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   503
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   504
     if I am a super-modal box, take the keyboard
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   505
    "
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   506
    exclusiveKeyboard ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   507
	device grabKeyboardInView:self.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   508
    ].
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   509
89
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   510
"/    UseTransientViews ifFalse:[
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   511
	"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   512
	 get the focus
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   513
	"
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   514
	self getKeyboardFocus.
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   515
	self enableEnterLeaveEvents
ea2bf46eb669 *** empty log message ***
claus
parents: 86
diff changeset
   516
"/    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   517
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   518
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   519
open
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   520
    "default for modalboxes is to come up modal at the pointer position"
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   521
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   522
    ^ self showAtPointer
46
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   523
!
7b331e9012fd *** empty log message ***
claus
parents: 21
diff changeset
   524
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   525
openModal:aBlock
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   526
    "open the box modal;
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   527
     In addition to the basic (inherited) modalloop, change
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   528
     the current active windowgroups cursors to the busy-stop cursor, show
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   529
     a shadow, and raise the box."
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   530
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   531
    |mainGroup mainView useTransient|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   532
81
4ba554473294 *** empty log message ***
claus
parents: 72
diff changeset
   533
    useTransient := UseTransientViews.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   534
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   535
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   536
     show a stop-cursor in the current group
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   537
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   538
    mainGroup := WindowGroup activeGroup.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   539
    mainGroup notNil ifTrue:[
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   540
	mainGroup := mainGroup mainGroup.
421
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   541
"/        mainGroup notNil ifTrue:[
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   542
"/            mainGroup showCursor:(Cursor stop).
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   543
"/        ]
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   544
    ].
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   545
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   546
    mainGroup isNil ifTrue:[
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   547
	useTransient := false
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   548
    ].
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   549
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   550
    useTransient ifTrue:[
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   551
	mainGroup topViews notNil ifTrue:[
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   552
	    mainView := mainGroup topViews first.
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   553
	].
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   554
	mainView isNil ifTrue:[
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   555
	    useTransient := false.
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   556
	]
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   557
    ].
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   558
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   559
    useTransient ifTrue:[
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   560
	shadowView := nil.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   561
    ] ifFalse:[
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   562
	shadowView notNil ifTrue:[shadowView realize].
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   563
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   564
    self raise.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   565
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   566
    useTransient ifTrue:[
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   567
	device setTransient:drawableId for:(mainView id).
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   568
    ].
129
752fbb07635a *** empty log message ***
claus
parents: 125
diff changeset
   569
421
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   570
"/    [
393
3504a0adbb2d use hideRequest to close via Escape key (allows redefinition);
Claus Gittinger <cg@exept.de>
parents: 371
diff changeset
   571
	super openModal:aBlock inGroup:mainGroup.
421
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   572
"/    ] valueNowOrOnUnwindDo:[
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   573
"/        "
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   574
"/         restore cursors in the main group
138
claus
parents: 134
diff changeset
   575
"/        "
421
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   576
"/        mainGroup notNil ifTrue:[
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   577
"/            mainGroup restoreCursors.
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   578
"/            mainGroup sensor flushUserEvents.
7f437da61df1 cursor restoring and event-flushing done in supers openModal
Claus Gittinger <cg@exept.de>
parents: 393
diff changeset
   579
"/        ]
138
claus
parents: 134
diff changeset
   580
"/    ].
300
6a63af1fec3e passing group to avoid multiple activeGroup searches
Claus Gittinger <cg@exept.de>
parents: 296
diff changeset
   581
6a63af1fec3e passing group to avoid multiple activeGroup searches
Claus Gittinger <cg@exept.de>
parents: 296
diff changeset
   582
    "Created: 10.12.1995 / 14:07:01 / cg"
6a63af1fec3e passing group to avoid multiple activeGroup searches
Claus Gittinger <cg@exept.de>
parents: 296
diff changeset
   583
    "Modified: 10.12.1995 / 14:08:41 / cg"
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   584
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   585
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   586
positionOffset
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   587
    "return the delta, by which the box should be
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   588
     displaced from the mouse pointer. 
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   589
     Usually redefined in subclasses to have the most convenient
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   590
     ok-button appear under the pointer."
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   591
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   592
    ^ (width // 2) @ (height // 2)
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   593
!
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   594
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   595
show
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   596
    "make myself visible (at the last or default position) and take control.
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   597
     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
   598
     it fully visible."
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   599
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   600
    self fixSize.
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   601
    self makeFullyVisible.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   602
    self openModal
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   603
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   604
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   605
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   606
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   607
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   608
     b show.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   609
    "
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   610
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   611
    "Modified: 7.3.1996 / 17:57:49 / cg"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   612
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   613
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   614
showAt:aPoint
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   615
    "make myself visible at aPoint.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   616
     Fix position to make box fully visible"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   617
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   618
    self fixSize.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   619
    self fixPosition:aPoint.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   620
    self openModal
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   621
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   622
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   623
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   624
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   625
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   626
     b showAt:(0 @ 0).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   627
     b showAt:(400 @ 400).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   628
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   629
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   630
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   631
showAt:aPoint center:center
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   632
    "make myself visible at aPoint. center specifies
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   633
     if the view should show up centered around aPoint."
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   634
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   635
    self showAt:aPoint centerX:center centerY:center
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   636
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   637
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   638
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   639
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   640
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   641
     b showAt:(100 @ 100) center:true.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   642
     b showAt:(100 @ 100) center:false.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   643
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   644
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   645
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   646
showAt:aPoint centerX:centerX centerY:centerY
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   647
    "make myself visible at aPoint. centerX/centerY specify
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   648
     if the view should show up centered around aPoint.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   649
     Fix position to make box fully visible"
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   650
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   651
    |dx dy|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   652
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   653
    self fixSize.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   654
    centerX ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   655
	dx := self width // 2.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   656
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   657
	dx := 0
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   658
    ].
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   659
    centerY ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   660
	dy := self height // 2.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   661
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   662
	dy := 0
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   663
    ].
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   664
    self origin:(aPoint - (dx @ dy)).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   665
    self makeFullyVisible.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   666
    self openModal
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   667
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   668
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   669
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   670
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   671
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   672
     b showAt:(100 @ 100).
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   673
     b showAt:(100 @ 100) centerX:true centerY:false.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   674
    "
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   675
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   676
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   677
showAtCenter
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   678
    "make myself visible at the screen center."
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   679
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   680
    self showAt:(device center) center:true
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   681
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   682
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   683
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   684
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   685
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   686
     b showAtCenter.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   687
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   688
!
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   689
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   690
showAtPointer
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   691
    "make myself visible at mouse pointer shifted to have
66
398cf6bfb241 *** empty log message ***
claus
parents: 59
diff changeset
   692
     convenient button under cursor. self positionOffset should
398cf6bfb241 *** empty log message ***
claus
parents: 59
diff changeset
   693
     return that offset (usually redefined, since we dont know here,
398cf6bfb241 *** empty log message ***
claus
parents: 59
diff changeset
   694
     which button should be under cursor)."
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   695
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   696
    self fixSize.
66
398cf6bfb241 *** empty log message ***
claus
parents: 59
diff changeset
   697
    self fixPosition:(device pointerPosition - self positionOffset).
398cf6bfb241 *** empty log message ***
claus
parents: 59
diff changeset
   698
    self openModal
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   699
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   700
    "/ cannot use:
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   701
    "/    self showAt:(device pointerPosition - self positionOffset).
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   702
    "/ because the resizing must be done before the
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   703
    "/ positionOffset is grabbed (it may change due to the resize)
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   704
72
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   705
    "
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   706
     |b|
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   707
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   708
     b := InfoBox title:'hello'.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   709
     b showAtPointer.
3e84121988c3 *** empty log message ***
claus
parents: 66
diff changeset
   710
    "
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   711
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   712
    "Modified: 7.3.1996 / 17:56:53 / cg"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   713
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   714
48194c26a46c Initial revision
claus
parents:
diff changeset
   715
showAtPointerNotCovering:aView
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   716
    "make myself visible at mouse pointer shifted to have
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   717
     convenient button under cursor.
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   718
     Fix position to make the box fully visible AND to make sure that
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   719
     aView is not covered."
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   720
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   721
    |pos newX|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   722
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   723
    pos := device pointerPosition - self positionOffset.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   724
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   725
    ((Rectangle origin:pos extent:self extent) 
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   726
        intersects: (aView origin corner: aView corner)) 
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   727
    ifTrue:[
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   728
        "
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   729
         try to the right of the untouchable view
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   730
        "
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   731
        newX := (aView origin x + aView width).
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   732
        newX + width > device width ifTrue:[
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   733
            newX := device width - width
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   734
        ].
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   735
        pos x:newX.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   736
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   737
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   738
        ((Rectangle origin:pos extent:self extent) 
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   739
            intersects: (aView origin corner: aView corner)) 
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   740
        ifTrue:[
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   741
            "
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   742
             try to the left of the untouchable view
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   743
            "
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   744
            newX := aView origin x - width.
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   745
            "
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   746
             should look for vertical possibilities too ...
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   747
            "
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   748
            pos x:newX.
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   749
        ]
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   750
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   751
    ].
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   752
    self showAt:pos
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   753
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   754
    "Modified: 7.3.1996 / 17:58:10 / cg"
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   755
!
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   756
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   757
showCenteredIn:aView
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   758
    "make myself visible at the center if aView."
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   759
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   760
    |top|
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   761
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   762
    top := aView topView.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   763
    top raise.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   764
    self showAt:(top center + (aView originRelativeTo:top)) center:true
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   765
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   766
    "
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   767
     |b|
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   768
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   769
     b := InfoBox title:'hello'.
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   770
     b showCenteredIn:Transcript.
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   771
    "
514
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   772
122e61a00a9d commentary
Claus Gittinger <cg@exept.de>
parents: 421
diff changeset
   773
    "Modified: 7.3.1996 / 17:58:53 / cg"
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   774
! !
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   775
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   776
!ModalBox class methodsFor:'documentation'!
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   777
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   778
version
616
56cf67c82664 documentation
Claus Gittinger <cg@exept.de>
parents: 596
diff changeset
   779
    ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.40 1996-04-25 17:16:06 cg Exp $'
270
f80e2a67de1e oops - checkin failed
Claus Gittinger <cg@exept.de>
parents: 269
diff changeset
   780
! !
296
655507429feb checkin from browser
Claus Gittinger <cg@exept.de>
parents: 270
diff changeset
   781
ModalBox initialize!