[clfswm-cvs] r59 - in clfswm: . src

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Sat Mar 29 16:23:53 2008
New Revision: 59

Modified:
   clfswm/ChangeLog
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-util.lisp
Log:
In second mode: Focus, move and resize the current child (even if it's a window).


Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sat Mar 29 16:23:53 2008
@@ -1,3 +1,8 @@
+2008-03-29  Philippe Brochard  <hocwp at free.fr>
+
+	* src/bindings-second-mode.lisp (sm-mouse-click-to-focus-generic): Focus, move and resize
+	the current child (even if it's a window).
+
 2008-03-28  Philippe Brochard  <hocwp at free.fr>
 
 	* src/clfswm-util.lisp (mouse-click-to-focus-and-move)

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Sat Mar 29 16:23:53 2008
@@ -359,23 +359,24 @@
 
 
 ;;; Mouse action
-
+(defun sm-mouse-click-to-focus-generic (window root-x root-y fn-action)
+  (declare (ignore window))
+  (let* ((child (find-child-under-mouse root-x root-y))
+	 (father (find-father-frame child)))
+    (unless (equal child *current-root*)
+      (typecase child
+	(xlib:window (funcall fn-action father (find-father-frame father) root-x root-y))
+	(frame (funcall fn-action child father root-x root-y)))
+      (focus-all-children child father nil)
+      (show-all-children))))
 
 (defun sm-mouse-click-to-focus-and-move (window root-x root-y)
   "Move and focus the current child"
-  (declare (ignore window))
-  (let ((win (find-window-under-mouse root-x root-y)))
-    (unless (equal win (frame-window *current-root*))
-      (mouse-click-to-focus-and-move win root-x root-y))))
-
+  (sm-mouse-click-to-focus-generic window root-x root-y #'move-frame))
 
 (defun sm-mouse-click-to-focus-and-resize (window root-x root-y)
   "Resize and focus the current child"
-  (declare (ignore window))
-  (let ((win (find-window-under-mouse root-x root-y)))
-    (unless (equal win (frame-window *current-root*))
-      (mouse-click-to-focus-and-resize win root-x root-y))))
-
+  (sm-mouse-click-to-focus-generic window root-x root-y #'resize-frame))
 
 
 

Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp	(original)
+++ clfswm/src/clfswm-internal.lisp	Sat Mar 29 16:23:53 2008
@@ -212,14 +212,14 @@
 
 
 
-(defun get-current-child ()
-  "Return the current focused child"
-  (unless (equal *current-child* *root-frame*)
-    (typecase *current-child*
-      (xlib:window *current-child*)
-      (frame (if (xlib:window-p (first (frame-child *current-child*)))
-		 (first (frame-child *current-child*))
-		 *current-child*)))))
+;;(defun get-current-child ()
+;;  "Return the current focused child"
+;;  (unless (equal *current-child* *root-frame*)
+;;    (typecase *current-child*
+;;      (xlib:window *current-child*)
+;;      (frame (if (xlib:window-p (first (frame-child *current-child*)))
+;;		 (first (frame-child *current-child*))
+;;		 *current-child*)))))
 
 
 (defun find-child (to-find root)
@@ -580,19 +580,19 @@
     change))
 
 
-(defgeneric set-current-child (child father))
-
-(defmethod set-current-child ((child xlib:window) father)
-  (unless (equal *current-child* father)
-    (setf *current-child* father)
-    t))
-
-(defmethod set-current-child ((child frame) father)
-  (declare (ignore father))
+(defun set-current-child-generic (child)
   (unless (equal *current-child* child)
     (setf *current-child* child)
     t))
 
+(defgeneric set-current-child (child father window-father))
+
+(defmethod set-current-child ((child xlib:window) father window-father)
+  (set-current-child-generic (if window-father father child)))
+
+(defmethod set-current-child ((child frame) father window-father)
+  (declare (ignore father window-father))
+  (set-current-child-generic child))
 
 
 (defun set-current-root (father)
@@ -601,10 +601,11 @@
     (setf *current-root* father)))
 
 
-(defun focus-all-children (child father)
-  "Focus child and its fathers - Set current frame to father"
+(defun focus-all-children (child father &optional (window-father t))
+  "Focus child and its fathers -
+For window: set current child to window or its father according to window-father"
   (let ((new-focus (focus-child-rec child father))
-	(new-current-child (set-current-child child father))
+	(new-current-child (set-current-child child father window-father))
 	(new-root (set-current-root father)))
     (or new-focus new-current-child new-root)))
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sat Mar 29 16:23:53 2008
@@ -148,6 +148,7 @@
 
 
 
+
 ;;; Selection functions
 (defun clear-selection ()
   "Clear the current selection"