'From Cuis 2.4 of 17 June 2010 [latest update: #509] on 30 June 2010 at 11:47:40 pm'!

!Editor methodsFor: 'new selection' stamp: 'jmv 6/30/2010 17:25'!
selectWord
	"Select delimited text or word--the result of double-clicking."

	^self selectWordLeftDelimiters: String cr rightDelimiters: String cr! !

!Editor methodsFor: 'new selection' stamp: 'jmv 6/30/2010 17:24'!
selectWordLeftDelimiters: leftDelimiters rightDelimiters: rightDelimiters
	"Select delimited text or word--the result of double-clicking."

	| openDelimiter closeDelimiter direction match level
	string here hereChar start stop |
	string _ self string.
	here _ self pointIndex.
	(here between: 2 and: string size)
		ifFalse: ["if at beginning or end, select entire string"
			^self selectFrom: 1 to: string size].
	openDelimiter _ string at: here - 1.
	match _ leftDelimiters indexOf: openDelimiter.
	match > 0
		ifTrue: 
			["delimiter is on left -- match to the right"
			start _ here.
			direction _ 1.
			here _ here - 1.
			closeDelimiter _ rightDelimiters at: match]
		ifFalse: 
			[openDelimiter _ string at: here.
			match _ rightDelimiters indexOf: openDelimiter.
			match > 0
				ifTrue: 
					["delimiter is on right -- match to the left"
					stop _ here - 1.
					direction _ -1.
					closeDelimiter _ leftDelimiters at: match]
				ifFalse: ["no delimiters -- select a token"
					direction _ -1]].
	level _ 1.
	[level > 0 and: [direction > 0
			ifTrue: [here < string size]
			ifFalse: [here > 1]]]
		whileTrue: 
			[hereChar _ string at: (here _ here + direction).
			match = 0
				ifTrue: ["token scan goes left, then right"
					hereChar tokenish
						ifTrue: [here = 1
								ifTrue: 
									[start _ 1.
									"go right if hit string start"
									direction _ 1]]
						ifFalse: [direction < 0
								ifTrue: 
									[start _ here + 1.
									"go right if hit non-token"
									direction _ 1]
								ifFalse: [level _ 0]]]
				ifFalse: ["bracket match just counts nesting level"
					hereChar = closeDelimiter
						ifTrue: [level _ level - 1"leaving nest"]
						ifFalse: [hereChar = openDelimiter 
									ifTrue: [level _ level + 1"entering deeper nest"]]]].

	level > 0 ifTrue: ["in case ran off string end"	here _ here + direction].
	direction > 0
		ifTrue: [self selectFrom: start to: here - 1]
		ifFalse: [self selectFrom: here + 1 to: stop]! !


!Morph methodsFor: 'geometry' stamp: 'jmv 6/30/2010 22:50'!
bounds: aRectangle in: referenceMorph
	self revisar.
	"este y los senders... quizas sacar... no se"
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	^(self externalizePositionFromOwner: aRectangle origin to: referenceMorph)
		corner:
	(self externalizePositionFromOwner: aRectangle corner to: referenceMorph)! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 6/30/2010 22:44'!
transferHalo: event from: formerHaloOwner
	"Progressively transfer the halo to the next likely recipient"
	| localEvt w |

	"Never transfer halo to top-most world"
	(self isWorldMorph and:[owner isNil]) ifFalse:[
		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
			ifTrue:[^self addHalo: event from: formerHaloOwner]].

	event shiftPressed ifTrue:[
		"Pass it outwards"
		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
		"We're at the top level; throw the event back in to find recipient"
		formerHaloOwner removeHalo.
		^self processEvent: event copy resetHandlerFields.
	].
	self submorphsDo:[:m|
		localEvt _ event internalizedToOwnerOf: m from: self.
		(m fullContainsPoint: localEvt position) 
			ifTrue:[^m transferHalo: event from: formerHaloOwner].
	].
	"We're at the bottom most level; throw the event back up to the root to find recipient"
	formerHaloOwner removeHalo.
	(w _ self world) ifNil: [ ^self ].
	localEvt _ event externalizedFromOwnerOf: self to: w.
	^w processEvent: localEvt resetHandlerFields.
! !


!MorphicEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:58'!
externalizedFromOwnerOf: targetMorph to: outerMorph
	"Return a new event, transformed from the receiver owner's to an outer coordinate system (outerMorph)."! !

!MorphicEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 23:02'!
internalizedTo: targetMorph from: outerMorph
	"Return a new event, transformed into an inner coordinate system (targetMorph's)."
! !

!MorphicEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 23:02'!
internalizedToOwnerOf: targetMorph from: outerMorph
	"Return a new event, transformed into an inner coordinate system (targetMorph owner's)."
! !


!DropEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:57'!
externalizeFromOwnerOf: targetMorph to: outerMorph
	"Transform from the receiver owner's to an outer coordinate system (outerMorph)."
	position _  targetMorph externalizePositionFromOwner: position to: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:58'!
externalizedFromOwnerOf: targetMorph to: outerMorph
	"Return a new event, transformed from the receiver owner's to an outer coordinate system (outerMorph)."
	^self shallowCopy externalizeFromOwnerOf: targetMorph to: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:58'!
internalizeTo: targetMorph from: outerMorph
	"Transform the receiver into an inner coordinate system (targetMorph's)."
	position _  targetMorph internalizePosition: position from: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:59'!
internalizeToOwnerOf: targetMorph from: outerMorph
	"Transform the receiver into an inner coordinate system (targetMorph onwer's)."
	position _  targetMorph internalizePositionToOwner: position from: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 23:01'!
internalizedTo: targetMorph from: outerMorph
	"Return a new event, transformed into an inner coordinate system (targetMorph's)."
	^self shallowCopy internalizeTo: targetMorph from: outerMorph! !

!DropEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 23:02'!
internalizedToOwnerOf: targetMorph from: outerMorph
	"Return a new event, transformed into an inner coordinate system (targetMorph owner's)."
	^self shallowCopy internalizeToOwnerOf: targetMorph from: outerMorph! !


!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/9/2009 12:50'!
dispatchDefault: anEvent with: aMorph
	"Dispatch the given event. The event will be passed to the front-most visible submorph that contains the position wrt. to the event."
	| localEvt inside |
	"See if we're fully outside aMorphs bounds"
	(aMorph fullBounds containsPoint: anEvent position) ifFalse: [ ^#rejected ]. "outside"

	"Traverse children"
	inside _ false.
	aMorph submorphsDo: [ :eachChild |
		inside ifFalse: [
			localEvt _ anEvent internalizedToOwnerOf: eachChild from: aMorph.
			(eachChild processEvent: localEvt using: self) == #rejected ifFalse: [
				"Not rejected. The event was in some submorph of the receiver"
				inside _ true.
				localEvt wasHandled ifTrue: [ anEvent copyHandlerState: localEvt ].
			]]].

	"Check for being inside the receiver"
	inside ifFalse: [ inside _ aMorph containsPoint: anEvent position event: anEvent ].
	inside ifTrue: [ ^aMorph handleEvent: anEvent ].
	^ #rejected! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/9/2009 12:50'!
dispatchDropEvent: anEvent with: aMorph
	"Find the appropriate receiver for the event and let it handle it. The dispatch is similar to the default dispatch with one difference: Morphs are given the chance to reject an entire drop operation. If the operation is rejected, no drop will be executed."
	| inside localEvt |

	"Try to get out quickly"
	(aMorph fullBounds containsPoint: anEvent cursorPoint)
		ifFalse: [ ^#rejected ].

	"Give aMorph a chance to repel the dropping morph"
	aMorph rejectDropEvent: anEvent.
	anEvent wasHandled ifTrue:[^self].

	"Go looking if any of our submorphs wants it"
	inside _ false.
	aMorph submorphsDo: [ :eachChild |
		inside ifFalse: [
			localEvt _ anEvent internalizedToOwnerOf: eachChild from: aMorph.
			(eachChild processEvent: localEvt using: self) == #rejected ifFalse: [
				localEvt wasHandled ifTrue: [ ^anEvent wasHandled: true ]. "done"
				inside _ true
			]]].

	inside ifFalse: [ inside _ aMorph containsPoint: anEvent cursorPoint event: anEvent ].
	inside ifTrue: [ ^aMorph handleEvent: anEvent ].
	^#rejected! !

