Update of /project/eclipse/cvsroot/eclipse In directory clnet:/tmp/cvs-serv4432

Modified Files: widgets.lisp rectangles.lisp Log Message: Fix: - rectangles: window->rectangle transformation is now correct. rectangle->width/heigth computation is now correct. netwm-struts usage was partially incorrect and has been fixed. sub-rectangles computation now returns rectangles that does not overlap anymore - widgets: find-max-geometry updated according to changes in the rectangle api.

--- /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/23 15:16:32 1.52 +++ /project/eclipse/cvsroot/eclipse/widgets.lisp 2008/04/24 08:24:45 1.53 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: widgets.lisp,v 1.52 2008/04/23 15:16:32 ihatchondo Exp $ +;;; $Id: widgets.lisp,v 1.53 2008/04/24 08:24:45 ihatchondo Exp $ ;;; ;;; ECLIPSE. The Common Lisp Window Manager. ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO @@ -292,26 +292,27 @@

;; Maximization helpers. (defun find-max-geometry (application direction fill-p &key x y w h) - (multiple-value-bind (ulx uly lrx lry) - (find-largest-empty-area - application - :area-include-me-p (or (/= 1 direction) fill-p) - :panels-only-p (not fill-p) - :direction (case direction (2 :vertical) (3 :horizontal) (t :both))) + (multiple-value-bind (rx ry rw rh) + (rectangle-geometry + (find-largest-empty-area + application + :area-include-me-p (or (/= 1 direction) fill-p) + :panels-only-p (not fill-p) + :direction (case direction (2 :vertical) (3 :horizontal) (t :both)))) (with-slots (window master) application (with-slots ((hm hmargin) (vm vmargin)) - (if master (decoration-frame-style master) - (theme-default-style (lookup-theme "no-decoration"))) - (symbol-macrolet ((minw (aref wmsh 0)) (minh (aref wmsh 1)) - (maxw (aref wmsh 2)) (maxh (aref wmsh 3)) - (incw (aref wmsh 4)) (inch (aref wmsh 5)) - (basew (aref wmsh 6)) (baseh (aref wmsh 7))) - (let* ((wmsh (recompute-wm-normal-hints window hm vm)) - (ww (or w (check-size (- lrx ulx hm) basew incw minw maxw))) - (hh (or h (check-size (- lry uly vm) baseh inch minh maxh)))) - (when (> (+ ww hm) (- lrx ulx)) (decf ww incw)) - (when (> (+ hh vm) (- lry uly)) (decf hh inch)) - (make-geometry :w ww :h hh :x (or x ulx) :y (or y uly)))))))) + (if master (decoration-frame-style master) + (theme-default-style (lookup-theme "no-decoration"))) + (symbol-macrolet ((minw (aref wmsh 0)) (minh (aref wmsh 1)) + (maxw (aref wmsh 2)) (maxh (aref wmsh 3)) + (incw (aref wmsh 4)) (inch (aref wmsh 5)) + (basew (aref wmsh 6)) (baseh (aref wmsh 7))) + (let* ((wmsh (recompute-wm-normal-hints window hm vm)) + (ww (or w (check-size (- rw hm) basew incw minw maxw))) + (hh (or h (check-size (- rh vm) baseh inch minh maxh)))) + (when (> (+ ww hm) rw) (decf ww incw)) + (when (> (+ hh vm) rh) (decf hh inch)) + (make-geometry :w ww :h hh :x (or x rx) :y (or y ry))))))))

(defun compute-max-geometry (application x y w h direction fill-p vert-p horz-p) --- /project/eclipse/cvsroot/eclipse/rectangles.lisp 2008/04/23 15:12:40 1.6 +++ /project/eclipse/cvsroot/eclipse/rectangles.lisp 2008/04/24 08:24:45 1.7 @@ -1,5 +1,5 @@ ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*- -;;; $Id: rectangles.lisp,v 1.6 2008/04/23 15:12:40 ihatchondo Exp $ +;;; $Id: rectangles.lisp,v 1.7 2008/04/24 08:24:45 ihatchondo Exp $ ;;; ;;; This file is part of Eclipse. ;;; Copyright (C) 2003 Iban HATCHONDO @@ -36,17 +36,25 @@ "Compute the area of a rectangle. The value NIL represents an empty rectangle" (if (null rectangle) 0 (multiple-value-bind (ulx uly lrx lry) (rectangle-coordinates rectangle) - (* (- lrx ulx) (- lry uly))))) + (* (1+ (- lrx ulx)) (1+ (- lry uly))))))

