Commit a964f5e5 authored by Chong Yidong's avatar Chong Yidong
Browse files

Synch to Eric M. 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.
parent 0a3b3f9e
2009-09-13 Chong Yidong <cyd@stupidchicken.com>
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.
2009-09-07 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/autoload.el (make-autoload): Handle defclass form.
......
......@@ -31,6 +31,9 @@
;; printing.
;;; Code:
(require 'edebug)
(require 'debug)
(defvar cedet-edebug-prin1-extensions nil
"An alist of of code that can extend PRIN1 for edebug.
Each entry has the value: (CONDITION . PRIN1COMMAND).")
......
......@@ -24,26 +24,22 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
;;
;; This library automatically setups your [X]Emacs to use CEDET tools.
;;
;; (require 'cedet)
;;
;; If you want to turn on useful or all Semantic features by default,
;; respectively add:
;; Add the following into your ~/.emacs startup file:
;;
;; (setq semantic-load-turn-useful-things-on t)
;; or
;; (setq semantic-load-turn-everything-on t)
;; (load-file "<INSTALL-PATH>/cedet/common/cedet.el")
;;
;; before loading this file, like this:
;; Once loaded, you can enable additional feature. For example,
;; this will enable some basic and advance features:
;;
;; (setq semantic-load-turn-useful-things-on t)
;; (require 'cedet)
;;
;; That's it!
;;; Code:
;; (load-file "<INSTALL-PATH>/cedet/common/cedet.el")
;; (global-ede-mode t)
;; (semantic-load-enable-code-helpers)
;; (global-srecode-minor-mode 1)
(eval-when-compile
(require 'cl))
......
......@@ -43,9 +43,6 @@
(require 'font-lock)
(require 'ring)
(require 'eieio)
(eval-when-compile
(require 'semantic/tag))
;;; Code:
......@@ -384,18 +381,9 @@ PREBUTTONTEXT is some text between prefix and the stuff list button."
(ring-size ring)))
(ringthing
(if (= (ring-length ring) 0) nil (ring-ref ring 0)))
(tip (format "Ring max-size %d, length %d. Full of: %S"
(tip (format "Ring max-size %d, length %d."
(ring-size ring)
(ring-length ring)
(cond ((stringp ringthing)
"strings")
((semantic-tag-p ringthing)
"tags")
((eieio-object-p ringthing)
"eieio objects")
((listp ringthing)
"List of somethin'")
(t "stuff"))))
(ring-length ring)))
)
(insert prefix prebuttontext str)
(setq end (point))
......@@ -763,25 +751,6 @@ FACE is the face to use."
;; nil
(null . data-debug-insert-nil)
;; eieio object
((lambda (thing) (object-p thing)) . data-debug-insert-object-button)
;; tag
(semantic-tag-p . data-debug-insert-tag)
;; taglist
((lambda (thing) (and (listp thing) (semantic-tag-p (car thing)))) .
data-debug-insert-tag-list-button)
;; find results
(semanticdb-find-results-p . data-debug-insert-find-results-button)
;; Elt of a find-results
((lambda (thing) (and (listp thing)
(semanticdb-abstract-table-child-p (car thing))
(semantic-tag-p (cdr thing)))) .
data-debug-insert-db-and-tag-button)
;; Overlay
(data-debug-overlay-p . data-debug-insert-overlay-button)
......@@ -829,6 +798,22 @@ FACE is the face to use."
)
"Alist of methods used to insert things into an Ddebug buffer.")
;; An augmentation function for the thing alist.
(defun data-debug-add-specialized-thing (predicate fcn)
"Add a new specialized thing to display with data-debug.
PREDICATE is a function that returns t if a thing is this new type.
FCN is a function that will display stuff in the data debug buffer."
(let ((entry (cons predicate fcn))
;; Specialized entries show up AFTER nil,
;; but before listp, vectorp, symbolp, and
;; other general things. Splice it into
;; the beginning.
(first (nthcdr 0 data-debug-thing-alist))
(second (nthcdr 1 data-debug-thing-alist))
)
(when (not (member entry data-debug-thing-alist))
(setcdr first (cons entry second)))))
;; uber insert method
(defun data-debug-insert-thing (thing prefix prebuttontext &optional parent)
"Insert THING with PREFIX.
......@@ -853,7 +838,7 @@ If PARENT is non-nil, it is somehow related as a parent to thing."
;;; MAJOR MODE
;;
;; The Ddebug major mode provides an interactive space to explore
;; the current state of semantic's parsing and analysis
;; complicated data structures.
;;
(defgroup data-debug nil
"data-debug group."
......@@ -1044,7 +1029,7 @@ Do nothing if already expanded."
;;; DEBUG COMMANDS
;;
;; Various commands to output aspects of the current semantic environment.
;; Various commands for displaying complex data structures.
(defun data-debug-edebug-expr (expr)
"Dump out the contets of some expression EXPR in edebug with ddebug."
......@@ -1092,7 +1077,9 @@ If the result is a list or vector, then use the data debugger to display it."
(let ((str (eval-expression-print-format (car values))))
(if str (princ str t))))))
(provide 'data-debug)
(if (featurep 'eieio)
(require 'eieio-datadebug))
;;; data-debug.el ends here
......@@ -32,9 +32,17 @@
;;
;; Allow interactive navigation of the analysis process, tags, etc.
(require 'eieio)
(require 'data-debug)
(require 'eieio-datadebug)
(require 'semantic/analyze)
(require 'semantic)
(require 'semantic/tag)
(require 'semantic/format)
(declare-function semanticdb-get-database "semantic/db")
(declare-function semanticdb-directory-loaded-p "semantic/db")
(declare-function semanticdb-file-table "semantic/db")
(declare-function semanticdb-needs-refresh-p "semantic/db")
(declare-function semanticdb-full-filename "semantic/db")
;;; Code:
......@@ -303,38 +311,10 @@ Display the results as a debug list."
(data-debug-insert-find-results fr "*")))
(defun semantic-adebug-analyze (&optional ctxt)
"Perform `semantic-analyze-current-context'.
Display the results as a debug list.
Optional argument CTXT is the context to show."
(interactive)
(let ((start (current-time))
(ctxt (or ctxt (semantic-analyze-current-context)))
(end (current-time)))
(if (not ctxt)
(message "No Analyzer Results")
(message "Analysis took %.2f seconds."
(semantic-elapsed-time start end))
(semantic-analyze-pulse ctxt)
(if ctxt
(progn
(data-debug-new-buffer "*Analyzer ADEBUG*")
(data-debug-insert-object-slots ctxt "]"))
(message "No Context to analyze here.")))))
(defun semantic-adebug-edebug-expr (expr)
"Dump out the contets of some expression EXPR in edebug with adebug."
(interactive "sExpression: ")
(let ((v (eval (read expr))))
(if (not v)
(message "Expression %s is nil." expr)
(data-debug-new-buffer "*expression ADEBUG*")
(data-debug-insert-thing v "?" "")
)))
(defun semanticdb-debug-file-tag-check (startfile)
"Report debug info for checking STARTFILE for up-to-date tags."
(interactive "FFile to Check (default = current-buffer): ")
(require 'semantic/db)
(let* ((file (file-truename startfile))
(default-directory (file-name-directory file))
(db (or
......
......@@ -674,6 +674,26 @@ Returns an object based on symbol `semantic-analyze-context'."
;; Return our context.
context-return))
(defun semantic-adebug-analyze (&optional ctxt)
"Perform `semantic-analyze-current-context'.
Display the results as a debug list.
Optional argument CTXT is the context to show."
(interactive)
(let ((start (current-time))
(ctxt (or ctxt (semantic-analyze-current-context)))
(end (current-time)))
(if (not ctxt)
(message "No Analyzer Results")
(message "Analysis took %.2f seconds."
(semantic-elapsed-time start end))
(semantic-analyze-pulse ctxt)
(if ctxt
(progn
(data-debug-new-buffer "*Analyzer ADEBUG*")
(data-debug-insert-object-slots ctxt "]"))
(message "No Context to analyze here.")))))
;;; DEBUG OUTPUT
;;
......
......@@ -1374,20 +1374,29 @@ with a fully qualified name in the original namespace. Returns
nil if NAMESPACE is not an alias."
(when (eq (semantic-tag-get-attribute namespace :kind) 'alias)
(let ((typename (semantic-analyze-split-name (semantic-tag-name type)))
ns newtype)
;; Get name of namespace this one's an alias for.
ns nstype originaltype newtype)
;; Make typename unqualified
(if (listp typename)
(setq typename (last typename))
(setq typename (list typename)))
(when
(setq ns (semantic-analyze-split-name
(semantic-tag-name
(car (semantic-tag-get-attribute namespace :members)))))
(and
;; Get original namespace and make sure TYPE exists there.
(setq ns (semantic-tag-name
(car (semantic-tag-get-attribute namespace :members))))
(setq nstype (semanticdb-typecache-find ns))
(setq originaltype (semantic-find-tags-by-name
(car typename)
(semantic-tag-get-attribute nstype :members))))
;; Construct new type with name in original namespace.
(setq ns (semantic-analyze-split-name ns))
(setq newtype
(semantic-tag-clone
type
(car originaltype)
(semantic-analyze-unsplit-name
(if (listp ns)
(append (butlast ns) (last typename))
(append (list ns) (last typename))))))))))
(append ns typename)
(append (list ns) typename)))))))))
;; This searches a type in a namespace, following through all using
;; statements.
......
......@@ -602,6 +602,7 @@ isn't in memory yet."
"Load an unloaded file in FILENAME using the default semanticdb loader."
(semanticdb-file-table-object filename))
;; The creation of the overload occurs above.
(defun semanticdb-find-table-for-include-default (includetag &optional table)
"Default implementation of `semanticdb-find-table-for-include'.
Uses `semanticdb-current-database-list' as the search path.
......
......@@ -162,7 +162,6 @@ Return a list of tags."
Optional argument TAGS is a list of tags to search.
Return a list of tags."
(if tags (call-next-method)
;; YOUR IMPLEMENTATION HERE
(let* ((semantic-symref-tool 'global)
(result (semantic-symref-find-tags-by-regexp regex 'project))
)
......
This diff is collapsed.
......@@ -53,7 +53,7 @@
;;
;; These routines provide fast access to tokens based on a buffer that
;; has parsed tokens in it. Uses overlays to perform the hard work.
;;
;;;###autoload
(defun semantic-find-tag-by-overlay (&optional positionormarker buffer)
"Find all tags covering POSITIONORMARKER by using overlays.
......@@ -257,7 +257,7 @@ TABLE is a semantic tags table. See `semantic-something-to-tag-table'."
(nreverse result)))
;;; Top level Searches
;;
;;;###autoload
(defun semantic-find-first-tag-by-name (name &optional table)
"Find the first tag with NAME in TABLE.
......
......@@ -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 @@ COLOR indicates that the generated text should be colored using
`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 @@ COLOR indicates that the generated text should be colored using
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 @@ Images can be used as icons instead of some types of text strings."
"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 @@ Faces used are generated in `font-lock' for consistency, and will not
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 @@ for details on adding new types."
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 @@ Argument COLOR specifies to colorize the text."
;;; 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 @@ of FACE-CLASS for which this is used."
(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 COLOR means highlight the prototype with font-lock colors.")
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 COLOR means highlight the prototype with font-lock colors.")
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 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
))
;;; 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 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
(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 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
")"))
((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)))))
......@@ -755,6 +730,32 @@ Optional argument COLOR means highlight the prototype with font-lock colors."
text
))