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