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

[pbrochard at common-lisp.net]

Author: pbrochard
Date: Sun Mar 30 07:47:57 2008
New Revision: 60

Modified:
   clfswm/ChangeLog
   clfswm/src/bindings-second-mode.lisp
   clfswm/src/clfswm-internal.lisp
   clfswm/src/clfswm-layout.lisp
   clfswm/src/clfswm-util.lisp
   clfswm/src/config.lisp
Log:
Create a new frame on the root window. (in the main mode only if *create-frame-on-root* is true)


Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Sun Mar 30 07:47:57 2008
@@ -1,3 +1,16 @@
+2008-03-30  Philippe Brochard  <hocwp at free.fr>
+
+	* src/clfswm-internal.lisp (place-frame): Place frame from real (pixel) coordinates.
+
+	* src/config.lisp (*create-frame-on-root*): New variable: Create a new frame on the
+	root window only if true.
+
+	* src/clfswm-util.lisp (mouse-click-to-focus-generic): Create a new frame on the
+	root window only if *create-frame-on-root* is true.
+
+	* src/bindings-second-mode.lisp (sm-mouse-click-to-focus-generic): Create a new frame
+	on the root window.
+
 2008-03-29  Philippe Brochard  <hocwp at free.fr>
 
 	* src/bindings-second-mode.lisp (sm-mouse-click-to-focus-generic): Focus, move and resize

Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp	(original)
+++ clfswm/src/bindings-second-mode.lisp	Sun Mar 30 07:47:57 2008
@@ -359,23 +359,29 @@
 
 
 ;;; Mouse action
-(defun sm-mouse-click-to-focus-generic (window root-x root-y fn-action)
+(defun sm-mouse-click-to-focus-generic (window root-x root-y mouse-fn)
   (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))))
+    (when (equal child *current-root*)
+      (setf child (create-frame)
+	    father *current-root*
+	    mouse-fn #'resize-frame)
+      (place-frame child father root-x root-y 10 10)
+	    (xlib:map-window (frame-window child))
+	    (pushnew child (frame-child *current-root*)))
+    (typecase child
+      (xlib:window (funcall mouse-fn father (find-father-frame father) root-x root-y))
+      (frame (funcall mouse-fn 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"
+  "Move and focus the current child - Create a new frame on the root window"
   (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"
+  "Resize and focus the current child - Create a new frame on the root window"
   (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	Sun Mar 30 07:47:57 2008
@@ -208,6 +208,18 @@
   (push frame (frame-child father)))
 
 
+(defun place-frame (frame father prx pry prw prh)
+  "Place a frame from real (pixel) coordinates"
+  (with-slots (window x y w h) frame
+    (setf (xlib:drawable-x window) prx
+	  (xlib:drawable-y window) pry
+	  (xlib:drawable-width window) prw
+	  (xlib:drawable-height window) prh
+	  x (x-px->fl prx father)
+	  y (y-px->fl pry father)
+	  w (w-px->fl prw father)
+	  h (h-px->fl prh father))))
+
 
 
 

Modified: clfswm/src/clfswm-layout.lisp
==============================================================================
--- clfswm/src/clfswm-layout.lisp	(original)
+++ clfswm/src/clfswm-layout.lisp	Sun Mar 30 07:47:57 2008
@@ -83,7 +83,7 @@
 	  (y-fl->px (frame-y child) father)
 	  (w-fl->px (frame-w child) father)
 	  (h-fl->px (frame-h child) father)
-	  :first-only))
+	  t))
 
 
 

Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp	(original)
+++ clfswm/src/clfswm-util.lisp	Sun Mar 30 07:47:57 2008
@@ -555,15 +555,26 @@
 mouse-fun is #'move-frame or #'resize-frame"
   (let ((to-replay t)
 	(child window)
-	(father (find-father-frame window *current-root*)))
-    (unless father
-      (setf child (find-frame-window window *current-root*)
-	    father (find-father-frame child *current-root*))
-      (when child
-	(funcall mouse-fn child father root-x root-y)))
-    (when (and child father (focus-all-children child father))
-      (show-all-children)
-      (setf to-replay nil))
+	(father (find-father-frame window *current-root*))
+	(root-p (or (equal window *root*)
+		    (equal window (frame-window *current-root*)))))
+    (when (or (not root-p) *create-frame-on-root*)
+      (unless father
+	(if root-p
+	    (progn
+	      (setf child (create-frame)
+		    father *current-root*
+		    mouse-fn #'resize-frame)
+	      (place-frame child father root-x root-y 10 10)
+	      (xlib:map-window (frame-window child))
+	      (pushnew child (frame-child *current-root*)))
+	    (setf child (find-frame-window window *current-root*)
+		  father (find-father-frame child *current-root*)))
+	(when child
+	  (funcall mouse-fn child father root-x root-y)))
+      (when (and child father (focus-all-children child father))
+	(show-all-children)
+	(setf to-replay nil)))
     (if to-replay
 	(replay-button-event)
 	(stop-button-event))))

Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp	(original)
+++ clfswm/src/config.lisp	Sun Mar 30 07:47:57 2008
@@ -47,6 +47,11 @@
 ;;  (values 100 100 800 600))
 
 
+;;; CONFIG
+(defparameter *create-frame-on-root* nil
+  "Set this variable to true if you want to allow to create a new frame
+on root window in the main mode")
+
 
 ;;; CONFIG: Main mode colors
 (defparameter *color-selected* "Red")