From d1a4268efe303701f7b4723a8f9017f2b38d3acd Mon Sep 17 00:00:00 2001 From: slava Date: Sat, 3 Jun 2006 23:25:50 +0000 Subject: [PATCH] X11 paste support --- library/ui/backend.factor | 5 +++++ library/ui/gadgets/editors.factor | 8 ++------ library/ui/x11/clipboard.factor | 26 ++++++++++++++++++-------- library/ui/x11/events.factor | 3 +++ library/ui/x11/ui.factor | 11 ++++++----- library/ui/x11/xlib.factor | 2 -- 6 files changed, 34 insertions(+), 21 deletions(-) diff --git a/library/ui/backend.factor b/library/ui/backend.factor index c773c7ec2b..41aa5b15f5 100644 --- a/library/ui/backend.factor +++ b/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 diff --git a/library/ui/gadgets/editors.factor b/library/ui/gadgets/editors.factor index c41876a98f..d5e37f603a 100644 --- a/library/ui/gadgets/editors.factor +++ b/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 ; diff --git a/library/ui/x11/clipboard.factor b/library/ui/x11/clipboard.factor index fcb263616a..0880cc0c69 100644 --- a/library/ui/x11/clipboard.factor +++ b/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 0 0 0 f - [ 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 selection set-global + "CLIPBOARD" x-atom clipboard set-global ; diff --git a/library/ui/x11/events.factor b/library/ui/x11/events.factor index 6d8ad58613..ad44e02e44 100644 --- a/library/ui/x11/events.factor +++ b/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 ; diff --git a/library/ui/x11/ui.factor b/library/ui/x11/ui.factor index b137a4b964..c31d419561 100644 --- a/library/ui/x11/ui.factor +++ b/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 [ ] event>gesture [ - over handle-gesture drop - ] [ - 2drop - ] if* ; + world-focus over [ ] 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 ] [ diff --git a/library/ui/x11/xlib.factor b/library/ui/x11/xlib.factor index 122a86d25b..9bc1d0acf0 100644 --- a/library/ui/x11/xlib.factor +++ b/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 ) ;