hg/stx-libview: changeset 727:bf23a306b6f2

--- a/Cursor.st	Tue May 28 17:13:25 1996 +0200
+++ b/Cursor.st	Tue May 28 17:57:29 1996 +0200
@@ -67,7 +67,7 @@
 
     [see also:]
         DeviceWorkstation 
-        PseudoView
+        DisplaySurface
         Font Cursor Color Form
         ( introduction to view programming :html: programming/viewintro.html#CURSOR )
 
@@ -1952,6 +1952,6 @@
 !Cursor class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.32 1996-05-21 09:01:55 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Cursor.st,v 1.33 1996-05-28 15:56:12 cg Exp $'
 ! !
 Cursor initialize!

--- a/DRootView.st	Tue May 28 17:13:25 1996 +0200
+++ b/DRootView.st	Tue May 28 17:57:29 1996 +0200
@@ -10,7 +10,7 @@
  hereby transferred.
 "
 
-PseudoView subclass:#DisplayRootView
+DisplaySurface subclass:#DisplayRootView
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
@@ -183,6 +183,6 @@
 !DisplayRootView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.16 1996-04-30 13:43:23 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Attic/DRootView.st,v 1.17 1996-05-28 15:56:18 cg Exp $'
 ! !
 DisplayRootView initialize!

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/DSurface.st	Tue May 28 17:57:29 1996 +0200
@@ -0,0 +1,1691 @@
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+GraphicsMedium subclass:#DisplaySurface
+	instanceVariableNames:'viewBackground cursor eventMask middleButtonMenu keyCommands
+		gotExpose exposePending backed saveUnder delegate'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Graphics-Support'
+!
+
+!DisplaySurface class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+    this abstract class describes stuff common to any Window on a display 
+    device. i.e. RootWindow, TopWindows, PopUps and Subwindows.
+    That is, they have a viewBackground, cursor etc. and especially events.
+    A special feature is the delegate field, which allows key- and button 
+    events to be stolen from a view. 
+    If the delegate is non-nil, these events will be sent to it instead.
+    So you can change a views behavior even if it was not initially designed 
+    for it. Also, controller functionality could be simulated using delegates.
+
+    [instance variables:]
+
+        viewBackground  <Color|Form|Image>      the views background
+
+        cursor          <Cursor>                the cursor
+
+        eventMask                               mask specifying the enabled
+                                                events.
+
+        middleButtonMenu                        a popup menu for the middle
+                                                button.
+
+        keyCommands                             not yet supported
+
+        gotExpose                               for exposure handling after
+        exposePending                           after a scroll
+
+        backed                                  true if backing store for that
+                                                view is enabled
+
+        saveUnder                               true if saveunder store for 
+                                                that view is enabled
+
+        delegate                                for event delegation
+
+    [see also:]
+        DeviceWorkstation
+        WindowGroup
+        StandardSYstemView SimpleView View
+
+    [author:]
+        Claus Gittinger
+"
+! !
+
+!DisplaySurface methodsFor:'accessing'!
+
+depth
+    "return the depth in pixels of the view.
+     Notice, that this is currently the devices depth, 
+     but support for mixed depth views is being prepared.
+     (especially useful on SGI, with 24bit view)"
+
+    ^ device depth
+!
+
+insideColor:aColor
+    "set the views background color - ST-80 compatibility"
+
+    self viewBackground:aColor.
+    self background:aColor
+!
+
+setViewBackground
+    "install the viewBackground for the receiver on the device"
+
+    |id devBgPixmap bgPixmap w h colors|
+
+    drawableId notNil ifTrue:[
+	viewBackground isColor ifTrue:[
+	    viewBackground := viewBackground on:device.
+	    id := viewBackground colorId.
+	    "
+	     a real color (i.e. one supported by the device) ?
+	    "
+	    id notNil ifTrue:[
+		device setWindowBackground:id in:drawableId.
+		^ self
+	    ].
+	    "
+	     no, a dithered one - must have a dither-pattern
+	     (which is ready for the device, since viewBackground
+	      is already assigned to the device)
+	    "
+	    bgPixmap := viewBackground ditherForm.
+	] ifFalse:[
+	    "
+	     assume, it can convert itself to a form
+	    "
+	    bgPixmap := viewBackground asFormOn:device
+	].
+
+	"
+	 must now have:
+	 a dithered color or bitmap or pixmap
+	"
+	bgPixmap isNil ifTrue:[
+	    'PSEUDOVIEW: background not convertable - ignored' errorPrintNL.
+	    ^ self
+	].
+
+	w := bgPixmap width.
+	h := bgPixmap height.
+
+	(bgPixmap depth ~~ device depth) ifTrue:[
+	    (bgPixmap depth ~~ 1) ifTrue:[
+		self error:'bad dither depth'.
+		^ self
+	    ].
+	    "
+	     convert it into a deep form
+	    "
+	    colors := bgPixmap colorMap.
+	    devBgPixmap := Form width:w height:h depth:(device depth) on:device.
+	    devBgPixmap paint:(colors at:1).
+	    devBgPixmap fillRectangleX:0 y:0 width:w height:h.
+	    devBgPixmap foreground:(colors at:2) background:(colors at:1).
+	    devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
+	    bgPixmap := devBgPixmap.
+	] ifFalse:[
+	    (bgPixmap depth == 1) ifTrue:[
+		"
+		 although depth matches,
+		 values in the dither are to be interpreted via the ditherForms
+		 colormap, which is not always the same as blackpixel/whitepixel ...
+		"
+		(bgPixmap colorMap at:1) colorId == device whitepixel ifTrue:[
+		    (bgPixmap colorMap at:2) colorId == device blackpixel ifTrue:[
+			"
+			 ok, can use it
+			"
+			device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
+			^ self
+		    ]
+		].
+
+		"
+		 no, must invert it
+		"
+		devBgPixmap := Form width:w height:h depth:(device depth) on:device.
+		devBgPixmap paint:(bgPixmap colorMap at:2) on:(bgPixmap colorMap at:1).
+		devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
+		bgPixmap := devBgPixmap.
+	    ]
+	].
+	device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
+    ]
+!
+
+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."
+
+    viewBackground ~~ something ifTrue:[
+	viewBackground := something.
+	drawableId notNil ifTrue:[
+	    self setViewBackground
+	]
+    ]
+!
+
+viewBackgroundAndClear:something
+    "set the viewBackground to something, a color, image or form.
+     and clear the View.
+     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:something.
+    self clear.
+
+    "Created: 27.4.1996 / 14:09:08 / cg"
+!
+
+viewGravity
+    "return the views gravity"
+
+    ^ #NorthWest
+!
+
+viewOrigin
+    "0@0 here, since by default we cannot be scrolled"
+
+    ^ 0 @ 0
+!
+
+widget
+    "ST-80 compatibility"
+
+    ^ self
+! !
+
+!DisplaySurface methodsFor:'accessing-cursor'!
+
+cursor
+    "return the views cursor"
+
+    ^ cursor
+!
+
+cursor:aCursor
+    "set the views cursor. This cursor will be automatically displayed whenever 
+     the mouse-pointer enters the receiver. 
+     Cursors are typically set at view creation time and left as installed."
+
+    self cursor:aCursor now:true
+
+    "
+     |v|
+
+     v := View new.
+     v cursor:(Cursor wait).
+     v open.
+     [v shown] whileFalse:[Processor yield].
+     [v shown] whileTrue:[   
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor normal).
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor wait).
+     ]
+    "
+
+    "Modified: 14.12.1995 / 21:28:14 / cg"
+!
+
+cursor:aCursor now:showImmediately
+    "set the views cursor. This cursor will be automatically displayed whenever 
+     the mouse-pointer enters the receiver. 
+     Cursors are typically set at view creation time and left as installed."
+
+    |id|
+
+    aCursor notNil ifTrue:[
+	(aCursor ~~ cursor) ifTrue:[
+	    cursor := aCursor.
+	    drawableId notNil ifTrue:[
+		cursor := cursor on:device.
+		cursor isNil ifTrue:[ ^ self].
+		id := cursor id.
+		id isNil ifTrue:[
+		    'PSEUDOVIEW: nil cursorId ignored; shape=' errorPrint. cursor shape errorPrintNL.
+		    ^ self
+		].
+		device setCursor:id in:drawableId.
+		(showImmediately and:[realized]) ifTrue:[
+		    "flush, to make cursor immediately visible"
+		    device flush
+		]
+	    ]
+	]
+    ]
+
+    "
+     |v|
+
+     v := View new.
+     v cursor:(Cursor wait).
+     v open.
+     [v shown] whileFalse:[Processor yield].
+     [v shown] whileTrue:[   
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor normal).
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor wait).
+     ]
+    "
+
+    "Created: 14.12.1995 / 21:28:00 / cg"
+!
+
+withCursor:aCursor do:aBlock
+    "evaluate aBlock showing aCursor until ready; then restore the old cursor
+     and return the value as returned by aBlock.
+
+     Notice, that this method only changes the cursor for a SINGLE (sub-)view.
+     Most applications want to have the cursor changed in all views of its
+     application. Use 'aView windowGroup withCursor:do:' to acomplish this."
+
+    |savedCursor|
+
+    savedCursor := cursor.
+    self cursor:aCursor.
+    ^ aBlock valueNowOrOnUnwindDo:[self cursor:savedCursor]
+!
+
+withExecuteCursorDo:aBlock
+    "evaluate aBlock while showing an execute cursor in all my views.
+     Return the value as returned by aBlock."
+
+    ^ self withCursor:(Cursor execute) do:aBlock
+
+    "Created: 10.1.1996 / 13:53:03 / cg"
+!
+
+withReadCursorDo:aBlock
+    "evaluate aBlock while showing a readCursor in all my views.
+     Return the value as returned by aBlock."
+
+    ^ self withCursor:(Cursor read) do:aBlock
+
+    "Modified: 14.12.1995 / 20:57:40 / cg"
+    "Created: 10.1.1996 / 13:52:52 / cg"
+!
+
+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
+
+    "Created: 10.1.1996 / 13:51:08 / cg"
+! !
+
+!DisplaySurface methodsFor:'accessing-hierarchy'!
+
+delegate
+    "return the delegate - thats the one getting keyboard and button events"
+
+    ^ delegate
+!
+
+delegate:someOne
+    "set the delegate - keyboard- and button events will be forwarded to
+     that object if it is interested in them.
+     See the sendEvent... method in WindowEvent."
+
+    delegate := someOne
+!
+
+superView
+    "return the superView - nil here"
+
+    ^ nil
+!
+
+topComponent
+    "return the topView - that the one with no superview"
+
+    ^ self
+
+    "Created: 9.5.1996 / 01:39:43 / cg"
+!
+
+topView
+    "return the topView - that the one with no superview"
+
+    ^ self
+! !
+
+!DisplaySurface 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
+! !
+
+!DisplaySurface 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
+!
+
+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
+    ]
+! !
+
+!DisplaySurface methodsFor:'accessing-names'!
+
+icon
+    "return the views icon - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+icon:aBitmap
+    "set the views icon - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+!
+
+iconLabel
+    "return the views icon label - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+iconLabel:aLabel
+    "set the views icon label - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+!
+
+iconView
+    "return the views iconView - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+iconView:aView
+    "set the views icon view - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+!
+
+label
+    "return the views label - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+label:aLabel
+    "set the views label - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+! !
+
+!DisplaySurface methodsFor:'binary storage'!
+
+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)"
+
+    super readBinaryContentsFrom: stream manager: manager.
+
+    gcId := nil.
+    drawableId := nil.
+    self recreate.
+    realized ifTrue:[
+        self map
+    ]
+
+    "
+     |s|
+     s := 'storedLabel.boss' asFilename writeStream binary.
+     (Label label:'hello there') realize storeBinaryOn:s.
+     s close.
+    "
+
+    "
+     |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.
+    "
+
+    "
+     |s|
+     s := 'storedLabel.boss' asFilename readStream binary.
+     (Object readBinaryFrom:s)
+    "
+
+    "Modified: 3.5.1996 / 23:59:38 / stefan"
+! !
+
+!DisplaySurface methodsFor:'button menus'!
+
+middleButtonMenu
+    "return the menu associated with the middle mouse button"
+
+    ^ middleButtonMenu
+!
+
+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
+! !
+
+!DisplaySurface methodsFor:'drawing'!
+
+clearDeviceRectangleX:x y:y width:w height:h
+    "clear a rectangular area to viewBackground -
+     redefined since GraphicsMedium fills with background
+     - not viewBackground as we want here."
+
+    |oldPaint org|
+
+    oldPaint := paint.
+    self paint:viewBackground.
+
+    viewBackground isColor ifFalse:[
+	gcId notNil ifTrue:[
+	    org := self viewOrigin.
+	    device setMaskOriginX:org x rounded negated
+				y:org y rounded negated
+			       in:gcId
+	].
+    ].
+    "
+     fill in device coordinates - not logical coordinates
+    "
+    self fillDeviceRectangleX:x y:y width:w height:h "with:viewBackground".
+    self paint:oldPaint
+!
+
+clearRectangleX:x y:y width:w height:h
+    "clear a rectangular area to viewBackground -
+     redefined since GraphicsMedium fills with background
+     - not viewBackground as we want here."
+
+    |oldPaint org|
+
+    oldPaint := paint.
+    self paint:viewBackground.
+
+    viewBackground isColor ifFalse:[
+	gcId notNil ifTrue:[
+	    org := self viewOrigin.
+	    device setMaskOriginX:org x rounded negated
+				y:org y rounded negated
+			       in:gcId
+	].
+    ].
+    self fillRectangleX:x y:y width:w height:h.
+    self paint:oldPaint
+!
+
+redraw
+    "nothing done here"
+
+    ^ self
+! !
+
+!DisplaySurface 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; disableEvent:#buttonRelease
+
+    "Modified: 29.4.1996 / 11:09:25 / cg"
+!
+
+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; disableEvent:#leave
+
+    "Modified: 29.4.1996 / 11:09:37 / cg"
+!
+
+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; enableEvent:#buttonRelease
+
+    "Modified: 29.4.1996 / 11:09:46 / cg"
+!
+
+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; enableEvent:#leave
+
+    "Modified: 29.4.1996 / 11:09:55 / cg"
+!
+
+enableEvent:anEventSymbol
+    "enable 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 bitOr:(device eventMaskFor:anEventSymbol).
+    drawableId notNil ifTrue:[
+	device setEventMask:eventMask in:drawableId
+    ]
+!
+
+enableFocusEvents
+    "enable keyboard focus change events"
+    
+    self enableEvent:#focusChange
+!
+
+enableKeyEvents
+    "this is a compatibility leftover - 
+     starting with 2.10.3, keyPress is always enabled to allow 
+     ^C processing."
+
+!
+
+enableKeyPressEvents
+    "this is a compatibility leftover - 
+     starting with 2.10.3, keyPress is always enabled to allow 
+     ^C processing."
+    
+!
+
+enableKeyReleaseEvents
+    "enable key release events"
+    
+    self enableEvent:#keyRelease
+!
+
+enableLeaveEvents
+    "enable mouse-pointer leave events"
+    
+    self enableEvent:#leave
+!
+
+enableMotionEvents
+    "enable mouse-pointer motion events"
+    
+    self enableEvent:#pointerMotion
+! !
+
+!DisplaySurface methodsFor:'event handling'!
+
+activateMenu
+    "if there is a menu, show it."
+
+    middleButtonMenu notNil ifTrue:[
+        middleButtonMenu showAtPointer
+    ]
+
+    "Created: 1.3.1996 / 13:24:55 / cg"
+!
+
+buttonMotion:state x:x y:y
+    "mouse was moved while button is pressed - do nothing here"
+
+    ^ self
+!
+
+buttonMultiPress:button x:x y:y
+    "button was pressed fast after previous press - default to press-again"
+
+    ^ 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:[
+        self activateMenu.
+    ]
+
+    "Modified: 1.3.1996 / 13:25:07 / cg"
+!
+
+buttonRelease:button x:x y:y
+    "button was released - do nothing here"
+
+    ^ self
+!
+
+buttonShiftPress:button x:x y:y
+    "button was pressed with shift - default to unshift-press action"
+
+    ^ self buttonPress:button x:x y:y
+!
+
+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.
+     Sometime after the bit-blt, waitForExpose should be sent, to finally
+     suspend until the expose/noExpose event arrives. 
+     This may be an X speciality and be reimplemented to handle devices
+     which do not need this kind of asynchronous bit-blt confirmation.
+    "
+
+    |wg|
+
+    gotExpose := false.
+    wg := self windowGroup.
+    wg notNil ifTrue:[
+	"
+	 must process eny pending expose events, since
+	 usually the origin is changed soon so that previous
+	 expose events coordinates are invalid 
+	"
+	wg processExposeEvents.
+	wg sensor catchExpose
+    ]
+!
+
+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 #buttonMotion with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonMotion:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonMotion:state x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:25 / cg"
+!
+
+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 buttonMultiPress with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonMultiPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonMultiPress:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:22 / cg"
+!
+
+deviceButtonPress: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 buttonPress with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonPress:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:18 / cg"
+!
+
+deviceButtonRelease: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 buttonRelease with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonRelease:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonRelease:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:14 / cg"
+!
+
+deviceButtonShiftPress: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 buttonShiftPress with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonShiftPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonShiftPress:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:09 / cg"
+!
+
+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.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #exposeX:x:y:width:height:"
+
+    |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
+
+    "Modified: 13.5.1996 / 11:31:44 / cg"
+!
+
+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.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #graphicExposeX:x:y:width:height:"
+
+    |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
+
+    "Modified: 13.5.1996 / 11:31:54 / cg"
+!
+
+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.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #keyPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ]
+    ].
+    self keyPress:key x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:44:59 / cg"
+!
+
+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 keyRelease with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #keyRelease:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ]
+    ].
+    self keyRelease:key x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:44:42 / cg"
+!
+
+devicePointerEnter: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 pointerEnter with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #pointerEnter:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ]
+    ].
+    self pointerEnter:state x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:44:54 / cg"
+!
+
+exposeX:x y:y width:w height:h
+    "an expose event - nothing done here"
+
+    ^ self
+!
+
+focusIn
+    "got keyboard focus - do nothing here"
+
+    ^ self
+!
+
+focusOut
+    "lost keyboard 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
+!
+
+keyPress:key x:x y:y
+    "a key was pressed in this view.
+     Here only keyCommands are handled - more action has to
+     be implemented by redefining this method"
+      
+    |action|
+
+    keyCommands notNil ifTrue:[
+        action := keyCommands at:key ifAbsent:[nil].
+        action notNil ifTrue:[
+            action value
+        ]
+    ].
+
+    "Modified: 4.3.1996 / 21:56:03 / cg"
+!
+
+keyRelease:key x:x y:y
+    "default action is to do nothing"
+    
+    ^ self
+!
+
+noExpose
+    "a no expose event after a scroll (event-mode only)"
+
+    exposePending := false.
+    gotExpose := true
+!
+
+pointerEnter:state x:x y:y
+    "mouse cursor entered view - do nothing here"
+
+    ^ self
+!
+
+pointerLeave:state
+    "mouse cursor left view - do nothing here"
+
+    ^ self
+!
+
+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
+	].
+    ]
+! !
+
+!DisplaySurface 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
+!
+
+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
+!
+
+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
+
+    "Created: 3.5.1996 / 15:35:13 / stefan"
+! !
+
+!DisplaySurface 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:[]
+    ]
+! !
+
+!DisplaySurface 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
+!
+
+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
+!
+
+redrawsFull
+    ^ false
+
+    "Created: 4.3.1996 / 14:17:22 / cg"
+! !
+
+!DisplaySurface 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
+!
+
+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
+! !
+
+!DisplaySurface methodsFor:'selection handling '!
+
+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
+!
+
+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"
+
+    "
+     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|
+
+    "
+     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
+!
+
+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
+    ]
+! !
+
+!DisplaySurface methodsFor:'user notifications'!
+
+beep
+    "output an audible beep or bell on my screen device"
+
+    device beep; flush
+
+    "Created: 28.5.1996 / 16:16:13 / cg"
+    "Modified: 28.5.1996 / 16:58:25 / cg"
+!
+
+showActivity:aMessage
+    "this is sent indirectly by the activityNotification mechanism.
+     Defined here as a fallback, if ever sent to non topviews."
+
+    Transcript showCR:aMessage
+
+    "Modified: 18.5.1996 / 15:44:33 / cg"
+! !
+
+!DisplaySurface class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libview/Attic/DSurface.st,v 1.1 1996-05-28 15:56:19 cg Exp $'
+! !

