;;; -*-Scheme-*-
;;;
;;; X11 interface

(require 'xlib.o)

(define (translate-text string)
  (list->vector (map char->integer (string->list string))))

(define (drawable? d)
  (or (window? d) (pixmap? d)))

(define (clear-window w)
  (clear-area w 0 0 0 0 #f))

(define (define-cursor w c)
  (set-window-cursor! w c))

(define (undefine-cursor w)
  (set-window-cursor! w 'none))

(define (create-font-cursor dpy which)
  (let ((font (open-font dpy 'cursor)))
    (unwind-protect
     (create-glyph-cursor font which font (1+ which)
			  (make-color 0 0 0) (make-color 1 1 1))
     (close-font font))))

(define (synchronize d)
  (set-after-function! d (lambda (d) (display-wait-output d #f))))

(define (font-property font prop)
  (let* ((dpy (font-display font))
	(atom (intern-atom dpy prop))
	(properties (vector->list (font-properties font)))
	(result (assq atom properties)))
    (if result
	(cdr result)
	result)))

(define-macro (with-server-grabbed dpy . body)
  `(dynamic-wind
    (lambda () (grab-server ,dpy))
    (lambda () ,@body)
    (lambda () (ungrab-server ,dpy))))

(define (warp-pointer dst dst-x dst-y)
  (general-warp-pointer (window-display dst) dst dst-x dst-y 'none 0 0 0 0))

(define (warp-pointer-relative dpy x-off y-off)
  (general-warp-pointer dpy 'none x-off y-off 'none 0 0 0 0))

(define (query-best-cursor dpy w h)
  (query-best-size dpy w h 'cursor))

(define (query-best-tile dpy w h)
  (query-best-size dpy w h 'tile))

(define (query-best-stipple dpy w h)
  (query-best-size dpy w h 'stipple))

;; Until Xlib provides an XGetCommand():

(define (wm-command w)
  (let* ((dpy (window-display w))
	 (string (intern-atom dpy 'STRING))
	 (p (get-property w (intern-atom dpy 'WM_COMMAND) string 0 1000 #f))
	 (s (caddr p))
	 (next-null (lambda (i)
                      (do ((i i (1+ i)))
	                  ((char=? (string-ref s i) (integer->char 0)) i)))))
    (if (and (eq? (car p) string) (= (cadr p) 8))
	(do ((len (string-length s))
	     (end 0)
	     (start 0 (1+ end))
	     (l () (cons (substring s start end) l)))
	    ((>= start len) (reverse! l))
	  (set! end (next-null start)))
	())))


;;; Describe functions go here: