mirrors
/
emacs
mirror of https://github.com/emacs-mirror/emacs.git
0
0
Fork 0
Code Issues Projects Releases Wiki Activity
emacs/lisp/cedet/semantic/java.el

482 lines
16 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; semantic/java.el --- Semantic functions for Java -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2024 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
Reference in New Issue View Git Blame Copy Permalink