cocoa inline input using IM

basis/documents/documents-docs.factor

@@ -59,6 +59,12 @@ HELP: set-doc-range
 { $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." }
 { $side-effects "document" } ;
 
+HELP: set-doc-range*
+{ $values { "string" string } { "from" "a pair of integers" } { "to" "a pair of integers" } { "document" document } }
+{ $description "Replaces all text between two line/column number pairs with " { $snippet "string" } ". The string may use either " { $snippet "\\n" } ", " { $snippet "\\r\\n" } " or " { $snippet "\\r" } " line separators.\n\nThis word differs from " { $link set-doc-range } " in that it does not include changes in the Undo and Redo actions." }
+{ $errors "Throws an error if " { $snippet "from" } " or " { $snippet "to" } " is out of bounds." }
+{ $side-effects "document" } ;
+
 HELP: remove-doc-range
 { $values { "from" "a pair of integers" } { "to" "a pair of integers" } { "document" document } }
 { $description "Removes all text between two line/column number pairs." }

basis/documents/documents.factor

@@ -135,6 +135,14 @@ PRIVATE>
         new-to document update-locs
     ] unless ;
 
+:: set-doc-range* ( string from to document -- )
+    from to = string empty? and [
+        string split-lines :> new-lines
+        new-lines from text+loc :> new-to
+        new-lines from to document [ (set-doc-range) ] models:change-model
+        new-to document update-locs
+    ] unless ;
+
 : change-doc-range ( from to document quot -- )
     '[ doc-range @ ] 3keep set-doc-range ; inline
 

basis/ui/backend/cocoa/input-methods/editors/editors.factor

@@ -0,0 +1,6 @@
+! Copyright (C) 2019 KUSUMOTO Norio
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel ui.gadgets.editors ui.backend.cocoa.input-methods ;
+IN: ui.backend.cocoa.input-methods.editors
+
+M: editor support-input-methods? drop t ;

basis/ui/backend/cocoa/input-methods/input-methods.factor

@@ -0,0 +1,8 @@
+! Copyright (C) 2019 KUSUMOTO Norio
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel ui.gadgets ;
+IN: ui.backend.cocoa.input-methods
+
+GENERIC: support-input-methods? ( gadget -- ? )
+
+M: gadget support-input-methods? drop f ;

basis/ui/backend/cocoa/views/views.factor

@@ -8,7 +8,11 @@ core-graphics core-graphics.types core-text io.encodings.utf8
 kernel literals locals math math.order math.parser
 math.rectangles namespaces opengl sequences splitting threads
 ui.commands ui.gadgets ui.gadgets.private ui.gadgets.worlds
-ui.gestures ui.private words ;
+ui.gestures ui.private words sorting math.vectors
+ui.baseline-alignment ui.gadgets.line-support
+ui.gadgets.editors ui.backend.cocoa.input-methods
+ui.backend.cocoa.input-methods.editors io.encodings.utf16n
+io.encodings.string classes.struct ;
 IN: ui.backend.cocoa.views
 
 : send-mouse-moved ( view event -- )
@@ -181,8 +185,84 @@ M: send-touchbar-command send-queued-gesture
         yield
     ] [ 3drop ] if ;
 
