'From Cuis 1.0 of 19 April 2009 [latest update: #187] on 10 May 2009 at 10:20:11 am'!
!classDefinition: #MouseClickState category: #'Morphic-OldKernel'!
Object subclass: #MouseClickState
	instanceVariableNames: 'clickClient clickState firstClickDown firstClickUp firstClickTime clickSelector dblClickSelector dblClickTime dblClickTimeoutSelector dragSelector dragThreshold sendYellowButtonActivity '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!

!LightWidget methodsFor: 'meta actions' stamp: 'jmv 5/8/2009 19:45'!
blueButtonDown: anEvent
	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
	| h tfm doNotDrag |
	h _ anEvent hand halo.
	"Prevent wrap around halo transfers originating from throwing the event back in"
	doNotDrag _ false.
	h ifNotNil:[
		(h innerTarget == self) ifTrue:[doNotDrag _ true].
		(h innerTarget hasOwner: self) ifTrue:[doNotDrag _ true].
		(self hasOwner: h target) ifTrue:[doNotDrag _ true]].

	tfm _ (self transformedFrom: nil) inverseTransformation.

	"cmd-drag on flexed morphs works better this way"
	h _ self addHalo: (anEvent transformedBy: tfm).
	doNotDrag ifTrue:[^self].
	"Initiate drag transition if requested"
	anEvent hand 
		waitForClicksOrDrag: h
		event: (anEvent transformedBy: tfm)
		clkSel: nil
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel: #dragTarget:
		threshold: 5.
	"Pass focus explicitly here"
	anEvent hand newMouseFocus: h.! !


!MessageSet methodsFor: 'filtering' stamp: 'jmv 5/8/2009 18:54'!
filterMessageList
	"Allow the user to refine the list of messages."

	| aMenu evt |
	messageList size <= 1 
		ifTrue: [^self inform: 'this is not a propitious filtering situation'].

	"would like to get the evt coming in but thwarted by the setInvokingView: circumlocution"
	evt := self currentWorld activeHand lastEvent.
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addTitle: 'Filter by only showing...'.
	aMenu addStayUpItem.
	aMenu 
		addList: #(#('unsent messages' #filterToUnsentMessages 'filter to show only messages that have no senders') #- #('messages that send...' #filterToSendersOf 'filter to show only messages that send a selector I specify') #('messages that do not send...' #filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') #- #('messages whose selector is...' #filterToImplementorsOf 'filter to show only messages with a given selector I specify') #('messages whose selector is NOT...' #filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') #- #('messages in current change set' #filterToCurrentChangeSet 'filter to show only messages that are in the current change set') #('messages not in current change set' #filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') #- #('messages in any change set' #filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') #('messages not in any change set' #filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') #- #('messages authored by me' #filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') #('messages not authored by me' #filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') #- #('messages logged in .changes file' #filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') #('messages only in .sources file' #filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') #- #('messages with prior versions' #filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') #('messages without prior versions' #filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') #- #('uncommented messages' #filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') #('commented messages' #filterToCommentedMethods 'fileter to show only messages that have comments at the beginning') #- #('messages that...' #filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')).
	aMenu popUpInWorld: evt hand world! !


!Morph methodsFor: 'meta-actions' stamp: 'jmv 5/8/2009 21:33'!
blueButtonDown: anEvent
	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
	| h tfm doNotDrag |
	h _ anEvent hand halo.
	"Prevent wrap around halo transfers originating from throwing the event back in"
	doNotDrag _ false.
	h ifNotNil:[
		(h innerTarget == self) ifTrue:[doNotDrag _ true].
		(h innerTarget hasOwner: self) ifTrue:[doNotDrag _ true].
		(self hasOwner: h target) ifTrue:[doNotDrag _ true]].

	tfm _ (self transformedFrom: nil) inverseTransformation.

	"cmd-drag on flexed morphs works better this way"
	h _ self addHalo: (anEvent transformedBy: tfm).
	doNotDrag ifTrue:[^self].
	"Initiate drag transition if requested"
	anEvent hand 
		waitForClicksOrDrag: h
		event: (anEvent transformedBy: tfm)
		clkSel: nil
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel: #dragTarget:
		threshold: 5.
	"Pass focus explicitly here"
	anEvent hand newMouseFocus: h.! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 5/8/2009 18:54'!
