From a964f5e552c64a53fb4b5c417f1825807cdcca6f Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 13 Sep 2009 15:58:30 +0000 Subject: [PATCH] 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. --- lisp/ChangeLog | 58 ++ lisp/cedet/cedet-edebug.el | 3 + lisp/cedet/cedet.el | 24 +- lisp/cedet/data-debug.el | 59 +- lisp/cedet/semantic/adebug.el | 42 +- lisp/cedet/semantic/analyze.el | 20 + lisp/cedet/semantic/bovine/c.el | 25 +- lisp/cedet/semantic/db-find.el | 1 + lisp/cedet/semantic/db-global.el | 1 - lisp/cedet/semantic/elp.el | 775 ------------------ lisp/cedet/semantic/find.el | 4 +- lisp/cedet/semantic/format.el | 169 ++-- lisp/cedet/semantic/java.el | 13 +- lisp/cedet/semantic/lex-spp.el | 8 +- lisp/cedet/semantic/tag.el | 3 - .../semantic/wisent/{java.el => java-tags.el} | 111 +-- lisp/cedet/semantic/wisent/java-wy.el | Bin 46580 -> 0 bytes lisp/cedet/semantic/wisent/javat-wy.el | Bin 0 -> 19194 bytes lisp/cedet/semantic/wisent/js-wy.el | 2 +- lisp/emacs-lisp/eieio-comp.el | 101 +-- lisp/emacs-lisp/eieio-datadebug.el | 4 + lisp/emacs-lisp/eieio.el | 13 +- 22 files changed, 352 insertions(+), 1084 deletions(-) delete mode 100644 lisp/cedet/semantic/elp.el rename lisp/cedet/semantic/wisent/{java.el => java-tags.el} (54%) delete mode 100644 lisp/cedet/semantic/wisent/java-wy.el create mode 100644 lisp/cedet/semantic/wisent/javat-wy.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 060c238c725..984110fd65e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,61 @@ +2009-09-13 Chong Yidong + + 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 * emacs-lisp/autoload.el (make-autoload): Handle defclass form. diff --git a/lisp/cedet/cedet-edebug.el b/lisp/cedet/cedet-edebug.el index 3b6bcf7148c..09af834853c 100644 --- a/lisp/cedet/cedet-edebug.el +++ b/lisp/cedet/cedet-edebug.el @@ -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).") diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index e089407a195..2ff55dc8258 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -24,26 +24,22 @@ ;; along with GNU Emacs. If not, see . ;;; 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 "/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 "/cedet/common/cedet.el") +;; (global-ede-mode t) +;; (semantic-load-enable-code-helpers) +;; (global-srecode-minor-mode 1) (eval-when-compile (require 'cl)) diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index a82e4dbac29..d132e47fc9a 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -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 diff --git a/lisp/cedet/semantic/adebug.el b/lisp/cedet/semantic/adebug.el index fa474d3a0f2..cbe2985f6e5 100644 --- a/lisp/cedet/semantic/adebug.el +++ b/lisp/cedet/semantic/adebug.el @@ -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 diff --git a/lisp/cedet/semantic/analyze.el b/lisp/cedet/semantic/analyze.el index 2beb41319ea..7d8143e3a69 100644 --- a/lisp/cedet/semantic/analyze.el +++ b/lisp/cedet/semantic/analyze.el @@ -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 ;; diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index 2cd872a723c..5ab658d6af7 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -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. diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 1066ffd642f..817d716ab74 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -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. diff --git a/lisp/cedet/semantic/db-global.el b/lisp/cedet/semantic/db-global.el index b32255e7f1b..cf91a0498f4 100644 --- a/lisp/cedet/semantic/db-global.el +++ b/lisp/cedet/semantic/db-global.el @@ -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)) ) diff --git a/lisp/cedet/semantic/elp.el b/lisp/cedet/semantic/elp.el deleted file mode 100644 index a9f8354fd07..00000000000 --- a/lisp/cedet/semantic/elp.el +++ /dev/null @@ -1,775 +0,0 @@ -;;; semantic/elp.el --- Bind ELP to measure Semantic - -;;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; 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 diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index 4ab6a8d8a62..0a7475081be 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -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. diff --git a/lisp/cedet/semantic/format.el b/lisp/cedet/semantic/format.el index f967740ad2b..b13673318d2 100644 --- a/lisp/cedet/semantic/format.el +++ b/lisp/cedet/semantic/format.el @@ -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 )) + +;;; 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 ;; diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index 3a57c65792d..b7f2e9a16b0 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -24,9 +24,6 @@ ;; ;; Common function for Java parsers. -;;; History: -;; - ;;; Code: (require 'semantic) (require 'semantic/ctxt) @@ -169,7 +166,7 @@ corresponding compound declaration." "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 @@ See also `semantic-format-prototype-tag'." "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 @@ See also `semantic-format-prototype-tag'." "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 @@ See also `semantic-format-prototype-tag'." 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 @@ Optional argument COLOR indicates that color should be mixed in." 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 ;; diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 39258f550d3..de0f6fa61d4 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -834,14 +834,18 @@ Parsing starts inside the parens, and ends at the end of TOKEN." (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) diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index febe4046f84..015efb24fd9 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -42,9 +42,6 @@ ;; III. Tag Comparison. Allows explicit or comparitive tests to see ;; if two tags are the same. -;;; History: -;; - ;;; Code: ;; diff --git a/lisp/cedet/semantic/wisent/java.el b/lisp/cedet/semantic/wisent/java-tags.el similarity index 54% rename from lisp/cedet/semantic/wisent/java.el rename to lisp/cedet/semantic/wisent/java-tags.el index af7c33ffe40..ff5e0634d96 100644 --- a/lisp/cedet/semantic/wisent/java.el +++ b/lisp/cedet/semantic/wisent/java-tags.el @@ -1,11 +1,11 @@ -;;; semantic/wisent/java.el --- Java LALR parser for Emacs +;;; semantic/wisent/java-tags.el --- Java LALR parser for Emacs -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009 -;; Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2009 +;;; Free Software Foundation, Inc. ;; Author: David Ponce ;; Maintainer: David Ponce -;; Created: 19 June 2001 +;; Created: 15 Dec 2001 ;; Keywords: syntax ;; This file is part of GNU Emacs. @@ -32,34 +32,65 @@ ;;; Code: (require 'semantic/wisent) -(require 'semantic/wisent/java-wy) +(require 'semantic/wisent/javat-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)) +;;;; +;;;; 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 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) + "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-depth nil - semantic-lex-analyzer 'wisent-java-lexer + 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 - semantic-imenu-expandable-tag-classes '(type variable) imenu-create-index-function 'semantic-create-imenu-index semantic-type-relation-separator-character '(".") semantic-command-separation-character ";" @@ -80,35 +111,15 @@ names in scope." ;; Setup javadoc stuff (semantic-java-doc-setup)) +;;;###autoload (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))) +(provide 'semantic/wisent/java-tags) -(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 +;; 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 diff --git a/lisp/cedet/semantic/wisent/java-wy.el b/lisp/cedet/semantic/wisent/java-wy.el deleted file mode 100644 index 0c8de5527e2b556c240379fa9677bafc610a89a2..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 46580 zcmeHw{dOBSlJEUDKKl?D9Zw`rOga9}${MX{nYMW&OBzYej5p43D6%E-nj#f8X8ij0^=VE=7eaLmga`J9M4RzJ2I1^KPab@!SQTbn8DO^ zNBvvli8&wl2Pc=*5X#Uzq?(=;W?D?nOKOQ8h`h)?H2bsT;h<-B2EAfb7N!fHsH8lD zR*sntVbsf23{XEY?}|wYIn7m*T6apEPt5p&^l=01UYa3v?@=?72LbzL zFk;rv#upIg4Adar`@wK%jtes@i<8;#Cba`?n7_7qh{d zo{dpkyeov%;QV4ZfRyN}39RH2oD+qYt%L0sKxsZ{@3fCzgMag^eYD#;JT%Yt4ouVR zHxG{5+pl(-2WJ1(!T#Q1Yu%Vb^br(61mggXe9(J!Xm!O-^hYxHOd-iCd1)_qr? zXM4rq9XRWn9?Z{aw4N@t+8vHZr!1s0CS%$sW;CAO#7HR2=Gk<5v2p9x`}gnHPe-%$ z@#ORt`kwl|ytT#pCxbsf$581`E;m4yCJfW9DQsKIc9;opjI7yAv5TKuAZO z488^pzV-K)t|zx!Pg_Tj^oEI!=0cI{ul(Ic}z z84t&&Gg3EkcsT9$-jbS%(d^uey5~hnt(4GSv3|{%wSIB(4h$+r-~}2D0x!*IFuVaE zO{Y5=k1o&0v(og2-Lgb?;a_+PST4pRjcTHgL0Ejam=q;h{=9aGoNY(=f2!z_48&j$ zFl5r?s90Cb;@jf#{dm%EOuNT$Nf5>9qXB(1&bx1mMhaq9*Vb0L$M6l^-gL#Ro92_l zql4!55lM;vP+7v+N!8(D>mXDdkH^EJJ0hefdwV;r=B~#%o)q1;TyfB9ejkc2rv;b3 zK5F^GUbp1J?dG8_oc7KLbh~-9{UX4gbthcy#3#iSxG-rGG4Ttjoy z!DuE;?(H76cVC5Oq1orgcucbW5N zJA2K*H@pZ#?*)aOj;Acl^Sz@W&ftW=+Rr>a@^}S}ZsxE3a(}1wvbB2@SOfs3KgN2w zzo!gi0L6Dly<#jRq5bCWc56?O9tqlRU~@2ncR%U&SfTCRqt?N*=6292`73H^XK(kp z=Wv8E_Kp#Dn@8;*0`#bOPr$pazk1jU4EpXV1MfGtzi&Pd&=-@zJIpPFv47D1p{Z>1 zVlti1@IyL3gZcy3YI;R~%X=nH`d z5rVETUwA?^XZNNj7gBZ5-adM^A1Y@T1$XY@tNm8!-V&3S44y+wZff+Dm!saLL>$!G(TjHI>M77zrAL4dO66h;jdBH#IkFtUc9;_8)WbGR z$1^^iumv9-1nYe_9H6+Olz%UFl4V2Y2+0mh9Kw=rhC#sEDTh(qYW3AdF?uvJgH)2^jQ)lZv8 z%@q6Dpct}}Es1CC)=p6N<9>nZsYekm(|Ow3KWM@I!Zw%?O%xFfP0{^vPv!}lYkoGj z?;yOwFuV2@O&!xqgkLAKQIDoVgE@6T^U@8jL}X{CLYO8QD}?1RNBOpMKr^HO<7k|98F9<%>Q{z#m!&X@r4vNW! zao}c?SlTk1)Wch5eSKY%B;W1Hy)58>`v}%)4m5;DWCr~#E>8s>6;I|DmZseL)%*x& z)H_?-M8};&%20vUe=n0#ie4dydex96eTzHBi>Bnt~G$*qj7A9JY z8(8mP+APf`uM3Vye>Y>zF@RDXKO5;*qdF~~xqbV(I9LO;15>cQK#P%e)t?c{oIZ6y zL}-hn3U6}1pmUG`*yM#sgY9rbY_DYNK>yfa+86)yYv`X4*Z2n1GDq`k10eGYEAgX` z6F&;`zhO8g{7sC>{Tk?s?9yATso@&0Y^{NHaucVyN^aa90yWMYjvdyFmD=E!fa{F?|NS zB6Szjd+PgA5|2U~`ddQ@-QboF9$O6=yM9*+7U+5ILDndqTD@WX>zzAy?>@Zq?cE38 z-M{zn;r;KvWizQ3YoqaouWW&u;6+m`um`P(jG6>JZ@PDG-+OrPySoqWF=PHI;>WK3 zg1lUSBqcAjG)Luzk+q_ME9cs+&1l0qBIS_QH(tglvBDJX^3-{NAKAI8Nr0BL zp5)*pct|^6{zxlzJ7Fp`Ssr`DS0iK$X*xp)PI)%UumtvbdF^2-Ww-X@=3q3KickFM zk#VD%e$6hB;Vo>Ho3|A)S;BjA``)FTP|aX;+PD~_53Ps6V&QaHG$?8xNIvyW;~1IF zcB|Dg5AWYoF30B$JneX@r8%QApDM;A8{v_;e?Gn}&X19jRrxM8UYMF2&+~k>Pl9;r z-0#xFTobUEwf!$S7f-fD`98&L5Kl5T9x!7n%2EQF%K&-A1^p%Ps=prGtLrbyHhHp3 zM0GxK<&k6p5A!tz9*~~%TYgGbGjhm_c@nM&hCA#Y7sIV+X5yJ&aXEjS@a(OiWrVBV z*s$4C2{40_dz|v~Jdr!d`mELevr2RA>VN;&f34myYv0ntgZuaI-dCf5<4MItJO<`O zn?~`&=}ON}s^di=47ZRR4Z8H_8s=Zx9@28Ycs4KouBg^<@2;2IM^u?3fHl6pUeu{%Q)%6Ln;NjT(GCq+n@LIV4H0Q<|U)*)r%sQBMP@vDQw7wu<9LSbubOVO}Zgn){G5@RR?sSx-8 z{@f8)kk46Die~FC!oi;vkSz(6b}Xe$1+=5s->g;;Gn<>51eb(@!`938_8t=HRPM(k zcC205Mu2^atUC9{EyVx|3H6o&+hgfecfZ88%Aue(6e<_93I{}JTZUq_%^ z6iQz1S>!(|WE2wE9|PDfb`)5@e^6j3B(OiM1jo@Ej!Oi3I3^Ir-oX=W(|u2nKLvtZ z*rLK;RUs1EE$(i(azCE2-8o7~?s$?v25c^5lE0`zPjXF>JRXjFZ@qJ1Vx1>Dd&1?K zr7nE?Nd;aCa&n>WvzJE9X8&dp=*2N^9wqe z!rQnevqx@^xe%PSiZ#2TY*8C_uU<$%vAPFzuj!uN(Y<1<@mRBrEWnVR%K)H(AtQzc zmmOpH2V;W=rX909!u?RE9{><1A?`!D7ygOrr)Y#6mUuGpalr#((2F~@{{Vr#1O8?I z46n`3-1>Px54edU%q4!Zp?OFqDE#1wisw0=|NQKTc{7@G)A>A1`PdNDK?2ZpXyJG3 z4R*ecanMH`~ze zHSbm%yEQF4(eiiawc%Z6KIB5%$k;eGVT+i4VtdoH{njsj(xcthEeqG`x{$?5?5TAvCfdXzb>n>G*9vWB2q7_S0JULpyf#oA%$_zqAkMe)E2t z>8Oo0J2>f7iTk;BI_?gyeYLhGgOKB`&I}0!za4=6vf%)U9|4OE0s|SSi8)DOY)De3 zjZo942$u-?oMwkg1P8lC1?Hh%Vau#z1y?aN;ltNr-?FE$-ANJ9631jBAVNZdgO_*; z%cVa$oc^dZ9AU5m=zs~ULiXADC(KXE_z(dX(SXo$XWAiha-xDUWOQhpSRVw=Yu(Ox z(jmS$Kc_^Y^JAA42}r#iw~0tJf(OuTRVfoJZOMpa)q40dUek5DlT&oYXxhPXy=mt* zJ4QytHWzGdgw?OPe%oBXW3Jyd*YBC@_vbgvBIKpLDlbrMg@tP4&L*oeR4oa z8Sd{!+}lVjVPjeL?hqCg2V zA2i131jiu@t&A1Iq8N;`31KxtWb9^cM`h|oJ+j+dE$8lupo1tGV$=q|p@Nf09ESFvBiIG!?V_Z68(tYoW)RA}qHE>WEDKOcvM%as>#%vIizEy<8=pxlg zRnb`SvfllYY~je@aMmvXlH zMLXHm;nW@BZ5J{!lzx4KYZX$_d)bIE&3`HX9AgCdvBQU+t zNYOQ=-?d|y?gjGAeL!9N%43lCtkNeUlJ*gTJ{ja5<&3__CdcLZw|{empX9v>{%PM1 z5CnbZolAU1NXYwh<^qoF8=tx7r=W1nccnWcEs$ny&MkObS(5XC)B-62ac+2@u$VBo zw*;w>29C%5OK{=6T5o(+Pe(?=i%5*=hv)`$gjpM$*k9bo*z>)9pVpVUkaqfQu`925 zN%+kIFO1OXmhuAUQ7~PB)II9p(8DYtX~(UBL^9%wC6m=81?>q=VxCM#0|kWveb-*D$8^1Uyg_ zwgmg225rhc6l%vI24%Na$e3~}SE!NzaEb^OTKS>0(h~To;zm#`7JS3-(yWeX&Vk{r z#TpK_P}34gov*5@I}c}H-Rsa8)9fjwW6abjT_Xfm&iQbZt`q+va|Kd^I4g>@ht^#mSX`pZS+A4-WA6W!(kyb({w;UsbX)BfGuq`ap6o6k^$9 z01ygeLH3~YuCm^AQ}1tGi#K8Kz~rc6Wwu~=)@p86t$1DHG{@yg6dS+u*%nX`kSJ&bt?6MyvGaI_Dc04tFZhd*uNx8GIJV&AhNkDNzLbLXbQV zJI##MFYgqclzbo;(Iu~PtBY^5AyZh1_vgVr`@di*j)+zjX*E;M-4Z#843KjbnX1sO zB79j)d;N*1bFJ6!+MifAliuM_d=(xi#VJnBA*>bL$nVURrbd{~pwIjeAtEXB2kqWT zOWY1QUi`>v0|XckQv6);IO+ld(8f^+uMQow0H2$!Z9kocT?hKdE5?sfxOG4lh8s^JlG-dlmI8G^ zTESGEmRJWVgig1lbzUK~ri_;eDJV5w7rVK+Iuk9qKAXQra1$4=&2HN@7fa)VNAZ*n zP(?#uuyN?1CPrfua2oJO9D^CNBENw6)C;oufuvXfB+H&e8^0kVI2=`@3bRpREsTyZ z6RY7Mg?bQ437M4K7-AP2WM6EqtWFoFgA46YR86%2T(_n<6 z9BM@+sQfC4uq6m(e+8FO&3zHB-NF$Pz*(c?%MgqmPP}Hmm`xkqsk_Gxy%0~&YSN81 zCD4ANCt5kn8~c8=AVMc@ycuyOo`g>Uqo4|xt_27m^L?_lyTFTOhmWPj1n<#91nANg zQ{d%_V-?UCaS<2%)`nuQZoIIdwLzF7;8pc|Yv3N4QdI-4IH!S1gyvKi2WdprtLuK9 zy22RFYlG}YZN-1q^q-;g`SX8X05^DDrtbr;IP49k9WCTw^lpqufZp)q0otK4EZ2g$ zH#DGGw~b&!m?a5@Z3q_}Si~h-;>EPjde%}3sBD?=3ohx)uJFT5{8Bw^i=?I_euEg1CJ^+jWV~P927-jG98I{tiPyY+ueZ- zBDuk8>>mIV_ZcdxyKd5p!Am)R83k_(2`HV-g=MjqT}{oUM5>(!pcKq0&-u`F&#HSN zqN*dNB|3*?(!$dB`8+gYktZx{gy=y?R=c+5UKj5q=@pDp0gzzVE#!SM??F^b10R*D zO4LiO=VzblUM+=?3HyXz*)h;MnIjqDT6t|wGU9ISi)AD$xl(G`&f$JFs#2*gzitNt z_t0GM44}O4m#N4U<@L|egG!GYgPdF=kkYy0w7SBw3jatsDSXEsjp4EUDT^Sp!X#JBD*x-Ze`p56 z7FK*tq0#a4ByOdv@)&}EDeGgGw-w#64WeSk48Gs+lF!?L9b$4KFX#BT|}Ern>J-t-Nqzs_+&$E2Jeb``Cq=_>xTs?&p&kNl1|*#-@z@8gCTBM z>6A0vXl~c3GNAYZBb=a5iU%hhT*N=BE2e9o(mK9bGc80$I8#(~duO^h3=+>qXEg5c zrO+KZi21ofX=)<36EK#f3YSP#1&AcfR>#uDAUVnB_8RGeJ*bF*bk6irtCH%&)@@oN zw=$)reW*IN3cfWdErdJg8{*S)xur2J)fZ}}b)3qr6izCF$c0H7Fz73hoa7GC9F)U8 z5RRx~-~_2wn{xGml79}W?z{P9G^Cz*;u=w(NZm?yQ&pwuV<0Us&6*P9#{n zrN!k$$1Xs0aTtl6)5&;tQ5svzgRFFkPlO9gqG#473n^xBe5CI}l=?t_t~kW^JODA~ zc@SPBNt7%4%5+^8PVr$in}E@QFYnw|I-V&_^bECam@BK0|wlx)yy z!h=-g!RPa#^k2(t9R)i*x|t`H(Qbm|$ZAdpeT3b7G zL@ybc58PeGQ24kbK9Nx%PRbUuaQ0qrP0(T`z36F$fo_Y4IRETmg@fzRr8!$EJouUf z*_IOpxrEM&jqwfH!S$x0eu?tr5QfBrlV#z|C%4RUseIq_*sxZ$gE?&c%Ih)yaF?xp!dv zx`+wliizk=nPnEN)VOR#b@|&9!a>anSmf4#e%C$l%*TW2PyydXDD;vGx8~Qd@Sw9pS@3A5m`ZuhlGAP2d8br! z{R`;o*B1 zdi$Qh=d_>23p{uZNow~XYIIL5FpI8L=V}R$^N`=GwVHdejTPi-mwy`@v{}KR4QmK1 zIl8RT@)@Pq2ww5Q>Bs6@bpbd3`UuY>_8L(wsSY5h740R1I~3}2xQ`-$w8lG$JV@w~ zN_0YPGWG)RDjejwbGfZ(Xt2xHftSWjrpX}Aa-_VtpGhaDt>rifn4igl7bQ^qWNicz zpTShH6&qevP<0wXV;~_ZGXaHvx1amL~clhG@^kncst=QG@5o;ygTD$$k zEv>k@+@=^eT4BYw+t~F`CysMFXEh|krR|!?Y=ncy6`?h0lnpbUFmm)>OAV9RHdTBS`@i@@Ty4kDTb@! z(AOcVI6kpc!cAOvDQ2Ud=Lx@4X;m z%vR}Ek!~Z8#iJ+Yjl4k(PttHbs{3qCEqYL`CQ?zZu8f(hau6Xyc!)m_JQpRe(Ux9yHJ-L#6JJaHcG=v^rGw+Ug)$kSvfQm}>A&A4jz3*D#6WBQEsOa8)f89tP`GZXIlRt1I zKj{-kT9-ip3R1wOOGSl>Jb0{A)e#yT9fD0tyy+9D5ng!Gz`Q#2mv6Xah};SvidhU| zGIU~sNG-S!(Bny}KmBS${F-@8hcSp&rr0Lf;u@rBLT=vYRH_u}WwuOKQQSS~af1w= zWo60R>AiM*i~cw~w{$$7!56!o5Ok(b7tN7@Kd`~*o>=WyHexW<<`Ny{ne)tZiL;M5 zgO(TzLlT~Q5iy?Djf7L|@ueAh+a#li(sDGtMYAD^iF;t$1;t((5WeL!l2M7yk|%joCxH) zw4RJu2oZ{{u)<}PRCU6_a*{tgK)l(smxxB7xlB>0%_TIn`01i9Zt9;a*W-9wz`srp zITY4hC3WU%MO|My15>*eb%X!IKjs#GgM7Fu55*DHliupbvwc!LapONBlG)Osf zgi&g--{i~y3sAa9cP%W;kFYMTniKKV7a=nBxd{|fK`rxhF@yPKlMRl?c@1a<*QHWw znXAp!u+X)snOb_a7)_Ge7!YoR0&>_;~}-p)vJ64wn{j3OEz2L_*zI`v8X