+CONSTANT: NSNotFound 9223372036854775807 inline
+
+IMPORT: NSAttributedString
+
+<PRIVATE
+
+:: >codepoint-index ( str utf16-index -- codepoint-index )
+    0 utf16-index 2 * str utf16n encode subseq utf16n decode length ;
+
+:: >utf16-index ( str codepoint-index -- utf16-index )
+    0 codepoint-index str subseq utf16n encode length 2 / >integer ;
+
+:: earlier-caret/mark ( editor -- loc )
+    editor editor-caret :> caret
+    editor editor-mark :> mark
+    caret first mark first = [
+        caret second mark second < [ caret ] [ mark ] if
+    ] [
+        caret first mark first < [ caret ] [ mark ] if
+    ] if ;
+
+:: make-preedit-underlines ( gadget text range -- underlines )
+    f gadget preedit-selection-mode?<<
+    { } clone :> underlines!
+    text -> length :> text-length
+    0 0 <NSRange> :> effective-range
+    text -> string CF>string :> str
+    str utf16n encode :> byte-16n
+    0 :> cp-loc!    
+    "NSMarkedClauseSegment" <NSString> :> segment-attr
+    [ effective-range [ location>> ] [ length>> ] bi + text-length < ] [
+        text
+        segment-attr
+        effective-range [ location>> ] [ length>> ] bi +
+        effective-range >c-ptr
+        -> attribute:atIndex:effectiveRange: drop
+        1 :> thickness!
+        range location>> effective-range location>> = [
+            2 thickness!
+            t gadget preedit-selection-mode?<<
+        ] when
+        underlines
+        effective-range [ location>> ] [ length>> ] bi over +
+        [ str swap >codepoint-index ] bi@ swap - :> len
+        cp-loc cp-loc len + dup cp-loc!
+        2array thickness 2array
+        suffix underlines! 
+    ] while 
+    underlines length 1 = [
+        underlines first first 2 2array 1array  ! thickness: 2
+    ] [ underlines ] if ;
+
+:: update-marked-text ( gadget str range -- )
+    gadget preedit? [
+        gadget remove-preedit-text
+    ] when
+    gadget earlier-caret/mark dup
+    gadget preedit-start<<
+    0 str length 2array v+ gadget preedit-end<<
+    str gadget temp-im-input drop
+    gadget preedit-start>>
+    0 str range location>> >codepoint-index
+    2array v+
+    dup gadget preedit-selected-start<<
+    0
+    range location>> dup range length>> + [ 2 * ] bi@
+    str utf16n encode subseq utf16n decode length
+    2array v+
+    dup gadget preedit-selected-end<<
+    dup gadget set-caret gadget set-mark                    
+    gadget preedit-start>> gadget preedit-end>> = [
+        gadget remove-preedit-info 
+    ] when ;
+
+PRIVATE>
+
 <CLASS: FactorView < NSOpenGLView
-    COCOA-PROTOCOL: NSTextInput
+    COCOA-PROTOCOL: NSTextInputClient
 
     METHOD: void prepareOpenGL [
 
@@ -355,34 +435,147 @@ M: send-touchbar-command send-queued-gesture
     ] ;
 
     ! Text input
-    METHOD: void insertText: id text
+    METHOD: void insertText: id text replacementRange: NSRange replacementRange [
-    [
+            self window :> window
-        self window :> window
+            window [
-        window [
+                "" clone :> str!
-            text CF>string window user-input
+                text NSString -> class -> isKindOfClass: 0 = not [
-        ] when
+                    text CF>string str!               
-    ] ;
+                ] [
+                    text -> string CF>string str!               
+                ] if
+                window world-focus :> gadget
+                gadget support-input-methods? [
+                    gadget preedit? [
+                        gadget [ remove-preedit-text ] [ remove-preedit-info ] bi
+                    ] when
+                    str gadget user-input* drop                    
+                    f gadget preedit-selection-mode?<<
+                ] [ 
+                    str window user-input
+                ] if
+            ] when
+        ] ;
+    
+    METHOD: char hasMarkedText [
+            self window :> window
+            window [
+                window world-focus :> gadget
+                gadget preedit? [ 1 ] [ 0 ] if
+            ] [ 0 ] if
+        ] ;
 
-    METHOD: char hasMarkedText [ 0 ] ;
+    METHOD: NSRange markedRange [ 
+            self window :> window
+            window [
+                window world-focus :> gadget
+                gadget preedit? [
+                    gadget [ preedit-start>> second ] [ preedit-end>> second ] bi >= [ 
+                        NSNotFound 0 
+                    ] [
+                        gadget preedit-start>> first gadget editor-line :> str
+                        str gadget preedit-start>> second >utf16-index dup  ! location
+                        str gadget preedit-end>> second >utf16-index swap - ! length
+                    ] if
+                ] [  NSNotFound 0 ] if
+            ] [ NSNotFound 0 ] if
+            <NSRange>
+        ] ;
 
