[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-37-g793638d
Philippe Brochard
pbrochard at common-lisp.net
Sun May 13 21:27:09 UTC 2012
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CLFSWM - A(nother) Common Lisp FullScreen Window Manager".
The branch, test has been updated
via 793638d4c961bf53cbfa04157e6f6655c2b26979 (commit)
from bf200cb2092db5bfa72076914fdc9d3a8ceb07c0 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 793638d4c961bf53cbfa04157e6f6655c2b26979
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun May 13 23:27:01 2012 +0200
src/clfswm-internal.lisp: Remove the *current-child* variable and use a setfable function (current-child) instead.
diff --git a/ChangeLog b/ChangeLog
index 9d0f0d9..de5e677 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-13 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp: Remove the *current-child* variable
+ and use a setfable function (current-child) instead.
+
2012-05-09 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-internal.lisp: Use xdpyinfo/xinerama informations
diff --git a/clfswm.asd b/clfswm.asd
index c11942d..98ef92e 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -19,12 +19,10 @@
:depends-on ("tools"))
(:file "package"
:depends-on ("my-html" "tools" "version"))
- (:file "clfswm-placement"
- :depends-on ("package"))
(:file "keysyms"
:depends-on ("package"))
(:file "xlib-util"
- :depends-on ("package" "keysyms" "tools" "clfswm-placement"))
+ :depends-on ("package" "keysyms" "tools"))
(:file "config"
:depends-on ("package" "xlib-util"))
(:file "netwm-util"
@@ -35,6 +33,8 @@
:depends-on ("package" "clfswm-keys" "my-html" "tools" "config"))
(:file "clfswm-internal"
:depends-on ("xlib-util" "clfswm-keys" "netwm-util" "tools" "config"))
+ (:file "clfswm-placement"
+ :depends-on ("package" "clfswm-internal"))
(:file "clfswm-generic-mode"
:depends-on ("package" "tools" "xlib-util" "clfswm-internal"))
(:file "clfswm-circulate-mode"
@@ -61,7 +61,8 @@
"clfswm-generic-mode" "clfswm-placement"))
(:file "clfswm-util"
:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query"
- "clfswm-menu" "clfswm-autodoc" "clfswm-corner"))
+ "clfswm-menu" "clfswm-autodoc" "clfswm-corner"
+ "clfswm-placement"))
(:file "clfswm-configuration"
:depends-on ("package" "config" "clfswm-internal" "clfswm-util" "clfswm-query"
"clfswm-menu"))
diff --git a/contrib/osd.lisp b/contrib/osd.lisp
index 24581af..ecba461 100644
--- a/contrib/osd.lisp
+++ b/contrib/osd.lisp
@@ -75,7 +75,7 @@
(map-window *osd-window*))
(let* ((modifiers (state->modifiers state))
(keysym (keysym->keysym-name (xlib:keycode->keysym *display* code 0))))
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(push (list #'is-osd-window-p nil) *never-managed-window-list*))
(raise-window *osd-window*)
(rotatef (xlib:gcontext-foreground *osd-gc*) (xlib:gcontext-background *osd-gc*))
diff --git a/contrib/server/test.lisp b/contrib/server/test.lisp
index 59755e9..da7d3ea 100755
--- a/contrib/server/test.lisp
+++ b/contrib/server/test.lisp
@@ -4,10 +4,10 @@
(select-previous-level)
(let ((frame (create-frame \:name \"Test root\" \:x 0.05 \:y 0.05)))
- (add-frame frame *current-child*)
+ (add-frame frame (current-child))
(add-frame (create-frame \:name \"Test 1\" \:x 0.3 \:y 0 \:w 0.7 \:h 1) frame)
(add-frame (create-frame \:name \"Test 2\" \:x 0 \:y 0 \:w 0.3 \:h 1) frame)
- (setf *current-child* (first (frame-child frame))))
+ (setf (current-child) (first (frame-child frame))))
(show-all-children *current-root*)
diff --git a/src/bindings-second-mode.lisp b/src/bindings-second-mode.lisp
index cdeea62..3e4964a 100644
--- a/src/bindings-second-mode.lisp
+++ b/src/bindings-second-mode.lisp
@@ -122,6 +122,9 @@
(define-second-key ("h") 'rotate-frame-geometry)
(define-second-key ("h" :shift) 'anti-rotate-frame-geometry)
+ (define-second-key ("Page_Up") 'select-next-root)
+ (define-second-key ("Page_Down") 'select-previous-root)
+
(define-second-key ("Right") 'speed-mouse-right)
(define-second-key ("Left") 'speed-mouse-left)
(define-second-key ("Down") 'speed-mouse-down)
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index a5b189e..7e4be5e 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -39,7 +39,7 @@
(let* ((text (format nil "~A [~A]"
(limit-length (ensure-printable (child-name (xlib:input-focus *display*)))
*circulate-text-limite*)
- (limit-length (ensure-printable (child-name *current-child*))
+ (limit-length (ensure-printable (child-name (current-child)))
*circulate-text-limite*)))
(len (length text)))
(xlib:draw-glyphs *pixmap-buffer* *circulate-gc*
@@ -59,10 +59,10 @@
(defun reset-circulate-child ()
(setf *circulate-hit* 0
*circulate-parent* nil
- *circulate-orig* (frame-child *current-child*)))
+ *circulate-orig* (frame-child (current-child))))
(defun reset-circulate-brother ()
- (setf *circulate-parent* (find-parent-frame *current-child*)
+ (setf *circulate-parent* (find-parent-frame (current-child))
*circulate-hit* 0)
(when (frame-p *circulate-parent*)
(setf *circulate-orig* (frame-child *circulate-parent*))))
@@ -71,7 +71,7 @@
(defun reorder-child (direction)
(no-focus)
- (with-slots (child selected-pos) *current-child*
+ (with-slots (child selected-pos) (current-child)
(unless *circulate-orig*
(reset-circulate-child))
(let ((len (length *circulate-orig*)))
@@ -85,27 +85,27 @@
(defun reorder-brother (direction)
(no-focus)
- (let ((old-child *current-child*))
+ (let ((old-child (current-child)))
(select-current-frame nil)
(unless (and *circulate-orig* *circulate-parent*)
(reset-circulate-brother))
(let ((len (length *circulate-orig*)))
(when (plusp len)
(when (frame-p *circulate-parent*)
- (let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
+ (let ((elem (nth (mod (incf *circulate-hit* direction) len) *circulate-orig*)))
(setf (frame-child *circulate-parent*) (cons elem (child-remove elem *circulate-orig*))
(frame-selected-pos *circulate-parent*) 0
- *current-child* (frame-selected-child *circulate-parent*))))
- (when (and (not (child-root-p *current-child*))
+ (current-child) (frame-selected-child *circulate-parent*))))
+ (when (and (not (child-root-p (current-child)))
(child-root-p old-child))
- (change-root (find-root old-child) *current-child*))))
+ (change-root (find-root old-child) (current-child)))))
(show-all-children t)
(draw-circulate-mode-window)))
(defun reorder-subchild (direction)
(declare (ignore direction))
- (when (frame-p *current-child*)
- (let ((selected-child (frame-selected-child *current-child*)))
+ (when (frame-p (current-child))
+ (let ((selected-child (frame-selected-child (current-child))))
(when (frame-p selected-child)
(no-focus)
(with-slots (child selected-pos) selected-child
@@ -122,14 +122,14 @@
(defun circulate-select-next-child ()
"Select the next child"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(when *circulate-parent*
(reset-circulate-child))
(reorder-child +1)))
(defun circulate-select-previous-child ()
"Select the previous child"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(when *circulate-parent*
(reset-circulate-child))
(reorder-child -1)))
@@ -248,60 +248,60 @@
(defun select-next-child ()
"Select the next child"
- (when (frame-p *current-child*)
- (setf *circulate-orig* (frame-child *current-child*)
+ (when (frame-p (current-child))
+ (setf *circulate-orig* (frame-child (current-child))
*circulate-parent* nil)
(circulate-mode :child-direction +1)))
(defun select-previous-child ()
"Select the previous child"
- (when (frame-p *current-child*)
- (setf *circulate-orig* (frame-child *current-child*)
+ (when (frame-p (current-child))
+ (setf *circulate-orig* (frame-child (current-child))
*circulate-parent* nil)
(circulate-mode :child-direction -1)))
(defun select-next-brother ()
"Select the next brother"
- (setf *circulate-parent* (find-parent-frame *current-child*))
+ (setf *circulate-parent* (find-parent-frame (current-child)))
(when (frame-p *circulate-parent*)
(setf *circulate-orig* (frame-child *circulate-parent*)))
(circulate-mode :brother-direction +1))
(defun select-previous-brother ()
"Select the previous brother"
- (setf *circulate-parent* (find-parent-frame *current-child*))
+ (setf *circulate-parent* (find-parent-frame (current-child)))
(when (frame-p *circulate-parent*)
(setf *circulate-orig* (frame-child *circulate-parent*)))
(circulate-mode :brother-direction -1))
(defun select-next-subchild ()
"Select the next subchild"
- (when (and (frame-p *current-child*)
- (frame-p (frame-selected-child *current-child*)))
- (setf *circulate-orig* (frame-child *current-child*)
+ (when (and (frame-p (current-child))
+ (frame-p (frame-selected-child (current-child))))
+ (setf *circulate-orig* (frame-child (current-child))
*circulate-parent* nil)
(circulate-mode :subchild-direction +1)))
(defun select-next-child-simple ()
"Select the next child (do not enter in circulate mode)"
- (when (frame-p *current-child*)
- (with-slots (child) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child) (current-child)
(setf child (rotate-list child)))
(show-all-children)))
(defun reorder-brother-simple (reorder-fun)
- (unless (child-root-p *current-child*)
+ (unless (child-root-p (current-child))
(no-focus)
(select-current-frame nil)
- (let ((parent-frame (find-parent-frame *current-child*)))
+ (let ((parent-frame (find-parent-frame (current-child))))
(when (frame-p parent-frame)
(with-slots (child) parent-frame
(setf child (funcall reorder-fun child)
- *current-child* (frame-selected-child parent-frame))))
+ (current-child) (frame-selected-child parent-frame))))
(show-all-children t))))
@@ -318,27 +318,27 @@
;;; Spatial move functions
(defun select-brother-generic-spatial-move (fun-found)
"Select the nearest brother of the current child based on the fun-found function"
- (let ((is-root-p (child-root-p *current-child*)))
+ (let ((is-root-p (child-root-p (current-child))))
(when is-root-p
(leave-frame)
(sleep *spatial-move-delay-before*))
(no-focus)
(select-current-frame nil)
- (let ((parent-frame (find-parent-frame *current-child*)))
+ (let ((parent-frame (find-parent-frame (current-child))))
(when (frame-p parent-frame)
(with-slots (child selected-pos) parent-frame
(let ((found nil)
(found-dist nil))
(dolist (c child)
- (let ((dist (funcall fun-found *current-child* c)))
+ (let ((dist (funcall fun-found (current-child) c)))
(when (and dist
- (not (child-equal-p *current-child* c))
+ (not (child-equal-p (current-child) c))
(or (not found)
(and found-dist (< dist found-dist))))
(setf found c
found-dist dist))))
(when found
- (setf *current-child* found
+ (setf (current-child) found
selected-pos 0
child (cons found (child-remove found child)))))))
(show-all-children t)
@@ -380,3 +380,23 @@
(distance (middle-child-x current) (child-y current)
(middle-child-x child) (child-y2 child))))))
+
+
+
+(defun select-generic-root (fun)
+ (no-focus)
+ (let* ((current-root (find-root (current-child)))
+ (parent (find-parent-frame (root-original current-root))))
+ (setf (frame-child parent) (funcall fun (frame-child parent))
+ (current-child) (frame-selected-child parent)))
+ (show-all-children t)
+ (leave-second-mode))
+
+(defun select-next-root ()
+ "Select the next root"
+ (select-generic-root #'rotate-list))
+
+(defun select-previous-root ()
+ "Select the previous root"
+ (select-generic-root #'anti-rotate-list))
+
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index eae9406..60c63b7 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -106,7 +106,7 @@
(third lwin))))
(defun expose-create-window (child n)
- (let* ((*current-child* child)
+ (let* (;;((current-child) child) ;;; PHIL: Broken
(string (format nil "~A~A" (number->string n)
(if *expose-show-window-title*
(format nil " - ~A" (ensure-printable (child-fullname child)))
@@ -216,10 +216,10 @@
(defun expose-windows-current-child-mode ()
"Present all windows in the current child (An expose like)"
(stop-button-event)
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(let ((orig-root *current-root*))
- (unless (child-equal-p *current-child* *current-root*)
- (setf *current-root* *current-child*))
+ (unless (child-equal-p (current-child) *current-root*)
+ (setf *current-root* (current-child)))
(expose-windows-generic *current-root*
(lambda (parent)
(setf *current-root* parent))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index f270463..d71b0ca 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -375,8 +375,8 @@
(defun is-in-current-child-p (child)
- (and (frame-p *current-child*)
- (child-member child (frame-child *current-child*))))
+ (and (frame-p (current-child))
+ (child-member child (frame-child (current-child)))))
@@ -558,9 +558,9 @@
(defun fixe-real-size-current-child ()
"Fixe real (pixel) coordinates in float coordinates for children in the current child"
- (when (frame-p *current-child*)
- (dolist (child (frame-child *current-child*))
- (fixe-real-size child *current-child*))))
+ (when (frame-p (current-child))
+ (dolist (child (frame-child (current-child)))
+ (fixe-real-size child (current-child)))))
@@ -616,10 +616,25 @@
(rec parent)))))
(rec base)))
-
;;; Multiple roots support (replace the old *current-root* variable)
-(let ((root-list nil))
- ;; TODO: Add find-root-by-coordinates, change-root-geometry
+;; TODO: Add find-root-by-coordinates, change-root-geometry
+(let ((root-list nil)
+ (current-child nil))
+ (defun current-child ()
+ current-child)
+
+ (defun current-child-setter (value)
+ (setf current-child value))
+
+ (defmacro with-current-child ((new-child) &body body)
+ "Temporarly change the current child"
+ (let ((old-child (gensym))
+ (ret (gensym)))
+ `(let ((,old-child (current-child)))
+ (setf (current-child) ,new-child)
+ (let ((,ret (multiple-value-list (progn , at body))))
+ (setf (current-child) ,old-child)
+ (values-list ,ret)))))
(defun define-as-root (child x y width height)
(push (make-root :child child :original child :current-child nil :x x :y y :w width :h height) root-list))
@@ -654,9 +669,9 @@
(defun find-root (child)
(aif (child-original-root-p child)
- it
- (awhen (find-parent-frame child)
- (find-root it))))
+ it
+ (awhen (find-parent-frame child)
+ (find-root it))))
(defun find-child-in-all-root (child)
(dolist (root root-list)
@@ -664,7 +679,10 @@
(return-from find-child-in-all-root root))))
(defun find-current-root ()
- (root-child (find-root *current-child*))))
+ (root-child (find-root (current-child)))))
+
+(defsetf current-child current-child-setter)
+
;;; Multiple physical screen helper
@@ -681,18 +699,31 @@
(parse-integer string :junk-allowed t))
(split-string (substitute #\space #\x (substitute #\space #\, line))))))
-(defun get-connected-heads-size ()
- (when (xlib:query-extension *display* "XINERAMA")
- (let ((output (do-shell "xdpyinfo -ext XINERAMA"))
- (sizes '()))
- (loop for line = (read-line output nil nil)
- while line
- do (when (search " head " line)
- (destructuring-bind (w h x y)
- (parse-xinerama-info line)
- (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
- (remove-duplicates sizes :test #'equal))))
- ;;'((10 10 500 300) (520 20 480 300) (310 330 600 250)))) ;;; For test
+(defun get-connected-heads-size (&optional (fake t))
+ (labels ((heads-info ()
+ (if (not fake)
+ (do-shell "xdpyinfo -ext XINERAMA")
+ (progn
+ (setf *show-root-frame-p* t)
+ (do-shell "echo ' available colormap entries: 256 per subfield
+ red, green, blue masks: 0xff0000, 0xff00, 0xff
+ significant bits in color specification: 8 bits
+
+XINERAMA version 1.1 opcode: 150
+ head #0: 500x300 @ 10,10
+ head #1: 480x300 @ 520,20
+ head #2: 600x250 @ 310,330'")))))
+ (when (xlib:query-extension *display* "XINERAMA")
+ (let ((output (heads-info))
+ (sizes nil))
+ (loop for line = (read-line output nil nil)
+ while line
+ do (when (search " head " line)
+ (destructuring-bind (w h x y)
+ (parse-xinerama-info line)
+ (push (list (- x *border-size*) (- y *border-size*) w h) sizes))))
+ (dbg sizes)
+ (remove-duplicates sizes :test #'equal)))))
(defun place-frames-from-xinerama-infos ()
@@ -717,7 +748,7 @@
(frame-h frame) (float (/ h height)))
(add-frame (create-frame) frame)
(define-as-root frame x y w h)))
- (setf *current-child* (first (frame-child (first (frame-child *root-frame*)))))))))
+ (setf (current-child) (first (frame-child (first (frame-child *root-frame*)))))))))
@@ -741,9 +772,9 @@
;;; Current window utilities
(defun get-current-window ()
- (typecase *current-child*
- (xlib:window *current-child*)
- (frame (frame-selected-child *current-child*))))
+ (typecase (current-child)
+ (xlib:window (current-child))
+ (frame (frame-selected-child (current-child)))))
(defmacro with-current-window (&body body)
"Bind 'window' to the current window"
@@ -752,10 +783,10 @@
, at body)))
(defun get-first-window ()
- (typecase *current-child*
- (xlib:window *current-child*)
- (frame (or (first (frame-child *current-child*))
- *current-child*))))
+ (typecase (current-child)
+ (xlib:window (current-child))
+ (frame (or (first (frame-child (current-child)))
+ (current-child)))))
@@ -769,7 +800,7 @@
(xlib:window-background window) (get-color *frame-background*))
(clear-pixmap-buffer window gc)
(setf (xlib:gcontext-foreground gc) (get-color (if (and (child-root-p frame)
- (child-equal-p frame *current-child*))
+ (child-equal-p frame (current-child)))
*frame-foreground-root* *frame-foreground*)))
(xlib:draw-glyphs *pixmap-buffer* gc 5 dy
(format nil "Frame: ~A~A"
@@ -913,9 +944,9 @@
(defmethod show-child ((window xlib:window) parent previous)
(if (or (managed-window-p window parent)
- (child-equal-p window *current-child*)
+ (child-equal-p window (current-child))
(not (hide-unmanaged-window-p parent))
- (child-equal-p parent *current-child*))
+ (child-equal-p parent (current-child)))
(progn
(map-window window)
(set-child-stack-order window previous))
@@ -943,7 +974,7 @@
(defgeneric select-child (child selected))
(labels ((get-selected-color (child selected-p)
- (get-color (cond ((child-equal-p child *current-child*) *color-selected*)
+ (get-color (cond ((child-equal-p child (current-child)) *color-selected*)
(selected-p *color-maybe-selected*)
(t *color-unselected*)))))
(defmethod select-child ((frame frame) selected-p)
@@ -960,7 +991,7 @@
()))
(defun select-current-frame (selected)
- (select-child *current-child* selected))
+ (select-child (current-child) selected))
(defun unselect-all-frames ()
(with-all-children (*root-frame* child)
@@ -974,7 +1005,7 @@
(xlib:window (focus-window child))
(frame (rec (frame-selected-child child))))))
(no-focus)
- (rec *current-child*)))
+ (rec (current-child))))
@@ -1118,8 +1149,8 @@
(defun set-current-child-generic (child)
- (unless (child-equal-p *current-child* child)
- (setf *current-child* child)
+ (unless (child-equal-p (current-child) child)
+ (setf (current-child) child)
t))
(defgeneric set-current-child (child parent window-parent))
@@ -1160,30 +1191,30 @@ For window: set current child to window or its parent according to window-parent
(defun select-next-level ()
"Select the next level in frame"
(select-current-frame :maybe)
- (when (frame-p *current-child*)
- (awhen (frame-selected-child *current-child*)
- (setf *current-child* it)))
+ (when (frame-p (current-child))
+ (awhen (frame-selected-child (current-child))
+ (setf (current-child) it)))
(show-all-children))
(defun select-previous-level ()
"Select the previous level in frame"
- (unless (child-root-p *current-child*)
+ (unless (child-root-p (current-child))
(select-current-frame :maybe)
- (awhen (find-parent-frame *current-child*)
- (setf *current-child* it))
+ (awhen (find-parent-frame (current-child))
+ (setf (current-child) it))
(show-all-children)))
(defun enter-frame ()
"Enter in the selected frame - ie make it the root frame"
- (let ((root (find-root *current-child*)))
- (unless (child-equal-p (root-child root) *current-child*)
- (change-root root *current-child*))
+ (let ((root (find-root (current-child))))
+ (unless (child-equal-p (root-child root) (current-child))
+ (change-root root (current-child)))
(show-all-children t)))
(defun leave-frame ()
"Leave the selected frame - ie make its parent the root frame"
- (let ((root (find-root *current-child*)))
+ (let ((root (find-root (current-child))))
(unless (or (child-equal-p (root-child root) *root-frame*)
(child-original-root-p (root-child root)))
(awhen (and root (find-parent-frame (root-child root)))
@@ -1199,8 +1230,8 @@ For window: set current child to window or its parent according to window-parent
(defun frame-lower-child ()
"Lower the child in the current frame"
- (when (frame-p *current-child*)
- (with-slots (child selected-pos) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child selected-pos) (current-child)
(unless (>= selected-pos (length child))
(when (nth (1+ selected-pos) child)
(rotatef (nth selected-pos child)
@@ -1211,8 +1242,8 @@ For window: set current child to window or its parent according to window-parent
(defun frame-raise-child ()
"Raise the child in the current frame"
- (when (frame-p *current-child*)
- (with-slots (child selected-pos) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child selected-pos) (current-child)
(unless (< selected-pos 1)
(when (nth (1- selected-pos) child)
(rotatef (nth selected-pos child)
@@ -1223,8 +1254,8 @@ For window: set current child to window or its parent according to window-parent
(defun frame-select-next-child ()
"Select the next child in the current frame"
- (when (frame-p *current-child*)
- (with-slots (child selected-pos) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child selected-pos) (current-child)
(unless (>= selected-pos (length child))
(incf selected-pos)))
(show-all-children)))
@@ -1232,8 +1263,8 @@ For window: set current child to window or its parent according to window-parent
(defun frame-select-previous-child ()
"Select the previous child in the current frame"
- (when (frame-p *current-child*)
- (with-slots (child selected-pos) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child selected-pos) (current-child)
(unless (< selected-pos 1)
(decf selected-pos)))
(show-all-children)))
@@ -1242,16 +1273,16 @@ For window: set current child to window or its parent according to window-parent
(defun switch-to-root-frame (&key (show-later nil))
"Switch to the root frame"
- (let ((root (find-root *current-child*)))
+ (let ((root (find-root (current-child))))
(change-root root (root-original root)))
(unless show-later
(show-all-children t)))
(defun switch-and-select-root-frame (&key (show-later nil))
"Switch and select the root frame"
- (let ((root (find-root *current-child*)))
+ (let ((root (find-root (current-child))))
(change-root root (root-original root))
- (setf *current-child* (root-original root)))
+ (setf (current-child) (root-original root)))
(unless show-later
(show-all-children t)))
@@ -1270,8 +1301,8 @@ For window: set current child to window or its parent according to window-parent
(progn
(awhen (child-root-p child)
(change-root it (find-parent-frame child)))
- (when (child-equal-p child *current-child*)
- (setf *current-child* (root-child (find-root child))))
+ (when (child-equal-p child (current-child))
+ (setf (current-child) (root-child (find-root child))))
t)))
@@ -1340,28 +1371,6 @@ Warning:frame window and gc are freeed."
-
-
-(defun place-window-from-hints (window)
- "Place a window from its hints"
- (let* ((hints (xlib:wm-normal-hints window))
- (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
- (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
- (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (x-drawable-width *root*)))
- (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (x-drawable-height *root*)))
- (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
- (x-drawable-width window)))
- (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
- (x-drawable-height window))))
- (setf (x-drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
- (x-drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
- (with-placement (*unmanaged-window-placement* x y (x-drawable-width window) (x-drawable-height window))
- (setf (x-drawable-x window) x
- (x-drawable-y window) y))
- (xlib:display-finish-output *display*)))
-
-
-
(defun do-all-frames-nw-hook (window)
"Call nw-hook of each frame."
(catch 'nw-hook-loop
diff --git a/src/clfswm-layout.lisp b/src/clfswm-layout.lisp
index b3872a7..e8dafad 100644
--- a/src/clfswm-layout.lisp
+++ b/src/clfswm-layout.lisp
@@ -45,14 +45,14 @@
;;; Generic functions
(defun set-layout (layout)
"Set the layout of the current child"
- (when (frame-p *current-child*)
- (setf (frame-layout *current-child*) layout)
+ (when (frame-p (current-child))
+ (setf (frame-layout (current-child)) layout)
(leave-second-mode)))
(defun set-layout-dont-leave (layout)
"Set the layout of the current child"
- (when (frame-p *current-child*)
- (setf (frame-layout *current-child*) layout)))
+ (when (frame-p (current-child))
+ (setf (frame-layout (current-child)) layout)))
(defun set-layout-once (layout-name)
(set-layout-dont-leave layout-name)
@@ -90,14 +90,14 @@
(defun layout-ask-size (msg slot &optional (min 80))
- (when (frame-p *current-child*)
- (let ((new-size (/ (or (query-number msg (* (frame-data-slot *current-child* slot) 100)) min) 100)))
- (setf (frame-data-slot *current-child* slot) (max (min new-size 0.99) 0.01)))))
+ (when (frame-p (current-child))
+ (let ((new-size (/ (or (query-number msg (* (frame-data-slot (current-child) slot) 100)) min) 100)))
+ (setf (frame-data-slot (current-child) slot) (max (min new-size 0.99) 0.01)))))
(defun adjust-layout-size (slot inc)
- (when (frame-p *current-child*)
- (setf (frame-data-slot *current-child* slot)
- (max (min (+ (frame-data-slot *current-child* slot) inc) 0.99) 0.01))))
+ (when (frame-p (current-child))
+ (setf (frame-data-slot (current-child) slot)
+ (max (min (+ (frame-data-slot (current-child) slot) inc) 0.99) 0.01))))
(defun inc-tile-layout-size ()
"Increase the tile layout size"
@@ -124,9 +124,9 @@
(defun fast-layout-switch ()
"Switch between two layouts"
- (when (frame-p *current-child*)
- (with-slots (layout) *current-child*
- (let* ((layout-list (frame-data-slot *current-child* :fast-layout))
+ (when (frame-p (current-child))
+ (with-slots (layout) (current-child)
+ (let* ((layout-list (frame-data-slot (current-child) :fast-layout))
(first-layout (ensure-function (first layout-list)))
(second-layout (ensure-function (second layout-list))))
(setf layout (if (eql layout first-layout)
@@ -137,10 +137,10 @@
(defun push-in-fast-layout-list ()
"Push the current layout in the fast layout list"
- (when (frame-p *current-child*)
- (setf (frame-data-slot *current-child* :fast-layout)
- (list (frame-layout *current-child*)
- (first (frame-data-slot *current-child* :fast-layout))))
+ (when (frame-p (current-child))
+ (setf (frame-data-slot (current-child) :fast-layout)
+ (list (frame-layout (current-child))
+ (first (frame-data-slot (current-child) :fast-layout))))
(leave-second-mode)))
@@ -208,25 +208,25 @@
;;; Tile layout
(defun tile-layout-ask-keep-position ()
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(if (query-yes-or-no "Keep frame children positions?")
- (setf (frame-data-slot *current-child* :tile-layout-keep-position) :yes)
- (remove-frame-data-slot *current-child* :tile-layout-keep-position))))
+ (setf (frame-data-slot (current-child) :tile-layout-keep-position) :yes)
+ (remove-frame-data-slot (current-child) :tile-layout-keep-position))))
(labels ((set-managed ()
- (setf (frame-data-slot *current-child* :layout-managed-children)
- (copy-list (get-managed-child *current-child*)))))
+ (setf (frame-data-slot (current-child) :layout-managed-children)
+ (copy-list (get-managed-child (current-child))))))
(defun set-layout-managed-children ()
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(set-managed)
(tile-layout-ask-keep-position)))
(defun update-layout-managed-children-position ()
"Update layout managed children position"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(set-managed)
(leave-second-mode))))
@@ -573,9 +573,9 @@
;;; Left and space layout: like left layout but leave a space on the left
(defun layout-ask-space (msg slot &optional (default 100))
- (when (frame-p *current-child*)
- (let ((new-space (or (query-number msg (or (frame-data-slot *current-child* slot) default)) default)))
- (setf (frame-data-slot *current-child* slot) new-space))))
+ (when (frame-p (current-child))
+ (let ((new-space (or (query-number msg (or (frame-data-slot (current-child) slot) default)) default)))
+ (setf (frame-data-slot (current-child) slot) new-space))))
(defun tile-left-space-layout (child parent)
@@ -734,26 +734,26 @@
(defun add-in-main-window-list ()
"Add the current window in the main window list"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(with-current-window
- (when (child-member window (get-managed-child *current-child*))
- (pushnew window (frame-data-slot *current-child* :main-window-list)))))
+ (when (child-member window (get-managed-child (current-child)))
+ (pushnew window (frame-data-slot (current-child) :main-window-list)))))
(leave-second-mode))
(defun remove-in-main-window-list ()
"Remove the current window from the main window list"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(with-current-window
- (when (child-member window (get-managed-child *current-child*))
- (setf (frame-data-slot *current-child* :main-window-list)
- (child-remove window (frame-data-slot *current-child* :main-window-list))))))
+ (when (child-member window (get-managed-child (current-child)))
+ (setf (frame-data-slot (current-child) :main-window-list)
+ (child-remove window (frame-data-slot (current-child) :main-window-list))))))
(leave-second-mode))
(defun clear-main-window-list ()
"Clear the main window list"
- (when (frame-p *current-child*)
- (setf (frame-data-slot *current-child* :main-window-list) nil))
+ (when (frame-p (current-child))
+ (setf (frame-data-slot (current-child) :main-window-list) nil))
(leave-second-mode))
@@ -778,15 +778,15 @@
(defun select-next/previous-child-no-main-window (fun-rotate)
"Select the next/previous child - Skip windows in main window list"
- (when (frame-p *current-child*)
- (with-slots (child) *current-child*
- (let* ((main-windows (frame-data-slot *current-child* :main-window-list))
+ (when (frame-p (current-child))
+ (with-slots (child) (current-child)
+ (let* ((main-windows (frame-data-slot (current-child) :main-window-list))
(to-skip? (not (= (length main-windows)
(length child)))))
(labels ((rec ()
(setf child (funcall fun-rotate child))
(when (and to-skip?
- (child-member (frame-selected-child *current-child*) main-windows))
+ (child-member (frame-selected-child (current-child)) main-windows))
(rec))))
(unselect-all-frames)
(rec)
@@ -806,8 +806,8 @@
"Move and focus the current frame or focus the current window parent.
Or do actions on corners - Skip windows in main window list"
(unless (do-corner-action root-x root-y *corner-main-mode-left-button*)
- (if (and (frame-p *current-child*)
- (child-member window (frame-data-slot *current-child* :main-window-list)))
+ (if (and (frame-p (current-child))
+ (child-member window (frame-data-slot (current-child) :main-window-list)))
(replay-button-event)
(mouse-click-to-focus-generic root-x root-y #'move-frame))))
@@ -832,7 +832,7 @@ Or do actions on corners - Skip windows in main window list"
(defun set-gimp-layout ()
"The GIMP Layout"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
;; Note: There is no need to ungrab/grab keys because this
;; is done when leaving the second mode.
(define-main-key ("F8" :mod-1) 'add-in-main-window-list)
@@ -841,11 +841,11 @@ Or do actions on corners - Skip windows in main window list"
(define-main-key ("Tab" :mod-1) 'select-next-child-no-main-window)
(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child-no-main-window)
(define-main-mouse (1) 'mouse-click-to-focus-and-move-no-main-window)
- (setf (frame-data-slot *current-child* :focus-policy-save)
- (frame-focus-policy *current-child*))
- (setf (frame-focus-policy *current-child*) :sloppy)
- (setf (frame-data-slot *current-child* :layout-save)
- (frame-layout *current-child*))
+ (setf (frame-data-slot (current-child) :focus-policy-save)
+ (frame-focus-policy (current-child)))
+ (setf (frame-focus-policy (current-child)) :sloppy)
+ (setf (frame-data-slot (current-child) :layout-save)
+ (frame-layout (current-child)))
(open-notify-window help-text-list)
(add-timer *gimp-layout-notify-window-delay* #'close-notify-window)
;; Set the default layout and leave the second mode.
@@ -860,10 +860,10 @@ Or do actions on corners - Skip windows in main window list"
(define-main-key ("Tab" :mod-1) 'select-next-child)
(define-main-key ("Tab" :mod-1 :shift) 'select-previous-child)
(define-main-mouse (1) 'mouse-click-to-focus-and-move)
- (setf (frame-focus-policy *current-child*)
- (frame-data-slot *current-child* :focus-policy-save))
- (setf (frame-layout *current-child*)
- (frame-data-slot *current-child* :layout-save))
+ (setf (frame-focus-policy (current-child))
+ (frame-data-slot (current-child) :focus-policy-save))
+ (setf (frame-layout (current-child))
+ (frame-data-slot (current-child) :layout-save))
(leave-second-mode))
diff --git a/src/clfswm-nw-hooks.lisp b/src/clfswm-nw-hooks.lisp
index a307824..5dfc885 100644
--- a/src/clfswm-nw-hooks.lisp
+++ b/src/clfswm-nw-hooks.lisp
@@ -43,9 +43,9 @@
(defun set-nw-hook (hook)
"Set the hook of the current child"
- (let ((frame (if (xlib:window-p *current-child*)
- (find-parent-frame *current-child*)
- *current-child*)))
+ (let ((frame (if (xlib:window-p (current-child))
+ (find-parent-frame (current-child))
+ (current-child))))
(unless (or (child-member frame *permanent-nw-hook-frames*)
(child-original-root-p frame))
(setf (frame-nw-hook frame) hook)
@@ -89,10 +89,10 @@
(defun default-frame-nw-hook (frame window)
"Open the next window in the current frame"
(declare (ignore frame))
- (leave-if-not-frame *current-child*)
- (when (frame-p *current-child*)
- (pushnew window (frame-child *current-child*)))
- (default-window-placement *current-child* window)
+ (leave-if-not-frame (current-child))
+ (when (frame-p (current-child))
+ (pushnew window (frame-child (current-child))))
+ (default-window-placement (current-child) window)
t)
(defun set-default-frame-nw-hook ()
@@ -109,7 +109,7 @@
(leave-if-not-frame (find-current-root))
(let ((root (find-current-root)))
(pushnew window (frame-child root))
- (setf *current-child* (frame-selected-child root))
+ (setf (current-child) (frame-selected-child root))
(default-window-placement root window))
t)
@@ -129,7 +129,7 @@
(root (find-current-root)))
(pushnew new-frame (frame-child root))
(pushnew window (frame-child new-frame))
- (setf *current-child* new-frame)
+ (setf (current-child) new-frame)
(default-window-placement new-frame window))
t)
@@ -149,9 +149,9 @@
(pushnew new-frame (frame-child root))
(pushnew window (frame-child new-frame))
(switch-to-root-frame :show-later t)
- (setf *current-child* root)
+ (setf (current-child) root)
(set-layout-once #'tile-space-layout)
- (setf *current-child* new-frame)
+ (setf (current-child) new-frame)
(default-window-placement new-frame window))
t)
@@ -172,9 +172,9 @@
(pushnew new-frame (frame-child parent))
(pushnew window (frame-child new-frame))
(change-root (find-root parent) parent)
- (setf *current-child* parent)
+ (setf (current-child) parent)
(set-layout-once #'tile-space-layout)
- (setf *current-child* new-frame)
+ (setf (current-child) new-frame)
(default-window-placement new-frame window)
(show-all-children t)
t)))
@@ -192,12 +192,12 @@
(defun leave-focus-frame-nw-hook (frame window)
"Open the next window in the current frame and leave the focus on the current child"
(clear-nw-hook frame)
- (leave-if-not-frame *current-child*)
- (when (frame-p *current-child*)
- (with-slots (child) *current-child*
+ (leave-if-not-frame (current-child))
+ (when (frame-p (current-child))
+ (with-slots (child) (current-child)
(pushnew window child)
(setf child (rotate-list child))))
- (default-window-placement *current-child* window)
+ (default-window-placement (current-child) window)
t)
(defun set-leave-focus-frame-nw-hook ()
@@ -215,7 +215,7 @@
(pushnew window (frame-child frame))
(unless (find-child-in-all-root frame)
(change-root (find-root frame) frame))
- (setf *current-child* frame)
+ (setf (current-child) frame)
(focus-all-children window frame)
(default-window-placement frame window)
(show-all-children t)
@@ -261,7 +261,7 @@
(unless *in-process-existing-windows*
(unless (find-child-in-all-root frame)
(change-root (find-root frame) frame))
- (setf *current-child* frame)
+ (setf (current-child) frame)
(focus-all-children window frame)
(default-window-placement frame window)
(show-all-children t))
diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp
index cf525ef..7a075a9 100644
--- a/src/clfswm-pack.lisp
+++ b/src/clfswm-pack.lisp
@@ -207,7 +207,7 @@
(defun explode-current-frame ()
"Create a new frame for each window in frame"
- (explode-frame *current-child*)
+ (explode-frame (current-child))
(leave-second-mode))
@@ -223,7 +223,7 @@
(defun implode-current-frame ()
"Absorb all frames subchildren in frame (explode frame opposite)"
- (implode-frame *current-child*)
+ (implode-frame (current-child))
(leave-second-mode))
diff --git a/src/clfswm-placement.lisp b/src/clfswm-placement.lisp
index 4c4ccb0..8aa4c0b 100644
--- a/src/clfswm-placement.lisp
+++ b/src/clfswm-placement.lisp
@@ -106,15 +106,15 @@
;;; Current child placement
;;;
(defun current-child-coord ()
- (typecase *current-child*
- (xlib:window (values (x-drawable-x *current-child*)
- (x-drawable-y *current-child*)
- (x-drawable-width *current-child*)
- (x-drawable-height *current-child*)))
- (frame (values (frame-rx *current-child*)
- (frame-ry *current-child*)
- (frame-rw *current-child*)
- (frame-rh *current-child*)))
+ (typecase (current-child)
+ (xlib:window (values (x-drawable-x (current-child))
+ (x-drawable-y (current-child))
+ (x-drawable-width (current-child))
+ (x-drawable-height (current-child))))
+ (frame (values (frame-rx (current-child))
+ (frame-ry (current-child))
+ (frame-rw (current-child))
+ (frame-rh (current-child))))
(t (values 0 0 10 10))))
(defmacro with-current-child-coord ((x y w h) &body body)
diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp
index 34cebcc..8bc4c62 100644
--- a/src/clfswm-util.lisp
+++ b/src/clfswm-util.lisp
@@ -72,11 +72,36 @@
+(defun banish-pointer ()
+ "Move the pointer to the lower right corner of the screen"
+ (with-placement (*banish-pointer-placement* x y)
+ (xlib:warp-pointer *root* x y)))
+
+
+(defun place-window-from-hints (window)
+ "Place a window from its hints"
+ (let* ((hints (xlib:wm-normal-hints window))
+ (min-width (or (and hints (xlib:wm-size-hints-min-width hints)) 0))
+ (min-height (or (and hints (xlib:wm-size-hints-min-height hints)) 0))
+ (max-width (or (and hints (xlib:wm-size-hints-max-width hints)) (x-drawable-width *root*)))
+ (max-height (or (and hints (xlib:wm-size-hints-max-height hints)) (x-drawable-height *root*)))
+ (rwidth (or (and hints (or (xlib:wm-size-hints-width hints) (xlib:wm-size-hints-base-width hints)))
+ (x-drawable-width window)))
+ (rheight (or (and hints (or (xlib:wm-size-hints-height hints) (xlib:wm-size-hints-base-height hints)))
+ (x-drawable-height window))))
+ (setf (x-drawable-width window) (min (max min-width rwidth *default-window-width*) max-width)
+ (x-drawable-height window) (min (max min-height rheight *default-window-height*) max-height))
+ (with-placement (*unmanaged-window-placement* x y (x-drawable-width window) (x-drawable-height window))
+ (setf (x-drawable-x window) x
+ (x-drawable-y window) y))
+ (xlib:display-finish-output *display*)))
+
+
(defun rename-current-child ()
"Rename the current child"
- (let ((name (query-string (format nil "New child name: (last: ~A)" (child-name *current-child*))
- (child-name *current-child*))))
- (rename-child *current-child* name)
+ (let ((name (query-string (format nil "New child name: (last: ~A)" (child-name (current-child)))
+ (child-name (current-child)))))
+ (rename-child (current-child) name)
(leave-second-mode)))
@@ -90,16 +115,16 @@
(defun set-current-child-transparency ()
"Set the current child transparency"
- (ask-child-transparency "child" *current-child*)
+ (ask-child-transparency "child" (current-child))
(leave-second-mode))
(defun renumber-current-frame ()
"Renumber the current frame"
- (when (frame-p *current-child*)
- (let ((number (query-number (format nil "New child number: (last: ~A)" (frame-number *current-child*))
- (frame-number *current-child*))))
- (setf (frame-number *current-child*) number)
+ (when (frame-p (current-child))
+ (let ((number (query-number (format nil "New child number: (last: ~A)" (frame-number (current-child)))
+ (frame-number (current-child)))))
+ (setf (frame-number (current-child)) number)
(leave-second-mode))))
@@ -107,22 +132,22 @@
(defun add-default-frame ()
"Add a default frame in the current frame"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(let ((name (query-string "Frame name")))
- (push (create-frame :name name) (frame-child *current-child*))))
+ (push (create-frame :name name) (frame-child (current-child)))))
(leave-second-mode))
(defun add-frame-in-parent-frame ()
"Add a frame in the parent frame (and reorganize parent frame)"
- (let ((parent (find-parent-frame *current-child*)))
- (when (and parent (not (child-original-root-p *current-child*)))
+ (let ((parent (find-parent-frame (current-child))))
+ (when (and parent (not (child-original-root-p (current-child))))
(let ((new-frame (create-frame)))
(pushnew new-frame (frame-child parent))
- (awhen (child-root-p *current-child*)
+ (awhen (child-root-p (current-child))
(change-root it parent))
- (setf *current-child* parent)
+ (setf (current-child) parent)
(set-layout-once #'tile-space-layout)
- (setf *current-child* new-frame)
+ (setf (current-child) new-frame)
(leave-second-mode)))))
@@ -130,22 +155,22 @@
(defun add-placed-frame ()
"Add a placed frame in the current frame"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(let ((name (query-string "Frame name"))
(x (/ (query-number "Frame x in percent (%)") 100))
(y (/ (query-number "Frame y in percent (%)") 100))
(w (/ (query-number "Frame width in percent (%)" 100) 100))
(h (/ (query-number "Frame height in percent (%)" 100) 100)))
(push (create-frame :name name :x x :y y :w w :h h)
- (frame-child *current-child*))))
+ (frame-child (current-child)))))
(leave-second-mode))
(defun delete-focus-window-generic (close-fun)
(with-focus-window (window)
- (when (child-equal-p window *current-child*)
- (setf *current-child* (find-current-root)))
+ (when (child-equal-p window (current-child))
+ (setf (current-child) (find-current-root)))
(delete-child-and-children-in-all-frames window close-fun)))
(defun delete-focus-window ()
@@ -159,7 +184,7 @@
(defun remove-focus-window ()
"Remove the focus window from the current frame"
(with-focus-window (window)
- (setf *current-child* (find-current-root))
+ (setf (current-child) (find-current-root))
(hide-child window)
(remove-child-in-frame window (find-parent-frame window))
(show-all-children)))
@@ -180,7 +205,7 @@
"Return the child window under the mouse"
(let ((win *root*))
(with-all-windows-frames-and-parent (*root-frame* child parent)
- (when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+ (when (and (or (managed-window-p child parent) (child-equal-p parent (current-child)))
(not (window-hidden-p child))
(in-window child x y))
(setf win child))
@@ -208,7 +233,7 @@
(let ((ret nil))
(with-all-windows-frames-and-parent (*root-frame* child parent)
(when (and (not (window-hidden-p child))
- (or (managed-window-p child parent) (child-equal-p parent *current-child*))
+ (or (managed-window-p child parent) (child-equal-p parent (current-child)))
(in-window child x y))
(if first-foundp
(return-from find-child-under-mouse-in-child-tree child)
@@ -238,54 +263,54 @@
(defun copy-current-child ()
"Copy the current child to the selection"
- (pushnew *current-child* *child-selection*)
+ (pushnew (current-child) *child-selection*)
(display-all-root-frame-info))
(defun cut-current-child (&optional (show-now t))
"Cut the current child to the selection"
- (unless (child-root-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
- (hide-all *current-child*)
+ (unless (child-root-p (current-child))
+ (let ((parent (find-parent-frame (current-child))))
+ (hide-all (current-child))
(copy-current-child)
- (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
+ (remove-child-in-frame (current-child) (find-parent-frame (current-child) (find-current-root)))
(when parent
- (setf *current-child* parent))
+ (setf (current-child) parent))
(when show-now
(show-all-children t))
- *current-child*)))
+ (current-child))))
(defun remove-current-child ()
"Remove the current child from its parent frame"
- (unless (child-root-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
- (hide-all *current-child*)
- (remove-child-in-frame *current-child* (find-parent-frame *current-child* (find-current-root)))
+ (unless (child-root-p (current-child))
+ (let ((parent (find-parent-frame (current-child))))
+ (hide-all (current-child))
+ (remove-child-in-frame (current-child) (find-parent-frame (current-child) (find-current-root)))
(when parent
- (setf *current-child* parent))
+ (setf (current-child) parent))
(show-all-children t)
(leave-second-mode))))
(defun delete-current-child ()
"Delete the current child and its children in all frames"
- (unless (child-root-p *current-child*)
- (hide-all *current-child*)
- (delete-child-and-children-in-all-frames *current-child*)
+ (unless (child-root-p (current-child))
+ (hide-all (current-child))
+ (delete-child-and-children-in-all-frames (current-child))
(show-all-children t)
(leave-second-mode)))
(defun paste-selection-no-clear ()
"Paste the selection in the current frame - Do not clear the selection after paste"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(dolist (child *child-selection*)
- (unless (find-child-in-parent child *current-child*)
- (pushnew child (frame-child *current-child*) :test #'child-equal-p)))
+ (unless (find-child-in-parent child (current-child))
+ (pushnew child (frame-child (current-child)) :test #'child-equal-p)))
(show-all-children)))
(defun paste-selection ()
"Paste the selection in the current frame"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(paste-selection-no-clear)
(setf *child-selection* nil)
(display-all-root-frame-info)))
@@ -294,14 +319,14 @@
(defun copy-focus-window ()
"Copy the focus window to the selection"
(with-focus-window (window)
- (let ((*current-child* window))
+ (with-current-child (window)
(copy-current-child))))
(defun cut-focus-window ()
"Cut the focus window to the selection"
(with-focus-window (window)
- (setf *current-child* (let ((*current-child* window))
+ (setf (current-child) (with-current-child (window)
(cut-current-child nil)))
(show-all-children t)))
@@ -313,15 +338,15 @@
;;; Maximize function
(defun frame-toggle-maximize ()
"Maximize/Unmaximize the current frame in its parent frame"
- (when (frame-p *current-child*)
- (let ((unmaximized-coords (frame-data-slot *current-child* :unmaximized-coords)))
+ (when (frame-p (current-child))
+ (let ((unmaximized-coords (frame-data-slot (current-child) :unmaximized-coords)))
(if unmaximized-coords
- (with-slots (x y w h) *current-child*
+ (with-slots (x y w h) (current-child)
(destructuring-bind (nx ny nw nh) unmaximized-coords
- (setf (frame-data-slot *current-child* :unmaximized-coords) nil
+ (setf (frame-data-slot (current-child) :unmaximized-coords) nil
x nx y ny w nw h nh)))
- (with-slots (x y w h) *current-child*
- (setf (frame-data-slot *current-child* :unmaximized-coords)
+ (with-slots (x y w h) (current-child)
+ (setf (frame-data-slot (current-child) :unmaximized-coords)
(list x y w h)
x 0 y 0 w 1 h 1))))
(show-all-children)
@@ -493,8 +518,8 @@
(defun delete-frame-by (frame)
(unless (or (child-equal-p frame *root-frame*)
(child-root-p frame))
- (when (child-equal-p frame *current-child*)
- (setf *current-child* (find-current-root)))
+ (when (child-equal-p frame (current-child))
+ (setf (current-child) (find-current-root)))
(remove-child-in-frame frame (find-parent-frame frame)))
(show-all-children t))
@@ -520,16 +545,16 @@
(defun move-current-child-by-name ()
"Move current child in a named frame"
- (move-child-to *current-child*
+ (move-child-to (current-child)
(find-frame-by-name
- (ask-frame-name (format nil "Move '~A' to frame: " (child-name *current-child*)))))
+ (ask-frame-name (format nil "Move '~A' to frame: " (child-name (current-child))))))
(leave-second-mode))
(defun move-current-child-by-number ()
"Move current child in a numbered frame"
- (move-child-to *current-child*
+ (move-child-to (current-child)
(find-frame-by-number
- (query-number (format nil "Move '~A' to frame numbered:" (child-name *current-child*)))))
+ (query-number (format nil "Move '~A' to frame numbered:" (child-name (current-child))))))
(leave-second-mode))
@@ -542,16 +567,16 @@
(defun copy-current-child-by-name ()
"Copy current child in a named frame"
- (copy-child-to *current-child*
+ (copy-child-to (current-child)
(find-frame-by-name
- (ask-frame-name (format nil "Copy '~A' to frame: " (child-name *current-child*)))))
+ (ask-frame-name (format nil "Copy '~A' to frame: " (child-name (current-child))))))
(leave-second-mode))
(defun copy-current-child-by-number ()
"Copy current child in a numbered frame"
- (copy-child-to *current-child*
+ (copy-child-to (current-child)
(find-frame-by-number
- (query-number (format nil "Copy '~A' to frame numbered:" (child-name *current-child*)))))
+ (query-number (format nil "Copy '~A' to frame numbered:" (child-name (current-child))))))
(leave-second-mode))
@@ -610,7 +635,7 @@ mouse-fun is #'move-frame or #'resize-frame"
(setf parent child
child (create-frame)
mouse-fn #'resize-frame
- *current-child* child)
+ (current-child) child)
(place-frame child parent root-x root-y 10 10)
(map-window (frame-window child))
(pushnew child (frame-child parent)))))
@@ -758,7 +783,7 @@ For window: set current child to window or its parent according to window-parent
(current-slot 1))
(defun bind-on-slot (&optional (slot current-slot))
"Bind current child to slot"
- (setf (aref key-slots slot) *current-child*))
+ (setf (aref key-slots slot) (current-child)))
(defun remove-binding-on-slot ()
"Remove binding on slot"
@@ -770,19 +795,19 @@ For window: set current child to window or its parent according to window-parent
(when (find-child jump-child *root-frame*)
(unless (find-child-in-all-root jump-child)
(change-root (find-root jump-child) jump-child))
- (setf *current-child* jump-child)
- (focus-all-children *current-child* *current-child*)
+ (setf (current-child) jump-child)
+ (focus-all-children (current-child) (current-child))
(show-all-children t))))
(defun bind-or-jump (n)
"Bind or jump to a slot (a frame or a window)"
(setf current-slot (- n 1))
(let ((default-bind `("b" bind-on-slot
- ,(format nil "Bind slot ~A on child: ~A" n (child-fullname *current-child*)))))
+ ,(format nil "Bind slot ~A on child: ~A" n (child-fullname (current-child))))))
(info-mode-menu (aif (aref key-slots current-slot)
`(,default-bind
("BackSpace" remove-binding-on-slot
- ,(format nil "Remove slot ~A binding on child: ~A" n (child-fullname *current-child*)))
+ ,(format nil "Remove slot ~A binding on child: ~A" n (child-fullname (current-child))))
(" - " nil " -")
("Tab" jump-to-slot
,(format nil "Jump to child: ~A" (aif (aref key-slots current-slot)
@@ -798,7 +823,7 @@ For window: set current child to window or its parent according to window-parent
;;; Useful function for the second mode ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmacro with-movement (&body body)
- `(when (frame-p *current-child*)
+ `(when (frame-p (current-child))
, at body
(show-all-children)
(display-all-frame-info)
@@ -809,90 +834,90 @@ For window: set current child to window or its parent according to window-parent
;;; Pack
(defun current-frame-pack-up ()
"Pack the current frame up"
- (with-movement (pack-frame-up *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (pack-frame-up (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-pack-down ()
"Pack the current frame down"
- (with-movement (pack-frame-down *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (pack-frame-down (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-pack-left ()
"Pack the current frame left"
- (with-movement (pack-frame-left *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (pack-frame-left (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-pack-right ()
"Pack the current frame right"
- (with-movement (pack-frame-right *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (pack-frame-right (current-child) (find-parent-frame (current-child) (find-current-root)))))
;;; Center
(defun center-current-frame ()
"Center the current frame"
- (with-movement (center-frame *current-child*)))
+ (with-movement (center-frame (current-child))))
;;; Fill
(defun current-frame-fill-up ()
"Fill the current frame up"
- (with-movement (fill-frame-up *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (fill-frame-up (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-fill-down ()
"Fill the current frame down"
- (with-movement (fill-frame-down *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (fill-frame-down (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-fill-left ()
"Fill the current frame left"
- (with-movement (fill-frame-left *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (fill-frame-left (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-fill-right ()
"Fill the current frame right"
- (with-movement (fill-frame-right *current-child* (find-parent-frame *current-child* (find-current-root)))))
+ (with-movement (fill-frame-right (current-child) (find-parent-frame (current-child) (find-current-root)))))
(defun current-frame-fill-all-dir ()
"Fill the current frame in all directions"
(with-movement
- (let ((parent (find-parent-frame *current-child* (find-current-root))))
- (fill-frame-up *current-child* parent)
- (fill-frame-down *current-child* parent)
- (fill-frame-left *current-child* parent)
- (fill-frame-right *current-child* parent))))
+ (let ((parent (find-parent-frame (current-child) (find-current-root))))
+ (fill-frame-up (current-child) parent)
+ (fill-frame-down (current-child) parent)
+ (fill-frame-left (current-child) parent)
+ (fill-frame-right (current-child) parent))))
(defun current-frame-fill-vertical ()
"Fill the current frame vertically"
(with-movement
- (let ((parent (find-parent-frame *current-child* (find-current-root))))
- (fill-frame-up *current-child* parent)
- (fill-frame-down *current-child* parent))))
+ (let ((parent (find-parent-frame (current-child) (find-current-root))))
+ (fill-frame-up (current-child) parent)
+ (fill-frame-down (current-child) parent))))
(defun current-frame-fill-horizontal ()
"Fill the current frame horizontally"
(with-movement
- (let ((parent (find-parent-frame *current-child* (find-current-root))))
- (fill-frame-left *current-child* parent)
- (fill-frame-right *current-child* parent))))
+ (let ((parent (find-parent-frame (current-child) (find-current-root))))
+ (fill-frame-left (current-child) parent)
+ (fill-frame-right (current-child) parent))))
;;; Resize
(defun current-frame-resize-up ()
"Resize the current frame up to its half height"
- (with-movement (resize-half-height-up *current-child*)))
+ (with-movement (resize-half-height-up (current-child))))
(defun current-frame-resize-down ()
"Resize the current frame down to its half height"
- (with-movement (resize-half-height-down *current-child*)))
+ (with-movement (resize-half-height-down (current-child))))
(defun current-frame-resize-left ()
"Resize the current frame left to its half width"
- (with-movement (resize-half-width-left *current-child*)))
+ (with-movement (resize-half-width-left (current-child))))
(defun current-frame-resize-right ()
"Resize the current frame right to its half width"
- (with-movement (resize-half-width-right *current-child*)))
+ (with-movement (resize-half-width-right (current-child))))
(defun current-frame-resize-all-dir ()
"Resize down the current frame"
- (with-movement (resize-frame-down *current-child*)))
+ (with-movement (resize-frame-down (current-child))))
(defun current-frame-resize-all-dir-minimal ()
"Resize down the current frame to its minimal size"
- (with-movement (resize-minimal-frame *current-child*)))
+ (with-movement (resize-minimal-frame (current-child))))
;;; Children navigation
@@ -921,17 +946,17 @@ For window: set current child to window or its parent according to window-parent
;;; Adapt frame functions
(defun adapt-current-frame-to-window-hints-generic (width-p height-p)
"Adapt the current frame to the current window minimal size hints"
- (when (frame-p *current-child*)
- (let ((window (first (frame-child *current-child*))))
+ (when (frame-p (current-child))
+ (let ((window (first (frame-child (current-child)))))
(when (xlib:window-p window)
(let* ((hints (xlib:wm-normal-hints window))
(min-width (and hints (xlib:wm-size-hints-min-width hints)))
(min-height (and hints (xlib:wm-size-hints-min-height hints))))
(when (and width-p min-width)
- (setf (frame-rw *current-child*) min-width))
+ (setf (frame-rw (current-child)) min-width))
(when (and height-p min-height)
- (setf (frame-rh *current-child*) min-height))
- (fixe-real-size *current-child* (find-parent-frame *current-child*))
+ (setf (frame-rh (current-child)) min-height))
+ (fixe-real-size (current-child) (find-parent-frame (current-child)))
(leave-second-mode))))))
(defun adapt-current-frame-to-window-hints ()
@@ -951,18 +976,18 @@ For window: set current child to window or its parent according to window-parent
;;; Managed window type functions
(defun current-frame-manage-window-type-generic (type-list)
- (when (frame-p *current-child*)
- (setf (frame-managed-type *current-child*) type-list
- (frame-forced-managed-window *current-child*) nil
- (frame-forced-unmanaged-window *current-child*) nil))
+ (when (frame-p (current-child))
+ (setf (frame-managed-type (current-child)) type-list
+ (frame-forced-managed-window (current-child)) nil
+ (frame-forced-unmanaged-window (current-child)) nil))
(leave-second-mode))
(defun current-frame-manage-window-type ()
"Change window types to be managed by a frame"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(let* ((type-str (query-string "Managed window type: (all, normal, transient, maxsize, desktop, dock, toolbar, menu, utility, splash, dialog)"
- (format nil "~{~:(~A~) ~}" (frame-managed-type *current-child*))))
+ (format nil "~{~:(~A~) ~}" (frame-managed-type (current-child)))))
(type-list (loop :for type :in (split-string type-str)
:collect (intern (string-upcase type) :keyword))))
(current-frame-manage-window-type-generic type-list))))
@@ -1081,32 +1106,32 @@ For window: set current child to window or its parent according to window-parent
(defun hide/show-frame-window (frame value)
"Hide/show the frame window"
(when (frame-p frame)
- (setf (frame-show-window-p *current-child*) value)
+ (setf (frame-show-window-p (current-child)) value)
(show-all-children))
(leave-second-mode))
(defun hide-current-frame-window ()
"Hide the current frame window"
- (hide/show-frame-window *current-child* nil))
+ (hide/show-frame-window (current-child) nil))
(defun show-current-frame-window ()
"Show the current frame window"
- (hide/show-frame-window *current-child* t))
+ (hide/show-frame-window (current-child) t))
;;; Hide/Unhide current child
(defun hide-current-child ()
"Hide the current child"
- (unless (child-root-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
+ (unless (child-root-p (current-child))
+ (let ((parent (find-parent-frame (current-child))))
(when (frame-p parent)
(with-slots (child hidden-children) parent
- (hide-all *current-child*)
- (setf child (child-remove *current-child* child))
- (pushnew *current-child* hidden-children)
- (setf *current-child* parent))
+ (hide-all (current-child))
+ (setf child (child-remove (current-child) child))
+ (pushnew (current-child) hidden-children)
+ (setf (current-child) parent))
(show-all-children)))
(leave-second-mode)))
@@ -1122,14 +1147,14 @@ For window: set current child to window or its parent according to window-parent
(defun unhide-a-child ()
"Unhide a child in the current frame"
- (when (frame-p *current-child*)
- (with-slots (child hidden-children) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child hidden-children) (current-child)
(info-mode-menu (loop :for i :from 0
:for hidden :in hidden-children
:collect (list (code-char (+ (char-code #\a) i))
(let ((lhd hidden))
(lambda ()
- (frame-unhide-child lhd *current-child* *current-child*)))
+ (frame-unhide-child lhd (current-child) (current-child))))
(format nil "Unhide ~A" (child-fullname hidden))))))
(show-all-children))
(leave-second-mode))
@@ -1137,8 +1162,8 @@ For window: set current child to window or its parent according to window-parent
(defun unhide-all-children ()
"Unhide all current frame hidden children"
- (when (frame-p *current-child*)
- (with-slots (child hidden-children) *current-child*
+ (when (frame-p (current-child))
+ (with-slots (child hidden-children) (current-child)
(dolist (c hidden-children)
(pushnew c child))
(setf hidden-children nil))
@@ -1148,7 +1173,7 @@ For window: set current child to window or its parent according to window-parent
(defun unhide-a-child-from-all-frames ()
"Unhide a child from all frames in the current frame"
- (when (frame-p *current-child*)
+ (when (frame-p (current-child))
(let ((acc nil)
(keynum -1))
(with-all-frames (*root-frame* frame)
@@ -1158,7 +1183,7 @@ For window: set current child to window or its parent according to window-parent
(push (list (code-char (+ (char-code #\a) (incf keynum)))
(let ((lhd hidden))
(lambda ()
- (frame-unhide-child lhd frame *current-child*)))
+ (frame-unhide-child lhd frame (current-child))))
(format nil "Unhide ~A" (child-fullname hidden)))
acc))))
(info-mode-menu (nreverse acc)))
@@ -1174,11 +1199,11 @@ For window: set current child to window or its parent according to window-parent
(setf last-child nil))
(defun switch-to-last-child ()
"Store the current child and switch to the previous one"
- (let ((current-child *current-child*))
+ (let ((current-child (current-child)))
(when last-child
(change-root (find-root last-child) last-child)
- (setf *current-child* last-child)
- (focus-all-children *current-child* *current-child*)
+ (setf (current-child) last-child)
+ (focus-all-children (current-child) (current-child))
(show-all-children t))
(setf last-child current-child))
(leave-second-mode)))
@@ -1191,8 +1216,8 @@ For window: set current child to window or its parent according to window-parent
;;; Focus policy functions
(defun set-focus-policy-generic (focus-policy)
- (when (frame-p *current-child*)
- (setf (frame-focus-policy *current-child*) focus-policy))
+ (when (frame-p (current-child))
+ (setf (frame-focus-policy (current-child)) focus-policy))
(leave-second-mode))
@@ -1420,20 +1445,20 @@ For window: set current child to window or its parent according to window-parent
;;; Hide or show unmanaged windows utility.
(defun set-hide-unmanaged-window ()
"Hide unmanaged windows when frame is not selected"
- (when (frame-p *current-child*)
- (setf (frame-data-slot *current-child* :unmanaged-window-action) :hide)
+ (when (frame-p (current-child))
+ (setf (frame-data-slot (current-child) :unmanaged-window-action) :hide)
(leave-second-mode)))
(defun set-show-unmanaged-window ()
"Show unmanaged windows when frame is not selected"
- (when (frame-p *current-child*)
- (setf (frame-data-slot *current-child* :unmanaged-window-action) :show)
+ (when (frame-p (current-child))
+ (setf (frame-data-slot (current-child) :unmanaged-window-action) :show)
(leave-second-mode)))
(defun set-default-hide-unmanaged-window ()
"Set default behaviour to hide or not unmanaged windows when frame is not selected"
- (when (frame-p *current-child*)
- (setf (frame-data-slot *current-child* :unmanaged-window-action) nil)
+ (when (frame-p (current-child))
+ (setf (frame-data-slot (current-child) :unmanaged-window-action) nil)
(leave-second-mode)))
(defun set-globally-hide-unmanaged-window ()
@@ -1584,8 +1609,8 @@ For window: set current child to window or its parent according to window-parent
:font font
:line-style :solid))
(setf (window-transparency window) *notify-window-transparency*)
- (when (frame-p *current-child*)
- (setf current-child *current-child*))
+ (when (frame-p (current-child))
+ (setf current-child (current-child)))
(push (list #'is-notify-window-p 'raise-window) *never-managed-window-list*)
(map-window window)
(refresh-notify-window)
@@ -1610,7 +1635,7 @@ For window: set current child to window or its parent according to window-parent
(return win)))))
(if window
(let ((parent (find-parent-frame window)))
- (setf *current-child* parent)
+ (setf (current-child) parent)
(put-child-on-top window parent)
(when maximized
(change-root (find-root parent) parent))
@@ -1661,22 +1686,22 @@ For window: set current child to window or its parent according to window-parent
;;; Geometry change functions
(defun swap-frame-geometry ()
"Swap current brother frame geometry"
- (when (frame-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
+ (when (frame-p (current-child))
+ (let ((parent (find-parent-frame (current-child))))
(when (frame-p parent)
(let ((brother (second (frame-child parent))))
(when (frame-p brother)
- (rotatef (frame-x *current-child*) (frame-x brother))
- (rotatef (frame-y *current-child*) (frame-y brother))
- (rotatef (frame-w *current-child*) (frame-w brother))
- (rotatef (frame-h *current-child*) (frame-h brother))
+ (rotatef (frame-x (current-child)) (frame-x brother))
+ (rotatef (frame-y (current-child)) (frame-y brother))
+ (rotatef (frame-w (current-child)) (frame-w brother))
+ (rotatef (frame-h (current-child)) (frame-h brother))
(show-all-children t)
(leave-second-mode)))))))
(defun rotate-frame-geometry-generic (fun)
"(Rotate brother frame geometry"
- (when (frame-p *current-child*)
- (let ((parent (find-parent-frame *current-child*)))
+ (when (frame-p (current-child))
+ (let ((parent (find-parent-frame (current-child))))
(when (frame-p parent)
(let* ((child-list (funcall fun (frame-child parent)))
(first (first child-list)))
diff --git a/src/clfswm.lisp b/src/clfswm.lisp
index acb0a47..2cf7718 100644
--- a/src/clfswm.lisp
+++ b/src/clfswm.lisp
@@ -72,7 +72,7 @@
(case stack-mode
(:above
(unless (null-size-window-p window)
- (when (or (child-equal-p window *current-child*)
+ (when (or (child-equal-p window (current-child))
(is-in-current-child-p window))
(raise-window window)
(focus-window window)
@@ -113,12 +113,12 @@
(define-handler main-mode :enter-notify (window root-x root-y)
(unless (and (> root-x (- (xlib:screen-width *screen*) 3))
(> root-y (- (xlib:screen-height *screen*) 3)))
- (case (if (frame-p *current-child*)
- (frame-focus-policy *current-child*)
+ (case (if (frame-p (current-child))
+ (frame-focus-policy (current-child))
*default-focus-policy*)
(:sloppy (focus-window window))
- (:sloppy-strict (when (and (frame-p *current-child*)
- (child-member window (frame-child *current-child*)))
+ (:sloppy-strict (when (and (frame-p (current-child))
+ (child-member window (frame-child (current-child))))
(focus-window window)))
(:sloppy-select (let* ((child (find-child-under-mouse root-x root-y))
(parent (find-parent-frame child)))
@@ -126,7 +126,7 @@
(equal (typecase child
(xlib:window parent)
(t child))
- *current-child*))
+ (current-child)))
(focus-all-children child parent)
(show-all-children)))))))
@@ -176,7 +176,7 @@
:layout nil :x 0.05 :y 0.05
:w 0.9 :h 0.9)
*root-frame*)))
- (setf *current-child* frame)))
+ (setf (current-child) frame)))
(defun init-display ()
@@ -200,9 +200,6 @@
(clear-timers)
(map-window *no-focus-window*)
(dbg *display*)
- (dbg (xlib:display-roots *display*))
- (dbg (xlib:display-plist *display*))
- (dbg (xlib:query-extension *display* "XINERAMA"))
(setf (xlib:window-event-mask *root*) (xlib:make-event-mask :substructure-redirect
:substructure-notify
:property-change
@@ -216,7 +213,7 @@
(setf *child-selection* nil)
(setf *root-frame* (create-frame :name "Root" :number 0)
*current-root* *root-frame* ;;; PHIL: TO REMOVE
- *current-child* *root-frame*)
+ (current-child) *root-frame*)
(call-hook *init-hook*)
(unsure-at-least-one-root)
(process-existing-windows *screen*)
diff --git a/src/package.lisp b/src/package.lisp
index e4934ab..a301749 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -171,8 +171,8 @@ It is particulary useful with CLISP/MIT-CLX.")
"Root of the root - ie the root frame")
(defparameter *current-root* nil ;;; PHIL: TO REMOVE
"The current fullscreen maximized child")
-(defparameter *current-child* nil
- "The current child with the focus")
+;;(defparameter (current-child) nil ;;; PHIL: TO REMOVE
+;; "The current child with the focus")
(defparameter *main-keys* nil)
diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp
index c40a0d6..7e42730 100644
--- a/src/xlib-util.lisp
+++ b/src/xlib-util.lisp
@@ -215,12 +215,6 @@ they should be windows. So use this function to make a window out of them."
(values host num)))
-(defun banish-pointer ()
- "Move the pointer to the lower right corner of the screen"
- (with-placement (*banish-pointer-placement* x y)
- (xlib:warp-pointer *root* x y)))
-
-
;;; Transparency support
(let ((opaque #xFFFFFFFF))
(defun window-transparency (window)
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 5 +
clfswm.asd | 9 +-
contrib/osd.lisp | 2 +-
contrib/server/test.lisp | 4 +-
src/bindings-second-mode.lisp | 3 +
src/clfswm-circulate-mode.lisp | 84 +++++++----
src/clfswm-expose-mode.lisp | 8 +-
src/clfswm-internal.lisp | 179 ++++++++++++-----------
src/clfswm-layout.lisp | 104 +++++++-------
src/clfswm-nw-hooks.lisp | 38 +++---
src/clfswm-pack.lisp | 4 +-
src/clfswm-placement.lisp | 18 ++--
src/clfswm-util.lisp | 307 ++++++++++++++++++++++------------------
src/clfswm.lisp | 19 +--
src/package.lisp | 4 +-
src/xlib-util.lisp | 6 -
16 files changed, 424 insertions(+), 370 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list