1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
|
;;; semantic/java.el --- Semantic functions for Java -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2025 Free Software Foundation, Inc.
;; Author: David Ponce <david@dponce.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; Common function for Java parsers.
;;; Code:
(require 'semantic)
(require 'semantic/ctxt)
(require 'semantic/doc)
(require 'semantic/format)
(eval-when-compile
(require 'semantic/find)
(require 'semantic/dep))
;;; Lexical analysis
;;
(defconst semantic-java-number-regexp
(concat "\\("
"\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
"\\|"
"\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
"\\|"
"\\<[0-9]+[.][fFdD]\\>"
"\\|"
"\\<[0-9]+[.]"
"\\|"
"[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
"\\|"
"\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
"\\|"
"\\<0[xX][[:xdigit:]]+[lL]?\\>"
"\\|"
"\\<[0-9]+[lLfFdD]?\\>"
"\\)"
)
"Lexer regexp to match Java number terminals.
Following is the specification of Java number literals.
DECIMAL_LITERAL:
[1-9][0-9]*
;
HEX_LITERAL:
0[xX][[:xdigit:]]+
;
OCTAL_LITERAL:
0[0-7]*
;
INTEGER_LITERAL:
<DECIMAL_LITERAL>[lL]?
| <HEX_LITERAL>[lL]?
| <OCTAL_LITERAL>[lL]?
;
EXPONENT:
[eE][+-]?[09]+
;
FLOATING_POINT_LITERAL:
[0-9]+[.][0-9]*<EXPONENT>?[fFdD]?
| [.][0-9]+<EXPONENT>?[fFdD]?
| [0-9]+<EXPONENT>[fFdD]?
| [0-9]+<EXPONENT>?[fFdD]
;")
;;; Parsing
;;
(defsubst semantic-java-dim (id)
"Split ID string into a pair (NAME . DIM).
NAME is ID without trailing brackets: \"[]\".
DIM is the dimension of NAME deduced from the number of trailing
brackets, or 0 if there is no trailing brackets."
(let ((dim (string-match "\\(\\[]\\)+\\'" id)))
(if dim
(cons (substring id 0 dim)
(/ (length (match-string 0 id)) 2))
(cons id 0))))
(defsubst semantic-java-type (tag)
"Return the type of TAG, taking care of array notation."
(let ((type (semantic-tag-type tag))
(dim (semantic-tag-get-attribute tag :dereference)))
(when dim
(while (> dim 0)
(setq type (concat type "[]")
dim (1- dim))))
type))
(defun semantic-java-expand-tag (tag)
"Expand compound declarations found in TAG into separate tags.
TAG contains compound declarations when its class is `variable', and
its name is a list of elements (NAME START . END), where NAME is a
compound variable name, and START/END are the bounds of the
corresponding compound declaration."
(let* ((class (semantic-tag-class tag))
(elts (semantic-tag-name tag))
dim type dim0 elt clone start end xpand)
(cond
((and (eq class 'function)
(> (cdr (setq dim (semantic-java-dim elts))) 0))
(setq clone (semantic-tag-clone tag (car dim))
xpand (cons clone xpand))
(semantic-tag-put-attribute clone :dereference (cdr dim)))
((eq class 'variable)
(or (consp elts) (setq elts (list (list elts))))
(setq dim (semantic-java-dim (semantic-tag-get-attribute tag :type))
type (car dim)
dim0 (cdr dim))
(while elts
;; For each compound element, clone the initial tag with the
;; name and bounds of the compound variable declaration.
(setq elt (car elts)
elts (cdr elts)
start (if elts (cadr elt) (semantic-tag-start tag))
end (if xpand (cddr elt) (semantic-tag-end tag))
dim (semantic-java-dim (car elt))
clone (semantic-tag-clone tag (car dim))
xpand (cons clone xpand))
(semantic-tag-put-attribute clone :type type)
(semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
(semantic-tag-set-bounds clone start end)))
((and (eq class 'type) (string-search "." (semantic-tag-name tag)))
;; javap outputs files where the package name is stuck onto the class or interface
;; name. To make this more regular, we extract the package name into a package statement,
;; then make the class name regular.
(let* ((name (semantic-tag-name tag))
(rsplit (nreverse (split-string name "\\." t)))
(newclassname (car rsplit))
(newpkg (mapconcat #'identity (reverse (cdr rsplit)) ".")))
(semantic-tag-set-name tag newclassname)
(setq xpand
(list tag
(semantic-tag-new-package newpkg nil))))
))
xpand))
;;; Environment
;;
(defcustom-mode-local-semantic-dependency-system-include-path
java-mode semantic-java-dependency-system-include-path
;; @todo - Use JDEE to get at the include path, or something else?
nil
"The system include path used by Java language.")
;; Local context
;;
(define-mode-local-override semantic-ctxt-scoped-types
java-mode (&optional point)
"Return a list of type names currently in scope at POINT."
(mapcar #'semantic-tag-name
(semantic-find-tags-by-class
'type (semantic-find-tag-by-overlay point))))
;; Tag Protection
;;
(define-mode-local-override semantic-tag-protection
java-mode (tag &optional parent)
"Return the protection of TAG in PARENT.
Override function for `semantic-tag-protection'."
(let ((prot (semantic-tag-protection-default tag parent)))
(or prot 'package)))
;; Prototype handler
;;
(defun semantic-java-prototype-function (tag &optional _parent color)
"Return a function (method) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
See also `semantic-format-tag-prototype'."
(let ((name (semantic-tag-name tag))
(type (semantic-java-type tag))
(tmpl (semantic-tag-get-attribute tag :template-specifier))
(args (semantic-tag-function-arguments tag))
(argp "")
arg argt)
(while args
(setq arg (car args)
args (cdr args))
(if (semantic-tag-p arg)
(setq argt (if color
(semantic--format-colorize-text
(semantic-java-type arg) 'type)
(semantic-java-type arg))
argp (concat argp argt (if args "," "")))))
(when color
(when type
(setq type (semantic--format-colorize-text type 'type)))
(setq name (semantic--format-colorize-text name 'function)))
(concat (or tmpl "") (if tmpl " " "")
(or type "") (if type " " "")
name "(" argp ")")))
(defun semantic-java-prototype-variable (tag &optional _parent color)
"Return a variable (field) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
See also `semantic-format-tag-prototype'."
(let ((name (semantic-tag-name tag))
(type (semantic-java-type tag)))
(concat (if color
(semantic--format-colorize-text type 'type)
type)
" "
(if color
(semantic--format-colorize-text name 'variable)
name))))
(defun semantic-java-prototype-type (tag &optional _parent color)
"Return a type (class/interface) prototype for TAG.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
See also `semantic-format-tag-prototype'."
(let ((name (semantic-tag-name tag))
(type (semantic-tag-type tag))
(tmpl (semantic-tag-get-attribute tag :template-specifier)))
(concat type " "
(if color
(semantic--format-colorize-text name 'type)
name)
(or tmpl ""))))
(define-mode-local-override semantic-format-tag-prototype
java-mode (tag &optional parent color)
"Return a prototype for TOKEN.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in."
(let ((f (intern-soft (format "semantic-java-prototype-%s"
(semantic-tag-class tag)))))
(funcall (if (fboundp f)
f
'semantic-format-tag-prototype-default)
tag parent color)))
;; Include Tag Name
;;
;; Thanks Bruce Stephens
(define-mode-local-override semantic-tag-include-filename java-mode (tag)
"Return a suitable path for (some) Java imports."
(let ((name (semantic-tag-name tag)))
(concat (mapconcat #'identity (split-string name "\\.") "/") ".java")))
;; Documentation handler
;;
(defsubst semantic-java-skip-spaces-backward ()
"Move point backward, skipping Java whitespaces."
(skip-chars-backward " \n\r\t"))
(defsubst semantic-java-skip-spaces-forward ()
"Move point forward, skipping Java whitespaces."
(skip-chars-forward " \n\r\t"))
(define-mode-local-override semantic-documentation-for-tag
java-mode (&optional tag nosnarf)
"Find documentation from TAG and return it as a clean string.
Java have documentation set in a comment preceding TAG's definition.
Attempt to strip out comment syntactic sugar, unless optional argument
NOSNARF is non-nil.
If NOSNARF is `lex', then return the semantic lex token."
(when (or tag (setq tag (semantic-current-tag)))
(with-current-buffer (semantic-tag-buffer tag)
(save-excursion
;; Move the point at token start
(goto-char (semantic-tag-start tag))
(semantic-java-skip-spaces-forward)
;; If the point already at "/**" (this occurs after a doc fix)
(if (looking-at "/\\*\\*")
nil
;; Skip previous spaces
(semantic-java-skip-spaces-backward)
;; Ensure point is after "*/" (javadoc block comment end)
(condition-case nil
(backward-char 2)
(error nil))
(when (looking-at "\\*/")
;; Move the point backward across the comment
(forward-char 2) ; return just after "*/"
(forward-comment -1) ; to skip the entire block
))
;; Verify the point is at "/**" (javadoc block comment start)
(if (looking-at "/\\*\\*")
(let ((p (point))
(c (semantic-doc-snarf-comment-for-tag 'lex)))
(when c
;; Verify that the token just following the doc
;; comment is the current one!
(goto-char (semantic-lex-token-end c))
(semantic-java-skip-spaces-forward)
(when (eq tag (semantic-current-tag))
(goto-char p)
(semantic-doc-snarf-comment-for-tag nosnarf)))))
))))
;;; Javadoc facilities
;;
;; Javadoc elements
;;
(defvar semantic-java-doc-line-tags nil
"Valid javadoc line tags.
Ordered following Sun's Tag Convention at
<https://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
(defvar semantic-java-doc-with-name-tags nil
"Javadoc tags which have a name.")
(defvar semantic-java-doc-with-ref-tags nil
"Javadoc tags which have a reference.")
;; Optional javadoc tags by classes of semantic tag
;;
(defvar semantic-java-doc-extra-type-tags nil
"Optional tags used in class/interface documentation.
Ordered following Sun's Tag Convention.")
(defvar semantic-java-doc-extra-function-tags nil
"Optional tags used in method/constructor documentation.
Ordered following Sun's Tag Convention.")
(defvar semantic-java-doc-extra-variable-tags nil
"Optional tags used in field documentation.
Ordered following Sun's Tag Convention.")
;; All javadoc tags by classes of semantic tag
;;
(defvar semantic-java-doc-type-tags nil
"Tags allowed in class/interface documentation.
Ordered following Sun's Tag Convention.")
(defvar semantic-java-doc-function-tags nil
"Tags allowed in method/constructor documentation.
Ordered following Sun's Tag Convention.")
(defvar semantic-java-doc-variable-tags nil
"Tags allowed in field documentation.
Ordered following Sun's Tag Convention.")
;; Access to Javadoc elements
;;
(defmacro semantic-java-doc-tag (name)
"Return doc tag from NAME.
That is @NAME."
`(concat "@" ,name))
(defsubst semantic-java-doc-tag-name (tag)
"Return name of the doc TAG symbol.
That is TAG `symbol-name' without the leading `@'."
(substring (symbol-name tag) 1))
(defun semantic-java-doc-keyword-before-p (k1 k2)
"Return non-nil if javadoc keyword K1 is before K2."
(let* ((t1 (semantic-java-doc-tag k1))
(t2 (semantic-java-doc-tag k2))
(seq1 (and (semantic-lex-keyword-p t1)
(plist-get (semantic-lex-keyword-get t1 'javadoc)
'seq)))
(seq2 (and (semantic-lex-keyword-p t2)
(plist-get (semantic-lex-keyword-get t2 'javadoc)
'seq))))
(if (and (numberp seq1) (numberp seq2))
(<= seq1 seq2)
;; Unknown tags (probably custom ones) are always after official
;; ones and are not themselves ordered.
(or (numberp seq1)
(and (not seq1) (not seq2))))))
(defun semantic-java-doc-keywords-map (fun &optional property)
"Run function FUN for each javadoc keyword.
Return the list of FUN results. If optional PROPERTY is non-nil only
call FUN for javadoc keywords which have a value for PROPERTY. FUN
receives two arguments: the javadoc keyword and its associated
`javadoc' property list. It can return any value. All nil values are
removed from the result list."
(delq nil
(mapcar
(lambda (k)
(let* ((tag (semantic-java-doc-tag k))
(plist (semantic-lex-keyword-get tag 'javadoc)))
(if (or (not property) (plist-get plist property))
(funcall fun k plist))))
semantic-java-doc-line-tags)))
;;; Mode setup
;;
(defun semantic-java-doc-setup ()
"Lazy initialization of javadoc elements."
(or semantic-java-doc-line-tags
(setq semantic-java-doc-line-tags
(sort (mapcar #'semantic-java-doc-tag-name
(semantic-lex-keywords 'javadoc))
#'semantic-java-doc-keyword-before-p)))
(or semantic-java-doc-with-name-tags
(setq semantic-java-doc-with-name-tags
(semantic-java-doc-keywords-map
(lambda (k _p) k)
'with-name)))
(or semantic-java-doc-with-ref-tags
(setq semantic-java-doc-with-ref-tags
(semantic-java-doc-keywords-map
(lambda (k _p) k)
'with-ref)))
(or semantic-java-doc-extra-type-tags
(setq semantic-java-doc-extra-type-tags
(semantic-java-doc-keywords-map
(lambda (k p)
(if (memq 'type (plist-get p 'usage))
k))
'opt)))
(or semantic-java-doc-extra-function-tags
(setq semantic-java-doc-extra-function-tags
(semantic-java-doc-keywords-map
(lambda (k p)
(if (memq 'function (plist-get p 'usage))
k))
'opt)))
(or semantic-java-doc-extra-variable-tags
(setq semantic-java-doc-extra-variable-tags
(semantic-java-doc-keywords-map
(lambda (k p)
(if (memq 'variable (plist-get p 'usage))
k))
'opt)))
(or semantic-java-doc-type-tags
(setq semantic-java-doc-type-tags
(semantic-java-doc-keywords-map
(lambda (k p)
(if (memq 'type (plist-get p 'usage))
k)))))
(or semantic-java-doc-function-tags
(setq semantic-java-doc-function-tags
(semantic-java-doc-keywords-map
(lambda (k p)
(if (memq 'function (plist-get p 'usage))
k)))))
(or semantic-java-doc-variable-tags
(setq semantic-java-doc-variable-tags
(semantic-java-doc-keywords-map
(lambda (k p)
(if (memq 'variable (plist-get p 'usage))
k)))))
)
(provide 'semantic/java)
;; Local variables:
;; generated-autoload-load-name: "semantic/java"
;; End:
;;; semantic/java.el ends here
|