-    METHOD: NSRange markedRange [ 0 0 <NSRange> ] ;
+    METHOD: NSRange selectedRange [
-
+            self window :> window
-    METHOD: NSRange selectedRange [ 0 0 <NSRange> ] ;
+            window [
-
+                window world-focus :> gadget
-    METHOD: void setMarkedText: id text selectedRange: NSRange range [ ] ;
+                gadget support-input-methods? [
-
+                    gadget preedit? [
-    METHOD: void unmarkText [ ] ;
+                        gadget preedit-start>> first gadget editor-line :> str
-
+                        str
-    METHOD: id validAttributesForMarkedText [ NSArray -> array ] ;
+                        gadget
-
+                        [ preedit-selected-start>> second ]
-    METHOD: id attributedSubstringFromRange: NSRange range [ f ] ;
+                        [ preedit-start>> second ] bi - >utf16-index              ! location
+                        str gadget preedit-selected-end>> second >utf16-index
+                        str gadget preedit-selected-start>> second >utf16-index - ! length
+                    ] [ gadget earlier-caret/mark second 0 ] if
+                ] [ 0 0 ] if
+            ] [ 0 0 ] if 
+            <NSRange>
+        ] ;
+    
+    METHOD: void setMarkedText: id text selectedRange: NSRange selectedRange
+                                     replacementRange: NSRange replacementRange [           
+            self window :> window
+            { } clone :> underlines!
+            window [
+                window world-focus :> gadget
+                "" clone :> str!
+                text NSString -> class -> isKindOfClass: 0 = not [
+                    text CF>string str!               
+                ] [
+                    text -> string CF>string str!               
+                    gadget support-input-methods? [
+                        gadget text selectedRange make-preedit-underlines underlines!
+                    ] when
+                ] if
+                gadget support-input-methods? [
+                    gadget str selectedRange update-marked-text                   
+                    underlines gadget preedit-underlines<<
+                ] when
+            ] when            
+        ] ;
+             
+    METHOD: void unmarkText [ 
+            self window :> window
+            window [
+                window world-focus :> gadget
+                gadget support-input-methods? [
+                    gadget preedit? [
+                        gadget {
+                            [ preedit-start>> second ]
+                            [ preedit-end>> second ]
+                            [ preedit-start>> first ] [ editor-line ]
+                        } cleave subseq
+                        gadget [ remove-preedit-text ] [ remove-preedit-info ] bi
+                        gadget user-input* drop
+                    ] when
+                    f gadget preedit-selection-mode?<<
+                ] when
+            ] when
+        ] ;
+    
+    METHOD: id validAttributesForMarkedText [             
+            NSArray "NSMarkedClauseSegment" <NSString> -> arrayWithObject:
+        ] ;
 
+    METHOD: id attributedSubstringForProposedRange: NSRange range
+                                       actualRange: id actualRange [ f ] ;
+    
     METHOD: NSUInteger characterIndexForPoint: NSPoint point [ 0 ] ;
 