invokeMetaMenu: evt
	| menu |
	menu _ self buildMetaMenu: evt.
	menu addTitle: self externalName.
	menu popUpInWorld: self world! !


!HaloMorph methodsFor: 'meta-actions' stamp: 'jmv 5/8/2009 19:44'!
blueButtonDown: event
	"Transfer the halo to the next likely recipient"
	target ifNil:[^self delete].
	event hand obtainHalo: self.
	positionOffset _ event position - (target point: target position in: owner).
	"wait for drags or transfer"
	event hand 
		waitForClicksOrDrag: self 
		event: event
		clkSel: #transferHalo:
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel: #dragTarget
		threshold: 5.! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 5/8/2009 18:54'!
doDebug: evt with: menuHandle
	"Ask hand to invoke the a debugging menu for my inner target.  If shift key is down, immediately put up an inspector on the inner target"

	| menu |
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
	self world displayWorld.
	evt shiftPressed ifTrue: 
		[self delete.
		^ innerTarget inspectInMorphic: evt].

	menu _ innerTarget buildDebugMenu: evt hand.
	menu addTitle: (innerTarget externalName truncateWithElipsisTo: 40).
	menu popUpInWorld: self world! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 5/8/2009 18:54'!
doMenu: evt with: menuHandle
	"Ask hand to invoke the halo menu for my inner target."

	| menu |
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: nil.
	self world displayWorld.
	menu _ innerTarget buildHandleMenu: evt hand.
	innerTarget addTitleForHaloMenu: menu.
	menu popUpInWorld: self world.
! !


!HandMorph methodsFor: 'double click support' stamp: 'jmv 5/8/2009 19:44'!
waitForClicksOrDrag: aMorph event: evt

	"Wait until the difference between click, double-click, or drag gesture is known, then inform the given morph what transpired. This message is sent when the given morph first receives a mouse-down event. If the mouse button goes up, then down again within DoubleClickTime, then 'doubleClick: evt' is sent to the morph. If the mouse button goes up but not down again within DoubleClickTime, then the message 'click: evt' is sent to the morph. Finally, if the button does not go up within DoubleClickTime, then 'drag: evt' is sent to the morph. In all cases, the event supplied is the original mouseDown event that initiated the gesture. mouseMove: and mouseUp: events are not sent to the morph until it becomes the mouse focus, which is typically done by the client in its click:, doubleClick:, or drag: methods." 
	
	^self 
		waitForClicksOrDrag: aMorph 
		event: evt 
		clkSel: #click:
		dblClkSel: #doubleClick:
		dblClkTimeoutSel: #doubleClickTimeout:
		dragSel: #startDrag:
		threshold: 10! !

!HandMorph methodsFor: 'double click support' stamp: 'jmv 5/8/2009 19:49'!
waitForClicksOrDrag: aMorph event: evt  clkSel: clkSel dblClkSel: dblClkSel dblClkTimeoutSel: dblClkTimeoutSel dragSel: dragSel threshold: threshold

	"Wait until the difference between click, double-click, or drag gesture is known, then inform the given morph what transpired. This message is sent when the given morph first receives a mouse-down event. If the mouse button goes up, then down again within DoubleClickTime, then 'doubleClick: evt' is sent to the morph. If the mouse button goes up but not down again within DoubleClickTime, then the message 'click: evt' is sent to the morph. Finally, if the button does not go up within DoubleClickTime, then 'drag: evt' is sent to the morph. In all cases, the event supplied is the original mouseDown event that initiated the gesture. mouseMove: and mouseUp: events are not sent to the morph until it becomes the mouse focus, which is typically done by the client in its click:, doubleClick:, or drag: methods." 

	mouseClickState _ 
		MouseClickState new
			client: aMorph 
			click: clkSel 
			dblClick: dblClkSel
			dblClickTime: DoubleClickTime 
			dblClickTimeout: dblClkTimeoutSel
			drag: dragSel
			threshold: threshold 
			event: evt
			sendYellowButtonActivity: false! !

