/[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.11 - (hide annotations)
Wed May 26 12:19:23 2010 UTC (3 years, 10 months ago) by alendvai
Branch: MAIN
CVS Tags: SLIME-2-3, SLIME-2-2, FAIRLY-STABLE, byte-stream, HEAD
Changes since 1.10: +3 -3 lines
read-file: properly deal with formats where (not (eql byte-lenght character-length))
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 heller 1.7 (unless (source-cached-p filename)
45 jsnellman 1.6 (ignore-errors
46 heller 1.8 (source-cache-get filename (file-write-date filename))))
47     nil)
48 lgorrie 1.1
49     (defun get-source-code (filename code-date)
50     "Return the source code for FILENAME as written on DATE in a string.
51     If the exact version cannot be found then return the current one from disk."
52     (or (source-cache-get filename code-date)
53     (read-file filename)))
54    
55     (defun source-cache-get (filename date)
56     "Return the source code for FILENAME as written on DATE in a string.
57     Return NIL if the right version cannot be found."
58     (when *cache-sourcecode*
59     (let ((entry (gethash filename *source-file-cache*)))
60     (cond ((and entry (equal date (source-cache-entry.date entry)))
61     ;; Cache hit.
62     (source-cache-entry.text entry))
63     ((or (null entry)
64     (not (equal date (source-cache-entry.date entry))))
65     ;; Cache miss.
66     (if (equal (file-write-date filename) date)
67     ;; File on disk has the correct version.
68     (let ((source (read-file filename)))
69     (setf (gethash filename *source-file-cache*)
70     (make-source-cache-entry source date))
71     source)
72     nil))))))
73    
74     (defun source-cached-p (filename)
75     "Is any version of FILENAME in the source cache?"
76     (if (gethash filename *source-file-cache*) t))
77    
78     (defun read-file (filename)
79     "Return the entire contents of FILENAME as a string."
80 heller 1.5 (with-open-file (s filename :direction :input
81     :external-format (or (guess-external-format filename)
82     (find-external-format "latin-1")
83     :default))
84 alendvai 1.11 (let* ((string (make-string (file-length s)))
85     (length (read-sequence string s)))
86     (subseq string 0 length))))
87 lgorrie 1.1
88     ;;;; Snippets
89    
90     (defvar *source-snippet-size* 256
91     "Maximum number of characters in a snippet of source code.
92     Snippets at the beginning of definitions are used to tell Emacs what
93     the definitions looks like, so that it can accurately find them by
94     text search.")
95    
96 heller 1.3 (defun read-snippet (stream &optional position)
97     "Read a string of upto *SOURCE-SNIPPET-SIZE* characters from STREAM.
98     If POSITION is given, set the STREAM's file position first."
99     (when position
100     (file-position stream position))
101 trittweiler 1.10 #+sbcl (skip-comments-and-whitespace stream)
102 lgorrie 1.1 (read-upto-n-chars stream *source-snippet-size*))
103 lgorrie 1.2
104 trittweiler 1.10 (defun read-snippet-from-string (string &optional position)
105     (with-input-from-string (s string)
106     (read-snippet s position)))
107    
108 lgorrie 1.2 (defun skip-comments-and-whitespace (stream)
109     (case (peek-char nil stream)
110 gcarncross 1.9 ((#\Space #\Tab #\Newline #\Linefeed #\Page)
111 lgorrie 1.2 (read-char stream)
112     (skip-comments-and-whitespace stream))
113     (#\;
114     (read-line stream)
115     (skip-comments-and-whitespace stream))))
116 lgorrie 1.1
117     (defun read-upto-n-chars (stream n)
118     "Return a string of upto N chars from STREAM."
119     (let* ((string (make-string n))
120     (chars (read-sequence string stream)))
121     (subseq string 0 chars)))
122    

  ViewVC Help
Powered by ViewVC 1.1.5