[Eclipse-cvs] CVS eclipse - eclipse-cvs@common-lisp.net - mailman3.common-lisp.net

2 Apr 2010

Update of /project/eclipse/cvsroot/eclipse
In directory cl-net:/tmp/cvs-serv8701
Modified Files:
    eclipse.lisp input.lisp misc.lisp widgets.lisp wm.lisp 
Log Message:
Fix: added some declaration type, and null verification so the clx patch should not be necessary anymore.
Fix: wm-normal-hints returns some inproper values in fields that should be ignored. Now, we replace those obsolote fields values by the window geometry.

--- /project/eclipse/cvsroot/eclipse/eclipse.lisp	2009/11/17 22:40:49	1.29
+++ /project/eclipse/cvsroot/eclipse/eclipse.lisp	2010/04/02 09:57:53	1.30
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: eclipse.lisp,v 1.29 2009/11/17 22:40:49 ihatchondo Exp $
+;;; $Id: eclipse.lisp,v 1.30 2010/04/02 09:57:53 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -113,6 +113,8 @@
    			     :override-redirect :on
    			     :width 1 :height 1
    			     :x 0 :y 0)))
+    (declare (type xlib:window manager))
+    (declare (type (or null xlib:window) old-wm))
     (when old-wm
       (setf (xlib:window-event-mask old-wm) '(:structure-notify)))
@@ -132,8 +134,10 @@
    (t nil)))
