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