--- a/DRootView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/DRootView.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,10 +11,10 @@
"
PseudoView subclass:#DisplayRootView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!DisplayRootView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.13 1995-11-11 15:49:02 cg Exp $'
-!
-
documentation
"
this class describes Xs rootWindow (which is the background window and
@@ -94,39 +90,18 @@
^ super on:aDisplay
! !
-!DisplayRootView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- width := device width.
- height := device height.
- drawableId := device rootWindowFor:self.
- realized := true.
-!
-
-reinitialize
- "reinit after snapin"
-
- width := device width.
- height := device height.
- drawableId := device rootWindowFor:self.
- realized := true.
- gcId := nil.
-! !
-
!DisplayRootView methodsFor:'accessing'!
-name
- ^ 'RootWindow'
-!
-
controller
"I have no controller"
^ nil
!
+name
+ ^ 'RootWindow'
+!
+
sensor
"I have no sensor"
@@ -148,6 +123,27 @@
^ self
! !
+!DisplayRootView methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ width := device width.
+ height := device height.
+ drawableId := device rootWindowFor:self.
+ realized := true.
+!
+
+reinitialize
+ "reinit after snapin"
+
+ width := device width.
+ height := device height.
+ drawableId := device rootWindowFor:self.
+ realized := true.
+ gcId := nil.
+! !
+
!DisplayRootView methodsFor:'queries'!
canDrop:anObjectOrCollection
@@ -156,7 +152,7 @@
redefined in views which can take objects"
^ false
-!
+!
isWindowManagerRunning
"answer true, if a window manager is currently running.
@@ -180,3 +176,10 @@
RootView isWindowManagerRunning
"
! !
+
+!DisplayRootView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.14 1995-11-27 22:27:35 cg Exp $'
+! !
+DisplayRootView initialize!
--- a/DisplayRootView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/DisplayRootView.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,10 +11,10 @@
"
PseudoView subclass:#DisplayRootView
- instanceVariableNames:''
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!DisplayRootView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.13 1995-11-11 15:49:02 cg Exp $'
-!
-
documentation
"
this class describes Xs rootWindow (which is the background window and
@@ -94,39 +90,18 @@
^ super on:aDisplay
! !
-!DisplayRootView methodsFor:'initialization'!
-
-initialize
- super initialize.
-
- width := device width.
- height := device height.
- drawableId := device rootWindowFor:self.
- realized := true.
-!
-
-reinitialize
- "reinit after snapin"
-
- width := device width.
- height := device height.
- drawableId := device rootWindowFor:self.
- realized := true.
- gcId := nil.
-! !
-
!DisplayRootView methodsFor:'accessing'!
-name
- ^ 'RootWindow'
-!
-
controller
"I have no controller"
^ nil
!
+name
+ ^ 'RootWindow'
+!
+
sensor
"I have no sensor"
@@ -148,6 +123,27 @@
^ self
! !
+!DisplayRootView methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ width := device width.
+ height := device height.
+ drawableId := device rootWindowFor:self.
+ realized := true.
+!
+
+reinitialize
+ "reinit after snapin"
+
+ width := device width.
+ height := device height.
+ drawableId := device rootWindowFor:self.
+ realized := true.
+ gcId := nil.
+! !
+
!DisplayRootView methodsFor:'queries'!
canDrop:anObjectOrCollection
@@ -156,7 +152,7 @@
redefined in views which can take objects"
^ false
-!
+!
isWindowManagerRunning
"answer true, if a window manager is currently running.
@@ -180,3 +176,10 @@
RootView isWindowManagerRunning
"
! !
+
+!DisplayRootView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.14 1995-11-27 22:27:35 cg Exp $'
+! !
+DisplayRootView initialize!
--- a/ModalBox.st Sat Nov 25 14:06:08 1995 +0100
+++ b/ModalBox.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,10 +11,10 @@
"
StandardSystemView subclass:#ModalBox
- instanceVariableNames:'shadowView exclusiveKeyboard '
- classVariableNames:'UseTransientViews'
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'shadowView exclusiveKeyboard'
+ classVariableNames:'UseTransientViews'
+ poolDictionaries:''
+ category:'Views-Basic'
!
!ModalBox class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/ModalBox.st,v 1.29 1995-11-11 15:51:40 cg Exp $'
-!
-
documentation
"
this class implements modal boxes; ModalBoxes are different from
@@ -82,8 +78,138 @@
"
! !
+!ModalBox methodsFor:'accessing'!
+
+exclusiveKeyboard:aBoolean
+ "set/clear exclusive locking of the keyboard;
+ If set, the box will take total control over the
+ keyboard, not allowing input to other views/boxes
+ while active.
+ Danger: only use this for very very urgent boxes, since
+ no interaction with any view on the screen is possible then."
+
+ exclusiveKeyboard := aBoolean
+! !
+
+!ModalBox methodsFor:'event handling'!
+
+coveredBy:aView
+ "the receiver has been covered by another view.
+ If the other view is a non-modal one, raise"
+
+ |mainGroup topViews|
+
+ "
+ if the other view is not a modal- (or shadow-, or popup-) -view,
+ bring myself to the front again.
+ "
+ aView isPopUpView ifFalse:[
+ "
+ if I have a mainGroup,
+ only raise if its one of my maingroup-views
+ "
+ windowGroup notNil ifTrue:[
+ mainGroup := windowGroup mainGroup.
+ mainGroup notNil ifTrue:[
+ topViews := mainGroup topViews.
+ topViews notNil ifTrue:[
+ topViews do:[:aTopView |
+ aView == aTopView ifTrue:[
+ self raise.
+ ^ self
+ ]
+ ]
+ ].
+ ^ self
+ ]
+ ].
+ self raise
+ ]
+!
+
+pointerEnter:state x:x y:y
+ "mhmh: this seems to be a special X kludge;
+ without the following, we will not regain input focus after
+ pointer is reentered."
+
+ self getKeyboardFocus.
+ super pointerEnter:state x:x y:y
+!
+
+terminate
+ "this is the close from a windowmanager
+ (only if UseTransientViews == true)"
+
+ "
+ if I am a dialog, make the receiver invisible and leave control.
+ But, do not destroy the underlying view resources, to allow for
+ another open/show to occur later.
+ if I have been opened modeLess, perform the normal destroy operation.
+ "
+ (windowGroup isNil or:[windowGroup isModal]) ifTrue:[
+ self hide
+ ] ifFalse:[
+ super terminate
+ ]
+!
+
+visibilityChange:how
+ "raise when covered - this should not be needed, since we
+ have been created as override-redirect window (which should
+ stay on top - but some window managers (fvwm) seem to ignore
+ this ..."
+
+ "the code below is not good, since it will lead to
+ oscillating raises when two modalBoxes are going to cover
+ each other - see coveredBy:-handling ..."
+
+"/ how ~~ #fullyVisible ifTrue:[
+"/ self raise
+"/ ]
+! !
+
!ModalBox methodsFor:'initialize / release'!
+addToCurrentProject
+ "ignored here"
+
+ ^ self
+!
+
+create
+ super create.
+ shadowView notNil ifTrue:[
+ self saveUnder:true
+ ]
+!
+
+destroy
+ shadowView notNil ifTrue:[
+ shadowView destroy.
+ shadowView := nil
+ ].
+ self leaveControl. "just to make sure"
+ super destroy.
+!
+
+initEvents
+ super initEvents.
+ self enableEvent:#visibilityChange
+!
+
+initStyle
+ |style|
+
+ super initStyle.
+ style := styleSheet name.
+ ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
+ borderWidth := 0.
+ UseTransientViews ifFalse:[
+ self level:2
+ ]
+ ]
+!
+
initialize
|form resizeButton moveButton|
@@ -149,22 +275,8 @@
!
-initEvents
- super initEvents.
- self enableEvent:#visibilityChange
-!
-
-initStyle
- |style|
-
- super initStyle.
- style := styleSheet name.
- ((style ~~ #normal) and:[style ~~ #mswindows]) ifTrue:[
- borderWidth := 0.
- UseTransientViews ifFalse:[
- self level:2
- ]
- ]
+isPopUpView
+ ^ UseTransientViews not
!
reinitialize
@@ -172,32 +284,6 @@
self unrealize.
!
-addToCurrentProject
- "ignored here"
-
- ^ self
-!
-
-destroy
- shadowView notNil ifTrue:[
- shadowView destroy.
- shadowView := nil
- ].
- self leaveControl. "just to make sure"
- super destroy.
-!
-
-create
- super create.
- shadowView notNil ifTrue:[
- self saveUnder:true
- ]
-!
-
-isPopUpView
- ^ UseTransientViews not
-!
-
resize
"resize myself to make everything visible"
@@ -252,6 +338,48 @@
"Modified: 6.9.1995 / 15:31:21 / claus"
! !
+!ModalBox methodsFor:'move & resize'!
+
+doMove
+ "the move button was pressed"
+
+ |r|
+
+ r := device rectangleFromUser:(self origin corner:self corner).
+ shadowView notNil ifTrue:[
+ shadowView unrealize
+ ].
+ self origin:r origin extent:(r extent max:(100@100)).
+ shadowView notNil ifTrue:[
+ shadowView realize.
+ self raise
+ ].
+!
+
+doResize
+ "the resize button was pressed"
+
+ |r|
+
+ r := device rectangleFromUser:(self origin corner:self corner).
+ shadowView notNil ifTrue:[
+ shadowView unrealize
+ ].
+ self origin:r origin extent:(r extent max:(100@100)).
+ shadowView notNil ifTrue:[
+ shadowView realize.
+ self raise
+ ].
+! !
+
+!ModalBox methodsFor:'private'!
+
+leaveControl
+ exclusiveKeyboard ifTrue:[
+ device ungrabKeyboard
+ ]
+! !
+
!ModalBox methodsFor:'queries'!
preferredExtent
@@ -262,20 +390,76 @@
^ self class defaultExtent
! !
-!ModalBox methodsFor:'accessing'!
+!ModalBox methodsFor:'show / hide'!
+
+autoHideAfter:seconds with:anAction
+ "install a background process, which hides the box
+ after some time. Also, if non-nil, anAction will be
+ evaluated then. The action will not be evaluated if
+ the box is closed by the user pressing a button."
+
+ "the implementation is simple: just fork of a process
+ to hide me."
+ [
+ (Delay forSeconds:seconds) wait.
+ self shown ifTrue:[
+ self hide.
+ anAction notNil ifTrue:[anAction value]
+ ]
+ ] forkAt:4.
+
+ "
+ |b|
+
+ b := InfoBox title:'hello there'.
+ b autoHideAfter:5 with:[].
+ b showAtCenter.
+ "
+!
+
+fixPosition:aPoint
+ "set origin to aPoint, but make sure, that the box is fully visible
+ by shifting it into the visible screen area if nescessary.
+ This prevents invisible modalBoxes (which you could never close)."
-exclusiveKeyboard:aBoolean
- "set/clear exclusive locking of the keyboard;
- If set, the box will take total control over the
- keyboard, not allowing input to other views/boxes
- while active.
- Danger: only use this for very very urgent boxes, since
- no interaction with any view on the screen is possible then."
+ self origin:aPoint.
+ self makeFullyVisible
+!
+
+fixSize
+ "this is sent right before the modalBox is made visible;
+ If the size is not fixed, adjust my size."
+
+ sizeFixed == true ifFalse:[
+ self resize.
+ ].
+ super fixSize.
+!
+
+hide
+ "make the receiver invisible and leave control"
+
+ |p|
- exclusiveKeyboard := aBoolean
-! !
+ shadowView notNil ifTrue:[shadowView unrealize].
+ windowGroup notNil ifTrue:[windowGroup focusView:nil].
+ self leaveControl.
+ self unrealize.
+ device flush.
-!ModalBox methodsFor:'show / hide'!
+ (windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
+ "
+ this is a kludge for IRIS which does not provide backingstore:
+ when we hide a modalbox (such as a searchbox) which covered
+ a scrollbar, the scrollbars bitblt-method will copy from the
+ not-yet redrawn area - effectively clearing the scroller.
+ We need a short delay here, since at this time, the expose event has
+ not yet arrived.
+ "
+ (Delay forSeconds:0.1) wait.
+ p processExposeEvents
+ ].
+!
mapped
"wait till visible for grabbing"
@@ -303,34 +487,6 @@
"/ ]
!
-fixPosition:aPoint
- "set origin to aPoint, but make sure, that the box is fully visible
- by shifting it into the visible screen area if nescessary.
- This prevents invisible modalBoxes (which you could never close)."
-
- self origin:aPoint.
- self makeFullyVisible
-!
-
-fixSize
- "this is sent right before the modalBox is made visible;
- If the size is not fixed, adjust my size."
-
- sizeFixed == true ifFalse:[
- self resize.
- ].
- super fixSize.
-!
-
-positionOffset
- "return the delta, by which the box should be
- displaced from the mouse pointer.
- Usually redefined in subclasses to have the most convenient
- ok-button appear under the pointer."
-
- ^ (width // 2) @ (height // 2)
-!
-
open
"default for modalboxes is to come up modal at the pointer position"
@@ -403,6 +559,15 @@
"/ ].
!
+positionOffset
+ "return the delta, by which the box should be
+ displaced from the mouse pointer.
+ Usually redefined in subclasses to have the most convenient
+ ok-button appear under the pointer."
+
+ ^ (width // 2) @ (height // 2)
+!
+
show
"make myself visible (at the last or default position) and take control"
@@ -494,23 +659,6 @@
"
!
-showCenteredIn:aView
- "make myself visible at the screen center."
-
- |top|
-
- top := aView topView.
- top raise.
- self showAt:(top center + (aView originRelativeTo:top)) center:true
-
- "
- |b|
-
- b := InfoBox title:'hello'.
- b showCenteredIn:Transcript.
- "
-!
-
showAtPointer
"make myself visible at mouse pointer shifted to have
convenient button under cursor. self positionOffset should
@@ -556,184 +704,4 @@
intersects: (aView origin corner: aView corner))
ifTrue:[
"
- try to the left of the untouchable view
- "
- newX := aView origin x - width.
- "
- should look for vertical possibilities too ...
- "
- pos x:newX.
- ]
-
- ].
- self showAt:pos
-!
-
-hide
- "make the receiver invisible and leave control"
-
- |p|
-
- shadowView notNil ifTrue:[shadowView unrealize].
- windowGroup notNil ifTrue:[windowGroup focusView:nil].
- self leaveControl.
- self unrealize.
- device flush.
-
- (windowGroup notNil and:[(p := windowGroup previousGroup) notNil]) ifTrue:[
- "
- this is a kludge for IRIS which does not provide backingstore:
- when we hide a modalbox (such as a searchbox) which covered
- a scrollbar, the scrollbars bitblt-method will copy from the
- not-yet redrawn area - effectively clearing the scroller.
- We need a short delay here, since at this time, the expose event has
- not yet arrived.
- "
- (Delay forSeconds:0.1) wait.
- p processExposeEvents
- ].
-!
-
-autoHideAfter:seconds with:anAction
- "install a background process, which hides the box
- after some time. Also, if non-nil, anAction will be
- evaluated then. The action will not be evaluated if
- the box is closed by the user pressing a button."
-
- "the implementation is simple: just fork of a process
- to hide me."
- [
- (Delay forSeconds:seconds) wait.
- self shown ifTrue:[
- self hide.
- anAction notNil ifTrue:[anAction value]
- ]
- ] forkAt:4.
-
- "
- |b|
-
- b := InfoBox title:'hello there'.
- b autoHideAfter:5 with:[].
- b showAtCenter.
- "
-! !
-
-!ModalBox methodsFor:'move & resize'!
-
-doMove
- "the move button was pressed"
-
- |r|
-
- r := device rectangleFromUser:(self origin corner:self corner).
- shadowView notNil ifTrue:[
- shadowView unrealize
- ].
- self origin:r origin extent:(r extent max:(100@100)).
- shadowView notNil ifTrue:[
- shadowView realize.
- self raise
- ].
-!
-
-doResize
- "the resize button was pressed"
-
- |r|
-
- r := device rectangleFromUser:(self origin corner:self corner).
- shadowView notNil ifTrue:[
- shadowView unrealize
- ].
- self origin:r origin extent:(r extent max:(100@100)).
- shadowView notNil ifTrue:[
- shadowView realize.
- self raise
- ].
-! !
-
-!ModalBox methodsFor:'event handling'!
-
-terminate
- "this is the close from a windowmanager
- (only if UseTransientViews == true)"
-
- "
- if I am a dialog, make the receiver invisible and leave control.
- But, do not destroy the underlying view resources, to allow for
- another open/show to occur later.
- if I have been opened modeLess, perform the normal destroy operation.
- "
- (windowGroup isNil or:[windowGroup isModal]) ifTrue:[
- self hide
- ] ifFalse:[
- super terminate
- ]
-!
-
-visibilityChange:how
- "raise when covered - this should not be needed, since we
- have been created as override-redirect window (which should
- stay on top - but some window managers (fvwm) seem to ignore
- this ..."
-
- "the code below is not good, since it will lead to
- oscillating raises when two modalBoxes are going to cover
- each other - see coveredBy:-handling ..."
-
-"/ how ~~ #fullyVisible ifTrue:[
-"/ self raise
-"/ ]
-!
-
-coveredBy:aView
- "the receiver has been covered by another view.
- If the other view is a non-modal one, raise"
-
- |mainGroup topViews|
-
- "
- if the other view is not a modal- (or shadow-, or popup-) -view,
- bring myself to the front again.
- "
- aView isPopUpView ifFalse:[
- "
- if I have a mainGroup,
- only raise if its one of my maingroup-views
- "
- windowGroup notNil ifTrue:[
- mainGroup := windowGroup mainGroup.
- mainGroup notNil ifTrue:[
- topViews := mainGroup topViews.
- topViews notNil ifTrue:[
- topViews do:[:aTopView |
- aView == aTopView ifTrue:[
- self raise.
- ^ self
- ]
- ]
- ].
- ^ self
- ]
- ].
- self raise
- ]
-!
-
-pointerEnter:state x:x y:y
- "mhmh: this seems to be a special X kludge;
- without the following, we will not regain input focus after
- pointer is reentered."
-
- self getKeyboardFocus.
- super pointerEnter:state x:x y:y
-! !
-
-!ModalBox methodsFor:'private'!
-
-leaveControl
- exclusiveKeyboard ifTrue:[
- device ungrabKeyboard
- ]
-! !
+ try to t
\ No newline at end of file
--- a/PopUpView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/PopUpView.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,11 +11,10 @@
"
TopView subclass:#PopUpView
- instanceVariableNames:'shadowView haveControl exclusivePointer'
- classVariableNames:'DefaultShadow DefaultLevel DefaultBorderWidth
- DefaultBorderColor'
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'shadowView haveControl exclusivePointer'
+ classVariableNames:'DefaultShadow DefaultLevel DefaultBorderWidth DefaultBorderColor'
+ poolDictionaries:''
+ category:'Views-Basic'
!
!PopUpView class methodsFor:'documentation'!
@@ -34,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.18 1995-11-11 15:51:44 cg Exp $'
-!
-
documentation
"
this class implements an abstract superclass for all views which bypass the
@@ -59,15 +54,10 @@
^ (Display width // 3) @ (Display height // 3)
!
-updateStyleCache
- ShadowView isNil ifTrue:[
- DefaultShadow := false
- ] ifFalse:[
- DefaultShadow := StyleSheet at:'popupShadow' default:false.
- ].
- DefaultLevel := StyleSheet at:'popupLevel'.
- DefaultBorderWidth := StyleSheet at:'popupBorderWidth'.
- DefaultBorderColor := StyleSheet colorAt:'popupBorderColor'.
+shadows
+ "return the shadows-flag. False means: turned off."
+
+ ^ DefaultShadow
!
shadows:aBoolean
@@ -79,19 +69,108 @@
DefaultShadow := aBoolean
!
-shadows
- "return the shadows-flag. False means: turned off."
+updateStyleCache
+ ShadowView isNil ifTrue:[
+ DefaultShadow := false
+ ] ifFalse:[
+ DefaultShadow := StyleSheet at:'popupShadow' default:false.
+ ].
+ DefaultLevel := StyleSheet at:'popupLevel'.
+ DefaultBorderWidth := StyleSheet at:'popupBorderWidth'.
+ DefaultBorderColor := StyleSheet colorAt:'popupBorderColor'.
+! !
+
+!PopUpView methodsFor:'accessing'!
+
+exclusivePointer:aBoolean
+ exclusivePointer := aBoolean
+!
+
+noShadow
+ "turn off the shadow"
+
+ shadowView := nil
+! !
+
+!PopUpView methodsFor:'activation'!
+
+hide
+ "hide the view, leave its modal event loop"
+
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self.
+ windowGroup := nil.
+ ].
+ self unrealize.
+!
+
+show
+ "realize the view at its last position"
+
+ self fixSize.
+ self openModal:[true] "realize "
+!
- ^ DefaultShadow
+showAt:aPoint
+ "realize the view at aPoint"
+
+ self showAt:aPoint resizing:true
+!
+
+showAt:aPoint resizing:aBoolean
+ "realize the view at aPoint"
+
+ aBoolean ifTrue:[
+ self fixSize.
+ ].
+ self origin:aPoint.
+ self makeFullyVisible.
+ self openModal:[true] "realize "
+!
+
+showAtPointer
+ "realize the view at the current pointer position"
+
+ self showAt:(device pointerPosition) resizing:true
+!
+
+showCenteredIn:aView
+ "make myself visible at the screen center."
+
+ |top|
+
+ top := aView topView.
+ top raise.
+ self showAt:(top origin
+ + (aView originRelativeTo:top)
+ + (aView extent // 2)
+ - (self extent // 2))
+! !
+
+!PopUpView methodsFor:'dispatching'!
+
+modalLoop
+ haveControl := true.
+
+ "this is a kludge - we do not have multiple processes, therefore
+ we start another dispatch loop, which exits when control is lost"
+
+ device dispatchFor:nil while:[haveControl]
! !
!PopUpView methodsFor:'initialize / release'!
-initialize
- super initialize.
- exclusivePointer := true.
+create
+ super create.
+ shadowView isNil ifTrue:[
+ self saveUnder:true
+ ]
+!
+
+destroy
haveControl := false.
- type := #popup
+ super destroy.
+ shadowView notNil ifTrue:[shadowView destroy. shadowView := nil]
!
initStyle
@@ -123,17 +202,11 @@
].
!
-destroy
+initialize
+ super initialize.
+ exclusivePointer := true.
haveControl := false.
- super destroy.
- shadowView notNil ifTrue:[shadowView destroy. shadowView := nil]
-!
-
-create
- super create.
- shadowView isNil ifTrue:[
- self saveUnder:true
- ]
+ type := #popup
!
releasePointer
@@ -142,18 +215,15 @@
].
! !
-!PopUpView methodsFor:'dispatching'!
-
-modalLoop
- haveControl := true.
+!PopUpView methodsFor:'private'!
- "this is a kludge - we do not have multiple processes, therefore
- we start another dispatch loop, which exits when control is lost"
+leaveControl
+ haveControl := false
+!
- device dispatchFor:nil while:[haveControl]
-! !
-
-!PopUpView methodsFor:'private'!
+regainControl
+ device grabPointerInView:self
+!
takeControl
^ self.
@@ -163,69 +233,12 @@
we start another dispatch loop, which exits when control is lost"
device dispatchFor:drawableId while:[haveControl]
-!
-
-leaveControl
- haveControl := false
-!
-
-regainControl
- device grabPointerInView:self
! !
-!PopUpView methodsFor:'activation'!
-
-show
- "realize the view at its last position"
-
- self fixSize.
- self openModal:[true] "realize "
-!
-
-showAt:aPoint resizing:aBoolean
- "realize the view at aPoint"
-
- aBoolean ifTrue:[
- self fixSize.
- ].
- self origin:aPoint.
- self makeFullyVisible.
- self openModal:[true] "realize "
-!
-
-showAt:aPoint
- "realize the view at aPoint"
-
- self showAt:aPoint resizing:true
-!
+!PopUpView methodsFor:'queries'!
-showCenteredIn:aView
- "make myself visible at the screen center."
-
- |top|
-
- top := aView topView.
- top raise.
- self showAt:(top origin
- + (aView originRelativeTo:top)
- + (aView extent // 2)
- - (self extent // 2))
-!
-
-showAtPointer
- "realize the view at the current pointer position"
-
- self showAt:(device pointerPosition) resizing:true
-!
-
-hide
- "hide the view, leave its modal event loop"
-
- windowGroup notNil ifTrue:[
- windowGroup removeView:self.
- windowGroup := nil.
- ].
- self unrealize.
+isPopUpView
+ ^ true
! !
!PopUpView methodsFor:'realize / unrealize'!
@@ -262,6 +275,10 @@
super realize.
!
+restarted
+ ^ self
+!
+
unrealize
haveControl := false.
device activePointerGrab == self ifTrue:[
@@ -269,26 +286,10 @@
].
super unrealize.
shadowView notNil ifTrue:[shadowView unrealize].
-!
-
-restarted
- ^ self
! !
-!PopUpView methodsFor:'accessing'!
-
-noShadow
- "turn off the shadow"
-
- shadowView := nil
-!
+!PopUpView class methodsFor:'documentation'!
-exclusivePointer:aBoolean
- exclusivePointer := aBoolean
+version
+ ^ '$Header: /cvs/stx/stx/libview/PopUpView.st,v 1.19 1995-11-27 22:29:20 cg Exp $'
! !
-
-!PopUpView methodsFor:'queries'!
-
-isPopUpView
- ^ true
-! !
--- a/PseudoV.st Sat Nov 25 14:06:08 1995 +0100
+++ b/PseudoV.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,15 +11,11 @@
"
DeviceDrawable subclass:#PseudoView
- instanceVariableNames:'viewBackground
- cursor eventMask
- middleButtonMenu
- keyCommands
- gotExpose exposePending
- backed saveUnder delegate'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'viewBackground cursor eventMask middleButtonMenu keyCommands
+ gotExpose exposePending backed saveUnder delegate'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!PseudoView class methodsFor:'documentation'!
@@ -38,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.43 1995-11-24 16:39:36 cg Exp $'
-!
-
documentation
"
this abstract class describes stuff common to any Window on a display
@@ -80,121 +72,8 @@
"
! !
-!PseudoView methodsFor:'initialize / release'!
-
-initialize
- "initialize defaults"
-
- super initialize.
-
- eventMask := Display defaultEventMask.
- viewBackground := background.
- backed := false.
- saveUnder := false.
- exposePending := false.
- self initCursor
-!
-
-initStyle
- "nothing done here"
-
- ^ self
-!
-
-initCursor
- "default cursor for all views"
-
- cursor := Cursor arrow
-!
-
-reinitStyle
- "nothing done here"
-
- ^ self
-!
-
-recreate
- "recreate (i.e. tell X about me) after a snapin"
-
- viewBackground isColor ifTrue:[
- viewBackground := viewBackground on:device
- ].
- super recreate.
- cursor := cursor on:device.
- exposePending := false
-!
-
-destroy
- "view is about to be destroyed -
- first destroy menu if there is one and also destroy the GC.
- then the view is physically destroyed."
-
- middleButtonMenu notNil ifTrue:[
- middleButtonMenu destroy.
- middleButtonMenu := nil
- ].
- keyCommands := nil.
- gcId notNil ifTrue:[
- device destroyGC:gcId.
- gcId := nil
- ].
- drawableId notNil ifTrue:[
- device destroyView:self withId:drawableId.
- drawableId := nil
- ].
- Lobby unregister:self.
-!
-
-destroyed
- "view has been destroyed by someone else"
-
- drawableId notNil ifTrue:[
- device removeKnownView:self.
- drawableId := nil.
- realized := false.
- ].
- self destroy
-!
-
-reAdjustGeometry
- "sent late during snapin processing, nothing done here"
-
- ^ self
-!
-
-disposed
- "view was collected - release system resources"
-
- drawableId notNil ifTrue:[
- gcId notNil ifTrue:[
- device destroyGC:gcId.
- gcId := nil.
- ].
- device destroyView:self withId:drawableId.
- drawableId := nil.
- ].
-! !
-
!PseudoView methodsFor:'accessing'!
-widget
- "ST-80 compatibility"
-
- ^ self
-!
-
-viewOrigin
- "0@0 here, since by default we cannot be scrolled"
-
- ^ 0 @ 0
-!
-
-viewGravity
- "return the views gravity"
-
- ^ #NorthWest
-!
-
depth
"return the depth in pixels of the view.
Notice, that this is currently the devices depth,
@@ -204,24 +83,11 @@
^ device depth
!
-viewBackground
- "return the viewBackground"
-
- ^ viewBackground
-!
+insideColor:aColor
+ "set the views background color - ST-80 compatibility"
-viewBackground:something
- "set the viewBackground to something, a color, image or form.
- The viewBackground is the color or pattern with which exposed
- regions are filled - do not confuse this with the drawing background
- color, which is used with opaque drawing."
-
- viewBackground ~~ something ifTrue:[
- viewBackground := something.
- drawableId notNil ifTrue:[
- self setViewBackground
- ]
- ]
+ self viewBackground:aColor.
+ self background:aColor
!
setViewBackground
@@ -310,11 +176,42 @@
]
!
-insideColor:aColor
- "set the views background color - ST-80 compatibility"
+viewBackground
+ "return the viewBackground"
+
+ ^ viewBackground
+!
+
+viewBackground:something
+ "set the viewBackground to something, a color, image or form.
+ The viewBackground is the color or pattern with which exposed
+ regions are filled - do not confuse this with the drawing background
+ color, which is used with opaque drawing."
- self viewBackground:aColor.
- self background:aColor
+ viewBackground ~~ something ifTrue:[
+ viewBackground := something.
+ drawableId notNil ifTrue:[
+ self setViewBackground
+ ]
+ ]
+!
+
+viewGravity
+ "return the views gravity"
+
+ ^ #NorthWest
+!
+
+viewOrigin
+ "0@0 here, since by default we cannot be scrolled"
+
+ ^ 0 @ 0
+!
+
+widget
+ "ST-80 compatibility"
+
+ ^ self
! !
!PseudoView methodsFor:'accessing-cursor'!
@@ -384,18 +281,6 @@
!PseudoView methodsFor:'accessing-hierarchy'!
-superView
- "return the superView - nil here"
-
- ^ nil
-!
-
-topView
- "return the topView - that the one with no superview"
-
- ^ self
-!
-
delegate
"return the delegate - thats the one getting keyboard and button events"
@@ -408,19 +293,169 @@
See the sendEvent... method in WindowEvent."
delegate := someOne
+!
+
+superView
+ "return the superView - nil here"
+
+ ^ nil
+!
+
+topView
+ "return the topView - that the one with no superview"
+
+ ^ self
+! !
+
+!PseudoView methodsFor:'accessing-limits'!
+
+maxExtent
+ "return the views maximum extent - this is nil here.
+ Only standardSystemViews support this."
+
+ ^ nil
+!
+
+maxExtent:extent
+ "set the views maximum extent - ignored here.
+ Only standardSystemViews support this."
+
+ ^ self
+!
+
+minExtent
+ "return the views minimum extent - this is nil here.
+ Only standardSystemViews support this."
+
+ ^ nil
+!
+
+minExtent:extent
+ "set the views minimum extent - ignored here.
+ Only standardSystemViews support this."
+
+ ^ self
+! !
+
+!PseudoView methodsFor:'accessing-misc'!
+
+backingStore:how
+ "turn on/off backingStore (saving my pixels)
+ how may true/false, but also #always, #whenMapped or #never."
+
+ how ~~ backed ifTrue:[
+ backed := how.
+ drawableId notNil ifTrue:[
+ device setBackingStore:how in:drawableId
+ ]
+ ]
+!
+
+clipByChildren
+ "drawing shall be done into my view only (default)"
+
+ ^ self clippedByChildren:true
+!
+
+clippedByChildren:aBoolean
+ "turn on/off drawing over children.
+ If on, a superview may draw 'over' its children.
+ If off (the default), drawing is 'under' its children.
+ Only useful for the rootView, to draw over any visible views.
+ (for example, when dragging a rubber-line)"
+
+ gcId isNil ifTrue:[
+ self initGC
+ ].
+ device setClipByChildren:aBoolean in:gcId
+!
+
+eventMask
+ "return a (numeric) mask of allowed events -
+ this is X-specific and will be removed / replaced by symbolic values)"
+
+ ^ eventMask
+!
+
+eventMask:aMask
+ "set a (numeric) mask of allowed events -
+ this is X-specific and will be removed / replaced by symbolic values)"
+
+ eventMask := aMask
+!
+
+getKeyboardFocus
+ "tell the Display to assign keyboard focus to the receiver"
+
+ drawableId notNil ifTrue:[
+ self shown ifTrue:[
+ device setInputFocusTo:drawableId
+ ]
+ ].
+!
+
+inputOnly
+ "return true, if the receiver is an input only view - that is:
+ the view will realize as a transparent view, into which you cannot
+ draw, but get events as usual. Thich can be used to catch events away from
+ others, which where never meant to work in such a setup.
+ (for example, if you want to manipulate views in some DrawTool-like manner).
+ This uses a special X feature, which might not be supported in the near future
+ or on other plattforms."
+
+ ^ false
+!
+
+noClipByChildren
+ "drawing shall also be done into subviews"
+
+ ^ self clippedByChildren:false
+
+!
+
+preferredDepth
+ "return a non nil integer, if a specific depth is wanted in this view.
+ Return nil if we do not care (i.e. the displays default is wanted).
+ This is experimental and may change/vanish - do not use it."
+
+ ^ nil
+!
+
+preferredVisual
+ "return a non nil id, if a specific visual is wanted in this view.
+ Return nil if we do not care (i.e. the displays default is wanted).
+ This is experimental and may change/vanish - do not use it."
+
+ ^ nil
+!
+
+realized
+ "return true, if the receiver is realized"
+
+ ^ realized
+!
+
+saveUnder:aBoolean
+ "turn on/off saveUnder (saving pixels under myself)
+ - used for temporary views (i.e. PopUps and ModalBoxes)"
+
+ saveUnder := aBoolean.
+ drawableId notNil ifTrue:[
+ device setSaveUnder:aBoolean in:drawableId
+ ]
! !
!PseudoView methodsFor:'accessing-names'!
-label
- "return the views label - this is nil here.
+icon
+ "return the views icon - this is nil here.
Only standardSystemViews support labels and icons."
^ nil
!
-label:aLabel
- "set the views label - ignored here.
+icon:aBitmap
+ "set the views icon - ignored here.
Only standardSystemViews support labels and icons."
^ self
@@ -454,202 +489,86 @@
^ self
!
-icon
- "return the views icon - this is nil here.
+label
+ "return the views label - this is nil here.
Only standardSystemViews support labels and icons."
^ nil
!
-icon:aBitmap
- "set the views icon - ignored here.
+label:aLabel
+ "set the views label - ignored here.
Only standardSystemViews support labels and icons."
^ self
! !
-!PseudoView methodsFor:'queries-contents'!
+!PseudoView methodsFor:'binary storage'!
-heightOfContents
- "return the height of the contents in pixels.
- Since we dont know here, just return the views size.
- This will make your scrollbars show 100%-visible.
- Must be redefined in subviews to make scrollbars really work."
+readBinaryContentsFrom: stream manager: manager
+ "tell the newly restored View to recreate itself.
+ Bug: does not work correctly yet.
+ (restored view looses its position & wg process)"
- ^ self height
-!
+ super readBinaryContentsFrom: stream manager: manager.
-widthOfContents
- "return the width of the contents in pixels.
- Since we dont know here, just return the views size.
- This will make your scrollbars show 100%-visible.
- Must be redefined in subviews to make scrollbars really work."
+ gcId := nil.
+ drawableId := nil.
+ self recreate.
+ realized ifTrue:[
+ self rerealize
+ ]
- ^ self width
-!
-
-yOriginOfContents
- "return the y-origin of the contents in pixels.
- Since we dont know here, just return 0 for top.
- Must be redefined in subviews to make scrollbars really work."
+ "
+ |s|
+ s := 'storedLabel.boss' asFilename writeStream binary.
+ (Label label:'hello there') realize storeBinaryOn:s.
+ s close.
+ "
- ^ 0
-!
+ "
+ |s l|
+ s := 'storedLabel.boss' asFilename writeStream binary.
+ (l := Label label:'hello there') open.
+ (Delay forSeconds:10) wait.
+ l storeBinaryOn:s.
+ s close.
+ l destroy.
+ "
-xOriginOfContents
- "return the x-origin of the contents in pixels.
- Since we dont know here, just return 0 for left.
- Must be redefined in subviews to make scrollbars really work."
-
- ^ 0
+ "
+ |s|
+ s := 'storedLabel.boss' asFilename readStream binary.
+ (Object readBinaryFrom:s)
+ "
! !
-!PseudoView methodsFor:'accessing-limits'!
-
-minExtent:extent
- "set the views minimum extent - ignored here.
- Only standardSystemViews support this."
-
- ^ self
-!
-
-minExtent
- "return the views minimum extent - this is nil here.
- Only standardSystemViews support this."
-
- ^ nil
-!
-
-maxExtent:extent
- "set the views maximum extent - ignored here.
- Only standardSystemViews support this."
-
- ^ self
-!
+!PseudoView methodsFor:'button menus'!
-maxExtent
- "return the views maximum extent - this is nil here.
- Only standardSystemViews support this."
-
- ^ nil
-! !
-
-!PseudoView methodsFor:'accessing-misc'!
-
-realized
- "return true, if the receiver is realized"
+middleButtonMenu
+ "return the menu associated with the middle mouse button"
- ^ realized
-!
-
-inputOnly
- "return true, if the receiver is an input only view - that is:
- the view will realize as a transparent view, into which you cannot
- draw, but get events as usual. Thich can be used to catch events away from
- others, which where never meant to work in such a setup.
- (for example, if you want to manipulate views in some DrawTool-like manner).
- This uses a special X feature, which might not be supported in the near future
- or on other plattforms."
-
- ^ false
+ ^ middleButtonMenu
!
-getKeyboardFocus
- "tell the Display to assign keyboard focus to the receiver"
-
- drawableId notNil ifTrue:[
- self shown ifTrue:[
- device setInputFocusTo:drawableId
- ]
- ].
-!
-
-eventMask
- "return a (numeric) mask of allowed events -
- this is X-specific and will be removed / replaced by symbolic values)"
-
- ^ eventMask
-!
+middleButtonMenu:aMenu
+ "associate aMenu with the middle mouse button"
-eventMask:aMask
- "set a (numeric) mask of allowed events -
- this is X-specific and will be removed / replaced by symbolic values)"
-
- eventMask := aMask
-!
-
-clippedByChildren:aBoolean
- "turn on/off drawing over children.
- If on, a superview may draw 'over' its children.
- If off (the default), drawing is 'under' its children.
- Only useful for the rootView, to draw over any visible views.
- (for example, when dragging a rubber-line)"
-
- gcId isNil ifTrue:[
- self initGC
+ middleButtonMenu notNil ifTrue:[
+ middleButtonMenu destroy
].
- device setClipByChildren:aBoolean in:gcId
-!
-
-clipByChildren
- "drawing shall be done into my view only (default)"
-
- ^ self clippedByChildren:true
+ middleButtonMenu := aMenu
!
-noClipByChildren
- "drawing shall also be done into subviews"
-
- ^ self clippedByChildren:false
-
-!
-
-saveUnder:aBoolean
- "turn on/off saveUnder (saving pixels under myself)
- - used for temporary views (i.e. PopUps and ModalBoxes)"
-
- saveUnder := aBoolean.
- drawableId notNil ifTrue:[
- device setSaveUnder:aBoolean in:drawableId
- ]
-!
-
-backingStore:how
- "turn on/off backingStore (saving my pixels)
- how may true/false, but also #always, #whenMapped or #never."
+setMiddleButtonMenu:aMenu
+ "associate aMenu with the middle mouse button.
+ Do not destroy old menu if any"
- how ~~ backed ifTrue:[
- backed := how.
- drawableId notNil ifTrue:[
- device setBackingStore:how in:drawableId
- ]
- ]
-!
-
-preferredVisual
- "return a non nil id, if a specific visual is wanted in this view.
- Return nil if we do not care (i.e. the displays default is wanted).
- This is experimental and may change/vanish - do not use it."
-
- ^ nil
-!
-
-preferredDepth
- "return a non nil integer, if a specific depth is wanted in this view.
- Return nil if we do not care (i.e. the displays default is wanted).
- This is experimental and may change/vanish - do not use it."
-
- ^ nil
+ middleButtonMenu := aMenu
! !
!PseudoView methodsFor:'drawing'!
-redraw
- "nothing done here"
-
- ^ self
-!
-
clearDeviceRectangleX:x y:y width:w height:h
"clear a rectangular area to viewBackground -
redefined since DisplayMedium fills with background
@@ -695,51 +614,120 @@
].
self fillRectangleX:x y:y width:w height:h.
self paint:oldPaint
-! !
-
-!PseudoView methodsFor:'keyboard commands'!
-
-addActionForKey:aKey action:aBlock
- "define a keyboard command function"
-
- keyCommands isNil ifTrue:[
- keyCommands := IdentityDictionary new
- ].
- keyCommands at:aKey put:aBlock
!
-removeActionForKey:aKey
- keyCommands notNil ifTrue:[
- keyCommands removeKey:aKey ifAbsent:[]
- ]
-! !
-
-!PseudoView methodsFor:'button menus'!
-
-middleButtonMenu
- "return the menu associated with the middle mouse button"
-
- ^ middleButtonMenu
-!
+redraw
+ "nothing done here"
-middleButtonMenu:aMenu
- "associate aMenu with the middle mouse button"
-
- middleButtonMenu notNil ifTrue:[
- middleButtonMenu destroy
- ].
- middleButtonMenu := aMenu
-!
-
-setMiddleButtonMenu:aMenu
- "associate aMenu with the middle mouse button.
- Do not destroy old menu if any"
-
- middleButtonMenu := aMenu
+ ^ self
! !
!PseudoView methodsFor:'enable/disable events'!
+compressMotionEvents:aBoolean
+ "enable/disable motion event compression
+ (i.e. replacing all motion events by the last one).
+ Compression makes almost always sense, except when
+ doing things like freehand drawing"
+
+ |s|
+
+ (s := self sensor) notNil ifTrue:[
+ s compressMotionEvents:aBoolean
+ ]
+!
+
+disableButtonEvents
+ "disable all button events"
+
+ self disableEvent:#buttonpress.
+ self disableEvent:#buttonRelease
+!
+
+disableButtonMotionEvents
+ "disable button motion-while-button-is-pressed events"
+
+ self disableEvent:#buttonMotion
+!
+
+disableButtonPressEvents
+ "disable button press events"
+
+ self disableEvent:#buttonPress
+!
+
+disableButtonReleaseEvents
+ "disable button release events"
+
+ self disableEvent:#buttonRelease
+!
+
+disableEnterLeaveEvents
+ "disable both mouse-pointer enter and leave events"
+
+ self disableEvent:#enter.
+ self disableEvent:#leave
+!
+
+disableEvent:anEventSymbol
+ "disable an event -
+ this is a private (internal) method not to be used externally.
+ for a list of allowed event symbols see Workstation class"
+
+ eventMask := eventMask bitAnd:(device eventMaskFor:anEventSymbol) bitInvert.
+ drawableId notNil ifTrue:[
+ device setEventMask:eventMask in:drawableId
+ ]
+!
+
+disableMotionEvents
+ "disable motion events"
+
+ self disableEvent:#pointerMotion
+!
+
+enableButtonEvents
+ "enable both mouse button press and release events.
+ These are enabled by default anyway."
+
+ self enableEvent:#buttonPress.
+ self enableEvent:#buttonRelease
+!
+
+enableButtonMotionEvents
+ "enable mouse-pointer motion-while-button-is-pressed events.
+ These are enabled by default anyway."
+
+ self enableEvent:#buttonMotion
+!
+
+enableButtonPressEvents
+ "enable mouse button press events.
+ These are enabled by default anyway."
+
+ self enableEvent:#buttonPress
+!
+
+enableButtonReleaseEvents
+ "enable mouse button release events.
+ These are enabled by default anyway."
+
+ self enableEvent:#buttonRelease
+!
+
+enableEnterEvents
+ "enable mouse-pointer enter events"
+
+ self enableEvent:#enter
+!
+
+enableEnterLeaveEvents
+ "enable both mouse-pointer enter and leave events"
+
+ self enableEvent:#enter.
+ self enableEvent:#leave
+!
+
enableEvent:anEventSymbol
"enable an event -
this is a private (internal) method not to be used externally.
@@ -751,15 +739,10 @@
]
!
-disableEvent:anEventSymbol
- "disable an event -
- this is a private (internal) method not to be used externally.
- for a list of allowed event symbols see Workstation class"
-
- eventMask := eventMask bitAnd:(device eventMaskFor:anEventSymbol) bitInvert.
- drawableId notNil ifTrue:[
- device setEventMask:eventMask in:drawableId
- ]
+enableFocusEvents
+ "enable keyboard focus change events"
+
+ self enableEvent:#focusChange
!
enableKeyEvents
@@ -782,339 +765,55 @@
self enableEvent:#keyRelease
!
-enableButtonPressEvents
- "enable mouse button press events.
- These are enabled by default anyway."
-
- self enableEvent:#buttonPress
-!
-
-enableButtonReleaseEvents
- "enable mouse button release events.
- These are enabled by default anyway."
-
- self enableEvent:#buttonRelease
-!
-
-enableButtonEvents
- "enable both mouse button press and release events.
- These are enabled by default anyway."
-
- self enableEvent:#buttonPress.
- self enableEvent:#buttonRelease
-!
-
-enableEnterEvents
- "enable mouse-pointer enter events"
-
- self enableEvent:#enter
-!
-
enableLeaveEvents
"enable mouse-pointer leave events"
self enableEvent:#leave
!
-enableEnterLeaveEvents
- "enable both mouse-pointer enter and leave events"
-
- self enableEvent:#enter.
- self enableEvent:#leave
-!
-
enableMotionEvents
"enable mouse-pointer motion events"
self enableEvent:#pointerMotion
+! !
+
+!PseudoView methodsFor:'event handling'!
+
+buttonMotion:state x:x y:y
+ "mouse was moved while button is pressed - do nothing here"
+
+ ^ self
!
-compressMotionEvents:aBoolean
- "enable/disable motion event compression
- (i.e. replacing all motion events by the last one).
- Compression makes almost always sense, except when
- doing things like freehand drawing"
+buttonMultiPress:button x:x y:y
+ "button was pressed fast after previous press - default to press-again"
+
+ ^ self buttonPress:button x:x y:y
+!
- |s|
+buttonPress:button x:x y:y
+ "button was pressed - if its middle button and there is a menu,
+ show it."
- (s := self sensor) notNil ifTrue:[
- s compressMotionEvents:aBoolean
+ ((button == 2) or:[button == #menu]) ifTrue:[
+ middleButtonMenu notNil ifTrue:[
+ middleButtonMenu showAtPointer
+ ]
]
!
-enableButtonMotionEvents
- "enable mouse-pointer motion-while-button-is-pressed events.
- These are enabled by default anyway."
-
- self enableEvent:#buttonMotion
-!
-
-enableFocusEvents
- "enable keyboard focus change events"
-
- self enableEvent:#focusChange
-!
-
-disableButtonPressEvents
- "disable button press events"
-
- self disableEvent:#buttonPress
-!
-
-disableButtonReleaseEvents
- "disable button release events"
-
- self disableEvent:#buttonRelease
-!
-
-disableButtonEvents
- "disable all button events"
-
- self disableEvent:#buttonpress.
- self disableEvent:#buttonRelease
-!
-
-disableMotionEvents
- "disable motion events"
-
- self disableEvent:#pointerMotion
-!
-
-disableButtonMotionEvents
- "disable button motion-while-button-is-pressed events"
-
- self disableEvent:#buttonMotion
-!
-
-disableEnterLeaveEvents
- "disable both mouse-pointer enter and leave events"
-
- self disableEvent:#enter.
- self disableEvent:#leave
-! !
-
-!PseudoView methodsFor:'queries'!
-
-isView
- "return true, if the receiver is a view"
-
- ^ true
-!
-
-isXtWidget
- ^ false
-!
-
-exposeEventPending
- "return true, if an expose event is pending."
+buttonRelease:button x:x y:y
+ "button was released - do nothing here"
- |sensor|
-
- ((sensor := self sensor) notNil and:[sensor hasDamageFor:self]) ifTrue:[^ true].
- ^ device eventPending:#expose for:drawableId
-!
-
-buttonMotionEventPending
- "return true, if a button motion event is pending.
- Normally, you dont want to use this, since no polling is needed
- (not even for mouse-tracking).
- Dont use it, since it does not honor the windowGroup, but
- goes directly to the device instead.
- Actually, its a historical leftover"
-
- device flush.
- ^ device eventPending:#buttonMotion for:drawableId
-!
-
-buttonReleaseEventPending
- "return true, if a button release event is pending.
- Dont use it, since it does not honor the windowGroup, but
- goes directly to the device instead.
- Actually, its a historical leftover"
-
- device flush.
- ^ device eventPending:#buttonRelease for:drawableId
-! !
-
-!PseudoView methodsFor:'selection handling '!
-
-selectionClear:selectionID
- "someone else has the selection"
-
- "
- workaround a bug in olvwm: it clears selections
- on window raise. In this case, keep my last own selection
- "
- Smalltalk at:#LastCopyBuffer put:(Smalltalk at:#CopyBuffer).
- Smalltalk at:#CopyBuffer put:nil.
-!
-
-getSelection
- "return the object selection - either the local one, or the displays
- selection buffer."
-
- |sel|
-
- sel := Smalltalk at:#CopyBuffer.
- sel isNil ifTrue:[
- sel := device getSelectionFor:drawableId.
- sel isNil ifTrue:[^ nil].
- ].
- ^ sel
-!
-
-getTextSelection
- "return the text selection - either the local one, or the displays
- selection buffer."
-
- |sel|
-
- sel := Smalltalk at:#CopyBuffer.
- sel isNil ifTrue:[
- sel := device getTextSelectionFor:drawableId.
- sel isNil ifTrue:[^ nil].
- ].
- ^ sel
+ ^ self
!
-setTextSelection:something
- "set the text selection - both the local one, and tell the display
- that we have changed it."
-
- |s|
-
- Smalltalk at:#LastCopyBuffer put:nil.
- Smalltalk at:#CopyBuffer put:something.
- s := something.
- s isString ifFalse:[
- s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
- ].
- (device setTextSelection:s owner:drawableId) ifFalse:[
- 'PSEUDOVIEW: selection failed' errorPrintNL
- ]
-!
-
-setSelection:something
- "set the object selection - both the local one, and tell the display
- that we have changed it."
-
- Smalltalk at:#LastCopyBuffer put:nil.
- Smalltalk at:#CopyBuffer put:something.
- (device setSelection:something owner:drawableId) ifFalse:[
- 'PSEUDOVIEW: selection failed' errorPrintNL
- ]
-!
-
-selectionAsString
- "our current selection as a string"
-
- |o s|
-
- o := Smalltalk at:#CopyBuffer.
- s := o.
- o isString ifFalse:[
- o isNil ifTrue:[
- s := ''
- ] ifFalse:[
- (o isKindOf:StringCollection) ifTrue:[
- s := o asStringWithCRsFrom:1 to:(o size) compressTabs:false withCR:false
- ] ifFalse:[
- s := o storeString
- ]
- ]
- ].
- ^ s
-!
-
-selectionRequest:propertyID target:targetID selection:selectionID from:windowID
- "someone asks for our selection"
-
- |o s stream|
+buttonShiftPress:button x:x y:y
+ "button was pressed with shift - default to unshift-press action"
- "
- the code below has been hacked in a hurry -
- it MUST go into the XWorkstation class,
- since PseudoV should stay independend of any particular
- implementation (i.e. indep. of the display device)
- Expect this stuff to vanish in the next version ...
- "
- targetID == (device atomIDOfLENGTH) ifTrue:[
- "the other one wants to know the size of our selection ..."
- s := self selectionAsString.
- device
- setLengthProperty:propertyID
- value:s size
- for:windowID.
- device
- sendSelectionNotifySelection:selectionID
- property:propertyID
- target:targetID
- from:drawableId
- to:windowID.
- ^ self
- ].
- (targetID == device atomIDOfSTRING or:[
- targetID == (device atomIDOf:'COMPOUND_TEXT')]) ifTrue:[
- s := self selectionAsString.
- device
- sendSelection:s
- property:propertyID
- target:targetID
- from:drawableId
- to:windowID.
- ^ self
- ].
-
- o := Smalltalk at:#CopyBuffer.
- stream := WriteStream on:(ByteArray new:200).
- o storeBinaryOn:stream.
- device
- sendSelection:(stream contents)
- property:propertyID
- target:(device atomIDOf:'ST_OBJECT' create:true)
- from:drawableId
- to:windowID
+ ^ self buttonPress:button x:x y:y
!
-selectionNotify:propertyID target:targetID selection:selectionID from:windowID
- "this is sent from the display as a reply to a request for a
- selection. The view should be prepared to paste the received
- string (it asked for it so that should not be a problem)"
-
- |s|
-
- "workaround a bug in olvwm:
- it looses selection when bringing a view
- up front
- "
- propertyID == 0 ifTrue:[
- "invalid olvwm behavior"
- s := Smalltalk at:#LastCopyBuffer
- ] ifFalse:[
- targetID == (device atomIDOfSTRING) ifTrue:[
- "
- a returned string
- "
- s := device getTextProperty:propertyID from:windowID.
- s notNil ifTrue:[
- (s endsWith:Character cr) ifTrue:[
- s := s asStringCollection copyWith:''
- ]
- ]
- ] ifFalse:[
- "
- a returned object
- "
- s := device getObjectProperty:propertyID from:windowID.
- ].
- ].
- s notNil ifTrue:[
- self paste:s
- ]
-! !
-
-!PseudoView methodsFor:'event handling'!
-
catchExpose
"this MUST be sent BEFORE doing a bit-blt copy (i.e. copyFrom...),
to tell the sensor that incoming expose events are to be remembered.
@@ -1139,83 +838,11 @@
]
!
-waitForExpose
- "wait until an expose event arrives (to wait for scroll-finish)"
-
- |wg|
-
- wg := self windowGroup.
- wg notNil ifTrue:[
- "
- a normal (suspendable) view.
- wait by doing a real wait
- "
- wg waitForExposeFor:self
- ] ifFalse:[
- "
- a pure event driven view.
- wait by doing a direct dispatch loop until the event arrives.
- "
- [gotExpose] whileFalse:[
- device dispatchExposeEventFor:drawableId
- ].
- ]
-!
-
-noExpose
- "a no expose event after a scroll (event-mode only)"
-
- exposePending := false.
- gotExpose := true
-!
-
-deviceGraphicExposeX:x y:y width:w height:h
+deviceButtonMotion:state x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
- and send a graphicExpose with the logical coordinates."
-
- |lx ly lw lh|
-
- lx := x.
- ly := y.
- lw := w.
- lh := h.
- transformation notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
- lw := transformation applyInverseScaleX:lw.
- lh := transformation applyInverseScaleY:lh.
- ].
- self graphicExposeX:lx y:ly width:lw height:lh
-!
-
-deviceExposeX:x y:y width:w height:h
- "this is the low-level (untransformed) event as received
- from the device (i.e. coordinates are in device coordinates).
- If there is a transformation, apply the inverse
- and send an expose with the logical coordinates."
-
- |lx ly lw lh|
-
- lx := x.
- ly := y.
- lw := w.
- lh := h.
- transformation notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
- lw := transformation applyInverseScaleX:lw.
- lh := transformation applyInverseScaleY:lh.
- ].
- self exposeX:lx y:ly width:lw height:lh
-!
-
-deviceKeyPress:key x:x y:y
- "this is the low-level (untransformed) event as received
- from the device (i.e. coordinates are in device coordinates).
- If there is a transformation, apply the inverse
- and send a keyPress with the logical coordinates."
+ and send a buttonMotion with the logical coordinates."
|lx ly|
@@ -1225,14 +852,14 @@
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
- self keyPress:key x:lx y:ly
+ self buttonMotion:state x:lx y:ly
!
-deviceKeyRelease:key x:x y:y
+deviceButtonMultiPress:butt x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
- and send a keyRelease with the logical coordinates."
+ and send a buttonMultiPress with the logical coordinates."
|lx ly|
@@ -1242,7 +869,7 @@
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
- self keyRelease:key x:lx y:ly
+ self buttonMultiPress:butt x:lx y:ly
!
deviceButtonPress:butt x:x y:y
@@ -1296,11 +923,53 @@
self buttonShiftPress:butt x:lx y:ly
!
-deviceButtonMultiPress:butt x:x y:y
+deviceExposeX:x y:y width:w height:h
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
- and send a buttonMultiPress with the logical coordinates."
+ and send an expose with the logical coordinates."
+
+ |lx ly lw lh|
+
+ lx := x.
+ ly := y.
+ lw := w.
+ lh := h.
+ transformation notNil ifTrue:[
+ lx := transformation applyInverseToX:lx.
+ ly := transformation applyInverseToY:ly.
+ lw := transformation applyInverseScaleX:lw.
+ lh := transformation applyInverseScaleY:lh.
+ ].
+ self exposeX:lx y:ly width:lw height:lh
+!
+
+deviceGraphicExposeX:x y:y width:w height:h
+ "this is the low-level (untransformed) event as received
+ from the device (i.e. coordinates are in device coordinates).
+ If there is a transformation, apply the inverse
+ and send a graphicExpose with the logical coordinates."
+
+ |lx ly lw lh|
+
+ lx := x.
+ ly := y.
+ lw := w.
+ lh := h.
+ transformation notNil ifTrue:[
+ lx := transformation applyInverseToX:lx.
+ ly := transformation applyInverseToY:ly.
+ lw := transformation applyInverseScaleX:lw.
+ lh := transformation applyInverseScaleY:lh.
+ ].
+ self graphicExposeX:lx y:ly width:lw height:lh
+!
+
+deviceKeyPress:key x:x y:y
+ "this is the low-level (untransformed) event as received
+ from the device (i.e. coordinates are in device coordinates).
+ If there is a transformation, apply the inverse
+ and send a keyPress with the logical coordinates."
|lx ly|
@@ -1310,14 +979,14 @@
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
- self buttonMultiPress:butt x:lx y:ly
+ self keyPress:key x:lx y:ly
!
-deviceButtonMotion:state x:x y:y
+deviceKeyRelease:key x:x y:y
"this is the low-level (untransformed) event as received
from the device (i.e. coordinates are in device coordinates).
If there is a transformation, apply the inverse
- and send a buttonMotion with the logical coordinates."
+ and send a keyRelease with the logical coordinates."
|lx ly|
@@ -1327,7 +996,7 @@
lx := transformation applyInverseToX:lx.
ly := transformation applyInverseToY:ly.
].
- self buttonMotion:state x:lx y:ly
+ self keyRelease:key x:lx y:ly
!
devicePointerEnter:state x:x y:y
@@ -1347,18 +1016,30 @@
self pointerEnter:state x:lx y:ly
!
+exposeX:x y:y width:w height:h
+ "an expose event - nothing done here"
+
+ ^ self
+!
+
+focusIn
+ "got keayboard focus - do nothing here"
+
+ ^ self
+!
+
+focusOut
+ "lost keayboard focus - do nothing here"
+
+ ^ self
+!
+
graphicExposeX:x y:y width:w height:h
"an expose event after a scroll - do normal redraw processing"
self exposeX:x y:y width:w height:h
!
-exposeX:x y:y width:w height:h
- "an expose event - nothing done here"
-
- ^ self
-!
-
keyPress:key x:x y:y
"a key was pressed in this view.
Here only keyCommands are handled - more action has to
@@ -1380,51 +1061,11 @@
^ self
!
-buttonShiftPress:button x:x y:y
- "button was pressed with shift - default to unshift-press action"
-
- ^ self buttonPress:button x:x y:y
-!
-
-buttonPress:button x:x y:y
- "button was pressed - if its middle button and there is a menu,
- show it."
-
- ((button == 2) or:[button == #menu]) ifTrue:[
- middleButtonMenu notNil ifTrue:[
- middleButtonMenu showAtPointer
- ]
- ]
-!
-
-buttonMultiPress:button x:x y:y
- "button was pressed fast after previous press - default to press-again"
-
- ^ self buttonPress:button x:x y:y
-!
+noExpose
+ "a no expose event after a scroll (event-mode only)"
-buttonRelease:button x:x y:y
- "button was released - do nothing here"
-
- ^ self
-!
-
-buttonMotion:state x:x y:y
- "mouse was moved while button is pressed - do nothing here"
-
- ^ self
-!
-
-focusIn
- "got keayboard focus - do nothing here"
-
- ^ self
-!
-
-focusOut
- "lost keayboard focus - do nothing here"
-
- ^ self
+ exposePending := false.
+ gotExpose := true
!
pointerEnter:state x:x y:y
@@ -1441,44 +1082,401 @@
resizeRequest
^ self
+!
+
+waitForExpose
+ "wait until an expose event arrives (to wait for scroll-finish)"
+
+ |wg|
+
+ wg := self windowGroup.
+ wg notNil ifTrue:[
+ "
+ a normal (suspendable) view.
+ wait by doing a real wait
+ "
+ wg waitForExposeFor:self
+ ] ifFalse:[
+ "
+ a pure event driven view.
+ wait by doing a direct dispatch loop until the event arrives.
+ "
+ [gotExpose] whileFalse:[
+ device dispatchExposeEventFor:drawableId
+ ].
+ ]
+! !
+
+!PseudoView methodsFor:'initialize / release'!
+
+destroy
+ "view is about to be destroyed -
+ first destroy menu if there is one and also destroy the GC.
+ then the view is physically destroyed."
+
+ middleButtonMenu notNil ifTrue:[
+ middleButtonMenu destroy.
+ middleButtonMenu := nil
+ ].
+ keyCommands := nil.
+ gcId notNil ifTrue:[
+ device destroyGC:gcId.
+ gcId := nil
+ ].
+ drawableId notNil ifTrue:[
+ device destroyView:self withId:drawableId.
+ drawableId := nil
+ ].
+ Lobby unregister:self.
+!
+
+destroyed
+ "view has been destroyed by someone else"
+
+ drawableId notNil ifTrue:[
+ device removeKnownView:self.
+ drawableId := nil.
+ realized := false.
+ ].
+ self destroy
+!
+
+disposed
+ "view was collected - release system resources"
+
+ drawableId notNil ifTrue:[
+ gcId notNil ifTrue:[
+ device destroyGC:gcId.
+ gcId := nil.
+ ].
+ device destroyView:self withId:drawableId.
+ drawableId := nil.
+ ].
+!
+
+initCursor
+ "default cursor for all views"
+
+ cursor := Cursor arrow
+!
+
+initStyle
+ "nothing done here"
+
+ ^ self
+!
+
+initialize
+ "initialize defaults"
+
+ super initialize.
+
+ eventMask := Display defaultEventMask.
+ viewBackground := background.
+ backed := false.
+ saveUnder := false.
+ exposePending := false.
+ self initCursor
+!
+
+reAdjustGeometry
+ "sent late during snapin processing, nothing done here"
+
+ ^ self
+!
+
+recreate
+ "recreate (i.e. tell X about me) after a snapin"
+
+ viewBackground isColor ifTrue:[
+ viewBackground := viewBackground on:device
+ ].
+ super recreate.
+ cursor := cursor on:device.
+ exposePending := false
+!
+
+reinitStyle
+ "nothing done here"
+
+ ^ self
! !
-!PseudoView methodsFor: 'binary storage'!
+!PseudoView methodsFor:'keyboard commands'!
+
+addActionForKey:aKey action:aBlock
+ "define a keyboard command function"
+
+ keyCommands isNil ifTrue:[
+ keyCommands := IdentityDictionary new
+ ].
+ keyCommands at:aKey put:aBlock
+!
+
+removeActionForKey:aKey
+ keyCommands notNil ifTrue:[
+ keyCommands removeKey:aKey ifAbsent:[]
+ ]
+! !
+
+!PseudoView methodsFor:'queries'!
+
+buttonMotionEventPending
+ "return true, if a button motion event is pending.
+ Normally, you dont want to use this, since no polling is needed
+ (not even for mouse-tracking).
+ Dont use it, since it does not honor the windowGroup, but
+ goes directly to the device instead.
+ Actually, its a historical leftover"
+
+ device flush.
+ ^ device eventPending:#buttonMotion for:drawableId
+!
-readBinaryContentsFrom: stream manager: manager
- "tell the newly restored View to recreate itself.
- Bug: does not work correctly yet.
- (restored view looses its position & wg process)"
+buttonReleaseEventPending
+ "return true, if a button release event is pending.
+ Dont use it, since it does not honor the windowGroup, but
+ goes directly to the device instead.
+ Actually, its a historical leftover"
+
+ device flush.
+ ^ device eventPending:#buttonRelease for:drawableId
+!
+
+exposeEventPending
+ "return true, if an expose event is pending."
+
+ |sensor|
+
+ ((sensor := self sensor) notNil and:[sensor hasDamageFor:self]) ifTrue:[^ true].
+ ^ device eventPending:#expose for:drawableId
+!
+
+isView
+ "return true, if the receiver is a view"
+
+ ^ true
+!
+
+isXtWidget
+ ^ false
+! !
+
+!PseudoView methodsFor:'queries-contents'!
+
+heightOfContents
+ "return the height of the contents in pixels.
+ Since we dont know here, just return the views size.
+ This will make your scrollbars show 100%-visible.
+ Must be redefined in subviews to make scrollbars really work."
+
+ ^ self height
+!
- super readBinaryContentsFrom: stream manager: manager.
+widthOfContents
+ "return the width of the contents in pixels.
+ Since we dont know here, just return the views size.
+ This will make your scrollbars show 100%-visible.
+ Must be redefined in subviews to make scrollbars really work."
+
+ ^ self width
+!
+
+xOriginOfContents
+ "return the x-origin of the contents in pixels.
+ Since we dont know here, just return 0 for left.
+ Must be redefined in subviews to make scrollbars really work."
+
+ ^ 0
+!
+
+yOriginOfContents
+ "return the y-origin of the contents in pixels.
+ Since we dont know here, just return 0 for top.
+ Must be redefined in subviews to make scrollbars really work."
+
+ ^ 0
+! !
+
+!PseudoView methodsFor:'selection handling '!
+
+getSelection
+ "return the object selection - either the local one, or the displays
+ selection buffer."
+
+ |sel|
- gcId := nil.
- drawableId := nil.
- self recreate.
- realized ifTrue:[
- self rerealize
- ]
+ sel := Smalltalk at:#CopyBuffer.
+ sel isNil ifTrue:[
+ sel := device getSelectionFor:drawableId.
+ sel isNil ifTrue:[^ nil].
+ ].
+ ^ sel
+!
+
+getTextSelection
+ "return the text selection - either the local one, or the displays
+ selection buffer."
+
+ |sel|
+
+ sel := Smalltalk at:#CopyBuffer.
+ sel isNil ifTrue:[
+ sel := device getTextSelectionFor:drawableId.
+ sel isNil ifTrue:[^ nil].
+ ].
+ ^ sel
+!
+
+selectionAsString
+ "our current selection as a string"
+
+ |o s|
+
+ o := Smalltalk at:#CopyBuffer.
+ s := o.
+ o isString ifFalse:[
+ o isNil ifTrue:[
+ s := ''
+ ] ifFalse:[
+ (o isKindOf:StringCollection) ifTrue:[
+ s := o asStringWithCRsFrom:1 to:(o size) compressTabs:false withCR:false
+ ] ifFalse:[
+ s := o storeString
+ ]
+ ]
+ ].
+ ^ s
+!
+
+selectionClear:selectionID
+ "someone else has the selection"
"
- |s|
- s := 'storedLabel.boss' asFilename writeStream binary.
- (Label label:'hello there') realize storeBinaryOn:s.
- s close.
+ workaround a bug in olvwm: it clears selections
+ on window raise. In this case, keep my last own selection
+ "
+ Smalltalk at:#LastCopyBuffer put:(Smalltalk at:#CopyBuffer).
+ Smalltalk at:#CopyBuffer put:nil.
+!
+
+selectionNotify:propertyID target:targetID selection:selectionID from:windowID
+ "this is sent from the display as a reply to a request for a
+ selection. The view should be prepared to paste the received
+ string (it asked for it so that should not be a problem)"
+
+ |s|
+
+ "workaround a bug in olvwm:
+ it looses selection when bringing a view
+ up front
"
+ propertyID == 0 ifTrue:[
+ "invalid olvwm behavior"
+ s := Smalltalk at:#LastCopyBuffer
+ ] ifFalse:[
+ targetID == (device atomIDOfSTRING) ifTrue:[
+ "
+ a returned string
+ "
+ s := device getTextProperty:propertyID from:windowID.
+ s notNil ifTrue:[
+ (s endsWith:Character cr) ifTrue:[
+ s := s asStringCollection copyWith:''
+ ]
+ ]
+ ] ifFalse:[
+ "
+ a returned object
+ "
+ s := device getObjectProperty:propertyID from:windowID.
+ ].
+ ].
+ s notNil ifTrue:[
+ self paste:s
+ ]
+!
+
+selectionRequest:propertyID target:targetID selection:selectionID from:windowID
+ "someone asks for our selection"
+
+ |o s stream|
"
- |s l|
- s := 'storedLabel.boss' asFilename writeStream binary.
- (l := Label label:'hello there') open.
- (Delay forSeconds:10) wait.
- l storeBinaryOn:s.
- s close.
- l destroy.
+ the code below has been hacked in a hurry -
+ it MUST go into the XWorkstation class,
+ since PseudoV should stay independend of any particular
+ implementation (i.e. indep. of the display device)
+ Expect this stuff to vanish in the next version ...
"
+ targetID == (device atomIDOfLENGTH) ifTrue:[
+ "the other one wants to know the size of our selection ..."
+ s := self selectionAsString.
+ device
+ setLengthProperty:propertyID
+ value:s size
+ for:windowID.
+ device
+ sendSelectionNotifySelection:selectionID
+ property:propertyID
+ target:targetID
+ from:drawableId
+ to:windowID.
+ ^ self
+ ].
+ (targetID == device atomIDOfSTRING or:[
+ targetID == (device atomIDOf:'COMPOUND_TEXT')]) ifTrue:[
+ s := self selectionAsString.
+ device
+ sendSelection:s
+ property:propertyID
+ target:targetID
+ from:drawableId
+ to:windowID.
+ ^ self
+ ].
- "
- |s|
- s := 'storedLabel.boss' asFilename readStream binary.
- (Object readBinaryFrom:s)
- "
+ o := Smalltalk at:#CopyBuffer.
+ stream := WriteStream on:(ByteArray new:200).
+ o storeBinaryOn:stream.
+ device
+ sendSelection:(stream contents)
+ property:propertyID
+ target:(device atomIDOf:'ST_OBJECT' create:true)
+ from:drawableId
+ to:windowID
+!
+
+setSelection:something
+ "set the object selection - both the local one, and tell the display
+ that we have changed it."
+
+ Smalltalk at:#LastCopyBuffer put:nil.
+ Smalltalk at:#CopyBuffer put:something.
+ (device setSelection:something owner:drawableId) ifFalse:[
+ 'PSEUDOVIEW: selection failed' errorPrintNL
+ ]
+!
+
+setTextSelection:something
+ "set the text selection - both the local one, and tell the display
+ that we have changed it."
+
+ |s|
+
+ Smalltalk at:#LastCopyBuffer put:nil.
+ Smalltalk at:#CopyBuffer put:something.
+ s := something.
+ s isString ifFalse:[
+ s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
+ ].
+ (device setTextSelection:s owner:drawableId) ifFalse:[
+ 'PSEUDOVIEW: selection failed' errorPrintNL
+ ]
! !
+
+!PseudoView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/PseudoV.st,v 1.44 1995-11-27 22:29:53 cg Exp $'
+! !
--- a/ShadowV.st Sat Nov 25 14:06:08 1995 +0100
+++ b/ShadowV.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,10 +11,10 @@
"
SimpleView subclass:#ShadowView
- instanceVariableNames:'myView shadowLength shadowClr imageUnderShadow'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'myView shadowLength shadowClr imageUnderShadow'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!ShadowView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/ShadowV.st,v 1.12 1995-11-11 15:51:59 cg Exp $'
-!
-
documentation
"
just to give PopUps and ModalBoxes a shadow.
@@ -49,8 +45,61 @@
"
! !
+!ShadowView methodsFor:'accessing'!
+
+for:aView
+ "set the view I am for"
+
+ myView := aView
+!
+
+isPopUpView
+ ^ true
+!
+
+shadowColor:aColor
+ "to set the shadow color"
+
+ shadowClr := aColor
+! !
+
+!ShadowView methodsFor:'event handling'!
+
+redraw
+ "fill all of myself with black"
+
+ |ws hs|
+
+ shadowClr isNil ifTrue:[
+ imageUnderShadow isNil ifTrue:[^ self].
+
+"
+ self foreground:(Color colorId:-1) background:(Color colorId:0).
+ self function:#copy.
+"
+ ws := shadowLength x.
+ hs := shadowLength y.
+ self copyFrom:imageUnderShadow x:(width - ws) y:0
+ toX:(width - ws) y:0
+ width:ws height:height.
+ self copyFrom:imageUnderShadow x:0 y:(height - hs)
+ toX:0 y:(height - hs)
+ width:width height:hs.
+
+ ] ifFalse:[
+ self paint:shadowClr.
+ self fillRectangleX:(width - ws) y:0 width:ws height:height
+ ]
+! !
+
!ShadowView methodsFor:'initialization'!
+create
+ super create.
+ self backingStore:false.
+ self saveUnder:true
+!
+
initialize
super initialize.
borderWidth := 0.
@@ -134,17 +183,6 @@
]
!
-unrealize
- imageUnderShadow := nil.
- super unrealize.
-!
-
-create
- super create.
- self backingStore:false.
- self saveUnder:true
-!
-
recreate
shadowClr notNil ifTrue:[
shadowClr := shadowClr on:device
@@ -156,51 +194,15 @@
super recreate.
self backingStore:false.
self saveUnder:true
+!
+
+unrealize
+ imageUnderShadow := nil.
+ super unrealize.
! !
-!ShadowView methodsFor:'event handling'!
-
-redraw
- "fill all of myself with black"
-
- |ws hs|
-
- shadowClr isNil ifTrue:[
- imageUnderShadow isNil ifTrue:[^ self].
-
-"
- self foreground:(Color colorId:-1) background:(Color colorId:0).
- self function:#copy.
-"
- ws := shadowLength x.
- hs := shadowLength y.
- self copyFrom:imageUnderShadow x:(width - ws) y:0
- toX:(width - ws) y:0
- width:ws height:height.
- self copyFrom:imageUnderShadow x:0 y:(height - hs)
- toX:0 y:(height - hs)
- width:width height:hs.
+!ShadowView class methodsFor:'documentation'!
- ] ifFalse:[
- self paint:shadowClr.
- self fillRectangleX:(width - ws) y:0 width:ws height:height
- ]
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/ShadowV.st,v 1.13 1995-11-27 22:30:33 cg Exp $'
! !
-
-!ShadowView methodsFor:'accessing'!
-
-shadowColor:aColor
- "to set the shadow color"
-
- shadowClr := aColor
-!
-
-for:aView
- "set the view I am for"
-
- myView := aView
-!
-
-isPopUpView
- ^ true
-! !
--- a/ShadowView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/ShadowView.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,10 +11,10 @@
"
SimpleView subclass:#ShadowView
- instanceVariableNames:'myView shadowLength shadowClr imageUnderShadow'
- classVariableNames:''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'myView shadowLength shadowClr imageUnderShadow'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!ShadowView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.12 1995-11-11 15:51:59 cg Exp $'
-!
-
documentation
"
just to give PopUps and ModalBoxes a shadow.
@@ -49,8 +45,61 @@
"
! !
+!ShadowView methodsFor:'accessing'!
+
+for:aView
+ "set the view I am for"
+
+ myView := aView
+!
+
+isPopUpView
+ ^ true
+!
+
+shadowColor:aColor
+ "to set the shadow color"
+
+ shadowClr := aColor
+! !
+
+!ShadowView methodsFor:'event handling'!
+
+redraw
+ "fill all of myself with black"
+
+ |ws hs|
+
+ shadowClr isNil ifTrue:[
+ imageUnderShadow isNil ifTrue:[^ self].
+
+"
+ self foreground:(Color colorId:-1) background:(Color colorId:0).
+ self function:#copy.
+"
+ ws := shadowLength x.
+ hs := shadowLength y.
+ self copyFrom:imageUnderShadow x:(width - ws) y:0
+ toX:(width - ws) y:0
+ width:ws height:height.
+ self copyFrom:imageUnderShadow x:0 y:(height - hs)
+ toX:0 y:(height - hs)
+ width:width height:hs.
+
+ ] ifFalse:[
+ self paint:shadowClr.
+ self fillRectangleX:(width - ws) y:0 width:ws height:height
+ ]
+! !
+
!ShadowView methodsFor:'initialization'!
+create
+ super create.
+ self backingStore:false.
+ self saveUnder:true
+!
+
initialize
super initialize.
borderWidth := 0.
@@ -134,17 +183,6 @@
]
!
-unrealize
- imageUnderShadow := nil.
- super unrealize.
-!
-
-create
- super create.
- self backingStore:false.
- self saveUnder:true
-!
-
recreate
shadowClr notNil ifTrue:[
shadowClr := shadowClr on:device
@@ -156,51 +194,15 @@
super recreate.
self backingStore:false.
self saveUnder:true
+!
+
+unrealize
+ imageUnderShadow := nil.
+ super unrealize.
! !
-!ShadowView methodsFor:'event handling'!
-
-redraw
- "fill all of myself with black"
-
- |ws hs|
-
- shadowClr isNil ifTrue:[
- imageUnderShadow isNil ifTrue:[^ self].
-
-"
- self foreground:(Color colorId:-1) background:(Color colorId:0).
- self function:#copy.
-"
- ws := shadowLength x.
- hs := shadowLength y.
- self copyFrom:imageUnderShadow x:(width - ws) y:0
- toX:(width - ws) y:0
- width:ws height:height.
- self copyFrom:imageUnderShadow x:0 y:(height - hs)
- toX:0 y:(height - hs)
- width:width height:hs.
+!ShadowView class methodsFor:'documentation'!
- ] ifFalse:[
- self paint:shadowClr.
- self fillRectangleX:(width - ws) y:0 width:ws height:height
- ]
+version
+ ^ '$Header: /cvs/stx/stx/libview/ShadowView.st,v 1.13 1995-11-27 22:30:33 cg Exp $'
! !
-
-!ShadowView methodsFor:'accessing'!
-
-shadowColor:aColor
- "to set the shadow color"
-
- shadowClr := aColor
-!
-
-for:aView
- "set the view I am for"
-
- myView := aView
-!
-
-isPopUpView
- ^ true
-! !
--- a/SimpleView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/SimpleView.st Mon Nov 27 23:31:52 1995 +0100
@@ -10,34 +10,33 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:08:03 pm'!
-
PseudoView subclass:#SimpleView
- instanceVariableNames:'superView subViews components
- styleSheet resources
- borderColor borderWidth borderShape viewShape
- top left
- extentChanged originChanged cornerChanged
-
- relativeOrigin relativeExtent relativeCorner
- originRule extentRule cornerRule
- insets viewport
-
- layout
- shown hiddenOnRealize name level margin innerClipRect
- shadowColor lightColor
- bitGravity viewGravity
- controller windowGroup'
+ instanceVariableNames:'superView subViews components styleSheet resources borderColor
+ borderWidth borderShape viewShape top left extentChanged
+ originChanged cornerChanged relativeOrigin relativeExtent
+ relativeCorner originRule extentRule cornerRule insets viewport
+ layout shown hiddenOnRealize name level margin innerClipRect
+ shadowColor lightColor bitGravity viewGravity controller
+ windowGroup'
classVariableNames:'Grey CentPoint ViewSpacing DefaultStyle StyleSheet
- DefaultViewBackgroundColor DefaultBorderColor DefaultLightColor
- DefaultShadowColor DefaultBorderWidth DefaultFont
- DefaultFocusColor DefaultFocusBorderWidth'
+ DefaultViewBackgroundColor DefaultBorderColor DefaultLightColor
+ DefaultShadowColor DefaultBorderWidth DefaultFont
+ DefaultFocusColor DefaultFocusBorderWidth'
poolDictionaries:''
category:'Views-Basic'
!
SimpleView class instanceVariableNames:'ClassResources'
+"
+ The following class instance variables are inherited by this class:
+
+ PseudoView -
+ DeviceDrawable -
+ DisplayMedium -
+ GraphicsContext -
+ Object -
+"
!
!SimpleView class methodsFor:'documentation'!
@@ -56,10 +55,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.30 1995-11-24 22:33:02 cg Exp $'
-!
-
documentation
"
this class implements functions common to all Views which do not work on / show a model.
@@ -153,42 +148,6 @@
"
!
-layoutComputation
-"
- Due to historic reasons, there are 2 mechanisms to resize a view:
- - (old, to be eliminated mechanism)
- based upon info found in
- relativeOrigin / relativeCorner / relativeExtent
- originRule / cornerRule / extentRule
-
- - (new, will migrate to that one)
- letting a layoutObject compute things
-
- Actually, the old mechanism is just as powerful, as the new (layoutObject
- based) mechanism; with the help of block=rules, you can compute whatever
- geometry is desired.
- However, having 6 instance variables in every view creates some overhead,
- which can be avoided in most cases (most views are either fixed-size or
- relative-sized).
- Therefore (and also to make porting of ST-80 apps easier), ST/X will migrate
- to use layoutObjects.
- You will not see a difference at the views protocol level, since
- existing interfaces will (silently) create layoutObjects as appropriate.
- However, you should remove all direct accesses to the above mentioned
- instance variables, to be prepared for that change.
-
- Notice, that a view recomputes its size whenever its superview
- changes size. This is done via:
- sizeChanged
- -> allSubviews: superViewChangedSize
-
- If the geometry computation as performed in superViewChangedSize
- is not powerful enough for your application, you can either:
- - redefine superViewChangedSize
- - create a special layoutObject which computes a new layout.
-"
-!
-
examples
"
(all examples below use different viewBackgrounds,
@@ -435,6 +394,42 @@
top open
"
+!
+
+layoutComputation
+"
+ Due to historic reasons, there are 2 mechanisms to resize a view:
+ - (old, to be eliminated mechanism)
+ based upon info found in
+ relativeOrigin / relativeCorner / relativeExtent
+ originRule / cornerRule / extentRule
+
+ - (new, will migrate to that one)
+ letting a layoutObject compute things
+
+ Actually, the old mechanism is just as powerful, as the new (layoutObject
+ based) mechanism; with the help of block=rules, you can compute whatever
+ geometry is desired.
+ However, having 6 instance variables in every view creates some overhead,
+ which can be avoided in most cases (most views are either fixed-size or
+ relative-sized).
+ Therefore (and also to make porting of ST-80 apps easier), ST/X will migrate
+ to use layoutObjects.
+ You will not see a difference at the views protocol level, since
+ existing interfaces will (silently) create layoutObjects as appropriate.
+ However, you should remove all direct accesses to the above mentioned
+ instance variables, to be prepared for that change.
+
+ Notice, that a view recomputes its size whenever its superview
+ changes size. This is done via:
+ sizeChanged
+ -> allSubviews: superViewChangedSize
+
+ If the geometry computation as performed in superViewChangedSize
+ is not powerful enough for your application, you can either:
+ - redefine superViewChangedSize
+ - create a special layoutObject which computes a new layout.
+"
! !
!SimpleView class methodsFor:'initialization'!
@@ -462,14 +457,25 @@
!SimpleView class methodsFor:'instance creation'!
-on:aModel
- "create a new drawable on aModel"
-
- "although this one does not know about models,
- it can still send the model-assign message. This was done
- to catch obsolete calls to on:aDevice.
- "
- ^ self new model:aModel.
+extent:extent
+ "create a new view with given extent"
+
+ ^ self origin:nil extent:extent borderWidth:nil
+ font:nil label:nil in:nil
+!
+
+extent:extent in:aView
+ "create a new view as a subview of aView with given extent"
+
+ ^ self origin:nil extent:extent borderWidth:nil
+ font:nil label:nil in:aView
+!
+
+extent:extent label:label
+ "create a new view with given extent and label"
+
+ ^ self origin:nil extent:extent borderWidth:nil
+ font:nil label:label in:nil
!
in:aView
@@ -501,30 +507,43 @@
font:nil label:label in:nil
!
-origin:origin corner:corner in:aView
- "create a new view as a subview of aView with given origin and extent"
+label:label in:aView
+ "create a new view as subview of aView with given label"
+
+ ^ self origin:nil extent:nil borderWidth:nil
+ font:nil label:label in:aView
+!
+
+on:aModel
+ "create a new drawable on aModel"
+
+ "although this one does not know about models,
+ it can still send the model-assign message. This was done
+ to catch obsolete calls to on:aDevice.
+ "
+ ^ self new model:aModel.
+!
+
+onSameDeviceAs:anotherView
+ "create a view on the same device as anotherView.
+ Used with popUpMenus, which should be created on the device of
+ its masterView."
+
+ |device|
+
+ anotherView notNil ifTrue:[
+ device := anotherView device.
+ ] ifFalse:[
+ device := Screen current "Display".
+ ].
+ ^ self onDevice:device
+!
+
+origin:origin corner:corner
+ "create a new view with given origin and extent"
^ self origin:origin corner:corner borderWidth:nil
- font:nil label:nil in:aView
-!
-
-origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
- |newView|
-
- aView notNil ifTrue:[
- newView := self basicNew.
- newView device:(aView device).
- aView addSubView:newView.
- newView initialize
- ] ifFalse:[
- newView := self onDevice:Screen current "Display"
- ].
- bw notNil ifTrue:[newView borderWidth:bw].
- anExtent notNil ifTrue:[newView extent:anExtent].
- anOrigin notNil ifTrue:[newView origin:anOrigin].
- aFont notNil ifTrue:[newView font:aFont].
- aLabel notNil ifTrue:[newView label:aLabel].
- ^ newView
+ font:nil label:nil in:nil
!
origin:anOrigin corner:aCorner borderWidth:bw font:aFont label:aLabel in:aView
@@ -546,33 +565,83 @@
^ newView
!
-label:label in:aView
- "create a new view as subview of aView with given label"
-
- ^ self origin:nil extent:nil borderWidth:nil
- font:nil label:label in:aView
-!
-
-onSameDeviceAs:anotherView
- "create a view on the same device as anotherView.
- Used with popUpMenus, which should be created on the device of
- its masterView."
-
- |device|
-
- anotherView notNil ifTrue:[
- device := anotherView device.
+origin:origin corner:corner borderWidth:bw in:aView
+ "create a new view as a subview of aView with given origin and extent"
+
+ ^ self origin:origin corner:corner borderWidth:bw
+ font:nil label:nil in:aView
+!
+
+origin:origin corner:corner in:aView
+ "create a new view as a subview of aView with given origin and extent"
+
+ ^ self origin:origin corner:corner borderWidth:nil
+ font:nil label:nil in:aView
+!
+
+origin:origin extent:extent
+ "create a new view with given origin and extent"
+
+ ^ self origin:origin extent:extent borderWidth:nil
+ font:nil label:nil in:nil
+!
+
+origin:origin extent:extent borderWidth:bw
+ "create a new view with given origin, extent and borderWidth"
+
+ ^ self origin:origin extent:extent borderWidth:bw
+ font:nil label:nil in:nil
+!
+
+origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
+ |newView|
+
+ aView notNil ifTrue:[
+ newView := self basicNew.
+ newView device:(aView device).
+ aView addSubView:newView.
+ newView initialize
] ifFalse:[
- device := Screen current "Display".
+ newView := self onDevice:Screen current "Display"
].
- ^ self onDevice:device
-!
-
-extent:extent in:aView
- "create a new view as a subview of aView with given extent"
-
- ^ self origin:nil extent:extent borderWidth:nil
- font:nil label:nil in:aView
+ bw notNil ifTrue:[newView borderWidth:bw].
+ anExtent notNil ifTrue:[newView extent:anExtent].
+ anOrigin notNil ifTrue:[newView origin:anOrigin].
+ aFont notNil ifTrue:[newView font:aFont].
+ aLabel notNil ifTrue:[newView label:aLabel].
+ ^ newView
+!
+
+origin:origin extent:extent borderWidth:bw in:aView
+ "create a new view as a subview of aView with given origin, extent
+ and borderWidth"
+
+ ^ self origin:origin extent:extent borderWidth:bw
+ font:nil label:nil in:aView
+!
+
+origin:origin extent:extent font:aFont label:label
+ ^ self origin:origin extent:extent borderWidth:nil
+ font:nil label:label in:nil
+!
+
+origin:origin extent:extent font:aFont label:label in:aView
+ ^ self origin:origin extent:extent borderWidth:nil
+ font:aFont label:label in:aView
+!
+
+origin:origin extent:extent in:aView
+ "create a new view as a subview of aView with given origin and extent"
+
+ ^ self origin:origin extent:extent borderWidth:nil
+ font:nil label:nil in:aView
+!
+
+origin:origin extent:extent label:label
+ "create a new view with given origin, extent and label"
+
+ ^ self origin:origin extent:extent borderWidth:nil
+ font:nil label:label in:nil
!
origin:anOrigin extent:anExtent
@@ -590,142 +659,20 @@
^ newView
!
-extent:extent
- "create a new view with given extent"
-
- ^ self origin:nil extent:extent borderWidth:nil
- font:nil label:nil in:nil
-!
-
-origin:origin extent:extent in:aView
- "create a new view as a subview of aView with given origin and extent"
-
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:nil in:aView
-!
-
origin:origin in:aView
"create a new view as a subview of aView with given origin"
^ self origin:origin extent:nil borderWidth:nil
font:nil label:nil in:aView
-!
-
-origin:origin extent:extent
- "create a new view with given origin and extent"
-
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:nil in:nil
-!
-
-origin:origin extent:extent borderWidth:bw in:aView
- "create a new view as a subview of aView with given origin, extent
- and borderWidth"
-
- ^ self origin:origin extent:extent borderWidth:bw
- font:nil label:nil in:aView
-!
-
-origin:origin extent:extent borderWidth:bw
- "create a new view with given origin, extent and borderWidth"
-
- ^ self origin:origin extent:extent borderWidth:bw
- font:nil label:nil in:nil
-!
-
-extent:extent label:label
- "create a new view with given extent and label"
-
- ^ self origin:nil extent:extent borderWidth:nil
- font:nil label:label in:nil
-!
-
-origin:origin corner:corner
- "create a new view with given origin and extent"
-
- ^ self origin:origin corner:corner borderWidth:nil
- font:nil label:nil in:nil
-!
-
-origin:origin extent:extent label:label
- "create a new view with given origin, extent and label"
-
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:label in:nil
-!
-
-origin:origin extent:extent font:aFont label:label
- ^ self origin:origin extent:extent borderWidth:nil
- font:nil label:label in:nil
-!
-
-origin:origin extent:extent font:aFont label:label in:aView
- ^ self origin:origin extent:extent borderWidth:nil
- font:aFont label:label in:aView
-!
-
-origin:origin corner:corner borderWidth:bw in:aView
- "create a new view as a subview of aView with given origin and extent"
-
- ^ self origin:origin corner:corner borderWidth:bw
- font:nil label:nil in:aView
! !
-!SimpleView class methodsFor:'resources'!
-
-classResources
- "if not already loaded, get the classes resourcePack
- and return it"
-
- ClassResources isNil ifTrue:[
- ClassResources := ResourcePack for:self.
- ].
- ^ ClassResources
-!
-
-classResources:aResourcePack
- "allow setting of the classResources"
-
- ClassResources := aResourcePack
-!
-
-flushAllClassResources
- "flush all classes resource translations.
- Needed after a resource file has changed."
-
- ResourcePack flushCachedResourcePacks.
- SimpleView flushClassResources.
- SimpleView allSubclasses do:[:aClass |
- aClass flushClassResources.
+!SimpleView class methodsFor:'change & update'!
+
+update:something
+ something == #Language ifTrue:[
+ "flush resources on language changes"
+ self flushAllClassResources
]
-
- "
- View flushAllClassResources
- "
- "to change the language:
- Language := #english.
- Smalltalk changed:#Language.
- View flushAllClassResources
- or:
- Language := #german.
- Smalltalk changed:#Language.
- View flushAllClassResources
- "
-!
-
-flushClassResources
- "flush classes resource string translations.
- Needed whenever a resource file or language has changed"
-
- ClassResources := nil.
-!
-
-updateClassResources
- "flush classes resource string translations and reload them.
- Needed whenever a resource file or language has changed"
-
- ClassResources := nil.
- self classResources
! !
!SimpleView class methodsFor:'defaults'!
@@ -737,12 +684,18 @@
^ CentPoint
!
-viewSpacing
- "return a convenient number of pixels used to separate views (usually 1mm).
- Having this value here at a common place makes certain that all views
- get a common look"
-
- ^ ViewSpacing
+defaultFont
+ ^ DefaultFont notNil ifTrue:[DefaultFont] ifFalse:[super defaultFont]
+!
+
+defaultStyle
+ "return the default view style"
+
+ ^ DefaultStyle
+
+ "
+ View defaultStyle
+ "
!
defaultStyle:aStyle
@@ -762,6 +715,46 @@
"
!
+styleSheet:aViewStyle
+ "set the view style from a style-sheet"
+
+ StyleSheet := aViewStyle.
+ DefaultStyle := (StyleSheet at:'name' ifAbsent:'unknown') asSymbol.
+ self updateAllStyleCaches.
+!
+
+updateAllStyleCaches
+ "reload all style caches in all view classes.
+ Needed after a style change or when a style file has been changed"
+
+ StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
+ StyleSheet fileReadFailed ifTrue:[
+ ('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintNL.
+ DefaultStyle ~~ #normal ifTrue:[
+ DefaultStyle := #normal.
+ StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
+
+ StyleSheet fileReadFailed ifTrue:[
+ '***** WARNING: not even a styleSheet for normal-style (using defaults).' errorPrintNL.
+ ]
+ ]
+ ].
+
+ "
+ tell all view classes to flush any
+ cached style-data
+ "
+ self changed:#style.
+ SimpleView updateStyleCache.
+ SimpleView allSubclassesDo:[:aClass |
+ (aClass class implements:#updateStyleCache) ifTrue:[aClass updateStyleCache].
+ ]
+
+ "
+ View updateAllStyleCaches
+ "
+!
+
updateStyleCache
"this method gets some heavily used style stuff and keeps
it in class-variables for faster access.
@@ -834,335 +827,1121 @@
].
!
-defaultStyle
- "return the default view style"
-
- ^ DefaultStyle
-
- "
- View defaultStyle
- "
-!
-
-updateAllStyleCaches
- "reload all style caches in all view classes.
- Needed after a style change or when a style file has been changed"
-
- StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
- StyleSheet fileReadFailed ifTrue:[
- ('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintNL.
- DefaultStyle ~~ #normal ifTrue:[
- DefaultStyle := #normal.
- StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
-
- StyleSheet fileReadFailed ifTrue:[
- '***** WARNING: not even a styleSheet for normal-style (using defaults).' errorPrintNL.
- ]
- ]
+viewSpacing
+ "return a convenient number of pixels used to separate views (usually 1mm).
+ Having this value here at a common place makes certain that all views
+ get a common look"
+
+ ^ ViewSpacing
+! !
+
+!SimpleView class methodsFor:'resources'!
+
+classResources
+ "if not already loaded, get the classes resourcePack
+ and return it"
+
+ ClassResources isNil ifTrue:[
+ ClassResources := ResourcePack for:self.
].
-
- "
- tell all view classes to flush any
- cached style-data
- "
- self changed:#style.
- SimpleView updateStyleCache.
- SimpleView allSubclassesDo:[:aClass |
- (aClass class implements:#updateStyleCache) ifTrue:[aClass updateStyleCache].
+ ^ ClassResources
+!
+
+classResources:aResourcePack
+ "allow setting of the classResources"
+
+ ClassResources := aResourcePack
+!
+
+flushAllClassResources
+ "flush all classes resource translations.
+ Needed after a resource file has changed."
+
+ ResourcePack flushCachedResourcePacks.
+ SimpleView flushClassResources.
+ SimpleView allSubclasses do:[:aClass |
+ aClass flushClassResources.
]
"
- View updateAllStyleCaches
+ View flushAllClassResources
"
-!
-
-defaultFont
- ^ DefaultFont notNil ifTrue:[DefaultFont] ifFalse:[super defaultFont]
-!
-
-styleSheet:aViewStyle
- "set the view style from a style-sheet"
-
- StyleSheet := aViewStyle.
- DefaultStyle := (StyleSheet at:'name' ifAbsent:'unknown') asSymbol.
- self updateAllStyleCaches.
+ "to change the language:
+ Language := #english.
+ Smalltalk changed:#Language.
+ View flushAllClassResources
+ or:
+ Language := #german.
+ Smalltalk changed:#Language.
+ View flushAllClassResources
+ "
+!
+
+flushClassResources
+ "flush classes resource string translations.
+ Needed whenever a resource file or language has changed"
+
+ ClassResources := nil.
+!
+
+updateClassResources
+ "flush classes resource string translations and reload them.
+ Needed whenever a resource file or language has changed"
+
+ ClassResources := nil.
+ self classResources
! !
-!SimpleView class methodsFor:'change & update'!
-
-update:something
- something == #Language ifTrue:[
- "flush resources on language changes"
- self flushAllClassResources
- ]
-! !
-
-!SimpleView methodsFor:'copying'!
-
-shallowCopyForFinalization
- "redefined for faster creation of finalization copies
- (only device, gcId and drawableId are needed)"
-
- |aCopy|
-
- aCopy := DeviceViewHandle basicNew.
- aCopy setDevice:device id:drawableId gcId:gcId.
- ^ aCopy
+!SimpleView methodsFor:'ST-80 compatibility'!
+
+checkForEvents
+ (shown and:[windowGroup notNil]) ifTrue:[windowGroup processEvents].
+!
+
+sensor
+ "return the views sensor"
+
+ windowGroup notNil ifTrue:[
+ ^ windowGroup sensor.
+ ].
+ ^ nil
! !
-!SimpleView methodsFor:'accessing-transformation'!
-
-transformation
- "return the transformation"
-
- |vP org|
-
- transformation isNil ifTrue:[
- "
- fake a transformation, if I have a non-nil window
- "
- window notNil ifTrue:[
- superView isNil ifTrue:[
- org := 0 @ 0
- ] ifFalse:[
- org := self origin
- ].
- vP := org extent:(self extent).
- ^ WindowingTransformation window:window viewport:vP
+!SimpleView methodsFor:'accessing-bg & border'!
+
+borderColor
+ "return my borderColor"
+
+ ^ borderColor
+!
+
+borderColor:aColor
+ "set my borderColor"
+
+ (aColor ~~ borderColor) ifTrue:[
+ borderColor := aColor.
+ drawableId notNil ifTrue:[
+ self setBorderColor
]
- ].
- ^ transformation
-!
-
-viewRectangle
- "return the inside area"
-
- |m2|
-
-"/ innerClipRect notNil ifTrue:[
-"/ ^ innerClipRect
-"/ ].
- m2 := margin + margin.
-
- ^ (margin @ margin) extent:((width - m2) @ (height - m2))
-!
-
-window
- "return my window (i.e. logical coordinate space).
- If there is no window, return the extent."
-
- window isNil ifTrue:[^ width @ height].
- ^ window
-!
-
-window:aRectangle
- "define my window (i.e. logical coordinate space)"
-
- window := aRectangle.
- subViews notNil ifTrue:[
- subViews do:[:s |
- s superViewChangedSize
+ ]
+!
+
+borderShape:aForm
+ "set the borderShape to aForm"
+
+ borderShape := aForm.
+ drawableId notNil ifTrue:[
+ device setWindowBorderShape:(aForm id) in:drawableId
+ ]
+!
+
+borderWidth
+ "return my borderWidth"
+
+ ^ borderWidth
+!
+
+borderWidth:aNumber
+ "set my borderWidth"
+
+ (aNumber ~~ borderWidth) ifTrue:[
+ borderWidth := aNumber.
+ drawableId notNil ifTrue:[
+ device setWindowBorderWidth:aNumber in:drawableId
+ ]
+ ]
+!
+
+level
+ "return my level relative to superView (3D)"
+
+ ^ level
+!
+
+level:aNumber
+ "set my level relative to superView (3D)"
+
+ |oldMargin how|
+
+ (aNumber ~~ level and:[aNumber notNil]) ifTrue:[
+ self is3D ifTrue:[
+ level := aNumber.
+ oldMargin := margin.
+ margin := level abs.
+
+ realized ifTrue:[
+ margin ~~ oldMargin ifTrue:[
+ (margin > oldMargin) ifTrue:[
+ how := #smaller
+ ] ifFalse:[
+ how := #larger
+ ].
+ self sizeChanged:how.
+ self setInnerClip.
+ ].
+ shown ifTrue:[
+ self redrawEdges
+ ]
+ ]
]
]
-
-"
- viewport isNil ifTrue:[
- viewport := aRectangle.
+!
+
+lightColor:aColorOrImage
+ "set the color to be used for lighted edges (3D only)"
+
+ lightColor := aColorOrImage
+!
+
+margin
+ "return my margin - this is usually the level,
+ but can be more for some views"
+
+ ^ margin
+!
+
+shadowColor:aColorOrImage
+ "set the color to be used for shadowed edges (3D only)"
+
+ shadowColor := aColorOrImage
+!
+
+viewBackground:something
+ "set the viewBackground to something, a color, image or form.
+ If its a color and we run on a color display, also set shadow and light
+ colors - this means, that a red view will get light-red and dark-red
+ edges."
+
+ something isColor ifTrue:[
+ device hasGreyscales ifTrue:[
+ shadowColor := something darkened.
+ lightColor := something lightened
+ ]
].
-"
-"
- superView notNil ifTrue:[
- self superViewChangedSize
- ] ifFalse:[
- originChanged := true.
- extentChanged := true
+ super viewBackground:something
+!
+
+viewShape:aForm
+ "set the viewShape to aForm"
+
+ viewShape := aForm.
+ drawableId notNil ifTrue:[
+ device setWindowShape:(aForm id) in:drawableId
]
-"
-!
-
-viewOrigin
- "return the viewOrigin; thats the coordinate of the contents
- which is shown topLeft in the view
- (i.e. the origin of the visible part of the contents)."
-
- transformation isNil ifTrue:[
- ^ 0@0
+! !
+
+!SimpleView methodsFor:'accessing-dimensions'!
+
+allInset:aNumber
+ "set all insets; positive makes the view smaller,
+ negative makes it larger."
+
+ insets isNil ifTrue:[
+ insets := Array new:4.
+ ].
+ insets atAllPut:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize.
+"/ ]
+!
+
+bottom
+ "return the y position of the actual bottom edge (in pixels)"
+
+ ^ top + height - 1
+!
+
+bottom:aNumber
+ "set the corners y position"
+
+ self corner:(self corner x @ aNumber)
+!
+
+bottomInset
+ "return the inset of the bottom edge; positive is to the top,
+ negative to the bottom"
+
+ insets isNil ifTrue:[^ 0].
+ ^ insets at:4
+!
+
+bottomInset:aNumber
+ "set the inset of the bottom edge;
+ positive is to the top (view becomes smaller),
+ negative to the bottom (becomes larger)"
+
+ insets isNil ifTrue:[
+ insets := Array with:0 with:0 with:0 with:0
+ ].
+ insets at:4 put:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize
+"/ ]
+!
+
+center
+ "return the point at the center of the receiver (in pixels)"
+
+ ^ (left + (width // 2)) @ (top + (height // 2))
+!
+
+center:newCenter
+ "move the receiver so that newCenter, aPoint becomes the center point"
+
+ self origin:(newCenter - ((width // 2) @ (height // 2)))
+!
+
+computeCorner
+ "compute my corner; if I have a layoutObject,
+ relative origins or blocks to evaluate, compute it now ..
+ Blocks may return relative values or nil; nil means: take current value.
+ Returns the corner point in device coordinates (pixels)."
+
+ |org newCorner newExt x y|
+
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ ^ (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)) corner rounded
+ ].
+
+ (cornerRule notNil) ifTrue:[
+ newCorner := cornerRule value.
+ "
+ allow return of relative values ...
+ "
+ x := newCorner x.
+ y := newCorner y.
+ x isNil ifTrue:[x := self corner x].
+ y isNil ifTrue:[y := self corner y].
+ ((x isInteger not) or:[y isInteger not]) ifTrue:[
+ newCorner := self cornerFromRelativeCorner:x@y
+ ]
+ ] ifFalse:[
+ (relativeCorner notNil) ifTrue:[
+ newCorner := self cornerFromRelativeCorner:relativeCorner
+ ] ifFalse:[
+ org := self computeOrigin.
+ (extentRule notNil) ifTrue:[
+ newExt := extentRule value
+ ] ifFalse:[
+ (relativeExtent notNil) ifTrue:[
+ newExt := self extentFromRelativeExtent:relativeExtent
+ ]
+ ].
+ newCorner := org + newExt
+ ]
+ ].
+ ^ newCorner
+!
+
+computeExtent
+ "compute my extent; if I have a layoutObject, a relative extent
+ or blocks to evaluate, compute it now ..
+ There is one catch here, if the dimension was defined
+ by origin/corner, compute them here and take that value.
+ I.e. origin/corner definition has precedence over extent definition.
+ Returns the extent in device coordinates (pixels)."
+
+ |newOrg newExt newCorner x y|
+
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ ^ (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)) extent rounded
].
- ^ transformation translation negated
-!
-
-setViewOrigin:aPoint
- "set the viewOrigin - i.e. virtually scroll without redrawing"
-
- |p|
-
- p := aPoint negated.
- transformation isNil ifTrue:[
- transformation := WindowingTransformation scale:1 translation:p
+
+ (cornerRule notNil) ifTrue:[
+ newCorner := cornerRule value.
+ "
+ allow return of relative values ...
+ "
+ x := newCorner x.
+ y := newCorner y.
+ x isNil ifTrue:[x := self corner x].
+ y isNil ifTrue:[y := self corner y].
+ ((x isInteger not) or:[y isInteger not]) ifTrue:[
+ newCorner := self cornerFromRelativeCorner:x@y
+ ]
+ ] ifFalse:[
+ (relativeCorner notNil) ifTrue:[
+ newCorner := self cornerFromRelativeCorner:relativeCorner
+ ] ifFalse:[
+ (extentRule notNil) ifTrue:[
+ newExt := extentRule value.
+ "
+ allow return of relative values ...
+ "
+ x := newExt x.
+ y := newExt y.
+ x isNil ifTrue:[x := width].
+ y isNil ifTrue:[y := height].
+ ((x isInteger not) or:[y isInteger not]) ifTrue:[
+ newExt := self extentFromRelativeExtent:x@y
+ ]
+ ] ifFalse:[
+ (relativeExtent notNil) ifTrue:[
+ newExt := self extentFromRelativeExtent:relativeExtent
+ ] ifFalse:[
+ newExt := (width @ height).
+ ].
+ ].
+ ].
+ ].
+
+ newCorner notNil ifTrue:[
+ newOrg := self computeOrigin.
+ ^ newCorner - newOrg.
+ ].
+ ^ newExt.
+!
+
+computeOrigin
+ "compute my origin; if I have a layoutObject, a relative origin
+ or blocks to evaluate, compute it now ..
+ Blocks may return relative values or nil; nil means: take current value.
+ Returns the origin point in device coordinates (pixels)."
+
+ |newOrg x y|
+
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout notNil ifTrue:[
+ ^ (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)) origin rounded
+ ].
+
+ (originRule notNil) ifTrue:[
+ newOrg := originRule value.
+ "
+ allow return of relative values ...
+ "
+ x := newOrg x.
+ y := newOrg y.
+ x isNil ifTrue:[x := self origin x].
+ y isNil ifTrue:[y := self origin y].
+ ((x isInteger not) or:[y isInteger not]) ifTrue:[
+ newOrg := self originFromRelativeOrigin:x@y.
+ ]
+ ] ifFalse:[
+ (relativeOrigin notNil) ifTrue:[
+ newOrg := self originFromRelativeOrigin:relativeOrigin.
+ ] ifFalse:[
+ ^ (left @ top).
+ ].
+ ].
+ ^ newOrg
+!
+
+corner
+ "return the lower right corner-point (in pixels)"
+
+"/ ^ (left + width "- 1") @ (top + height "- 1")
+ ^ (left + width - 1) @ (top + height - 1)
+
+ "Modified: 31.8.1995 / 16:51:40 / claus"
+!
+
+corner:corner
+ "set the views corner;
+ the corner argument may be:
+ a point
+ where integer fields mean 'pixel-values'
+ and float values mean 'relative-to-superview'
+ and nil means 'take current value';
+ or a block returning a point which is interpreted as above.
+ Please migrate to use layoutObjects, if possible."
+
+ |x y pixelCorner c|
+
+ corner isBlock ifTrue:[
+ cornerRule := corner.
+ drawableId notNil ifTrue:[
+ pixelCorner := corner value
+ ] ifFalse:[
+ extentChanged := true
+ ]
+ ] ifFalse:[
+ x := corner x.
+ y := corner y.
+ x isNil ifTrue:[x := self corner x].
+ y isNil ifTrue:[y := self corner y].
+ c := x @ y.
+ ((x isInteger not) or:[y isInteger not]) ifTrue:[
+ relativeCorner := c.
+ pixelCorner := self cornerFromRelativeCorner.
+ pixelCorner isNil ifTrue:[
+ extentChanged := true
+ ]
+ ] ifFalse:[
+ pixelCorner := c
+ ]
+ ].
+
+ pixelCorner notNil ifTrue:[
+ self pixelCorner:pixelCorner
+ ]
+!
+
+extent:extent
+ "set the views extent;
+ extent may be:
+ a point
+ where integer fields mean 'pixel-values'
+ and float values mean 'relative-to-superview'
+ and nil means 'leave current value';
+ or a block returning a point which is interpreted as above.
+ Be careful when using relative extents: rounding errors may
+ accumulate. Better use origin/corner.
+ Best: migrate to use layour objects."
+
+ |w h pixelExtent e|
+
+ extent isBlock ifTrue:[
+ extentRule := extent.
+ drawableId notNil ifTrue:[
+ pixelExtent := extent value
+ ] ifFalse:[
+ extentChanged := true
+ ]
] ifFalse:[
- transformation translation:p
+ w := extent x.
+ h := extent y.
+ w isNil ifTrue:[w := width].
+ h isNil ifTrue:[h := height].
+ e := w@h.
+ ((w isInteger not) or:[h isInteger not]) ifTrue:[
+ relativeExtent := e.
+ pixelExtent := self extentFromRelativeExtent.
+ pixelExtent isNil ifTrue:[
+ extentChanged := true
+ ]
+ ] ifFalse:[
+ pixelExtent := e
+ ]
+ ].
+ pixelExtent notNil ifTrue:[
+ self pixelExtent:pixelExtent
+ ]
+!
+
+geometryLayout
+ "this method will vanish, as soon as all implementations of
+ #layout: are removed ...
+ (conflict for example in label>>layout:).
+ DO NOT USE #geometryLayout: in your code; it will be removed without
+ notice."
+
+ ^ here layout
+!
+
+geometryLayout:aLayoutObject
+ "this method will vanish, as soon as all implementations of
+ #layout: are removed ...
+ (conflict for example in label>>layout:).
+ DO NOT USE #geometryLayout: in your code; it will be removed without
+ notice."
+
+ here layout:aLayoutObject
+!
+
+height:aNumber
+ "set the views height in pixels"
+
+ self extent:(width @ aNumber)
+!
+
+heightIncludingBorder
+ "return my height including border
+ (this is my height as seen from the outside view;
+ while #height returns the height as seen by myself)"
+
+ ^ height + (2*borderWidth)
+!
+
+horizontalInset:aNumber
+ "set the insets of the left/right edge;
+ positive makes it smaller, negative makes it larger"
+
+ insets isNil ifTrue:[
+ insets := Array with:0 with:0 with:0 with:0
].
- clipRect notNil ifTrue:[
- self setInnerClip.
+ insets at:1 put:aNumber.
+ insets at:3 put:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize.
+"/ ]
+!
+
+innerHeight
+ "return the height of the view minus any 3D-shadow-borders"
+
+ (margin == 0) ifTrue:[^ height].
+ ^ height - (2 * margin)
+!
+
+innerWidth
+ "return the width of the view minus any 3D-shadow-borders"
+
+ (level == 0) ifTrue:[^ width].
+ ^ width - (2 * margin)
+!
+
+inset:aNumber
+ "set all insets; positive makes the view smaller,
+ negative makes it larger."
+
+ self allInset:aNumber
+!
+
+layout
+ "return the layout object which controls my geometry.
+ Currently, this is nil in most cases, and my geometry is
+ defined by relativeOrigin/relativeCorner/relativeExtent,
+ originRule/extentRule/cornerRule and inset.
+ Applications should be changed to use layoutObjects,
+ since the above listed instance variables will vanish."
+
+ ^ layout
+!
+
+layout:aLayoutObject
+ "set the layout object which controls my geometry.
+ Currently, this is almost nowhere used but views will be
+ incrementally changed to use this new geometry management."
+
+ layout := aLayoutObject.
+ superView isNil ifTrue:[
+ originChanged := cornerChanged := extentChanged := true
+ ] ifFalse:[
+ self superViewChangedSize.
+ ]
+
+ "Modified: 19.9.1995 / 16:17:25 / claus"
+!
+
+left
+ "return the x position of the left border (in pixels)"
+
+ ^ left
+!
+
+left:aNumber
+ "set the x position"
+
+ self origin:(aNumber @ top)
+!
+
+left:newLeft top:newTop width:newWidth height:newHeight
+ "another way of specifying origin and extent"
+
+ self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
+!
+
+leftInset
+ "return the inset of the left edge; positive is to the right,
+ negative to the left"
+
+ insets isNil ifTrue:[^ 0].
+ ^ insets at:1
+!
+
+leftInset:aNumber
+ "set the inset of the left edge;
+ positive is to the right (view becomes smaller),
+ negative to the left (becomes larger)"
+
+ insets isNil ifTrue:[
+ insets := Array with:0 with:0 with:0 with:0
+ ].
+ insets at:1 put:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize.
+"/ ]
+!
+
+makeFullyVisible
+ "make sure, that the view is fully visible by shifting it
+ into the visible screen area if nescessary.
+ This method will be moved to StandardSystemView ..."
+
+ |devBot devRight newTop newLeft|
+
+ newTop := top.
+ newLeft := left.
+
+ ((top + height) > (devBot := device height)) ifTrue:[
+ newTop := devBot - height
+ ].
+ ((left + width) > (devRight := device width)) ifTrue:[
+ newLeft := devRight - width
+ ].
+ (newTop < 0) ifTrue:[
+ newTop := 0.
+ ].
+ (newLeft < 0) ifTrue:[
+ newLeft := 0
+ ].
+ ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
+ self origin:newLeft @ newTop
+ ]
+!
+
+origin
+ "return the origin (in pixels)"
+
+ ^ left@top
+!
+
+origin:origin
+ "set the views origin;
+ origin may be:
+ a point
+ where integer fields mean 'pixel-values'
+ and float values mean 'relative-to-superview'
+ and nil means 'take current value';
+ or a block returning a point which is interpreted as above.
+ Please migrate to use layout objects."
+
+ |newLeft newTop pixelOrigin o|
+
+ origin isBlock ifTrue:[
+ originRule := origin.
+ drawableId notNil ifTrue:[
+ pixelOrigin := origin value
+ ] ifFalse:[
+ originChanged := true
+ ]
+ ] ifFalse:[
+ o := origin.
+ newLeft := origin x.
+ newTop := origin y.
+ newLeft isNil ifTrue:[newLeft := left].
+ newTop isNil ifTrue:[newTop := top].
+ o := newLeft @ newTop.
+ ((newLeft isInteger not) or:[newTop isInteger not]) ifTrue:[
+ relativeOrigin := o.
+ pixelOrigin := self originFromRelativeOrigin.
+ pixelOrigin isNil ifTrue:[
+ originChanged := true
+ ]
+ ] ifFalse:[
+ pixelOrigin := o
+ ]
+ ].
+ pixelOrigin notNil ifTrue:[
+ self pixelOrigin:pixelOrigin
+ ].
+!
+
+origin:origin corner:corner
+ "set both origin and extent"
+
+ |newLeft newTop newRight newBot|
+
+ "do it as one operation if possible"
+
+ origin isBlock ifFalse:[
+ corner isBlock ifFalse:[
+ newLeft := origin x.
+ newLeft isInteger ifTrue:[
+ newTop := origin y.
+ newTop isInteger ifTrue:[
+ newRight := corner x.
+ newRight isInteger ifTrue:[
+ newBot := corner y.
+ newBot isInteger ifTrue:[
+ self pixelOrigin:origin corner:corner
+ ]
+ ]
+ ]
+ ]
+ ]
].
-!
-
-viewport:aRectangle
- "define my extend in my superviews coordinate-system."
-
-"/ |relW relH relX relY winW winH|
-
- viewport := aRectangle.
- self dimensionFromViewport
-"/
-"/ superView notNil ifTrue:[
-"/ superView window isNil ifTrue:[
-"/ winW := 1.
-"/ winH := 1
-"/ ] ifFalse:[
-"/ winW := superView window width.
-"/ winH := superView window height
-"/ ].
-"/ relW := (aRectangle width / winW) asFloat.
-"/ relH := (aRectangle height / winH) asFloat.
-"/ relX := (aRectangle left / winW) asFloat.
-"/ relY := (aRectangle top / winH) asFloat.
-"/ self origin:(relX @ relY) extent:(relW @ relH)
+ self origin:origin.
+ self corner:corner
+!
+
+origin:origin extent:extent
+ "set both origin and extent"
+
+ |newLeft newTop newWidth newHeight|
+
+ "do it as one operation if possible"
+
+ origin isBlock ifFalse:[
+ extent isBlock ifFalse:[
+ newLeft := origin x.
+ newLeft isInteger ifTrue:[
+ newTop := origin y.
+ newTop isInteger ifTrue:[
+ newWidth := extent x.
+ newWidth isInteger ifTrue:[
+ newHeight := extent y.
+ newHeight isInteger ifTrue:[
+ self pixelOrigin:origin extent:extent
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ self extent:extent.
+ self origin:origin
+!
+
+originRelativeTo:aView
+ "return the origin (in pixels) relative to a superView,
+ or relative to the rootView (if the aView argument is nil).
+ If the receiver is nonNil and not a subview of aView, return nil."
+
+ |currentView
+ org "{ Class: Point }"
+ sumX "{ Class: SmallInteger }"
+ sumY "{ Class: SmallInteger }" |
+
+ currentView := self.
+ sumX := 0.
+ sumY := 0.
+ [currentView notNil] whileTrue:[
+ (currentView == aView) ifTrue:[
+ ^ (sumX @ sumY)
+ ].
+ org := currentView origin.
+ sumX := sumX + org x.
+ sumY := sumY + org y.
+ currentView := currentView superView
+ ].
+ (aView isNil or:[aView == RootView]) ifTrue:[
+ "return relative to screen ..."
+ ^ (sumX @ sumY)
+ ].
+ ^ nil
+
+ "
+ |top sub1 sub2|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+ sub1 := View origin:0.2 @ 0.2 corner:0.8 @ 0.8 in:top.
+ sub2 := Button origin:0.3 @ 0.3 corner:0.7 @ 0.7 in:sub1.
+ top openAndWait.
+ Transcript show:'button in top:'; showCr:(sub2 originRelativeTo:top).
+ Transcript show:'button on screen:'; showCr:(sub2 originRelativeTo:nil).
+ "
+!
+
+relativeCorner
+ "return the relative corner or nil"
+
+ ^ relativeCorner
+!
+
+relativeCorner:aPoint
+ "set the relative corner"
+
+ relativeCorner := aPoint
+!
+
+relativeExtent
+ "return the relative extent or nil"
+
+ ^ relativeExtent
+!
+
+relativeExtent:aPoint
+ "set the relative extent"
+
+ relativeExtent := aPoint
+!
+
+relativeOrigin
+ "return the relative origin or nil"
+
+ ^ relativeOrigin
+!
+
+relativeOrigin:aPoint
+ "set the relative origin"
+
+ relativeOrigin := aPoint
+!
+
+right
+ "return the x position of the right edge (in pixels)"
+
+ ^ left + width - 1
+
+ "Modified: 31.8.1995 / 19:31:10 / claus"
+!
+
+right:aNumber
+ "set the corners x position"
+
+ self corner:(aNumber @ self corner y)
+!
+
+rightInset
+ "return the inset of the right edge; positive is to the left,
+ negative to the right"
+
+ insets isNil ifTrue:[^ 0].
+ ^ insets at:3
+!
+
+rightInset:aNumber
+ "set the inset of the right edge;
+ positive is to the left (view becomes smaller),
+ negative to the right (becomes larger)"
+
+ insets isNil ifTrue:[
+ insets := Array with:0 with:0 with:0 with:0
+ ].
+ insets at:3 put:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize.
"/ ]
-"/
-!
-
-window:aRectangle viewport:vRect
- window := aRectangle.
- self viewport:vRect.
+!
+
+sizeFixed:aBoolean
+ "set/clear the fix-size attribute, if supported by concrete subclasses.
+ Views which want to resize themselfes as appropriate to their contents
+ should cease to do so and take their current size if sizeFixed is set to
+ true. Currently, only supported by Labels.
+ This does NOT prevent the window manager from resizing the view,
+ instead it tell the view to NOT resize ITSELF.
+ Added here to provide a common protocol for all views."
+
+ ^ self
+!
+
+top
+ "return the y position of the top border"
+
+ ^ top
+!
+
+top:aNumber
+ "set the y position"
+
+ self origin:(left @ aNumber)
+!
+
+topInset
+ "return the inset of the top edge; positive is to the bottom,
+ negative to the top"
+
+ insets isNil ifTrue:[^ 0].
+ ^ insets at:2
+!
+
+topInset:aNumber
+ "set the inset of the top edge;
+ positive is to the bottom (view becomes smaller),
+ negative to the top (becomes larger)"
+
+ insets isNil ifTrue:[
+ insets := Array with:0 with:0 with:0 with:0
+ ].
+ insets at:2 put:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize.
+"/ ]
+!
+
+verticalInset:aNumber
+ "set the insets of the top/bottom edge;
+ positive makes it smaller, negative makes it larger"
+
+ insets isNil ifTrue:[
+ insets := Array with:0 with:0 with:0 with:0
+ ].
+ insets at:2 put:aNumber.
+ insets at:4 put:aNumber.
+
+ "force recomputation"
+"/ drawableId isNil ifTrue:[
+"/ originChanged := true
+"/ ] ifFalse:[
+ self superViewChangedSize.
+"/ ]
+!
+
+width:aNumber
+ "set the views width in pixels"
+
+ self extent:(aNumber @ height)
+!
+
+widthIncludingBorder
+ "return my width including border
+ (this is my width as seen from the outside view;
+ while #width returns the width as seen by myself)"
+
+ ^ width + (2*borderWidth)
+! !
+
+!SimpleView methodsFor:'accessing-hierarchy'!
+
+lower
+ "bring to back"
+
+ drawableId isNil ifTrue:[self create].
+ device lowerWindow:drawableId
+
+ "
+ Transcript topView lower
+ "
+!
+
+raise
+ "bring to front"
+
+ drawableId isNil ifTrue:[self create].
+ device raiseWindow:drawableId
+
+ "
+ Transcript topView raise
+ "
+!
+
+subViews
+ "return the collection of subviews"
+
+ ^ subViews
+!
+
+subViews:aListOfViews
+ "set the collection of subviews"
+
+ subViews := aListOfViews.
subViews notNil ifTrue:[
- subViews do:[:s |
- s superViewChangedSize
+ subViews do:[:view |
+ view superView:self
]
]
!
-scale
- "return the scale factor (as point) of the transformation"
-
- transformation isNil ifTrue:[^ 1].
- ^ transformation scale
-!
-
-scale:aPoint
- "set the scale factor of the transformation"
-
- transformation isNil ifTrue:[
- aPoint = 1 ifTrue:[^ self].
- transformation := WindowingTransformation scale:aPoint translation:0
+superView
+ "return my superView"
+
+ ^ superView
+!
+
+superView:aView
+ "set my superView to be aView"
+
+ superView := aView
+!
+
+topView
+ "return the topView - thats the one with no superview"
+
+ |v|
+
+ v := self.
+ [v notNil] whileTrue:[
+ v superView isNil ifTrue:[^ v].
+ v := v superView
].
- transformation scale:aPoint.
- self computeInnerClip
-!
-
-xOriginOfContents
- "return the x coordinate of the viewOrigin in pixels;
- used by scrollBars to compute thumb position within the document."
-
- ^ self viewOrigin x
-!
-
-yOriginOfContents
- "return the y coordinate of the viewOrigin in pixels;
- used by scrollBars to compute thumb position within the document."
-
- ^ self viewOrigin y
-!
-
-heightOfContents
- "return the height of the contents in logical units
- - defaults to views visible area here.
- This method MUST be redefined in all view classess which are
- going to be scrolled AND show data which has different size than
- the view. For example, a view showing A4-size documents should return
- the number of vertical pixels such a document has on this device.
- A view showing a bitmap of height 1000 should return 1000.
- If not redefined, scrollbars have no way of knowing the actual size
- of the contents being shown. This is called by scrollBars to compute
- the relative height of the document vs. the views actual size.
- The value returned here must be based on a scale of 1, since users
- of this will scale as appropriate."
-
- ^ self innerHeight max:(self maxSubViewBottom)
-!
-
-widthOfContents
-
- ^ self innerWidth max:(self maxSubViewRight)
-
-!
-
-maxSubViewBottom
-"/ subViews isNil ifTrue:[^ 0].
-"/ ^ subViews inject:0 into:[:maxSoFar :sub | (sub top + sub height) max:maxSoFar].
- ^ 0
-!
-
-maxSubViewRight
-"/ subViews isNil ifTrue:[^ 0].
-"/ ^ subViews inject:0 into:[:maxSoFar :sub | (sub left + sub width) max:maxSoFar].
- ^ 0
+ ^ nil
+! !
+
+!SimpleView methodsFor:'accessing-menus'!
+
+menuHolder
+ "who has the menu ?
+ By default, I have it."
+
+ ^ self
+!
+
+menuMessage
+ "Return the symbol sent to myself to aquire the menu"
+
+ ^ #middleButtonMenu
+!
+
+menuPerformer
+ "who should perform the menu actions ?
+ By default, I do it."
+
+ ^ self
+!
+
+yellowButtonMenu
+ "actually, this should be called 'middleButtonMenu'.
+ But for ST-80 compatibility ....
+ This method will vanish, once all views have controllers
+ associated with them; for now, duplicate some code also found in
+ controller."
+
+ |sym menuHolder|
+
+"/ middleButtonMenu notNil ifTrue:[
+"/ "/
+"/ "/ has been assigned a static middleButtonMenu
+"/ "/ (or a cached menu)
+"/ "/
+"/ ^ middleButtonMenu
+"/ ].
+
+ menuHolder := self menuHolder.
+
+ menuHolder notNil ifTrue:[
+ sym := self menuMessage.
+ sym notNil ifTrue:[
+ "
+ mhmh - for backward compatibility, try to ask
+ the model first, then use the views menu.
+ "
+ (menuHolder respondsTo:sym) ifFalse:[
+ (self respondsTo:sym) ifTrue:[
+ menuHolder := self
+ ]
+ ].
+ "
+ ask the menuHolder for the menu
+ "
+ ^ menuHolder perform:sym.
+ ].
+ ].
+
+ ^ nil
! !
!SimpleView methodsFor:'accessing-misc'!
-shown
- "return true if the view is shown; false if not.
- Shown means: the view is mapped and is not completely covered."
-
- ^ shown
-!
-
-inputOnly
- "return true, if this view is an input-only view;
- input only views are transparent and can be layed on top of a view to
- catch its input"
-
- ^ false
-!
-
-isPopUpView
- "return true, if this view should be put on top (raised) automatically.
- usually this is true for alertBoxes etc."
-
- ^ false
-!
-
-is3D
- "return true, if my style is some kind of 3D style
- This is OBSOLETE and will be removed."
-
- ^ styleSheet is3D
-!
-
-styleSheet
- "return the styleSheet. This is set at early view-creation time,
- from the defaultStyleSheet which is valid at that time.
- It is not affected by later defaultStyle changes"
-
- ^ styleSheet
-
- "Created: 10.9.1995 / 11:02:20 / claus"
-!
-
-viewGravity:gravity
- "set the viewGravity - thats the direction where the view will move
- when the superView is resized."
-
- viewGravity ~~ gravity ifTrue:[
- viewGravity := gravity.
- drawableId notNil ifTrue:[
- device setWindowGravity:gravity in:drawableId
- ]
- ]
-!
-
beInvisible
self hidden:true.
realized ifTrue:[
@@ -1204,39 +1983,6 @@
"Created: 22.9.1995 / 15:50:33 / claus"
!
-hidden:aBoolean
- "if the argument is true, the receiver view will not
- be realized automatically when superview is realized"
-
- self obsoleteMethodWarning:'use #hiddenOnRealize:'.
- hiddenOnRealize := aBoolean
-!
-
-isHiddenOnRealize:aBoolean
- "return true, if the receiver will NOT be mapped when
- realized. False otherwise.
- The hiddenOnRealize flag is useful to create views which are
- to be made visible conditionally or later."
-
- ^ hiddenOnRealize
-!
-
-hiddenOnRealize:aBoolean
- "if the argument is true, the receiver view will not
- be mapped automatically when the superview is realized.
- The hiddenOnRealize flag is useful to create views which are
- to be made visible conditionally or later."
-
- hiddenOnRealize := aBoolean
-!
-
-viewGravity
- "return the viewGravity - thats the direction where the view will move
- when the superView is resized."
-
- ^ viewGravity
-!
-
bitGravity
"return the bitGravity - thats the direction where the contents will move
when the the view is resized."
@@ -1264,14 +2010,6 @@
^ false
!
-hidden
- "return true, if the view does not want to be realized
- automatically when superview is realized"
-
- self obsoleteMethodWarning:'use #hiddenOnRealize'.
- ^ hiddenOnRealize
-!
-
clipRect:aRectangle
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turn off clipping (i.e. whole view is drawable).
@@ -1331,18 +2069,6 @@
clipRect := aRectangle
!
-name:aString
- "set my name component to be used for resource-access"
-
- name := aString
-!
-
-name
- "return my name component to be used for resource-access"
-
- ^ name
-!
-
fullName
"return my full name to be used for resource-access"
@@ -1352,41 +2078,132 @@
^ name
!
+hidden
+ "return true, if the view does not want to be realized
+ automatically when superview is realized"
+
+ self obsoleteMethodWarning:'use #hiddenOnRealize'.
+ ^ hiddenOnRealize
+!
+
+hidden:aBoolean
+ "if the argument is true, the receiver view will not
+ be realized automatically when superview is realized"
+
+ self obsoleteMethodWarning:'use #hiddenOnRealize:'.
+ hiddenOnRealize := aBoolean
+!
+
+hiddenOnRealize:aBoolean
+ "if the argument is true, the receiver view will not
+ be mapped automatically when the superview is realized.
+ The hiddenOnRealize flag is useful to create views which are
+ to be made visible conditionally or later."
+
+ hiddenOnRealize := aBoolean
+!
+
+inputOnly
+ "return true, if this view is an input-only view;
+ input only views are transparent and can be layed on top of a view to
+ catch its input"
+
+ ^ false
+!
+
+is3D
+ "return true, if my style is some kind of 3D style
+ This is OBSOLETE and will be removed."
+
+ ^ styleSheet is3D
+!
+
+isHiddenOnRealize:aBoolean
+ "return true, if the receiver will NOT be mapped when
+ realized. False otherwise.
+ The hiddenOnRealize flag is useful to create views which are
+ to be made visible conditionally or later."
+
+ ^ hiddenOnRealize
+!
+
+isPopUpView
+ "return true, if this view should be put on top (raised) automatically.
+ usually this is true for alertBoxes etc."
+
+ ^ false
+!
+
+name
+ "return my name component to be used for resource-access"
+
+ ^ name
+!
+
+name:aString
+ "set my name component to be used for resource-access"
+
+ name := aString
+!
+
processName
"return a string to be shown in the process monitor"
^ self name
-! !
-
-!SimpleView methodsFor:'ST-80 compatibility'!
-
-sensor
- "return the views sensor"
-
- windowGroup notNil ifTrue:[
- ^ windowGroup sensor.
- ].
- ^ nil
-!
-
-checkForEvents
- (shown and:[windowGroup notNil]) ifTrue:[windowGroup processEvents].
+!
+
+shown
+ "return true if the view is shown; false if not.
+ Shown means: the view is mapped and is not completely covered."
+
+ ^ shown
+!
+
+styleSheet
+ "return the styleSheet. This is set at early view-creation time,
+ from the defaultStyleSheet which is valid at that time.
+ It is not affected by later defaultStyle changes"
+
+ ^ styleSheet
+
+ "Created: 10.9.1995 / 11:02:20 / claus"
+!
+
+viewGravity
+ "return the viewGravity - thats the direction where the view will move
+ when the superView is resized."
+
+ ^ viewGravity
+!
+
+viewGravity:gravity
+ "set the viewGravity - thats the direction where the view will move
+ when the superView is resized."
+
+ viewGravity ~~ gravity ifTrue:[
+ viewGravity := gravity.
+ drawableId notNil ifTrue:[
+ device setWindowGravity:gravity in:drawableId
+ ]
+ ]
! !
!SimpleView methodsFor:'accessing-mvc'!
+aspect:aspectSymbol
+ "ST-80 style updating: If a views aspectSymbol is nonNil,
+ it will respond to changes of this aspect from the model.
+ Alias for aspectMessage: for ST-80 compatibility."
+
+ self aspectMessage:aspectSymbol
+!
+
controller
"return the controller. For non MVC views, return nil"
^ controller
!
-windowGroup
- "return the window group. For old style views, return nil"
-
- ^ windowGroup
-!
-
controller:aController
"set the controller"
@@ -1400,143 +2217,917 @@
^ nil
!
+windowGroup
+ "return the window group. For old style views, return nil"
+
+ ^ windowGroup
+!
+
windowGroup:aGroup
"set the window group."
windowGroup := aGroup
-!
-
-aspect:aspectSymbol
- "ST-80 style updating: If a views aspectSymbol is nonNil,
- it will respond to changes of this aspect from the model.
- Alias for aspectMessage: for ST-80 compatibility."
-
- self aspectMessage:aspectSymbol
+! !
+
+!SimpleView methodsFor:'accessing-transformation'!
+
+heightOfContents
+ "return the height of the contents in logical units
+ - defaults to views visible area here.
+ This method MUST be redefined in all view classess which are
+ going to be scrolled AND show data which has different size than
+ the view. For example, a view showing A4-size documents should return
+ the number of vertical pixels such a document has on this device.
+ A view showing a bitmap of height 1000 should return 1000.
+ If not redefined, scrollbars have no way of knowing the actual size
+ of the contents being shown. This is called by scrollBars to compute
+ the relative height of the document vs. the views actual size.
+ The value returned here must be based on a scale of 1, since users
+ of this will scale as appropriate."
+
+ ^ self innerHeight max:(self maxSubViewBottom)
+!
+
+maxSubViewBottom
+"/ subViews isNil ifTrue:[^ 0].
+"/ ^ subViews inject:0 into:[:maxSoFar :sub | (sub top + sub height) max:maxSoFar].
+ ^ 0
+!
+
+maxSubViewRight
+"/ subViews isNil ifTrue:[^ 0].
+"/ ^ subViews inject:0 into:[:maxSoFar :sub | (sub left + sub width) max:maxSoFar].
+ ^ 0
+!
+
+scale
+ "return the scale factor (as point) of the transformation"
+
+ transformation isNil ifTrue:[^ 1].
+ ^ transformation scale
+!
+
+scale:aPoint
+ "set the scale factor of the transformation"
+
+ transformation isNil ifTrue:[
+ aPoint = 1 ifTrue:[^ self].
+ transformation := WindowingTransformation scale:aPoint translation:0
+ ].
+
+ transformation scale:aPoint.
+ self computeInnerClip
+!
+
+setViewOrigin:aPoint
+ "set the viewOrigin - i.e. virtually scroll without redrawing"
+
+ |p|
+
+ p := aPoint negated.
+ transformation isNil ifTrue:[
+ transformation := WindowingTransformation scale:1 translation:p
+ ] ifFalse:[
+ transformation translation:p
+ ].
+ clipRect notNil ifTrue:[
+ self setInnerClip.
+ ].
+!
+
+transformation
+ "return the transformation"
+
+ |vP org|
+
+ transformation isNil ifTrue:[
+ "
+ fake a transformation, if I have a non-nil window
+ "
+ window notNil ifTrue:[
+ superView isNil ifTrue:[
+ org := 0 @ 0
+ ] ifFalse:[
+ org := self origin
+ ].
+ vP := org extent:(self extent).
+ ^ WindowingTransformation window:window viewport:vP
+ ]
+ ].
+ ^ transformation
+!
+
+viewOrigin
+ "return the viewOrigin; thats the coordinate of the contents
+ which is shown topLeft in the view
+ (i.e. the origin of the visible part of the contents)."
+
+ transformation isNil ifTrue:[
+ ^ 0@0
+ ].
+ ^ transformation translation negated
+!
+
+viewRectangle
+ "return the inside area"
+
+ |m2|
+
+"/ innerClipRect notNil ifTrue:[
+"/ ^ innerClipRect
+"/ ].
+ m2 := margin + margin.
+
+ ^ (margin @ margin) extent:((width - m2) @ (height - m2))
+!
+
+viewport:aRectangle
+ "define my extend in my superviews coordinate-system."
+
+"/ |relW relH relX relY winW winH|
+
+ viewport := aRectangle.
+ self dimensionFromViewport
+"/
+"/ superView notNil ifTrue:[
+"/ superView window isNil ifTrue:[
+"/ winW := 1.
+"/ winH := 1
+"/ ] ifFalse:[
+"/ winW := superView window width.
+"/ winH := superView window height
+"/ ].
+"/ relW := (aRectangle width / winW) asFloat.
+"/ relH := (aRectangle height / winH) asFloat.
+"/ relX := (aRectangle left / winW) asFloat.
+"/ relY := (aRectangle top / winH) asFloat.
+"/ self origin:(relX @ relY) extent:(relW @ relH)
+"/ ]
+"/
+!
+
+widthOfContents
+
+ ^ self innerWidth max:(self maxSubViewRight)
+
+!
+
+window
+ "return my window (i.e. logical coordinate space).
+ If there is no window, return the extent."
+
+ window isNil ifTrue:[^ width @ height].
+ ^ window
+!
+
+window:aRectangle
+ "define my window (i.e. logical coordinate space)"
+
+ window := aRectangle.
+ subViews notNil ifTrue:[
+ subViews do:[:s |
+ s superViewChangedSize
+ ]
+ ]
+
+"
+ viewport isNil ifTrue:[
+ viewport := aRectangle.
+ ].
+"
+"
+ superView notNil ifTrue:[
+ self superViewChangedSize
+ ] ifFalse:[
+ originChanged := true.
+ extentChanged := true
+ ]
+"
+!
+
+window:aRectangle viewport:vRect
+ window := aRectangle.
+ self viewport:vRect.
+ subViews notNil ifTrue:[
+ subViews do:[:s |
+ s superViewChangedSize
+ ]
+ ]
+!
+
+xOriginOfContents
+ "return the x coordinate of the viewOrigin in pixels;
+ used by scrollBars to compute thumb position within the document."
+
+ ^ self viewOrigin x
+!
+
+yOriginOfContents
+ "return the y coordinate of the viewOrigin in pixels;
+ used by scrollBars to compute thumb position within the document."
+
+ ^ self viewOrigin y
+! !
+
+!SimpleView methodsFor:'adding & removing components'!
+
+add:aComponent
+ "add a component (either a view or gadget) to the collection of
+ subComponents."
+
+ self addComponent:aComponent
+!
+
+add:aComponent in:aRectangleOrLayoutFrame
+ "for ST-80 compatibility.
+ add a component in some frame; the argument may be either a rectangle
+ with relative coordinates, or an instance of LayoutFrame, specifying
+ both relative coordinates and the insets."
+
+"/ old code:
+"/ |origin corner l|
+"/
+"/ origin := aRectangleOrLayoutFrame origin.
+"/ origin := origin x asFloat @ origin y asFloat.
+"/ corner := aRectangleOrLayoutFrame corner.
+"/ corner := corner x asFloat @ corner y asFloat.
+"/ aComponent origin:origin corner:corner.
+"/
+"/ (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifFalse:[
+"/ aComponent leftInset:aRectangleOrLayoutFrame leftOffset.
+"/ aComponent rightInset:aRectangleOrLayoutFrame rightOffset negated.
+"/ aComponent topInset:aRectangleOrLayoutFrame topOffset.
+"/ aComponent bottomInset:aRectangleOrLayoutFrame bottomOffset negated.
+"/ ].
+
+"/ new (being validated):
+
+ |l|
+
+ (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifTrue:[
+ l := aRectangleOrLayoutFrame asLayout.
+ ] ifFalse:[
+ l := aRectangleOrLayoutFrame
+ ].
+
+"/ will soon be replaced by:
+"/ aComponent layout:l.
+ aComponent geometryLayout:l.
+
+ self addComponent:aComponent
+!
+
+addComponent:aComponent
+ "components (i.e. gadgets or lightweight views) are being prepared.
+ Dont use this right now for non-views"
+
+ aComponent isView ifTrue:[
+ self addSubView:aComponent
+ ] ifFalse:[
+ components isNil ifTrue:[
+ components := OrderedCollection new
+ ].
+ components add:aComponent.
+ aComponent setParentViewIn:self
+ ]
+!
+
+addSubView:newView
+ "add a view to the collection of subviews"
+
+ subViews isNil ifTrue:[
+ subViews := OrderedCollection with:newView
+ ] ifFalse:[
+ subViews add:newView.
+ ].
+ self setParentViewIn:newView.
+!
+
+addSubView:newView after:aView
+ "add a view to the collection of subviews after another view.
+ This makes sense, in Panels and other layout views, to enter a new
+ element at some defined place."
+
+ subViews isNil ifTrue:[
+ subViews := OrderedCollection with:newView
+ ] ifFalse:[
+ aView isNil ifTrue:[
+ subViews add:newView
+ ] ifFalse:[
+ subViews add:newView after:aView.
+ ]
+ ].
+ self setParentViewIn:newView.
+!
+
+addSubView:newView before:aView
+ "add a view to the collection of subviews before another view.
+ This makes sense, in Panels and other layout views, to enter a new
+ element at some defined place."
+
+ subViews isNil ifTrue:[
+ subViews := OrderedCollection with:newView
+ ] ifFalse:[
+ aView isNil ifTrue:[
+ subViews addFirst:newView
+ ] ifFalse:[
+ subViews add:newView before:aView.
+ ]
+ ].
+ self setParentViewIn:newView.
+!
+
+addSubView:aView in:bounds borderWidth:bw
+ "for ST-80 V2.x compatibility"
+
+ aView borderWidth:bw.
+ self add:aView in:bounds.
+!
+
+addSubView:aView viewport:aRectangle
+ "ST-80 V2.x compatibility:
+ Adds aView to the views list of subviews and uses the
+ existing subviews window and the new viewport to position it.
+ This method may be removed in future versions."
+
+ self addSubView:aView.
+ aView viewport:aRectangle
+!
+
+addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
+ "ST-80 V2.x compatibility:
+ Adds aView to the views list of subviews and uses
+ aWindowRectangle and aViewportRectangle to position it.
+ This method may be removed in future versions."
+
+ self addSubView:aView.
+ aView window:aWindowRectangle viewport:aViewportRectangle
+!
+
+component:aComponent
+ "components (i.e. gadgets or lightweight views) are being prepared.
+ Dont use this right now for non-views"
+
+ aComponent origin:0.0@0.0 corner:1.0@1.0.
+ aComponent isView ifTrue:[
+ self addSubView:aComponent
+ ] ifFalse:[
+ components := OrderedCollection with:aComponent.
+ aComponent setParentViewIn:self
+ ]
+!
+
+destroySubViews
+ "remove all subviews"
+
+ subViews notNil ifTrue:[
+ subViews copy do:[:aSubView |
+ aSubView destroy.
+ ]
+ ]
+
+ "Modified: 5.9.1995 / 22:35:36 / claus"
+!
+
+removeComponent:aComponent
+ "components (i.e. gadgets or lightweight views) are being prepared.
+ Dont use this right now for non-views"
+
+ aComponent isView ifTrue:[
+ self removeSubView:aComponent
+ ] ifFalse:[
+ components isNil ifTrue:[^self].
+ components remove:aComponent ifAbsent:[].
+ aComponent parent:nil
+ ]
+!
+
+removeSubView:aView
+ "remove a view from the collection of subviews"
+
+ subViews notNil ifTrue:[
+ subViews remove:aView ifAbsent:[nil].
+ (subViews size == 0) ifTrue:[
+ subViews := nil
+ ]
+ ]
+!
+
+setParentViewIn:aView
+ "common code for addSubView* methods"
+
+ aView superView:self.
+ (aView device ~~ device) ifTrue:[
+ 'VIEW: warning subview (' errorPrint. aView class name errorPrint.
+ ') has different device than me (' errorPrint.
+ self class name errorPrint. ').' errorPrintNL.
+ aView device:device
+ ]
+! !
+
+!SimpleView methodsFor:'change & update'!
+
+update:aspect with:aParameter from:changedObject
+ "an update request"
+
+ aspect == #sizeOfView ifTrue:[
+ "one of the views we depend on changed its size"
+ ^ self superViewChangedSize.
+ ].
+ ^super update:aspect with:aParameter from:changedObject
+! !
+
+!SimpleView methodsFor:'copying'!
+
+shallowCopyForFinalization
+ "redefined for faster creation of finalization copies
+ (only device, gcId and drawableId are needed)"
+
+ |aCopy|
+
+ aCopy := DeviceViewHandle basicNew.
+ aCopy setDevice:device id:drawableId gcId:gcId.
+ ^ aCopy
+! !
+
+!SimpleView methodsFor:'cursor animation'!
+
+showBusyWhile:aBlock
+ "evaluate some time consuming block, while doing this,
+ show a spinning wheel cursor"
+
+ |ok bitmaps cursors mask process oldCursor|
+
+ oldCursor := cursor.
+
+ ok := true.
+ bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4')
+ collect:[:name |
+ |f|
+
+ f := Form fromFile:(name , '.xbm').
+ f isNil ifTrue:[
+ ('no bitmap file: ' , name , '.xbm') errorPrintNL.
+ ok := false
+ ].
+ f
+ ].
+
+ mask := Form fromFile:'wheelm.xbm'.
+ mask isNil ifTrue:[
+ ('no bitmap file: ' , mask , '.xbm') errorPrintNL.
+ ok := false
+ ].
+
+ ok ifFalse:[
+ self cursor:Cursor wait.
+ aBlock valueNowOrOnUnwindDo:[
+ self cursor:oldCursor
+ ]
+ ] ifTrue:[
+ cursors := bitmaps collect:[:form | (Cursor sourceForm:form
+ maskForm:mask
+ hotX:8
+ hotY:8) on:device].
+
+ process := [
+ (Delay forSeconds:0.25) wait.
+ [true] whileTrue:[
+ cursors do:[:curs |
+ self cursor:curs.
+ (Delay forSeconds:0.05) wait
+ ]
+ ]
+ ] fork.
+
+ Processor activeProcess priority:7.
+ aBlock valueNowOrOnUnwindDo:[
+ Processor activeProcess priority:8.
+ process terminate.
+ self cursor:oldCursor
+ ]
+ ].
+
+ "
+ View new realize showBusyWhile:[10 timesRepeat:[3000 factorial]]
+ "
+! !
+
+!SimpleView methodsFor:'edge drawing'!
+
+drawBottomEdge
+ "draw bottom 3D edge into window frame"
+
+ self drawBottomEdgeLevel:level
+ shadow:shadowColor
+ light:lightColor
+ halfShadow:nil
+ halfLight:nil
+ style:nil.
+!
+
+drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
+ |botFg
+ count "{ Class: SmallInteger }"
+ b r|
+
+ count := level.
+ count == 0 ifTrue:[^ self].
+
+ (count < 0) ifTrue:[
+ botFg := lightColor.
+ count := count negated
+ ] ifFalse:[
+ ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+ botFg := halfShadowColor
+ ] ifFalse:[
+ botFg := shadowColor
+ ].
+ ].
+ super paint:botFg.
+ super lineWidth:0.
+
+ r := width - 1.
+ 0 to:(count - 1) do:[:i |
+ b := height - 1 - i.
+ super displayDeviceLineFromX:i y:b toX:(r - i) y:b
+ ].
+
+ ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+ b := height - 1.
+ super paint:shadowColor.
+ super displayDeviceLineFromX:1 y:b toX:r y:b.
+ ]
+!
+
+drawEdges
+ "draw all of my 3D edges"
+
+ self drawEdgesForX:0 y:0 width:width height:height level:level
+ shadow:shadowColor
+ light:lightColor
+ halfShadow:nil
+ halfLight:nil
+ style:nil
+!
+
+drawEdgesForX:x y:y width:w height:h level:l
+ "draw 3D edges into a rectangle"
+
+ self drawEdgesForX:x y:y width:w height:h level:l
+ shadow:shadowColor
+ light:lightColor
+ halfShadow:nil
+ halfLight:nil
+ style:nil
+!
+
+drawEdgesForX:x y:y width:w height:h level:l
+ shadow:shadowColor light:lightColor
+ halfShadow:halfShadowColor halfLight:halfLightColor
+ style:edgeStyle
+
+ "draw 3D edges into a rectangle"
+
+ |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
+ count "{ Class: SmallInteger }"
+ r "{ Class: SmallInteger }"
+ b "{ Class: SmallInteger }"
+ xi "{ Class: SmallInteger }"
+ yi "{ Class: SmallInteger }"
+ run paint|
+
+ count := l.
+ (count < 0) ifTrue:[
+ topLeftFg := shadowColor.
+ botRightFg := lightColor.
+ topLeftHalfFg := halfShadowColor.
+ botRightHalfFg := halfLightColor.
+ count := count negated
+ ] ifFalse:[
+ topLeftFg := lightColor.
+ botRightFg := shadowColor.
+ topLeftHalfFg := halfLightColor.
+ botRightHalfFg := halfShadowColor.
+ ].
+ topLeftHalfFg isNil ifTrue:[
+ topLeftHalfFg := topLeftFg
+ ].
+ botRightHalfFg isNil ifTrue:[
+ botRightHalfFg := botRightFg
+ ].
+
+ r := x + w - 1. "right"
+ b := y + h - 1. "bottom"
+
+ super lineWidth:0.
+
+ "top and left edges"
+ ((edgeStyle == #soft) and:["l" count > 0]) ifTrue:[
+ paint := topLeftHalfFg
+ ] ifFalse:[
+ paint := topLeftFg
+ ].
+ super paint:paint.
+
+ 0 to:(count - 1) do:[:i |
+ run := y + i.
+ super displayDeviceLineFromX:x y:run toX:r y:run. "top"
+ run := x + i.
+ super displayDeviceLineFromX:run y:y toX:run y:b "left"
+ ].
+ (edgeStyle == #soft) ifTrue:[
+"
+ super paint:topLeftFg.
+ super displayDeviceLineFromX:x y:y toX:r y:y.
+ super displayDeviceLineFromX:x y:y toX:x y:b
+"
+ (l > 2) ifTrue:[
+ super paint:Black.
+ super displayDeviceLineFromX:x y:y toX:r y:y.
+ super displayDeviceLineFromX:x y:y toX:x y:b.
+ ]
+ ].
+
+ xi := x + 1.
+ yi := y + 1.
+
+"/ does not look good
+"/ style == #st80 iftrue:[
+"/ yi := yi + 1
+"/ ].
+
+ "bottom and right edges"
+ (edgeStyle == #soft "new:" and:[count > 1]) ifTrue:[
+ paint := botRightHalfFg
+ ] ifFalse:[
+ paint := botRightFg
+ ].
+
+ super paint:paint.
+ 0 to:(count - 1) do:[:i |
+ run := b - i.
+ super displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
+ run := r - i.
+ super displayDeviceLineFromX:run y:yi-1 toX:run y:b. "right"
+ xi := xi + 1.
+ yi := yi + 1
+ ].
+ ((edgeStyle == #soft) and:[l > 1]) ifTrue:[
+ super paint:Black "shadowColor".
+ super displayDeviceLineFromX:(x + (1 - 1)) y:b toX:r y:b.
+ super displayDeviceLineFromX:r y:(y + (1 - 1)) toX:r y:b
+ ]
+!
+
+drawLeftEdge
+ "draw left 3D edge into window frame"
+
+ self drawLeftEdgeLevel:level
+ shadow:shadowColor
+ light:lightColor
+ halfShadow:nil
+ halfLight:nil
+ style:nil.
+!
+
+drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
+ |leftFg leftHalfFg paint b
+ count "{ Class: SmallInteger }" |
+
+ count := level.
+ count == 0 ifTrue:[^ self].
+
+ (count < 0) ifTrue:[
+ leftFg := shadowColor.
+ leftHalfFg := halfShadowColor.
+ count := count negated.
+ ] ifFalse:[
+ leftFg := lightColor.
+ leftHalfFg := halfLightColor.
+ ].
+ leftHalfFg isNil ifTrue:[
+ leftHalfFg := leftFg
+ ].
+
+ ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
+ paint := leftHalfFg
+ ] ifFalse:[
+ paint := leftFg
+ ].
+ super paint:paint.
+ super lineWidth:0.
+
+ b := height - 1.
+ 0 to:(count - 1) do:[:i |
+ super displayDeviceLineFromX:i y:i toX:i y:(b - i)
+ ].
+
+ ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
+ super paint:Black.
+ super displayDeviceLineFromX:0 y:0 toX:0 y:b.
+ ]
+!
+
+drawRightEdge
+ "draw right 3D edge into window frame"
+
+ self drawRightEdgeLevel:level
+ shadow:shadowColor
+ light:lightColor
+ halfShadow:nil
+ halfLight:nil
+ style:nil.
+!
+
+drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
+ |rightFg
+ count "{ Class: SmallInteger }"
+ r b|
+
+ count := level.
+ count == 0 ifTrue:[^ self].
+
+ (count < 0) ifTrue:[
+ rightFg := lightColor.
+ count := count negated
+ ] ifFalse:[
+ ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+ rightFg := halfShadowColor
+ ] ifFalse:[
+ rightFg := shadowColor
+ ].
+ ].
+ super paint:rightFg.
+ super lineWidth:0.
+
+ b := height - 1.
+ 0 to:(count - 1) do:[:i |
+ r := width - 1 - i.
+ super displayDeviceLineFromX:r y:i toX:r y:(b - i)
+ ].
+ ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
+ r := width - 1.
+ super paint:shadowColor.
+ super displayDeviceLineFromX:r y:1 toX:r y:b.
+ ]
+!
+
+drawTopEdge
+ "draw top 3D edge into window frame"
+
+ self drawTopEdgeLevel:level
+ shadow:shadowColor
+ light:lightColor
+ halfShadow:nil
+ halfLight:nil
+ style:nil.
+!
+
+drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
+ |topFg topHalfFg paint r
+ count "{ Class: SmallInteger }" |
+
+ count := level.
+ count == 0 ifTrue:[^ self].
+
+ (count < 0) ifTrue:[
+ topFg := shadowColor.
+ topHalfFg := halfShadowColor.
+ count := count negated
+ ] ifFalse:[
+ topFg := lightColor.
+ topHalfFg := halfLightColor.
+ ].
+ topHalfFg isNil ifTrue:[
+ topHalfFg := topFg
+ ].
+
+ ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
+ paint := topHalfFg
+ ] ifFalse:[
+ paint := topFg
+ ].
+ super paint:paint.
+ super lineWidth:0.
+
+ r := width - 1.
+ 0 to:(count - 1) do:[:i |
+ super displayDeviceLineFromX:i y:i toX:(r - i) y:i
+ ].
+ ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
+ super paint:Black.
+ super displayDeviceLineFromX:0 y:0 toX:r y:0.
+ ]
+!
+
+redrawEdges
+ "redraw my edges (if any)"
+
+ (level ~~ 0) ifTrue:[
+ shown ifTrue:[
+ self clipRect:nil.
+ self drawEdges.
+ self clipRect:innerClipRect
+ ]
+ ]
+! !
+
+!SimpleView methodsFor:'enumerating subviews'!
+
+allSubViewsDo:aBlock
+ "evaluate aBlock for all subviews (recursively)"
+
+ (subViews isNil or:[subViews isEmpty]) ifFalse:[
+ subViews do:[:aSubview |
+ aSubview withAllSubViewsDo:aBlock
+ ]
+ ]
+!
+
+withAllSubViewsDo:aBlock
+ "evaluate aBlock for the receiver and all subviews (recursively)"
+
+ aBlock value:self.
+ self allSubViewsDo:aBlock
! !
!SimpleView methodsFor:'event handling'!
-mapped
- "the view has been mapped (by some outside
- action - i.e. window manager de-iconified me)"
-
- "
- the old code was:
-
- realized := true.
- shown := true.
- ...
-
- this created a race condition, if the view was
- realized and shortly after unrealized - before the mapped event
- arrived. This lead to shown being set to true even thought the
- view was not. Boy - that was a bad one (hard to reproduce and hard to find).
- "
-
- realized ifTrue:[
- shown := true.
- "
- backed views will not get expose events - have
- to force a redraw here to get things drawn into
- backing store.
- "
- backed ifTrue:[
- self redraw
- ].
- subViews notNil ifTrue:[
- subViews do:[:v |
- v superViewMapped
+buttonPress:button x:x y:y
+ "button was pressed - if its the middle button
+ and there is a middleButtonMenu, show it.
+ If both a model and a menuSelector is is defined, ask the model for
+ the menu and launch it. The menu is supposed to return an actionSelector
+ which in turn is sent to the model."
+
+ |menu menuPerformer actionSelector actionArg|
+
+ components notNil ifTrue:[
+ components do:[:aComponent |
+ |thisFrame|
+
+ thisFrame := aComponent frame.
+ (thisFrame containsPointX:x y:y) ifTrue:[
+ aComponent buttonPress:button x:x - thisFrame left
+ y:y - thisFrame top.
+ ^ self
]
]
- ]
-!
-
-superViewChangedSize
- "my superView has changed size; if I have relative
- origin/extent or blocks to evaluate, do it now .."
-
- |oldWidth oldHeight oldTop oldLeft newExt newOrg
- winSuper newWidth newHeight newLeft newTop
- superWidth superHeight superWinWidth superWinHeight
- r|
-
- oldWidth := width.
- oldHeight := height.
- oldTop := top.
- oldLeft := left.
-
- "
- if this view has a viewPort, resize a la ST-80 V2.x
- this will vanish - dont use it.
- "
- viewport notNil ifTrue:[
- superView isNil ifTrue:[^ self].
- winSuper := superView window.
- winSuper isNil ifTrue:[
- "take pixel size as window"
- winSuper := 0@0 extent:(superView width@superView height)
- ].
-
- superWidth := superView width.
- superHeight := superView height.
- superWinWidth := winSuper width.
- superWinHeight := winSuper height.
- newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
- newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
- newWidth := superWidth * viewport width // superWinWidth.
- newHeight := superHeight * viewport height // superWinHeight.
- self pixelOrigin:(newLeft @ newTop).
- self pixelExtent:(newWidth @ newHeight).
- ^ self
].
- "
- slowly migrating to use layoutObjects ...
- "
- layout isNil ifTrue:[
- newOrg := self computeOrigin.
- newExt := self computeExtent.
- ] ifFalse:[
- r := (layout rectangleRelativeTo:(superView viewRectangle)
- preferred:(self preferredBounds)).
- newOrg := r origin rounded.
- newExt := r extent rounded.
-"/ newOrg printNL.
-"/ newExt printNL.
- ].
-
- newOrg notNil ifTrue:[
- ((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
- newOrg := nil
- ]
+ ((button == 2) or:[button == #menu]) ifTrue:[
+ "
+ try ST-80 style menus first:
+ if there is a model, and a menuMessage is defined,
+ ask model for the menu and launch that if non-nil.
+ "
+ menu := self yellowButtonMenu.
+ menu notNil ifTrue:[
+ "
+ got one, launch the menu. It is supposed
+ to return an actionSelector.
+ "
+ menuPerformer := self menuPerformer.
+ "
+ a temporary kludge: subMenus dont know about
+ actionSelectors yet ...
+ "
+ menu receiver isNil ifTrue:[
+ menu receiver:menuPerformer
+ ].
+ actionSelector := menu startUp.
+
+ "
+ mhmh - kludge for selectors with argument
+ "
+ (actionSelector isMemberOf:Array) ifTrue:[
+ actionArg := actionSelector at:2.
+ actionSelector := actionSelector at:1.
+ ].
+
+ "
+ mhmh - ST-80 seems to send some to the model and
+ others (copy/cut/paste) to the controller/view
+ Simulate this behavior, by looking what the model responds to.
+ "
+ (actionSelector notNil
+ and:[actionSelector isSymbol]) ifTrue:[
+ (menuPerformer respondsTo:actionSelector) ifFalse:[
+ (self respondsTo:actionSelector) ifTrue:[
+ menuPerformer := self
+ ]
+ ].
+ actionSelector numArgs ~~ 0 ifTrue:[
+ menuPerformer perform:actionSelector with:actionArg
+ ] ifFalse:[
+ menuPerformer perform:actionSelector
+ ]
+ ].
+ ^ self
+ ].
].
- newExt notNil ifTrue:[
- ((newExt x == width) and:[newExt y == height]) ifTrue:[
- newExt := nil
- ]
- ].
-
- newExt isNil ifTrue:[
- newOrg notNil ifTrue:[
- self pixelOrigin:newOrg
- ]
- ] ifFalse:[
- newOrg isNil ifTrue:[
- self pixelExtent:newExt
- ] ifFalse:[
- self pixelOrigin:newOrg extent:newExt
- ]
- ]
-!
-
-subViewChangedSize
- "some subview has changed its size; we are not interrested
- in that here, but some geometry managers redefine this, to reorganize
- components if that happens."
-
- ^ self
-
- "Created: 22.9.1995 / 14:44:59 / claus"
+ super buttonPress:button x:x y:y
!
configureX:x y:y width:newWidth height:newHeight
@@ -1604,6 +3195,18 @@
]
!
+coveredBy:aView
+ "the receiver has been covered by another view;
+ we are not interrested in that here (but see modalBox for more)."
+!
+
+destroyed
+ "view has been destroyed by someone else (usually window system)"
+
+ shown := false.
+ super destroyed
+!
+
exposeX:x y:y width:w height:h
"a low level redraw event from device
- let subclass handle the redraw and take care of edges here"
@@ -1715,79 +3318,19 @@
]
!
-superViewMapped
- "my superview was mapped (became visible)"
-
- realized ifTrue:[
- shown := true.
- subViews notNil ifTrue:[
- subViews do:[:v |
- v superViewMapped
- ]
- ]
- ].
-!
-
-unmapped
- "the view has been unmapped
- (either by some outside action - i.e. window manager iconified me,
- or due to unmapping of my parentView)"
-
- shown := false.
- subViews notNil ifTrue:[
- subViews do:[:v |
- v superViewUnmapped
- ]
- ]
-!
-
-coveredBy:aView
- "the receiver has been covered by another view;
- we are not interrested in that here (but see modalBox for more)."
-!
-
-superViewUnmapped
- "my superView was unmapped"
-
- self unmapped
-!
-
-sizeChanged:how
- "tell subviews if I change size.
- How is either #smaller, #larger or nil, and is used to control the order,
- in which subviews are notified (possibly reducing redraw activity)"
-
- window notNil ifTrue:[
- "compute new transformation"
- ].
- subViews notNil ifTrue:[
- (how isNil "false"
- or:[how == #smaller]) ifTrue:[
- subViews do:[:view |
- view superViewChangedSize
- ]
- ] ifFalse:[
- "doing it reverse speeds up resizing - usually subviews
- are created from top-left to bottom-right; therefore
- bottom-right views will be moved/resized first, then top-left ones;
- this avoids multiple redraws of subviews"
-
- subViews reverseDo:[:view |
- view superViewChangedSize
- ]
- ]
- ].
- self changed:#sizeOfView with:how.
- superView notNil ifTrue:[
- superView subViewChangedSize
- ]
-!
-
-reparented
- "the view has changed its parent by some outside
- action - i.e. window manager has added a frame.
- nothing done here"
-
+focusIn
+ "got keyboard focus"
+
+ self showFocus
+!
+
+focusOut
+ "lost keyboard focus"
+
+ self showNoFocus
+!
+
+hasKeyboardFocus:aBoolean
^ self
!
@@ -1821,90 +3364,218 @@
]
!
-buttonPress:button x:x y:y
- "button was pressed - if its the middle button
- and there is a middleButtonMenu, show it.
- If both a model and a menuSelector is is defined, ask the model for
- the menu and launch it. The menu is supposed to return an actionSelector
- which in turn is sent to the model."
-
- |menu menuPerformer actionSelector actionArg|
-
- components notNil ifTrue:[
- components do:[:aComponent |
- |thisFrame|
-
- thisFrame := aComponent frame.
- (thisFrame containsPointX:x y:y) ifTrue:[
- aComponent buttonPress:button x:x - thisFrame left
- y:y - thisFrame top.
- ^ self
+mapped
+ "the view has been mapped (by some outside
+ action - i.e. window manager de-iconified me)"
+
+ "
+ the old code was:
+
+ realized := true.
+ shown := true.
+ ...
+
+ this created a race condition, if the view was
+ realized and shortly after unrealized - before the mapped event
+ arrived. This lead to shown being set to true even thought the
+ view was not. Boy - that was a bad one (hard to reproduce and hard to find).
+ "
+
+ realized ifTrue:[
+ shown := true.
+ "
+ backed views will not get expose events - have
+ to force a redraw here to get things drawn into
+ backing store.
+ "
+ backed ifTrue:[
+ self redraw
+ ].
+ subViews notNil ifTrue:[
+ subViews do:[:v |
+ v superViewMapped
+ ]
+ ]
+ ]
+!
+
+reparented
+ "the view has changed its parent by some outside
+ action - i.e. window manager has added a frame.
+ nothing done here"
+
+ ^ self
+!
+
+saveAndTerminate
+ "window manager wants me to save and go away;
+ - notice, that not all window managers are nice enough to
+ send this event, but simply destroy the view instead.
+ Can be redefined in subclasses to do whatever is required
+ to prepare for restart."
+
+ ^ self destroy
+!
+
+sizeChanged:how
+ "tell subviews if I change size.
+ How is either #smaller, #larger or nil, and is used to control the order,
+ in which subviews are notified (possibly reducing redraw activity)"
+
+ window notNil ifTrue:[
+ "compute new transformation"
+ ].
+ subViews notNil ifTrue:[
+ (how isNil "false"
+ or:[how == #smaller]) ifTrue:[
+ subViews do:[:view |
+ view superViewChangedSize
+ ]
+ ] ifFalse:[
+ "doing it reverse speeds up resizing - usually subviews
+ are created from top-left to bottom-right; therefore
+ bottom-right views will be moved/resized first, then top-left ones;
+ this avoids multiple redraws of subviews"
+
+ subViews reverseDo:[:view |
+ view superViewChangedSize
]
]
].
-
- ((button == 2) or:[button == #menu]) ifTrue:[
- "
- try ST-80 style menus first:
- if there is a model, and a menuMessage is defined,
- ask model for the menu and launch that if non-nil.
- "
- menu := self yellowButtonMenu.
- menu notNil ifTrue:[
- "
- got one, launch the menu. It is supposed
- to return an actionSelector.
- "
- menuPerformer := self menuPerformer.
- "
- a temporary kludge: subMenus dont know about
- actionSelectors yet ...
- "
- menu receiver isNil ifTrue:[
- menu receiver:menuPerformer
- ].
- actionSelector := menu startUp.
-
- "
- mhmh - kludge for selectors with argument
- "
- (actionSelector isMemberOf:Array) ifTrue:[
- actionArg := actionSelector at:2.
- actionSelector := actionSelector at:1.
- ].
-
- "
- mhmh - ST-80 seems to send some to the model and
- others (copy/cut/paste) to the controller/view
- Simulate this behavior, by looking what the model responds to.
- "
- (actionSelector notNil
- and:[actionSelector isSymbol]) ifTrue:[
- (menuPerformer respondsTo:actionSelector) ifFalse:[
- (self respondsTo:actionSelector) ifTrue:[
- menuPerformer := self
- ]
- ].
- actionSelector numArgs ~~ 0 ifTrue:[
- menuPerformer perform:actionSelector with:actionArg
- ] ifFalse:[
- menuPerformer perform:actionSelector
- ]
- ].
- ^ self
+ self changed:#sizeOfView with:how.
+ superView notNil ifTrue:[
+ superView subViewChangedSize
+ ]
+!
+
+subViewChangedSize
+ "some subview has changed its size; we are not interrested
+ in that here, but some geometry managers redefine this, to reorganize
+ components if that happens."
+
+ ^ self
+
+ "Created: 22.9.1995 / 14:44:59 / claus"
+!
+
+superViewChangedSize
+ "my superView has changed size; if I have relative
+ origin/extent or blocks to evaluate, do it now .."
+
+ |oldWidth oldHeight oldTop oldLeft newExt newOrg
+ winSuper newWidth newHeight newLeft newTop
+ superWidth superHeight superWinWidth superWinHeight
+ r|
+
+ oldWidth := width.
+ oldHeight := height.
+ oldTop := top.
+ oldLeft := left.
+
+ "
+ if this view has a viewPort, resize a la ST-80 V2.x
+ this will vanish - dont use it.
+ "
+ viewport notNil ifTrue:[
+ superView isNil ifTrue:[^ self].
+ winSuper := superView window.
+ winSuper isNil ifTrue:[
+ "take pixel size as window"
+ winSuper := 0@0 extent:(superView width@superView height)
].
+
+ superWidth := superView width.
+ superHeight := superView height.
+ superWinWidth := winSuper width.
+ superWinHeight := winSuper height.
+ newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
+ newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
+ newWidth := superWidth * viewport width // superWinWidth.
+ newHeight := superHeight * viewport height // superWinHeight.
+ self pixelOrigin:(newLeft @ newTop).
+ self pixelExtent:(newWidth @ newHeight).
+ ^ self
].
- super buttonPress:button x:x y:y
-!
-
-hasKeyboardFocus:aBoolean
- ^ self
-!
-
-focusIn
- "got keyboard focus"
-
- self showFocus
+
+ "
+ slowly migrating to use layoutObjects ...
+ "
+ layout isNil ifTrue:[
+ newOrg := self computeOrigin.
+ newExt := self computeExtent.
+ ] ifFalse:[
+ r := (layout rectangleRelativeTo:(superView viewRectangle)
+ preferred:(self preferredBounds)).
+ newOrg := r origin rounded.
+ newExt := r extent rounded.
+"/ newOrg printNL.
+"/ newExt printNL.
+ ].
+
+ newOrg notNil ifTrue:[
+ ((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
+ newOrg := nil
+ ]
+ ].
+ newExt notNil ifTrue:[
+ ((newExt x == width) and:[newExt y == height]) ifTrue:[
+ newExt := nil
+ ]
+ ].
+
+ newExt isNil ifTrue:[
+ newOrg notNil ifTrue:[
+ self pixelOrigin:newOrg
+ ]
+ ] ifFalse:[
+ newOrg isNil ifTrue:[
+ self pixelExtent:newExt
+ ] ifFalse:[
+ self pixelOrigin:newOrg extent:newExt
+ ]
+ ]
+!
+
+superViewMapped
+ "my superview was mapped (became visible)"
+
+ realized ifTrue:[
+ shown := true.
+ subViews notNil ifTrue:[
+ subViews do:[:v |
+ v superViewMapped
+ ]
+ ]
+ ].
+!
+
+superViewUnmapped
+ "my superView was unmapped"
+
+ self unmapped
+!
+
+terminate
+ "window manager wants me to go away;
+ - notice, that not all window managers are nice enough to
+ send this event, but simply destroy the view instead.
+ Can be redefined in subclasses to do whatever cleanup is
+ required."
+
+ ^ self destroy
+!
+
+unmapped
+ "the view has been unmapped
+ (either by some outside action - i.e. window manager iconified me,
+ or due to unmapping of my parentView)"
+
+ shown := false.
+ subViews notNil ifTrue:[
+ subViews do:[:v |
+ v superViewUnmapped
+ ]
+ ]
!
visibilityChange:how
@@ -1917,50 +3588,218 @@
] ifFalse:[
shown := true.
]
-!
-
-focusOut
- "lost keyboard focus"
-
- self showNoFocus
-!
-
-destroyed
- "view has been destroyed by someone else (usually window system)"
-
- shown := false.
- super destroyed
-!
-
-terminate
- "window manager wants me to go away;
- - notice, that not all window managers are nice enough to
- send this event, but simply destroy the view instead.
- Can be redefined in subclasses to do whatever cleanup is
- required."
-
- ^ self destroy
-!
-
-saveAndTerminate
- "window manager wants me to save and go away;
- - notice, that not all window managers are nice enough to
- send this event, but simply destroy the view instead.
- Can be redefined in subclasses to do whatever is required
- to prepare for restart."
-
- ^ self destroy
+! !
+
+!SimpleView methodsFor:'informing others of changes'!
+
+contentsChanged
+ "this one is sent, whenever contents changes size -
+ tell dependents about the change (i.e. scrollers)."
+
+ self changed:#sizeOfContents
+!
+
+originChanged:delta
+ "this one is sent, after the origin of my contents has changed -
+ tell dependents (i.e. scrollers) about this"
+
+ self changed:#originOfContents with:delta.
+"/ subViews notNil ifTrue:[
+"/ subViews do:[:aSubView |
+"/ aSubView pixelOrigin:((aSubView left @ aSubView top) - delta)
+"/ ]
+"/ ]
+!
+
+originWillChange
+ "this one is sent, just before viewOrigin changes -
+ gives subclasses a chance to catch scrolls easily
+ (for example to hide cursor before scroll)"
+
+ ^ self
+! !
+
+!SimpleView methodsFor:'initialization'!
+
+defaultControllerClass
+ ^ nil "/ Controller
+!
+
+initEvents
+ "will be sent by create - can be redefined by subclasses to enable
+ view events"
+
+ ^ self
+!
+
+initStyle
+ "this method sets up all style dependent things"
+
+ self initStyleSheet.
+
+ borderWidth := DefaultBorderWidth.
+ borderWidth isNil ifTrue:[borderWidth := 1].
+
+ viewBackground := DefaultViewBackgroundColor.
+
+ DefaultLightColor notNil ifTrue:[
+ lightColor := DefaultLightColor.
+ ] ifFalse:[
+ device hasGreyscales ifTrue:[
+ DefaultLightColor := lightColor := viewBackground lightened.
+ ] ifFalse:[
+ "
+ this seems strange: on B&W screens, we create the light color
+ darker than normal viewBackground (White) -
+ to make the boundary of the view visible
+ "
+ lightColor := Color grey:50
+ ]
+ ].
+ DefaultShadowColor notNil ifTrue:[
+ shadowColor := DefaultShadowColor.
+ ] ifFalse:[
+ shadowColor := Black
+ ].
+
+ lightColor := lightColor.
+ shadowColor := shadowColor.
+ borderColor := DefaultBorderColor.
+ font := DefaultFont.
+!
+
+initStyleSheet
+ "this method gets the styleSheet"
+
+ "
+ when coming here the first time, we read the styleSheet
+ and keep the values in fast class variables
+ "
+ StyleSheet isNil ifTrue:[
+ self class updateStyleCache
+ ].
+
+ styleSheet := StyleSheet.
+!
+
+initialize
+ "initialize all state of the view - usually redefined in subclasses,
+ but always doing a 'super initialize'. Each class should setup its
+ locals - and not forget the others.
+ View setup is separated into two parts, the general setup done here
+ and the style specific setup in initStyle. Each view should be prepared
+ for a stylechange by being sent another initStyle with a new style value.
+ (in this case, it should set all of its style-dependent things, but
+ leave the state and contents as-is)"
+
+ |ext myClass controllerClass|
+
+ super initialize.
+
+ font := DefaultFont.
+
+ shown := hiddenOnRealize := realized := false.
+
+ "fill in some defaults - some of them are usually redefined in subclasses
+ initialize methods"
+
+ myClass := self class.
+ name := myClass name "asString" asLowercaseFirst.
+ ext := myClass defaultExtent.
+ resources := myClass classResources.
+
+ level := margin := 0.
+ margin := 0.
+
+ self initStyle.
+
+ left := top := 0.
+ width := ext x.
+ height := ext y.
+
+ originChanged := extentChanged := false.
+ bitGravity := nil.
+ viewGravity := nil.
+
+ controllerClass := self defaultControllerClass.
+ controllerClass notNil ifTrue:[
+ controller := controllerClass new.
+ controller view:self.
+ ].
+!
+
+initializeMiddleButtonMenu
+ "a place to initialize menu - this one is sent once when the view is
+ first created; usually redefined in subclasses; default here is no menu.
+ Notice, that static middleButtonmenus are a historic thing in ST/X;
+ you may prefer to create the menu dynamically (i.e. the ST-80 way)."
+
+ ^ self
+!
+
+prepareForReinit
+ super prepareForReinit.
+ windowGroup notNil ifTrue:[
+ windowGroup reinitialize
+ ]
+!
+
+reinitStyle
+ "this method is called for a style change"
+
+ |t|
+
+ self initStyle.
+ drawableId notNil ifTrue:[
+ "force a change"
+ t := borderWidth. borderWidth := nil. self borderWidth:t.
+ t := viewBackground. viewBackground := nil. self viewBackground:t.
+ self clear.
+ self redraw
+ ].
+!
+
+reinitialize
+ "this is called right snapIn"
+
+ |myController|
+
+ "if I have already been reinited - return"
+ drawableId notNil ifTrue:[
+ ^ self
+ ].
+
+ "
+ superView must be there, first
+ "
+ superView notNil ifTrue:[
+ superView id isNil ifTrue:[
+ superView reinitialize
+ ]
+ ].
+
+ myController := controller.
+ controller := nil.
+ self recreate.
+
+ "if I was mapped, do it again"
+ realized ifTrue:[
+ "only remap if I have a superview - otherwise, I might be
+ a hidden iconView or menu ..."
+ superView notNil ifTrue:[
+"/ shown ifTrue:[
+ device mapView:self id:drawableId iconified:false
+ atX:left y:top width:width height:height
+"/ ].
+ ].
+ ].
+
+ "restore controller"
+ controller := myController
! !
!SimpleView methodsFor:'private'!
-setInnerClip
- "compute, and set the inside clip-area"
-
- self computeInnerClip.
- self clipRect:innerClipRect
-!
-
computeInnerClip
"compute, but do not set the inside clip-area"
@@ -1988,6 +3827,240 @@
]
!
+cornerFromRelativeCorner
+ "compute & return pixel corner from relativeCorner"
+
+ ^ self cornerFromRelativeCorner:relativeCorner
+!
+
+cornerFromRelativeCorner:aPoint
+ "compute & return pixel corner from a relativeCorner, aPoint"
+
+ |p r b bw|
+
+ p := self pointFromRelative:aPoint.
+
+ bw := borderWidth.
+ insets isNil ifTrue:[
+ bw == 0 ifTrue:[
+ ^ p
+ ].
+ ^ (p x - bw) @ (p y - bw)
+ ].
+ r := (insets at:3) + bw.
+ b := (insets at:4) + bw.
+
+"/ r := b := bw.
+"/ rightInset notNil ifTrue:[
+"/ r := rightInset + bw
+"/ ].
+"/ bottomInset notNil ifTrue:[
+"/ b := bottomInset + bw
+"/ ].
+ ((r ~~ 0) or:[b ~~ 0]) ifTrue:[
+ ^ (p x - r) @ (p y - b)
+ ].
+ ^ p
+!
+
+dimensionFromViewport
+ "define my origin/extend from viewport"
+
+ |relW relH relX relY winW winH org ext|
+
+ superView notNil ifTrue:[
+ superView window isNil ifTrue:[
+"
+ v := superView.
+ (v notNil and:[v window isNil]) whileTrue:[
+ v := v superview
+ ].
+ v notNil ifTrue:[
+ w := v window
+ ].
+"
+"
+ winW := 1.
+ winH := 1
+"
+ winW := superView width.
+ winH := superView height.
+
+ ] ifFalse:[
+ winW := superView window width.
+ winH := superView window height
+ ].
+ relW := (viewport width / winW) asFloat.
+ relH := (viewport height / winH) asFloat.
+ relX := (viewport left / winW) asFloat.
+ relY := (viewport top / winH) asFloat.
+ "bad coding style ... misuse other method"
+ relativeOrigin := (relX @ relY).
+ org := self originFromRelativeOrigin.
+ relativeOrigin := nil.
+
+ "bad coding style ...misuse other method"
+ relativeExtent := (relW @ relH).
+ ext := self extentFromRelativeExtent.
+ relativeExtent := nil.
+
+ self pixelOrigin:org extent:ext.
+ ]
+!
+
+extentFromRelativeExtent
+ "compute & return pixel extent from relativeExtent"
+
+ ^ self extentFromRelativeExtent:relativeExtent
+!
+
+extentFromRelativeExtent:aPoint
+ "compute & return pixel extent from relativeExtent, aPoint"
+
+ |rel newX newY inRect bw2 i|
+
+ superView isNil ifTrue:[
+ inRect := 0@0 extent:device extent
+ ] ifFalse:[
+ inRect := superView viewRectangle.
+ ].
+
+ bw2 := borderWidth * 2.
+
+ rel := aPoint x.
+ rel isInteger ifFalse:[
+ newX := (rel * (inRect width + bw2)) asInteger + inRect left.
+ (borderWidth ~~ 0) ifTrue:[
+ newX := newX - borderWidth
+ ].
+ ] ifTrue:[
+ newX := rel
+ ].
+
+ rel := aPoint y.
+ rel isInteger ifFalse:[
+ newY := (rel * (inRect height + bw2)) asInteger + inRect top.
+ (borderWidth ~~ 0) ifTrue:[
+ newY := newY - borderWidth
+ ].
+ ] ifTrue:[
+ newY := rel
+ ].
+
+ insets notNil ifTrue:[
+ i := insets at:1. "top"
+ (i ~~ 0) ifTrue:[
+ newX := newX - i
+ ].
+ i := insets at:3. "left"
+ (i ~~ 0) ifTrue:[
+ newX := newX - i
+ ].
+ i := insets at:2. "right"
+ (i ~~ 0) ifTrue:[
+ newY := newY - i
+ ].
+ i := insets at:4. "bottom"
+ (i ~~ 0) ifTrue:[
+ newY := newY - i
+ ].
+ ].
+ ^ newX @ newY
+!
+
+originFromRelativeOrigin
+ "compute & return pixel origin from relativeOrigin"
+
+ ^ self originFromRelativeOrigin:relativeOrigin
+!
+
+originFromRelativeOrigin:aPoint
+ "compute & return pixel origin from relativeOrigin, aPoint"
+
+ |p l t|
+
+ p := self pointFromRelative:aPoint.
+
+ insets isNil ifTrue:[
+ ^ p
+ ].
+ l := insets at:1.
+ t := insets at:2.
+
+"/ l := t := 0.
+"/ leftInset notNil ifTrue:[
+"/ l := leftInset
+"/ ].
+"/ topInset notNil ifTrue:[
+"/ t := topInset
+"/ ].
+ ((l ~~ 0) or:[t ~~ 0]) ifTrue:[
+ ^ (p x + l) @ (p y + t)
+ ].
+ ^ p
+!
+
+pixelCorner:corner
+ "set the views corner in pixels"
+
+ |w h|
+
+ w := corner x - left + 1.
+ h := corner y - top + 1.
+ self pixelOrigin:(left @ top) extent:(w @ h)
+
+ "Modified: 31.8.1995 / 18:20:22 / claus"
+!
+
+pixelExtent:extent
+ "set the views extent in pixels"
+
+ self pixelOrigin:(left @ top) extent:extent
+!
+
+pixelOrigin:origin
+ "set the views origin in pixels. For subviews. the origin is relative
+ to the superviews top-left. For topViews, its the screen origin."
+
+ |newLeft newTop|
+
+ newLeft := origin x.
+ newTop := origin y.
+ ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
+ top := newTop.
+ left := newLeft.
+
+ "
+ if the receiver is visible, or is a topView, perform the
+ operation right away - otherwise, simply remember that the
+ origin has changed - will tell the display once we get realized
+ "
+"/ (shown
+"/ or:[superView isNil and:[drawableId notNil]]) ifTrue:[
+
+ "/ no, have to do it if drawableId is there
+ "/ (otherwise, we could not move unmapped views around ...
+ "/
+ drawableId notNil ifTrue:[
+ device moveWindow:drawableId x:left y:top
+ ] ifFalse:[
+ originChanged := true
+ ]
+ ]
+!
+
+pixelOrigin:origin corner:corner
+ "set the views origin and corner in pixels"
+
+ |w h|
+
+ w := corner x - origin x + 1.
+ h := corner y - origin y + 1.
+ self pixelOrigin:origin extent:(w @ h)
+
+ "Modified: 31.8.1995 / 18:24:16 / claus"
+!
+
pixelOrigin:origin extent:extent
"set the views origin and extent in pixels"
@@ -2125,105 +4198,6 @@
]
!
-originFromRelativeOrigin:aPoint
- "compute & return pixel origin from relativeOrigin, aPoint"
-
- |p l t|
-
- p := self pointFromRelative:aPoint.
-
- insets isNil ifTrue:[
- ^ p
- ].
- l := insets at:1.
- t := insets at:2.
-
-"/ l := t := 0.
-"/ leftInset notNil ifTrue:[
-"/ l := leftInset
-"/ ].
-"/ topInset notNil ifTrue:[
-"/ t := topInset
-"/ ].
- ((l ~~ 0) or:[t ~~ 0]) ifTrue:[
- ^ (p x + l) @ (p y + t)
- ].
- ^ p
-!
-
-pixelOrigin:origin
- "set the views origin in pixels. For subviews. the origin is relative
- to the superviews top-left. For topViews, its the screen origin."
-
- |newLeft newTop|
-
- newLeft := origin x.
- newTop := origin y.
- ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
- top := newTop.
- left := newLeft.
-
- "
- if the receiver is visible, or is a topView, perform the
- operation right away - otherwise, simply remember that the
- origin has changed - will tell the display once we get realized
- "
-"/ (shown
-"/ or:[superView isNil and:[drawableId notNil]]) ifTrue:[
-
- "/ no, have to do it if drawableId is there
- "/ (otherwise, we could not move unmapped views around ...
- "/
- drawableId notNil ifTrue:[
- device moveWindow:drawableId x:left y:top
- ] ifFalse:[
- originChanged := true
- ]
- ]
-!
-
-pixelExtent:extent
- "set the views extent in pixels"
-
- self pixelOrigin:(left @ top) extent:extent
-!
-
-cornerFromRelativeCorner:aPoint
- "compute & return pixel corner from a relativeCorner, aPoint"
-
- |p r b bw|
-
- p := self pointFromRelative:aPoint.
-
- bw := borderWidth.
- insets isNil ifTrue:[
- bw == 0 ifTrue:[
- ^ p
- ].
- ^ (p x - bw) @ (p y - bw)
- ].
- r := (insets at:3) + bw.
- b := (insets at:4) + bw.
-
-"/ r := b := bw.
-"/ rightInset notNil ifTrue:[
-"/ r := rightInset + bw
-"/ ].
-"/ bottomInset notNil ifTrue:[
-"/ b := bottomInset + bw
-"/ ].
- ((r ~~ 0) or:[b ~~ 0]) ifTrue:[
- ^ (p x - r) @ (p y - b)
- ].
- ^ p
-!
-
-cornerFromRelativeCorner
- "compute & return pixel corner from relativeCorner"
-
- ^ self cornerFromRelativeCorner:relativeCorner
-!
-
pointFromRelative:p
"compute absolute coordinate from p"
@@ -2269,96 +4243,6 @@
^ newX @ newY
!
-originFromRelativeOrigin
- "compute & return pixel origin from relativeOrigin"
-
- ^ self originFromRelativeOrigin:relativeOrigin
-!
-
-pixelCorner:corner
- "set the views corner in pixels"
-
- |w h|
-
- w := corner x - left + 1.
- h := corner y - top + 1.
- self pixelOrigin:(left @ top) extent:(w @ h)
-
- "Modified: 31.8.1995 / 18:20:22 / claus"
-!
-
-extentFromRelativeExtent:aPoint
- "compute & return pixel extent from relativeExtent, aPoint"
-
- |rel newX newY inRect bw2 i|
-
- superView isNil ifTrue:[
- inRect := 0@0 extent:device extent
- ] ifFalse:[
- inRect := superView viewRectangle.
- ].
-
- bw2 := borderWidth * 2.
-
- rel := aPoint x.
- rel isInteger ifFalse:[
- newX := (rel * (inRect width + bw2)) asInteger + inRect left.
- (borderWidth ~~ 0) ifTrue:[
- newX := newX - borderWidth
- ].
- ] ifTrue:[
- newX := rel
- ].
-
- rel := aPoint y.
- rel isInteger ifFalse:[
- newY := (rel * (inRect height + bw2)) asInteger + inRect top.
- (borderWidth ~~ 0) ifTrue:[
- newY := newY - borderWidth
- ].
- ] ifTrue:[
- newY := rel
- ].
-
- insets notNil ifTrue:[
- i := insets at:1. "top"
- (i ~~ 0) ifTrue:[
- newX := newX - i
- ].
- i := insets at:3. "left"
- (i ~~ 0) ifTrue:[
- newX := newX - i
- ].
- i := insets at:2. "right"
- (i ~~ 0) ifTrue:[
- newY := newY - i
- ].
- i := insets at:4. "bottom"
- (i ~~ 0) ifTrue:[
- newY := newY - i
- ].
- ].
- ^ newX @ newY
-!
-
-extentFromRelativeExtent
- "compute & return pixel extent from relativeExtent"
-
- ^ self extentFromRelativeExtent:relativeExtent
-!
-
-pixelOrigin:origin corner:corner
- "set the views origin and corner in pixels"
-
- |w h|
-
- w := corner x - origin x + 1.
- h := corner y - origin y + 1.
- self pixelOrigin:origin extent:(w @ h)
-
- "Modified: 31.8.1995 / 18:24:16 / claus"
-!
-
setBorderColor
"set my borderColor"
@@ -2380,932 +4264,226 @@
]
!
-dimensionFromViewport
- "define my origin/extend from viewport"
-
- |relW relH relX relY winW winH org ext|
-
- superView notNil ifTrue:[
- superView window isNil ifTrue:[
-"
- v := superView.
- (v notNil and:[v window isNil]) whileTrue:[
- v := v superview
- ].
- v notNil ifTrue:[
- w := v window
- ].
-"
-"
- winW := 1.
- winH := 1
-"
- winW := superView width.
- winH := superView height.
-
- ] ifFalse:[
- winW := superView window width.
- winH := superView window height
- ].
- relW := (viewport width / winW) asFloat.
- relH := (viewport height / winH) asFloat.
- relX := (viewport left / winW) asFloat.
- relY := (viewport top / winH) asFloat.
- "bad coding style ... misuse other method"
- relativeOrigin := (relX @ relY).
- org := self originFromRelativeOrigin.
- relativeOrigin := nil.
-
- "bad coding style ...misuse other method"
- relativeExtent := (relW @ relH).
- ext := self extentFromRelativeExtent.
- relativeExtent := nil.
-
- self pixelOrigin:org extent:ext.
- ]
+setInnerClip
+ "compute, and set the inside clip-area"
+
+ self computeInnerClip.
+ self clipRect:innerClipRect
! !
-!SimpleView methodsFor:'accessing-dimensions'!
-
-layout
- "return the layout object which controls my geometry.
- Currently, this is nil in most cases, and my geometry is
- defined by relativeOrigin/relativeCorner/relativeExtent,
- originRule/extentRule/cornerRule and inset.
- Applications should be changed to use layoutObjects,
- since the above listed instance variables will vanish."
-
- ^ layout
-!
-
-geometryLayout
- "this method will vanish, as soon as all implementations of
- #layout: are removed ...
- (conflict for example in label>>layout:).
- DO NOT USE #geometryLayout: in your code; it will be removed without
- notice."
-
- ^ here layout
-!
-
-geometryLayout:aLayoutObject
- "this method will vanish, as soon as all implementations of
- #layout: are removed ...
- (conflict for example in label>>layout:).
- DO NOT USE #geometryLayout: in your code; it will be removed without
- notice."
-
- here layout:aLayoutObject
-!
-
-layout:aLayoutObject
- "set the layout object which controls my geometry.
- Currently, this is almost nowhere used but views will be
- incrementally changed to use this new geometry management."
-
- layout := aLayoutObject.
- superView isNil ifTrue:[
- originChanged := cornerChanged := extentChanged := true
- ] ifFalse:[
- self superViewChangedSize.
- ]
-
- "Modified: 19.9.1995 / 16:17:25 / claus"
-!
-
-computeOrigin
- "compute my origin; if I have a layoutObject, a relative origin
- or blocks to evaluate, compute it now ..
- Blocks may return relative values or nil; nil means: take current value.
- Returns the origin point in device coordinates (pixels)."
-
- |newOrg x y|
-
- "
- slowly migrating to use layoutObjects ...
- "
- layout notNil ifTrue:[
- ^ (layout rectangleRelativeTo:(superView viewRectangle)
- preferred:(self preferredBounds)) origin rounded
- ].
-
- (originRule notNil) ifTrue:[
- newOrg := originRule value.
- "
- allow return of relative values ...
- "
- x := newOrg x.
- y := newOrg y.
- x isNil ifTrue:[x := self origin x].
- y isNil ifTrue:[y := self origin y].
- ((x isInteger not) or:[y isInteger not]) ifTrue:[
- newOrg := self originFromRelativeOrigin:x@y.
- ]
- ] ifFalse:[
- (relativeOrigin notNil) ifTrue:[
- newOrg := self originFromRelativeOrigin:relativeOrigin.
- ] ifFalse:[
- ^ (left @ top).
- ].
- ].
- ^ newOrg
-!
-
-computeExtent
- "compute my extent; if I have a layoutObject, a relative extent
- or blocks to evaluate, compute it now ..
- There is one catch here, if the dimension was defined
- by origin/corner, compute them here and take that value.
- I.e. origin/corner definition has precedence over extent definition.
- Returns the extent in device coordinates (pixels)."
-
- |newOrg newExt newCorner x y|
-
- "
- slowly migrating to use layoutObjects ...
- "
- layout notNil ifTrue:[
- ^ (layout rectangleRelativeTo:(superView viewRectangle)
- preferred:(self preferredBounds)) extent rounded
- ].
-
- (cornerRule notNil) ifTrue:[
- newCorner := cornerRule value.
- "
- allow return of relative values ...
- "
- x := newCorner x.
- y := newCorner y.
- x isNil ifTrue:[x := self corner x].
- y isNil ifTrue:[y := self corner y].
- ((x isInteger not) or:[y isInteger not]) ifTrue:[
- newCorner := self cornerFromRelativeCorner:x@y
- ]
- ] ifFalse:[
- (relativeCorner notNil) ifTrue:[
- newCorner := self cornerFromRelativeCorner:relativeCorner
- ] ifFalse:[
- (extentRule notNil) ifTrue:[
- newExt := extentRule value.
- "
- allow return of relative values ...
- "
- x := newExt x.
- y := newExt y.
- x isNil ifTrue:[x := width].
- y isNil ifTrue:[y := height].
- ((x isInteger not) or:[y isInteger not]) ifTrue:[
- newExt := self extentFromRelativeExtent:x@y
- ]
- ] ifFalse:[
- (relativeExtent notNil) ifTrue:[
- newExt := self extentFromRelativeExtent:relativeExtent
- ] ifFalse:[
- newExt := (width @ height).
- ].
- ].
- ].
- ].
-
- newCorner notNil ifTrue:[
- newOrg := self computeOrigin.
- ^ newCorner - newOrg.
+!SimpleView methodsFor:'queries'!
+
+buttonMotionEventPending
+ "return true, if a button motion event is pending.
+ Normally, you dont want to use this, since no polling is needed
+ (not even for mouse-tracking).
+ Dont use it, since it does not honor the windowGroup, but
+ goes directly to the device instead.
+ Actually, its a historical leftover"
+
+ windowGroup notNil ifTrue:[
+ ^ windowGroup sensor hasButtonMotionEventsFor:self
].
- ^ newExt.
-!
-
-extent:extent
- "set the views extent;
- extent may be:
- a point
- where integer fields mean 'pixel-values'
- and float values mean 'relative-to-superview'
- and nil means 'leave current value';
- or a block returning a point which is interpreted as above.
- Be careful when using relative extents: rounding errors may
- accumulate. Better use origin/corner.
- Best: migrate to use layour objects."
-
- |w h pixelExtent e|
-
- extent isBlock ifTrue:[
- extentRule := extent.
- drawableId notNil ifTrue:[
- pixelExtent := extent value
- ] ifFalse:[
- extentChanged := true
- ]
- ] ifFalse:[
- w := extent x.
- h := extent y.
- w isNil ifTrue:[w := width].
- h isNil ifTrue:[h := height].
- e := w@h.
- ((w isInteger not) or:[h isInteger not]) ifTrue:[
- relativeExtent := e.
- pixelExtent := self extentFromRelativeExtent.
- pixelExtent isNil ifTrue:[
- extentChanged := true
- ]
- ] ifFalse:[
- pixelExtent := e
- ]
- ].
- pixelExtent notNil ifTrue:[
- self pixelExtent:pixelExtent
- ]
-!
-
-origin:origin
- "set the views origin;
- origin may be:
- a point
- where integer fields mean 'pixel-values'
- and float values mean 'relative-to-superview'
- and nil means 'take current value';
- or a block returning a point which is interpreted as above.
- Please migrate to use layout objects."
-
- |newLeft newTop pixelOrigin o|
-
- origin isBlock ifTrue:[
- originRule := origin.
- drawableId notNil ifTrue:[
- pixelOrigin := origin value
- ] ifFalse:[
- originChanged := true
- ]
- ] ifFalse:[
- o := origin.
- newLeft := origin x.
- newTop := origin y.
- newLeft isNil ifTrue:[newLeft := left].
- newTop isNil ifTrue:[newTop := top].
- o := newLeft @ newTop.
- ((newLeft isInteger not) or:[newTop isInteger not]) ifTrue:[
- relativeOrigin := o.
- pixelOrigin := self originFromRelativeOrigin.
- pixelOrigin isNil ifTrue:[
- originChanged := true
- ]
- ] ifFalse:[
- pixelOrigin := o
- ]
- ].
- pixelOrigin notNil ifTrue:[
- self pixelOrigin:pixelOrigin
- ].
-!
-
-top
- "return the y position of the top border"
-
- ^ top
-!
-
-origin
- "return the origin (in pixels)"
-
- ^ left@top
-!
-
-height:aNumber
- "set the views height in pixels"
-
- self extent:(width @ aNumber)
-!
-
-innerWidth
- "return the width of the view minus any 3D-shadow-borders"
-
- (level == 0) ifTrue:[^ width].
- ^ width - (2 * margin)
-!
-
-corner:corner
- "set the views corner;
- the corner argument may be:
- a point
- where integer fields mean 'pixel-values'
- and float values mean 'relative-to-superview'
- and nil means 'take current value';
- or a block returning a point which is interpreted as above.
- Please migrate to use layoutObjects, if possible."
-
- |x y pixelCorner c|
-
- corner isBlock ifTrue:[
- cornerRule := corner.
- drawableId notNil ifTrue:[
- pixelCorner := corner value
- ] ifFalse:[
- extentChanged := true
- ]
- ] ifFalse:[
- x := corner x.
- y := corner y.
- x isNil ifTrue:[x := self corner x].
- y isNil ifTrue:[y := self corner y].
- c := x @ y.
- ((x isInteger not) or:[y isInteger not]) ifTrue:[
- relativeCorner := c.
- pixelCorner := self cornerFromRelativeCorner.
- pixelCorner isNil ifTrue:[
- extentChanged := true
- ]
- ] ifFalse:[
- pixelCorner := c
- ]
- ].
-
- pixelCorner notNil ifTrue:[
- self pixelCorner:pixelCorner
- ]
-!
-
-origin:origin extent:extent
- "set both origin and extent"
-
- |newLeft newTop newWidth newHeight|
-
- "do it as one operation if possible"
-
- origin isBlock ifFalse:[
- extent isBlock ifFalse:[
- newLeft := origin x.
- newLeft isInteger ifTrue:[
- newTop := origin y.
- newTop isInteger ifTrue:[
- newWidth := extent x.
- newWidth isInteger ifTrue:[
- newHeight := extent y.
- newHeight isInteger ifTrue:[
- self pixelOrigin:origin extent:extent
- ]
- ]
- ]
- ]
- ]
- ].
- self extent:extent.
- self origin:origin
-!
-
-origin:origin corner:corner
- "set both origin and extent"
-
- |newLeft newTop newRight newBot|
-
- "do it as one operation if possible"
-
- origin isBlock ifFalse:[
- corner isBlock ifFalse:[
- newLeft := origin x.
- newLeft isInteger ifTrue:[
- newTop := origin y.
- newTop isInteger ifTrue:[
- newRight := corner x.
- newRight isInteger ifTrue:[
- newBot := corner y.
- newBot isInteger ifTrue:[
- self pixelOrigin:origin corner:corner
- ]
- ]
- ]
- ]
+ ^ super buttonMotionEventPending
+!
+
+canHandle:aKey
+ "return true, if I like to handle the key (from a keyPress event).
+ OBSOLETE: do not use & depend on this method, it is a historic
+ leftOver and will be removed. Use the delegation mechanism for this."
+
+ ^ false
+!
+
+canHandle:aKey from:aView
+ "return true, if I like to handle the key (from a keyPress event)
+ in aView.
+ OBSOLETE: do not use & depend on this method, it is a historic
+ leftOver and will be removed. Use the delegation mechanism for this."
+
+ ^ self canHandle:aKey
+!
+
+delegatesTo:someone
+ "return true, if I delegate events to someone"
+
+ delegate isNil ifTrue:[^ false].
+ ^ delegate delegatesTo:someone
+!
+
+hasFocus
+ "return true, if the receiver has the keyboard focus
+ (either via the focusView mechanism in the windowGroup,
+ or via delegation)"
+
+ |focusView delegate|
+
+ windowGroup isNil ifTrue:[^ false].
+
+ (focusView := windowGroup focusView) == self ifTrue:[^ true].
+ focusView notNil ifTrue:[
+ "mhmh - is there a delegation to me ?"
+ (delegate := focusView delegate) notNil ifTrue:[
+ delegate == self ifTrue:[^ true].
+ ^ delegate delegatesTo:self
]
].
- self origin:origin.
- self corner:corner
-!
-
-relativeCorner
- "return the relative corner or nil"
-
- ^ relativeCorner
-!
-
-makeFullyVisible
- "make sure, that the view is fully visible by shifting it
- into the visible screen area if nescessary.
- This method will be moved to StandardSystemView ..."
-
- |devBot devRight newTop newLeft|
-
- newTop := top.
- newLeft := left.
-
- ((top + height) > (devBot := device height)) ifTrue:[
- newTop := devBot - height
- ].
- ((left + width) > (devRight := device width)) ifTrue:[
- newLeft := devRight - width
- ].
- (newTop < 0) ifTrue:[
- newTop := 0.
- ].
- (newLeft < 0) ifTrue:[
- newLeft := 0
- ].
- ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
- self origin:newLeft @ newTop
- ]
-!
-
-width:aNumber
- "set the views width in pixels"
-
- self extent:(aNumber @ height)
-!
-
-inset:aNumber
- "set all insets; positive makes the view smaller,
- negative makes it larger."
-
- self allInset:aNumber
-!
-
-allInset:aNumber
- "set all insets; positive makes the view smaller,
- negative makes it larger."
-
- insets isNil ifTrue:[
- insets := Array new:4.
- ].
- insets atAllPut:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize.
-"/ ]
-!
-
-horizontalInset:aNumber
- "set the insets of the left/right edge;
- positive makes it smaller, negative makes it larger"
-
- insets isNil ifTrue:[
- insets := Array with:0 with:0 with:0 with:0
- ].
- insets at:1 put:aNumber.
- insets at:3 put:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize.
-"/ ]
-!
-
-verticalInset:aNumber
- "set the insets of the top/bottom edge;
- positive makes it smaller, negative makes it larger"
-
- insets isNil ifTrue:[
- insets := Array with:0 with:0 with:0 with:0
- ].
- insets at:2 put:aNumber.
- insets at:4 put:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize.
-"/ ]
-!
-
-rightInset:aNumber
- "set the inset of the right edge;
- positive is to the left (view becomes smaller),
- negative to the right (becomes larger)"
-
- insets isNil ifTrue:[
- insets := Array with:0 with:0 with:0 with:0
- ].
- insets at:3 put:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize.
-"/ ]
-!
-
-leftInset:aNumber
- "set the inset of the left edge;
- positive is to the right (view becomes smaller),
- negative to the left (becomes larger)"
-
- insets isNil ifTrue:[
- insets := Array with:0 with:0 with:0 with:0
- ].
- insets at:1 put:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize.
-"/ ]
-!
-
-topInset:aNumber
- "set the inset of the top edge;
- positive is to the bottom (view becomes smaller),
- negative to the top (becomes larger)"
-
- insets isNil ifTrue:[
- insets := Array with:0 with:0 with:0 with:0
- ].
- insets at:2 put:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize.
-"/ ]
-!
-
-bottomInset:aNumber
- "set the inset of the bottom edge;
- positive is to the top (view becomes smaller),
- negative to the bottom (becomes larger)"
-
- insets isNil ifTrue:[
- insets := Array with:0 with:0 with:0 with:0
- ].
- insets at:4 put:aNumber.
-
- "force recomputation"
-"/ drawableId isNil ifTrue:[
-"/ originChanged := true
-"/ ] ifFalse:[
- self superViewChangedSize
-"/ ]
-!
-
-left:aNumber
- "set the x position"
-
- self origin:(aNumber @ top)
-!
-
-relativeOrigin
- "return the relative origin or nil"
-
- ^ relativeOrigin
-!
-
-innerHeight
- "return the height of the view minus any 3D-shadow-borders"
-
- (margin == 0) ifTrue:[^ height].
- ^ height - (2 * margin)
-!
-
-heightIncludingBorder
- "return my height including border
- (this is my height as seen from the outside view;
- while #height returns the height as seen by myself)"
-
- ^ height + (2*borderWidth)
-!
-
-widthIncludingBorder
- "return my width including border
- (this is my width as seen from the outside view;
- while #width returns the width as seen by myself)"
-
- ^ width + (2*borderWidth)
-!
-
-originRelativeTo:aView
- "return the origin (in pixels) relative to a superView,
- or relative to the rootView (if the aView argument is nil).
- If the receiver is nonNil and not a subview of aView, return nil."
-
- |currentView
- org "{ Class: Point }"
- sumX "{ Class: SmallInteger }"
- sumY "{ Class: SmallInteger }" |
-
- currentView := self.
- sumX := 0.
- sumY := 0.
- [currentView notNil] whileTrue:[
- (currentView == aView) ifTrue:[
- ^ (sumX @ sumY)
- ].
- org := currentView origin.
- sumX := sumX + org x.
- sumY := sumY + org y.
- currentView := currentView superView
- ].
- (aView isNil or:[aView == RootView]) ifTrue:[
- "return relative to screen ..."
- ^ (sumX @ sumY)
- ].
- ^ nil
-
- "
- |top sub1 sub2|
-
- top := StandardSystemView new.
- top extent:200@200.
- sub1 := View origin:0.2 @ 0.2 corner:0.8 @ 0.8 in:top.
- sub2 := Button origin:0.3 @ 0.3 corner:0.7 @ 0.7 in:sub1.
- top openAndWait.
- Transcript show:'button in top:'; showCr:(sub2 originRelativeTo:top).
- Transcript show:'button on screen:'; showCr:(sub2 originRelativeTo:nil).
- "
-!
-
-relativeCorner:aPoint
- "set the relative corner"
-
- relativeCorner := aPoint
-!
-
-relativeOrigin:aPoint
- "set the relative origin"
-
- relativeOrigin := aPoint
-!
-
-leftInset
- "return the inset of the left edge; positive is to the right,
- negative to the left"
-
- insets isNil ifTrue:[^ 0].
- ^ insets at:1
-!
-
-sizeFixed:aBoolean
- "set/clear the fix-size attribute, if supported by concrete subclasses.
- Views which want to resize themselfes as appropriate to their contents
- should cease to do so and take their current size if sizeFixed is set to
- true. Currently, only supported by Labels.
- This does NOT prevent the window manager from resizing the view,
- instead it tell the view to NOT resize ITSELF.
- Added here to provide a common protocol for all views."
-
- ^ self
-!
-
-top:aNumber
- "set the y position"
-
- self origin:(left @ aNumber)
-!
-
-rightInset
- "return the inset of the right edge; positive is to the left,
- negative to the right"
-
- insets isNil ifTrue:[^ 0].
- ^ insets at:3
-!
-
-topInset
- "return the inset of the top edge; positive is to the bottom,
- negative to the top"
-
- insets isNil ifTrue:[^ 0].
- ^ insets at:2
-!
-
-left
- "return the x position of the left border (in pixels)"
-
- ^ left
-!
-
-corner
- "return the lower right corner-point (in pixels)"
-
-"/ ^ (left + width "- 1") @ (top + height "- 1")
- ^ (left + width - 1) @ (top + height - 1)
-
- "Modified: 31.8.1995 / 16:51:40 / claus"
-!
-
-bottomInset
- "return the inset of the bottom edge; positive is to the top,
- negative to the bottom"
-
- insets isNil ifTrue:[^ 0].
- ^ insets at:4
-!
-
-right:aNumber
- "set the corners x position"
-
- self corner:(aNumber @ self corner y)
-!
-
-bottom:aNumber
- "set the corners y position"
-
- self corner:(self corner x @ aNumber)
-!
-
-right
- "return the x position of the right edge (in pixels)"
-
- ^ left + width - 1
-
- "Modified: 31.8.1995 / 19:31:10 / claus"
-!
-
-bottom
- "return the y position of the actual bottom edge (in pixels)"
-
- ^ top + height - 1
-!
-
-relativeExtent
- "return the relative extent or nil"
-
- ^ relativeExtent
-!
-
-left:newLeft top:newTop width:newWidth height:newHeight
- "another way of specifying origin and extent"
-
- self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
-!
-
-relativeExtent:aPoint
- "set the relative extent"
-
- relativeExtent := aPoint
-!
-
-center:newCenter
- "move the receiver so that newCenter, aPoint becomes the center point"
-
- self origin:(newCenter - ((width // 2) @ (height // 2)))
-!
-
-center
- "return the point at the center of the receiver (in pixels)"
-
- ^ (left + (width // 2)) @ (top + (height // 2))
-!
-
-computeCorner
- "compute my corner; if I have a layoutObject,
- relative origins or blocks to evaluate, compute it now ..
- Blocks may return relative values or nil; nil means: take current value.
- Returns the corner point in device coordinates (pixels)."
-
- |org newCorner newExt x y|
-
- "
- slowly migrating to use layoutObjects ...
- "
- layout notNil ifTrue:[
- ^ (layout rectangleRelativeTo:(superView viewRectangle)
- preferred:(self preferredBounds)) corner rounded
- ].
-
- (cornerRule notNil) ifTrue:[
- newCorner := cornerRule value.
- "
- allow return of relative values ...
- "
- x := newCorner x.
- y := newCorner y.
- x isNil ifTrue:[x := self corner x].
- y isNil ifTrue:[y := self corner y].
- ((x isInteger not) or:[y isInteger not]) ifTrue:[
- newCorner := self cornerFromRelativeCorner:x@y
- ]
- ] ifFalse:[
- (relativeCorner notNil) ifTrue:[
- newCorner := self cornerFromRelativeCorner:relativeCorner
- ] ifFalse:[
- org := self computeOrigin.
- (extentRule notNil) ifTrue:[
- newExt := extentRule value
- ] ifFalse:[
- (relativeExtent notNil) ifTrue:[
- newExt := self extentFromRelativeExtent:relativeExtent
- ]
- ].
- newCorner := org + newExt
+ ^ false
+!
+
+isSubViewOf:aView
+ "return true, if I am a subview of aView"
+
+ aView == self isNil ifTrue:[^ true].
+ superView isNil ifTrue:[^ false].
+ superView == aView ifTrue:[^ true].
+ ^ superView isSubViewOf:aView
+!
+
+isView
+ "return true, if the receiver is some kind of view;
+ true is returned here."
+
+ ^ true
+!
+
+preferredBounds
+ "ST-80 compatibility."
+
+ ^ 0@0 corner:self preferredExtent
+!
+
+preferredExtent
+ "return my preferred extent - this is the minimum size I would like to have.
+ The default here is the actual extent, the receiver currently has."
+
+ "mhmh - if I have components, collect their
+ preferred bounds ..."
+
+ |maxX maxY|
+
+ subViews isNil ifTrue:[^ self extent].
+"/ ^ self extent.
+
+ maxX := maxY := 0.
+ subViews notNil ifTrue:[
+ subViews do:[:aSubView |
+ |org corn|
+
+ org := aSubView computeOrigin.
+ corn := org + aSubView preferredExtent.
+ maxX := maxX max:corn x.
+ maxY := maxY max:corn y.
]
].
- ^ newCorner
+ ^ maxX @ maxY.
+!
+
+sizeFixed
+ "return true, if this vew wants its size to remain unchanged.
+ Used by panels, to check if their components want to keep their size."
+
+ ^ false
+
+ "Created: 17.9.1995 / 20:29:20 / claus"
! !
!SimpleView methodsFor:'realization'!
-map
- "make the view visible on the screen"
-
- realized ifFalse:[
+create
+ "create (i.e. tell my device about me) if not already created.
+ This does not make the view visible (needs a #map for that)"
+
+ drawableId isNil ifTrue:[
"
- now, make the view visible
+ make certain that superview is created also
"
- device mapWindow:drawableId.
- realized := true.
+ superView notNil ifTrue:[
+"/ superView id isNil ifTrue:[
+ superView create.
+"/ ].
+
+"/ "and put my controller into the superviews controller list"
+"/ controller notNil ifTrue:[
+"/ superView controller notNil ifTrue:[
+"/ controller manager:(superView controller manager)
+"/ ]
+"/ ]
+ ].
+
+ cursor := cursor on:device.
+
+ self physicalCreate.
+
+ viewBackground notNil ifTrue:[
+ self setViewBackground
+ ].
+
+ self initializeMiddleButtonMenu.
+ self initEvents.
+
+ "
+ this is the first create,
+ force sizechange messages to be sent to the view
+ "
+ extentChanged := true.
+ originChanged := true
]
!
-unmap
- "hide me - the view stays created, and can be mapped again later."
+createWithAllSubViews
+ "create, then create all subviews"
+
+ drawableId isNil ifTrue:[self create].
+ subViews notNil ifTrue:[
+ subViews do:[:subView | subView createWithAllSubViews]
+ ]
+!
+
+destroy
+ "unrealize & destroy - make me invisible, destroy subviews then
+ make me unknown to the device"
+
+ |subs|
realized ifTrue:[
- drawableId notNil ifTrue:[
- device unmapWindow:drawableId
- ].
- realized := shown := false.
+ self unrealize.
+ "make it go away immediately
+ - also, this hides the subview killing"
+"
+ device synchronizeOutput.
+"
].
- "
- |top sub|
-
- top := StandardSystemView new.
- top extent:200@200.
-
- sub := View
- origin:0.2@0.2
- corner:0.8@0.8
- in:top.
-
- sub viewBackground:Color red.
- sub hiddenOnRealize:true.
-
- top open.
- (Delay forSeconds:5) wait.
- sub map.
- (Delay forSeconds:3) wait.
- sub unmap.
- sub viewBackground:(Color green).
- (Delay forSeconds:3) wait.
- sub map.
- "
-!
-
-unrealize
- "alias for unmap, for historic reasons"
-
- self unmap.
-!
-
-physicalCreate
- "common code for create & recreate:
- physically create (but do not map) the view on the device."
-
- "associate colors to device"
-
- drawableId := device
- createWindowFor:self
- origin:(left @ top)
- extent:(width @ height)
- minExtent:nil
- maxExtent:nil
- borderWidth:borderWidth
- subViewOf:superView
- onTop:(self isPopUpView)
- inputOnly:(self inputOnly)
- label:nil
- cursor:cursor
- icon:nil
- iconView:nil.
-
- Lobby registerChange:self.
- extentChanged := false.
- originChanged := false.
-
- (borderColor notNil and:[borderColor ~~ Black]) ifTrue:[
-"/ borderColor := borderColor on:device.
- self setBorderColor
+"/ controller notNil ifTrue:[
+"/ controller release.
+"/ controller := nil.
+"/ ].
+
+ subs := subViews.
+ subs notNil ifTrue:[
+ "stupid: destroy removes itself from the subview list
+ - therefore we have to loop over a copy here"
+
+ subViews := nil.
+ subs do:[:aView |
+ aView notNil ifTrue:[aView destroy]
+ ]
].
- (viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
- device setWindowGravity:viewGravity in:drawableId
- ].
- (bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
- device setBitGravity:bitGravity in:drawableId
- ].
- borderShape notNil ifTrue:[
- device setWindowBorderShape:(borderShape id) in:drawableId
+ superView notNil ifTrue:[
+ superView removeSubView:self.
+ superView := nil
].
- viewShape notNil ifTrue:[
- device setWindowShape:(viewShape id) in:drawableId
+ super destroy.
+
+ controller notNil ifTrue:[
+ controller release.
+ controller := nil.
].
- (backed notNil and:[backed ~~ false]) ifTrue:[
- device setBackingStore:backed in:drawableId
- ].
- saveUnder ifTrue:[
- device setSaveUnder:true in:drawableId
+
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self.
+ windowGroup := nil
].
!
@@ -3363,47 +4541,96 @@
]
!
-create
- "create (i.e. tell my device about me) if not already created.
- This does not make the view visible (needs a #map for that)"
-
- drawableId isNil ifTrue:[
+map
+ "make the view visible on the screen"
+
+ realized ifFalse:[
"
- make certain that superview is created also
+ now, make the view visible
"
- superView notNil ifTrue:[
-"/ superView id isNil ifTrue:[
- superView create.
-"/ ].
-
-"/ "and put my controller into the superviews controller list"
-"/ controller notNil ifTrue:[
-"/ superView controller notNil ifTrue:[
-"/ controller manager:(superView controller manager)
-"/ ]
-"/ ]
- ].
-
- cursor := cursor on:device.
-
- self physicalCreate.
-
- viewBackground notNil ifTrue:[
- self setViewBackground
- ].
-
- self initializeMiddleButtonMenu.
- self initEvents.
-
- "
- this is the first create,
- force sizechange messages to be sent to the view
- "
- extentChanged := true.
- originChanged := true
+ device mapWindow:drawableId.
+ realized := true.
]
!
+physicalCreate
+ "common code for create & recreate:
+ physically create (but do not map) the view on the device."
+
+ "associate colors to device"
+
+ drawableId := device
+ createWindowFor:self
+ origin:(left @ top)
+ extent:(width @ height)
+ minExtent:nil
+ maxExtent:nil
+ borderWidth:borderWidth
+ subViewOf:superView
+ onTop:(self isPopUpView)
+ inputOnly:(self inputOnly)
+ label:nil
+ cursor:cursor
+ icon:nil
+ iconView:nil.
+
+ Lobby registerChange:self.
+ extentChanged := false.
+ originChanged := false.
+
+ (borderColor notNil and:[borderColor ~~ Black]) ifTrue:[
+"/ borderColor := borderColor on:device.
+ self setBorderColor
+ ].
+ (viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
+ device setWindowGravity:viewGravity in:drawableId
+ ].
+ (bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
+ device setBitGravity:bitGravity in:drawableId
+ ].
+ borderShape notNil ifTrue:[
+ device setWindowBorderShape:(borderShape id) in:drawableId
+ ].
+ viewShape notNil ifTrue:[
+ device setWindowShape:(viewShape id) in:drawableId
+ ].
+ (backed notNil and:[backed ~~ false]) ifTrue:[
+ device setBackingStore:backed in:drawableId
+ ].
+ saveUnder ifTrue:[
+ device setSaveUnder:true in:drawableId
+ ].
+!
+
+realize
+ "realize - make visible;
+ realizing is done very late (after layout is fixed) to avoid
+ visible rearranging of windows on the screen"
+
+ self realizeLeavingGroup:false
+!
+
+realizeAllSubViews
+ "realize all my subviews"
+
+ subViews notNil ifTrue:[
+ subViews do:[:subView |
+ subView realize
+ ]
+ ].
+
+ "Modified: 5.9.1995 / 23:30:47 / claus"
+!
+
+realizeInGroup
+ "special realize - leave windowgroup as is;
+ This allows a view to be realized in any windowgroup;
+ for special applications, like the kill button in the Filebrowser which has
+ another windowGroup as its superview and is handled as a separate process."
+
+ self realizeLeavingGroup:true
+!
+
realizeLeavingGroup:leaveGroupAsIs
"common helper for realize and realizeInGroup.
Create the view, if the argument is not true, assign my windowGroup,
@@ -3466,96 +4693,6 @@
]
!
-realize
- "realize - make visible;
- realizing is done very late (after layout is fixed) to avoid
- visible rearranging of windows on the screen"
-
- self realizeLeavingGroup:false
-!
-
-destroy
- "unrealize & destroy - make me invisible, destroy subviews then
- make me unknown to the device"
-
- |subs|
-
- realized ifTrue:[
- self unrealize.
- "make it go away immediately
- - also, this hides the subview killing"
-"
- device synchronizeOutput.
-"
- ].
-
-"/ controller notNil ifTrue:[
-"/ controller release.
-"/ controller := nil.
-"/ ].
-
- subs := subViews.
- subs notNil ifTrue:[
- "stupid: destroy removes itself from the subview list
- - therefore we have to loop over a copy here"
-
- subViews := nil.
- subs do:[:aView |
- aView notNil ifTrue:[aView destroy]
- ]
- ].
- superView notNil ifTrue:[
- superView removeSubView:self.
- superView := nil
- ].
- super destroy.
-
- controller notNil ifTrue:[
- controller release.
- controller := nil.
- ].
-
- windowGroup notNil ifTrue:[
- windowGroup removeView:self.
- windowGroup := nil
- ].
-!
-
-rerealizeInGroup:aWindowGroup
- "rerealize at old position in (a possibly different) windowGroup."
-
- drawableId isNil ifTrue:[
- self create
- ].
- drawableId notNil ifTrue:[
- aWindowGroup ~~ windowGroup ifTrue:[
- windowGroup notNil ifTrue:[
- windowGroup removeView:self
- ].
- windowGroup := aWindowGroup.
- aWindowGroup addTopView:self.
- ].
- self rerealize.
- ]
-!
-
-rerealize
- "rerealize at old position"
-
- drawableId notNil ifTrue:[
- realized := true.
- device mapView:self id:drawableId iconified:false
- atX:left y:top width:width height:height
- ]
-!
-
-resize
- "resize myself to make everything fit into me.
- Nothing special done here, but redefined in some subclasses"
-
- self extent:(self preferredExtent)
-!
-
recreate
"recreate (i.e. tell X about me) after a snapin"
@@ -3576,22 +4713,32 @@
]
!
-createWithAllSubViews
- "create, then create all subviews"
-
- drawableId isNil ifTrue:[self create].
- subViews notNil ifTrue:[
- subViews do:[:subView | subView createWithAllSubViews]
+rerealize
+ "rerealize at old position"
+
+ drawableId notNil ifTrue:[
+ realized := true.
+ device mapView:self id:drawableId iconified:false
+ atX:left y:top width:width height:height
]
!
-realizeInGroup
- "special realize - leave windowgroup as is;
- This allows a view to be realized in any windowgroup;
- for special applications, like the kill button in the Filebrowser which has
- another windowGroup as its superview and is handled as a separate process."
-
- self realizeLeavingGroup:true
+rerealizeInGroup:aWindowGroup
+ "rerealize at old position in (a possibly different) windowGroup."
+
+ drawableId isNil ifTrue:[
+ self create
+ ].
+ drawableId notNil ifTrue:[
+ aWindowGroup ~~ windowGroup ifTrue:[
+ windowGroup notNil ifTrue:[
+ windowGroup removeView:self
+ ].
+ windowGroup := aWindowGroup.
+ aWindowGroup addTopView:self.
+ ].
+ self rerealize.
+ ]
!
rerealizeWithAllSubViews
@@ -3607,651 +4754,84 @@
]
!
-realizeAllSubViews
- "realize all my subviews"
-
- subViews notNil ifTrue:[
- subViews do:[:subView |
- subView realize
- ]
- ].
-
- "Modified: 5.9.1995 / 23:30:47 / claus"
-! !
-
-!SimpleView methodsFor:'startup'!
-
-open
- "open up the view - for normal views, this is a modeless open
- (i.e. the new view comes up as independent process).
- Although #open is only to be sent to topviews (i.e. it could have been
- implemented in TopView), it is implemented here - therefore, every view
- can be opened as a topView.
- This is redefined in ModalBox, which comes up modal (i.e.
- control is under the current process, so that interaction with the
- current group is blocked while the modalBox is active)."
-
- ^ self openModeless
-
- "
- View new open
-
- (Button label:'hello') open
-
- |top|
- top := StandardSystemView new.
- top extent:200@200.
- Button label:'hello' in:top.
- top open
-
- YesNoBox new open
- "
-!
-
-openAt:aPoint
- "open up the view modeless - positions the view"
-
- ^self openModelessAt:aPoint
-
- "Created: 18.9.1995 / 23:30:43 / claus"
-!
-
-openAtCenter
- "open up the view modeless - positions the view"
-
- ^self openModelessAtCenter
-
- "Created: 18.9.1995 / 23:30:56 / claus"
-!
-
-openModeless
- "create and schedule a new windowgroup for me and open the view.
- The view will be handled by its own process, effectively running in
- parallel (i.e. control is returned to the sender immediately)."
-
- ProcessorScheduler isPureEventDriven ifFalse:[
- windowGroup isNil ifTrue:[
- windowGroup := WindowGroup new.
- windowGroup addTopView:self.
- windowGroup startup:false.
- ] ifFalse:[
- windowGroup startup:false.
- self realizeInGroup.
+resize
+ "resize myself to make everything fit into me.
+ Nothing special done here, but redefined in some subclasses"
+
+ self extent:(self preferredExtent)
+!
+
+unmap
+ "hide me - the view stays created, and can be mapped again later."
+
+ realized ifTrue:[
+ drawableId notNil ifTrue:[
+ device unmapWindow:drawableId
].
- ] ifTrue:[
- self realize
- ]
-
- "
- the same:
- (Button label:'hello') open
-
- (Button label:'hello') openModeless
-
- different:
- YesNoBox new open
-
- YesNoBox new openModeless
- "
- "
- (almost) the same:
- YesNoBox new open
-
- YesNoBox new openModal
-
- different:
- (Button label:'hello') open
-
- (Button label:'hello') openModal
- "
-!
-
-openModelessAt:aPoint
- "open up the view modeless - positions the view
- (i.e. circumvents window managers positioning)"
-
- self origin:aPoint.
- self create.
- device setTransient:drawableId for:0.
- ^ self openModeless
-
- "
- View new openModeless
-
- View new openModelessAt:100@100
- "
-
- "Created: 18.9.1995 / 23:21:42 / claus"
-!
-
-openModelessAtCenter
- "open up the view modeless - positions the view
- (i.e. circumvents window managers positioning)"
-
- ^ self openModelessAt:(device center - (self extent//2)).
-
- "
- View new openModeless
-
- View new openModelessAtCenter
- "
-
- "Created: 18.9.1995 / 23:21:42 / claus"
-!
-
-openModal
- "create a new windowgroup, but start processing in the current process
- actually suspending event processing for the currently active group.
- Stay in modalLoop while view is visible.
- (i.e. control is returned to the sender when the receiver is closed)"
-
- self openModal:[true]
-
- "
- the same:
- YesNoBox new open
-
- YesNoBox new openModal
-
- different:
- (Button label:'hello') open
-
- (Button label:'hello') openModal
- "
-!
-
-openModalAt:aPoint
- "open up the view modeless - positions the view
- (i.e. circumvents window managers positioning)"
-
- self origin:aPoint.
- self create.
- device setTransient:drawableId for:0.
- ^ self openModal
+ realized := shown := false.
+ ].
"
- View new openModal
-
- View new openModalAt:100@100
- "
-
- "Created: 18.9.1995 / 23:21:42 / claus"
- "Modified: 18.9.1995 / 23:32:26 / claus"
-!
-
-openModalAtCenter
- "open up the view modeless - positions the view
- (i.e. circumvents window managers positioning)"
-
- ^ self openModalAt:(device center - (self extent//2)).
-
- "Created: 18.9.1995 / 23:31:47 / claus"
-!
-
-openModal:aBlock
- "create a new windowgroup, but start processing in the current process -
- actually suspending event processing for the currently active group.
- Stay in this modal loop while aBlock evaluates to true AND the receiver is
- visible.
- (i.e. control is returned to the sender when the receiver is closed)
- This makes any interaction with the current window impossible -
- however, other views (in other windowgroups) still work."
-
- |activeGroup tops|
-
- activeGroup := WindowGroup activeGroup.
- Processor activeProcessIsSystemProcess ifTrue:[
- "
- put myself into the modal group, let it handle events for
- me as well. This is only a half way solution, since the view
- is not modal at all ... however, the only situation
- where this happens is with modal boxes popped while in a
- modal browser. You will forgive me for that inconvenience.
- "
- windowGroup := activeGroup.
- activeGroup notNil ifTrue:[activeGroup addTopView:self].
- self realize
- ] ifFalse:[
- "
- create a new window group and put myself into it
- "
- windowGroup := WindowGroup new.
- windowGroup addTopView:self.
- "
- go dispatch events in this new group
- (thus current windowgroup is blocked from interaction)
- "
- Object abortSignal handle:[:ex |
- self hide.
- ex return.
- ] do:[
- [
- windowGroup startupModal:[realized and:aBlock]
- ] valueOnUnwindDo:[
- self hide.
- ]
- ].
- "
- return input focus to previously active groups top.
- This helps with windowmanagers which need an explicit click
- on the view for the focus.
- "
- activeGroup notNil ifTrue:[
- tops := activeGroup topViews.
- (tops notNil and:[tops notEmpty]) ifTrue:[
- tops first getKeyboardFocus
- ]
- ]
- ]
-!
-
-openAutonomous
- "create and schedule a new windowgroup for me and open the view.
- The view will be handled by its own process, effectively running in
- parallel. This entry is for non-topviews, which want to be served
- autonomous from the topview. (see the fileBrowsers kill-button
- when executing unix commands as an example)"
-
- |wg|
-
- ProcessorScheduler isPureEventDriven ifFalse:[
- wg := WindowGroup new.
- self windowGroup:wg.
- wg addView:self.
- wg startup:false.
- self realizeInGroup.
- ] ifTrue:[
- self realize
- ]
-!
-
-waitUntilVisible
- "wait until the receiver visible.
- In normal applications, you do not need to wait till a view is
- open - it should do all of its drawing itself when it gets the
- first expose event.
- However, if you want to 'manually' draw into the view (for example,
- in doIt expressions), or subsequent views depend on some state of
- another view (which is only available once visible),
- use this to suspend the current process until the receiver is shown.
- Caveat:
- we poll here for the view to be shown - we need a semaphore
- which is raised by the view in order to do it right."
-
- [self shown] whileFalse:[
- (Delay forSeconds:0.05) wait.
- ].
-
- "does not work (the view is in its opening phase,
- when we attempt to draw a line - this gives an error, since
- its internals are not yet correctly setup):
-
- |v|
-
- v := View new open.
- v displayLineFrom:0@0 to:50@50
-
- does work (since we wait until the view has completely finished
- its startup phase):
-
- |v|
-
- v := View new open.
- v waitUntilVisible.
- v displayLineFrom:0@0 to:50@50
- "
-!
-
-openAndWait
- "open up the view - wait until it is visible.
- In normal applications, you do not need to wait till the view is
- open - it should do all of its drawing itself when it gets the
- first expose event.
- However, if you want to 'manually' draw into the view (for example,
- in doIt expressions) the view must be visible (realized) before doing so.
- Use this open in those situations."
-
- self open.
- self waitUntilVisible.
-
- "does not work:
-
- |v|
-
- v := View new open.
- v displayLineFrom:0@0 to:50@50
-
- does work:
-
- |v|
-
- v := View new openAndWait.
- v displayLineFrom:0@0 to:50@50
+ |top sub|
+
+ top := StandardSystemView new.
+ top extent:200@200.
+
+ sub := View
+ origin:0.2@0.2
+ corner:0.8@0.8
+ in:top.
+
+ sub viewBackground:Color red.
+ sub hiddenOnRealize:true.
+
+ top open.
+ (Delay forSeconds:5) wait.
+ sub map.
+ (Delay forSeconds:3) wait.
+ sub unmap.
+ sub viewBackground:(Color green).
+ (Delay forSeconds:3) wait.
+ sub map.
"
-! !
-
-!SimpleView methodsFor:'edge drawing'!
-
-drawBottomEdge
- "draw bottom 3D edge into window frame"
-
- self drawBottomEdgeLevel:level
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil.
-!
-
-drawLeftEdge
- "draw left 3D edge into window frame"
-
- self drawLeftEdgeLevel:level
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil.
-!
-
-drawRightEdge
- "draw right 3D edge into window frame"
-
- self drawRightEdgeLevel:level
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil.
-!
-
-drawTopEdge
- "draw top 3D edge into window frame"
-
- self drawTopEdgeLevel:level
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil.
-!
-
-drawEdges
- "draw all of my 3D edges"
-
- self drawEdgesForX:0 y:0 width:width height:height level:level
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil
-!
-
-drawEdgesForX:x y:y width:w height:h level:l
- shadow:shadowColor light:lightColor
- halfShadow:halfShadowColor halfLight:halfLightColor
- style:edgeStyle
-
- "draw 3D edges into a rectangle"
-
- |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
- count "{ Class: SmallInteger }"
- r "{ Class: SmallInteger }"
- b "{ Class: SmallInteger }"
- xi "{ Class: SmallInteger }"
- yi "{ Class: SmallInteger }"
- run paint|
-
- count := l.
- (count < 0) ifTrue:[
- topLeftFg := shadowColor.
- botRightFg := lightColor.
- topLeftHalfFg := halfShadowColor.
- botRightHalfFg := halfLightColor.
- count := count negated
- ] ifFalse:[
- topLeftFg := lightColor.
- botRightFg := shadowColor.
- topLeftHalfFg := halfLightColor.
- botRightHalfFg := halfShadowColor.
- ].
- topLeftHalfFg isNil ifTrue:[
- topLeftHalfFg := topLeftFg
- ].
- botRightHalfFg isNil ifTrue:[
- botRightHalfFg := botRightFg
- ].
-
- r := x + w - 1. "right"
- b := y + h - 1. "bottom"
-
- super lineWidth:0.
-
- "top and left edges"
- ((edgeStyle == #soft) and:["l" count > 0]) ifTrue:[
- paint := topLeftHalfFg
- ] ifFalse:[
- paint := topLeftFg
- ].
- super paint:paint.
-
- 0 to:(count - 1) do:[:i |
- run := y + i.
- super displayDeviceLineFromX:x y:run toX:r y:run. "top"
- run := x + i.
- super displayDeviceLineFromX:run y:y toX:run y:b "left"
- ].
- (edgeStyle == #soft) ifTrue:[
-"
- super paint:topLeftFg.
- super displayDeviceLineFromX:x y:y toX:r y:y.
- super displayDeviceLineFromX:x y:y toX:x y:b
-"
- (l > 2) ifTrue:[
- super paint:Black.
- super displayDeviceLineFromX:x y:y toX:r y:y.
- super displayDeviceLineFromX:x y:y toX:x y:b.
- ]
- ].
-
- xi := x + 1.
- yi := y + 1.
-
-"/ does not look good
-"/ style == #st80 iftrue:[
-"/ yi := yi + 1
-"/ ].
-
- "bottom and right edges"
- (edgeStyle == #soft "new:" and:[count > 1]) ifTrue:[
- paint := botRightHalfFg
- ] ifFalse:[
- paint := botRightFg
- ].
-
- super paint:paint.
- 0 to:(count - 1) do:[:i |
- run := b - i.
- super displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
- run := r - i.
- super displayDeviceLineFromX:run y:yi-1 toX:run y:b. "right"
- xi := xi + 1.
- yi := yi + 1
- ].
- ((edgeStyle == #soft) and:[l > 1]) ifTrue:[
- super paint:Black "shadowColor".
- super displayDeviceLineFromX:(x + (1 - 1)) y:b toX:r y:b.
- super displayDeviceLineFromX:r y:(y + (1 - 1)) toX:r y:b
- ]
-!
-
-drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
- |topFg topHalfFg paint r
- count "{ Class: SmallInteger }" |
-
- count := level.
- count == 0 ifTrue:[^ self].
-
- (count < 0) ifTrue:[
- topFg := shadowColor.
- topHalfFg := halfShadowColor.
- count := count negated
- ] ifFalse:[
- topFg := lightColor.
- topHalfFg := halfLightColor.
- ].
- topHalfFg isNil ifTrue:[
- topHalfFg := topFg
- ].
-
- ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
- paint := topHalfFg
- ] ifFalse:[
- paint := topFg
- ].
- super paint:paint.
- super lineWidth:0.
-
- r := width - 1.
- 0 to:(count - 1) do:[:i |
- super displayDeviceLineFromX:i y:i toX:(r - i) y:i
- ].
- ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
- super paint:Black.
- super displayDeviceLineFromX:0 y:0 toX:r y:0.
- ]
-!
-
-drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
- |botFg
- count "{ Class: SmallInteger }"
- b r|
-
- count := level.
- count == 0 ifTrue:[^ self].
-
- (count < 0) ifTrue:[
- botFg := lightColor.
- count := count negated
- ] ifFalse:[
- ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
- botFg := halfShadowColor
- ] ifFalse:[
- botFg := shadowColor
- ].
- ].
- super paint:botFg.
- super lineWidth:0.
-
- r := width - 1.
- 0 to:(count - 1) do:[:i |
- b := height - 1 - i.
- super displayDeviceLineFromX:i y:b toX:(r - i) y:b
- ].
-
- ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
- b := height - 1.
- super paint:shadowColor.
- super displayDeviceLineFromX:1 y:b toX:r y:b.
- ]
-!
-
-drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
- |leftFg leftHalfFg paint b
- count "{ Class: SmallInteger }" |
-
- count := level.
- count == 0 ifTrue:[^ self].
-
- (count < 0) ifTrue:[
- leftFg := shadowColor.
- leftHalfFg := halfShadowColor.
- count := count negated.
- ] ifFalse:[
- leftFg := lightColor.
- leftHalfFg := halfLightColor.
- ].
- leftHalfFg isNil ifTrue:[
- leftHalfFg := leftFg
- ].
-
- ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
- paint := leftHalfFg
- ] ifFalse:[
- paint := leftFg
- ].
- super paint:paint.
- super lineWidth:0.
-
- b := height - 1.
- 0 to:(count - 1) do:[:i |
- super displayDeviceLineFromX:i y:i toX:i y:(b - i)
- ].
-
- ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
- super paint:Black.
- super displayDeviceLineFromX:0 y:0 toX:0 y:b.
- ]
-!
-
-drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
- |rightFg
- count "{ Class: SmallInteger }"
- r b|
-
- count := level.
- count == 0 ifTrue:[^ self].
-
- (count < 0) ifTrue:[
- rightFg := lightColor.
- count := count negated
- ] ifFalse:[
- ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
- rightFg := halfShadowColor
- ] ifFalse:[
- rightFg := shadowColor
- ].
- ].
- super paint:rightFg.
- super lineWidth:0.
-
- b := height - 1.
- 0 to:(count - 1) do:[:i |
- r := width - 1 - i.
- super displayDeviceLineFromX:r y:i toX:r y:(b - i)
- ].
- ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
- r := width - 1.
- super paint:shadowColor.
- super displayDeviceLineFromX:r y:1 toX:r y:b.
- ]
-!
-
-drawEdgesForX:x y:y width:w height:h level:l
- "draw 3D edges into a rectangle"
-
- self drawEdgesForX:x y:y width:w height:h level:l
- shadow:shadowColor
- light:lightColor
- halfShadow:nil
- halfLight:nil
- style:nil
-!
-
-redrawEdges
- "redraw my edges (if any)"
-
- (level ~~ 0) ifTrue:[
- shown ifTrue:[
- self clipRect:nil.
- self drawEdges.
- self clipRect:innerClipRect
- ]
- ]
+!
+
+unrealize
+ "alias for unmap, for historic reasons"
+
+ self unmap.
! !
!SimpleView methodsFor:'redrawing'!
+redraw
+ "redraw myself
+ cannot do much here - has to be redefined in subclasses"
+
+!
+
+redrawDeviceX:x y:y width:w height:h
+ "have to redraw part of the view.
+ The coordinates are in device space - if there is a transformation,
+ must inverse-transform back to logical coordinates. (since the view thinks
+ in its coordinate space)"
+
+ |lx ly lw lh|
+
+ lx := x.
+ ly := y.
+ lw := w.
+ lh := h.
+
+ transformation notNil ifTrue:[
+ lx := transformation applyInverseToX:lx.
+ ly := transformation applyInverseToY:ly.
+ lw := transformation applyInverseScaleX:lw.
+ lh := transformation applyInverseScaleY:lh.
+ ].
+ self redrawX:lx y:ly width:lw height:lh
+!
+
redrawX:x y:y width:w height:h
"have to redraw part of myself, given logical coordinates (if trans is nonNil)
default is to redraw everything - subclasses should add intelligence"
@@ -4291,32 +4871,11 @@
]
!
-redraw
- "redraw myself
- cannot do much here - has to be redefined in subclasses"
-
-!
-
-redrawDeviceX:x y:y width:w height:h
- "have to redraw part of the view.
- The coordinates are in device space - if there is a transformation,
- must inverse-transform back to logical coordinates. (since the view thinks
- in its coordinate space)"
-
- |lx ly lw lh|
-
- lx := x.
- ly := y.
- lw := w.
- lh := h.
-
- transformation notNil ifTrue:[
- lx := transformation applyInverseToX:lx.
- ly := transformation applyInverseToY:ly.
- lw := transformation applyInverseScaleX:lw.
- lh := transformation applyInverseScaleY:lh.
- ].
- self redrawX:lx y:ly width:lw height:lh
+showActive
+ "redraw myself as active (i.e. busy).
+ Nothing done here, but redefined in some classes."
+
+ ^ self
!
showFocus
@@ -4349,13 +4908,6 @@
]
!
-showActive
- "redraw myself as active (i.e. busy).
- Nothing done here, but redefined in some classes."
-
- ^ self
-!
-
showPassive
"redraw myself as inactive (i.e. nonbusy).
Nothing done here, but redefined in some classes."
@@ -4363,922 +4915,133 @@
^ self
! !
-!SimpleView methodsFor:'accessing-hierarchy'!
-
-superView:aView
- "set my superView to be aView"
-
- superView := aView
-!
-
-superView
- "return my superView"
-
- ^ superView
-!
-
-subViews
- "return the collection of subviews"
-
- ^ subViews
-!
-
-topView
- "return the topView - thats the one with no superview"
-
- |v|
-
- v := self.
- [v notNil] whileTrue:[
- v superView isNil ifTrue:[^ v].
- v := v superView
- ].
-
- ^ nil
-!
-
-subViews:aListOfViews
- "set the collection of subviews"
-
- subViews := aListOfViews.
- subViews notNil ifTrue:[
- subViews do:[:view |
- view superView:self
- ]
- ]
-!
-
-raise
- "bring to front"
-
- drawableId isNil ifTrue:[self create].
- device raiseWindow:drawableId
-
- "
- Transcript topView raise
- "
-!
-
-lower
- "bring to back"
-
- drawableId isNil ifTrue:[self create].
- device lowerWindow:drawableId
-
- "
- Transcript topView lower
- "
-! !
-
-!SimpleView methodsFor:'initialization'!
-
-initEvents
- "will be sent by create - can be redefined by subclasses to enable
- view events"
-
- ^ self
-!
-
-defaultControllerClass
- ^ nil "/ Controller
-!
-
-initStyleSheet
- "this method gets the styleSheet"
-
- "
- when coming here the first time, we read the styleSheet
- and keep the values in fast class variables
- "
- StyleSheet isNil ifTrue:[
- self class updateStyleCache
- ].
-
- styleSheet := StyleSheet.
-!
-
-initStyle
- "this method sets up all style dependent things"
-
- self initStyleSheet.
-
- borderWidth := DefaultBorderWidth.
- borderWidth isNil ifTrue:[borderWidth := 1].
-
- viewBackground := DefaultViewBackgroundColor.
-
- DefaultLightColor notNil ifTrue:[
- lightColor := DefaultLightColor.
- ] ifFalse:[
- device hasGreyscales ifTrue:[
- DefaultLightColor := lightColor := viewBackground lightened.
- ] ifFalse:[
- "
- this seems strange: on B&W screens, we create the light color
- darker than normal viewBackground (White) -
- to make the boundary of the view visible
- "
- lightColor := Color grey:50
- ]
- ].
- DefaultShadowColor notNil ifTrue:[
- shadowColor := DefaultShadowColor.
+!SimpleView methodsFor:'scrolling'!
+
+horizontalScrollStep
+ "return the amount to scroll when stepping left/right.
+ Subclasses may want to redefine this."
+
+ ^ (device horizontalPixelPerMillimeter * 20) asInteger
+!
+
+scrollDown
+ "scroll down by some amount; this is called when the scrollbars
+ scroll-step down button is pressed."
+
+ self scrollDown:(self verticalScrollStep)
+!
+
+scrollHorizontalTo:aPixelOffset
+ "change origin to make aPixelOffset be the left col"
+
+ |orgX|
+
+ orgX := self viewOrigin x.
+
+ (aPixelOffset < orgX) ifTrue:[
+ self scrollLeft:(orgX - aPixelOffset)
] ifFalse:[
- shadowColor := Black
- ].
-
- lightColor := lightColor.
- shadowColor := shadowColor.
- borderColor := DefaultBorderColor.
- font := DefaultFont.
-!
-
-initialize
- "initialize all state of the view - usually redefined in subclasses,
- but always doing a 'super initialize'. Each class should setup its
- locals - and not forget the others.
- View setup is separated into two parts, the general setup done here
- and the style specific setup in initStyle. Each view should be prepared
- for a stylechange by being sent another initStyle with a new style value.
- (in this case, it should set all of its style-dependent things, but
- leave the state and contents as-is)"
-
- |ext myClass controllerClass|
-
- super initialize.
-
- font := DefaultFont.
-
- shown := hiddenOnRealize := realized := false.
-
- "fill in some defaults - some of them are usually redefined in subclasses
- initialize methods"
-
- myClass := self class.
- name := myClass name "asString" asLowercaseFirst.
- ext := myClass defaultExtent.
- resources := myClass classResources.
-
- level := margin := 0.
- margin := 0.
-
- self initStyle.
-
- left := top := 0.
- width := ext x.
- height := ext y.
-
- originChanged := extentChanged := false.
- bitGravity := nil.
- viewGravity := nil.
-
- controllerClass := self defaultControllerClass.
- controllerClass notNil ifTrue:[
- controller := controllerClass new.
- controller view:self.
- ].
-!
-
-prepareForReinit
- super prepareForReinit.
- windowGroup notNil ifTrue:[
- windowGroup reinitialize
- ]
-!
-
-reinitialize
- "this is called right snapIn"
-
- |myController|
-
- "if I have already been reinited - return"
- drawableId notNil ifTrue:[
- ^ self
- ].
-
- "
- superView must be there, first
- "
- superView notNil ifTrue:[
- superView id isNil ifTrue:[
- superView reinitialize
- ]
- ].
-
- myController := controller.
- controller := nil.
- self recreate.
-
- "if I was mapped, do it again"
- realized ifTrue:[
- "only remap if I have a superview - otherwise, I might be
- a hidden iconView or menu ..."
- superView notNil ifTrue:[
-"/ shown ifTrue:[
- device mapView:self id:drawableId iconified:false
- atX:left y:top width:width height:height
-"/ ].
- ].
- ].
-
- "restore controller"
- controller := myController
-!
-
-reinitStyle
- "this method is called for a style change"
-
- |t|
-
- self initStyle.
- drawableId notNil ifTrue:[
- "force a change"
- t := borderWidth. borderWidth := nil. self borderWidth:t.
- t := viewBackground. viewBackground := nil. self viewBackground:t.
- self clear.
- self redraw
- ].
-!
-
-initializeMiddleButtonMenu
- "a place to initialize menu - this one is sent once when the view is
- first created; usually redefined in subclasses; default here is no menu.
- Notice, that static middleButtonmenus are a historic thing in ST/X;
- you may prefer to create the menu dynamically (i.e. the ST-80 way)."
-
- ^ self
-! !
-
-!SimpleView methodsFor:'accessing-bg & border'!
-
-borderWidth
- "return my borderWidth"
-
- ^ borderWidth
-!
-
-level:aNumber
- "set my level relative to superView (3D)"
-
- |oldMargin how|
-
- (aNumber ~~ level and:[aNumber notNil]) ifTrue:[
- self is3D ifTrue:[
- level := aNumber.
- oldMargin := margin.
- margin := level abs.
-
- realized ifTrue:[
- margin ~~ oldMargin ifTrue:[
- (margin > oldMargin) ifTrue:[
- how := #smaller
- ] ifFalse:[
- how := #larger
- ].
- self sizeChanged:how.
- self setInnerClip.
- ].
- shown ifTrue:[
- self redrawEdges
- ]
- ]
- ]
- ]
-!
-
-borderWidth:aNumber
- "set my borderWidth"
-
- (aNumber ~~ borderWidth) ifTrue:[
- borderWidth := aNumber.
- drawableId notNil ifTrue:[
- device setWindowBorderWidth:aNumber in:drawableId
- ]
- ]
-!
-
-viewBackground:something
- "set the viewBackground to something, a color, image or form.
- If its a color and we run on a color display, also set shadow and light
- colors - this means, that a red view will get light-red and dark-red
- edges."
-
- something isColor ifTrue:[
- device hasGreyscales ifTrue:[
- shadowColor := something darkened.
- lightColor := something lightened
- ]
- ].
- super viewBackground:something
-!
-
-margin
- "return my margin - this is usually the level,
- but can be more for some views"
-
- ^ margin
-!
-
-borderColor
- "return my borderColor"
-
- ^ borderColor
-!
-
-borderColor:aColor
- "set my borderColor"
-
- (aColor ~~ borderColor) ifTrue:[
- borderColor := aColor.
- drawableId notNil ifTrue:[
- self setBorderColor
+ (aPixelOffset > orgX) ifTrue:[
+ self scrollRight:(aPixelOffset - orgX)
]
]
!
-borderShape:aForm
- "set the borderShape to aForm"
-
- borderShape := aForm.
- drawableId notNil ifTrue:[
- device setWindowBorderShape:(aForm id) in:drawableId
- ]
-!
-
-viewShape:aForm
- "set the viewShape to aForm"
-
- viewShape := aForm.
- drawableId notNil ifTrue:[
- device setWindowShape:(aForm id) in:drawableId
- ]
-!
-
-level
- "return my level relative to superView (3D)"
-
- ^ level
-!
-
-lightColor:aColorOrImage
- "set the color to be used for lighted edges (3D only)"
-
- lightColor := aColorOrImage
-!
-
-shadowColor:aColorOrImage
- "set the color to be used for shadowed edges (3D only)"
-
- shadowColor := aColorOrImage
-! !
-
-!SimpleView methodsFor:'informing others of changes'!
-
-contentsChanged
- "this one is sent, whenever contents changes size -
- tell dependents about the change (i.e. scrollers)."
-
- self changed:#sizeOfContents
-!
-
-originChanged:delta
- "this one is sent, after the origin of my contents has changed -
- tell dependents (i.e. scrollers) about this"
-
- self changed:#originOfContents with:delta.
-"/ subViews notNil ifTrue:[
-"/ subViews do:[:aSubView |
-"/ aSubView pixelOrigin:((aSubView left @ aSubView top) - delta)
-"/ ]
-"/ ]
-!
-
-originWillChange
- "this one is sent, just before viewOrigin changes -
- gives subclasses a chance to catch scrolls easily
- (for example to hide cursor before scroll)"
-
- ^ self
-! !
-
-!SimpleView methodsFor:'adding & removing components'!
-
-addSubView:newView
- "add a view to the collection of subviews"
-
- subViews isNil ifTrue:[
- subViews := OrderedCollection with:newView
+scrollHorizontalToPercent:percent
+ "scroll to a position given in percent of total"
+
+ |wCont|
+
+ wCont := self widthOfContents.
+ transformation notNil ifTrue:[
+ wCont := transformation applyScaleX:wCont.
+ ].
+ self scrollHorizontalTo:
+ ((((wCont * percent) / 100.0) + 0.5) asInteger)
+!
+
+scrollLeft
+ "scroll left by some amount; this is called when the scrollbars
+ scroll-step left button is pressed."
+
+ self scrollLeft:(self horizontalScrollStep)
+!
+
+scrollRight
+ "scroll right by some amount; this is called when the scrollbars
+ scroll-step right button is pressed."
+
+ self scrollRight:(self horizontalScrollStep)
+!
+
+scrollToTop
+ "move viewOrigin to top"
+
+ self scrollVerticalTo:0
+!
+
+scrollToTopLeft
+ "move viewOrigin to top/left"
+
+ self scrollTo:(0 @ 0).
+!
+
+scrollUp
+ "scroll up by some amount; this is called when the scrollbars
+ scroll-step up button is pressed."
+
+ self scrollUp:(self verticalScrollStep)
+!
+
+scrollVerticalTo:aPixelOffset
+ "change origin to make aPixelOffset be the top line"
+
+ |orgY|
+
+ orgY := self viewOrigin y.
+
+ (aPixelOffset < orgY) ifTrue:[
+ self scrollUp:(orgY - aPixelOffset)
] ifFalse:[
- subViews add:newView.
- ].
- self setParentViewIn:newView.
-!
-
-setParentViewIn:aView
- "common code for addSubView* methods"
-
- aView superView:self.
- (aView device ~~ device) ifTrue:[
- 'VIEW: warning subview (' errorPrint. aView class name errorPrint.
- ') has different device than me (' errorPrint.
- self class name errorPrint. ').' errorPrintNL.
- aView device:device
- ]
-!
-
-removeSubView:aView
- "remove a view from the collection of subviews"
-
- subViews notNil ifTrue:[
- subViews remove:aView ifAbsent:[nil].
- (subViews size == 0) ifTrue:[
- subViews := nil
+ (aPixelOffset > orgY) ifTrue:[
+ self scrollDown:(aPixelOffset - orgY)
]
]
!
-add:aComponent
- "add a component (either a view or gadget) to the collection of
- subComponents."
-
- self addComponent:aComponent
-!
-
-addSubView:newView after:aView
- "add a view to the collection of subviews after another view.
- This makes sense, in Panels and other layout views, to enter a new
- element at some defined place."
-
- subViews isNil ifTrue:[
- subViews := OrderedCollection with:newView
- ] ifFalse:[
- aView isNil ifTrue:[
- subViews add:newView
- ] ifFalse:[
- subViews add:newView after:aView.
- ]
- ].
- self setParentViewIn:newView.
-!
-
-addComponent:aComponent
- "components (i.e. gadgets or lightweight views) are being prepared.
- Dont use this right now for non-views"
-
- aComponent isView ifTrue:[
- self addSubView:aComponent
- ] ifFalse:[
- components isNil ifTrue:[
- components := OrderedCollection new
- ].
- components add:aComponent.
- aComponent setParentViewIn:self
- ]
-!
-
-add:aComponent in:aRectangleOrLayoutFrame
- "for ST-80 compatibility.
- add a component in some frame; the argument may be either a rectangle
- with relative coordinates, or an instance of LayoutFrame, specifying
- both relative coordinates and the insets."
-
-"/ old code:
-"/ |origin corner l|
-"/
-"/ origin := aRectangleOrLayoutFrame origin.
-"/ origin := origin x asFloat @ origin y asFloat.
-"/ corner := aRectangleOrLayoutFrame corner.
-"/ corner := corner x asFloat @ corner y asFloat.
-"/ aComponent origin:origin corner:corner.
-"/
-"/ (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifFalse:[
-"/ aComponent leftInset:aRectangleOrLayoutFrame leftOffset.
-"/ aComponent rightInset:aRectangleOrLayoutFrame rightOffset negated.
-"/ aComponent topInset:aRectangleOrLayoutFrame topOffset.
-"/ aComponent bottomInset:aRectangleOrLayoutFrame bottomOffset negated.
-"/ ].
-
-"/ new (being validated):
-
- |l|
-
- (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifTrue:[
- l := aRectangleOrLayoutFrame asLayout.
- ] ifFalse:[
- l := aRectangleOrLayoutFrame
- ].
-
-"/ will soon be replaced by:
-"/ aComponent layout:l.
- aComponent geometryLayout:l.
-
- self addComponent:aComponent
-!
-
-addSubView:newView before:aView
- "add a view to the collection of subviews before another view.
- This makes sense, in Panels and other layout views, to enter a new
- element at some defined place."
-
- subViews isNil ifTrue:[
- subViews := OrderedCollection with:newView
- ] ifFalse:[
- aView isNil ifTrue:[
- subViews addFirst:newView
- ] ifFalse:[
- subViews add:newView before:aView.
- ]
- ].
- self setParentViewIn:newView.
-!
-
-component:aComponent
- "components (i.e. gadgets or lightweight views) are being prepared.
- Dont use this right now for non-views"
-
- aComponent origin:0.0@0.0 corner:1.0@1.0.
- aComponent isView ifTrue:[
- self addSubView:aComponent
- ] ifFalse:[
- components := OrderedCollection with:aComponent.
- aComponent setParentViewIn:self
- ]
-!
-
-removeComponent:aComponent
- "components (i.e. gadgets or lightweight views) are being prepared.
- Dont use this right now for non-views"
-
- aComponent isView ifTrue:[
- self removeSubView:aComponent
- ] ifFalse:[
- components isNil ifTrue:[^self].
- components remove:aComponent ifAbsent:[].
- aComponent parent:nil
- ]
-!
-
-addSubView:aView in:bounds borderWidth:bw
- "for ST-80 V2.x compatibility"
-
- aView borderWidth:bw.
- self add:aView in:bounds.
-!
-
-addSubView:aView viewport:aRectangle
- "ST-80 V2.x compatibility:
- Adds aView to the views list of subviews and uses the
- existing subviews window and the new viewport to position it.
- This method may be removed in future versions."
-
- self addSubView:aView.
- aView viewport:aRectangle
-!
-
-addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
- "ST-80 V2.x compatibility:
- Adds aView to the views list of subviews and uses
- aWindowRectangle and aViewportRectangle to position it.
- This method may be removed in future versions."
-
- self addSubView:aView.
- aView window:aWindowRectangle viewport:aViewportRectangle
-!
-
-destroySubViews
- "remove all subviews"
-
- subViews notNil ifTrue:[
- subViews copy do:[:aSubView |
- aSubView destroy.
- ]
- ]
-
- "Modified: 5.9.1995 / 22:35:36 / claus"
-! !
-
-!SimpleView methodsFor:'queries'!
-
-preferredExtent
- "return my preferred extent - this is the minimum size I would like to have.
- The default here is the actual extent, the receiver currently has."
-
- "mhmh - if I have components, collect their
- preferred bounds ..."
-
- |maxX maxY|
-
- subViews isNil ifTrue:[^ self extent].
-"/ ^ self extent.
-
- maxX := maxY := 0.
- subViews notNil ifTrue:[
- subViews do:[:aSubView |
- |org corn|
-
- org := aSubView computeOrigin.
- corn := org + aSubView preferredExtent.
- maxX := maxX max:corn x.
- maxY := maxY max:corn y.
- ]
+scrollVerticalToPercent:percent
+ "scroll to a position given in percent of total"
+
+ |hCont|
+
+ hCont := self heightOfContents.
+ transformation notNil ifTrue:[
+ hCont := transformation applyScaleY:hCont.
].
- ^ maxX @ maxY.
-!
-
-buttonMotionEventPending
- "return true, if a button motion event is pending.
- Normally, you dont want to use this, since no polling is needed
- (not even for mouse-tracking).
- Dont use it, since it does not honor the windowGroup, but
- goes directly to the device instead.
- Actually, its a historical leftover"
-
- windowGroup notNil ifTrue:[
- ^ windowGroup sensor hasButtonMotionEventsFor:self
- ].
- ^ super buttonMotionEventPending
-!
-
-isView
- "return true, if the receiver is some kind of view;
- true is returned here."
-
- ^ true
-!
-
-hasFocus
- "return true, if the receiver has the keyboard focus
- (either via the focusView mechanism in the windowGroup,
- or via delegation)"
-
- |focusView delegate|
-
- windowGroup isNil ifTrue:[^ false].
-
- (focusView := windowGroup focusView) == self ifTrue:[^ true].
- focusView notNil ifTrue:[
- "mhmh - is there a delegation to me ?"
- (delegate := focusView delegate) notNil ifTrue:[
- delegate == self ifTrue:[^ true].
- ^ delegate delegatesTo:self
- ]
- ].
- ^ false
-!
-
-delegatesTo:someone
- "return true, if I delegate events to someone"
-
- delegate isNil ifTrue:[^ false].
- ^ delegate delegatesTo:someone
-!
-
-isSubViewOf:aView
- "return true, if I am a subview of aView"
-
- aView == self isNil ifTrue:[^ true].
- superView isNil ifTrue:[^ false].
- superView == aView ifTrue:[^ true].
- ^ superView isSubViewOf:aView
-!
-
-canHandle:aKey from:aView
- "return true, if I like to handle the key (from a keyPress event)
- in aView.
- OBSOLETE: do not use & depend on this method, it is a historic
- leftOver and will be removed. Use the delegation mechanism for this."
-
- ^ self canHandle:aKey
-!
-
-canHandle:aKey
- "return true, if I like to handle the key (from a keyPress event).
- OBSOLETE: do not use & depend on this method, it is a historic
- leftOver and will be removed. Use the delegation mechanism for this."
-
- ^ false
-!
-
-preferredBounds
- "ST-80 compatibility."
-
- ^ 0@0 corner:self preferredExtent
-!
-
-sizeFixed
- "return true, if this vew wants its size to remain unchanged.
- Used by panels, to check if their components want to keep their size."
-
- ^ false
-
- "Created: 17.9.1995 / 20:29:20 / claus"
-! !
-
-!SimpleView methodsFor:'accessing-menus'!
-
-yellowButtonMenu
- "actually, this should be called 'middleButtonMenu'.
- But for ST-80 compatibility ....
- This method will vanish, once all views have controllers
- associated with them; for now, duplicate some code also found in
- controller."
-
- |sym menuHolder|
-
-"/ middleButtonMenu notNil ifTrue:[
-"/ "/
-"/ "/ has been assigned a static middleButtonMenu
-"/ "/ (or a cached menu)
-"/ "/
-"/ ^ middleButtonMenu
-"/ ].
-
- menuHolder := self menuHolder.
-
- menuHolder notNil ifTrue:[
- sym := self menuMessage.
- sym notNil ifTrue:[
- "
- mhmh - for backward compatibility, try to ask
- the model first, then use the views menu.
- "
- (menuHolder respondsTo:sym) ifFalse:[
- (self respondsTo:sym) ifTrue:[
- menuHolder := self
- ]
- ].
- "
- ask the menuHolder for the menu
- "
- ^ menuHolder perform:sym.
- ].
- ].
-
- ^ nil
-!
-
-menuHolder
- "who has the menu ?
- By default, I have it."
-
- ^ self
-!
-
-menuPerformer
- "who should perform the menu actions ?
- By default, I do it."
-
- ^ self
-!
-
-menuMessage
- "Return the symbol sent to myself to aquire the menu"
-
- ^ #middleButtonMenu
-! !
-
-!SimpleView methodsFor:'change & update'!
-
-update:aspect with:aParameter from:changedObject
- "an update request"
-
- aspect == #sizeOfView ifTrue:[
- "one of the views we depend on changed its size"
- ^ self superViewChangedSize.
- ].
- ^super update:aspect with:aParameter from:changedObject
-! !
-
-!SimpleView methodsFor:'enumerating subviews'!
-
-allSubViewsDo:aBlock
- "evaluate aBlock for all subviews (recursively)"
-
- (subViews isNil or:[subViews isEmpty]) ifFalse:[
- subViews do:[:aSubview |
- aSubview withAllSubViewsDo:aBlock
- ]
- ]
-!
-
-withAllSubViewsDo:aBlock
- "evaluate aBlock for the receiver and all subviews (recursively)"
-
- aBlock value:self.
- self allSubViewsDo:aBlock
+ self scrollVerticalTo:
+ ((((hCont * percent) / 100.0) + 0.5) asInteger)
+!
+
+verticalScrollStep
+ "return the amount to scroll when stepping up/down.
+ Subclasses may want to redefine this."
+
+ ^ (device verticalPixelPerMillimeter * 20) asInteger
+!
+
+widthForScrollBetween:yStart and:yEnd
+ "return the width in pixels for a scroll between yStart and yEnd
+ - return full width here since we do not know how wide contents is.
+ Views which only use part of their space (short lists, text) may redefine
+ this method and return the number of pixels that have to be scrolled.
+ On slow displays, this may make a difference; on fast ones you will probably
+ not notice any difference."
+
+ ^ (width - margin - margin)
! !
!SimpleView methodsFor:'scrolling-basic'!
-scrollTo:newOrigin
- "change origin to have newOrigin be visible at the top-left.
- The argument defines the integer device coordinates of the new top-left
- point."
-
- "due to historic reasons, the work is actually done by scrollUp/Down
- scrollLeft/Right (those where implemented first).
- This will be changed to do all work here, and call it from
- the other scrolling methods."
-
- |dX "{ Class:SmallInteger }"
- dY "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- orgX "{ Class:SmallInteger }"
- orgY "{ Class:SmallInteger }" |
-
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated
- ].
- dX := newOrigin x - orgX.
- dY := newOrigin y - orgY.
- dX = 0 ifTrue:[
- dY < 0 ifTrue:[
- ^ self scrollUp:(dY negated).
- ].
- dY > 0 ifTrue:[
- ^ self scrollDown:dY.
- ].
- ^ self
- ].
- dY = 0 ifTrue:[
- dX < 0 ifTrue:[
- ^ self scrollLeft:dX negated
- ].
- dX > 0 ifTrue:[
- ^ self scrollRight:dX
- ].
- ].
-
- self originWillChange.
- self setViewOrigin:newOrigin.
- shown ifTrue:[
- m2 := margin * 2. "top & bottom margins"
- self redrawDeviceX:margin y:margin
- width:(width - m2)
- height:(height - m2).
- ].
- self originChanged:(dX @ dY).
-!
-
-scrollUp:nPixels
- "change origin to scroll up (towards the origin) by some pixels"
-
- |count "{ Class:SmallInteger }"
- m2 "{ Class:SmallInteger }"
- w "{ Class:SmallInteger }"
- h "{ Class:SmallInteger }"
- orgX
- orgY "{ Class:SmallInteger }"
- newOrigin|
-
- transformation isNil ifTrue:[
- orgY := orgX := 0
- ] ifFalse:[
- orgY := transformation translation y negated.
- orgX := transformation translation x negated
- ].
-
- count := nPixels.
- (count > orgY) ifTrue:[
- count := orgY
- ].
- (count <= 0) ifTrue:[^ self].
-
- self originWillChange.
- newOrigin := orgX @ (orgY - count).
-
- shown ifFalse:[
- self setViewOrigin:newOrigin.
- ] ifTrue:[
- m2 := margin * 2. "top & bottom margins"
- (count >= self innerHeight) ifTrue:[
- self setViewOrigin:newOrigin.
- self redrawDeviceX:margin y:margin
- width:(width - m2)
- height:(height - m2).
- ] ifFalse:[
- h := height - m2 - count.
- w := width.
- self catchExpose.
- self setViewOrigin:newOrigin.
- self copyFrom:self x:margin y:margin
- toX:margin y:(count + margin)
- width:w height:h.
-
- self setInnerClip.
- self redrawDeviceX:margin y:margin
- width:(width - m2)
- height:count.
-
- self waitForExpose.
- ]
- ].
- self originChanged:(0 @ count negated).
-!
-
scrollDown:nPixels
"change origin to scroll down some pixels"
@@ -5451,131 +5214,426 @@
].
].
self originChanged:(count @ 0).
+!
+
+scrollTo:newOrigin
+ "change origin to have newOrigin be visible at the top-left.
+ The argument defines the integer device coordinates of the new top-left
+ point."
+
+ "due to historic reasons, the work is actually done by scrollUp/Down
+ scrollLeft/Right (those where implemented first).
+ This will be changed to do all work here, and call it from
+ the other scrolling methods."
+
+ |dX "{ Class:SmallInteger }"
+ dY "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ orgX "{ Class:SmallInteger }"
+ orgY "{ Class:SmallInteger }" |
+
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated
+ ].
+ dX := newOrigin x - orgX.
+ dY := newOrigin y - orgY.
+ dX = 0 ifTrue:[
+ dY < 0 ifTrue:[
+ ^ self scrollUp:(dY negated).
+ ].
+ dY > 0 ifTrue:[
+ ^ self scrollDown:dY.
+ ].
+ ^ self
+ ].
+ dY = 0 ifTrue:[
+ dX < 0 ifTrue:[
+ ^ self scrollLeft:dX negated
+ ].
+ dX > 0 ifTrue:[
+ ^ self scrollRight:dX
+ ].
+ ].
+
+ self originWillChange.
+ self setViewOrigin:newOrigin.
+ shown ifTrue:[
+ m2 := margin * 2. "top & bottom margins"
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ].
+ self originChanged:(dX @ dY).
+!
+
+scrollUp:nPixels
+ "change origin to scroll up (towards the origin) by some pixels"
+
+ |count "{ Class:SmallInteger }"
+ m2 "{ Class:SmallInteger }"
+ w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ orgX
+ orgY "{ Class:SmallInteger }"
+ newOrigin|
+
+ transformation isNil ifTrue:[
+ orgY := orgX := 0
+ ] ifFalse:[
+ orgY := transformation translation y negated.
+ orgX := transformation translation x negated
+ ].
+
+ count := nPixels.
+ (count > orgY) ifTrue:[
+ count := orgY
+ ].
+ (count <= 0) ifTrue:[^ self].
+
+ self originWillChange.
+ newOrigin := orgX @ (orgY - count).
+
+ shown ifFalse:[
+ self setViewOrigin:newOrigin.
+ ] ifTrue:[
+ m2 := margin * 2. "top & bottom margins"
+ (count >= self innerHeight) ifTrue:[
+ self setViewOrigin:newOrigin.
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:(height - m2).
+ ] ifFalse:[
+ h := height - m2 - count.
+ w := width.
+ self catchExpose.
+ self setViewOrigin:newOrigin.
+ self copyFrom:self x:margin y:margin
+ toX:margin y:(count + margin)
+ width:w height:h.
+
+ self setInnerClip.
+ self redrawDeviceX:margin y:margin
+ width:(width - m2)
+ height:count.
+
+ self waitForExpose.
+ ]
+ ].
+ self originChanged:(0 @ count negated).
! !
-!SimpleView methodsFor:'scrolling'!
-
-widthForScrollBetween:yStart and:yEnd
- "return the width in pixels for a scroll between yStart and yEnd
- - return full width here since we do not know how wide contents is.
- Views which only use part of their space (short lists, text) may redefine
- this method and return the number of pixels that have to be scrolled.
- On slow displays, this may make a difference; on fast ones you will probably
- not notice any difference."
-
- ^ (width - margin - margin)
-!
-
-verticalScrollStep
- "return the amount to scroll when stepping up/down.
- Subclasses may want to redefine this."
-
- ^ (device verticalPixelPerMillimeter * 20) asInteger
-!
-
-scrollVerticalToPercent:percent
- "scroll to a position given in percent of total"
-
- |hCont|
-
- hCont := self heightOfContents.
- transformation notNil ifTrue:[
- hCont := transformation applyScaleY:hCont.
- ].
- self scrollVerticalTo:
- ((((hCont * percent) / 100.0) + 0.5) asInteger)
-!
-
-scrollVerticalTo:aPixelOffset
- "change origin to make aPixelOffset be the top line"
-
- |orgY|
-
- orgY := self viewOrigin y.
-
- (aPixelOffset < orgY) ifTrue:[
- self scrollUp:(orgY - aPixelOffset)
+!SimpleView methodsFor:'startup'!
+
+open
+ "open up the view - for normal views, this is a modeless open
+ (i.e. the new view comes up as independent process).
+ Although #open is only to be sent to topviews (i.e. it could have been
+ implemented in TopView), it is implemented here - therefore, every view
+ can be opened as a topView.
+ This is redefined in ModalBox, which comes up modal (i.e.
+ control is under the current process, so that interaction with the
+ current group is blocked while the modalBox is active)."
+
+ ^ self openModeless
+
+ "
+ View new open
+
+ (Button label:'hello') open
+
+ |top|
+ top := StandardSystemView new.
+ top extent:200@200.
+ Button label:'hello' in:top.
+ top open
+
+ YesNoBox new open
+ "
+!
+
+openAndWait
+ "open up the view - wait until it is visible.
+ In normal applications, you do not need to wait till the view is
+ open - it should do all of its drawing itself when it gets the
+ first expose event.
+ However, if you want to 'manually' draw into the view (for example,
+ in doIt expressions) the view must be visible (realized) before doing so.
+ Use this open in those situations."
+
+ self open.
+ self waitUntilVisible.
+
+ "does not work:
+
+ |v|
+
+ v := View new open.
+ v displayLineFrom:0@0 to:50@50
+
+ does work:
+
+ |v|
+
+ v := View new openAndWait.
+ v displayLineFrom:0@0 to:50@50
+ "
+!
+
+openAt:aPoint
+ "open up the view modeless - positions the view"
+
+ ^self openModelessAt:aPoint
+
+ "Created: 18.9.1995 / 23:30:43 / claus"
+!
+
+openAtCenter
+ "open up the view modeless - positions the view"
+
+ ^self openModelessAtCenter
+
+ "Created: 18.9.1995 / 23:30:56 / claus"
+!
+
+openAutonomous
+ "create and schedule a new windowgroup for me and open the view.
+ The view will be handled by its own process, effectively running in
+ parallel. This entry is for non-topviews, which want to be served
+ autonomous from the topview. (see the fileBrowsers kill-button
+ when executing unix commands as an example)"
+
+ |wg|
+
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ wg := WindowGroup new.
+ self windowGroup:wg.
+ wg addView:self.
+ wg startup:false.
+ self realizeInGroup.
+ ] ifTrue:[
+ self realize
+ ]
+!
+
+openModal
+ "create a new windowgroup, but start processing in the current process
+ actually suspending event processing for the currently active group.
+ Stay in modalLoop while view is visible.
+ (i.e. control is returned to the sender when the receiver is closed)"
+
+ self openModal:[true]
+
+ "
+ the same:
+ YesNoBox new open
+
+ YesNoBox new openModal
+
+ different:
+ (Button label:'hello') open
+
+ (Button label:'hello') openModal
+ "
+!
+
+openModal:aBlock
+ "create a new windowgroup, but start processing in the current process -
+ actually suspending event processing for the currently active group.
+ Stay in this modal loop while aBlock evaluates to true AND the receiver is
+ visible.
+ (i.e. control is returned to the sender when the receiver is closed)
+ This makes any interaction with the current window impossible -
+ however, other views (in other windowgroups) still work."
+
+ |activeGroup tops|
+
+ activeGroup := WindowGroup activeGroup.
+ Processor activeProcessIsSystemProcess ifTrue:[
+ "
+ put myself into the modal group, let it handle events for
+ me as well. This is only a half way solution, since the view
+ is not modal at all ... however, the only situation
+ where this happens is with modal boxes popped while in a
+ modal browser. You will forgive me for that inconvenience.
+ "
+ windowGroup := activeGroup.
+ activeGroup notNil ifTrue:[activeGroup addTopView:self].
+ self realize
] ifFalse:[
- (aPixelOffset > orgY) ifTrue:[
- self scrollDown:(aPixelOffset - orgY)
+ "
+ create a new window group and put myself into it
+ "
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ "
+ go dispatch events in this new group
+ (thus current windowgroup is blocked from interaction)
+ "
+ Object abortSignal handle:[:ex |
+ self hide.
+ ex return.
+ ] do:[
+ [
+ windowGroup startupModal:[realized and:aBlock]
+ ] valueOnUnwindDo:[
+ self hide.
+ ]
+ ].
+ "
+ return input focus to previously active groups top.
+ This helps with windowmanagers which need an explicit click
+ on the view for the focus.
+ "
+ activeGroup notNil ifTrue:[
+ tops := activeGroup topViews.
+ (tops notNil and:[tops notEmpty]) ifTrue:[
+ tops first getKeyboardFocus
+ ]
]
]
!
-scrollHorizontalToPercent:percent
- "scroll to a position given in percent of total"
-
- |wCont|
-
- wCont := self widthOfContents.
- transformation notNil ifTrue:[
- wCont := transformation applyScaleX:wCont.
- ].
- self scrollHorizontalTo:
- ((((wCont * percent) / 100.0) + 0.5) asInteger)
-!
-
-horizontalScrollStep
- "return the amount to scroll when stepping left/right.
- Subclasses may want to redefine this."
-
- ^ (device horizontalPixelPerMillimeter * 20) asInteger
-!
-
-scrollHorizontalTo:aPixelOffset
- "change origin to make aPixelOffset be the left col"
-
- |orgX|
-
- orgX := self viewOrigin x.
-
- (aPixelOffset < orgX) ifTrue:[
- self scrollLeft:(orgX - aPixelOffset)
- ] ifFalse:[
- (aPixelOffset > orgX) ifTrue:[
- self scrollRight:(aPixelOffset - orgX)
- ]
+openModalAt:aPoint
+ "open up the view modeless - positions the view
+ (i.e. circumvents window managers positioning)"
+
+ self origin:aPoint.
+ self create.
+ device setTransient:drawableId for:0.
+ ^ self openModal
+
+ "
+ View new openModal
+
+ View new openModalAt:100@100
+ "
+
+ "Created: 18.9.1995 / 23:21:42 / claus"
+ "Modified: 18.9.1995 / 23:32:26 / claus"
+!
+
+openModalAtCenter
+ "open up the view modeless - positions the view
+ (i.e. circumvents window managers positioning)"
+
+ ^ self openModalAt:(device center - (self extent//2)).
+
+ "Created: 18.9.1995 / 23:31:47 / claus"
+!
+
+openModeless
+ "create and schedule a new windowgroup for me and open the view.
+ The view will be handled by its own process, effectively running in
+ parallel (i.e. control is returned to the sender immediately)."
+
+ ProcessorScheduler isPureEventDriven ifFalse:[
+ windowGroup isNil ifTrue:[
+ windowGroup := WindowGroup new.
+ windowGroup addTopView:self.
+ windowGroup startup:false.
+ ] ifFalse:[
+ windowGroup startup:false.
+ self realizeInGroup.
+ ].
+ ] ifTrue:[
+ self realize
]
-!
-
-scrollToTop
- "move viewOrigin to top"
-
- self scrollVerticalTo:0
-!
-
-scrollToTopLeft
- "move viewOrigin to top/left"
-
- self scrollTo:(0 @ 0).
-!
-
-scrollUp
- "scroll up by some amount; this is called when the scrollbars
- scroll-step up button is pressed."
-
- self scrollUp:(self verticalScrollStep)
-!
-
-scrollDown
- "scroll down by some amount; this is called when the scrollbars
- scroll-step down button is pressed."
-
- self scrollDown:(self verticalScrollStep)
-!
-
-scrollLeft
- "scroll left by some amount; this is called when the scrollbars
- scroll-step left button is pressed."
-
- self scrollLeft:(self horizontalScrollStep)
-!
-
-scrollRight
- "scroll right by some amount; this is called when the scrollbars
- scroll-step right button is pressed."
-
- self scrollRight:(self horizontalScrollStep)
+
+ "
+ the same:
+ (Button label:'hello') open
+
+ (Button label:'hello') openModeless
+
+ different:
+ YesNoBox new open
+
+ YesNoBox new openModeless
+ "
+ "
+ (almost) the same:
+ YesNoBox new open
+
+ YesNoBox new openModal
+
+ different:
+ (Button label:'hello') open
+
+ (Button label:'hello') openModal
+ "
+!
+
+openModelessAt:aPoint
+ "open up the view modeless - positions the view
+ (i.e. circumvents window managers positioning)"
+
+ self origin:aPoint.
+ self create.
+ device setTransient:drawableId for:0.
+ ^ self openModeless
+
+ "
+ View new openModeless
+
+ View new openModelessAt:100@100
+ "
+
+ "Created: 18.9.1995 / 23:21:42 / claus"
+!
+
+openModelessAtCenter
+ "open up the view modeless - positions the view
+ (i.e. circumvents window managers positioning)"
+
+ ^ self openModelessAt:(device center - (self extent//2)).
+
+ "
+ View new openModeless
+
+ View new openModelessAtCenter
+ "
+
+ "Created: 18.9.1995 / 23:21:42 / claus"
+!
+
+waitUntilVisible
+ "wait until the receiver visible.
+ In normal applications, you do not need to wait till a view is
+ open - it should do all of its drawing itself when it gets the
+ first expose event.
+ However, if you want to 'manually' draw into the view (for example,
+ in doIt expressions), or subsequent views depend on some state of
+ another view (which is only available once visible),
+ use this to suspend the current process until the receiver is shown.
+ Caveat:
+ we poll here for the view to be shown - we need a semaphore
+ which is raised by the view in order to do it right."
+
+ [self shown] whileFalse:[
+ (Delay forSeconds:0.05) wait.
+ ].
+
+ "does not work (the view is in its opening phase,
+ when we attempt to draw a line - this gives an error, since
+ its internals are not yet correctly setup):
+
+ |v|
+
+ v := View new open.
+ v displayLineFrom:0@0 to:50@50
+
+ does work (since we wait until the view has completely finished
+ its startup phase):
+
+ |v|
+
+ v := View new open.
+ v waitUntilVisible.
+ v displayLineFrom:0@0 to:50@50
+ "
! !
!SimpleView methodsFor:'user notification'!
@@ -5601,67 +5659,9 @@
super warn:(resources string:aString with:arg1 with:arg2) withCRs
! !
-!SimpleView methodsFor:'cursor animation'!
-
-showBusyWhile:aBlock
- "evaluate some time consuming block, while doing this,
- show a spinning wheel cursor"
-
- |ok bitmaps cursors mask process oldCursor|
-
- oldCursor := cursor.
-
- ok := true.
- bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4')
- collect:[:name |
- |f|
-
- f := Form fromFile:(name , '.xbm').
- f isNil ifTrue:[
- ('no bitmap file: ' , name , '.xbm') errorPrintNL.
- ok := false
- ].
- f
- ].
-
- mask := Form fromFile:'wheelm.xbm'.
- mask isNil ifTrue:[
- ('no bitmap file: ' , mask , '.xbm') errorPrintNL.
- ok := false
- ].
-
- ok ifFalse:[
- self cursor:Cursor wait.
- aBlock valueNowOrOnUnwindDo:[
- self cursor:oldCursor
- ]
- ] ifTrue:[
- cursors := bitmaps collect:[:form | (Cursor sourceForm:form
- maskForm:mask
- hotX:8
- hotY:8) on:device].
-
- process := [
- (Delay forSeconds:0.25) wait.
- [true] whileTrue:[
- cursors do:[:curs |
- self cursor:curs.
- (Delay forSeconds:0.05) wait
- ]
- ]
- ] fork.
-
- Processor activeProcess priority:7.
- aBlock valueNowOrOnUnwindDo:[
- Processor activeProcess priority:8.
- process terminate.
- self cursor:oldCursor
- ]
- ].
-
- "
- View new realize showBusyWhile:[10 timesRepeat:[3000 factorial]]
- "
+!SimpleView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.31 1995-11-27 22:31:10 cg Exp $'
! !
-
SimpleView initialize!
--- a/StandardSystemView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/StandardSystemView.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,12 +11,11 @@
"
TopView subclass:#StandardSystemView
- instanceVariableNames:'label icon iconView iconLabel
- minExtent maxExtent sizeFixed
- application windowEventsForApplication'
- classVariableNames: 'DefaultIcon TakeFocusWhenMapped IncludeHostNameInLabel'
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'label icon iconView iconLabel minExtent maxExtent sizeFixed
+ application windowEventsForApplication'
+ classVariableNames:'DefaultIcon TakeFocusWhenMapped IncludeHostNameInLabel'
+ poolDictionaries:''
+ category:'Views-Basic'
!
!StandardSystemView class methodsFor:'documentation'!
@@ -35,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.36 1995-11-24 22:33:17 cg Exp $'
-!
-
documentation
"
I represent topViews i.e. those views which have a title-label,
@@ -47,84 +42,34 @@
"
! !
-!StandardSystemView class methodsFor:'defaults'!
-
-includeHostNameInLabel
- "return the flag which controls if a views label should
- include the hostname.
- This flag is usually set/cleared in your private.rc file;
- the default is false."
-
- ^ IncludeHostNameInLabel
-
- "Created: 10.9.1995 / 19:21:16 / claus"
-!
+!StandardSystemView class methodsFor:'instance creation'!
-includeHostNameInLabel:aBoolean
- "set/clear the flag which controls if a views label should
- include the hostname - this is highly useful if you have
- multiple smalltalks open simultaniously ...
- This flag is usually set/cleared in your private.rc file;
- the default is false."
+extent:anExtent label:aLabel icon:aForm
+ "create a new topView and define its extent, label and icon"
- IncludeHostNameInLabel := aBoolean
-!
-
-defaultLabel
- "return the default label for views of my kind.
- This can be redefined in subclasses or overwritten in
- initialize methods."
-
- ^ 'aView'
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:aForm
+ minExtent:nil maxExtent:nil
!
-defaultIcon
- "return the default icon for views.
- This can be redefined in subclasses or overwritten in
- initialize methods."
-
- DefaultIcon isNil ifTrue:[
- DefaultIcon := Image fromFile:'SmalltalkX.xbm'.
- DefaultIcon notNil ifTrue:[
- DefaultIcon := DefaultIcon on:Display
- ]
- ].
- ^ DefaultIcon
-! !
-
-!StandardSystemView class methodsFor:'startup'!
-
-open
- "create, realize the view - this topview and all its subviews will
- run as a separate process with its own windowGroup"
-
- ^ self new open
+extent:anExtent label:aLabel icon:aForm minExtent:minExtent
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:aForm
+ minExtent:minExtent maxExtent:nil
!
-start
- "create, realize the view - this topview and all its subviews will
- run as a separate process with its own windowGroup.
- This method exists for backward compatibility - use open."
-
- ^ self open
-! !
-
-!StandardSystemView class methodsFor:'instance creation'!
+extent:anExtent label:aLabel icon:aForm minExtent:minExtent maxExtent:maxExtent
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:aForm
+ minExtent:minExtent maxExtent:maxExtent
+!
-model:aModel label:aLabel minimumSize:minExtent
- "ST80-style instance creation"
-
- |newView|
+extent:anExtent label:aLabel minExtent:minExtent
+ "create a new topView and define its extent, label and minumum extent"
- newView := self origin:nil
- extent:minExtent
- label:aLabel
- icon:nil
- minExtent:minExtent
- maxExtent:nil.
- newView model:aModel.
-"/ newView controller:(self defaultControllerClass new view:newView).
- ^ newView
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:nil
+ minExtent:minExtent maxExtent:nil
!
label:aLabel
@@ -135,14 +80,6 @@
minExtent:nil maxExtent:nil
!
-label:aLabel minExtent:anExtent
- "create a new topView and define its label and minimum extent"
-
- ^ self origin:nil extent:nil
- label:aLabel icon:nil
- minExtent:anExtent maxExtent:nil
-!
-
label:aLabel icon:aForm
"create a new topView and define its label and icon"
@@ -167,6 +104,30 @@
minExtent:minExtent maxExtent:maxExtent
!
+label:aLabel minExtent:anExtent
+ "create a new topView and define its label and minimum extent"
+
+ ^ self origin:nil extent:nil
+ label:aLabel icon:nil
+ minExtent:anExtent maxExtent:nil
+!
+
+model:aModel label:aLabel minimumSize:minExtent
+ "ST80-style instance creation"
+
+ |newView|
+
+ newView := self origin:nil
+ extent:minExtent
+ label:aLabel
+ icon:nil
+ minExtent:minExtent
+ maxExtent:nil.
+ newView model:aModel.
+"/ newView controller:(self defaultControllerClass new view:newView).
+ ^ newView
+!
+
origin:anOrigin extent:anExtent label:aLabel
"create a new topView and define its origin, extent and label"
@@ -183,60 +144,429 @@
^ self origin:anOrigin extent:nil
label:aLabel icon:aForm
minExtent:minExtent maxExtent:maxExtent
+! !
+
+!StandardSystemView class methodsFor:'defaults'!
+
+defaultIcon
+ "return the default icon for views.
+ This can be redefined in subclasses or overwritten in
+ initialize methods."
+
+ DefaultIcon isNil ifTrue:[
+ DefaultIcon := Image fromFile:'SmalltalkX.xbm'.
+ DefaultIcon notNil ifTrue:[
+ DefaultIcon := DefaultIcon on:Display
+ ]
+ ].
+ ^ DefaultIcon
+!
+
+defaultLabel
+ "return the default label for views of my kind.
+ This can be redefined in subclasses or overwritten in
+ initialize methods."
+
+ ^ 'aView'
+!
+
+includeHostNameInLabel
+ "return the flag which controls if a views label should
+ include the hostname.
+ This flag is usually set/cleared in your private.rc file;
+ the default is false."
+
+ ^ IncludeHostNameInLabel
+
+ "Created: 10.9.1995 / 19:21:16 / claus"
+!
+
+includeHostNameInLabel:aBoolean
+ "set/clear the flag which controls if a views label should
+ include the hostname - this is highly useful if you have
+ multiple smalltalks open simultaniously ...
+ This flag is usually set/cleared in your private.rc file;
+ the default is false."
+
+ IncludeHostNameInLabel := aBoolean
+! !
+
+!StandardSystemView class methodsFor:'startup'!
+
+open
+ "create, realize the view - this topview and all its subviews will
+ run as a separate process with its own windowGroup"
+
+ ^ self new open
+!
+
+start
+ "create, realize the view - this topview and all its subviews will
+ run as a separate process with its own windowGroup.
+ This method exists for backward compatibility - use open."
+
+ ^ self open
+! !
+
+!StandardSystemView methodsFor:'accessing'!
+
+application
+ "return the topViews application.
+ This is new protocol for ST-80 compatibility and not yet fully supported"
+
+ ^ application
+!
+
+application:anApplicationModel
+ "set the topViews application.
+ This is new protocol for ST-80 compatibility and not yet fully supported"
+
+ application := anApplicationModel
+!
+
+bePartner
+ self setWindowGroupFromApplication.
+ super bePartner.
+
+ "Created: 22.9.1995 / 17:40:15 / claus"
+!
+
+beSlave
+ self setWindowGroupFromApplication.
+ super beSlave.
+
+ "Created: 22.9.1995 / 17:40:15 / claus"
+!
+
+icon
+ "return the form defined as icon"
+
+ ^ icon
!
-extent:anExtent label:aLabel minExtent:minExtent
- "create a new topView and define its extent, label and minumum extent"
+icon:aForm
+ "define the form (bitmap) used as icon"
+
+ |invertedIcon i|
+
+ icon := aForm.
+ icon notNil ifTrue:[
+ drawableId notNil ifTrue:[
+ icon depth ~~ 1 ifTrue:[
+ icon := icon asMonochromeFormOn:device.
+ ].
+ "icons assume 1s as black - invert icon if the device thinks different"
+ (device depth == 1 and:[device whitepixel ~~ 0]) ifTrue:[
+ i := icon on:device.
+ i notNil ifTrue:[
+ invertedIcon := Form width:icon width height:icon height on:device.
+ invertedIcon function:#copy.
+ invertedIcon foreground:Color noColor background:Color allColor.
+ invertedIcon copyFrom:i x:0 y:0 toX:0 y:0 width:icon width height:icon height.
+ i := invertedIcon.
+ ]
+ ] ifFalse:[
+ i := icon on:device.
+ ].
+ (i notNil and:[i id notNil]) ifTrue:[
+ device setWindowIcon:i in:drawableId
+ ]
+ ]
+ ]
+!
+
+iconLabel
+ "return the name displayed in the icon"
+
+ ^ iconLabel
+!
+
+iconLabel:aString
+ "define the name to be displayed in the icon"
+
+ iconLabel := aString.
+ drawableId notNil ifTrue:[
+ device setIconName:aString in:drawableId.
+ "
+ unbuffered - to make it visible right NOW
+ "
+ device flush.
+ ]
+!
- ^ self origin:nil extent:anExtent
- label:aLabel icon:nil
- minExtent:minExtent maxExtent:nil
+iconName:aString
+ "this method will vanish soon ... - for backward compatibility"
+
+ self iconLabel:aString
+!
+
+iconView
+ "return the view used as icon-view"
+
+ ^ iconView
+!
+
+iconView:aView
+ "specify the view to be used as icon"
+
+ iconView := aView.
+ drawableId notNil ifTrue:[
+ aView create.
+ device setWindowIconWindow:aView in:drawableId
+ ]
+!
+
+label
+ "return the views name in the title area"
+
+ ^ label
+!
+
+label:aString
+ "define the views name in the windows title area.
+ If IncludeHostNameInLabel is true, prepend the hostname
+ (you will appreciate this, if you are working on multiple
+ machines simultanously - as I do ...)"
+
+ |l|
+
+ aString ~= label ifTrue:[
+ label := aString.
+ drawableId notNil ifTrue: [
+ IncludeHostNameInLabel == true ifTrue:[
+ l := OperatingSystem getHostName , ': ' , aString.
+ ] ifFalse:[
+ l := aString
+ ].
+ device setWindowName:l in:drawableId.
+ "
+ unbuffered - to make it visible right NOW
+ "
+ device flush.
+ ]
+ ]
+
+ "Created: 8.9.1995 / 19:37:06 / claus"
+ "Modified: 8.9.1995 / 19:39:18 / claus"
!
-extent:anExtent label:aLabel icon:aForm
- "create a new topView and define its extent, label and icon"
+label:labelString iconLabel:iconLabelString
+ "set both the label and the iconLabel"
+
+ self label:labelString.
+ self iconLabel:iconLabelString
+!
+
+maxExtent
+ "return the views maximum allowed extent"
+
+ ^ maxExtent
+!
+
+maxExtent:max
+ "define the maximum extent the view may have -
+ depends on good-will of window manager"
+
+ maxExtent := max.
+ (width notNil and:[height notNil]) ifTrue:[
+ ((width > (maxExtent x)) or:
+ [height > (maxExtent y)]) ifTrue: [
+ self extent:maxExtent
+ ]
+ ]
+!
+
+maximumSize:anExtent
+ "same as maxExtent: for ST-80 compatibility"
+
+ ^ self maxExtent:anExtent
+!
- ^ self origin:nil extent:anExtent
- label:aLabel icon:aForm
- minExtent:nil maxExtent:nil
+minExtent
+ "return the views minimum allowed extent"
+
+ ^ minExtent
+!
+
+minExtent:min
+ "define the minimum extent the view may have -
+ depends on good-will of window manager"
+
+ minExtent := min.
+ (width notNil and:[height notNil]) ifTrue:[
+ ((width < (minExtent x)) or:
+ [height < (minExtent y)]) ifTrue: [
+ self extent:minExtent
+ ]
+ ]
+!
+
+minimumSize
+ "same as minExtent for ST-80 compatibility"
+
+ ^ self minExtent
+!
+
+minimumSize:anExtent
+ "same as minExtent: for ST-80 compatibility"
+
+ ^ self minExtent:anExtent
+!
+
+name
+ "return the topViews label"
+
+ ^ label
!
-extent:anExtent label:aLabel icon:aForm minExtent:minExtent
- ^ self origin:nil extent:anExtent
- label:aLabel icon:aForm
- minExtent:minExtent maxExtent:nil
+sizeFixed:aBoolean
+ "this prevents the view from resizing itself when realized.
+ For normal topViews, this is void, since they dont do this anyway.
+
+ However, modalBoxes (especially: DialogBoxes) typically resize themselfes
+ to the preferredExtent of their components. In some cases, this behavior is
+ not desired and it should be turned off by setting sizeFixed to true.
+
+ To avoid confusion:
+ This does NOT prevent the window manager from resizing the view,
+ instead it tells the view to NOT resize ITSELF."
+
+ sizeFixed := aBoolean.
+
+ "example: dialog which resizes itself on #open:
+ (thereby ignoring the 200@200 extent)
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200.
+ dialog open.
+
+
+ using sizeFixed:
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200; sizeFixed:true.
+ dialog open.
+
+
+ using openWithExtent (also sets sizeFixed):
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog openWithExtent:200@200.
+ "
+! !
+
+!StandardSystemView methodsFor:'destroying'!
+
+closeRequest
+ "programmatic close request"
+
+ ^ self terminate
+!
+
+destroy
+ "destroy the view."
+
+ self removeFromCurrentProject.
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:nil.
+ ].
+ application notNil ifTrue:[
+ application windowEvent:(#close -> self) from:self
+ ].
+ super destroy.
!
-extent:anExtent label:aLabel icon:aForm minExtent:minExtent maxExtent:maxExtent
- ^ self origin:nil extent:anExtent
- label:aLabel icon:aForm
- minExtent:minExtent maxExtent:maxExtent
+saveAndTerminate
+ "save & terminate request from the windowManager. The application should
+ save its data/files/text etc. somehow and close.
+ If there is an application, let it decide how do do that.
+ Otherwise, forward it to superclasses which knows how to do this.
+ (it defaults to a terminate there).
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
+
+ application notNil ifTrue:[
+ application saveAndTerminateRequest
+ ] ifFalse:[
+ super saveAndTerminate
+ ]
+!
+
+terminate
+ "terminate request from the windowManager. If there is an application,
+ let it decide if it really wants to be close. Otherwise, forward it to
+ superclasses terminate which knows how to do this.
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
+
+ application notNil ifTrue:[
+ application closeRequest
+ ] ifFalse:[
+ super terminate
+ ]
+! !
+
+!StandardSystemView methodsFor:'event handling'!
+
+focusIn
+ "the view got the keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showFocus
+ ]
+ ].
+!
+
+focusOut
+ "the view lost keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showNoFocus
+ ]
+ ].
+!
+
+mapped
+ "the view got mapped"
+
+ super mapped.
+ "
+ ask for the focus - this avoids having to click on the
+ view with WM's which need an explicit click.
+ Q: is this a good idea ?
+ "
+ TakeFocusWhenMapped == true ifTrue:[
+ self getKeyboardFocus.
+ ]
+!
+
+sendWindowEvents:collectionOfEventSymbols
+ "define the events that are to be forwarded to the application.
+ This is being implemented ..."
+
+ windowEventsForApplication := collectionOfEventSymbols
! !
!StandardSystemView methodsFor:'initialization'!
-initialize
- super initialize.
-
- borderWidth := 2. "- notice: many window managers ignore this"
- minExtent := 10 @ 10.
- maxExtent := (device width) @ (device height).
- label isNil ifTrue:[label := self class defaultLabel].
- icon isNil ifTrue:[icon := self class defaultIcon].
- name := self class name.
-!
-
-initEvents
- super initEvents.
- self enableFocusEvents.
-!
-
-defaultControllerClass
- "for ST-80 compatibility only - not used in ST/X"
-
- ^ nil "/ StandardSystemController
-!
-
addToCurrentProject
"add the receiver (a topview) to the current projects set-of-views.
(If there is a current project)"
@@ -252,18 +582,84 @@
]
!
-removeFromCurrentProject
- "remove the receiver (a topview) from the current projects set-of-views.
- (If there is a current project)"
+defaultControllerClass
+ "for ST-80 compatibility only - not used in ST/X"
+
+ ^ nil "/ StandardSystemController
+!
+
+initEvents
+ super initEvents.
+ self enableFocusEvents.
+!
+
+initialize
+ super initialize.
- |p|
+ borderWidth := 2. "- notice: many window managers ignore this"
+ minExtent := 10 @ 10.
+ maxExtent := (device width) @ (device height).
+ label isNil ifTrue:[label := self class defaultLabel].
+ icon isNil ifTrue:[icon := self class defaultIcon].
+ name := self class name.
+!
+
+reAdjustGeometry
+ "when we come up on a smaller display,
+ make certain, that the receiver is visible"
+
+ |dX dY limitRight limitBottom|
+
+ dX := (device horizontalPixelPerMillimeter * 20) rounded.
+ dY := (device verticalPixelPerMillimeter * 20) rounded.
- "
- the following check allows systems
- without projects and changeSets
- "
- (Project notNil and:[(p := Project current) notNil]) ifTrue:[
- p removeView:self
+ limitRight := device width - dX.
+ limitBottom := device height - dY.
+ ((self left > limitRight) or:[
+ self top > limitBottom]) ifTrue:[
+ 'moving view into visible area' errorPrintNL.
+ self origin:limitRight @ limitBottom
+ ]
+!
+
+realize
+ "realize the view i.e. make it visible."
+
+ super realize.
+ windowGroup notNil ifTrue:[
+ "/
+ "/ have to wait till now with focus-setting,
+ "/ up to now, I may have had no windowGroup (its set in realize)
+ "/
+ windowGroup focusSequence:self focusSequence.
+ "/
+ "/ let the application add its views to the current project
+ "/
+ application notNil ifTrue:[
+ application opened.
+ ] ifFalse:[
+ self addToCurrentProject.
+ ].
+ ]
+!
+
+recreate
+ "recreate the view after a snap-in"
+
+ icon := self convertedIcon.
+ super recreate.
+
+ iconView notNil ifTrue:[
+ iconView create.
+ device setWindowIconWindow:iconView in:drawableId
+ ] ifFalse:[
+ (icon notNil and:[icon id notNil]) ifTrue:[
+ device setWindowIcon:icon in:drawableId
+ ].
+ ].
+
+ iconLabel notNil ifTrue:[
+ device setIconName:iconLabel in:drawableId
]
!
@@ -305,62 +701,18 @@
controller := myController
!
-recreate
- "recreate the view after a snap-in"
-
- icon := self convertedIcon.
- super recreate.
+removeFromCurrentProject
+ "remove the receiver (a topview) from the current projects set-of-views.
+ (If there is a current project)"
- iconView notNil ifTrue:[
- iconView create.
- device setWindowIconWindow:iconView in:drawableId
- ] ifFalse:[
- (icon notNil and:[icon id notNil]) ifTrue:[
- device setWindowIcon:icon in:drawableId
- ].
- ].
-
- iconLabel notNil ifTrue:[
- device setIconName:iconLabel in:drawableId
- ]
-!
-
-reAdjustGeometry
- "when we come up on a smaller display,
- make certain, that the receiver is visible"
-
- |dX dY limitRight limitBottom|
+ |p|
- dX := (device horizontalPixelPerMillimeter * 20) rounded.
- dY := (device verticalPixelPerMillimeter * 20) rounded.
-
- limitRight := device width - dX.
- limitBottom := device height - dY.
- ((self left > limitRight) or:[
- self top > limitBottom]) ifTrue:[
- 'moving view into visible area' errorPrintNL.
- self origin:limitRight @ limitBottom
- ]
-!
-
-realize
- "realize the view i.e. make it visible."
-
- super realize.
- windowGroup notNil ifTrue:[
- "/
- "/ have to wait till now with focus-setting,
- "/ up to now, I may have had no windowGroup (its set in realize)
- "/
- windowGroup focusSequence:self focusSequence.
- "/
- "/ let the application add its views to the current project
- "/
- application notNil ifTrue:[
- application opened.
- ] ifFalse:[
- self addToCurrentProject.
- ].
+ "
+ the following check allows systems
+ without projects and changeSets
+ "
+ (Project notNil and:[(p := Project current) notNil]) ifTrue:[
+ p removeView:self
]
!
@@ -376,55 +728,19 @@
].
! !
-!StandardSystemView methodsFor:'destroying'!
-
-terminate
- "terminate request from the windowManager. If there is an application,
- let it decide if it really wants to be close. Otherwise, forward it to
- superclasses terminate which knows how to do this.
- Notice, that not all windowmanagers are nice enough
- to send this request; some simply distroy the view."
+!StandardSystemView methodsFor:'printing & storing'!
- application notNil ifTrue:[
- application closeRequest
- ] ifFalse:[
- super terminate
- ]
-!
-
-saveAndTerminate
- "save & terminate request from the windowManager. The application should
- save its data/files/text etc. somehow and close.
- If there is an application, let it decide how do do that.
- Otherwise, forward it to superclasses which knows how to do this.
- (it defaults to a terminate there).
- Notice, that not all windowmanagers are nice enough
- to send this request; some simply distroy the view."
+displayString
+ "just for your convenience in inspectors ...
+ ... add the views label to the displayString."
- application notNil ifTrue:[
- application saveAndTerminateRequest
- ] ifFalse:[
- super saveAndTerminate
- ]
-!
-
-destroy
- "destroy the view."
+ |s|
- self removeFromCurrentProject.
- windowGroup notNil ifTrue:[
- windowGroup focusSequence:nil.
- ].
- application notNil ifTrue:[
- application windowEvent:(#close -> self) from:self
+ s := super displayString.
+ label notNil ifTrue:[
+ s := s , '(' , label , ')'
].
- super destroy.
-!
-
-closeRequest
- "programmatic close request"
-
- ^ self terminate
+ ^ s
! !
!StandardSystemView methodsFor:'private'!
@@ -472,8 +788,70 @@
"Created: 22.9.1995 / 17:40:36 / claus"
! !
+!StandardSystemView methodsFor:'queries'!
+
+focusSequence
+ "return a sequence which defines the order in which the focus
+ is passed for FocusNext and FocusPrevious keys.
+ All views which like to support these keys should redefine
+ this method and return a collection of (sub-) views.
+ Or, if the model is some applicationModel, it may itself define
+ the focusSequence.
+ Notice: I dont think this is good style: the focusSequence seems
+ to belong into the controller, ..."
+
+ "/
+ "/ if I have an application, its supposed to
+ "/ know about the focusSequence
+ "/
+ application notNil ifTrue:[
+ ^ application focusSequence
+ ].
+
+ (model notNil
+ and:[(model respondsTo:#focusSequence)
+ and:[model ~~ self]]) ifTrue:[
+ ^ model focusSequence
+ ].
+ ^ nil
+!
+
+processName
+ "return a string to be shown for my process in the
+ process monitor"
+
+ application notNil ifTrue:[
+ ^ application processName
+ ].
+ label notNil ifTrue:[^ label].
+ ^ super processName
+! !
+
!StandardSystemView methodsFor:'realization'!
+create
+ "create - make certain that icon is available"
+
+ icon := self convertedIcon.
+ super create.
+
+ iconView notNil ifTrue:[
+ iconView create.
+ device setWindowIconWindow:iconView in:drawableId
+ ].
+ iconLabel notNil ifTrue:[
+ device setIconName:iconLabel in:drawableId
+ ]
+!
+
+openWithPriority:aPriority
+ "open the view, run the windowgroup process at
+ other than UserScehdulingPriority."
+
+ self open.
+ windowGroup process priority:aPriority.
+!
+
physicalCreate
"common code for create & recreate"
@@ -528,387 +906,10 @@
saveUnder ifTrue:[
device setSaveUnder:true in:drawableId
].
-!
-
-create
- "create - make certain that icon is available"
-
- icon := self convertedIcon.
- super create.
-
- iconView notNil ifTrue:[
- iconView create.
- device setWindowIconWindow:iconView in:drawableId
- ].
- iconLabel notNil ifTrue:[
- device setIconName:iconLabel in:drawableId
- ]
-!
-
-openWithPriority:aPriority
- "open the view, run the windowgroup process at
- other than UserScehdulingPriority."
-
- self open.
- windowGroup process priority:aPriority.
-! !
-
-!StandardSystemView methodsFor:'printing & storing'!
-
-displayString
- "just for your convenience in inspectors ...
- ... add the views label to the displayString."
-
- |s|
-
- s := super displayString.
- label notNil ifTrue:[
- s := s , '(' , label , ')'
- ].
- ^ s
-! !
-
-!StandardSystemView methodsFor:'queries'!
-
-processName
- "return a string to be shown for my process in the
- process monitor"
-
- application notNil ifTrue:[
- ^ application processName
- ].
- label notNil ifTrue:[^ label].
- ^ super processName
-!
-
-focusSequence
- "return a sequence which defines the order in which the focus
- is passed for FocusNext and FocusPrevious keys.
- All views which like to support these keys should redefine
- this method and return a collection of (sub-) views.
- Or, if the model is some applicationModel, it may itself define
- the focusSequence.
- Notice: I dont think this is good style: the focusSequence seems
- to belong into the controller, ..."
-
- "/
- "/ if I have an application, its supposed to
- "/ know about the focusSequence
- "/
- application notNil ifTrue:[
- ^ application focusSequence
- ].
-
- (model notNil
- and:[(model respondsTo:#focusSequence)
- and:[model ~~ self]]) ifTrue:[
- ^ model focusSequence
- ].
- ^ nil
! !
-!StandardSystemView methodsFor:'accessing'!
-
-label
- "return the views name in the title area"
-
- ^ label
-!
-
-label:aString
- "define the views name in the windows title area.
- If IncludeHostNameInLabel is true, prepend the hostname
- (you will appreciate this, if you are working on multiple
- machines simultanously - as I do ...)"
-
- |l|
-
- aString ~= label ifTrue:[
- label := aString.
- drawableId notNil ifTrue: [
- IncludeHostNameInLabel == true ifTrue:[
- l := OperatingSystem getHostName , ': ' , aString.
- ] ifFalse:[
- l := aString
- ].
- device setWindowName:l in:drawableId.
- "
- unbuffered - to make it visible right NOW
- "
- device flush.
- ]
- ]
-
- "Created: 8.9.1995 / 19:37:06 / claus"
- "Modified: 8.9.1995 / 19:39:18 / claus"
-!
-
-iconLabel
- "return the name displayed in the icon"
-
- ^ iconLabel
-!
-
-iconLabel:aString
- "define the name to be displayed in the icon"
-
- iconLabel := aString.
- drawableId notNil ifTrue:[
- device setIconName:aString in:drawableId.
- "
- unbuffered - to make it visible right NOW
- "
- device flush.
- ]
-!
-
-label:labelString iconLabel:iconLabelString
- "set both the label and the iconLabel"
-
- self label:labelString.
- self iconLabel:iconLabelString
-!
-
-name
- "return the topViews label"
-
- ^ label
-!
-
-icon
- "return the form defined as icon"
-
- ^ icon
-!
-
-icon:aForm
- "define the form (bitmap) used as icon"
-
- |invertedIcon i|
-
- icon := aForm.
- icon notNil ifTrue:[
- drawableId notNil ifTrue:[
- icon depth ~~ 1 ifTrue:[
- icon := icon asMonochromeFormOn:device.
- ].
- "icons assume 1s as black - invert icon if the device thinks different"
- (device depth == 1 and:[device whitepixel ~~ 0]) ifTrue:[
- i := icon on:device.
- i notNil ifTrue:[
- invertedIcon := Form width:icon width height:icon height on:device.
- invertedIcon function:#copy.
- invertedIcon foreground:Color noColor background:Color allColor.
- invertedIcon copyFrom:i x:0 y:0 toX:0 y:0 width:icon width height:icon height.
- i := invertedIcon.
- ]
- ] ifFalse:[
- i := icon on:device.
- ].
- (i notNil and:[i id notNil]) ifTrue:[
- device setWindowIcon:i in:drawableId
- ]
- ]
- ]
-!
-
-iconView
- "return the view used as icon-view"
-
- ^ iconView
-!
-
-iconView:aView
- "specify the view to be used as icon"
-
- iconView := aView.
- drawableId notNil ifTrue:[
- aView create.
- device setWindowIconWindow:aView in:drawableId
- ]
-!
-
-iconName:aString
- "this method will vanish soon ... - for backward compatibility"
-
- self iconLabel:aString
-!
-
-maximumSize:anExtent
- "same as maxExtent: for ST-80 compatibility"
-
- ^ self maxExtent:anExtent
-!
-
-minimumSize
- "same as minExtent for ST-80 compatibility"
-
- ^ self minExtent
-!
-
-minimumSize:anExtent
- "same as minExtent: for ST-80 compatibility"
-
- ^ self minExtent:anExtent
-!
-
-minExtent
- "return the views minimum allowed extent"
-
- ^ minExtent
-!
+!StandardSystemView class methodsFor:'documentation'!
-minExtent:min
- "define the minimum extent the view may have -
- depends on good-will of window manager"
-
- minExtent := min.
- (width notNil and:[height notNil]) ifTrue:[
- ((width < (minExtent x)) or:
- [height < (minExtent y)]) ifTrue: [
- self extent:minExtent
- ]
- ]
-!
-
-maxExtent
- "return the views maximum allowed extent"
-
- ^ maxExtent
-!
-
-maxExtent:max
- "define the maximum extent the view may have -
- depends on good-will of window manager"
-
- maxExtent := max.
- (width notNil and:[height notNil]) ifTrue:[
- ((width > (maxExtent x)) or:
- [height > (maxExtent y)]) ifTrue: [
- self extent:maxExtent
- ]
- ]
-!
-
-sizeFixed:aBoolean
- "this prevents the view from resizing itself when realized.
- For normal topViews, this is void, since they dont do this anyway.
-
- However, modalBoxes (especially: DialogBoxes) typically resize themselfes
- to the preferredExtent of their components. In some cases, this behavior is
- not desired and it should be turned off by setting sizeFixed to true.
-
- To avoid confusion:
- This does NOT prevent the window manager from resizing the view,
- instead it tells the view to NOT resize ITSELF."
-
- sizeFixed := aBoolean.
-
- "example: dialog which resizes itself on #open:
- (thereby ignoring the 200@200 extent)
-
- |dialog|
-
- dialog := Dialog new.
- dialog addInputFieldOn:'' asValue.
- dialog addOkButton.
- dialog extent:200@200.
- dialog open.
-
-
- using sizeFixed:
-
- |dialog|
-
- dialog := Dialog new.
- dialog addInputFieldOn:'' asValue.
- dialog addOkButton.
- dialog extent:200@200; sizeFixed:true.
- dialog open.
-
-
- using openWithExtent (also sets sizeFixed):
-
- |dialog|
-
- dialog := Dialog new.
- dialog addInputFieldOn:'' asValue.
- dialog addOkButton.
- dialog openWithExtent:200@200.
- "
-!
-
-application
- "return the topViews application.
- This is new protocol for ST-80 compatibility and not yet fully supported"
-
- ^ application
-!
-
-application:anApplicationModel
- "set the topViews application.
- This is new protocol for ST-80 compatibility and not yet fully supported"
-
- application := anApplicationModel
-!
-
-bePartner
- self setWindowGroupFromApplication.
- super bePartner.
-
- "Created: 22.9.1995 / 17:40:15 / claus"
-!
-
-beSlave
- self setWindowGroupFromApplication.
- super beSlave.
-
- "Created: 22.9.1995 / 17:40:15 / claus"
+version
+ ^ '$Header: /cvs/stx/stx/libview/StandardSystemView.st,v 1.37 1995-11-27 22:31:28 cg Exp $'
! !
-
-!StandardSystemView methodsFor:'event handling'!
-
-sendWindowEvents:collectionOfEventSymbols
- "define the events that are to be forwarded to the application.
- This is being implemented ..."
-
- windowEventsForApplication := collectionOfEventSymbols
-!
-
-focusOut
- "the view lost keyboard focus"
-
- |v|
-
- windowGroup notNil ifTrue:[
- (v := windowGroup focusView) notNil ifTrue:[
- v showNoFocus
- ]
- ].
-!
-
-focusIn
- "the view got the keyboard focus"
-
- |v|
-
- windowGroup notNil ifTrue:[
- (v := windowGroup focusView) notNil ifTrue:[
- v showFocus
- ]
- ].
-!
-
-mapped
- "the view got mapped"
-
- super mapped.
- "
- ask for the focus - this avoids having to click on the
- view with WM's which need an explicit click.
- Q: is this a good idea ?
- "
- TakeFocusWhenMapped == true ifTrue:[
- self getKeyboardFocus.
- ]
-! !
--- a/StdSysV.st Sat Nov 25 14:06:08 1995 +0100
+++ b/StdSysV.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,12 +11,11 @@
"
TopView subclass:#StandardSystemView
- instanceVariableNames:'label icon iconView iconLabel
- minExtent maxExtent sizeFixed
- application windowEventsForApplication'
- classVariableNames: 'DefaultIcon TakeFocusWhenMapped IncludeHostNameInLabel'
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'label icon iconView iconLabel minExtent maxExtent sizeFixed
+ application windowEventsForApplication'
+ classVariableNames:'DefaultIcon TakeFocusWhenMapped IncludeHostNameInLabel'
+ poolDictionaries:''
+ category:'Views-Basic'
!
!StandardSystemView class methodsFor:'documentation'!
@@ -35,10 +34,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.36 1995-11-24 22:33:17 cg Exp $'
-!
-
documentation
"
I represent topViews i.e. those views which have a title-label,
@@ -47,84 +42,34 @@
"
! !
-!StandardSystemView class methodsFor:'defaults'!
-
-includeHostNameInLabel
- "return the flag which controls if a views label should
- include the hostname.
- This flag is usually set/cleared in your private.rc file;
- the default is false."
-
- ^ IncludeHostNameInLabel
-
- "Created: 10.9.1995 / 19:21:16 / claus"
-!
+!StandardSystemView class methodsFor:'instance creation'!
-includeHostNameInLabel:aBoolean
- "set/clear the flag which controls if a views label should
- include the hostname - this is highly useful if you have
- multiple smalltalks open simultaniously ...
- This flag is usually set/cleared in your private.rc file;
- the default is false."
+extent:anExtent label:aLabel icon:aForm
+ "create a new topView and define its extent, label and icon"
- IncludeHostNameInLabel := aBoolean
-!
-
-defaultLabel
- "return the default label for views of my kind.
- This can be redefined in subclasses or overwritten in
- initialize methods."
-
- ^ 'aView'
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:aForm
+ minExtent:nil maxExtent:nil
!
-defaultIcon
- "return the default icon for views.
- This can be redefined in subclasses or overwritten in
- initialize methods."
-
- DefaultIcon isNil ifTrue:[
- DefaultIcon := Image fromFile:'SmalltalkX.xbm'.
- DefaultIcon notNil ifTrue:[
- DefaultIcon := DefaultIcon on:Display
- ]
- ].
- ^ DefaultIcon
-! !
-
-!StandardSystemView class methodsFor:'startup'!
-
-open
- "create, realize the view - this topview and all its subviews will
- run as a separate process with its own windowGroup"
-
- ^ self new open
+extent:anExtent label:aLabel icon:aForm minExtent:minExtent
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:aForm
+ minExtent:minExtent maxExtent:nil
!
-start
- "create, realize the view - this topview and all its subviews will
- run as a separate process with its own windowGroup.
- This method exists for backward compatibility - use open."
-
- ^ self open
-! !
-
-!StandardSystemView class methodsFor:'instance creation'!
+extent:anExtent label:aLabel icon:aForm minExtent:minExtent maxExtent:maxExtent
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:aForm
+ minExtent:minExtent maxExtent:maxExtent
+!
-model:aModel label:aLabel minimumSize:minExtent
- "ST80-style instance creation"
-
- |newView|
+extent:anExtent label:aLabel minExtent:minExtent
+ "create a new topView and define its extent, label and minumum extent"
- newView := self origin:nil
- extent:minExtent
- label:aLabel
- icon:nil
- minExtent:minExtent
- maxExtent:nil.
- newView model:aModel.
-"/ newView controller:(self defaultControllerClass new view:newView).
- ^ newView
+ ^ self origin:nil extent:anExtent
+ label:aLabel icon:nil
+ minExtent:minExtent maxExtent:nil
!
label:aLabel
@@ -135,14 +80,6 @@
minExtent:nil maxExtent:nil
!
-label:aLabel minExtent:anExtent
- "create a new topView and define its label and minimum extent"
-
- ^ self origin:nil extent:nil
- label:aLabel icon:nil
- minExtent:anExtent maxExtent:nil
-!
-
label:aLabel icon:aForm
"create a new topView and define its label and icon"
@@ -167,6 +104,30 @@
minExtent:minExtent maxExtent:maxExtent
!
+label:aLabel minExtent:anExtent
+ "create a new topView and define its label and minimum extent"
+
+ ^ self origin:nil extent:nil
+ label:aLabel icon:nil
+ minExtent:anExtent maxExtent:nil
+!
+
+model:aModel label:aLabel minimumSize:minExtent
+ "ST80-style instance creation"
+
+ |newView|
+
+ newView := self origin:nil
+ extent:minExtent
+ label:aLabel
+ icon:nil
+ minExtent:minExtent
+ maxExtent:nil.
+ newView model:aModel.
+"/ newView controller:(self defaultControllerClass new view:newView).
+ ^ newView
+!
+
origin:anOrigin extent:anExtent label:aLabel
"create a new topView and define its origin, extent and label"
@@ -183,60 +144,429 @@
^ self origin:anOrigin extent:nil
label:aLabel icon:aForm
minExtent:minExtent maxExtent:maxExtent
+! !
+
+!StandardSystemView class methodsFor:'defaults'!
+
+defaultIcon
+ "return the default icon for views.
+ This can be redefined in subclasses or overwritten in
+ initialize methods."
+
+ DefaultIcon isNil ifTrue:[
+ DefaultIcon := Image fromFile:'SmalltalkX.xbm'.
+ DefaultIcon notNil ifTrue:[
+ DefaultIcon := DefaultIcon on:Display
+ ]
+ ].
+ ^ DefaultIcon
+!
+
+defaultLabel
+ "return the default label for views of my kind.
+ This can be redefined in subclasses or overwritten in
+ initialize methods."
+
+ ^ 'aView'
+!
+
+includeHostNameInLabel
+ "return the flag which controls if a views label should
+ include the hostname.
+ This flag is usually set/cleared in your private.rc file;
+ the default is false."
+
+ ^ IncludeHostNameInLabel
+
+ "Created: 10.9.1995 / 19:21:16 / claus"
+!
+
+includeHostNameInLabel:aBoolean
+ "set/clear the flag which controls if a views label should
+ include the hostname - this is highly useful if you have
+ multiple smalltalks open simultaniously ...
+ This flag is usually set/cleared in your private.rc file;
+ the default is false."
+
+ IncludeHostNameInLabel := aBoolean
+! !
+
+!StandardSystemView class methodsFor:'startup'!
+
+open
+ "create, realize the view - this topview and all its subviews will
+ run as a separate process with its own windowGroup"
+
+ ^ self new open
+!
+
+start
+ "create, realize the view - this topview and all its subviews will
+ run as a separate process with its own windowGroup.
+ This method exists for backward compatibility - use open."
+
+ ^ self open
+! !
+
+!StandardSystemView methodsFor:'accessing'!
+
+application
+ "return the topViews application.
+ This is new protocol for ST-80 compatibility and not yet fully supported"
+
+ ^ application
+!
+
+application:anApplicationModel
+ "set the topViews application.
+ This is new protocol for ST-80 compatibility and not yet fully supported"
+
+ application := anApplicationModel
+!
+
+bePartner
+ self setWindowGroupFromApplication.
+ super bePartner.
+
+ "Created: 22.9.1995 / 17:40:15 / claus"
+!
+
+beSlave
+ self setWindowGroupFromApplication.
+ super beSlave.
+
+ "Created: 22.9.1995 / 17:40:15 / claus"
+!
+
+icon
+ "return the form defined as icon"
+
+ ^ icon
!
-extent:anExtent label:aLabel minExtent:minExtent
- "create a new topView and define its extent, label and minumum extent"
+icon:aForm
+ "define the form (bitmap) used as icon"
+
+ |invertedIcon i|
+
+ icon := aForm.
+ icon notNil ifTrue:[
+ drawableId notNil ifTrue:[
+ icon depth ~~ 1 ifTrue:[
+ icon := icon asMonochromeFormOn:device.
+ ].
+ "icons assume 1s as black - invert icon if the device thinks different"
+ (device depth == 1 and:[device whitepixel ~~ 0]) ifTrue:[
+ i := icon on:device.
+ i notNil ifTrue:[
+ invertedIcon := Form width:icon width height:icon height on:device.
+ invertedIcon function:#copy.
+ invertedIcon foreground:Color noColor background:Color allColor.
+ invertedIcon copyFrom:i x:0 y:0 toX:0 y:0 width:icon width height:icon height.
+ i := invertedIcon.
+ ]
+ ] ifFalse:[
+ i := icon on:device.
+ ].
+ (i notNil and:[i id notNil]) ifTrue:[
+ device setWindowIcon:i in:drawableId
+ ]
+ ]
+ ]
+!
+
+iconLabel
+ "return the name displayed in the icon"
+
+ ^ iconLabel
+!
+
+iconLabel:aString
+ "define the name to be displayed in the icon"
+
+ iconLabel := aString.
+ drawableId notNil ifTrue:[
+ device setIconName:aString in:drawableId.
+ "
+ unbuffered - to make it visible right NOW
+ "
+ device flush.
+ ]
+!
- ^ self origin:nil extent:anExtent
- label:aLabel icon:nil
- minExtent:minExtent maxExtent:nil
+iconName:aString
+ "this method will vanish soon ... - for backward compatibility"
+
+ self iconLabel:aString
+!
+
+iconView
+ "return the view used as icon-view"
+
+ ^ iconView
+!
+
+iconView:aView
+ "specify the view to be used as icon"
+
+ iconView := aView.
+ drawableId notNil ifTrue:[
+ aView create.
+ device setWindowIconWindow:aView in:drawableId
+ ]
+!
+
+label
+ "return the views name in the title area"
+
+ ^ label
+!
+
+label:aString
+ "define the views name in the windows title area.
+ If IncludeHostNameInLabel is true, prepend the hostname
+ (you will appreciate this, if you are working on multiple
+ machines simultanously - as I do ...)"
+
+ |l|
+
+ aString ~= label ifTrue:[
+ label := aString.
+ drawableId notNil ifTrue: [
+ IncludeHostNameInLabel == true ifTrue:[
+ l := OperatingSystem getHostName , ': ' , aString.
+ ] ifFalse:[
+ l := aString
+ ].
+ device setWindowName:l in:drawableId.
+ "
+ unbuffered - to make it visible right NOW
+ "
+ device flush.
+ ]
+ ]
+
+ "Created: 8.9.1995 / 19:37:06 / claus"
+ "Modified: 8.9.1995 / 19:39:18 / claus"
!
-extent:anExtent label:aLabel icon:aForm
- "create a new topView and define its extent, label and icon"
+label:labelString iconLabel:iconLabelString
+ "set both the label and the iconLabel"
+
+ self label:labelString.
+ self iconLabel:iconLabelString
+!
+
+maxExtent
+ "return the views maximum allowed extent"
+
+ ^ maxExtent
+!
+
+maxExtent:max
+ "define the maximum extent the view may have -
+ depends on good-will of window manager"
+
+ maxExtent := max.
+ (width notNil and:[height notNil]) ifTrue:[
+ ((width > (maxExtent x)) or:
+ [height > (maxExtent y)]) ifTrue: [
+ self extent:maxExtent
+ ]
+ ]
+!
+
+maximumSize:anExtent
+ "same as maxExtent: for ST-80 compatibility"
+
+ ^ self maxExtent:anExtent
+!
- ^ self origin:nil extent:anExtent
- label:aLabel icon:aForm
- minExtent:nil maxExtent:nil
+minExtent
+ "return the views minimum allowed extent"
+
+ ^ minExtent
+!
+
+minExtent:min
+ "define the minimum extent the view may have -
+ depends on good-will of window manager"
+
+ minExtent := min.
+ (width notNil and:[height notNil]) ifTrue:[
+ ((width < (minExtent x)) or:
+ [height < (minExtent y)]) ifTrue: [
+ self extent:minExtent
+ ]
+ ]
+!
+
+minimumSize
+ "same as minExtent for ST-80 compatibility"
+
+ ^ self minExtent
+!
+
+minimumSize:anExtent
+ "same as minExtent: for ST-80 compatibility"
+
+ ^ self minExtent:anExtent
+!
+
+name
+ "return the topViews label"
+
+ ^ label
!
-extent:anExtent label:aLabel icon:aForm minExtent:minExtent
- ^ self origin:nil extent:anExtent
- label:aLabel icon:aForm
- minExtent:minExtent maxExtent:nil
+sizeFixed:aBoolean
+ "this prevents the view from resizing itself when realized.
+ For normal topViews, this is void, since they dont do this anyway.
+
+ However, modalBoxes (especially: DialogBoxes) typically resize themselfes
+ to the preferredExtent of their components. In some cases, this behavior is
+ not desired and it should be turned off by setting sizeFixed to true.
+
+ To avoid confusion:
+ This does NOT prevent the window manager from resizing the view,
+ instead it tells the view to NOT resize ITSELF."
+
+ sizeFixed := aBoolean.
+
+ "example: dialog which resizes itself on #open:
+ (thereby ignoring the 200@200 extent)
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200.
+ dialog open.
+
+
+ using sizeFixed:
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog extent:200@200; sizeFixed:true.
+ dialog open.
+
+
+ using openWithExtent (also sets sizeFixed):
+
+ |dialog|
+
+ dialog := Dialog new.
+ dialog addInputFieldOn:'' asValue.
+ dialog addOkButton.
+ dialog openWithExtent:200@200.
+ "
+! !
+
+!StandardSystemView methodsFor:'destroying'!
+
+closeRequest
+ "programmatic close request"
+
+ ^ self terminate
+!
+
+destroy
+ "destroy the view."
+
+ self removeFromCurrentProject.
+ windowGroup notNil ifTrue:[
+ windowGroup focusSequence:nil.
+ ].
+ application notNil ifTrue:[
+ application windowEvent:(#close -> self) from:self
+ ].
+ super destroy.
!
-extent:anExtent label:aLabel icon:aForm minExtent:minExtent maxExtent:maxExtent
- ^ self origin:nil extent:anExtent
- label:aLabel icon:aForm
- minExtent:minExtent maxExtent:maxExtent
+saveAndTerminate
+ "save & terminate request from the windowManager. The application should
+ save its data/files/text etc. somehow and close.
+ If there is an application, let it decide how do do that.
+ Otherwise, forward it to superclasses which knows how to do this.
+ (it defaults to a terminate there).
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
+
+ application notNil ifTrue:[
+ application saveAndTerminateRequest
+ ] ifFalse:[
+ super saveAndTerminate
+ ]
+!
+
+terminate
+ "terminate request from the windowManager. If there is an application,
+ let it decide if it really wants to be close. Otherwise, forward it to
+ superclasses terminate which knows how to do this.
+ Notice, that not all windowmanagers are nice enough
+ to send this request; some simply distroy the view."
+
+ application notNil ifTrue:[
+ application closeRequest
+ ] ifFalse:[
+ super terminate
+ ]
+! !
+
+!StandardSystemView methodsFor:'event handling'!
+
+focusIn
+ "the view got the keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showFocus
+ ]
+ ].
+!
+
+focusOut
+ "the view lost keyboard focus"
+
+ |v|
+
+ windowGroup notNil ifTrue:[
+ (v := windowGroup focusView) notNil ifTrue:[
+ v showNoFocus
+ ]
+ ].
+!
+
+mapped
+ "the view got mapped"
+
+ super mapped.
+ "
+ ask for the focus - this avoids having to click on the
+ view with WM's which need an explicit click.
+ Q: is this a good idea ?
+ "
+ TakeFocusWhenMapped == true ifTrue:[
+ self getKeyboardFocus.
+ ]
+!
+
+sendWindowEvents:collectionOfEventSymbols
+ "define the events that are to be forwarded to the application.
+ This is being implemented ..."
+
+ windowEventsForApplication := collectionOfEventSymbols
! !
!StandardSystemView methodsFor:'initialization'!
-initialize
- super initialize.
-
- borderWidth := 2. "- notice: many window managers ignore this"
- minExtent := 10 @ 10.
- maxExtent := (device width) @ (device height).
- label isNil ifTrue:[label := self class defaultLabel].
- icon isNil ifTrue:[icon := self class defaultIcon].
- name := self class name.
-!
-
-initEvents
- super initEvents.
- self enableFocusEvents.
-!
-
-defaultControllerClass
- "for ST-80 compatibility only - not used in ST/X"
-
- ^ nil "/ StandardSystemController
-!
-
addToCurrentProject
"add the receiver (a topview) to the current projects set-of-views.
(If there is a current project)"
@@ -252,18 +582,84 @@
]
!
-removeFromCurrentProject
- "remove the receiver (a topview) from the current projects set-of-views.
- (If there is a current project)"
+defaultControllerClass
+ "for ST-80 compatibility only - not used in ST/X"
+
+ ^ nil "/ StandardSystemController
+!
+
+initEvents
+ super initEvents.
+ self enableFocusEvents.
+!
+
+initialize
+ super initialize.
- |p|
+ borderWidth := 2. "- notice: many window managers ignore this"
+ minExtent := 10 @ 10.
+ maxExtent := (device width) @ (device height).
+ label isNil ifTrue:[label := self class defaultLabel].
+ icon isNil ifTrue:[icon := self class defaultIcon].
+ name := self class name.
+!
+
+reAdjustGeometry
+ "when we come up on a smaller display,
+ make certain, that the receiver is visible"
+
+ |dX dY limitRight limitBottom|
+
+ dX := (device horizontalPixelPerMillimeter * 20) rounded.
+ dY := (device verticalPixelPerMillimeter * 20) rounded.
- "
- the following check allows systems
- without projects and changeSets
- "
- (Project notNil and:[(p := Project current) notNil]) ifTrue:[
- p removeView:self
+ limitRight := device width - dX.
+ limitBottom := device height - dY.
+ ((self left > limitRight) or:[
+ self top > limitBottom]) ifTrue:[
+ 'moving view into visible area' errorPrintNL.
+ self origin:limitRight @ limitBottom
+ ]
+!
+
+realize
+ "realize the view i.e. make it visible."
+
+ super realize.
+ windowGroup notNil ifTrue:[
+ "/
+ "/ have to wait till now with focus-setting,
+ "/ up to now, I may have had no windowGroup (its set in realize)
+ "/
+ windowGroup focusSequence:self focusSequence.
+ "/
+ "/ let the application add its views to the current project
+ "/
+ application notNil ifTrue:[
+ application opened.
+ ] ifFalse:[
+ self addToCurrentProject.
+ ].
+ ]
+!
+
+recreate
+ "recreate the view after a snap-in"
+
+ icon := self convertedIcon.
+ super recreate.
+
+ iconView notNil ifTrue:[
+ iconView create.
+ device setWindowIconWindow:iconView in:drawableId
+ ] ifFalse:[
+ (icon notNil and:[icon id notNil]) ifTrue:[
+ device setWindowIcon:icon in:drawableId
+ ].
+ ].
+
+ iconLabel notNil ifTrue:[
+ device setIconName:iconLabel in:drawableId
]
!
@@ -305,62 +701,18 @@
controller := myController
!
-recreate
- "recreate the view after a snap-in"
-
- icon := self convertedIcon.
- super recreate.
+removeFromCurrentProject
+ "remove the receiver (a topview) from the current projects set-of-views.
+ (If there is a current project)"
- iconView notNil ifTrue:[
- iconView create.
- device setWindowIconWindow:iconView in:drawableId
- ] ifFalse:[
- (icon notNil and:[icon id notNil]) ifTrue:[
- device setWindowIcon:icon in:drawableId
- ].
- ].
-
- iconLabel notNil ifTrue:[
- device setIconName:iconLabel in:drawableId
- ]
-!
-
-reAdjustGeometry
- "when we come up on a smaller display,
- make certain, that the receiver is visible"
-
- |dX dY limitRight limitBottom|
+ |p|
- dX := (device horizontalPixelPerMillimeter * 20) rounded.
- dY := (device verticalPixelPerMillimeter * 20) rounded.
-
- limitRight := device width - dX.
- limitBottom := device height - dY.
- ((self left > limitRight) or:[
- self top > limitBottom]) ifTrue:[
- 'moving view into visible area' errorPrintNL.
- self origin:limitRight @ limitBottom
- ]
-!
-
-realize
- "realize the view i.e. make it visible."
-
- super realize.
- windowGroup notNil ifTrue:[
- "/
- "/ have to wait till now with focus-setting,
- "/ up to now, I may have had no windowGroup (its set in realize)
- "/
- windowGroup focusSequence:self focusSequence.
- "/
- "/ let the application add its views to the current project
- "/
- application notNil ifTrue:[
- application opened.
- ] ifFalse:[
- self addToCurrentProject.
- ].
+ "
+ the following check allows systems
+ without projects and changeSets
+ "
+ (Project notNil and:[(p := Project current) notNil]) ifTrue:[
+ p removeView:self
]
!
@@ -376,55 +728,19 @@
].
! !
-!StandardSystemView methodsFor:'destroying'!
-
-terminate
- "terminate request from the windowManager. If there is an application,
- let it decide if it really wants to be close. Otherwise, forward it to
- superclasses terminate which knows how to do this.
- Notice, that not all windowmanagers are nice enough
- to send this request; some simply distroy the view."
+!StandardSystemView methodsFor:'printing & storing'!
- application notNil ifTrue:[
- application closeRequest
- ] ifFalse:[
- super terminate
- ]
-!
-
-saveAndTerminate
- "save & terminate request from the windowManager. The application should
- save its data/files/text etc. somehow and close.
- If there is an application, let it decide how do do that.
- Otherwise, forward it to superclasses which knows how to do this.
- (it defaults to a terminate there).
- Notice, that not all windowmanagers are nice enough
- to send this request; some simply distroy the view."
+displayString
+ "just for your convenience in inspectors ...
+ ... add the views label to the displayString."
- application notNil ifTrue:[
- application saveAndTerminateRequest
- ] ifFalse:[
- super saveAndTerminate
- ]
-!
-
-destroy
- "destroy the view."
+ |s|
- self removeFromCurrentProject.
- windowGroup notNil ifTrue:[
- windowGroup focusSequence:nil.
- ].
- application notNil ifTrue:[
- application windowEvent:(#close -> self) from:self
+ s := super displayString.
+ label notNil ifTrue:[
+ s := s , '(' , label , ')'
].
- super destroy.
-!
-
-closeRequest
- "programmatic close request"
-
- ^ self terminate
+ ^ s
! !
!StandardSystemView methodsFor:'private'!
@@ -472,8 +788,70 @@
"Created: 22.9.1995 / 17:40:36 / claus"
! !
+!StandardSystemView methodsFor:'queries'!
+
+focusSequence
+ "return a sequence which defines the order in which the focus
+ is passed for FocusNext and FocusPrevious keys.
+ All views which like to support these keys should redefine
+ this method and return a collection of (sub-) views.
+ Or, if the model is some applicationModel, it may itself define
+ the focusSequence.
+ Notice: I dont think this is good style: the focusSequence seems
+ to belong into the controller, ..."
+
+ "/
+ "/ if I have an application, its supposed to
+ "/ know about the focusSequence
+ "/
+ application notNil ifTrue:[
+ ^ application focusSequence
+ ].
+
+ (model notNil
+ and:[(model respondsTo:#focusSequence)
+ and:[model ~~ self]]) ifTrue:[
+ ^ model focusSequence
+ ].
+ ^ nil
+!
+
+processName
+ "return a string to be shown for my process in the
+ process monitor"
+
+ application notNil ifTrue:[
+ ^ application processName
+ ].
+ label notNil ifTrue:[^ label].
+ ^ super processName
+! !
+
!StandardSystemView methodsFor:'realization'!
+create
+ "create - make certain that icon is available"
+
+ icon := self convertedIcon.
+ super create.
+
+ iconView notNil ifTrue:[
+ iconView create.
+ device setWindowIconWindow:iconView in:drawableId
+ ].
+ iconLabel notNil ifTrue:[
+ device setIconName:iconLabel in:drawableId
+ ]
+!
+
+openWithPriority:aPriority
+ "open the view, run the windowgroup process at
+ other than UserScehdulingPriority."
+
+ self open.
+ windowGroup process priority:aPriority.
+!
+
physicalCreate
"common code for create & recreate"
@@ -528,387 +906,10 @@
saveUnder ifTrue:[
device setSaveUnder:true in:drawableId
].
-!
-
-create
- "create - make certain that icon is available"
-
- icon := self convertedIcon.
- super create.
-
- iconView notNil ifTrue:[
- iconView create.
- device setWindowIconWindow:iconView in:drawableId
- ].
- iconLabel notNil ifTrue:[
- device setIconName:iconLabel in:drawableId
- ]
-!
-
-openWithPriority:aPriority
- "open the view, run the windowgroup process at
- other than UserScehdulingPriority."
-
- self open.
- windowGroup process priority:aPriority.
-! !
-
-!StandardSystemView methodsFor:'printing & storing'!
-
-displayString
- "just for your convenience in inspectors ...
- ... add the views label to the displayString."
-
- |s|
-
- s := super displayString.
- label notNil ifTrue:[
- s := s , '(' , label , ')'
- ].
- ^ s
-! !
-
-!StandardSystemView methodsFor:'queries'!
-
-processName
- "return a string to be shown for my process in the
- process monitor"
-
- application notNil ifTrue:[
- ^ application processName
- ].
- label notNil ifTrue:[^ label].
- ^ super processName
-!
-
-focusSequence
- "return a sequence which defines the order in which the focus
- is passed for FocusNext and FocusPrevious keys.
- All views which like to support these keys should redefine
- this method and return a collection of (sub-) views.
- Or, if the model is some applicationModel, it may itself define
- the focusSequence.
- Notice: I dont think this is good style: the focusSequence seems
- to belong into the controller, ..."
-
- "/
- "/ if I have an application, its supposed to
- "/ know about the focusSequence
- "/
- application notNil ifTrue:[
- ^ application focusSequence
- ].
-
- (model notNil
- and:[(model respondsTo:#focusSequence)
- and:[model ~~ self]]) ifTrue:[
- ^ model focusSequence
- ].
- ^ nil
! !
-!StandardSystemView methodsFor:'accessing'!
-
-label
- "return the views name in the title area"
-
- ^ label
-!
-
-label:aString
- "define the views name in the windows title area.
- If IncludeHostNameInLabel is true, prepend the hostname
- (you will appreciate this, if you are working on multiple
- machines simultanously - as I do ...)"
-
- |l|
-
- aString ~= label ifTrue:[
- label := aString.
- drawableId notNil ifTrue: [
- IncludeHostNameInLabel == true ifTrue:[
- l := OperatingSystem getHostName , ': ' , aString.
- ] ifFalse:[
- l := aString
- ].
- device setWindowName:l in:drawableId.
- "
- unbuffered - to make it visible right NOW
- "
- device flush.
- ]
- ]
-
- "Created: 8.9.1995 / 19:37:06 / claus"
- "Modified: 8.9.1995 / 19:39:18 / claus"
-!
-
-iconLabel
- "return the name displayed in the icon"
-
- ^ iconLabel
-!
-
-iconLabel:aString
- "define the name to be displayed in the icon"
-
- iconLabel := aString.
- drawableId notNil ifTrue:[
- device setIconName:aString in:drawableId.
- "
- unbuffered - to make it visible right NOW
- "
- device flush.
- ]
-!
-
-label:labelString iconLabel:iconLabelString
- "set both the label and the iconLabel"
-
- self label:labelString.
- self iconLabel:iconLabelString
-!
-
-name
- "return the topViews label"
-
- ^ label
-!
-
-icon
- "return the form defined as icon"
-
- ^ icon
-!
-
-icon:aForm
- "define the form (bitmap) used as icon"
-
- |invertedIcon i|
-
- icon := aForm.
- icon notNil ifTrue:[
- drawableId notNil ifTrue:[
- icon depth ~~ 1 ifTrue:[
- icon := icon asMonochromeFormOn:device.
- ].
- "icons assume 1s as black - invert icon if the device thinks different"
- (device depth == 1 and:[device whitepixel ~~ 0]) ifTrue:[
- i := icon on:device.
- i notNil ifTrue:[
- invertedIcon := Form width:icon width height:icon height on:device.
- invertedIcon function:#copy.
- invertedIcon foreground:Color noColor background:Color allColor.
- invertedIcon copyFrom:i x:0 y:0 toX:0 y:0 width:icon width height:icon height.
- i := invertedIcon.
- ]
- ] ifFalse:[
- i := icon on:device.
- ].
- (i notNil and:[i id notNil]) ifTrue:[
- device setWindowIcon:i in:drawableId
- ]
- ]
- ]
-!
-
-iconView
- "return the view used as icon-view"
-
- ^ iconView
-!
-
-iconView:aView
- "specify the view to be used as icon"
-
- iconView := aView.
- drawableId notNil ifTrue:[
- aView create.
- device setWindowIconWindow:aView in:drawableId
- ]
-!
-
-iconName:aString
- "this method will vanish soon ... - for backward compatibility"
-
- self iconLabel:aString
-!
-
-maximumSize:anExtent
- "same as maxExtent: for ST-80 compatibility"
-
- ^ self maxExtent:anExtent
-!
-
-minimumSize
- "same as minExtent for ST-80 compatibility"
-
- ^ self minExtent
-!
-
-minimumSize:anExtent
- "same as minExtent: for ST-80 compatibility"
-
- ^ self minExtent:anExtent
-!
-
-minExtent
- "return the views minimum allowed extent"
-
- ^ minExtent
-!
+!StandardSystemView class methodsFor:'documentation'!
-minExtent:min
- "define the minimum extent the view may have -
- depends on good-will of window manager"
-
- minExtent := min.
- (width notNil and:[height notNil]) ifTrue:[
- ((width < (minExtent x)) or:
- [height < (minExtent y)]) ifTrue: [
- self extent:minExtent
- ]
- ]
-!
-
-maxExtent
- "return the views maximum allowed extent"
-
- ^ maxExtent
-!
-
-maxExtent:max
- "define the maximum extent the view may have -
- depends on good-will of window manager"
-
- maxExtent := max.
- (width notNil and:[height notNil]) ifTrue:[
- ((width > (maxExtent x)) or:
- [height > (maxExtent y)]) ifTrue: [
- self extent:maxExtent
- ]
- ]
-!
-
-sizeFixed:aBoolean
- "this prevents the view from resizing itself when realized.
- For normal topViews, this is void, since they dont do this anyway.
-
- However, modalBoxes (especially: DialogBoxes) typically resize themselfes
- to the preferredExtent of their components. In some cases, this behavior is
- not desired and it should be turned off by setting sizeFixed to true.
-
- To avoid confusion:
- This does NOT prevent the window manager from resizing the view,
- instead it tells the view to NOT resize ITSELF."
-
- sizeFixed := aBoolean.
-
- "example: dialog which resizes itself on #open:
- (thereby ignoring the 200@200 extent)
-
- |dialog|
-
- dialog := Dialog new.
- dialog addInputFieldOn:'' asValue.
- dialog addOkButton.
- dialog extent:200@200.
- dialog open.
-
-
- using sizeFixed:
-
- |dialog|
-
- dialog := Dialog new.
- dialog addInputFieldOn:'' asValue.
- dialog addOkButton.
- dialog extent:200@200; sizeFixed:true.
- dialog open.
-
-
- using openWithExtent (also sets sizeFixed):
-
- |dialog|
-
- dialog := Dialog new.
- dialog addInputFieldOn:'' asValue.
- dialog addOkButton.
- dialog openWithExtent:200@200.
- "
-!
-
-application
- "return the topViews application.
- This is new protocol for ST-80 compatibility and not yet fully supported"
-
- ^ application
-!
-
-application:anApplicationModel
- "set the topViews application.
- This is new protocol for ST-80 compatibility and not yet fully supported"
-
- application := anApplicationModel
-!
-
-bePartner
- self setWindowGroupFromApplication.
- super bePartner.
-
- "Created: 22.9.1995 / 17:40:15 / claus"
-!
-
-beSlave
- self setWindowGroupFromApplication.
- super beSlave.
-
- "Created: 22.9.1995 / 17:40:15 / claus"
+version
+ ^ '$Header: /cvs/stx/stx/libview/Attic/StdSysV.st,v 1.37 1995-11-27 22:31:28 cg Exp $'
! !
-
-!StandardSystemView methodsFor:'event handling'!
-
-sendWindowEvents:collectionOfEventSymbols
- "define the events that are to be forwarded to the application.
- This is being implemented ..."
-
- windowEventsForApplication := collectionOfEventSymbols
-!
-
-focusOut
- "the view lost keyboard focus"
-
- |v|
-
- windowGroup notNil ifTrue:[
- (v := windowGroup focusView) notNil ifTrue:[
- v showNoFocus
- ]
- ].
-!
-
-focusIn
- "the view got the keyboard focus"
-
- |v|
-
- windowGroup notNil ifTrue:[
- (v := windowGroup focusView) notNil ifTrue:[
- v showFocus
- ]
- ].
-!
-
-mapped
- "the view got mapped"
-
- super mapped.
- "
- ask for the focus - this avoids having to click on the
- view with WM's which need an explicit click.
- Q: is this a good idea ?
- "
- TakeFocusWhenMapped == true ifTrue:[
- self getKeyboardFocus.
- ]
-! !
--- a/TopView.st Sat Nov 25 14:06:08 1995 +0100
+++ b/TopView.st Mon Nov 27 23:31:52 1995 +0100
@@ -11,10 +11,10 @@
"
View subclass:#TopView
- instanceVariableNames:'type'
- classVariableNames: ''
- poolDictionaries:''
- category:'Views-Basic'
+ instanceVariableNames:'type'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Basic'
!
!TopView class methodsFor:'documentation'!
@@ -33,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/TopView.st,v 1.7 1995-11-11 15:52:38 cg Exp $'
-!
-
documentation
"
I am an abstract superclass of StandardSystemView and PopUpView;
@@ -55,6 +51,63 @@
^ (display width // 3 * 2) @ (display height // 3 * 2)
! !
+!TopView methodsFor:'accessing & queries'!
+
+beMaster
+ "make this a master-view. All slave views within the same
+ windowGroup will be closed if any master is closed."
+
+ type := #master
+!
+
+bePartner
+ "make this a partner-view. Each partner-view will automatically
+ close other partner views whenclosed."
+
+ type := #partner
+!
+
+beSlave
+ "make this a slave-view. It will be closed automatically,
+ whenever any master of the group is closed."
+
+ type := #slave
+!
+
+heightIncludingBorder
+ "return the views overall-height"
+
+ ^ height
+!
+
+isCollapsed
+ "ST80 compatibility: return true if the view is not shown (i.e. iconified)"
+
+ ^ shown not
+!
+
+preferredExtent
+ "return my preferred extent - this is the minimum size I would like to have.
+ The default here is the classes default extent,
+ however many subclasses redefine this to compute the actual value
+ depending on the sizes of the contents or subcomponents."
+
+ ^ self class defaultExtent
+!
+
+type
+ "return the views type. This is one of #normal,
+ #master, #slave or #partner."
+
+ ^ type
+!
+
+widthIncludingBorder
+ "return the views overall-width"
+
+ ^ width
+! !
+
!TopView methodsFor:'initialization'!
initialize
@@ -68,6 +121,61 @@
type := #normal
! !
+!TopView methodsFor:'misc'!
+
+raiseDeiconified
+ "deiconify & bring to front"
+
+ self isCollapsed ifTrue:[
+ self unrealize.
+ self realize.
+ ].
+ self raise
+
+ "
+ Transcript topView raiseDeiconified
+ "
+!
+
+withCursor:aCursor do:aBlock
+ "evaluate aBlock while showing aCursor in all my views.
+ Return the value as returned by aBlock."
+
+ windowGroup notNil ifTrue:[
+ ^ windowGroup withCursor:aCursor do:aBlock
+ ].
+ ^ super withCursor:aCursor do:aBlock
+!
+
+withWaitCursorDo:aBlock
+ "evaluate aBlock while showing a waitCursor in all my views.
+ Return the value as returned by aBlock."
+
+ ^ self withCursor:(Cursor wait) do:aBlock
+! !
+
+!TopView methodsFor:'startup'!
+
+openInGroup:aGroup
+ "special open within another windowGroup.
+ This allows a view to be realized in any windowgroup;
+ for applications where multiple views act as a group
+ (i.e. close and iconify together)."
+
+ self windowGroup:aGroup.
+ aGroup addTopView:self.
+ self realizeLeavingGroup:true
+!
+
+openWithExtent:anExtent
+ "set extent and open. The given extent overrides the
+ receivers preferredExtent.
+ Added for ST-80 compatibility"
+
+ self extent:anExtent; sizeFixed:true.
+ self open
+! !
+
!TopView methodsFor:'window events'!
destroy
@@ -125,115 +233,8 @@
! !
-!TopView methodsFor:'misc'!
-
-withWaitCursorDo:aBlock
- "evaluate aBlock while showing a waitCursor in all my views.
- Return the value as returned by aBlock."
-
- ^ self withCursor:(Cursor wait) do:aBlock
-!
-
-withCursor:aCursor do:aBlock
- "evaluate aBlock while showing aCursor in all my views.
- Return the value as returned by aBlock."
-
- windowGroup notNil ifTrue:[
- ^ windowGroup withCursor:aCursor do:aBlock
- ].
- ^ super withCursor:aCursor do:aBlock
-!
-
-raiseDeiconified
- "deiconify & bring to front"
-
- self isCollapsed ifTrue:[
- self unrealize.
- self realize.
- ].
- self raise
-
- "
- Transcript topView raiseDeiconified
- "
-! !
-
-!TopView methodsFor:'startup'!
-
-openWithExtent:anExtent
- "set extent and open. The given extent overrides the
- receivers preferredExtent.
- Added for ST-80 compatibility"
-
- self extent:anExtent; sizeFixed:true.
- self open
-!
-
-openInGroup:aGroup
- "special open within another windowGroup.
- This allows a view to be realized in any windowgroup;
- for applications where multiple views act as a group
- (i.e. close and iconify together)."
-
- self windowGroup:aGroup.
- aGroup addTopView:self.
- self realizeLeavingGroup:true
-! !
+!TopView class methodsFor:'documentation'!
-!TopView methodsFor:'accessing & queries'!
-
-type
- "return the views type. This is one of #normal,
- #master, #slave or #partner."
-
- ^ type
-!
-
-beMaster
- "make this a master-view. All slave views within the same
- windowGroup will be closed if any master is closed."
-
- type := #master
-!
-
-beSlave
- "make this a slave-view. It will be closed automatically,
- whenever any master of the group is closed."
-
- type := #slave
-!
-
-bePartner
- "make this a partner-view. Each partner-view will automatically
- close other partner views whenclosed."
-
- type := #partner
-!
-
-preferredExtent
- "return my preferred extent - this is the minimum size I would like to have.
- The default here is the classes default extent,
- however many subclasses redefine this to compute the actual value
- depending on the sizes of the contents or subcomponents."
-
- ^ self class defaultExtent
-!
-
-isCollapsed
- "ST80 compatibility: return true if the view is not shown (i.e. iconified)"
-
- ^ shown not
-!
-
-heightIncludingBorder
- "return the views overall-height"
-
- ^ height
-!
-
-widthIncludingBorder
- "return the views overall-width"
-
- ^ width
+version
+ ^ '$Header: /cvs/stx/stx/libview/TopView.st,v 1.8 1995-11-27 22:31:39 cg Exp $'
! !
-
--- a/View.st Sat Nov 25 14:06:08 1995 +0100
+++ b/View.st Mon Nov 27 23:31:52 1995 +0100
@@ -10,8 +10,6 @@
hereby transferred.
"
-'From Smalltalk/X, Version:2.10.5 on 14-mar-1995 at 11:02:34 am'!
-
SimpleView subclass:#View
instanceVariableNames:'model aspectMsg changeMsg menuMsg'
classVariableNames:''
@@ -35,10 +33,6 @@
"
!
-version
- ^ '$Header: /cvs/stx/stx/libview/View.st,v 1.47 1995-11-11 15:52:57 cg Exp $'
-!
-
documentation
"
this class adds provisions for views which show or work on a model.
@@ -70,6 +64,12 @@
!View class methodsFor:'instance creation'!
+model:aModel
+ "st-80 style view creation: create a new view and set its model"
+
+ ^ self new model:aModel
+!
+
on:aModel aspect:aspectMsg
"st-80 style view creation: create a new view, set its model
and selectors for aspect"
@@ -89,16 +89,6 @@
change:changeMsg
!
-on:aModel aspect:aspectMsg menu:menuMsg
- "st-80 style view creation: create a new view, set its model
- and selectors for aspect and menu"
-
- ^ self new
- on:aModel
- aspect:aspectMsg
- menu:menuMsg
-!
-
on:aModel aspect:aspectMsg change:changeMsg menu:menuMsg
"st-80 style view creation: create a new view, set its model
and selectors for aspect, change and menu"
@@ -110,10 +100,14 @@
menu:menuMsg
!
-model:aModel
- "st-80 style view creation: create a new view and set its model"
+on:aModel aspect:aspectMsg menu:menuMsg
+ "st-80 style view creation: create a new view, set its model
+ and selectors for aspect and menu"
- ^ self new model:aModel
+ ^ self new
+ on:aModel
+ aspect:aspectMsg
+ menu:menuMsg
! !
!View class methodsFor:'defaults'!
@@ -148,56 +142,117 @@
^ newChannel
! !
+!View methodsFor:'accessing-menus'!
+
+menuHolder
+ "who has the menu ?
+ By default, its the model if I have one."
+
+ model notNil ifTrue:[^ model].
+ ^ self
+!
+
+menuPerformer
+ "who should perform the menu actions ?
+ By default, its the model if I have one."
+
+ model notNil ifTrue:[^ model].
+ ^ self
+! !
+
!View methodsFor:'accessing-mvc'!
-sendChangeMessageWith:arg
- "tell the model about a change"
+addModelInterfaceTo:aDictionary
+ "this adds entries for all messages sent to my model
+ to aDictionary"
+
+ aDictionary at:#aspectMessage put:aspectMsg.
+ aDictionary at:#changeMessage put:changeMsg.
+ aDictionary at:#menuMessage put:menuMsg.
+
+ "
+ Button new modelInterface
+ "
+!
- self sendChangeMessage:changeMsg with:arg
+aspect
+ "Return the aspect used with changes from/to the model"
+
+ ^ aspectMsg
+!
+
+aspectMessage
+ "Return the aspect used with changes from/to the model"
+
+ ^ aspectMsg
+!
+
+aspectMessage:aspectSymbol
+ "ST-80 style updating: If a views aspectSymbol is nonNil,
+ it will respond to changes of this aspect from the model."
+
+ aspectMsg := aspectSymbol
!
-sendChangeMessage:aSelector with:arg
- "tell the model about a change"
+change:changeSymbol
+ "ST-80 style change notification: If a views changeSymbol is nonNil,
+ it will send it to its model when something changes.
+ Alias for changeMessage: for ST-80 compatibility."
+
+ self changeMessage:changeSymbol
+!
+
+changeMessage
+ "Return the symbol sent to the model if nonNil when something changes."
- |n selector|
+ ^ changeMsg
+!
+
+changeMessage:aSymbol
+ "ST-80 style change notification: If a views changeSymbol is nonNil,
+ it will send it to its model when something changes.
+ This is the same as change: which was added for ST-80 compatibility."
+
+ changeMsg := aSymbol
+!
+
+controller:aController
+ "set the controller"
- "/
- "/ MVC way of doing it:
- "/ if the model is a block, evaluate it, optionally
- "/ passing the arg and the receiver as arguments.
- "/
- "/ otherwise (the common case) send it a changeMsg message
- "/ also with arg and the receiver (depending on the number of arguments
- "/ as defined by the selector).
- "/
- (model notNil and:[aSelector notNil]) ifTrue:[
- n := aSelector numArgs.
- model isBlock ifTrue:[
- n := model numArgs.
- n == 0 ifTrue:[
- selector := #value
- ] ifFalse:[
- n == 1 ifTrue:[
- selector := #value:
- ] ifFalse:[
- selector := #value:value:
- ]
- ]
- ] ifFalse:[
- selector := aSelector
- ].
- n == 0 ifTrue:[
- model perform:selector
- ] ifFalse:[
- n == 1 ifTrue:[
- model perform:selector with:arg
- ] ifFalse:[
- model perform:selector with:arg with:self
- ]
- ]
+ super controller:aController.
+ controller notNil ifTrue:[
+ controller model:model
]
!
+menu:menuSymbol
+ "ST-80 style menus: If a views menuSymbol is nonNil, it
+ will send it to its model when the middleButton is pressed.
+ That method should return nil or the menu to be shown.
+ This is useful for very dynamic menus, where it does not
+ make sense to define an initial menu.
+ Alias for #menuMessage:, for ST-80 compatibility."
+
+ menuMsg := menuSymbol
+!
+
+menuMessage
+ "Return the symbol sent to the model to aquire the menu"
+
+ ^ menuMsg
+!
+
+menuMessage:aSymbol
+ "ST-80 style menus: If a views menuSymbol is nonNil, it
+ will send it to its model when the middleButton is pressed.
+ That method should return nil or the menu to be shown.
+ This is useful for very dynamic menus, where it does not
+ make sense to define an initial menu.
+ This is the same as #menu: which was added for ST-80 compatibility."
+
+ menuMsg := aSymbol
+!
+
model
"return the model, for non-MVC views,
this is nil or the receiver"
@@ -221,133 +276,6 @@
]
!
-controller:aController
- "set the controller"
-
- super controller:aController.
- controller notNil ifTrue:[
- controller model:model
- ]
-!
-
-on:aModel aspect:aspectSymbol
- "ST-80 compatibility: set model and aspect
- messages - needs a view which uses these"
-
- aspectMsg := aspectSymbol.
- self model:aModel.
-!
-
-on:aModel aspect:aspectSymbol menu:menuSymbol
- "ST-80 compatibility: set model, aspect and menu
- messages - needs a view which uses these"
-
- aspectMsg := aspectSymbol.
- menuMsg := menuSymbol.
- self model:aModel.
-!
-
-on:aModel aspect:aspectSymbol change:changeSymbol
- "ST-80 compatibility: set model, aspect and change
- messages - needs a view which uses these"
-
- aspectMsg := aspectSymbol.
- changeMsg := changeSymbol.
- self model:aModel.
-!
-
-on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
- "ST-80 compatibility: set model, aspect, change and menu
- messages - needs a view which uses these"
-
- aspectMsg := aspectSymbol.
- changeMsg := changeSymbol.
- menuMsg := menuSymbol.
- self model:aModel.
-!
-
-menuMessage:aSymbol
- "ST-80 style menus: If a views menuSymbol is nonNil, it
- will send it to its model when the middleButton is pressed.
- That method should return nil or the menu to be shown.
- This is useful for very dynamic menus, where it does not
- make sense to define an initial menu.
- This is the same as #menu: which was added for ST-80 compatibility."
-
- menuMsg := aSymbol
-!
-
-menuMessage
- "Return the symbol sent to the model to aquire the menu"
-
- ^ menuMsg
-!
-
-menu:menuSymbol
- "ST-80 style menus: If a views menuSymbol is nonNil, it
- will send it to its model when the middleButton is pressed.
- That method should return nil or the menu to be shown.
- This is useful for very dynamic menus, where it does not
- make sense to define an initial menu.
- Alias for #menuMessage:, for ST-80 compatibility."
-
- menuMsg := menuSymbol
-!
-
-changeMessage:aSymbol
- "ST-80 style change notification: If a views changeSymbol is nonNil,
- it will send it to its model when something changes.
- This is the same as change: which was added for ST-80 compatibility."
-
- changeMsg := aSymbol
-!
-
-changeMessage
- "Return the symbol sent to the model if nonNil when something changes."
-
- ^ changeMsg
-!
-
-change:changeSymbol
- "ST-80 style change notification: If a views changeSymbol is nonNil,
- it will send it to its model when something changes.
- Alias for changeMessage: for ST-80 compatibility."
-
- self changeMessage:changeSymbol
-!
-
-aspect
- "Return the aspect used with changes from/to the model"
-
- ^ aspectMsg
-!
-
-aspectMessage:aspectSymbol
- "ST-80 style updating: If a views aspectSymbol is nonNil,
- it will respond to changes of this aspect from the model."
-
- aspectMsg := aspectSymbol
-!
-
-aspectMessage
- "Return the aspect used with changes from/to the model"
-
- ^ aspectMsg
-!
-
-addModelInterfaceTo:aDictionary
- "this adds entries for all messages sent to my model
- to aDictionary"
-
- aDictionary at:#aspectMessage put:aspectMsg.
- aDictionary at:#changeMessage put:changeMsg.
- aDictionary at:#menuMessage put:menuMsg.
-
- "
- Button new modelInterface
- "
-!
-
modelInterface
"this returns a dictionary of messages sent to my model.
It can be used for builders and wrappers to get information
@@ -392,24 +320,102 @@
v perform:(what , ':') asSymbol with:nil.
].
"
+!
+
+on:aModel aspect:aspectSymbol
+ "ST-80 compatibility: set model and aspect
+ messages - needs a view which uses these"
+
+ aspectMsg := aspectSymbol.
+ self model:aModel.
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol
+ "ST-80 compatibility: set model, aspect and change
+ messages - needs a view which uses these"
+
+ aspectMsg := aspectSymbol.
+ changeMsg := changeSymbol.
+ self model:aModel.
+!
+
+on:aModel aspect:aspectSymbol change:changeSymbol menu:menuSymbol
+ "ST-80 compatibility: set model, aspect, change and menu
+ messages - needs a view which uses these"
+
+ aspectMsg := aspectSymbol.
+ changeMsg := changeSymbol.
+ menuMsg := menuSymbol.
+ self model:aModel.
+!
+
+on:aModel aspect:aspectSymbol menu:menuSymbol
+ "ST-80 compatibility: set model, aspect and menu
+ messages - needs a view which uses these"
+
+ aspectMsg := aspectSymbol.
+ menuMsg := menuSymbol.
+ self model:aModel.
+!
+
+sendChangeMessage:aSelector with:arg
+ "tell the model about a change"
+
+ |n selector|
+
+ "/
+ "/ MVC way of doing it:
+ "/ if the model is a block, evaluate it, optionally
+ "/ passing the arg and the receiver as arguments.
+ "/
+ "/ otherwise (the common case) send it a changeMsg message
+ "/ also with arg and the receiver (depending on the number of arguments
+ "/ as defined by the selector).
+ "/
+ (model notNil and:[aSelector notNil]) ifTrue:[
+ n := aSelector numArgs.
+ model isBlock ifTrue:[
+ n := model numArgs.
+ n == 0 ifTrue:[
+ selector := #value
+ ] ifFalse:[
+ n == 1 ifTrue:[
+ selector := #value:
+ ] ifFalse:[
+ selector := #value:value:
+ ]
+ ]
+ ] ifFalse:[
+ selector := aSelector
+ ].
+ n == 0 ifTrue:[
+ model perform:selector
+ ] ifFalse:[
+ n == 1 ifTrue:[
+ model perform:selector with:arg
+ ] ifFalse:[
+ model perform:selector with:arg with:self
+ ]
+ ]
+ ]
+!
+
+sendChangeMessageWith:arg
+ "tell the model about a change"
+
+ self sendChangeMessage:changeMsg with:arg
! !
-!View methodsFor:'accessing-menus'!
-
-menuHolder
- "who has the menu ?
- By default, its the model if I have one."
+!View methodsFor:'drawing'!
- model notNil ifTrue:[^ model].
- ^ self
-!
+redraw
+ "redraw myself
+ if there is a model, this one shall redraw itself,
+ otherwise we cannot do much here - has to be redefined in subclasses"
-menuPerformer
- "who should perform the menu actions ?
- By default, its the model if I have one."
-
- model notNil ifTrue:[^ model].
- ^ self
+ model notNil ifTrue:[
+ model update:self
+ ]
! !
!View methodsFor:'initialization'!
@@ -427,18 +433,6 @@
].
! !
-!View methodsFor:'drawing'!
-
-redraw
- "redraw myself
- if there is a model, this one shall redraw itself,
- otherwise we cannot do much here - has to be redefined in subclasses"
-
- model notNil ifTrue:[
- model update:self
- ]
-! !
-
!View methodsFor:'realization'!
destroy
@@ -451,3 +445,9 @@
].
super destroy.
! !
+
+!View class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/View.st,v 1.48 1995-11-27 22:31:52 cg Exp $'
+! !