[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-38-gd5ebccb
Philippe Brochard
pbrochard at common-lisp.net
Sun May 13 21:56:48 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 d5ebccb678ccfdeb22c419926ef05298f629fc0d (commit)
from 793638d4c961bf53cbfa04157e6f6655c2b26979 (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 d5ebccb678ccfdeb22c419926ef05298f629fc0d
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Sun May 13 23:56:42 2012 +0200
src/clfswm-internal.lisp (current-child-setter): Store root current child before apllying current child change.
diff --git a/ChangeLog b/ChangeLog
index de5e677..dd3b082 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,8 @@
* src/clfswm-internal.lisp: Remove the *current-child* variable
and use a setfable function (current-child) instead.
+ (current-child-setter): Store root current child before apllying
+ current child change.
2012-05-09 Philippe Brochard <pbrochard at common-lisp.net>
diff --git a/clfswm.asd b/clfswm.asd
index 98ef92e..edeab21 100644
--- a/clfswm.asd
+++ b/clfswm.asd
@@ -39,7 +39,8 @@
:depends-on ("package" "tools" "xlib-util" "clfswm-internal"))
(:file "clfswm-circulate-mode"
:depends-on ("xlib-util" "clfswm-keys" "clfswm-generic-mode"
- "clfswm-internal" "netwm-util" "tools" "config"))
+ "clfswm-internal" "netwm-util" "tools" "config"
+ "clfswm-placement"))
(:file "clfswm"
:depends-on ("xlib-util" "netwm-util" "clfswm-keys" "config"
"clfswm-internal" "clfswm-circulate-mode" "tools"))
@@ -47,7 +48,8 @@
:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"
"clfswm-placement"))
(:file "clfswm-expose-mode"
- :depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools" "clfswm-keys" "clfswm-generic-mode"))
+ :depends-on ("package" "config" "clfswm-internal" "xlib-util" "tools"
+ "clfswm-keys" "clfswm-generic-mode" "clfswm-placement"))
(:file "clfswm-corner"
:depends-on ("package" "config" "clfswm-internal" "clfswm-expose-mode" "xlib-util"))
(:file "clfswm-info"
diff --git a/src/clfswm-circulate-mode.lisp b/src/clfswm-circulate-mode.lisp
index 7e4be5e..e69d8a9 100644
--- a/src/clfswm-circulate-mode.lisp
+++ b/src/clfswm-circulate-mode.lisp
@@ -387,8 +387,11 @@
(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)))
+ (setf (frame-child parent) (funcall fun (frame-child parent)))
+ (let ((new-root (find-root (frame-selected-child parent))))
+ (setf (current-child) (aif (root-current-child new-root)
+ it
+ (frame-selected-child parent)))))
(show-all-children t)
(leave-second-mode))
diff --git a/src/clfswm-expose-mode.lisp b/src/clfswm-expose-mode.lisp
index 60c63b7..32cbf37 100644
--- a/src/clfswm-expose-mode.lisp
+++ b/src/clfswm-expose-mode.lisp
@@ -106,33 +106,33 @@
(third lwin))))
(defun expose-create-window (child n)
- (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)))
- "")))
- (width (if *expose-show-window-title*
- (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
- (- (child-width child) 4))
- (* (xlib:max-char-width *expose-font*) 3)))
- (height (* (xlib:font-ascent *expose-font*) 2)))
- (with-placement (*expose-mode-placement* x y width height)
- (let* ((window (xlib:create-window :parent *root*
- :x x :y y
- :width width :height height
- :background (get-color *expose-background*)
- :border-width *border-size*
- :border (get-color *expose-border*)
- :colormap (xlib:screen-default-colormap *screen*)
- :event-mask '(:exposure :key-press)))
- (gc (xlib:create-gcontext :drawable window
- :foreground (get-color *expose-foreground*)
- :background (get-color *expose-background*)
- :font *expose-font*
- :line-style :solid)))
- (setf (window-transparency window) *expose-transparency*)
- (map-window window)
- (push (list window gc string child) *expose-windows-list*)))))
+ (with-current-child (child)
+ (let* ((string (format nil "~A~A" (number->string n)
+ (if *expose-show-window-title*
+ (format nil " - ~A" (ensure-printable (child-fullname child)))
+ "")))
+ (width (if *expose-show-window-title*
+ (min (* (xlib:max-char-width *expose-font*) (+ (length string) 2))
+ (- (child-width child) 4))
+ (* (xlib:max-char-width *expose-font*) 3)))
+ (height (* (xlib:font-ascent *expose-font*) 2)))
+ (with-placement (*expose-mode-placement* x y width height)
+ (let* ((window (xlib:create-window :parent *root*
+ :x x :y y
+ :width width :height height
+ :background (get-color *expose-background*)
+ :border-width *border-size*
+ :border (get-color *expose-border*)
+ :colormap (xlib:screen-default-colormap *screen*)
+ :event-mask '(:exposure :key-press)))
+ (gc (xlib:create-gcontext :drawable window
+ :foreground (get-color *expose-foreground*)
+ :background (get-color *expose-background*)
+ :font *expose-font*
+ :line-style :solid)))
+ (setf (window-transparency window) *expose-transparency*)
+ (map-window window)
+ (push (list window gc string child) *expose-windows-list*))))))
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index d71b0ca..2e351d8 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -620,22 +620,6 @@
;; 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))
@@ -671,7 +655,7 @@
(aif (child-original-root-p child)
it
(awhen (find-parent-frame child)
- (find-root it))))
+ (find-root it))))
(defun find-child-in-all-root (child)
(dolist (root root-list)
@@ -679,7 +663,28 @@
(return-from find-child-in-all-root root))))
(defun find-current-root ()
- (root-child (find-root (current-child)))))
+ (root-child (find-root (current-child))))
+
+ (defun current-child ()
+ current-child)
+
+ (defun current-child-setter (value)
+ (let ((current-root (find-root current-child)))
+ (dolist (root root-list)
+ (when (equal root current-root)
+ (setf (root-current-child root) current-child))))
+ (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)))))
+)
(defsetf current-child current-child-setter)
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 2 +
clfswm.asd | 6 +++-
src/clfswm-circulate-mode.lisp | 7 +++-
src/clfswm-expose-mode.lisp | 54 ++++++++++++++++++++--------------------
src/clfswm-internal.lisp | 41 +++++++++++++++++-------------
5 files changed, 61 insertions(+), 49 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list