X11 paste support

library/ui/backend.factor

@@ -21,6 +21,11 @@ DEFER: flush-gl-context ( handle -- )
 TUPLE: clipboard contents ;
 C: clipboard "" over set-clipboard-contents ;
 
+GENERIC: paste-clipboard ( gadget clipboard -- )
+
+M: object paste-clipboard ( gadget clipboard -- )
+    clipboard-contents dup [ swap user-input ] [ 2drop ] if ;
+
 SYMBOL: clipboard
 SYMBOL: selection
 

library/ui/gadgets/editors.factor

@@ -68,10 +68,6 @@ TUPLE: editor line caret font color ;
 : click-editor ( editor -- )
     dup hand-click-rel first over set-caret-x request-focus ;
 
-: editor-paste ( editor clipboard -- )
-    clipboard-contents dup
-    [ swap user-input* drop ] [ 2drop ] if ;
-
 M: editor gadget-gestures
     drop H{
         { T{ button-down } [ click-editor ] }
@@ -90,8 +86,8 @@ M: editor gadget-gestures
         { T{ key-down f f "HOME" } [ [ T{ document-elt } prev-elt ] with-editor ] }
         { T{ key-down f f "END" } [ [ T{ document-elt } next-elt ] with-editor ] }
         { T{ key-down f { C+ } "k" } [ [ line-clear ] with-editor ] }
-        { T{ button-down f 2 } [ selection get editor-paste ] }
-        { T{ paste-action } [ clipboard get editor-paste ] }
+        { T{ button-down f 2 } [ selection get paste-clipboard ] }
+        { T{ paste-action } [ clipboard get paste-clipboard ] }
     } ;
 
 : add-editor-caret 2dup set-editor-caret add-gadget ;

library/ui/x11/clipboard.factor

@@ -6,20 +6,30 @@ IN: x11
 ! This code was inspired by McCLIM's Backends/CLX/port.lisp.
 
 : selection-property ( -- n )
-    dpy get "org.factorcode.Factor.SELECTION" 0 XInternAtom ;
+    "org.factorcode.Factor.SELECTION" x-atom ;
 
-: convert-selection ( win -- n )
-    >r dpy get XA_PRIMARY XA_STRING selection-property r>
-    CurrentTime XConvertSelection ;
+: convert-selection ( win selection -- n )
+    >r >r dpy get r> XA_STRING selection-property r>
+    CurrentTime XConvertSelection drop ;
 
-: snarf-property ( length-return prop-return -- string )
-    swap *ulong zero? [ drop f ] [ *char* ] if ;
+: snarf-property ( prop-return -- string )
+    dup *void* [ *char* ] [ drop f ] if ;
 
 : window-property ( win prop delete? -- string )
-    >r dpy get -rot 0 -1 r> AnyProperty
+    >r dpy get -rot 0 -1 r> AnyPropertyType
     0 <Atom> 0 <int> 0 <ulong> 0 <ulong> f <void*>
-    [ XGetWindowProperty ] 2keep snarf-property ;
+    [ XGetWindowProperty drop ] keep snarf-property ;
 
 : selection-from-event ( event -- string )
     dup XSelectionEvent-property zero?
     [ drop f ] [ selection-property 1 window-property ] if ;
+
+TUPLE: x-clipboard atom ;
+
+M: x-clipboard paste-clipboard ( gadget clipboard -- )
+    >r find-world world-handle first r> clipboard-atom
+    convert-selection ;
+
+: init-clipboard ( -- )
+    XA_PRIMARY <x-clipboard> selection set-global
+    "CLIPBOARD" x-atom <x-clipboard> clipboard set-global ;

library/ui/x11/events.factor

@@ -28,6 +28,8 @@ GENERIC: focus-in-event ( event window -- )
 
 GENERIC: focus-out-event ( event window -- )
 
+GENERIC: selection-event ( event window -- )
+
 GENERIC: client-event ( event window -- )
 
 : next-event ( -- event )
@@ -63,6 +65,7 @@ GENERIC: client-event ( event window -- )
         { [ dup KeyRelease = ] [ drop key-up-event ] }
         { [ dup FocusIn = ] [ drop focus-in-event ] }
         { [ dup FocusOut = ] [ drop focus-out-event ] }
+        { [ dup SelectionNotify = ] [ drop selection-event ] }
         { [ dup ClientMessage = ] [ drop client-event ] }
         { [ t ] [ 3drop ] }
     } cond ;

library/ui/x11/ui.factor

@@ -97,16 +97,16 @@ M: world key-down-event ( event world -- )
     ] if* ;
 
 M: world key-up-event ( event world -- )
-    world-focus over [ <key-up> ] event>gesture [
-        over handle-gesture drop
-    ] [
-        2drop
-    ] if* ;
+    world-focus over [ <key-up> ] event>gesture
+    [ over handle-gesture drop ] [ 2drop ] if* ;
 
 M: world focus-in-event ( event world -- ) nip focus-world ;
 
 M: world focus-out-event ( event world -- ) nip unfocus-world ;
 
+M: world selection-event ( event world -- )
+    >r selection-from-event r> world-focus user-input ;
+
 : close-box? ( event -- ? )
     dup XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom =
     swap XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom =
@@ -149,6 +149,7 @@ IN: shells
     [
         f [
             init-timers
+            init-clipboard
             restore-windows? [
                 restore-windows
             ] [

library/ui/x11/xlib.factor

@@ -259,8 +259,6 @@ FUNCTION: char* XGetAtomName ( Display* display, Atom atom ) ;
 
 ! 4.4 - Obtaining and Changing Window Properties
 
-: AnyPropertyType 0 ; inline
-
 FUNCTION: int XGetWindowProperty ( Display* display, Window w, Atom property, long long_offset, long long_length, Bool delete, Atom req_type, Atom* actual_type_return, int* actual_format_return, ulong* nitems_return, ulong* bytes_after_return, char** prop_return ) ;
 
 FUNCTION: int XChangeProperty ( Display* display, Window w, Atom property, Atom type, int format, int mode, char* data, int nelements ) ;