--- a/DevViewH.st	Tue May 28 17:13:25 1996 +0200
+++ b/DevViewH.st	Tue May 28 17:57:29 1996 +0200
@@ -42,7 +42,7 @@
     keeps the device handle for finalization.
 
     [see also:]
-        PseudoView
+        DisplaySurface
 
     [author:]
         Claus Gittinger
@@ -70,5 +70,5 @@
 !DeviceViewHandle class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Attic/DevViewH.st,v 1.7 1996-04-25 16:25:05 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Attic/DevViewH.st,v 1.8 1996-05-28 15:56:24 cg Exp $'
 ! !

--- a/DisplayRootView.st	Tue May 28 17:13:25 1996 +0200
+++ b/DisplayRootView.st	Tue May 28 17:57:29 1996 +0200
@@ -10,7 +10,7 @@
  hereby transferred.
 "
 
-PseudoView subclass:#DisplayRootView
+DisplaySurface subclass:#DisplayRootView
 	instanceVariableNames:''
 	classVariableNames:''
 	poolDictionaries:''
@@ -183,6 +183,6 @@
 !DisplayRootView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.16 1996-04-30 13:43:23 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/DisplayRootView.st,v 1.17 1996-05-28 15:56:18 cg Exp $'
 ! !
 DisplayRootView initialize!

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/DisplaySurface.st	Tue May 28 17:57:29 1996 +0200
@@ -0,0 +1,1691 @@
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+
+GraphicsMedium subclass:#DisplaySurface
+	instanceVariableNames:'viewBackground cursor eventMask middleButtonMenu keyCommands
+		gotExpose exposePending backed saveUnder delegate'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Graphics-Support'
+!
+
+!DisplaySurface class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1992 by Claus Gittinger
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+    this abstract class describes stuff common to any Window on a display 
+    device. i.e. RootWindow, TopWindows, PopUps and Subwindows.
+    That is, they have a viewBackground, cursor etc. and especially events.
+    A special feature is the delegate field, which allows key- and button 
+    events to be stolen from a view. 
+    If the delegate is non-nil, these events will be sent to it instead.
+    So you can change a views behavior even if it was not initially designed 
+    for it. Also, controller functionality could be simulated using delegates.
+
+    [instance variables:]
+
+        viewBackground  <Color|Form|Image>      the views background
+
+        cursor          <Cursor>                the cursor
+
+        eventMask                               mask specifying the enabled
+                                                events.
+
+        middleButtonMenu                        a popup menu for the middle
+                                                button.
+
+        keyCommands                             not yet supported
+
+        gotExpose                               for exposure handling after
+        exposePending                           after a scroll
+
+        backed                                  true if backing store for that
+                                                view is enabled
+
+        saveUnder                               true if saveunder store for 
+                                                that view is enabled
+
+        delegate                                for event delegation
+
+    [see also:]
+        DeviceWorkstation
+        WindowGroup
+        StandardSYstemView SimpleView View
+
+    [author:]
+        Claus Gittinger
+"
+! !
+
+!DisplaySurface methodsFor:'accessing'!
+
+depth
+    "return the depth in pixels of the view.
+     Notice, that this is currently the devices depth, 
+     but support for mixed depth views is being prepared.
+     (especially useful on SGI, with 24bit view)"
+
+    ^ device depth
+!
+
+insideColor:aColor
+    "set the views background color - ST-80 compatibility"
+
+    self viewBackground:aColor.
+    self background:aColor
+!
+
+setViewBackground
+    "install the viewBackground for the receiver on the device"
+
+    |id devBgPixmap bgPixmap w h colors|
+
+    drawableId notNil ifTrue:[
+	viewBackground isColor ifTrue:[
+	    viewBackground := viewBackground on:device.
+	    id := viewBackground colorId.
+	    "
+	     a real color (i.e. one supported by the device) ?
+	    "
+	    id notNil ifTrue:[
+		device setWindowBackground:id in:drawableId.
+		^ self
+	    ].
+	    "
+	     no, a dithered one - must have a dither-pattern
+	     (which is ready for the device, since viewBackground
+	      is already assigned to the device)
+	    "
+	    bgPixmap := viewBackground ditherForm.
+	] ifFalse:[
+	    "
+	     assume, it can convert itself to a form
+	    "
+	    bgPixmap := viewBackground asFormOn:device
+	].
+
+	"
+	 must now have:
+	 a dithered color or bitmap or pixmap
+	"
+	bgPixmap isNil ifTrue:[
+	    'PSEUDOVIEW: background not convertable - ignored' errorPrintNL.
+	    ^ self
+	].
+
+	w := bgPixmap width.
+	h := bgPixmap height.
+
+	(bgPixmap depth ~~ device depth) ifTrue:[
+	    (bgPixmap depth ~~ 1) ifTrue:[
+		self error:'bad dither depth'.
+		^ self
+	    ].
+	    "
+	     convert it into a deep form
+	    "
+	    colors := bgPixmap colorMap.
+	    devBgPixmap := Form width:w height:h depth:(device depth) on:device.
+	    devBgPixmap paint:(colors at:1).
+	    devBgPixmap fillRectangleX:0 y:0 width:w height:h.
+	    devBgPixmap foreground:(colors at:2) background:(colors at:1).
+	    devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
+	    bgPixmap := devBgPixmap.
+	] ifFalse:[
+	    (bgPixmap depth == 1) ifTrue:[
+		"
+		 although depth matches,
+		 values in the dither are to be interpreted via the ditherForms
+		 colormap, which is not always the same as blackpixel/whitepixel ...
+		"
+		(bgPixmap colorMap at:1) colorId == device whitepixel ifTrue:[
+		    (bgPixmap colorMap at:2) colorId == device blackpixel ifTrue:[
+			"
+			 ok, can use it
+			"
+			device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
+			^ self
+		    ]
+		].
+
+		"
+		 no, must invert it
+		"
+		devBgPixmap := Form width:w height:h depth:(device depth) on:device.
+		devBgPixmap paint:(bgPixmap colorMap at:2) on:(bgPixmap colorMap at:1).
+		devBgPixmap copyPlaneFrom:bgPixmap x:0 y:0 toX:0 y:0 width:w height:h.
+		bgPixmap := devBgPixmap.
+	    ]
+	].
+	device setWindowBackgroundPixmap:(bgPixmap id) in:drawableId.
+    ]
+!
+
+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."
+
+    viewBackground ~~ something ifTrue:[
+	viewBackground := something.
+	drawableId notNil ifTrue:[
+	    self setViewBackground
+	]
+    ]
+!
+
+viewBackgroundAndClear:something
+    "set the viewBackground to something, a color, image or form.
+     and clear the View.
+     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:something.
+    self clear.
+
+    "Created: 27.4.1996 / 14:09:08 / cg"
+!
+
+viewGravity
+    "return the views gravity"
+
+    ^ #NorthWest
+!
+
+viewOrigin
+    "0@0 here, since by default we cannot be scrolled"
+
+    ^ 0 @ 0
+!
+
+widget
+    "ST-80 compatibility"
+
+    ^ self
+! !
+
+!DisplaySurface methodsFor:'accessing-cursor'!
+
+cursor
+    "return the views cursor"
+
+    ^ cursor
+!
+
+cursor:aCursor
+    "set the views cursor. This cursor will be automatically displayed whenever 
+     the mouse-pointer enters the receiver. 
+     Cursors are typically set at view creation time and left as installed."
+
+    self cursor:aCursor now:true
+
+    "
+     |v|
+
+     v := View new.
+     v cursor:(Cursor wait).
+     v open.
+     [v shown] whileFalse:[Processor yield].
+     [v shown] whileTrue:[   
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor normal).
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor wait).
+     ]
+    "
+
+    "Modified: 14.12.1995 / 21:28:14 / cg"
+!
+
+cursor:aCursor now:showImmediately
+    "set the views cursor. This cursor will be automatically displayed whenever 
+     the mouse-pointer enters the receiver. 
+     Cursors are typically set at view creation time and left as installed."
+
+    |id|
+
+    aCursor notNil ifTrue:[
+	(aCursor ~~ cursor) ifTrue:[
+	    cursor := aCursor.
+	    drawableId notNil ifTrue:[
+		cursor := cursor on:device.
+		cursor isNil ifTrue:[ ^ self].
+		id := cursor id.
+		id isNil ifTrue:[
+		    'PSEUDOVIEW: nil cursorId ignored; shape=' errorPrint. cursor shape errorPrintNL.
+		    ^ self
+		].
+		device setCursor:id in:drawableId.
+		(showImmediately and:[realized]) ifTrue:[
+		    "flush, to make cursor immediately visible"
+		    device flush
+		]
+	    ]
+	]
+    ]
+
+    "
+     |v|
+
+     v := View new.
+     v cursor:(Cursor wait).
+     v open.
+     [v shown] whileFalse:[Processor yield].
+     [v shown] whileTrue:[   
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor normal).
+	(Delay forSeconds:1) wait.
+	v cursor:(Cursor wait).
+     ]
+    "
+
+    "Created: 14.12.1995 / 21:28:00 / cg"
+!
+
+withCursor:aCursor do:aBlock
+    "evaluate aBlock showing aCursor until ready; then restore the old cursor
+     and return the value as returned by aBlock.
+
+     Notice, that this method only changes the cursor for a SINGLE (sub-)view.
+     Most applications want to have the cursor changed in all views of its
+     application. Use 'aView windowGroup withCursor:do:' to acomplish this."
+
+    |savedCursor|
+
+    savedCursor := cursor.
+    self cursor:aCursor.
+    ^ aBlock valueNowOrOnUnwindDo:[self cursor:savedCursor]
+!
+
+withExecuteCursorDo:aBlock
+    "evaluate aBlock while showing an execute cursor in all my views.
+     Return the value as returned by aBlock."
+
+    ^ self withCursor:(Cursor execute) do:aBlock
+
+    "Created: 10.1.1996 / 13:53:03 / cg"
+!
+
+withReadCursorDo:aBlock
+    "evaluate aBlock while showing a readCursor in all my views.
+     Return the value as returned by aBlock."
+
+    ^ self withCursor:(Cursor read) do:aBlock
+
+    "Modified: 14.12.1995 / 20:57:40 / cg"
+    "Created: 10.1.1996 / 13:52:52 / cg"
+!
+
+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
+
+    "Created: 10.1.1996 / 13:51:08 / cg"
+! !
+
+!DisplaySurface methodsFor:'accessing-hierarchy'!
+
+delegate
+    "return the delegate - thats the one getting keyboard and button events"
+
+    ^ delegate
+!
+
+delegate:someOne
+    "set the delegate - keyboard- and button events will be forwarded to
+     that object if it is interested in them.
+     See the sendEvent... method in WindowEvent."
+
+    delegate := someOne
+!
+
+superView
+    "return the superView - nil here"
+
+    ^ nil
+!
+
+topComponent
+    "return the topView - that the one with no superview"
+
+    ^ self
+
+    "Created: 9.5.1996 / 01:39:43 / cg"
+!
+
+topView
+    "return the topView - that the one with no superview"
+
+    ^ self
+! !
+
+!DisplaySurface 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
+! !
+
+!DisplaySurface 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
+!
+
+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
+    ]
+! !
+
+!DisplaySurface methodsFor:'accessing-names'!
+
+icon
+    "return the views icon - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+icon:aBitmap
+    "set the views icon - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+!
+
+iconLabel
+    "return the views icon label - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+iconLabel:aLabel
+    "set the views icon label - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+!
+
+iconView
+    "return the views iconView - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+iconView:aView
+    "set the views icon view - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+!
+
+label
+    "return the views label - this is nil here.
+     Only standardSystemViews support labels and icons."
+
+    ^ nil
+!
+
+label:aLabel
+    "set the views label - ignored here.
+     Only standardSystemViews support labels and icons."
+
+    ^ self
+! !
+
+!DisplaySurface methodsFor:'binary storage'!
+
+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)"
+
+    super readBinaryContentsFrom: stream manager: manager.
+
+    gcId := nil.
+    drawableId := nil.
+    self recreate.
+    realized ifTrue:[
+        self map
+    ]
+
+    "
+     |s|
+     s := 'storedLabel.boss' asFilename writeStream binary.
+     (Label label:'hello there') realize storeBinaryOn:s.
+     s close.
+    "
+
+    "
+     |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.
+    "
+
+    "
+     |s|
+     s := 'storedLabel.boss' asFilename readStream binary.
+     (Object readBinaryFrom:s)
+    "
+
+    "Modified: 3.5.1996 / 23:59:38 / stefan"
+! !
+
+!DisplaySurface methodsFor:'button menus'!
+
+middleButtonMenu
+    "return the menu associated with the middle mouse button"
+
+    ^ middleButtonMenu
+!
+
+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
+! !
+
+!DisplaySurface methodsFor:'drawing'!
+
+clearDeviceRectangleX:x y:y width:w height:h
+    "clear a rectangular area to viewBackground -
+     redefined since GraphicsMedium fills with background
+     - not viewBackground as we want here."
+
+    |oldPaint org|
+
+    oldPaint := paint.
+    self paint:viewBackground.
+
+    viewBackground isColor ifFalse:[
+	gcId notNil ifTrue:[
+	    org := self viewOrigin.
+	    device setMaskOriginX:org x rounded negated
+				y:org y rounded negated
+			       in:gcId
+	].
+    ].
+    "
+     fill in device coordinates - not logical coordinates
+    "
+    self fillDeviceRectangleX:x y:y width:w height:h "with:viewBackground".
+    self paint:oldPaint
+!
+
+clearRectangleX:x y:y width:w height:h
+    "clear a rectangular area to viewBackground -
+     redefined since GraphicsMedium fills with background
+     - not viewBackground as we want here."
+
+    |oldPaint org|
+
+    oldPaint := paint.
+    self paint:viewBackground.
+
+    viewBackground isColor ifFalse:[
+	gcId notNil ifTrue:[
+	    org := self viewOrigin.
+	    device setMaskOriginX:org x rounded negated
+				y:org y rounded negated
+			       in:gcId
+	].
+    ].
+    self fillRectangleX:x y:y width:w height:h.
+    self paint:oldPaint
+!
+
+redraw
+    "nothing done here"
+
+    ^ self
+! !
+
+!DisplaySurface 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; disableEvent:#buttonRelease
+
+    "Modified: 29.4.1996 / 11:09:25 / cg"
+!
+
+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; disableEvent:#leave
+
+    "Modified: 29.4.1996 / 11:09:37 / cg"
+!
+
+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; enableEvent:#buttonRelease
+
+    "Modified: 29.4.1996 / 11:09:46 / cg"
+!
+
+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; enableEvent:#leave
+
+    "Modified: 29.4.1996 / 11:09:55 / cg"
+!
+
+enableEvent:anEventSymbol
+    "enable 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 bitOr:(device eventMaskFor:anEventSymbol).
+    drawableId notNil ifTrue:[
+	device setEventMask:eventMask in:drawableId
+    ]
+!
+
+enableFocusEvents
+    "enable keyboard focus change events"
+    
+    self enableEvent:#focusChange
+!
+
+enableKeyEvents
+    "this is a compatibility leftover - 
+     starting with 2.10.3, keyPress is always enabled to allow 
+     ^C processing."
+
+!
+
+enableKeyPressEvents
+    "this is a compatibility leftover - 
+     starting with 2.10.3, keyPress is always enabled to allow 
+     ^C processing."
+    
+!
+
+enableKeyReleaseEvents
+    "enable key release events"
+    
+    self enableEvent:#keyRelease
+!
+
+enableLeaveEvents
+    "enable mouse-pointer leave events"
+    
+    self enableEvent:#leave
+!
+
+enableMotionEvents
+    "enable mouse-pointer motion events"
+    
+    self enableEvent:#pointerMotion
+! !
+
+!DisplaySurface methodsFor:'event handling'!
+
+activateMenu
+    "if there is a menu, show it."
+
+    middleButtonMenu notNil ifTrue:[
+        middleButtonMenu showAtPointer
+    ]
+
+    "Created: 1.3.1996 / 13:24:55 / cg"
+!
+
+buttonMotion:state x:x y:y
+    "mouse was moved while button is pressed - do nothing here"
+
+    ^ self
+!
+
+buttonMultiPress:button x:x y:y
+    "button was pressed fast after previous press - default to press-again"
+
+    ^ 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:[
+        self activateMenu.
+    ]
+
+    "Modified: 1.3.1996 / 13:25:07 / cg"
+!
+
+buttonRelease:button x:x y:y
+    "button was released - do nothing here"
+
+    ^ self
+!
+
+buttonShiftPress:button x:x y:y
+    "button was pressed with shift - default to unshift-press action"
+
+    ^ self buttonPress:button x:x y:y
+!
+
+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.
+     Sometime after the bit-blt, waitForExpose should be sent, to finally
+     suspend until the expose/noExpose event arrives. 
+     This may be an X speciality and be reimplemented to handle devices
+     which do not need this kind of asynchronous bit-blt confirmation.
+    "
+
+    |wg|
+
+    gotExpose := false.
+    wg := self windowGroup.
+    wg notNil ifTrue:[
+	"
+	 must process eny pending expose events, since
+	 usually the origin is changed soon so that previous
+	 expose events coordinates are invalid 
+	"
+	wg processExposeEvents.
+	wg sensor catchExpose
+    ]
+!
+
+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 #buttonMotion with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonMotion:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonMotion:state x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:25 / cg"
+!
+
+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 buttonMultiPress with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonMultiPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonMultiPress:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:22 / cg"
+!
+
+deviceButtonPress: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 buttonPress with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonPress:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:18 / cg"
+!
+
+deviceButtonRelease: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 buttonRelease with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonRelease:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonRelease:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:14 / cg"
+!
+
+deviceButtonShiftPress: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 buttonShiftPress with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #buttonShiftPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ].
+    ].
+    self buttonShiftPress:butt x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:45:09 / cg"
+!
+
+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.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #exposeX:x:y:width:height:"
+
+    |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
+
+    "Modified: 13.5.1996 / 11:31:44 / cg"
+!
+
+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.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #graphicExposeX:x:y:width:height:"
+
+    |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
+
+    "Modified: 13.5.1996 / 11:31:54 / cg"
+!
+
+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.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #keyPress:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ]
+    ].
+    self keyPress:key x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:44:59 / cg"
+!
+
+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 keyRelease with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #keyRelease:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ]
+    ].
+    self keyRelease:key x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:44:42 / cg"
+!
+
+devicePointerEnter: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 pointerEnter with the logical coordinates.
+
+     Views which are interrested in deviceCoordinates should
+     redefine this method - 
+     those which are interrested in logical coordinates
+     should redefine #pointerEnter:x:y:"
+
+    |lx ly|
+
+    lx := x.
+    ly := y.
+    transformation notNil ifTrue:[
+        lx notNil ifTrue:[
+            lx := transformation applyInverseToX:lx.
+            ly := transformation applyInverseToY:ly.
+        ]
+    ].
+    self pointerEnter:state x:lx y:ly
+
+    "Modified: 20.5.1996 / 17:44:54 / cg"
+!
+
+exposeX:x y:y width:w height:h
+    "an expose event - nothing done here"
+
+    ^ self
+!
+
+focusIn
+    "got keyboard focus - do nothing here"
+
+    ^ self
+!
+
+focusOut
+    "lost keyboard 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
+!
+
+keyPress:key x:x y:y
+    "a key was pressed in this view.
+     Here only keyCommands are handled - more action has to
+     be implemented by redefining this method"
+      
+    |action|
+
+    keyCommands notNil ifTrue:[
+        action := keyCommands at:key ifAbsent:[nil].
+        action notNil ifTrue:[
+            action value
+        ]
+    ].
+
+    "Modified: 4.3.1996 / 21:56:03 / cg"
+!
+
+keyRelease:key x:x y:y
+    "default action is to do nothing"
+    
+    ^ self
+!
+
+noExpose
+    "a no expose event after a scroll (event-mode only)"
+
+    exposePending := false.
+    gotExpose := true
+!
+
+pointerEnter:state x:x y:y
+    "mouse cursor entered view - do nothing here"
+
+    ^ self
+!
+
+pointerLeave:state
+    "mouse cursor left view - do nothing here"
+
+    ^ self
+!
+
+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
+	].
+    ]
+! !
+
+!DisplaySurface 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
+!
+
+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
+!
+
+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
+
+    "Created: 3.5.1996 / 15:35:13 / stefan"
+! !
+
+!DisplaySurface 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:[]
+    ]
+! !
+
+!DisplaySurface 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
+!
+
+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
+!
+
+redrawsFull
+    ^ false
+
+    "Created: 4.3.1996 / 14:17:22 / cg"
+! !
+
+!DisplaySurface 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
+!
+
+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
+! !
+
+!DisplaySurface methodsFor:'selection handling '!
+
+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
+!
+
+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"
+
+    "
+     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|
+
+    "
+     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
+!
+
+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
+    ]
+! !
+
+!DisplaySurface methodsFor:'user notifications'!
+
+beep
+    "output an audible beep or bell on my screen device"
+
+    device beep; flush
+
+    "Created: 28.5.1996 / 16:16:13 / cg"
+    "Modified: 28.5.1996 / 16:58:25 / cg"
+!
+
+showActivity:aMessage
+    "this is sent indirectly by the activityNotification mechanism.
+     Defined here as a fallback, if ever sent to non topviews."
+
+    Transcript showCR:aMessage
+
+    "Modified: 18.5.1996 / 15:44:33 / cg"
+! !
+
+!DisplaySurface class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libview/DisplaySurface.st,v 1.1 1996-05-28 15:56:19 cg Exp $'
+! !