!HandMorph methodsFor: 'double click support' stamp: 'jmv 5/8/2009 19:51'!
waitForClicksOrDragOrSimulatedYellow: aMorph event: evt clkSel: clkSel dblClkSel: dblClkSel dblClkTimeoutSel: dblClkTimeoutSel dragSel: dragSel threshold: threshold

	"Wait until the difference between click, double-click, or drag gesture is known, then inform the given morph what transpired. This message is sent when the given morph first receives a mouse-down event. If the mouse button goes up, then down again within DoubleClickTime, then 'doubleClick: evt' is sent to the morph. If the mouse button goes up but not down again within DoubleClickTime, then the message 'click: evt' is sent to the morph. Finally, if the button does not go up within DoubleClickTime, then 'drag: evt' is sent to the morph. In all cases, the event supplied is the original mouseDown event that initiated the gesture. mouseMove: and mouseUp: events are not sent to the morph until it becomes the mouse focus, which is typically done by the client in its click:, doubleClick:, or drag: methods." 

	mouseClickState _ 
		MouseClickState new
			client: aMorph 
			click: clkSel 
			dblClick: dblClkSel
			dblClickTime: DoubleClickTime 
			dblClickTimeout: dblClkTimeoutSel
			drag: dragSel
			threshold: threshold 
			event: evt
			sendYellowButtonActivity: true! !

!HandMorph methodsFor: 'double click support' stamp: 'jmv 5/8/2009 19:52'!
waitForSimulatedYellow: aMorph event: evt threshold: threshold

	"Wait until the difference between click, double-click, or drag gesture is known, then inform the given morph what transpired. This message is sent when the given morph first receives a mouse-down event. If the mouse button goes up, then down again within DoubleClickTime, then 'doubleClick: evt' is sent to the morph. If the mouse button goes up but not down again within DoubleClickTime, then the message 'click: evt' is sent to the morph. Finally, if the button does not go up within DoubleClickTime, then 'drag: evt' is sent to the morph. In all cases, the event supplied is the original mouseDown event that initiated the gesture. mouseMove: and mouseUp: events are not sent to the morph until it becomes the mouse focus, which is typically done by the client in its click:, doubleClick:, or drag: methods." 

	mouseClickState _ 
		MouseClickState new
			client: aMorph 
			click: nil 
			dblClick: nil
			dblClickTime: DoubleClickTime 
			dblClickTimeout: nil
			drag: nil
			threshold: threshold 
			event: evt
			sendYellowButtonActivity: true! !


!MouseClickState methodsFor: 'event handling' stamp: 'jmv 5/10/2009 10:19'!
handleEvent: evt from: aHand
	"Process the given mouse event to detect a click, double-click, or drag.
	Return true if the event should be processed by the sender, false if it shouldn't.
	NOTE: This method heavily relies on getting *all* mouse button events."
	| localEvt timedOut isDrag distance |
	timedOut _ (evt timeStamp - firstClickTime) > dblClickTime.
	localEvt _ evt transformedBy: (clickClient transformedFrom: aHand owner).
	distance _ (localEvt position - firstClickDown position) r.
	isDrag _ distance > dragThreshold.
	clickState == #firstClickDown ifTrue: [
		"Careful here - if we had a slow cycle we may have a timedOut mouseUp event"
		(timedOut and:[localEvt isMouseUp not]) ifTrue:[
			"timeout before #mouseUp -> keep waiting for drag or sendYellowButtonActivity if requested"
			clickState _ #firstClickTimedOut.
			(sendYellowButtonActivity not and: [ dragSelector isNil ]) ifTrue: [
				aHand resetClickState.
				self doubleClickTimeout; click "***"].
			^true].
		localEvt isMouseUp ifTrue:[
			(timedOut or: [ dblClickSelector isNil ]) ifTrue:[
				self click.
				aHand resetClickState.
				^true ].
			"Otherwise transfer to #firstClickUp"
			firstClickUp _ evt copy.
			clickState _ #firstClickUp.
			"If timedOut or the client's not interested in dbl clicks get outta here"
			self click.
			aHand handleEvent: firstClickUp.
			^false ].
		isDrag ifTrue: [ "drag start"
			self doubleClickTimeout. "***"
			aHand resetClickState.
			dragSelector "If no drag selector send #click instead"
				ifNil: [ self click ]
				ifNotNil: [ self drag: firstClickDown ].
			^true ].
		^false ].

	clickState == #firstClickTimedOut ifTrue: [
		localEvt isMouseUp ifTrue:[ "neither drag nor double click"
			aHand resetClickState.
			self doubleClickTimeout; click. "***"
			^true ].
		isDrag ifTrue: [ "drag start"
			aHand resetClickState.
			self doubleClickTimeout; drag: firstClickDown. "***"
			^true ].
		"Neither drag nor double click. Simulate yellow button click. This is useful, for example, for pen computers"
		(sendYellowButtonActivity and: [ distance = 0 ]) ifTrue: [
			aHand resetClickState.
			clickClient yellowButtonActivity: evt shiftPressed.
			^true ].
		^false ].

	clickState = #firstClickUp ifTrue:[
		timedOut ifTrue:[
			"timed out after mouseUp - send #click: and mouseUp"
			aHand resetClickState.
			self doubleClickTimeout. "***"
			^true ].
		localEvt isMouseDown ifTrue:[ "double click"
			clickState _ #secondClickDown.
			^false ]].

	clickState == #secondClickDown ifTrue: [
		localEvt isMouseUp ifTrue: ["double click"
			aHand resetClickState.
			self doubleClick.
			^false ]
	].

	^true! !

