--- a/SimpleView.st Fri Oct 02 15:37:52 2015 +0200
+++ b/SimpleView.st Wed Nov 11 14:12:03 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
@@ -9,6 +11,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.5.0 on 24-04-2015 at 14:30:54' !
+
"{ Package: 'stx:libview' }"
"{ NameSpace: Smalltalk }"
@@ -837,15 +841,15 @@
newView := self basicNew.
aView notNil ifTrue:[
- device := aView graphicsDevice.
+ newView initializeForDevice:(aView graphicsDevice).
+"/ newView container:aView.
] ifFalse:[
+ newView initializeForDevice:Screen current
+ ].
+ (newView device supportsNativeWidgetType:newView nativeWindowType) ifTrue:[
+ newView beNativeWidget.
device := Screen current
].
- newView device:device.
- (device supportsNativeWidgetType:newView nativeWindowType) ifTrue:[
- newView beNativeWidget
- ].
- newView initialize.
aView notNil ifTrue:[aView addSubView:newView].
^ newView
@@ -1064,20 +1068,18 @@
DefaultFont notNil ifTrue:[^ DefaultFont].
- DefaultFont isNil ifTrue:[
- self == SimpleView ifFalse:[
- f := self superclass defaultFont.
- ] ifTrue:[
- f := super defaultFont
- ].
+ self == SimpleView ifTrue:[
+ f := super defaultFont
+ ] ifFalse:[
+ f := self superclass defaultFont.
].
f notNil ifTrue:[
- DefaultFont := f.
- f := f onDevice:(Screen current).
- f notNil ifTrue:[
- DefaultFont := f.
- ]
+ DefaultFont := f.
+ f := f onDevice:Screen current.
+ f notNil ifTrue:[
+ DefaultFont := f.
+ ]
].
^ DefaultFont
@@ -1091,10 +1093,10 @@
DefaultFont := aFont.
aFont notNil ifTrue:[
- f := aFont onDevice:(Screen current).
- f notNil ifTrue:[
- DefaultFont := f.
- ]
+ f := aFont onDevice:(Screen current).
+ f notNil ifTrue:[
+ DefaultFont := f.
+ ]
]
"Modified: 18.3.1996 / 12:56:20 / cg"
@@ -1417,6 +1419,13 @@
^ ViewSpacing
! !
+!SimpleView class methodsFor:'misc ui support'!
+
+iconInBrowserSymbol
+ <resource: #programImage>
+
+ ^ #windowClassBrowserIcon
+! !
!SimpleView class methodsFor:'resources'!
@@ -1651,61 +1660,58 @@
isApplicationModel := true.
(builder := aBuilder) isNil ifTrue:[
- "/ problem: anApplication could have no builder
- "/ or anApplication could be a non-appModel (theoretically - only providing a spec)
- builder := anApplication perform:#builder ifNotUnderstood:[isApplicationModel := false. nil].
- builder isNil ifTrue:[
- isApplicationModel ifTrue:[
- anApplication createBuilder.
- builder := anApplication builder
- ] ifFalse:[
- builder := UIBuilder new.
- ]
- ]
+ "/ problem: anApplication could have no builder
+ "/ or anApplication could be a non-appModel (theoretically - only providing a spec)
+ builder := anApplication perform:#builder ifNotUnderstood:[isApplicationModel := false. nil].
+ builder isNil ifTrue:[
+ isApplicationModel ifTrue:[
+ anApplication createBuilder.
+ builder := anApplication builder
+ ] ifFalse:[
+ builder := UIBuilder new.
+ ]
+ ]
].
(subSpec := aWindowSpecOrSpecSymbol) isSymbol ifTrue:[
- anApplication isNil ifTrue:[^ self].
- subSpec := anApplication interfaceSpecFor:aWindowSpecOrSpecSymbol.
- subSpec isNil ifTrue:[
- ^ self
- ].
+ anApplication isNil ifTrue:[^ self].
+ subSpec := anApplication interfaceSpecFor:aWindowSpecOrSpecSymbol.
+ subSpec isNil ifTrue:[
+ ^ self
+ ].
].
"/ if the appl is not the master, but the masters builder is used,
"/ we have to temporarily change the builders window
masterApp := anApplication perform:#masterApplication ifNotUnderstood:[isApplicationModel := false. nil].
- masterApp isNil ifTrue:[
- isApplicationModel := false.
- ].
thisApp := builder application.
(isApplicationModel and:[anApplication ~~ thisApp]) ifTrue:[
- masterApp ~~ thisApp ifTrue:[
- self error:'should not happen' mayProceed:true.
- masterApp isNil ifTrue:[
- anApplication masterApplication:thisApp.
- ].
- ].
-
- builder application:anApplication.
- savedView := builder window.
- builder window:self.
- [
- anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
- ] ensure:[
- builder window:savedView.
- builder application:thisApp.
- ].
+ masterApp ~~ thisApp ifTrue:[
+ self error:'should not happen' mayProceed:true.
+ masterApp isNil ifTrue:[
+ anApplication masterApplication:thisApp.
+ ].
+ ].
+
+ builder application:anApplication.
+ savedView := builder window.
+ builder window:self.
+ [
+ anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
+ ] ensure:[
+ builder window:savedView.
+ builder application:thisApp.
+ ].
] ifFalse:[
- thisIsANewBuild := builder window isNil.
- thisIsANewBuild ifTrue:[
- builder window:self.
- anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
- ] ifFalse:[
- "/ WARNING: in case of rebuilding, we do NOT invoke pre- and postBuilds
- builder buildFromSpec:subSpec in:self.
- ]
+ thisIsANewBuild := builder window isNil.
+ thisIsANewBuild ifTrue:[
+ builder window:self.
+ anApplication buildSubCanvas:subSpec withMenu:withMenuBoolean withBuilder:builder.
+ ] ifFalse:[
+ "/ WARNING: in case of rebuilding, we do NOT invoke pre- and postBuilds
+ builder buildFromSpec:subSpec in:self.
+ ]
].
"/ postBuildWith: will be called twice if code below is enabled
@@ -1787,16 +1793,6 @@
"Created: / 30.3.1999 / 15:54:29 / stefan"
!
-preferFirstInputFieldWhenAssigningInitialFocus
- "define the focus behavior for dialogs.
- If true is returned, input fields take precedence over other keyboard consumers.
- This used to return true, but the behavior is somewhat ugly."
-
- ^ false
-
- "Created: / 29-08-2006 / 14:28:54 / cg"
-!
-
readOnly:aBoolean
"ignored here; present for compatibility with some textView subclasses,
so that UIPainter can handle it in its TextView spec (which contains a
@@ -1898,18 +1894,8 @@
border:aBorder
"set my border"
- |prevMargin m|
-
- prevMargin := margin.
border := aBorder.
self computeMargin.
- realized ifTrue:[
- m := prevMargin max:margin.
- self invalidate:(0@0 corner:width@m). "/ top margin
- self invalidate:((width-m)@m corner:width@height). "/ right margin
- self invalidate:(0@(height-m) corner:width@height). "/ bottom margin
- self invalidate:(0@m corner:m@(height-m)). "/ left margin
- ].
!
borderColor
@@ -2305,6 +2291,16 @@
"Modified: 26.5.1996 / 12:44:21 / cg"
!
+heightOfContentsDependsOnWidth
+ "a very special which is only used by the scrollableView,
+ to check if it should NOT automatically hide scrollbars, when the
+ pointer leaves the view.
+ Currently, there are only a small number of views which return true here,
+ one being the HTML view, which rearranges its text depending on the width,
+ and therefore, it is a bad idea to hide/show scrollbars dynamically"
+
+ ^ false
+!
widthOfContents
"return the width of the contents in logical units
@@ -2323,6 +2319,15 @@
^ (self innerWidth max:(self maxSubViewRight)) max:self maxComponentRight
"Modified: 26.5.1996 / 13:02:50 / cg"
+!
+widthOfContentsDependsOnHeight
+ "a very special query which is only used by the scrollableView,
+ to check if it should NOT automatically hide scrollbars, when the
+ pointer leaves the view.
+ Currently, there is no view, which returns true
+ (maybe if we ever support chinese writing top to bottom..."
+
+ ^ false
! !
!SimpleView methodsFor:'accessing-dimensions'!
@@ -3319,28 +3324,18 @@
!
relativeCorner
- "return the relative corner or nil"
-
- "MB:added {" "needed if layout is used e.g. POUEditor"
- layout notNil ifTrue:[
- ^(layout rightFraction) @ (layout bottomFraction)
- ].
- "MB:added }"
-
- ^relativeCorner
+ "return the relative corner or nil.
+ Obsolete: please use a layout object."
+
+ ^ relativeCorner
!
relativeCorner:aPoint
- "set the relative corner"
+ "set the relative corner.
+ Obsolete: please use a layout object."
aPoint notNil ifTrue:[relativeExtent := nil].
- relativeCorner := aPoint.
- "MB:added {" "needed if layout is used e.g. POUEditor"
- layout notNil ifTrue:[
- layout rightFraction: aPoint x.
- layout bottomFraction: aPoint y.
- ].
- "MB:added }"
+ relativeCorner := aPoint
!
relativeExtent
@@ -3359,26 +3354,17 @@
!
relativeOrigin
- "return the relative corner or nil"
-
- "MB:added {" "needed if layout is used e.g. POUEditor"
- layout notNil ifTrue:[
- ^(layout leftFraction) @ (layout topFraction)
- ].
- "MB:added }"
- ^relativeOrigin
+ "return the relative origin or nil.
+ Obsolete: please use a layout object."
+
+ ^ relativeOrigin
!
relativeOrigin:aPoint
- "set the relative origin"
-
- relativeOrigin := aPoint.
- "MB:added {" "needed if layout is used e.g. POUEditor"
- layout notNil ifTrue:[
- layout leftFraction: aPoint x.
- layout topFraction: aPoint y.
- ].
- "MB:added }"
+ "set the relative origin.
+ Obsolete: please use a layout object."
+
+ relativeOrigin := aPoint
!
right
@@ -3916,80 +3902,68 @@
bitGravity ~~ gravity ifTrue:[
bitGravity := gravity.
- super bitGravity:gravity.
+ gc bitGravity:gravity.
]
!
-clippingBounds:aRectangle
+clippingBounds:aRectangleOrNil
"set the clipping rectangle for drawing (in logical coordinates);
a nil argument turns off clipping (i.e. whole view is drawable).
Redefined to care for any margin."
- |x y w h currentClippingBounds|
+ |x y w h currentClippingBounds newBounds|
currentClippingBounds := gc clippingBoundsOrNil.
-
- aRectangle isNil ifTrue:[
- currentClippingBounds isNil ifTrue:[^ self].
- gc gcId notNil ifTrue:[
- gc graphicsDevice noClipIn:gc drawableId gc:gc gcId
- ]
- ] ifFalse:[
- currentClippingBounds notNil ifTrue:[
- (currentClippingBounds = aRectangle) ifTrue:[^ self]
+ (currentClippingBounds = aRectangleOrNil) ifTrue:[
+ ^ self
+ ].
+ newBounds := aRectangleOrNil.
+
+ aRectangleOrNil notNil ifTrue:[
+ |currentTransformation|
+
+ x := aRectangleOrNil left.
+ y := aRectangleOrNil top.
+ w := aRectangleOrNil width.
+ h := aRectangleOrNil height.
+ currentTransformation := gc transformation.
+ currentTransformation notNil ifTrue:[
+ x := currentTransformation applyToX:x.
+ y := currentTransformation applyToY:y.
+ w := currentTransformation applyScaleX:w.
+ h := currentTransformation applyScaleY:h.
+ ].
+ (x isMemberOf:SmallInteger) ifFalse:[
+ w := w + (x - x truncated).
+ x := x truncated
].
- gc gcId notNil ifTrue:[
- |currentTransformation pO pC|
-
- x := aRectangle left.
- y := aRectangle top.
- w := aRectangle width.
- h := aRectangle height.
- currentTransformation := gc transformation.
- currentTransformation notNil ifTrue:[
- pO := transformation transformPoint:x@y.
- pC := transformation transformPoint:(x+w-1)@(y+h-1).
- x := pO x.
- y := pO y.
- w := pC x - x + 1.
- h := pC y - y + 1.
-"/ x := currentTransformation applyToX:x.
-"/ y := currentTransformation applyToY:y.
-"/ w := currentTransformation applyScaleX:w.
-"/ h := currentTransformation applyScaleY:h.
- ].
- (x isMemberOf:SmallInteger) ifFalse:[
- w := w + (x - x truncated).
- x := x truncated
- ].
- (y isMemberOf:SmallInteger) ifFalse:[
- h := h + (y - y truncated).
- y := y truncated
- ].
- (w isMemberOf:SmallInteger) ifFalse:[
- w := w truncated + 1
- ].
- (h isMemberOf:SmallInteger) ifFalse:[
- h := h truncated + 1
- ].
- x < margin ifTrue:[
- x := margin.
- ].
- y < margin ifTrue:[
- y := margin.
- ].
- x + w - 1 >= (width-margin) ifTrue:[
- w := width - margin - x
- ].
- y + h - 1 >= (height-margin) ifTrue:[
- h := height - margin - y
- ].
- w := w max:0.
- h := h max:0.
- self graphicsDevice setClipX:x y:y width:w height:h in:self drawableId gc:gc gcId
- ]
- ].
- self setClippingBounds:aRectangle
+ (y isMemberOf:SmallInteger) ifFalse:[
+ h := h + (y - y truncated).
+ y := y truncated
+ ].
+ (w isMemberOf:SmallInteger) ifFalse:[
+ w := w truncated + 1
+ ].
+ (h isMemberOf:SmallInteger) ifFalse:[
+ h := h truncated + 1
+ ].
+ x < margin ifTrue:[
+ x := margin.
+ ].
+ y < margin ifTrue:[
+ y := margin.
+ ].
+ x + w - 1 >= (width-margin) ifTrue:[
+ w := width - margin - x
+ ].
+ y + h - 1 >= (height-margin) ifTrue:[
+ h := height - margin - y
+ ].
+ w := w max:0.
+ h := h max:0.
+ newBounds := Rectangle left:x top:y width:w height:h.
+ ].
+ gc deviceClippingBounds:newBounds
"Created: 28.5.1996 / 19:50:03 / cg"
"Modified: 28.5.1996 / 22:32:15 / cg"
@@ -4066,7 +4040,7 @@
viewGravity ~~ gravity ifTrue:[
viewGravity := gravity.
- super viewGravity:gravity.
+ gc viewGravity:gravity.
]
! !
@@ -4222,17 +4196,18 @@
setViewOrigin:aPoint
"set the viewOrigin - i.e. virtually scroll without redrawing"
- |p currentTransformation|
-
- p := aPoint negated.
+ |currentTransformation|
+
currentTransformation := gc transformation.
currentTransformation isNil ifTrue:[
- gc transformation:(WindowingTransformation scale:1 translation:p).
+ (aPoint x ~~ 0 or:[aPoint y ~~ 0]) ifTrue:[
+ gc transformation:(WindowingTransformation scale:1 translation:aPoint negated).
+ ].
] ifFalse:[
- currentTransformation translation:p
+ currentTransformation translation:aPoint negated.
].
self clippingBoundsOrNil notNil ifTrue:[
- self setInnerClip.
+ self setInnerClip.
].
!
@@ -5381,11 +5356,11 @@
"redraw my edges (if any)"
(level ~~ 0) ifTrue:[
- shown ifTrue:[
- self clippingRectangle:nil.
- self drawEdges.
- self deviceClippingRectangle:innerClipRect
- ]
+ shown ifTrue:[
+ gc clippingBounds:nil.
+ self drawEdges.
+ gc deviceClippingBounds:innerClipRect
+ ]
]
"Modified: / 25.5.1999 / 14:50:25 / cg"
@@ -5973,16 +5948,16 @@
"a low level redraw event from device
- let subclass handle the redraw and take care of edges here"
- |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh dx dy dw dh old oldPaint|
+ |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh old oldPaint|
shown ifFalse:[
^ self
].
- nw := dw := w.
- nh := dh := h.
- nx := dx := x.
- ny := dy := y.
+ nw := w.
+ nh := h.
+ nx := x.
+ ny := y.
anyEdge := false.
@@ -5998,21 +5973,13 @@
botEdge := false.
currentTransformation := gc transformation.
currentTransformation notNil ifTrue:[
- |pO pC|
-
"
need device coordinates for this test
"
- pO := transformation transformPoint:x@y.
- pC := transformation transformPoint:(x+w-1)@(y+h-1).
- nx := pO x.
- ny := pO y.
- nw := pC x - nx + 1.
- nh := pC y - ny + 1.
-"/ nx := currentTransformation applyToX:nx.
-"/ ny := currentTransformation applyToY:ny.
-"/ nw := currentTransformation applyScaleX:nw.
-"/ nh := currentTransformation applyScaleY:nh.
+ nx := currentTransformation applyToX:nx.
+ ny := currentTransformation applyToY:ny.
+ nw := currentTransformation applyScaleX:nw.
+ nh := currentTransformation applyScaleY:nh.
].
"
adjust expose rectangle, to exclude the margin.
@@ -6035,11 +6002,6 @@
nh := nh truncated + 1
].
- dx := nx.
- dy := ny.
- dw := nw.
- dh := nh.
-
(nx < margin) ifTrue:[
old := nx.
nx := margin.
@@ -6075,16 +6037,16 @@
"
redraw inside area
"
- self clippingRectangle:(Rectangle left:nx top:ny width:nw height:nh).
-
- self redrawX:nx y:ny width:nw height:nh.
+ self
+ clippingBounds:(Rectangle left:nx top:ny width:nw height:nh);
+ redrawX:nx y:ny width:nw height:nh.
].
"
redraw edge(s)
"
anyEdge ifTrue:[
- self deviceClippingRectangle:nil.
+ self clippingBounds:nil.
oldPaint := self paint.
border notNil ifTrue:[
border displayOn:self forDisplayBox:(Rectangle left:0 top:0 width:width height:height).
@@ -6108,7 +6070,7 @@
].
self paint:oldPaint.
].
- self deviceClippingRectangle:innerClipRect.
+ gc deviceClippingBounds:innerClipRect.
"Modified: / 25.5.1999 / 14:57:38 / cg"
!
@@ -6117,7 +6079,6 @@
"got keyboard focus (via the window manager).
Nothing done here"
- ^ self
!
focusOut
@@ -6956,6 +6917,14 @@
^ nil
!
+preferFirstInputFieldWhenAssigningInitialFocus
+ "define the focus behavior for dialogs.
+ If true is returned, input fields take precedence over other keyboard consumers.
+ This used to return true, but the behavior is somewhat ugly."
+
+ ^ false
+!
+
requestDoNotFocusOnPointerEnter
<resource: #obsolete>
@@ -7050,6 +7019,10 @@
graphicsDevice setWindowBorderColor:clrId in:self drawableId.
]
]
+ ] ifFalse:[
+"/ superView notNil ifTrue:[
+"/ superView showFocus:explicit
+"/ ]
]
"Modified: / 17.9.1998 / 15:08:34 / cg"
@@ -7138,8 +7111,8 @@
with buttonPress can do so by redefining this
to return false
(actually: they should, because it is quite annoying
- in the UI, if a menuPanel or button takes my keyboard focus.
- So we should consider making the default false here, so every
+ in the UI if a menuPanel or button takes my keyboard focus.
+ So we should onsider making the default false here, so every
widget writer has to think twice...
Can we do such a major change?)"
@@ -7500,7 +7473,7 @@
prepareForReinit
super prepareForReinit.
windowGroup notNil ifTrue:[
- windowGroup reinitialize
+ windowGroup reinitialize
]
!
@@ -7960,30 +7933,30 @@
!
computeInnerClip
- "compute, but do not set the inside clip-area"
+ "compute, but do not set the inside clip-area, in device coordinates"
|m2 nX nY nW nH|
margin isNil ifTrue:[margin := 0].
(margin ~~ 0) ifTrue:[
- m2 := margin + margin.
- nX := nY := margin.
- nW := width - m2.
- nH := height - m2.
+ m2 := margin + margin.
+ nX := nY := margin.
+ nW := width - m2.
+ nH := height - m2.
"/ transformation notNil ifTrue:[
"/ nX := transformation applyInverseToX:nX.
"/ nY := transformation applyInverseToY:nY.
"/ nW := transformation applyInverseScaleX:nW.
"/ nH := transformation applyInverseScaleY:nH.
"/ ].
- innerClipRect := Rectangle
- left:nX
- top:nY
- width:nW
- height:nH
+ innerClipRect := Rectangle
+ left:nX
+ top:nY
+ width:nW
+ height:nH
] ifFalse:[
- "no clipping"
- innerClipRect := nil
+ "no clipping"
+ innerClipRect := nil
]
"Modified: / 22.5.1999 / 16:50:58 / cg"
@@ -8485,7 +8458,7 @@
"compute, and set the inside clip-area"
self computeInnerClip.
- self deviceClippingRectangle:innerClipRect.
+ self clippingBounds:innerClipRect.
"Modified: / 25.5.1999 / 14:45:53 / cg"
!
@@ -8499,10 +8472,10 @@
|form|
(form := viewShape borderShapeForm) notNil ifTrue:[
- self windowBorderShape:form.
+ gc windowBorderShape:form.
].
(form := viewShape viewShapeForm) notNil ifTrue:[
- self windowShape:form.
+ gc windowShape:form.
].
"Created: 18.9.1997 / 11:09:00 / cg"
@@ -9460,8 +9433,6 @@
icon:nil iconMask:nil
iconView:nil.
- Lobby registerChange:self.
-
"/ if there is a global eventListener,
"/ give it a chance to track views
@@ -9476,11 +9447,11 @@
"/ ]
"/ ].
(viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
- super viewGravity:viewGravity.
+ gc viewGravity:viewGravity.
].
(bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
isInputOnly ifFalse:[
- super bitGravity:bitGravity.
+ gc bitGravity:bitGravity.
]
].
viewShape notNil ifTrue:[
@@ -9995,20 +9966,19 @@
|r currentTransformation|
shown ifFalse:[
- "/ no need to add damage - will get a full-redraw anyway,
- "/ when I will be shown again.
- ^ self
+ "/ no need to add damage - will get a full-redraw anyway,
+ "/ when I will be shown again.
+ ^ self
].
r := aRectangle.
currentTransformation := gc transformation.
currentTransformation notNil ifTrue:[
- r := (currentTransformation transformPoint:r origin) corner:(currentTransformation transformPoint:r corner).
+ r := currentTransformation applyTo:r.
].
self invalidateDeviceRectangle:r repairNow:doRepairNow
- "Modified: / 10-11-1998 / 01:55:03 / cg"
- "Modified: / 22-01-2015 / 14:23:09 / az"
+ "Modified: / 10.11.1998 / 01:55:03 / cg"
!
invalidateDeviceRectangle:aRectangle repairNow:doRepairNow
@@ -11206,6 +11176,14 @@
isApplicationSubView
^ false
+!
+
+isCodeView2
+ "codeview2 seems to require some extra hacks"
+
+ ^ false
+
+ "Created: / 20-07-2010 / 15:42:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SimpleView methodsFor:'user interaction & notifications'!
@@ -11385,11 +11363,11 @@
!SimpleView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.783 2015-04-24 09:28:08 mb Exp $'
+ ^ '$Header$'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.783 2015-04-24 09:28:08 mb Exp $'
+ ^ '$Header$'
!
version_SVN