diff --git a/extra/documents/documents.factor b/extra/documents/documents.factor old mode 100644 new mode 100755 index bc4dc412fc..01034e0e3f --- a/extra/documents/documents.factor +++ b/extra/documents/documents.factor @@ -167,6 +167,12 @@ M: char-elt prev-elt M: char-elt next-elt drop [ drop 1 +col ] (next-char) ; +TUPLE: one-char-elt ; + +M: one-char-elt prev-elt 2drop ; + +M: one-char-elt next-elt 2drop ; + : (word-elt) ( loc document quot -- loc ) pick >r >r >r first2 swap r> doc-line r> call diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor index 65758ab54c..84cc01cdb6 100755 --- a/extra/ui/gadgets/editors/editors.factor +++ b/extra/ui/gadgets/editors/editors.factor @@ -4,7 +4,7 @@ USING: arrays documents ui.clipboards ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers ui.gadgets.theme ui.render ui.gestures io kernel math models namespaces opengl opengl.gl sequences strings -io.styles math.vectors sorting colors combinators ; +io.styles math.vectors sorting colors combinators assocs ; IN: ui.gadgets.editors TUPLE: editor @@ -94,8 +94,11 @@ M: editor ungraft* rot editor-line x>offset , ] { } make ; +: clicked-loc ( editor -- loc ) + [ hand-rel ] keep point>loc ; + : click-loc ( editor model -- ) - >r [ hand-rel ] keep point>loc r> set-model ; + >r clicked-loc r> set-model ; : focus-editor ( editor -- ) t over set-editor-focused? relayout-1 ; @@ -244,11 +247,37 @@ M: editor user-input* M: editor gadget-text* editor-string % ; -: start-selection ( editor -- ) - dup editor-caret click-loc ; - : extend-selection ( editor -- ) - dup request-focus start-selection ; + dup request-focus dup editor-caret click-loc ; + +: mouse-elt ( -- elelement ) + hand-click# get { + { 2 T{ one-word-elt } } + { 3 T{ one-line-elt } } + } at T{ one-char-elt } or ; + +: drag-direction? ( loc editor -- ? ) + editor-mark* <=> 0 < ; + +: drag-selection-caret ( loc editor element -- loc ) + >r [ drag-direction? ] 2keep + gadget-model + r> prev/next-elt ? ; + +: drag-selection-mark ( loc editor element -- loc ) + >r [ drag-direction? not ] 2keep + nip dup editor-mark* swap gadget-model + r> prev/next-elt ? ; + +: drag-caret&mark ( editor -- caret mark ) + dup clicked-loc swap mouse-elt + [ drag-selection-caret ] 3keep + drag-selection-mark ; + +: drag-selection ( editor -- ) + dup drag-caret&mark + pick editor-mark set-model + swap editor-caret set-model ; : editor-cut ( editor clipboard -- ) dupd gadget-copy remove-selection ; @@ -296,17 +325,10 @@ M: editor gadget-text* editor-string % ; dup T{ one-word-elt } select-elt ] unless gadget-selection ; -: (position-caret) ( editor -- ) - dup extend-selection - dup editor-mark click-loc ; - : position-caret ( editor -- ) - hand-click# get { - { 1 [ (position-caret) ] } - { 2 [ T{ one-word-elt } select-elt ] } - { 3 [ T{ one-line-elt } select-elt ] } - [ 2drop ] - } case ; + mouse-elt dup T{ one-char-elt } = + [ drop dup extend-selection dup editor-mark click-loc ] + [ select-elt ] if ; : insert-newline "\n" swap user-input ; @@ -408,7 +430,7 @@ editor "caret-motion" f { editor "selection" f { { T{ button-down f { S+ } } extend-selection } - { T{ drag } start-selection } + { T{ drag } drag-selection } { T{ gain-focus } focus-editor } { T{ lose-focus } unfocus-editor } { T{ delete-action } remove-selection } diff --git a/extra/ui/gestures/gestures.factor b/extra/ui/gestures/gestures.factor index 756ddfbf00..3d1e7baf7f 100755 --- a/extra/ui/gestures/gestures.factor +++ b/extra/ui/gestures/gestures.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs kernel math models namespaces sequences words strings system hashtables math.parser -math.vectors tuples classes ui.gadgets timers combinators ; +math.vectors tuples classes ui.gadgets timers combinators.lib ; IN: ui.gestures : set-gestures ( class hash -- ) "gestures" set-word-prop ; @@ -187,12 +187,11 @@ drag-timer construct-empty drag-timer set-global : multi-click? ( button -- ? ) { - { [ multi-click-timeout? not ] [ f ] } - { [ multi-click-button? not ] [ f ] } - { [ multi-click-position? not ] [ f ] } - { [ multi-click-position? not ] [ f ] } - { [ t ] [ t ] } - } cond nip ; + [ multi-click-timeout? ] + [ multi-click-button? ] + [ multi-click-position? ] + [ multi-click-position? ] + } && nip ; : update-click# ( button -- ) global [ diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 3ce745970d..290e4ef311 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -397,8 +397,10 @@ M: windows-ui-backend (close-window) GetDoubleClickTime double-click-timeout set-global ; : cleanup-win32-ui ( -- ) - class-name-ptr get-global f UnregisterClass drop - class-name-ptr get-global [ free ] when* + class-name-ptr get-global [ + dup f UnregisterClass drop + free + ] when* f class-name-ptr set-global ; : setup-pixel-format ( hdc -- )