'From Squeak3.2gamma of 15 January 2002 [latest update: #4743] on 3 May 2018 at 8:21:55 am'!
ScrollPane subclass: #AlansTextPlusMorph
	instanceVariableNames: 'theTextMorph thePasteUp '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-GeeMail'!
!AlansTextPlusMorph commentStamp: '<historical>' prior: 0!
The code is here, but the class you really want to use is GeeMailMorph (nicer name).!


!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:50'!
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	self addGeeMailMenuItemsTo: aCustomMenu.! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:49'!
addGeeMailMenuItemsTo: menu

	self flag: #convertToBook.	"<-- no longer used"
	menu 
		addUpdating: #showPageBreaksString action: #togglePageBreaks;
		addUpdating: #keepScrollbarString action: #toggleKeepScrollbar;
		addLine;
		add: 'Print...' action: #printPSToFile;
		addLine.
	thePasteUp allTextPlusMorphs size = 1 ifTrue: [
		menu add: 'make 1-column book' selector: #makeBookStyle: argument: 1.
		menu add: 'make 2-column book' selector: #makeBookStyle: argument: 2.
		menu add: 'make 3-column book' selector: #makeBookStyle: argument: 3.
		menu add: 'make 4-column book' selector: #makeBookStyle: argument: 4.
	] ifFalse: [
		menu add: 'make a galley of me' action: #makeGalleyStyle.
	].
	^menu! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 10/30/2000 15:06'!
adjustPasteUpSize

	| newBottom |

	thePasteUp ifNil: [^self].
	newBottom _ thePasteUp bottom max: thePasteUp boundingBoxOfSubmorphs bottom + 20.
	thePasteUp height: (newBottom - thePasteUp top max: self height).
	thePasteUp width: (thePasteUp width max: scroller innerBounds width - 5).! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:42'!
allTextPlusMorphs

	^thePasteUp allTextPlusMorphs! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 10/3/2000 12:03'!
convertToBook

	GeeBookMorph new 
		geeMail: thePasteUp;
		rebuildPages;
		openInWorld! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 3/5/2001 23:19'!
doLayoutIn: layoutBounds
	"layout has changed. update scroll deltas or whatever else"

	self adjustPasteUpSize.
	scroller ifNotNil: [self setScrollDeltas].
	super doLayoutIn: layoutBounds.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'JW 2/21/2001 22:54'!
extraScrollRange
	^ bounds height
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:50'!
getMenu: shiftKeyState

	| menu |

	self flag: #convertToBook.	"<-- no longer used"

	menu _ MenuMorph new defaultTarget: self.
	self addGeeMailMenuItemsTo: menu.
	^menu! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 17:33'!
handlesMouseDown: evt

	^evt yellowButtonPressed ! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:57'!
hideScrollBar

	self keepScrollBarAlways ifTrue: [^self].
	^super hideScrollBar! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/2/2001 14:11'!
initialize

	super initialize.
	color _ Color white.
	thePasteUp _ TextPlusPasteUpMorph new borderWidth: 0; color: color.
	scroller addMorph: thePasteUp.
	self position: 100@100.
	self extent: Display extent // 3.
	self useRoundedCorners.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:57'!
keepScrollBarAlways

	^self valueOfProperty: #keepScrollBarAlways ifAbsent: [false]! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:59'!
keepScrollbarString

	^self keepScrollBarAlways ifTrue: ['<on>scrollbar stays up'] ifFalse: ['<off>scrollbar stays up']! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 12/5/2001 11:15'!
makeBookStyle: nColumns

	| all totalWidth second columnWidth currY prev columnHeight currX currColumn pageBreakRectangles r rm columnGap pageGap starter |

	pageBreakRectangles _ OrderedCollection new.
	all _ thePasteUp allTextPlusMorphs.
	all size = 1 ifFalse: [^self].
	Cursor wait show.
	starter _ prev _ all first.
	totalWidth _ self width - 16.
	columnGap _ 32.
	pageGap _ 16.
	columnWidth _ totalWidth - (columnGap * (nColumns - 1)) // nColumns.
	columnHeight _ self height - 12.
	currY _ 4.
	currX _ 4.
	currColumn _ 1.
	prev
		position: currX@currY;
		width: columnWidth.
	[
		second _ prev makeSuccessorMorph.
		thePasteUp addMorphBack: second.
		prev 
			setProperty: #autoFitContents toValue: false;
			height: columnHeight.
		(currColumn _ currColumn + 1) <= nColumns ifTrue: [
			currX _ currX + columnWidth + columnGap.
		] ifFalse: [
			r _ 4@(prev bottom + 4) corner: (self right - 4 @ (prev bottom + pageGap - 4)).
			rm _ RectangleMorph new bounds: r; color: (Color gray alpha: 0.3); borderWidth: 0.
			pageBreakRectangles add: rm beSticky.
			thePasteUp addMorphBack: rm.
			currColumn _ 1.
			currX _ 4.
			currY _ prev bottom + pageGap.
		].
		second 
			autoFit: true;
			position: currX@currY;
			width: columnWidth.
		prev recomposeChain.		"was commented"
		prev _ second.
		prev height > columnHeight
	] whileTrue.
	prev autoFit: true.
	thePasteUp height: (prev bottom + 20 - self top).
	self layoutChanged.
	self setProperty: #pageBreakRectangles toValue: pageBreakRectangles.
	thePasteUp allTextPlusMorphs do: [ :each |
		each repositionAnchoredMorphs
	].
	Cursor normal show.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 11/30/2001 12:12'!