-    METHOD: NSRect firstRectForCharacterRange: NSRange range [ 0 0 0 0 <CGRect> ] ;
+    METHOD: NSRect firstRectForCharacterRange: NSRange aRange
-
+                                  actualRange: id actualRange [
-    METHOD: NSInteger conversationIdentifier [ self alien-address ] ;
+            aRange :> range!
-
+            actualRange [
+                 actualRange NSRange memory>struct range!
+             ] when
+            
+            self window :> window
+            window [
+                window world-focus preedit? [
+                    window world-focus :> gadget
+                    gadget editor-caret first gadget editor-line :> str                    
+                    str range location>> >codepoint-index :> start-pos
+                    gadget screen-loc                    
+                    gadget editor-caret first start-pos 2array gadget loc>x dup :> xl
+                    gadget caret-loc second gadget caret-dim second + 
+                    [ >fixnum ] bi@ 2array v+ { 1 -1 } v*
+                    window handle>> window>> dup -> frame -> contentRectForFrameRect:
+                    CGRect-top-left 2array v+
+                    first2 0 gadget line-height >fixnum
+                ] [ 0 0 0 0 ] if
+            ] [ 0 0 0 0 ] if    
+            <CGRect>
+        ] ;
+        
     ! Initialization
     METHOD: void updateFactorGadgetSize: id notification
     [

basis/ui/gadgets/editors/editors-docs.factor

@@ -15,7 +15,16 @@ $nl
     { { $snippet "caret" } " - a " { $link model } " storing a line/column pair." }
     { { $snippet "mark" } " - a " { $link model } " storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." }
     { { $snippet "focused?" } " - a boolean." }
-} }
+    { { $snippet "preedit-start" } " - a line/column pair or " { $link f } ". It represents the starting point of the string being edited by an input method." }
+    { { $snippet "preedit-end" } " - a line/column pair or " { $link f } ". It represents the end point of the string being edited by an input method." }
+    { { $snippet "preedit-selected-start" } " - a line/column pair or " { $link f } ". It represents the starting point of the string being selected by an input method." }
+    { { $snippet "preedit-selected-end" } " - a line/column pair or " { $link f } ". It represents the end point of the string being selected by an input method." }
+    { { $snippet "preedit-selection-mode?" } " - a boolean. It means the mode of selecting convertion canditate word. The caret in an editor is not drawn if it is true." }
+    { { $snippet "preedit-underlines" } " - an array or " { $link f } ". It stores underline attributes for its preedit area." }
+}
+$nl
+" Slots that are prefixed with \"preedit-\" should not be modified directly. They are changed by the platform-dependent backend."
+}
 { $see-also line-gadget } ;
 
 HELP: <editor>

basis/ui/gadgets/editors/editors.factor

@@ -7,13 +7,25 @@ math.rectangles math.vectors models models.arrow namespaces opengl
 sequences sorting splitting timers ui.baseline-alignment ui.clipboards
 ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.line-support
 ui.gadgets.menus ui.gadgets.scrollers ui.gestures ui.pens.solid
-ui.render ui.text ui.theme unicode ;
+ui.render ui.text ui.theme unicode opengl.gl ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < line-gadget
     caret mark
     focused? blink blink-timer
-    default-text ;
+    default-text
+    preedit-start
+    preedit-end
+    preedit-selected-start
+    preedit-selected-end
+    preedit-selection-mode?
+    preedit-underlines ;
+
+GENERIC: preedit? ( gadget -- ? )
+
+M: gadget preedit? drop f ;
+
+M: editor preedit? preedit-start>> [ t ] [ f ] if ;
 
 <PRIVATE
 
@@ -93,6 +105,9 @@ M: editor ungraft*
 : set-caret ( loc editor -- )
     [ model>> validate-loc ] [ caret>> ] bi set-model ;
 
