[slime-cvs] CVS slime

[CVS User nsiivola]

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
sbcl: SWANK-VALUE to make it nicer to refer to values of SWANK symbols


--- /project/slime/cvsroot/slime/ChangeLog	2012/04/11 11:38:56	1.2316
+++ /project/slime/cvsroot/slime/ChangeLog	2012/04/20 12:43:04	1.2317
@@ -1,3 +1,13 @@
+2012-04-20  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp (swank-value): New function, makes it easy to
+	refer to variables in SWANK -- which doesn't exist when the
+	backend is loaded.
+	(lisp-source-location): One of the strings being interned was
+	downcased. Fix using SWANK-VALUE.
+	(make-socket-io-stream): Use SWANK-VALUE instead of INTERN &
+	SYMBOL-VALUE.
+
 2012-04-11  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el ([test] utf-8-source): Use the encoded byte sequence of
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/04/07 10:23:39	1.306
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/04/20 12:43:04	1.307
@@ -297,10 +297,7 @@
                          `(:external-format ,external-format))
                         (t '()))
                 :serve-events ,(eq :fd-handler
-                                   ;; KLUDGE: SWANK package isn't
-                                   ;; available when backend is loaded.
-                                   (symbol-value
-                                    (intern "*COMMUNICATION-STYLE*" :swank)))
+                                   (swank-value '*communication-style* t))
                   ;; SBCL < 1.0.42.43 doesn't support :SERVE-EVENTS
                   ;; argument.
                 :allow-other-keys t)))
@@ -402,6 +399,15 @@
 
 ;;; Utilities
 
+(defun swank-value (name &optional errorp)
+  ;; Easy way to refer to symbol values in SWANK, which doesn't yet exist when
+  ;; this is file is loaded.
+  (let ((symbol (find-symbol (string name) :swank)))
+    (if (and symbol (or errorp (boundp symbol)))
+        (symbol-value symbol)
+        (when errorp
+          (error "~S does not exist in SWANK." name)))))
+
 #+#.(swank-backend:with-symbol 'function-lambda-list 'sb-introspect)
 (defimplementation arglist (fname)
   (sb-introspect:function-lambda-list fname))
@@ -1142,12 +1148,11 @@
 (defun lisp-source-location (code-location)
   (let ((source (prin1-to-string
                  (sb-debug::code-location-source-form code-location 100)))
-        (condition (intern "*swank-debugger-condition*" :swank)))
-    (if (and (boundp condition)
-             (typep (symbol-value condition) 'sb-impl::step-form-condition)
-             (and (search "SB-IMPL::WITH-STEPPING-ENABLED" source 
-                          :test #'char-equal)
-                  (search "SB-IMPL::STEP-FINISHED" source :test #'char-equal)))
+        (condition (swank-value '*swank-debugger-condition*)))
+    (if (typep condition 'sb-impl::step-form-condition)
+        (and (search "SB-IMPL::WITH-STEPPING-ENABLED" source
+                     :test #'char-equal)
+             (search "SB-IMPL::STEP-FINISHED" source :test #'char-equal))
         ;; The initial form is utterly uninteresting -- and almost
         ;; certainly right there in the REPL.
         (make-error-location "Stepping...")