makeGalleyStyle

	| all first theRest |

	(self valueOfProperty: #pageBreakRectangles ifAbsent: [#()]) do: [ :each |
		each delete
	].
	self removeProperty: #pageBreakRectangles.
	all _ thePasteUp allTextPlusMorphs.
	first _ all select: [ :x | x predecessor isNil].
	first size = 1 ifFalse: [^self].
	Cursor wait show.
	first _ first first.
	theRest _ all reject: [ :x | x predecessor isNil].
	theRest do: [ :each | each delete].
	first autoFit: true.
	first width: self width - 8.
	first recomposeChain.
	first repositionAnchoredMorphs.
	Cursor normal show.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'ar 10/6/2000 16:36'!
mouseUp: evt inMorph: aMorph

	evt hand grabMorph: aMorph	"old instances may have a handler we no longer use"! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/7/2001 13:25'!
pageRectanglesForPrinting

	| pageBreaks prevBottom pageRects r |

	pageBreaks _ self valueOfProperty: #pageBreakRectangles ifAbsent: [^nil].
	prevBottom _ 0.
	pageRects _ pageBreaks collect: [ :each |
		r _ 0@prevBottom corner: self width @ each top.
		prevBottom _ each bottom.
		r
	].
	pageRects add: (0@prevBottom corner: self width @ thePasteUp bottom).
	^pageRects! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/7/2001 12:20'!
printPSToFile

	thePasteUp printer
		geeMail: self;
		doPages! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 16:16'!
scrollBarValue: scrollValue

	| newPt pageBreaks topOfPage |

	scroller hasSubmorphs ifFalse: [^ self].
	newPt _ -3 @ (self leftoverScrollRange * scrollValue).

	pageBreaks _ self valueOfProperty: #pageBreakRectangles ifAbsent: [#()].
	pageBreaks isEmpty ifTrue: [
		^scroller offset: newPt.
	].
	topOfPage _ pageBreaks inject: (0@0 corner: 0@0) into: [ :closest :each |
		(each bottom - newPt y) abs < (closest bottom - newPt y) abs ifTrue: [
			each 
		] ifFalse: [
			closest 
		].
	].
	topOfPage ifNotNil: [
		newPt _ newPt x @ topOfPage bottom.
		scrollBar value: newPt y / self leftoverScrollRange.
	].
	scroller offset: newPt.! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/4/2001 09:21'!
scrollSelectionIntoView: event alignTop: alignTop inTextMorph: tm
	"Scroll my text into view if necessary and return true, else return false"

	| selRects delta selRect rectToTest transform cpHere |

	selRects _ tm paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest _ selRects first merge: selRects last.
	transform _ scroller transformFrom: self.
	(event notNil and: [event isMouse and: [event anyButtonPressed]]) ifTrue:  "Check for autoscroll"
		[cpHere _ transform localPointToGlobal: event cursorPoint.
		cpHere y <= self top
			ifTrue: [rectToTest _ selRects first topLeft extent: 2@2]
			ifFalse: [cpHere y >= self bottom
					ifTrue: [rectToTest _ selRects last bottomRight extent: 2@2]
					ifFalse: [^ false]]].
	selRect _ transform localBoundsToGlobal: rectToTest.
	selRect height > bounds height
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	alignTop ifTrue: [
		self scrollBy: 0@(bounds top - selRect top).
		^ true
	].
	selRect bottom > bounds bottom ifTrue: [
		self scrollBy: 0@(bounds bottom - selRect bottom - 30).
		^ true
	].
	(delta _ selRect amountToTranslateWithin: self bounds) y ~= 0 ifTrue: [
		"Scroll end of selection into view if necessary"
		self scrollBy: 0@delta y.
		^ true].
	^ false! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 13:06'!
scrollToPage: pageNumber

	| rects oneRect |

	rects _ self valueOfProperty: #pageBreakRectangles ifAbsent: [#()].
	oneRect _ rects at: pageNumber - 1 ifAbsent: [0@0 extent: 0@0].
	self scrollToYAbsolute: oneRect bottom.
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 5/3/2001 13:01'!
scrollToYAbsolute: yValue

	| transform transformedPoint |

	transform _ scroller transformFrom: self.
	transformedPoint _ transform localPointToGlobal: 0@yValue.

	self scrollBy: 0@(bounds top - transformedPoint y).
! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/20/2001 17:10'!
showPageBreaksString

	^(thePasteUp ifNil: [^'???']) showPageBreaksString! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/21/2001 12:58'!
toggleKeepScrollbar

	self setProperty: #keepScrollBarAlways toValue: self keepScrollBarAlways not! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 2/20/2001 17:12'!
togglePageBreaks

	(thePasteUp ifNil: [^self]) togglePageBreaks! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 9/7/2000 11:42'!
wantsDroppedMorph: aMorph event: evt
	"Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. The default implementation returns false.
NOTE: the event is assumed to be in global (world) coordinates."

	^false! !

!AlansTextPlusMorph methodsFor: 'as yet unclassified' stamp: 'RAA 9/6/2000 16:25'!
wantsSlot

	^false! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

AlansTextPlusMorph class
	instanceVariableNames: ''!

!AlansTextPlusMorph class methodsFor: 'as yet unclassified' stamp: 'RAA 9/10/2000 12:52'!
includeInNewMorphMenu

	^ false		"to encourage the use of GeeMail instead"! !