[clfswm-cvs] r280 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Tue Jul 20 21:33:25 UTC 2010
Author: pbrochard
Date: Tue Jul 20 17:33:24 2010
New Revision: 280
Log:
src/clfswm-internal.lisp (remove-child-in-frame): Do not destroy the frame window and the frame gc. Close a very annoying bug when cuting/pasting a frame or moving a child over frames with the mouse.
Modified:
clfswm/ChangeLog
clfswm/load.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/clfswm.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Tue Jul 20 17:33:24 2010
@@ -1,5 +1,10 @@
2010-07-20 Philippe Brochard <pbrochard at common-lisp.net>
+ * src/clfswm-internal.lisp (remove-child-in-frame): Do not destroy
+ the frame window and the frame gc. Close a very annoying bug when
+ cuting/pasting a frame or moving a child over frames with the
+ mouse.
+
* src/clfswm-util.lisp (mouse-click-to-focus-generic): Redisplay
all children in *current-root* after moving/resizing a frame.
Modified: clfswm/load.lisp
==============================================================================
--- clfswm/load.lisp (original)
+++ clfswm/load.lisp Tue Jul 20 17:33:24 2010
@@ -56,7 +56,7 @@
#-BUILD
(ignore-errors
- (main-unprotected :read-conf-file-p t))
+ (main :read-conf-file-p t))
;;(produce-all-docs)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Tue Jul 20 17:33:24 2010
@@ -124,7 +124,7 @@
(define-main-mouse (3) 'mouse-click-to-focus-and-resize)
(define-main-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window)
(define-main-mouse (3 :mod-1) 'mouse-click-to-focus-and-resize-window)
- (define-main-mouse (1 :control :mod-1) 'mouse-move-window-over-frame)
+ (define-main-mouse (1 :control :mod-1) 'mouse-move-child-over-frame)
(define-main-mouse (4) 'mouse-select-next-level)
(define-main-mouse (5) 'mouse-select-previous-level)
(define-main-mouse (4 :mod-1) 'mouse-enter-frame)
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Tue Jul 20 17:33:24 2010
@@ -815,19 +815,12 @@
(defun remove-child-in-frame (child frame)
"Remove the child in frame"
(when (frame-p frame)
- (setf (frame-child frame) (remove child (frame-child frame) :test #'equal))
- (with-all-frames (child fr)
- (unless (find-frame-window (frame-window fr))
- (awhen (frame-gc fr) (xlib:free-gcontext it) (setf it nil))
- (awhen (frame-window fr) (xlib:destroy-window it) (setf it nil))))))
+ (setf (frame-child frame) (remove child (frame-child frame) :test #'equal))))
(defun remove-child-in-frames (child root)
"Remove child in the frame root and in all its children"
(with-all-frames (root frame)
- (remove-child-in-frame child frame))
- (when (xlib:window-p child)
- (netwm-remove-in-client-list child)))
-
+ (remove-child-in-frame child frame)))
(defun remove-child-in-all-frames (child)
@@ -839,6 +832,27 @@
(remove-child-in-frames child *root-frame*))
+(defun delete-child-in-frames (child root)
+ "Delete child in the frame root and in all its children
+Warning:frame window and gc are freeed."
+ (with-all-frames (root frame)
+ (remove-child-in-frame child frame)
+ (unless (find-frame-window (frame-window frame))
+ (awhen (frame-gc frame) (xlib:free-gcontext it) (setf it nil))
+ (awhen (frame-window frame) (xlib:destroy-window it) (setf it nil))))
+ (when (xlib:window-p child)
+ (netwm-remove-in-client-list child)))
+
+
+(defun delete-child-in-all-frames (child)
+ "Delete child in all frames from *root-frame*"
+ (when (equal child *current-root*)
+ (setf *current-root* (find-parent-frame child)))
+ (when (equal child *current-child*)
+ (setf *current-child* *current-root*))
+ (delete-child-in-frames child *root-frame*))
+
+
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Tue Jul 20 17:33:24 2010
@@ -1002,14 +1002,13 @@
-;;; Moving window with the mouse function
-(defun mouse-move-window-over-frame (window root-x root-y)
- "Move the window under the mouse cursor to another frame"
+;;; Moving child with the mouse button
+(defun mouse-move-child-over-frame (window root-x root-y)
+ "Move the child under the mouse cursor to another frame"
(declare (ignore window))
(let ((child (find-child-under-mouse root-x root-y)))
- (dbg child (frame-child child))
(unless (equal child *current-root*)
- (hide-child child)
+ (hide-all child)
(remove-child-in-frame child (find-parent-frame child))
(wait-mouse-button-release 50 51)
(multiple-value-bind (x y)
@@ -1018,12 +1017,7 @@
(when (xlib:window-p dest)
(setf dest (find-parent-frame dest)))
(unless (equal child dest)
- ;;(move-child-to child dest))))))
- (dbg dest (frame-child dest))
- (pushnew child (frame-child dest))
- (dbg dest (frame-child dest))
- (dbg child (frame-child child))
- ;;(focus-all-children child dest)
+ (move-child-to child dest)
(show-all-children *current-root*))))))
(stop-button-event))
Modified: clfswm/src/clfswm.lisp
==============================================================================
--- clfswm/src/clfswm.lisp (original)
+++ clfswm/src/clfswm.lisp Tue Jul 20 17:33:24 2010
@@ -111,7 +111,7 @@
(unless (and (not send-event-p)
(not (xlib:window-equal window event-window)))
(when (find-child window *root-frame*)
- (remove-child-in-all-frames window)
+ (delete-child-in-all-frames window)
(show-all-children))))
@@ -120,7 +120,7 @@
(unless (or send-event-p
(xlib:window-equal window event-window))
(when (find-child window *root-frame*)
- (remove-child-in-all-frames window)
+ (delete-child-in-all-frames window)
(show-all-children))))
More information about the clfswm-cvs
mailing list