[clfswm-cvs] r449 - in clfswm: . src
Philippe Brochard
pbrochard at common-lisp.net
Tue Apr 19 21:07:10 UTC 2011
Author: pbrochard
Date: Tue Apr 19 17:07:09 2011
New Revision: 449
Log:
src/clfswm-pack.lisp (move-frame-constrained, resize-frame-constrained): Use pixels instead of floating measure.
Modified:
clfswm/ChangeLog
clfswm/src/clfswm-pack.lisp
clfswm/src/config.lisp
clfswm/src/xlib-util.lisp
Modified: clfswm/ChangeLog
==============================================================================
--- clfswm/ChangeLog (original)
+++ clfswm/ChangeLog Tue Apr 19 17:07:09 2011
@@ -1,3 +1,9 @@
+2011-04-19 Philippe Brochard <pbrochard at common-lisp.net>
+
+ * src/clfswm-pack.lisp (move-frame-constrained)
+ (resize-frame-constrained): Use pixels instead of floating
+ measure.
+
2011-04-18 Philippe Brochard <pbrochard at common-lisp.net>
* src/clfswm-pack.lisp (resize-frame-constrained): Takes care of
Modified: clfswm/src/clfswm-pack.lisp
==============================================================================
--- clfswm/src/clfswm-pack.lisp (original)
+++ clfswm/src/clfswm-pack.lisp Tue Apr 19 17:07:09 2011
@@ -232,81 +232,88 @@
;;;;;,-----
;;;;;| 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*)
+(labels ((readjust-all-frames-fl-size (parent)
+ (dolist (child (frame-child parent))
+ (when (frame-p child)
+ (setf (frame-x child) (x-px->fl (xlib:drawable-x (frame-window child)) parent)
+ (frame-y child) (y-px->fl (xlib:drawable-y (frame-window child)) parent)
+ (frame-w child) (w-px->fl (anti-adj-border-wh (xlib:drawable-width (frame-window child)) parent) parent)
+ (frame-h child) (h-px->fl (anti-adj-border-wh (xlib:drawable-height (frame-window child)) parent) parent))))))
+ (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))
+ (readjust-all-frames-fl-size parent)
+ (move-window window orig-x orig-y
+ (lambda ()
+ (let ((move-x t)
+ (move-y t))
(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))))
+ (let ((x-found (x-fl->px (find-edge-right frame parent) parent)))
+ (when (< (abs (- x-found (window-x2 window))) *snap-size*)
+ (setf (xlib:drawable-x window) (- x-found (adj-border-xy (xlib:drawable-width window) window))
+ (frame-x frame) (x-px->fl (xlib:drawable-x window) parent)
+ move-x nil))))
+ (when (< x lx)
+ (let ((x-found (x-fl->px (find-edge-left frame parent) parent)))
+ (when (< (abs (- x-found (xlib:drawable-x window))) *snap-size*)
+ (setf (xlib:drawable-x window) (adj-border-xy x-found window)
+ (frame-x frame) (x-px->fl (xlib:drawable-x window) parent)
+ 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-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))))
+ (let ((y-found (y-fl->px (find-edge-down frame parent) parent)))
+ (when (< (abs (- y-found (window-y2 window))) *snap-size*)
+ (setf (xlib:drawable-y window) (- y-found (adj-border-xy (xlib:drawable-height window) window))
+ (frame-y frame) (y-px->fl (xlib:drawable-y window) parent)
+ move-y nil))))
+ (when (< y ly)
+ (let ((y-found (y-fl->px (find-edge-up frame parent) parent)))
+ (when (< (abs (- y-found (xlib:drawable-y window))) *snap-size*)
+ (setf (xlib:drawable-y window) (adj-border-xy y-found window)
+ (frame-y frame) (y-px->fl (xlib:drawable-y window) parent)
+ move-y 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 (anti-adj-border-wh (xlib:drawable-width window) frame) parent)
- (frame-h frame) (h-px->fl (anti-adj-border-wh (xlib:drawable-height window) frame) parent)))
- (show-all-children)))
+ (when move-x (setf lx x))
+ (when move-y (setf ly y))
+ (values move-x move-y)))))))
+ (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))
+ (readjust-all-frames-fl-size parent)
+ (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 (anti-adj-border-wh (xlib:drawable-width window) parent) parent)
+ (frame-h frame) (h-px->fl (anti-adj-border-wh (xlib:drawable-height window) parent) parent))
+ (when (> x lx)
+ (let ((x-found (x-fl->px (find-edge-right frame parent) parent)))
+ (when (< (abs (- x-found (window-x2 window))) *snap-size*)
+ (setf (xlib:drawable-width window) (+ (xlib:drawable-width window)
+ (- x-found (adj-border-xy (window-x2 window) parent)))
+ (frame-w frame) (w-px->fl (anti-adj-border-wh (xlib:drawable-width window) parent) parent)
+ resize-w nil))))
+ (when (> y ly)
+ (let ((y-found (y-fl->px (find-edge-down frame parent) parent)))
+ (when (< (abs (- y-found (window-y2 window))) *snap-size*)
+ (setf (xlib:drawable-height window) (+ (xlib:drawable-height window)
+ (- y-found (adj-border-xy (window-y2 window) parent)))
+ (frame-h frame) (h-px->fl (anti-adj-border-wh (xlib:drawable-height window) parent) parent)
+ resize-h nil))))
+ (display-frame-info frame)
+ (when resize-w (setf lx x))
+ (when resize-h (setf ly y))
+ (values resize-w resize-h)))))))
+ (show-all-children))))
Modified: clfswm/src/config.lisp
==============================================================================
--- clfswm/src/config.lisp (original)
+++ clfswm/src/config.lisp Tue Apr 19 17:07:09 2011
@@ -53,8 +53,8 @@
(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")
+(defconfig *snap-size* 20 nil
+ "Snap size (in pixels) when move or resize frame is constrained")
;;; CONFIG - Screen size
Modified: clfswm/src/xlib-util.lisp
==============================================================================
--- clfswm/src/xlib-util.lisp (original)
+++ clfswm/src/xlib-util.lisp Tue Apr 19 17:07:09 2011
@@ -84,6 +84,15 @@
+(declaim (inline window-x2 window-y2))
+(defun window-x2 (window)
+ (+ (xlib:drawable-x window) (xlib:drawable-width window)))
+
+(defun window-y2 (window)
+ (+ (xlib:drawable-y window) (xlib:drawable-height window)))
+
+
+
;;;
;;; Events management functions.
;;;
@@ -246,7 +255,6 @@
(xlib:kill-client *display* (xlib:window-id window)))
-
;;(defconstant +exwm-atoms+
;; (list "_NET_SUPPORTED" "_NET_CLIENT_LIST"
;; "_NET_CLIENT_LIST_STACKING" "_NET_NUMBER_OF_DESKTOPS"
More information about the clfswm-cvs
mailing list