--- a/GC.st	Tue May 28 17:13:25 1996 +0200
+++ b/GC.st	Tue May 28 17:57:29 1996 +0200
@@ -11,7 +11,7 @@
 "
 
 Object subclass:#GraphicsContext
-	instanceVariableNames:'medium paint bgPaint function font lineStyle lineWidth joinStyle
+	instanceVariableNames:'device paint bgPaint function font lineStyle lineWidth joinStyle
 		capStyle mask maskOrigin transformation clipRect'
 	classVariableNames:'White Black DefaultFont'
 	poolDictionaries:''
@@ -628,6 +628,12 @@
     ^ self subclassResponsibility
 !
 
+graphicsDevice
+    "same as #device, for ST-80 compatibility"
+
+    ^ device
+!
+
 graphicsContext
     "for ST-80 compatibility"
 
@@ -726,7 +732,7 @@
      this is now being migrated and things are separated.
      In the meanwhile, those old views have themself as the medium."
 
-    ^ medium
+    ^ device
 
     "Modified: 28.5.1996 / 14:26:03 / cg"
 !
@@ -1459,6 +1465,6 @@
 !GraphicsContext class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.39 1996-05-28 15:13:25 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Attic/GC.st,v 1.40 1996-05-28 15:56:28 cg Exp $'
 ! !
 GraphicsContext initialize!

