lisp/cedet/semantic/java.el

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