[Eclipse-cvs] CVS update: eclipse/move-resize.lisp eclipse/global.lisp
Iban Hatchondo
ihatchondo at common-lisp.net
Thu Oct 9 11:36:18 UTC 2003
Update of /project/eclipse/cvsroot/eclipse
In directory common-lisp.net:/tmp/cvs-serv21678
Modified Files:
move-resize.lisp global.lisp
Log Message:
- The screen edges resistance is implemented.
To configure it use *screen-edge-resistant-p*.
Set it to nil if you don't want to feel any resistance when
attempting to move a window outside the screen boundaries. Default
value is t.
- The window edges resistance is also implemented.
To configure it use *standard-window-edge-resistant-p*.
Set it to nil if you don't want to feel any resistance on
edges of window(s) you are about to overlap. Default value is t.
Date: Thu Oct 9 07:36:18 2003
Author: ihatchondo
Index: eclipse/move-resize.lisp
diff -u eclipse/move-resize.lisp:1.6 eclipse/move-resize.lisp:1.7
--- eclipse/move-resize.lisp:1.6 Mon Oct 6 13:57:26 2003
+++ eclipse/move-resize.lisp Thu Oct 9 07:36:18 2003
@@ -1,5 +1,5 @@
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: move-resize.lisp,v 1.6 2003/10/06 17:57:26 ihatchondo Exp $
+;;; $Id: move-resize.lisp,v 1.7 2003/10/09 11:36:18 ihatchondo Exp $
;;;
;;; ECLIPSE. The Common Lisp Window Manager.
;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -278,12 +278,88 @@
(setf *card-point* nil))
;;;; Move.
-
+
+(defvar *screen-windows* nil)
+
+(defun region-intersect-region-p (x y w h x2 y2 w2 h2)
+ "Returns true if the rectangular regions, described by the two four-uple
+ `x y w h', have a not empty intersection."
+ (declare (optimize (speed 3) (safety 0)))
+ (declare (type (signed-byte 16) x y x2 y2))
+ (declare (type (unsigned-byte 16) w h w2 h2))
+ (or (and (<= x (+ x2 w2)) (<= x2 (+ x w)) (<= y (+ y2 h2)) (<= y2 (+ y h)))
+ (and (<= x2 (+ x w)) (<= x (+ x2 w2)) (<= y2 (+ y h)) (<= y (+ y2 h2)))))
+
+(defun region-intersect-window-in-screen (x y w h &rest windows-to-skip)
+ "Returns a window list that has an intersection with the given region
+ (defines by the four-uple `x y w h'). The windows-to-skip argument is
+ a list of window that should not be used."
+ (declare (optimize (speed 3) (safety 0)))
+ (declare (type (signed-byte 16) x y))
+ (declare (inline region-intersect-region-p))
+ (declare (type (unsigned-byte 16) w h))
+ (loop for win in *screen-windows*
+ for master = (application-master (lookup-widget win))
+ when master do (setf win (widget-window master)) end
+ when (and (not (member win windows-to-skip :test #'xlib:window-equal))
+ (multiple-value-bind (x2 y2 w2 h2) (window-geometry win)
+ (declare (type (signed-byte 16) x2 y2))
+ (declare (type (unsigned-byte 16) w2 h2))
+ (region-intersect-region-p x y w h x2 y2 w2 h2)))
+ collect win))
+
+(defun perform-dock (window x y)
+ "Returns the new coordinates of the window if it needs do be docked on
+ one or two window present on that desktop. Otherwise x and y will be
+ returned. Arguments x, y represent the hypotheticals future coordinates."
+ (declare (optimize (speed 3) (safety 0)))
+ (declare (type (signed-byte 16) x y))
+ (multiple-value-bind (x1 y1 w1 h1) (window-geometry window)
+ (declare (type (signed-byte 16) x1 y1))
+ (declare (type (unsigned-byte 16) w1 h1))
+ (loop with x-already-set-p and y-already-set-p
+ for win in (region-intersect-window-in-screen x y w1 h1 window)
+ do (multiple-value-bind (x2 y2 w2 h2) (window-geometry win)
+ (declare (type (signed-byte 16) x2 y2))
+ (declare (type (unsigned-byte 16) w2 h2))
+ (unless x-already-set-p
+ (cond ((and (<= (+ x1 w1) x2) (<= -40 (- x2 x w1) 0))
+ (setf x (- x2 w1)) (setf x-already-set-p t))
+ ((and (>= x1 (+ x2 w2)) (<= -40 (- x x2 w2) 0))
+ (setf x (+ x2 w2)) (setf x-already-set-p t))))
+ (unless y-already-set-p
+ (cond ((and (>= y1 (+ y2 h2)) (<= -40 (- y y2 h2) 0))
+ (setf y (+ y2 h2)) (setf y-already-set-p t))
+ ((and (<= (+ y1 h1) y2) (<= -40 (- y2 y h1) 0))
+ (setf y (- y2 h1)) (setf y-already-set-p t)))))
+ when (and x-already-set-p y-already-set-p) do (loop-finish)
+ finally (return (values x y)))))
+
+(defun perform-root-dock (window x y)
+ "Returns the new coordinates of the window if it needs do be docked
+ on the root window. Otherwise x and y will be returned.
+ Arguments x, y represent the hypotheticals future coordinates."
+ (declare (optimize (speed 3) (safety 0)))
+ (declare (type (signed-byte 16) x y))
+ (multiple-value-bind (x1 y1 w1 h1) (window-geometry window)
+ (declare (type (signed-byte 16) x1 y1))
+ (declare (type (unsigned-byte 16) w1 h1))
+ (and (>= x1 0) (< -40 x 0) (setf x 0))
+ (and (>= y1 0) (< -40 y 0) (setf y 0))
+ (let ((scr-w (screen-width)) (scr-h (screen-height)))
+ (declare (type (unsigned-byte 16) scr-w scr-h))
+ (and (>= (- scr-w x1 w1) 0) (< -40 (- scr-w x w1) 0)
+ (setf x (- scr-w w1)))
+ (and (>= (- scr-h y1 h1) 0) (< -40 (- scr-h y h1) 0)
+ (setf y (- scr-h h1)))))
+ (values x y))
+
(defmethod initialize-move ((widget base-widget) (event button-press))
"Initialize internal values for animating the future widget movements."
(with-slots (window active-p) widget
(setf (window-priority window) :above)
(setf active-p t
+ *screen-windows* (get-screen-content (current-desk))
*delta-x* (- (event-root-x event) (xlib:drawable-x window))
*delta-y* (- (event-root-y event) (xlib:drawable-y window)))))
@@ -291,27 +367,24 @@
(let ((app-window (get-child master :application :window t)))
(when (or (member :win_state_fixed_position (gnome:win-state app-window))
(member :_net_wm_state_sticky (netwm:net-wm-state app-window)))
- (setf (decoration-active-p master) nil))))
+ (setf (decoration-active-p master) nil
+ *screen-windows* nil))))
(defun move-widget (widget event &optional verbose-p mode)
(declare (optimize (speed 3) (safety 0)))
(with-slots (window active-p gcontext) widget
(when active-p
(let ((new-x (- (the (signed-byte 16) (event-root-x event)) *delta-x*))
- (new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*))
- (scr-w (screen-width)) (scr-h (screen-height)))
+ (new-y (- (the (signed-byte 16) (event-root-y event)) *delta-y*)))
(declare (type (signed-byte 16) new-x new-y))
- (declare (type (unsigned-byte 16) scr-w scr-h))
- (multiple-value-bind (x y w h)
- (window-geometry (if (eq mode :box) (widget-window *clone*) window))
- (declare (type (signed-byte 16) x y))
- (declare (type (unsigned-byte 16) w h))
- (when (and (>= x 0) (< -40 new-x 0)) (setf new-x 0))
- (when (and (>= y 0) (< -40 new-y 0)) (setf new-y 0))
- (when (and (>= (- scr-w x w) 0) (< -40 (- scr-w new-x w) 0))
- (setf new-x (- scr-w w)))
- (when (and (>= (- scr-h y h) 0) (< -40 (- scr-h new-y h) 0))
- (setf new-y (- scr-h h))))
+ (let ((aux (if (eq mode :box) (widget-window *clone*) window)))
+ (declare (inline perform-dock perform-root-dock))
+ (when *standard-window-edge-resistant-p*
+ (multiple-value-setq (new-x new-y)
+ (perform-dock aux new-x new-y)))
+ (when *screen-edge-resistant-p*
+ (multiple-value-setq (new-x new-y)
+ (perform-root-dock aux new-x new-y))))
(when verbose-p (display-coordinates new-x new-y))
(if (and (decoration-p widget) (eql mode :box))
(with-slots (window) *clone*
@@ -331,4 +404,5 @@
(when (get-child master :title-bar)
(with-slots (armed active-p) (get-child master :title-bar)
(setf armed nil active-p nil)))
- (send-configuration-notify (get-child master :application :window t)))
+ (send-configuration-notify (get-child master :application :window t))
+ (setf *screen-windows* nil))
Index: eclipse/global.lisp
diff -u eclipse/global.lisp:1.12 eclipse/global.lisp:1.13
--- eclipse/global.lisp:1.12 Mon Oct 6 13:57:26 2003
+++ eclipse/global.lisp Thu Oct 9 07:36:18 2003
@@ -1,5 +1,5 @@
;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: global.lisp,v 1.12 2003/10/06 17:57:26 ihatchondo Exp $
+;;; $Id: global.lisp,v 1.13 2003/10/09 11:36:18 ihatchondo Exp $
;;;
;;; This file is part of Eclipse.
;;; Copyright (C) 2001, 2002 Iban HATCHONDO
@@ -66,6 +66,8 @@
(defparameter *cycle-icons-p* t "Alt-Tab shows or not iconified windows.")
(defparameter *focus-new-mapped-window* t)
(defparameter *focus-when-window-cycle* t)
+(defparameter *screen-edge-resistant-p* t)
+(defparameter *standard-window-edge-resistant-p* t)
(defparameter *double-click-speed* 200 "the speed of the double click")
(defparameter *move-mode* :opaque "values are: :box :opaque")
(defparameter *resize-mode* :opaque "values are: :box :opaque")
More information about the Eclipse-cvs
mailing list