Very nice, thank you!
The logic for mapping the cursor position to links is still buggy (e.g., in the screenshot when hovering at the X), but this seems to be a different issue. :-)
Best, Christoph
--- Sent from Squeak Inbox Talk
On 2023-07-26T15:15:40+00:00, commits@source.squeak.org wrote:
Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2116.mcz
==================== Summary ====================
Name: Morphic-mt.2116 Author: mt Time: 26 July 2023, 5:15:38.140063 pm UUID: ccde047a-5845-5345-8989-e1f2c738612c Ancestors: Morphic-mt.2115
In Morphic, redesign how text actions are processed:
- underline actions on mouse hover
- integrate with Morphic UI loop, i.e., no busy wait for mouse-up
- allow for selecting text from within text-action ranges for a better support of the preference "Interactive print-it"
Unfortunately, the current text selection is not preserved anymore when just clicking a text action at the moment. Hmmm...
=============== Diff against Morphic-mt.2115 ===============
Item was removed:
- ----- Method: NewParagraph>>clickAt:for:controller: (in category 'editing') -----
- clickAt: clickPoint for: model controller: editor
- "Give sensitive text a chance to fire. Display flash: (100(a)100 extent: 100(a)100)."
- | startBlock action |
- action := false.
- startBlock := self characterBlockAtPoint: clickPoint.
- (text attributesAt: startBlock stringIndex forStyle: textStyle)
- do: [:att | | range target box boxes |
- att mayActOnClick ifTrue:
- [(target := model) ifNil: [target := editor morph].
- range := text rangeOf: att startingAt: startBlock stringIndex.
- boxes := self selectionRectsFrom: (self characterBlockForIndex: range first)
- to: (self characterBlockForIndex: range last+1).
- box := boxes detect: [:each | each containsPoint: clickPoint] ifNone: [nil].
- box ifNotNil:
- [ box := (editor transformFrom: nil) invertBoundsRect: box.
- editor morph allOwnersDo: [ :m | box := box intersect: (m boundsInWorld) ].
- self flag: #fix. "mt: Make it stateful and with real events."
- Utilities awaitMouseUpIn: box
- repeating: []
- ifSucceed: [(att actOnClickFor: target in: self at: clickPoint editor: editor) ifTrue: [action := true]].
- Cursor currentCursor == Cursor webLink ifTrue:[Cursor normal show].
- ]]].
- ^ action!
Item was changed: ----- Method: TextEditor>>mouseDown: (in category 'events') ----- mouseDown: evt "Either 1) handle text actions in the paragraph, 2) begin a text drag operation, or 3) modify the caret/selection."
- | clickPoint b |
oldInterval := self selectionInterval.
- (self mouseDownOnTextAction: evt) ifTrue: [^ self].
clickPoint := evt cursorPoint.
b := paragraph characterBlockAtPoint: clickPoint.
(paragraph clickAt: clickPoint for: model controller: self) ifTrue: [
self flag: #note. "mt: Do not reset the current text selection for successful text actions. Leave markBlock and pointBlock as is. This behavior matches the one in web browsers when clicking on links."
evt hand releaseKeyboardFocus: morph.
evt hand releaseMouseFocus: morph.
^ self ].
(morph dragEnabled and: [self isEventInSelection: evt]) ifTrue: [ evt hand waitForClicksOrDrag: morph event: evt selectors: {#click:. nil. nil. #startDrag:} threshold: HandMorph dragThreshold. morph setProperty: #waitingForTextDrag toValue: true. ^ self]. evt shiftPressed
- ifFalse: [ | b |
- ifFalse: [
self closeTypeIn.
- b := paragraph characterBlockAtPoint: evt position.
markBlock := b. pointBlock := b ] ifTrue: [ self closeTypeIn. self mouseMove: evt ].
- self storeSelectionInParagraph.!
- self storeSelectionInParagraph!
Item was added:
- ----- Method: TextEditor>>mouseDownOnTextAction: (in category 'events') -----
- mouseDownOnTextAction: evt
- self flag: #todo. "mt: Do not reset the current text selection for successful text actions. Leave markBlock and pointBlock as is. This behavior matches the one in web browsers when clicking on links."
- ^ false!
Item was added:
- ----- Method: TextEditor>>mouseEnterOnTextAction: (in category 'events') -----
- mouseEnterOnTextAction: evt
- "Manage mouse-hovering effects for text actions."
- | index highlights |
- self removeHighlightedTextActions.
- index := (paragraph characterBlockAtPoint: evt position) stringIndex.
- (paragraph text attributesAt: index forStyle: paragraph textStyle)
- do: [:attr | | highlight range |
- attr mayActOnClick ifTrue: [
- highlights ifNil: [
- morph
- setProperty: #highlightedTextActions
- toValue: (highlights := OrderedCollection new)].
- highlight := TextEmphasis underlined.
- range := paragraph text rangeOf: attr startingAt: index.
- highlights add: {attr. highlight. range}.
- paragraph text
- addAttribute: highlight
- from: range start to: range stop]].
- highlights
- ifNil: [self updateCursorForEvent: evt]
- ifNotNil: [
- morph updateFromParagraph.
- evt hand showTemporaryCursor: Cursor webLink].!
Item was changed: ----- Method: TextEditor>>mouseUp: (in category 'events') ----- mouseUp: evt "An attempt to break up the old processRedButton code into threee phases"
- "0) Click on text actions."
- (self mouseUpOnTextAction: evt) ifTrue: [^ self].
- "1) A 'double-click' will result in selecting the whole word."
- (self hasCaret and: [oldInterval = self selectionInterval])
- oldInterval ifNil: [^ self]. "Patched during clickAt: repair"
- (self hasCaret
- and: [oldInterval = self selectionInterval])
ifTrue: [self selectWord].
- "2) For the next type-in, configure emphasis. We don't want to do this on
- every key-press for performance reasons."
self setEmphasisHere.
- "3) Notice selection changes."
- (self isDisjointFrom: oldInterval)
- ifTrue: [otherInterval := oldInterval].
- (self isDisjointFrom: oldInterval) ifTrue:
- [otherInterval := oldInterval].
self storeSelectionInParagraph.
- "4) Reset mouse cursor to account for selection changes."
self updateCursorForEvent: evt. morph removeProperty: #waitingForTextDrag.!
Item was added:
- ----- Method: TextEditor>>mouseUpOnTextAction: (in category 'events') -----
- mouseUpOnTextAction: evt
- | target |
- "Do not trigger text action if start and stop of the selection are within that action range."
- self hasCaret ifFalse: [
- self removeHighlightedTextActions.
- ^ false].
- (morph hasProperty: #highlightedTextActions) ifTrue: [
- target := model ifNil: [morph].
- (morph valueOfProperty: #highlightedTextActions) do: [:ea |
- ea first
- actOnClickFor: target
- in: paragraph
- at: evt position
- editor: self].
- self removeHighlightedTextActions.
- morph removeProperty: #waitingForTextDrag.
- evt hand releaseKeyboardFocus: morph.
- evt hand releaseMouseFocus: morph.
- ^ true].
- ^ false!
Item was added:
- ----- Method: TextEditor>>removeHighlightedTextActions (in category 'events') -----
- removeHighlightedTextActions
- (morph hasProperty: #highlightedTextActions)
- ifTrue: [
- (morph valueOfProperty: #highlightedTextActions) do: [:ea |
- paragraph text
- removeAttribute: ea second
- from: ea third start to: ea third stop].
- morph removeProperty: #highlightedTextActions.
- morph updateFromParagraph].!
Item was removed:
- ----- Method: TextMorph>>enterClickableRegion: (in category 'editing') -----
- enterClickableRegion: evt
- | index isLink |
- evt hand hasSubmorphs ifTrue:[^false].
- paragraph ifNotNil:[
- index := (paragraph characterBlockAtPoint: evt position) stringIndex.
- isLink := (paragraph text attributesAt: index forStyle: paragraph textStyle)
- anySatisfy:[:attr| attr mayActOnClick].
- isLink ifTrue: [
- evt hand showTemporaryCursor: Cursor webLink.
- ^ true]].
- ^ false
- !
Item was removed:
- ----- Method: TextMorph>>handleMouseMove: (in category 'events-processing') -----
- handleMouseMove: anEvent
- "Re-implemented to allow for mouse-up move events"
- anEvent wasHandled ifTrue:[^self]. "not interested"
- (anEvent hand hasSubmorphs) ifTrue:[^self].
- anEvent wasHandled: true.
- self mouseMove: anEvent.
- (anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
- (self handlesMouseStillDown: anEvent) ifTrue:[
- "Step at the new location"
- self startStepping: #handleMouseStillDown:
- at: Time millisecondClockValue
- arguments: {anEvent copy resetHandlerFields}
- stepTime: 1].
- !
Item was added:
- ----- Method: TextMorph>>handlesMouseMove: (in category 'event handling') -----
- handlesMouseMove: anEvent
- "Handle all mouse-move events unless something is attached to the hand."
- ^ anEvent hand hasSubmorphs not!
Item was added:
- ----- Method: TextMorph>>handlesMouseStillDown: (in category 'event handling') -----
- handlesMouseStillDown: anEvent
- (anEvent anyButtonPressed and: [anEvent hand mouseFocus == self]) ifFalse: [^ false].
- ^ super handlesMouseStillDown: anEvent!
Item was changed: ----- Method: TextMorph>>mouseLeave: (in category 'event handling') ----- mouseLeave: evt
- evt hand showTemporaryCursor: nil.
- self editor removeHighlightedTextActions.!
- evt hand showTemporaryCursor: nil.!
Item was changed: ----- Method: TextMorph>>mouseMove: (in category 'event handling') ----- mouseMove: evt
evt redButtonPressed ifFalse: [
- "Avoid expensive #handleInteraction:fromEvent: wrapper here."
- self editor mouseEnterOnTextAction: evt.
- (self enterClickableRegion: evt)
- ifFalse: [self editor updateCursorForEvent: evt].
^ self].
self handleInteraction: [self editor mouseMove: evt] fromEvent: evt.!
Item was changed: ----- Method: TextMorph>>startDrag: (in category 'event handling') ----- startDrag: evt
self removeProperty: #waitingForTextDrag.
- self editor removeHighlightedTextActions.
[evt hand grabMorph: (TransferMorph withPassenger: self selection from: self)] ensure: [evt hand releaseMouseFocus: self].!
["TextAction-wrong-pos.png"]