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