'From etoys2.2 of 27 September 2007 [latest update: #1787] on 20 November 2007 at 12:22:56 am'!
"Change Set:		PopUpCaretFix-tak
Date:			19 November 2007
Author:			Takashi Yamamiya

Based on Karl Ramberg's idea, position of  arrow follows width of the text."!


!TileMorph methodsFor: 'arrows popup' stamp: 'tak 11/19/2007 03:30'!
buildHPopArrows
	| panel left right |
	self outmostScriptEditor
		ifNil: [^ nil].
	(retractArrow isNil
			and: [suffixArrow isNil])
		ifTrue: [^ nil].
	panel := Morph new.
	panel cornerStyle: #rounded.
	left := SketchMorph new
				form: (ScriptingSystem formAtKey: #LargeLeftArrow).
	right := SketchMorph new
				form: (ScriptingSystem formAtKey: #LargeRightArrow).
	panel
		color: (Color white alpha: 0.7).
	panel sticky: true.
	panel layoutPolicy: TableLayout new.
	panel listDirection: #leftToRight.
	panel hResizing: #shrinkWrap.
	panel vResizing: #shrinkWrap.
	panel cellInset: 4.
	panel layoutInset: 2.
	retractArrow
		ifNotNil: [panel addMorphBack: left].
	suffixArrow
		ifNotNil: [panel addMorphBack: right].
	panel
		on: #mouseLeave
		send: #hidePopArrows
		to: self.
	left
		on: #mouseUp
		send: #popArrowRetractArrowHit:
		to: self.
	right
		on: #mouseUp
		send: #showSuffixChoices
		to: self.
	^ panel! !

!TileMorph methodsFor: 'arrows popup' stamp: 'tak 11/19/2007 01:53'!
buildVPopArrows
	| panel up down |
	panel := Morph new.
	panel cornerStyle: #rounded.
	up := SketchMorph new
				form: (ScriptingSystem formAtKey: #LargeUpArrow).
	down := SketchMorph new
				form: (ScriptingSystem formAtKey: #LargeDownArrow).
	panel
		color: (Color white alpha: 0.7).
	panel sticky: true.
	panel layoutPolicy: TableLayout new.
	panel listDirection: #topToBottom.
	panel hResizing: #shrinkWrap.
	panel vResizing: #shrinkWrap.
	panel cellInset: 4.
	panel layoutInset: 2.
	panel addMorphBack: up.
	panel addMorphBack: down.
	panel
		on: #mouseLeave
		send: #hidePopArrows
		to: self.
	up
		on: #mouseDown
		send: #popArrowUp:
		to: self.
	up
		on: #mouseMove
		send: #mouseMove:
		to: self.
	down
		on: #mouseDown
		send: #popArrowDown:
		to: self.
	down
		on: #mouseMove
		send: #mouseMove:
		to: self.
	^ panel! !

!TileMorph methodsFor: 'arrows popup' stamp: 'tak 11/19/2007 01:53'!
hidePopArrows
	| panels |
	panels := self activeHand
				valueOfProperty: #popArrows
				ifAbsent: [^ self].
	panels
		do: [:each | each
				ifNotNil: [each delete]].
	self activeHand removeProperty: #popArrows! !

!TileMorph methodsFor: 'arrows popup' stamp: 'tak 11/19/2007 01:56'!
popArrowRetractArrowHit: evt 
	self retractArrowHit.
	self showPopArrows! !

!TileMorph methodsFor: 'arrows popup' stamp: 'tak 11/19/2007 03:23'!
showPopArrows
	| vpanel hpanel |
	self hidePopArrows.
	(self hasProperty: #isPopArrowNeeded)
		ifFalse: [^ self].
	vpanel := self buildVPopArrows.
	hpanel := self buildHPopArrows.
	self activeHand setProperty: #popArrows toValue: {vpanel. hpanel}.
	self layoutChanged! !

!TileMorph methodsFor: 'event handling' stamp: 'tak 11/19/2007 01:55'!
mouseEnter: evt
	self showPopArrows! !

!TileMorph methodsFor: 'event handling' stamp: 'tak 11/19/2007 01:53'!
mouseLeave: evt 
	"When the mouse is leaving and next object is not a pop arrow, remove pop arrows. "
	| popArrows |
	popArrows := evt hand
				valueOfProperty: #popArrows
				ifAbsent: [^ self].
	popArrows
		detect: [:each | each notNil
				and: [each containsPoint: evt position]]
		ifNone: [self hidePopArrows]! !

!TileMorph methodsFor: 'layout' stamp: 'tak 11/19/2007 15:13'!
layoutChanged
	| vpanel hpanel popArrows |
	super layoutChanged.
	self labelMorph
		ifNil: [^ self].
	popArrows := self activeHand
				valueOfProperty: #popArrows
				ifAbsent: [^ self].
	vpanel := popArrows first.
	hpanel := popArrows second.
	vpanel
		ifNotNil: [vpanel openInWorld.
			vpanel center: self labelMorph center.
			vpanel right: self labelMorph left - 2].
	hpanel
		ifNotNil: [hpanel openInWorld.
			hpanel center: self labelMorph center.
			hpanel left: self labelMorph right + 2]! !

TileMorph removeSelector: #hidePopArrows:!
TileMorph removeSelector: #popArrowShowSuffixChoices:!
TileMorph removeSelector: #showPopArrows:!

!TileMorph reorganize!
('accessing' abandonLabelFocus associatedPlayer downArrow labelMorph lastTile literal literalFromContents literal: operatorOrExpression options playerBearingCode receiverType resultType retractArrow slotName suffixArrow type upArrow updatingStringMorph value value:)
('arrows' addArrows addCaretsAsAppropriate: addRetractArrow addRetractArrowAnyway addSuffixArrow addSuffixIfCan arrowAction: couldAddSuffixArrow couldRetract deleteSuffixArrow phraseForOp:arg:resultType: rescindRetractArrow rescindSuffixArrow retractArrowHit setVisibilityOfUpDownCarets: showSuffixChoices variableDelay: wrapPhraseInFunction)
('arrows popup' buildHPopArrows buildVPopArrows hidePopArrows popArrowDown: popArrowRetractArrowHit: popArrowUp: showPopArrows)
('as yet unclassified' fixLayoutOfSubmorphsNotIn: fixUponLoad:seg: unhibernate)
('change reporting' colorChangedForSubmorph: ownerChanged)
('code generation' acceptNewLiteral codeString parseNodeWith: precedingTileType scriptEdited sexpWith: storeCodeOn:indent:)
('copying' veryDeepFixupWith: veryDeepInner:)
('dropping/grabbing' justGrabbedFrom:)
('event handling' grabMorph: handlesMouseDown: handlesMouseOver: handlesMouseStillDown: morphToDropInPasteUp: mouseDown: mouseEnter: mouseLeave: mouseMove: mouseStillDown: mouseUp: wantsKeyboardFocusFor:)
('events-processing' handlerForMouseDown:)
('e-toy support' adoptVocabulary: isCandidateForAutomaticViewing localeChanged)
('initialization' actualObject bePossessive bringUpToDate defaultBorderWidth emblazonPlayerNameOnReferenceTile emblazonPlayerNameOnReferenceTileWithin: initialize isPossessive rawVocabulary: referToSimilarObject: referTo: retargetFrom:to: setExpression:label: setLiteral: setOperatorAndUseArrows: setOperator: setOperator:andUseWording: setSlotRefOperator: setToReferTo: updateWordingToMatchVocabulary)
('layout' layoutChanged)
('macpal' currentVocabulary scriptPerformer)
('misc' addCustomMenuItems:hand: basicWidth currentEToyVocabulary handReferentMorph minimumWidth numericValue setLiteralInitially: soundChoices typeColor:)
('mouse handling' arrowDelta presentOperatorAlternatives: showOptions)
('player viewer' updateLiteralLabel)
('printing' printOn:)
('scripting' isTileLike isTileScriptingElement restoreTypeColor useUniformTileColor)
('testing' isTileMorph)
('tiles from method' selectorTile:in:)
('*connectors-commands' playerRepresented)
('*connectors-dropping/grabbing' justDroppedInto:event:)
('private' convertAlignment line1: test)
!