|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-eif-ft.el
|
|
|
4 ;; SUMMARY: Eiffel OO-Browser class and feature functions.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
24
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 03-Oct-90
|
|
24
|
12 ;; LAST-MOD: 31-Oct-96 at 17:05:31 by Bob Weiner
|
|
0
|
13 ;;
|
|
24
|
14 ;; Copyright (C) 1990-1996 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 ;; DESCRIP-END.
|
|
|
21
|
|
24
|
22 ;;; ************************************************************************
|
|
|
23 ;;; Other required Elisp libraries
|
|
|
24 ;;; ************************************************************************
|
|
0
|
25
|
|
|
26 (require 'eif-calls)
|
|
|
27
|
|
24
|
28 ;;; ************************************************************************
|
|
|
29 ;;; Public variables
|
|
|
30 ;;; ************************************************************************
|
|
0
|
31
|
|
|
32 (defconst eif-type-tag-separator ","
|
|
|
33 "String that separates a tags type from its normalized definition form.")
|
|
|
34
|
|
24
|
35 ;;; ************************************************************************
|
|
|
36 ;;; Public functions
|
|
|
37 ;;; ************************************************************************
|
|
0
|
38
|
|
|
39 (defun eif-feature-implementors (ftr-name)
|
|
|
40 "Return unsorted list of Eiffel feature tags which implement FTR-NAME."
|
|
|
41 (eif-feature-matches (concat "^" (regexp-quote ftr-name) "$")))
|
|
|
42
|
|
24
|
43 (defun eif-feature-map-class-tags (function class)
|
|
|
44 "Apply FUNCTION to all feature tags from CLASS and return a list of the results.
|
|
|
45 Feature tags come from the file named by br-feature-tags-file."
|
|
|
46 (let ((obuf (current-buffer))
|
|
|
47 (class-tag (concat "\n" class eif-type-tag-separator))
|
|
|
48 (results)
|
|
|
49 start end)
|
|
|
50 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
51 (goto-char 1)
|
|
|
52 (if (not (search-forward class-tag nil t))
|
|
|
53 nil
|
|
|
54 (setq start (match-beginning 0)
|
|
|
55 end (if (search-forward "\^L\n" nil t)
|
|
|
56 (match-beginning 0)
|
|
|
57 (point-max)))
|
|
|
58 (goto-char start)
|
|
|
59 ;; Feature defs can occur only within a single file.
|
|
|
60 (while (search-forward class-tag end t)
|
|
|
61 (setq results (cons (funcall function) results))
|
|
|
62 ;; Might have deleted current tag and would miss next tag unless point
|
|
|
63 ;; is moved backwards.
|
|
|
64 (backward-char)))
|
|
|
65 (set-buffer obuf)
|
|
|
66 results))
|
|
|
67
|
|
0
|
68 (defun eif-feature-name-to-regexp (name)
|
|
|
69 "Converts feature NAME into a regular expression matching the feature's name tag."
|
|
|
70 (if (string-match (concat "^" br-feature-type-regexp " ") name)
|
|
|
71 (setq name (substring name (match-end 0))))
|
|
|
72 (format "%s%s%s %s[ \n]"
|
|
|
73 eif-identifier eif-type-tag-separator br-feature-type-regexp
|
|
|
74 (regexp-quote name)))
|
|
|
75
|
|
|
76 (fset 'eif-feature-signature-to-name 'eif-feature-partial-name)
|
|
|
77
|
|
|
78 (defun eif-feature-signature-to-regexp (signature)
|
|
|
79 "Given an Eiffel class or feature SIGNATURE, return regexp to match its definition."
|
|
24
|
80 (let ((regexp) name type)
|
|
0
|
81 (setq regexp
|
|
|
82 (cond ((string-match (concat eif-type-tag-separator
|
|
|
83 "\\(" br-feature-type-regexp "\\) ")
|
|
|
84 signature)
|
|
|
85 (setq name (substring signature (match-end 0))
|
|
|
86 type (string-to-char
|
|
|
87 (substring
|
|
|
88 signature (match-beginning 1) (match-end 1))))
|
|
|
89 (cond ((memq type '(?- ?1 ?>))
|
|
|
90 ;; routine
|
|
|
91 (eif-routine-to-regexp name))
|
|
|
92 ((= type ?=)
|
|
|
93 ;; attribute
|
|
|
94 (eif-attribute-to-regexp name))))
|
|
|
95 ((equal 0 (string-match eif-identifier signature))
|
|
|
96 ;; Assume is a class name
|
|
|
97 (concat eif-class-name-before (regexp-quote signature)
|
|
|
98 eif-class-name-after))))
|
|
|
99 (or regexp
|
|
|
100 (error "(eif-feature-signature-to-regexp): Invalid format, '%s'"
|
|
|
101 signature))))
|
|
|
102
|
|
24
|
103 (defun eif-feature-tag-regexp (class feature-name)
|
|
|
104 "Return a regexp that matches to the feature tag entry for CLASS' FEATURE-NAME."
|
|
|
105 (concat "^" (regexp-quote class) eif-type-tag-separator
|
|
|
106 br-feature-type-regexp " "
|
|
|
107 (regexp-quote feature-name) "[ \n]"))
|
|
|
108
|
|
0
|
109 (defun eif-feature-tree-command-p (class-or-signature)
|
|
|
110 "Display definition of CLASS-OR-SIGNATURE if a signature and return t, else return nil."
|
|
|
111 (if (br-in-browser) (br-to-view-window))
|
|
|
112 (br-feature-found-p (br-feature-file class-or-signature)
|
|
|
113 class-or-signature))
|
|
|
114
|
|
|
115
|
|
|
116 (defun eif-get-feature-tags (feature-file feature-list)
|
|
|
117 "Save Eiffel feature tags defined in FEATURE-FILE to 'br-feature-tags-file'.
|
|
|
118 Assume FEATURE-FILE has already been read into a buffer and that
|
|
|
119 'br-feature-tags-init' has been called. FEATURE-LIST is the list
|
|
|
120 of tags to save."
|
|
|
121 (interactive)
|
|
|
122 (let ((obuf (current-buffer)))
|
|
|
123 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
124 (goto-char 1)
|
|
|
125 ;; Delete any prior feature tags associated with feature-file
|
|
|
126 (if (search-forward feature-file nil 'end)
|
|
|
127 (progn (forward-line -1)
|
|
|
128 (let ((start (point)))
|
|
|
129 (search-forward "\^L" nil 'end 2)
|
|
|
130 (backward-char 1)
|
|
|
131 (delete-region start (point))
|
|
|
132 )))
|
|
|
133 (if feature-list
|
|
|
134 (progn (insert "\^L\n" feature-file "\n")
|
|
|
135 (mapcar (function (lambda (tag) (insert tag "\n")))
|
|
|
136 feature-list)))
|
|
|
137 (set-buffer obuf)))
|
|
|
138
|
|
24
|
139 (defun eif-list-features (class &optional indent)
|
|
|
140 "Return sorted list of Eiffel feature names lexically defined in CLASS.
|
|
|
141 Optional INDENT is unused but is required for multi-language OO-Browser conformance."
|
|
|
142 ;; Use nreverse here so that stable sort ends up leaving same named
|
|
|
143 ;; features in the order they were defined in the source file.
|
|
|
144 (eif-sort-features
|
|
|
145 (eif-feature-map-class-tags 'br-feature-current class)))
|
|
|
146
|
|
0
|
147 (defun eif-scan-features-in-class (class start end)
|
|
|
148 "Return unordered list of Eiffel feature definitions in CLASS.
|
|
|
149 START and END give buffer region to search."
|
|
|
150 (save-excursion
|
|
|
151 (save-restriction
|
|
|
152 (narrow-to-region start end)
|
|
|
153 (goto-char start)
|
|
|
154 (let ((attributes-and-routines (eif-parse-features t)))
|
|
|
155 (append
|
|
|
156 (mapcar
|
|
|
157 (function (lambda (routine)
|
|
|
158 (concat class eif-type-tag-separator routine)))
|
|
|
159 (cdr attributes-and-routines))
|
|
|
160 (mapcar
|
|
|
161 (function (lambda (attribute)
|
|
|
162 (concat class eif-type-tag-separator attribute)))
|
|
|
163 (car attributes-and-routines)))))))
|
|
|
164
|
|
|
165 (defun eif-sort-features (feature-list)
|
|
|
166 (sort feature-list 'eif-feature-lessp))
|
|
|
167
|
|
|
168 (defun eif-to-definition (&optional identifier)
|
|
|
169 "If point is within an Eiffel class or feature name, try to move to its definition.
|
|
|
170 With optional IDENTIFIER, do the same instead for it."
|
|
|
171 (interactive)
|
|
|
172 (let ((cl (or identifier (eif-find-class-name))))
|
|
|
173 (cond
|
|
|
174 ((eif-keyword-p) nil)
|
|
|
175 ((br-check-for-class cl))
|
|
|
176 ((eif-feature cl))
|
|
|
177 ((progn
|
|
|
178 (beep)
|
|
|
179 (message
|
|
|
180 "(OO-Browser): Select an Eiffel identifier to move to its definition.")
|
|
|
181 nil))
|
|
|
182 )))
|
|
|
183
|
|
24
|
184 ;;; ************************************************************************
|
|
|
185 ;;; Private functions
|
|
|
186 ;;; ************************************************************************
|
|
0
|
187
|
|
|
188 (defun eif-export-feature-p ()
|
|
|
189 "Return nil unless point is within a class export clause."
|
|
|
190 (save-excursion
|
|
|
191 (let ((end (point)))
|
|
|
192 (beginning-of-line)
|
|
|
193 ;; If in a comment, return nil.
|
|
|
194 (if (search-forward "--" end t)
|
|
|
195 nil
|
|
|
196 (goto-char (point-min))
|
|
|
197 (and (re-search-forward eif-export-key-regexp end t)
|
|
|
198 (not (re-search-forward "^\\(inherit\\|feature\\)\\([ \t]\\|$\\)" end t)))))))
|
|
|
199
|
|
|
200 (defun eif-feature (&optional ftr)
|
|
|
201 "Return nil if definition is not found for optional FTR or feature declared at point."
|
|
|
202 (interactive)
|
|
|
203 (let ((class-deferred)
|
|
|
204 (class)
|
|
|
205 (deferred-p)
|
|
|
206 (ftr-def-class))
|
|
|
207 (cond ((or ftr (and (eif-export-feature-p)
|
|
|
208 (setq ftr (eif-to-feature-decl))))
|
|
|
209 (if (and (setq class-deferred (eif-get-class-name-from-source))
|
|
|
210 (setq class (car class-deferred)
|
|
|
211 deferred-p (cdr class-deferred)
|
|
|
212 ftr-def-class (eif-find-ancestors-feature
|
|
|
213 (list class) deferred-p ftr)))
|
|
|
214 (cond ((equal (car ftr-def-class) class) t)
|
|
|
215 ((equal (cdr ftr-def-class) ftr)
|
|
|
216 ;; Feature inherited but not renamed.
|
|
|
217 (message
|
|
|
218 "Feature '%s' of class '%s' inherited from class '%s'."
|
|
|
219 ftr class (car ftr-def-class)))
|
|
|
220 ;; Feature inherited and renamed.
|
|
|
221 (t (message "Feature '%s', class '%s' from feature '%s', class '%s'."
|
|
|
222 ftr class (cdr ftr-def-class)
|
|
|
223 (car ftr-def-class))
|
|
|
224 t))
|
|
|
225 (beep)
|
|
|
226 (message "(OO-Browser): '%s' feature not found." ftr)
|
|
|
227 t))
|
|
|
228 ((and (not ftr) (eif-feature-def-p)))
|
|
|
229 ;;
|
|
|
230 ;; Later we might add the case of a feature invocation here.
|
|
|
231 ;;
|
|
|
232 )))
|
|
|
233
|
|
|
234 (defun eif-feature-def-p ()
|
|
|
235 "If point is within a feature definition's name, display feature including leading comments."
|
|
|
236 (let ((opoint (point)))
|
|
|
237 (beginning-of-line)
|
|
|
238 (if (or (looking-at eif-routine-regexp)
|
|
|
239 (looking-at eif-attribute-regexp))
|
|
|
240 (progn (setq opoint (match-beginning eif-feature-name-grpn))
|
|
|
241 (eif-to-comments-begin)
|
|
|
242 (recenter 0)
|
|
|
243 (goto-char opoint)
|
|
|
244 t)
|
|
|
245 (goto-char opoint)
|
|
|
246 nil)))
|
|
|
247
|
|
|
248 (defun eif-feature-lessp (feature1 feature2)
|
|
|
249 (string-lessp (eif-feature-partial-name feature1)
|
|
|
250 (eif-feature-partial-name feature2)))
|
|
|
251
|
|
24
|
252 (defun eif-feature-map-tags (function regexp)
|
|
|
253 "Apply FUNCTION to all current feature tags that match REGEXP and return a list of the results.
|
|
|
254 Feature tags come from the file named by br-feature-tags-file."
|
|
|
255 (let ((identifier-chars (concat "[" eif-identifier-chars "]*"))
|
|
|
256 (results))
|
|
|
257 ;; Ensure match to feature names only; also handle "^" and "$" meta-chars
|
|
|
258 (setq regexp
|
|
|
259 (concat "^\\(" eif-identifier "\\)"
|
|
|
260 eif-type-tag-separator
|
|
|
261 br-feature-type-regexp " "
|
|
|
262 (if (equal (substring regexp 0 1) "^")
|
|
|
263 (progn (setq regexp (substring regexp 1)) nil)
|
|
|
264 identifier-chars)
|
|
|
265 (if (equal (substring regexp -1) "$")
|
|
|
266 (substring regexp 0 -1)
|
|
|
267 (concat regexp identifier-chars))
|
|
|
268 "[ \t\n\r\f]"))
|
|
|
269 (save-excursion
|
|
|
270 (set-buffer (funcall br-find-file-noselect-function br-feature-tags-file))
|
|
|
271 (goto-char 1)
|
|
|
272 (while (re-search-forward regexp nil t)
|
|
|
273 (setq results (cons (funcall function) results))))
|
|
|
274 results))
|
|
|
275
|
|
|
276 (defun eif-feature-matches (regexp)
|
|
|
277 "Return an unsorted list of feature tags whose names match in part or whole to REGEXP.
|
|
|
278 ^ and $ characters may be used to match to the beginning and end of a feature name,
|
|
|
279 respectively."
|
|
|
280 (eif-feature-map-tags
|
|
|
281 ;; Backward-char is necessary in this next function since point might have
|
|
|
282 ;; moved past a newline.
|
|
|
283 (function (lambda () (backward-char) (br-feature-current)))
|
|
|
284 regexp))
|
|
|
285
|
|
0
|
286 (defun eif-feature-partial-name (signature &optional with-class for-display)
|
|
|
287 "Extract the feature name without its class name from feature SIGNATURE.
|
|
|
288 If optional WITH-CLASS is non-nil, class name and 'eif-type-tag-separator'
|
|
|
289 are prepended to the name returned. If optional FOR-DISPLAY is non-nil, a
|
|
|
290 feature type character is prepended to the name for display in a browser
|
|
|
291 listing."
|
|
|
292 (if (string-match (concat eif-type-tag-separator
|
|
|
293 "\\(" br-feature-type-regexp " \\)")
|
|
|
294 signature)
|
|
|
295 (let ((class (substring signature 0 (match-beginning 0)))
|
|
|
296 (name (substring signature (match-end 0))))
|
|
|
297 (cond ((and with-class for-display)
|
|
|
298 signature)
|
|
|
299 (with-class
|
|
|
300 (concat class eif-type-tag-separator name))
|
|
|
301 (for-display
|
|
|
302 (substring signature (match-beginning 1)))
|
|
|
303 (t name)))
|
|
|
304 signature))
|
|
|
305
|
|
|
306 (defun eif-feature-tag-class (element-tag)
|
|
|
307 "Extract the class name from ELEMENT-TAG."
|
|
|
308 (if (string-match eif-type-tag-separator element-tag)
|
|
|
309 (substring element-tag 0 (match-beginning 0))
|
|
|
310 ""))
|
|
|
311
|
|
|
312 (defun eif-find-ancestors-feature (class-list deferred-class ftr)
|
|
|
313 (let* ((classes class-list)
|
|
|
314 (cl)
|
|
|
315 (file)
|
|
|
316 (found-ftr))
|
|
|
317 (if (null class-list)
|
|
|
318 nil
|
|
|
319 (while (and (not found-ftr) classes)
|
|
|
320 (setq cl (car classes)
|
|
|
321 file (br-class-path cl))
|
|
|
322 (and file (setq found-ftr
|
|
|
323 (br-feature-found-p file ftr deferred-class)))
|
|
|
324 ;; If found-ftr is a cons cell, then only one parent class need
|
|
|
325 ;; be searched to look for ftr.
|
|
|
326 (if (consp found-ftr)
|
|
|
327 (setq class-list (list (car found-ftr))
|
|
|
328 ftr (cdr found-ftr)))
|
|
|
329 (setq classes (cdr classes)))
|
|
|
330 (cond ((consp found-ftr)
|
|
|
331 (eif-find-ancestors-feature class-list deferred-class ftr))
|
|
|
332 ((null found-ftr)
|
|
|
333 (eif-find-ancestors-feature
|
|
|
334 (apply 'append (mapcar (function
|
|
|
335 (lambda (cl) (br-get-parents cl)))
|
|
|
336 class-list))
|
|
|
337 deferred-class
|
|
|
338 ftr))
|
|
|
339 (t (cons cl ftr))))))
|
|
|
340
|
|
|
341 ;; Prefixed with 'eiffel' rather than 'eif' since works as a standalone
|
|
|
342 ;; feature in buffers whose major mode is 'eiffel-mode'. It is used by the
|
|
|
343 ;; browser but may also be used standalone.
|
|
|
344 ;;
|
|
|
345 (defun eif-find-class-name ()
|
|
|
346 "Return class name that point is within, else nil."
|
|
|
347 (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
|
|
|
348 (save-excursion
|
|
|
349 (skip-chars-forward " \t")
|
|
|
350 (skip-chars-backward eif-identifier-chars)
|
|
|
351 (skip-chars-backward " \t\n")
|
|
|
352 (backward-char 1)
|
|
|
353 (and (looking-at eif-class-name-pat)
|
|
|
354 (eif-set-case
|
|
|
355 (buffer-substring (match-beginning 2)
|
|
|
356 (match-end 2))))))
|
|
|
357
|
|
|
358 (defun eif-find-feature (feature-name)
|
|
|
359 "With point selecting a class in a listing buffer, move point to definition of FEATURE-NAME in viewer window.
|
|
|
360 Move point and return non-nil iff FEATURE-NAME is found."
|
|
|
361 (interactive "sFeature to find: ")
|
|
|
362 ;; If selected class is displayed, don't go to start of class
|
|
|
363 (if (equal (br-class-path (br-find-class-name))
|
|
|
364 (progn
|
|
|
365 (br-to-from-viewer)
|
|
|
366 (expand-file-name buffer-file-name)))
|
|
|
367 nil
|
|
|
368 (br-edit))
|
|
|
369 (if (eiffel-find-feature feature-name)
|
|
|
370 (progn (recenter 0)
|
|
|
371 t)
|
|
|
372 (br-to-from-viewer)
|
|
|
373 (and (interactive-p)
|
|
|
374 (progn
|
|
|
375 (beep)
|
|
|
376 (message "(OO-Browser): No '%s' feature found." feature-name)))))
|
|
|
377
|
|
|
378 (defun eif-feature-locate-p (feature-tag)
|
|
|
379 (let (start class)
|
|
|
380 (if (string-match (concat "\\`[^\]\[]+" eif-type-tag-separator)
|
|
|
381 feature-tag)
|
|
|
382 ;; First move to the proper class implementation, so that if two
|
|
|
383 ;; classes in the same file have the same feature signature, we still
|
|
|
384 ;; end up at the right one.
|
|
|
385 (progn
|
|
|
386 (setq class (substring feature-tag 0 (1- (match-end 0))))
|
|
|
387 (re-search-forward
|
|
|
388 (concat eif-class-name-before (regexp-quote class)
|
|
|
389 eif-class-name-after)
|
|
|
390 nil t)))
|
|
|
391 (if (not (re-search-forward
|
|
|
392 (eif-feature-signature-to-regexp feature-tag) nil t))
|
|
|
393 nil
|
|
|
394 (setq start (match-beginning 0))
|
|
|
395 (goto-char start)
|
|
|
396 (skip-chars-forward " \t\n")
|
|
|
397 (eif-to-comments-begin)
|
|
|
398 (recenter 0)
|
|
|
399 (goto-char start)
|
|
|
400 t)))
|
|
|
401
|
|
|
402 (defun eif-keyword-p ()
|
|
|
403 "Return t if point is within an Eiffel keyword, else nil."
|
|
|
404 (if (= (point) (point-max)) (skip-chars-backward " \t\n"))
|
|
|
405 (save-excursion
|
|
|
406 (skip-chars-forward " \t")
|
|
|
407 (skip-chars-backward eif-identifier-chars)
|
|
|
408 (and (looking-at eif-identifier)
|
|
|
409 (br-member-sorted-strings (buffer-substring (match-beginning 0)
|
|
|
410 (match-end 0))
|
|
|
411 eif-reserved-words))))
|
|
|
412
|
|
|
413 (defun eif-locate-feature (ftr ftr-pat)
|
|
|
414 (let ((opoint (point)))
|
|
|
415 (goto-char (point-min))
|
|
|
416 (if (and (re-search-forward "^feature\\([ \t]\\|$\\)" nil t)
|
|
|
417 (re-search-forward ftr-pat nil t))
|
|
|
418 (progn (goto-char (match-beginning eif-feature-name-grpn))
|
|
|
419 (setq opoint (point))
|
|
|
420 (eif-to-comments-begin)
|
|
|
421 (recenter 0)
|
|
|
422 (goto-char opoint)
|
|
|
423 t)
|
|
|
424 (goto-char opoint)
|
|
|
425 (and (interactive-p) (error (format "Feature '%s' not found."
|
|
|
426 ftr))))))
|
|
|
427
|
|
|
428 (defun eif-renamed-feature-p (ftr)
|
|
|
429 (goto-char (point-min))
|
|
|
430 (let ((rename-regexp "[ \t\n]+rename[ \t\n]")
|
|
|
431 (rename-match
|
|
|
432 (concat eif-identifier "[ \t\n]+as[ \t\n]+" ftr "[,; \t\n]"))
|
|
|
433 (prev-feature-nm)
|
|
|
434 (prev-class)
|
|
|
435 (parents))
|
|
|
436 (while (and (setq prev-feature-nm
|
|
|
437 (and (re-search-forward rename-regexp nil t)
|
|
|
438 (re-search-forward rename-match nil t)))
|
|
|
439 (setq prev-feature-nm
|
|
|
440 (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
441 prev-class (match-beginning 0))
|
|
|
442 (progn (backward-char 1)
|
|
|
443 (eif-in-comment-p))))
|
|
|
444 (if prev-feature-nm
|
|
|
445 (progn (goto-char prev-class)
|
|
|
446 (setq parents (eif-get-parents-from-source buffer-file-name))
|
|
|
447 (if (re-search-backward (concat
|
|
|
448 "[^[][ \t\n]+\\("
|
|
|
449 (mapconcat
|
|
|
450 (function (lambda (cl)
|
|
|
451 (eif-set-case-type cl)))
|
|
|
452 parents
|
|
|
453 "\\|")
|
|
|
454 "\\)")
|
|
|
455 nil t)
|
|
|
456 (progn (setq prev-class (eif-set-case (buffer-substring
|
|
|
457 (match-beginning 1)
|
|
|
458 (match-end 1))))
|
|
|
459 (cons prev-class prev-feature-nm))
|
|
|
460 (beep)
|
|
|
461 (message
|
|
|
462 "(OO-Browser): Internal error - no class associated with rename clause."))))))
|
|
|
463
|
|
|
464 (defun eif-to-feature-decl ()
|
|
|
465 (let ((end))
|
|
|
466 (while (and (progn (skip-chars-backward "^, \t\n")
|
|
|
467 (and (not (= (preceding-char) ?,))
|
|
|
468 (not (looking-at "export[ \t\n]+"))))
|
|
|
469 (progn (skip-chars-backward " \t\n")
|
|
|
470 (setq end (point))
|
|
|
471 (beginning-of-line)
|
|
|
472 (if (search-forward "--" end t)
|
|
|
473 (progn (goto-char end)
|
|
|
474 (skip-chars-forward " \t\n")
|
|
|
475 nil)
|
|
|
476 (goto-char end)
|
|
|
477 t)))))
|
|
|
478 (if (looking-at "export[ \t\n]+")
|
|
|
479 (goto-char (match-end 0))
|
|
|
480 (skip-chars-forward " \t\n"))
|
|
|
481 (if (looking-at eif-feature-name)
|
|
|
482 (buffer-substring (match-beginning 0) (match-end 0))))
|
|
|
483
|
|
|
484
|
|
24
|
485 (defun eiffel-find-feature (feature-name)
|
|
|
486 "Move point to start of feature named FEATURE-NAME in current buffer.
|
|
|
487 Display feature including all preceding comments at the top of the window.
|
|
|
488 Move point and return non-nil iff FEATURE-NAME is found."
|
|
|
489 (interactive "sFeature to find: ")
|
|
|
490 (cond ((eif-locate-feature
|
|
|
491 feature-name (eif-routine-to-regexp feature-name)))
|
|
|
492 ((eif-to-attribute feature-name)
|
|
|
493 (let ((opoint (point)))
|
|
|
494 (eif-to-comments-begin)
|
|
|
495 (recenter 0)
|
|
|
496 (goto-char opoint)
|
|
|
497 (back-to-indentation)
|
|
|
498 t))))
|
|
|
499
|
|
|
500 ;;; ************************************************************************
|
|
|
501 ;;; Private variables
|
|
|
502 ;;; ************************************************************************
|
|
0
|
503
|
|
|
504 (defconst eif-feature-name
|
|
|
505 (concat
|
|
|
506 "\\("
|
|
|
507 "\\(prefix[ \t]+\"\\(not\\|\\+\\|-\\)\"\\)"
|
|
|
508 "\\|infix[ \t]+\"\\(div\\|mod\\|^\\|<=?\\|>=?\\|\+\\|-\\|\\*\\|/"
|
|
|
509 "\\|and then\\|and\\|or else\\|or\\|xor\\|implies\\)"
|
|
|
510 "\\|" eif-identifier "\\)")
|
|
|
511 "Regexp matching any Eiffel feature name.
|
|
|
512 Will also match class names and keywords, so tests for these should precede
|
|
|
513 use of this expression.")
|
|
|
514
|
|
|
515 (defconst eif-export-key-regexp
|
|
|
516 "\\(^[ \t]*\\|[ \t]+\\)export[ \t\n]+"
|
|
|
517 "Regexp matching the Eiffel export keyword in context.")
|
|
|
518
|
|
|
519 (defconst eif-class-repeat (concat "repeat[ \t]+" eif-identifier)
|
|
|
520 "Match to an Eiffel 'repeat <class>' phrase. Grouping 1 is class name.")
|
|
|
521
|
|
|
522 (defconst eif-exported-feature
|
|
|
523 (concat "\\(,\\|export[ \t\n]+\\(--.*[ \t\n]+\\)*\\)"
|
|
|
524 eif-feature-name "\\([ \t]*{[^}]+}\\)?"
|
|
|
525 "\\([ \t]*[\n,]\\|[ \t]+--\\)")
|
|
|
526 "Regexp to match to a feature declaration in an export clause.
|
|
|
527 Exclude 'repeat <class>' phrases. Feature name is grouping 3.")
|
|
|
528
|
|
|
529
|
|
|
530 (provide 'br-eif-ft)
|
