/[slime]/slime/swank-sbcl.lisp
ViewVC logotype

Diff of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.306 by heller, Sat Apr 7 10:23:39 2012 UTC revision 1.307 by nsiivola, Fri Apr 20 12:43:04 2012 UTC
# Line 297  Line 297 
297                           `(:external-format ,external-format))                           `(:external-format ,external-format))
298                          (t '()))                          (t '()))
299                  :serve-events ,(eq :fd-handler                  :serve-events ,(eq :fd-handler
300                                     ;; KLUDGE: SWANK package isn't                                     (swank-value '*communication-style* t))
                                    ;; available when backend is loaded.  
                                    (symbol-value  
                                     (intern "*COMMUNICATION-STYLE*" :swank)))  
301                    ;; SBCL < 1.0.42.43 doesn't support :SERVE-EVENTS                    ;; SBCL < 1.0.42.43 doesn't support :SERVE-EVENTS
302                    ;; argument.                    ;; argument.
303                  :allow-other-keys t)))                  :allow-other-keys t)))
# Line 402  Line 399 
399    
400  ;;; Utilities  ;;; Utilities
401    
402    (defun swank-value (name &optional errorp)
403      ;; Easy way to refer to symbol values in SWANK, which doesn't yet exist when
404      ;; this is file is loaded.
405      (let ((symbol (find-symbol (string name) :swank)))
406        (if (and symbol (or errorp (boundp symbol)))
407            (symbol-value symbol)
408            (when errorp
409              (error "~S does not exist in SWANK." name)))))
410    
411  #+#.(swank-backend:with-symbol 'function-lambda-list 'sb-introspect)  #+#.(swank-backend:with-symbol 'function-lambda-list 'sb-introspect)
412  (defimplementation arglist (fname)  (defimplementation arglist (fname)
413    (sb-introspect:function-lambda-list fname))    (sb-introspect:function-lambda-list fname))
# Line 1142  stack." Line 1148  stack."
1148  (defun lisp-source-location (code-location)  (defun lisp-source-location (code-location)
1149    (let ((source (prin1-to-string    (let ((source (prin1-to-string
1150                   (sb-debug::code-location-source-form code-location 100)))                   (sb-debug::code-location-source-form code-location 100)))
1151          (condition (intern "*swank-debugger-condition*" :swank)))          (condition (swank-value '*swank-debugger-condition*)))
1152      (if (and (boundp condition)      (if (typep condition 'sb-impl::step-form-condition)
1153               (typep (symbol-value condition) 'sb-impl::step-form-condition)          (and (search "SB-IMPL::WITH-STEPPING-ENABLED" source
1154               (and (search "SB-IMPL::WITH-STEPPING-ENABLED" source                       :test #'char-equal)
1155                            :test #'char-equal)               (search "SB-IMPL::STEP-FINISHED" source :test #'char-equal))
                   (search "SB-IMPL::STEP-FINISHED" source :test #'char-equal)))  
1156          ;; The initial form is utterly uninteresting -- and almost          ;; The initial form is utterly uninteresting -- and almost
1157          ;; certainly right there in the REPL.          ;; certainly right there in the REPL.
1158          (make-error-location "Stepping...")          (make-error-location "Stepping...")

Legend:
Removed from v.1.306  
changed lines
  Added in v.1.307

  ViewVC Help
Powered by ViewVC 1.1.5