/[slime]/slime/swank-source-file-cache.lisp
ViewVC logotype

Contents of /slime/swank-source-file-cache.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (hide annotations)
Mon Aug 29 20:02:58 2005 UTC (8 years, 7 months ago) by lgorrie
Branch: MAIN
CVS Tags: SLIME-2-0, SLIME-1-3
Branch point for: fsm
Changes since 1.3: +3 -0 lines
Added public domain dedication.
1 lgorrie 1.1 ;;;; Source-file cache
2     ;;;
3     ;;; To robustly find source locations in CMUCL and SBCL it's useful to
4     ;;; have the exact source code that the loaded code was compiled from.
5     ;;; In this source we can accurately find the right location, and from
6     ;;; that location we can extract a "snippet" of code to show what the
7     ;;; definition looks like. Emacs can use this snippet in a best-match
8     ;;; search to locate the right definition, which works well even if
9     ;;; the buffer has been modified.
10     ;;;
11     ;;; The idea is that if a definition previously started with
12     ;;; `(define-foo bar' then it probably still does.
13     ;;;
14     ;;; Whenever we see that the file on disk has the same
15     ;;; `file-write-date' as a location we're looking for we cache the
16     ;;; whole file inside Lisp. That way we will still have the matching
17     ;;; version even if the file is later modified on disk. If the file is
18     ;;; later recompiled and reloaded then we replace our cache entry.
19 lgorrie 1.4 ;;;
20     ;;; This code has been placed in the Public Domain. All warranties
21     ;;; are disclaimed.
22 lgorrie 1.1
23     (in-package :swank-backend)
24    
25     (defvar *cache-sourcecode* t
26     "When true complete source files are cached.
27     The cache is used to keep known good copies of the source text which
28     correspond to the loaded code. Finding definitions is much more
29     reliable when the exact source is available, so we cache it in case it
30     gets edited on disk later.")
31    
32     (defvar *source-file-cache* (make-hash-table :test 'equal)
33     "Cache of source file contents.
34     Maps from truename to source-cache-entry structure.")
35    
36     (defstruct (source-cache-entry
37     (:conc-name source-cache-entry.)
38     (:constructor make-source-cache-entry (text date)))
39     text date)
40    
41     (defimplementation buffer-first-change (filename)
42     "Load a file into the cache when the user modifies its buffer.
43     This is a win if the user then saves the file and tries to M-. into it."
44     (unless (source-cached-p filename)
45     (ignore-errors (source-cache-get filename (file-write-date filename)))))
46    
47     (defun get-source-code (filename code-date)
48     "Return the source code for FILENAME as written on DATE in a string.
49     If the exact version cannot be found then return the current one from disk."
50     (or (source-cache-get filename code-date)
51     (read-file filename)))
52    
53     (defun source-cache-get (filename date)
54     "Return the source code for FILENAME as written on DATE in a string.
55     Return NIL if the right version cannot be found."
56     (when *cache-sourcecode*
57     (let ((entry (gethash filename *source-file-cache*)))
58     (cond ((and entry (equal date (source-cache-entry.date entry)))
59     ;; Cache hit.
60     (source-cache-entry.text entry))
61     ((or (null entry)
62     (not (equal date (source-cache-entry.date entry))))
63     ;; Cache miss.
64     (if (equal (file-write-date filename) date)
65     ;; File on disk has the correct version.
66     (let ((source (read-file filename)))
67     (setf (gethash filename *source-file-cache*)
68     (make-source-cache-entry source date))
69     source)
70     nil))))))
71    
72     (defun source-cached-p (filename)
73     "Is any version of FILENAME in the source cache?"
74     (if (gethash filename *source-file-cache*) t))
75    
76     (defun read-file (filename)
77     "Return the entire contents of FILENAME as a string."
78     (with-open-file (s filename :direction :input)
79     (let ((string (make-string (file-length s))))
80     (read-sequence string s)
81     string)))
82    
83     ;;;; Snippets
84    
85     (defvar *source-snippet-size* 256
86     "Maximum number of characters in a snippet of source code.
87     Snippets at the beginning of definitions are used to tell Emacs what
88     the definitions looks like, so that it can accurately find them by
89     text search.")
90    
91 heller 1.3 (defun read-snippet (stream &optional position)
92     "Read a string of upto *SOURCE-SNIPPET-SIZE* characters from STREAM.
93     If POSITION is given, set the STREAM's file position first."
94     (when position
95     (file-position stream position))
96 lgorrie 1.2 #+SBCL (skip-comments-and-whitespace stream)
97 lgorrie 1.1 (read-upto-n-chars stream *source-snippet-size*))
98 lgorrie 1.2
99     (defun skip-comments-and-whitespace (stream)
100     (case (peek-char nil stream)
101     ((#\Space #\Tab #\Newline #\Linefeed)
102     (read-char stream)
103     (skip-comments-and-whitespace stream))
104     (#\;
105     (read-line stream)
106     (skip-comments-and-whitespace stream))))
107 lgorrie 1.1
108     (defun read-upto-n-chars (stream n)
109     "Return a string of upto N chars from STREAM."
110     (let* ((string (make-string n))
111     (chars (read-sequence string stream)))
112     (subseq string 0 chars)))
113    

  ViewVC Help
Powered by ViewVC 1.1.5