--- a/GMedium.st	Tue May 28 17:13:25 1996 +0200
+++ b/GMedium.st	Tue May 28 17:57:29 1996 +0200
@@ -10,8 +10,8 @@
  hereby transferred.
 "
 
-DeviceDrawable subclass:#GraphicsMedium
-	instanceVariableNames:'width height'
+DeviceGraphicsContext subclass:#GraphicsMedium
+	instanceVariableNames:'width height realized'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Graphics-Support'
@@ -160,6 +160,12 @@
     ^ 0 @ 0
 !
 
+realized
+    "return true, if the receiver is realized"
+
+    ^ realized
+!
+
 rightCenter
     "return the leftCenter point"
 
@@ -210,6 +216,15 @@
     height := h
 ! !
 
+!GraphicsMedium methodsFor:'copying'!
+
+postCopy
+    "this may not be enough to allow copying of views ..."
+
+    super postCopy.
+    realized := false.
+! !
+
 !GraphicsMedium methodsFor:'evaluating in another context'!
 
 clippedTo:aRectangle do:aBlock
@@ -418,11 +433,20 @@
     super initialize.
 
     width := 0.
-    height := 0
+    height := 0.
+    realized := false.
+!
+
+setRealized:aBoolean
+    "low level special interface to manipulate the realized state.
+     Non-public interface, only to be used by experts.
+     (use to pretend a view has been realized - for example with alien views)"
+
+    realized := aBoolean
 ! !
 
 !GraphicsMedium class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Attic/GMedium.st,v 1.1 1996-05-28 14:36:26 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Attic/GMedium.st,v 1.2 1996-05-28 15:56:34 cg Exp $'
 ! !

