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