!MorphicEventDispatcher methodsFor: 'dispatching' stamp: 'jmv 10/9/2009 12:50'!
dispatchMouseDown: anEvent with: aMorph
	"Find the appropriate receiver for the event and let it handle it. Default rules:
	* The top-most chain of visible, unlocked morphs containing the event position will get a chance to handle the event.
	* When travelling down the hierarchy a prospective handler for the event is installed. This prospective handler can be used by submorphs wishing to handle the mouse down for negotiating who the receiver is.
	* When travelling up, the prospective handler is always executed. The handler needs to check if the event was handled before as well as checking if somebody else's handler has been installed.
	* If another handler has been installed but the event was not handled it means that somebody up in the hierarchy wants to handle the event.
"
	| globalPt localEvt handler inside lastHandler |
	"Try to get out quickly"
	globalPt _ anEvent cursorPoint.
	(aMorph fullBounds containsPoint: globalPt) ifFalse: [ ^#rejected ].

	"Install the prospective handler for the receiver"
	lastHandler _ anEvent handler. "in case the mouse wasn't even in the receiver"
	handler _ aMorph handlerForMouseDown: anEvent.
	handler ifNotNil: [ anEvent handler: handler ].

	"Now give our submorphs a chance to handle the event"
	inside _ false.
	aMorph submorphsDo: [ :eachChild |
		inside ifFalse: [
			localEvt _ anEvent internalizedToOwnerOf: eachChild from: aMorph.
			(eachChild processEvent: localEvt using: self) == #rejected ifFalse: [
				"Some child did contain the point so we're part of the top-most chain."
				inside _ true.
				localEvt wasHandled ifTrue: [ anEvent copyHandlerState: localEvt ].
			]]].

	(inside or: [ aMorph containsPoint: anEvent cursorPoint event: anEvent ]) ifTrue:[
		"Receiver is in the top-most unlocked, visible chain."
		handler ifNotNil: [ handler handleEvent: anEvent ].
		"Note: Re-installing the handler is not really necessary but good style."
		anEvent handler: lastHandler.
		^self ].

	"Mouse was not on receiver nor any of its children"
	anEvent handler: lastHandler.
	^#rejected! !


!PluggableButtonMorph methodsFor: 'event handling' stamp: 'jmv 6/30/2010 23:24'!
mouseDown: evt
	"Details: If this button is triggered on mouse down or the event is the menu gesture, handle it immediately. Otherwise, make a list of buttons (including the receiver) for mouseMove feedback. This allows a simple radio-button effect among the button submorphs of a given morph."

	allButtons _ nil.
	evt yellowButtonPressed ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
	triggerOnMouseDown
		ifTrue: [self performAction]
		ifFalse: [
			allButtons _ owner submorphs select: [:m | m class = self class].
			self updateFeedbackForEvt: evt].
	evt hand
		waitForSimulatedYellow: self
		event: evt
		dblClkSel: #doubleClick:! !


!ScrollPane methodsFor: 'event handling' stamp: 'jmv 6/30/2010 23:23'!
mouseDown: evt

	evt yellowButtonPressed  "First check for option (menu) click"
		ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue: [
		scroller submorphs last mouseDown:
			(evt internalizedTo: scroller from: self)].
	evt hand 
		waitForSimulatedYellow: self 
		event: evt
		dblClkSel: #doubleClick:! !

!ScrollPane methodsFor: 'event handling' stamp: 'jmv 6/30/2010 20:32'!
mouseUp: evt
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue: [
		scroller submorphs last mouseUp: 
		(evt internalizedTo: scroller from: self)]! !

!ScrollPane methodsFor: 'pane events' stamp: 'jmv 6/30/2010 22:25'!
mouseMove: evt
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue: [
		scroller submorphs last mouseMove: 
		(evt internalizedTo: scroller from: self)]! !


!PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'jmv 6/30/2010 23:24'!
mouseDown: event

	| oldIndex oldVal row |
	event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed].

	self hasKeyboardFocus ifFalse: [
		event hand newKeyboardFocus: self ].

	row := self rowAtLocation: event position.

	row = 0 ifTrue: [^super mouseDown: event].

	model okToChange ifTrue: ["No change if model is locked"

		"Set meaning for subsequent dragging of selection"
		dragOnOrOff _ (self listSelectionAt: row) not.
		oldIndex _ self getCurrentSelectionIndex.
		oldIndex ~= 0 ifTrue: [oldVal _ self listSelectionAt: oldIndex].

		"Set or clear new primary selection (listIndex)"
		dragOnOrOff
			ifTrue: [self changeModelSelection: row]
			ifFalse: [self changeModelSelection: 0].

		"Need to restore the old one, due to how model works, and set new one."
		oldIndex ~= 0 ifTrue: [self listSelectionAt: oldIndex put: oldVal].
		self listSelectionAt: row put: dragOnOrOff.
		"event hand releaseMouseFocus: aMorph."
		"aMorph changed"
	].
	event hand
		waitForSimulatedYellow: self
		event: event
		dblClkSel: #doubleClick:! !


