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

Diff of /slime/swank-lispworks.lisp

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

revision 1.3 by heller, Sat Nov 29 07:59:12 2003 UTC revision 1.4 by heller, Sun Nov 30 08:12:11 2003 UTC
# Line 123  Return NIL if the symbol is unbound." Line 123  Return NIL if the symbol is unbound."
123        (if result        (if result
124            (list* :designator (to-string symbol) result)))))            (list* :designator (to-string symbol) result)))))
125    
126    (defslimefun describe-function (symbol-name)
127      (with-output-to-string (*standard-output*)
128        (let ((sym (from-string symbol-name)))
129          (cond ((fboundp sym)
130                 (format t "~%(~A~{ ~A~})~%~%~:[(not documented)~;~:*~A~]~%"
131                         (string-downcase sym)
132                         (mapcar #'string-upcase
133                                 (lispworks:function-lambda-list sym))
134                         (documentation sym 'function))
135                 (describe (symbol-function sym)))
136                (t (format t "~S is not fbound" sym))))))
137    
138  #+(or)  #+(or)
139  (defmethod describe-object ((sym symbol) *standard-output*)  (defmethod describe-object ((sym symbol) *standard-output*)
140    (format t "~A is a symbol in package ~A." sym (symbol-package sym))    (format t "~A is a symbol in package ~A." sym (symbol-package sym))
# Line 231  Return NIL if the symbol is unbound." Line 243  Return NIL if the symbol is unbound."
243                (dspec-source-location func))))))                (dspec-source-location func))))))
244    
245  (defun dspec-source-location (dspec)  (defun dspec-source-location (dspec)
246    (let ((locations (dspec:dspec-definition-locations dspec)))    (destructuring-bind (first) (dspec-source-locations dspec)
247        first))
248    
249    (defun dspec-source-locations (dspec)
250      (let ((locations (dspec:find-dspec-locations dspec)))
251      (cond ((not locations)      (cond ((not locations)
252             (list :error (format nil "Cannot find source for ~S" dspec)))             (list :error (format nil "Cannot find source for ~S" dspec)))
253            (t            (t
254             (destructuring-bind ((dspec file) . others) locations             (loop for (dspec location) in locations
255               (declare (ignore others))                   collect (make-dspec-location dspec location))))))
              (if (eq file :unknown)  
                  (list :error (format nil "Cannot find source for ~S" dspec))  
                  (make-dspec-location dspec file)))))))  
256    
257  (defmethod function-source-location-for-emacs (fname)  (defmethod function-source-location-for-emacs (fname)
258    "Return a source position of the definition of FNAME.  The    "Return a source position of the definition of FNAME.  The
# Line 247  precise location of the definition is no Line 260  precise location of the definition is no
260  able to return the file name in which the definition occurs."  able to return the file name in which the definition occurs."
261    (dspec-source-location (from-string fname)))    (dspec-source-location (from-string fname)))
262    
263    (defslimefun find-function-locations (fname)
264      (dspec-source-locations (from-string fname)))
265    
266  ;;; callers  ;;; callers
267    
268  (defun stringify-function-name-list (list)  (defun stringify-function-name-list (list)
# Line 296  able to return the file name in which th Line 312  able to return the file name in which th
312      (delete-file filename)))      (delete-file filename)))
313    
314  (defun make-dspec-location (dspec location &optional tmpfile buffer position)  (defun make-dspec-location (dspec location &optional tmpfile buffer position)
315    (flet ((from-buffer-p () (and (pathnamep location) tmpfile    (flet ((from-buffer-p ()
316                                  (pathname-match-p location tmpfile))))             (and (pathnamep location) tmpfile
317      (make-location                  (pathname-match-p location tmpfile)))
318       (etypecase location           (filename (pathname)
319         (pathname (cond ((from-buffer-p) `(:buffer ,buffer))             (multiple-value-bind (truename condition)
320                         (t `(:file ,(namestring (truename location)))))))                 (ignore-errors (truename pathname))
321       (cond ((from-buffer-p) `(:position ,position))               (cond (condition
322             (t `(:dspec , (etypecase dspec                      (return-from make-dspec-location
323                             (symbol (symbol-name dspec))                        (list :error (format nil "~A" condition))))
324                             (cons (symbol-name                     (t (namestring truename)))))
325                                    (dspec:dspec-primary-name dspec))))))))))           (function-name (dspec)
326               (etypecase dspec
327                 (symbol (symbol-name dspec))
328                 (cons (symbol-name (dspec:dspec-primary-name dspec))))))
329        (cond ((from-buffer-p)
330               (make-location `(:buffer ,buffer) `(:position ,position)))
331              (t
332               (etypecase location
333                 (pathname
334                  (make-location `(:file ,(filename location))
335                                 `(:function-name ,(function-name dspec))))
336                 ((member :listener)
337                  `(:error ,(format nil "Function defined in listener: ~S" dspec)))
338                 ((member :unknown)
339                  `(:error ,(format nil "Function location unkown: ~S" dspec))))
340               ))))
341    
342  (defun signal-error-data-base (database &optional tmpfile buffer position)  (defun signal-error-data-base (database &optional tmpfile buffer position)
343    (map-error-database    (map-error-database
# Line 343  able to return the file name in which th Line 374  able to return the file name in which th
374    
375  ;;; xref  ;;; xref
376    
377    (defun lookup-xrefs (finder name)
378      (xref-results-for-emacs (funcall finder (from-string name))))
379    
380  (defslimefun who-calls (function-name)  (defslimefun who-calls (function-name)
381    (xref-results-for-emacs (hcl:who-calls function-name)))    (lookup-xrefs #'hcl:who-calls function-name))
382    
383  (defslimefun who-references (variable)  (defslimefun who-references (variable)
384    (xref-results-for-emacs (hcl:who-references variable)))    (lookup-xrefs #'hcl:who-references variable))
385    
386  (defslimefun who-binds (variable)  (defslimefun who-binds (variable)
387    (xref-results-for-emacs (hcl:who-binds variable)))    (lookup-xrefs #'hcl:who-binds variable))
388    
389  (defslimefun who-sets (variable)  (defslimefun who-sets (variable)
390    (xref-results-for-emacs (hcl:who-sets variable)))    (lookup-xrefs #'hcl:who-sets variable))
391    
392  (defun xref-results-for-emacs (dspecs)  (defun xref-results-for-emacs (dspecs)
393    (let ((xrefs '()))    (let ((xrefs '()))
# Line 364  able to return the file name in which th Line 398  able to return the file name in which th
398                       xrefs)))                       xrefs)))
399      (group-xrefs xrefs)))      (group-xrefs xrefs)))
400    
401    (defslimefun list-callers (symbol-name)
402      (lookup-xrefs #'hcl:who-calls symbol-name))
403    
404    (defslimefun list-callees (symbol-name)
405      (lookup-xrefs #'hcl:calls-who symbol-name))
406    
407  ;; (dspec:at-location  ;; (dspec:at-location
408  ;;  ('(:inside (:buffer "foo" 34)))  ;;  ('(:inside (:buffer "foo" 34)))
409  ;;  (defun foofun () (foofun)))  ;;  (defun foofun () (foofun)))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5