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"]