--- a/GraphicsContext.st	Tue May 28 17:13:25 1996 +0200
+++ b/GraphicsContext.st	Tue May 28 17:57:29 1996 +0200
@@ -11,7 +11,7 @@
 "
 
 Object subclass:#GraphicsContext
-	instanceVariableNames:'medium paint bgPaint function font lineStyle lineWidth joinStyle
+	instanceVariableNames:'device paint bgPaint function font lineStyle lineWidth joinStyle
 		capStyle mask maskOrigin transformation clipRect'
 	classVariableNames:'White Black DefaultFont'
 	poolDictionaries:''
@@ -628,6 +628,12 @@
     ^ self subclassResponsibility
 !
 
+graphicsDevice
+    "same as #device, for ST-80 compatibility"
+
+    ^ device
+!
+
 graphicsContext
     "for ST-80 compatibility"
 
@@ -726,7 +732,7 @@
      this is now being migrated and things are separated.
      In the meanwhile, those old views have themself as the medium."
 
-    ^ medium
+    ^ device
 
     "Modified: 28.5.1996 / 14:26:03 / cg"
 !
@@ -1459,6 +1465,6 @@
 !GraphicsContext class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.39 1996-05-28 15:13:25 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/GraphicsContext.st,v 1.40 1996-05-28 15:56:28 cg Exp $'
 ! !
 GraphicsContext initialize!