(declaim (inline rectangle-width)) (defun rectangle-width (rect) "Returns the width of a rectangle." - (if (null rect) 0 (- (rectangle-lrx rect) (rectangle-ulx rect)))) + (if (null rect) 0 (1+ (- (rectangle-lrx rect) (rectangle-ulx rect)))))

(declaim (inline rectangle-height)) (defun rectangle-height (rect) "Returns the height of a rectangle." - (if (null rect) 0 (- (rectangle-lry rect) (rectangle-uly rect)))) + (if (null rect) 0 (1+ (- (rectangle-lry rect) (rectangle-uly rect))))) + +(declaim (inline rectangle-height)) +(defun rectangle-geometry (rect) + "Returns the x y width and height of a rectangle as a multiple value." + (if (null rect) + (values 0 0 0 0) + (multiple-value-bind (ulx uly lrx lry) (rectangle-coordinates rect) + (values ulx uly (1+ (- lrx ulx)) (1+ (- lry uly))))))

(defun rectangle-surface< (rectangle1 rectangle2) (< (rectangle-surface rectangle1) (rectangle-surface rectangle2))) @@ -72,16 +80,16 @@ (declare (type (signed-byte 16) ulx1 uly1 lrx1 lry1)) (multiple-value-bind (ulx2 uly2 lrx2 lry2) (rectangle-coordinates inside) (declare (type (signed-byte 16) ulx2 uly2 lrx2 lry2)) - (let ((seq (list))) - (when (< uly1 uly2) ; defines the north sub rectangle. - (push (make-rectangle :ulx ulx1 :uly uly1 :lrx lrx1 :lry uly2) seq)) - (when (< ulx1 ulx2) ; defines the west sub rectangle. - (push (make-rectangle :ulx ulx1 :uly uly1 :lrx ulx2 :lry lry1) seq)) - (when (< lry2 lry1) ; defines the south sub rectangle. - (push (make-rectangle :ulx ulx1 :uly lry2 :lrx lrx1 :lry lry1) seq)) - (when (< lrx2 lrx1) ; defines the east sub rectangle. - (push (make-rectangle :ulx lrx2 :uly uly1 :lrx lrx1 :lry lry1) seq)) - (stable-sort seq #'rectangle-surface>=))))) + (let ((l (list))) + (when (< uly1 (1- uly2)) ; defines the north sub rectangle. + (push (make-rectangle :ulx ulx1 :uly uly1 :lrx lrx1 :lry (1- uly2)) l)) + (when (< ulx1 (1- ulx2)) ; defines the west sub rectangle. + (push (make-rectangle :ulx ulx1 :uly uly1 :lrx (1- ulx2) :lry lry1) l)) + (when (< (1+ lry2) lry1) ; defines the south sub rectangle. + (push (make-rectangle :ulx ulx1 :uly (1+ lry2) :lrx lrx1 :lry lry1) l)) + (when (< (1+ lrx2) lrx1) ; defines the east sub rectangle. + (push (make-rectangle :ulx (1+ lrx2) :uly uly1 :lrx lrx1 :lry lry1) l)) + (stable-sort l #'rectangle-surface>=)))))

(defun overlap-p (rect1 rect2) "Returns true if rectangle1 intersects rectangle2." @@ -131,25 +139,27 @@ (defun window->rectangle (window) "Returns the rectangle that represent this window." (multiple-value-bind (x y w h) (window-geometry window) - (make-rectangle :ulx x :uly y :lrx (+ x w) :lry (+ y h)))) + (make-rectangle :ulx x :uly y :lrx (+ x (1- w)) :lry (+ y (1- h))))) + +(defun window->rectangle-coordinates (window) + "Returns the rectangle coordinates that represent this window." + (multiple-value-bind (x y w h) (window-geometry window) + (values x y (+ x (1- w)) (+ y (1- h)))))

(defun compute-screen-rectangles (application &optional filter-overlap-p) "Gets screen content according to desktop number and filter all windows that are overlaped by the given one except if filter-overlap-p is NIL. Returns a list of rectangles that represent all the founded windows." (with-slots (window master) application - (multiple-value-bind (xx yy ww hh) - (window-geometry (if master (widget-window master) window)) + (let ((rect (window->rectangle (if master (widget-window master) window)))) (flet ((predicate (win n icon taskbar desktop dock) (cond ((xlib:window-equal window win) nil) ((window-belongs-to-vscreen-p win n icon taskbar desktop dock) (not (and filter-overlap-p - (multiple-value-bind (x y w h) - (with-slots ((m master)) (lookup-widget win) - (window-geometry (if m (widget-window m) win))) - (and (< xx (+ x w)) (< x (+ xx ww)) - (< yy (+ y h)) (< y (+ yy hh))))))) + (with-slots ((m master)) (lookup-widget win) + (let ((win2 (if m (widget-window m) win))) + (overlap-p rect (window->rectangle win2))))))) (t (window-panel-p win n icon))))) (mapcar (lambda (win) @@ -165,7 +175,9 @@ (lambda (win) (multiple-value-bind (l r to b lsy ley rsy rey tsx tex bsx bex) (netwm:net-wm-strut-partial win) - (multiple-value-bind (w h) (drawable-sizes (xlib:drawable-root win)) + (multiple-value-bind (x y w h) + (window->rectangle-coordinates (xlib:drawable-root win)) + (declare (ignorable x y)) (unless l (multiple-value-setq (l r to b) (netwm:net-wm-strut win)) (multiple-value-setq (lsy ley rsy rey tsx tex bsx bex) @@ -173,10 +185,14 @@ (unless (and l r to b) (setf (values l r to b) (values 0 0 0 0)))) (cond - ((/= 0 l) (make-rectangle :ulx 0 :uly lsy :lrx l :lry ley)) - ((/= 0 r) (make-rectangle :ulx (- w r) :uly rsy :lrx w :lry rey)) - ((/= 0 to) (make-rectangle :ulx tsx :uly 0 :lrx tex :lry to)) - ((/= 0 b) (make-rectangle :ulx bsx :uly (- h b) :lrx bex :lry h)) + ((/= 0 l) + (make-rectangle :ulx 0 :uly lsy :lrx (1- l) :lry ley)) + ((/= 0 r) + (make-rectangle :ulx (- w (1- r)) :uly rsy :lrx w :lry rey)) + ((/= 0 to) + (make-rectangle :ulx tsx :uly 0 :lrx tex :lry (1- to))) + ((/= 0 b) + (make-rectangle :ulx bsx :uly (- h (1- b)) :lrx bex :lry h)) (t (window->rectangle win)))))) (screen-content scr-num :predicate predicate)))

@@ -210,7 +226,8 @@ - :direction (or :vertical :horizontal :both) to indicate wat kind of region the search should be looking for." (with-slots (window (m master)) application - (multiple-value-bind (w h) (drawable-sizes (xlib:drawable-root window)) + (multiple-value-bind (x y w h) + (window->rectangle-coordinates (xlib:drawable-root window)) (let ((app-rect (window->rectangle (if m (widget-window m) window))) (rectangles (find-empty-rectangles (make-rectangle :lrx w :lry h) @@ -224,18 +241,16 @@ (:vertical #'rectangle-height>=) (t #'rectangle-surface>=))))) ;; clip the application window rectangle to fit in the root one. - (when (< (rectangle-ulx app-rect) 0) (setf (rectangle-ulx app-rect) 0)) - (when (< (rectangle-uly app-rect) 0) (setf (rectangle-uly app-rect) 0)) + (when (< (rectangle-ulx app-rect) x) (setf (rectangle-ulx app-rect) x)) + (when (< (rectangle-uly app-rect) y) (setf (rectangle-uly app-rect) y)) (when (> (rectangle-lrx app-rect) w) (setf (rectangle-lrx app-rect) w)) (when (> (rectangle-lry app-rect) h) (setf (rectangle-lry app-rect) h)) ;; returns the appropriated area. - (multiple-value-call #'values - (if rectangles - (rectangle-coordinates - (if area-include-me-p - (loop for r in rectangles + (values + (cond ((and rectangles area-include-me-p) + (loop for r in rectangles when (include-p r app-rect) do (return r) - finally (return (car rectangles))) - (car rectangles))) - (values 0 0 w h)) - (if rectangles T NIL)))))) + finally (return (car rectangles)))) + (rectangles (car rectangles)) + (t (window->rectangle (xlib:drawable-root window)))) + (if rectangles T NIL))))))