104 lines
2.4 KiB
Scheme
104 lines
2.4 KiB
Scheme
; Author: Norbert Freudemann
|
|
|
|
|
|
(define (str-or-sym->str thing)
|
|
(if (symbol? thing)
|
|
(symbol->string thing)
|
|
thing))
|
|
|
|
; The C-procedures for (xlib-release-X-or-later?) are in the
|
|
; file init.c
|
|
|
|
(import-lambda-definition xlib-release-4-or-later? ()
|
|
"scx_Xlib_Release_4_Or_Later")
|
|
|
|
(import-lambda-definition xlib-release-5-or-later? ()
|
|
"scx_Xlib_Release_5_Or_Later")
|
|
|
|
(import-lambda-definition xlib-release-6-or-later? ()
|
|
"scx_Xlib_Release_6_Or_Later")
|
|
|
|
; Get the user-default values of a specified program
|
|
|
|
(define (get-default dpy program option)
|
|
(%get-default (display-Xdisplay dpy)
|
|
(str-or-sym->str program)
|
|
(str-or-sym->str option)))
|
|
|
|
(import-lambda-definition %get-default (Xdisplay program option)
|
|
"scx_Get_Default")
|
|
|
|
|
|
; ---
|
|
|
|
(define (resource-manager-string dpy)
|
|
(%resource-manager-string (display-Xdisplay dpy)))
|
|
|
|
(import-lambda-definition %resource-manager-string (Xdisplay)
|
|
"scx_Resource_Manager_String")
|
|
|
|
; ---
|
|
|
|
(define (parse-geometry string)
|
|
(reverse (%parse-geometry string)))
|
|
|
|
(import-lambda-definition %parse-geometry (string)
|
|
"scx_Parse_Geometry")
|
|
|
|
; ---
|
|
|
|
(define (store-buffer) #f)
|
|
(define (store-bytes) #f)
|
|
(define (fetch-buffer) #f)
|
|
(define (fetch-bytes) #f)
|
|
(define (rotate-buffers) #f)
|
|
|
|
(let ((xa-string (make-atom 31)) ; (31 is XA_STRING)
|
|
(xa-cut-buffers
|
|
(vector (make-atom 9) (make-atom 10) (make-atom 11)
|
|
(make-atom 12) (make-atom 13) (make-atom 14)
|
|
(make-atom 15) (make-atom 16))))
|
|
;(9...16 are XA_CUT_BUFFER0...XA_CUT_BUFFER7)
|
|
(set! store-buffer (lambda (dpy bytes buf)
|
|
(if (<= 0 buf 7)
|
|
(change-property
|
|
(display-default-root-window dpy)
|
|
(vector-ref xa-cut-buffers buf)
|
|
xa-string
|
|
8
|
|
'replace
|
|
bytes))))
|
|
|
|
(set! store-bytes (lambda (dpy bytes)
|
|
(store-buffer dpy bytes 0)))
|
|
|
|
(set! fetch-buffer (lambda (dpy buf)
|
|
(if (<= 0 buf 7)
|
|
(receive
|
|
(type format data bytes-left)
|
|
(apply values
|
|
(get-property
|
|
(display-root-window dpy)
|
|
(vector-ref xa-cut-buffers buf)
|
|
xa-string
|
|
0
|
|
100000
|
|
#f))
|
|
(if (and (eq? type xa-string)
|
|
(< format 32))
|
|
data
|
|
""))
|
|
"")))
|
|
|
|
(set! fetch-bytes (lambda (dpy)
|
|
(fetch-buffer dpy 0)))
|
|
|
|
(set! rotate-buffers (lambda (dpy delta)
|
|
(rotate-properties (display-default-root-window dpy)
|
|
xa-cut-buffers delta))))
|
|
|
|
|
|
|
|
|
|
|