[clfswm-cvs] [clfswm-git]CLFSWM - A(nother) Common Lisp FullScreen Window Manager branch test updated. R-1106-54-g0b64c55
Philippe Brochard
pbrochard at common-lisp.net
Wed May 23 22:12:11 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 0b64c55b92c7212fcc2e25b9efd37dc75f608975 (commit)
from 14b6038660f7be24eae865a5b7bbdbd54956f960 (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 0b64c55b92c7212fcc2e25b9efd37dc75f608975
Author: Philippe Brochard <pbrochard at common-lisp.net>
Date: Thu May 24 00:12:05 2012 +0200
src/clfswm-internal.lisp (rotate-root-geometry): Do not use rotatef but a simpler algorithm.
diff --git a/ChangeLog b/ChangeLog
index 1aeeb18..2e2cec0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2012-05-24 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-internal.lisp (rotate-root-geometry): Do not use
+ rotatef but a simpler algorithm.
+
2012-05-19 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-placement.lisp: Adjust width and height in child and
diff --git a/contrib/toolbar.lisp b/contrib/toolbar.lisp
index facc63c..3f8c156 100644
--- a/contrib/toolbar.lisp
+++ b/contrib/toolbar.lisp
@@ -60,24 +60,26 @@
(let ((root (toolbar-root toolbar))
(placement-name (symbol-name (toolbar-placement toolbar)))
(thickness (+ (toolbar-thickness toolbar) (* 2 *border-size*))))
- (case (toolbar-direction toolbar)
- (:horiz (cond ((search "TOP" placement-name)
- (incf (root-y root) thickness)
- (decf (root-h root) thickness))
- ((search "BOTTOM" placement-name)
- (decf (root-h root) thickness))))
- (t (cond ((search "LEFT" placement-name)
- (incf (root-x root) thickness)
- (decf (root-w root) thickness))
- ((search "RIGHT" placement-name)
- (decf (root-w root) thickness))))))))
+ (when (root-p root)
+ (case (toolbar-direction toolbar)
+ (:horiz (cond ((search "TOP" placement-name)
+ (incf (root-y root) thickness)
+ (decf (root-h root) thickness))
+ ((search "BOTTOM" placement-name)
+ (decf (root-h root) thickness))))
+ (t (cond ((search "LEFT" placement-name)
+ (incf (root-x root) thickness)
+ (decf (root-w root) thickness))
+ ((search "RIGHT" placement-name)
+ (decf (root-w root) thickness)))))))))
(let ((windows-list nil))
(defun is-toolbar-window-p (win)
(and (xlib:window-p win) (member win windows-list :test 'xlib:window-equal)))
- ;; (defun refresh-toolbar-window ()
+ (defun refresh-toolbar (toolbar)
+ (dbg (toolbar-modules toolbar)))
;; (add-timer 0.1 #'refresh-toolbar-window :refresh-toolbar-window)
;; (raise-window window)
;; (let ((text-height (- (xlib:font-ascent font) (xlib:font-descent font))))
@@ -89,21 +91,21 @@
;; (* text-height i 2)
;; (text-string tx)))))
;;
- ;; (defun close-toolbar-window ()
- ;; (erase-timer :refresh-toolbar-window)
- ;; (setf *never-managed-window-list*
- ;; (remove (list #'is-toolbar-window-p 'raise-window)
- ;; *never-managed-window-list* :test #'equal))
- ;; (when gc
- ;; (xlib:free-gcontext gc))
- ;; (when window
- ;; (xlib:destroy-window window))
- ;; (when font
- ;; (xlib:close-font font))
- ;; (xlib:display-finish-output *display*)
- ;; (setf window nil
- ;; gc nil
- ;; font nil))
+ (defun close-toolbar (toolbar)
+ (erase-timer :refresh-toolbar-window)
+ (setf *never-managed-window-list*
+ (remove (list #'is-toolbar-window-p nil)
+ *never-managed-window-list* :test #'equal))
+ (awhen (toolbar-gc toolbar)
+ (xlib:free-gcontext it))
+ (awhen (toolbar-window toolbar)
+ (xlib:destroy-window it))
+ (awhen (toolbar-font toolbar)
+ (xlib:close-font it))
+ (xlib:display-finish-output *display*)
+ (setf (toolbar-window toolbar) nil
+ (toolbar-gc toolbar) nil
+ (toolbar-font toolbar) nil))
(defun open-toolbar (toolbar)
(let ((root (find-root-by-coordinates (toolbar-root-x toolbar) (toolbar-root-y toolbar))))
@@ -135,10 +137,10 @@
:line-style :solid))
(push (toolbar-window toolbar) windows-list)
(setf (window-transparency (toolbar-window toolbar)) *toolbar-window-transparency*)
- (push (list #'is-toolbar-window-p 'raise-window) *never-managed-window-list*)
+ (push (list #'is-toolbar-window-p nil) *never-managed-window-list*)
(map-window (toolbar-window toolbar))
(raise-window (toolbar-window toolbar))
- ;;(refresh-toolbar-window)
+ (refresh-toolbar toolbar)
(xlib:display-finish-output *display*))))))))
(defun open-all-toolbars ()
@@ -148,6 +150,10 @@
(dolist (toolbar *toolbar-list*)
(toolbar-adjust-root-size toolbar)))
+(defun close-all-toolbars ()
+ (dolist (toolbar *toolbar-list*)
+ (close-toolbar toolbar)))
+
(defun add-toolbar (root-x root-y direction size placement autohide &rest modules)
"Add a new toolbar.
@@ -165,6 +171,7 @@
(add-hook *init-hook* 'open-all-toolbars)
+(add-hook *close-hook* 'close-all-toolbars)
(format t "done~%")
diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp
index 61b8d20..2606087 100644
--- a/src/clfswm-internal.lisp
+++ b/src/clfswm-internal.lisp
@@ -652,20 +652,22 @@
(rotatef (root-h root-1) (root-h root-2))))
(defun rotate-root-geometry ()
- (let* ((first (first root-list))
- (len (length root-list))
- (orig-x (root-x first))
- (orig-y (root-y first))
- (orig-w (root-w first))
- (orig-h (root-h first)))
- (dotimes (i (1- len))
- (exchange-root-geometry (nth i root-list) (nth (1+ i) root-list)))
- (let ((root-1 (nth (1- len) root-list)))
- (setf (root-x root-1) orig-x)
- (setf (root-y root-1) orig-y)
- (setf (root-w root-1) orig-w)
- (setf (root-h root-1) orig-h))))
-
+ (let* ((current (first root-list))
+ (orig-x (root-x current))
+ (orig-y (root-y current))
+ (orig-w (root-w current))
+ (orig-h (root-h current)))
+ (dolist (elem (rest root-list))
+ (setf (root-x current) (root-x elem)
+ (root-y current) (root-y elem)
+ (root-w current) (root-w elem)
+ (root-h current) (root-h elem)
+ current elem))
+ (let ((last (car (last root-list))))
+ (setf (root-x last) orig-x
+ (root-y last) orig-y
+ (root-w last) orig-w
+ (root-h last) orig-h))))
(defun anti-rotate-root-geometry ()
(setf root-list (nreverse root-list))
@@ -1201,7 +1203,7 @@ XINERAMA version 1.1 opcode: 150
(defun set-current-root (child parent window-parent)
"Set current root if parent is not in current root"
(let ((root (find-root child)))
- (when (and window-parent
+ (when (and root window-parent
(not (child-root-p child))
(not (find-child parent (root-child root))))
(change-root root parent)
@@ -1239,7 +1241,7 @@ For window: set current child to window or its parent according to window-parent
(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))
+ (when (and root (not (child-equal-p (root-child root) (current-child))))
(change-root root (current-child)))
(show-all-children t)))
@@ -1305,17 +1307,19 @@ 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))))
- (change-root root (root-original root)))
- (unless show-later
- (show-all-children t)))
+ (when root
+ (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))))
- (change-root root (root-original root))
- (setf (current-child) (root-original root)))
- (unless show-later
- (show-all-children t)))
+ (when root
+ (change-root root (root-original root))
+ (setf (current-child) (root-original root)))
+ (unless show-later
+ (show-all-children t))))
(defun toggle-show-root-frame ()
@@ -1333,7 +1337,8 @@ For window: set current child to window or its parent according to window-parent
(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))))
+ (awhen (find-root child)
+ (setf (current-child) (root-child it))))
t)))
-----------------------------------------------------------------------
Summary of changes:
ChangeLog | 5 +++
contrib/toolbar.lisp | 65 +++++++++++++++++++++++++--------------------
src/clfswm-internal.lisp | 53 ++++++++++++++++++++-----------------
3 files changed, 70 insertions(+), 53 deletions(-)
hooks/post-receive
--
CLFSWM - A(nother) Common Lisp FullScreen Window Manager
More information about the clfswm-cvs
mailing list