Mercurial > hg > xemacs-beta

comparison lisp/oobr/br-java.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 4103f0995bd7
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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)