[clfswm-cvs] r103 - in clfswm: . src
pbrochard at common-lisp.net
pbrochard at common-lisp.net
Wed Apr 30 20:14:21 UTC 2008
Author: pbrochard
Date: Wed Apr 30 16:14:19 2008
New Revision: 103
Modified:
clfswm/ChangeLog
clfswm/TODO
clfswm/src/bindings-second-mode.lisp
clfswm/src/bindings.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/xlib-util.lisp
Log:
mouse-move-window-over-frame: New function to move the window under the mouse cursor to another frame.
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Wed Apr 30 16:14:19 2008
@@ -3,6 +3,10 @@
* src/clfswm-util.lisp (paste-selection-no-clear): Prevent to
paste a child on one of its own children. (this prevent a
recursive bug).
+ (move-child-to): Rename move/copy-current-child-by to
+ move/copy-child-to.
+ (mouse-move-window-over-frame): New function to move the window
+ under the mouse cursor to another frame.
* src/clfswm-internal.lisp (find-child-in-parent): New function.
Modified: clfswm/TODO
==============================================================================
--- clfswm/TODO (original)
+++ clfswm/TODO Wed Apr 30 16:14:19 2008
@@ -7,8 +7,6 @@
===============
Should handle these soon.
-- Move window over frame (Alt+Control+B1) [Philippe]
-
- Move the autodoc in its own file (clfswm-autodoc.lisp) and make the autodoc
for the menu system.
Modified: clfswm/src/bindings-second-mode.lisp
==============================================================================
--- clfswm/src/bindings-second-mode.lisp (original)
+++ clfswm/src/bindings-second-mode.lisp Wed Apr 30 16:14:19 2008
@@ -362,6 +362,8 @@
(define-second-mouse (1 :mod-1) 'mouse-click-to-focus-and-move-window)
(define-second-mouse (3 :mod-1) 'mouse-click-to-focus-and-resize-window)
+(define-second-mouse (1 :control :mod-1) 'mouse-move-window-over-frame)
+
(define-second-mouse (4) 'sm-mouse-select-next-level)
(define-second-mouse (5) 'sm-mouse-select-previous-level)
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Wed Apr 30 16:14:19 2008
@@ -127,6 +127,8 @@
(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 (4) 'mouse-select-next-level)
(define-main-mouse (5) 'mouse-select-previous-level)
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Wed Apr 30 16:14:19 2008
@@ -396,7 +396,7 @@
;;; Move by function
-(defun move-current-child-by (child frame-dest)
+(defun move-child-to (child frame-dest)
(when (and child (frame-p frame-dest))
(hide-all *current-root*)
(remove-child-in-frame child (find-parent-frame child))
@@ -406,21 +406,21 @@
(defun move-current-child-by-name ()
"Move current child in a named frame"
- (move-current-child-by *current-child*
- (find-frame-by-name
- (ask-frame-name (format nil "Move '~A' to frame" (child-name *current-child*)))))
+ (move-child-to *current-child*
+ (find-frame-by-name
+ (ask-frame-name (format nil "Move '~A' to frame" (child-name *current-child*)))))
(leave-second-mode))
(defun move-current-child-by-number ()
"Move current child in a numbered frame"
- (move-current-child-by *current-child*
- (find-frame-by-number
- (query-number (format nil "Move '~A' to frame numbered:" (child-name *current-child*)))))
+ (move-child-to *current-child*
+ (find-frame-by-number
+ (query-number (format nil "Move '~A' to frame numbered:" (child-name *current-child*)))))
(leave-second-mode))
;;; Copy by function
-(defun copy-current-child-by (child frame-dest)
+(defun copy-child-to (child frame-dest)
(when (and child (frame-p frame-dest))
(hide-all *current-root*)
(pushnew child (frame-child frame-dest))
@@ -429,16 +429,16 @@
(defun copy-current-child-by-name ()
"Copy current child in a named frame"
- (copy-current-child-by *current-child*
- (find-frame-by-name
- (ask-frame-name (format nil "Copy '~A' to frame" (child-name *current-child*)))))
+ (copy-child-to *current-child*
+ (find-frame-by-name
+ (ask-frame-name (format nil "Copy '~A' to frame" (child-name *current-child*)))))
(leave-second-mode))
(defun copy-current-child-by-number ()
"Copy current child in a numbered frame"
- (copy-current-child-by *current-child*
- (find-frame-by-number
- (query-number (format nil "Copy '~A' to frame numbered:" (child-name *current-child*)))))
+ (copy-child-to *current-child*
+ (find-frame-by-number
+ (query-number (format nil "Copy '~A' to frame numbered:" (child-name *current-child*)))))
(leave-second-mode))
@@ -904,3 +904,24 @@
(pushnew window unmanaged))))
(leave-second-mode))
+
+
+;;; 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"
+ (declare (ignore window))
+ (let ((child (find-child-under-mouse root-x root-y)))
+ (unless (equal child *current-root*)
+ (hide-child child)
+ (remove-child-in-frame child (find-parent-frame child))
+ (wait-mouse-button-release 50 51)
+ (multiple-value-bind (x y)
+ (xlib:query-pointer *root*)
+ (let ((dest (find-child-under-mouse x y)))
+ (when (xlib:window-p dest)
+ (setf dest (find-parent-frame dest)))
+ (unless (equal child dest)
+ (move-child-to child dest))))))
+ (stop-button-event))
+
+
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Wed Apr 30 16:14:19 2008
@@ -460,7 +460,7 @@
(xlib:drawable-y window) (+ root-y dy))
(when additional-fn
(apply additional-fn additional-arg)))
- (my-handle-event (&rest event-slots &key event-key &allow-other-keys)
+ (handle-event (&rest event-slots &key event-key &allow-other-keys)
(case event-key
(:motion-notify (apply #'motion-notify event-slots))
(:button-release (setf done t))
@@ -480,7 +480,7 @@
(loop until done
do (with-xlib-protect
(xlib:display-finish-output *display*)
- (xlib:process-event *display* :handler #'my-handle-event)))
+ (xlib:process-event *display* :handler #'handle-event)))
(unless pointer-grabbed-p
(xungrab-pointer)))))
@@ -535,6 +535,37 @@
+(defun wait-mouse-button-release (&optional cursor-char cursor-mask-char)
+ (let ((done nil)
+ (pointer-grabbed-p (xgrab-pointer-p)))
+ (labels ((handle-event (&rest event-slots &key event-key &allow-other-keys)
+ (case event-key
+ ;;(:motion-notify (apply #'motion-notify event-slots))
+ (:button-release (setf done t))
+ (:configure-request (call-hook *configure-request-hook* event-slots))
+ (:configure-notify (call-hook *configure-notify-hook* event-slots))
+ (:map-request (call-hook *map-request-hook* event-slots))
+ (:unmap-notify (call-hook *unmap-notify-hook* event-slots))
+ (:destroy-notify (call-hook *destroy-notify-hook* event-slots))
+ (:mapping-notify (call-hook *mapping-notify-hook* event-slots))
+ (:property-notify (call-hook *property-notify-hook* event-slots))
+ (:create-notify (call-hook *create-notify-hook* event-slots)))
+ t))
+ (unless pointer-grabbed-p
+ (xgrab-pointer *root* cursor-char cursor-mask-char))
+ (loop until done
+ do (with-xlib-protect
+ (xlib:display-finish-output *display*)
+ (xlib:process-event *display* :handler #'handle-event)))
+ (unless pointer-grabbed-p
+ (xungrab-pointer)))))
+
+
+
+
+
+
+
(defun get-color (color)
(xlib:alloc-color (xlib:screen-default-colormap *screen*) color))
@@ -615,3 +646,11 @@
(xlib:event-case (*display* :discard-p nil :peek-p t :timeout 0)
(:motion-notify () t))))
+
+(defun display-all-cursors (&optional (display-time 1))
+ "Display all X11 cursors for display-time seconds"
+ (loop for i from 0 to 152 by 2
+ do (xgrab-pointer *root* i (1+ i))
+ (dbg i)
+ (sleep display-time)
+ (xungrab-pointer)))
More information about the clfswm-cvs
mailing list