|
0
|
1 ;;!emacs
|
|
|
2 ;;
|
|
|
3 ;; FILE: br-java.el
|
|
|
4 ;; SUMMARY: Support routines for Java inheritance browsing.
|
|
|
5 ;; USAGE: GNU Emacs Lisp Library
|
|
|
6 ;; KEYWORDS: c, oop, tools
|
|
|
7 ;;
|
|
|
8 ;; AUTHOR: Bob Weiner
|
|
100
|
9 ;; ORG: InfoDock Associates
|
|
0
|
10 ;;
|
|
|
11 ;; ORIG-DATE: 01-Aug-95
|
|
100
|
12 ;; LAST-MOD: 20-Feb-97 at 07:33:18 by Bob Weiner
|
|
0
|
13 ;;
|
|
100
|
14 ;; Copyright (C) 1995, 1996, 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 (mapcar 'require '(br-lib hypb hasht))
|
|
|
27
|
|
|
28 ;;; ************************************************************************
|
|
|
29 ;;; User visible variables
|
|
|
30 ;;; ************************************************************************
|
|
|
31
|
|
|
32 (defvar java-class-keyword
|
|
|
33 "\\(class\\|interface\\)[ \t\n]+"
|
|
|
34 "*Keyword regexp preceding a java class declaration or definition.")
|
|
|
35
|
|
|
36 (defvar java-lib-search-dirs nil
|
|
|
37 "List of directories below which java Library source files are found.
|
|
|
38 Subdirectories of Library source are also searched. A Library is a stable
|
|
|
39 group of classes.")
|
|
|
40
|
|
|
41 (defvar java-sys-search-dirs nil
|
|
|
42 "List of directories below which java System source files are found.
|
|
|
43 Subdirectories of System source are also searched. A System class is one
|
|
|
44 that is not yet reusable and is likely to change before release.")
|
|
|
45
|
|
|
46 (defvar java-package-name nil
|
|
|
47 "Name of current packge if any. Nil otherwise.")
|
|
|
48
|
|
|
49 (defconst java-narrow-view-to-class nil
|
|
|
50 "*Non-nil means narrow buffer to just the matching class definition when displayed.")
|
|
|
51
|
|
|
52 ;;; ************************************************************************
|
|
|
53 ;;; Internal functions
|
|
|
54 ;;; ************************************************************************
|
|
|
55
|
|
|
56 (defun java-get-classes-from-source (filename &optional skip-tags
|
|
|
57 skip-tags-cleanup)
|
|
|
58 "Scans FILENAME and returns cons of class list with parents-class alist.
|
|
|
59 Handles multiple inheritance. Assumes file existence and readability have
|
|
|
60 already been checked.
|
|
|
61 With optional SKIP-TAGS non-nil, does not compute and store lookup tags
|
|
|
62 for member definitions. If SKIP-TAGS is nil, normally a cleanup
|
|
|
63 function is called after scanning the members. SKIP-TAGS-CLEANUP
|
|
|
64 non-nil suppresses this action."
|
|
|
65 (let ((no-kill (get-file-buffer filename))
|
|
|
66 class-name-end classes class has-parents open-brace-point end
|
|
|
67 parents-start parents parent-cons parent-list signatures)
|
|
|
68 (if no-kill
|
|
|
69 (set-buffer no-kill)
|
|
|
70 (funcall br-view-file-function filename))
|
|
|
71 ;; Static initializers confuse the parser and don't define anything
|
|
|
72 ;; that we need, so remove them.
|
|
|
73 (java-strip-static-code)
|
|
|
74 ;; Is more than one package statement allowed?
|
|
|
75 (setq java-package-name (java-get-package-name))
|
|
|
76 (save-excursion
|
|
|
77 (save-restriction
|
|
|
78 (widen)
|
|
|
79 (goto-char (point-min))
|
|
|
80 (while (re-search-forward java-class-def-regexp nil t)
|
|
|
81 (setq has-parents
|
|
|
82 (not (= ?{ (char-after
|
|
|
83 (match-beginning java-class-def-derived-grpn))))
|
|
|
84 parents-start (match-beginning java-class-def-derived-grpn)
|
|
|
85 end (match-end 0)
|
|
|
86 class-name-end (match-end java-class-def-name-grpn)
|
|
|
87 ;;
|
|
|
88 ;; Now since we've saved all the match expressions we need
|
|
|
89 ;; from our last regexp match, we can call functions which
|
|
|
90 ;; change the match data below here.
|
|
|
91 class (java-normalize-class-match))
|
|
|
92 (goto-char parents-start)
|
|
|
93 (setq parent-list (if has-parents
|
|
|
94 ;; Return parents as a list.
|
|
|
95 (java-scan-parents end)))
|
|
|
96 (if (and (null parent-list)
|
|
|
97 (not (equal class "Object")))
|
|
|
98 ;; All classes have Object as an ancestor, so if
|
|
|
99 ;; no parents are listed, make Object the sole parent.
|
|
|
100 (setq parent-list '("Object")))
|
|
|
101 ;; Ensure class name not found within a comment
|
|
|
102 (if (c-within-comment-p)
|
|
|
103 (progn (search-forward "*/" nil t)
|
|
|
104 (setq class nil parent-cons nil))
|
|
|
105 (setq parent-cons (cons parent-list class)
|
|
|
106 classes (cons class classes)
|
|
|
107 parents (cons parent-cons parents))
|
|
|
108 (or skip-tags
|
|
|
109 ;; Scan members defined within class
|
|
|
110 (progn (goto-char class-name-end)
|
|
|
111 (if (search-forward "{" nil t)
|
|
|
112 (progn (setq open-brace-point (point))
|
|
|
113 (backward-char)
|
|
|
114 ;; Move to class close brace but ignore
|
|
|
115 ;; any error if braces are unbalanced.
|
|
|
116 ;; Let the compiler tell the user about
|
|
|
117 ;; this.
|
|
|
118 (if (condition-case ()
|
|
|
119 (progn (forward-sexp) t)
|
|
|
120 (error nil))
|
|
|
121 (setq signatures
|
|
|
122 (append
|
|
|
123 signatures
|
|
|
124 (java-scan-features
|
|
|
125 class open-brace-point
|
|
|
126 (point)))))))))))))
|
|
|
127 (if skip-tags
|
|
|
128 nil
|
|
|
129 (java-get-feature-tags buffer-file-name (java-sort-features signatures))
|
|
|
130 (or skip-tags-cleanup (br-feature-tags-save)))
|
|
|
131 (or no-kill
|
|
|
132 (progn (set-buffer-modified-p nil)
|
|
|
133 (kill-buffer (current-buffer))))
|
|
|
134 (cons classes (delq nil parents))))
|
|
|
135
|
|
|
136 (defun java-get-package-name()
|
|
|
137 "Return the package name of the current file."
|
|
|
138 (save-excursion
|
|
|
139 (goto-char (point-min))
|
|
|
140 (if (re-search-forward java-package-name-regexp nil t)
|
|
|
141 (buffer-substring (match-beginning java-package-name-grpn)
|
|
|
142 (match-end java-package-name-grpn))
|
|
|
143 "")))
|
|
|
144
|
|
|
145 (defun java-split-identifier (name)
|
|
|
146 "Return list of component words (in reverse order) of the given NAME."
|
|
|
147 (or (hash-lookup name java-package-htable)
|
|
|
148 (let ((s name)
|
|
|
149 start words tmp)
|
|
|
150 (while (and (not (null s)) (> (length s) 0))
|
|
|
151 (setq start (string-match java-package-word-regexp s))
|
|
|
152 (if start
|
|
|
153 (progn
|
|
|
154 (setq tmp (substring s (match-beginning 1) (match-end 1)))
|
|
|
155 (setq s (substring s (match-end 0)))
|
|
|
156 (setq words (cons tmp words)))))
|
|
|
157 (hash-add words java-package-name java-package-htable))))
|
|
|
158
|
|
|
159 (defun java-normalize-class-name (name)
|
|
100
|
160 "Normalize class NAME to include the package name that defines it."
|
|
|
161 ;; Currently incomplete. The defined class has a package name, but
|
|
0
|
162 ;; the parents do not. How do we match the parents to the correct
|
|
|
163 ;; class if there are multiple matches?
|
|
|
164 (or (car (java-split-identifier name))
|
|
|
165 (if (null java-package-name)
|
|
|
166 (car (java-split-identifier name))
|
|
|
167 ;; Note: maybe allow user to pick how many words to prepend.
|
|
|
168 (let ((prefix (car (java-split-identifier java-package-name))))
|
|
|
169 (if (and prefix (> (length prefix) 0))
|
|
|
170 (concat prefix "." (car (java-split-identifier name)))
|
|
|
171 (car (java-split-identifier name)))))))
|
|
|
172
|
|
|
173 (defun java-class-definition-regexp (class &optional regexp-flag)
|
|
|
174 "Return regexp to uniquely match the definition of CLASS name.
|
|
|
175 Optional REGEXP-FLAG non-nil means CLASS has already been quoted for use in a
|
|
|
176 regular expression."
|
|
|
177 (concat "[ \t]*"
|
|
|
178 java-class-keyword
|
|
|
179 (if regexp-flag
|
|
|
180 class
|
|
|
181 (regexp-quote class))
|
|
|
182 java-class-name-after))
|
|
|
183
|
|
|
184 (defun java-normalize-class-match ()
|
|
|
185 "After a regexp match to a class definition, return the matching class name."
|
|
|
186 (java-normalize-class-name
|
|
|
187 (buffer-substring (match-beginning java-class-def-name-grpn)
|
|
|
188 (match-end java-class-def-name-grpn))))
|
|
|
189
|
|
|
190 (defun java-scan-parents (end)
|
|
|
191 "Return list of parent names from a java class definition.
|
|
|
192 Since java permits only single inheritance, the list will include at most one
|
|
|
193 parent name. Point must be before the implements or extends keyword that
|
|
|
194 precedes the parent class name."
|
|
|
195 (let (parent-list parent)
|
|
|
196 (while (re-search-forward java-parent-regexp end t)
|
|
|
197 (setq parent (java-normalize-class-name
|
|
|
198 (buffer-substring (match-beginning java-parent-name-grpn)
|
|
|
199 (match-end java-parent-name-grpn)))
|
|
|
200 parent-list (cons parent parent-list)))
|
|
|
201 (nreverse parent-list)))
|
|
|
202
|
|
|
203 (defun java-get-parents-from-source (filename class-name)
|
|
|
204 "Scan source in FILENAME and return list of parents of CLASS-NAME.
|
|
|
205 Assume file existence has already been checked."
|
|
|
206 (cond ((null class-name) nil)
|
|
|
207 ((equal filename br-null-path)
|
|
|
208 ;; This means there is no source for this class, so
|
|
|
209 ;; since all classes have Object as an ancestor and there is no
|
|
|
210 ;; where to look for parents, make Object the sole parent.
|
|
|
211 '("Object"))
|
|
|
212 (t (car (car (br-rassoc
|
|
|
213 class-name
|
|
|
214 (cdr (java-get-classes-from-source filename t))))))))
|
|
|
215
|
|
|
216 (defun java-select-path (paths-htable-elt &optional feature-p)
|
|
|
217 "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
|
|
|
218 Selection is between path of class definition and path for features associated
|
|
|
219 with the class."
|
|
|
220 (let ((elt (cdr paths-htable-elt)))
|
|
|
221 (if (consp elt)
|
|
|
222 (if feature-p (cdr elt) (car elt))
|
|
|
223 ;; Both paths are the same.
|
|
|
224 elt)))
|
|
|
225
|
|
|
226 (defun java-set-case (type)
|
|
|
227 "Return string TYPE identifier for use as a class name."
|
|
|
228 type)
|
|
|
229
|
|
|
230 (defun java-set-case-type (class-name)
|
|
|
231 "Return string CLASS-NAME for use as a type identifier."
|
|
|
232 class-name)
|
|
|
233
|
|
|
234 (defun java-to-class-end ()
|
|
|
235 "Assuming point is at start of class, move to start of line after end of class."
|
|
|
236 (interactive)
|
|
|
237 (condition-case ()
|
|
|
238 (forward-list)
|
|
|
239 (error (progn (or (re-search-forward "^}" nil t)
|
|
|
240 (goto-char (point-max))))))
|
|
|
241 (forward-line 1))
|
|
|
242
|
|
|
243 (defun java-to-comments-begin ()
|
|
|
244 "Skip back from current point past any preceding blank lines and comments.
|
|
|
245 Presumes no \"/*\" strings are nested within multi-line comments."
|
|
|
246 (let ((opoint))
|
|
|
247 (while (progn (setq opoint (point))
|
|
|
248 ;; To previous line
|
|
|
249 (if (= 0 (forward-line -1))
|
|
|
250 (cond
|
|
|
251 ;; If begins with "//" or ends with "*/", then is a
|
|
|
252 ;; comment.
|
|
|
253 ((looking-at "[ \t]*\\(//\\|$\\)"))
|
|
|
254 ((looking-at ".*\\*/[ \t]*$")
|
|
|
255 (end-of-line)
|
|
|
256 ;; Avoid //*** single line comments here.
|
|
|
257 (re-search-backward "\\(^\\|[^/]\\)/\\*" nil t))
|
|
|
258 ((looking-at "[ \t]*$"))))))
|
|
|
259 (goto-char opoint)
|
|
|
260 ;; Skip past whitespace
|
|
|
261 (skip-chars-forward " \t\n")
|
|
|
262 (beginning-of-line)))
|
|
|
263
|
|
|
264 ;; Static initializers confuse the parser, and don't define anything
|
|
|
265 ;; that we need
|
|
|
266 (defun java-strip-static-code ()
|
|
|
267 "Strip the static initializers from this buffer."
|
|
|
268 (let (buffer-read-only)
|
|
|
269 (save-excursion
|
|
|
270 (goto-char (point-min))
|
|
|
271 (while (re-search-forward java-static-init-regexp (point-max) t)
|
|
|
272 (goto-char (1- (match-end 0)))
|
|
|
273 (let ((start (point)))
|
|
|
274 (if (= (following-char) ?{)
|
|
|
275 (condition-case ()
|
|
|
276 (forward-sexp)
|
|
|
277 (error nil)))
|
|
|
278 (delete-region start (point))
|
|
|
279 (delete-region (match-beginning 0) (1- (match-end 0)))
|
|
|
280 )))))
|
|
|
281
|
|
|
282 ;;; ************************************************************************
|
|
|
283 ;;; Internal variables
|
|
|
284 ;;; ************************************************************************
|
|
|
285
|
|
|
286 (defconst java-class-modifier-keyword
|
|
100
|
287 "\\(public\\|final\\|abstract\\|[ \t\n\^M]+\\)*")
|
|
0
|
288
|
|
|
289 (defconst java-class-name-before
|
|
|
290 (concat "^[ \t]*" java-class-modifier-keyword java-class-keyword)
|
|
|
291 "Regexp preceding the class name in a class definition.")
|
|
|
292
|
|
|
293 (defconst java-class-name-after
|
|
|
294 "[ \t\n]+\\({\\|extends\\|implements\\)"
|
|
|
295 "Regexp following the class name in a class definition.
|
|
|
296 Last character matched is either the colon preceding the list of class
|
|
|
297 parents, or the curly brace beginning the class body definition.")
|
|
|
298
|
|
|
299 (defconst java-identifier-chars "_$.a-zA-Z0-9"
|
|
|
300 "String of chars and char ranges that may be used within a Java identifier.")
|
|
|
301
|
|
|
302 (defconst java-return-type-chars java-identifier-chars
|
|
|
303 "String of chars and char ranges that may be used within a Java return type identifier.")
|
|
|
304
|
|
|
305 (defconst java-identifier (concat "\\([_$a-zA-Z][" java-identifier-chars "]*\\)")
|
|
|
306 "Regular expression matching a Java identifier.")
|
|
|
307
|
|
|
308 (defconst java-class-def-regexp
|
|
|
309 (concat java-class-name-before java-identifier java-class-name-after
|
|
|
310 "[^{(;]+")
|
|
|
311 "Regular expression used to match to class definitions in source text.
|
|
|
312 Class name identifier is grouping 'java-class-def-name-grpn'.
|
|
|
313 ':' derived class indicator begins grouping 'java-class-def-derived-grpn,'
|
|
|
314 unless the class is not derived, in which case this grouping begins with
|
|
|
315 '{'.")
|
|
|
316
|
|
|
317 (defconst java-class-def-name-grpn 3)
|
|
|
318 (defconst java-class-def-derived-grpn 4)
|
|
|
319
|
|
|
320 (defconst java-lang-prefix "java-"
|
|
|
321 "Prefix string that starts \"br-java.el\" symbol names.")
|
|
|
322
|
|
|
323 (defconst java-parent-regexp
|
|
|
324 (concat "\\(\\(implements\\|extends\\|,\\)?[ \t\n]+\\)*[ \t\n]+"
|
|
|
325 java-identifier "[ \t\n]*[ {;]")
|
|
|
326 "Parent identifier is group 'java-parent-name-grpn'.")
|
|
|
327 ;; part 2 of original
|
|
|
328 ;; "\\(\\(public\\|private\\|protected\\|final\||abstract\\|implements\\|extends\\)[,]?[ \t\n]+\\)?\\)?"
|
|
|
329
|
|
|
330 (defconst java-parent-name-grpn 3)
|
|
|
331
|
|
|
332 (defconst java-package-name-regexp
|
|
|
333 (concat "[ \t\n]*" java-identifier "[ \t\n]*;")
|
|
|
334 "Regexp matching a package statement. Package name is java-package-name-grpn.")
|
|
|
335
|
|
|
336 (defconst java-package-name-grpn 1)
|
|
|
337
|
|
|
338 (defconst java-package-word-regexp
|
|
|
339 "\\([a-zA-z_0-9]*\\)\\.?"
|
|
|
340 "Return a single component of a package name.")
|
|
|
341
|
|
|
342 (defconst java-static-init-regexp
|
|
|
343 "[ \t\n]*static[ \t\n]+{"
|
|
|
344 "Regexp matching start of static initializer block.")
|
|
|
345
|
|
|
346 (defvar java-package-htable
|
|
|
347 (hash-make 7)
|
|
|
348 "Hash table of split package names.")
|
|
|
349
|
|
|
350 (defconst java-src-file-regexp "[^.]\\.\\(java\\)$"
|
|
|
351 "Regular expression matching a unique part of java source or header file name and no others.")
|
|
|
352
|
|
|
353 (defvar java-children-htable nil
|
|
|
354 "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
|
|
|
355 Used to traverse java inheritance graph. 'br-build-children-htable' builds
|
|
|
356 this list.")
|
|
|
357 (defvar java-parents-htable nil
|
|
|
358 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
|
|
|
359 Used to traverse java inheritance graph. 'br-build-parents-htable' builds
|
|
|
360 this list.")
|
|
|
361 (defvar java-paths-htable nil
|
|
|
362 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
|
|
|
363 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
|
|
|
364 'br-build-paths-htable' builds this list.")
|
|
|
365
|
|
|
366
|
|
|
367 (defvar java-lib-parents-htable nil
|
|
|
368 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
|
|
|
369 Only classes from stable software libraries are used to build the list.")
|
|
|
370 (defvar java-lib-paths-htable nil
|
|
|
371 "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
|
|
|
372 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
|
|
|
373 Only classes from stable software libraries are used to build the list.")
|
|
|
374
|
|
|
375 (defvar java-sys-parents-htable nil
|
|
|
376 "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
|
|
|
377 Only classes from systems that are likely to change are used to build the
|
|
|
378 list.")
|
|
|
379 (defvar java-sys-paths-htable nil
|
|
|
380 "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
|
|
|
381 FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
|
|
|
382 Only classes from systems that are likely to change are used to build the
|
|
|
383 list.")
|
|
|
384
|
|
|
385 (defvar java-lib-prev-search-dirs nil
|
|
|
386 "Used to check if 'java-lib-classes-htable' must be regenerated.")
|
|
|
387 (defvar java-sys-prev-search-dirs nil
|
|
|
388 "Used to check if 'java-sys-classes-htable' must be regenerated.")
|
|
|
389
|
|
|
390 (defvar java-env-spec nil
|
|
|
391 "Non-nil value means Environment specification has been given but not yet built.
|
|
|
392 Nil means current Environment has been built, though it may still require
|
|
|
393 updating.")
|
|
|
394
|
|
|
395 (provide 'br-java)
|
