Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

226 lines (209 sloc) 9.733 kb
(defpackage :test-wm (:use :cl))
(in-package :test-wm)
(defparameter *current-test-num* 0)
(defparameter *tests* nil)
(defmacro define-test ((dpy screen) &body body)
(let ((name (intern (format nil "TEST-~d" *current-test-num*))))
`(progn
(defun ,name (,dpy ,screen)
(format t "Starting test ~d~%" ,*current-test-num*)
,@body
(format t "Done.~%"))
(push ',name *tests*)
(incf *current-test-num*))))
(define-test (dpy screen)
(let ((w (xlib:create-window :parent (xlib:screen-root screen)
:x 10 :y 10 :width 100 :height 100 :border-width 1)))
(xlib:map-window w)
(xlib:display-finish-output dpy)
(xlib:destroy-window w)
(xlib:display-finish-output dpy)))
(define-test (dpy screen)
(let ((w (xlib:create-window :parent (xlib:screen-root screen)
:x 10 :y 10 :width 100 :height 100 :border-width 1)))
(xlib:map-window w)
(xlib:display-finish-output dpy)
(sleep 1)
(setf (xlib:window-priority w) :above)
;; (setf (xlib:drawable-border-width w) 3)
(xlib:display-finish-output dpy)
(xlib:destroy-window w)
(xlib:display-finish-output dpy)))
(define-test (dpy screen)
(let ((windows (loop for i from 0 to 100
collect (let ((w (xlib:create-window :parent (xlib:screen-root screen)
:x 10 :y 10 :width 100 :height 100 :border-width 1)))
(xlib:map-window w)
(xlib:display-finish-output dpy)
(setf (xlib:window-priority w) :above)
w))))
(xlib:display-finish-output dpy)
(loop for i in windows do
(xlib:unmap-window i))
(xlib:display-finish-output dpy)
(sleep 3)
(loop for i in windows do
(xlib:destroy-window i))))
;; (define-test (dpy screen)
;; (let ((windows (loop for i from 0 to 100
;; collect (let ((w (xlib:create-window :parent (xlib:screen-root screen)
;; :x 10 :y 10 :width 100 :height 100 :border-width 1)))
;; (xlib:map-window w)
;; (xlib:display-finish-output dpy)
;; (setf (xlib:window-priority w) :above)
;; w))))
;; (xlib:display-finish-output dpy)
;; (loop for i in windows do
;; (xlib:unmap-window i))
;; (xlib:display-finish-output dpy)
;; (sleep 3)
;; (loop for i in windows do
;; (xlib:destroy-window i))))
(define-test (dpy screen)
(let ((w (xlib:create-window :parent (xlib:screen-root screen)
:x 10 :y 10 :width 100 :height 100 :border-width 1)))
(xlib:map-window w)
(setf (xlib:window-priority w) :above)
(xlib:display-finish-output dpy)
(xlib:unmap-window w)
(setf (xlib:drawable-x w) 5)
(xlib:display-finish-output dpy)))
(define-test (dpy screen)
;; create a window and set its role after being mapped
(let ((w (xlib:create-window :parent (xlib:screen-root screen)
:x 10 :y 10 :width 100 :height 100 :border-width 1)))
(xlib:map-window w)
(xlib:display-finish-output dpy)
(sleep 1)
(xlib:change-property w
:WM_WINDOW_ROLE
(map 'list 'char-code "rad dude")
:string
8)
(xlib:display-finish-output dpy)
(sleep 10)))
(defun break-display-xid-cache ()
(labels ((make-win (dpy)
(xlib:create-window :parent (xlib:screen-root (first (xlib:display-roots dpy))) :x 0 :y 0 :width 50 :height 50))
(make-pixmap (window)
(xlib:create-pixmap :width (random 100) :height (random 100) :depth 8 :drawable window))
(first-pass (dpy)
;; Open a fresh connection. Create a window and a pixmap.
(let* ((dpy2 (xlib:open-default-display))
(window (make-win dpy2))
(pixmap (make-pixmap window)))
;; make the pixmap the window's icon pixmap hint.
(setf (xlib:wm-hints window) (xlib:make-wm-hints :icon-pixmap pixmap))
(format t "Window ID: ~s pixmap ID: ~s~%" (xlib:window-id window) (xlib:pixmap-id pixmap))
(xlib:map-window window)
(xlib:display-finish-output dpy2)
(sleep 1)
;; On the old connection, list the root window children
;; and the icon pixmap hint to cache their XIDs.
(loop for w in (xlib:query-tree (xlib:screen-root (first (xlib:display-roots dpy))))
for hints = (xlib:wm-hints w)
when hints
do (format t "top level window id: ~s | icon pixmap hint: ~s~%" (xlib:window-id w) (xlib:wm-hints-icon-pixmap hints)))
(xlib:close-display dpy2)))
(second-pass (dpy)
;; Open a fresh connection and create 2 windows.
(let* ((dpy2 (xlib:open-default-display))
(window1 (make-win dpy2))
(window2 (make-win dpy2)))
(format t "Window#1 ID: ~s Window#2 ID: ~s~%" (xlib:window-id window1) (xlib:window-id window2))
(xlib:display-finish-output dpy2)
;; On the old connection, list the root window children
;; and note the second window is erroneously a pixmap
;; due to too agressive caching in clx.
(loop for w in (xlib:query-tree (xlib:screen-root (first (xlib:display-roots dpy))))
do (format t "window: ~s~%" w))
(xlib:close-display dpy2))))
(let ((dpy (xlib:open-default-display)))
(first-pass dpy)
(second-pass dpy)
(xlib:close-display dpy))))
(defun test-wm-class (map-p)
"Test the robustness of CLX's wm-class function. If MAP-P is T then
map the window. Useful if you want to test the running window
manager."
(labels ((test-it (w &rest strings)
(xlib:change-property w :WM_CLASS
(apply #'concatenate '(vector xlib:card8)
strings)
:string 8)
(print (multiple-value-list (xlib:get-wm-class w)))
;; give the wm a chance to try out the value
(when map-p
(sleep 1)))
(convert (s)
(map '(vector xlib:card8) #'xlib:char->card8 s)))
(let* ((dpy (xlib:open-default-display))
(screen (first (xlib:display-roots dpy)))
(root (xlib:screen-root screen))
(win (xlib:create-window :parent root :x 0 :y 0 :width 100 :height 100 :background (xlib:screen-white-pixel screen))))
(unwind-protect
(when map-p
(xlib:map-window win))
(progn
(test-it win
(convert "string 1")
#(0)
(convert "string 2")
#(0))
(test-it win
(convert "Manifold X")
#(0)
(convert "Powercoupling Y")
#(0)
(convert "Magistrate Z")
#(0))
(test-it win
#(0))
(test-it win)
(test-it win
#(0)
(convert "checkity checkfoo"))
(test-it win
(convert "ohh bother")
#(0)
(convert "Magic Fudge"))
(test-it win
(convert "You Gellin?")
#(0))
(test-it win
(convert "Blinky The Cloon")))
(xlib:close-display dpy))
(values))))
(defun get-wm-hints ()
"simias reports that on sbcl the wm-hints property is all screwed up
when he runs an x server on 32 or 64bit freebsd and runs any x client
on a fedora 32bit, connecting through an ssh tunnel. clisp works fine.
so run this function on clisp and sbcl and compare the numbers. This
assumes you're running a reparenting wm."
(let ((dpy (xlib:open-default-display)))
(write-line "you gotta have some windows open for this to work.")
(dolist (top (xlib:query-tree (xlib:screen-root (first (xlib:display-roots dpy)))))
(dolist (w (xlib:query-tree top))
(format t "~s ~s: ~s~%" w (xlib:wm-name w) (xlib:get-property w :WM_HINTS :type :WM_HINTS :result-type 'vector))))
(xlib:close-display dpy)))
(defun parse-display-string (display)
"Parse an X11 DISPLAY string and return the host and display from it."
(let* ((colon (position #\: display))
(host (subseq display 0 colon))
(rest (subseq display (1+ colon)))
(dot (position #\. rest))
(num (parse-integer (subseq rest 0 dot))))
(values host num)))
(defvar *dpy* nil)
(defun test-wm (display-str)
(multiple-value-bind (host display) (parse-display-string display-str)
(setf *dpy* (xlib:open-display host :display display :protocol nil))
(let* ((dpy *dpy*)
(screen (first (xlib:display-roots dpy))))
(unwind-protect
(progn
;; (dolist (i *tests*)
;; (funcall i dpy screen))
(funcall (car *tests*) dpy screen)
)
(xlib:close-display *dpy*)))))
Jump to Line
Something went wrong with that request. Please try again.