diff lisp/cedet/semantic/format.el @ 104489:25e047f7f6a2

Synch to Eric Ludlam's upstream CEDET repository. * cedet/semantic/wisent/java-tags.el: * cedet/semantic/wisent/javat-wy.el: New files. * cedet/semantic/wisent/java.el: * cedet/semantic/wisent/java-wy.el: Files removed. * cedet/semantic/java.el (semantic-java-prototype-function) (semantic-java-prototype-variable, semantic-java-prototype-type): Doc fix (java-mode::semantic-format-tag-prototype): Renamed from semantic-format-prototype-tag, which didn't match the overloadable function. * cedet/semantic/bovine/c.el (semantic-c-dereference-namespace-alias): Deal correctly with nested namespaces. Make sure type actually exists in original namespace. * cedet/semantic/lex-spp.el (semantic-lex-spp-hack-depth): New. (semantic-lex-spp-lex-text-string): Use above to enable recursion. * cedet/semantic/format.el: Whitespace cleanup. (semantic-test-all-format-tag-functions): Move to end. (semantic-format-tag-prototype, semantic-format-tag-name) (semantic-format-tag-name-default): Revert to original upstream positions. * cedet/semantic/elp.el: File removed. * cedet/semantic/analyze.el (semantic-adebug-analyze): New function, moved here from semantic/adebug. * cedet/semantic/adebug.el: Declare external semanticdb functions. (semantic-adebug-analyze, semantic-adebug-edebug-expr): Deleted. * emacs-lisp/eieio.el (eieio-unbound): Default value is now robust to recompile. * emacs-lisp/eieio-datadebug.el: Add eieio objects to the list of data debug things to recognize. * emacs-lisp/eieio-comp.el: Synch to upstream. * cedet/data-debug.el: Don't require eieio and semantic/tag. If eieio is loaded, require eieio-datadebug. (data-debug-insert-ring-button): Do not be specific about the ring contents. (data-debug-thing-alist): Remove eieio and semantic specific entries. (data-debug-add-specialized-thing): New function. * cedet/cedet.el: Update commentary. * cedet/cedet-edebug.el: Require edebug and debug.

--- a/lisp/cedet/semantic/format.el	Fri Sep 11 01:17:46 2009 +0000
+++ b/lisp/cedet/semantic/format.el	Sun Sep 13 15:58:30 2009 +0000
@@ -33,13 +33,12 @@
 ;;
 
 ;;; Code:
