|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-eif.el
|
|
|
4 ;; SUMMARY: Support routines for Eiffel inheritance browsing and error parsing.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 7-Dec-89
|
|
100
|
12 ;; LAST-MOD: 21-Feb-97 at 17:22:26 by Bob Weiner
|
|
0
|
13 ;;
|
|
100
|
14 ;; Copyright (C) 1989-1995, 1997 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
|
|
|
22 ;;; ************************************************************************
|
|
|
23 ;;; Other required Elisp libraries
|
|
|
24 ;;; ************************************************************************
|
|
|
25
|
|
|
26 (require 'br-lib)
|
|
|
27
|
|
|
28 ;;; ************************************************************************
|
|
|
29 ;;; User visible variables
|
|
|
30 ;;; ************************************************************************
|
|
|
31
|
|
|
32 (defvar eif-lib-search-dirs nil
|
|
|
33 "List of directories below which Eiffel Library source files are found.
|
|
|
34 Subdirectories of Library source are also searched. A Library is a stable
|
|
|
35 group of classes.")
|
|
|
36
|
|
|
37 (defvar eif-sys-search-dirs nil
|
|
|
38 "List of directories below which Eiffel System source files are found.
|
|
|
39 Subdirectories of System source are also searched. A System class is one
|
|
|
40 that is not yet reusable and is likely to change before release.")
|
|
|
41
|
|
|
42 (defconst eif-narrow-view-to-class nil
|
|
|
43 "*Non-nil means narrow buffer to just the matching class definition when displayed.")
|
|
|
44
|
|
|
45 ;;; ************************************************************************
|
|
|
46 ;;; Internal functions
|
|
|
47 ;;; ************************************************************************
|
|
|
48
|
|
|
49 (defun eif-get-classes-from-source (filename &optional skip-tags
|
|
|
50 skip-tags-cleanup)
|
|
|
51 "Scans FILENAME and returns cons of class list with parents-class alist.
|
|
|
52 Handles multiple inheritance. Assumes file existence and readability have
|
|
|
53 already been checked.
|
|
|
54 With optional SKIP-TAGS non-nil, does not compute and store lookup tags
|
|
|
55 for element definitions. If SKIP-TAGS is nil, normally a cleanup
|
|
|
56 function is called after scanning the elements. SKIP-TAGS-CLEANUP
|
|
|
57 non-nil suppresses this action."
|
|
|
58 ;; Multiple classes per file allowed
|
|
|
59 (let ((no-kill (get-file-buffer filename))
|
|
|
60 classes class end parents signatures start)
|
|
|
61 (if no-kill
|
|
|
62 (set-buffer no-kill)
|
|
|
63 (funcall br-view-file-function filename))
|
|
|
64 (save-excursion
|
|
|
65 (save-restriction
|
|
|
66 (widen)
|
|
|
67 (goto-char (point-min))
|
|
|
68 (while (re-search-forward eif-class-def-regexp nil t)
|
|
|
69 (setq start (point)
|
|
|
70 class
|
|
|
71 (eif-set-case
|
|
|
72 (buffer-substring (match-beginning 2) (match-end 2)))
|
|
|
73 classes (cons class classes)
|
|
|
74 parents (cons (cons (eif-get-parents-from-source
|
|
|
75 filename class)
|
|
|
76 class)
|
|
|
77 parents))
|
|
|
78 (eif-to-class-end)
|
|
|
79 (setq end (point))
|
|
|
80 (or skip-tags
|
|
|
81 ;; Scan class features
|
|
|
82 (setq signatures
|
|
|
83 (eif-scan-features-in-class class start end))))))
|
|
|
84 (if skip-tags
|
|
|
85 nil
|
|
|
86 (eif-get-feature-tags
|
|
|
87 buffer-file-name (eif-sort-features signatures))
|
|
|
88 (or skip-tags-cleanup (br-feature-tags-save)))
|
|
|
89 (or no-kill (kill-buffer (current-buffer)))
|
|
|
90 (cons classes (delq nil parents))))
|
|
|
91
|
|
|
92 (defun eif-get-parents-from-source (filename &optional class-name)
|
|
|
93 "Return list of downcased parents of Eiffel class in FILENAME.
|
|
|
94 Return nil if file is not readable. Assume that Eiffel keywords
|
|
|
95 'inherit' and 'feature' occur at the beginning of lines, when present."
|
|
|
96 (let ((parents) (par)
|
|
|
97 (no-kill (get-file-buffer filename))
|
|
|
98 (obuf (current-buffer)))
|
|
|
99 (if no-kill
|
|
|
100 (set-buffer no-kill))
|
|
|
101 (if (or no-kill
|
|
|
102 (if (file-readable-p filename)
|
|
|
103 (let ((br-view-file-function 'br-insert-file-contents))
|
|
|
104 (message "Scanning %s ..." filename)
|
|
|
105 (funcall br-view-file-function filename)
|
|
|
106 t)))
|
|
|
107 (progn
|
|
|
108 (save-restriction
|
|
|
109 (save-excursion
|
|
|
110 (widen)
|
|
|
111 (goto-char (point-min))
|
|
|
112 (let ((case-fold-search t) ;; Ignore case in searches
|
|
|
113 (end)
|
|
|
114 indent)
|
|
|
115 (if (or (null class-name)
|
|
|
116 (let ((class-def (concat eif-class-name-before
|
|
|
117 (eif-set-case-type class-name)
|
|
|
118 eif-class-name-after)))
|
|
|
119 (re-search-forward class-def nil t)))
|
|
|
120 (if (not (re-search-forward (concat "^inherit[ \t\n]+"
|
|
|
121 eif-parent-regexp)
|
|
|
122 nil t))
|
|
|
123 nil
|
|
|
124 ;; Save first parent
|
|
|
125 (setq parents (list
|
|
|
126 (eif-set-case (buffer-substring
|
|
|
127 (match-beginning 2)
|
|
|
128 (match-end 2))))
|
|
|
129 indent (save-excursion
|
|
|
130 (goto-char (match-beginning 2))
|
|
|
131 (current-column)))
|
|
|
132 ;; Save any succeeding parents
|
|
|
133 (save-excursion
|
|
|
134 (if (re-search-forward "^[a-zA-Z]" nil t)
|
|
|
135 (setq end (1- (point)))))
|
|
|
136 (forward-line 1)
|
|
|
137 (while (< (point) end)
|
|
|
138 (back-to-indentation)
|
|
|
139 (and (<= (current-column) indent)
|
|
|
140 (looking-at eif-identifier)
|
|
|
141 (setq par (eif-set-case (buffer-substring
|
|
|
142 (match-beginning 1)
|
|
|
143 (match-end 1))))
|
|
|
144 (if (or (br-member par parents)
|
|
|
145 (br-member-sorted-strings
|
|
|
146 par eif-reserved-words))
|
|
|
147 nil
|
|
|
148 (setq parents (cons par parents))))
|
|
|
149 (forward-line 1)))))))
|
|
|
150 (or no-kill (kill-buffer (current-buffer)))
|
|
|
151 (set-buffer obuf)
|
|
|
152 (nreverse parents)))))
|
|
|
153
|
|
|
154 (defun eif-select-path (paths-htable-elt &optional feature-p)
|
|
|
155 "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
|
|
|
156 Selection is between path of class definition and path for features associated
|
|
|
157 with the class."
|
|
|
158 (cdr paths-htable-elt))
|
|
|
159
|
|
|
160 (defun eif-set-case (type)
|
|
|
161 "Return string TYPE identifier for use as a class name."
|
|
|
162 (downcase type))
|
|
|
163
|
|
|
164 (defun eif-set-case-type (class-name)
|
|
|
165 "Return string CLASS-NAME for use as a type identifier."
|
|
|
166 (upcase class-name))
|
|
|
167
|
|
|
168
|
|
|
169 (defun eif-to-class-end ()
|
|
|
170 "Assuming point is at start of class, move to start of line after end of class."
|
|
|
171 (interactive)
|
|
|
172 (if (and (re-search-forward "^end[ \t\n-]" nil t)
|
|
|
173 (= (forward-line 1) 0))
|
|
|
174 nil
|
|
|
175 (goto-char (point-max))))
|
|
|
176
|
|
|
177 (defun eif-to-comments-begin ()
|
|
|
178 "Skip back from current point past any preceding blank lines and comments."
|
|
|
179 (let ((opoint))
|
|
|
180 (while
|
|
|
181 (progn (setq opoint (point))
|
|
|
182 ;; To previous line
|
|
|
183 (and (= 0 (forward-line -1))
|
|
|
184 ;; If begins with "--", then is a comment.
|
|
|
185 (cond ((looking-at "[ \t]*--"))
|
|
|
186 ((looking-at "[ \t]*$"))))))
|
|
|
187 (goto-char opoint)
|
|
|
188 ;; Skip past whitespace
|
|
|
189 (skip-chars-forward " \t\n")
|
|
|
190 (beginning-of-line)))
|
|
|
191
|
|
|
192 ;;; ************************************************************************
|
|
|
193 ;;; Internal variables
|
|
|
194 ;;; ************************************************************************
|
|
|
195
|
|
|
196 (defconst eif-class-name-before "^[ \t]*\\(deferred[ \t\n]+\\|expanded[ \t\n]+\\)?class[ \t\n]+"
|
|
|
197 "Regexp preceding the class name in a class definition.")
|
|
|
198
|
|
|
199 (defconst eif-class-name-after "[ \t\n]+"
|
|
|
200 "Regexp following the class name in a class definition.")
|
|
|
201
|
|
|
202 (defconst eif-identifier-chars "A-Za-z0-9_"
|
|
|
203 "String of chars and char ranges that may be used within an Eiffel identifier.")
|
|
|
204
|
|
|
205 (defconst eif-identifier (concat "\\([a-zA-Z][" eif-identifier-chars "]*\\)")
|
|
|
206 "Regular expression matching an Eiffel identifier.")
|
|
|
207
|
|
|
208 (defconst eif-class-def-regexp
|
|
|
209 (concat eif-class-name-before eif-identifier eif-class-name-after)
|
|
|
210 "Regular expression used to match to class definitions in source text.
|
|
|
211 Class name identifier is grouped expression 2.")
|
|
|
212
|
|
|
213 (defconst eif-class-name-preceding
|
|
|
214 "\\([\[\{>;:][ \t\n]*\\|[a-zA-z][ \t\n]+\\)"
|
|
|
215 "Pattern preceding any valid non-comment use of an Eiffel class/type name.")
|
|
|
216
|
|
|
217 (defconst eif-class-name-pat
|
|
|
218 (concat eif-class-name-preceding eif-identifier)
|
|
|
219 "Class name is grouped expression 2.")
|
|
|
220
|
|
|
221 (defconst eif-lang-prefix "eif-"
|
|
|
222 "Prefix string that starts \"br-eif.el\" symbol names.")
|
|
|
223
|
|
|
224
|
|
|
225 (defconst eif-parent-regexp (concat "[ \t\n]*\\(--.*[\n]\\)*[ \t\n]*"
|
|
|
226 eif-identifier)
|
|
|
227 "Parent identifier is grouped expression 2.")
|
|
|
228
|
|
|
229 (defconst eif-src-file-regexp ".\\.e$"
|
|
|
230 "Regular expression matching a unique part of Eiffel class filenames and no others.")
|
|
|
231
|
|
|
232 (defvar eif-children-htable nil
|
|
|
233 "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
|
|
|
234 Used to traverse Eiffel inheritance graph. 'br-build-children-htable' builds
|
|
|
235 this list.")
|
|
|
236 (defvar eif-parents-htable nil
|
|
|
237 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
|
|
|
238 Used to traverse Eiffel inheritance graph. 'br-build-parents-htable' builds
|
|
|
239 this list.")
|
|
|
240 (defvar eif-paths-htable nil
|
|
|
241 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . DIRECTORY).
|
|
|
242 DIRECTORY gives the location of classes found in LIST-OF-CLASS-NAMES.
|
|
|
243 'br-build-paths-htable' builds this list.")
|
|
|
244
|
|
|
245 (defvar eif-lib-parents-htable nil
|
|
|
246 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
|
|
|
247 Only classes from stable software libraries are used to build the list.")
|
|
|
248 (defvar eif-lib-paths-htable nil
|
|
|
249 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . DIRECTORY).
|
|
|
250 DIRECTORY gives the location of classes found in LIST-OF-CLASS-NAMES.
|
|
|
251 Only classes from stable software libraries are used to build the list.")
|
|
|
252
|
|
|
253 (defvar eif-sys-parents-htable nil
|
|
|
254 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
|
|
|
255 Only classes from systems that are likely to change are used to build the list.")
|
|
|
256 (defvar eif-sys-paths-htable nil
|
|
|
257 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . DIRECTORY).
|
|
|
258 DIRECTORY gives the location of classes found in LIST-OF-CLASS-NAMES.
|
|
|
259 Only classes from systems that are likely to change are used to build the
|
|
|
260 list.")
|
|
|
261
|
|
|
262 (defvar eif-lib-prev-search-dirs nil
|
|
|
263 "Used to check if 'eif-lib-paths-htable' must be regenerated.")
|
|
|
264 (defvar eif-sys-prev-search-dirs nil
|
|
|
265 "Used to check if 'eif-sys-paths-htable' must be regenerated.")
|
|
|
266
|
|
|
267 (defvar eif-env-spec nil
|
|
|
268 "Non-nil value means Environment specification has been given but not yet built.
|
|
|
269 Nil means current Environment has been built, though it may still require updating.")
|
|
|
270
|
|
|
271 (provide 'br-eif)
|
