From ihatchondo at common-lisp.net  Wed Apr 23 09:54:47 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Wed, 23 Apr 2008 05:54:47 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080423095447.24440743DB@common-lisp.net>

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

Modified Files:
	global.lisp input.lisp misc.lisp wm.lisp 
Log Message:
Fix: netwm-user-time usage, and some withdrawal glitches.

--- /project/eclipse/cvsroot/eclipse/global.lisp	2005/03/01 22:41:31	1.29
+++ /project/eclipse/cvsroot/eclipse/global.lisp	2008/04/23 09:54:46	1.30
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: global.lisp,v 1.29 2005/03/01 22:41:31 ihatchondo Exp $
+;;; $Id: global.lisp,v 1.30 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2001, 2002 Iban HATCHONDO
@@ -37,7 +37,7 @@
     :_net_current_desktop :_net_active_window :_net_close_window :_net_workarea
     :_net_wm_desktop :_net_wm_window_type :_net_desktop_names
     :_net_restack_window :_net_moveresize_window :_net_wm_user_time
-    :_net_request_frame_extents :_net_frame_extents 
+    :_net_wm_user_time_window :_net_request_frame_extents :_net_frame_extents 
     :_net_wm_strut_partial :_net_wm_state :_net_wm_strut
     :_net_wm_window_type_desktop :_net_wm_window_type_dock
     :_net_wm_window_type_toolbar :_net_wm_window_type_menu
--- /project/eclipse/cvsroot/eclipse/input.lisp	2007/05/07 13:22:50	1.47
+++ /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/23 09:54:46	1.48
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: input.lisp,v 1.47 2007/05/07 13:22:50 ihatchondo Exp $
+;;; $Id: input.lisp,v 1.48 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -146,7 +146,14 @@
 		 (undecore-application widget :state 0)
 		 (setf (wm-state window) 3)))))
 	(decoration 
-	 (setf (wm-state (get-child widget :application :window t)) 3))))))
+         (let ((application (get-child widget :application)))
+           (if (application-iconic-p application)
+               (setf (wm-state (widget-window application)) 3)
+               (with-slots (window send-event-p) event
+                 (setf send-event-p t)
+                 (setf window (widget-window application))
+                 (format t "about to withdraw: ~a ~%" (wm-name window))
+                 (event-process event root)))))))))
 
 (defmethod event-process ((event destroy-notify) (root root))
   (let ((app (lookup-widget (event-window event))))
@@ -427,9 +434,9 @@
 	 (with-slots ((pwindow window)) (root-property-holder *root*)
 	   (let* ((length (length data))
 		  (time (if (> length 1) (aref data 1) 0))
-		  (wtime (or (netwm:net-wm-user-time pwindow) 0)))
+		  (wtime (or (net-wm-user-time pwindow) 0)))
 	     (unless (> wtime time 0)
-	       (setf (netwm:net-wm-user-time pwindow) time)
+	       ;;(setf (netwm:net-wm-user-time pwindow) time)
 	       (focus-widget application time)
 	       (put-on-top application)))))
 	(:_net_wm_desktop (migrate-application application (aref data 0)))
--- /project/eclipse/cvsroot/eclipse/misc.lisp	2007/11/02 09:33:08	1.40
+++ /project/eclipse/cvsroot/eclipse/misc.lisp	2008/04/23 09:54:46	1.41
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: misc.lisp,v 1.40 2007/11/02 09:33:08 ihatchondo Exp $
+;;; $Id: misc.lisp,v 1.41 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -44,10 +44,11 @@
 (defmacro current-desk () `(current-vscreen *root-window*))
 
 (defmacro id->atom-name (id)
-  `(xlib:atom-name *display* ,id))
+  `(when (typep ,id 'xlib:card29)
+     (xlib:atom-name *display* ,id)))
 
 (defmacro atom-name->id (name)
- `(xlib:find-atom *display* ,name))
+  `(xlib:find-atom *display* ,name))
 
 (defmacro with-root-cursor ((new-cursor) &body body)
   `(unwind-protect
@@ -176,6 +177,19 @@
   (or (= (or (window-desktop-num window) -1) +any-desktop+)
       (logbitp 0 (or (gnome:win-state window :result-type t) 0))))
 
