113 lines
3.1 KiB
Scheme
113 lines
3.1 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-default returns the user default values of a specified program
|
|
;; from the X-resource database. program and option should be
|
|
;; strings. On success a string is returned, otherwise #f. See
|
|
;; XGetDefault.
|
|
|
|
(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")
|
|
|
|
;; resource-manager-string returns the RESOURCE_MANAGER property from
|
|
;; the server's root window of screen 0, or #f if no such property
|
|
;; exists. See XResourceManagerString.
|
|
|
|
(define (resource-manager-string dpy)
|
|
(%resource-manager-string (display-Xdisplay dpy)))
|
|
|
|
(import-lambda-definition %resource-manager-string (Xdisplay)
|
|
"scx_Resource_Manager_String")
|
|
|
|
;; parse-geometry parses a string for the standard X format for x, y,
|
|
;; width and height arguments. Definition:
|
|
;; [=][<width>{xX}<height>][{+-}<xoffset>{+-}<yoffset>]. The return
|
|
;; value is a list (x-negative? y-negative? x y width height), where
|
|
;; x, y, width, height can be #f if they were not specified in the
|
|
;; string. See XParseGeometry.
|
|
|
|
(define (parse-geometry string)
|
|
(reverse (%parse-geometry string)))
|
|
|
|
(import-lambda-definition %parse-geometry (string)
|
|
"scx_Parse_Geometry")
|
|
|
|
;; these are some functions for clipboard handling.
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
|