Mercurial > emacs
changeset 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.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 13 Sep 2009 15:58:30 +0000 |
parents | 7042156f9f43 |
children | 7811201f57f2 |
files | lisp/ChangeLog lisp/cedet/cedet-edebug.el lisp/cedet/cedet.el lisp/cedet/data-debug.el lisp/cedet/semantic/adebug.el lisp/cedet/semantic/analyze.el lisp/cedet/semantic/bovine/c.el lisp/cedet/semantic/db-find.el lisp/cedet/semantic/db-global.el lisp/cedet/semantic/elp.el lisp/cedet/semantic/find.el lisp/cedet/semantic/format.el lisp/cedet/semantic/java.el lisp/cedet/semantic/lex-spp.el lisp/cedet/semantic/tag.el lisp/cedet/semantic/wisent/java-tags.el lisp/cedet/semantic/wisent/java-wy.el lisp/cedet/semantic/wisent/java.el lisp/cedet/semantic/wisent/javat-wy.el lisp/cedet/semantic/wisent/js-wy.el lisp/emacs-lisp/eieio-comp.el lisp/emacs-lisp/eieio-datadebug.el lisp/emacs-lisp/eieio.el |
diffstat | 23 files changed, 416 insertions(+), 1148 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/ChangeLog Sun Sep 13 15:58:30 2009 +0000 @@ -1,3 +1,61 @@ +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.
--- a/lisp/cedet/cedet-edebug.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/cedet-edebug.el Sun Sep 13 15:58:30 2009 +0000 @@ -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).")
--- a/lisp/cedet/cedet.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/cedet.el Sun Sep 13 15:58:30 2009 +0000 @@ -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) +;; Add the following into your ~/.emacs startup file: ;; -;; If you want to turn on useful or all Semantic features by default, -;; respectively add: -;; -;; (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))
--- a/lisp/cedet/data-debug.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/data-debug.el Sun Sep 13 15:58:30 2009 +0000 @@ -43,9 +43,6 @@ (require 'font-lock) (require 'ring) -(require 'eieio) -(eval-when-compile - (require 'semantic/tag)) ;;; Code: @@ -384,18 +381,9 @@ (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 @@ ;; 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 @@ ) "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 @@ ;;; 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 @@ ;;; 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 @@ (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
--- a/lisp/cedet/semantic/adebug.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/adebug.el Sun Sep 13 15:58:30 2009 +0000 @@ -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 @@ (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
--- a/lisp/cedet/semantic/analyze.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/analyze.el Sun Sep 13 15:58:30 2009 +0000 @@ -675,6 +675,26 @@ 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 ;; ;; Friendly output of a context analysis.
--- a/lisp/cedet/semantic/bovine/c.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/bovine/c.el Sun Sep 13 15:58:30 2009 +0000 @@ -1374,20 +1374,29 @@ 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.
--- a/lisp/cedet/semantic/db-find.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/db-find.el Sun Sep 13 15:58:30 2009 +0000 @@ -602,6 +602,7 @@ "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.
--- a/lisp/cedet/semantic/db-global.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/db-global.el Sun Sep 13 15:58:30 2009 +0000 @@ -162,7 +162,6 @@ 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)) )
--- a/lisp/cedet/semantic/elp.el Fri Sep 11 01:17:46 2009 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,775 +0,0 @@ -;;; semantic/elp.el --- Bind ELP to measure Semantic - -;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam <eric@siege-engine.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: -;; -;; Provide fast ways to profile various (often slow) Semantic processes. - -(require 'elp) -(require 'data-debug) -(require 'semantic/adebug) -(require 'semantic/tag-ls) -(require 'semantic/tag-file) -(require 'semantic/db) -(require 'semantic/db-find) -(require 'semantic/db-typecache) -(require 'semantic/scope) -(require 'semantic/analyze/fcn) -(require 'semantic/analyze) -(require 'semantic/analyze/complete) - -(declare-function semantic-idle-scheduler-work-parse-neighboring-files - "semantic/idle") - -;;; Code: -(defvar semantic-elp-emacs-core-list - '( - append - copy-sequence - expand-file-name - file-exists-p - file-name-directory - file-name-nondirectory - file-attributes - file-truename - find-buffer-visiting - length - locate-file - nconc - nreverse - sort - string< - string= - ) - "List of Emacs functions for profiling.") - -(defvar semantic-elp-eieio-core-list - '( - eieio-generic-call - eieio-generic-call-primary-only - eieiomt-method-list - eieio-generic-form - eieio-oref - eieio-oset - obj-of-class-p - ) - "List of EIEIO functions for profiling.") - -(defvar semantic-elp-ede-core-list - '( - ede-current-project - ede-directory-get-open-project - ede-expand-filename - ede-expand-filename-impl - ede-locate-file-in-project - ede-locate-file-in-project-impl - ede-system-include-path - ede-toplevel - ede-toplevel-project - ede-directory-project-p - ) - "List of EDE functions to watch out for.") - -(defvar semantic-elp-semantic-core-list - '( - semantic-ctxt-current-argument - semantic-ctxt-current-assignment - semantic-ctxt-current-class-list - semantic-ctxt-current-function - semantic-ctxt-current-symbol-and-bounds - semantic-current-tag - semantic-dependency-tag-file - semantic-equivalent-tag-p - semantic-fetch-tags - semantic-fetch-tags-fast - semantic-find-tag-by-overlay - semantic-sort-tags-by-name-decreasing - semantic-sort-tags-by-name-increasing - semantic-sort-tags-by-name-then-type-increasing - semantic-sort-tags-by-type-decreasing - semantic-sort-tags-by-type-increasing - semantic-tag-clone - semantic-tag-components - semantic-tag-copy - semantic-tag-external-member-children - semantic-tag-file-name - semantic-tag-function-arguments - semantic-tag-function-parent - semantic-tag-get-attribute - semantic-tag-in-buffer-p - semantic-tag-include-filename - ;;semantic-tag-lessp-name-then-type - semantic-tag-name - semantic-tag-new-type - semantic-tag-of-class-p - semantic-tag-of-type-p - semantic-tag-of-type-p - semantic-tag-p - semantic-tag-prototype-p - semantic-tag-set-faux - semantic-tag-type - semantic-tag-type-members - semantic-tag-type-superclasses - semantic-tag-with-position-p - ) - "List of core Semantic functions for profiling.") -(defvar semantic-elp-semantic-find-core-list - '( - semantic-find-tags-by-class - semantic-find-tags-by-name - semantic-find-tags-by-name-regexp - semantic-find-tags-by-scope-protection - semantic-find-tags-by-type - semantic-find-tags-for-completion - semantic-find-tags-included - semantic-find-tags-of-compound-type - ) - "List of semantic-find routines for profiling.") - -(defvar semantic-elp-semanticdb-core-list - '( - semanticdb-cache-get - semanticdb-current-database-list - semanticdb-file-table - semanticdb-file-table-object - semanticdb-full-filename - semanticdb-get-buffer - semanticdb-get-table-index - semanticdb-refresh-references - semanticdb-refresh-table - semanticdb-needs-refresh-p - semanticdb-directory-loaded-p - semanticdb-full-filename - semanticdb-create-table-for-file - ) - "List of core Semanticdb functions for profiling.") - -(defvar semantic-elp-include-path-list - '( - semanticdb-find-incomplete-cache-entries-p - semanticdb-find-load-unloaded - semanticdb-find-table-for-include - semanticdb-find-throttle-active-p - semanticdb-find-translate-path-default - semanticdb-find-translate-path-brutish-default - semanticdb-find-translate-path-includes--internal - semanticdb-find-translate-path-includes-default - ) - "List of include path calculation functions for profiling.") - -(defvar semantic-elp-semanticdb-find-list - '( - semanticdb-fast-strip-find-results - semanticdb-find-results-p - semanticdb-find-tags-by-class - semanticdb-find-tags-by-name - semanticdb-find-tags-by-name-regexp - semanticdb-find-tags-collector - semanticdb-find-tags-external-children-of-type - semanticdb-find-tags-for-completion - semanticdb-strip-find-results - ) - "List of semanticdb find functions to profile. -You may also need `semantic-elp-include-path-list'.") - -(defun semantic-elp-core-enable () - "Do an ELP reset, and enable profiling of the core system." - (elp-reset-all) - (elp-instrument-list semantic-elp-emacs-core-list) - (elp-instrument-list semantic-elp-eieio-core-list) - (elp-instrument-list semantic-elp-ede-core-list) - (elp-instrument-list semantic-elp-semantic-core-list) - (elp-instrument-list semantic-elp-semanticdb-core-list) - (elp-instrument-list semantic-elp-semanticdb-find-list) - (elp-instrument-list semantic-elp-include-path-list) - ) - - -(defun semantic-elp-include-path-enable () - "Enable profiling for `semanticdb-find-translate-path'." - (semantic-elp-core-enable) - (elp-set-master 'semanticdb-find-translate-path-default) - ) - -(defvar semantic-elp-typecache-list - '( - semantic-analyze-split-name - semanticdb-get-typecache - semanticdb-typecache-merge-streams - semanticdb-typecache-safe-tag-members - semanticdb-typecache-apply-filename - semanticdb-typecache-file-tags - semanticdb-typecache-include-tags - ) - "List of typecaching functions for profiling.") - -(defun semantic-elp-profile-typecache (tab) - "Profile the typecache. Start with table TAB." - (let ((tc (semanticdb-get-typecache tab))) - (semanticdb-typecache-file-tags tab) - (semanticdb-typecache-include-tags tab) - tc)) - -(defun semantic-elp-typecache-enable () - "Enable profiling for `semanticdb-get-typecache'." - (semantic-elp-include-path-enable) - (elp-instrument-list semantic-elp-typecache-list) - (elp-set-master 'semantic-elp-profile-typecache) - ) - -(defvar semantic-elp-scope-list - '( - semantic-analyze-find-tag - semantic-analyze-scope-nested-tags - semantic-analyze-scoped-types - semantic-analyze-scoped-types - semantic-analyze-tag-prototype-p - semantic-analyze-scoped-type-parts - semantic-calculate-scope - semantic-ctxt-scoped-types - semantic-get-all-local-variables - semantic-scope-find - semanticdb-typecache-find - semanticdb-typecache-merge-streams - ) - "List of scope calculation functions for profiling.") - -(defun semantic-elp-scope-enable () - "Enable profiling for `semanticdb-calculate-scope'." - (semantic-elp-core-enable) - (elp-instrument-list semantic-elp-typecache-list) - (elp-instrument-list semantic-elp-scope-list) - (elp-set-master 'semantic-calculate-scope) - ) - -(defvar semantic-elp-analyze-list - '( - semantic-analyze-current-symbol - semantic-analyze-current-context - semantic-analyze-dereference-metatype - semantic-analyze-find-tag-sequence - semantic-analyze-interesting-tag - semantic-analyze-pop-to-context - semantic-analyze-select-best-tag - semantic-analyze-tag-type - semantic-analyze-type-to-name - semantic-analyze-type-constraint - semantic-analyze-scoped-type-parts - semantic-cache-data-to-buffer - ) - "List of analyzer calculation functions for profiling.") - -(defun semantic-elp-analyze-enable () - "Enable profiling for `semanticdb-analyze-current-context'." - (semantic-elp-scope-enable) - (elp-instrument-list semantic-elp-analyze-list) - (elp-set-master 'semantic-analyze-current-context) - ) - -(defvar semantic-elp-symref-list - '( - semantic-symref-hits-in-region - semantic-symref-test-count-hits-in-tag - ) - "List of symref functions for profiling.") - -(defun semantic-elp-analyze-symref-hits () - "Enable profiling for `semanticdb-analyze-current-context'." - (semantic-elp-analyze-enable) - (elp-instrument-list semantic-elp-symref-list) - (elp-set-master 'semantic-symref-test-count-hits-in-tag) - ) - -(defvar semantic-elp-complete-list - '( - semantic-analyze-possible-completions - semantic-analyze-possible-completions-default - semantic-analyze-tags-of-class-list - semantic-analyze-type-constants - semantic-unique-tag-table-by-name - ) - "List of smart completion functions for profiling.") - -(defun semantic-elp-complete-enable () - "Enable profiling for `semanticdb-analyze-current-context'." - (semantic-elp-analyze-enable) - (elp-instrument-list semantic-elp-complete-list) - (elp-set-master 'semantic-analyze-possible-completions) - ) - -;;; Storage Classes -;; -;; -(defclass semantic-elp-data () - ((raw :initarg :raw - :type list - :documentation - "The raw ELP data.") - (sort :initform time - :documentation - "Which column do we sort our data by during various dumps.") - (sorted :initform nil - :documentation - "The sorted and filtered version of this data.") - (total :initarg :total - :initform nil - :documentation - "The total time spent in the operation. -Recorded outside of ELP.") - ) - "Class for managing ELP data.") - -(defmethod semantic-elp-change-sort ((data semantic-elp-data) &optional newsort) - "Change the sort in DATA object to NEWSORT." - (cond ((eq newsort 'rotate) - (let* ((arot '((time . avg) - (avg . calls) - (calls . name) - (name . time))) - (next (cdr (assoc (oref data sort) arot))) - ) - (oset data sort next))) - ((null newsort) - nil) - (t - (oset data sort newsort))) - (let ((r (copy-sequence (oref data raw))) - (s (oref data sort))) - (cond ((eq s 'time) - (oset data sorted (sort r (lambda (a b) - (> (aref a 1) (aref b 1)) - ))) - ) - ((eq s 'avg) - (oset data sorted (sort r (lambda (a b) - (> (aref a 2) (aref b 2)) - ))) - ) - ((eq s 'calls) - (oset data sorted (sort r (lambda (a b) - (> (aref a 0) (aref b 0)) - ))) - ) - ((eq s 'name) - (oset data sorted (sort r (lambda (a b) - (string< (aref a 3) (aref b 3)) - ))) - ) - (t (message "Don't know how to resort with %s" s) - )))) - -(defun semantic-elp-goto-function (point) - "Goto the function from the ELP data. -Argument POINT is where to get the data from." - (let* ((data (get-text-property point 'ddebug)) - ) - (find-function (intern-soft (aref data 3))) - )) - -(defmethod semantic-elp-dump-table ((data semantic-elp-data) - prefix) - "dump out the current DATA table using PREFIX before each line." - (let* ((elpd (oref data sorted)) - (spaces (make-string (- (length prefix) 2) ? )) - ) - (data-debug-insert-simple-thing - "Calls\t Total Time\t Avg Time/Call\tName" - spaces " " 'underline) - (dolist (d elpd) - (when (> (aref d 0) 0) ;; We had some calls - (let ((start (point)) - (end nil)) - (data-debug-insert-simple-thing - (format " % 4d\t% 2.7f\t% 2.7f\t%s" - (aref d 0) (aref d 1) (aref d 2) (aref d 3)) - spaces " " nil) - (setq end (1- (point))) - (put-text-property start end 'ddebug d) - (put-text-property start end 'ddebug-noexpand t) - (put-text-property start end 'ddebug-function - 'semantic-elp-goto-function) - ) - )) - ) - ) - -(defmethod data-debug/eieio-insert-slots ((data semantic-elp-data) - prefix) - "Show the fields of ELP data in an adebug buffer. -Ignore the usual, and format a nice table." - (data-debug-insert-thing (object-name-string data) - prefix - "Name: ") - (let* ((cl (object-class data)) - (cv (class-v cl))) - (data-debug-insert-thing (class-constructor cl) - prefix - "Class: ") - ) - - (data-debug-insert-thing (oref data :total) - prefix - "Total Time Spent: ") - - (let ((s (oref data sort)) - ) - ;; Show how it's sorted: - (let ((start (point)) - (end nil) - ) - (insert prefix "Sort Method: " (symbol-name s)) - (setq end (point)) - ;; (data-debug-insert-thing s prefix "Sort Method: ") - (put-text-property start end 'ddebug data) - (put-text-property start end 'ddebug-noexpand t) - (put-text-property start end 'ddebug-indent(length prefix)) - (put-text-property start end 'ddebug-prefix prefix) - (put-text-property start end 'ddebug-function - 'semantic-elp-change-sort-adebug) - (put-text-property start end 'help-echo - "Change the Sort by selecting twice.") - (insert "\n")) - - ;; How to sort the raw data - (semantic-elp-change-sort data) - ) - ;; Display - (semantic-elp-dump-table data prefix) - ) - -(defun semantic-elp-change-sort-adebug (point) - "Change the sort function here. Redisplay. -Argument POINT is where the text is." - (let* ((data (get-text-property point 'ddebug)) - (prefix (get-text-property point 'ddebug-prefix)) - ) - ;; Get rid of the old table. - (data-debug-contract-current-line) - ;; Change it - (semantic-elp-change-sort data 'rotate) - (end-of-line) - (forward-word -1) - (delete-region (point) (point-at-eol)) - (insert (symbol-name (oref data sort))) - ;; Redraw it. - (save-excursion - (end-of-line) - (forward-char 1) - (semantic-elp-dump-table data prefix)) - )) - -(defclass semantic-elp-object-base (eieio-persistent) - ((file-header-line :initform ";; SEMANTIC ELP Profiling Save File") - (total :initarg :total - :type number - :documentation - "Amount of time spent during the entire collection.") - ) - "Base elp object.") - -(defclass semantic-elp-object (semantic-elp-object-base) - ((time :initarg :time - :type semantic-elp-data - :documentation - "Times for calculating something.") - (answer :initarg :answer - :documentation - "Any answer that might be useful.")) - "Simple elp object for remembering one analysis run.") - -(defclass semantic-elp-object-analyze (semantic-elp-object-base) - ((pathtime :initarg :pathtime - :type semantic-elp-data - :documentation - "Times for calculating the include path.") - (typecachetime :initarg :typecachetime - :type semantic-elp-data - :documentation - "Times for calculating the typecache.") - (scopetime :initarg :scopetime - :type semantic-elp-data - :documentation - "Times for calculating the typecache") - (ctxttime :initarg :ctxttime - :type semantic-elp-data - :documentation - "Times for calculating the context.") - (completiontime :initarg :completiontime - :type semantic-elp-data - :documentation - "Times for calculating the completions.") - ) - "Results from a profile run.") - -;;; ELP hackery. -;; - -(defvar semantic-elp-last-results nil - "Save the last results from an ELP run for more post processing.") - -(defun semantic-elp-results (name) - "Fetch results from the last run, and display. -Copied out of elp.el and modified only slightly. -Argument NAME is the name to give the ELP data object." - (let ((resvec - (mapcar - (function - (lambda (funsym) - (let* ((info (get funsym elp-timer-info-property)) - (symname (format "%s" funsym)) - (cc (aref info 0)) - (tt (aref info 1))) - (if (not info) - (insert "No profiling information found for: " - symname) - ;;(setq longest (max longest (length symname))) - (vector cc tt (if (zerop cc) - 0.0 ;avoid arithmetic div-by-zero errors - (/ (float tt) (float cc))) - symname))))) - elp-all-instrumented-list)) - ) ; end let - (setq semantic-elp-last-results (semantic-elp-data name :raw resvec)) - (elp-reset-all)) - ) - -;;; The big analyze and timer function! -;; -;; - -(defvar semantic-elp-last-run nil - "The results from the last elp run.") - -(defun semantic-elp-analyze () - "Run the analyzer, using ELP to measure performance." - (interactive) - (let ((elp-recycle-buffers-p nil) - (totalstart (current-time)) - (totalstop nil) - start stop - path pathtime - typecache typecachetime - scope scopetime - ctxt ctxttime - completion completiontime) - ;; Force tag table to be up to date. - (semantic-clear-toplevel-cache) - (semantic-fetch-tags) - ;; Path translation - (semantic-elp-include-path-enable) - (progn - (setq start (current-time)) - (setq path (semanticdb-find-translate-path nil nil)) - (setq stop (current-time))) - (semantic-elp-results "translate-path") - (setq pathtime semantic-elp-last-results) - (oset pathtime :total (semantic-elapsed-time start stop)) - ;; typecache - (let* ((tab semanticdb-current-table) - (idx (semanticdb-get-table-index tab)) - (tc nil) - ) - (semantic-elp-typecache-enable) - (progn - (setq start (current-time)) - (setq tc (semantic-elp-profile-typecache tab)) - (setq stop (current-time))) - (setq typecache tc)) - (semantic-elp-results "typecache") - (setq typecachetime semantic-elp-last-results) - (oset typecachetime :total (semantic-elapsed-time start stop)) - ;; Scope - (semantic-elp-scope-enable) - (progn - (setq start (current-time)) - (setq scope (semantic-calculate-scope)) - (setq stop (current-time))) - (semantic-elp-results "scope") - (setq scopetime semantic-elp-last-results) - (oset scopetime :total (semantic-elapsed-time start stop)) - ;; Analyze! - (semantic-elp-analyze-enable) - (progn - (setq start (current-time)) - (setq ctxt (semantic-analyze-current-context)) ; skip caching - (setq stop (current-time))) - (semantic-elp-results "analyze") - (setq ctxttime semantic-elp-last-results) - (oset ctxttime :total (semantic-elapsed-time start stop)) - ;; Complete! - (semantic-elp-complete-enable) - (progn - (setq start (current-time)) - (setq completion (semantic-analyze-possible-completions ctxt)) - (setq stop (current-time))) - (semantic-elp-results "complete") - (setq completiontime semantic-elp-last-results) - (oset completiontime :total (semantic-elapsed-time start stop)) - ;; Finish it - (setq totalstop (current-time)) - ;; build it - (let ((elpobj (semantic-elp-object-analyze - "ELP" - :total (semantic-elapsed-time totalstart totalstop) - :pathtime pathtime - :typecachetime typecachetime - :scopetime scopetime - :ctxttime ctxttime - :completiontime completiontime - ))) - (data-debug-show elpobj) - (setq semantic-elp-last-run elpobj) - (let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") - "semantic.elp" nil "semantic.elp"))) - (oset elpobj :file saveas) - (eieio-persistent-save elpobj) - ) - ))) - -(defun semantic-elp-idle-work () - "Run the idle work scheduler, using ELP to measure performance." - (interactive) - (require 'semantic/idle) - (let ((elp-recycle-buffers-p nil) - (totalstart nil) - (totalstop nil) - ans time - ) - ;; Path translation - (semantic-elp-core-enable) - (setq totalstart (current-time)) - (semantic-idle-scheduler-work-parse-neighboring-files) - (setq totalstop (current-time)) - (semantic-elp-results "") - (setq time semantic-elp-last-results) - (oset time :total (semantic-elapsed-time totalstart totalstop)) - ;; build it - (let ((elpobj (semantic-elp-object - "ELP" - :total (semantic-elapsed-time totalstart totalstop) - :time time))) - (data-debug-show elpobj) - (setq semantic-elp-last-run elpobj) - (let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") - "semantic.elp" nil "semantic.elp"))) - (oset elpobj :file saveas) - (eieio-persistent-save elpobj) - ) - ))) - -(defun semantic-elp-searchdb () - "Run a semanticdb search routine with the profiler. -The expectation is that you will edit this fcn with different -`semanticdb-find-' routines." - (interactive) - (let ((elp-recycle-buffers-p nil) - (totalstart nil) - (totalstop nil) - ans time - ) - ;; reset - (semantic-clear-toplevel-cache) - (semantic-fetch-tags) - - ;; Path translation - (semantic-elp-include-path-enable) - (setq totalstart (current-time)) - - (setq ans (semanticdb-find-tags-by-name-regexp "task" nil)) - - (setq totalstop (current-time)) - (semantic-elp-results "") - (setq time semantic-elp-last-results) - (oset time :total (semantic-elapsed-time totalstart totalstop)) - ;; build it - (let ((elpobj (semantic-elp-object - "ELP" - :total (semantic-elapsed-time totalstart totalstop) - :time time - :answer ans))) - (data-debug-show elpobj) - (setq semantic-elp-last-run elpobj) - (let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") - "semantic.elp" nil "semantic.elp"))) - (oset elpobj :file saveas) - (eieio-persistent-save elpobj) - ) - ))) - -(defun semantic-elp-symref-hit-count () - "Run a `semantic-symref-test-count-hits-in-tag' with elp on." - (interactive) - (let ((elp-recycle-buffers-p nil) - (totalstart nil) - (totalstop nil) - ans time - ) - ;; reset - (semantic-clear-toplevel-cache) - (semantic-fetch-tags) - - ;; Build up caches so we get user use timings. - (semantic-analyze-current-context) - - ;; Enable everything for analysis. - (semantic-elp-analyze-symref-hits) - - ;; Do the analysis - (setq totalstart (current-time)) - - (setq ans (semantic-symref-test-count-hits-in-tag)) - - (setq totalstop (current-time)) - - (semantic-elp-results "") - (setq time semantic-elp-last-results) - (oset time :total (semantic-elapsed-time totalstart totalstop)) - ;; build it - (let ((elpobj (semantic-elp-object - "ELP" - :total (semantic-elapsed-time totalstart totalstop) - :time time - :answer ans))) - (data-debug-show elpobj) - (setq semantic-elp-last-run elpobj) -;;(let ((saveas (read-file-name "Save Profile to: " (expand-file-name "~/") -;; "semantic.elp" nil "semantic.elp"))) -;; (oset elpobj :file saveas) -;; (eieio-persistent-save elpobj) -;; ) - ))) - -(defun semantic-elp-show-last-run () - "Show the last elp run." - (interactive) - (when (not semantic-elp-last-run) - (error "No last run to show")) - (data-debug-show semantic-elp-last-run)) - -(defun semantic-elp-load-old-run (file) - "Load an old run from FILE, and show it." - (interactive "fLast Run File: ") - (setq semantic-elp-last-run - (eieio-persistent-read file)) - (data-debug-show semantic-elp-last-run)) - -(provide 'semantic/elp) -;;; semantic/elp.el ends here
--- a/lisp/cedet/semantic/find.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/find.el Sun Sep 13 15:58:30 2009 +0000 @@ -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 @@ (nreverse result))) ;;; Top level Searches - +;; ;;;###autoload (defun semantic-find-first-tag-by-name (name &optional table) "Find the first tag with NAME in TABLE.
--- 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
--- a/lisp/cedet/semantic/java.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/java.el Sun Sep 13 15:58:30 2009 +0000 @@ -24,9 +24,6 @@ ;; ;; Common function for Java parsers. -;;; History: -;; - ;;; Code: (require 'semantic) (require 'semantic/ctxt) @@ -169,7 +166,7 @@ "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'." +See also `semantic-format-tag-prototype'." (let ((name (semantic-tag-name tag)) (type (semantic-java-type tag)) (tmpl (semantic-tag-get-attribute tag :template-specifier)) @@ -197,7 +194,7 @@ "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'." +See also `semantic-format-tag-prototype'." (let ((name (semantic-tag-name tag)) (type (semantic-java-type tag))) (concat (if color @@ -212,7 +209,7 @@ "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'." +See also `semantic-format-tag-prototype'." (let ((name (semantic-tag-name tag)) (type (semantic-tag-type tag)) (tmpl (semantic-tag-get-attribute tag :template-specifier))) @@ -222,7 +219,7 @@ name) (or tmpl "")))) -(define-mode-local-override semantic-format-prototype-tag +(define-mode-local-override semantic-format-tag-prototype java-mode (tag &optional parent color) "Return a prototype for TOKEN. Optional argument PARENT is a parent (containing) item. @@ -235,7 +232,7 @@ tag parent color))) (semantic-alias-obsolete 'semantic-java-prototype-nonterminal - 'semantic-format-prototype-tag-java-mode) + 'semantic-format-tag-prototype-java-mode) ;; Include Tag Name ;;
--- a/lisp/cedet/semantic/lex-spp.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/lex-spp.el Sun Sep 13 15:58:30 2009 +0000 @@ -834,14 +834,18 @@ (nreverse toks))))) +(defvar semantic-lex-spp-hack-depth 0 + "Current depth of recursive calls to `semantic-lex-spp-lex-text-string'.") + (defun semantic-lex-spp-lex-text-string (text) "Lex the text string TEXT using the current buffer's state. Use this to parse text extracted from a macro as if it came from the current buffer. Since the lexer is designed to only work in a buffer, we need to create a new buffer, and populate it with rules and variable state from the current buffer." - ;; @TODO - will this fcn recurse? - (let* ((buf (get-buffer-create " *SPP parse hack*")) + (let* ((semantic-lex-spp-hack-depth (1+ semantic-lex-spp-hack-depth)) + (buf (get-buffer-create (format " *SPP parse hack %d*" + semantic-lex-spp-hack-depth))) (mode major-mode) (fresh-toks nil) (toks nil)
--- a/lisp/cedet/semantic/tag.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/tag.el Sun Sep 13 15:58:30 2009 +0000 @@ -42,9 +42,6 @@ ;; III. Tag Comparison. Allows explicit or comparitive tests to see ;; if two tags are the same. -;;; History: -;; - ;;; Code: ;;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/semantic/wisent/java-tags.el Sun Sep 13 15:58:30 2009 +0000 @@ -0,0 +1,125 @@ +;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs + +;;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009 +;;; Free Software Foundation, Inc. + +;; Author: David Ponce <david@dponce.com> +;; Maintainer: David Ponce <david@dponce.com> +;; Created: 15 Dec 2001 +;; Keywords: syntax + +;; 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: +;; + +;;; History: +;; + +;;; Code: + +(require 'semantic/wisent) +(require 'semantic/wisent/javat-wy) +(require 'semantic/java) + +;;;; +;;;; Simple parser error reporting function +;;;; + +(defun wisent-java-parse-error (msg) + "Error reporting function called when a parse error occurs. +MSG is the message string to report." +;; (let ((error-start (nth 2 wisent-input))) +;; (if (number-or-marker-p error-start) +;; (goto-char error-start))) + (message msg) + ;;(debug) + ) + +;;;; +;;;; Local context +;;;; + +(define-mode-local-override semantic-get-local-variables + java-mode () + "Get local values from a specific context. +Parse the current context for `field_declaration' nonterminals to +collect tags, such as local variables or prototypes. +This function override `get-local-variables'." + (let ((vars nil) + ;; We want nothing to do with funny syntaxing while doing this. + (semantic-unmatched-syntax-hook nil)) + (while (not (semantic-up-context (point) 'function)) + (save-excursion + (forward-char 1) + (setq vars + (append (semantic-parse-region + (point) + (save-excursion (semantic-end-of-context) (point)) + 'field_declaration + 0 t) + vars)))) + vars)) + +;;;; +;;;; Semantic integration of the Java LALR parser +;;;; + +;;;###autoload +(defun wisent-java-default-setup () + "Hook run to setup Semantic in `java-mode'. +Use the alternate LALR(1) parser." + (wisent-java-tags-wy--install-parser) + (setq + ;; Lexical analysis + semantic-lex-number-expression semantic-java-number-regexp + semantic-lex-analyzer 'wisent-java-tags-lexer + ;; Parsing + semantic-tag-expand-function 'semantic-java-expand-tag + ;; Environment + semantic-imenu-summary-function 'semantic-format-tag-prototype + imenu-create-index-function 'semantic-create-imenu-index + semantic-type-relation-separator-character '(".") + semantic-command-separation-character ";" + ;; speedbar and imenu buckets name + semantic-symbol->name-assoc-list-for-type-parts + ;; in type parts + '((type . "Classes") + (variable . "Variables") + (function . "Methods")) + semantic-symbol->name-assoc-list + ;; everywhere + (append semantic-symbol->name-assoc-list-for-type-parts + '((include . "Imports") + (package . "Package"))) + ;; navigation inside 'type children + senator-step-at-tag-classes '(function variable) + ) + ;; Setup javadoc stuff + (semantic-java-doc-setup)) + +;;;###autoload +(add-hook 'java-mode-hook 'wisent-java-default-setup) + +(provide 'semantic/wisent/java-tags) + +;; Local variables: +;; generated-autoload-file: "../loaddefs.el" +;; generated-autoload-feature: semantic/loaddefs +;; generated-autoload-load-name: "semantic/wisent/java-tags" +;; End: + +;;; semantic/wisent/java-tags.el ends here
--- a/lisp/cedet/semantic/wisent/java.el Fri Sep 11 01:17:46 2009 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,114 +0,0 @@ -;;; semantic/wisent/java.el --- Java LALR parser for Emacs - -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009 -;; Free Software Foundation, Inc. - -;; Author: David Ponce <david@dponce.com> -;; Maintainer: David Ponce <david@dponce.com> -;; Created: 19 June 2001 -;; Keywords: syntax - -;; 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: -;; - -;;; History: -;; - -;;; Code: - -(require 'semantic/wisent) -(require 'semantic/wisent/java-wy) -(require 'semantic/java) - -;;; Enable Semantic in `java-mode'. -;; -(defun wisent-java-init-parser-context () - "Initialize context of the LR parser engine. -Used as a local `wisent-pre-parse-hook' to cleanup the stack of enum -names in scope." - (setq wisent-java-wy--enums nil)) - -(defun wisent-java-default-setup () - "Hook run to setup Semantic in `java-mode'." - ;; Use the Wisent LALR(1) parser to analyze Java sources. - (wisent-java-wy--install-parser) - (semantic-make-local-hook 'wisent-pre-parse-hook) - (add-hook 'wisent-pre-parse-hook - 'wisent-java-init-parser-context nil t) - (setq - ;; Lexical analysis - semantic-lex-number-expression semantic-java-number-regexp - semantic-lex-depth nil - semantic-lex-analyzer 'wisent-java-lexer - ;; Parsing - semantic-tag-expand-function 'semantic-java-expand-tag - ;; Environment - semantic-imenu-summary-function 'semantic-format-tag-prototype - semantic-imenu-expandable-tag-classes '(type variable) - imenu-create-index-function 'semantic-create-imenu-index - semantic-type-relation-separator-character '(".") - semantic-command-separation-character ";" - ;; speedbar and imenu buckets name - semantic-symbol->name-assoc-list-for-type-parts - ;; in type parts - '((type . "Classes") - (variable . "Variables") - (function . "Methods")) - semantic-symbol->name-assoc-list - ;; everywhere - (append semantic-symbol->name-assoc-list-for-type-parts - '((include . "Imports") - (package . "Package"))) - ;; navigation inside 'type children - senator-step-at-tag-classes '(function variable) - ) - ;; Setup javadoc stuff - (semantic-java-doc-setup)) - -(add-hook 'java-mode-hook 'wisent-java-default-setup) - -;;; Overridden Semantic API. -;; -(define-mode-local-override semantic-tag-components java-mode (tag) - "Return a list of components for TAG." - (if (semantic-tag-of-class-p tag 'function) - (semantic-tag-function-arguments tag) - ;; Simply return the value of the :members attribute. - (semantic-tag-get-attribute tag :members))) - -(define-mode-local-override semantic-get-local-variables - java-mode () - "Get local variable declarations from the current context." - (let (result - ;; Ignore funny syntax while doing this. - semantic-unmatched-syntax-hook) - (while (not (semantic-up-context (point) 'function)) - (save-excursion - (forward-char 1) - (push (semantic-parse-region - (point) - (save-excursion (semantic-end-of-context) (point)) - ;; See this production in wisent-java.wy. - 'block_statement - nil t) - result))) - (apply 'append result))) - -(provide 'semantic/wisent/java) - -;;; semantic/wisent/java.el ends here
--- a/lisp/cedet/semantic/wisent/js-wy.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/cedet/semantic/wisent/js-wy.el Sun Sep 13 15:58:30 2009 +0000 @@ -20,7 +20,7 @@ ;;; Commentary: ;; ;; This file was generated from the grammar file -;; semantic/wisent/javascript-jv.wy in the CEDET repository. +;; semantic/wisent/wisent-javascript-jv.wy in the CEDET repository. ;;; Code: (require 'semantic/lex)
--- a/lisp/emacs-lisp/eieio-comp.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/emacs-lisp/eieio-comp.el Sun Sep 13 15:58:30 2009 +0000 @@ -32,70 +32,24 @@ ;;; Code: -(eval-and-compile - (if (featurep 'xemacs) - (progn - ;; XEmacs compatibility settings. - (if (not (fboundp 'byte-compile-compiled-obj-to-list)) - (defun byte-compile-compiled-obj-to-list (moose) nil)) - (if (not (boundp 'byte-compile-outbuffer)) - (defvar byte-compile-outbuffer nil)) - (defmacro eieio-byte-compile-princ-code (code outbuffer) - `(progn (if (atom ,code) - (princ "#[" ,outbuffer) - (princ "'(" ,outbuffer)) - (let ((codelist (if (byte-code-function-p ,code) - (byte-compile-compiled-obj-to-list ,code) - (append ,code nil)))) - (while codelist - (eieio-prin1 (car codelist) ,outbuffer) - (princ " " ,outbuffer) - (setq codelist (cdr codelist)))) - (if (atom ,code) - (princ "]" ,outbuffer) - (princ ")" ,outbuffer)))) - (defun eieio-prin1 (code outbuffer) - (cond ((byte-code-function-p code) - (let ((codelist (byte-compile-compiled-obj-to-list code))) - (princ "#[" outbuffer) - (while codelist - (eieio-prin1 (car codelist) outbuffer) - (princ " " outbuffer) - (setq codelist (cdr codelist))) - (princ "]" outbuffer))) - ((vectorp code) - (let ((i 0) (ln (length code))) - (princ "[" outbuffer) - (while (< i ln) - (eieio-prin1 (aref code i) outbuffer) - (princ " " outbuffer) - (setq i (1+ i))) - (princ "]" outbuffer))) - (t (prin1 code outbuffer))))) - ;; Emacs: - (defmacro eieio-byte-compile-princ-code (code outbuffer) - (list 'prin1 code outbuffer)) - ;; Dynamically bound in byte-compile-from-buffer. - (defvar bytecomp-outbuffer) - (defvar bytecomp-filename))) - (declare-function eieio-defgeneric-form "eieio" (method doc-string)) -(defun byte-compile-defmethod-param-convert (paramlist) - "Convert method params into the params used by the defmethod thingy. -Argument PARAMLIST is the paramter list to convert." - (let ((argfix nil)) - (while paramlist - (setq argfix (cons (if (listp (car paramlist)) - (car (car paramlist)) - (car paramlist)) - argfix)) - (setq paramlist (cdr paramlist))) - (nreverse argfix))) +;; Some compatibility stuff +(eval-and-compile + (if (not (fboundp 'byte-compile-compiled-obj-to-list)) + (defun byte-compile-compiled-obj-to-list (moose) nil)) + + (if (not (boundp 'byte-compile-outbuffer)) + (defvar byte-compile-outbuffer nil)) + ) ;; This teaches the byte compiler how to do this sort of thing. (put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) +;; Variables used free: +(defvar outbuffer) +(defvar filename) + (defun byte-compile-file-form-defmethod (form) "Mumble about the method we are compiling. This function is mostly ripped from `byte-compile-file-form-defun', but @@ -126,14 +80,18 @@ (lamparams (byte-compile-defmethod-param-convert params)) (arg1 (car params)) (class (if (listp arg1) (nth 1 arg1) nil)) - (my-outbuffer (if (featurep 'xemacs) + (my-outbuffer (if (eval-when-compile (featurep 'xemacs)) byte-compile-outbuffer - bytecomp-outbuffer))) + (condition-case nil + bytecomp-outbuffer + (error outbuffer)))) + ) (let ((name (format "%s::%s" (or class "#<generic>") meth))) (if byte-compile-verbose - ;; bytecomp-filename is from byte-compile-from-buffer. - (message "Compiling %s... (%s)" (or bytecomp-filename "") name)) - (setq byte-compile-current-form name)) ; for warnings + ;; #### filename used free + (message "Compiling %s... (%s)" (or filename "") name)) + (setq byte-compile-current-form name) ; for warnings + ) ;; Flush any pending output (byte-compile-flush-pending) ;; Byte compile the body. For the byte compiled forms, add the @@ -149,8 +107,9 @@ (princ key my-outbuffer) (prin1 params my-outbuffer) (princ " " my-outbuffer) - (eieio-byte-compile-princ-code code my-outbuffer) - (princ "))" my-outbuffer)) + (prin1 code my-outbuffer) + (princ "))" my-outbuffer) + ) ;; Now add this function to the list of known functions. ;; Don't bother with a doc string. Not relevant here. (add-to-list 'byte-compile-function-environment @@ -165,6 +124,18 @@ ;; nil prevents cruft from appearing in the output buffer. nil)) +(defun byte-compile-defmethod-param-convert (paramlist) + "Convert method params into the params used by the defmethod thingy. +Argument PARAMLIST is the paramter list to convert." + (let ((argfix nil)) + (while paramlist + (setq argfix (cons (if (listp (car paramlist)) + (car (car paramlist)) + (car paramlist)) + argfix)) + (setq paramlist (cdr paramlist))) + (nreverse argfix))) + (provide 'eieio-comp) ;;; eieio-comp.el ends here
--- a/lisp/emacs-lisp/eieio-datadebug.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/emacs-lisp/eieio-datadebug.el Sun Sep 13 15:58:30 2009 +0000 @@ -121,6 +121,10 @@ (setq publa (cdr publa) publd (cdr publd))) ))) +;;; Augment the Data debug thing display list. +(data-debug-add-specialized-thing (lambda (thing) (object-p thing)) + #'data-debug-insert-object-button) + ;;; DEBUG METHODS ;; ;; A generic function to run DDEBUG on an object and popup a new buffer.
--- a/lisp/emacs-lisp/eieio.el Fri Sep 11 01:17:46 2009 +0000 +++ b/lisp/emacs-lisp/eieio.el Sun Sep 13 15:58:30 2009 +0000 @@ -36,8 +36,6 @@ ;; is the only way I seem to be able to make this stuff load properly. ;; @TODO - fix :initform to be a form, not a quoted value -;; @TODO - For API calls like `object-p', replace with something -;; that does not conflict with "object", meaning a lisp object. ;; @TODO - Prefix non-clos functions with `eieio-'. ;;; Code: @@ -53,7 +51,7 @@ (message eieio-version)) (eval-and-compile -;; Abount the above. EIEIO must process it's own code when it compiles +;; About the above. EIEIO must process it's own code when it compiles ;; itself, thus, by eval-and-compiling outselves, we solve the problem. ;; Compatibility @@ -109,7 +107,10 @@ (defvar eieio-initializing-object nil "Set to non-nil while initializing an object.") -(defconst eieio-unbound (make-symbol "unbound") +(defconst eieio-unbound + (if (and (boundp 'eieio-unbound) (symbolp eieio-unbound)) + eieio-unbound + (make-symbol "unbound")) "Uninterned symbol representing an unbound slot in an object.") ;; This is a bootstrap for eieio-default-superclass so it has a value @@ -2744,6 +2745,10 @@ '(cedet-edebug-prin1-recurse object) ) )) +;; Done in cedet/data-debug.el: +;; (eval-after-load "data-debug" +;; '(require 'eieio-datadebug)) + ;;; Interfacing with imenu in emacs lisp mode ;; (Only if the expression is defined) ;;