[clfswm-cvs] r38 - clfswm

pbrochard at common-lisp.net pbrochard at common-lisp.net
Thu Mar 13 10:13:34 UTC 2008


Author: pbrochard
Date: Thu Mar 13 05:13:28 2008
New Revision: 38

Modified:
   clfswm/ChangeLog
   clfswm/bindings-second-mode.lisp
   clfswm/clfswm-internal.lisp
   clfswm/clfswm-keys.lisp
   clfswm/clfswm-util.lisp
Log:
force-window-in-group/force-window-center-in-group: new functions


Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Thu Mar 13 05:13:28 2008
@@ -1,3 +1,8 @@
+2008-03-13  Philippe Brochard  <hocwp at free.fr>
+
+	* clfswm-util.lisp (force-window-in-group/force-window-center-in-group):
+	new functions.
+
 2008-03-11  Philippe Brochard  <hocwp at free.fr>
 
 	* clfswm-util.lisp (identify-key): Display the documentation

Modified: clfswm/bindings-second-mode.lisp
==============================================================================
--- clfswm/bindings-second-mode.lisp	(original)
+++ clfswm/bindings-second-mode.lisp	Thu Mar 13 05:13:28 2008
@@ -107,6 +107,11 @@
 		    (#\r rename-current-child)
 		    (#\n renumber-current-group))))
 
+(defun window-menu ()
+  "Window menu"
+  (info-mode-menu '((#\i force-window-in-group)
+		    (#\c force-window-center-in-group))))
+
 
 
 (defun selection-menu ()
@@ -128,7 +133,7 @@
 (defun main-menu ()
   "Open the main menu"
   (info-mode-menu '((#\g group-menu)
-		    ;;(#\w window-menu)
+		    (#\w window-menu)
 		    (#\s selection-menu)
 		    (#\n action-by-name-menu)
 		    (#\u action-by-number-menu)

Modified: clfswm/clfswm-internal.lisp
==============================================================================
--- clfswm/clfswm-internal.lisp	(original)
+++ clfswm/clfswm-internal.lisp	Thu Mar 13 05:13:28 2008
@@ -663,7 +663,7 @@
 						(:normal 1)
 						(:maxsize 1)
 						(:transient 1)
-						(t 0)))
+						(t 1)))
     (grab-all-buttons window)
 ;;    (when (group-p *current-child*) ;; PHIL: Remove this!!!
 ;;      (setf (group-nw-hook *current-child*) #'open-in-new-group-nw-hook))

Modified: clfswm/clfswm-keys.lisp
==============================================================================
--- clfswm/clfswm-keys.lisp	(original)
+++ clfswm/clfswm-keys.lisp	Thu Mar 13 05:13:28 2008
@@ -142,8 +142,8 @@
 	   (from-string ()
 	     (let* ((modifiers (xlib:make-state-keys state))
 		    (string (keysym->keysym-name (xlib:keycode->keysym *display* code (cond  ((member :shift modifiers) 1)
-											   ((member :mod-5 modifiers) 2)
-											   (t 0))))))
+											     ((member :mod-5 modifiers) 2)
+											     (t 0))))))
 	       (function-from string))))
     (or (from-code) (from-char) (from-string))))
 

Modified: clfswm/clfswm-util.lisp
==============================================================================
--- clfswm/clfswm-util.lisp	(original)
+++ clfswm/clfswm-util.lisp	Thu Mar 13 05:13:28 2008
@@ -438,6 +438,30 @@
 
 
 
+(defun force-window-in-group ()
+  "Force the current window to move in the group (Useful only for transient windows)"
+  (when (xlib:window-p *current-child*)
+    (let ((father (find-father-group *current-child*)))
+      (with-xlib-protect
+	(setf (xlib:drawable-x *current-child*) (group-rx father)
+	      (xlib:drawable-y *current-child*) (group-ry father)))))
+  (leave-second-mode))
+
+(defun force-window-center-in-group ()
+  "Force the current window to move in the center of the group (Useful only for transient windows)"
+  (when (xlib:window-p *current-child*)
+    (let ((father (find-father-group *current-child*)))
+      (with-xlib-protect
+	(setf (xlib:drawable-x *current-child*) (truncate (+ (group-rx father)
+							     (/ (- (group-rw father)
+								   (xlib:drawable-width *current-child*)) 2)))
+	      (xlib:drawable-y *current-child*) (truncate (+ (group-ry father)
+							     (/ (- (group-rh father)
+								   (xlib:drawable-height *current-child*)) 2)))))))
+  (leave-second-mode))
+
+
+
 ;;;;;,-----
 ;;;;;| Various definitions
 ;;;;;`-----



More information about the clfswm-cvs mailing list