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

Diff of /slime/swank.lisp

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

revision 1.533 by heller, Wed Feb 20 22:07:35 2008 UTC revision 1.534 by heller, Wed Feb 20 22:12:37 2008 UTC
# Line 2587  Include the nicknames if NICKNAMES is tr Line 2587  Include the nicknames if NICKNAMES is tr
2587  (defslimefun find-definitions-for-emacs (name)  (defslimefun find-definitions-for-emacs (name)
2588    "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.    "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.
2589  DSPEC is a string and LOCATION a source location. NAME is a string."  DSPEC is a string and LOCATION a source location. NAME is a string."
2590    (multiple-value-bind (sexp error)    (multiple-value-bind (sexp error) (ignore-errors (values (from-string name)))
       (ignore-errors (values (from-string name)))  
2591      (unless error      (unless error
2592        (loop for (dspec loc) in (find-definitions sexp)        (mapcar #'xref>elisp (find-definitions sexp)))))
          collect (list (to-string dspec) loc)))))  
2593    
2594  (defun alistify (list key test)  (defslimefun xref (type name)
2595    "Partition the elements of LIST into an alist.  KEY extracts the key    (let ((symbol (parse-symbol-or-lose name *buffer-package*)))
2596  from an element and TEST is used to compare keys."      (mapcar #'xref>elisp
2597    (declare (type function key))              (ecase type
2598    (let ((alist '()))                (:calls (who-calls symbol))
2599      (dolist (e list)                (:calls-who (calls-who symbol))
2600        (let* ((k (funcall key e))                (:references (who-references symbol))
2601               (probe (assoc k alist :test test)))                (:binds (who-binds symbol))
2602          (if probe                (:sets (who-sets symbol))
2603              (push e (cdr probe))                (:macroexpands (who-macroexpands symbol))
2604              (push (cons k (list e)) alist))))                (:specializes (who-specializes symbol))
2605      alist))                (:callers (list-callers symbol))
2606                  (:callees (list-callees symbol))))))
2607  (defun location-position< (pos1 pos2)  
2608    (cond ((and (position-p pos1) (position-p pos2))  (defun xref>elisp (xref)
2609           (< (position-pos pos1)    (destructuring-bind (name loc) xref
2610              (position-pos pos2)))      (list (to-string name) loc)))
         (t nil)))  
   
 (defun partition (list test key)  
   (declare (type function test key))  
   (loop for e in list  
         if (funcall test (funcall key e)) collect e into yes  
         else collect e into no  
         finally (return (values yes no))))  
   
 (defstruct (xref (:conc-name xref.)  
                  (:type list))  
   dspec location)  
   
 (defun location-valid-p (location)  
   (eq (car location) :location))  
   
 (defun xref-buffer (xref)  
   (location-buffer (xref.location xref)))  
   
 (defun xref-position (xref)  
   (location-buffer (xref.location xref)))  
   
 (defun group-xrefs (xrefs)  
   "Group XREFS, a list of the form ((DSPEC LOCATION) ...) by location.  
 The result is a list of the form ((LOCATION . ((DSPEC . LOCATION) ...)) ...)."  
   (multiple-value-bind (resolved errors)  
       (partition xrefs #'location-valid-p #'xref.location)  
     (let ((alist (alistify resolved #'xref-buffer #'equal)))  
       (append  
        (loop for (buffer . list) in alist  
              collect (cons (second buffer)  
                            (mapcar (lambda (xref)  
                                      (cons (to-string (xref.dspec xref))  
                                            (xref.location xref)))  
                                    (sort list #'location-position<  
                                          :key #'xref-position))))  
        (if errors  
            (list (cons "Unresolved"  
                        (mapcar (lambda (xref)  
                                  (cons (to-string (xref.dspec xref))  
                                        (xref.location xref)))  
                                errors))))))))  
   
 (defslimefun xref (type symbol-name)  
   (let ((symbol (parse-symbol-or-lose symbol-name *buffer-package*)))  
     (group-xrefs  
      (ecase type  
        (:calls (who-calls symbol))  
        (:calls-who (calls-who symbol))  
        (:references (who-references symbol))  
        (:binds (who-binds symbol))  
        (:sets (who-sets symbol))  
        (:macroexpands (who-macroexpands symbol))  
        (:specializes (who-specializes symbol))  
        (:callers (list-callers symbol))  
        (:callees (list-callees symbol))))))  
2611    
2612    
2613  ;;;; Inspecting  ;;;; Inspecting

Legend:
Removed from v.1.533  
changed lines
  Added in v.1.534

  ViewVC Help
Powered by ViewVC 1.1.5