code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/java.el

   1 ;;; semantic/java.el --- Semantic functions for Java
   2
   3 ;;; Copyright (C) 1999-2011 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      ((eq class 'variable)
 125       (or (consp elts) (setq elts (list (list elts))))
 126       (setq dim  (semantic-java-dim (semantic-tag-get-attribute tag :type))
 127             type (car dim)
 128             dim0 (cdr dim))
 129       (while elts
 130         ;; For each compound element, clone the initial tag with the
 131         ;; name and bounds of the compound variable declaration.
 132         (setq elt   (car elts)
 133               elts  (cdr elts)
 134               start (if elts  (cadr elt) (semantic-tag-start tag))
 135               end   (if xpand (cddr elt) (semantic-tag-end   tag))
 136               dim   (semantic-java-dim (car elt))
 137               clone (semantic-tag-clone tag (car dim))
 138               xpand (cons clone xpand))
 139         (semantic-tag-put-attribute clone :type type)
 140         (semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim)))
 141         (semantic-tag-set-bounds clone start end)))
 142      )
 143     xpand))
 144 \f
 145 ;;; Environment
 146 ;;
 147 (defcustom-mode-local-semantic-dependency-system-include-path
 148   java-mode semantic-java-dependency-system-include-path
 149   ;; @todo - Use JDEE to get at the include path, or something else?
 150   nil
 151   "The system include path used by Java language.")
 152
 153 ;; Local context
 154 ;;
 155 (define-mode-local-override semantic-ctxt-scoped-types
 156   java-mode (&optional point)
 157   "Return a list of type names currently in scope at POINT."
 158   (mapcar 'semantic-tag-name
 159           (semantic-find-tags-by-class
 160            'type (semantic-find-tag-by-overlay point))))
 161
 162 ;; Prototype handler
 163 ;;
 164 (defun semantic-java-prototype-function (tag &optional parent color)
 165   "Return a function (method) prototype for TAG.
 166 Optional argument PARENT is a parent (containing) item.
 167 Optional argument COLOR indicates that color should be mixed in.
 168 See also `semantic-format-tag-prototype'."
 169   (let ((name (semantic-tag-name tag))
 170         (type (semantic-java-type tag))
 171         (tmpl (semantic-tag-get-attribute tag :template-specifier))
 172         (args (semantic-tag-function-arguments tag))
 173         (argp "")
 174         arg argt)
 175     (while args
 176       (setq arg  (car args)
 177             args (cdr args))
 178       (if (semantic-tag-p arg)
 179           (setq argt (if color
 180                          (semantic--format-colorize-text
 181                           (semantic-java-type arg) 'type)
 182                        (semantic-java-type arg))
 183                 argp (concat argp argt (if args "," "")))))
 184     (when color
 185       (when type
 186         (setq type (semantic--format-colorize-text type 'type)))
 187       (setq name (semantic--format-colorize-text name 'function)))
 188     (concat (or tmpl "") (if tmpl " " "")
 189             (or type "") (if type " " "")
 190             name "(" argp ")")))
 191
 192 (defun semantic-java-prototype-variable (tag &optional parent color)
 193   "Return a variable (field) prototype for TAG.
 194 Optional argument PARENT is a parent (containing) item.
 195 Optional argument COLOR indicates that color should be mixed in.
 196 See also `semantic-format-tag-prototype'."
 197   (let ((name (semantic-tag-name tag))
 198         (type (semantic-java-type tag)))
 199     (concat (if color
 200                 (semantic--format-colorize-text type 'type)
 201               type)
 202             " "
 203             (if color
 204                 (semantic--format-colorize-text name 'variable)
 205               name))))
 206
 207 (defun semantic-java-prototype-type (tag &optional parent color)
 208   "Return a type (class/interface) prototype for TAG.
 209 Optional argument PARENT is a parent (containing) item.
 210 Optional argument COLOR indicates that color should be mixed in.
 211 See also `semantic-format-tag-prototype'."
 212   (let ((name (semantic-tag-name tag))
 213         (type (semantic-tag-type tag))
 214         (tmpl (semantic-tag-get-attribute tag :template-specifier)))
 215     (concat type " "
 216             (if color
 217                 (semantic--format-colorize-text name 'type)
 218               name)
 219             (or tmpl ""))))
 220
 221 (define-mode-local-override semantic-format-tag-prototype
 222   java-mode (tag &optional parent color)
 223   "Return a prototype for TOKEN.
 224 Optional argument PARENT is a parent (containing) item.
 225 Optional argument COLOR indicates that color should be mixed in."
 226   (let ((f (intern-soft (format "semantic-java-prototype-%s"
 227                                 (semantic-tag-class tag)))))
 228     (funcall (if (fboundp f)
 229                  f
 230                'semantic-format-tag-prototype-default)
 231              tag parent color)))
 232
 233 (semantic-alias-obsolete 'semantic-java-prototype-nonterminal
 234                          'semantic-format-tag-prototype-java-mode "23.2")
 235
 236 ;; Include Tag Name
 237 ;;
 238
 239 ;; Thanks Bruce Stephens
 240 (define-mode-local-override semantic-tag-include-filename java-mode (tag)
 241   "Return a suitable path for (some) Java imports."
 242   (let ((name (semantic-tag-name tag)))
 243     (concat (mapconcat 'identity (split-string name "\\.") "/") ".java")))
 244
 245
 246 ;; Documentation handler
 247 ;;
 248 (defsubst semantic-java-skip-spaces-backward ()
 249   "Move point backward, skipping Java whitespaces."
 250   (skip-chars-backward " \n\r\t"))
 251
 252 (defsubst semantic-java-skip-spaces-forward ()
 253   "Move point forward, skipping Java whitespaces."
 254   (skip-chars-forward " \n\r\t"))
 255
 256 (define-mode-local-override semantic-documentation-for-tag
 257   java-mode (&optional tag nosnarf)
 258   "Find documentation from TAG and return it as a clean string.
 259 Java have documentation set in a comment preceeding TAG's definition.
 260 Attempt to strip out comment syntactic sugar, unless optional argument
 261 NOSNARF is non-nil.
 262 If NOSNARF is 'lex, then return the semantic lex token."
 263   (when (or tag (setq tag (semantic-current-tag)))
 264     (with-current-buffer (semantic-tag-buffer tag)
 265       (save-excursion
 266         ;; Move the point at token start
 267         (goto-char (semantic-tag-start tag))
 268         (semantic-java-skip-spaces-forward)
 269         ;; If the point already at "/**" (this occurs after a doc fix)
 270         (if (looking-at "/\\*\\*")
 271             nil
 272           ;; Skip previous spaces
 273           (semantic-java-skip-spaces-backward)
 274           ;; Ensure point is after "*/" (javadoc block comment end)
 275           (condition-case nil
 276               (backward-char 2)
 277             (error nil))
 278           (when (looking-at "\\*/")
 279             ;; Move the point backward across the comment
 280             (forward-char 2)              ; return just after "*/"
 281             (forward-comment -1)          ; to skip the entire block
 282             ))
 283         ;; Verify the point is at "/**" (javadoc block comment start)
 284         (if (looking-at "/\\*\\*")
 285             (let ((p (point))
 286                   (c (semantic-doc-snarf-comment-for-tag 'lex)))
 287               (when c
 288                 ;; Verify that the token just following the doc
 289                 ;; comment is the current one!
 290                 (goto-char (semantic-lex-token-end c))
 291                 (semantic-java-skip-spaces-forward)
 292                 (when (eq tag (semantic-current-tag))
 293                   (goto-char p)
 294                   (semantic-doc-snarf-comment-for-tag nosnarf)))))
 295         ))))
 296 \f
 297 ;;; Javadoc facilities
 298 ;;
 299
 300 ;; Javadoc elements
 301 ;;
 302 (defvar semantic-java-doc-line-tags nil
 303   "Valid javadoc line tags.
 304 Ordered following Sun's Tag Convention at
 305 <http://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
 306
 307 (defvar semantic-java-doc-with-name-tags nil
 308   "Javadoc tags which have a name.")
 309
 310 (defvar semantic-java-doc-with-ref-tags nil
 311   "Javadoc tags which have a reference.")
 312
 313 ;; Optional javadoc tags by classes of semantic tag
 314 ;;
 315 (defvar semantic-java-doc-extra-type-tags nil
 316   "Optional tags used in class/interface documentation.
 317 Ordered following Sun's Tag Convention.")
 318
 319 (defvar semantic-java-doc-extra-function-tags nil
 320   "Optional tags used in method/constructor documentation.
 321 Ordered following Sun's Tag Convention.")
 322
 323 (defvar semantic-java-doc-extra-variable-tags nil
 324   "Optional tags used in field documentation.
 325 Ordered following Sun's Tag Convention.")
 326
 327 ;; All javadoc tags by classes of semantic tag
 328 ;;
 329 (defvar semantic-java-doc-type-tags nil
 330   "Tags allowed in class/interface documentation.
 331 Ordered following Sun's Tag Convention.")
 332
 333 (defvar semantic-java-doc-function-tags nil
 334   "Tags allowed in method/constructor documentation.
 335 Ordered following Sun's Tag Convention.")
 336
 337 (defvar semantic-java-doc-variable-tags nil
 338   "Tags allowed in field documentation.
 339 Ordered following Sun's Tag Convention.")
 340
 341 ;; Access to Javadoc elements
 342 ;;
 343 (defmacro semantic-java-doc-tag (name)
 344   "Return doc tag from NAME.
 345 That is @NAME."
 346   `(concat "@" ,name))
 347
 348 (defsubst semantic-java-doc-tag-name (tag)
 349   "Return name of the doc TAG symbol.
 350 That is TAG `symbol-name' without the leading '@'."
 351   (substring (symbol-name tag) 1))
 352
 353 (defun semantic-java-doc-keyword-before-p (k1 k2)
 354   "Return non-nil if javadoc keyword K1 is before K2."
 355   (let* ((t1   (semantic-java-doc-tag k1))
 356          (t2   (semantic-java-doc-tag k2))
 357          (seq1 (and (semantic-lex-keyword-p t1)
 358                     (plist-get (semantic-lex-keyword-get t1 'javadoc)
 359                                'seq)))
 360          (seq2 (and (semantic-lex-keyword-p t2)
 361                     (plist-get (semantic-lex-keyword-get t2 'javadoc)
 362                                'seq))))
 363     (if (and (numberp seq1) (numberp seq2))
 364         (<= seq1 seq2)
 365       ;; Unknown tags (probably custom ones) are always after official
 366       ;; ones and are not themselves ordered.
 367       (or (numberp seq1)
 368           (and (not seq1) (not seq2))))))
 369
 370 (defun semantic-java-doc-keywords-map (fun &optional property)
 371   "Run function FUN for each javadoc keyword.
 372 Return the list of FUN results.  If optional PROPERTY is non nil only
 373 call FUN for javadoc keywords which have a value for PROPERTY.  FUN
 374 receives two arguments: the javadoc keyword and its associated
 375 'javadoc property list.  It can return any value.  All nil values are
 376 removed from the result list."
 377   (delq nil
 378         (mapcar
 379          #'(lambda (k)
 380              (let* ((tag   (semantic-java-doc-tag k))
 381                     (plist (semantic-lex-keyword-get tag 'javadoc)))
 382                (if (or (not property) (plist-get plist property))
 383                    (funcall fun k plist))))
 384          semantic-java-doc-line-tags)))
 385
 386 \f
 387 ;;; Mode setup
 388 ;;
 389
 390 (defun semantic-java-doc-setup ()
 391   "Lazy initialization of javadoc elements."
 392   (or semantic-java-doc-line-tags
 393       (setq semantic-java-doc-line-tags
 394             (sort (mapcar #'semantic-java-doc-tag-name
 395                           (semantic-lex-keywords 'javadoc))
 396                   #'semantic-java-doc-keyword-before-p)))
 397
 398   (or semantic-java-doc-with-name-tags
 399       (setq semantic-java-doc-with-name-tags
 400             (semantic-java-doc-keywords-map
 401              #'(lambda (k p)
 402                  k)
 403              'with-name)))
 404
 405   (or semantic-java-doc-with-ref-tags
 406       (setq semantic-java-doc-with-ref-tags
 407             (semantic-java-doc-keywords-map
 408              #'(lambda (k p)
 409                  k)
 410              'with-ref)))
 411
 412   (or semantic-java-doc-extra-type-tags
 413       (setq semantic-java-doc-extra-type-tags
 414             (semantic-java-doc-keywords-map
 415              #'(lambda (k p)
 416                  (if (memq 'type (plist-get p 'usage))
 417                      k))
 418              'opt)))
 419
 420   (or semantic-java-doc-extra-function-tags
 421       (setq semantic-java-doc-extra-function-tags
 422             (semantic-java-doc-keywords-map
 423              #'(lambda (k p)
 424                  (if (memq 'function (plist-get p 'usage))
 425                      k))
 426              'opt)))
 427
 428   (or semantic-java-doc-extra-variable-tags
 429       (setq semantic-java-doc-extra-variable-tags
 430             (semantic-java-doc-keywords-map
 431              #'(lambda (k p)
 432                  (if (memq 'variable (plist-get p 'usage))
 433                      k))
 434              'opt)))
 435
 436   (or semantic-java-doc-type-tags
 437       (setq semantic-java-doc-type-tags
 438             (semantic-java-doc-keywords-map
 439              #'(lambda (k p)
 440                  (if (memq 'type (plist-get p 'usage))
 441                      k)))))
 442
 443   (or semantic-java-doc-function-tags
 444       (setq semantic-java-doc-function-tags
 445             (semantic-java-doc-keywords-map
 446              #'(lambda (k p)
 447                  (if (memq 'function (plist-get p 'usage))
 448                      k)))))
 449
 450   (or semantic-java-doc-variable-tags
 451       (setq semantic-java-doc-variable-tags
 452             (semantic-java-doc-keywords-map
 453              #'(lambda (k p)
 454                  (if (memq 'variable (plist-get p 'usage))
 455                      k)))))
 456
 457   )
 458
 459 (provide 'semantic/java)
 460
 461 ;;; semantic/java.el ends here