Gq;^jPAq9g=eD32P;{jdvtnQ5yuwS8OSS?Xxg_Qi81odL5raE2 zQAQQa8plF7x+g#WC|HhGeK%C0BLks~m0VR(J-lOg=KIA-7u(FZ_wwE zc3!=b(Oy|i@0x{<(LxLFY?JbRB{4ISNaU^p+kAGVVr~=Eg1(6pUqR3W>Ts=n``x|Z zw}rdV^%-t6M^kH*P=Ta&t^3n#y4$ESuad`L8GzsDo~@|ev>&TVaS~{>U>vJ!r(=9W zA@k`_Q~ge-Jy4^ZfqWjPQs5kvsocNjzU`nhMO1Lw0u;H^%rp-UKh`mGtWVD$>S8wSjw-i|)Buca7^(VOQRU@i!_7GYwt} zuIw~-4py#xb09%cJ|a3`xEX*Koaq3#EXM)Y`J} z?5jQ9p77Z4JT@$km?`Pwtk@-$(JT7ivqEyG3ZFwj;*U|qAs3YR2|2ynti2|kF28#JmgTGm$9R@{8g?_+nK?Cfph zBt8ZcdT!+x)Y9SPmf^oi?T@zhd#?T7)(Z04%8eC2?F+GAQNUyz#80;1dvv8SNf+Vk zLe{Lk)~g*zVLvg6DdlRV&N05R60kL^JH&tr`6o;?6i+s2hAOL6LjQ1 za6^0X=FKWPkfq84opf=Tmx9`TwX>7Z8O?@6h9E+#A;eA8P-0qNWEb#u7<*d{hShdK z1*rxEHqk)&W`!-{5TBskeeO6-SXrt^@U6JxVzPXXSa{8k8@D`CrM?k@8)yr|pLB+= zG(Kq^)G#YLS){p(*{C<2@!}NfW7R}PBt?k|HInAr4)b*xV%O!LRUYlcE{ET+p~ud2 z{8uATxV}zPCR-G5&!Ol)T>`6T#f_jnb)ND)1mU zK8k52bz(h(-Rc~`Ejc$)pl{EDsrSJ|b3l&I81GjAK Z4;bnk*S)vm+Vx_HHDA9p&{c8me*l0<69xbP diff --git a/lisp/cedet/semantic/wisent/javat-wy.el b/lisp/cedet/semantic/wisent/javat-wy.el new file mode 100644 index 0000000000000000000000000000000000000000..0cbee2c086b3fdbaf964fe18d117ded5091a98d5 GIT binary patch literal 19194 zcmd5^{c_t#j=z7$bq~?2%8r@c$Vr^98OQ65BFl+xWXU7RnaL$t6)jOVHZW#M3XMji(P%Up0Qvm+bCpN4a9+gY`&V%u&5Qeg4==-_ zes#SQC8}Ppt5?xH%EBU=s709NQKs_cVv%Nrn#M`AwFL^zba9=<=NE+vns?Rig9p3! z=-+4RD2pOBNTlf()leqvjOz$dA5_J}-WgbnJ$vqke z(ojFOhp&65L)GZMRX;WQ{YH2A_BoJ?ixjQVWhA8H*&>NCODt6eeYghaMB%vAZ@xyC z#>;l6J$wuP)lqxcZ4CzMsMl8wb<*e$+s)HXqpwa*`zO6YYe%U8)(Ckua zAF2I|qFC(RzkhXgwR1jS?xflIeXKpLdw&0bNvNza!gbPYL-#z}~+3k}N&8cd?;7|*0CwACFC*zWcE z$LRVh%_d;#3>#aizzkEzF!fpZF{raZyt{s_}9#>^GXjyXcSqg4$V{ zCQ&%2wwJwLr`71XrYs6Saznq>_`!j%i-@6bhb;>nhdBeAje!p=#utRzYz&*P9qvV# zG4yq#?|?~|=M3#M1_K8saWJ^o9XPHbr6Qg$WyoH4*zTUXVIjqEnQ*Ve)=}fM-ePCcSFXIaX24GsgQ)A8{KBB=aHUEx31p@#&8;rS$6I2u+=|mG@bZp zd(%jrUiX#da1K?!Hni&!a0s?zVoixQlT7F+6AFlScE0#w&-t$YPv;($sIi zX?SY5$kHMj<18d{C;i^A)f~1C9Z^0#xDAWlZrX+{DwY{ZhE7B_cT zkN-<1GzV7$B?f>-VRN#Q7(T1?So&0OPq8pmQmvr zN1+qU3w=xzxzU?ef6(r^m3aYYB%E;*j=09LW%h+z%+bnfzKA}JBR)>tt9W z>LfH`(K!*lz?sCo1}&$GFY*}sM!;?C8OH=1u~-bkXwd4nJ(B=J)N~jYp{7U8hmB!l zwf9jRB`jo3;;7x~IAOn-L<^j~+^61Ptc>~?T`v`PrjC%*^3pl9#_)xSkW82qU)o|uB@lkv$BSyg4o&?xa;v?j8jFw zl7f>ec>T1k%a`P7UaK1aR>6MsX^|b=Rr`4{D-P6WHA&5L8RL1)+5%@&Ej8YCaLTRs zDA%Ys%J!5&SNp`$f!e1PK2SS5J3dLW-Im;O1Oq&QTT5r4qHaVco>cbbqri5>FZCP!YRmPwCB5`uNzLKg18c@@+j?LK?@ zohnjA56|wp$r~ePY3Qx;P8R-yzw#W8fM;lN8{=`5=PJQPKJnxvcwaXa&%6C1dE*Fw z?Fibn{xW?={7UM^r?=Ek1XA9G+V$6p;+DZ&A8c=L%jj#gCt$(eWFF*>VyWG%7~k*i zK6>{IGUXyf?4f2Fg3HE zH`!_%1hLe4-DQZ4DxiDbxc(Azv1BVWz*7J>Srfyt9lx*)g6}QE)5kY01I3Fh*;_bk zHuPjW$+_%~Ve%)i0vw^TC#`qTy2zF#VL;HwBs`0fgVKS+2fD}QX7%So*~6BN>uJQE zVw5#YH0Ge4<%xEAr77C}w{1E?xBurK|Jc5(f(P{D>60gqo_Na5ZlcFTS+zGfk;*N) z1RO0tt76{l>?lv*XB^J7gl?Qz{oyVf*N3~lRXvj!sqN0cs~5^fS}n5EQv`Pejve(BnfkDN0R~v+W$BUe4ojI*Do~Hlcr$(jjmiW$s2cUy=>8h~3lUm#zK? zsgG74F&2AkB7YSTNJ9@n?{@c91={uOEKMw0`w&sDHo`1@M`=OvkR^y~nstEj72R`i& zUbl~iLgC=xz@wp?r~?{YmvRrUgER=fLw{w6dzi0=jOCD8KMDtb@sKpcA$2sReGjSQ zvA@6GK*Q|s`y?3R0E5g?inQa6kux&Kx%g@t%X7bPU};dvpm(|0m=>|GA9KFb6tDazhyV zlShD{g!m_i*ytV#-nSkefcPI_e*0|+l|c@2+|!-^=ye8=(EjMqx(K(keE;B~0Z3?n zsJR_APSPA+5K_)=NA+JKEA<0mesBaC*dpL>9uU#q7B4ppqTTPvv(8sYb}Y$vt~Udj zJG_D8f&w_8$K&-#w^*AJ(TIZu)Dc9@K3AD&pGKRt~HUY;~Jh z)yg*CoK_-;*h@_;3-3^hKJj76=gh56B7aJ+-+$N{3 zUQ!BMy+q0y$>;(7gG8G`DWs}e_=l2V^h~KO^OsUw=9yDjYUJgt^u|;3I5CfbY%KP@ zMp)xw>zg3Z5s8s^XTf$vgM=*B;pAPTwiM3Ugjon4w2jJg|oon0DPYs>E*7zwOoIf;}V_-5j?<=Jd} z{q*!GoOr=v&2e?35$`-wcOFZAZgtkHi$QFa#-$Df1YIberIYJhFFVbWr2ttx-TDUqsUV)p1DD<4PIu?A zy7L4SsgYrHk=IZS-Xl7ecXj7sNr4>4n4%GzF;L~%G2`(B`F*-u-q|hbp^+%h)+6QF zurjp~>h0ixU{3Q4QEeQpDg*Y z_^;Hp_1!=WN-30*z2k32mu}sxn^oHgmQu2^Vw-)GuTn}=`#@#|c7-g>E^T4O4u=5A z*l6IIGD1BiIgGl{4vwjs6LWEa7zrEdoLCldR#cLE#_8eHJVmBPz73jox1z6uB z%Pp2~_I+?5uXkn?@*l*Tu?M!Nan#AVgiK>i&lw!Ym0P_FcB#l%& zp<-tTK^0u@tBNM(Pa;=*TIEpz@0j-h`^oa8k2ceiL#M<0(W)fPNr)jn_a@N^{|tEle7b+6v6g zLwWl$$5BstM7+~J_|LWvz4sxVI7uSU5(U+8N$bcD zL_zdJ`;C1tv^WkbP(xJWpca7%FeO04{o_%9a{~8Jlk{IJ)_v2H3WW&cvndVavd{s~C=5_BebrZmckIh7947 z>hn7s%)5Q3fq&Wfsh+w2b_OHpw_NyHPB4D7?_lvS{Q?O;>zJ?5bFZ&Ro4m2&&7G_R z@mO}k*1Sm1&JlKbaW`Q*DVIm67?Wa%o{6FbgVgQF)f z6wZ(V*50QN6?Fi~;ulr+;WK%yq1I`1`n9cZY@@I$c|b#v3i~O3pYto0LSGVvuHPg& zTcVPW=ULD3TJShRN&m_#ns`mrA8ShQWSXj(dU{50?Os<8T7Iw74NDYgkLR1ad*wE? z1bEZ5nI;L|fe_}H1Ww3_Z%c&u9<>zYTpG!)p5`W@K@UaP!DxYfQO8_y$t-_=SD5~_z9 zt6ISO8u!2~h{eYgYPu1xc*{t%C6(=h`ZZKDA^A_In8Em<0Y9)QT@edhcCE}`5=+jt z0|$7=2|X4Tn*<}E70GD)7169M6Z+H90y%j{P8IRQq!STy#}vL z0Tz8oL!Zd&Hk|vAjp=A_$e3`@K>fl6zD$!ux%v+{hWI|qbPC^NXRD1bxSY>Z#DEmu z)GVSLl^s!jPoc;o!ALnQ)da3Pe~d(&g_1>;z9=*^T`_(Yf+lxEtD%o(d{E@MYAlPi z?!Ith<^guq`n2f_BKtR=6sztmyTf?zhRUedk2(x~yhIQmABG`EQ@c<(zHWoHK;<}p zWJiu>a_FmxZ}Q5jd)(|CRO5Slq3V>W?sSu5hB>$SQ#| zS~%Reex>-74W;-5h1ZO=1hScvs+>V@G$M}rCB6iM&l!#5*h!OgszBl!AMBy8+87er zP5nD9z{e") 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 @@ that is called but rarely. Argument FORM is the body of the method." (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 @@ that is called but rarely. Argument FORM is the body of the method." ;; 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 diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index f9ec56da7c1..b6c116e064d 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -121,6 +121,10 @@ PREBUTTONTEXT is some text between PREFIX and the object button." (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. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 28af9bad419..ff7dc823430 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -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 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!") (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 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." '(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) ;; -- 2.39.5