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@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@common-lisp.net http://common-lisp.net/mailman/listinfo/slime-devel