cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/bovine/semantic-java.el

   1 ;;; semantic-java.el --- Semantic functions for Java
   2
   3 ;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
   4 ;;;   David Ponce
   5
   6 ;; Author: David Ponce <david@dponce.com>
   7 ;; X-RCS: $Id: semantic-java.el,v 1.1 2007-11-26 15:11:56 michaels Exp $
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; semantic-java is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This software is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Common function for Java parsers.
  29
  30 ;;; History:
  31 ;;
  32
  33 ;;; Code:
  34 (require 'semantic)
  35 (require 'semantic-ctxt)
  36 (require 'semantic-doc)
  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
 149 ;; Local context
 150 ;;
 151 (define-mode-local-override semantic-ctxt-scoped-types
 152   java-mode (&optional point)
 153   "Return a list of type names currently in scope at POINT."
 154   (mapcar 'semantic-tag-name
 155           (semantic-find-tags-by-class
 156            'type (semantic-find-tag-by-overlay point))))
 157
 158 ;; Prototype handler
 159 ;;
 160 (defun semantic-java-prototype-function (tag &optional parent color)
 161   "Return a function (method) prototype for TAG.
 162 Optional argument PARENT is a parent (containing) item.
 163 Optional argument COLOR indicates that color should be mixed in.
 164 See also `semantic-format-prototype-tag'."
 165   (let ((name (semantic-tag-name tag))
 166         (type (semantic-java-type tag))
 167         (tmpl (semantic-tag-get-attribute tag :template-specifier))
 168         (args (semantic-tag-function-arguments tag))
 169         (argp "")
 170         arg argt)
 171     (while args
 172       (setq arg  (car args)
 173             args (cdr args))
 174       (if (semantic-tag-p arg)
 175           (setq argt (if color
 176                          (semantic--format-colorize-text
 177                           (semantic-java-type arg) 'type)
 178                        (semantic-java-type arg))
 179                 argp (concat argp argt (if args "," "")))))
 180     (when color
 181       (when type
 182         (setq type (semantic--format-colorize-text type 'type)))
 183       (setq name (semantic--format-colorize-text name 'function)))
 184     (concat (or tmpl "") (if tmpl " " "")
 185             (or type "") (if type " " "")
 186             name "(" argp ")")))
 187
 188 (defun semantic-java-prototype-variable (tag &optional parent color)
 189   "Return a variable (field) prototype for TAG.
 190 Optional argument PARENT is a parent (containing) item.
 191 Optional argument COLOR indicates that color should be mixed in.
 192 See also `semantic-format-prototype-tag'."
 193   (let ((name (semantic-tag-name tag))
 194         (type (semantic-java-type tag)))
 195     (concat (if color
 196                 (semantic--format-colorize-text type 'type)
 197               type)
 198             " "
 199             (if color
 200                 (semantic--format-colorize-text name 'variable)
 201               name))))
 202
 203 (defun semantic-java-prototype-type (tag &optional parent color)
 204   "Return a type (class/interface) prototype for TAG.
 205 Optional argument PARENT is a parent (containing) item.
 206 Optional argument COLOR indicates that color should be mixed in.
 207 See also `semantic-format-prototype-tag'."
 208   (let ((name (semantic-tag-name tag))
 209         (type (semantic-tag-type tag))
 210         (tmpl (semantic-tag-get-attribute tag :template-specifier)))
 211     (concat type " "
 212             (if color
 213                 (semantic--format-colorize-text name 'type)
 214               name)
 215             (or tmpl ""))))
 216
 217 (define-mode-local-override semantic-format-prototype-tag
 218   java-mode (tag &optional parent color)
 219   "Return a prototype for TOKEN.
 220 Optional argument PARENT is a parent (containing) item.
 221 Optional argument COLOR indicates that color should be mixed in."
 222   (let ((f (intern-soft (format "semantic-java-prototype-%s"
 223                                 (semantic-tag-class tag)))))
 224     (funcall (if (fboundp f)
 225                  f
 226                'semantic-format-tag-prototype-default)
 227              tag parent color)))
 228
 229 (semantic-alias-obsolete 'semantic-java-prototype-nonterminal
 230                          'semantic-format-prototype-tag-java-mode)
 231
 232 ;; Documentation handler
 233 ;;
 234 (defsubst semantic-java-skip-spaces-backward ()
 235   "Move point backward, skipping Java whitespaces."
 236   (skip-chars-backward " \n\r\t"))
 237
 238 (defsubst semantic-java-skip-spaces-forward ()
 239   "Move point forward, skipping Java whitespaces."
 240   (skip-chars-forward " \n\r\t"))
 241
 242 (define-mode-local-override semantic-documentation-for-tag
 243   java-mode (&optional tag nosnarf)
 244   "Find documentation from TAG and return it as a clean string.
 245 Java have documentation set in a comment preceeding TAG's definition.
 246 Attempt to strip out comment syntactic sugar, unless optional argument
 247 NOSNARF is non-nil.
 248 If NOSNARF is 'lex, then return the semantic lex token."
 249   (when (or tag (setq tag (semantic-current-tag)))
 250     (with-current-buffer (semantic-tag-buffer tag)
 251       (save-excursion
 252         ;; Move the point at token start
 253         (goto-char (semantic-tag-start tag))
 254         (semantic-java-skip-spaces-forward)
 255         ;; If the point already at "/**" (this occurs after a doc fix)
 256         (if (looking-at "/\\*\\*")
 257             nil
 258           ;; Skip previous spaces
 259           (semantic-java-skip-spaces-backward)
 260           ;; Ensure point is after "*/" (javadoc block comment end)
 261           (condition-case nil
 262               (backward-char 2)
 263             (error nil))
 264           (when (looking-at "\\*/")
 265             ;; Move the point backward across the comment
 266             (forward-char 2)              ; return just after "*/"
 267             (forward-comment -1)          ; to skip the entire block
 268             ))
 269         ;; Verify the point is at "/**" (javadoc block comment start)
 270         (if (looking-at "/\\*\\*")
 271             (let ((p (point))
 272                   (c (semantic-doc-snarf-comment-for-tag 'lex)))
 273               (when c
 274                 ;; Verify that the token just following the doc
 275                 ;; comment is the current one!
 276                 (goto-char (semantic-lex-token-end c))
 277                 (semantic-java-skip-spaces-forward)
 278                 (when (eq tag (semantic-current-tag))
 279                   (goto-char p)
 280                   (semantic-doc-snarf-comment-for-tag nosnarf)))))
 281         ))))
 282 \f
 283 ;;; Javadoc facilities
 284 ;;
 285
 286 ;; Javadoc elements
 287 ;;
 288 (defvar semantic-java-doc-line-tags nil
 289   "Valid javadoc line tags.
 290 Ordered following Sun's Tag Convention at
 291 <http://java.sun.com/products/jdk/javadoc/writingdoccomments/index.html>")
 292
 293 (defvar semantic-java-doc-with-name-tags nil
 294   "Javadoc tags which have a name.")
 295
 296 (defvar semantic-java-doc-with-ref-tags nil
 297   "Javadoc tags which have a reference.")
 298
 299 ;; Optional javadoc tags by classes of semantic tag
 300 ;;
 301 (defvar semantic-java-doc-extra-type-tags nil
 302   "Optional tags used in class/interface documentation.
 303 Ordered following Sun's Tag Convention.")
 304
 305 (defvar semantic-java-doc-extra-function-tags nil
 306   "Optional tags used in method/constructor documentation.
 307 Ordered following Sun's Tag Convention.")
 308
 309 (defvar semantic-java-doc-extra-variable-tags nil
 310   "Optional tags used in field documentation.
 311 Ordered following Sun's Tag Convention.")
 312
 313 ;; All javadoc tags by classes of semantic tag
 314 ;;
 315 (defvar semantic-java-doc-type-tags nil
 316   "Tags allowed in class/interface documentation.
 317 Ordered following Sun's Tag Convention.")
 318
 319 (defvar semantic-java-doc-function-tags nil
 320   "Tags allowed in method/constructor documentation.
 321 Ordered following Sun's Tag Convention.")
 322
 323 (defvar semantic-java-doc-variable-tags nil
 324   "Tags allowed in field documentation.
 325 Ordered following Sun's Tag Convention.")
 326
 327 ;; Access to Javadoc elements
 328 ;;
 329 (defmacro semantic-java-doc-tag (name)
 330   "Return doc tag from NAME.
 331 That is @NAME."
 332   `(concat "@" ,name))
 333
 334 (defsubst semantic-java-doc-tag-name (tag)
 335   "Return name of the doc TAG symbol.
 336 That is TAG `symbol-name' without the leading '@'."
 337   (substring (symbol-name tag) 1))
 338
 339 (defun semantic-java-doc-keyword-before-p (k1 k2)
 340   "Return non-nil if javadoc keyword K1 is before K2."
 341   (let* ((t1   (semantic-java-doc-tag k1))
 342          (t2   (semantic-java-doc-tag k2))
 343          (seq1 (and (semantic-lex-keyword-p t1)
 344                     (plist-get (semantic-lex-keyword-get t1 'javadoc)
 345                                'seq)))
 346          (seq2 (and (semantic-lex-keyword-p t2)
 347                     (plist-get (semantic-lex-keyword-get t2 'javadoc)
 348                                'seq))))
 349     (if (and (numberp seq1) (numberp seq2))
 350         (<= seq1 seq2)
 351       ;; Unknown tags (probably custom ones) are always after official
 352       ;; ones and are not themselves ordered.
 353       (or (numberp seq1)
 354           (and (not seq1) (not seq2))))))
 355
 356 (defun semantic-java-doc-keywords-map (fun &optional property)
 357   "Run function FUN for each javadoc keyword.
 358 Return the list of FUN results.  If optional PROPERTY is non nil only
 359 call FUN for javadoc keyword which have a value for PROPERTY.  FUN
 360 receives two arguments: the javadoc keyword and its associated
 361 'javadoc property list. It can return any value.  Nil values are
 362 removed from the result list."
 363   (delq nil
 364         (mapcar
 365          #'(lambda (k)
 366              (let* ((tag   (semantic-java-doc-tag k))
 367                     (plist (semantic-lex-keyword-get tag 'javadoc)))
 368                (if (or (not property) (plist-get plist property))
 369                    (funcall fun k plist))))
 370          semantic-java-doc-line-tags)))
 371
 372 \f
 373 ;;; Mode setup
 374 ;;
 375
 376 (defun semantic-java-doc-setup ()
 377   "Lazy initialization of javadoc elements."
 378   (or semantic-java-doc-line-tags
 379       (setq semantic-java-doc-line-tags
 380             (sort (mapcar #'semantic-java-doc-tag-name
 381                           (semantic-lex-keywords 'javadoc))
 382                   #'semantic-java-doc-keyword-before-p)))
 383
 384   (or semantic-java-doc-with-name-tags
 385       (setq semantic-java-doc-with-name-tags
 386             (semantic-java-doc-keywords-map
 387              #'(lambda (k p)
 388                  k)
 389              'with-name)))
 390
 391   (or semantic-java-doc-with-ref-tags
 392       (setq semantic-java-doc-with-ref-tags
 393             (semantic-java-doc-keywords-map
 394              #'(lambda (k p)
 395                  k)
 396              'with-ref)))
 397
 398   (or semantic-java-doc-extra-type-tags
 399       (setq semantic-java-doc-extra-type-tags
 400             (semantic-java-doc-keywords-map
 401              #'(lambda (k p)
 402                  (if (memq 'type (plist-get p 'usage))
 403                      k))
 404              'opt)))
 405
 406   (or semantic-java-doc-extra-function-tags
 407       (setq semantic-java-doc-extra-function-tags
 408             (semantic-java-doc-keywords-map
 409              #'(lambda (k p)
 410                  (if (memq 'function (plist-get p 'usage))
 411                      k))
 412              'opt)))
 413
 414   (or semantic-java-doc-extra-variable-tags
 415       (setq semantic-java-doc-extra-variable-tags
 416             (semantic-java-doc-keywords-map
 417              #'(lambda (k p)
 418                  (if (memq 'variable (plist-get p 'usage))
 419                      k))
 420              'opt)))
 421
 422   (or semantic-java-doc-type-tags
 423       (setq semantic-java-doc-type-tags
 424             (semantic-java-doc-keywords-map
 425              #'(lambda (k p)
 426                  (if (memq 'type (plist-get p 'usage))
 427                      k)))))
 428
 429   (or semantic-java-doc-function-tags
 430       (setq semantic-java-doc-function-tags
 431             (semantic-java-doc-keywords-map
 432              #'(lambda (k p)
 433                  (if (memq 'function (plist-get p 'usage))
 434                      k)))))
 435
 436   (or semantic-java-doc-variable-tags
 437       (setq semantic-java-doc-variable-tags
 438             (semantic-java-doc-keywords-map
 439              #'(lambda (k p)
 440                  (if (memq 'variable (plist-get p 'usage))
 441                      k)))))
 442
 443   )
 444
 445 (provide 'semantic-java)
 446
 447 ;;; semantic-java.el ends here