[mcclim-devel] A fix to fix-clisp.lisp

[Pascal Bourguignon]

Think about this: 

  when is interned gray::original-input-stream-p in:

    (ext:without-package-lock ("GRAY")
       (setf (fdefinition 'gray::original-input-stream-p) ...))

  ?

I'd propose to put these symbols in a user package: a specific
gray-user, or they could as well be left in the current package. 

fix-clisp.lisp:

(defpackage #:clim-mop
  (:use #:clos))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (loop for sym being the symbols of :clim-mop
        do (export sym :clim-mop)))


(defpackage #:gray-user (:use))

(ext:without-package-lock ("GRAY")

  ;; CLIM expects INPUT-STREAM-P to be a generic function.
  (unless (typep #'input-stream-p 'generic-function)
    (setf (fdefinition 'gray-user::original-input-stream-p) #'input-stream-p)
    (fmakunbound 'input-stream-p)
    (defgeneric input-stream-p (stream)
      (:method ((stream stream)) (gray-user::original-input-stream-p stream))))

  ;; CLIM expects OUTPUT-STREAM-P to be a generic function.
  (unless (typep #'output-stream-p 'generic-function)
    (setf (fdefinition 'gray-user::original-output-stream-p) #'output-stream-p)
    (fmakunbound 'output-stream-p)
    (defgeneric output-stream-p (stream)
      (:method ((stream stream)) (gray-user::original-output-stream-p stream))))
  )



An alternative could be to gensym them.

(defmacro make-generic (funame arguments)
  (let ((old (gensym (string funame)))
        (gargs (mapcar (lambda (arg) (if (consp arg) (first arg) arg)) 
                       arguments)))
    `(progn (setf (fdefinition ',old) (function ,funame))
            (fmakunbound ',funame)
            (defgeneric ,funame ,gargs
               (:method ,arguments (,old , at gargs))))))

(defpackage #:clim-mop
  (:use #:clos))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (loop for sym being the symbols of :clim-mop
        do (export sym :clim-mop)))

(ext:without-package-lock ("GRAY")

  ;; CLIM expects INPUT-STREAM-P to be a generic function.
  (unless (typep #'input-stream-p 'generic-function)
    (make-generic input-stream-p ((stream stream))))

  ;; CLIM expects OUTPUT-STREAM-P to be a generic function.
  (unless (typep #'output-stream-p 'generic-function)
    (make-generic output-stream-p ((stream stream))))
  )

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
Cats meow out of angst
"Thumbs! If only we had thumbs!
We could break so much!"