[Eclipse-cvs] CVS eclipse
ihatchondo
ihatchondo at common-lisp.net
Fri Apr 2 09:57:53 UTC 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))
More information about the Eclipse-cvs
mailing list