!MouseClickState methodsFor: 'initialize' stamp: 'jmv 5/8/2009 19:49'!
client: aMorph click: aClickSelector dblClick: aDblClickSelector dblClickTime: timeOut dblClickTimeout: aDblClickTimeoutSelector drag: aDragSelector threshold: aNumber event: firstClickEvent sendYellowButtonActivity: aBoolean
	clickClient _ aMorph.
	clickSelector _ aClickSelector.
	dblClickSelector _ aDblClickSelector.
	dblClickTime _ timeOut.
	dblClickTimeoutSelector _ aDblClickTimeoutSelector.
	dragSelector _ aDragSelector.
	dragThreshold _ aNumber.
	firstClickDown _ firstClickEvent.
	firstClickTime _ firstClickEvent timeStamp.
	clickState _ #firstClickDown.
	sendYellowButtonActivity _ aBoolean! !


!PasteUpMorph methodsFor: 'event handling' stamp: 'jmv 5/8/2009 19:45'!
mouseDown: evt
	"Handle a mouse down event."
	| grabbedMorph handHadHalos handler |
	grabbedMorph _ self morphToGrab: evt.
	grabbedMorph ifNotNil:[
		grabbedMorph isSticky ifTrue:[^self].
		^evt hand grabMorph: grabbedMorph].

	handler _ self eventHandler.
	(handler notNil and: [handler handlesMouseDown: evt])
		ifTrue: [^handler mouseDown: evt fromMorph: self].
		
	handHadHalos _ evt hand halo notNil.
	evt hand halo: nil. "shake off halos"
	evt hand releaseKeyboardFocus. "shake of keyboard foci"
	evt shiftPressed ifTrue:[
		^evt hand 
			waitForClicksOrDrag: self 
			event: evt 
			clkSel: #findWindow:
			dblClkSel: nil
			dblClkTimeoutSel: nil
			dragSel: #dragThroughOnDesktop:
			threshold: 5].
	self isWorldMorph ifTrue: [
		handHadHalos ifTrue: [^self addAlarm: #invokeWorldMenu: with: evt after: 200].
		^self invokeWorldMenu: evt
	].
	"otherwise, explicitly ignore the event if we're not the world,
	so that we could be picked up if need be"
	self isWorldMorph ifFalse:[evt wasHandled: false].
! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 5/8/2009 18:54'!
findDirtyBrowsers: evt 
	"Present a menu of window titles for browsers with changes,
	and activate the one that gets chosen."

	| menu |
	menu := MenuMorph new.
	(SystemWindow windowsIn: self
		satisfying: [:w | (w model isKindOf: Browser) and: [w model canDiscardEdits not]]) 
			do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #activate].
	menu submorphs notEmpty ifTrue: [menu popUpInWorld: self]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 5/8/2009 18:55'!
findDirtyWindows: evt 
	"Present a menu of window titles for all windows with changes,
	and activate the one that gets chosen."

	| menu |
	menu := MenuMorph new.
	(SystemWindow windowsIn: self
		satisfying: [:w | w model canDiscardEdits not]) do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #activate].
	menu submorphs notEmpty ifTrue: [menu popUpInWorld: self]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 5/8/2009 18:55'!
findWindow: evt 
	"Present a menu names of windows and naked morphs, and activate the one that gets chosen.  Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."

	| menu expanded collapsed nakedMorphs |
	menu := MenuMorph new.
	expanded := SystemWindow windowsIn: self
				satisfying: [:w | w isCollapsed not].
	collapsed := SystemWindow windowsIn: self
				satisfying: [:w | w isCollapsed].
	nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not].
	expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty) 
		ifTrue: [^Beeper beep].
	(expanded 
		asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) 
			do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #activateAndForceLabelToShow.
				w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
	expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty) 
		ifFalse: [menu addLine].
	(collapsed 
		asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) 
			do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #collapseOrExpand.
				w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
	nakedMorphs isEmpty ifFalse: [menu addLine].
	(nakedMorphs asSortedCollection: 
			[:w1 :w2 | 
			w1 nameForFindWindowFeature 
				caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) 
		do: 
			[:w | 
			menu 
				add: w nameForFindWindowFeature
				target: w
				action: #comeToFrontAndAddHalo].
	menu addTitle: 'find window' translated.
	menu popUpInWorld: self! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 5/8/2009 18:55'!
putUpWorldMenu: evt
	"Put up a menu in response to a click on the desktop, triggered by evt."

	| menu |
	evt isMouse ifTrue:
		[evt yellowButtonPressed
			ifTrue: [^ self yellowButtonClickOnDesktopWithEvent: evt].
		evt shiftPressed ifTrue:[^ self findWindow: evt]].
	"put up screen menu"
	menu _ self buildWorldMenu: evt.
	menu addTitle: Preferences desktopMenuTitle translated.
	menu popUpInWorld: self.
	^ menu! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 5/8/2009 18:55'!
yellowButtonClickOnDesktopWithEvent: evt 
	"Put up either the personalized menu or the world menu when 
	the user clicks on the morphic desktop with the yellow button. 
	The preference 'personalizedWorldMenu' governs which one 
	is used"
	| aMenu |
	Preferences personalizedWorldMenu
		ifTrue: [aMenu := MenuMorph new defaultTarget: self.
			Preferences personalizeUserMenu: aMenu.
			aMenu addLine.
			aMenu
				add: 'personalize...' translated
				target: Preferences
				action: #letUserPersonalizeMenu]
		ifFalse: [aMenu := self buildWorldMenu: evt.
			aMenu addTitle: 'World' translated].
	aMenu popUpInWorld: self! !


!PluggableButtonMorph methodsFor: 'event handling' stamp: 'jmv 5/8/2009 20:00'!
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 
		threshold: 10 "pixels".! !

!PluggableButtonMorph methodsFor: 'private' stamp: 'jmv 5/8/2009 18:55'!
yellowButtonActivity: shiftKeyState
	"Invoke my menu in response to the given event."
	| menu |
	menu _ self getMenu: shiftKeyState.
	menu ifNotNil: [menu popUpInWorld: self world]! !


!ScrollPane methodsFor: 'event handling' stamp: 'jmv 5/8/2009 20:00'!
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 transformedBy: (scroller transformFrom: self))].
	evt hand 
		waitForSimulatedYellow: self 
		event: evt 
		threshold: 10 "pixels".! !

!ScrollPane methodsFor: 'scroll bar events' stamp: 'jmv 5/8/2009 18:55'!
yellowButtonActivity: shiftKeyState
	| menu |
	(menu _ self getMenu: shiftKeyState) ifNotNil: [
		menu setInvokingView: self.
		menu popUpInWorld: self world]! !


!PluggableListMorph methodsFor: 'events' stamp: 'jmv 5/8/2009 20:00'!
mouseDown: evt

	| row |
	evt yellowButtonPressed  "First check for option (menu) click"
		ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
	self hasKeyboardFocus ifFalse: [
		evt hand newKeyboardFocus: self.
		"If we are focusing, deselect, so that later selection doesn't result in deselect."
		self listMorph noSelection].
	row _ self rowAtLocation: evt position.
	row = 0  ifTrue: [^super mouseDown: evt].
	"self dragEnabled ifTrue: [aMorph highlightForMouseDown]."
	evt hand 
		waitForClicksOrDragOrSimulatedYellow: self
		event: evt
		clkSel: #click:
		dblClkSel: (doubleClickSelector ifNotNil:[#doubleClick:])
		dblClkTimeoutSel: nil
		dragSel: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil])
		threshold: 10 "pixels".! !


!PluggableListMorphOfMany methodsFor: 'event handling' stamp: 'jmv 5/8/2009 20:00'!
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 
		threshold: 10 "pixels".! !


!SimpleHierarchicalListMorph methodsFor: 'event handling' stamp: 'jmv 5/8/2009 20:00'!
mouseDown: evt

	| aMorph |
	evt hand newKeyboardFocus: self.
	aMorph _ self itemFromPoint: evt position.
	(aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)])
		ifTrue:[^self toggleExpandedState: aMorph event: evt]. 
	evt yellowButtonPressed  "First check for option (menu) click"
		ifTrue: [^ self yellowButtonActivity: evt shiftPressed].
	aMorph ifNil:[^super mouseDown: evt].
	aMorph highlightForMouseDown.
	evt hand 
		waitForClicksOrDragOrSimulatedYellow: self 
		event: evt 
		clkSel: #click:
		dblClkSel: nil
		dblClkTimeoutSel: nil
		dragSel:  (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil])
		threshold: 10 "pixels".! !


