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

Philippe Brochard pbrochard at common-lisp.net
Wed Jun 3 21:43:06 UTC 2009


Author: pbrochard
Date: Wed Jun  3 17:43:06 2009
New Revision: 232

Log:
src/clfswm-placement.lisp: New file. Allow to place info windows or query windows on an arbitrary place. Allow to bannish the pointer on an arbitrary place.

Added:
   clfswm/src/clfswm-placement.lisp
Modified:
   clfswm/ChangeLog
   clfswm/TODO
   clfswm/clfswm.asd
   clfswm/src/clfswm-circulate-mode.lisp
   clfswm/src/clfswm-info.lisp
   clfswm/src/clfswm-query.lisp
   clfswm/src/clfswm-second-mode.lisp
   clfswm/src/package.lisp
   clfswm/src/xlib-util.lisp

Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog	(original)
+++ clfswm/ChangeLog	Wed Jun  3 17:43:06 2009
@@ -1,3 +1,24 @@
+2009-06-03  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/xlib-util.lisp (banish-pointer): Use with-placement macro to
+	bannish the pointer in an arbitrary place.
+
+	* src/clfswm-info.lisp (info-mode): Use with-placement macro to
+	place the info window in an arbitrary place.
+
+	* src/clfswm-query.lisp (query-enter-function): Use with-placement
+	macro to place the query window in an arbitrary place.
+
+	* src/clfswm-placement.lisp: New file. Allow to place info windows
+	or query windows on an arbitrary place. Allow to bannish the
+	pointer on an arbitrary place.
+
+2009-05-16  Philippe Brochard  <pbrochard at common-lisp.net>
+
+	* src/clfswm-circulate-mode.lisp (reorder-child)
+	(reorder-brother): Unfocus windows before reordering children or
+	brothers.
+
 2009-05-13  Philippe Brochard  <pbrochard at common-lisp.net>
 
 	* src/clfswm-circulate-mode.lisp (reorder-brother): Ensure that

Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO	(original)
+++ clfswm/TODO	Wed Jun  3 17:43:06 2009
@@ -7,6 +7,12 @@
 ===============
 Should handle these soon.
 
+- Add a hook for banish-pointer -> by default to bottom right corner
+
+- Add a placement hook for all windows (second-mode, info-mode...)
+
+- Alt+button draw on the selected frame if in the root frame
+
 - Show config -> list and display documentation for all tweakable global variables. [Philippe]
    TODO :
    In ~/.clfswmrc:

Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd	(original)
+++ clfswm/clfswm.asd	Wed Jun  3 17:43:06 2009
@@ -17,10 +17,12 @@
 				:depends-on ("tools"))
 			 (:file "package"
 				:depends-on ("my-html" "tools" "version"))
