lisp/cedet/semantic/java.el

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