|
0
|
1 ;;; -*- Mode: Emacs-Lisp -*-
|
|
|
2
|
|
|
3 ;;; ilisp-src.el --
|
|
|
4
|
|
|
5 ;;; This file is part of ILISP.
|
|
4
|
6 ;;; Version: 5.8
|
|
0
|
7 ;;;
|
|
|
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
|
|
|
9 ;;; 1993, 1994 Ivan Vasquez
|
|
4
|
10 ;;; 1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
|
|
|
11 ;;; 1996 Marco Antoniotti and Rick Campbell
|
|
0
|
12 ;;;
|
|
|
13 ;;; Other authors' names for which this Copyright notice also holds
|
|
|
14 ;;; may appear later in this file.
|
|
|
15 ;;;
|
|
4
|
16 ;;; Send mail to 'ilisp-request@naggum.no' to be included in the
|
|
|
17 ;;; ILISP mailing list. 'ilisp@naggum.no' is the general ILISP
|
|
0
|
18 ;;; mailing list were bugs and improvements are discussed.
|
|
|
19 ;;;
|
|
|
20 ;;; ILISP is freely redistributable under the terms found in the file
|
|
|
21 ;;; COPYING.
|
|
|
22
|
|
|
23
|
|
|
24
|
|
|
25 ;;; See ilisp.el for more information.
|
|
|
26
|
|
|
27 ;;;%Source file operations
|
|
|
28 (if (not (boundp 'tags-file-name)) (defvar tags-file-name nil))
|
|
|
29 (defvar lisp-last-definition nil "Last definition (name type) looked for.")
|
|
|
30 (defvar lisp-last-file nil "Last used source file.")
|
|
|
31 (defvar lisp-first-point nil "First point found in last source file.")
|
|
|
32 (defvar lisp-last-point nil "Last point in last source file.")
|
|
|
33 (defvar lisp-last-locator nil "Last source locator used.")
|
|
|
34 (defvar lisp-search nil "Set to T when searching for definitions.")
|
|
|
35 (defvar lisp-using-tags nil "Set to T when using tags.")
|
|
|
36
|
|
|
37 ;;;%%lisp-directory
|
|
|
38 (defvar lisp-edit-files t
|
|
|
39 "If T, then buffers in one of lisp-source-modes will be searched by
|
|
|
40 edit-definitions-lisp if the source cannot be found through the
|
|
|
41 inferior LISP. It can also be a list of files to edit definitions
|
|
|
42 from set up by \(\\[lisp-directory]). If it is set to nil, then no
|
|
|
43 additional files will be searched.")
|
|
|
44
|
|
|
45 ;;;
|
|
|
46 (defun lisp-extensions ()
|
|
|
47 "Return a regexp for matching the extensions of files that enter one
|
|
|
48 of lisp-source-modes according to auto-mode-alist."
|
|
|
49 (let ((entries auto-mode-alist)
|
|
|
50 (extensions nil))
|
|
|
51 (while entries
|
|
|
52 (let ((entry (car entries)))
|
|
|
53 (if (memq (cdr entry) lisp-source-modes)
|
|
|
54 (setq extensions
|
|
|
55 (concat "\\|" (car entry) extensions))))
|
|
|
56 (setq entries (cdr entries)))
|
|
|
57 (substring extensions 2)))
|
|
|
58
|
|
|
59 ;;;
|
|
|
60 (defun lisp-directory (directory add)
|
|
|
61 "Edit the files in DIRECTORY that have an auto-mode alist entry in
|
|
|
62 lisp-source-modes. With a positive prefix, add the files on to the
|
|
|
63 already existing files. With a negative prefix, clear the list. In
|
|
|
64 either case set tags-file-name to nil so that tags are not used."
|
|
|
65 (interactive
|
|
|
66 (list (if (not (eq current-prefix-arg '-))
|
|
|
67 (read-file-name "Lisp Directory: "
|
|
|
68 nil
|
|
|
69 default-directory
|
|
|
70 nil))
|
|
|
71 current-prefix-arg))
|
|
|
72 (setq tags-file-name nil)
|
|
|
73 (if (eq add '-)
|
|
|
74 (progn (setq lisp-edit-files t)
|
|
|
75 (message "No current lisp directory"))
|
|
|
76 (if add
|
|
|
77 (message "Added %s as a lisp directory" directory)
|
|
|
78 (message "%s is the lisp directory" directory))
|
|
|
79 (setq directory (expand-file-name directory))
|
|
|
80 (if (file-directory-p directory)
|
|
|
81 (setq lisp-edit-files
|
|
|
82 (append
|
|
|
83 (directory-files directory t (lisp-extensions))
|
|
|
84 (if add (if (eq lisp-edit-files t) nil lisp-edit-files))))
|
|
|
85 (error "%s is not a directory" directory))))
|
|
|
86
|
|
|
87 ;;;%%Utilities
|
|
|
88
|
|
|
89 (defun fix-source-filenames ()
|
|
|
90 "Apply the ilisp-source-directory-fixup-alist to the current buffer
|
|
|
91 (which will be *Edit-Definitions*) to change any pre-compiled
|
|
|
92 source-file locations to point to local source file locations.
|
|
|
93 See ilisp-source-directory-fixup-alist."
|
|
|
94 (let ((alist (ilisp-value 'ilisp-source-directory-fixup-alist t))
|
|
|
95 cons)
|
|
|
96 (if alist
|
|
|
97 (save-excursion
|
|
|
98 (while alist
|
|
|
99 (setq cons (car alist))
|
|
|
100 (goto-char (point-min))
|
|
|
101 (if (re-search-forward (car cons) (point-max) t)
|
|
|
102 (replace-match (cdr cons)))
|
|
|
103 (setq alist (cdr alist)))))))
|
|
|
104
|
|
|
105 (defun lisp-setup-edit-definitions (message edit-files)
|
|
|
106 "Set up *Edit-Definitions* with MESSAGE. If EDIT-FILES is T, insert
|
|
|
107 all buffer filenames that are in one of lisp-source-modes into the
|
|
|
108 current buffer. If it is a list of files set up by lisp-directory,
|
|
|
109 insert those in the buffer. If it is a string put that in the buffer."
|
|
|
110 (setq lisp-using-tags nil
|
|
|
111 lisp-search (not (stringp edit-files)))
|
|
|
112 (set-buffer (get-buffer-create "*Edit-Definitions*"))
|
|
|
113 (erase-buffer)
|
|
|
114 (insert message)
|
|
|
115 (insert "\n\n")
|
|
|
116 (if edit-files
|
|
|
117 (progn
|
|
|
118 (if (eq edit-files t)
|
|
|
119 (let ((buffers (buffer-list)))
|
|
|
120 (while buffers
|
|
|
121 (let ((buffer (car buffers)))
|
|
|
122 (if (save-excursion
|
|
|
123 (set-buffer buffer)
|
|
|
124 (and (memq major-mode lisp-source-modes)
|
|
|
125 (buffer-file-name buffer)))
|
|
|
126 (progn (insert ?\") (insert (buffer-file-name buffer))
|
|
|
127 (insert "\"\n"))))
|
|
|
128 (setq buffers (cdr buffers))))
|
|
|
129 (if (stringp edit-files)
|
|
|
130 (progn (insert edit-files)
|
|
|
131 ;; Remove garbage collection messages
|
|
|
132 (replace-regexp "^;[^\n]*\n" "")
|
|
|
133 (fix-source-filenames))
|
|
|
134 (let ((files edit-files))
|
|
|
135 (while files
|
|
|
136 (insert ?\")
|
|
|
137 (insert (car files))
|
|
|
138 (insert "\"\n")
|
|
|
139 (setq files (cdr files))))))
|
|
|
140 (goto-char (point-min))
|
|
|
141 (forward-line 2)
|
|
|
142 (set-buffer-modified-p nil))
|
|
|
143 (error
|
|
|
144 (substitute-command-keys
|
|
|
145 "Use \\[lisp-directory] to define source files."))))
|
|
|
146
|
|
|
147 ;;;
|
|
|
148 (defun lisp-locate-definition (locator definition file point
|
|
|
149 &optional
|
|
|
150 back pop)
|
|
|
151 "Use LOCATOR to find the next DEFINITION (symbol . type) in FILE
|
|
|
152 starting at POINT, optionally BACKWARDS and POP to buffer. Return T
|
|
|
153 if successful."
|
|
|
154 (if file
|
|
|
155 (if (not (file-exists-p file))
|
|
|
156 (progn
|
|
|
157 (message "File %s doesn't exist!" file)
|
|
|
158 (sit-for 1)
|
|
|
159 nil)
|
|
|
160 (let* ((symbol (car definition))
|
|
|
161 (type (cdr definition))
|
|
|
162 (first (not (eq lisp-last-file file)))
|
|
|
163 (buffer (current-buffer))
|
|
|
164 name)
|
|
|
165 (lisp-find-file file pop)
|
|
|
166 (if first (setq lisp-first-point (point)))
|
|
|
167 (if back
|
|
|
168 (if first
|
|
|
169 (goto-char (point-max))
|
|
|
170 (goto-char point)
|
|
|
171 (forward-line -1)
|
|
|
172 (end-of-line))
|
|
|
173 (goto-char point)
|
|
|
174 (if (not first)
|
|
|
175 (progn (forward-line 1) (beginning-of-line))))
|
|
|
176 (if (eq type 't)
|
|
|
177 (message "Search %s for %s" file symbol)
|
|
|
178 (message "Searching %s for %s %s" file type
|
|
|
179 (setq name (lisp-buffer-symbol symbol))))
|
|
|
180 (if (funcall locator symbol type first back)
|
|
|
181 (progn
|
|
|
182 (setq lisp-last-file file
|
|
|
183 lisp-last-point (point))
|
|
|
184 (if (bolp)
|
|
|
185 (forward-line -1)
|
|
|
186 (beginning-of-line))
|
|
|
187 (recenter 0)
|
|
|
188 (if name
|
|
|
189 (message "Found %s %s definition" type name)
|
|
|
190 (message "Found %s"))
|
|
|
191 t)
|
|
|
192 (if first
|
|
|
193 (goto-char lisp-first-point)
|
|
|
194 (set-buffer buffer)
|
|
|
195 (goto-char point))
|
|
|
196 nil)))))
|
|
|
197
|
|
|
198 ;;;
|
|
|
199 (defun lisp-next-file (back)
|
|
|
200 "Return the next filename in *Edit-Definitions*, or nil if none."
|
|
|
201 (let ((file t)
|
|
|
202 result)
|
|
|
203 (set-buffer (get-buffer-create "*Edit-Definitions*"))
|
|
|
204 (if back
|
|
|
205 (progn (forward-line -1)
|
|
|
206 (if (looking-at "\n")
|
|
|
207 (progn
|
|
|
208 (forward-line 1)
|
|
|
209 (end-of-line)
|
|
|
210 (setq file nil)))))
|
|
|
211 (if file
|
|
|
212 (progn
|
|
|
213 (skip-chars-forward "^\"")
|
|
|
214 (if (eobp)
|
|
|
215 (progn (bury-buffer (current-buffer))
|
|
|
216 (setq result nil))
|
|
|
217 (let* ((start (progn (forward-char 1) (point))))
|
|
|
218 (skip-chars-forward "^\"")
|
|
|
219 (setq file
|
|
|
220 (prog1 (buffer-substring start (point))
|
|
|
221 (end-of-line)))
|
|
|
222 (bury-buffer (current-buffer))))))
|
|
|
223 (if (not (eq file 't)) file)))
|
|
|
224
|
|
|
225 ;;;
|
|
|
226 (defun lisp-next-definition (back pop)
|
|
|
227 "Go to the next definition from *Edit-Definitions* going BACK with
|
|
|
228 prefix and POPPING. Return 'first if found first time, 'none if no
|
|
|
229 definition ever, T if another definition is found, and nil if no more
|
|
|
230 definitions are found."
|
|
|
231 (let ((done nil)
|
|
|
232 (result nil))
|
|
|
233 (while
|
|
|
234 (not
|
|
|
235 (or
|
|
|
236 (setq result
|
|
|
237 (lisp-locate-definition ;Same file
|
|
|
238 lisp-last-locator
|
|
|
239 lisp-last-definition lisp-last-file lisp-last-point back))
|
|
|
240 (let ((file (lisp-next-file back)))
|
|
|
241 (if file
|
|
|
242 (if (lisp-locate-definition
|
|
|
243 lisp-last-locator lisp-last-definition
|
|
|
244 file 1 back
|
|
|
245 (prog1 pop (setq pop nil)))
|
|
|
246 (setq result 'first)
|
|
|
247 (setq result (if (not lisp-search) 'none)))
|
|
|
248 t)))))
|
|
|
249 (set-buffer (window-buffer (selected-window)))
|
|
|
250 result))
|
|
|
251
|
|
|
252 ;;;%%Next-definition
|
|
|
253 (defun next-definition-lisp (back &optional pop)
|
|
|
254 "Edit the next definition from *Edit-Definitions* going BACK with
|
|
|
255 prefix and optionally POPPING or call tags-loop-continue if using tags."
|
|
|
256 (interactive "P")
|
|
|
257 (if lisp-using-tags
|
|
|
258 (tags-loop-continue)
|
|
|
259 (let* ((result (lisp-next-definition back pop))
|
|
|
260 (symbol (car lisp-last-definition))
|
|
|
261 (type (cdr lisp-last-definition))
|
|
|
262 (name (if (not (eq type 't)) (lisp-buffer-symbol symbol))))
|
|
|
263 (cond ((or (eq result 'first) (eq result 't))
|
|
|
264 (if name
|
|
|
265 (message "Found %s %s definition" type name)
|
|
|
266 (message "Found %s" symbol)))
|
|
|
267 ((eq result 'none)
|
|
|
268 (error "Can't find %s %s definition" type name))
|
|
|
269 (t
|
|
|
270 (if name
|
|
|
271 (error "No more %s %s definitions" type name)
|
|
|
272 (message "Done")))))))
|
|
|
273
|
|
|
274
|
|
|
275 ;;;%%Edit-definitions
|
|
|
276 (defun edit-definitions-lisp (symbol type &optional stay search locator)
|
|
|
277 "Find the source files for the TYPE definitions of SYMBOL. If STAY,
|
|
|
278 use the same window. If SEARCH, do not look for symbol in inferior
|
|
|
279 LISP. The definition will be searched for through the inferior LISP
|
|
|
280 and if not found it will be searched for in the current tags file and
|
|
|
281 if not found in the files in lisp-edit-files set up by
|
|
|
282 \(\\[lisp-directory]) or the buffers in one of lisp-source-modes if
|
|
|
283 lisp-edit-files is T. If lisp-edit-files is nil, no search will be
|
|
|
284 done if not found through the inferior LISP. TYPES are from
|
|
|
285 ilisp-source-types which is an alist of symbol strings or list
|
|
|
286 strings. With a negative prefix, look for the current symbol as the
|
|
|
287 first type in ilisp-source-types."
|
|
|
288 (interactive
|
|
|
289 (let* ((types (ilisp-value 'ilisp-source-types t))
|
|
|
290 (default (if types (car (car types))))
|
|
|
291 (function (lisp-function-name))
|
|
|
292 (symbol (lisp-buffer-symbol function)))
|
|
|
293 (if (lisp-minus-prefix)
|
|
|
294 (list function default)
|
|
|
295 (list (ilisp-read-symbol
|
|
|
296 (format "Edit Definition [%s]: " symbol)
|
|
|
297 function
|
|
|
298 nil
|
|
|
299 t)
|
|
|
300 (if types
|
|
|
301 (ilisp-completing-read
|
|
|
302 (format "Type [%s]: " default)
|
|
|
303 types default))))))
|
|
|
304 (let* ((name (lisp-buffer-symbol symbol))
|
|
|
305 (symbol-name (lisp-symbol-name symbol))
|
|
|
306 (command (ilisp-value 'ilisp-find-source-command t))
|
|
|
307 (source
|
|
|
308 (if (and command (not search) (comint-check-proc ilisp-buffer))
|
|
|
309 (ilisp-send
|
|
|
310 (format command symbol-name
|
|
|
311 (lisp-symbol-package symbol)
|
|
|
312 type)
|
|
|
313 (concat "Finding " type " " name " definitions")
|
|
|
314 'source )
|
|
|
315 "nil"))
|
|
|
316 (result (and source (lisp-last-line source)))
|
|
|
317 (source-ok (not (or (ilisp-value 'comint-errorp t)
|
|
|
318 (null result)
|
|
|
319 (string-match "nil" (car result)))))
|
|
|
320 (case-fold-search t)
|
|
|
321 (tagged nil))
|
|
|
322 (unwind-protect
|
|
|
323 (if (and tags-file-name (not source-ok))
|
|
|
324 (progn (setq lisp-using-tags t)
|
|
|
325 (if (string-match "Lucid" emacs-version)
|
|
|
326 (find-tag symbol-name stay)
|
|
|
327 (find-tag symbol-name nil stay))
|
|
|
328 (setq tagged t)))
|
|
|
329 (if (not tagged)
|
|
|
330 (progn
|
|
|
331 (setq lisp-last-definition (cons symbol type)
|
|
|
332 lisp-last-file nil
|
|
|
333 lisp-last-locator (or locator (ilisp-value 'ilisp-locator)))
|
|
|
334 (lisp-setup-edit-definitions
|
|
|
335 (format "%s %s definitions:" type name)
|
|
|
336 (if source-ok (cdr result) lisp-edit-files))
|
|
|
337 (next-definition-lisp nil t))))))
|
|
|
338
|
|
|
339 ;;;%%Searching
|
|
|
340 (defun lisp-locate-search (pattern type first back)
|
|
|
341 "Find PATTERN in the current buffer."
|
|
|
342 (if back
|
|
|
343 (search-backward pattern nil t)
|
|
|
344 (search-forward pattern nil t)))
|
|
|
345
|
|
|
346 ;;;
|
|
|
347 (defun lisp-locate-regexp (regexp type first back)
|
|
|
348 "Find REGEXP in the current buffer."
|
|
|
349 (if back
|
|
|
350 (re-search-backward regexp nil t)
|
|
|
351 (re-search-forward regexp nil t)))
|
|
|
352
|
|
|
353 ;;;
|
|
|
354 (defvar lisp-last-pattern nil "Last search regexp.")
|
|
|
355 (defun search-lisp (pattern regexp)
|
|
|
356 "Search for PATTERN through the files in lisp-edit-files if it is a
|
|
|
357 list and the current buffers in one of lisp-source-modes otherwise.
|
|
|
358 If lisp-edit-files is nil, no search will be done. If called with a
|
|
|
359 prefix, search for regexp. If there is a tags file, call tags-search instead."
|
|
|
360 (interactive
|
|
|
361 (list (read-string (if current-prefix-arg
|
|
|
362 "Search for regexp: "
|
|
|
363 "Search for: ") lisp-last-pattern)
|
|
|
364 current-prefix-arg))
|
|
|
365 (if tags-file-name
|
|
|
366 (progn (setq lisp-using-tags t)
|
|
|
367 (tags-search (if regexp pattern (regexp-quote pattern))))
|
|
|
368 (setq lisp-last-pattern pattern
|
|
|
369 lisp-last-definition (cons pattern t)
|
|
|
370 lisp-last-file nil
|
|
|
371 lisp-last-locator (if regexp
|
|
|
372 'lisp-locate-regexp
|
|
|
373 'lisp-locate-search))
|
|
|
374 (lisp-setup-edit-definitions (format "Searching for %s:" pattern)
|
|
|
375 lisp-edit-files)
|
|
|
376 (next-definition-lisp nil nil)))
|
|
|
377
|
|
|
378 ;;;%%Replacing
|
|
|
379 (defvar lisp-last-replace nil "Last replace regexp.")
|
|
|
380 (defun replace-lisp (old new regexp)
|
|
|
381 "Query replace OLD by NEW through the files in lisp-edit-files if it
|
|
|
382 is a list and the current buffers in one of lisp-source-modes
|
|
|
383 otherwise. If lisp-edit-files is nil, no search will be done. If
|
|
|
384 called with a prefix, replace regexps. If there is a tags file, then
|
|
|
385 call tags-query-replace instead."
|
|
|
386 (interactive
|
|
|
387 (let ((old (read-string (if current-prefix-arg
|
|
|
388 "Replace regexp: "
|
|
|
389 "Replace: ") lisp-last-pattern)))
|
|
|
390 (list old
|
|
|
391 (read-string (if current-prefix-arg
|
|
|
392 (format "Replace regexp %s by: " old)
|
|
|
393 (format "Replace %s by: " old))
|
|
|
394 lisp-last-replace)
|
|
|
395 current-prefix-arg)))
|
|
|
396 (if tags-file-name
|
|
|
397 (progn (setq lisp-using-tags t)
|
|
|
398 (tags-query-replace (if regexp old (regexp-quote old))
|
|
|
399 new))
|
|
|
400 (setq lisp-last-pattern old
|
|
|
401 lisp-last-replace new)
|
|
|
402 (lisp-setup-edit-definitions
|
|
|
403 (format "Replacing %s by %s:\n\n" old new)
|
|
|
404 lisp-edit-files)
|
|
|
405 (let (file)
|
|
|
406 (while (setq file (lisp-next-file nil))
|
|
|
407 (lisp-find-file file)
|
|
|
408 (let ((point (point)))
|
|
|
409 (goto-char (point-min))
|
|
|
410 (if (if regexp
|
|
|
411 (re-search-forward old nil t)
|
|
|
412 (search-forward old nil t))
|
|
|
413 (progn (beginning-of-line)
|
|
|
414 (if regexp
|
|
|
415 (query-replace-regexp old new)
|
|
|
416 (query-replace old new)))
|
|
|
417 (goto-char point)))))))
|
|
|
418
|
|
|
419 ;;;%%Edit-callers
|
|
|
420 (defvar lisp-callers nil
|
|
|
421 "T if we found callers through inferior LISP.")
|
|
|
422
|
|
|
423 ;;;
|
|
|
424 (defun who-calls-lisp (function &optional no-show)
|
|
|
425 "Put the functions that call FUNCTION into the buffer *All-Callers*
|
|
|
426 and show it unless NO-SHOW is T. Return T if successful."
|
|
|
427 (interactive
|
|
|
428 (let* ((function (lisp-defun-name))
|
|
|
429 (symbol (lisp-buffer-symbol function)))
|
|
|
430 (if (lisp-minus-prefix)
|
|
|
431 (list function)
|
|
|
432 (list (ilisp-read-symbol
|
|
|
433 (format "Who Calls [%s]: " symbol)
|
|
|
434 function
|
|
|
435 t t)))))
|
|
|
436 (let* ((name (lisp-buffer-symbol function))
|
|
|
437 (command (ilisp-value 'ilisp-callers-command t))
|
|
|
438 (callers
|
|
|
439 (if command
|
|
|
440 (ilisp-send
|
|
|
441 (format command
|
|
|
442 (lisp-symbol-name function)
|
|
|
443 (lisp-symbol-package function))
|
|
|
444 (concat "Finding callers of " name)
|
|
|
445 'callers)))
|
|
|
446 (last-line (lisp-last-line callers))
|
|
|
447 (case-fold-search t))
|
|
|
448 (set-buffer (get-buffer-create "*All-Callers*"))
|
|
|
449 (erase-buffer)
|
|
|
450 (insert (format "All callers of function %s:\n\n" name))
|
|
|
451 (if (and command (not (ilisp-value 'comint-errorp t)))
|
|
|
452 (if (string-match "nil" (car last-line))
|
|
|
453 (error "%s has no callers" name)
|
|
|
454 (message "")
|
|
|
455 (insert (cdr last-line))
|
|
|
456 (goto-char (point-min))
|
|
|
457 ;; Remove garbage collection messages
|
|
|
458 (replace-regexp "^;[^\n]*\n" "")
|
|
|
459 (goto-char (point-min))
|
|
|
460 (forward-line 2)
|
|
|
461 (if (not no-show)
|
|
|
462 (if (ilisp-temp-buffer-show-function)
|
|
|
463 (funcall (ilisp-temp-buffer-show-function)
|
|
|
464 (get-buffer "*All-Callers*"))
|
|
|
465 (view-buffer "*All-Callers*")))
|
|
|
466 t)
|
|
|
467 (insert "Using the current source files to find callers.")
|
|
|
468 nil)))
|
|
|
469
|
|
|
470 ;;;
|
|
|
471 (defun next-caller-lisp (back &optional pop)
|
|
|
472 "Edit the next caller from *All-Callers*. With prefix, edit
|
|
|
473 the previous caller. If it can't get caller information from the
|
|
|
474 inferior LISP, this will search using the current source files. See
|
|
|
475 lisp-directory."
|
|
|
476 (interactive "P")
|
|
|
477 (if (not lisp-callers)
|
|
|
478 (next-definition-lisp back pop)
|
|
|
479 (set-buffer (get-buffer-create "*All-Callers*"))
|
|
|
480 (if back (forward-line -1))
|
|
|
481 (skip-chars-forward " \t\n")
|
|
|
482 (if (eobp)
|
|
|
483 (progn
|
|
|
484 (bury-buffer (current-buffer))
|
|
|
485 (error "No more callers"))
|
|
|
486 (let* ((start (point))
|
|
|
487 (caller-function
|
|
|
488 (progn
|
|
|
489 (skip-chars-forward "^ \t\n")
|
|
|
490 (buffer-substring start (point)))))
|
|
|
491 (bury-buffer (current-buffer))
|
|
|
492 (edit-definitions-lisp (lisp-string-to-symbol caller-function)
|
|
|
493 (car (car (ilisp-value 'ilisp-source-types)))
|
|
|
494 (not pop))))))
|
|
|
495
|
|
|
496 ;;;
|
|
|
497 (defun edit-callers-lisp (function)
|
|
|
498 "Edit the callers of FUNCTION. With a minus prefix use the symbol
|
|
|
499 at the start of the current defun."
|
|
|
500 (interactive
|
|
|
501 (let* ((function (lisp-defun-name)))
|
|
|
502 (if (lisp-minus-prefix)
|
|
|
503 (list function)
|
|
|
504 (list (ilisp-read-symbol
|
|
|
505 (format "Edit callers of [%s]: "
|
|
|
506 (lisp-buffer-symbol function))
|
|
|
507 function
|
|
|
508 t)))))
|
|
|
509 (if (save-excursion (setq lisp-callers (who-calls-lisp function t)))
|
|
|
510 (progn
|
|
|
511 (setq lisp-last-locator (ilisp-value 'ilisp-calls-locator))
|
|
|
512 (next-caller-lisp nil t))
|
|
|
513 (edit-definitions-lisp function "calls" nil t
|
|
|
514 (ilisp-value 'ilisp-calls-locator))))
|
|
|
515
|
|
|
516 ;;;%Locators
|
|
|
517 (defun lisp-re (back format &rest args)
|
|
|
518 "Search BACK if T using FORMAT applied to ARGS."
|
|
|
519 (let ((regexp (apply 'format format args)))
|
|
|
520 (if back
|
|
|
521 (re-search-backward regexp nil t)
|
|
|
522 (re-search-forward regexp nil t))))
|
|
|
523
|
|
|
524 ;;;
|
|
|
525 (defun lisp-locate-ilisp (symbol type first back)
|
|
|
526 "Find SYMBOL's TYPE definition in the current file and return T if
|
|
|
527 successful. A definition is of the form
|
|
|
528 \(def<whitespace>(?name<whitespace>."
|
|
|
529 (lisp-re back
|
|
|
530 "^[ \t\n]*(def[^ \t\n]*[ \t\n]+(?%s[ \t\n(]+"
|
|
|
531 (regexp-quote (lisp-symbol-name symbol))))
|
|
|
532
|
|
|
533 ;;;
|
|
|
534 (defun lisp-locate-calls (symbol type first back)
|
|
|
535 "Locate calls to SYMBOL."
|
|
|
536 (lisp-re back "\\(#'\\|(\\|'\\)%s\\([ \t\n]+\\|)\\)"
|
|
|
537 (regexp-quote (lisp-buffer-symbol symbol))))
|
|
|
538
|
|
|
539
|
|
|
540 ;;;%%Common LISP
|
|
|
541
|
|
|
542 (defvar ilisp-cl-source-locater-patterns
|
|
|
543 '((setf
|
|
|
544 "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(setf\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*)")
|
|
|
545
|
|
|
546 (function
|
|
|
547 "^\\(.\\)?[ \t\n]*(defun\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
|
|
|
548
|
|
|
549 (macro
|
|
|
550 "^\\(.\\)?[ \t\n]*(defmacro\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
|
|
|
551
|
|
|
552 (variable
|
|
|
553 "^\\(.\\)?[ \t\n]*(def\\(\\(var\\)\\|\\(parameter\\)\\|constant\\)\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
|
|
|
554
|
|
|
555 (structure
|
|
|
556 "^\\(.\\)?[ \t\n]*(defstruct\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)(?[ \t\n]*\\(.\\)?[ \t\n]*%s[ \t\n(]")
|
|
|
557
|
|
|
558 (type
|
|
|
559 "^\\(.\\)?[ \t\n]*(deftype\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
|
|
|
560
|
|
|
561 (class
|
|
|
562 "^\\(.\\)?[ \t\n]*(defclass\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n(]")
|
|
|
563 ))
|
|
|
564
|
|
|
565
|
|
|
566 (defun ilisp-locate-clisp-defn (name type back)
|
|
|
567 (let ((pattern (car (cdr (assoc (intern type) ilisp-cl-source-locater-patterns)))))
|
|
|
568 (if pattern
|
|
|
569 (lisp-re back pattern name))))
|
|
|
570
|
|
|
571
|
|
|
572
|
|
|
573 (defun ilisp-locate-clos-method (name type back)
|
|
|
574 (if (string-match "(\\([^(]*\\)\\(([^)]*)\\)" type)
|
|
|
575 (let* ((quals (substring type (match-beginning 1) (match-end 1)))
|
|
|
576 (class
|
|
|
577 (read (substring type (match-beginning 2) (match-end 2))))
|
|
|
578 (class-re nil)
|
|
|
579 (position 0))
|
|
|
580 (while (setq position (string-match
|
|
|
581 "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
|
|
|
582 quals position))
|
|
|
583 (setq quals
|
|
|
584 (concat (substring quals 0 position)
|
|
|
585 "\\([ \t\n]+.[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\|[ \t\n]+\\)"
|
|
|
586 (substring quals (match-end 0)))))
|
|
|
587 (while class
|
|
|
588 (setq class-re
|
|
|
589 (concat
|
|
|
590 class-re
|
|
|
591 (format
|
|
|
592 "[ \t\n]*\\(.\\)?[ \t\n]*([ \t\n]*\\(.\\)?[ \t\n]*[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n]*\\(.\\)?[ \t\n]*"
|
|
|
593 (car class)))
|
|
|
594 class (cdr class)))
|
|
|
595 (lisp-re back
|
|
|
596 "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[^ \t\n]*([^ \t\n]*%s"
|
|
|
597 name quals class-re))))
|
|
|
598
|
|
|
599
|
|
|
600
|
|
|
601
|
|
|
602 (defun lisp-locate-clisp (symbol type first back)
|
|
|
603 "Try to find SYMBOL's TYPE definition in the current buffer and return
|
|
|
604 T if sucessful. FIRST is T if this is the first time in a file. BACK
|
|
|
605 is T to go backwards."
|
|
|
606 (let* ((name (regexp-quote (lisp-symbol-name symbol)))
|
|
|
607 (prefix
|
|
|
608 ;; Automatically generated defstruct accessors
|
|
|
609 (if (string-match "-" name)
|
|
|
610 (let ((struct (substring name 0 (1- (match-end 0)))))
|
|
|
611 (format
|
|
|
612 "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?\\|\\|[ \t\n]*.[ \t\n]+\\)(?%s[ \t\n)]\\|:conc-name\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s-"
|
|
|
613 struct struct))))
|
|
|
614 ;; Defclass accessors
|
|
|
615 (class
|
|
|
616 "\\(:accessor\\|:writer\\|:reader\\)\\([ \t\n]+\\(.\\)?+[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)%s[ \t\n)]"))
|
|
|
617 (or
|
|
|
618 (if (equal type "any")
|
|
|
619 (lisp-re
|
|
|
620 back
|
|
|
621 (concat
|
|
|
622 "^\\(.\\)?[ \t\n]*(def[^ \t\n]*\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)\\((setf\\([ \t\n]+\\(.\\)?[ \t\n]*\\|[ \t\n]*.[ \t\n]+\\)\\|(?[ \t\n]*\\(.\\)?[ \t\n]*\\)%s[ \t\n)]"
|
|
|
623 (if prefix (concat "\\|" prefix))
|
|
|
624 "\\|"
|
|
|
625 class)
|
|
|
626 name name))
|
|
|
627
|
|
|
628 ;; (qualifiers* (type1 type2 ...))
|
|
|
629 (ilisp-locate-clos-method name type back)
|
|
|
630
|
|
|
631 (ilisp-locate-clisp-defn name type back)
|
|
|
632
|
|
|
633 ;; Standard def form
|
|
|
634 (if first (lisp-locate-ilisp symbol type first back))
|
|
|
635 ;; Automatically generated defstruct accessors
|
|
|
636 (if (and first prefix) (lisp-re back prefix))
|
|
|
637 ;; Defclass accessors
|
|
|
638 (lisp-re back class name)
|
|
|
639 ;; Give up!
|
|
|
640 )))
|
