[slime-devel] patch to disappear some allegro warnings

[Dan Weinreb]

I was just about to suggest such a thing for slime-sbcl, or
at least a hook to allow it (it would have to be progv).

On Mon, 2006-10-09 at 20:55 -0400, Gary King wrote:
> Putative changelog entry
> 
> 2006-10-09  Gary King <gwking at metabang.com>
> 
> 	* swank-allegro.lisp: Wrapped many things in excl:without- 
> redefinition-warnings so as to compile, well, without redefinition  
> warnings.
> 
> The diff
> 
> RCS file: /project/slime/cvsroot/slime/swank-allegro.lisp,v
> retrieving revision 1.90
> diff -u -w -r1.90 swank-allegro.lisp
> --- swank-allegro.lisp	10 Aug 2006 18:55:51 -0000	1.90
> +++ swank-allegro.lisp	9 Oct 2006 23:36:42 -0000
> @@ -28,8 +28,9 @@
> ;;;; TCP Server
> +(excl:without-redefinition-warnings
> (defimplementation preferred-communication-style ()
> -  :spawn)
> +    :spawn))
> (defimplementation create-socket (host port)
>     (socket:make-socket :connect :passive :local-port port
> @@ -64,40 +65,48 @@
>     (setf (stream-external-format stream)
>           (find-external-format external-format)))
> +(excl:without-redefinition-warnings
> (defimplementation format-sldb-condition (c)
> -  (princ-to-string c))
> +    (princ-to-string c)))
> +(excl:without-redefinition-warnings
> (defimplementation condition-references (c)
>     (declare (ignore c))
> -  '())
> +    '()))
> +(excl:without-redefinition-warnings
> (defimplementation call-with-syntax-hooks (fn)
> -  (funcall fn))
> +    (funcall fn)))
> ;;;; Unix signals
> +(excl:without-redefinition-warnings
> (defimplementation call-without-interrupts (fn)
> -  (excl:without-interrupts (funcall fn)))
> +    (excl:without-interrupts (funcall fn))))
> (defimplementation getpid ()
>     (excl::getpid))
> +(excl:without-redefinition-warnings
> (defimplementation lisp-implementation-type-name ()
> -  "allegro")
> +    "allegro"))
> +(excl:without-redefinition-warnings
> (defimplementation set-default-directory (directory)
>     (let* ((dir (namestring (truename (merge-pathnames directory)))))
>       (setf *default-pathname-defaults* (pathname (excl:chdir dir)))
> -    dir))
> +      dir)))
> +(excl:without-redefinition-warnings
> (defimplementation default-directory ()
> -  (namestring (excl:current-directory)))
> +    (namestring (excl:current-directory))))
> ;;;; Misc
> +(excl:without-redefinition-warnings
> (defimplementation arglist (symbol)
>     (handler-case (excl:arglist symbol)
> -    (simple-error () :not-available)))
> +      (simple-error () :not-available))))
> (defimplementation macroexpand-all (form)
>     (excl::walk form))
> @@ -129,8 +138,9 @@
>       (:class
>        (describe (find-class symbol)))))
> +(excl:without-redefinition-warnings
> (defimplementation make-stream-interactive (stream)
> -  (setf (interactive-stream-p stream) t))
> +    (setf (interactive-stream-p stream) t)))
> ;;;; Debugger
> @@ -581,14 +591,15 @@
>                (when doc
>                  `("Documentation:" (:newline) ,doc))))))
> -(defmethod inspect-for-emacs ((o t) (inspector acl-inspector))
> -  inspector
> -  (values "A value." (allegro-inspect o)))
> -
> +#+(or)
> (defmethod inspect-for-emacs ((o function) (inspector acl-inspector))
>     inspector
>     (values "A function." (allegro-inspect o)))
> +(defmethod inspect-for-emacs ((o t) (inspector acl-inspector))
> +  inspector
> +  (values "A value." (allegro-inspect o)))
> +
> (defmethod inspect-for-emacs ((o standard-object) (inspector acl- 
> inspector))
>     inspector
>     (values (format nil "~A is a standard-object." o) (allegro- 
> inspect o)))
> @@ -616,8 +627,9 @@
> ;;;; Multithreading
> +(excl:without-redefinition-warnings
> (defimplementation initialize-multiprocessing ()
> -  (mp:start-scheduler))
> +    (mp:start-scheduler)))
> (defimplementation spawn (fn &key name)
>     (mp:process-run-function name fn))
> @@ -635,21 +647,26 @@
>     (find id mp:*all-processes*
>           :key (lambda (p) (getf (mp:process-property-list p) 'id))))
> +(excl:without-redefinition-warnings
> (defimplementation thread-name (thread)
> -  (mp:process-name thread))
> +    (mp:process-name thread)))
> +(excl:without-redefinition-warnings
> (defimplementation thread-status (thread)
>     (format nil "~A ~D" (mp:process-whostate thread)
> -          (mp:process-priority thread)))
> +            (mp:process-priority thread))))
> +(excl:without-redefinition-warnings
> (defimplementation make-lock (&key name)
> -  (mp:make-process-lock :name name))
> +    (mp:make-process-lock :name name)))
> +(excl:without-redefinition-warnings
> (defimplementation call-with-lock-held (lock function)
> -  (mp:with-process-lock (lock) (funcall function)))
> +    (mp:with-process-lock (lock) (funcall function))))
> +(excl:without-redefinition-warnings
> (defimplementation current-thread ()
> -  mp:*current-process*)
> +    mp:*current-process*))
> (defimplementation all-threads ()
>     (copy-list mp:*all-processes*))
> @@ -657,8 +674,9 @@
> (defimplementation interrupt-thread (thread fn)
>     (mp:process-interrupt thread fn))
> +(excl:without-redefinition-warnings
> (defimplementation kill-thread (thread)
> -  (mp:process-kill thread))
> +    (mp:process-kill thread)))
> (defvar *mailbox-lock* (mp:make-process-lock :name "mailbox lock"))
> @@ -754,8 +772,10 @@
> ;;;; Weak hashtables
> +(excl:without-redefinition-warnings
> (defimplementation make-weak-key-hash-table (&rest args)
> -  (apply #'make-hash-table :weak-keys t args))
> +    (apply #'make-hash-table :weak-keys t args)))
> +(excl:without-redefinition-warnings
> (defimplementation make-weak-value-hash-table (&rest args)
> -  (apply #'make-hash-table :values :weak args))
> +    (apply #'make-hash-table :values :weak args)))
> 
> --
> Gary Warren King, metabang.com
> Cell: (413) 885 9127
> Fax: (206) 338-4052
> gwkkwg on Skype * garethsan on AIM
> 
> 
> 
> 
> _______________________________________________
> slime-devel site list
> slime-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/slime-devel
> 
>