From d859f2de0ab11e3cd6631851bc13f6520ae47c28 Mon Sep 17 00:00:00 2001 From: Philippe Brochard Date: Sun, 17 Apr 2011 22:54:44 +0200 Subject: [PATCH] src/clfswm-pack.lisp (move-frame-constrained, resize-frame-constrained): New function. Move and resize frame with the mouse constrained by other frame brothers. --- ChangeLog | 6 ++++ clfswm.asd | 2 +- src/bindings.lisp | 16 +++++++++ src/clfswm-internal.lisp | 3 +- src/clfswm-pack.lisp | 85 ++++++++++++++++++++++++++++++++++++++++++++++++ src/clfswm-util.lisp | 10 +++--- src/config.lisp | 5 ++- src/xlib-util.lisp | 32 +++++++++++++----- 8 files changed, 144 insertions(+), 15 deletions(-) diff --git a/ChangeLog b/ChangeLog index 0386396..fe5dfee 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2011-04-17 Philippe Brochard + + * src/clfswm-pack.lisp (move-frame-constrained) + (resize-frame-constrained): New function. Move and resize frame + with the mouse constrained by other frame brothers. + 2011-04-14 Philippe Brochard * src/clfswm-util.lisp (with-movement-select-next-brother) diff --git a/clfswm.asd b/clfswm.asd index cf2f114..8884df2 100644 --- a/clfswm.asd +++ b/clfswm.asd @@ -70,7 +70,7 @@ (:file "clfswm-layout" :depends-on ("package" "clfswm-internal" "clfswm-util" "clfswm-info" "menu-def")) (:file "clfswm-pack" - :depends-on ("clfswm" "clfswm-util" "clfswm-second-mode")) + :depends-on ("clfswm" "clfswm-util" "clfswm-second-mode" "clfswm-layout")) (:file "clfswm-nw-hooks" :depends-on ("package" "clfswm-util" "clfswm-info" "clfswm-layout" "menu-def")) (:file "bindings" diff --git a/src/bindings.lisp b/src/bindings.lisp index fdc2311..ec42696 100644 --- a/src/bindings.lisp +++ b/src/bindings.lisp @@ -106,6 +106,20 @@ (mouse-focus-move/resize-generic root-x root-y #'resize-frame t)) +(defun mouse-click-to-focus-and-move-window-constrained (window root-x root-y) + "Move (constrained by other frames) and focus the current child - Create a new frame on the root window" + (declare (ignore window)) + (stop-button-event) + (mouse-focus-move/resize-generic root-x root-y #'move-frame-constrained t)) + + +(defun mouse-click-to-focus-and-resize-window-constrained (window root-x root-y) + "Resize and focus the current child - Create a new frame on the root window" + (declare (ignore window)) + (stop-button-event) + (mouse-focus-move/resize-generic root-x root-y #'resize-frame-constrained t)) + + (defun set-default-main-mouse () (define-main-mouse (1) 'mouse-click-to-focus-and-move) @@ -113,6 +127,8 @@ (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 :mod-1 :shift) 'mouse-click-to-focus-and-move-window-constrained) + (define-main-mouse (3 :mod-1 :shift) 'mouse-click-to-focus-and-resize-window-constrained) (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) diff --git a/src/clfswm-internal.lisp b/src/clfswm-internal.lisp index 1305992..108a7bd 100644 --- a/src/clfswm-internal.lisp +++ b/src/clfswm-internal.lisp @@ -548,7 +548,8 @@ (dolist (ch hidden-children) (xlib:draw-glyphs *pixmap-buffer* gc 5 (incf pos dy) (format nil " ~A - hidden" (ensure-printable (child-fullname ch)))))) - (copy-pixmap-buffer window gc)))) + (copy-pixmap-buffer window gc) + (values t t)))) (defun display-all-frame-info (&optional (root *current-root*)) diff --git a/src/clfswm-pack.lisp b/src/clfswm-pack.lisp index a16c804..89bf005 100644 --- a/src/clfswm-pack.lisp +++ b/src/clfswm-pack.lisp @@ -25,6 +25,7 @@ (in-package :clfswm) + ;;;,----- ;;;| Edges functions ;;;`----- @@ -208,3 +209,87 @@ "Create a new frame for each window in frame" (explode-frame *current-child*) (leave-second-mode)) + + + +;;;;;,----- +;;;;;| Constrained move/resize frames +;;;;;`----- +(defun move-frame-constrained (frame parent orig-x orig-y) + (when (and frame parent (not (child-equal-p frame *current-root*))) + (hide-all-children frame) + (with-slots (window) frame + (let ((lx orig-x) + (ly orig-y)) + (move-window window orig-x orig-y + (lambda () + (let ((move-x t) + (move-y t)) + (multiple-value-bind (x y) (xlib:query-pointer *root*) + (setf (frame-x frame) (x-px->fl (xlib:drawable-x window) parent) + (frame-y frame) (y-px->fl (xlib:drawable-y window) parent)) + (when (> x lx) + (let ((x-found (find-edge-right frame parent))) + (when (< (abs (- x-found (frame-x2 frame))) *snap-size*) + (setf (frame-x frame) (- x-found (frame-w frame)) + (xlib:drawable-x window) (adj-border-xy (x-fl->px (frame-x frame) parent) frame) + move-x nil)))) + (when (< x lx) + (let ((x-found (find-edge-left frame parent))) + (when (< (abs (- x-found (frame-x frame))) *snap-size*) + (setf (frame-x frame) x-found + (xlib:drawable-x window) (adj-border-xy (x-fl->px (frame-x frame) parent) frame) + move-x nil)))) + (when (> y ly) + (let ((y-found (find-edge-down frame parent))) + (when (< (abs (- y-found (frame-y2 frame))) *snap-size*) + (setf (frame-y frame) (- y-found (frame-h frame)) + (xlib:drawable-y window) (adj-border-xy (y-fl->px (frame-y frame) parent) frame) + move-y nil)))) + (when (< y ly) + (let ((y-found (find-edge-up frame parent))) + (when (< (abs (- y-found (frame-y frame))) *snap-size*) + (setf (frame-y frame) y-found + (xlib:drawable-y window) (adj-border-xy (y-fl->px (frame-y frame) parent) frame) + move-y nil)))) + (display-frame-info frame) + (when move-x (setf lx x)) + (when move-y (setf ly y)) + (values move-x move-y)))))) + (setf (frame-x frame) (x-px->fl (xlib:drawable-x window) parent) + (frame-y frame) (y-px->fl (xlib:drawable-y window) parent))) + (show-all-children))) + + +(defun resize-frame-constrained (frame parent orig-x orig-y) + (when (and frame parent (not (child-equal-p frame *current-root*))) + (hide-all-children frame) + (with-slots (window) frame + (let ((lx orig-x) + (ly orig-y)) + (resize-window window orig-x orig-y + (lambda () + (let ((resize-w t) + (resize-h t)) + (multiple-value-bind (x y) (xlib:query-pointer *root*) + (setf (frame-w frame) (w-px->fl (xlib:drawable-width window) parent) + (frame-h frame) (h-px->fl (xlib:drawable-height window) parent)) + (when (> x lx) + (let ((x-found (find-edge-right frame parent))) + (when (< (abs (- x-found (frame-x2 frame))) *snap-size*) + (setf (frame-w frame) (+ (frame-w frame) (- x-found (frame-x2 frame))) + (xlib:drawable-width window) (adj-border-wh (w-fl->px (frame-w frame) parent) frame) + resize-w nil)))) + (when (> y ly) + (let ((y-found (find-edge-down frame parent))) + (when (< (abs (- y-found (frame-y2 frame))) *snap-size*) + (setf (frame-h frame) (+ (frame-h frame) (- y-found (frame-y2 frame))) + (xlib:drawable-height window) (adj-border-wh (h-fl->px (frame-h frame) parent) frame) + resize-h nil)))) + (display-frame-info frame) + (when resize-w (setf lx x)) + (when resize-h (setf ly y)) + (values resize-w resize-h)))))) + (setf (frame-w frame) (w-px->fl (xlib:drawable-width window) parent) + (frame-h frame) (h-px->fl (xlib:drawable-height window) parent))) + (show-all-children))) diff --git a/src/clfswm-util.lisp b/src/clfswm-util.lisp index 2bcccf9..e69d6fd 100644 --- a/src/clfswm-util.lisp +++ b/src/clfswm-util.lisp @@ -531,7 +531,6 @@ (hide-all-frames-info)) - (defun move-frame (frame parent orig-x orig-y) (when (and frame parent (not (child-equal-p frame *current-root*))) (hide-all-children frame) @@ -541,7 +540,6 @@ (frame-y frame) (y-px->fl (xlib:drawable-y window) parent))) (show-all-children))) - (defun resize-frame (frame parent orig-x orig-y) (when (and frame parent (not (child-equal-p frame *current-root*))) (hide-all-children frame) @@ -632,8 +630,12 @@ For window: set current child to window or its parent according to window-parent (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)) + (funcall (cond ((or (eql mouse-fn #'move-frame) + (eql mouse-fn #'move-frame-constrained)) + #'move-window) + ((or (eql mouse-fn #'resize-frame) + (eql mouse-fn #'resize-frame-constrained)) + #'resize-window)) child root-x root-y))) (frame (funcall mouse-fn child parent root-x root-y))) (show-all-children))) diff --git a/src/config.lisp b/src/config.lisp index 2da2b5f..82a9f60 100644 --- a/src/config.lisp +++ b/src/config.lisp @@ -53,6 +53,10 @@ A list of (list match-function handle-function)") (defconfig *hide-unmanaged-window* t nil "Hide or not unmanaged windows when a child is deselected.") +(defconfig *snap-size* 0.02 nil + "Snap size when move or resize frame is constrained") + + ;;; CONFIG - Screen size (defun get-fullscreen-size () "Return the size of root child (values rx ry rw rh) @@ -68,7 +72,6 @@ You can tweak this to what you want" (defconfig *corner-size* 3 'Corner "The size of the corner square") - ;;; CONFIG: Corner actions - See in clfswm-corner.lisp for ;;; allowed functions (defconfig *corner-main-mode-left-button* diff --git a/src/xlib-util.lisp b/src/xlib-util.lisp index 71b077c..4bb5320 100644 --- a/src/xlib-util.lisp +++ b/src/xlib-util.lisp @@ -525,10 +525,18 @@ Expand in handle-event-fun-main-mode-key-press" (let (add-fn add-arg dx dy window) (define-handler move-window-mode :motion-notify (root-x root-y) (unless (compress-motion-notify) - (setf (xlib:drawable-x window) (+ root-x dx) - (xlib:drawable-y window) (+ root-y dy)) - (when add-fn - (apply add-fn add-arg)))) + (if add-fn + (multiple-value-bind (move-x move-y) + (apply add-fn add-arg) + (when move-x + (setf (xlib:drawable-x window) (+ root-x dx))) + (when move-y + (setf (xlib:drawable-y window) (+ root-y dy)))) + (setf (xlib:drawable-x window) (+ root-x dx) + (xlib:drawable-y window) (+ root-y dy))))) + + (define-handler move-window-mode :key-release () + (throw 'exit-move-window-mode nil)) (define-handler move-window-mode :button-release () (throw 'exit-move-window-mode nil)) @@ -559,10 +567,18 @@ Expand in handle-event-fun-main-mode-key-press" min-height max-height) (define-handler resize-window-mode :motion-notify (root-x root-y) (unless (compress-motion-notify) - (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x o-x)) 10 min-width) max-width) - (xlib:drawable-height window) (min (max (+ orig-height (- root-y o-y)) 10 min-height) max-height)) - (when add-fn - (apply add-fn add-arg)))) + (if add-fn + (multiple-value-bind (resize-w resize-h) + (apply add-fn add-arg) + (when resize-w + (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x o-x)) 10 min-width) max-width))) + (when resize-h + (setf (xlib:drawable-height window) (min (max (+ orig-height (- root-y o-y)) 10 min-height) max-height)))) + (setf (xlib:drawable-width window) (min (max (+ orig-width (- root-x o-x)) 10 min-width) max-width) + (xlib:drawable-height window) (min (max (+ orig-height (- root-y o-y)) 10 min-height) max-height))))) + + (define-handler resize-window-mode :key-release () + (throw 'exit-resize-window-mode nil)) (define-handler resize-window-mode :button-release () (throw 'exit-resize-window-mode nil)) -- 2.11.4.GIT