|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: eif-calls.el
|
|
|
4 ;; SUMMARY: Produce first level static call tree for Eiffel class.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
70
|
9 ;; ORG: Motorola Inc.
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 7-Dec-89 at 19:32:47
|
|
70
|
12 ;; LAST-MOD: 30-Aug-95 at 15:22:33 by Bob Weiner
|
|
0
|
13 ;;
|
|
70
|
14 ;; Copyright (C) 1989-1995 Free Software Foundation, Inc.
|
|
0
|
15 ;; See the file BR-COPY for license information.
|
|
|
16 ;;
|
|
|
17 ;; This file is part of the OO-Browser.
|
|
|
18 ;;
|
|
|
19 ;; DESCRIPTION:
|
|
|
20 ;;
|
|
|
21 ;; The default commands, 'eif-store-class-info' and 'eif-insert-class-info'
|
|
|
22 ;; work in tandem to display the parents, attributes and routines with
|
|
|
23 ;; routine call summaries for a class.
|
|
|
24 ;; The command {M-x eif-info-use-short}, will instead cause the above
|
|
|
25 ;; commands to run the Eiffel 'short' command on a class, thereby
|
|
|
26 ;; displaying its specification.
|
|
|
27 ;; The command {M-x eif-info-use-flat}, will instead cause the above
|
|
|
28 ;; commands to run the Eiffel 'flat' command on a class, thereby
|
|
|
29 ;; displaying its complete feature set.
|
|
|
30 ;; Call {M-x eif-info-use-calls} to reset these commands to their default.
|
|
|
31 ;;
|
|
|
32 ;; DESCRIP-END.
|
|
|
33
|
|
|
34 ;;; ************************************************************************
|
|
|
35 ;;; Other required Elisp libraries
|
|
|
36 ;;; ************************************************************************
|
|
|
37
|
|
|
38 (require 'br-eif)
|
|
|
39
|
|
|
40 ;;; ************************************************************************
|
|
|
41 ;;; Public functions
|
|
|
42 ;;; ************************************************************************
|
|
|
43
|
|
|
44 (defun eif-info-use-calls ()
|
|
|
45 "Setup to display call trees and other class summary info."
|
|
|
46 (interactive)
|
|
|
47 (fset 'eif-store-class-info 'eif-store-class-info-calls)
|
|
|
48 (fset 'eif-insert-class-info 'eif-insert-class-info-calls))
|
|
|
49 (eif-info-use-calls)
|
|
|
50
|
|
|
51 (defun eif-info-use-flat ()
|
|
|
52 "Setup to display the Eiffel 'flat' output for classes."
|
|
|
53 (interactive)
|
|
|
54 (fset 'eif-store-class-info 'eif-store-class-info-flat)
|
|
|
55 (fset 'eif-insert-class-info 'eif-insert-class-info-flat))
|
|
|
56
|
|
|
57 (defun eif-info-use-short ()
|
|
|
58 "Setup to display the Eiffel 'short' output for classes."
|
|
|
59 (interactive)
|
|
|
60 (fset 'eif-store-class-info 'eif-store-class-info-short)
|
|
|
61 (fset 'eif-insert-class-info 'eif-insert-class-info-short))
|
|
|
62
|
|
|
63 (defun eif-show-class-info (&optional class-name)
|
|
|
64 "Displays class specific information summary in other window.
|
|
|
65 This summary includes listings of textually included attributes, routines,
|
|
|
66 and routine calls from an Eiffel class. Use optional CLASS-NAME for class
|
|
|
67 text or extract from the current buffer."
|
|
|
68 (interactive (list (br-complete-class-name
|
|
|
69 nil
|
|
|
70 (let ((cn (car (eif-get-class-name-from-source))))
|
|
|
71 (if cn (concat "Class name: (default " cn ") "))))))
|
|
|
72 (let ((class-file-name))
|
|
|
73 (if (not (br-class-in-table-p class-name))
|
|
|
74 (if (setq class-file-name buffer-file-name)
|
|
|
75 (setq class-name (car (eif-get-class-name-from-source)))
|
|
|
76 (error "No class specified.")))
|
|
|
77 (if (null class-name)
|
|
|
78 (error "No class specified.")
|
|
|
79 (message "Building '%s' class info..." class-name)
|
|
|
80 (sit-for 2)
|
|
|
81 (eif-store-class-info class-name)
|
|
|
82 (message "Building '%s' class info...Done" class-name)
|
|
|
83 (br-eval-in-other-window "*Class Info*"
|
|
|
84 '(eif-insert-class-info class-file-name)))))
|
|
|
85
|
|
|
86 ;;; ************************************************************************
|
|
|
87 ;;; Internal functions
|
|
|
88 ;;; ************************************************************************
|
|
|
89
|
|
|
90 (defun eif-get-class-name-from-source ()
|
|
|
91 "Return indication of closest class definition preceding point or nil.
|
|
|
92 If non-nil, value is a cons cell of (class-name . deferred-class-p)."
|
|
|
93 (save-excursion
|
|
|
94 (if (or (re-search-backward eif-class-def-regexp nil t)
|
|
|
95 (re-search-forward eif-class-def-regexp nil t))
|
|
|
96 (cons (eif-set-case (buffer-substring (match-beginning 2)
|
|
|
97 (match-end 2)))
|
|
|
98 (match-end 1)))))
|
|
|
99
|
|
|
100 (defun eif-insert-class-info-calls (&optional src-file-name)
|
|
|
101 "Inserts textually included attributes, routines, and routine calls from 'eif-last-class-name'.
|
|
|
102 Uses optional SRC-FILE-NAME for lookups or class name from 'eif-last-class-name'."
|
|
|
103 (interactive)
|
|
|
104 (if (and eif-last-class-name eif-attributes-and-routines)
|
|
|
105 nil
|
|
|
106 (error (concat "Call 'eif-store-class-info' first."
|
|
|
107 (let ((key (car (where-is-internal 'eif-store-class-info))))
|
|
|
108 (and key (concat " It is bound to {" key "}."))))))
|
|
|
109 (let ((in-lookup-table
|
|
|
110 (if src-file-name
|
|
|
111 nil
|
|
|
112 (br-class-in-table-p eif-last-class-name))))
|
|
|
113 (if (not (or in-lookup-table src-file-name))
|
|
|
114 nil
|
|
|
115 (insert eif-last-class-name)
|
|
|
116 (center-line)
|
|
|
117 (insert "\n")
|
|
|
118 (insert "Parents:\n")
|
|
|
119 (let ((parents (if in-lookup-table
|
|
|
120 (br-get-parents eif-last-class-name)
|
|
|
121 (eif-get-parents-from-source src-file-name))))
|
|
|
122 (if parents
|
|
|
123 (mapcar (function (lambda (par) (insert " " par "\n")))
|
|
|
124 parents)
|
|
|
125 (insert " <None>\n"))
|
|
|
126 (let ((attribs (car eif-attributes-and-routines))
|
|
|
127 (routines (cdr eif-attributes-and-routines)))
|
|
|
128 (if parents
|
|
|
129 (insert "\nNon-Inherited Attributes:\n")
|
|
|
130 (insert "\nAttributes:\n"))
|
|
|
131 (if attribs
|
|
|
132 (mapcar (function (lambda(attr) (insert " " attr "\n")))
|
|
|
133 attribs)
|
|
|
134 (insert " <None>\n"))
|
|
|
135 (if parents
|
|
|
136 (insert
|
|
|
137 "\nNon-Inherited Routines with Apparent Routine Calls:\n")
|
|
|
138 (insert "\nRoutines with Apparent Routine Calls:\n"))
|
|
|
139 (if routines
|
|
|
140 (mapcar (function
|
|
|
141 (lambda(cns)
|
|
|
142 (insert " " (car cns) "\n")
|
|
|
143 (mapcar (function
|
|
|
144 (lambda (call)
|
|
|
145 (insert " " call "\n")))
|
|
|
146 (cdr cns))))
|
|
|
147 routines)
|
|
|
148 (insert " <None>\n"))
|
|
|
149 ))
|
|
|
150 (set-buffer-modified-p nil))))
|
|
|
151
|
|
|
152 (defun eif-store-class-info-calls (class-name)
|
|
|
153 "Generates cons of textually included attributes and routines (including routine calls) from CLASS-NAME.
|
|
|
154 It stores this cons in the global 'eif-attributes-and-routines'."
|
|
|
155 (interactive (list (br-complete-class-name)))
|
|
|
156 (setq eif-last-class-name (downcase class-name))
|
|
|
157 (let ((in-lookup-table (br-class-path eif-last-class-name)))
|
|
|
158 (if (not (or in-lookup-table buffer-file-name))
|
|
|
159 nil
|
|
|
160 (setq eif-attributes-and-routines
|
|
|
161 (eif-get-features-from-source
|
|
|
162 (if in-lookup-table
|
|
|
163 (br-class-path eif-last-class-name)
|
|
|
164 buffer-file-name))))))
|
|
|
165
|
|
|
166 (defun eif-insert-class-info-short ()
|
|
|
167 (interactive)
|
|
|
168 (insert-file-contents eif-tmp-info-file)
|
|
|
169 (shell-command (concat "rm -f " eif-tmp-info-file))
|
|
|
170 (message ""))
|
|
|
171
|
|
|
172 (defun eif-store-class-info-short (class-name)
|
|
|
173 (interactive (list (br-complete-class-name)))
|
|
|
174 (shell-command (concat "short -b 3 -p "
|
|
|
175 (br-class-path (br-find-class-name))
|
|
|
176 "> " eif-tmp-info-file)))
|
|
|
177
|
|
|
178 (defun eif-insert-class-info-flat ()
|
|
|
179 (interactive)
|
|
|
180 (insert-file-contents eif-tmp-info-file)
|
|
|
181 (shell-command (concat "rm -f " eif-tmp-info-file))
|
|
|
182 (message ""))
|
|
|
183
|
|
|
184 (defun eif-store-class-info-flat (class-name)
|
|
|
185 (interactive (list (br-complete-class-name)))
|
|
|
186 (shell-command (concat "flat -b 3 "
|
|
|
187 (br-class-path (br-find-class-name))
|
|
|
188 "> " eif-tmp-info-file)))
|
|
|
189
|
|
|
190 (defun eif-class-name-from-file-name (file-name)
|
|
|
191 (string-match "^.*/\\([a-z0-9_]+\\)\\.e$" file-name)
|
|
|
192 (if (match-beginning 1)
|
|
|
193 (substring file-name (match-beginning 1) (match-end 1))))
|
|
|
194
|
|
|
195 (defun eif-eval-in-other-window (buffer form)
|
|
|
196 "Clear out BUFFER and display result of FORM evaluation in viewer window.
|
|
|
197 Then return to previous window. BUFFER may be a buffer name."
|
|
|
198 (interactive)
|
|
|
199 (let ((wind (selected-window)))
|
|
|
200 (pop-to-buffer (get-buffer-create buffer))
|
|
|
201 (let (buffer-read-only)
|
|
|
202 (erase-buffer)
|
|
|
203 (eval form))
|
|
|
204 (goto-char (point-min))
|
|
|
205 (setq buffer-read-only t)
|
|
|
206 (select-window wind)))
|
|
|
207
|
|
|
208 (defun eif-get-attribute-definition-regexp (identifier-regexp)
|
|
|
209 "Return regexp to match to IDENTIFIER-REGEXP definition.
|
|
|
210 Matching attribute name is grouping 'eif-feature-name-grpn'."
|
|
|
211 (concat eif-modifier-regexp
|
|
|
212 "\\(" identifier-regexp "\\)[ \t]*:[ \t]*"
|
|
|
213 eif-type "\\([ \t]+is[ \t]+.+\\)?[ \t]*;?[ \t]*\\(--.*\\)?$"))
|
|
|
214
|
|
|
215 (defun eif-get-features-from-source (filename &optional form)
|
|
|
216 "Returns cons of attribute def list and routine def list from Eiffel class FILENAME.
|
|
|
217 Optional FORM is a Lisp form to be evaluated instead of the default feature
|
|
|
218 extraction. Assumes file existence has already been checked. The cdr of
|
|
|
219 each element of each item in routine def list is a best guess list of
|
|
|
220 subroutines invoked by the routine."
|
|
|
221 (let* ((no-kill (get-file-buffer filename))
|
|
|
222 (tmp-buf (set-buffer (get-buffer-create "*tmp*")))
|
|
|
223 features orig-buf)
|
|
|
224 (setq buffer-read-only nil)
|
|
|
225 (erase-buffer)
|
|
|
226 (if no-kill
|
|
|
227 (set-buffer no-kill)
|
|
|
228 (setq orig-buf (funcall br-find-file-noselect-function filename))
|
|
|
229 (set-buffer orig-buf))
|
|
|
230 (copy-to-buffer tmp-buf (point-min) (point-max))
|
|
|
231 (set-buffer tmp-buf)
|
|
|
232 (goto-char (point-min))
|
|
|
233 (while (re-search-forward "^\\([^\"\n]*\\)--.*" nil t)
|
|
|
234 (replace-match "\\1" t nil))
|
|
|
235 (goto-char (point-min))
|
|
|
236 (if (not (re-search-forward "^feature[ \t]*$" nil t))
|
|
|
237 nil
|
|
|
238 (setq features
|
|
|
239 (if form
|
|
|
240 (eval form)
|
|
|
241 (eif-parse-features)))
|
|
|
242 (erase-buffer) ; tmp-buf
|
|
|
243 (or no-kill (kill-buffer orig-buf))
|
|
|
244 )
|
|
|
245 features))
|
|
|
246
|
|
|
247 (defun eif-in-comment-p ()
|
|
|
248 "Return nil unless point is within an Eiffel comment."
|
|
|
249 (save-excursion
|
|
|
250 (let ((end (point)))
|
|
|
251 (beginning-of-line)
|
|
|
252 (search-forward "--" end t))))
|
|
|
253
|
|
|
254 (defun eif-to-attribute (&optional identifier)
|
|
|
255 "Move point to attribute matching optional IDENTIFIER or next attribute def in buffer.
|
|
|
256 Leave point at beginning of line where feature is defined.
|
|
|
257 Return name of attribute matched or nil. Ignore obsolete attributes."
|
|
|
258 (let ((pat (if identifier
|
|
|
259 (eif-attribute-to-regexp identifier)
|
|
|
260 eif-attribute-regexp))
|
|
|
261 (start)
|
|
|
262 (found)
|
|
|
263 (keyword)
|
|
|
264 (non-attrib-keyword "local\\|require\\|ensure\\|invariant"))
|
|
|
265 (while (and (re-search-forward pat nil t)
|
|
|
266 (setq found (buffer-substring
|
|
|
267 (match-beginning eif-feature-name-grpn)
|
|
|
268 (match-end eif-feature-name-grpn))
|
|
|
269 start (match-beginning 0))
|
|
|
270 ;; Continue loop if in a comment or a local declaration.
|
|
|
271 (or (if (eif-in-comment-p)
|
|
|
272 (progn (setq found nil) t))
|
|
|
273 (save-excursion
|
|
|
274 (while (and (setq keyword
|
|
|
275 (re-search-backward
|
|
|
276 (concat
|
|
|
277 "\\(^\\|[ \t]+\\)\\("
|
|
|
278 "end\\|feature\\|"
|
|
|
279 non-attrib-keyword
|
|
|
280 "\\)[\; \t\n]")
|
|
|
281 nil t))
|
|
|
282 (eif-in-comment-p)))
|
|
|
283 (if (and keyword
|
|
|
284 (setq keyword
|
|
|
285 (buffer-substring
|
|
|
286 (match-beginning 2)
|
|
|
287 (match-end 2)))
|
|
|
288 (equal 0 (string-match non-attrib-keyword
|
|
|
289 keyword)))
|
|
|
290 (progn (setq found nil) t))))))
|
|
|
291 (if start (goto-char start))
|
|
|
292 found))
|
|
|
293
|
|
|
294 (defun eif-parse-attributes ()
|
|
|
295 "Returns list of attributes defined in current buffer.
|
|
|
296 Assumes point is at the start of buffer."
|
|
|
297 (let (attribs attrib lattrib reserved)
|
|
|
298 ;; For each attribute definition
|
|
|
299 (while (and (eif-to-attribute)
|
|
|
300 (looking-at eif-attribute-regexp))
|
|
|
301 (setq attrib (buffer-substring
|
|
|
302 (match-beginning eif-feature-name-grpn)
|
|
|
303 (match-end eif-feature-name-grpn))
|
|
|
304 lattrib (downcase attrib))
|
|
|
305 (goto-char (match-end 0))
|
|
|
306 (if (or (> (length lattrib) 9)
|
|
|
307 (< (length lattrib) 2))
|
|
|
308 nil
|
|
|
309 (setq reserved eif-reserved-words)
|
|
|
310 ;; Ensure that each attrib is not a reserved word
|
|
|
311 (while (if (string-equal lattrib (car reserved))
|
|
|
312 (setq attrib nil)
|
|
|
313 (string-lessp (car reserved) lattrib))
|
|
|
314 (setq reserved (cdr reserved))))
|
|
|
315 (if attrib (br-set-cons attribs attrib)))
|
|
|
316 (setq attribs (nreverse attribs))))
|
|
|
317
|
|
|
318 (defun eif-parse-features (&optional skip-calls)
|
|
|
319 "Returns cons of attribute def list and routine def list from current buffer.
|
|
|
320 The cdr of each item in routine def list is a best guess list of routine calls
|
|
|
321 invoked by the routine, unless optional SKIP-CALLS is non-nil, in which case
|
|
|
322 each item is just the routine name."
|
|
|
323 (let ((routines) attribs external routine calls non-ids reserved type)
|
|
|
324 ;; Get attribute definitions
|
|
|
325 ;; and add attributes to list of names not to consider routine invocations.
|
|
|
326 (setq attribs (eif-parse-attributes)
|
|
|
327 non-ids (append attribs eif-reserved-words)
|
|
|
328 attribs (mapcar (function (lambda (attribute)
|
|
|
329 (concat "= " attribute)))
|
|
|
330 attribs))
|
|
|
331 (goto-char (point-min))
|
|
|
332 ;; For each routine definition
|
|
|
333 (while (re-search-forward eif-routine-regexp nil t)
|
|
|
334 (setq routine (buffer-substring (match-beginning eif-feature-name-grpn)
|
|
|
335 (match-end eif-feature-name-grpn))
|
|
|
336 external (if (match-beginning eif-modifier-grpn)
|
|
|
337 (string-match "external"
|
|
|
338 (buffer-substring
|
|
|
339 (match-beginning eif-modifier-grpn)
|
|
|
340 (match-end eif-modifier-grpn))))
|
|
|
341 reserved non-ids)
|
|
|
342 (if (match-beginning eif-feature-args-grpn)
|
|
|
343 ;; Routine takes a list of arguments.
|
|
|
344 ;; Add ids matched to list of names not to consider routine
|
|
|
345 ;; invocations.
|
|
|
346 (setq reserved
|
|
|
347 (append (eif-parse-params
|
|
|
348 (match-beginning eif-feature-args-grpn)
|
|
|
349 (match-end eif-feature-args-grpn))
|
|
|
350 reserved)))
|
|
|
351 (cond (external
|
|
|
352 (setq routine (concat "/ " routine)))
|
|
|
353 ((re-search-forward
|
|
|
354 "^[ \t]*\\(do\\|once\\|deferred\\)[ \t\n]+" nil t)
|
|
|
355 (setq type (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
356 (cond ((string-equal type "do")
|
|
|
357 (setq routine (concat "- " routine)))
|
|
|
358 ((string-equal type "once")
|
|
|
359 (setq routine (concat "1 " routine)))
|
|
|
360 (t ;; deferred type
|
|
|
361 (setq routine (concat "> " routine))))
|
|
|
362 (if skip-calls
|
|
|
363 (setq routines (cons routine routines))
|
|
|
364 (setq calls (nreverse (eif-parse-ids reserved))
|
|
|
365 routines (cons (cons routine calls) routines))))))
|
|
|
366 (setq routines (nreverse routines))
|
|
|
367 (cons attribs routines)))
|
|
|
368
|
|
|
369 (defun eif-parse-ids (&optional non-ids)
|
|
|
370 "Ignores list of NON-IDS and returns list of Eiffel identifiers through the end of the current routine definition."
|
|
|
371 (let (call calls lcall call-list non-id-list same start valid-call)
|
|
|
372 (while (and (setq start (eif-try-for-routine-call))
|
|
|
373 ;; Ignore assignable entities
|
|
|
374 (cond ((stringp start)
|
|
|
375 (setq non-ids (cons (downcase start) non-ids)))
|
|
|
376 ;; Ignore reserved word expressions that look like
|
|
|
377 ;; routine calls with arguments
|
|
|
378 ((and (setq call
|
|
|
379 (downcase
|
|
|
380 (buffer-substring start (match-end 0))))
|
|
|
381 (looking-at "[ \t]*\(")
|
|
|
382 (br-member call non-ids)))
|
|
|
383 ;; Skip past rest of this routine invocation
|
|
|
384 ((progn
|
|
|
385 (while (or (progn (setq valid-call t same (point))
|
|
|
386 (and (setq call
|
|
|
387 (eif-skip-past-arg-list)
|
|
|
388 valid-call
|
|
|
389 (or (null call)
|
|
|
390 (= call 0)))
|
|
|
391 (looking-at "\\.")
|
|
|
392 (progn
|
|
|
393 (skip-chars-forward ".")
|
|
|
394 (if (setq valid-call
|
|
|
395 (looking-at
|
|
|
396 eif-identifier))
|
|
|
397 (goto-char
|
|
|
398 (match-end 0)))))
|
|
|
399 (> (point) same))
|
|
|
400 (if (and valid-call (looking-at "\\."))
|
|
|
401 (progn (skip-chars-forward ".")
|
|
|
402 (if (setq valid-call
|
|
|
403 (looking-at
|
|
|
404 eif-identifier))
|
|
|
405 (goto-char
|
|
|
406 (match-end 0)))))))
|
|
|
407 (if (and valid-call
|
|
|
408 (/= start (point)))
|
|
|
409 (progn (setq call (buffer-substring start (point))
|
|
|
410 lcall (downcase call))
|
|
|
411 ;; If at end of 'do' part of routine
|
|
|
412 ;; definition...
|
|
|
413 (if (or (string-equal lcall "ensure")
|
|
|
414 (and (string-equal lcall "end")
|
|
|
415 (looking-at
|
|
|
416 "[ \t]*[;]?[ \t]*[\n][ \t]*[\n]")))
|
|
|
417 (setq valid-call nil)
|
|
|
418 (if call (br-set-cons calls call))
|
|
|
419 )
|
|
|
420 valid-call)
|
|
|
421 nil))))))
|
|
|
422 (while calls
|
|
|
423 (setq call (car calls)
|
|
|
424 calls (cdr calls)
|
|
|
425 lcall (downcase call)
|
|
|
426 non-id-list
|
|
|
427 (or non-ids eif-reserved-words))
|
|
|
428 (if (br-member lcall non-id-list)
|
|
|
429 (setq call nil))
|
|
|
430 (if call (setq call-list (append call-list (list call)))))
|
|
|
431 call-list))
|
|
|
432
|
|
|
433 (defun eif-parse-params (start end)
|
|
|
434 "Returns list of Eiffel formal parameters between START and END, in reverse order."
|
|
|
435 (narrow-to-region start end)
|
|
|
436 (goto-char (point-min))
|
|
|
437 (let (params)
|
|
|
438 (while (re-search-forward eif-identifier nil t)
|
|
|
439 (setq params (cons (buffer-substring
|
|
|
440 (match-beginning 0) (match-end 0)) params))
|
|
|
441 (if (looking-at "[ \t]*:")
|
|
|
442 (progn (goto-char (match-end 0))
|
|
|
443 (re-search-forward eif-type nil t)))
|
|
|
444 )
|
|
|
445 (widen)
|
|
|
446 params))
|
|
|
447
|
|
|
448 (defun eif-skip-past-arg-list ()
|
|
|
449 "Skips path arg list delimited by parenthesis.
|
|
|
450 Leaves point after closing parenthesis. Returns number of unclosed parens
|
|
|
451 iff point moves, otherwise nil."
|
|
|
452 (let ((depth 0))
|
|
|
453 (if (not (looking-at "[ \t]*\("))
|
|
|
454 nil
|
|
|
455 (setq depth (1+ depth))
|
|
|
456 (goto-char (match-end 0))
|
|
|
457 (while (> depth 0)
|
|
|
458 (skip-chars-forward "^()\"'")
|
|
|
459 (cond ((= ?\" (following-char))
|
|
|
460 (progn (forward-char 1)
|
|
|
461 (skip-chars-forward "^\"")))
|
|
|
462 ((= ?' (following-char))
|
|
|
463 (progn (forward-char 1)
|
|
|
464 (skip-chars-forward "^'")))
|
|
|
465 ((setq depth (if (= ?\( (following-char))
|
|
|
466 (1+ depth)
|
|
|
467 (1- depth)))))
|
|
|
468 (and (not (eobp)) (forward-char 1)))
|
|
|
469 depth)))
|
|
|
470
|
|
|
471 (defun eif-try-for-routine-call ()
|
|
|
472 "Matches to best guess of next routine call.
|
|
|
473 Returns character position of start of valid match, nil when no match,
|
|
|
474 identifier string when an assignable entity, i.e. matches to a non-routine."
|
|
|
475 (if (re-search-forward (concat eif-identifier "\\([ \t\n]*:=\\)?") nil t)
|
|
|
476 (if (match-beginning 2)
|
|
|
477 (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
478 (match-beginning 0))))
|
|
|
479
|
|
|
480 ;;; ************************************************************************
|
|
|
481 ;;; Internal variables
|
|
|
482 ;;; ************************************************************************
|
|
|
483
|
|
|
484 (defvar eif-reserved-words
|
|
|
485 '("!!" "alias" "and" "as" "bits" "boolean" "character" "check" "class" "clone" "create"
|
|
|
486 "creation"
|
|
|
487 "current" "debug" "deferred" "define" "div" "do" "double" "else" "elseif"
|
|
|
488 "end" "ensure" "expanded" "export" "external" "false" "feature" "forget"
|
|
|
489 "from" "if" "implies" "indexing" "infix" "inherit" "inspect" "integer"
|
|
|
490 "invariant" "is" "language" "like" "local" "loop" "mod" "name" "nochange"
|
|
|
491 "not" "obsolete" "old" "once" "or" "prefix" "real" "redefine" "rename"
|
|
|
492 "repeat" "require" "rescue" "result" "retry" "select" "then" "true"
|
|
|
493 "undefine" "unique" "until" "variant" "void" "when" "xor")
|
|
|
494 "Lexicographically ordered list of reserved words in Eiffel version 2.2.
|
|
|
495 Longest one is 9 characters.
|
|
|
496 Minor support for Eiffel 3 has now been added.")
|
|
|
497
|
|
|
498 ;; Must handle types of these forms:
|
|
|
499 ;; like LIST [INTEGER]
|
|
|
500 ;; VECTOR [INTEGER , INTEGER]
|
|
|
501 ;; LIST [ LIST[INTEGER]]
|
|
|
502 ;; yet must ignore the 'is' in:
|
|
|
503 ;; var: INTEGER is 0
|
|
|
504 (defconst eif-type
|
|
|
505 "\\(like[ \t]+\\)?[a-zA-Z][a-zA-Z_0-9]*\\([ \t]*\\[.+\\]\\)?"
|
|
|
506 "Regexp to match Eiffel entity and return value type expressions.")
|
|
|
507
|
|
|
508 (defconst eif-modifier-regexp
|
|
|
509 "^[ \t]*\\(frozen[ \t\n]+\\|external[ \t]+\"[^\" ]+\"[ \t\n]+\\)?"
|
|
|
510 "Special prefix modifiers that can precede a feature definition.")
|
|
|
511
|
|
|
512 ;; Handles attributes of these forms:
|
|
|
513 ;; attr: TYPE
|
|
|
514 ;; char: CHARACTER is 'a'
|
|
|
515 ;; message: STRING is "Hello, what is your name?"
|
|
|
516 ;; flag: BOOLEAN is true ;
|
|
|
517 (defconst eif-attribute-regexp
|
|
|
518 (eif-get-attribute-definition-regexp eif-identifier)
|
|
|
519 "Regexp to match to an attribute definition line.")
|
|
|
520
|
|
|
521 (defconst eif-routine-regexp
|
|
|
522 (concat eif-modifier-regexp "\\(" eif-identifier
|
|
|
523 "\\|prefix[ \t]+\"[^\" ]+\"\\|infix[ \t]+\"[^\" ]+\"\\)[ \t]*"
|
|
|
524 "\\(([^\)]+)[ \t]*\\)?\\(:[ \t\n]*"
|
|
|
525 eif-type "[ \t\n]+\\)?is[ \t]*$")
|
|
|
526 "Regexp to match to routine definition line.
|
|
|
527 Ignores obsolete routines and multiple routine definition lists.")
|
|
|
528 ;;; Should match a multiple feature definition list on a single line
|
|
|
529 ;;; (routine-regexp
|
|
|
530 ;;; (concat "^[ \t]*\\(\\("
|
|
|
531 ;;; eif-identifier "[ \t]*[,]?[ \t]*\\)+\\)"
|
|
|
532 ;;; "\\(([^\)]+)[ \t]*\\)?\\(:[ \t]*"
|
|
|
533 ;;; eif-type "[ \t]+\\)?is[ \t]*$"))
|
|
|
534
|
|
|
535 (defun eif-attribute-to-regexp (identifier)
|
|
|
536 "Return regexp to match to IDENTIFER attribute definition.
|
|
|
537 Attribute name is grouping 'eif-feature-name-grpn'."
|
|
|
538 (eif-get-attribute-definition-regexp (regexp-quote identifier)))
|
|
|
539
|
|
|
540 (defun eif-routine-to-regexp (identifier)
|
|
|
541 "Return regexp to match to IDENTIFIER's routine definition.
|
|
|
542 Routine name is grouping 'eif-feature-name-grpn'. Ignore obsolete routines
|
|
|
543 and multiple routine definition lists."
|
|
|
544 (concat eif-modifier-regexp "\\("
|
|
|
545 (regexp-quote identifier) "\\)[ \t]*"
|
|
|
546 "\\(([^\)]+)[ \t\n]*\\)?\\(:[ \t\n]*"
|
|
|
547 eif-type "[ \t\n]+\\)?is[ \t]*\\(--.*\\)?$"))
|
|
|
548
|
|
|
549 (defconst eif-modifier-grpn 1
|
|
|
550 "Regexp grouping for leading feature modifies, 'frozen' or 'external'.")
|
|
|
551
|
|
|
552 (defconst eif-feature-name-grpn 2
|
|
|
553 "Regexp grouping for feature name from (eif-attribute-to-regexp) or (eif-routine-to-regexp).")
|
|
|
554
|
|
|
555 (defconst eif-feature-args-grpn 4
|
|
|
556 "Regexp grouping for feature arg list for (eif-routine-to-regexp).")
|
|
|
557
|
|
|
558 (defvar eif-last-class-name nil
|
|
|
559 "Last class name used as parameter to 'eif-store-class-info'. Value is
|
|
|
560 used by 'eif-insert-class-info'.")
|
|
|
561
|
|
|
562 (defvar eif-attributes-and-routines nil
|
|
|
563 "Class data stored by 'eif-store-class-info' for use by 'eif-insert-class-info'.")
|
|
|
564
|
|
|
565 (defconst eif-tmp-info-file "/tmp/eif-short"
|
|
|
566 "Temporary file used to hold Eiffel class info.")
|
|
|
567
|
|
|
568 (provide 'eif-calls)
|