!SystemWindow methodsFor: 'menu' stamp: 'jmv 5/8/2009 18:55'!
offerWindowMenu
	| aMenu |
	aMenu _ self buildWindowMenu.
	model ifNotNil: [
		model addModelItemsToWindowMenu: aMenu].
	aMenu popUpInWorld: self world! !


!TextEditor methodsFor: 'events' stamp: 'jmv 5/10/2009 10:11'!
mouseDown: evt 
	"An attempt to break up the old processRedButton code into threee phases"
	| clickPoint b |

	oldInterval _ self selectionInterval.
	clickPoint _ evt cursorPoint.
	b _ paragraph characterBlockAtPoint: clickPoint.

	(paragraph clickAt: clickPoint for: model controller: self) ifTrue: [
		self markBlock: b.
		self pointBlock: b.
		evt hand releaseKeyboardFocus: self.
		^ self ].
	
	"If click is inside the selection, do not modify it.
	This is so the 'tap and wait' gesture (used to bring pop-up menu
	on pen devices) does not affect selection, allowing to do copy / paste
	of selection with menu on pen devices."
	(oldInterval includes: b stringIndex) ifTrue: [ ^self ].
	
	evt shiftPressed
		ifFalse: [
			self closeTypeIn.
			self markBlock: b.
			self pointBlock: b ]
		ifTrue: [
			self closeTypeIn.
			self mouseMove: evt ].
	self storeSelectionInParagraph! !


!TextMorphForEditView methodsFor: 'event handling' stamp: 'jmv 5/8/2009 20:00'!
mouseDown: event

	event yellowButtonPressed ifTrue: [^ self yellowButtonActivity: event shiftPressed].
	super mouseDown: event.
	event hand 
		waitForSimulatedYellow: self 
		event: event 
		threshold: 10 "pixels".! !

!TextMorphForEditView methodsFor: 'private' stamp: 'jmv 5/8/2009 19:00'!
yellowButtonActivity: shiftKeyState
	^ editView yellowButtonActivity: shiftKeyState! !

PluggableButtonMorph removeSelector: #invokeMenu:!
MouseClickState removeSelector: #client:click:dblClick:dblClickTime:dblClickTimeout:drag:threshold:event:!
!classDefinition: #MouseClickState category: #'Morphic-OldKernel'!
Object subclass: #MouseClickState
	instanceVariableNames: 'clickClient clickState firstClickDown firstClickUp firstClickTime clickSelector dblClickSelector dblClickTime dblClickTimeoutSelector dragSelector dragThreshold sendYellowButtonActivity'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!
MenuMorph removeSelector: #popUpEvent:in:!
HandMorph removeSelector: #waitForClicksOrDrag:event:selectors:threshold:!
