From: Chong Yidong Date: Sun, 6 Sep 2009 02:18:37 +0000 (+0000) Subject: lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory. X-Git-Tag: emacs-pretest-23.1.90~1091^2~52 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=6ca2fce3b8d345e619694f64c99013574000d0b3;p=emacs.git lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory. --- diff --git a/lisp/cedet/semantic/bovine/java.el b/lisp/cedet/semantic/bovine/java.el deleted file mode 100644 index 1d01eb887f6..00000000000 --- a/lisp/cedet/semantic/bovine/java.el +++ /dev/null @@ -1,465 +0,0 @@ -;;; semantic/bovine/java.el --- Semantic functions for Java - -;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, -;;; 2007, 2008, 2009 Free Software Foundation, Inc. - -;; Author: David Ponce - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs 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. If not, see . - -;;; Commentary: -;; -;; Common function for Java parsers. - -;;; History: -;; - -;;; Code: -(require 'semantic) -(require 'semantic/ctxt) -(require 'semantic/doc) -(require 'semantic/format) - -(eval-when-compile - (require 'semantic/find) - (require 'semantic/dep)) - - -;;; Lexical analysis -;; -(defconst semantic-java-number-regexp - (eval-when-compile - (concat "\\(" - "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" - "\\|" - "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>" - "\\|" - "\\<[0-9]+[.][fFdD]\\>" - "\\|" - "\\<[0-9]+[.]" - "\\|" - "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" - "\\|" - "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>" - "\\|" - "\\<0[xX][0-9a-fA-F]+[lL]?\\>" - "\\|" - "\\<[0-9]+[lLfFdD]?\\>" - "\\)" - )) - "Lexer regexp to match Java number terminals. -Following is the specification of Java number literals. - -DECIMAL_LITERAL: - [1-9][0-9]* - ; -HEX_LITERAL: - 0[xX][0-9a-fA-F]+ - ; -OCTAL_LITERAL: - 0[0-7]* - ; -INTEGER_LITERAL: - [lL]? - | [lL]? - | [lL]? - ; -EXPONENT: - [eE][+-]?[09]+ - ; -FLOATING_POINT_LITERAL: - [0-9]+[.][0-9]*?[fFdD]? - | [.][0-9]+?[fFdD]? - | [0-9]+[fFdD]? - | [0-9]+?[fFdD] - ;") - -;;; Parsing -;; -(defsubst semantic-java-dim (id) - "Split ID string into a pair (NAME . DIM). -NAME is ID without trailing brackets: \"[]\". -DIM is the dimension of NAME deduced from the number of trailing -brackets, or 0 if there is no trailing brackets." - (let ((dim (string-match "\\(\\[]\\)+\\'" id))) - (if dim - (cons (substring id 0 dim) - (/ (length (match-string 0 id)) 2)) - (cons id 0)))) - -(defsubst semantic-java-type (tag) - "Return the type of TAG, taking care of array notation." - (let ((type (semantic-tag-type tag)) - (dim (semantic-tag-get-attribute tag :dereference))) - (when dim - (while (> dim 0) - (setq type (concat type "[]") - dim (1- dim)))) - type)) - -(defun semantic-java-expand-tag (tag) - "Expand compound declarations found in TAG into separate tags. -TAG contains compound declarations when its class is `variable', and -its name is a list of elements (NAME START . END), where NAME is a -compound variable name, and START/END are the bounds of the -corresponding compound declaration." - (let* ((class (semantic-tag-class tag)) - (elts (semantic-tag-name tag)) - dim type dim0 elt clone start end xpand) - (cond - ((and (eq class 'function) - (> (cdr (setq dim (semantic-java-dim elts))) 0)) - (setq clone (semantic-tag-clone tag (car dim)) - xpand (cons clone xpand)) - (semantic-tag-put-attribute clone :dereference (cdr dim))) - ((eq class 'variable) - (or (consp elts) (setq elts (list (list elts)))) - (setq dim (semantic-java-dim (semantic-tag-get-attribute tag :type)) - type (car dim) - dim0 (cdr dim)) - (while elts - ;; For each compound element, clone the initial tag with the - ;; name and bounds of the compound variable declaration. - (setq elt (car elts) - elts (cdr elts) - start (if elts (cadr elt) (semantic-tag-start tag)) - end (if xpand (cddr elt) (semantic-tag-end tag)) - dim (semantic-java-dim (car elt)) - clone (semantic-tag-clone tag (car dim)) - xpand (cons clone xpand)) - (semantic-tag-put-attribute clone :type type) - (semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim))) - (semantic-tag-set-bounds clone start end))) - ) - xpand)) - -;;; Environment -;; -(defcustom-mode-local-semantic-dependency-system-include-path - java-mode semantic-java-dependency-system-include-path - ;; @todo - Use JDEE to get at the include path, or something else? - nil - "The system include path used by Java langauge.") - -;; Local context -;; -(define-mode-local-override semantic-ctxt-scoped-types - java-mode (&optional point) - "Return a list of type names currently in scope at POINT." - (mapcar 'semantic-tag-name - (semantic-find-tags-by-class - 'type (semantic-find-tag-by-overlay point)))) - -;; Prototype handler -;; -(defun semantic-java-prototype-function (tag &optional parent color) - "Return a function (method) prototype for TAG. -Optional argument PARENT is a parent (containing) item. -Optional argument COLOR indicates that color should be mixed in. -See also `semantic-format-prototype-tag'." - (let ((name (semantic-tag-name tag)) - (type (semantic-java-type tag)) - (tmpl (semantic-tag-get-attribute tag :template-specifier)) - (args (semantic-tag-function-arguments tag)) - (argp "") - arg argt) - (while args - (setq arg (car args) - args (cdr args)) - (if (semantic-tag-p arg) - (setq argt (if color - (semantic--format-colorize-text - (semantic-java-type arg) 'type) - (semantic-java-type arg)) - argp (concat argp argt (if args "," ""))))) - (when color - (when type - (setq type (semantic--format-colorize-text type 'type))) - (setq name (semantic--format-colorize-text name 'function))) - (concat (or tmpl "") (if tmpl " " "") - (or type "") (if type " " "") - name "(" argp ")"))) - -(defun semantic-java-prototype-variable (tag &optional parent color) - "Return a variable (field) prototype for TAG. -Optional argument PARENT is a parent (containing) item. -Optional argument COLOR indicates that color should be mixed in. -See also `semantic-format-prototype-tag'." - (let ((name (semantic-tag-name tag)) - (type (semantic-java-type tag))) - (concat (if color - (semantic--format-colorize-text type 'type) - type) - " " - (if color - (semantic--format-colorize-text name 'variable) - name)))) - -(defun semantic-java-prototype-type (tag &optional parent color) - "Return a type (class/interface) prototype for TAG. -Optional argument PARENT is a parent (containing) item. -Optional argument COLOR indicates that color should be mixed in. -See also `semantic-format-prototype-tag'." - (let ((name (semantic-tag-name tag)) - (type (semantic-tag-type tag)) - (tmpl (semantic-tag-get-attribute tag :template-specifier))) - (concat type " " - (if color - (semantic--format-colorize-text name 'type) - name) - (or tmpl "")))) - -(define-mode-local-override semantic-format-prototype-tag - java-mode (tag &optional parent color) - "Return a prototype for TOKEN. -Optional argument PARENT is a parent (containing) item. -Optional argument COLOR indicates that color should be mixed in." - (let ((f (intern-soft (format "semantic-java-prototype-%s" - (semantic-tag-class tag))))) - (funcall (if (fboundp f) - f - 'semantic-format-tag-prototype-default) - tag parent color))) - -(semantic-alias-obsolete 'semantic-java-prototype-nonterminal - 'semantic-format-prototype-tag-java-mode) - -;; Include Tag Name -;; - -;; Thanks Bruce Stephens -(define-mode-local-override semantic-tag-include-filename java-mode (tag) - "Return a suitable path for (some) Java imports" - (let ((name (semantic-tag-name tag))) - (concat (mapconcat 'identity (split-string name "\\.") "/") ".java"))) - - -;; Documentation 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")) - -(define-mode-local-override semantic-documentation-for-tag - java-mode (&optional tag nosnarf) - "Find documentation from TAG and return it as a clean string. -Java have documentation set in a comment preceeding TAG's definition. -Attempt to strip out comment syntactic sugar, unless optional argument -NOSNARF is non-nil. -If NOSNARF is 'lex, then return the semantic lex token." - (when (or tag (setq tag (semantic-current-tag))) - (with-current-buffer (semantic-tag-buffer tag) - (save-excursion - ;; Move the point at token start - (goto-char (semantic-tag-start tag)) - (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-doc-snarf-comment-for-tag 'lex))) - (when c - ;; Verify that the token just following the doc - ;; comment is the current one! - (goto-char (semantic-lex-token-end c)) - (semantic-java-skip-spaces-forward) - (when (eq tag (semantic-current-tag)) - (goto-char p) - (semantic-doc-snarf-comment-for-tag nosnarf))))) - )))) - -;;; Javadoc facilities -;; - -;; Javadoc elements -;; -(defvar semantic-java-doc-line-tags nil - "Valid javadoc line tags. -Ordered following Sun's Tag Convention at -") - -(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 classes of semantic tag -;; -(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 classes of semantic tag -;; -(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.") - -;; Access to Javadoc elements -;; -(defmacro semantic-java-doc-tag (name) - "Return doc tag from NAME. -That is @NAME." - `(concat "@" ,name)) - -(defsubst semantic-java-doc-tag-name (tag) - "Return name of the doc TAG symbol. -That is TAG `symbol-name' without the leading '@'." - (substring (symbol-name tag) 1)) - -(defun semantic-java-doc-keyword-before-p (k1 k2) - "Return non-nil if javadoc keyword K1 is before K2." - (let* ((t1 (semantic-java-doc-tag k1)) - (t2 (semantic-java-doc-tag k2)) - (seq1 (and (semantic-lex-keyword-p t1) - (plist-get (semantic-lex-keyword-get t1 'javadoc) - 'seq))) - (seq2 (and (semantic-lex-keyword-p t2) - (plist-get (semantic-lex-keyword-get t2 '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* ((tag (semantic-java-doc-tag k)) - (plist (semantic-lex-keyword-get tag 'javadoc))) - (if (or (not property) (plist-get plist property)) - (funcall fun k plist)))) - semantic-java-doc-line-tags))) - - -;;; Mode setup -;; - -(defun semantic-java-doc-setup () - "Lazy initialization of javadoc elements." - (or semantic-java-doc-line-tags - (setq semantic-java-doc-line-tags - (sort (mapcar #'semantic-java-doc-tag-name - (semantic-lex-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))))) - - ) - -(provide 'semantic/bovine/java) - -;;; semantic/bovine/java.el ends here diff --git a/lisp/cedet/semantic/debug.el b/lisp/cedet/semantic/debug.el index 9c506c54bd1..31100e075c2 100644 --- a/lisp/cedet/semantic/debug.el +++ b/lisp/cedet/semantic/debug.el @@ -1,4 +1,4 @@ -;;; debug.el --- Language Debugger framework +;;; semantic/debug.el --- Language Debugger framework ;;; Copyright (C) 2003, 2004, 2005, 2008 Free Software Foundation, Inc. @@ -38,8 +38,6 @@ (require 'semantic) (require 'eieio) -;; (require 'inversion) -;; (inversion-require 'eieio "0.18beta1") ;;; Code: (defvar semantic-debug-parser-source nil @@ -141,7 +139,7 @@ These buffers are brought into view when layout occurs.") ) ;; Set the number of lines to 1/3, or the size of the data buffer. (if (< cnt lines) (setq cnt lines)) - + (split-window-vertically cnt) (switch-to-buffer (oref iface data-buffer)) ) @@ -175,7 +173,7 @@ NONTERM is the name of the rule currently being processed that shows up as a nonterminal (or tag) in the source buffer. If RULE and MATCH indicies are specified, highlight those also." (set-buffer (oref iface :parser-buffer)) - + (let* ((rules (semantic-find-tags-by-class 'nonterminal (current-buffer))) (nt (semantic-find-first-tag-by-name nonterm rules)) (o nil) @@ -183,7 +181,7 @@ If RULE and MATCH indicies are specified, highlight those also." (when nt ;; I know it is the first symbol appearing in the body of this token. (goto-char (semantic-tag-start nt)) - + (setq o (semantic-make-overlay (point) (progn (forward-sexp 1) (point)))) (semantic-overlay-put o 'face 'highlight) @@ -264,12 +262,12 @@ on different types of return values." (defmethod semantic-debug-frame-highlight ((frame semantic-debug-frame)) "Highlight one parser frame." - + ) (defmethod semantic-debug-frame-info ((frame semantic-debug-frame)) "Display info about this one parser frame." - + ) ;;; Major Mode @@ -291,7 +289,7 @@ on different types of return values." (define-key km "b" 'semantic-debug-set-breakpoint) ;; Some boring bindings. (define-key km "e" 'eval-expression) - + km) "Keymap used when in semantic-debug-node.") @@ -308,7 +306,7 @@ Argument ONOFF is non-nil when we are entering debug mode. (use-local-map semantic-debug-mode-map) ;; Make the buffer read only (toggle-read-only 1) - + (set-buffer (oref iface source-buffer)) ;; Use our map in the source buffer also (use-local-map semantic-debug-mode-map) @@ -563,4 +561,4 @@ A frame is of the form: (provide 'semantic/debug) -;;; semantic-debug.el ends here +;;; semantic/debug.el ends here diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el new file mode 100644 index 00000000000..3a57c65792d --- /dev/null +++ b/lisp/cedet/semantic/java.el @@ -0,0 +1,465 @@ +;;; semantic/java.el --- Semantic functions for Java + +;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;;; 2007, 2008, 2009 Free Software Foundation, Inc. + +;; Author: David Ponce + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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. If not, see . + +;;; Commentary: +;; +;; Common function for Java parsers. + +;;; History: +;; + +;;; Code: +(require 'semantic) +(require 'semantic/ctxt) +(require 'semantic/doc) +(require 'semantic/format) + +(eval-when-compile + (require 'semantic/find) + (require 'semantic/dep)) + + +;;; Lexical analysis +;; +(defconst semantic-java-number-regexp + (eval-when-compile + (concat "\\(" + "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" + "\\|" + "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>" + "\\|" + "\\<[0-9]+[.][fFdD]\\>" + "\\|" + "\\<[0-9]+[.]" + "\\|" + "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>" + "\\|" + "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>" + "\\|" + "\\<0[xX][0-9a-fA-F]+[lL]?\\>" + "\\|" + "\\<[0-9]+[lLfFdD]?\\>" + "\\)" + )) + "Lexer regexp to match Java number terminals. +Following is the specification of Java number literals. + +DECIMAL_LITERAL: + [1-9][0-9]* + ; +HEX_LITERAL: + 0[xX][0-9a-fA-F]+ + ; +OCTAL_LITERAL: + 0[0-7]* + ; +INTEGER_LITERAL: + [lL]? + | [lL]? + | [lL]? + ; +EXPONENT: + [eE][+-]?[09]+ + ; +FLOATING_POINT_LITERAL: + [0-9]+[.][0-9]*?[fFdD]? + | [.][0-9]+?[fFdD]? + | [0-9]+[fFdD]? + | [0-9]+?[fFdD] + ;") + +;;; Parsing +;; +(defsubst semantic-java-dim (id) + "Split ID string into a pair (NAME . DIM). +NAME is ID without trailing brackets: \"[]\". +DIM is the dimension of NAME deduced from the number of trailing +brackets, or 0 if there is no trailing brackets." + (let ((dim (string-match "\\(\\[]\\)+\\'" id))) + (if dim + (cons (substring id 0 dim) + (/ (length (match-string 0 id)) 2)) + (cons id 0)))) + +(defsubst semantic-java-type (tag) + "Return the type of TAG, taking care of array notation." + (let ((type (semantic-tag-type tag)) + (dim (semantic-tag-get-attribute tag :dereference))) + (when dim + (while (> dim 0) + (setq type (concat type "[]") + dim (1- dim)))) + type)) + +(defun semantic-java-expand-tag (tag) + "Expand compound declarations found in TAG into separate tags. +TAG contains compound declarations when its class is `variable', and +its name is a list of elements (NAME START . END), where NAME is a +compound variable name, and START/END are the bounds of the +corresponding compound declaration." + (let* ((class (semantic-tag-class tag)) + (elts (semantic-tag-name tag)) + dim type dim0 elt clone start end xpand) + (cond + ((and (eq class 'function) + (> (cdr (setq dim (semantic-java-dim elts))) 0)) + (setq clone (semantic-tag-clone tag (car dim)) + xpand (cons clone xpand)) + (semantic-tag-put-attribute clone :dereference (cdr dim))) + ((eq class 'variable) + (or (consp elts) (setq elts (list (list elts)))) + (setq dim (semantic-java-dim (semantic-tag-get-attribute tag :type)) + type (car dim) + dim0 (cdr dim)) + (while elts + ;; For each compound element, clone the initial tag with the + ;; name and bounds of the compound variable declaration. + (setq elt (car elts) + elts (cdr elts) + start (if elts (cadr elt) (semantic-tag-start tag)) + end (if xpand (cddr elt) (semantic-tag-end tag)) + dim (semantic-java-dim (car elt)) + clone (semantic-tag-clone tag (car dim)) + xpand (cons clone xpand)) + (semantic-tag-put-attribute clone :type type) + (semantic-tag-put-attribute clone :dereference (+ dim0 (cdr dim))) + (semantic-tag-set-bounds clone start end))) + ) + xpand)) + +;;; Environment +;; +(defcustom-mode-local-semantic-dependency-system-include-path + java-mode semantic-java-dependency-system-include-path + ;; @todo - Use JDEE to get at the include path, or something else? + nil + "The system include path used by Java langauge.") + +;; Local context +;; +(define-mode-local-override semantic-ctxt-scoped-types + java-mode (&optional point) + "Return a list of type names currently in scope at POINT." + (mapcar 'semantic-tag-name + (semantic-find-tags-by-class + 'type (semantic-find-tag-by-overlay point)))) + +;; Prototype handler +;; +(defun semantic-java-prototype-function (tag &optional parent color) + "Return a function (method) prototype for TAG. +Optional argument PARENT is a parent (containing) item. +Optional argument COLOR indicates that color should be mixed in. +See also `semantic-format-prototype-tag'." + (let ((name (semantic-tag-name tag)) + (type (semantic-java-type tag)) + (tmpl (semantic-tag-get-attribute tag :template-specifier)) + (args (semantic-tag-function-arguments tag)) + (argp "") + arg argt) + (while args + (setq arg (car args) + args (cdr args)) + (if (semantic-tag-p arg) + (setq argt (if color + (semantic--format-colorize-text + (semantic-java-type arg) 'type) + (semantic-java-type arg)) + argp (concat argp argt (if args "," ""))))) + (when color + (when type + (setq type (semantic--format-colorize-text type 'type))) + (setq name (semantic--format-colorize-text name 'function))) + (concat (or tmpl "") (if tmpl " " "") + (or type "") (if type " " "") + name "(" argp ")"))) + +(defun semantic-java-prototype-variable (tag &optional parent color) + "Return a variable (field) prototype for TAG. +Optional argument PARENT is a parent (containing) item. +Optional argument COLOR indicates that color should be mixed in. +See also `semantic-format-prototype-tag'." + (let ((name (semantic-tag-name tag)) + (type (semantic-java-type tag))) + (concat (if color + (semantic--format-colorize-text type 'type) + type) + " " + (if color + (semantic--format-colorize-text name 'variable) + name)))) + +(defun semantic-java-prototype-type (tag &optional parent color) + "Return a type (class/interface) prototype for TAG. +Optional argument PARENT is a parent (containing) item. +Optional argument COLOR indicates that color should be mixed in. +See also `semantic-format-prototype-tag'." + (let ((name (semantic-tag-name tag)) + (type (semantic-tag-type tag)) + (tmpl (semantic-tag-get-attribute tag :template-specifier))) + (concat type " " + (if color + (semantic--format-colorize-text name 'type) + name) + (or tmpl "")))) + +(define-mode-local-override semantic-format-prototype-tag + java-mode (tag &optional parent color) + "Return a prototype for TOKEN. +Optional argument PARENT is a parent (containing) item. +Optional argument COLOR indicates that color should be mixed in." + (let ((f (intern-soft (format "semantic-java-prototype-%s" + (semantic-tag-class tag))))) + (funcall (if (fboundp f) + f + 'semantic-format-tag-prototype-default) + tag parent color))) + +(semantic-alias-obsolete 'semantic-java-prototype-nonterminal + 'semantic-format-prototype-tag-java-mode) + +;; Include Tag Name +;; + +;; Thanks Bruce Stephens +(define-mode-local-override semantic-tag-include-filename java-mode (tag) + "Return a suitable path for (some) Java imports" + (let ((name (semantic-tag-name tag))) + (concat (mapconcat 'identity (split-string name "\\.") "/") ".java"))) + + +;; Documentation 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")) + +(define-mode-local-override semantic-documentation-for-tag + java-mode (&optional tag nosnarf) + "Find documentation from TAG and return it as a clean string. +Java have documentation set in a comment preceeding TAG's definition. +Attempt to strip out comment syntactic sugar, unless optional argument +NOSNARF is non-nil. +If NOSNARF is 'lex, then return the semantic lex token." + (when (or tag (setq tag (semantic-current-tag))) + (with-current-buffer (semantic-tag-buffer tag) + (save-excursion + ;; Move the point at token start + (goto-char (semantic-tag-start tag)) + (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-doc-snarf-comment-for-tag 'lex))) + (when c + ;; Verify that the token just following the doc + ;; comment is the current one! + (goto-char (semantic-lex-token-end c)) + (semantic-java-skip-spaces-forward) + (when (eq tag (semantic-current-tag)) + (goto-char p) + (semantic-doc-snarf-comment-for-tag nosnarf))))) + )))) + +;;; Javadoc facilities +;; + +;; Javadoc elements +;; +(defvar semantic-java-doc-line-tags nil + "Valid javadoc line tags. +Ordered following Sun's Tag Convention at +") + +(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 classes of semantic tag +;; +(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 classes of semantic tag +;; +(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.") + +;; Access to Javadoc elements +;; +(defmacro semantic-java-doc-tag (name) + "Return doc tag from NAME. +That is @NAME." + `(concat "@" ,name)) + +(defsubst semantic-java-doc-tag-name (tag) + "Return name of the doc TAG symbol. +That is TAG `symbol-name' without the leading '@'." + (substring (symbol-name tag) 1)) + +(defun semantic-java-doc-keyword-before-p (k1 k2) + "Return non-nil if javadoc keyword K1 is before K2." + (let* ((t1 (semantic-java-doc-tag k1)) + (t2 (semantic-java-doc-tag k2)) + (seq1 (and (semantic-lex-keyword-p t1) + (plist-get (semantic-lex-keyword-get t1 'javadoc) + 'seq))) + (seq2 (and (semantic-lex-keyword-p t2) + (plist-get (semantic-lex-keyword-get t2 '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* ((tag (semantic-java-doc-tag k)) + (plist (semantic-lex-keyword-get tag 'javadoc))) + (if (or (not property) (plist-get plist property)) + (funcall fun k plist)))) + semantic-java-doc-line-tags))) + + +;;; Mode setup +;; + +(defun semantic-java-doc-setup () + "Lazy initialization of javadoc elements." + (or semantic-java-doc-line-tags + (setq semantic-java-doc-line-tags + (sort (mapcar #'semantic-java-doc-tag-name + (semantic-lex-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))))) + + ) + +(provide 'semantic/java) + +;;; semantic/java.el ends here