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

Diff of /slime/swank.lisp

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

revision 1.2 by lukeg, Thu Sep 4 11:41:59 2003 UTC revision 1.3 by lukeg, Mon Sep 8 13:34:01 2003 UTC
# Line 1  Line 1 
1  (defpackage :swank  (defpackage :swank
2    (:use :common-lisp :wire)    (:use :common-lisp :wire)
3    (:export #:start-server #:evaluate #:lookup-notes    (:export #:start-server #:evaluate #:lookup-notes
4             #:swank-compile-file #:arglist-string #:completions))             #:swank-compile-file #:arglist-string #:completions
5               #:find-fdefinition))
6    
7  (in-package :swank)  (in-package :swank)
8    
# Line 207  the package are considered." Line 208  the package are considered."
208    (and (<= (length s1) (length s2))    (and (<= (length s1) (length s2))
209         (string= s1 s2 :end2 (length s1))))         (string= s1 s2 :end2 (length s1))))
210    
211    ;;;; Definitions
212    
213    ;;; FIND-FDEFINITION -- interface
214    ;;;
215    (defun find-fdefinition (symbol-name package-name)
216      "Return the name of the file in which the function was defined, or NIL."
217      (fdefinition-file (read-symbol/package symbol-name package-name)))
218    
219    ;;; Clone of HEMLOCK-INTERNALS::FUN-DEFINED-FROM-PATHNAME
220    (defun fdefinition-file (function)
221      "Return the name of the file in which FUNCTION was defined."
222      (declare (type (or symbol function) function))
223      (typecase function
224        (symbol
225         (let ((def (or (macro-function function)
226                                      (and (fboundp function)
227                                           (fdefinition function)))))
228           (when def (fdefinition-file def))))
229        (kernel:byte-closure
230         (fdefinition-file (kernel:byte-closure-function function)))
231        (kernel:byte-function
232         (code-definition-file (c::byte-function-component function)))
233        (function
234         (code-definition-file (kernel:function-code-header
235                                  (kernel:%function-self function))))
236        (t nil)))
237    
238    (defun code-definition-file (code)
239      "Return the name of the file in which CODE was defined."
240      (declare (type kernel:code-component code))
241      (flet ((to-namestring (pathname)
242               (handler-case (namestring (truename pathname))
243                 (file-error () nil))))
244        (let ((info (kernel:%code-debug-info code)))
245          (when info
246            (let ((source (car (c::debug-info-source info))))
247              (when (and source (eq (c::debug-source-from source) :file))
248                (to-namestring (c::debug-source-name source))))))))
249    
250    ;;;; Utilities.
251    
252    (defun read-symbol/package (symbol-name package-name)
253      (let ((package (find-package package-name)))
254        (unless package (error "No such package: %S" package-name))
255        (handler-case
256            (let ((*package* package))
257              (read-from-string symbol-name))
258          (reader-error () nil))))
259    

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

  ViewVC Help
Powered by ViewVC 1.1.5