--- a/GraphicsMedium.st	Tue May 28 17:13:25 1996 +0200
+++ b/GraphicsMedium.st	Tue May 28 17:57:29 1996 +0200
@@ -10,8 +10,8 @@
  hereby transferred.
 "
 
-DeviceDrawable subclass:#GraphicsMedium
-	instanceVariableNames:'width height'
+DeviceGraphicsContext subclass:#GraphicsMedium
+	instanceVariableNames:'width height realized'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Graphics-Support'
@@ -160,6 +160,12 @@
     ^ 0 @ 0
 !
 
+realized
+    "return true, if the receiver is realized"
+
+    ^ realized
+!
+
 rightCenter
     "return the leftCenter point"
 
@@ -210,6 +216,15 @@
     height := h
 ! !
 
+!GraphicsMedium methodsFor:'copying'!
+
+postCopy
+    "this may not be enough to allow copying of views ..."
+
+    super postCopy.
+    realized := false.
+! !
+
 !GraphicsMedium methodsFor:'evaluating in another context'!
 
 clippedTo:aRectangle do:aBlock
@@ -418,11 +433,20 @@
     super initialize.
 
     width := 0.
-    height := 0
+    height := 0.
+    realized := false.
+!
+
+setRealized:aBoolean
+    "low level special interface to manipulate the realized state.
+     Non-public interface, only to be used by experts.
+     (use to pretend a view has been realized - for example with alien views)"
+
+    realized := aBoolean
 ! !
 
 !GraphicsMedium class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/GraphicsMedium.st,v 1.1 1996-05-28 14:36:26 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/GraphicsMedium.st,v 1.2 1996-05-28 15:56:34 cg Exp $'
 ! !

