DEFINE-GCONTEXT-ACCESSOR

Christophe Rhodes <[email protected]> Wed, 25 Jun 2003 15:04:38 +0100
Newsgroups gmane.lisp.clx.devel
Message-ID <[email protected]>
Does anyone use DEFINE-GCONTEXT-ACCESSOR?

The type declarations for it (and also GCONTEXT-EXTENSION) don't match
up with the code.  Here's a patch against telent-cvs, putting rather
more vague type declarations in.  Since I don't have an X server that
supports the ZoidExtension extension, and no other client code that
uses DEFINE-GCONTEXT-ACCESSOR, I can't actually test that it does what
it is meant to do, but at least it's no longer throwing errors at
compile-time.


Cheers,

Christophe
-- 
http://www-jcsu.jesus.cam.ac.uk/~csr21/       +44 1223 510 299/+44 7729 383 757
(set-pprint-dispatch 'number (lambda (s o) (declare (special b)) (format s b)))
(defvar b "~&Just another Lisp hacker~%")    (pprint #36rJesusCollegeCambridge)

_______________________________________________
Portable-clx-devel mailing list
[email protected]
http://clozure.com/cgi-bin/mailman/listinfo/portable-clx-devel
gcontext.diff (application/octet-stream, 1.9 KB)
Index: gcontext.lisp
===================================================================
RCS file: /usr/local/src/cvs/clx/gcontext.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- gcontext.lisp	5 Jun 2003 20:18:22 -0000	1.6
+++ gcontext.lisp	25 Jun 2003 12:55:04 -0000	1.7
@@ -95,14 +95,16 @@
 (defstruct (gcontext-extension (:type vector) (:copier nil)) ;; un-named
   (name nil :type symbol :read-only t)
   (default nil :type t :read-only t)
+  ;; FIXME: these used to have glorious, but wrong, type declarations.
+  ;; See if we can't return them to their former glory.
   (set-function #'(lambda (gcontext value)
 		    (declare (ignore gcontext))
 		    value)
-		:type (function (gcontext t) t) :read-only t)
+		:type (or function symbol) :read-only t)
   (copy-function #'(lambda (from-gc to-gc value)
 		     (declare (ignore from-gc to-gc))
 		     value)
-		 :type (function (gcontext gcontext t) t) :read-only t))
+		 :type (or function symbol) :read-only t))
 
 (defvar *gcontext-extensions* nil) ;; list of gcontext-extension
 
@@ -904,7 +906,7 @@
   (declare (type symbol name)
 	   (type t default)
 	   (type symbol set-function) ;; required
-	   (type symbol copy-function))
+	   (type (or symbol list) copy-function))
   (let* ((gc-name (intern (concatenate 'string
 				       (string 'gcontext-)
 				       (string name)))) ;; in current package
@@ -957,8 +959,8 @@
 (defun add-gcontext-extension (name default-value set-function copy-function)
   (declare (type symbol name)
 	   (type t default-value)
-	   (type (function (gcontext t) t) set-function)
-	   (type (function (gcontext gcontext t) t) copy-function))
+	   (type (or function symbol) set-function)
+	   (type (or function symbol) copy-function))
   (let ((number (or (position name *gcontext-extensions* :key #'gcontext-extension-name)
 		    (prog1 (length *gcontext-extensions*)
 			   (push nil *gcontext-extensions*)))))