[Eclipse-cvs] CVS eclipse
ihatchondo
ihatchondo at common-lisp.net
Thu Apr 24 08:24:45 UTC 2008
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))))))
More information about the Eclipse-cvs
mailing list