+			 (:file "clfswm-placement"
+				:depends-on ("package"))
 			 (:file "keysyms"
 				:depends-on ("package"))
 			 (:file "xlib-util"
-				:depends-on ("package" "keysyms" "tools"))
+				:depends-on ("package" "keysyms" "tools" "clfswm-placement"))
 			 (:file "config"
 				:depends-on ("package" "xlib-util"))
 			 (:file "netwm-util"
@@ -42,18 +44,19 @@
 			 (:file "version"
 				:depends-on ("tools"))
 			 (:file "clfswm-second-mode"
-				:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"))
+				:depends-on ("package" "clfswm" "clfswm-internal" "clfswm-generic-mode"
+						       "clfswm-placement"))
 			 (:file "clfswm-corner"
 				:depends-on ("package" "config" "clfswm-internal"))
 			 (:file "clfswm-info"
 				:depends-on ("package" "version" "xlib-util" "config" "clfswm-keys" "clfswm" "clfswm-internal"
 						       "clfswm-autodoc" "clfswm-corner"
-						       "clfswm-generic-mode"))
+						       "clfswm-generic-mode" "clfswm-placement"))
 			 (:file "clfswm-menu"
 				:depends-on ("package" "clfswm-info"))
 			 (:file "clfswm-query"
 				:depends-on ("package" "config" "xlib-util" "clfswm-keys"
-						       "clfswm-generic-mode"))
+						       "clfswm-generic-mode" "clfswm-placement"))
 			 (:file "clfswm-util"
 				:depends-on ("clfswm" "keysyms" "clfswm-info" "clfswm-second-mode" "clfswm-query" "clfswm-menu" "clfswm-autodoc" "clfswm-corner"))
 			 (:file "clfswm-layout"

Modified: clfswm/src/clfswm-circulate-mode.lisp
==============================================================================
--- clfswm/src/clfswm-circulate-mode.lisp	(original)
+++ clfswm/src/clfswm-circulate-mode.lisp	Wed Jun  3 17:43:06 2009
@@ -69,6 +69,7 @@
 
 
 (defun reorder-child (direction)
+  (no-focus)
   (with-slots (child) *current-child*
     (unless *circulate-orig*
       (reset-circulate-child))
@@ -81,6 +82,7 @@
 
 
 (defun reorder-brother (direction)
+  (no-focus)
   (let ((frame-is-root? (and (equal *current-root* *current-child*)
 			     (not (equal *current-root* *root-frame*)))))
     (if frame-is-root?

Modified: clfswm/src/clfswm-info.lisp
==============================================================================
--- clfswm/src/clfswm-info.lisp	(original)
+++ clfswm/src/clfswm-info.lisp	Wed Jun  3 17:43:06 2009
@@ -188,7 +188,7 @@
 ;;;| Main mode
 ;;;`-----
 
-(defun info-mode (info-list &key (x 0) (y 0) (width nil) (height nil))
+(defun info-mode (info-list &key (width nil) (height nil))
   "Open the info mode. Info-list is a list of info: One string per line
 Or for colored output: a list (line_string color)
 Or ((1_word color) (2_word color) 3_word (4_word color)...)"
@@ -203,74 +203,77 @@
 					       (t (length l)))))))
 			 (t (length (first line)))))
 		 (t (length line)))))
-      (let* ((pointer-grabbed-p (xgrab-pointer-p))
-	     (keyboard-grabbed-p (xgrab-keyboard-p))
-	     (font (xlib:open-font *display* *info-font-string*))
+      (let* ((font (xlib:open-font *display* *info-font-string*))
 	     (ilw (xlib:max-char-width font))
 	     (ilh (+ (xlib:max-char-ascent font) (xlib:max-char-descent font) 1))
-	     (window (xlib:create-window :parent *root*
-					 :x x :y y
-					 :width (or width
-						    (min (* (+ (loop for l in info-list maximize (compute-size l)) 2) ilw)
-							 (- (xlib:screen-width *screen*) 2 x)))
-					 :height (or height
-						     (min (round (+ (* (length info-list) ilh) (/ ilh 2)))
-							  (- (xlib:screen-height *screen*) 2 y)))
-					 :background (get-color *info-background*)
-					 :colormap (xlib:screen-default-colormap *screen*)
-					 :border-width 1
-					 :border (get-color *info-border*)
-					 :event-mask '(:exposure)))
-	     (gc (xlib:create-gcontext :drawable window
-				       :foreground (get-color *info-foreground*)
-				       :background (get-color *info-background*)
-				       :font font
-				       :line-style :solid))
-	     (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
-			      :font font :ilw ilw :ilh ilh
-			      :max-x (* (loop for l in info-list maximize (compute-size l)) ilw)
-			      :max-y (* (length info-list) ilh))))
-	(labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
-		   (declare (ignore event-slots root))
-		   (funcall-key-from-code *info-keys* code state info))
-		 (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
-		   (declare (ignore event-slots))
-		   (unless (compress-motion-notify)
-		     (funcall-button-from-code *info-mouse* 'motion (modifiers->state *default-modifiers*)
-					       window root-x root-y *fun-press* (list info))))
-		 (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
-		   (declare (ignore event-slots))
-		   (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
-		 (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
-		   (declare (ignore event-slots))
-		   (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info))))
-	  (map-window window)
-	  (draw-info-window info)
-	  (xgrab-pointer *root* 68 69)
-	  (unless keyboard-grabbed-p
-	    (xgrab-keyboard *root*))
-	  (generic-mode 'exit-info-loop
-			:loop-function (lambda ()
-					 (raise-window (info-window info)))
-			:button-press-hook #'handle-button-press
-			:button-release-hook #'handle-button-release
-			:motion-notify-hook #'handle-motion-notify
-			:key-press-hook #'handle-key)
-	  (if pointer-grabbed-p
-	      (xgrab-pointer *root* 66 67)
-	      (xungrab-pointer))
-	  (unless keyboard-grabbed-p
-	    (xungrab-keyboard))
-	  (xlib:free-gcontext gc)
-	  (xlib:destroy-window window)
-	  (xlib:close-font font)
-	  (display-all-frame-info)
-	  (wait-no-key-or-button-press))))))
+	     (width (or width
+			(min (* (+ (loop for l in info-list maximize (compute-size l)) 2) ilw)
+			     (xlib:screen-width *screen*))))
+	     (height (or height
+			 (min (round (+ (* (length info-list) ilh) (/ ilh 2)))
+			      (xlib:screen-height *screen*)))))
+	(with-placement (*info-mode-placement* x y width height)
+	  (let* ((pointer-grabbed-p (xgrab-pointer-p))
+		 (keyboard-grabbed-p (xgrab-keyboard-p))
+		 (window (xlib:create-window :parent *root*
+					     :x x :y y
+					     :width width
+					     :height height
+					     :background (get-color *info-background*)
+					     :colormap (xlib:screen-default-colormap *screen*)
+					     :border-width 1
+					     :border (get-color *info-border*)
+					     :event-mask '(:exposure)))
+		 (gc (xlib:create-gcontext :drawable window
+					   :foreground (get-color *info-foreground*)
+					   :background (get-color *info-background*)
+					   :font font
+					   :line-style :solid))
+		 (info (make-info :window window :gc gc :x 0 :y 0 :list info-list
+				  :font font :ilw ilw :ilh ilh
+				  :max-x (* (loop for l in info-list maximize (compute-size l)) ilw)
+				  :max-y (* (length info-list) ilh))))
+	    (labels ((handle-key (&rest event-slots &key root code state &allow-other-keys)
+		       (declare (ignore event-slots root))
+		       (funcall-key-from-code *info-keys* code state info))
+		     (handle-motion-notify (&rest event-slots &key root-x root-y &allow-other-keys)
+		       (declare (ignore event-slots))
+		       (unless (compress-motion-notify)
+			 (funcall-button-from-code *info-mouse* 'motion (modifiers->state *default-modifiers*)
+						   window root-x root-y *fun-press* (list info))))
+		     (handle-button-press (&rest event-slots &key window root-x root-y code state &allow-other-keys)
+		       (declare (ignore event-slots))
+		       (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-press* (list info)))
+		     (handle-button-release (&rest event-slots &key window root-x root-y code state &allow-other-keys)
+		       (declare (ignore event-slots))
+		       (funcall-button-from-code *info-mouse* code state window root-x root-y *fun-release* (list info))))
+	      (map-window window)
+	      (draw-info-window info)
+	      (xgrab-pointer *root* 68 69)
+	      (unless keyboard-grabbed-p
+		(xgrab-keyboard *root*))
+	      (generic-mode 'exit-info-loop
+			    :loop-function (lambda ()
+					     (raise-window (info-window info)))
+			    :button-press-hook #'handle-button-press
+			    :button-release-hook #'handle-button-release
+			    :motion-notify-hook #'handle-motion-notify
+			    :key-press-hook #'handle-key)
+	      (if pointer-grabbed-p
+		  (xgrab-pointer *root* 66 67)
+		  (xungrab-pointer))
+	      (unless keyboard-grabbed-p
+		(xungrab-keyboard))
+	      (xlib:free-gcontext gc)
+	      (xlib:destroy-window window)
+	      (xlib:close-font font)
+	      (display-all-frame-info)
+	      (wait-no-key-or-button-press))))))))
 
 
 
 
-(defun info-mode-menu (item-list &key (x 0) (y 0) (width nil) (height nil))
+(defun info-mode-menu (item-list &key (width nil) (height nil))
   "Open an info help menu.
 Item-list is: '((key function) separator (key function))
 or with explicit docstring: '((key function \"documentation 1\") (key function \"bla bla\") (key function))
@@ -299,7 +302,7 @@
 			     info-list)
 		       (define-key key function)))))
 	  (t (push (list (format nil "-=- ~A -=-" item) *menu-color-comment*) info-list))))
-      (info-mode (nreverse info-list) :x x :y y :width width :height height)
+      (info-mode (nreverse info-list) :width width :height height)
       (dolist (item item-list)
 	(when (consp item)
 	  (let ((key (first item)))

Added: clfswm/src/clfswm-placement.lisp
==============================================================================
--- (empty file)
+++ clfswm/src/clfswm-placement.lisp	Wed Jun  3 17:43:06 2009
@@ -0,0 +1,181 @@
+;;; --------------------------------------------------------------------------
+;;; CLFSWM - FullScreen Window Manager
+;;;
+;;; --------------------------------------------------------------------------
+;;; Documentation: Placement functions
+;;; --------------------------------------------------------------------------
+;;;
+;;; (C) 2005 Philippe Brochard <hocwp at free.fr>
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software
+;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+;;;
+;;; --------------------------------------------------------------------------
+
+(in-package :clfswm)
+
+(defun get-placement-values (placement &optional (width 0) (height 0))
+  (typecase placement
+    (list (values (first placement)
+		  (second placement)))
+    (function (funcall placement width height))
+    (symbol
+     (if (fboundp placement)
+	 (funcall placement width height)
+	 (values 0 0)))
+    (t (values 0 0))))
+
+(defmacro with-placement ((placement x y &optional (width 0) (height 0)) &body body)
+  `(multiple-value-bind (,x ,y)
+       (get-placement-values ,placement ,width ,height)
+     , at body))
+
+;;;; Test functions
+;;
+;;(defun fun-placement (&optional width height)
+;;  (declare (ignore width height))
+;;  (values 30 40))
+;;
+;;(defparameter *placement-test* (list 10 20))
+;;;;(defparameter *placement-test* #'fun-placement)
+;;;;(defparameter *placement-test* 'fun-placement)
+;;
+;;(defun toto ()
+;;  (with-placement (*placement-test* x y)
+;;    (format t "X=~A  Y=~A~%" x y)))
+
+;;;
+;;; Absolute placement
+;;;
+(defun top-left-placement (&optional (width 0) (height 0))
+  (declare (ignore width height))
+  (values 0 0))
+
+(defun top-middle-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
+	  0))
+
+(defun top-right-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (values (- (xlib:screen-width *screen*) width 1)
+	  0))
+
+
+
+(defun middle-left-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (values 0
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+
+(defun middle-middle-placement (&optional (width 0) (height 0))
+  (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+
+(defun middle-right-placement (&optional (width 0) (height 0))
+  (values (- (xlib:screen-width *screen*) width 1)
+	  (truncate (/ (- (xlib:screen-height *screen*) height) 2))))
+
+
+(defun bottom-left-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (values 0
+	  (- (xlib:screen-height *screen*) height 1)))
+
+(defun bottom-middle-placement (&optional (width 0) (height 0))
+  (values (truncate (/ (- (xlib:screen-width *screen*) width) 2))
+	  (- (xlib:screen-height *screen*) height 1)))
+
+(defun bottom-right-placement (&optional (width 0) (height 0))
+  (values (- (xlib:screen-width *screen*) width 1)
+	  (- (xlib:screen-height *screen*) height 1)))
+
+
+;;;
+;;; Current child placement
+;;;
+(defun current-child-coord ()
+  (typecase *current-child*
+    (xlib:window (values (xlib:drawable-x *current-child*)
+			 (xlib:drawable-y *current-child*)
+			 (xlib:drawable-width *current-child*)
+			 (xlib:drawable-height *current-child*)))
+    (frame (values (frame-rx *current-child*)
+		   (frame-ry *current-child*)
+		   (frame-rw *current-child*)
+		   (frame-rh *current-child*)))
+    (t (values 0 0 10 10))))
+
+(defmacro with-current-child-coord ((x y w h) &body body)
+  `(multiple-value-bind (,x ,y ,w ,h)
+       (current-child-coord)
+     , at body))
+
+
+(defun top-left-child-placement (&optional (width 0) (height 0))
+  (declare (ignore width height))
+  (with-current-child-coord (x y w h)
+    (declare (ignore w h))
+    (values x y)))
+
+(defun top-middle-child-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (with-current-child-coord (x y w h)
+    (declare (ignore h))
+    (values (+ x (truncate (/ (- w width) 2)))
+	    y)))
+
+(defun top-right-child-placement (&optional (width 0) (height 0))
+  (declare (ignore height))
+  (with-current-child-coord (x y w h)
+    (declare (ignore h))
+    (values (+ x (- w width))
+	    y)))
+
+
+
+(defun middle-left-child-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (with-current-child-coord (x y w h)
+    (declare (ignore w))
+    (values x
+	    (+ y (truncate (/ (- h height) 2))))))
+
+(defun middle-middle-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (truncate (/ (- w width) 2)))
+	    (+ y (truncate (/ (- h height) 2))))))
+
+(defun middle-right-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (- w width))
+	    (+ y (truncate (/ (- h height) 2))))))
+
+
+(defun bottom-left-child-placement (&optional (width 0) (height 0))
+  (declare (ignore width))
+  (with-current-child-coord (x y w h)
+    (declare (ignore w))
+    (values x
+	    (+ y (- h height)))))
+
+(defun bottom-middle-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (truncate (/ (- w width) 2)))
+	    (+ y (- h height)))))
+
+(defun bottom-right-child-placement (&optional (width 0) (height 0))
+  (with-current-child-coord (x y w h)
+    (values (+ x (- w width))
+	    (+ y (- h height)))))

Modified: clfswm/src/clfswm-query.lisp
==============================================================================
--- clfswm/src/clfswm-query.lisp	(original)
+++ clfswm/src/clfswm-query.lisp	Wed Jun  3 17:43:06 2009
@@ -107,24 +107,27 @@
 
 
 (defun query-enter-function ()
-  (setf *query-font* (xlib:open-font *display* *query-font-string*)
-	*query-window* (xlib:create-window :parent *root*
-					   :x 0 :y 0
-					   :width (- (xlib:screen-width *screen*) 2)
-					   :height (* 3 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*)))
-					   :background (get-color *query-background*)
-					   :border-width 1
-					   :border (get-color *query-border*)
-					   :colormap (xlib:screen-default-colormap *screen*)
-					   :event-mask '(:exposure :key-press))
-	*query-gc* (xlib:create-gcontext :drawable *query-window*
-					 :foreground (get-color *query-foreground*)
-					 :background (get-color *query-background*)
-					 :font *query-font*
-					 :line-style :solid))
-  (map-window *query-window*)
-  (query-print-string)
-  (wait-no-key-or-button-press))
+  (let ((width (- (xlib:screen-width *screen*) 2))
+	(height (* 3 (+ (xlib:max-char-ascent *query-font*) (xlib:max-char-descent *query-font*)))))
+    (with-placement (*query-mode-placement* x y width height)
+      (setf *query-font* (xlib:open-font *display* *query-font-string*)
+	    *query-window* (xlib:create-window :parent *root*
+					       :x x :y y
+					       :width width
+					       :height height
+					       :background (get-color *query-background*)
+					       :border-width 1
+					       :border (get-color *query-border*)
+					       :colormap (xlib:screen-default-colormap *screen*)
+					       :event-mask '(:exposure :key-press))
+	    *query-gc* (xlib:create-gcontext :drawable *query-window*
+					     :foreground (get-color *query-foreground*)
+					     :background (get-color *query-background*)
+					     :font *query-font*
+					     :line-style :solid))
+      (map-window *query-window*)
+      (query-print-string)
+      (wait-no-key-or-button-press))))
 
 
 (defun query-leave-function ()

Modified: clfswm/src/clfswm-second-mode.lisp
==============================================================================
--- clfswm/src/clfswm-second-mode.lisp	(original)
+++ clfswm/src/clfswm-second-mode.lisp	Wed Jun  3 17:43:06 2009
@@ -197,22 +197,22 @@
 
 
 (defun sm-enter-function ()
-  (setf *in-second-mode* t
-	*sm-window* (xlib:create-window :parent *root*
-					:x (truncate (/ (- (xlib:screen-width *screen*) *sm-width*) 2))
-					:y 0
-					:width *sm-width* :height *sm-height*
+  (with-placement (*second-mode-placement* x y *sm-width* *sm-height*)
+    (setf *in-second-mode* t
+	  *sm-window* (xlib:create-window :parent *root*
+					  :x x :y y
+					  :width *sm-width* :height *sm-height*
+					  :background (get-color *sm-background-color*)
+					  :border-width 1
+					  :border (get-color *sm-border-color*)
+					  :colormap (xlib:screen-default-colormap *screen*)
+					  :event-mask '(:exposure))
+	  *sm-font* (xlib:open-font *display* *sm-font-string*)
+	  *sm-gc* (xlib:create-gcontext :drawable *sm-window*
+					:foreground (get-color *sm-foreground-color*)
 					:background (get-color *sm-background-color*)
-					:border-width 1
-					:border (get-color *sm-border-color*)
-					:colormap (xlib:screen-default-colormap *screen*)
-					:event-mask '(:exposure))
-	*sm-font* (xlib:open-font *display* *sm-font-string*)
-	*sm-gc* (xlib:create-gcontext :drawable *sm-window*
-				      :foreground (get-color *sm-foreground-color*)
-				      :background (get-color *sm-background-color*)
-				      :font *sm-font*
-				      :line-style :solid))
+					:font *sm-font*
+					:line-style :solid)))
   (map-window *sm-window*)
   (draw-second-mode-window)
   (no-focus)

Modified: clfswm/src/package.lisp
==============================================================================
--- clfswm/src/package.lisp	(original)
+++ clfswm/src/package.lisp	Wed Jun  3 17:43:06 2009
@@ -94,8 +94,6 @@
   "Config(): Default mouse focus policy. One of :click, :sloppy, :sloppy-strict or :sloppy-select.")
 
 
-
-
 (defclass frame ()
   ((name :initarg :name :accessor frame-name :initform nil)
    (number :initarg :number :accessor frame-number :initform 0)
@@ -244,6 +242,24 @@
 (defparameter *vt-keyboard-on* nil)
 (defparameter *clfswm-terminal* nil)
 
+
+;;; Placement variables. A list of two absolute coordinates
+;;; or a function: 'Y-X-placement' for absolute placement or
+;;; 'Y-X-child-placement' for child relative placement.
+;;; Where Y-X are one of:
+;;;
+;;; top-left     top-middle     top-right
+;;; middle-left  middle-middle  middle-right
+;;; bottom-left  bottom-middle  bottom-right
+;;;
+(defparameter *banish-pointer-placement* 'bottom-left-placement)
+(defparameter *second-mode-placement* 'top-middle-child-placement)
+(defparameter *info-mode-placement* 'top-middle-child-placement)
+(defparameter *query-mode-placement* 'bottom-left-placement)
+
+
+
+
 ;; For debug - redefine defun
 ;;(shadow :defun)
 ;;

Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp	(original)
+++ clfswm/src/xlib-util.lisp	Wed Jun  3 17:43:06 2009
@@ -86,11 +86,8 @@
 
 (defun banish-pointer ()
   "Move the pointer to the lower right corner of the screen"
-  (xlib:warp-pointer *root*
-		     (1- (xlib:screen-width *screen*))
-		     (1- (xlib:screen-height *screen*))))
-
-
+  (with-placement (*banish-pointer-placement* x y)
+    (xlib:warp-pointer *root* x y)))
 
 
 




More information about the clfswm-cvs mailing list