[clfswm-cvs] r445 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Sun Apr 17 20:53:44 UTC 2011
Author: pbrochard
Date: Sun Apr 17 16:53:43 2011
New Revision: 445
Log:
src/clfswm-pack.lisp (move-frame-constrained, resize-frame-constrained): New function. Move and resize frame with the mouse constrained by other frame brothers.
Modified:
clfswm/ChangeLog
clfswm/clfswm.asd
clfswm/src/bindings.lisp
clfswm/src/clfswm-internal.lisp
clfswm/src/clfswm-pack.lisp
clfswm/src/clfswm-util.lisp
clfswm/src/config.lisp
clfswm/src/xlib-util.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Sun Apr 17 16:53:43 2011
@@ -1,3 +1,9 @@
+2011-04-17 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * 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 <pbrochard at common-lisp.net>
* src/clfswm-util.lisp (with-movement-select-next-brother)
Modified: clfswm/clfswm.asd
==============================================================================
--- clfswm/clfswm.asd (original)
+++ clfswm/clfswm.asd Sun Apr 17 16:53:43 2011
@@ -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"
Modified: clfswm/src/bindings.lisp
==============================================================================
--- clfswm/src/bindings.lisp (original)
+++ clfswm/src/bindings.lisp Sun Apr 17 16:53:43 2011
@@ -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)
Modified: clfswm/src/clfswm-internal.lisp
==============================================================================
--- clfswm/src/clfswm-internal.lisp (original)
+++ clfswm/src/clfswm-internal.lisp Sun Apr 17 16:53:43 2011
@@ -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*))
Modified: clfswm/src/clfswm-pack.lisp
==============================================================================
--- clfswm/src/clfswm-pack.lisp (original)
+++ clfswm/src/clfswm-pack.lisp Sun Apr 17 16:53:43 2011
@@ -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)))
Modified: clfswm/src/clfswm-util.lisp
==============================================================================
--- clfswm/src/clfswm-util.lisp (original)
+++ clfswm/src/clfswm-util.lisp Sun Apr 17 16:53:43 2011
@@ -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 @@
(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)))
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Sun Apr 17 16:53:43 2011
@@ -53,6 +53,10 @@
(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 @@
(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*
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Sun Apr 17 16:53:43 2011
@@ -525,10 +525,18 @@
(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 @@
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))
More information about the clfswm-cvs
mailing list