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