scx/scheme/xlib/utility.scm

; 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))))