;; Are we the selection owner after all ?
-    (unless (xlib:window-equal manager (xlib:selection-owner display +xa-wm+))
-      (error "ICCCM Error: failed to aquire selection ownership~%"))
+    (let ((owner (xlib:selection-owner display +xa-wm+)))
+      (declare (type (or null xlib:window) owner))
+      (unless (and owner (xlib:window-equal manager owner))
+        (error "ICCCM Error: failed to aquire selection ownership~%")))
;; Check if a non ICCCM complient window manager is not running.
     (handler-case
--- /project/eclipse/cvsroot/eclipse/input.lisp	2009/11/17 21:17:29	1.54
+++ /project/eclipse/cvsroot/eclipse/input.lisp	2010/04/02 09:57:53	1.55
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: input.lisp,v 1.54 2009/11/17 21:17:29 ihatchondo Exp $
+;;; $Id: input.lisp,v 1.55 2010/04/02 09:57:53 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -47,7 +47,8 @@
   (with-slots (window (candidat event-window)) event
     (multiple-value-bind (children parent) (xlib:query-tree window)
       (declare (ignore children))
-      (unless (xlib:window-equal candidat parent)
+      (declare (type (or null xlib:window) parent))
+      (unless (and parent (xlib:window-equal candidat parent))
         (xlib:send-event parent :map-request
             '(:substructure-redirect) :window window :event-window parent)))))
--- /project/eclipse/cvsroot/eclipse/misc.lisp	2009/11/17 22:40:49	1.47
+++ /project/eclipse/cvsroot/eclipse/misc.lisp	2010/04/02 09:57:53	1.48
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: misc.lisp,v 1.47 2009/11/17 22:40:49 ihatchondo Exp $
+;;; $Id: misc.lisp,v 1.48 2010/04/02 09:57:53 ihatchondo Exp $
 ;;;
 ;;; This file is part of Eclipse.
 ;;; Copyright (C) 2002 Iban HATCHONDO
@@ -110,6 +110,18 @@
   (or (xlib:transient-for app-window)
       (member :_net_wm_window_type_dialog (netwm:net-wm-state app-window))))
+(defun wm-normal-hints (window)
+  "Returns the window WM_NORMAL_HINTS property with the obsolete values 
+   reset to the window geometry."
+  (let ((hint (ignore-errors (xlib:wm-normal-hints window))))
+    (unless (null hint)
+      (multiple-value-bind (x y w h) (window-geometry window)
+        (setf (xlib:wm-size-hints-x hint) x
+              (xlib:wm-size-hints-y hint) y
+              (xlib:wm-size-hints-width hint) w
+              (xlib:wm-size-hints-height hint) h)))
+    hint))
+
 (defun wm-state (window)
   "Returns the wm_state property of a window as xlib:get-property would."
   (xlib:get-property window :WM_STATE))
@@ -247,6 +259,9 @@
   (flet ((lookup-app-w (widget)
       (when (decoration-p widget)
         (get-child widget :application :window t)))
+	 (layer-member (window windows)
+	   (when (xlib:window-p window)
+	     (member window windows :test #'xlib:window-equal)))	     
     (first-win (windows &optional above-p)
       (car (if above-p (last windows) windows)))
     (restack (app sib-app priority)
@@ -254,7 +269,7 @@
              (let* ((window (widget-window (or (application-master app) app)))
                     (sm (when sib-app (application-master sib-app)))
                     (sibling (when sib-app (widget-window (or sm sib-app)))))
-               (unless (xlib:window-equal window sibling)
+               (unless (and sibling (xlib:window-equal window sibling))
                  (setf (xlib:window-priority window sibling) priority))))))
     (let* ((win (or (lookup-app-w (lookup-widget window)) window))
       (sib (or (lookup-app-w (lookup-widget sibling)) sibling))
@@ -272,20 +287,20 @@
    	(setf wnwm-state (nconc wnwm-state (netwm:net-wm-state lw)))))
        ;; Find the correct sibling and reset the priority if needed.
        (cond ((member :_net_wm_state_below wnwm-state)
-		   (unless (member sib below-layer :test #'xlib:window-equal)
+		   (unless (layer-member sib below-layer)
    	     (setf sib (first-win (or below-layer std-layer above-layer)
-				      (and below-layer above-p)))
+                                          (and below-layer above-p)))
    	     (unless below-layer (setf stack-mode :below))))
    	  ((member :_net_wm_state_above wnwm-state)
-		   (unless (member sib above-layer :test #'xlib:window-equal)
+		   (unless (layer-member sib above-layer)
    	     (unless (member :_net_wm_state_fullscreen snwm-state)
    	       (setf sib (first-win above-layer above-p))
    	       (unless above-layer (setf stack-mode :above)))))
    	  ((member :_net_wm_state_fullscreen wnwm-state)
-		   (when (member sib below-layer :test #'xlib:window-equal)
+		   (when (layer-member sib below-layer)
    	     (setf sib (first-win (or std-layer above-layer)))
    	     (setf stack-mode :below)))
-		  ((not (member sib std-layer :test #'xlib:window-equal))
+		  ((not (layer-member sib std-layer))
    	   (setf sib (first-win (or std-layer below-layer above-layer)
    				(if std-layer above-p below-layer)))
    	   (unless std-layer
@@ -348,7 +363,7 @@
     (parent (when master (widget-window master)))
     (top-margin 0) (left-margin 0)
     (g (or gravity	(and master (decoration-application-gravity master))
-		(let ((h (ignore-errors (xlib:wm-normal-hints win))))
+		(let ((h (ignore-errors (wm-normal-hints win))))
    	  (if h (xlib:wm-size-hints-win-gravity h) :north-west)))))
     (when master
       (setf top-margin (style-top-margin (decoration-frame-style master)))
--- /project/eclipse/cvsroot/eclipse/widgets.lisp	2009/11/17 21:17:29	1.59
+++ /project/eclipse/cvsroot/eclipse/widgets.lisp	2010/04/02 09:57:53	1.60
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: widgets.lisp,v 1.59 2009/11/17 21:17:29 ihatchondo Exp $
+;;; $Id: widgets.lisp,v 1.60 2010/04/02 09:57:53 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -296,7 +296,7 @@
(defun fullscreenable-p (application) 
   (with-slots (window) application
-    (let ((hint (ignore-errors (xlib:wm-normal-hints window))))
+    (let ((hint (ignore-errors (wm-normal-hints window))))
       (symbol-macrolet ((max-h (and hint (xlib:wm-size-hints-max-height hint)))
                         (max-w (and hint (xlib:wm-size-hints-max-width hint))))
      (and (if max-w (= max-w (screen-width)) t)
@@ -515,7 +515,7 @@
    actual geometry of the specified window. If the optional geometry is 
    given then it will be filled and returned."
   (multiple-value-bind (x y w h) (window-geometry window)
-    (let ((hint (ignore-errors (xlib:wm-normal-hints window))))
+    (let ((hint (ignore-errors (wm-normal-hints window))))
       (setf (geometry geometry)
        (values (or (when hint (xlib:wm-size-hints-x hint)) x)
    	    (or (when hint (xlib:wm-size-hints-y hint)) y)
--- /project/eclipse/cvsroot/eclipse/wm.lisp	2009/11/17 21:36:08	1.60
+++ /project/eclipse/cvsroot/eclipse/wm.lisp	2010/04/02 09:57:53	1.61
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp; Package: ECLIPSE-INTERNALS -*-
-;;; $Id: wm.lisp,v 1.60 2009/11/17 21:36:08 ihatchondo Exp $
+;;; $Id: wm.lisp,v 1.61 2010/04/02 09:57:53 ihatchondo Exp $
 ;;;
 ;;; ECLIPSE. The Common Lisp Window Manager.
 ;;; Copyright (C) 2000, 2001, 2002 Iban HATCHONDO
@@ -169,7 +169,7 @@
   the window gravity of the designed window. The wm-normal-hints property is
   recomputed in order to reflect the margin that a top level decoration widget
   (aka master) might introduce."
-  (let ((hints (or (ignore-errors (xlib:wm-normal-hints window))
+  (let ((hints (or (ignore-errors (wm-normal-hints window))
    	   (xlib:make-wm-size-hints)))
    (max-ww (screen-width))
    (max-hh (screen-height)))
@@ -364,7 +364,7 @@
(defun initial-coordinates (window frame-style)
   "Returns as multiple values the decoration initial coordinates."
-  (let ((hint (ignore-errors (xlib:wm-normal-hints window))))
+  (let ((hint (ignore-errors (wm-normal-hints window))))
     (with-slots (top-margin left-margin vmargin hmargin) frame-style
       (flet ((default-coordinates ()
                (let* ((n (or (window-desktop-num window) 0))

    