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