;;; semantic-java.el --- Semantic details for Java

;;; Copyright (C) 1999, 2000, 2001 David Ponce

;; Author: David Ponce <david@dponce.com>
;; X-RCS: $Id: semantic-java.el,v 1.1 2001/08/16 03:37:29 andyp Exp $

;; This file is not part of GNU Emacs.

;; semantic-java 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 2, or (at
;; your option) any later version.

;; This software 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; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:
;;
;; Setup the Semantic Bovinator for Java.  See also the grammar in
;; java.bnf.

;;; History:
;; 

;;; Code:
(require 'semantic)

(eval-when-compile
  (require 'semantic-ctxt)
  (require 'semantic-imenu)
  (require 'document)
  (require 'senator))

;; Generated parser table
(defvar semantic-toplevel-java-bovine-table
`((bovine-toplevel
 ( package_declaration)
 ( import_declaration)
 ( type_declaration)
 ) ; end bovine-toplevel
 (number
 ( symbol "[0-9]" punctuation "\\." symbol "[0-9Ee]" punctuation "[-+]" symbol "[0-9fFdD]")
 ( symbol "[0-9]" punctuation "\\." symbol "[0-9EefFdD]")
 ( symbol "[0-9fFdD]")
 ) ; end number
 (literal
 ( number)
 ( qualified_name)
 ( string)
 ) ; end literal
 (type
 ( reference_type
  ,(semantic-lambda
  (nth 0 vals)))
 ( primitive_type
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end type
 (primitive_type
 ( BOOLEAN)
 ( BYTE)
 ( SHORT)
 ( INT)
 ( LONG)
 ( CHAR)
 ( FLOAT)
 ( DOUBLE)
 ) ; end primitive_type
 (reference_type
 ( array_type
  ,(semantic-lambda
  (nth 0 vals)))
 ( qualified_name
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end reference_type
 (array_type
 ( primitive_type dims
  ,(semantic-lambda
  (list ( concat ( car (nth 0 vals)) ( car (nth 1 vals))))))
 ( qualified_name dims
  ,(semantic-lambda
  (list ( concat ( car (nth 0 vals)) ( car (nth 1 vals))))))
 ) ; end array_type
 (qualified_name
 ( symbol punctuation "\\." qualified_name
  ,(semantic-lambda
  (list ( concat (nth 0 vals) (nth 1 vals) ( car (nth 2 vals))))))
 ( symbol
  ,(semantic-lambda
  (list (nth 0 vals))))
 ) ; end qualified_name
 (package_declaration
 ( PACKAGE qualified_name punctuation ";"
  ,(semantic-lambda
  (nth 1 vals) (list 'package nil nil)))
 ) ; end package_declaration
 (import_declaration
 ( IMPORT qualified_name punctuation ";"
  ,(semantic-lambda
  (nth 1 vals) (list 'include nil nil)))
 ( IMPORT qualified_name punctuation "\\." punctuation "*" punctuation ";"
  ,(semantic-lambda
  (list ( concat ( car (nth 1 vals)) (nth 2 vals) (nth 3 vals)) 'include nil nil)))
 ) ; end import_declaration
 (type_declaration
 ( punctuation ";")
 ( class_declaration)
 ( interface_declaration)
 ) ; end type_declaration
 (modifiers_opt
 ( modifiers
  ,(semantic-lambda
  (nth 0 vals)))
 ()
 ) ; end modifiers_opt
 (modifiers
 ( modifier modifiers
  ,(semantic-lambda
  ( cons ( car (nth 0 vals)) (nth 1 vals))))
 ( modifier
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end modifiers
 (modifier
 ( PUBLIC)
 ( PROTECTED)
 ( PRIVATE)
 ( STATIC)
 ( ABSTRACT)
 ( FINAL)
 ( NATIVE)
 ( SYNCHRONIZED)
 ( TRANSIENT)
 ( VOLATILE)
 ( STRICTFP)
 ) ; end modifier
 (class_declaration
 ( modifiers_opt CLASS qualified_name class_parents class_body
  ,(semantic-lambda
  (nth 2 vals) (list 'type "class" (nth 4 vals) (nth 3 vals) ( semantic-bovinate-make-assoc-list 'typemodifiers (nth 0 vals)) nil)))
 ) ; end class_declaration
 (class_parents
 ( super interfaces
  ,(semantic-lambda
  ( append (nth 0 vals) (nth 1 vals))))
 ( interfaces super
  ,(semantic-lambda
  ( append (nth 1 vals) (nth 0 vals))))
 ( super
  ,(semantic-lambda
  (nth 0 vals)))
 ( interfaces
  ,(semantic-lambda
  ( cons nil (nth 0 vals))))
 ()
 ) ; end class_parents
 (super
 ( EXTENDS qualified_name
  ,(semantic-lambda
  (nth 1 vals)))
 ) ; end super
 (interfaces
 ( IMPLEMENTS qualified_name_list
  ,(semantic-lambda
  (nth 1 vals)))
 ) ; end interfaces
 (qualified_name_list
 ( qualified_name punctuation "," qualified_name_list
  ,(semantic-lambda
  ( cons ( car (nth 0 vals)) (nth 2 vals))))
 ( qualified_name
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end qualified_name_list
 (class_body
 ( semantic-list
  ,(semantic-lambda
 
 (semantic-bovinate-from-nonterminal-full (car (nth 0 vals)) (cdr (nth 0 vals)) 'class_body_declarations)
 ))
 ) ; end class_body
 (class_body_declarations
 ( class_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ( interface_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ( field_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ( method_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ( constructor_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end class_body_declarations
 (field_declaration
 ( modifiers_opt type variable_declarators punctuation ";"
  ,(semantic-lambda
  (nth 2 vals) (list 'variable) (nth 1 vals) (list nil ( semantic-bovinate-make-assoc-list 'typemodifiers (nth 0 vals)) nil)))
 ) ; end field_declaration
 (field_declaration_multi
 ( modifiers_opt type variable_declarator punctuation ","
  ,(semantic-lambda
  (nth 2 vals)))
 ( modifiers_opt type variable_declarator punctuation ";"
  ,(semantic-lambda
  (nth 2 vals)))
 ( variable_declarator punctuation ","
  ,(semantic-lambda
  (nth 0 vals)))
 ( variable_declarator punctuation ";"
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end field_declaration_multi
 (variable_declarators
 ( variable_declarator variable_declarators_opt
  ,(semantic-lambda
  (list ( cons ( car (nth 0 vals)) ( car (nth 1 vals))))))
 ) ; end variable_declarators
 (variable_declarators_opt
 ( punctuation "," variable_declarators
  ,(semantic-lambda
  (nth 1 vals)))
 ()
 ) ; end variable_declarators_opt
 (variable_declarator
 ( variable_declarator_id variable_assign_opt
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end variable_declarator
 (variable_assign_opt
 ( punctuation "=" variable_initializer)
 ()
 ) ; end variable_assign_opt
 (variable_declarator_id
 ( symbol dims
  ,(semantic-lambda
  (list ( concat (nth 0 vals) ( car (nth 1 vals))))))
 ( symbol
  ,(semantic-lambda
  (list (nth 0 vals))))
 ) ; end variable_declarator_id
 (variable_initializer
 ( array_initializer)
 ( expression)
 ) ; end variable_initializer
 (method_declaration
 ( method_header method_body
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end method_declaration
 (method_header
 ( modifiers_opt method_type symbol formal_parameter_list_opt throws_opt
  ,(semantic-lambda
  (list (nth 2 vals) 'function) (nth 1 vals) (list (nth 3 vals) ( semantic-bovinate-make-assoc-list 'typemodifiers (nth 0 vals) 'throws (nth 4 vals)) nil)))
 ) ; end method_header
 (method_type
 ( VOID
  ,(semantic-lambda
  (list (nth 0 vals))))
 ( type
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end method_type
 (formal_parameter_list_opt
 ( semantic-list
  ,(semantic-lambda
 
 (semantic-bovinate-from-nonterminal-full (car (nth 0 vals)) (cdr (nth 0 vals)) 'formal_parameter_list)
 ))
 ()
 ) ; end formal_parameter_list_opt
 (formal_parameter_list
 ( formal_parameter punctuation ","
  ,(semantic-lambda
  (nth 0 vals)))
 ( formal_parameter
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end formal_parameter_list
 (formal_parameter-modifier
 ( FINAL)
 ()
 ) ; end formal_parameter-modifier
 (formal_parameter
 ( formal_parameter-modifier type variable_declarator_id
  ,(semantic-lambda
  (nth 2 vals) (list 'variable) (nth 1 vals) (list nil ( semantic-bovinate-make-assoc-list 'typemodifiers (nth 0 vals)) nil)))
 ) ; end formal_parameter
 (throws_opt
 ( throws
  ,(semantic-lambda
  (nth 0 vals)))
 ()
 ) ; end throws_opt
 (throws
 ( THROWS qualified_name_list
  ,(semantic-lambda
  (nth 1 vals)))
 ) ; end throws
 (method_body
 ( punctuation ";")
 ( block)
 ) ; end method_body
 (constructor_declaration
 ( modifiers_opt symbol formal_parameter_list_opt throws_opt constructor_body
  ,(semantic-lambda
  (list (nth 1 vals) 'function nil (nth 2 vals) ( semantic-bovinate-make-assoc-list 'typemodifiers (nth 0 vals) 'throws (nth 3 vals)) nil)))
 ) ; end constructor_declaration
 (constructor_body
 ( block)
 ) ; end constructor_body
 (interface_declaration
 ( modifiers_opt INTERFACE symbol interface_parents interface_body
  ,(semantic-lambda
  (list (nth 2 vals) 'type "interface" (nth 4 vals) (nth 3 vals) ( semantic-bovinate-make-assoc-list 'typemodifiers (nth 0 vals)) nil)))
 ) ; end interface_declaration
 (interface_parents
 ( EXTENDS qualified_name_list
  ,(semantic-lambda
  (nth 1 vals)))
 ()
 ) ; end interface_parents
 (interface_body
 ( semantic-list
  ,(semantic-lambda
 
 (semantic-bovinate-from-nonterminal-full (car (nth 0 vals)) (cdr (nth 0 vals)) 'interface_body_declarations)
 ))
 ) ; end interface_body
 (interface_body_declarations
 ( class_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ( interface_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ( method_header punctuation ";"
  ,(semantic-lambda
  (nth 0 vals)))
 ( field_declaration
  ,(semantic-lambda
  (nth 0 vals)))
 ) ; end interface_body_declarations
 (array_initializer
 ( semantic-list "\\`{")
 ) ; end array_initializer
 (block
 ( semantic-list "\\`{")
 ) ; end block
 (primary
 ( array_creation_expression)
 ( primary_no_new_array primary_dim_opt)
 ) ; end primary
 (primary_dim_opt
 ( semantic-list "\\`\\[")
 ()
 ) ; end primary_dim_opt
 (primary_no_new_array
 ( qualified_name semantic-list "\\`(")
 ( class_instance_creation_expression)
 ( semantic-list "\\`(")
 ( array_type punctuation "\\." CLASS)
 ( literal)
 ) ; end primary_no_new_array
 (class_instance_creation_expression
 ( NEW qualified_name semantic-list "\\`(" semantic-list "\\`{")
 ( NEW qualified_name semantic-list "\\`(")
 ) ; end class_instance_creation_expression
 (array_creation_expression
 ( NEW array_type array_initializer)
 ( NEW array_type)
 ) ; end array_creation_expression
 (dims_opt
 ( dims
  ,(semantic-lambda
  (nth 0 vals)))
 (
  ,(semantic-lambda
  (list nil)))
 ) ; end dims_opt
 (dims
 ( semantic-list "\\`\\[" dims_opt
  ,(semantic-lambda
  (list ( concat "[]" ( car (nth 1 vals))))))
 ) ; end dims
 (field_access
 ( primary punctuation "\\." symbol)
 ( qualified_name)
 ) ; end field_access
 (postfix_expression
 ( primary postfix_operator_opt)
 ) ; end postfix_expression
 (postfix_operator_opt
 ( punctuation "[-+]" punctuation "[-+]")
 ()
 ) ; end postfix_operator_opt
 (unary_expression
 ( punctuation "[-+^!]" unary_expression)
 ( punctuation "[-+]" punctuation "[-+]" unary_expression)
 ( semantic-list "\\`(" unary_expression)
 ( postfix_expression)
 ) ; end unary_expression
 (operator
 ( punctuation "[-+*/%=<>^~&|!?:.]")
 ( INSTANCEOF)
 ) ; end operator
 (operators
 ( operator operators)
 ( operator)
 ) ; end operators
 (operators_expression_opt
 ( operators expression)
 ()
 ) ; end operators_expression_opt
 (expression
 ( unary_expression operators_expression_opt)
 ) ; end expression
 )
              "Java language specification.")

;; Generated keyword table
(defvar semantic-java-keyword-table
  (semantic-flex-make-keyword-table 
   `( ("abstract" . ABSTRACT)
      ("boolean" . BOOLEAN)
      ("break" . BREAK)
      ("byte" . BYTE)
      ("case" . CASE)
      ("catch" . CATCH)
      ("char" . CHAR)
      ("class" . CLASS)
      ("const" . CONST)
      ("continue" . CONTINUE)
      ("default" . DEFAULT)
      ("do" . DO)
      ("double" . DOUBLE)
      ("else" . ELSE)
      ("extends" . EXTENDS)
      ("final" . FINAL)
      ("finally" . FINALLY)
      ("float" . FLOAT)
      ("for" . FOR)
      ("goto" . GOTO)
      ("if" . IF)
      ("implements" . IMPLEMENTS)
      ("import" . IMPORT)
      ("instanceof" . INSTANCEOF)
      ("int" . INT)
      ("interface" . INTERFACE)
      ("long" . LONG)
      ("native" . NATIVE)
      ("new" . NEW)
      ("package" . PACKAGE)
      ("private" . PRIVATE)
      ("protected" . PROTECTED)
      ("public" . PUBLIC)
      ("return" . RETURN)
      ("short" . SHORT)
      ("static" . STATIC)
      ("strictfp" . STRICTFP)
      ("super" . SUPER)
      ("switch" . SWITCH)
      ("synchronized" . SYNCHRONIZED)
      ("this" . THIS)
      ("throw" . THROW)
      ("throws" . THROWS)
      ("transient" . TRANSIENT)
      ("try" . TRY)
      ("void" . VOID)
      ("volatile" . VOLATILE)
      ("while" . WHILE)
      ("author" . AUTHOR)
      ("version" . VERSION)
      ("param" . PARAM)
      ("exception" . EXCEPTION)
      ("see" . SEE)
      ("since" . SINCE)
      ("serial" . SERIAL)
      ("serialData" . SERIALDATA)
      ("serialField" . SERIALFIELD)
      ("deprecated" . DEPRECATED)
      )
   '(
     ("abstract" summary "Class|Method declaration modifier: abstract {class|<type>} <name> ...")
     ("boolean" summary "Primitive logical quantity type (true or false)")
     ("break" summary "break [<label>] ;")
     ("byte" summary "Integral primitive type (-128 to 127)")
     ("case" summary "switch(<expr>) {case <const-expr>: <stmts> ... }")
     ("catch" summary "try {<stmts>} catch(<parm>) {<stmts>} ... ")
     ("char" summary "Integral primitive type ('\u0000' to '\uffff') (0 to 65535)")
     ("class" summary "Class declaration: class <name>")
     ("const" summary "Unused reserved word")
     ("continue" summary "continue [<label>] ;")
     ("default" summary "switch(<expr>) { ... default: <stmts>}")
     ("do" summary "do <stmt> while (<expr>);")
     ("double" summary "Primitive floating-point type (double-precision 64-bit IEEE 754)")
     ("else" summary "if (<expr>) <stmt> else <stmt>")
     ("extends" summary "SuperClass|SuperInterfaces declaration: extends <name> [, ...]")
     ("final" summary "Class|Member declaration modifier: final {class|<type>} <name> ...")
     ("finally" summary "try {<stmts>} ... finally {<stmts>}")
     ("float" summary "Primitive floating-point type (single-precision 32-bit IEEE 754)")
     ("for" summary "for ([<init-expr>]; [<expr>]; [<update-expr>]) <stmt>")
     ("goto" summary "Unused reserved word")
     ("if" summary "if (<expr>) <stmt> [else <stmt>]")
     ("implements" summary "Class SuperInterfaces declaration: implements <name> [, ...]")
     ("import" summary "Import package declarations: import <package>")
     ("int" summary "Integral primitive type (-2147483648 to 2147483647)")
     ("interface" summary "Interface declaration: interface <name>")
     ("long" summary "Integral primitive type (-9223372036854775808 to 9223372036854775807)")
     ("native" summary "Method declaration modifier: native <type> <name> ...")
     ("package" summary "Package declaration: package <name>")
     ("private" summary "Access level modifier: private {class|interface|<type>} <name> ...")
     ("protected" summary "Access level modifier: protected {class|interface|<type>} <name> ...")
     ("public" summary "Access level modifier: public {class|interface|<type>} <name> ...")
     ("return" summary "return [<expr>] ;")
     ("short" summary "Integral primitive type (-32768 to 32767)")
     ("static" summary "Declaration modifier: static {class|interface|<type>} <name> ...")
     ("strictfp" summary "Declaration modifier: strictfp {class|interface|<type>} <name> ...")
     ("switch" summary "switch(<expr>) {[case <const-expr>: <stmts> ...] [default: <stmts>]}")
     ("synchronized" summary "synchronized (<expr>) ... | Method decl. modifier: synchronized <type> <name> ...")
     ("throw" summary "throw <expr> ;")
     ("throws" summary "Method|Constructor declaration: throws <classType>, ...")
     ("transient" summary "Field declaration modifier: transient <type> <name> ...")
     ("try" summary "try {<stmts>} [catch(<parm>) {<stmts>} ...] [finally {<stmts>}]")
     ("void" summary "Method return type: void <name> ...")
     ("volatile" summary "Field declaration modifier: volatile <type> <name> ...")
     ("while" summary "while (<expr>) <stmt> | do <stmt> while (<expr>);")
     ("author" javadoc (seq 1 usage (type)))
     ("version" javadoc (seq 2 usage (type)))
     ("param" javadoc (seq 3 usage (function) with-name t))
     ("return" javadoc (seq 4 usage (function)))
     ("exception" javadoc (seq 5 usage (function) with-name t))
     ("throws" javadoc (seq 6 usage (function) with-name t))
     ("see" javadoc (seq 7 usage (type function variable) opt t with-ref t))
     ("since" javadoc (seq 8 usage (type function variable) opt t))
     ("serial" javadoc (seq 9 usage (variable) opt t))
     ("serialData" javadoc (seq 10 usage (function) opt t))
     ("serialField" javadoc (seq 11 usage (variable) opt t))
     ("deprecated" javadoc (seq 12 usage (type function variable) opt t))
     ))
  "Java keywords.")

;;;;
;;;; Prototype handler
;;;;

(defun semantic-java-prototype-function (token &optional parent color)
  "Return a function (method) prototype for TOKEN.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
See also `semantic-java-prototype-nonterminal'."
  (let ((name (semantic-token-name token))
        (type (semantic-token-type token))
        (args (semantic-token-function-args token))
        (argp "")
        arg argt)
    (while args
      (setq arg  (car args)
            args (cdr args))
      (if (semantic-token-p arg)
          (setq argt (if color
                         (semantic-colorize-text
                          (semantic-token-type arg) 'type)
                       (semantic-token-type arg))
                argp (concat argp argt (if args "," "")))))
    (if color
        (progn
          (if type
              (setq type (semantic-colorize-text type 'type)))
          (setq name (semantic-colorize-text name 'function))))
    (concat (or type "") (if type " " "") name "(" argp ")")))

(defun semantic-java-prototype-variable (token &optional parent color)
  "Return a variable (field) prototype for TOKEN.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
See also `semantic-java-prototype-nonterminal'."
  (concat (if color
              (semantic-colorize-text
               (semantic-token-type token) 'type)
            (semantic-token-type token))
          " "
          (if color
              (semantic-colorize-text
               (semantic-token-name token) 'variable)
            (semantic-token-name token))))

(defun semantic-java-prototype-type (token &optional parent color)
  "Return a type (class/interface) prototype for TOKEN.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in.
See also `semantic-java-prototype-nonterminal'."
  (concat (semantic-token-type token)
          " "
          (if color
              (semantic-colorize-text
               (semantic-token-name token) 'type)
            (semantic-token-name token))))

(defun semantic-java-prototype-nonterminal (token &optional parent color)
  "Return a prototype for TOKEN.
Override `semantic-prototype-nonterminal'.
Optional argument PARENT is a parent (containing) item.
Optional argument COLOR indicates that color should be mixed in."
  (let ((fprot (intern-soft
                (format "semantic-java-prototype-%s"
                        (semantic-token-token token)))))
    (if (fboundp fprot)
        (funcall fprot token parent color)
      (semantic-prototype-nonterminal-default token parent color))))

;;;;
;;;; Specific nonterminal handler
;;;;

(defun semantic-expand-java-nonterminal (token)
  "Expand TOKEN into a list of equivalent nonterminals, or nil.
Handle multiple variable declarations in the same statement."
  (if (eq (semantic-token-token token) 'variable)
      (let ((name (semantic-token-name token)))
        (if (listp name)
            (let ((multi (cdr name)))
              
              ;; Always replace the list of variable names by the first
              ;; name to get a valid token!  There is nothing more to
              ;; do if there is only one variable in the list.
              (setcar token (car name))
              
              (if multi
                  ;; There are multiple names in the same variable
                  ;; declaration.
                  (let ((ty (semantic-token-type                 token))
                        (dv (semantic-token-variable-default     token))
                        (xs (semantic-token-variable-extra-specs token))
                        (ds (semantic-token-docstring            token))
                        (pr (semantic-token-properties           token))
                        ;; Reparse the declaration using the special
                        ;; nonterminal 'field_declaration_multi to get
                        ;; the START/END values of each variable.
                        (nl (semantic-bovinate-from-nonterminal-full
                             (semantic-token-start token)
                             (semantic-token-end   token)
                             'field_declaration_multi
                             0))
                        tok vl)
                    ;; Merge in new 'variable tokens each reparsed
                    ;; token name and overlay with other values from
                    ;; the initial token.
                    (while nl
                      (setq tok (car nl)
                            nl  (cdr nl)
                            vl  (cons
                                 (list
                                  (semantic-token-name tok)
                                  'variable
                                  ty    ; type
                                  dv    ; default value
                                  xs    ; extra specs
                                  ds    ; docstring
                                  pr    ; properties
                                  (semantic-token-overlay tok))
                                 vl)))
                    (if vl
                        ;; Cleanup the no more needed initial token.
                        (semantic-deoverlay-token token))
                    vl)))))))

;;;;
;;;; Javadoc 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"))

(defun semantic-java-find-documentation (&optional token nosnarf)
  "Find documentation from TOKEN and return it as a clean string.
Java have documentation set in a comment preceeding TOKEN's
definition.  Optional argument NOSNARF means to only return the flex
token for it.  If NOSNARF is 'flex, then only return the flex token.
Override `semantic-find-documentation'."
  (if (or token (setq token (semantic-current-nonterminal)))
      (save-excursion
        (set-buffer (semantic-token-buffer token))
        ;; Move the point at token start
        (goto-char (semantic-token-start token))
        (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-find-doc-snarf-comment 'flex)))
              (when c
                ;; Verify that the token just following the doc
                ;; comment is the current one!
                (goto-char (semantic-flex-end c))
                (semantic-java-skip-spaces-forward)
                (when (eq token (semantic-current-nonterminal))
                  (goto-char p)
                  (semantic-find-doc-snarf-comment nosnarf))))))))

;;;;
;;;; Javadoc elements
;;;;

(defvar semantic-java-doc-line-tags nil
  "Valid javadoc line tags.
Ordered following Sun's Tag Convention at
<http://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 token category
;;
(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 token category
;;
(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.")

(defun semantic-java-doc-keyword-before-p (k1 k2)
  "Return non-nil if javadoc keyword K1 is before K2."
  (let ((seq1 (and (semantic-flex-keyword-p k1)
                   (plist-get (semantic-flex-keyword-get k1 'javadoc)
                              'seq)))
        (seq2 (and (semantic-flex-keyword-p k2)
                   (plist-get (semantic-flex-keyword-get k2 '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 keyword which have a value for PROPERTY.  FUN
receives two arguments: the javadoc keyword and its associated
'javadoc property list. It can return any value.  Nil values are
removed from the result list."
  (delq nil
        (mapcar
         #'(lambda (k)
             (let ((plist (semantic-flex-keyword-get k 'javadoc)))
               (if (or (not property) (plist-get plist property))
                   (funcall fun k plist))))
         semantic-java-doc-line-tags)))

(defun semantic-java-doc-setup ()
  "Lazy initialization of javadoc elements."
  (or semantic-java-doc-line-tags
      (setq semantic-java-doc-line-tags
            (sort (mapcar #'symbol-name
                          (semantic-flex-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)))))
  
  )

;;;;
;;;; Mode Hook
;;;;

(defun semantic-default-java-setup ()
  "Set up a buffer for semantic parsing of the Java language."

  ;; semantic overloaded functions
  (semantic-install-function-overrides
   '((prototype-nonterminal . semantic-java-prototype-nonterminal)
     (find-documentation    . semantic-java-find-documentation))
   t ;; They can be changed in mode hook by more specific ones
   )

  ;; Code generated from java.bnf
  (setq semantic-toplevel-bovine-table semantic-toplevel-java-bovine-table
        semantic-toplevel-bovine-table-source "java.bnf")
  (setq semantic-flex-keywords-obarray semantic-java-keyword-table)
  (progn
    (setq
     ;; Java is case sensitive
     semantic-case-fold nil
     ;; special handling of multiple variable declarations/statement
     semantic-expand-nonterminal 'semantic-expand-java-nonterminal
     ;; function to use when creating items in imenu
     semantic-imenu-summary-function 'semantic-prototype-nonterminal
     ;; function to use for creating the imenu
     imenu-create-index-function 'semantic-create-imenu-index
     ;; Character used to separation a parent/child relationship
     semantic-type-relation-separator-character '(".")
     semantic-command-separation-character ";"
     document-comment-start "/**"
     document-comment-line-prefix " *"
     document-comment-end " */"
     ;; speedbar and imenu buckets name
     semantic-symbol->name-assoc-list '((type     . "Classes")
                                        (variable . "Variables")
                                        (function . "Methods")
                                        (include  . "Imports")
                                        (package  . "Package"))
     ;; Semantic navigation inside 'type children
     senator-step-at-token-ids '(function variable)
     )
    ;; Needed by `semantic-find-doc-snarf-comment'.
    (set (make-local-variable 'block-comment-end) "\\s-*\\*/")
    )
 
  ;; End code generated from java.bnf

  (semantic-java-doc-setup)
 )

(add-hook 'java-mode-hook 'semantic-default-java-setup)

(provide 'semantic-java)

;;; semantic-java.el ends here
