steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove >r/r> usage from x11

db4
Slava Pestov 2008-12-15 20:34:57 -06:00
parent 09c60f7e90
commit 53e3568fa3
3 changed files with 21 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
basis/x11/clipboard/clipboard.factor
View File

@ -22,14 +22,14 @@ TUPLE: x-clipboard atom contents ;
"org.factorcode.Factor.SELECTION" x-atom ; "org.factorcode.Factor.SELECTION" x-atom ;
: convert-selection ( win selection -- ) : convert-selection ( win selection -- )
swap >r >r dpy get r> XA_UTF8_STRING selection-property r> swap [ [ dpy get ] dip XA_UTF8_STRING selection-property ] dip
CurrentTime XConvertSelection drop ; CurrentTime XConvertSelection drop ;
: snarf-property ( prop-return -- string ) : snarf-property ( prop-return -- string )
dup *void* [ *void* ascii alien>string ] [ drop f ] if ; dup *void* [ *void* ascii alien>string ] [ drop f ] if ;
: window-property ( win prop delete? -- string ) : window-property ( win prop delete? -- string )
>r dpy get -rot 0 -1 r> AnyPropertyType [ [ dpy get ] 2dip 0 -1 ] dip AnyPropertyType
0 <Atom> 0 <int> 0 <ulong> 0 <ulong> f <void*> 0 <Atom> 0 <int> 0 <ulong> 0 <ulong> f <void*>
[ XGetWindowProperty drop ] keep snarf-property ; [ XGetWindowProperty drop ] keep snarf-property ;
@ -58,7 +58,7 @@ TUPLE: x-clipboard atom contents ;
dpy get swap dpy get swap
[ XSelectionRequestEvent-requestor ] keep [ XSelectionRequestEvent-requestor ] keep
[ XSelectionRequestEvent-property ] keep [ XSelectionRequestEvent-property ] keep
>r "TIMESTAMP" x-atom 32 PropModeReplace r> [ "TIMESTAMP" x-atom 32 PropModeReplace ] dip
XSelectionRequestEvent-time <int> XSelectionRequestEvent-time <int>
1 XChangeProperty drop ; 1 XChangeProperty drop ;
@ -71,7 +71,7 @@ TUPLE: x-clipboard atom contents ;
over XSelectionRequestEvent-selection over set-XSelectionEvent-selection over XSelectionRequestEvent-selection over set-XSelectionEvent-selection
over XSelectionRequestEvent-target over set-XSelectionEvent-target over XSelectionRequestEvent-target over set-XSelectionEvent-target
over XSelectionRequestEvent-time over set-XSelectionEvent-time over XSelectionRequestEvent-time over set-XSelectionEvent-time
>r dpy get swap XSelectionRequestEvent-requestor 0 0 r> [ dpy get swap XSelectionRequestEvent-requestor 0 0 ] dip
XSendEvent drop XSendEvent drop
flush-dpy ; flush-dpy ;

18
basis/x11/events/events.factor
View File

@ -36,12 +36,12 @@ GENERIC: selection-request-event ( event window -- )
GENERIC: client-event ( event window -- ) GENERIC: client-event ( event window -- )
: next-event ( -- event ) : next-event ( -- event )
dpy get "XEvent" <c-object> dup >r XNextEvent drop r> ; dpy get "XEvent" <c-object> [ XNextEvent drop ] keep ;
: mask-event ( mask -- event ) : mask-event ( mask -- event )
>r dpy get r> "XEvent" <c-object> dup >r XMaskEvent drop r> ; [ dpy get ] dip "XEvent" <c-object> [ XMaskEvent drop ] keep ;
: events-queued ( mode -- n ) >r dpy get r> XEventsQueued ; : events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ; : wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
@ -71,15 +71,15 @@ GENERIC: client-event ( event window -- )
} case ; } case ;
: configured-loc ( event -- dim ) : configured-loc ( event -- dim )
dup XConfigureEvent-x swap XConfigureEvent-y 2array ; [ XConfigureEvent-x ] [ XConfigureEvent-y ] bi 2array ;
: configured-dim ( event -- dim ) : configured-dim ( event -- dim )
dup XConfigureEvent-width swap XConfigureEvent-height 2array ; [ XConfigureEvent-width ] [ XConfigureEvent-height ] bi 2array ;
: mouse-event-loc ( event -- loc ) : mouse-event-loc ( event -- loc )
dup XButtonEvent-x swap XButtonEvent-y 2array ; [ XButtonEvent-x ] [ XButtonEvent-y ] bi 2array ;
: close-box? ( event -- ? ) : close-box? ( event -- ? )
dup XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = [ XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = ]
swap XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = [ XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = ]
and ; bi and ;

9
basis/x11/windows/windows.factor
View File

@ -31,7 +31,7 @@ IN: x11.windows
"XSetWindowAttributes" <c-object> "XSetWindowAttributes" <c-object>
0 over set-XSetWindowAttributes-background_pixel 0 over set-XSetWindowAttributes-background_pixel
0 over set-XSetWindowAttributes-border_pixel 0 over set-XSetWindowAttributes-border_pixel
[ >r create-colormap r> set-XSetWindowAttributes-colormap ] keep [ [ create-colormap ] dip set-XSetWindowAttributes-colormap ] keep
event-mask over set-XSetWindowAttributes-event_mask ; event-mask over set-XSetWindowAttributes-event_mask ;
: set-size-hints ( window -- ) : set-size-hints ( window -- )
@ -43,12 +43,13 @@ IN: x11.windows
{ 0 0 } = [ drop ] [ set-size-hints ] if ; { 0 0 } = [ drop ] [ set-size-hints ] if ;
: create-window ( loc dim visinfo -- window ) : create-window ( loc dim visinfo -- window )
pick >r pick [
>r >r >r dpy get root get r> first2 r> { 1 1 } vmax first2 0 r> [ [ [ dpy get root get ] dip first2 ] dip { 1 1 } vmax first2 0 ] dip
[ XVisualInfo-depth InputOutput ] keep [ XVisualInfo-depth InputOutput ] keep
[ XVisualInfo-visual create-window-mask ] keep [ XVisualInfo-visual create-window-mask ] keep
window-attributes XCreateWindow window-attributes XCreateWindow
dup r> auto-position ; dup
] dip auto-position ;
: glx-window ( loc dim -- window glx ) : glx-window ( loc dim -- window glx )
GLX_DOUBLEBUFFER 1array choose-visual GLX_DOUBLEBUFFER 1array choose-visual