--- a/Make.proto	Tue May 28 17:13:25 1996 +0200
+++ b/Make.proto	Tue May 28 17:57:29 1996 +0200
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libview/Make.proto,v 1.69 1996-05-28 14:36:09 cg Exp $
+# $Header: /cvs/stx/stx/libview/Make.proto,v 1.70 1996-05-28 15:56:37 cg Exp $
 #
 # -------------- no need to change anything below ----------
 
@@ -85,10 +85,10 @@
 	      DevViewH.$(O)                     \
 	      DevFormH.$(O)                     \
 	    GC.$(O)                             \
-	      DevDraw.$(O)                      \
+	      DevGC.$(O)                      \
 	      GMedium.$(O)                      \
 		  Form.$(O)                     \
-		  PseudoV.$(O)                  \
+		  DSurface.$(O)                  \
 		    SimpleView.$(O)             \
 		      View.$(O)                 \
 			TopView.$(O)            \
@@ -199,7 +199,7 @@
 
 HPbigFiles:
 	$(MAKE) $(BIG_STFILE_RULE) BIG_FILE=Color CC=$(CC) OPT="$(OPT)"
-	$(MAKE) $(BIG_STFILE_RULE) BIG_FILE=DevDraw CC=$(CC) OPT="$(OPT)"
+	$(MAKE) $(BIG_STFILE_RULE) BIG_FILE=DevGC CC=$(CC) OPT="$(OPT)"
 
 #
 # install the extra objects
@@ -216,7 +216,7 @@
 
 # BEGINMAKEDEPEND --- do not remove this line; make depend needs it 
 ActiveHelp.o: ActiveHelp.st $(STCHDR) ../include/EventListener.H ../include/Object.H
-ActiveHelpView.o: ActiveHelpView.st $(STCHDR) ../include/View.H ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+ActiveHelpView.o: ActiveHelpView.st $(STCHDR) ../include/View.H ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 AlignOrg.o: AlignOrg.st $(STCHDR) ../include/LayoutOrg.H ../include/Layout.H ../include/Object.H
 AppControl.o: AppControl.st $(STCHDR)
 AppModel.o: AppModel.st $(STCHDR) ../include/Model.H ../include/Object.H
@@ -230,14 +230,15 @@
 ConvValue.o: ConvValue.st $(STCHDR) ../include/ValHolder.H ../include/ValModel.H ../include/Model.H ../include/Object.H
 Cursor.o: Cursor.st $(STCHDR) ../include/Object.H
 DObject.o: DObject.st $(STCHDR) ../include/Object.H
-DRootView.o: DRootView.st $(STCHDR) ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+DRootView.o: DRootView.st $(STCHDR) ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+DSurface.o: DSurface.st $(STCHDR) ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 Depth1Image.o: Depth1Image.st $(STCHDR) ../include/Image.H ../include/Object.H
 Depth24Image.o: Depth24Image.st $(STCHDR) ../include/Image.H ../include/Object.H
 Depth2Image.o: Depth2Image.st $(STCHDR) ../include/Image.H ../include/Object.H
 Depth4Image.o: Depth4Image.st $(STCHDR) ../include/Image.H ../include/Object.H
 Depth8Image.o: Depth8Image.st $(STCHDR) ../include/Image.H ../include/Object.H
 Depth16Image.o: Depth16Image.st $(STCHDR) ../include/Image.H ../include/Object.H
-DevDraw.o: DevDraw.st $(STCHDR) ../include/Object.H
+DevGC.o: DevGC.st $(STCHDR) ../include/Object.H
 DevFormH.o: DevFormH.st $(STCHDR) ../include/DevHandle.H ../include/Object.H
 DevHandle.o: DevHandle.st $(STCHDR) ../include/Object.H
 DevViewH.o: DevViewH.st $(STCHDR) ../include/DevHandle.H ../include/Object.H
@@ -246,7 +247,7 @@
 FaceReader.o: FaceReader.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 Font.o: Font.st $(STCHDR) ../include/FontDescr.H ../include/Object.H
 FontDescr.o: FontDescr.st $(STCHDR) ../include/Object.H
-Form.o: Form.st $(STCHDR) ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+Form.o: Form.st $(STCHDR) ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 GC.o: GC.st $(STCHDR) ../include/Object.H
 GIFReader.o: GIFReader.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 GLXWorkstat.o: GLXWorkstat.st $(STCHDR) ../include/XWorkstat.H ../include/DevWorkst.H ../include/Object.H
@@ -255,14 +256,14 @@
 HersheyFont.o: HersheyFont.st $(STCHDR) ../include/Font.H ../include/FontDescr.H ../include/Object.H
 Image.o: Image.st $(STCHDR) ../include/Object.H
 ImageRdr.o: ImageRdr.st $(STCHDR) ../include/Object.H
-InputView.o: InputView.st $(STCHDR) ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+InputView.o: InputView.st $(STCHDR) ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 JPEGReader.o: JPEGReader.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 KeybdFwd.o: KeybdFwd.st $(STCHDR) ../include/Object.H
 KeybdMap.o: KeybdMap.st $(STCHDR) ../include/IdDict.H ../include/Dict.H ../include/Set.H ../include/Coll.H ../include/Object.H
 Layout.o: Layout.st $(STCHDR) ../include/Object.H
 LayoutFrm.o: LayoutFrm.st $(STCHDR) ../include/LayoutOrg.H ../include/Layout.H ../include/Object.H
 LayoutOrg.o: LayoutOrg.st $(STCHDR) ../include/Layout.H ../include/Object.H
