+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.
;; 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).")
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
+
+;;; Code:
;;
;; This library automatically setups your [X]Emacs to use CEDET tools.
;;
-;; (require 'cedet)
-;;
-;; If you want to turn on useful or all Semantic features by default,
-;; respectively add:
+;; Add the following into your ~/.emacs startup file:
;;
-;; (setq semantic-load-turn-useful-things-on t)
-;; or
-;; (setq semantic-load-turn-everything-on t)
+;; (load-file "<INSTALL-PATH>/cedet/common/cedet.el")
;;
-;; before loading this file, like this:
+;; Once loaded, you can enable additional feature. For example,
+;; this will enable some basic and advance features:
;;
-;; (setq semantic-load-turn-useful-things-on t)
-;; (require 'cedet)
-;;
-;; That's it!
-
-;;; Code:
+;; (load-file "<INSTALL-PATH>/cedet/common/cedet.el")
+;; (global-ede-mode t)
+;; (semantic-load-enable-code-helpers)
+;; (global-srecode-minor-mode 1)
(eval-when-compile
(require 'cl))
(require 'font-lock)
(require 'ring)
-(require 'eieio)
-(eval-when-compile
- (require 'semantic/tag))
;;; Code:
(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))
;; 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)
)
"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.
;;; 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."
;;; 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."
(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
;;
;; 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:
(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
;; Return our context.
context-return))
+\f
+(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.")))))
+
\f
;;; DEBUG OUTPUT
;;
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.
"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.
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))
)
+++ /dev/null
-;;; 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
;;
;; 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.
(nreverse result)))
;;; Top level Searches
-
+;;
;;;###autoload
(defun semantic-find-first-tag-by-name (name &optional table)
"Find the first tag with NAME in TABLE.
;;
;;; 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
;;
`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)
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.
"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)
be used unless font lock is a feature.")
(semantic-varalias-obsolete 'semantic-face-alist
- 'semantic-format-face-alist)
+ 'semantic-format-face-alist)
\f
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.
\f
;;; Abstract formatting functions
+;;
(defun semantic-format-tag-prin1 (tag &optional parent color)
"Convert TAG to a string that is the print name for TAG.
(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)
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)
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))
))
;;; 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.
(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
")"))
((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)))))
text
))
+\f
+;;; 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))))
+ ))
+
\f
;;; Compatibility and aliases
;;
;;
;; Common function for Java parsers.
-;;; History:
-;;
-
;;; Code:
(require 'semantic)
(require 'semantic/ctxt)
"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))
"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
"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)))
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.
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
;;
(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)
;; III. Tag Comparison. Allows explicit or comparitive tests to see
;; if two tags are the same.
-;;; History:
-;;
-
;;; Code:
;;
--- /dev/null
+;;; 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
+++ /dev/null
-;;; 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
;;; 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)
;;; 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
(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
(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
;; 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
(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.
;; 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:
(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
(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
'(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)
;;
projects / emacs.git / commitdiff