[slime-cvs] CVS update: slime/swank.lisp

Helmut Eller heller at common-lisp.net
Sat Feb 28 09:06:50 UTC 2004


Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv25066

Modified Files:
	swank.lisp 
Log Message:
(*initial-pprint-dispatch-table*, *arglist-pprint-dispatch-table*):
Workaround for bug in CLISP. Don't supply nil as argument to
copy-pprint-dispatch.

(print-cons-argument): Insert a space after the car.

Date: Sat Feb 28 04:06:50 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.128 slime/swank.lisp:1.129
--- slime/swank.lisp:1.128	Fri Feb 27 07:32:06 2004
+++ slime/swank.lisp	Sat Feb 28 04:06:50 2004
@@ -340,11 +340,8 @@
 (defun interrupt-worker-thread (thread)
   (let ((thread (etypecase thread
                   ((member t) (cdr (car *active-threads*)))
-                  (fixnum (lookup-thread-id thread))))
-        (hook #'swank-debugger-hook))
-    (interrupt-thread thread (lambda ()
-			       (let ((*debugger-hook* hook))
-				 (simple-break))))))
+                  (fixnum (lookup-thread-id thread)))))
+    (interrupt-thread thread #'simple-break)))
 
 (defun dispatch-event (event socket-io)
   (log-event "DISPATCHING: ~S~%" event)
@@ -697,11 +694,12 @@
 ;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too
 ;;; much code for such a minor feature?
 
-(defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch nil))
+(defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch))
 
 (defun print-cons-argument (stream object)
   (pprint-logical-block (stream object :prefix "(" :suffix ")")
     (princ (car object) stream)
+    (write-char #\space stream)
     (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
       (pprint-fill stream (cdr object) nil))))
 
@@ -710,7 +708,7 @@
     (princ object stream)))
 
 (defvar *arglist-pprint-dispatch-table* 
-  (let ((table (copy-pprint-dispatch nil)))
+  (let ((table (copy-pprint-dispatch)))
     (set-pprint-dispatch 'cons #'print-cons-argument 0 table)
     (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)
     table))





More information about the slime-cvs mailing list