Pasting the selection buffer now works on X11
parent
457abfd50a
commit
fd45996f1e
|
@ -86,7 +86,7 @@ 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 paste-clipboard ] }
|
||||
{ T{ button-up f 2 } [ dup click-editor selection get paste-clipboard ] }
|
||||
{ T{ paste-action } [ clipboard get paste-clipboard ] }
|
||||
} ;
|
||||
|
||||
|
|
|
@ -16,7 +16,7 @@ TUPLE: pane output active current input prototype continuation ;
|
|||
: add-output 2dup set-pane-output add-gadget ;
|
||||
|
||||
: <active-line> ( current input -- line )
|
||||
[ 2array ] [ 1array ] if* make-shelf ;
|
||||
{ { [ ] f @center } { [ ] f @left } } make-frame ;
|
||||
|
||||
: init-line ( pane -- )
|
||||
dup pane-prototype clone swap set-pane-current ;
|
||||
|
@ -61,6 +61,7 @@ SYMBOL: structured-input
|
|||
|
||||
C: pane ( -- pane )
|
||||
<pile> over set-delegate
|
||||
1 over set-pack-fill
|
||||
<shelf> over set-pane-prototype
|
||||
<pile> <incremental> over add-output
|
||||
dup prepare-line ;
|
||||
|
|
|
@ -9,7 +9,7 @@ IN: x11
|
|||
"org.factorcode.Factor.SELECTION" x-atom ;
|
||||
|
||||
: convert-selection ( win selection -- n )
|
||||
>r >r dpy get r> XA_STRING selection-property r>
|
||||
swap >r >r dpy get r> XA_STRING selection-property r>
|
||||
CurrentTime XConvertSelection drop ;
|
||||
|
||||
: snarf-property ( prop-return -- string )
|
||||
|
@ -20,9 +20,12 @@ IN: x11
|
|||
0 <Atom> 0 <int> 0 <ulong> 0 <ulong> f <void*>
|
||||
[ XGetWindowProperty drop ] keep snarf-property ;
|
||||
|
||||
: selection-from-event ( event -- string )
|
||||
dup XSelectionEvent-property zero?
|
||||
[ drop f ] [ selection-property 1 window-property ] if ;
|
||||
: selection-from-event ( event window -- string )
|
||||
>r dup XSelectionEvent-property zero? [
|
||||
r> 2drop f
|
||||
] [
|
||||
r> selection-property 1 window-property
|
||||
] if ;
|
||||
|
||||
TUPLE: x-clipboard atom ;
|
||||
|
||||
|
|
|
@ -105,7 +105,8 @@ 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 ;
|
||||
[ world-handle first selection-from-event ] keep
|
||||
world-focus user-input ;
|
||||
|
||||
: close-box? ( event -- ? )
|
||||
dup XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom =
|
||||
|
|
|
@ -18,14 +18,11 @@ SYMBOL: root
|
|||
[ "Cannot connect to X server - check $DISPLAY" throw ] unless* ;
|
||||
|
||||
: initialize-x ( display-string -- )
|
||||
XOpenDisplay check-display dpy set
|
||||
dpy get XDefaultScreen scr set
|
||||
dpy get scr get XRootWindow root set ;
|
||||
XOpenDisplay check-display dpy set-global
|
||||
dpy get XDefaultScreen scr set-global
|
||||
dpy get scr get XRootWindow root set-global ;
|
||||
|
||||
: close-x ( -- ) dpy get XCloseDisplay drop ;
|
||||
|
||||
: with-x ( display-string quot -- )
|
||||
[
|
||||
swap initialize-x
|
||||
[ close-x ] cleanup
|
||||
] with-scope ;
|
||||
>r initialize-x r> [ close-x ] cleanup ;
|
||||
|
|
|
@ -21,7 +21,8 @@ USING: alien gadgets hashtables kernel math namespaces sequences ;
|
|||
PointerMotionMask bitor
|
||||
FocusChangeMask bitor
|
||||
EnterWindowMask bitor
|
||||
LeaveWindowMask bitor ;
|
||||
LeaveWindowMask bitor
|
||||
PropertyChangeMask bitor ;
|
||||
|
||||
: window-attributes ( visinfo -- attributes )
|
||||
"XSetWindowAttributes" <c-object>
|
||||
|
|
Loading…
Reference in New Issue