-ModalBox.o: ModalBox.st $(STCHDR) ../include/StdSysV.H ../include/TopView.H ../include/View.H ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+ModalBox.o: ModalBox.st $(STCHDR) ../include/StdSysV.H ../include/TopView.H ../include/View.H ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 Model.o: Model.st $(STCHDR) ../include/Object.H
 NXWorkst.o: NXWorkst.st $(STCHDR) ../include/DevWorkst.H ../include/Object.H
 NewGC.o: NewGC.st $(STCHDR) ../include/Object.H
@@ -270,26 +271,25 @@
 PCXReader.o: PCXReader.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 Plug.o: Plug.st $(STCHDR) ../include/Model.H ../include/Object.H
 PlugAdptr.o: PlugAdptr.st $(STCHDR) ../include/ValModel.H ../include/Model.H ../include/Object.H
-PopUpView.o: PopUpView.st $(STCHDR) ../include/TopView.H ../include/View.H ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+PopUpView.o: PopUpView.st $(STCHDR) ../include/TopView.H ../include/View.H ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 PrintConv.o: PrintConv.st $(STCHDR) ../include/Object.H
 ProtAdptr.o: ProtAdptr.st $(STCHDR) ../include/ValModel.H ../include/Model.H ../include/Object.H
-PseudoV.o: PseudoV.st $(STCHDR) ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 RsrcPack.o: RsrcPack.st $(STCHDR) ../include/Dict.H ../include/Set.H ../include/Coll.H ../include/Object.H
 STFormRdr.o: STFormRdr.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 SWSensor.$(O): SWSensor.st $(STCHDR) ../include/Object.H
-ShadowV.o: ShadowV.st $(STCHDR) ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
-SimpleView.o: SimpleView.st $(STCHDR) ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+ShadowV.o: ShadowV.st $(STCHDR) ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+SimpleView.o: SimpleView.st $(STCHDR) ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 StdSysC.o: StdSysC.st $(STCHDR) ../include/Controll.H ../include/Object.H
-StdSysV.o: StdSysV.st $(STCHDR) ../include/TopView.H ../include/View.H ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+StdSysV.o: StdSysV.st $(STCHDR) ../include/TopView.H ../include/View.H ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 SunReader.o: SunReader.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 TIFFRdr.o: TIFFRdr.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
 TargaReader.o: TargaReader.st $(STCHDR) ../include/ImageRdr.H ../include/Object.H
-TopView.o: TopView.st $(STCHDR) ../include/View.H ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+TopView.o: TopView.st $(STCHDR) ../include/View.H ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 TriggerVal.o: TriggerVal.st $(STCHDR) ../include/ValHolder.H ../include/ValModel.H ../include/Model.H ../include/Object.H
 UIBuilder.o: UIBuilder.st $(STCHDR) ../include/WinBuilder.H ../include/Object.H
 ValHolder.o: ValHolder.st $(STCHDR) ../include/ValModel.H ../include/Model.H ../include/Object.H
 ValModel.o: ValModel.st $(STCHDR) ../include/Model.H ../include/Object.H
-View.o: View.st $(STCHDR) ../include/SimpleView.H ../include/PseudoV.H ../include/DevDraw.H ../include/GMedium.H ../include/GC.H ../include/Object.H
+View.o: View.st $(STCHDR) ../include/SimpleView.H ../include/DSurface.H ../include/DevGC.H ../include/GMedium.H ../include/GC.H ../include/Object.H
 ViewStyle.o: ViewStyle.st $(STCHDR) ../include/RsrcPack.H ../include/Dict.H ../include/Set.H ../include/Coll.H ../include/Object.H
 WEvent.o: WEvent.st $(STCHDR) ../include/Object.H
 WGroup.o: WGroup.st $(STCHDR) ../include/Object.H

--- a/SimpleView.st	Tue May 28 17:13:25 1996 +0200
+++ b/SimpleView.st	Tue May 28 17:57:29 1996 +0200
@@ -10,7 +10,7 @@
  hereby transferred.
 "
 
-PseudoView subclass:#SimpleView
+DisplaySurface subclass:#SimpleView
 	instanceVariableNames:'superView subViews components styleSheet resources borderColor
 		borderWidth borderShape viewShape top left extentChanged
 		originChanged cornerChanged relativeOrigin relativeExtent
@@ -27,16 +27,6 @@
 !
 
 SimpleView class instanceVariableNames:'ClassResources DefaultFont'
-
-"
- The following class instance variables are inherited by this class:
-
-	PseudoView - 
-	DeviceDrawable - 
-	DisplayMedium - 
-	GraphicsContext - 
-	Object - 
-"
 !
 
 !SimpleView class methodsFor:'documentation'!
@@ -6110,6 +6100,6 @@
 !SimpleView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.97 1996-05-28 14:57:53 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.98 1996-05-28 15:57:03 cg Exp $'
 ! !
 SimpleView initialize!

--- a/WEvent.st	Tue May 28 17:13:25 1996 +0200
+++ b/WEvent.st	Tue May 28 17:57:29 1996 +0200
@@ -336,7 +336,7 @@
      from #foo to #deviceFoo...
      This allows the view to handle the event either in device or
      logical coordinates. (since the deviceFoo-messages default implementation
-     in PseudoView translates and resends).
+     in DisplaySurface translates and resends).
      Actually, I could always send deviceXXX without speed penalty
      (event sending is no high frequency operation), but that just adds 
      another context to any debuggers walkback, making things less clear.
@@ -508,5 +508,5 @@
 !WindowEvent class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.27 1996-04-25 16:32:56 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/Attic/WEvent.st,v 1.28 1996-05-28 15:57:29 cg Exp $'
 ! !

--- a/WindowEvent.st	Tue May 28 17:13:25 1996 +0200
+++ b/WindowEvent.st	Tue May 28 17:57:29 1996 +0200
@@ -336,7 +336,7 @@
      from #foo to #deviceFoo...
      This allows the view to handle the event either in device or
      logical coordinates. (since the deviceFoo-messages default implementation
-     in PseudoView translates and resends).
+     in DisplaySurface translates and resends).
      Actually, I could always send deviceXXX without speed penalty
      (event sending is no high frequency operation), but that just adds 
      another context to any debuggers walkback, making things less clear.
@@ -508,5 +508,5 @@
 !WindowEvent class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.27 1996-04-25 16:32:56 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libview/WindowEvent.st,v 1.28 1996-05-28 15:57:29 cg Exp $'
 ! !

author	Claus Gittinger <cg@exept.de>
	Tue, 28 May 1996 17:57:29 +0200
changeset 727	bf23a306b6f2
parent 726	5400de25657e
child 728	04d0a262b82e

Cursor.st		file \| annotate \| diff \| comparison \| revisions
DRootView.st		file \| annotate \| diff \| comparison \| revisions
DSurface.st		file \| annotate \| diff \| comparison \| revisions
DevViewH.st		file \| annotate \| diff \| comparison \| revisions
DisplayRootView.st		file \| annotate \| diff \| comparison \| revisions
DisplaySurface.st		file \| annotate \| diff \| comparison \| revisions
GC.st		file \| annotate \| diff \| comparison \| revisions
GMedium.st		file \| annotate \| diff \| comparison \| revisions
GraphicsContext.st		file \| annotate \| diff \| comparison \| revisions
GraphicsMedium.st		file \| annotate \| diff \| comparison \| revisions
Make.proto		file \| annotate \| diff \| comparison \| revisions
SimpleView.st		file \| annotate \| diff \| comparison \| revisions
WEvent.st		file \| annotate \| diff \| comparison \| revisions
WindowEvent.st		file \| annotate \| diff \| comparison \| revisions