(shadow 'char-width) (use-package :xlib) (defparameter *mods* '(:mod-1)) (defparameter *move* 1) (defparameter *resize* 3) (defparameter *lower* 4) (defparameter *raise* 5) (defparameter *display* nil) ; set this to an integer to do testing with xnest (defun open-default-display (&optional display-name) "Open a connection to DISPLAY-NAME if supplied, or to the appropriate default display as given by GET-DEFAULT-DISPLAY otherwise. OPEN-DISPLAY-NAME always attempts to do display authorization. The hostname is resolved to an address, then authorization data for the (protocol, host-address, displaynumber) triple is looked up in the file given by AUTHORITY_PATHNAME (typically $HOME/.Xauthority). If the protocol is :local, or if the hostname resolves to the local host, authority data for the local machine's actual hostname - as returned by gethostname(3) - is used instead." (destructuring-bind (host display screen protocol) (get-default-display display-name) (declare (ignore screen)) (open-display host :display display :protocol protocol))) (defun main () (let* ((display (if *display* (open-display "" :display *display*) (open-default-display))) (screen (first (display-roots display))) (root (screen-root screen))) (dolist (button (list *move* *resize* *lower* *raise*)) (grab-button root button '(:button-press) :modifiers *mods*)) (unwind-protect (let (last-button last-x last-y) (do () (nil) ; infinite loop (event-case (display :discard-p t) ;; for key-press and key-release, code is the keycode ;; for button-press and button-release, code is the button number (:button-press (code child event-window) (cond ((= code *raise*) (circulate-window-up root)) ((= code *lower*) (circulate-window-down root)) ((or (= code *move*) (= code *resize*)) (when child ; do nothing if we're not over a window (setf last-button code) (grab-pointer child '(:pointer-motion :button-release)) (let ((lst (multiple-value-list (query-pointer root)))) (setf last-x (sixth lst) last-y (seventh lst))))))) (:motion-notify (event-window root-x root-y) ;; while(XCheckTypedEvent(display, MotionNotify, &ev)); (let ((delta-x (- root-x last-x)) (delta-y (- root-y last-y))) (cond ((= last-button *move*) ;; (incf (drawable-x event-window) delta-x) ;; (incf (drawable-y event-window) delta-y) (setf (drawable-x event-window) root-x (drawable-y event-window) root-y)) ((= last-button *resize*) ;; (incf (drawable-width event-window) delta-x) ;; (incf (drawable-height event-window) delta-y) (setf (drawable-width event-window) (max 1 (- root-x (drawable-x event-window))) (drawable-height event-window) (max 1 (- root-y (drawable-y event-window)))))))) (:button-release () (ungrab-pointer display))))) (dolist (button (list *move* *resize* *lower* *raise*)) (ungrab-button root button :modifiers *mods*)) (close-display display))))
tinywm-lisp is a Common Lisp port of the TinyWM X11 window manager.