[Eclipse-cvs] CVS eclipse/lib/clx-ext

[ihatchondo]

Update of /project/eclipse/cvsroot/eclipse/lib/clx-ext
In directory cl-net:/tmp/cvs-serv20028/lib/clx-ext

Modified Files:
	clx-patch.lisp 
Log Message:
Fix: <mumble>-equal now accept null arguments.

--- /project/eclipse/cvsroot/eclipse/lib/clx-ext/clx-patch.lisp	2004/03/03 09:05:12	1.6
+++ /project/eclipse/cvsroot/eclipse/lib/clx-ext/clx-patch.lisp	2009/11/17 17:29:13	1.7
@@ -1,5 +1,5 @@
 ;;; -*- Mode: Lisp -*-
-;;; $Id: clx-patch.lisp,v 1.6 2004/03/03 09:05:12 ihatchondo Exp $
+;;; $Id: clx-patch.lisp,v 1.7 2009/11/17 17:29:13 ihatchondo Exp $
 ;;;
 ;;; This file contains the patch fixing a bug in CLX as distributed
 ;;; with vanilla CMUCL versions up to 18d.
@@ -51,6 +51,33 @@
 	  (t (xlib::lookup-window dpy id))))
       (xlib::member8-get 1 :none :pointer-root :parent))))
 
+;; This is a patch for the equality functions. Not accepting at least
+;; nil arguments is pretty anoying. It will still complain if at least
+;; one is not of the proper type but this should save us from lots of 
+;; testing.
+
+(macrolet ((make-mumble-equal (type)
+	     ;; Since caching is only done for objects created by the
+	     ;; client, we must always compare ID and display for
+	     ;; non-identical mumbles.
+	     (let ((predicate (xintern type '-equal))
+		   (id (xintern type '-id))
+		   (dpy (xintern type '-display)))
+		`(within-definition (,type make-mumble-equal)
+		   (defun ,predicate (a b)
+		     (declare (type (or null ,type) a b))
+                     (when (and a b)
+                       (or (eql a b)
+                           (and (= (,id a) (,id b))
+                                (eq (,dpy a) (,dpy b))))))))))
+  (make-mumble-equal window)
+  (make-mumble-equal pixmap)
+  (make-mumble-equal cursor)
+  (make-mumble-equal font)
+  (make-mumble-equal gcontext)
+  (make-mumble-equal colormap)
+  (make-mumble-equal drawable))
+
 ;; It seems that sometimes some id are still present in the clx display
 ;; internal cache even when those resources have been destroyed. This has
 ;; for effect that when the X server reallocate this id to a resource of