hg/stx-libwidg: changeset 71:9fd1c36af7a8

--- a/ObjView.st	Mon Nov 28 22:05:43 1994 +0100
+++ b/ObjView.st	Wed Dec 21 20:19:42 1994 +0100
@@ -10,16 +10,15 @@
  hereby transferred.
 "
 
-'From Smalltalk/X, Version:2.10.4 on 7-nov-1994 at 1:19:10'!
+'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
 
 View subclass:#ObjectView
 	 instanceVariableNames:'contents sorted lastButt lastPointer lastButtonTime pressAction
 		releaseAction shiftPressAction doublePressAction motionAction
-		keyPressAction selection gridShown gridPixmap 
-		scaleMetric dragObject leftHandCursor readCursor oldCursor
-		movedObject moveStartPoint moveDelta buffer documentFormat
-		canDragOutOfView rootMotion
-		rootView aligning gridAlign'
+		keyPressAction selection gridShown gridPixmap scaleMetric
+		dragObject leftHandCursor readCursor oldCursor movedObject
+		moveStartPoint moveDelta buffer documentFormat canDragOutOfView
+		rootMotion rootView aligning gridAlign'
 	 classVariableNames:''
 	 poolDictionaries:''
 	 category:'Views-Basic'
@@ -48,7 +47,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.16 1994-11-28 21:05:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/ObjView.st,v 1.17 1994-12-21 19:19:42 claus Exp $
 "
 !
 
@@ -71,6 +70,554 @@
     ^ 0
 ! !
 
+!ObjectView methodsFor:'scrolling'!
+
+viewOrigin
+    transformation isNil ifTrue:[
+	^ 0@0
+    ].
+    ^ transformation translation negated
+!
+
+setViewOrigin:aPoint
+    |p|
+
+    p := aPoint negated.
+    transformation isNil ifTrue:[
+	transformation := WindowingTransformation scale:1 translation:p 
+    ] ifFalse:[
+	transformation translation:p 
+    ].
+"/    clipRect notNil ifTrue:[
+"/        self computeInnerClip.
+"/    ].
+!
+
+scrollDown:nPixels
+    "change origin to scroll down some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     w     "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }"
+     hCont "{ Class:SmallInteger }"
+     ih    "{ Class:SmallInteger }"
+     orgX orgY|
+
+    hCont := self heightOfContents.
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+    ].
+
+    count := nPixels.
+    ih := self innerHeight.
+
+    ((orgY + nPixels + ih) > hCont) ifTrue:[
+	count := hCont - orgY - ih
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX @ (orgY + count)).
+
+    (count >= ih) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2.
+	h := height - m2 - count.
+	w := self width.
+	self catchExpose.
+	self copyFrom:self x:margin y:(count + margin)
+			 toX:margin y:margin
+		       width:w 
+		      height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:margin y:(h + margin) 
+		     width:(width - m2) height:count.
+
+	self waitForExpose.
+    ].
+    self originChanged:(0 @ count).
+!
+
+scrollUp:nPixels
+    "change origin to scroll up (towards the origin) by some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     w     "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }"
+     orgX
+     orgY  "{ Class:SmallInteger }"|
+
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated
+    ].
+
+    count := nPixels.
+    (count > orgY) ifTrue:[
+	count := orgY
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX @ (orgY - count)).
+
+    (count >= self innerHeight) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2. "top & bottom margins"
+	h := height - m2 - count.
+	w := width.
+	self catchExpose.
+	self copyFrom:self x:margin y:margin
+			 toX:margin y:(count + margin)
+		       width:w height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:count.
+
+	self waitForExpose.
+    ].
+    self originChanged:(0 @ count negated).
+!
+
+scrollLeft:nPixels
+    "change origin to scroll left some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }"
+     orgX orgY|
+
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+    ].
+
+    count := nPixels.
+    (count > orgX) ifTrue:[
+	count := orgX
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX - count) @ orgY.
+
+    (count >= self innerWidth) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2.
+	h := (height - m2).
+
+	self catchExpose.
+	self copyFrom:self x:margin y:margin
+			 toX:(count + margin) y:margin
+		       width:(width - m2 - count) 
+		      height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:margin y:margin
+		     width:count height:(height - m2).
+
+	self waitForExpose.
+    ].
+    self originChanged:(count negated @ 0).
+!
+
+scrollRight:nPixels
+    "change origin to scroll right some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }" 
+     wCont "{ Class:SmallInteger }"
+     iw    "{ Class:SmallInteger }"
+     orgX orgY|
+
+    wCont := self widthOfContents.
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+    ].
+
+
+    count := nPixels.
+    iw := self innerWidth.
+
+    ((orgX + nPixels + iw) > wCont) ifTrue:[
+	count := wCont - orgX - iw
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX + count) @ orgY.
+
+    (count >= iw) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2.
+	h := (height - m2).
+
+	self catchExpose.
+	self copyFrom:self x:(count + margin) y:margin
+			 toX:margin y:margin
+		       width:(width - m2 - count) 
+		      height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:(width - margin - count) y:margin 
+		     width:count height:(height - m2).
+
+	self waitForExpose.
+    ].
+    self originChanged:(count @ 0).
+!
+
+verticalScrollStep
+    "return the amount to scroll when stepping left/right."
+
+    scaleMetric == #inch ifTrue:[
+	^ (device verticalPixelPerInch * (1/2)) asInteger
+    ].
+    ^ (device verticalPixelPerMillimeter * 20) asInteger
+!
+
+horizontalScrollStep
+    "return the amount to scroll when stepping left/right."
+
+    scaleMetric == #inch ifTrue:[
+	^ (device horizontalPixelPerInch * (1/2)) asInteger
+    ].
+    ^ (device horizontalPixelPerMillimeter * 20) asInteger
+! !
+
+!ObjectView methodsFor:'misc'!
+
+objectsIntersecting:aRectangle do:aBlock
+    "do something to every object which intersects a rectangle"
+
+    |f top bot
+     firstIndex "{ Class: SmallInteger }"
+     delta      "{ Class: SmallInteger }"
+     theObject 
+     nObjects   "{ Class: SmallInteger }"|
+
+    nObjects := contents size.
+    (nObjects == 0) ifTrue:[^ self].
+
+    sorted ifFalse:[
+	"
+	 have to check every object
+	"
+	contents do:[:theObject |
+	    (theObject frame intersects:aRectangle) ifTrue:[
+		aBlock value:theObject
+	    ]
+	].
+	^ self
+    ].
+
+    "
+     contents is sorted by y; can do a fast (binary) search for the first
+     object which intersects aRectangle and 
+     break from the draw loop, when the 1st object below aRectangle is reached.
+    "
+    bot := aRectangle bottom.
+    top := aRectangle top.
+
+    "
+     binary search for an object in aRectangle ...
+    "
+    delta := nObjects // 2.
+    firstIndex := delta.
+    (firstIndex == 0) ifTrue:[
+       firstIndex := 1
+    ].
+    theObject := contents at:firstIndex.
+    (theObject frame bottom < top) ifTrue:[
+	[theObject frame bottom < top and:[delta > 1]] whileTrue:[
+	    delta := delta // 2.
+	    firstIndex := firstIndex + delta.
+	    theObject := contents at:firstIndex
+	]
+    ] ifFalse:[
+	[theObject frame top > bot and:[delta > 1]] whileTrue:[
+	    delta := delta // 2.
+	    firstIndex := firstIndex - delta.
+	    theObject := contents at:firstIndex
+	]
+    ].
+
+    "
+     now, theObject at:firstIndex is in aRectangle; go backward to the object
+     following first non-visible
+    "
+    [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
+	firstIndex := firstIndex - 1.
+	theObject := contents at:firstIndex
+    ].
+
+    firstIndex to:nObjects do:[:index |
+	theObject := contents at:index.
+	f := theObject frame.
+	(f intersects:aRectangle) ifTrue:[
+	    aBlock value:theObject
+	] ifFalse:[
+	    (f top > bot) ifTrue:[^ self]
+	]
+    ]
+!
+
+forEach:aCollection do:aBlock
+    "apply block to every object in a collectioni;
+     (adds a check for non-collection)"
+
+    aCollection isNil ifTrue:[^self].
+    (aCollection isKindOf:Collection) ifTrue:[
+	aCollection do:[:object |
+	    object notNil ifTrue:[
+		aBlock value:object
+	    ]
+	]
+    ] ifFalse: [
+	aBlock value:aCollection
+    ]
+!
+
+objectsIntersectingVisible:aRectangle do:aBlock
+    "do something to every object which intersects a visible rectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:(aRectangle left + viewOrigin x)
+			  top:(aRectangle top + viewOrigin y)
+			width:(aRectangle width)
+		       height:(aRectangle height).
+    self objectsIntersecting:absRect do:aBlock
+!
+
+setDefaultActions
+    motionAction := [:movePoint | nil].
+    releaseAction := [nil]
+!
+
+objectsIntersecting:aRectangle
+    "answer a Collection of objects intersecting the argument, aRectangle"
+
+    |newCollection|
+
+    newCollection := OrderedCollection new.
+    self objectsIntersecting:aRectangle do:[:theObject |
+	newCollection add:theObject
+    ].
+    (newCollection size == 0) ifTrue:[^ nil].
+    ^ newCollection
+!
+
+setMoveActions
+    motionAction := [:movePoint | self doObjectMove:movePoint].
+    releaseAction := [self endObjectMove]
+!
+
+setRectangleDragActions
+    motionAction := [:movePoint | self doRectangleDrag:movePoint].
+    releaseAction := [self endRectangleDrag]
+!
+
+objectsIn:aRectangle do:aBlock
+    "do something to every object which is completely in a rectangle"
+
+    |bot|
+
+    sorted ifTrue:[
+	bot := aRectangle bottom.
+	contents do:[:theObject |
+	    (theObject isContainedIn:aRectangle) ifTrue:[
+		aBlock value:theObject
+	    ] ifFalse:[
+		theObject frame top > bot ifTrue:[^ self]
+	    ]
+	].
+	^ self
+    ].
+
+    contents do:[:theObject |
+	(theObject isContainedIn:aRectangle) ifTrue:[
+	    aBlock value:theObject
+	]
+    ]
+!
+
+documentFormat:aFormatString
+    "set the document format (mostly used by scrollbars).
+     The argument should be a string such as 'a4', 'a5'
+     or 'letter'. See widthOfContentsInMM for supported formats."
+
+    aFormatString ~= documentFormat ifTrue:[
+	documentFormat := aFormatString.
+	self contentsChanged.
+	self defineGrid.
+	gridShown ifTrue:[
+	    self clear.
+	    self redraw
+	]
+    ]
+!
+
+setLineDragActions
+    motionAction := [:movePoint | self doLineDrag:movePoint].
+    releaseAction := [self endLineDrag]
+!
+
+objectsInVisible:aRectangle do:aBlock
+    "do something to every object which is completely in a 
+     visible rectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:(aRectangle left + viewOrigin x)
+			  top:(aRectangle top + viewOrigin y)
+			width:(aRectangle width)
+		       height:(aRectangle height).
+    self objectsIn:absRect do:aBlock
+!
+
+visibleObjectsDo:aBlock
+    "do something to every visible object"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:viewOrigin x
+			  top:viewOrigin y
+			width:width
+		       height:height.
+    self objectsIntersecting:absRect do:aBlock
+!
+
+numberOfObjectsIntersectingVisible:aRectangle
+    "answer the number of objects intersecting the argument, aRectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle
+		 left:(aRectangle left + viewOrigin x)
+		  top:(aRectangle top  + viewOrigin y)
+		width:(aRectangle width)
+	       height:(aRectangle height).
+
+    ^ self numberOfObjectsIntersecting:aRectangle
+!
+
+numberOfObjectsIntersecting:aRectangle
+    "answer the number of objects intersecting the argument, aRectangle"
+
+    |tally|
+
+    tally := 0.
+    contents do:[:theObject |
+	(theObject frame intersects:aRectangle) ifTrue:[
+	    tally := tally + 1
+	]
+    ].
+    ^ tally
+!
+
+objectsIntersectingVisible:aRectangle
+    "answer a Collection of objects intersecting a visible aRectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:(aRectangle left + viewOrigin x)
+			  top:(aRectangle top + viewOrigin y)
+			width:(aRectangle width)
+		       height:(aRectangle height).
+    ^ self objectsIntersecting:absRect
+!
+
+objectsBelow:objectToBeTested do:aBlock
+    "do something to every object below objectToBeTested
+     (does not mean obscured by - simply below in hierarchy)"
+
+    |endIndex|
+
+    endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
+    contents from:1 to:(endIndex - 1) do:aBlock
+!
+
+objectsAbove:objectToBeTested do:aBlock
+    "do something to every object above objectToBeTested
+     (does not mean obscured - simply above in hierarchy)"
+
+    |startIndex|
+
+    startIndex := contents identityIndexOf:objectToBeTested
+				  ifAbsent:[self error].
+    contents from:startIndex to:(contents size) do:aBlock
+!
+
+objectsAbove:anObject intersecting:aRectangle do:aBlock
+    "do something to every object above objectToBeTested
+     and intersecting aRectangle"
+
+    self objectsAbove:anObject do:[:theObject |
+	(theObject frame intersects:aRectangle) ifTrue:[
+	    aBlock value:theObject
+	]
+    ]
+!
+
+rectangleForScroll
+    "find the area occupied by visible objects"
+
+    |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    orgX := 0 . "/viewOrigin x.
+    orgY := 0 . "/viewOrigin y.
+    left := 9999.
+    right := 0.
+    top := 9999.
+    bottom := 0.
+    self visibleObjectsDo:[:anObject |
+	frame := anObject frame.
+	oLeft := frame left - orgX.
+	oRight := frame right - orgX.
+	oTop := frame top - orgY.
+	oBottom := frame bottom - orgY.
+	(oLeft < left) ifTrue:[left := oLeft].
+	(oRight > right) ifTrue:[right := oRight].
+	(oTop < top) ifTrue:[top := oTop].
+	(oBottom > bottom) ifTrue:[bottom := oBottom]
+    ].
+    (left < margin) ifTrue:[left := margin].
+    (top < margin) ifTrue:[top := margin].
+    (right > (width - margin)) ifTrue:[right := width - margin].
+    (bottom > (height - margin)) ifTrue:[bottom := height - margin].
+
+    ((left > right) or:[top > bottom]) ifTrue:[^ nil].
+
+    ^ Rectangle left:left right:right top:top bottom:bottom
+! !
+
 !ObjectView methodsFor:'event handling'!
 
 redrawX:x y:y width:w height:h
@@ -88,6 +635,31 @@
     ]
 !
 