+(eval-when-compile (require 'font-lock))
 (require 'semantic)
 (require 'semantic/tag-ls)
 (require 'ezimage)
 
-(eval-when-compile
-  (require 'font-lock)
-  (require 'semantic/find))
+(eval-when-compile (require 'semantic/find))
 
 ;;; Tag to text overload functions
 ;;
@@ -68,7 +67,7 @@
 `font-lock'.")
 
 (semantic-varalias-obsolete 'semantic-token->text-functions
-                            'semantic-format-tag-functions)
+			    'semantic-format-tag-functions)
 
 (defvar semantic-format-tag-custom-list
   (append '(radio)
@@ -79,7 +78,7 @@
 Use this variable in the :type field of a customizable variable.")
 
 (semantic-varalias-obsolete 'semantic-token->text-custom-list
-                            'semantic-format-tag-custom-list)
+			    'semantic-format-tag-custom-list)
 
 (defcustom semantic-format-use-images-flag ezimage-use-images
   "Non-nil means semantic format functions use images.
@@ -95,61 +94,6 @@
   "Text used to separate names when between namespaces/classes and functions.")
 (make-variable-buffer-local 'semantic-format-parent-separator)
 
-;;;###autoload
-(define-overloadable-function semantic-format-tag-name (tag &optional parent color)
-  "Return the name string describing TAG.
-The name is the shortest possible representation.
-Optional argument PARENT is the parent type if TAG is a detail.
-Optional argument COLOR means highlight the prototype with font-lock colors.")
-
-(defun semantic-format-tag-name-default (tag &optional parent color)
-  "Return an abbreviated string describing TAG.
-Optional argument PARENT is the parent type if TAG is a detail.
-Optional argument COLOR means highlight the prototype with font-lock colors."
-  (let ((name (semantic-tag-name tag))
-	(destructor
-	 (if (eq (semantic-tag-class tag) 'function)
-	     (semantic-tag-function-destructor-p tag))))
-    (when destructor
-      (setq name (concat "~" name)))
-    (if color
-	(setq name (semantic--format-colorize-text name (semantic-tag-class tag))))
-    name))
-
-;;;###autoload
-(define-overloadable-function semantic-format-tag-prototype (tag &optional parent color)
-  "Return a prototype for TAG.
-This function should be overloaded, though it need not be used.
-This is because it can be used to create code by language independent
-tools.
-Optional argument PARENT is the parent type if TAG is a detail.
-Optional argument COLOR means highlight the prototype with font-lock colors.")
-
-
-(defun semantic-test-all-format-tag-functions (&optional arg)
-  "Test all outputs from `semantic-format-tag-functions'.
-Output is generated from the function under `point'.
-Optional argument ARG specifies not to use color."
-  (interactive "P")
-  (require 'semantic/find)
-  (semantic-fetch-tags)
-  (let* ((tag (semantic-current-tag))
-	 (par (semantic-current-tag-parent))
-	 (fns semantic-format-tag-functions))
-    (with-output-to-temp-buffer "*format-tag*"
-      (princ "Tag->format function tests:")
-      (while fns
-	(princ "\n")
-	(princ (car fns))
-	(princ ":\n ")
-	(let ((s (funcall (car fns) tag par (not arg))))
-	  (save-excursion
-	    (set-buffer "*format-tag*")
-	    (goto-char (point-max))
-	    (insert s)))
-	(setq fns (cdr fns))))
-      ))
-
 (defvar semantic-format-face-alist
   `( (function . font-lock-function-name-face)
      (variable . font-lock-variable-name-face)
@@ -180,7 +124,7 @@
 be used unless font lock is a feature.")
 
 (semantic-varalias-obsolete 'semantic-face-alist
-                            'semantic-format-face-alist)
+			    'semantic-format-face-alist)
 
 
 
@@ -198,7 +142,7 @@
     text))
 
 (make-obsolete 'semantic-colorize-text
-               'semantic--format-colorize-text)
+	       'semantic--format-colorize-text)
 
 (defun semantic--format-colorize-merge-text (precoloredtext face-class)
   "Apply onto PRECOLOREDTEXT a color associated with FACE-CLASS.
@@ -280,6 +224,7 @@
 
 
 ;;; Abstract formatting functions
+;;
 
 (defun semantic-format-tag-prin1 (tag &optional parent color)
   "Convert TAG to a string that is the print name for TAG.
@@ -311,6 +256,27 @@
 	      (stringp (car anything)))
 	 (semantic--format-colorize-text (car anything) colorhint))))
 
+;;;###autoload
+(define-overloadable-function semantic-format-tag-name (tag &optional parent color)
+  "Return the name string describing TAG.
+The name is the shortest possible representation.
+Optional argument PARENT is the parent type if TAG is a detail.
+Optional argument COLOR means highlight the prototype with font-lock colors.")
+
+(defun semantic-format-tag-name-default (tag &optional parent color)
+  "Return an abbreviated string describing TAG.
+Optional argument PARENT is the parent type if TAG is a detail.
+Optional argument COLOR means highlight the prototype with font-lock colors."
+  (let ((name (semantic-tag-name tag))
+	(destructor
+	 (if (eq (semantic-tag-class tag) 'function)
+	     (semantic-tag-function-destructor-p tag))))
+    (when destructor
+      (setq name (concat "~" name)))
+    (if color
+	(setq name (semantic--format-colorize-text name (semantic-tag-class tag))))
+    name))
+
 (declare-function semantic-go-to-tag "semantic/tag-file")
 
 (defun semantic--format-tag-parent-tree (tag parent)
@@ -430,14 +396,14 @@
 Optional argument PARENT is the parent type if TAG is a detail.
 Optional argument COLOR means highlight the prototype with font-lock colors."
   (let* ((proto (semantic-format-tag-prototype tag nil color))
-         (names (if parent
-                    semantic-symbol->name-assoc-list-for-type-parts
-                  semantic-symbol->name-assoc-list))
-         (tsymb (semantic-tag-class tag))
-         (label (capitalize (or (cdr-safe (assoc tsymb names))
-                                (symbol-name tsymb)))))
+	 (names (if parent
+		    semantic-symbol->name-assoc-list-for-type-parts
+		  semantic-symbol->name-assoc-list))
+	 (tsymb (semantic-tag-class tag))
+	 (label (capitalize (or (cdr-safe (assoc tsymb names))
+				(symbol-name tsymb)))))
     (if color
-        (setq label (semantic--format-colorize-text label 'label)))
+	(setq label (semantic--format-colorize-text label 'label)))
     (concat label ": " proto)))
 
 (define-overloadable-function semantic-format-tag-summarize-with-file (tag &optional parent color)
@@ -450,7 +416,7 @@
 Optional argument PARENT is the parent type if TAG is a detail.
 Optional argument COLOR means highlight the prototype with font-lock colors."
   (let* ((proto (semantic-format-tag-prototype tag nil color))
-         (file (semantic-tag-file-name tag))
+	 (file (semantic-tag-file-name tag))
 	 )
     ;; Nothing for tag?  Try parent.
     (when (and (not file) (and parent))
@@ -505,6 +471,15 @@
     ))
 
 ;;; Prototype generation
+;;
+;;;###autoload
+(define-overloadable-function semantic-format-tag-prototype (tag &optional parent color)
+  "Return a prototype for TAG.
+This function should be overloaded, though it need not be used.
+This is because it can be used to create code by language independent
+tools.
+Optional argument PARENT is the parent type if TAG is a detail.
+Optional argument COLOR means highlight the prototype with font-lock colors.")
 
 (defun semantic-format-tag-prototype-default (tag &optional parent color)
   "Default method for returning a prototype for TAG.
@@ -516,14 +491,14 @@
 	 (type (if (member class '(function variable type))
 		   (semantic-format-tag-type tag color)))
 	 (args (if (member class '(function type))
-                   (semantic--format-tag-arguments
-                    (if (eq class 'function)
-                        (semantic-tag-function-arguments tag)
+		   (semantic--format-tag-arguments
+		    (if (eq class 'function)
+			(semantic-tag-function-arguments tag)
 		      (list "")
-                      ;;(semantic-tag-type-members tag)
+		      ;;(semantic-tag-type-members tag)
 		      )
-                    #'semantic-format-tag-prototype
-                    color)))
+		    #'semantic-format-tag-prototype
+		    color)))
 	 (const (semantic-tag-get-attribute tag :constant-flag))
 	 (tm (semantic-tag-get-attribute tag :typemodifiers))
 	 (mods (append
@@ -581,14 +556,14 @@
 	      ")"))
      ((eq class 'variable)
       (let* ((deref (semantic-tag-get-attribute
-                     tag :dereference))
-             (array "")
-             )
-        (while (and deref (/= deref 0))
-          (setq array (concat array "[]")
-                deref (1- deref)))
-        (concat (semantic-format-tag-name tag parent color)
-                array)))
+		     tag :dereference))
+	     (array "")
+	     )
+	(while (and deref (/= deref 0))
+	  (setq array (concat array "[]")
+		deref (1- deref)))
+	(concat (semantic-format-tag-name tag parent color)
+		array)))
      (t
       (semantic-format-tag-abbreviate tag parent color)))))
 
@@ -756,6 +731,32 @@
     ))
 
 
+;;; Test routines
+;;
+(defun semantic-test-all-format-tag-functions (&optional arg)
+  "Test all outputs from `semantic-format-tag-functions'.
+Output is generated from the function under `point'.
+Optional argument ARG specifies not to use color."
+  (interactive "P")
+  (semantic-fetch-tags)
+  (let* ((tag (semantic-current-tag))
+	 (par (semantic-current-tag-parent))
+	 (fns semantic-format-tag-functions))
+    (with-output-to-temp-buffer "*format-tag*"
+      (princ "Tag->format function tests:")
+      (while fns
+	(princ "\n")
+	(princ (car fns))
+	(princ ":\n ")
+	(let ((s (funcall (car fns) tag par (not arg))))
+	  (save-excursion
+	    (set-buffer "*format-tag*")
+	    (goto-char (point-max))
+	    (insert s)))
+	(setq fns (cdr fns))))
+      ))
+
+
 ;;; Compatibility and aliases
 ;;
 (semantic-alias-obsolete 'semantic-prin1-nonterminal