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

Diff of /slime/swank.lisp

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

revision 1.202 by lgorrie, Tue Jun 22 08:02:15 2004 UTC revision 1.203 by heller, Fri Jun 25 08:06:39 2004 UTC
# Line 906  If a protocol error occurs then a SLIME- Line 906  If a protocol error occurs then a SLIME-
906    
907  (defslimefun connection-info ()  (defslimefun connection-info ()
908    "Return a list of the form:    "Return a list of the form:
909  \(VERSION PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)."  \(PID IMPLEMENTATION-TYPE IMPLEMENTATION-NAME FEATURES)."
910    (list (getpid)    (list (getpid)
911          (lisp-implementation-type)          (lisp-implementation-type)
912          (lisp-implementation-type-name)          (lisp-implementation-type-name)
# Line 1578  Record compiler notes signalled as `comp Line 1578  Record compiler notes signalled as `comp
1578  ;;;; Completion  ;;;; Completion
1579    
1580  (defun determine-case (string)  (defun determine-case (string)
1581    "Return to booleans LOWER and UPPER indicating whether STRING    "Return two booleans LOWER and UPPER indicating whether STRING
1582  contains lower or upper case characters."  contains lower or upper case characters."
1583    (values (some #'lower-case-p string)    (values (some #'lower-case-p string)
1584            (some #'upper-case-p string)))            (some #'upper-case-p string)))
# Line 2446  The result is a list of the form ((LOCAT Line 2446  The result is a list of the form ((LOCAT
2446      (inspect-object (eval (read-from-string string)))))      (inspect-object (eval (read-from-string string)))))
2447    
2448  (defun print-part-to-string (value)  (defun print-part-to-string (value)
2449    (let ((*print-pretty* nil)    (let ((string (to-string value))
2450          (*print-circle* t))          (pos (position value *inspector-history*)))
2451      (let ((string (to-string value))      (if pos
2452            (pos (position value *inspector-history*)))          (format nil "#~D=~A" pos string)
2453        (if pos          string)))
           (format nil "#~D=~A" pos string)  
           string))))  
2454    
2455  (defun inspect-object (object)  (defun inspect-object (object)
2456    (push (setq *inspectee* object) *inspector-stack*)    (push (setq *inspectee* object) *inspector-stack*)
2457    (unless (find object *inspector-history*)    (unless (find object *inspector-history*)
2458      (vector-push-extend object *inspector-history*))      (vector-push-extend object *inspector-history*))
2459    (multiple-value-bind (text parts) (inspected-parts object)    (let ((*print-pretty* nil)            ; print everything in the same line
2460      (setq *inspectee-parts* parts)          (*print-circle* t)
2461      (list :text text          (*print-readably* nil))
2462            :type (to-string (type-of object))      (multiple-value-bind (text parts) (inspected-parts object)
2463            :primitive-type (describe-primitive-type object)        (setq *inspectee-parts* parts)
2464            :parts (loop for (label . value) in parts        (list :text text
2465                         collect (cons (princ-to-string label)              :type (to-string (type-of object))
2466                                       (print-part-to-string value))))))              :primitive-type (describe-primitive-type object)
2467                :parts (loop for (label . value) in parts
2468                             collect (cons (princ-to-string label)
2469                                           (print-part-to-string value)))))))
2470    
2471  (defun nth-part (index)  (defun nth-part (index)
2472    (cdr (nth index *inspectee-parts*)))    (cdr (nth index *inspectee-parts*)))
# Line 2561  nil if there's no second element." Line 2562  nil if there's no second element."
2562      (reset-inspector)      (reset-inspector)
2563      (inspect-object *swank-debugger-condition*)))      (inspect-object *swank-debugger-condition*)))
2564    
2565    (defslimefun inspect-frame-var (frame var)
2566      (with-buffer-syntax ()
2567        (reset-inspector)
2568        (inspect-object (frame-var-value frame var))))
2569    
2570    
2571  ;;;; Thread listing  ;;;; Thread listing
2572    

Legend:
Removed from v.1.202  
changed lines
  Added in v.1.203

  ViewVC Help
Powered by ViewVC 1.1.5