+redrawDeviceX:x y:y width:w height:h
+super redrawDeviceX:x y:y width:w height:h
+!
+
+buttonPress:button x:x y:y
+    "user pressed left button"
+
+    ((button == 1) or:[button == #select]) ifTrue:[
+	pressAction notNil ifTrue:[
+	    lastButt := x @ y.
+	    pressAction value:lastButt
+	]
+    ] ifFalse:[
+	super buttonPress:button x:x y:y
+    ]
+!
+
+buttonRelease:button x:x y:y
+    ((button == 1) or:[button == #select]) ifTrue:[
+	releaseAction notNil ifTrue:[releaseAction value]
+    ] ifFalse:[
+	super buttonRelease:button x:x y:y
+    ] 
+!
+
 buttonMotion:buttonMask x:buttX y:buttY
     "user moved mouse while button pressed"
 
@@ -139,27 +711,18 @@
     ]
 !
 
-buttonPress:button x:x y:y
-    "user pressed left button"
+buttonMultiPress:button x:x y:y
+    "user pressed left button twice (or more)"
 
     ((button == 1) or:[button == #select]) ifTrue:[
-	pressAction notNil ifTrue:[
-	    lastButt := x @ y.
-	    pressAction value:lastButt
+	doublePressAction notNil ifTrue:[
+	    doublePressAction value:(x @ y)
 	]
     ] ifFalse:[
-	super buttonPress:button x:x y:y
+	super buttonMultiPress:button x:x y:y
     ]
 !
 
-buttonRelease:button x:x y:y
-    ((button == 1) or:[button == #select]) ifTrue:[
-	releaseAction notNil ifTrue:[releaseAction value]
-    ] ifFalse:[
-	super buttonRelease:button x:x y:y
-    ] 
-!
-
 buttonShiftPress:button x:x y:y
     "user pressed left button with shift"
 
@@ -173,18 +736,6 @@
     ]
 !
 
-buttonMultiPress:button x:x y:y
-    "user pressed left button twice (or more)"
-
-    ((button == 1) or:[button == #select]) ifTrue:[
-	doublePressAction notNil ifTrue:[
-	    doublePressAction value:(x @ y)
-	]
-    ] ifFalse:[
-	super buttonMultiPress:button x:x y:y
-    ]
-!
-
 keyPress:key x:x y:y
     keyPressAction notNil ifTrue:[
 	selection notNil ifTrue:[
@@ -195,24 +746,364 @@
     ]
 ! !
 
-!ObjectView methodsFor:'scrolling'!
-
-horizontalScrollStep
-    "return the amount to scroll when stepping left/right."
-
-    scaleMetric == #inch ifTrue:[
-	^ (device horizontalPixelPerInch * (1/2)) asInteger
+!ObjectView methodsFor:'dragging object move'!
+
+doObjectMove:aPoint
+    "do an object move.
+     moveStartPoint is the original click-point.
+     moveDelta"
+
+    |dragger offset d p|
+
+    rootMotion ifTrue:[
+	dragger := rootView.
+	offset := 0@0 "self viewOrigin".
+    ] ifFalse:[
+	dragger := self.
+	offset := 0@0.
+    ].
+
+    "
+     when drawing in the root window, we have to use its coordinates
+     this is kept in offset.
+    "
+    movedObject isNil ifTrue:[
+	movedObject := selection.
+	"
+	 draw first outline
+	"
+	movedObject notNil ifTrue:[
+	    moveDelta := 0@0.
+
+	    dragger xoring:[
+		"tricky, the moved object may not currently be aligned.
+		 if so, simulate a frame move of the delta"
+
+		aligning ifTrue:[
+		    d := movedObject origin 
+			 - (self alignToGrid:(movedObject origin)).
+"/ d printNL.
+		    moveDelta := d negated.
+		].
+"/ moveDelta printNL.
+		self showDragging:movedObject offset:moveDelta - offset.
+	    ]
+	]
+    ].
+    movedObject notNil ifTrue:[
+	"
+	 clear prev outline,
+	 draw new outline
+	"
+	dragger xoring:[
+	    self showDragging:movedObject offset:moveDelta - offset.
+	    moveDelta := aPoint - moveStartPoint.
+	    aligning ifTrue:[
+		moveDelta := self alignToGrid:moveDelta
+	    ].
+	    self showDragging:movedObject offset:moveDelta - offset.
+	]
+    ]
+!
+
+endObjectMove
+    "cleanup after object move - find the destination view and dispatch to
+     one of the moveObjectXXX-methods. These can be redefined in subclasses."
+
+    |dragger inMySelf offs2 rootPoint destinationPoint
+     viewId destinationView destinationId lastViewId|
+
+    movedObject notNil ifTrue:[
+	rootMotion ifTrue:[
+	    dragger := rootView.
+	    offs2 := 0@0 "self viewOrigin"
+	] ifFalse:[
+	    dragger := self.
+	    offs2 := 0@0
+	].
+	dragger xoring:[
+	    self showDragging:movedObject offset:moveDelta - offs2
+	].
+	dragger device synchronizeOutput.
+
+	"check if object is to be put into another view"
+	rootMotion ifTrue:[
+	    rootPoint := device translatePoint:lastButt
+					  from:(self id) 
+					    to:(rootView id).
+	    "search view the drop is in"
+	    viewId := rootView id.
+	    [viewId notNil] whileTrue:[
+		destinationId := device viewIdFromPoint:rootPoint in:viewId.
+		lastViewId := viewId.
+		viewId := destinationId
+	    ].
+	    destinationView := device viewFromId:lastViewId.
+	    destinationId := lastViewId.
+	    inMySelf := (destinationView == self).
+	    rootMotion := false
+	] ifFalse:[
+	    inMySelf := true
+	].
+	inMySelf ifTrue:[
+	    "simple move"
+	    self move:movedObject by:moveDelta
+	] ifFalse:[
+	    destinationPoint := device translatePoint:rootPoint
+						 from:(rootView id) 
+						   to:destinationId.
+	    destinationView notNil ifTrue:[
+		"
+		 move into another smalltalk view
+		"
+		self move:movedObject to:destinationPoint in:destinationView
+	    ] ifFalse:[
+		"
+		 not one of my views
+		"
+		self move:movedObject to:destinationPoint inAlienViewId:destinationId
+	    ] 
+	].
+	self setDefaultActions.
+	movedObject := nil
+    ]
+!
+
+startObjectMove:something at:aPoint
+    "start an object move"
+
+    something notNil ifTrue:[
+	self select:something.
+	(self canMove:something) ifTrue:[
+	    self setMoveActions.
+	    moveStartPoint := aPoint.
+	    rootMotion := canDragOutOfView.
+	    "self doObjectMove:aPoint "
+	] ifFalse:[
+	    self setDefaultActions
+	]
+    ]
+! !
+
+!ObjectView methodsFor:'drawing'!
+
+redrawObjectsIntersecting:aRectangle
+    "redraw all objects which have part of themself in aRectangle"
+
+    self objectsIntersecting:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+!
+
+showDragging:something offset:anOffset
+    "show an object while dragging"
+
+    |drawOffset top drawer|
+
+    rootMotion ifTrue:[
+	"drag in root-window"
+
+	top := self topView.
+	drawOffset := device translatePoint:anOffset
+				       from:(self id) to:(rootView id).
+	drawer := rootView
+    ] ifFalse:[
+	drawOffset := anOffset.
+	drawer := self
     ].
-    ^ (device horizontalPixelPerMillimeter * 20) asInteger
+    self forEach:something do:[:anObject |
+	anObject drawDragIn:drawer offset:drawOffset
+    ]
+!
+
+redrawObjectsIntersectingVisible:aRectangle
+    "redraw all objects which have part of themself in a vis rectangle"
+
+    self objectsIntersectingVisible:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+
+!
+
+redrawObjectsInVisible:visRect
+    "redraw all objects which have part of themselfes in a vis rectangle
+     draw only in (i.e. clip output to) aRectangle"
+
+    |vis|
+
+    shown ifTrue:[
+	vis := visRect.
+	clipRect notNil ifTrue:[
+	    vis := vis intersect:clipRect
+	].
+	transformation notNil ifTrue:[
+	    vis := vis origin truncated
+		       corner:(vis corner + (1@1)) truncated.
+	].
+
+	self clippedTo:vis do:[
+	    self clearRectangle:vis.
+	    self redrawObjectsIntersectingVisible:vis
+	]
+    ]
+!
+
+redraw
+    "redraw complete View"
+
+    shown ifTrue:[
+	self clear.
+	self redrawObjects
+    ]
+!
+
+redrawObjectsOn:aGC
+    "redraw all objects on a graphic context"
+
+    |vFrame org viewOrigin|
+
+    (aGC == self) ifTrue:[
+	shown ifFalse:[^ self].
+	viewOrigin := 0@0. "/self viewOrigin.
+	org := viewOrigin.
+	vFrame := Rectangle origin:org
+			    corner:(viewOrigin + (width @ height)).
+
+	transformation notNil ifTrue:[
+	    vFrame := transformation applyInverseTo:vFrame.
+	].
+	self redrawObjectsIntersecting:vFrame
+    ] ifFalse:[
+	"loop over pages"
+
+"
+	org := 0 @ 0.
+	vFrame := Rectangle origin:org
+			    corner:(org + (width @ height)).
+
+	self redrawObjectsIntersecting:vFrame
+"
+	self objectsIntersecting:vFrame do:[:theObject |
+	    theObject drawIn:aGC
+	]
+    ]
+!
+
+redrawObjects
+    "redraw all objects"
+
+    self redrawObjectsOn:self
+!
+
+show:anObject
+    "show the object, either selected or not"
+
+    (self isSelected:anObject) ifTrue:[
+	self showSelected:anObject
+    ] ifFalse:[
+	self showUnselected:anObject
+    ]
 !
 
-verticalScrollStep
-    "return the amount to scroll when stepping left/right."
-
-    scaleMetric == #inch ifTrue:[
-	^ (device verticalPixelPerInch * (1/2)) asInteger
-    ].
-    ^ (device verticalPixelPerMillimeter * 20) asInteger
+showUnselected:anObject
+    "show an object as unselected"
+
+    anObject drawIn:self
+!
+
+redrawObjectsIn:aRectangle
+    "redraw all objects which have part of themselfes in aRectangle
+     draw only in (i.e. clip output to) aRectangle"
+
+    |visRect viewOrigin|
+
+    shown ifTrue:[
+	viewOrigin := 0@0. "/self viewOrigin.
+	visRect := Rectangle origin:(aRectangle origin - viewOrigin)
+			     extent:(aRectangle extent).
+	transformation notNil ifTrue:[
+	    visRect := visRect origin truncated
+		       corner:(visRect corner + (1@1)) truncated.
+	].
+	clipRect notNil ifTrue:[
+	    visRect := visRect intersect:clipRect
+	].
+"/        transformation notNil ifTrue:[
+"/            visRect := visRect origin truncated
+"/                       corner:(visRect corner + (1@1)) truncated.
+"/        ].
+	self clippedTo:visRect do:[
+	    self clearRectangle:visRect.
+	    self redrawObjectsIntersecting:visRect "/ aRectangle
+	]
+    ]
+!
+
+redrawScale
+    "redraw the scales"
+
+    self redrawHorizontalScale.
+    self redrawVerticalScale
+!
+
+redrawObjectsAbove:anObject intersecting:aRectangle
+    "redraw all objects which have part of themself in aRectangle
+     and are above (in front of) anObject"
+
+    self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+!
+
+redrawObjectsAbove:anObject intersectingVisible:aRectangle
+    "redraw all objects which have part of themself in a vis rectangle
+     and are above (in front of) anObject"
+
+    self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+!
+
+showSelected:anObject
+    "show an object as selected"
+
+    anObject drawSelectedIn:self
+!
+
+redrawObjectsAbove:anObject in:aRectangle
+    "redraw all objects which have part of themselfes in aRectangle
+     and are above (in front of) anObject.
+     draw only in (i.e. clip output to) aRectangle"
+
+    |vis|
+
+    shown ifTrue:[
+	vis := aRectangle.
+	clipRect notNil ifTrue:[
+	    vis := vis intersect:clipRect
+	].
+	self clippedTo:vis do:[
+	    self redrawObjectsAbove:anObject intersecting:vis
+	]
+    ]
+!
+
+redrawObjectsAbove:anObject inVisible:aRectangle
+    "redraw all objects which have part of themselfes in a vis rectangle
+     and are above (in front of) anObject.
+     draw only in (i.e. clip output to) aRectangle"
+
+    |vis|
+
+    shown ifTrue:[
+	vis := aRectangle.
+	clipRect notNil ifTrue:[
+	    vis := vis intersect:clipRect
+	].
+	self clippedTo:vis do:[
+	    self redrawObjectsAbove:anObject intersectingVisible:vis
+	]
+    ]
 ! !
 
 !ObjectView methodsFor:'queries'!
@@ -230,57 +1121,17 @@
     ^ (transformation applyScaleY:h) rounded 
 !
 
-widthOfContentsInMM
-    "answer the width of the document in millimeters"
-
-    "landscape"
-    (documentFormat = 'a1l') ifTrue:[
-	^ 840
-    ].
-    (documentFormat = 'a2l') ifTrue:[
-	^ 592
-    ].
-    (documentFormat = 'a3l') ifTrue:[
-	^ 420
-    ].
-    (documentFormat = 'a4l') ifTrue:[
-	^ 296
-    ].
-    (documentFormat = 'a5l') ifTrue:[
-	^ 210
-    ].
-    (documentFormat = 'a6l') ifTrue:[
-	^ 148
-    ].
-    (documentFormat = 'letterl') ifTrue:[
-	^ 11 * 25.4
+widthOfContents
+    "answer the width of the document in pixels"
+
+    |w|
+
+    w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
+
+    transformation isNil ifTrue:[
+	^ w rounded
     ].
-
-    (documentFormat = 'a1') ifTrue:[
-	^ 592
-    ].
-    (documentFormat = 'a2') ifTrue:[
-	^ 420
-    ].
-    (documentFormat = 'a3') ifTrue:[
-	^ 296
-    ].
-    (documentFormat = 'a4') ifTrue:[
-	^ 210
-    ].
-    (documentFormat = 'a5') ifTrue:[
-	^ 148
-    ].
-    (documentFormat = 'a6') ifTrue:[
-	^ 105
-    ].
-    (documentFormat = 'letter') ifTrue:[
-	^ 8.5 * 25.4
-    ].
-    "*** more formats needed here ...***"
-
-    "assuming window size is document size"
-    ^ (width / self horizontalPixelPerMillimeter:1) asInteger
+    ^ (transformation applyScaleX:w) rounded
 !
 
 heightOfContentsInMM
@@ -336,17 +1187,193 @@
     ^ (height / self verticalPixelPerMillimeter:1) asInteger
 !
 
-widthOfContents
-    "answer the width of the document in pixels"
-
-    |w|
-
-    w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
-
-    transformation isNil ifTrue:[
-	^ w rounded
+widthOfContentsInMM
+    "answer the width of the document in millimeters"
+
+    "landscape"
+    (documentFormat = 'a1l') ifTrue:[
+	^ 840
+    ].
+    (documentFormat = 'a2l') ifTrue:[
+	^ 592
+    ].
+    (documentFormat = 'a3l') ifTrue:[
+	^ 420
+    ].
+    (documentFormat = 'a4l') ifTrue:[
+	^ 296
+    ].
+    (documentFormat = 'a5l') ifTrue:[
+	^ 210
+    ].
+    (documentFormat = 'a6l') ifTrue:[
+	^ 148
+    ].
+    (documentFormat = 'letterl') ifTrue:[
+	^ 11 * 25.4
+    ].
+
+    (documentFormat = 'a1') ifTrue:[
+	^ 592
+    ].
+    (documentFormat = 'a2') ifTrue:[
+	^ 420
+    ].
+    (documentFormat = 'a3') ifTrue:[
+	^ 296
+    ].
+    (documentFormat = 'a4') ifTrue:[
+	^ 210
+    ].
+    (documentFormat = 'a5') ifTrue:[
+	^ 148
+    ].
+    (documentFormat = 'a6') ifTrue:[
+	^ 105
+    ].
+    (documentFormat = 'letter') ifTrue:[
+	^ 8.5 * 25.4
+    ].
+    "*** more formats needed here ...***"
+
+    "assuming window size is document size"
+    ^ (width / self horizontalPixelPerMillimeter:1) asInteger
+! !
+
+!ObjectView methodsFor:'testing objects'!
+
+frameOf:anObjectOrCollection
+    "answer the maximum extent defined by the argument, anObject or a
+     collection of objects"
+
+    |first frameAll|
+
+    anObjectOrCollection isNil ifTrue:[^ nil ].
+    first := true.
+    self forEach:anObjectOrCollection do:[:theObject |
+	first ifTrue:[
+	    frameAll := theObject frame.
+	    first := false
+	] ifFalse:[
+	    frameAll := frameAll merge:(theObject frame)
+	]
+    ].
+    ^ frameAll
+!
+
+isObscured:something
+    "return true, if the argument something, anObject or a collection of
+     objects is obscured (partially or whole) by any other object"
+
+    self forEach:something do:[:anObject |
+	(self objectIsObscured:anObject) ifTrue:[
+	    ^ true
+	]
     ].
-    ^ (transformation applyScaleX:w) rounded
+    ^ false
+!
+
+findObjectAt:aPoint
+    "find the last object (by looking from back to front) which is hit by
+     the argument, aPoint - this is the topmost object hit"
+
+    |hdelta|
+
+    hdelta := self class hitDelta.
+    contents reverseDo:[:object |
+	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
+    ].
+    ^ nil
+!
+
+findObjectAtVisible:aPoint
+    "find the last object (by looking from back to front) which is hit by
+     a visible point - this is the topmost object hit"
+
+    ^ self findObjectAt:(aPoint "+ self viewOrigin")
+!
+
+isSelected:anObject
+    "return true, if the argument, anObject is in the selection"
+
+    selection isNil ifTrue:[^ false].
+    (selection == anObject) ifTrue:[^ true].
+    (selection isKindOf:Collection) ifTrue:[
+	^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
+    ].
+    ^ false
+!
+
+canMove:something
+    "return true, if the argument, anObject or a collection can be moved"
+
+    (something isKindOf:Collection) ifTrue:[
+	self forEach:something do:[:theObject |
+	    (theObject canBeMoved) ifFalse:[^ false]
+	].
+	^ true
+    ].
+    ^ something canBeMoved
+!
+
+objectIsObscured:objectToBeTested
+    "return true, if the argument, anObject is obscured (partially or whole)
+     by any other object"
+
+    |frameToBeTested frameleft frameright frametop framebot
+     objectsFrame startIndex|
+
+    (objectToBeTested == (contents last)) ifTrue:[
+	"quick return if object is on top"
+	^ false
+    ].
+
+    frameToBeTested := self frameOf:objectToBeTested.
+    frameleft := frameToBeTested left.
+    frameright := frameToBeTested right.
+    frametop := frameToBeTested top.
+    framebot := frameToBeTested bottom.
+
+    "check objects after the one to check"
+
+    startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
+    contents from:(startIndex + 1) to:(contents size) do:[:object |
+	objectsFrame := self frameOf:object.
+	(objectsFrame right < frameleft) ifFalse:[
+	    (objectsFrame left > frameright) ifFalse:[
+		(objectsFrame bottom < frametop) ifFalse:[
+		    (objectsFrame top > framebot) ifFalse:[
+			^ true
+		    ]
+		]
+	    ]
+	]
+    ].
+    ^ false
+!
+
+findObjectAt:aPoint suchThat:aBlock
+    "find the last object (back to front ) which is hit by
+     the argument, aPoint and for which the testBlock, aBlock evaluates to
+     true"
+
+    |hdelta|
+
+    hdelta := self class hitDelta.
+    contents reverseDo:[:object |
+	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
+	    (aBlock value:object) ifTrue:[^ object]
+	]
+    ].
+    ^ nil
+!
+
+findObjectAtVisible:aPoint suchThat:aBlock
+    "find the last object (back to front ) which is hit by
+     the argument, aPoint and for which the testBlock, aBlock evaluates to
+     true"
+
+    ^ self findObjectAt:(aPoint "+ self viewOrigin") suchThat:aBlock
 ! !
 
 !ObjectView methodsFor:'user interface'!
@@ -420,264 +1447,6 @@
     self startRectangleDrag:aPoint
 ! !
 
-!ObjectView methodsFor:'initialization'!
-
-setInitialDocumentFormat
-    (Smalltalk language == #english) ifTrue:[
-	documentFormat := 'letter'.
-	scaleMetric := #inch
-    ] ifFalse:[
-	documentFormat := 'a4'.
-	scaleMetric := #mm
-    ].
-!
-
-initialize
-    |pixPerMM|
-
-    super initialize.
-
-    viewBackground := White.
-
-    bitGravity := #NorthWest.
-    contents := OrderedCollection new.
-    gridShown := false.
-
-    canDragOutOfView := false.
-    rootView := DisplayRootView new.
-    rootView noClipByChildren.
-    rootMotion := false.
-    self setInitialDocumentFormat.
-
-    readCursor := Cursor read.
-    leftHandCursor := Cursor leftHand.
-    sorted := false.
-    aligning := false
-!
-
-initEvents
-    self backingStore:true.
-    self enableButtonEvents.
-    self enableButtonMotionEvents
-! !
-
-!ObjectView methodsFor:'drawing'!
-
-redrawObjectsInVisible:visRect
-    "redraw all objects which have part of themselfes in a vis rectangle
-     draw only in (i.e. clip output to) aRectangle"
-
-    |vis|
-
-    shown ifTrue:[
-	vis := visRect.
-	clipRect notNil ifTrue:[
-	    vis := vis intersect:clipRect
-	].
-	transformation notNil ifTrue:[
-	    vis := vis origin truncated
-		       corner:(vis corner + (1@1)) truncated.
-	].
-
-	self clippedTo:vis do:[
-	    self clearRectangle:vis.
-	    self redrawObjectsIntersectingVisible:vis
-	]
-    ]
-!
-
-redrawObjectsIntersectingVisible:aRectangle
-    "redraw all objects which have part of themself in a vis rectangle"
-
-    self objectsIntersectingVisible:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-
-!
-
-redraw
-    "redraw complete View"
-
-    shown ifTrue:[
-	self clear.
-	self redrawObjects
-    ]
-!
-
-redrawObjectsIntersecting:aRectangle
-    "redraw all objects which have part of themself in aRectangle"
-
-    self objectsIntersecting:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-!
-
-redrawObjectsOn:aGC
-    "redraw all objects on a graphic context"
-
-    |vFrame org viewOrigin|
-
-    (aGC == self) ifTrue:[
-	shown ifFalse:[^ self].
-	viewOrigin := self viewOrigin.
-	org := viewOrigin.
-	vFrame := Rectangle origin:org
-			    corner:(viewOrigin + (width @ height)).
-
-	transformation notNil ifTrue:[
-	    vFrame := transformation applyInverseTo:vFrame.
-	].
-	self redrawObjectsIntersecting:vFrame
-    ] ifFalse:[
-	"loop over pages"
-
-"
-	org := 0 @ 0.
-	vFrame := Rectangle origin:org
-			    corner:(org + (width @ height)).
-
-	self redrawObjectsIntersecting:vFrame
-"
-	self objectsIntersecting:vFrame do:[:theObject |
-	    theObject drawIn:aGC
-	]
-    ]
-!
-
-redrawObjects
-    "redraw all objects"
-
-    self redrawObjectsOn:self
-!
-
-showDragging:something offset:anOffset
-    "show an object while dragging"
-
-    |drawOffset top drawer|
-
-    rootMotion ifTrue:[
-	"drag in root-window"
-
-	top := self topView.
-	drawOffset := device translatePoint:anOffset
-				       from:(self id) to:(rootView id).
-	drawer := rootView
-    ] ifFalse:[
-	drawOffset := anOffset.
-	drawer := self
-    ].
-    self forEach:something do:[:anObject |
-	anObject drawDragIn:drawer offset:drawOffset
-    ]
-!
-
-redrawObjectsIn:aRectangle
-    "redraw all objects which have part of themselfes in aRectangle
-     draw only in (i.e. clip output to) aRectangle"
-
-    |visRect viewOrigin|
-
-    shown ifTrue:[
-	viewOrigin := self viewOrigin.
-	visRect := Rectangle origin:(aRectangle origin - viewOrigin)
-			     extent:(aRectangle extent).
-	clipRect notNil ifTrue:[
-	    visRect := visRect intersect:clipRect
-	].
-	transformation notNil ifTrue:[
-	    visRect := visRect origin truncated
-		       corner:(visRect corner + (1@1)) truncated.
-	].
-	self clippedTo:visRect do:[
-	    self clearRectangle:visRect.
-	    self redrawObjectsIntersecting:aRectangle
-	]
-    ]
-!
-
-redrawScale
-    "redraw the scales"
-
-    self redrawHorizontalScale.
-    self redrawVerticalScale
-!
-
-redrawObjectsAbove:anObject intersecting:aRectangle
-    "redraw all objects which have part of themself in aRectangle
-     and are above (in front of) anObject"
-
-    self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-!
-
-redrawObjectsAbove:anObject intersectingVisible:aRectangle
-    "redraw all objects which have part of themself in a vis rectangle
-     and are above (in front of) anObject"
-
-    self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-!
-
-redrawObjectsAbove:anObject in:aRectangle
-    "redraw all objects which have part of themselfes in aRectangle
-     and are above (in front of) anObject.
-     draw only in (i.e. clip output to) aRectangle"
-
-    |vis|
-
-    shown ifTrue:[
-	vis := aRectangle.
-	clipRect notNil ifTrue:[
-	    vis := vis intersect:clipRect
-	].
-	self clippedTo:vis do:[
-	    self redrawObjectsAbove:anObject intersecting:vis
-	]
-    ]
-!
-
-redrawObjectsAbove:anObject inVisible:aRectangle
-    "redraw all objects which have part of themselfes in a vis rectangle
-     and are above (in front of) anObject.
-     draw only in (i.e. clip output to) aRectangle"
-
-    |vis|
-
-    shown ifTrue:[
-	vis := aRectangle.
-	clipRect notNil ifTrue:[
-	    vis := vis intersect:clipRect
-	].
-	self clippedTo:vis do:[
-	    self redrawObjectsAbove:anObject intersectingVisible:vis
-	]
-    ]
-!
-
-show:anObject
-    "show the object, either selected or not"
-
-    (self isSelected:anObject) ifTrue:[
-	self showSelected:anObject
-    ] ifFalse:[
-	self showUnselected:anObject
-    ]
-!
-
-showSelected:anObject
-    "show an object as selected"
-
-    anObject drawSelectedIn:self
-!
-
-showUnselected:anObject
-    "show an object as unselected"
-
-    anObject drawIn:self
-! !
-
 !ObjectView methodsFor:'selections'!
 
 unselect
@@ -687,14 +1456,20 @@
     selection := nil
 !
 
-select:something
-    "select something - hide previouse selection, set to something and hilight"
-
-    (selection == something) ifFalse:[
-	self hideSelection.
-	selection := something.
-	self showSelection
-    ]
+selectAllIn:aRectangle
+    "select all objects fully in aRectangle"
+
+    self hideSelection.
+    selection := OrderedCollection new.
+    self objectsIn:aRectangle do:[:theObject |
+	selection add:theObject
+    ].
+    (selection size == 0) ifTrue:[
+	selection := nil
+    ] ifFalse:[
+	(selection size == 1) ifTrue:[selection := selection first]
+    ].
+    self showSelection
 !
 
 withSelectionHiddenDo:aBlock
@@ -708,12 +1483,30 @@
     self select:sel
 !
 
+select:something
+    "select something - hide previouse selection, set to something and hilight"
+
+    (selection == something) ifFalse:[
+	self hideSelection.
+	selection := something.
+	self showSelection
+    ]
+!
+
 selectionDo:aBlock
     "apply block to every object in selection"
 
     self forEach:selection do:aBlock
 !
 
+hideSelection
+    "hide the selection - undraw hilights - whatever that is"
+
+    self selectionDo:[:object |
+	self showUnselected:object
+    ]
+!
+
 showSelection
     "show the selection - draw hilights - whatever that is"
 
@@ -722,14 +1515,6 @@
     ]
 !
 
-hideSelection
-    "hide the selection - undraw hilights - whatever that is"
-
-    self selectionDo:[:object |
-	self showUnselected:object
-    ]
-!
-
 selectAll
     "select all objects"
 
@@ -764,22 +1549,6 @@
     self showUnselected:anObject
 !
 
-selectAllIn:aRectangle
-    "select all objects fully in aRectangle"
-
-    self hideSelection.
-    selection := OrderedCollection new.
-    self objectsIn:aRectangle do:[:theObject |
-	selection add:theObject
-    ].
-    (selection size == 0) ifTrue:[
-	selection := nil
-    ] ifFalse:[
-	(selection size == 1) ifTrue:[selection := selection first]
-    ].
-    self showSelection
-!
-
 selectAllIntersecting:aRectangle
     "select all objects touched by aRectangle"
 
@@ -797,465 +1566,177 @@
     self showSelection
 ! !
 
-!ObjectView methodsFor:'testing objects'!
-
-frameOf:anObjectOrCollection
-    "answer the maximum extent defined by the argument, anObject or a
-     collection of objects"
-
-    |first frameAll|
-
-    anObjectOrCollection isNil ifTrue:[^ nil ].
-    first := true.
-    self forEach:anObjectOrCollection do:[:theObject |
-	first ifTrue:[
-	    frameAll := theObject frame.
-	    first := false
-	] ifFalse:[
-	    frameAll := frameAll merge:(theObject frame)
-	]
+!ObjectView methodsFor:'initialization'!
+
+setInitialDocumentFormat
+    (Smalltalk language == #english) ifTrue:[
+	documentFormat := 'letter'.
+	scaleMetric := #inch
+    ] ifFalse:[
+	documentFormat := 'a4'.
+	scaleMetric := #mm
     ].
-    ^ frameAll
+!
+
+initEvents
+    self backingStore:true.
+    self enableButtonEvents.
+    self enableButtonMotionEvents
 !
 
-isObscured:something
-    "return true, if the argument something, anObject or a collection of
-     objects is obscured (partially or whole) by any other object"
+initialize
+    |pixPerMM|
+
+    super initialize.
+
+    viewBackground := White.
+
+    bitGravity := #NorthWest.
+    contents := OrderedCollection new.
+    gridShown := false.
+
+    canDragOutOfView := false.
+    rootView := DisplayRootView new.
+    rootView noClipByChildren.
+    rootMotion := false.
+    self setInitialDocumentFormat.
+
+    readCursor := Cursor read.
+    leftHandCursor := Cursor leftHand.
+    sorted := false.
+    aligning := false
+! !
+
+!ObjectView methodsFor:'adding / removing'!
+
+addWithoutRedraw:something
+    "add something, anObject or a collection of objects to the contents
+     do not redraw"
 
     self forEach:something do:[:anObject |
-	(self objectIsObscured:anObject) ifTrue:[
-	    ^ true
-	]
-    ].
-    ^ false
-!
-
-findObjectAt:aPoint
-    "find the last object (by looking from back to front) which is hit by
-     the argument, aPoint - this is the topmost object hit"
-
-    |hdelta|
-
-    hdelta := self class hitDelta.
-    contents reverseDo:[:object |
-	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
-    ].
-    ^ nil
-!
-
-findObjectAtVisible:aPoint
-    "find the last object (by looking from back to front) which is hit by
-     a visible point - this is the topmost object hit"
-
-    ^ self findObjectAt:(aPoint + self viewOrigin)
-!
-
-findObjectAt:aPoint suchThat:aBlock
-    "find the last object (back to front ) which is hit by
-     the argument, aPoint and for which the testBlock, aBlock evaluates to
-     true"
-
-    |hdelta|
-
-    hdelta := self class hitDelta.
-    contents reverseDo:[:object |
-	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
-	    (aBlock value:object) ifTrue:[^ object]
-	]
-    ].
-    ^ nil
-!
-
-findObjectAtVisible:aPoint suchThat:aBlock
-    "find the last object (back to front ) which is hit by
-     the argument, aPoint and for which the testBlock, aBlock evaluates to
-     true"
-
-    ^ self findObjectAt:(aPoint + self viewOrigin) suchThat:aBlock
-!
-
-canMove:something
-    "return true, if the argument, anObject or a collection can be moved"
-
-    (something isKindOf:Collection) ifTrue:[
-	self forEach:something do:[:theObject |
-	    (theObject canBeMoved) ifFalse:[^ false]
-	].
-	^ true
-    ].
-    ^ something canBeMoved
+	self addObjectWithoutRedraw:anObject
+    ]
 !
 
-isSelected:anObject
-    "return true, if the argument, anObject is in the selection"
-
-    selection isNil ifTrue:[^ false].
-    (selection == anObject) ifTrue:[^ true].
-    (selection isKindOf:Collection) ifTrue:[
-	^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
-    ].
-    ^ false
-!
-
-objectIsObscured:objectToBeTested
-    "return true, if the argument, anObject is obscured (partially or whole)
-     by any other object"
-
-    |frameToBeTested frameleft frameright frametop framebot
-     objectsFrame startIndex|
-
-    (objectToBeTested == (contents last)) ifTrue:[
-	"quick return if object is on top"
-	^ false
-    ].
-
-    frameToBeTested := self frameOf:objectToBeTested.
-    frameleft := frameToBeTested left.
-    frameright := frameToBeTested right.
-    frametop := frameToBeTested top.
-    framebot := frameToBeTested bottom.
-
-    "check objects after the one to check"
-
-    startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
-    contents from:(startIndex + 1) to:(contents size) do:[:object |
-	objectsFrame := self frameOf:object.
-	(objectsFrame right < frameleft) ifFalse:[
-	    (objectsFrame left > frameright) ifFalse:[
-		(objectsFrame bottom < frametop) ifFalse:[
-		    (objectsFrame top > framebot) ifFalse:[
-			^ true
-		    ]
-		]
-	    ]
-	]
-    ].
-    ^ false
-! !
-
-!ObjectView methodsFor:'misc'!
-
-forEach:aCollection do:aBlock
-    "apply block to every object in a collectioni;
-     (adds a check for non-collection)"
-
-    aCollection isNil ifTrue:[^self].
-    (aCollection isKindOf:Collection) ifTrue:[
-	aCollection do:[:object |
-	    object notNil ifTrue:[
-		aBlock value:object
-	    ]
-	]
-    ] ifFalse: [
-	aBlock value:aCollection
+addObjectWithoutRedraw:anObject
+    "add the argument, anObject to the contents - no redraw"
+
+    anObject notNil ifTrue:[
+	contents addLast:anObject
     ]
 !
 
-objectsIntersecting:aRectangle do:aBlock
-    "do something to every object which intersects a rectangle"
-
-    |f top bot
-     firstIndex "{ Class: SmallInteger }"
-     delta      "{ Class: SmallInteger }"
-     theObject 
-     nObjects   "{ Class: SmallInteger }"|
-
-    sorted ifFalse:[
-	"have to check every object"
-	contents do:[:theObject |
-	    (theObject frame intersects:aRectangle) ifTrue:[
-		aBlock value:theObject
-	    ]
-	].
-	^ self
+deleteSelection
+    "delete the selection"
+
+    buffer := selection.
+    self unselect.
+    self remove:buffer.
+!
+
+pasteBuffer
+    "add the objects in the paste-buffer"
+
+    self unselect.
+    self addSelected:buffer
+!
+
+copySelection
+    "copy the selection into the paste-buffer"
+
+    buffer := OrderedCollection new.
+    self selectionDo:[:object |
+	buffer add:(object copy)
     ].
-    nObjects := contents size.
-    (nObjects == 0) ifTrue:[^ self].
-
-    "can break, when 1st object below aRectangle is reached"
-    bot := aRectangle bottom.
-    top := aRectangle top.
-
-    "binary search an object in aRectangle ..."
-    delta := nObjects // 2.
-    firstIndex := delta.
-    (firstIndex == 0) ifTrue:[
-       firstIndex := 1
-    ].
-    theObject := contents at:firstIndex.
-    (theObject frame bottom < top) ifTrue:[
-	[theObject frame bottom < top and:[delta > 1]] whileTrue:[
-	    delta := delta // 2.
-	    firstIndex := firstIndex + delta.
-	    theObject := contents at:firstIndex
-	]
-    ] ifFalse:[
-	[theObject frame top > bot and:[delta > 1]] whileTrue:[
-	    delta := delta // 2.
-	    firstIndex := firstIndex - delta.
-	    theObject := contents at:firstIndex
-	]
-    ].
-    "now, theObject at:firstIndex is in aRectangle; go backward to the object
-     following first non-visible"
-
-    [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
-	firstIndex := firstIndex - 1.
-	theObject := contents at:firstIndex
-    ].
-
-    firstIndex to:nObjects do:[:index |
-	theObject := contents at:index.
-	f := theObject frame.
-	(f intersects:aRectangle) ifTrue:[
-	    aBlock value:theObject
-	] ifFalse:[
-	    (f top > bot) ifTrue:[^ self]
+    self forEach:buffer do:[:anObject |
+	anObject moveTo:(anObject origin + (8 @ 8))
+    ]
+!
+
+addSelected:something
+    "add something, anObject or a collection of objects to the contents
+     and select it"
+
+    self add:something.
+    self select:something
+!
+
+remove:something
+    "remove something, anObject or a collection of objects from the contents
+     do redraw"
+
+    self forEach:something do:[:anObject |
+	self removeObject:anObject
+    ]
+!
+
+removeObject:anObject
+    "remove the argument, anObject from the contents - no redraw"
+
+    anObject notNil ifTrue:[
+	self removeFromSelection:anObject.
+	contents remove:anObject.
+	shown "realized" ifTrue:[
+	    self redrawObjectsIn:(anObject frame)
 	]
     ]
 !
 
-setDefaultActions
-    motionAction := [:movePoint | nil].
-    releaseAction := [nil]
-!
-
-setMoveActions
-    motionAction := [:movePoint | self doObjectMove:movePoint].
-    releaseAction := [self endObjectMove]
-!
-
-objectsIntersectingVisible:aRectangle do:aBlock
-    "do something to every object which intersects a visible rectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:(aRectangle left + viewOrigin x)
-			  top:(aRectangle top + viewOrigin y)
-			width:(aRectangle width)
-		       height:(aRectangle height).
-    self objectsIntersecting:absRect do:aBlock
-!
-
-objectsIntersecting:aRectangle
-    "answer a Collection of objects intersecting the argument, aRectangle"
-
-    |newCollection|
-
-    newCollection := OrderedCollection new.
-    self objectsIntersecting:aRectangle do:[:theObject |
-	newCollection add:theObject
-    ].
-    (newCollection size == 0) ifTrue:[^ nil].
-    ^ newCollection
-!
-
-documentFormat:aFormatString
-    "set the document format (mostly used by scrollbars).
-     The argument should be a string such as 'a4', 'a5'
-     or 'letter'. See widthOfContentsInMM for supported formats."
-
-    aFormatString ~= documentFormat ifTrue:[
-	documentFormat := aFormatString.
-	self contentsChanged.
-	self defineGrid.
-	gridShown ifTrue:[
-	    self clear.
-	    self redraw
-	]
-    ]
-!
-
-setRectangleDragActions
-    motionAction := [:movePoint | self doRectangleDrag:movePoint].
-    releaseAction := [self endRectangleDrag]
-!
-
-setLineDragActions
-    motionAction := [:movePoint | self doLineDrag:movePoint].
-    releaseAction := [self endLineDrag]
-!
-
-objectsIn:aRectangle do:aBlock
-    "do something to every object which is completely in a rectangle"
-
-    |bot|
-
-    sorted ifTrue:[
-	bot := aRectangle bottom.
-	contents do:[:theObject |
-	    (theObject isContainedIn:aRectangle) ifTrue:[
-		aBlock value:theObject
-	    ] ifFalse:[
-		theObject frame top > bot ifTrue:[^ self]
-	    ]
-	].
-	^ self
-    ].
-
-    contents do:[:theObject |
-	(theObject isContainedIn:aRectangle) ifTrue:[
-	    aBlock value:theObject
+addObject:anObject
+    "add the argument, anObject to the contents - with redraw"
+
+    anObject notNil ifTrue:[
+	contents addLast:anObject.
+	"its on top - only draw this one"
+	shown "realized" ifTrue:[
+	    self showUnselected:anObject
 	]
     ]
 !
 
-objectsInVisible:aRectangle do:aBlock
-    "do something to every object which is completely in a 
-     visible rectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:(aRectangle left + viewOrigin x)
-			  top:(aRectangle top + viewOrigin y)
-			width:(aRectangle width)
-		       height:(aRectangle height).
-    self objectsIn:absRect do:aBlock
-!
-
-visibleObjectsDo:aBlock
-    "do something to every visible object"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:viewOrigin x
-			  top:viewOrigin y
-			width:width
-		       height:height.
-    self objectsIntersecting:absRect do:aBlock
-!
-
-numberOfObjectsIntersectingVisible:aRectangle
-    "answer the number of objects intersecting the argument, aRectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle
-		 left:(aRectangle left + viewOrigin x)
-		  top:(aRectangle top  + viewOrigin y)
-		width:(aRectangle width)
-	       height:(aRectangle height).
-
-    ^ self numberOfObjectsIntersecting:aRectangle
+add:something
+    "add something, anObject or a collection of objects to the contents
+     with redraw"
+
+    self forEach:something do:[:anObject |
+	self addObject:anObject
+    ]
 !
 
-numberOfObjectsIntersecting:aRectangle
-    "answer the number of objects intersecting the argument, aRectangle"
-
-    |tally|
-
-    tally := 0.
-    contents do:[:theObject |
-	(theObject frame intersects:aRectangle) ifTrue:[
-	    tally := tally + 1
-	]
-    ].
-    ^ tally
-!
-
-objectsIntersectingVisible:aRectangle
-    "answer a Collection of objects intersecting a visible aRectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:(aRectangle left + viewOrigin x)
-			  top:(aRectangle top + viewOrigin y)
-			width:(aRectangle width)
-		       height:(aRectangle height).
-    ^ self objectsIntersecting:absRect
-!
-
-objectsBelow:objectToBeTested do:aBlock
-    "do something to every object below objectToBeTested
-     (does not mean obscured by - simply below in hierarchy)"
-
-    |endIndex|
-
-    endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
-    contents from:1 to:(endIndex - 1) do:aBlock
-!
-
-objectsAbove:objectToBeTested do:aBlock
-    "do something to every object above objectToBeTested
-     (does not mean obscured - simply above in hierarchy)"
-
-    |startIndex|
-
-    startIndex := contents identityIndexOf:objectToBeTested
-				  ifAbsent:[self error].
-    contents from:startIndex to:(contents size) do:aBlock
-!
-
-objectsAbove:anObject intersecting:aRectangle do:aBlock
-    "do something to every object above objectToBeTested
-     and intersecting aRectangle"
-
-    self objectsAbove:anObject do:[:theObject |
-	(theObject frame intersects:aRectangle) ifTrue:[
-	    aBlock value:theObject
-	]
+removeWithoutRedraw:something
+    "remove something, anObject or a collection of objects from the contents
+     do not redraw"
+
+    self forEach:something do:[:anObject |
+	self removeObjectWithoutRedraw:anObject
     ]
 !
 
-rectangleForScroll
-    "find the area occupied by visible objects"
-
-    |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    orgX := viewOrigin x.
-    orgY := viewOrigin y.
-    left := 9999.
-    right := 0.
-    top := 9999.
-    bottom := 0.
-    self visibleObjectsDo:[:anObject |
-	frame := anObject frame.
-	oLeft := frame left - orgX.
-	oRight := frame right - orgX.
-	oTop := frame top - orgY.
-	oBottom := frame bottom - orgY.
-	(oLeft < left) ifTrue:[left := oLeft].
-	(oRight > right) ifTrue:[right := oRight].
-	(oTop < top) ifTrue:[top := oTop].
-	(oBottom > bottom) ifTrue:[bottom := oBottom]
-    ].
-    (left < margin) ifTrue:[left := margin].
-    (top < margin) ifTrue:[top := margin].
-    (right > (width - margin)) ifTrue:[right := width - margin].
-    (bottom > (height - margin)) ifTrue:[bottom := height - margin].
-
-    ((left > right) or:[top > bottom]) ifTrue:[^ nil].
-
-    ^ Rectangle left:left right:right top:top bottom:bottom
+removeObjectWithoutRedraw:anObject
+    "remove the argument, anObject from the contents - no redraw"
+
+    anObject notNil ifTrue:[
+	self removeFromSelection:anObject.
+	contents remove:anObject
+    ]
+!
+
+removeAllWithoutRedraw
+    "remove all - no redraw"
+
+    selection := nil.
+    contents := OrderedCollection new
+!
+
+removeAll
+    "remove all - redraw"
+
+    self removeAllWithoutRedraw.
+    self redraw
 ! !
 
 !ObjectView methodsFor:'layout manipulation'!
 
-moveObject:anObject by:delta
-    "change the position of anObject by delta, aPoint"
-
-    self moveObject:anObject to:(anObject origin + delta)
-!
-
-move:something by:delta
-    "change the position of something, an Object or Collection 
-     by delta, aPoint"
-
-    (delta x == 0) ifTrue:[
-	(delta y == 0) ifTrue:[^ self]
-    ].
-
-    self forEach:something do:[:anObject |
-	self moveObject:anObject by:delta
-    ]
-!
-
 moveObject:anObject to:newOrigin
     "move anObject to newOrigin, aPoint"
 
@@ -1284,7 +1765,7 @@
 
     "if no other object intersects both frames we can do a copy:"
 
-    viewOrigin := self viewOrigin.
+    viewOrigin := 0@0 "self viewOrigin".
     intersects := oldFrame intersects:newFrame.
     intersects ifFalse:[
 	gridShown ifFalse:[
@@ -1302,6 +1783,7 @@
 			    h := oldFrame height.
 			    ((newLeft < width) and:[newTop < height]) ifTrue:[
 				((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
+				    self catchExpose.
 				    self copyFrom:self x:oldLeft y:oldTop
 						     toX:newLeft y:newTop
 						   width:w height:h.
@@ -1341,6 +1823,25 @@
     ]
 !
 
+move:something by:delta
+    "change the position of something, an Object or Collection 
+     by delta, aPoint"
+
+    (delta x == 0) ifTrue:[
+	(delta y == 0) ifTrue:[^ self]
+    ].
+
+    self forEach:something do:[:anObject |
+	self moveObject:anObject by:delta
+    ]
+!
+
+moveObject:anObject by:delta
+    "change the position of anObject by delta, aPoint"
+
+    self moveObject:anObject to:(anObject origin + delta)
+!
+
 move:something to:aPoint in:aView
     "can only happen when dragOutOfView is true
      - should be redefined in subclasses"
@@ -1498,143 +1999,88 @@
     self alignBottom:selection
 ! !
 
-!ObjectView methodsFor:'adding / removing'!
-
-deleteSelection
-    "delete the selection"
-
-    buffer := selection.
-    self unselect.
-    self remove:buffer.
-!
-
-pasteBuffer
-    "add the objects in the paste-buffer"
-
-    self unselect.
-    self addSelected:buffer
-!
-
-copySelection
-    "copy the selection into the paste-buffer"
-
-    buffer := OrderedCollection new.
-    self selectionDo:[:object |
-	buffer add:(object copy)
-    ].
-    self forEach:buffer do:[:anObject |
-	anObject moveTo:(anObject origin + (8 @ 8))
-    ]
+!ObjectView methodsFor:'dragging rectangle'!
+
+endRectangleDrag
+    "cleanup after rectangle drag; select them"
+
+    self invertDragRectangle.
+    self cursor:oldCursor.
+    self selectAllIn:(dragObject "+ self viewOrigin")
 !
 
-addSelected:something
-    "add something, anObject or a collection of objects to the contents
-     and select it"
-
-    self add:something.
-    self select:something
-!
-
-addWithoutRedraw:something
-    "add something, anObject or a collection of objects to the contents
-     do not redraw"
-
-    self forEach:something do:[:anObject |
-	self addObjectWithoutRedraw:anObject
-    ]
-!
-
-addObject:anObject
-    "add the argument, anObject to the contents - with redraw"
-
-    anObject notNil ifTrue:[
-	contents addLast:anObject.
-	"its on top - only draw this one"
-	shown "realized" ifTrue:[
-	    self showUnselected:anObject
-	]
-    ]
+invertDragRectangle
+    "helper for rectangle drag - invert the dragRectangle.
+     Extracted into a separate method to allow easier redefinition
+     (different lineWidth etc)"
+
+    self xoring:[self lineWidth:0. self displayRectangle:dragObject].
 !
 
-addObjectWithoutRedraw:anObject
-    "add the argument, anObject to the contents - no redraw"
-
-    anObject notNil ifTrue:[
-	contents addLast:anObject
-    ]
-!
-
-add:something
-    "add something, anObject or a collection of objects to the contents
-     with redraw"
-
-    self forEach:something do:[:anObject |
-	self addObject:anObject
-    ]
-!
-
-remove:something
-    "remove something, anObject or a collection of objects from the contents
-     do redraw"
-
-    self forEach:something do:[:anObject |
-	self removeObject:anObject
-    ]
+startRectangleDrag:startPoint
+    "start a rectangle drag"
+
+    self setRectangleDragActions.
+    dragObject := Rectangle origin:startPoint corner:startPoint.
+    self invertDragRectangle.
+    oldCursor := cursor.
+    self cursor:leftHandCursor
 !
 
-removeObject:anObject
-    "remove the argument, anObject from the contents - no redraw"
-
-    anObject notNil ifTrue:[
-	self removeFromSelection:anObject.
-	contents remove:anObject.
-	shown "realized" ifTrue:[
-	    self redrawObjectsIn:(anObject frame)
-	]
-    ]
-!
-
-removeWithoutRedraw:something
-    "remove something, anObject or a collection of objects from the contents
-     do not redraw"
-
-    self forEach:something do:[:anObject |
-	self removeObjectWithoutRedraw:anObject
-    ]
-!
-
-removeObjectWithoutRedraw:anObject
-    "remove the argument, anObject from the contents - no redraw"
-
-    anObject notNil ifTrue:[
-	self removeFromSelection:anObject.
-	contents remove:anObject
-    ]
-!
-
-removeAllWithoutRedraw
-    "remove all - no redraw"
-
-    selection := nil.
-    contents := OrderedCollection new
-!
-
-removeAll
-    "remove all - redraw"
-
-    self removeAllWithoutRedraw.
-    self redraw
+doRectangleDrag:aPoint
+    "do drag a rectangle"
+
+    self invertDragRectangle.
+    dragObject corner:aPoint.
+    self invertDragRectangle.
 ! !
 
 !ObjectView methodsFor:'view manipulation'!
 
+zoom:factor
+    "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
+     0.5 is shrink by 2"
+
+    |current|
+
+    transformation isNil ifTrue:[
+	current := 1@1
+    ] ifFalse:[
+	current := transformation scale
+    ].
+    factor asPoint = current asPoint ifTrue:[
+	^ self
+    ].
+    current := factor.
+    current isNil ifTrue:[
+	current := 1
+    ].
+
+    (current = 1) ifTrue:[
+	transformation := nil
+    ] ifFalse:[
+	transformation := WindowingTransformation scale:current translation:0.
+    ].
+    self contentsChanged.
+    self setInnerClip.
+    gridShown ifTrue:[
+	self newGrid
+    ].
+    shown ifTrue:[
+	self clear.
+	self redraw
+    ].
+!
+
 zoomIn
     transformation isNil ifTrue:[
 	transformation := WindowingTransformation scale:1 translation:0
     ].
     transformation := WindowingTransformation scale:(transformation scale / 2)
 					      translation:0.
-    self redraw
+    self contentsChanged.
+    self setInnerClip.
+    self redraw.
 !
 
 zoomOut
@@ -1643,29 +2089,11 @@
     ].
     transformation := WindowingTransformation scale:(transformation scale * 2)
 					      translation:0.
+    self contentsChanged.
+    self setInnerClip.
     self redraw
 !
 
-zoom:factor
-    "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
-     0.5 is shrink by 2"
-
-    (factor isNil or:[factor = 1]) ifTrue:[
-	transformation := nil
-    ] ifFalse:[
-	transformation := WindowingTransformation scale:factor translation:0.
-    ].
-    self setInnerClip.
-    gridShown ifTrue:[
-	self newGrid
-    ].
-    shown ifTrue:[
-	self clear.
-	self redraw
-    ].
-    self contentsChanged
-!
-
 millimeterMetric
     (scaleMetric ~~ #mm) ifTrue:[
 	scaleMetric := #mm.
@@ -1682,6 +2110,24 @@
 
 !ObjectView methodsFor:'grid manipulation'!
 
+newGrid
+    "define a new grid"
+
+    gridPixmap := nil.
+    shown ifTrue:[
+	self viewBackground:White.
+	self clear.
+    ].
+
+    gridShown ifTrue:[
+	self defineGrid.
+	self viewBackground:gridPixmap.
+    ].
+    shown ifTrue:[
+	self redraw
+    ].
+!
+
 gridParameters
     "used by defineGrid, and in a separate method for
      easier redefinition in subclasses. 
@@ -1880,24 +2326,6 @@
     ]
 !
 
-newGrid
-    "define a new grid"
-
-    gridPixmap := nil.
-    shown ifTrue:[
-	self viewBackground:White.
-	self clear.
-    ].
-
-    gridShown ifTrue:[
-	self defineGrid.
-	self viewBackground:gridPixmap.
-    ].
-    shown ifTrue:[
-	self redraw
-    ].
-!
-
 showGrid
     "show the grid"
 
@@ -1934,42 +2362,6 @@
     aligning := false
 ! !
 
-!ObjectView methodsFor:'dragging rectangle'!
-
-startRectangleDrag:startPoint
-    "start a rectangle drag"
-
-    self setRectangleDragActions.
-    dragObject := Rectangle origin:startPoint corner:startPoint.
-    self invertDragRectangle.
-    oldCursor := cursor.
-    self cursor:leftHandCursor
-!
-
-endRectangleDrag
-    "cleanup after rectangle drag; select them"
-
-    self invertDragRectangle.
-    self cursor:oldCursor.
-    self selectAllIn:(dragObject + self viewOrigin)
-!
-
-doRectangleDrag:aPoint
-    "do drag a rectangle"
-
-    self invertDragRectangle.
-    dragObject corner:aPoint.
-    self invertDragRectangle.
-!
-
-invertDragRectangle
-    "helper for rectangle drag - invert the dragRectangle.
-     Extracted into a separate method to allow easier redefinition
-     (different lineWidth etc)"
-
-    self xoring:[self displayRectangle:dragObject].
-! !
-
 !ObjectView methodsFor:'dragging line'!
 
 startLineDrag:startPoint
@@ -1996,17 +2388,14 @@
 doLineDrag:aPoint
     "do drag a line"
 
-    |dragger top offs2 org|
+    |dragger top org|
 
     rootMotion ifTrue:[
 	dragger := rootView.
-	offs2 := self viewOrigin.
 	top := self topView.
 	org := device translatePoint:0@0 from:(self id) to:(rootView id).
-	offs2 := offs2 - org
     ] ifFalse:[
 	dragger := self.
-	offs2 := 0@0.
     ].
 
     self invertDragLine.
@@ -2024,7 +2413,7 @@
 
     rootMotion ifTrue:[
 	dragger := rootView.
-	offs2 := self viewOrigin.
+	offs2 := 0@0 "self viewOrigin".
 	top := self topView.
 	org := device translatePoint:0@0 from:(self id) to:(rootView id).
 	offs2 := offs2 - org
@@ -2114,146 +2503,7 @@
      Extracted for easier redefinition in subclasses
      (different line width etc.)"
 
-    self xoring:[self displayLineFrom:dragObject origin to:dragObject corner].
-! !
-
-!ObjectView methodsFor:'dragging object move'!
-
-startObjectMove:something at:aPoint
-    "start an object move"
-
-    something notNil ifTrue:[
-	self select:something.
-	(self canMove:something) ifTrue:[
-	    self setMoveActions.
-	    moveStartPoint := aPoint.
-	    rootMotion := canDragOutOfView.
-	    "self doObjectMove:aPoint "
-	] ifFalse:[
-	    self setDefaultActions
-	]
-    ]
-!
-
-endObjectMove
-    "cleanup after object move - find the destination view and dispatch to
-     one of the moveObjectXXX-methods. These can be redefined in subclasses."
-
-    |dragger inMySelf offs2 rootPoint destinationPoint
-     viewId destinationView destinationId lastViewId|
-
-    movedObject notNil ifTrue:[
-	rootMotion ifTrue:[
-	    dragger := rootView.
-	    offs2 := self viewOrigin
-	] ifFalse:[
-	    dragger := self.
-	    offs2 := 0@0
-	].
-	dragger xoring:[
-	    self showDragging:movedObject offset:moveDelta - offs2
-	].
-	dragger device synchronizeOutput.
-
-	"check if object is to be put into another view"
-	rootMotion ifTrue:[
-	    rootPoint := device translatePoint:lastButt
-					  from:(self id) 
-					    to:(rootView id).
-	    "search view the drop is in"
-	    viewId := rootView id.
-	    [viewId notNil] whileTrue:[
-		destinationId := device viewIdFromPoint:rootPoint in:viewId.
-		lastViewId := viewId.
-		viewId := destinationId
-	    ].
-	    destinationView := device viewFromId:lastViewId.
-	    destinationId := lastViewId.
-	    inMySelf := (destinationView == self).
-	    rootMotion := false
-	] ifFalse:[
-	    inMySelf := true
-	].
-	inMySelf ifTrue:[
-	    "simple move"
-	    self move:movedObject by:moveDelta
-	] ifFalse:[
-	    destinationPoint := device translatePoint:rootPoint
-						 from:(rootView id) 
-						   to:destinationId.
-	    destinationView notNil ifTrue:[
-		"
-		 move into another smalltalk view
-		"
-		self move:movedObject to:destinationPoint in:destinationView
-	    ] ifFalse:[
-		"
-		 not one of my views
-		"
-		self move:movedObject to:destinationPoint inAlienViewId:destinationId
-	    ] 
-	].
-	self setDefaultActions.
-	movedObject := nil
-    ]
-!
-
-doObjectMove:aPoint
-    "do an object move.
-     moveStartPoint is the original click-point.
-     moveDelta"
-
-    |dragger offset d p|
-
-    rootMotion ifTrue:[
-	dragger := rootView.
-	offset := self viewOrigin.
-    ] ifFalse:[
-	dragger := self.
-	offset := 0@0.
-    ].
-
-    "
-     when drawing in the root window, we have to use its coordinates
-     this is kept in offset.
-    "
-    movedObject isNil ifTrue:[
-	movedObject := selection.
-	"
-	 draw first outline
-	"
-	movedObject notNil ifTrue:[
-	    moveDelta := 0@0.
-
-	    dragger xoring:[
-		"tricky, the moved object may not currently be aligned.
-		 if so, simulate a frame move of the delta"
-
-		aligning ifTrue:[
-		    d := movedObject origin 
-			 - (self alignToGrid:(movedObject origin)).
-"/ d printNL.
-		    moveDelta := d negated.
-		].
-"/ moveDelta printNL.
-		self showDragging:movedObject offset:moveDelta - offset.
-	    ]
-	]
-    ].
-    movedObject notNil ifTrue:[
-	"
-	 clear prev outline,
-	 draw new outline
-	"
-	dragger xoring:[
-	    self showDragging:movedObject offset:moveDelta - offset.
-	    moveDelta := aPoint - moveStartPoint.
-	    aligning ifTrue:[
-		moveDelta := self alignToGrid:moveDelta
-	    ].
-	    self showDragging:movedObject offset:moveDelta - offset.
-	]
-    ]
+    self xoring:[self lineWidth:0. self displayLineFrom:dragObject origin to:dragObject corner].
 ! !
 
 !ObjectView methodsFor:'saving / restoring'!

--- a/ObjectView.st	Mon Nov 28 22:05:43 1994 +0100
+++ b/ObjectView.st	Wed Dec 21 20:19:42 1994 +0100
@@ -10,16 +10,15 @@
  hereby transferred.
 "
 
-'From Smalltalk/X, Version:2.10.4 on 7-nov-1994 at 1:19:10'!
+'From Smalltalk/X, Version:2.10.4 on 30-nov-1994 at 3:38:24 pm'!
 
 View subclass:#ObjectView
 	 instanceVariableNames:'contents sorted lastButt lastPointer lastButtonTime pressAction
 		releaseAction shiftPressAction doublePressAction motionAction
-		keyPressAction selection gridShown gridPixmap 
-		scaleMetric dragObject leftHandCursor readCursor oldCursor
-		movedObject moveStartPoint moveDelta buffer documentFormat
-		canDragOutOfView rootMotion
-		rootView aligning gridAlign'
+		keyPressAction selection gridShown gridPixmap scaleMetric
+		dragObject leftHandCursor readCursor oldCursor movedObject
+		moveStartPoint moveDelta buffer documentFormat canDragOutOfView
+		rootMotion rootView aligning gridAlign'
 	 classVariableNames:''
 	 poolDictionaries:''
 	 category:'Views-Basic'
@@ -48,7 +47,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.16 1994-11-28 21:05:10 claus Exp $
+$Header: /cvs/stx/stx/libwidg/ObjectView.st,v 1.17 1994-12-21 19:19:42 claus Exp $
 "
 !
 
@@ -71,6 +70,554 @@
     ^ 0
 ! !
 
+!ObjectView methodsFor:'scrolling'!
+
+viewOrigin
+    transformation isNil ifTrue:[
+	^ 0@0
+    ].
+    ^ transformation translation negated
+!
+
+setViewOrigin:aPoint
+    |p|
+
+    p := aPoint negated.
+    transformation isNil ifTrue:[
+	transformation := WindowingTransformation scale:1 translation:p 
+    ] ifFalse:[
+	transformation translation:p 
+    ].
+"/    clipRect notNil ifTrue:[
+"/        self computeInnerClip.
+"/    ].
+!
+
+scrollDown:nPixels
+    "change origin to scroll down some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     w     "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }"
+     hCont "{ Class:SmallInteger }"
+     ih    "{ Class:SmallInteger }"
+     orgX orgY|
+
+    hCont := self heightOfContents.
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+    ].
+
+    count := nPixels.
+    ih := self innerHeight.
+
+    ((orgY + nPixels + ih) > hCont) ifTrue:[
+	count := hCont - orgY - ih
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX @ (orgY + count)).
+
+    (count >= ih) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2.
+	h := height - m2 - count.
+	w := self width.
+	self catchExpose.
+	self copyFrom:self x:margin y:(count + margin)
+			 toX:margin y:margin
+		       width:w 
+		      height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:margin y:(h + margin) 
+		     width:(width - m2) height:count.
+
+	self waitForExpose.
+    ].
+    self originChanged:(0 @ count).
+!
+
+scrollUp:nPixels
+    "change origin to scroll up (towards the origin) by some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     w     "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }"
+     orgX
+     orgY  "{ Class:SmallInteger }"|
+
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated
+    ].
+
+    count := nPixels.
+    (count > orgY) ifTrue:[
+	count := orgY
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX @ (orgY - count)).
+
+    (count >= self innerHeight) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2. "top & bottom margins"
+	h := height - m2 - count.
+	w := width.
+	self catchExpose.
+	self copyFrom:self x:margin y:margin
+			 toX:margin y:(count + margin)
+		       width:w height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:margin y:margin
+		     width:(width - m2)
+		    height:count.
+
+	self waitForExpose.
+    ].
+    self originChanged:(0 @ count negated).
+!
+
+scrollLeft:nPixels
+    "change origin to scroll left some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }"
+     orgX orgY|
+
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+    ].
+
+    count := nPixels.
+    (count > orgX) ifTrue:[
+	count := orgX
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX - count) @ orgY.
+
+    (count >= self innerWidth) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2.
+	h := (height - m2).
+
+	self catchExpose.
+	self copyFrom:self x:margin y:margin
+			 toX:(count + margin) y:margin
+		       width:(width - m2 - count) 
+		      height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:margin y:margin
+		     width:count height:(height - m2).
+
+	self waitForExpose.
+    ].
+    self originChanged:(count negated @ 0).
+!
+
+scrollRight:nPixels
+    "change origin to scroll right some pixels"
+
+    |count "{ Class:SmallInteger }"
+     m2    "{ Class:SmallInteger }"
+     h     "{ Class:SmallInteger }" 
+     wCont "{ Class:SmallInteger }"
+     iw    "{ Class:SmallInteger }"
+     orgX orgY|
+
+    wCont := self widthOfContents.
+    transformation isNil ifTrue:[
+	orgY := orgX := 0
+    ] ifFalse:[
+	orgY := transformation translation y negated.
+	orgX := transformation translation x negated.
+    ].
+
+
+    count := nPixels.
+    iw := self innerWidth.
+
+    ((orgX + nPixels + iw) > wCont) ifTrue:[
+	count := wCont - orgX - iw
+    ].
+    (count <= 0) ifTrue:[^ self].
+
+    self originWillChange.
+    self setViewOrigin:(orgX + count) @ orgY.
+
+    (count >= iw) ifTrue:[
+	self redraw.
+    ] ifFalse:[
+	m2 := margin * 2.
+	h := (height - m2).
+
+	self catchExpose.
+	self copyFrom:self x:(count + margin) y:margin
+			 toX:margin y:margin
+		       width:(width - m2 - count) 
+		      height:h.
+
+	self setInnerClip.
+	self redrawDeviceX:(width - margin - count) y:margin 
+		     width:count height:(height - m2).
+
+	self waitForExpose.
+    ].
+    self originChanged:(count @ 0).
+!
+
+verticalScrollStep
+    "return the amount to scroll when stepping left/right."
+
+    scaleMetric == #inch ifTrue:[
+	^ (device verticalPixelPerInch * (1/2)) asInteger
+    ].
+    ^ (device verticalPixelPerMillimeter * 20) asInteger
+!
+
+horizontalScrollStep
+    "return the amount to scroll when stepping left/right."
+
+    scaleMetric == #inch ifTrue:[
+	^ (device horizontalPixelPerInch * (1/2)) asInteger
+    ].
+    ^ (device horizontalPixelPerMillimeter * 20) asInteger
+! !
+
+!ObjectView methodsFor:'misc'!
+
+objectsIntersecting:aRectangle do:aBlock
+    "do something to every object which intersects a rectangle"
+
+    |f top bot
+     firstIndex "{ Class: SmallInteger }"
+     delta      "{ Class: SmallInteger }"
+     theObject 
+     nObjects   "{ Class: SmallInteger }"|
+
+    nObjects := contents size.
+    (nObjects == 0) ifTrue:[^ self].
+
+    sorted ifFalse:[
+	"
+	 have to check every object
+	"
+	contents do:[:theObject |
+	    (theObject frame intersects:aRectangle) ifTrue:[
+		aBlock value:theObject
+	    ]
+	].
+	^ self
+    ].
+
+    "
+     contents is sorted by y; can do a fast (binary) search for the first
+     object which intersects aRectangle and 
+     break from the draw loop, when the 1st object below aRectangle is reached.
+    "
+    bot := aRectangle bottom.
+    top := aRectangle top.
+
+    "
+     binary search for an object in aRectangle ...
+    "
+    delta := nObjects // 2.
+    firstIndex := delta.
+    (firstIndex == 0) ifTrue:[
+       firstIndex := 1
+    ].
+    theObject := contents at:firstIndex.
+    (theObject frame bottom < top) ifTrue:[
+	[theObject frame bottom < top and:[delta > 1]] whileTrue:[
+	    delta := delta // 2.
+	    firstIndex := firstIndex + delta.
+	    theObject := contents at:firstIndex
+	]
+    ] ifFalse:[
+	[theObject frame top > bot and:[delta > 1]] whileTrue:[
+	    delta := delta // 2.
+	    firstIndex := firstIndex - delta.
+	    theObject := contents at:firstIndex
+	]
+    ].
+
+    "
+     now, theObject at:firstIndex is in aRectangle; go backward to the object
+     following first non-visible
+    "
+    [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
+	firstIndex := firstIndex - 1.
+	theObject := contents at:firstIndex
+    ].
+
+    firstIndex to:nObjects do:[:index |
+	theObject := contents at:index.
+	f := theObject frame.
+	(f intersects:aRectangle) ifTrue:[
+	    aBlock value:theObject
+	] ifFalse:[
+	    (f top > bot) ifTrue:[^ self]
+	]
+    ]
+!
+
+forEach:aCollection do:aBlock
+    "apply block to every object in a collectioni;
+     (adds a check for non-collection)"
+
+    aCollection isNil ifTrue:[^self].
+    (aCollection isKindOf:Collection) ifTrue:[
+	aCollection do:[:object |
+	    object notNil ifTrue:[
+		aBlock value:object
+	    ]
+	]
+    ] ifFalse: [
+	aBlock value:aCollection
+    ]
+!
+
+objectsIntersectingVisible:aRectangle do:aBlock
+    "do something to every object which intersects a visible rectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:(aRectangle left + viewOrigin x)
+			  top:(aRectangle top + viewOrigin y)
+			width:(aRectangle width)
+		       height:(aRectangle height).
+    self objectsIntersecting:absRect do:aBlock
+!
+
+setDefaultActions
+    motionAction := [:movePoint | nil].
+    releaseAction := [nil]
+!
+
+objectsIntersecting:aRectangle
+    "answer a Collection of objects intersecting the argument, aRectangle"
+
+    |newCollection|
+
+    newCollection := OrderedCollection new.
+    self objectsIntersecting:aRectangle do:[:theObject |
+	newCollection add:theObject
+    ].
+    (newCollection size == 0) ifTrue:[^ nil].
+    ^ newCollection
+!
+
+setMoveActions
+    motionAction := [:movePoint | self doObjectMove:movePoint].
+    releaseAction := [self endObjectMove]
+!
+
+setRectangleDragActions
+    motionAction := [:movePoint | self doRectangleDrag:movePoint].
+    releaseAction := [self endRectangleDrag]
+!
+
+objectsIn:aRectangle do:aBlock
+    "do something to every object which is completely in a rectangle"
+
+    |bot|
+
+    sorted ifTrue:[
+	bot := aRectangle bottom.
+	contents do:[:theObject |
+	    (theObject isContainedIn:aRectangle) ifTrue:[
+		aBlock value:theObject
+	    ] ifFalse:[
+		theObject frame top > bot ifTrue:[^ self]
+	    ]
+	].
+	^ self
+    ].
+
+    contents do:[:theObject |
+	(theObject isContainedIn:aRectangle) ifTrue:[
+	    aBlock value:theObject
+	]
+    ]
+!
+
+documentFormat:aFormatString
+    "set the document format (mostly used by scrollbars).
+     The argument should be a string such as 'a4', 'a5'
+     or 'letter'. See widthOfContentsInMM for supported formats."
+
+    aFormatString ~= documentFormat ifTrue:[
+	documentFormat := aFormatString.
+	self contentsChanged.
+	self defineGrid.
+	gridShown ifTrue:[
+	    self clear.
+	    self redraw
+	]
+    ]
+!
+
+setLineDragActions
+    motionAction := [:movePoint | self doLineDrag:movePoint].
+    releaseAction := [self endLineDrag]
+!
+
+objectsInVisible:aRectangle do:aBlock
+    "do something to every object which is completely in a 
+     visible rectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:(aRectangle left + viewOrigin x)
+			  top:(aRectangle top + viewOrigin y)
+			width:(aRectangle width)
+		       height:(aRectangle height).
+    self objectsIn:absRect do:aBlock
+!
+
+visibleObjectsDo:aBlock
+    "do something to every visible object"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:viewOrigin x
+			  top:viewOrigin y
+			width:width
+		       height:height.
+    self objectsIntersecting:absRect do:aBlock
+!
+
+numberOfObjectsIntersectingVisible:aRectangle
+    "answer the number of objects intersecting the argument, aRectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle
+		 left:(aRectangle left + viewOrigin x)
+		  top:(aRectangle top  + viewOrigin y)
+		width:(aRectangle width)
+	       height:(aRectangle height).
+
+    ^ self numberOfObjectsIntersecting:aRectangle
+!
+
+numberOfObjectsIntersecting:aRectangle
+    "answer the number of objects intersecting the argument, aRectangle"
+
+    |tally|
+
+    tally := 0.
+    contents do:[:theObject |
+	(theObject frame intersects:aRectangle) ifTrue:[
+	    tally := tally + 1
+	]
+    ].
+    ^ tally
+!
+
+objectsIntersectingVisible:aRectangle
+    "answer a Collection of objects intersecting a visible aRectangle"
+
+    |absRect viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    absRect := Rectangle left:(aRectangle left + viewOrigin x)
+			  top:(aRectangle top + viewOrigin y)
+			width:(aRectangle width)
+		       height:(aRectangle height).
+    ^ self objectsIntersecting:absRect
+!
+
+objectsBelow:objectToBeTested do:aBlock
+    "do something to every object below objectToBeTested
+     (does not mean obscured by - simply below in hierarchy)"
+
+    |endIndex|
+
+    endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
+    contents from:1 to:(endIndex - 1) do:aBlock
+!
+
+objectsAbove:objectToBeTested do:aBlock
+    "do something to every object above objectToBeTested
+     (does not mean obscured - simply above in hierarchy)"
+
+    |startIndex|
+
+    startIndex := contents identityIndexOf:objectToBeTested
+				  ifAbsent:[self error].
+    contents from:startIndex to:(contents size) do:aBlock
+!
+
+objectsAbove:anObject intersecting:aRectangle do:aBlock
+    "do something to every object above objectToBeTested
+     and intersecting aRectangle"
+
+    self objectsAbove:anObject do:[:theObject |
+	(theObject frame intersects:aRectangle) ifTrue:[
+	    aBlock value:theObject
+	]
+    ]
+!
+
+rectangleForScroll
+    "find the area occupied by visible objects"
+
+    |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
+
+    viewOrigin := 0@0. "/self viewOrigin.
+    orgX := 0 . "/viewOrigin x.
+    orgY := 0 . "/viewOrigin y.
+    left := 9999.
+    right := 0.
+    top := 9999.
+    bottom := 0.
+    self visibleObjectsDo:[:anObject |
+	frame := anObject frame.
+	oLeft := frame left - orgX.
+	oRight := frame right - orgX.
+	oTop := frame top - orgY.
+	oBottom := frame bottom - orgY.
+	(oLeft < left) ifTrue:[left := oLeft].
+	(oRight > right) ifTrue:[right := oRight].
+	(oTop < top) ifTrue:[top := oTop].
+	(oBottom > bottom) ifTrue:[bottom := oBottom]
+    ].
+    (left < margin) ifTrue:[left := margin].
+    (top < margin) ifTrue:[top := margin].
+    (right > (width - margin)) ifTrue:[right := width - margin].
+    (bottom > (height - margin)) ifTrue:[bottom := height - margin].
+
+    ((left > right) or:[top > bottom]) ifTrue:[^ nil].
+
+    ^ Rectangle left:left right:right top:top bottom:bottom
+! !
+
 !ObjectView methodsFor:'event handling'!
 
 redrawX:x y:y width:w height:h
@@ -88,6 +635,31 @@
     ]
 !
 
+redrawDeviceX:x y:y width:w height:h
+super redrawDeviceX:x y:y width:w height:h
+!
+
+buttonPress:button x:x y:y
+    "user pressed left button"
+
+    ((button == 1) or:[button == #select]) ifTrue:[
+	pressAction notNil ifTrue:[
+	    lastButt := x @ y.
+	    pressAction value:lastButt
+	]
+    ] ifFalse:[
+	super buttonPress:button x:x y:y
+    ]
+!
+
+buttonRelease:button x:x y:y
+    ((button == 1) or:[button == #select]) ifTrue:[
+	releaseAction notNil ifTrue:[releaseAction value]
+    ] ifFalse:[
+	super buttonRelease:button x:x y:y
+    ] 
+!
+
 buttonMotion:buttonMask x:buttX y:buttY
     "user moved mouse while button pressed"
 
@@ -139,27 +711,18 @@
     ]
 !
 
-buttonPress:button x:x y:y
-    "user pressed left button"
+buttonMultiPress:button x:x y:y
+    "user pressed left button twice (or more)"
 
     ((button == 1) or:[button == #select]) ifTrue:[
-	pressAction notNil ifTrue:[
-	    lastButt := x @ y.
-	    pressAction value:lastButt
+	doublePressAction notNil ifTrue:[
+	    doublePressAction value:(x @ y)
 	]
     ] ifFalse:[
-	super buttonPress:button x:x y:y
+	super buttonMultiPress:button x:x y:y
     ]
 !
 
-buttonRelease:button x:x y:y
-    ((button == 1) or:[button == #select]) ifTrue:[
-	releaseAction notNil ifTrue:[releaseAction value]
-    ] ifFalse:[
-	super buttonRelease:button x:x y:y
-    ] 
-!
-
 buttonShiftPress:button x:x y:y
     "user pressed left button with shift"
 
@@ -173,18 +736,6 @@
     ]
 !
 
-buttonMultiPress:button x:x y:y
-    "user pressed left button twice (or more)"
-
-    ((button == 1) or:[button == #select]) ifTrue:[
-	doublePressAction notNil ifTrue:[
-	    doublePressAction value:(x @ y)
-	]
-    ] ifFalse:[
-	super buttonMultiPress:button x:x y:y
-    ]
-!
-
 keyPress:key x:x y:y
     keyPressAction notNil ifTrue:[
 	selection notNil ifTrue:[
@@ -195,24 +746,364 @@
     ]
 ! !
 
-!ObjectView methodsFor:'scrolling'!
-
-horizontalScrollStep
-    "return the amount to scroll when stepping left/right."
-
-    scaleMetric == #inch ifTrue:[
-	^ (device horizontalPixelPerInch * (1/2)) asInteger
+!ObjectView methodsFor:'dragging object move'!
+
+doObjectMove:aPoint
+    "do an object move.
+     moveStartPoint is the original click-point.
+     moveDelta"
+
+    |dragger offset d p|
+
+    rootMotion ifTrue:[
+	dragger := rootView.
+	offset := 0@0 "self viewOrigin".
+    ] ifFalse:[
+	dragger := self.
+	offset := 0@0.
+    ].
+
+    "
+     when drawing in the root window, we have to use its coordinates
+     this is kept in offset.
+    "
+    movedObject isNil ifTrue:[
+	movedObject := selection.
+	"
+	 draw first outline
+	"
+	movedObject notNil ifTrue:[
+	    moveDelta := 0@0.
+
+	    dragger xoring:[
+		"tricky, the moved object may not currently be aligned.
+		 if so, simulate a frame move of the delta"
+
+		aligning ifTrue:[
+		    d := movedObject origin 
+			 - (self alignToGrid:(movedObject origin)).
+"/ d printNL.
+		    moveDelta := d negated.
+		].
+"/ moveDelta printNL.
+		self showDragging:movedObject offset:moveDelta - offset.
+	    ]
+	]
+    ].
+    movedObject notNil ifTrue:[
+	"
+	 clear prev outline,
+	 draw new outline
+	"
+	dragger xoring:[
+	    self showDragging:movedObject offset:moveDelta - offset.
+	    moveDelta := aPoint - moveStartPoint.
+	    aligning ifTrue:[
+		moveDelta := self alignToGrid:moveDelta
+	    ].
+	    self showDragging:movedObject offset:moveDelta - offset.
+	]
+    ]
+!
+
+endObjectMove
+    "cleanup after object move - find the destination view and dispatch to
+     one of the moveObjectXXX-methods. These can be redefined in subclasses."
+
+    |dragger inMySelf offs2 rootPoint destinationPoint
+     viewId destinationView destinationId lastViewId|
+
+    movedObject notNil ifTrue:[
+	rootMotion ifTrue:[
+	    dragger := rootView.
+	    offs2 := 0@0 "self viewOrigin"
+	] ifFalse:[
+	    dragger := self.
+	    offs2 := 0@0
+	].
+	dragger xoring:[
+	    self showDragging:movedObject offset:moveDelta - offs2
+	].
+	dragger device synchronizeOutput.
+
+	"check if object is to be put into another view"
+	rootMotion ifTrue:[
+	    rootPoint := device translatePoint:lastButt
+					  from:(self id) 
+					    to:(rootView id).
+	    "search view the drop is in"
+	    viewId := rootView id.
+	    [viewId notNil] whileTrue:[
+		destinationId := device viewIdFromPoint:rootPoint in:viewId.
+		lastViewId := viewId.
+		viewId := destinationId
+	    ].
+	    destinationView := device viewFromId:lastViewId.
+	    destinationId := lastViewId.
+	    inMySelf := (destinationView == self).
+	    rootMotion := false
+	] ifFalse:[
+	    inMySelf := true
+	].
+	inMySelf ifTrue:[
+	    "simple move"
+	    self move:movedObject by:moveDelta
+	] ifFalse:[
+	    destinationPoint := device translatePoint:rootPoint
+						 from:(rootView id) 
+						   to:destinationId.
+	    destinationView notNil ifTrue:[
+		"
+		 move into another smalltalk view
+		"
+		self move:movedObject to:destinationPoint in:destinationView
+	    ] ifFalse:[
+		"
+		 not one of my views
+		"
+		self move:movedObject to:destinationPoint inAlienViewId:destinationId
+	    ] 
+	].
+	self setDefaultActions.
+	movedObject := nil
+    ]
+!
+
+startObjectMove:something at:aPoint
+    "start an object move"
+
+    something notNil ifTrue:[
+	self select:something.
+	(self canMove:something) ifTrue:[
+	    self setMoveActions.
+	    moveStartPoint := aPoint.
+	    rootMotion := canDragOutOfView.
+	    "self doObjectMove:aPoint "
+	] ifFalse:[
+	    self setDefaultActions
+	]
+    ]
+! !
+
+!ObjectView methodsFor:'drawing'!
+
+redrawObjectsIntersecting:aRectangle
+    "redraw all objects which have part of themself in aRectangle"
+
+    self objectsIntersecting:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+!
+
+showDragging:something offset:anOffset
+    "show an object while dragging"
+
+    |drawOffset top drawer|
+
+    rootMotion ifTrue:[
+	"drag in root-window"
+
+	top := self topView.
+	drawOffset := device translatePoint:anOffset
+				       from:(self id) to:(rootView id).
+	drawer := rootView
+    ] ifFalse:[
+	drawOffset := anOffset.
+	drawer := self
     ].
-    ^ (device horizontalPixelPerMillimeter * 20) asInteger
+    self forEach:something do:[:anObject |
+	anObject drawDragIn:drawer offset:drawOffset
+    ]
+!
+
+redrawObjectsIntersectingVisible:aRectangle
+    "redraw all objects which have part of themself in a vis rectangle"
+
+    self objectsIntersectingVisible:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+
+!
+
+redrawObjectsInVisible:visRect
+    "redraw all objects which have part of themselfes in a vis rectangle
+     draw only in (i.e. clip output to) aRectangle"
+
+    |vis|
+
+    shown ifTrue:[
+	vis := visRect.
+	clipRect notNil ifTrue:[
+	    vis := vis intersect:clipRect
+	].
+	transformation notNil ifTrue:[
+	    vis := vis origin truncated
+		       corner:(vis corner + (1@1)) truncated.
+	].
+
+	self clippedTo:vis do:[
+	    self clearRectangle:vis.
+	    self redrawObjectsIntersectingVisible:vis
+	]
+    ]
+!
+
+redraw
+    "redraw complete View"
+
+    shown ifTrue:[
+	self clear.
+	self redrawObjects
+    ]
+!
+
+redrawObjectsOn:aGC
+    "redraw all objects on a graphic context"
+
+    |vFrame org viewOrigin|
+
+    (aGC == self) ifTrue:[
+	shown ifFalse:[^ self].
+	viewOrigin := 0@0. "/self viewOrigin.
+	org := viewOrigin.
+	vFrame := Rectangle origin:org
+			    corner:(viewOrigin + (width @ height)).
+
+	transformation notNil ifTrue:[
+	    vFrame := transformation applyInverseTo:vFrame.
+	].
+	self redrawObjectsIntersecting:vFrame
+    ] ifFalse:[
+	"loop over pages"
+
+"
+	org := 0 @ 0.
+	vFrame := Rectangle origin:org
+			    corner:(org + (width @ height)).
+
+	self redrawObjectsIntersecting:vFrame
+"
+	self objectsIntersecting:vFrame do:[:theObject |
+	    theObject drawIn:aGC
+	]
+    ]
+!
+
+redrawObjects
+    "redraw all objects"
+
+    self redrawObjectsOn:self
+!
+
+show:anObject
+    "show the object, either selected or not"
+
+    (self isSelected:anObject) ifTrue:[
+	self showSelected:anObject
+    ] ifFalse:[
+	self showUnselected:anObject
+    ]
 !
 
-verticalScrollStep
-    "return the amount to scroll when stepping left/right."
-
-    scaleMetric == #inch ifTrue:[
-	^ (device verticalPixelPerInch * (1/2)) asInteger
-    ].
-    ^ (device verticalPixelPerMillimeter * 20) asInteger
+showUnselected:anObject
+    "show an object as unselected"
+
+    anObject drawIn:self
+!
+
+redrawObjectsIn:aRectangle
+    "redraw all objects which have part of themselfes in aRectangle
+     draw only in (i.e. clip output to) aRectangle"
+
+    |visRect viewOrigin|
+
+    shown ifTrue:[
+	viewOrigin := 0@0. "/self viewOrigin.
+	visRect := Rectangle origin:(aRectangle origin - viewOrigin)
+			     extent:(aRectangle extent).
+	transformation notNil ifTrue:[
+	    visRect := visRect origin truncated
+		       corner:(visRect corner + (1@1)) truncated.
+	].
+	clipRect notNil ifTrue:[
+	    visRect := visRect intersect:clipRect
+	].
+"/        transformation notNil ifTrue:[
+"/            visRect := visRect origin truncated
+"/                       corner:(visRect corner + (1@1)) truncated.
+"/        ].
+	self clippedTo:visRect do:[
+	    self clearRectangle:visRect.
+	    self redrawObjectsIntersecting:visRect "/ aRectangle
+	]
+    ]
+!
+
+redrawScale
+    "redraw the scales"
+
+    self redrawHorizontalScale.
+    self redrawVerticalScale
+!
+
+redrawObjectsAbove:anObject intersecting:aRectangle
+    "redraw all objects which have part of themself in aRectangle
+     and are above (in front of) anObject"
+
+    self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+!
+
+redrawObjectsAbove:anObject intersectingVisible:aRectangle
+    "redraw all objects which have part of themself in a vis rectangle
+     and are above (in front of) anObject"
+
+    self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
+	self show:theObject
+    ]
+!
+
+showSelected:anObject
+    "show an object as selected"
+
+    anObject drawSelectedIn:self
+!
+
+redrawObjectsAbove:anObject in:aRectangle
+    "redraw all objects which have part of themselfes in aRectangle
+     and are above (in front of) anObject.
+     draw only in (i.e. clip output to) aRectangle"
+
+    |vis|
+
+    shown ifTrue:[
+	vis := aRectangle.
+	clipRect notNil ifTrue:[
+	    vis := vis intersect:clipRect
+	].
+	self clippedTo:vis do:[
+	    self redrawObjectsAbove:anObject intersecting:vis
+	]
+    ]
+!
+
+redrawObjectsAbove:anObject inVisible:aRectangle
+    "redraw all objects which have part of themselfes in a vis rectangle
+     and are above (in front of) anObject.
+     draw only in (i.e. clip output to) aRectangle"
+
+    |vis|
+
+    shown ifTrue:[
+	vis := aRectangle.
+	clipRect notNil ifTrue:[
+	    vis := vis intersect:clipRect
+	].
+	self clippedTo:vis do:[
+	    self redrawObjectsAbove:anObject intersectingVisible:vis
+	]
+    ]
 ! !
 
 !ObjectView methodsFor:'queries'!
@@ -230,57 +1121,17 @@
     ^ (transformation applyScaleY:h) rounded 
 !
 
-widthOfContentsInMM
-    "answer the width of the document in millimeters"
-
-    "landscape"
-    (documentFormat = 'a1l') ifTrue:[
-	^ 840
-    ].
-    (documentFormat = 'a2l') ifTrue:[
-	^ 592
-    ].
-    (documentFormat = 'a3l') ifTrue:[
-	^ 420
-    ].
-    (documentFormat = 'a4l') ifTrue:[
-	^ 296
-    ].
-    (documentFormat = 'a5l') ifTrue:[
-	^ 210
-    ].
-    (documentFormat = 'a6l') ifTrue:[
-	^ 148
-    ].
-    (documentFormat = 'letterl') ifTrue:[
-	^ 11 * 25.4
+widthOfContents
+    "answer the width of the document in pixels"
+
+    |w|
+
+    w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
+
+    transformation isNil ifTrue:[
+	^ w rounded
     ].
-
-    (documentFormat = 'a1') ifTrue:[
-	^ 592
-    ].
-    (documentFormat = 'a2') ifTrue:[
-	^ 420
-    ].
-    (documentFormat = 'a3') ifTrue:[
-	^ 296
-    ].
-    (documentFormat = 'a4') ifTrue:[
-	^ 210
-    ].
-    (documentFormat = 'a5') ifTrue:[
-	^ 148
-    ].
-    (documentFormat = 'a6') ifTrue:[
-	^ 105
-    ].
-    (documentFormat = 'letter') ifTrue:[
-	^ 8.5 * 25.4
-    ].
-    "*** more formats needed here ...***"
-
-    "assuming window size is document size"
-    ^ (width / self horizontalPixelPerMillimeter:1) asInteger
+    ^ (transformation applyScaleX:w) rounded
 !
 
 heightOfContentsInMM
@@ -336,17 +1187,193 @@
     ^ (height / self verticalPixelPerMillimeter:1) asInteger
 !
 
-widthOfContents
-    "answer the width of the document in pixels"
-
-    |w|
-
-    w := self widthOfContentsInMM * (self horizontalPixelPerMillimeter:1).
-
-    transformation isNil ifTrue:[
-	^ w rounded
+widthOfContentsInMM
+    "answer the width of the document in millimeters"
+
+    "landscape"
+    (documentFormat = 'a1l') ifTrue:[
+	^ 840
+    ].
+    (documentFormat = 'a2l') ifTrue:[
+	^ 592
+    ].
+    (documentFormat = 'a3l') ifTrue:[
+	^ 420
+    ].
+    (documentFormat = 'a4l') ifTrue:[
+	^ 296
+    ].
+    (documentFormat = 'a5l') ifTrue:[
+	^ 210
+    ].
+    (documentFormat = 'a6l') ifTrue:[
+	^ 148
+    ].
+    (documentFormat = 'letterl') ifTrue:[
+	^ 11 * 25.4
+    ].
+
+    (documentFormat = 'a1') ifTrue:[
+	^ 592
+    ].
+    (documentFormat = 'a2') ifTrue:[
+	^ 420
+    ].
+    (documentFormat = 'a3') ifTrue:[
+	^ 296
+    ].
+    (documentFormat = 'a4') ifTrue:[
+	^ 210
+    ].
+    (documentFormat = 'a5') ifTrue:[
+	^ 148
+    ].
+    (documentFormat = 'a6') ifTrue:[
+	^ 105
+    ].
+    (documentFormat = 'letter') ifTrue:[
+	^ 8.5 * 25.4
+    ].
+    "*** more formats needed here ...***"
+
+    "assuming window size is document size"
+    ^ (width / self horizontalPixelPerMillimeter:1) asInteger
+! !
+
+!ObjectView methodsFor:'testing objects'!
+
+frameOf:anObjectOrCollection
+    "answer the maximum extent defined by the argument, anObject or a
+     collection of objects"
+
+    |first frameAll|
+
+    anObjectOrCollection isNil ifTrue:[^ nil ].
+    first := true.
+    self forEach:anObjectOrCollection do:[:theObject |
+	first ifTrue:[
+	    frameAll := theObject frame.
+	    first := false
+	] ifFalse:[
+	    frameAll := frameAll merge:(theObject frame)
+	]
+    ].
+    ^ frameAll
+!
+
+isObscured:something
+    "return true, if the argument something, anObject or a collection of
+     objects is obscured (partially or whole) by any other object"
+
+    self forEach:something do:[:anObject |
+	(self objectIsObscured:anObject) ifTrue:[
+	    ^ true
+	]
     ].
-    ^ (transformation applyScaleX:w) rounded
+    ^ false
+!
+
+findObjectAt:aPoint
+    "find the last object (by looking from back to front) which is hit by
+     the argument, aPoint - this is the topmost object hit"
+
+    |hdelta|
+
+    hdelta := self class hitDelta.
+    contents reverseDo:[:object |
+	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
+    ].
+    ^ nil
+!
+
+findObjectAtVisible:aPoint
+    "find the last object (by looking from back to front) which is hit by
+     a visible point - this is the topmost object hit"
+
+    ^ self findObjectAt:(aPoint "+ self viewOrigin")
+!
+
+isSelected:anObject
+    "return true, if the argument, anObject is in the selection"
+
+    selection isNil ifTrue:[^ false].
+    (selection == anObject) ifTrue:[^ true].
+    (selection isKindOf:Collection) ifTrue:[
+	^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
+    ].
+    ^ false
+!
+
+canMove:something
+    "return true, if the argument, anObject or a collection can be moved"
+
+    (something isKindOf:Collection) ifTrue:[
+	self forEach:something do:[:theObject |
+	    (theObject canBeMoved) ifFalse:[^ false]
+	].
+	^ true
+    ].
+    ^ something canBeMoved
+!
+
+objectIsObscured:objectToBeTested
+    "return true, if the argument, anObject is obscured (partially or whole)
+     by any other object"
+
+    |frameToBeTested frameleft frameright frametop framebot
+     objectsFrame startIndex|
+
+    (objectToBeTested == (contents last)) ifTrue:[
+	"quick return if object is on top"
+	^ false
+    ].
+
+    frameToBeTested := self frameOf:objectToBeTested.
+    frameleft := frameToBeTested left.
+    frameright := frameToBeTested right.
+    frametop := frameToBeTested top.
+    framebot := frameToBeTested bottom.
+
+    "check objects after the one to check"
+
+    startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
+    contents from:(startIndex + 1) to:(contents size) do:[:object |
+	objectsFrame := self frameOf:object.
+	(objectsFrame right < frameleft) ifFalse:[
+	    (objectsFrame left > frameright) ifFalse:[
+		(objectsFrame bottom < frametop) ifFalse:[
+		    (objectsFrame top > framebot) ifFalse:[
+			^ true
+		    ]
+		]
+	    ]
+	]
+    ].
+    ^ false
+!
+
+findObjectAt:aPoint suchThat:aBlock
+    "find the last object (back to front ) which is hit by
+     the argument, aPoint and for which the testBlock, aBlock evaluates to
+     true"
+
+    |hdelta|
+
+    hdelta := self class hitDelta.
+    contents reverseDo:[:object |
+	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
+	    (aBlock value:object) ifTrue:[^ object]
+	]
+    ].
+    ^ nil
+!
+
+findObjectAtVisible:aPoint suchThat:aBlock
+    "find the last object (back to front ) which is hit by
+     the argument, aPoint and for which the testBlock, aBlock evaluates to
+     true"
+
+    ^ self findObjectAt:(aPoint "+ self viewOrigin") suchThat:aBlock
 ! !
 
 !ObjectView methodsFor:'user interface'!
@@ -420,264 +1447,6 @@
     self startRectangleDrag:aPoint
 ! !
 
-!ObjectView methodsFor:'initialization'!
-
-setInitialDocumentFormat
-    (Smalltalk language == #english) ifTrue:[
-	documentFormat := 'letter'.
-	scaleMetric := #inch
-    ] ifFalse:[
-	documentFormat := 'a4'.
-	scaleMetric := #mm
-    ].
-!
-
-initialize
-    |pixPerMM|
-
-    super initialize.
-
-    viewBackground := White.
-
-    bitGravity := #NorthWest.
-    contents := OrderedCollection new.
-    gridShown := false.
-
-    canDragOutOfView := false.
-    rootView := DisplayRootView new.
-    rootView noClipByChildren.
-    rootMotion := false.
-    self setInitialDocumentFormat.
-
-    readCursor := Cursor read.
-    leftHandCursor := Cursor leftHand.
-    sorted := false.
-    aligning := false
-!
-
-initEvents
-    self backingStore:true.
-    self enableButtonEvents.
-    self enableButtonMotionEvents
-! !
-
-!ObjectView methodsFor:'drawing'!
-
-redrawObjectsInVisible:visRect
-    "redraw all objects which have part of themselfes in a vis rectangle
-     draw only in (i.e. clip output to) aRectangle"
-
-    |vis|
-
-    shown ifTrue:[
-	vis := visRect.
-	clipRect notNil ifTrue:[
-	    vis := vis intersect:clipRect
-	].
-	transformation notNil ifTrue:[
-	    vis := vis origin truncated
-		       corner:(vis corner + (1@1)) truncated.
-	].
-
-	self clippedTo:vis do:[
-	    self clearRectangle:vis.
-	    self redrawObjectsIntersectingVisible:vis
-	]
-    ]
-!
-
-redrawObjectsIntersectingVisible:aRectangle
-    "redraw all objects which have part of themself in a vis rectangle"
-
-    self objectsIntersectingVisible:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-
-!
-
-redraw
-    "redraw complete View"
-
-    shown ifTrue:[
-	self clear.
-	self redrawObjects
-    ]
-!
-
-redrawObjectsIntersecting:aRectangle
-    "redraw all objects which have part of themself in aRectangle"
-
-    self objectsIntersecting:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-!
-
-redrawObjectsOn:aGC
-    "redraw all objects on a graphic context"
-
-    |vFrame org viewOrigin|
-
-    (aGC == self) ifTrue:[
-	shown ifFalse:[^ self].
-	viewOrigin := self viewOrigin.
-	org := viewOrigin.
-	vFrame := Rectangle origin:org
-			    corner:(viewOrigin + (width @ height)).
-
-	transformation notNil ifTrue:[
-	    vFrame := transformation applyInverseTo:vFrame.
-	].
-	self redrawObjectsIntersecting:vFrame
-    ] ifFalse:[
-	"loop over pages"
-
-"
-	org := 0 @ 0.
-	vFrame := Rectangle origin:org
-			    corner:(org + (width @ height)).
-
-	self redrawObjectsIntersecting:vFrame
-"
-	self objectsIntersecting:vFrame do:[:theObject |
-	    theObject drawIn:aGC
-	]
-    ]
-!
-
-redrawObjects
-    "redraw all objects"
-
-    self redrawObjectsOn:self
-!
-
-showDragging:something offset:anOffset
-    "show an object while dragging"
-
-    |drawOffset top drawer|
-
-    rootMotion ifTrue:[
-	"drag in root-window"
-
-	top := self topView.
-	drawOffset := device translatePoint:anOffset
-				       from:(self id) to:(rootView id).
-	drawer := rootView
-    ] ifFalse:[
-	drawOffset := anOffset.
-	drawer := self
-    ].
-    self forEach:something do:[:anObject |
-	anObject drawDragIn:drawer offset:drawOffset
-    ]
-!
-
-redrawObjectsIn:aRectangle
-    "redraw all objects which have part of themselfes in aRectangle
-     draw only in (i.e. clip output to) aRectangle"
-
-    |visRect viewOrigin|
-
-    shown ifTrue:[
-	viewOrigin := self viewOrigin.
-	visRect := Rectangle origin:(aRectangle origin - viewOrigin)
-			     extent:(aRectangle extent).
-	clipRect notNil ifTrue:[
-	    visRect := visRect intersect:clipRect
-	].
-	transformation notNil ifTrue:[
-	    visRect := visRect origin truncated
-		       corner:(visRect corner + (1@1)) truncated.
-	].
-	self clippedTo:visRect do:[
-	    self clearRectangle:visRect.
-	    self redrawObjectsIntersecting:aRectangle
-	]
-    ]
-!
-
-redrawScale
-    "redraw the scales"
-
-    self redrawHorizontalScale.
-    self redrawVerticalScale
-!
-
-redrawObjectsAbove:anObject intersecting:aRectangle
-    "redraw all objects which have part of themself in aRectangle
-     and are above (in front of) anObject"
-
-    self objectsAbove:anObject intersecting:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-!
-
-redrawObjectsAbove:anObject intersectingVisible:aRectangle
-    "redraw all objects which have part of themself in a vis rectangle
-     and are above (in front of) anObject"
-
-    self objectsAbove:anObject intersectingVisible:aRectangle do:[:theObject |
-	self show:theObject
-    ]
-!
-
-redrawObjectsAbove:anObject in:aRectangle
-    "redraw all objects which have part of themselfes in aRectangle
-     and are above (in front of) anObject.
-     draw only in (i.e. clip output to) aRectangle"
-
-    |vis|
-
-    shown ifTrue:[
-	vis := aRectangle.
-	clipRect notNil ifTrue:[
-	    vis := vis intersect:clipRect
-	].
-	self clippedTo:vis do:[
-	    self redrawObjectsAbove:anObject intersecting:vis
-	]
-    ]
-!
-
-redrawObjectsAbove:anObject inVisible:aRectangle
-    "redraw all objects which have part of themselfes in a vis rectangle
-     and are above (in front of) anObject.
-     draw only in (i.e. clip output to) aRectangle"
-
-    |vis|
-
-    shown ifTrue:[
-	vis := aRectangle.
-	clipRect notNil ifTrue:[
-	    vis := vis intersect:clipRect
-	].
-	self clippedTo:vis do:[
-	    self redrawObjectsAbove:anObject intersectingVisible:vis
-	]
-    ]
-!
-
-show:anObject
-    "show the object, either selected or not"
-
-    (self isSelected:anObject) ifTrue:[
-	self showSelected:anObject
-    ] ifFalse:[
-	self showUnselected:anObject
-    ]
-!
-
-showSelected:anObject
-    "show an object as selected"
-
-    anObject drawSelectedIn:self
-!
-
-showUnselected:anObject
-    "show an object as unselected"
-
-    anObject drawIn:self
-! !
-
 !ObjectView methodsFor:'selections'!
 
 unselect
@@ -687,14 +1456,20 @@
     selection := nil
 !
 
-select:something
-    "select something - hide previouse selection, set to something and hilight"
-
-    (selection == something) ifFalse:[
-	self hideSelection.
-	selection := something.
-	self showSelection
-    ]
+selectAllIn:aRectangle
+    "select all objects fully in aRectangle"
+
+    self hideSelection.
+    selection := OrderedCollection new.
+    self objectsIn:aRectangle do:[:theObject |
+	selection add:theObject
+    ].
+    (selection size == 0) ifTrue:[
+	selection := nil
+    ] ifFalse:[
+	(selection size == 1) ifTrue:[selection := selection first]
+    ].
+    self showSelection
 !
 
 withSelectionHiddenDo:aBlock
@@ -708,12 +1483,30 @@
     self select:sel
 !
 
+select:something
+    "select something - hide previouse selection, set to something and hilight"
+
+    (selection == something) ifFalse:[
+	self hideSelection.
+	selection := something.
+	self showSelection
+    ]
+!
+
 selectionDo:aBlock
     "apply block to every object in selection"
 
     self forEach:selection do:aBlock
 !
 
+hideSelection
+    "hide the selection - undraw hilights - whatever that is"
+
+    self selectionDo:[:object |
+	self showUnselected:object
+    ]
+!
+
 showSelection
     "show the selection - draw hilights - whatever that is"
 
@@ -722,14 +1515,6 @@
     ]
 !
 
-hideSelection
-    "hide the selection - undraw hilights - whatever that is"
-
-    self selectionDo:[:object |
-	self showUnselected:object
-    ]
-!
-
 selectAll
     "select all objects"
 
@@ -764,22 +1549,6 @@
     self showUnselected:anObject
 !
 
-selectAllIn:aRectangle
-    "select all objects fully in aRectangle"
-
-    self hideSelection.
-    selection := OrderedCollection new.
-    self objectsIn:aRectangle do:[:theObject |
-	selection add:theObject
-    ].
-    (selection size == 0) ifTrue:[
-	selection := nil
-    ] ifFalse:[
-	(selection size == 1) ifTrue:[selection := selection first]
-    ].
-    self showSelection
-!
-
 selectAllIntersecting:aRectangle
     "select all objects touched by aRectangle"
 
@@ -797,465 +1566,177 @@
     self showSelection
 ! !
 
-!ObjectView methodsFor:'testing objects'!
-
-frameOf:anObjectOrCollection
-    "answer the maximum extent defined by the argument, anObject or a
-     collection of objects"
-
-    |first frameAll|
-
-    anObjectOrCollection isNil ifTrue:[^ nil ].
-    first := true.
-    self forEach:anObjectOrCollection do:[:theObject |
-	first ifTrue:[
-	    frameAll := theObject frame.
-	    first := false
-	] ifFalse:[
-	    frameAll := frameAll merge:(theObject frame)
-	]
+!ObjectView methodsFor:'initialization'!
+
+setInitialDocumentFormat
+    (Smalltalk language == #english) ifTrue:[
+	documentFormat := 'letter'.
+	scaleMetric := #inch
+    ] ifFalse:[
+	documentFormat := 'a4'.
+	scaleMetric := #mm
     ].
-    ^ frameAll
+!
+
+initEvents
+    self backingStore:true.
+    self enableButtonEvents.
+    self enableButtonMotionEvents
 !
 
-isObscured:something
-    "return true, if the argument something, anObject or a collection of
-     objects is obscured (partially or whole) by any other object"
+initialize
+    |pixPerMM|
+
+    super initialize.
+
+    viewBackground := White.
+
+    bitGravity := #NorthWest.
+    contents := OrderedCollection new.
+    gridShown := false.
+
+    canDragOutOfView := false.
+    rootView := DisplayRootView new.
+    rootView noClipByChildren.
+    rootMotion := false.
+    self setInitialDocumentFormat.
+
+    readCursor := Cursor read.
+    leftHandCursor := Cursor leftHand.
+    sorted := false.
+    aligning := false
+! !
+
+!ObjectView methodsFor:'adding / removing'!
+
+addWithoutRedraw:something
+    "add something, anObject or a collection of objects to the contents
+     do not redraw"
 
     self forEach:something do:[:anObject |
-	(self objectIsObscured:anObject) ifTrue:[
-	    ^ true
-	]
-    ].
-    ^ false
-!
-
-findObjectAt:aPoint
-    "find the last object (by looking from back to front) which is hit by
-     the argument, aPoint - this is the topmost object hit"
-
-    |hdelta|
-
-    hdelta := self class hitDelta.
-    contents reverseDo:[:object |
-	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[^ object]
-    ].
-    ^ nil
-!
-
-findObjectAtVisible:aPoint
-    "find the last object (by looking from back to front) which is hit by
-     a visible point - this is the topmost object hit"
-
-    ^ self findObjectAt:(aPoint + self viewOrigin)
-!
-
-findObjectAt:aPoint suchThat:aBlock
-    "find the last object (back to front ) which is hit by
-     the argument, aPoint and for which the testBlock, aBlock evaluates to
-     true"
-
-    |hdelta|
-
-    hdelta := self class hitDelta.
-    contents reverseDo:[:object |
-	(object isHitBy:aPoint withDelta:hdelta) ifTrue:[
-	    (aBlock value:object) ifTrue:[^ object]
-	]
-    ].
-    ^ nil
-!
-
-findObjectAtVisible:aPoint suchThat:aBlock
-    "find the last object (back to front ) which is hit by
-     the argument, aPoint and for which the testBlock, aBlock evaluates to
-     true"
-
-    ^ self findObjectAt:(aPoint + self viewOrigin) suchThat:aBlock
-!
-
-canMove:something
-    "return true, if the argument, anObject or a collection can be moved"
-
-    (something isKindOf:Collection) ifTrue:[
-	self forEach:something do:[:theObject |
-	    (theObject canBeMoved) ifFalse:[^ false]
-	].
-	^ true
-    ].
-    ^ something canBeMoved
+	self addObjectWithoutRedraw:anObject
+    ]
 !
 
-isSelected:anObject
-    "return true, if the argument, anObject is in the selection"
-
-    selection isNil ifTrue:[^ false].
-    (selection == anObject) ifTrue:[^ true].
-    (selection isKindOf:Collection) ifTrue:[
-	^ (selection identityIndexOf:anObject startingAt:1) ~~ 0
-    ].
-    ^ false
-!
-
-objectIsObscured:objectToBeTested
-    "return true, if the argument, anObject is obscured (partially or whole)
-     by any other object"
-
-    |frameToBeTested frameleft frameright frametop framebot
-     objectsFrame startIndex|
-
-    (objectToBeTested == (contents last)) ifTrue:[
-	"quick return if object is on top"
-	^ false
-    ].
-
-    frameToBeTested := self frameOf:objectToBeTested.
-    frameleft := frameToBeTested left.
-    frameright := frameToBeTested right.
-    frametop := frameToBeTested top.
-    framebot := frameToBeTested bottom.
-
-    "check objects after the one to check"
-
-    startIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
-    contents from:(startIndex + 1) to:(contents size) do:[:object |
-	objectsFrame := self frameOf:object.
-	(objectsFrame right < frameleft) ifFalse:[
-	    (objectsFrame left > frameright) ifFalse:[
-		(objectsFrame bottom < frametop) ifFalse:[
-		    (objectsFrame top > framebot) ifFalse:[
-			^ true
-		    ]
-		]
-	    ]
-	]
-    ].
-    ^ false
-! !
-
-!ObjectView methodsFor:'misc'!
-
-forEach:aCollection do:aBlock
-    "apply block to every object in a collectioni;
-     (adds a check for non-collection)"
-
-    aCollection isNil ifTrue:[^self].
-    (aCollection isKindOf:Collection) ifTrue:[
-	aCollection do:[:object |
-	    object notNil ifTrue:[
-		aBlock value:object
-	    ]
-	]
-    ] ifFalse: [
-	aBlock value:aCollection
+addObjectWithoutRedraw:anObject
+    "add the argument, anObject to the contents - no redraw"
+
+    anObject notNil ifTrue:[
+	contents addLast:anObject
     ]
 !
 
-objectsIntersecting:aRectangle do:aBlock
-    "do something to every object which intersects a rectangle"
-
-    |f top bot
-     firstIndex "{ Class: SmallInteger }"
-     delta      "{ Class: SmallInteger }"
-     theObject 
-     nObjects   "{ Class: SmallInteger }"|
-
-    sorted ifFalse:[
-	"have to check every object"
-	contents do:[:theObject |
-	    (theObject frame intersects:aRectangle) ifTrue:[
-		aBlock value:theObject
-	    ]
-	].
-	^ self
+deleteSelection
+    "delete the selection"
+
+    buffer := selection.
+    self unselect.
+    self remove:buffer.
+!
+
+pasteBuffer
+    "add the objects in the paste-buffer"
+
+    self unselect.
+    self addSelected:buffer
+!
+
+copySelection
+    "copy the selection into the paste-buffer"
+
+    buffer := OrderedCollection new.
+    self selectionDo:[:object |
+	buffer add:(object copy)
     ].
-    nObjects := contents size.
-    (nObjects == 0) ifTrue:[^ self].
-
-    "can break, when 1st object below aRectangle is reached"
-    bot := aRectangle bottom.
-    top := aRectangle top.
-
-    "binary search an object in aRectangle ..."
-    delta := nObjects // 2.
-    firstIndex := delta.
-    (firstIndex == 0) ifTrue:[
-       firstIndex := 1
-    ].
-    theObject := contents at:firstIndex.
-    (theObject frame bottom < top) ifTrue:[
-	[theObject frame bottom < top and:[delta > 1]] whileTrue:[
-	    delta := delta // 2.
-	    firstIndex := firstIndex + delta.
-	    theObject := contents at:firstIndex
-	]
-    ] ifFalse:[
-	[theObject frame top > bot and:[delta > 1]] whileTrue:[
-	    delta := delta // 2.
-	    firstIndex := firstIndex - delta.
-	    theObject := contents at:firstIndex
-	]
-    ].
-    "now, theObject at:firstIndex is in aRectangle; go backward to the object
-     following first non-visible"
-
-    [theObject frame bottom > top and:[firstIndex > 1]] whileTrue:[
-	firstIndex := firstIndex - 1.
-	theObject := contents at:firstIndex
-    ].
-
-    firstIndex to:nObjects do:[:index |
-	theObject := contents at:index.
-	f := theObject frame.
-	(f intersects:aRectangle) ifTrue:[
-	    aBlock value:theObject
-	] ifFalse:[
-	    (f top > bot) ifTrue:[^ self]
+    self forEach:buffer do:[:anObject |
+	anObject moveTo:(anObject origin + (8 @ 8))
+    ]
+!
+
+addSelected:something
+    "add something, anObject or a collection of objects to the contents
+     and select it"
+
+    self add:something.
+    self select:something
+!
+
+remove:something
+    "remove something, anObject or a collection of objects from the contents
+     do redraw"
+
+    self forEach:something do:[:anObject |
+	self removeObject:anObject
+    ]
+!
+
+removeObject:anObject
+    "remove the argument, anObject from the contents - no redraw"
+
+    anObject notNil ifTrue:[
+	self removeFromSelection:anObject.
+	contents remove:anObject.
+	shown "realized" ifTrue:[
+	    self redrawObjectsIn:(anObject frame)
 	]
     ]
 !
 
-setDefaultActions
-    motionAction := [:movePoint | nil].
-    releaseAction := [nil]
-!
-
-setMoveActions
-    motionAction := [:movePoint | self doObjectMove:movePoint].
-    releaseAction := [self endObjectMove]
-!
-
-objectsIntersectingVisible:aRectangle do:aBlock
-    "do something to every object which intersects a visible rectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:(aRectangle left + viewOrigin x)
-			  top:(aRectangle top + viewOrigin y)
-			width:(aRectangle width)
-		       height:(aRectangle height).
-    self objectsIntersecting:absRect do:aBlock
-!
-
-objectsIntersecting:aRectangle
-    "answer a Collection of objects intersecting the argument, aRectangle"
-
-    |newCollection|
-
-    newCollection := OrderedCollection new.
-    self objectsIntersecting:aRectangle do:[:theObject |
-	newCollection add:theObject
-    ].
-    (newCollection size == 0) ifTrue:[^ nil].
-    ^ newCollection
-!
-
-documentFormat:aFormatString
-    "set the document format (mostly used by scrollbars).
-     The argument should be a string such as 'a4', 'a5'
-     or 'letter'. See widthOfContentsInMM for supported formats."
-
-    aFormatString ~= documentFormat ifTrue:[
-	documentFormat := aFormatString.
-	self contentsChanged.
-	self defineGrid.
-	gridShown ifTrue:[
-	    self clear.
-	    self redraw
-	]
-    ]
-!
-
-setRectangleDragActions
-    motionAction := [:movePoint | self doRectangleDrag:movePoint].
-    releaseAction := [self endRectangleDrag]
-!
-
-setLineDragActions
-    motionAction := [:movePoint | self doLineDrag:movePoint].
-    releaseAction := [self endLineDrag]
-!
-
-objectsIn:aRectangle do:aBlock
-    "do something to every object which is completely in a rectangle"
-
-    |bot|
-
-    sorted ifTrue:[
-	bot := aRectangle bottom.
-	contents do:[:theObject |
-	    (theObject isContainedIn:aRectangle) ifTrue:[
-		aBlock value:theObject
-	    ] ifFalse:[
-		theObject frame top > bot ifTrue:[^ self]
-	    ]
-	].
-	^ self
-    ].
-
-    contents do:[:theObject |
-	(theObject isContainedIn:aRectangle) ifTrue:[
-	    aBlock value:theObject
+addObject:anObject
+    "add the argument, anObject to the contents - with redraw"
+
+    anObject notNil ifTrue:[
+	contents addLast:anObject.
+	"its on top - only draw this one"
+	shown "realized" ifTrue:[
+	    self showUnselected:anObject
 	]
     ]
 !
 
-objectsInVisible:aRectangle do:aBlock
-    "do something to every object which is completely in a 
-     visible rectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:(aRectangle left + viewOrigin x)
-			  top:(aRectangle top + viewOrigin y)
-			width:(aRectangle width)
-		       height:(aRectangle height).
-    self objectsIn:absRect do:aBlock
-!
-
-visibleObjectsDo:aBlock
-    "do something to every visible object"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:viewOrigin x
-			  top:viewOrigin y
-			width:width
-		       height:height.
-    self objectsIntersecting:absRect do:aBlock
-!
-
-numberOfObjectsIntersectingVisible:aRectangle
-    "answer the number of objects intersecting the argument, aRectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle
-		 left:(aRectangle left + viewOrigin x)
-		  top:(aRectangle top  + viewOrigin y)
-		width:(aRectangle width)
-	       height:(aRectangle height).
-
-    ^ self numberOfObjectsIntersecting:aRectangle
+add:something
+    "add something, anObject or a collection of objects to the contents
+     with redraw"
+
+    self forEach:something do:[:anObject |
+	self addObject:anObject
+    ]
 !
 
-numberOfObjectsIntersecting:aRectangle
-    "answer the number of objects intersecting the argument, aRectangle"
-
-    |tally|
-
-    tally := 0.
-    contents do:[:theObject |
-	(theObject frame intersects:aRectangle) ifTrue:[
-	    tally := tally + 1
-	]
-    ].
-    ^ tally
-!
-
-objectsIntersectingVisible:aRectangle
-    "answer a Collection of objects intersecting a visible aRectangle"
-
-    |absRect viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    absRect := Rectangle left:(aRectangle left + viewOrigin x)
-			  top:(aRectangle top + viewOrigin y)
-			width:(aRectangle width)
-		       height:(aRectangle height).
-    ^ self objectsIntersecting:absRect
-!
-
-objectsBelow:objectToBeTested do:aBlock
-    "do something to every object below objectToBeTested
-     (does not mean obscured by - simply below in hierarchy)"
-
-    |endIndex|
-
-    endIndex := contents identityIndexOf:objectToBeTested ifAbsent:[self error].
-    contents from:1 to:(endIndex - 1) do:aBlock
-!
-
-objectsAbove:objectToBeTested do:aBlock
-    "do something to every object above objectToBeTested
-     (does not mean obscured - simply above in hierarchy)"
-
-    |startIndex|
-
-    startIndex := contents identityIndexOf:objectToBeTested
-				  ifAbsent:[self error].
-    contents from:startIndex to:(contents size) do:aBlock
-!
-
-objectsAbove:anObject intersecting:aRectangle do:aBlock
-    "do something to every object above objectToBeTested
-     and intersecting aRectangle"
-
-    self objectsAbove:anObject do:[:theObject |
-	(theObject frame intersects:aRectangle) ifTrue:[
-	    aBlock value:theObject
-	]
+removeWithoutRedraw:something
+    "remove something, anObject or a collection of objects from the contents
+     do not redraw"
+
+    self forEach:something do:[:anObject |
+	self removeObjectWithoutRedraw:anObject
     ]
 !
 
-rectangleForScroll
-    "find the area occupied by visible objects"
-
-    |left right top bottom frame oLeft oRight oTop oBottom orgX orgY viewOrigin|
-
-    viewOrigin := self viewOrigin.
-    orgX := viewOrigin x.
-    orgY := viewOrigin y.
-    left := 9999.
-    right := 0.
-    top := 9999.
-    bottom := 0.
-    self visibleObjectsDo:[:anObject |
-	frame := anObject frame.
-	oLeft := frame left - orgX.
-	oRight := frame right - orgX.
-	oTop := frame top - orgY.
-	oBottom := frame bottom - orgY.
-	(oLeft < left) ifTrue:[left := oLeft].
-	(oRight > right) ifTrue:[right := oRight].
-	(oTop < top) ifTrue:[top := oTop].
-	(oBottom > bottom) ifTrue:[bottom := oBottom]
-    ].
-    (left < margin) ifTrue:[left := margin].
-    (top < margin) ifTrue:[top := margin].
-    (right > (width - margin)) ifTrue:[right := width - margin].
-    (bottom > (height - margin)) ifTrue:[bottom := height - margin].
-
-    ((left > right) or:[top > bottom]) ifTrue:[^ nil].
-
-    ^ Rectangle left:left right:right top:top bottom:bottom
+removeObjectWithoutRedraw:anObject
+    "remove the argument, anObject from the contents - no redraw"
+
+    anObject notNil ifTrue:[
+	self removeFromSelection:anObject.
+	contents remove:anObject
+    ]
+!
+
+removeAllWithoutRedraw
+    "remove all - no redraw"
+
+    selection := nil.
+    contents := OrderedCollection new
+!
+
+removeAll
+    "remove all - redraw"
+
+    self removeAllWithoutRedraw.
+    self redraw
 ! !
 
 !ObjectView methodsFor:'layout manipulation'!
 
-moveObject:anObject by:delta
-    "change the position of anObject by delta, aPoint"
-
-    self moveObject:anObject to:(anObject origin + delta)
-!
-
-move:something by:delta
-    "change the position of something, an Object or Collection 
-     by delta, aPoint"
-
-    (delta x == 0) ifTrue:[
-	(delta y == 0) ifTrue:[^ self]
-    ].
-
-    self forEach:something do:[:anObject |
-	self moveObject:anObject by:delta
-    ]
-!
-
 moveObject:anObject to:newOrigin
     "move anObject to newOrigin, aPoint"
 
@@ -1284,7 +1765,7 @@
 
     "if no other object intersects both frames we can do a copy:"
 
-    viewOrigin := self viewOrigin.
+    viewOrigin := 0@0 "self viewOrigin".
     intersects := oldFrame intersects:newFrame.
     intersects ifFalse:[
 	gridShown ifFalse:[
@@ -1302,6 +1783,7 @@
 			    h := oldFrame height.
 			    ((newLeft < width) and:[newTop < height]) ifTrue:[
 				((newLeft >= 0) and:[newTop >= 0]) ifTrue:[
+				    self catchExpose.
 				    self copyFrom:self x:oldLeft y:oldTop
 						     toX:newLeft y:newTop
 						   width:w height:h.
@@ -1341,6 +1823,25 @@
     ]
 !
 
+move:something by:delta
+    "change the position of something, an Object or Collection 
+     by delta, aPoint"
+
+    (delta x == 0) ifTrue:[
+	(delta y == 0) ifTrue:[^ self]
+    ].
+
+    self forEach:something do:[:anObject |
+	self moveObject:anObject by:delta
+    ]
+!
+
+moveObject:anObject by:delta
+    "change the position of anObject by delta, aPoint"
+
+    self moveObject:anObject to:(anObject origin + delta)
+!
+
 move:something to:aPoint in:aView
     "can only happen when dragOutOfView is true
      - should be redefined in subclasses"
@@ -1498,143 +1999,88 @@
     self alignBottom:selection
 ! !
 
-!ObjectView methodsFor:'adding / removing'!
-
-deleteSelection
-    "delete the selection"
-
-    buffer := selection.
-    self unselect.
-    self remove:buffer.
-!
-
-pasteBuffer
-    "add the objects in the paste-buffer"
-
-    self unselect.
-    self addSelected:buffer
-!
-
-copySelection
-    "copy the selection into the paste-buffer"
-
-    buffer := OrderedCollection new.
-    self selectionDo:[:object |
-	buffer add:(object copy)
-    ].
-    self forEach:buffer do:[:anObject |
-	anObject moveTo:(anObject origin + (8 @ 8))
-    ]
+!ObjectView methodsFor:'dragging rectangle'!
+
+endRectangleDrag
+    "cleanup after rectangle drag; select them"
+
+    self invertDragRectangle.
+    self cursor:oldCursor.
+    self selectAllIn:(dragObject "+ self viewOrigin")
 !
 
-addSelected:something
-    "add something, anObject or a collection of objects to the contents
-     and select it"
-
-    self add:something.
-    self select:something
-!
-
-addWithoutRedraw:something
-    "add something, anObject or a collection of objects to the contents
-     do not redraw"
-
-    self forEach:something do:[:anObject |
-	self addObjectWithoutRedraw:anObject
-    ]
-!
-
-addObject:anObject
-    "add the argument, anObject to the contents - with redraw"
-
-    anObject notNil ifTrue:[
-	contents addLast:anObject.
-	"its on top - only draw this one"
-	shown "realized" ifTrue:[
-	    self showUnselected:anObject
-	]
-    ]
+invertDragRectangle
+    "helper for rectangle drag - invert the dragRectangle.
+     Extracted into a separate method to allow easier redefinition
+     (different lineWidth etc)"
+
+    self xoring:[self lineWidth:0. self displayRectangle:dragObject].
 !
 
-addObjectWithoutRedraw:anObject
-    "add the argument, anObject to the contents - no redraw"
-
-    anObject notNil ifTrue:[
-	contents addLast:anObject
-    ]
-!
-
-add:something
-    "add something, anObject or a collection of objects to the contents
-     with redraw"
-
-    self forEach:something do:[:anObject |
-	self addObject:anObject
-    ]
-!
-
-remove:something
-    "remove something, anObject or a collection of objects from the contents
-     do redraw"
-
-    self forEach:something do:[:anObject |
-	self removeObject:anObject
-    ]
+startRectangleDrag:startPoint
+    "start a rectangle drag"
+
+    self setRectangleDragActions.
+    dragObject := Rectangle origin:startPoint corner:startPoint.
+    self invertDragRectangle.
+    oldCursor := cursor.
+    self cursor:leftHandCursor
 !
 
-removeObject:anObject
-    "remove the argument, anObject from the contents - no redraw"
-
-    anObject notNil ifTrue:[
-	self removeFromSelection:anObject.
-	contents remove:anObject.
-	shown "realized" ifTrue:[
-	    self redrawObjectsIn:(anObject frame)
-	]
-    ]
-!
-
-removeWithoutRedraw:something
-    "remove something, anObject or a collection of objects from the contents
-     do not redraw"
-
-    self forEach:something do:[:anObject |
-	self removeObjectWithoutRedraw:anObject
-    ]
-!
-
-removeObjectWithoutRedraw:anObject
-    "remove the argument, anObject from the contents - no redraw"
-
-    anObject notNil ifTrue:[
-	self removeFromSelection:anObject.
-	contents remove:anObject
-    ]
-!
-
-removeAllWithoutRedraw
-    "remove all - no redraw"
-
-    selection := nil.
-    contents := OrderedCollection new
-!
-
-removeAll
-    "remove all - redraw"
-
-    self removeAllWithoutRedraw.
-    self redraw
+doRectangleDrag:aPoint
+    "do drag a rectangle"
+
+    self invertDragRectangle.
+    dragObject corner:aPoint.
+    self invertDragRectangle.
 ! !
 
 !ObjectView methodsFor:'view manipulation'!
 
+zoom:factor
+    "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
+     0.5 is shrink by 2"
+
+    |current|
+
+    transformation isNil ifTrue:[
+	current := 1@1
+    ] ifFalse:[
+	current := transformation scale
+    ].
+    factor asPoint = current asPoint ifTrue:[
+	^ self
+    ].
+    current := factor.
+    current isNil ifTrue:[
+	current := 1
+    ].
+
+    (current = 1) ifTrue:[
+	transformation := nil
+    ] ifFalse:[
+	transformation := WindowingTransformation scale:current translation:0.
+    ].
+    self contentsChanged.
+    self setInnerClip.
+    gridShown ifTrue:[
+	self newGrid
+    ].
+    shown ifTrue:[
+	self clear.
+	self redraw
+    ].
+!
+
 zoomIn
     transformation isNil ifTrue:[
 	transformation := WindowingTransformation scale:1 translation:0
     ].
     transformation := WindowingTransformation scale:(transformation scale / 2)
 					      translation:0.
-    self redraw
+    self contentsChanged.
+    self setInnerClip.
+    self redraw.
 !
 
 zoomOut
@@ -1643,29 +2089,11 @@
     ].
     transformation := WindowingTransformation scale:(transformation scale * 2)
 					      translation:0.
+    self contentsChanged.
+    self setInnerClip.
     self redraw
 !
 
-zoom:factor
-    "set a zoom factor; nil or 1 is identity; 2 is magnify by 2;
-     0.5 is shrink by 2"
-
-    (factor isNil or:[factor = 1]) ifTrue:[
-	transformation := nil
-    ] ifFalse:[
-	transformation := WindowingTransformation scale:factor translation:0.
-    ].
-    self setInnerClip.
-    gridShown ifTrue:[
-	self newGrid
-    ].
-    shown ifTrue:[
-	self clear.
-	self redraw
-    ].
-    self contentsChanged
-!
-
 millimeterMetric
     (scaleMetric ~~ #mm) ifTrue:[
 	scaleMetric := #mm.
@@ -1682,6 +2110,24 @@
 
 !ObjectView methodsFor:'grid manipulation'!
 
+newGrid
+    "define a new grid"
+
+    gridPixmap := nil.
+    shown ifTrue:[
+	self viewBackground:White.
+	self clear.
+    ].
+
+    gridShown ifTrue:[
+	self defineGrid.
+	self viewBackground:gridPixmap.
+    ].
+    shown ifTrue:[
+	self redraw
+    ].
+!
+
 gridParameters
     "used by defineGrid, and in a separate method for
      easier redefinition in subclasses. 
@@ -1880,24 +2326,6 @@
     ]
 !
 
-newGrid
-    "define a new grid"
-
-    gridPixmap := nil.
-    shown ifTrue:[
-	self viewBackground:White.
-	self clear.
-    ].
-
-    gridShown ifTrue:[
-	self defineGrid.
-	self viewBackground:gridPixmap.
-    ].
-    shown ifTrue:[
-	self redraw
-    ].
-!
-
 showGrid
     "show the grid"
 
@@ -1934,42 +2362,6 @@
     aligning := false
 ! !
 
-!ObjectView methodsFor:'dragging rectangle'!
-
-startRectangleDrag:startPoint
-    "start a rectangle drag"
-
-    self setRectangleDragActions.
-    dragObject := Rectangle origin:startPoint corner:startPoint.
-    self invertDragRectangle.
-    oldCursor := cursor.
-    self cursor:leftHandCursor
-!
-
-endRectangleDrag
-    "cleanup after rectangle drag; select them"
-
-    self invertDragRectangle.
-    self cursor:oldCursor.
-    self selectAllIn:(dragObject + self viewOrigin)
-!
-
-doRectangleDrag:aPoint
-    "do drag a rectangle"
-
-    self invertDragRectangle.
-    dragObject corner:aPoint.
-    self invertDragRectangle.
-!
-
-invertDragRectangle
-    "helper for rectangle drag - invert the dragRectangle.
-     Extracted into a separate method to allow easier redefinition
-     (different lineWidth etc)"
-
-    self xoring:[self displayRectangle:dragObject].
-! !
-
 !ObjectView methodsFor:'dragging line'!
 
 startLineDrag:startPoint
@@ -1996,17 +2388,14 @@
 doLineDrag:aPoint
     "do drag a line"
 
-    |dragger top offs2 org|
+    |dragger top org|
 
     rootMotion ifTrue:[
 	dragger := rootView.
-	offs2 := self viewOrigin.
 	top := self topView.
 	org := device translatePoint:0@0 from:(self id) to:(rootView id).
-	offs2 := offs2 - org
     ] ifFalse:[
 	dragger := self.
-	offs2 := 0@0.
     ].
 
     self invertDragLine.
@@ -2024,7 +2413,7 @@
 
     rootMotion ifTrue:[
 	dragger := rootView.
-	offs2 := self viewOrigin.
+	offs2 := 0@0 "self viewOrigin".
 	top := self topView.
 	org := device translatePoint:0@0 from:(self id) to:(rootView id).
 	offs2 := offs2 - org
@@ -2114,146 +2503,7 @@
      Extracted for easier redefinition in subclasses
      (different line width etc.)"
 
-    self xoring:[self displayLineFrom:dragObject origin to:dragObject corner].
-! !
-
-!ObjectView methodsFor:'dragging object move'!
-
-startObjectMove:something at:aPoint
-    "start an object move"
-
-    something notNil ifTrue:[
-	self select:something.
-	(self canMove:something) ifTrue:[
-	    self setMoveActions.
-	    moveStartPoint := aPoint.
-	    rootMotion := canDragOutOfView.
-	    "self doObjectMove:aPoint "
-	] ifFalse:[
-	    self setDefaultActions
-	]
-    ]
-!
-
-endObjectMove
-    "cleanup after object move - find the destination view and dispatch to
-     one of the moveObjectXXX-methods. These can be redefined in subclasses."
-
-    |dragger inMySelf offs2 rootPoint destinationPoint
-     viewId destinationView destinationId lastViewId|
-
-    movedObject notNil ifTrue:[
-	rootMotion ifTrue:[
-	    dragger := rootView.
-	    offs2 := self viewOrigin
-	] ifFalse:[
-	    dragger := self.
-	    offs2 := 0@0
-	].
-	dragger xoring:[
-	    self showDragging:movedObject offset:moveDelta - offs2
-	].
-	dragger device synchronizeOutput.
-
-	"check if object is to be put into another view"
-	rootMotion ifTrue:[
-	    rootPoint := device translatePoint:lastButt
-					  from:(self id) 
-					    to:(rootView id).
-	    "search view the drop is in"
-	    viewId := rootView id.
-	    [viewId notNil] whileTrue:[
-		destinationId := device viewIdFromPoint:rootPoint in:viewId.
-		lastViewId := viewId.
-		viewId := destinationId
-	    ].
-	    destinationView := device viewFromId:lastViewId.
-	    destinationId := lastViewId.
-	    inMySelf := (destinationView == self).
-	    rootMotion := false
-	] ifFalse:[
-	    inMySelf := true
-	].
-	inMySelf ifTrue:[
-	    "simple move"
-	    self move:movedObject by:moveDelta
-	] ifFalse:[
-	    destinationPoint := device translatePoint:rootPoint
-						 from:(rootView id) 
-						   to:destinationId.
-	    destinationView notNil ifTrue:[
-		"
-		 move into another smalltalk view
-		"
-		self move:movedObject to:destinationPoint in:destinationView
-	    ] ifFalse:[
-		"
-		 not one of my views
-		"
-		self move:movedObject to:destinationPoint inAlienViewId:destinationId
-	    ] 
-	].
-	self setDefaultActions.
-	movedObject := nil
-    ]
-!
-
-doObjectMove:aPoint
-    "do an object move.
-     moveStartPoint is the original click-point.
-     moveDelta"
-
-    |dragger offset d p|
-
-    rootMotion ifTrue:[
-	dragger := rootView.
-	offset := self viewOrigin.
-    ] ifFalse:[
-	dragger := self.
-	offset := 0@0.
-    ].
-
-    "
-     when drawing in the root window, we have to use its coordinates
-     this is kept in offset.
-    "
-    movedObject isNil ifTrue:[
-	movedObject := selection.
-	"
-	 draw first outline
-	"
-	movedObject notNil ifTrue:[
-	    moveDelta := 0@0.
-
-	    dragger xoring:[
-		"tricky, the moved object may not currently be aligned.
-		 if so, simulate a frame move of the delta"
-
-		aligning ifTrue:[
-		    d := movedObject origin 
-			 - (self alignToGrid:(movedObject origin)).
-"/ d printNL.
-		    moveDelta := d negated.
-		].
-"/ moveDelta printNL.
-		self showDragging:movedObject offset:moveDelta - offset.
-	    ]
-	]
-    ].
-    movedObject notNil ifTrue:[
-	"
-	 clear prev outline,
-	 draw new outline
-	"
-	dragger xoring:[
-	    self showDragging:movedObject offset:moveDelta - offset.
-	    moveDelta := aPoint - moveStartPoint.
-	    aligning ifTrue:[
-		moveDelta := self alignToGrid:moveDelta
-	    ].
-	    self showDragging:movedObject offset:moveDelta - offset.
-	]
-    ]
+    self xoring:[self lineWidth:0. self displayLineFrom:dragObject origin to:dragObject corner].
 ! !
 
 !ObjectView methodsFor:'saving / restoring'!

author	claus
	Wed, 21 Dec 1994 20:19:42 +0100
changeset 71	9fd1c36af7a8
parent 70	14443a9ea4ec
child 72	730e270a37e6

ObjView.st		file \| annotate \| diff \| comparison \| revisions
ObjectView.st		file \| annotate \| diff \| comparison \| revisions