Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
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.