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

Diff of /slime/swank.lisp

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

revision 1.128 by mbaringer, Fri Feb 27 12:32:06 2004 UTC revision 1.129 by heller, Sat Feb 28 09:06:50 2004 UTC
# Line 340  element." Line 340  element."
340  (defun interrupt-worker-thread (thread)  (defun interrupt-worker-thread (thread)
341    (let ((thread (etypecase thread    (let ((thread (etypecase thread
342                    ((member t) (cdr (car *active-threads*)))                    ((member t) (cdr (car *active-threads*)))
343                    (fixnum (lookup-thread-id thread))))                    (fixnum (lookup-thread-id thread)))))
344          (hook #'swank-debugger-hook))      (interrupt-thread thread #'simple-break)))
     (interrupt-thread thread (lambda ()  
                                (let ((*debugger-hook* hook))  
                                  (simple-break))))))  
345    
346  (defun dispatch-event (event socket-io)  (defun dispatch-event (event socket-io)
347    (log-event "DISPATCHING: ~S~%" event)    (log-event "DISPATCHING: ~S~%" event)
# Line 697  exists." Line 694  exists."
694  ;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too  ;;; cover cases like (&key (function #'cons) (quote 'quote)).  Too
695  ;;; much code for such a minor feature?  ;;; much code for such a minor feature?
696    
697  (defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch nil))  (defvar *initial-pprint-dispatch-table* (copy-pprint-dispatch))
698    
699  (defun print-cons-argument (stream object)  (defun print-cons-argument (stream object)
700    (pprint-logical-block (stream object :prefix "(" :suffix ")")    (pprint-logical-block (stream object :prefix "(" :suffix ")")
701      (princ (car object) stream)      (princ (car object) stream)
702        (write-char #\space stream)
703      (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))      (let ((*print-pprint-dispatch* *initial-pprint-dispatch-table*))
704        (pprint-fill stream (cdr object) nil))))        (pprint-fill stream (cdr object) nil))))
705    
# Line 710  exists." Line 708  exists."
708      (princ object stream)))      (princ object stream)))
709    
710  (defvar *arglist-pprint-dispatch-table*  (defvar *arglist-pprint-dispatch-table*
711    (let ((table (copy-pprint-dispatch nil)))    (let ((table (copy-pprint-dispatch)))
712      (set-pprint-dispatch 'cons #'print-cons-argument 0 table)      (set-pprint-dispatch 'cons #'print-cons-argument 0 table)
713      (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)      (set-pprint-dispatch 'symbol #'print-symbol-argument 0 table)
714      table))      table))

Legend:
Removed from v.1.128  
changed lines
  Added in v.1.129

  ViewVC Help
Powered by ViewVC 1.1.5