+(defun net-wm-user-time (window) 
+  "Returns the _net_wm_user_time property using the _net_wm_user_time_window
+   if present. If the property is not defined return NIL."
+  (let ((user-time-window (netwm:net-wm-user-time-window window)))
+    (netwm:net-wm-user-time (or user-time-window window))))
+
+(defsetf net-wm-user-time (window) (timestamp)
+  "Sets the _net_wm_user_time property using the _net_wm_user_time_window
+   if present, otherwise window is the property holder."
+  (let ((time-window (gensym)))
+    `(let ((,time-window (netwm:net-wm-user-time-window ,window)))
+       (setf (netwm:net-wm-user-time (or ,time-window ,window)) ,timestamp))))
+
 ;;;; Miscellaneous functions.
 
 (defun grab-root-pointer (&key cursor owner-p confine-to)
--- /project/eclipse/cvsroot/eclipse/wm.lisp	2007/05/04 08:26:14	1.52
+++ /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/23 09:54:46	1.53
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: wm.lisp,v 1.52 2007/05/04 08:26:14 ihatchondo Exp $
+;;; $Id: wm.lisp,v 1.53 2008/04/23 09:54:46 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -686,7 +686,7 @@
 
 (defun procede-decoration (window)
   "Decore, if necessary, add/update properties, map or not, etc a window."
-  (let* ((time (or (ignore-errors (netwm:net-wm-user-time window)) 1))
+  (let* ((time (or (ignore-errors (net-wm-user-time window)) 1))
 	 (rw (xlib:drawable-root window))
 	 (scr-num (current-vscreen rw))
 	 (application (create-application window nil))



From ihatchondo at common-lisp.net  Wed Apr 23 15:12:41 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Wed, 23 Apr 2008 11:12:41 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080423151241.8E8E15002@common-lisp.net>

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

Modified Files:
	rectangles.lisp 
Log Message:
Fix: improper area returnes when no area includes the desired window.

--- /project/eclipse/cvsroot/eclipse/rectangles.lisp	2007/05/08 22:30:47	1.5
+++ /project/eclipse/cvsroot/eclipse/rectangles.lisp	2008/04/23 15:12:40	1.6
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: rectangles.lisp,v 1.5 2007/05/08 22:30:47 ihatchondo Exp $
+;;; $Id: rectangles.lisp,v 1.6 2008/04/23 15:12:40 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2003 Iban HATCHONDO
@@ -93,7 +93,7 @@
       (and (< ulx1 lrx2) (< ulx2 lrx1) (< uly1 lry2) (< uly2 lry1)))))
 
 (defun include-p (rect1 rect2)
-  "Return true if rectangle1 is included in rectangle2."
+  "Return true if rectangle2 is included in rectangle1."
   (declare (optimize (speed 3) (safety 0)))
   (multiple-value-bind (ulx1 uly1 lrx1 lry1) (rectangle-coordinates rect1)
     (declare (type (signed-byte 16) ulx1 uly1 lrx1 lry1))
@@ -233,8 +233,9 @@
 	  (if rectangles
 	      (rectangle-coordinates
 	       (if area-include-me-p
-		   (loop for r in rectangles until (include-p r app-rect)
-			 finally (return r))
+		   (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))))))



From ihatchondo at common-lisp.net  Wed Apr 23 15:16:35 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Wed, 23 Apr 2008 11:16:35 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080423151635.E98A716036@common-lisp.net>

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

Modified Files:
	widgets.lisp 
Log Message:
Fix: improper variable usage in defsetf. So in order to avoid glitches set-.. created, and defsetf calls it.

--- /project/eclipse/cvsroot/eclipse/widgets.lisp	2007/11/02 09:33:08	1.51
+++ /project/eclipse/cvsroot/eclipse/widgets.lisp	2008/04/23 15:16:32	1.52
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: widgets.lisp,v 1.51 2007/11/02 09:33:08 ihatchondo Exp $
+;;; $Id: widgets.lisp,v 1.52 2008/04/23 15:16:32 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -377,43 +377,46 @@
 
 (defsetf fullscreen-mode (application) (mode)
   "Mode may be (or :on :off). Put or remove application in or from fullscreen."
-  `(with-slots (window (fgeometry full-geometry) master icon) ,application
-     ;; reset appropriately _net_wm_state property.
-     (let ((prop (netwm:net-wm-state window)))
-       (if (eq ,mode :on)
-	   (pushnew :_net_wm_state_fullscreen prop)
-	   (setf prop (delete :_net_wm_state_fullscreen prop)))
-       (setf (netwm:net-wm-state window) prop))
-     (if (eq ,mode :on)
-	 ;; put in fullscreen mode.
-	 (with-event-mask (*root-window*)
-	   (multiple-value-bind (x y w h) (window-geometry window)
-	     (when master
-	       (with-slots (children (master-win window) frame-style) master
-		 (multiple-value-setq (x y) (window-position master-win))
-		 (setf (slot-value master 'old-frame-style) frame-style)
-		 (setf (decoration-frame-style master)
-		       (theme-default-style (lookup-theme "no-decoration")))))
-	     (setf (geometry fgeometry) (values x y w h))
-	     (if (xlib:query-extension *display* "XFree86-VidModeExtension")
-		 (let* ((scr (first (xlib:display-roots *display*)))
-			(ml (xlib:xfree86-vidmode-get-mode-line *display* scr)))
-		   (multiple-value-setq (x y) 
-		     (xlib:xfree86-vidmode-get-viewport *display* scr))
-		   (setf w (xlib:mode-info-hdisplay ml)
-			 h (xlib:mode-info-vdisplay ml)))
-		 (setf x 0 y 0 w (screen-width) h (screen-height)))
-	     (configure-window window :x x :y y :width w :height h))
-	   (focus-widget ,application 0))
-	 ;; revert: restore precedent geometry and decoration style.
-	 (with-event-mask (*root-window*)
-	   (setf (drawable-sizes window) (geometry-sizes fgeometry))
-	   (unless (window-not-decorable-p window)
-	     (setf (decoration-frame-style master)
-		   (slot-value master 'old-frame-style)))
-	   (multiple-value-bind (x y) (geometry-coordinates fgeometry)
-	     (with-slots (window) (or master ,application)
-	       (configure-window window :x x :y y)))))))
+  `(set-fullscreen-mode ,application ,mode))
+
+(defun set-fullscreen-mode (application mode)
+  (with-slots (window (fgeometry full-geometry) master icon) application
+    ;; reset appropriately _net_wm_state property.
+    (let ((prop (netwm:net-wm-state window)))
+      (if (eq mode :on)
+          (pushnew :_net_wm_state_fullscreen prop)
+          (setf prop (delete :_net_wm_state_fullscreen prop)))
+      (setf (netwm:net-wm-state window) prop))
+    (if (eq mode :on)
+        ;; put in fullscreen mode.
+        (with-event-mask (*root-window*)
+          (multiple-value-bind (x y w h) (window-geometry window)
+            (when master
+              (with-slots (children (master-win window) frame-style) master
+                (multiple-value-setq (x y) (window-position master-win))
+                (setf (slot-value master 'old-frame-style) frame-style)
+                (setf (decoration-frame-style master)
+                      (theme-default-style (lookup-theme "no-decoration")))))
+            (setf (geometry fgeometry) (values x y w h))
+            (if (xlib:query-extension *display* "XFree86-VidModeExtension")
+                (let* ((scr (first (xlib:display-roots *display*)))
+                       (ml (xlib:xfree86-vidmode-get-mode-line *display* scr)))
+                  (multiple-value-setq (x y) 
+                    (xlib:xfree86-vidmode-get-viewport *display* scr))
+                  (setf w (xlib:mode-info-hdisplay ml)
+                        h (xlib:mode-info-vdisplay ml)))
+                (setf x 0 y 0 w (screen-width) h (screen-height)))
+            (configure-window window :x x :y y :width w :height h))
+          (focus-widget application 0))
+        ;; revert: restore precedent geometry and decoration style.
+        (with-event-mask (*root-window*)
+          (setf (drawable-sizes window) (geometry-sizes fgeometry))
+          (unless (window-not-decorable-p window)
+            (setf (decoration-frame-style master)
+                  (slot-value master 'old-frame-style)))
+          (multiple-value-bind (x y) (geometry-coordinates fgeometry)
+            (with-slots (window) (or master application)
+              (configure-window window :x x :y y)))))))
 
 (defun application-leader (application)
   "Returns the \"leader\" of an application. The leader is computed 



From ihatchondo at common-lisp.net  Thu Apr 24 08:24:45 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Thu, 24 Apr 2008 04:24:45 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080424082445.E3DBB1B017@common-lisp.net>

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))))))



From ihatchondo at common-lisp.net  Thu Apr 24 15:29:15 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Thu, 24 Apr 2008 11:29:15 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse/docs
Message-ID: <20080424152915.65B033307E@common-lisp.net>

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

Modified Files:
	changelog eclipse.1 
Log Message:
update

--- /project/eclipse/cvsroot/eclipse/docs/changelog	2004/02/12 23:30:23	1.6
+++ /project/eclipse/cvsroot/eclipse/docs/changelog	2008/04/24 15:29:15	1.7
@@ -1,5 +1,5 @@
 -*- Mode: ChangeLog -*-
-$Id: changelog,v 1.6 2004/02/12 23:30:23 ihatchondo Exp $
+$Id: changelog,v 1.7 2008/04/24 15:29:15 ihatchondo Exp $
 0.01 => 0.02
 
      Eclipse should now compile on every ANSI-compliant Common Lisp
@@ -333,7 +333,7 @@
 
      - move resize improvements:
 
-       We now use the :pointer-potion-hint in the event-mask. The server
+       We now use the :pointer-motion-hint in the event-mask. The server
        is now free to send only one :motion-notify event, until either the
        key or button state changes, the pointer leaves the event window,
        or the client calls query-pointer or motion-events. 
@@ -375,24 +375,155 @@
 	  - add event handling for map-request on decoration.
 	
      - bug fix and code clean up and more hacking.
-       - error handling at start up.
-       - close-sm-connection (widget.lisp)
-       - (event-process selection-notify null)
-       - bug fix and typo in gestures.lisp
-       - bug fix in ewmh implementation.
-       - ...
+	- error handling at start up.
+	- close-sm-connection (widget.lisp)
+	- (event-process selection-notify null)
+	- bug fix and typo in gestures.lisp
+	- bug fix in ewmh implementation.
+	- ...
 
 O.10 => 0.11
+     - Daniel's Barlow feedbacks implemented:
+       eclipse has now a new keyword parmeter: :die-on-init-error that is
+       used in the starting script. If nil then error during init will
+       drop in the debugger allowing you to debug nicely without any
+       "extra" hacking. If T then it will catch ini errors and quit. 
+
+     - Luca Capello Patch applied: When compiled without dumping an
+       image file, the way eclipse is started wasn't up to
+       date. (latest options of eclipse:eclipse was not handled by
+       the start function). 
+
+     - compile.lisp has been removed. Compilation/Load operations are
+       defined in eclipse/system.lisp.
+
+     - system(s).lisp files now handles asdsf system description as
+       well as mk-defsystem. Both system are created if both package
+       present in the lisp environment. 
+
+     - added an asdf:operate :around overload for sbcl to avoid
+       compilation warnings relatives to structured constant
+       redefinition that break the compilation and drop the user into
+       the debuger. 
+
+     - six new configure options added:
+       + --with-load-switch : to indicate the command line argument of
+         the lisp machine for loading a file.
+
+       + --with-eval-switch : to indicate the command line argument of
+         the lisp machine for evaluating forms.
+
+       + --with-core-switch : to indicate the command line argument of
+         the lisp machine to start it with an alternative image.
+
+       + --with-save-lisp   : to indicate the function name for saving
+           a lisp image. 
+
+       + --with-quit-form   : to indicate a particular quit form.
+
+       + --with-lisp-system : to indicate the name (the same as the
+         one that is present in *features*) of the lisp system you
+         want to use in case we know it (currently sbcl and cmu are
+         known). Use this option if you have a lisp system we know but
+         its executable is not named as expected (lisp for cmucl and
+         sbcl for sbcl for instance).  
+
+     - eclipse: new option --activate-log
+
+     - change in the movement handlers that allow undecorated windows
+       (xmms for example) to moved through mouse strokes or menu.
+       (input.lisp gestures.lisp move-resize.lisp wm.lisp)
+
+     - group of windows (such as described in the ICCCM) are now honored:
+       transient-for windows are supposed to be stack under their
+       dialogs. As another effect, iconifying or sending to another
+       desktop one window of a group affect the entire group.  
+
+     - a new option is now available:
+       *save-and-restore-pointer-position-during-workspace-switch*
+       that allows to save pointer position before switching from a
+       desktop to another and restore previous position when arriving on
+       the new one. (misc.lisp virtual-screen.lisp) This has been done via
+       a private property on the root window named:
+       _ECLIPSE_DESKTOP_POINTER_POSITIONS
+
+     - Update NETWM support: according to 1.4 draft2, note that
+	nothing has been done for the compositing manager selction
+	owning, since this is a complete process to be handled rather
+	than just a property ...	 
+        + _NET_MOVERESIZE_WINDOW client message is now supported.
+        + _NET_WM_STATE_STICKY is now supported. (is it correct since
+	  Eclipse does not implements area's ?)
+        + an ECLIPSE-EXTENSIONS package is defined in order to export
+          all symbols provides by future Eclipse extensions. 
+        + Removed useless property-manager-window from the root
+          object. Instead standard-property-holder class is defined in
+          widgets.lisp. 
+	
+     - man page, compliance updated.
 
-     
-
-
-
-
-
-     
-
-
-
-
-
+     - enhancements:
+        - enhancement in the focus gestion (input.lisp) to be more
+          ICCCM complient. 
+        - added error output when die-on-init-error is T (eclipse.lisp)
+        - start function has been removed from start-eclipse.lisp.in
+          configure.in updated.
+
+     - documentation generally updated.
+
+     - bug fix, code clean up and hacking:
+	- Fix: (setf window-priority)
+	- Fix: dead windows during window cycling (gestures.lisp)
+        - gestures.lisp: macrologie simplified (may need a few lines
+          of doc). 
+	- Fix: window placement (wm.lisp) decoration where incorrectly
+          placed when user indicates its preferences (via the
+	  wm_normal_hints property)
+	- minor changes in destroy-notify handling on decoration.
+        - Fix: theme default value for title bar position.
+        - Fix: hardcoded boole function value in draw-window-grid. It
+          now use the appropriated constant. 
+        - %resize% => resize-internal
+        - Fix: event-mask wrong value: nil isn't an window-event-mask.
+          (virtual-screen.lisp) 	
+        - Fix: circulate-window keystroke: all modifiers keycodes were
+	  not took in account.  
+        - Fix: lib/clx-ext/keysyms.lisp: multiple-value-list surrounding
+	  xlib:keysym->keycodes was missing. 
+        - Fix sbcl issues with unicode and with-open-file.
+        - Fix bug in with-combo-realizer. Strokes were systematically
+          removed from the hash table.
+        - Fix: the settings of all the net-wm spec root properties is
+	  now surrounded with a with-server-grabbed to avoid tones of
+	  property change event on the root window.
+        - Fix: _net_wm_state_maximized were improperly handled when an
+	  application is newly decorated. 
+        - recomputation of the application geometry before
+	  maximization when the wm-size-hints property is changed. 
+        - Fix: handling of the _net_wm_state_maximized in configure-window
+	  (misc.lisp) 
+        - configure-window when configuring panel window should honor
+	  size without guessing anything (misc.lisp). 
+        - _net_wm__state property update before put an application in
+	  fullscreen to avoid race conditions. (widgets.lisp)
+        - Fix: map-request race condition (input.lisp & widgets.lisp)
+        - application-panel-p predicate (widgets.lisp)
+        - Fix: initial-coordinates to work the with net-workarea
+          property. 
+        - Fix: netwm-user-time usage, and some withdrawal glitches.
+        - Fix: the max sizes were not properly computed.
+        - screen-window-layer computation when the window doesn't have
+          any workspace number associated with. 
+        - Fix: make-viewport-property has only one viewport since we
+	  don't handled multiple viewport. 
+	- Fix: improper variable usage in defsetf. So in order to avoid
+	  glitches set-.. created, and defsetf calls it.
+        - Fix: window->rectangle transformation is now correct.
+        - Fix: rectangle->width/heigth computation is now correct.
+        - Fix: netwm-struts was used as coordinates rather than sizes.
+        - sub-rectangles computation now returns rectangles that does
+	  not overlap anymore
+        - Fix: 'unix' type handling in the SESSION_MANAGER scheme in
+	  ICE-lib.lisp
+        - Fix: ice & SM system load whan not loaded from the eclipse
+          directory. 
--- /project/eclipse/cvsroot/eclipse/docs/eclipse.1	2004/02/12 23:30:23	1.15
+++ /project/eclipse/cvsroot/eclipse/docs/eclipse.1	2008/04/24 15:29:15	1.16
@@ -1,12 +1,12 @@
 .TH Eclipse 1 "(c) 2001 Iban HATCHONDO"
-.\"$Id: eclipse.1,v 1.15 2004/02/12 23:30:23 ihatchondo Exp $
+.\"$Id: eclipse.1,v 1.16 2008/04/24 15:29:15 ihatchondo Exp $
 
 .SH NAME
 eclipse - a window manager in Common Lisp
 
 
 .SH SYNOPSIS
-.B eclipse [ --display=display_specification --sm-client-id=id ]
+\fB eclipse \fP[ OPTIONS ]
 
 
 .SH DESCRIPTION
@@ -70,9 +70,16 @@
 
 
 .SH OPTIONS
-\fIeclipse\fP accepts one argument. This argument allows you to
-specify a particular display connection. To use this argument give it
-as the DISPLAY environment variable. Use eclipse gandalf:2.0 for example
+.TP
+\fB--display\fP=display_specification 
+starts eclipse for managing the given X display.
+.TP
+\fB--sm-client-id\fP=ID
+specify a session management ID.
+.TP
+\fB--activate-log\fP
+specifies that errors must be logged in a file. The log file will be
+named as follows: eclipse-YYYY-MM-DD.log
 
 
 .SH MENUS



From ihatchondo at common-lisp.net  Fri Apr 25 08:42:45 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Fri, 25 Apr 2008 04:42:45 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080425084245.6DF84340C3@common-lisp.net>

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

Modified Files:
	widgets.lisp wm.lisp 
Log Message:
Fix: fullscreen state handling when decorating an application.

--- /project/eclipse/cvsroot/eclipse/widgets.lisp	2008/04/24 08:24:45	1.53
+++ /project/eclipse/cvsroot/eclipse/widgets.lisp	2008/04/25 08:42:44	1.54
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: widgets.lisp,v 1.53 2008/04/24 08:24:45 ihatchondo Exp $
+;;; $Id: widgets.lisp,v 1.54 2008/04/25 08:42:44 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -290,29 +290,39 @@
 	  (and (if max-w (= max-w (screen-width)) t)
 	       (if max-h (= max-h (screen-height)) t))))))
 
+(defun fullscreen-sizes (display)
+  "Returns the fullscreen x, y, width and height as a multiple value."
+  (if (xlib:query-extension display "XFree86-VidModeExtension")
+      (let* ((screen (xlib:display-default-screen display))
+            (ml (xlib:xfree86-vidmode-get-mode-line display screen)))
+        (multiple-value-bind (x y)
+            (xlib:xfree86-vidmode-get-viewport display screen)
+          (values x y (xlib:mode-info-hdisplay ml) (xlib:mode-info-vdisplay ml)))
+        (values 0 0 (screen-width) (screen-height)))))
+
 ;; Maximization helpers.
 (defun find-max-geometry (application direction fill-p &key x y w h)
   (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))))
+       (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 (- 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))))))))
+          (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)
@@ -399,14 +409,8 @@
                 (setf (decoration-frame-style master)
                       (theme-default-style (lookup-theme "no-decoration")))))
             (setf (geometry fgeometry) (values x y w h))
-            (if (xlib:query-extension *display* "XFree86-VidModeExtension")
-                (let* ((scr (first (xlib:display-roots *display*)))
-                       (ml (xlib:xfree86-vidmode-get-mode-line *display* scr)))
-                  (multiple-value-setq (x y) 
-                    (xlib:xfree86-vidmode-get-viewport *display* scr))
-                  (setf w (xlib:mode-info-hdisplay ml)
-                        h (xlib:mode-info-vdisplay ml)))
-                (setf x 0 y 0 w (screen-width) h (screen-height)))
+            (multiple-value-setq (x y w h)
+              (fullscreen-sizes (xlib:window-display window)))
             (configure-window window :x x :y y :width w :height h))
           (focus-widget application 0))
         ;; revert: restore precedent geometry and decoration style.
--- /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/23 09:54:46	1.53
+++ /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/25 08:42:45	1.54
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: wm.lisp,v 1.53 2008/04/23 09:54:46 ihatchondo Exp $
+;;; $Id: wm.lisp,v 1.54 2008/04/25 08:42:45 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -392,48 +392,55 @@
 (defun make-decoration (app-window application &key theme)
   "Returns a newly initialized decoration to hold the given application."
   (unless theme (setf theme (root-decoration-theme *root*)))
-  (let* ((dstyle (find-decoration-frame-style theme app-window))
-	 (style dstyle))
-    (when (member :_net_wm_state_fullscreen (netwm:net-wm-state app-window))
+  (let* ((netwm-states (ignore-errors (netwm:net-wm-state app-window)))
+         (dstyle (find-decoration-frame-style theme app-window))
+         (style dstyle)
+         (fullscreen-p (member :_net_wm_state_fullscreen netwm-states)))
+    (when fullscreen-p
       (setf style (theme-default-style (lookup-theme "no-decoration"))))
     (with-slots (hmargin vmargin left-margin top-margin background) style
-      (multiple-value-bind (wm-sizes gravity) 
-	  (recompute-wm-normal-hints app-window hmargin vmargin)
-	(multiple-value-bind (width height) (drawable-sizes app-window)
-	  (multiple-value-bind (x y) (initial-coordinates app-window style)
-	    (let* ((window (xlib:create-window
-			       :parent (xlib:drawable-root app-window)
-			       :x x :y y
-			       :width (+ width hmargin)
-			       :height (+ height vmargin)
-			       :background background
-			       :event-mask +decoration-event-mask+
-			       :do-not-propagate-mask 
-			       '(:button-press :button-release)))
-		   (master (make-instance 'decoration
-			     :window window
-			     :old-frame-style dstyle :frame-style style
-			     :children (list :application application)
-			     :application-gravity gravity
-			     :wm-size-hints wm-sizes)))
-	      (make-frame-parts master)
-	      (make-title-bar master (wm-name app-window))
-	      (update-edges-geometry master)
-	      (with-slots (icon) application
-		(setf (getf (decoration-children master) :icon) icon
-		      (slot-value icon 'master) master
-		      (slot-value application 'master) master
-		      (xlib:drawable-border-width app-window) 0))
-	      master)))))))
+      (multiple-value-bind (wm-sizes gravity)
+          (recompute-wm-normal-hints app-window hmargin vmargin)
+        (multiple-value-bind (width height) (drawable-sizes app-window)
+          (multiple-value-bind (x y) (initial-coordinates app-window style)
+            (let* ((window (xlib:create-window
+                               :parent (xlib:drawable-root app-window)
+                               :x x :y y
+                               :width (+ width hmargin)
+                               :height (+ height vmargin)
+                               :background background
+                               :event-mask +decoration-event-mask+
+                               :do-not-propagate-mask
+                               '(:button-press :button-release)))
+                   (master (make-instance 'decoration
+                               :window window
+                               :old-frame-style dstyle :frame-style style
+                               :children (list :application application)
+                               :application-gravity gravity
+                               :wm-size-hints wm-sizes)))
+              (make-frame-parts master)
+              (make-title-bar master (wm-name app-window))
+              (update-edges-geometry master)
+              (with-slots (icon (fgeometry full-geometry)) application
+                (setf (getf (decoration-children master) :icon) icon
+                      (slot-value icon 'master) master
+                      (slot-value application 'master) master
+                      (xlib:drawable-border-width app-window) 0)
+                (when fullscreen-p
+                  (multiple-value-bind (x y w h)
+                      (fullscreen-sizes (xlib:window-display app-window))
+                    (configure-window app-window :x x :y y :width w :height h))
+                  (setf (geometry fgeometry) (values x y width height))))
+              master)))))))
 
 (defun decore-application (window application &key (map t) theme)
   "Decores an application and map the resulting decoration as indicated
   by the :map keyword argument. (default value is T).
   Returns the newly created decoration instance."
   (let* ((master (make-decoration window application :theme theme))
-	 (master-window (widget-window master))
-	 (left-margin (style-left-margin (decoration-frame-style master)))
-	 (top-margin (style-top-margin (decoration-frame-style master))))
+         (master-window (widget-window master))
+         (left-margin (style-left-margin (decoration-frame-style master)))
+         (top-margin (style-top-margin (decoration-frame-style master))))
     (with-event-mask (master-window)
       (xlib:map-subwindows master-window))
     (with-event-mask (master-window (when map +decoration-event-mask+))



From ihatchondo at common-lisp.net  Fri Apr 25 16:02:49 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Fri, 25 Apr 2008 12:02:49 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080425160249.BDC20161C7@common-lisp.net>

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

Modified Files:
	eclipse.lisp global.lisp input.lisp misc.lisp move-resize.lisp 
	widgets.lisp wm.lisp 
Log Message:
Fix: hacking around *root-window* ...

--- /project/eclipse/cvsroot/eclipse/eclipse.lisp	2007/05/08 22:33:17	1.26
+++ /project/eclipse/cvsroot/eclipse/eclipse.lisp	2008/04/25 16:02:49	1.27
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: eclipse.lisp,v 1.26 2007/05/08 22:33:17 ihatchondo Exp $
+;;; $Id: eclipse.lisp,v 1.27 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -129,7 +129,7 @@
   (let ((first-desknum (current-vscreen window))
 	(nb-vs (number-of-virtual-screens window))
 	(srcw (screen-width)) (srch (screen-height)))
-    (xlib:with-server-grabbed (*display*)
+    (xlib:with-server-grabbed (display)
       (delete-properties window +netwm-protocol+)
       (unless (< -1 first-desknum nb-vs) (setf first-desknum 0))
       (setf (gnome:win-protocols window) +gnome-protocols+
@@ -166,7 +166,7 @@
 	    (xlib:display-after-function display) #'xlib:display-force-output)
       (setf *root* (make-instance 'root :window root-window :manager manager)
 	    *root-window* root-window
-	    (root-default-cursor *root*) (get-x-cursor *display* :xc_left_ptr)
+	    (root-default-cursor *root*) (get-x-cursor display :xc_left_ptr)
 	    (root-sm-conn *root*) (connect-to-session-manager
 				      display-specification sm-client-id))
       ;; init all gnome properties on root.
@@ -177,7 +177,7 @@
 	    *white* (xlib:screen-white-pixel screen)
 	    *background1* (xlib:alloc-color colormap *menu-color*)
 	    *background2* (xlib:alloc-color colormap *menu-hilighted-color*)
-	    *cursor-2* (get-x-cursor *display* :xc_fleur)
+	    *cursor-2* (get-x-cursor display :xc_fleur)
 	    *gctxt* (xlib:create-gcontext :drawable root-window :font menu-font)
 	    *max-char-width* (xlib:max-char-width menu-font)
 	    *gcontext* (xlib:create-gcontext
--- /project/eclipse/cvsroot/eclipse/global.lisp	2008/04/23 09:54:46	1.30
+++ /project/eclipse/cvsroot/eclipse/global.lisp	2008/04/25 16:02:49	1.31
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: global.lisp,v 1.30 2008/04/23 09:54:46 ihatchondo Exp $
+;;; $Id: global.lisp,v 1.31 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2001, 2002 Iban HATCHONDO
@@ -119,17 +119,20 @@
 (defsetf decoration-theme (&key free-old-theme-p) (name)
   "Sets the theme that must be used for window decoration. This theme will 
    be used for all existing applications as well as futur one." 
-  `(with-slots (decoration-theme) *root*
-     (let ((theme (load-theme *root-window* ,name)))
-       (when decoration-theme
-	 (loop with old-name = (theme-name decoration-theme)
-	       for val being each hash-value in *widget-table*
-	       when (and (application-p val) (application-master val)) do
-	        (with-slots (window master) val
+  `(set-decoration-theme ,name ,free-old-theme-p))
+
+(defun set-decoration-theme (name free-old-theme-p)
+  (with-slots (decoration-theme window) *root*
+    (let ((theme (load-theme window name)))
+      (when decoration-theme
+        (loop with old-name = (theme-name decoration-theme)
+              for val being each hash-value in *widget-table*
+              when (and (application-p val) (application-master val)) do
+                (with-slots (window master) val
 		  (setf (decoration-frame-style master)
 			(find-decoration-frame-style theme window)))
-	       finally (and ,free-old-theme-p (free-theme old-name))))
-       (setf decoration-theme theme))))
+              finally (and free-old-theme-p (free-theme old-name))))
+      (setf decoration-theme theme))))
 
 (defsetf maximize-modifier () (modifier-key)
   "Sets the modifier to use to activate window maximization second behavior."
--- /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/23 09:54:46	1.48
+++ /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/25 16:02:49	1.49
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: input.lisp,v 1.48 2008/04/23 09:54:46 ihatchondo Exp $
+;;; $Id: input.lisp,v 1.49 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -90,7 +90,8 @@
     (when (or (decoration-p widget) (application-p (lookup-widget window)))
       (if (eq *focus-type* :on-click)
 	  (give-focus-to-next-widget-in-desktop) 
-	  (multiple-value-bind (x y s child) (xlib:query-pointer *root-window*)
+	  (multiple-value-bind (x y s child)
+              (xlib:query-pointer (xlib:drawable-root window))
 	    (declare (ignore x y s))
 	    (let ((e (make-event :enter-notify :kind :nonlinear :mode :normal)))
 	      (event-process e (or (lookup-widget child) *root*))))))))
@@ -316,7 +317,7 @@
   (with-slots (master window) application
     (unless (eql (event-mode event) :grab)
       (when master (dispatch-repaint master :focus t))
-      (setf (netwm:net-active-window *root-window*) window)
+      (setf (netwm:net-active-window (xlib:drawable-root window)) window)
       (xlib:delete-property
           (widget-window (root-property-holder *root*))
 	  :_net_active_window))))
--- /project/eclipse/cvsroot/eclipse/misc.lisp	2008/04/23 09:54:46	1.41
+++ /project/eclipse/cvsroot/eclipse/misc.lisp	2008/04/25 16:02:49	1.42
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: misc.lisp,v 1.41 2008/04/23 09:54:46 ihatchondo Exp $
+;;; $Id: misc.lisp,v 1.42 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -91,14 +91,16 @@
 (defsetf wm-state (window &key (icon-id 0)) (state)
   "Sets the wm_state property of a window. Note that its _net_wm_state property
    will be updated accordingly to the value given for the wm_state."
-  (let ((net-wm-state (gensym)))
-    `(let ((,net-wm-state (netwm:net-wm-state ,window)))
-       (if (or (= ,state 3) (= ,state 0))
-	   (pushnew :_net_wm_state_hidden ,net-wm-state)
-           (setf ,net-wm-state (delete :_net_wm_state_hidden ,net-wm-state)))
-       (setf (netwm:net-wm-state ,window) ,net-wm-state)
-       (xlib:change-property ,window :WM_STATE
-	   (list ,state ,icon-id)
+  (with-gensym (_window _state _net-wm-state)
+    `(let* ((,_window ,window)
+            (,_state ,state)
+            (,_net-wm-state (netwm:net-wm-state ,_window)))
+       (if (or (= ,_state 3) (= ,_state 0))
+	   (pushnew :_net_wm_state_hidden ,_net-wm-state)
+           (setf ,_net-wm-state (delete :_net_wm_state_hidden ,_net-wm-state)))
+       (setf (netwm:net-wm-state ,_window) ,_net-wm-state)
+       (xlib:change-property ,_window :WM_STATE
+	   (list ,_state ,icon-id)
 	   :WM_STATE
 	   32))))
 
@@ -107,12 +109,12 @@
    between _net_wm_desktop_names and _win_workspace_names respectively."
   (or (netwm:net-desktop-names window) (gnome:win-workspace-names window)))
 
-(defsetf workspace-names () (names)
+(defsetf workspace-names (window) (names)
   "Sets both the _win_workspace_names and the _net_wm_desktop_names properties
    to the given list of name."
   `(when ,names
-     (setf (netwm:net-desktop-names *root-window*) ,names
-           (gnome:win-workspace-names *root-window*) ,names)))
+     (setf (netwm:net-desktop-names ,window) ,names
+           (gnome:win-workspace-names ,window) ,names)))
 
 (defun wm-name (window)
   "Returns the name of the window according to the first property that is set
--- /project/eclipse/cvsroot/eclipse/move-resize.lisp	2005/01/17 09:30:40	1.18
+++ /project/eclipse/cvsroot/eclipse/move-resize.lisp	2008/04/25 16:02:49	1.19
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: move-resize.lisp,v 1.18 2005/01/17 09:30:40 ihatchondo Exp $
+;;; $Id: move-resize.lisp,v 1.19 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -31,9 +31,9 @@
   (when *geometry-info-box*
     (xlib:unmap-window (widget-window *geometry-info-box*))))
 
-(defun initialize-geometry-info-box ()
+(defun initialize-geometry-info-box (parent-window)
   (unless *geometry-info-box*
-    (setf *geometry-info-box* (create-message-box nil :parent *root-window*)))
+    (setf *geometry-info-box* (create-message-box nil :parent parent-window)))
   (with-slots (window) *geometry-info-box*
     (xlib:map-window window)
     (setf (xlib:window-priority window) :above)))
@@ -59,9 +59,9 @@
 
 (defparameter *clone* nil)
 
-(defun initialize-clone ()
+(defun initialize-clone (parent-window)
   (let ((win (xlib:create-window 
-	        :parent *root-window* :x 0 :y 0 :width 100 :height 100)))
+	        :parent parent-window :x 0 :y 0 :width 100 :height 100)))
     (setf *clone* (make-decoration win (create-application win nil)))))
 
 (defun update-*clone* (x y w h decoration-frame-style &optional wm-hints)
@@ -96,13 +96,13 @@
   (with-slots (resize-status move-status current-active-widget window) root
     (with-slots ((widget-window window) gcontext active-p) widget
       (when (and active-p (not (or resize-status move-status)))
-	(or *clone* (initialize-clone))
+	(or *clone* (initialize-clone window))
 	(update-clone widget)
 	(grab-root-pointer)
 	(setf (slot-value root status) t
 	      current-active-widget widget)
 	(when verbose-p
-	  (initialize-geometry-info-box)
+	  (initialize-geometry-info-box window)
 	  (multiple-value-bind (x y w h) (window-geometry widget-window)
 	    (if (and (eq status 'resize-status) (decoration-p widget))
 		(multiple-value-bind (a b c d iw ih bw bh)
@@ -255,7 +255,8 @@
   ;; called when button-release on root and root-resize-status is not nil.
   (with-slots (window gcontext) master
     (when (and (decoration-active-p master) (eql mode :box))
-      (draw-window-grid (widget-window *clone*) gcontext *root-window*)
+      (draw-window-grid
+          (widget-window *clone*) gcontext (xlib:drawable-root window))
       (multiple-value-bind (x y w h)
 	  (window-geometry (widget-window *clone*))
 	(setf (window-position window) (values x y)
@@ -296,9 +297,10 @@
 	(update-edges-geometry master)
 	(resize-from master))
       (with-slots (window gcontext) *clone*
-	(draw-window-grid window gcontext *root-window*)
-	(resize-internal *clone* event verbose-p)
-	(draw-window-grid window gcontext *root-window*))))	
+        (let ((root-window (xlib:drawable-root window)))
+          (draw-window-grid window gcontext root-window)
+          (resize-internal *clone* event verbose-p)
+          (draw-window-grid window gcontext root-window)))))
 
 ;;;; Move.
 
@@ -403,10 +405,11 @@
 	(when verbose-p (display-coordinates new-x new-y))
 	(if (and (or (decoration-p widget) (application-p widget))
 		 (eql mode :box))
-	    (with-slots (window) *clone*	    
-	      (draw-window-grid window gcontext *root-window*)
-	      (setf (window-position window) (values new-x new-y))
-	      (draw-window-grid window gcontext *root-window*))
+	    (with-slots (window) *clone*
+              (let ((root-window (xlib:drawable-root window)))
+                (draw-window-grid window gcontext root-window)
+                (setf (window-position window) (values new-x new-y))
+                (draw-window-grid window gcontext root-window)))
 	    (setf (window-position window) (values new-x new-y)))))))
 
 (defun finish-move (widget &optional verbose-p mode) 
@@ -414,7 +417,7 @@
   (with-slots ((widget-window window) active-p) widget
     (when (eql mode :box)
       (with-slots (window gcontext) *clone*
-	(draw-window-grid window gcontext *root-window*)
+	(draw-window-grid window gcontext (xlib:drawable-root window))
 	(setf (window-position widget-window) (window-position window))))
     (setf active-p nil)
     (when verbose-p (undraw-geometry-info-box)))
--- /project/eclipse/cvsroot/eclipse/widgets.lisp	2008/04/25 08:42:44	1.54
+++ /project/eclipse/cvsroot/eclipse/widgets.lisp	2008/04/25 16:02:49	1.55
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: widgets.lisp,v 1.54 2008/04/25 08:42:44 ihatchondo Exp $
+;;; $Id: widgets.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -400,7 +400,7 @@
       (setf (netwm:net-wm-state window) prop))
     (if (eq mode :on)
         ;; put in fullscreen mode.
-        (with-event-mask (*root-window*)
+        (with-event-mask ((xlib:drawable-root window))
           (multiple-value-bind (x y w h) (window-geometry window)
             (when master
               (with-slots (children (master-win window) frame-style) master
@@ -414,7 +414,7 @@
             (configure-window window :x x :y y :width w :height h))
           (focus-widget application 0))
         ;; revert: restore precedent geometry and decoration style.
-        (with-event-mask (*root-window*)
+        (with-event-mask ((xlib:drawable-root window))
           (setf (drawable-sizes window) (geometry-sizes fgeometry))
           (unless (window-not-decorable-p window)
             (setf (decoration-frame-style master)
@@ -440,7 +440,7 @@
 	       (with-slots (master window) application
 		 (when (shaded-p application) (shade application))
  		 (setf (window-desktop-num window) new-screen-number)
-		 (with-event-mask (*root-window*)
+		 (with-event-mask ((xlib:drawable-root window))
 		   (let ((master-window (when master (widget-window master))))
 		     (funcall operation (or master-window window))
 		     (when master-window
@@ -457,10 +457,11 @@
   "Removes all decoration of this application widget and reparent it to root."
   (with-slots (window master icon) application
     (if master
-	(multiple-value-bind (x y)
-	    (xlib:translate-coordinates window 0 0 *root-window*)
-	  (xlib:reparent-window window *root-window* x y)
-          (event-process (make-event :destroy-notify) master))
+        (let ((root-window (xlib:drawable-root window)))
+          (multiple-value-bind (x y)
+              (xlib:translate-coordinates window 0 0 root-window)
+            (xlib:reparent-window window root-window x y)
+            (event-process (make-event :destroy-notify) master)))
         (event-process (make-event :destroy-notify :window window) *root*))
     (when state
       (setf (wm-state window) state)
@@ -823,7 +824,7 @@
 	    (setf bkgrd pix))))
       (setf icon (create-button 'icon
 		   :event-mask '(:pointer-motion-hint . #.+std-button-mask+)
-		   :parent *root-window* :master master
+		   :parent (xlib:drawable-root window) :master master
 		   :x 0 :y 0 :width width :height height
 		   :item (unless bkgrd (wm-icon-name window))
 		   :background (or bkgrd bg-color)))
--- /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/25 08:42:45	1.54
+++ /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/25 16:02:49	1.55
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: wm.lisp,v 1.54 2008/04/25 08:42:45 ihatchondo Exp $
+;;; $Id: wm.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -362,16 +362,16 @@
 	(setf (drawable-sizes window)
 	      (values (max 1 (- width hm)) (max 1 (- height vm))))))))
 
-(defun initial-coordinates (app-window frame-style)
+(defun initial-coordinates (window frame-style)
   "Returns as multiple values the decoration initial coordinates."
-  (let ((hint (ignore-errors (xlib:wm-normal-hints app-window))))
+  (let ((hint (ignore-errors (xlib:wm-normal-hints window))))
     (with-slots (top-margin left-margin vmargin hmargin) frame-style
       (flet ((default-coordinates ()
-               (let* ((n (or (window-desktop-num app-window) 0))
+               (let* ((n (or (window-desktop-num window) 0))
                       (k (if (= +any-desktop+ n) 0 (* 4 n)))
-                      (areas (netwm:net-workarea *root-window*))
+                      (areas (netwm:net-workarea (xlib:drawable-root window)))
                       (ax (aref areas k)) (ay (aref areas (1+ k))))
-                 (multiple-value-bind (x y) (window-position app-window)
+                 (multiple-value-bind (x y) (window-position window)
                    (values (max ax (- x left-margin))
                            (max ay (- y top-margin)))))))
         (if (and hint (xlib:wm-size-hints-user-specified-position-p hint))



From ihatchondo at common-lisp.net  Mon Apr 28 12:29:39 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Mon, 28 Apr 2008 08:29:39 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080428122939.31024330E8@common-lisp.net>

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

Modified Files:
	input.lisp misc.lisp 
Log Message:
fix: nil event window

--- /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/25 16:02:49	1.49
+++ /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/28 12:29:38	1.50
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: input.lisp,v 1.49 2008/04/25 16:02:49 ihatchondo Exp $
+;;; $Id: input.lisp,v 1.50 2008/04/28 12:29:38 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -91,7 +91,7 @@
       (if (eq *focus-type* :on-click)
 	  (give-focus-to-next-widget-in-desktop) 
 	  (multiple-value-bind (x y s child)
-              (xlib:query-pointer (xlib:drawable-root window))
+              (xlib:query-pointer (xlib:drawable-root (widget-window widget)))
 	    (declare (ignore x y s))
 	    (let ((e (make-event :enter-notify :kind :nonlinear :mode :normal)))
 	      (event-process e (or (lookup-widget child) *root*))))))))
--- /project/eclipse/cvsroot/eclipse/misc.lisp	2008/04/25 16:02:49	1.42
+++ /project/eclipse/cvsroot/eclipse/misc.lisp	2008/04/28 12:29:39	1.43
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: misc.lisp,v 1.42 2008/04/25 16:02:49 ihatchondo Exp $
+;;; $Id: misc.lisp,v 1.43 2008/04/28 12:29:39 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -91,16 +91,14 @@
 (defsetf wm-state (window &key (icon-id 0)) (state)
   "Sets the wm_state property of a window. Note that its _net_wm_state property
    will be updated accordingly to the value given for the wm_state."
-  (with-gensym (_window _state _net-wm-state)
-    `(let* ((,_window ,window)
-            (,_state ,state)
-            (,_net-wm-state (netwm:net-wm-state ,_window)))
-       (if (or (= ,_state 3) (= ,_state 0))
-	   (pushnew :_net_wm_state_hidden ,_net-wm-state)
-           (setf ,_net-wm-state (delete :_net_wm_state_hidden ,_net-wm-state)))
-       (setf (netwm:net-wm-state ,_window) ,_net-wm-state)
-       (xlib:change-property ,_window :WM_STATE
-	   (list ,_state ,icon-id)
+  (let ((net-wm-state (gensym)))
+    `(let* ((,net-wm-state (netwm:net-wm-state ,window)))
+       (if (or (= ,state 3) (= ,state 0))
+	   (pushnew :_net_wm_state_hidden ,net-wm-state)
+           (setf ,net-wm-state (delete :_net_wm_state_hidden ,net-wm-state)))
+       (setf (netwm:net-wm-state ,window) ,net-wm-state)
+       (xlib:change-property ,window :WM_STATE
+	   (list ,state ,icon-id)
 	   :WM_STATE
 	   32))))
 



From ihatchondo at common-lisp.net  Mon Apr 28 16:09:17 2008
From: ihatchondo at common-lisp.net (ihatchondo)
Date: Mon, 28 Apr 2008 12:09:17 -0400 (EDT)
Subject: [Eclipse-cvs] CVS eclipse
Message-ID: <20080428160917.EEEAC702FE@common-lisp.net>

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

Modified Files:
	input.lisp wm.lisp 
Log Message:
Fix: frame extents request handling and frame entents property on undecorate window.

--- /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/28 12:29:38	1.50
+++ /project/eclipse/cvsroot/eclipse/input.lisp	2008/04/28 16:09:16	1.51
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: input.lisp,v 1.50 2008/04/28 12:29:38 ihatchondo Exp $
+;;; $Id: input.lisp,v 1.51 2008/04/28 16:09:16 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -97,7 +97,8 @@
 	      (event-process e (or (lookup-widget child) *root*))))))))
 
 (defmethod event-process ((event client-message) window)
-  (when (xlib:window-p window)
+  (declare (ignorable window))
+  (with-slots ((window event-window)) event
     (case (event-type event) 
       (:_net_request_frame_extents
        (with-slots (left-margin right-margin top-margin bottom-margin)
--- /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/25 16:02:49	1.55
+++ /project/eclipse/cvsroot/eclipse/wm.lisp	2008/04/28 16:09:16	1.56
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: wm.lisp,v 1.55 2008/04/25 16:02:49 ihatchondo Exp $
+;;; $Id: wm.lisp,v 1.56 2008/04/28 16:09:16 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -711,6 +711,7 @@
 	       (decore-application window application :map nil))
 	     (update-lists application 1 *root*)))
 	  ((window-not-decorable-p window (application-type application))
+           (setf (netwm:net-frame-extents window) (values 0 0 0 0))
 	   (setf (wm-state window) 1)
 	   (xlib:map-window window))
 	  (t (decore-application window application :map t)))