[clfswm-cvs] CVS clfswm
pbrochard
pbrochard at common-lisp.net
Thu Jan 3 22:15:48 UTC 2008
Update of /project/clfswm/cvsroot/clfswm
In directory clnet:/tmp/cvs-serv16280
Modified Files:
ChangeLog bindings-second-mode.lisp clfswm-internal.lisp
clfswm.lisp tools.lisp
Log Message:
adapt window to its group in all cases
--- /project/clfswm/cvsroot/clfswm/ChangeLog 2008/01/03 20:31:24 1.13
+++ /project/clfswm/cvsroot/clfswm/ChangeLog 2008/01/03 22:15:48 1.14
@@ -1,5 +1,7 @@
2008-01-03 Philippe Brochard <hocwp at free.fr>
+ * clfswm-internal.lisp (find-window-group): New function.
+
* clfswm*: Change to make clfswm run with clisp/new-clx.
2008-01-01 Philippe Brochard <hocwp at free.fr>
--- /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/01/03 20:31:24 1.10
+++ /project/clfswm/cvsroot/clfswm/bindings-second-mode.lisp 2008/01/03 22:15:48 1.11
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 00:25:33 2008
+;;; #Date#: Thu Jan 3 23:13:40 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Bindings keys and mouse for second mode
@@ -385,6 +385,14 @@
+(defun init-motion-vars ()
+ (setf *motion-action* nil
+ *motion-object* nil
+ *motion-start-group* nil
+ *motion-dx* nil
+ *motion-dy* nil))
+
+
(let ((accept-motion t)
(selected-group nil))
(defun mouse-motion (root-x root-y)
@@ -477,10 +485,7 @@
(move-group-to *motion-object* (+ root-x *motion-dx*) (+ root-y *motion-dy*)))
(:resize-group
(resize-group *motion-object* 0 0))))
- (setf *motion-action* nil
- *motion-object* nil
- *motion-dx* nil
- *motion-dy* nil)
+ (init-motion-vars)
(select-group-under-mouse root-x root-y))
@@ -491,10 +496,7 @@
(unless (group-windows-already-in-workspace *motion-object* (current-workspace))
(add-group-in-workspace *motion-object* (current-workspace))
(move-group-to *motion-object* (+ root-x *motion-dx*) (+ root-y *motion-dy*))))
- (setf *motion-action* nil
- *motion-object* nil
- *motion-dx* nil
- *motion-dy* nil)
+ (init-motion-vars)
(select-group-under-mouse root-x root-y)
(show-all-windows-in-workspace (current-workspace)))
@@ -514,10 +516,7 @@
"Release button"
(when *motion-object*
(resize-group *motion-object* 0 0))
- (setf *motion-action* nil
- *motion-object* nil
- *motion-dx* nil
- *motion-dy* nil)
+ (init-motion-vars)
(select-group-under-mouse root-x root-y))
@@ -535,11 +534,11 @@
(defun release-move-selected-window (root-x root-y)
"Release button"
(xgrab-pointer *root* 66 67)
- (setf *motion-action* nil)
(select-group-under-mouse root-x root-y)
(when *motion-object*
(remove-window-in-group *motion-object* *motion-start-group*)
(add-window-in-group *motion-object* (current-group)))
+ (init-motion-vars)
(select-group-under-mouse root-x root-y)
(show-all-windows-in-workspace (current-workspace)))
@@ -553,11 +552,11 @@
(defun release-copy-selected-window (root-x root-y)
"Release button"
(xgrab-pointer *root* 66 67)
- (setf *motion-action* nil)
(select-group-under-mouse root-x root-y)
(when *motion-object*
(unless (window-already-in-workspace *motion-object* (current-workspace))
(add-window-in-group *motion-object* (current-group))))
+ (init-motion-vars)
(select-group-under-mouse root-x root-y)
(show-all-windows-in-workspace (current-workspace)))
--- /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/01/03 20:31:24 1.12
+++ /project/clfswm/cvsroot/clfswm/clfswm-internal.lisp 2008/01/03 22:15:48 1.13
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 00:25:14 2008
+;;; #Date#: Thu Jan 3 23:09:04 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -233,6 +233,13 @@
+(defun find-window-group (window workspace)
+ "Find the group where the window window is"
+ (dolist (group (workspace-group-list workspace))
+ (when (member window (group-window-list group))
+ (return-from find-window-group group))))
+
+
(defun get-all-windows ()
"Return a list with all known windows in all workspace"
(let ((acc nil))
--- /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/01/03 20:31:24 1.10
+++ /project/clfswm/cvsroot/clfswm/clfswm.lisp 2008/01/03 22:15:48 1.11
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Thu Jan 3 19:24:03 2008
+;;; #Date#: Thu Jan 3 23:10:41 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: Main functions
@@ -98,9 +98,9 @@
(with-state (window)
(when (has-bw value-mask)
(setf (drawable-border-width window) border-width))
- (if (member window (group-window-list (current-group)))
+ (if (window-already-in-workspace window (current-workspace))
(case (window-type window)
- (:normal (adapt-window-to-group window (current-group))
+ (:normal (adapt-window-to-group window (find-window-group window (current-workspace)))
(send-configuration-notify window))
(t (adjust-from-request)))
(adjust-from-request))
@@ -115,7 +115,7 @@
(defun handle-configure-notify (&rest event-slots)
(declare (ignore event-slots)))
-;; (adapt-all-window-in-workspace (current-workspace)))
+
--- /project/clfswm/cvsroot/clfswm/tools.lisp 2007/12/29 15:20:10 1.4
+++ /project/clfswm/cvsroot/clfswm/tools.lisp 2008/01/03 22:15:48 1.5
@@ -1,7 +1,7 @@
;;; --------------------------------------------------------------------------
;;; CLFSWM - FullScreen Window Manager
;;;
-;;; #Date#: Sat Dec 29 15:08:48 2007
+;;; #Date#: Thu Jan 3 22:53:59 2008
;;;
;;; --------------------------------------------------------------------------
;;; Documentation: General tools
@@ -31,6 +31,7 @@
(defpackage tools
(:use common-lisp)
(:export :dbg
+ :dbgnl
:setf/=
:create-symbol
:split-string
@@ -106,6 +107,23 @@
(force-output)
, at forms))
+(defmacro dbgnl (&rest forms)
+ `(progn
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ (string `(setf *%dbg-name%* ,form))
+ (number `(setf *%dbg-count%* ,form))))
+ forms)
+ (format t "~&DEBUG[~A - ~A] --------------------~%" (incf *%dbg-count%*) *%dbg-name%*)
+ ,@(mapcar #'(lambda (form)
+ (typecase form
+ ((or string number) nil)
+ (t `(format t " - ~A=~S~%" ',form ,form))))
+ forms)
+ (force-output)
+ , at forms))
+
+
More information about the clfswm-cvs
mailing list