!PluggableTextMorph methodsFor: 'editor access' stamp: 'jmv 6/30/2010 23:44'!
scrollSelectionIntoView: event
	"Scroll my text into view if necessary and return true, else return false"
	| selRects delta selRect rectToTest cpHere |
	selectionInterval _ textMorph editor selectionInterval.
	selRects _ textMorph paragraph selectionRects.
	selRects isEmpty ifTrue: [^ false].
	rectToTest _ selRects first merge: selRects last.
	(event notNil and: [event anyButtonPressed]) ifTrue: [  "Check for autoscroll"
		cpHere _ scroller externalizePosition: event cursorPoint to: self.
		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 _ textMorph bounds: rectToTest in: self.
	selRect height > bounds height
		ifTrue: [^ false].  "Would not fit, even if we tried to scroll"
	(delta _ selRect amountToTranslateWithin: self viewableBounds) y ~= 0 ifTrue: [
		"Scroll end of selection into view if necessary"
		self scrollBy: 0@delta y.
		^ true].
	^ false! !

!PluggableTextMorph methodsFor: 'event handling' stamp: 'jmv 6/30/2010 23:21'!
doubleClick: event
	textMorph doubleClick: event! !


!SimpleHierarchicalListMorph methodsFor: 'drawing' stamp: 'jmv 6/30/2010 23:46'!
drawOn: aCanvas

	super drawOn: aCanvas.
	self hasKeyboardFocus ifTrue: [
		aCanvas
			frameRectangle: self focusIndicatorRectangle 
			width: Preferences focusIndicatorWidth
			color: Preferences focusIndicatorColor ].

	selectedMorph  ifNotNil:
		[aCanvas fillRectangle:
			((selectedMorph bounds: selectedMorph bounds in: self)
						intersect: scroller bounds)
				color: color blacker].

	Preferences showLinesInHierarchyViews ifTrue:[
		self drawLinesOn: aCanvas.
	].


! !


!TextEditor methodsFor: 'events' stamp: 'jmv 6/30/2010 17:18'!
doubleClick: evt

	self selectWord! !

!TextEditor methodsFor: 'events' stamp: 'jmv 6/30/2010 23:08'!
mouseMove: evt
	"Change the selection in response to mouse-down drag"

	self pointBlock: (paragraph characterBlockAtPoint: (evt cursorPoint)).
	self storeSelectionInParagraph! !

!TextEditor methodsFor: 'events' stamp: 'jmv 6/30/2010 23:09'!
mouseUp: evt
	"An attempt to break up the old processRedButton code into threee phases"
	| cursorBlock cursorIndex startBlock startIndex stopBlock stopIndex |
	oldInterval ifNil: [^ self].  "Patched during clickAt: repair"

	oldInterval = self selectionInterval
		ifTrue: [
			"Squeak classic behavior"
			"self pointBlock: (paragraph characterBlockAtPoint: (evt cursorPoint))."

			"Mac behavior"
			cursorBlock _ paragraph characterBlockAtPoint: evt cursorPoint.
			cursorIndex _ cursorBlock stringIndex.
			startBlock _ self startBlock min: cursorBlock.
			startIndex _ startBlock stringIndex.
			stopBlock _ self stopBlock max: cursorBlock.
			stopIndex _ stopBlock stringIndex.
			(stopIndex - cursorIndex) < (cursorIndex - startIndex)
				ifTrue: [
					self markBlock: startBlock.
					self pointBlock: cursorBlock ]
				ifFalse: [
					self markBlock: stopBlock.
					self pointBlock: cursorBlock ]].

	self setEmphasisHereFromText.
	(self isDisjointFrom: oldInterval) ifTrue: [
		otherInterval _ oldInterval].

	self storeSelectionInParagraph	"store selection , done in this method, (shift click) or perhaps in #mouseDown: (click)"! !


!SmalltalkEditor methodsFor: 'new selection' stamp: 'jmv 6/30/2010 17:24'!
selectWord
	"Select delimited text or word--the result of double-clicking."

	| leftDelimiters rightDelimiters |
	leftDelimiters _ '([{<''"
'.
	rightDelimiters _ ')]}>''"
'.
	^self selectWordLeftDelimiters: leftDelimiters rightDelimiters: rightDelimiters! !


!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 6/30/2010 23:28'!
openMenu
	"Build the open window menu for the world."

	| menu |
	menu _ self menu: 'open...'.
	self fillIn: menu from: {

		{'browser' . { self . #openBrowser}. 'A five-paned tool that lets you see all the code in the system'}.
		{'package-pane browser' . { PackagePaneBrowser . #openBrowser} . 'Similar to the regular browser, but adds an extra pane at top-left that groups class-categories that start with the same prefix' }.
		{'workspace' . {self . #openWorkspace}. 'A window for evaluating Smalltalk expressions' }.
		{'text editor' . {self . #openTextEditor}. 'A window for composing text' }.
		{'file list' . {self . #openFileList} . 'A tool allowing you to browse any file' }.
		{'file...' . { FileList . #openFileDirectly} . 'Lets you open a window on a single file'}.
		{'transcript' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }.
		{ 'process browser' . { ProcessBrowser . #open } }.
		"{'inner world' . { WorldWindow . #test1} }."
		nil.
		{'message names' . { self . #openMessageNames} . 'A tool for finding and editing methods that contain any given keyword in their names.'}.
		nil.
		{'simple change sorter' . {self . #openChangeSorter1} . 'A tool allowing you to view the methods in a single change set' }.
		{'dual change sorter' . {self . #openChangeSorter2} . 'A tool allowing you to compare and manipulate two change sets concurrently' }.
		nil.
	}.
	self fillIn: menu from: self class registeredOpenCommands.
	^menu! !


!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:57'!
externalizeFromOwnerOf: targetMorph to: outerMorph
	"Transform from the receiver owner's to an outer coordinate system (outerMorph)."
	position _  targetMorph externalizePositionFromOwner: position to: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:58'!
externalizedFromOwnerOf: targetMorph to: outerMorph
	"Return a new event, transformed from the receiver owner's to an outer coordinate system (outerMorph)."
	^self shallowCopy externalizeFromOwnerOf: targetMorph to: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:59'!
internalizeTo: targetMorph from: outerMorph
	"Transform the receiver into an inner coordinate system (targetMorph's)."
	position _  targetMorph internalizePosition: position from: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:59'!
internalizeToOwnerOf: targetMorph from: outerMorph
	"Transform the receiver into an inner coordinate system (targetMorph onwer's)."
	position _  targetMorph internalizePositionToOwner: position from: outerMorph! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 23:02'!
internalizedTo: targetMorph from: outerMorph
	"Return a new event, transformed into an inner coordinate system (targetMorph's)."
	^self shallowCopy internalizeTo: targetMorph from: outerMorph
! !

!UserInputEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 23:02'!
internalizedToOwnerOf: targetMorph from: outerMorph
	"Return a new event, transformed into an inner coordinate system (targetMorph owner's)."
	^self shallowCopy internalizeToOwnerOf: targetMorph from: outerMorph
! !


!MouseMoveEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:57'!
externalizeFromOwnerOf: targetMorph to: outerMorph
	"Transform from the receiver owner's to an outer coordinate system (outerMorph)."
	position _  targetMorph externalizePositionFromOwner: position to: outerMorph.
	startPoint _  targetMorph externalizePositionFromOwner: startPoint to: outerMorph! !

!MouseMoveEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:59'!
internalizeTo: targetMorph from: outerMorph
	"Transform the receiver into an inner coordinate system (targetMorph's)."
	position _  targetMorph internalizePosition: position from: outerMorph.
	startPoint _  targetMorph internalizePosition: startPoint from: outerMorph! !

!MouseMoveEvent methodsFor: 'transforming' stamp: 'jmv 6/30/2010 22:59'!
internalizeToOwnerOf: targetMorph from: outerMorph
	"Transform the receiver into an inner coordinate system (targetMorph onwer's)."
	position _  targetMorph internalizePositionToOwner: position from: outerMorph.
	startPoint _  targetMorph internalizePositionToOwner: startPoint from: outerMorph! !

HandMorph removeSelector: #waitForSimulatedYellow:event:!