+: set-mark ( loc editor -- )
+    [ model>> validate-loc ] [ mark>> ] bi set-model ;
+
 : change-caret ( editor quot: ( loc document -- newloc ) -- )
     [ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi
     set-caret ; inline
@@ -152,7 +167,8 @@ M: editor ungraft*
 <PRIVATE
 
 : draw-caret? ( editor -- ? )
-    { [ focused?>> ] [ blink>> ] } 1&& ;
+    { [ focused?>> ] [ blink>> ]
+      [ [ preedit? not ] [ preedit-selection-mode?>> not ] bi or ] } 1&& ;
 
 : draw-caret ( editor -- )
     dup draw-caret? [
@@ -161,6 +177,23 @@ M: editor ungraft*
         over v+ gl-line
     ] [ drop ] if ;
 
+:: draw-preedit-underlines ( editor -- )
+    editor [ preedit? ] [ preedit-underlines>> ] bi and [
+        editor [ caret-loc second ] [ caret-dim second ] bi + 2.0 - :> y
+        editor editor-caret first :> row
+        editor font>> foreground>> gl-color
+        editor preedit-underlines>> [            
+            GL_LINE_BIT [
+                dup second glLineWidth
+                first editor preedit-start>> second dup 2array v+ first2 
+                [ row swap 2array editor loc>x 1.0 + y 2array ]
+                [ row swap 2array editor loc>x 1.0 - y 2array ]
+                bi*
+                gl-line
+            ] do-attribs
+        ] each
+    ] when ;
+
 : selection-start/end ( editor -- start end )
     [ editor-mark ] [ editor-caret ] bi sort-pair ;
 
@@ -211,10 +244,10 @@ M: editor draw-line ( line index editor -- )
 
 M: editor draw-gadget*
     dup draw-default-text? [
-        [ draw-default-text ] [ draw-caret ] bi
+        [ draw-default-text ] [ draw-caret ] [ draw-preedit-underlines ] tri
     ] [
         dup compute-selection selected-lines [
-            [ draw-lines ] [ draw-caret ] bi
+            [ draw-lines ] [ draw-caret ] [ draw-preedit-underlines ] tri
         ] with-variable
     ] if ;
 
@@ -259,6 +292,9 @@ M: editor gadget-selection
 M: editor user-input*
     [ selection-start/end ] [ model>> ] bi set-doc-range t ;
 
+M: editor temp-im-input
+    [ selection-start/end ] [ model>> ] bi set-doc-range* t ;
+
 : editor-string ( editor -- string )
     model>> doc-string ;
 
@@ -272,6 +308,21 @@ M: editor gadget-text* editor-string % ;
     [ restart-blinking ]
     [ dup caret>> click-loc ] tri ;
 
+: remove-preedit-text ( editor -- )
+    { [ preedit-start>> ] [ set-caret ]
+      [ preedit-end>> ] [ set-mark ]
+      [ remove-selection ]
+    } cleave ;
+
+: remove-preedit-info ( editor -- )
+    f >>preedit-start
+    f >>preedit-end
+    f >>preedit-selected-start
+    f >>preedit-selected-end
+    f >>preedit-selection-mode?
+    f >>preedit-underlines
+    drop ;
+
 : mouse-elt ( -- element )
     hand-click# get {
         { 1 one-char-elt }

basis/ui/gadgets/gadgets-docs.factor

@@ -46,6 +46,10 @@ HELP: user-input*
 { $values { "str" string } { "gadget" gadget } { "?" boolean } }
 { $contract "Handle free-form textual input while the gadget has keyboard focus." } ;
 
+HELP: temp-im-input
+{ $values { "str" string } { "gadget" gadget } { "?" boolean } }
+{ $contract "Handle free-form textual input while the gadget has keyboard focus. This is used to display the string being preedited by an input method on the gadget. Input by this word is not include changes in the Undo and Redo actions." } ;
+
 HELP: pick-up
 { $values { "point" "a pair of integers" } { "gadget" gadget } { "child/f" { $maybe gadget } } }
 { $description "Outputs the child at a point in the gadget's co-ordinate system. This word recursively descends the gadget hierarchy, and so outputs the deepest child." } ;

basis/ui/gadgets/gadgets.factor

@@ -55,6 +55,10 @@ GENERIC: user-input* ( str gadget -- ? )
 
 M: gadget user-input* 2drop t ;
 
+GENERIC: temp-im-input ( str gadget -- ? )
+
+M: gadget temp-im-input 2drop t ;
+
 GENERIC: children-on ( rect gadget -- seq )
 
 M: gadget children-on nip children>> ;

basis/ui/gestures/gestures.factor

@@ -3,7 +3,7 @@
 USING: accessors arrays ascii assocs boxes calendar classes columns
 combinators combinators.short-circuit deques fry kernel make math
 math.order math.parser math.vectors namespaces sequences sets system
-timers ui.gadgets ui.gadgets.private words ;
+timers ui.gadgets ui.gadgets.private words locals ui.gadgets.editors ;
 IN: ui.gestures
 
 : get-gesture-handler ( gesture gadget -- quot )
@@ -63,8 +63,10 @@ M: propagate-key-gesture-tuple send-queued-gesture
     [ gesture>> ] [ world>> world-focus ] bi
     [ handle-gesture ] with each-parent drop ;
 
-: propagate-key-gesture ( gesture world -- )
+:: propagate-key-gesture ( gesture world -- )
-    \ propagate-key-gesture-tuple queue-gesture ;
+    world world-focus preedit? [
+        gesture world \ propagate-key-gesture-tuple queue-gesture
+    ] unless ;
 
 TUPLE: user-input-tuple string world ;