Mercurial > emacs

changeset 104468:3e6235dcb480

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
lisp/cedet/semantic/java.el: File moved here from bovine/ subdirectory.
author Chong Yidong <cyd@stupidchicken.com>
date Sun, 06 Sep 2009 02:18:08 +0000
parents fe04795ca590
children ce081012a7d6
files lisp/cedet/semantic/bovine/java.el lisp/cedet/semantic/debug.el
diffstat 2 files changed, 9 insertions(+), 476 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/cedet/semantic/bovine/java.el	Sat Sep 05 23:39:31 2009 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -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 <david@dponce.com>
-
-;; 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 <http://www.gnu.org/licenses/>.
-
-;;; 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:
-    <DECIMAL_LITERAL>[lL]?
-  | <HEX_LITERAL>[lL]?
-  | <OCTAL_LITERAL>[lL]?
-  ;
-EXPONENT:
-    [eE][+-]?[09]+
-  ;
-FLOATING_POINT_LITERAL:
-    [0-9]+[.][0-9]*<EXPONENT>?[fFdD]?
-  | [.][0-9]+<EXPONENT>?[fFdD]?
-  | [0-9]+<EXPONENT>[fFdD]?
-  | [0-9]+<EXPONENT>?[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
-<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 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
--- a/lisp/cedet/semantic/debug.el	Sat Sep 05 23:39:31 2009 +0000
+++ b/lisp/cedet/semantic/debug.el	Sun Sep 06 02:18:08 2009 +0000
@@ -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 @@
 	  )
       ;; 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 @@
 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 @@
     (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 @@
 
 (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 @@
     (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 @@
 	  (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 @@
 
 (provide 'semantic/debug)
 
-;;; semantic-debug.el ends here
+;;; semantic/debug.el ends here