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

Diff of /slime/swank-ccl.lisp

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

revision 1.5 by heller, Mon Aug 31 17:08:17 2009 UTC revision 1.8 by trittweiler, Sat Oct 24 11:32:18 2009 UTC
# Line 303  Line 303 
303     :test 'equal))     :test 'equal))
304    
305  (defimplementation who-specializes (class)  (defimplementation who-specializes (class)
306    (delete-duplicates    (when (symbolp class)
307     (mapcar (lambda (m)      (setq class (find-class class nil)))
308               (car (find-definitions m)))    (when class
309             (ccl:specializer-direct-methods (if (symbolp class) (find-class class) class)))      (delete-duplicates
310     :test 'equal))       (mapcar (lambda (m)
311                   (car (find-definitions m)))
312                 (ccl:specializer-direct-methods class))
313         :test 'equal)))
314    
315  (defimplementation list-callees (name)  (defimplementation list-callees (name)
316    (remove-duplicates    (remove-duplicates
# Line 385  Line 388 
388    )    )
389    
390  (defun map-backtrace (function &optional  (defun map-backtrace (function &optional
391                                 (start-frame-number 0)                        (start-frame-number 0)
392                                 (end-frame-number most-positive-fixnum))                        end-frame-number)
393    "Call FUNCTION passing information about each stack frame    "Call FUNCTION passing information about each stack frame
394   from frames START-FRAME-NUMBER to END-FRAME-NUMBER."   from frames START-FRAME-NUMBER to END-FRAME-NUMBER."
395    (ccl:map-call-frames function    (let ((end-frame-number (or end-frame-number most-positive-fixnum)))
396                         :origin ccl:*top-error-frame*      (ccl:map-call-frames function
397                         :start-frame-number start-frame-number                           :origin ccl:*top-error-frame*
398                         :count (- end-frame-number start-frame-number)                           :start-frame-number start-frame-number
399                         :test (and (not t) ;(not (symbol-value (swank-sym *sldb-show-internal-frames*)))                           :count (- end-frame-number start-frame-number)
400                                    'interesting-frame-p)))                           :test (and (not t) ;(not (symbol-value (swank-sym *sldb-show-internal-frames*)))
401                                        'interesting-frame-p))))
402    
403  ;; Exceptions  ;; Exceptions
404  (defvar *interesting-internal-frames* ())  (defvar *interesting-internal-frames* ())
# Line 581  Line 585 
585                (t `(:error ,(funcall if-nil-thunk))))                (t `(:error ,(funcall if-nil-thunk))))
586        (error (c) `(:error ,(princ-to-string c))))))        (error (c) `(:error ,(princ-to-string c))))))
587    
588  (defimplementation find-definitions (obj)  (defimplementation find-definitions (name)
589    (loop for ((type . name) . sources) in (ccl:find-definition-sources obj)    (let ((defs (or (ccl:find-definition-sources name)
590          collect (list (definition-name type name)                    (and (symbolp name)
591                        (source-note-to-source-location                         (fboundp name)
592                         (find-if-not #'null sources)                         (ccl:find-definition-sources (symbol-function name))))))
593                         (lambda () "No source-note available")      (loop for ((type . name) . sources) in defs
594                         name))))            collect (list (definition-name type name)
595                            (source-note-to-source-location
596                             (find-if-not #'null sources)
597                             (lambda () "No source-note available")
598                             name)))))
599    
600  (defimplementation find-source-location (obj)  (defimplementation find-source-location (obj)
601    (let* ((defs (ccl:find-definition-sources obj))    (let* ((defs (ccl:find-definition-sources obj))

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5