[clfswm-cvs] r403 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Wed Feb 9 21:59:59 UTC 2011
Author: pbrochard
Date: Wed Feb 9 16:59:58 2011
New Revision: 403
Log:
src/clfswm-util.lisp (mouse-focus-move/resize-generic): Take care of never managed windows to move or resize them if the raise parameter is true.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-corner.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/config.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Wed Feb 9 16:59:58 2011
@@ -1,3 +1,12 @@
+2011-02-09 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-util.lisp (mouse-focus-move/resize-generic): Take
+ care of never managed windows to move or resize them if the raise
+ parameter is true.
+
+ * src/clfswm-internal.lisp (in-frame, in-window, in-child): New
+ functions.
+
2011-02-08 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm.lisp (main-mode): Raise or not unmanaged windows
Modified: clfswm/src/clfswm-corner.lisp
==============================================================================
--- clfswm/src/clfswm-corner.lisp (original)
+++ clfswm/src/clfswm-corner.lisp Wed Feb 9 16:59:58 2011
@@ -122,3 +122,4 @@
t))
t))
+
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Wed Feb 9 16:59:58 2011
@@ -64,7 +64,6 @@
-
(defgeneric frame-p (frame))
(defmethod frame-p ((frame frame))
(declare (ignore frame))
@@ -75,6 +74,28 @@
+;;; in-*: Find if point (x,y) is in frame, window or child
+(defun in-frame (frame x y)
+ (and (frame-p frame)
+ (<= (frame-rx frame) x (+ (frame-rx frame) (frame-rw frame)))
+ (<= (frame-ry frame) y (+ (frame-ry frame) (frame-rh frame)))))
+
+(defun in-window (window x y)
+ (and (xlib:window-p window)
+ (<= (xlib:drawable-x window) x (+ (xlib:drawable-x window) (xlib:drawable-width window)))
+ (<= (xlib:drawable-y window) y (+ (xlib:drawable-y window) (xlib:drawable-height window)))))
+
+(defgeneric in-child (child x y))
+
+(defmethod in-child ((child frame) x y)
+ (in-frame child x y))
+(defmethod in-child ((child xlib:window) x y)
+ (in-window child x y))
+(defmethod in-child (child x y)
+ (declare (ignore child x y))
+ nil)
+
+
(defun frame-selected-child (frame)
@@ -156,10 +177,11 @@
(defun never-managed-window-p (window)
- (dolist (type *never-managed-window-list*)
- (destructuring-bind (test predicate result raise) type
- (when (funcall test (funcall predicate window) result)
- (return (values t raise))))))
+ (when (xlib:window-p window)
+ (dolist (type *never-managed-window-list*)
+ (destructuring-bind (test predicate result raise) type
+ (when (funcall test (funcall predicate window) result)
+ (return (values t raise)))))))
(defgeneric child-name (child))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Wed Feb 9 16:59:58 2011
@@ -149,34 +149,48 @@
(let ((win *root*))
(with-all-windows-frames-and-parent (*current-root* child parent)
(when (and (or (managed-window-p child parent) (child-equal-p parent *current-child*))
- (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
- (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
+ (in-window child x y))
(setf win child))
- (when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
- (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
+ (when (in-frame child x y)
(setf win (frame-window child))))
win))
-(defun find-child-under-mouse (x y &optional first-foundp)
+
+
+(defun find-child-under-mouse-in-never-managed-windows (x y)
+ "Return the child under mouse from never managed windows"
+ (dolist (win (xlib:query-tree *root*))
+ (unless (window-hidden-p win)
+ (multiple-value-bind (managed raise)
+ (never-managed-window-p win)
+ (when (and managed raise (in-window win x y))
+ (return-from find-child-under-mouse-in-never-managed-windows win))))))
+
+
+(defun find-child-under-mouse-in-child-tree (x y &optional first-foundp)
"Return the child under the mouse"
(let ((ret nil))
(with-all-windows-frames-and-parent (*current-root* child parent)
(when (and (not (window-hidden-p child))
(or (managed-window-p child parent) (child-equal-p parent *current-child*))
- (<= (xlib:drawable-x child) x (+ (xlib:drawable-x child) (xlib:drawable-width child)))
- (<= (xlib:drawable-y child) y (+ (xlib:drawable-y child) (xlib:drawable-height child))))
+ (in-window child x y))
(if first-foundp
- (return-from find-child-under-mouse child)
+ (return-from find-child-under-mouse-in-child-tree child)
(setf ret child)))
- (when (and (<= (frame-rx child) x (+ (frame-rx child) (frame-rw child)))
- (<= (frame-ry child) y (+ (frame-ry child) (frame-rh child))))
+ (when (in-frame child x y)
(if first-foundp
- (return-from find-child-under-mouse child)
+ (return-from find-child-under-mouse-in-child-tree child)
(setf ret child))))
ret))
+(defun find-child-under-mouse (x y &optional first-foundp also-never-managed)
+ "Return the child under the mouse"
+ (or (and also-never-managed
+ (find-child-under-mouse-in-never-managed-windows x y))
+ (find-child-under-mouse-in-child-tree x y first-foundp)))
+
@@ -596,26 +610,39 @@
mouse-fun is #'move-frame or #'resize-frame.
Focus child and its parents -
For window: set current child to window or its parent according to window-parent"
- (let* ((child (find-child-under-mouse root-x root-y))
- (parent (find-parent-frame child)))
- (when (and (child-equal-p child *current-root*)
- (frame-p *current-root*))
- (setf child (create-frame)
- parent *current-root*
- mouse-fn #'resize-frame)
- (place-frame child parent root-x root-y 10 10)
- (map-window (frame-window child))
- (pushnew child (frame-child *current-root*)))
- (typecase child
- (xlib:window
- (if (managed-window-p child parent)
- (funcall mouse-fn parent (find-parent-frame parent) root-x root-y)
- (funcall(cond ((eql mouse-fn #'move-frame) #'move-window)
- ((eql mouse-fn #'resize-frame) #'resize-window))
- child root-x root-y)))
- (frame (funcall mouse-fn child parent root-x root-y)))
- (focus-all-children child parent window-parent)
- (show-all-children *current-root*)))
+ (labels ((move/resize-managed (child)
+ (let ((parent (find-parent-frame child)))
+ (when (and (child-equal-p child *current-root*)
+ (frame-p *current-root*))
+ (setf child (create-frame)
+ parent *current-root*
+ mouse-fn #'resize-frame)
+ (place-frame child parent root-x root-y 10 10)
+ (map-window (frame-window child))
+ (pushnew child (frame-child *current-root*)))
+ (typecase child
+ (xlib:window
+ (if (managed-window-p child parent)
+ (funcall mouse-fn parent (find-parent-frame parent) root-x root-y)
+ (funcall (cond ((eql mouse-fn #'move-frame) #'move-window)
+ ((eql mouse-fn #'resize-frame) #'resize-window))
+ child root-x root-y)))
+ (frame (funcall mouse-fn child parent root-x root-y)))
+ (focus-all-children child parent window-parent)
+ (show-all-children *current-root*)))
+ (move/resize-never-managed (child)
+ (raise-window child)
+ (funcall (cond ((eql mouse-fn #'move-frame) #'move-window)
+ ((eql mouse-fn #'resize-frame) #'resize-window))
+ child root-x root-y)
+ (focus-window child)))
+ (let ((child (find-child-under-mouse root-x root-y nil t)))
+ (multiple-value-bind (never-managed raise)
+ (never-managed-window-p child)
+ (if (and (xlib:window-p child) never-managed raise)
+ (move/resize-never-managed child)
+ (move/resize-managed child))))))
+
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Wed Feb 9 16:59:58 2011
@@ -48,7 +48,7 @@
;;; CONFIG - Never managed window list
(defparameter *never-managed-window-list*
'((string-equal xlib:get-wm-class "ROX-Pinboard" nil)
- (string-equal xlib:get-wm-class "xvkbd" t)
+ (string-equal xlib:get-wm-class "xvkbd" t)
(string-equal xlib:wm-name "clfswm-terminal" t))
"Config(): CLFSWM will never manage windows of this type.
A list of (predicate-function-on-window expected-string raise-p)")
@@ -129,6 +129,7 @@
(defparameter *clfswm-terminal-name* "clfswm-terminal"
"Config(Corner group): The clfswm terminal name")
;;(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A -e /bin/bash --noprofile --norc" *clfswm-terminal-name*)
+;;(defparameter *clfswm-terminal-cmd* (format nil "urxvt -name ~A" *clfswm-terminal-name*)
(defparameter *clfswm-terminal-cmd* (format nil "xterm -T ~A" *clfswm-terminal-name*)
"Config(Corner group): The clfswm terminal command.
This command must set the window title to *clfswm-terminal-name*")
More information about the clfswm-cvs
mailing list