Mercurial > emacs

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/db.el	Fri Aug 28 15:19:20 2009 +0000
@@ -0,0 +1,989 @@
+;;; semanticdb.el --- Semantic tag database manager
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
+;;; 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: tags
+
+;; 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:
+;;
+;; Maintain a database of tags for a group of files and enable
+;; queries into the database.
+;;
+;; By default, assume one database per directory.
+;;
+
+(require 'eieio)
+;; (require 'inversion)
+;; (eval-and-compile
+;;   (inversion-require 'eieio "1.0"))
+(require 'eieio-base)
+(require 'semantic)
+(eval-when-compile
+  (require 'semantic/lex-spp))
+
+;;; Variables:
+(defgroup semanticdb nil
+  "Parser Generator Persistent Database interface."
+  :group 'semantic
+  )
+;;; Code:
+(defvar semanticdb-database-list nil
+  "List of all active databases.")
+
+(defvar semanticdb-new-database-class 'semanticdb-project-database-file
+  "The default type of database created for new files.
+This can be changed on a per file basis, so that some directories
+are saved using one mechanism, and some directories via a different
+mechanism.")
+(make-variable-buffer-local 'semanticdb-new-database-class)
+
+(defvar semanticdb-default-find-index-class 'semanticdb-find-search-index
+  "The default type of search index to use for a `semanticdb-table's.
+This can be changed to try out new types of search indicies.")
+(make-variable-buffer-local 'semanticdb-default-find=index-class)
+
+
+;;; ABSTRACT CLASSES
+;;
+(defclass semanticdb-abstract-table ()
+  ((parent-db ;; :initarg :parent-db
+    ;; Do not set an initarg, or you get circular writes to disk.
+	      :documentation "Database Object containing this table.")
+   (major-mode :initarg :major-mode
+	       :initform nil
+	       :documentation "Major mode this table belongs to.
+Sometimes it is important for a program to know if a given table has the
+same major mode as the current buffer.")
+   (tags :initarg :tags
+	 :accessor semanticdb-get-tags
+	 :printer semantic-tag-write-list-slot-value
+	 :documentation "The tags belonging to this table.")
+   (index :type semanticdb-abstract-search-index
+	  :documentation "The search index.
+Used by semanticdb-find to store additional information about
+this table for searching purposes.
+
+Note: This index will not be saved in a persistent file.")
+   (cache :type list
+	  :initform nil
+	  :documentation "List of cache information for tools.
+Any particular tool can cache data to a database at runtime
+with `semanticdb-cache-get'.
+
+Using a semanticdb cache does not save any information to a file,
+so your cache will need to be recalculated at runtime.  Caches can be
+referenced even when the file is not in a buffer.
+
+Note: This index will not be saved in a persistent file.")
+   )
+  "A simple table for semantic tags.
+This table is the root of tables, and contains the minimum needed
+for a new table not associated with a buffer."
+  :abstract t)
+
+(defmethod semanticdb-in-buffer-p ((obj semanticdb-abstract-table))
+  "Return a nil, meaning abstract table OBJ is not in a buffer."
+  nil)
+
+(defmethod semanticdb-get-buffer ((obj semanticdb-abstract-table))
+  "Return a buffer associated with OBJ.
+If the buffer is not in memory, load it with `find-file-noselect'."
+  nil)
+
+(defmethod semanticdb-full-filename ((obj semanticdb-abstract-table))
+  "Fetch the full filename that OBJ refers to.
+Abstract tables do not have file names associated with them."
+  nil)
+
+(defmethod semanticdb-dirty-p ((obj semanticdb-abstract-table))
+  "Return non-nil if OBJ is 'dirty'."
+  nil)
+
+(defmethod semanticdb-set-dirty ((obj semanticdb-abstract-table))
+  "Mark the abstract table OBJ dirty.
+Abstract tables can not be marked dirty, as there is nothing
+for them to synchronize against."
+  ;; The abstract table can not be dirty.
+  nil)
+
+(defmethod semanticdb-normalize-tags ((obj semanticdb-abstract-table) tags)
+  "For the table OBJ, convert a list of TAGS, into standardized form.
+The default is to return TAGS.
+Some databases may default to searching and providing simplified tags
+based on whichever technique used.  This method provides a hook for
+them to convert TAG into a more complete form."
+  tags)
+
+(defmethod semanticdb-normalize-one-tag ((obj semanticdb-abstract-table) tag)
+  "For the table OBJ, convert a TAG, into standardized form.
+This method returns a list of the form (DATABASE . NEWTAG).
+
+The default is to just return (OBJ TAG).
+
+Some databases may default to searching and providing simplified tags
+based on whichever technique used.  This method provides a hook for
+them to convert TAG into a more complete form."
+  (cons obj tag))
+
+(defmethod object-print ((obj semanticdb-abstract-table) &rest strings)
+  "Pretty printer extension for `semanticdb-table'.
+Adds the number of tags in this file to the object print name."
+  (apply 'call-next-method obj
+	 (cons (format " (%d tags)"
+		       (length (semanticdb-get-tags obj))
+		       )
+	       strings)))
+
+;;; Index Cache
+;;
+(defclass semanticdb-abstract-search-index ()
+  ((table :initarg :table
+	  :type semanticdb-abstract-table
+	  :documentation "XRef to the table this belongs to.")
+   )
+  "A place where semanticdb-find can store search index information.
+The search index will store data about which other tables might be
+needed, or perhaps create hash or index tables for the current buffer."
+  :abstract t)
+
+(defmethod semanticdb-get-table-index ((obj semanticdb-abstract-table))
+  "Return the search index for the table OBJ.
+If one doesn't exist, create it."
+  (if (slot-boundp obj 'index)
+      (oref obj index)
+    (let ((idx nil))
+      (setq idx (funcall semanticdb-default-find-index-class
+			 (concat (object-name obj) " index")
+			 ;; Fill in the defaults
+		         :table obj
+			 ))
+      (oset obj index idx)
+      idx)))
+
+(defmethod semanticdb-synchronize ((idx semanticdb-abstract-search-index)
+				   new-tags)
+  "Synchronize the search index IDX with some NEW-TAGS."
+  ;; The abstract class will do... NOTHING!
+  )
+
+(defmethod semanticdb-partial-synchronize ((idx semanticdb-abstract-search-index)
+					   new-tags)
+  "Synchronize the search index IDX with some changed NEW-TAGS."
+  ;; The abstract class will do... NOTHING!
+  )
+
+
+;;; CONCRETE TABLE CLASSES
+;;
+(defclass semanticdb-table (semanticdb-abstract-table)
+  ((file :initarg :file
+	 :documentation "File name relative to the parent database.
+This is for the file whose tags are stored in this TABLE object.")
+   (buffer :initform nil
+	   :documentation "The buffer associated with this table.
+If nil, the table's buffer is no in Emacs.  If it has a value, then
+it is in Emacs.")
+   (dirty :initform nil
+	  :documentation
+	  "Non nil if this table needs to be `Saved'.")
+   (db-refs :initform nil
+	    :documentation
+	    "List of `semanticdb-table' objects refering to this one.
+These aren't saved, but are instead recalculated after load.
+See the file semanticdb-ref.el for how this slot is used.")
+   (pointmax :initarg :pointmax
+	     :initform nil
+	     :documentation "Size of buffer when written to disk.
+Checked on retrieval to make sure the file is the same.")
+   (fsize :initarg :fsize
+	  :initform nil
+	  :documentation "Size of the file when it was last referenced.
+Checked when deciding if a loaded table needs updating from changes
+outside of Semantic's control.")
+   (lastmodtime :initarg :lastmodtime
+		:initform nil
+		:documentation "Last modification time of the file referenced.
+Checked when deciding if a loaded table needs updating from changes outside of
+Semantic's control.")
+   ;; @todo - need to add `last parsed time', so we can also have
+   ;; refresh checks if spp tables or the parser gets rebuilt.
+   (unmatched-syntax :initarg :unmatched-syntax
+		     :documentation
+		     "List of vectors specifying unmatched syntax.")
+
+   (lexical-table :initarg :lexical-table
+		  :initform nil
+		  :printer semantic-lex-spp-table-write-slot-value
+		  :documentation
+		  "Table that might be needed by the lexical analyzer.
+For C/C++, the C preprocessor macros can be saved here.")
+   )
+  "A single table of tags derived from file.")
+
+(defmethod semanticdb-in-buffer-p ((obj semanticdb-table))
+  "Return a buffer associated with OBJ.
+If the buffer is in memory, return that buffer."
+  (let ((buff (oref obj buffer)))
+    (if (buffer-live-p buff)
+	buff
+      (oset obj buffer nil))))
+
+(defmethod semanticdb-get-buffer ((obj semanticdb-table))
+  "Return a buffer associated with OBJ.
+If the buffer is in memory, return that buffer.
+If the buffer is not in memory, load it with `find-file-noselect'."
+  (or (semanticdb-in-buffer-p obj)
+      (find-file-noselect (semanticdb-full-filename obj) t)))
+
+(defmethod semanticdb-set-buffer ((obj semanticdb-table))
+  "Set the current buffer to be a buffer owned by OBJ.
+If OBJ's file is not loaded, read it in first."
+  (set-buffer (semanticdb-get-buffer obj)))
+
+(defmethod semanticdb-full-filename ((obj semanticdb-table))
+  "Fetch the full filename that OBJ refers to."
+  (expand-file-name (oref obj file)
+		    (oref (oref obj parent-db) reference-directory)))
+
+(defmethod semanticdb-dirty-p ((obj semanticdb-table))
+  "Return non-nil if OBJ is 'dirty'."
+  (oref obj dirty))
+
+(defmethod semanticdb-set-dirty ((obj semanticdb-table))
+  "Mark the abstract table OBJ dirty."
+  (oset obj dirty t)
+  )
+
+(defmethod object-print ((obj semanticdb-table) &rest strings)
+  "Pretty printer extension for `semanticdb-table'.
+Adds the number of tags in this file to the object print name."
+  (apply 'call-next-method obj
+	 (cons (if (oref obj dirty) ", DIRTY" "") strings)))
+
+;;; DATABASE BASE CLASS
+;;
+(defclass semanticdb-project-database (eieio-instance-tracker)
+  ((tracking-symbol :initform semanticdb-database-list)
+   (reference-directory :type string
+			:documentation "Directory this database refers to.
+When a cache directory is specified, then this refers to the directory
+this database contains symbols for.")
+   (new-table-class :initform semanticdb-table
+		    :type class
+		    :documentation
+		    "New tables created for this database are of this class.")
+   (cache :type list
+	  :initform nil
+	  :documentation "List of cache information for tools.
+Any particular tool can cache data to a database at runtime
+with `semanticdb-cache-get'.
+
+Using a semanticdb cache does not save any information to a file,
+so your cache will need to be recalculated at runtime.
+
+Note: This index will not be saved in a persistent file.")
+   (tables :initarg :tables
+	   :type list
+	   ;; Need this protection so apps don't try to access
+	   ;; the tables without using the accessor.
+	   :accessor semanticdb-get-database-tables
+	   :protection :protected
+	   :documentation "List of `semantic-db-table' objects."))
+  "Database of file tables.")
+
+(defmethod semanticdb-full-filename ((obj semanticdb-project-database))
+  "Fetch the full filename that OBJ refers to.
+Abstract tables do not have file names associated with them."
+  nil)
+
+(defmethod semanticdb-dirty-p ((DB semanticdb-project-database))
+  "Return non-nil if DB is 'dirty'.
+A database is dirty if the state of the database changed in a way
+where it may need to resynchronize with some persistent storage."
+  (let ((dirty nil)
+	(tabs (oref DB tables)))
+    (while (and (not dirty) tabs)
+      (setq dirty (semanticdb-dirty-p (car tabs)))
+      (setq tabs (cdr tabs)))
+    dirty))
+
+(defmethod object-print ((obj semanticdb-project-database) &rest strings)
+  "Pretty printer extension for `semanticdb-project-database'.
+Adds the number of tables in this file to the object print name."
+  (apply 'call-next-method obj
+	 (cons (format " (%d tables%s)"
+		       (length (semanticdb-get-database-tables obj))
+		       (if (semanticdb-dirty-p obj)
+			   " DIRTY" "")
+		       )
+	       strings)))
+
+(defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database) directory)
+  "Create a new semantic database of class DBC for DIRECTORY and return it.
+If a database for DIRECTORY has already been created, return it.
+If DIRECTORY doesn't exist, create a new one."
+  (let ((db (semanticdb-directory-loaded-p directory)))
+    (unless db
+      (setq db (semanticdb-project-database
+		(file-name-nondirectory directory)
+		:tables nil))
+      ;; Set this up here.   We can't put it in the constructor because it
+      ;; would be saved, and we want DB files to be portable.
+      (oset db reference-directory (file-truename directory)))
+    db))
+
+(defmethod semanticdb-flush-database-tables ((db semanticdb-project-database))
+  "Reset the tables in DB to be empty."
+  (oset db tables nil))
+
+(defmethod semanticdb-create-table ((db semanticdb-project-database) file)
+  "Create a new table in DB for FILE and return it.
+The class of DB contains the class name for the type of table to create.
+If the table for FILE exists, return it.
+If the table for FILE does not exist, create one."
+  (let ((newtab (semanticdb-file-table db file)))
+    (unless newtab
+      ;; This implementation will satisfy autoloaded classes
+      ;; for tables.
+      (setq newtab (funcall (oref db new-table-class)
+			    (file-name-nondirectory file)
+			    :file (file-name-nondirectory file)
+			    ))
+      (oset newtab parent-db db)
+      (object-add-to-list db 'tables newtab t))
+    newtab))
+
+(defmethod semanticdb-file-table ((obj semanticdb-project-database) filename)
+  "From OBJ, return FILENAME's associated table object."
+  (object-assoc (file-relative-name (file-truename filename)
+  				    (oref obj reference-directory))
+		'file (oref obj tables)))
+
+;; DATABASE FUNCTIONS
+(defun semanticdb-get-database (filename)
+  "Get a database for FILENAME.
+If one isn't found, create one."
+  (semanticdb-create-database semanticdb-new-database-class (file-truename filename)))
+
+(defun semanticdb-directory-loaded-p (path)
+  "Return the project belonging to PATH if it was already loaded."
+  (eieio-instance-tracker-find path 'reference-directory 'semanticdb-database-list))
+
+(defun semanticdb-create-table-for-file (filename)
+  "Initialize a database table for FILENAME, and return it.
+If FILENAME exists in the database already, return that.
+If there is no database for the table to live in, create one."
+  (let ((cdb nil)
+	(tbl nil)
+	(dd (file-name-directory filename))
+	)
+    ;; Allow a database override function
+    (setq cdb (semanticdb-create-database semanticdb-new-database-class
+					  dd))
+    ;; Get a table for this file.
+    (setq tbl (semanticdb-create-table cdb filename))
+
+    ;; Return the pair.
+    (cons cdb tbl)
+    ))
+
+;;; Cache Cache.
+;;
+(defclass semanticdb-abstract-cache ()
+  ((table :initarg :table
+	  :type semanticdb-abstract-table
+	  :documentation
+	  "Cross reference to the table this belongs to.")
+   )
+  "Abstract baseclass for tools to use to cache information in semanticdb.
+Tools needing a per-file cache must subclass this, and then get one as
+needed.  Cache objects are identified in semanticdb by subclass.
+In order to keep your cache up to date, be sure to implement
+`semanticdb-synchronize', and `semanticdb-partial-synchronize'.
+See the file semantic-scope.el for an example."
+  :abstract t)
+
+(defmethod semanticdb-cache-get ((table semanticdb-abstract-table)
+				 desired-class)
+  "Get a cache object on TABLE of class DESIRED-CLASS.
+This method will create one if none exists with no init arguments
+other than :table."
+  (assert (child-of-class-p desired-class 'semanticdb-abstract-cache))
+  (let ((cache (oref table cache))
+	(obj nil))
+    (while (and (not obj) cache)
+      (if (eq (object-class-fast (car cache)) desired-class)
+	  (setq obj (car cache)))
+      (setq cache (cdr cache)))
+    (if obj
+	obj ;; Just return it.
+      ;; No object, lets create a new one and return that.
+      (setq obj (funcall desired-class "Cache" :table table))
+      (object-add-to-list table 'cache obj)
+      obj)))
+
+(defmethod semanticdb-cache-remove ((table semanticdb-abstract-table)
+				    cache)
+  "Remove from TABLE the cache object CACHE."
+  (object-remove-from-list table 'cache cache))
+
+(defmethod semanticdb-synchronize ((cache semanticdb-abstract-cache)
+				   new-tags)
+  "Synchronize a CACHE with some NEW-TAGS."
+  ;; The abstract class will do... NOTHING!
+  )
+
+(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-cache)
+					   new-tags)
+  "Synchronize a CACHE with some changed NEW-TAGS."
+  ;; The abstract class will do... NOTHING!
+  )
+
+(defclass semanticdb-abstract-db-cache ()
+  ((db :initarg :db
+       :type semanticdb-project-database
+       :documentation
+       "Cross reference to the database this belongs to.")
+   )
+  "Abstract baseclass for tools to use to cache information in semanticdb.
+Tools needing a database cache must subclass this, and then get one as
+needed.  Cache objects are identified in semanticdb by subclass.
+In order to keep your cache up to date, be sure to implement
+`semanticdb-synchronize', and `semanticdb-partial-synchronize'.
+See the file semantic-scope.el for an example."
+  :abstract t)
+
+(defmethod semanticdb-cache-get ((db semanticdb-project-database)
+				 desired-class)
+  "Get a cache object on DB of class DESIRED-CLASS.
+This method will create one if none exists with no init arguments
+other than :table."
+  (assert (child-of-class-p desired-class 'semanticdb-abstract-db-cache))
+  (let ((cache (oref db cache))
+	(obj nil))
+    (while (and (not obj) cache)
+      (if (eq (object-class-fast (car cache)) desired-class)
+	  (setq obj (car cache)))
+      (setq cache (cdr cache)))
+    (if obj
+	obj ;; Just return it.
+      ;; No object, lets create a new one and return that.
+      (setq obj (funcall desired-class "Cache" :db db))
+      (object-add-to-list db 'cache obj)
+      obj)))
+
+(defmethod semanticdb-cache-remove ((db semanticdb-project-database)
+				    cache)
+  "Remove from TABLE the cache object CACHE."
+  (object-remove-from-list db 'cache cache))
+
+
+(defmethod semanticdb-synchronize ((cache semanticdb-abstract-db-cache)
+				   new-tags)
+  "Synchronize a CACHE with some NEW-TAGS."
+  ;; The abstract class will do... NOTHING!
+  )
+
+(defmethod semanticdb-partial-synchronize ((cache semanticdb-abstract-db-cache)
+					   new-tags)
+  "Synchronize a CACHE with some changed NEW-TAGS."
+  ;; The abstract class will do... NOTHING!
+  )
+
+;;; REFRESH
+
+(defmethod semanticdb-refresh-table ((obj semanticdb-table) &optional force)
+  "If the tag list associated with OBJ is loaded, refresh it.
+Optional argument FORCE will force a refresh even if the file in question
+is not in a buffer.  Avoid using FORCE for most uses, as an old cache
+may be sufficient for the general case.  Forced updates can be slow.
+This will call `semantic-fetch-tags' if that file is in memory."
+  (when (or (semanticdb-in-buffer-p obj) force)
+    (save-excursion
+      (semanticdb-set-buffer obj)
+      (semantic-fetch-tags))))
+
+(defmethod semanticdb-needs-refresh-p ((obj semanticdb-table))
+  "Return non-nil of OBJ's tag list is out of date.
+The file associated with OBJ does not need to be in a buffer."
+  (let* ((ff (semanticdb-full-filename obj))
+	 (buff (semanticdb-in-buffer-p obj))
+	 )
+    (if buff
+	(save-excursion
+	  (set-buffer buff)
+	  ;; Use semantic's magic tracker to determine of the buffer is up
+	  ;; to date or not.
+	  (not (semantic-parse-tree-up-to-date-p))
+	  ;; We assume that semanticdb is keeping itself up to date.
+	  ;; via all the clever hooks
+	  )
+      ;; Buffer isn't loaded.  The only clue we have is if the file
+      ;; is somehow different from our mark in the semanticdb table.
+      (let* ((stats (file-attributes ff))
+	     (actualsize (nth 7 stats))
+	     (actualmod (nth 5 stats))
+	     )
+
+	(or (not (slot-boundp obj 'tags))
+	    ;; (not (oref obj tags)) -->  not needed anymore?
+	    (/= (or (oref obj fsize) 0) actualsize)
+	    (not (equal (oref obj lastmodtime) actualmod))
+	    )
+	))))
+
+
+;;; Synchronization
+;;
+(defmethod semanticdb-synchronize ((table semanticdb-abstract-table)
+				   new-tags)
+  "Synchronize the table TABLE with some NEW-TAGS."
+  (oset table tags new-tags)
+  (oset table pointmax (point-max))
+  (let ((fattr (file-attributes (semanticdb-full-filename table))))
+    (oset table fsize (nth 7 fattr))
+    (oset table lastmodtime (nth 5 fattr))
+    )
+  ;; Assume it is now up to date.
+  (oset table unmatched-syntax semantic-unmatched-syntax-cache)
+  ;; The lexical table should be good too.
+  (when (featurep 'semantic-lex-spp)
+    (oset table lexical-table (semantic-lex-spp-save-table)))
+  ;; this implies dirtyness
+  (semanticdb-set-dirty table)
+
+  ;; Synchronize the index
+  (when (slot-boundp table 'index)
+    (let ((idx (oref table index)))
+      (when idx (semanticdb-synchronize idx new-tags))))
+
+  ;; Synchronize application caches.
+  (dolist (C (oref table cache))
+    (semanticdb-synchronize C new-tags)
+    )
+
+  ;; Update cross references
+  ;; (semanticdb-refresh-references table)
+  )
+
+(defmethod semanticdb-partial-synchronize ((table semanticdb-abstract-table)
+					   new-tags)
+  "Synchronize the table TABLE where some NEW-TAGS changed."
+  ;; You might think we need to reset the tags, but since the partial
+  ;; parser splices the lists, we don't need to do anything
+  ;;(oset table tags new-tags)
+  ;; We do need to mark ourselves dirty.
+  (semanticdb-set-dirty table)
+
+  ;; The lexical table may be modified.
+  (when (featurep 'semantic-lex-spp)
+    (oset table lexical-table (semantic-lex-spp-save-table)))
+
+  ;; Incremental parser doesn't mokey around with this.
+  (oset table unmatched-syntax semantic-unmatched-syntax-cache)
+
+  ;; Synchronize the index
+  (when (slot-boundp table 'index)
+    (let ((idx (oref table index)))
+      (when idx (semanticdb-partial-synchronize idx new-tags))))
+
+  ;; Synchronize application caches.
+  (dolist (C (oref table cache))
+    (semanticdb-synchronize C new-tags)
+    )
+
+  ;; Update cross references
+  ;;(when (semantic-find-tags-by-class 'include new-tags)
+  ;;  (semanticdb-refresh-references table))
+  )
+
+;;; SAVE/LOAD
+;;
+(defmethod semanticdb-save-db ((DB semanticdb-project-database)
+			       &optional supress-questions)
+  "Cause a database to save itself.
+The database base class does not save itself persistently.
+Subclasses could save themselves to a file, or to a database, or other
+form."
+  nil)
+
+(defun semanticdb-save-current-db ()
+  "Save the current tag database."
+  (interactive)
+  (message "Saving current tag summaries...")
+  (semanticdb-save-db semanticdb-current-database)
+  (message "Saving current tag summaries...done"))
+
+(defun semanticdb-save-all-db ()
+  "Save all semantic tag databases."
+  (interactive)
+  (message "Saving tag summaries...")
+  (mapc 'semanticdb-save-db semanticdb-database-list)
+  (message "Saving tag summaries...done"))
+
+(defun semanticdb-save-all-db-idle ()
+  "Save all semantic tag databases from idle time.
+Exit the save between databases if there is user input."
+  (semantic-safe "Auto-DB Save: %S"
+    (semantic-exit-on-input 'semanticdb-idle-save
+      (mapc (lambda (db)
+	      (semantic-throw-on-input 'semanticdb-idle-save)
+	      (semanticdb-save-db db t))
+	    semanticdb-database-list))
+    ))
+
+;;; Directory Project support
+;;
+(defvar semanticdb-project-predicate-functions nil
+  "List of predicates to try that indicate a directory belongs to a project.
+This list is used when `semanticdb-persistent-path' contains the value
+'project.  If the predicate list is nil, then presume all paths are valid.
+
+Project Management software (such as EDE and JDE) should add their own
+predicates with `add-hook' to this variable, and semanticdb will save tag
+caches in directories controlled by them.")
+
+(defmethod semanticdb-write-directory-p ((obj semanticdb-project-database))
+  "Return non-nil if OBJ should be written to disk.
+Uses `semanticdb-persistent-path' to determine the return value."
+  nil)
+
+;;; Utilities
+;;
+;; What is the current database, are two tables of an equivalent mode,
+;; and what databases are a part of the same project.
+(defun semanticdb-current-database ()
+  "Return the currently active database."
+  (or semanticdb-current-database
+      (and default-directory
+	   (semanticdb-create-database semanticdb-new-database-class
+				       default-directory)
+	   )
+      nil))
+
+(defvar semanticdb-match-any-mode nil
+  "Non-nil to temporarilly search any major mode for a tag.
+If a particular major mode wants to search any mode, put the
+`semantic-match-any-mode' symbol onto the symbol of that major mode.
+Do not set the value of this variable permanently.")
+
+(defmacro semanticdb-with-match-any-mode (&rest body)
+  "A Semanticdb search occuring withing BODY will search tags in all modes.
+This temporarilly sets `semanticdb-match-any-mode' while executing BODY."
+  `(let ((semanticdb-match-any-mode t))
+     ,@body))
+(put 'semanticdb-with-match-any-mode 'lisp-indent-function 0)
+
+(defmethod semanticdb-equivalent-mode-for-search (table &optional buffer)
+  "Return non-nil if TABLE's mode is equivalent to BUFFER.
+See `semanticdb-equivalent-mode' for details.
+This version is used during searches.  Major-modes that opt
+to set the `semantic-match-any-mode' property will be able to search
+all files of any type."
+  (or (get major-mode 'semantic-match-any-mode)
+      semanticdb-match-any-mode
+      (semanticdb-equivalent-mode table buffer))
+  )
+
+(defmethod semanticdb-equivalent-mode ((table semanticdb-abstract-table) &optional buffer)
+  "Return non-nil if TABLE's mode is equivalent to BUFFER.
+Equivalent modes are specified by by `semantic-equivalent-major-modes'
+local variable."
+  nil)
+
+(defmethod semanticdb-equivalent-mode ((table semanticdb-table) &optional buffer)
+  "Return non-nil if TABLE's mode is equivalent to BUFFER.
+Equivalent modes are specified by by `semantic-equivalent-major-modes'
+local variable."
+  (save-excursion
+    (if buffer (set-buffer buffer))
+    (or
+     ;; nil major mode in table means we don't know yet.  Assume yes for now?
+     (null (oref table major-mode))
+     ;; nil means the same as major-mode
+     (and (not semantic-equivalent-major-modes)
+	  (mode-local-use-bindings-p major-mode (oref table major-mode)))
+     (and semantic-equivalent-major-modes
+	  (member (oref table major-mode) semantic-equivalent-major-modes))
+     )
+    ))
+
+
+;;; Associations
+;;
+;; These routines determine associations between a file, and multiple
+;; associated databases.
+
+(defcustom semanticdb-project-roots nil
+  "*List of directories, where each directory is the root of some project.
+All subdirectories of a root project are considered a part of one project.
+Values in this string can be overriden by project management programs
+via the `semanticdb-project-root-functions' variable."
+  :group 'semanticdb
+  :type '(repeat string))
+
+(defvar semanticdb-project-root-functions nil
+  "List of functions used to determine a given directories project root.
+Functions in this variable can override `semanticdb-project-roots'.
+Functions set in the variable are given one argument (a directory) and
+must return a string, (the root directory) or a list of strings (multiple
+root directories in a more complex system).  This variable should be used
+by project management programs like EDE or JDE.")
+
+(defvar semanticdb-project-system-databases nil
+  "List of databases containing system library information.
+Mode authors can create their own system databases which know
+detailed information about the system libraries for querying purposes.
+Put those into this variable as a buffer-local, or mode-local
+value.")
+(make-variable-buffer-local 'semanticdb-project-system-databases)
+
+(defvar semanticdb-search-system-databases t
+  "Non nil if search routines are to include a system database.")
+
+(defun semanticdb-current-database-list (&optional dir)
+  "Return a list of databases associated with the current buffer.
+If optional argument DIR is non-nil, then use DIR as the starting directory.
+If this buffer has a database, but doesn't have a project associated
+with it, return nil.
+First, it checks `semanticdb-project-root-functions', and if that
+has no results, it checks `semanticdb-project-roots'.  If that fails,
+it returns the results of function `semanticdb-current-database'.
+Always append `semanticdb-project-system-databases' if
+`semanticdb-search-system' is non-nil."
+  (let ((root nil)			; found root directory
+	(dbs nil)			; collected databases
+	(roots semanticdb-project-roots) ;all user roots
+	(dir (file-truename (or dir default-directory)))
+	)
+    ;; Find the root based on project functions.
+    (setq root (run-hook-with-args-until-success
+		'semanticdb-project-root-functions
+		dir))
+    ;; Find roots based on strings
+    (while (and roots (not root))
+      (let ((r (file-truename (car roots))))
+	(if (string-match (concat "^" (regexp-quote r)) dir)
+	    (setq root r)))
+      (setq roots (cdr roots)))
+
+    ;; If no roots are found, use this directory.
+    (unless root (setq root dir))
+
+    ;; Find databases based on the root directory.
+    (when root
+      ;; The rootlist allows the root functions to possibly
+      ;; return several roots which are in different areas but
+      ;; all apart of the same system.
+      (let ((regexp (concat "^" (regexp-quote root)))
+	    (adb semanticdb-database-list) ; all databases
+	    )
+	(while adb
+	  ;; I don't like this part, but close enough.
+	  (if (and (slot-boundp (car adb) 'reference-directory)
+		   (string-match regexp (oref (car adb) reference-directory)))
+	      (setq dbs (cons (car adb) dbs)))
+	  (setq adb (cdr adb))))
+      )
+    ;; Add in system databases
+    (when semanticdb-search-system-databases
+      (setq dbs (nconc dbs semanticdb-project-system-databases)))
+    ;; Return
+    dbs))
+
+
+;;; Generic Accessor Routines
+;;
+;; These routines can be used to get at tags in files w/out
+;; having to know a lot about semanticDB.
+(defvar semanticdb-file-table-hash (make-hash-table :test 'equal)
+  "Hash table mapping file names to database tables.")
+
+(defun semanticdb-file-table-object-from-hash (file)
+  "Retrieve a DB table from the hash for FILE.
+Does not use `file-truename'."
+  (gethash file semanticdb-file-table-hash 'no-hit))
+
+(defun semanticdb-file-table-object-put-hash (file dbtable)
+  "For FILE, associate DBTABLE in the hash table."
+  (puthash file dbtable semanticdb-file-table-hash))
+
+(defun semanticdb-file-table-object (file &optional dontload)
+  "Return a semanticdb table belonging to FILE, make it up to date.
+If file has database tags available in the database, return it.
+If file does not have tags available, and DONTLOAD is nil,
+then load the tags for FILE, and create a new table object for it.
+DONTLOAD does not affect the creation of new database objects."
+  ;; (message "Object Translate: %s" file)
+  (when (file-exists-p file)
+    (let* ((default-directory (file-name-directory file))
+	   (tab (semanticdb-file-table-object-from-hash file))
+	   (fullfile nil))
+
+      ;; If it is not in the cache, then extract the more traditional
+      ;; way by getting the database, and finding a table in that database.
+      ;; Once we have a table, add it to the hash.
+      (when (eq tab 'no-hit)
+	(setq fullfile (file-truename file))
+	(let ((db (or ;; This line will pick up system databases.
+		   (semanticdb-directory-loaded-p default-directory)
+		   ;; this line will make a new one if needed.
+		   (semanticdb-get-database default-directory))))
+	  (setq tab (semanticdb-file-table db fullfile))
+	  (when tab
+	    (semanticdb-file-table-object-put-hash file tab)
+	    (when (not (string= fullfile file))
+	      (semanticdb-file-table-object-put-hash fullfile tab)
+	    ))
+	  ))
+
+      (cond
+       ((and tab
+	     ;; Is this in a buffer?
+	     ;;(find-buffer-visiting (semanticdb-full-filename tab))
+	     (semanticdb-in-buffer-p tab)
+	     )
+	(save-excursion
+	  ;;(set-buffer (find-buffer-visiting (semanticdb-full-filename tab)))
+	  (semanticdb-set-buffer tab)
+	  (semantic-fetch-tags)
+	  ;; Return the table.
+	  tab))
+       ((and tab dontload)
+	;; If we have table, and we don't want to load it, just return it.
+	tab)
+       ((and tab
+	     ;; Is table fully loaded, or just a proxy?
+	     (number-or-marker-p (oref tab pointmax))
+	     ;; Is this table up to date with the file?
+	     (not (semanticdb-needs-refresh-p tab)))
+	;; A-ok!
+	tab)
+       ((or (and fullfile (get-file-buffer fullfile))
+	    (get-file-buffer file))
+	;; are these two calls this faster than `find-buffer-visiting'?
+
+	;; If FILE is being visited, but none of the above state is
+	;; true (meaning, there is no table object associated with it)
+	;; then it is a file not supported by Semantic, and can be safely
+	;; ignored.
+	nil)
+       ((not dontload) ;; We must load the file.
+	;; Full file should have been set by now.  Debug why not?
+	(when (and (not tab) (not fullfile))
+	  ;; This case is if a 'nil is erroneously put into the hash table.  This
+	  ;; would need fixing
+	  (setq fullfile (file-truename file))
+	  )
+
+	;; If we have a table, but no fullfile, that's ok.  Lets get the filename
+	;; from the table which is pre-truenamed.
+	(when (and (not fullfile) tab)
+	  (setq fullfile (semanticdb-full-filename tab)))
+
+	(setq tab (semanticdb-create-table-for-file-not-in-buffer fullfile))
+
+	;; Save the new table.
+	(semanticdb-file-table-object-put-hash file tab)
+	(when (not (string= fullfile file))
+	  (semanticdb-file-table-object-put-hash fullfile tab)
+	  )
+	;; Done!
+	tab)
+       (t
+	;; Full file should have been set by now.  Debug why not?
+	;; One person found this.  Is it a file that failed to parse
+	;; in the past?
+	(when (not fullfile)
+	  (setq fullfile (file-truename file)))
+
+	;; We were asked not to load the file in and parse it.
+	;; Instead just create a database table with no tags
+	;; and a claim of being empty.
+	;;
+	;; This will give us a starting point for storing
+	;; database cross-references so when it is loaded,
+	;; the cross-references will fire and caches will
+	;; be cleaned.
+	(let ((ans (semanticdb-create-table-for-file file)))
+	  (setq tab (cdr ans))
+
+	  ;; Save the new table.
+	  (semanticdb-file-table-object-put-hash file tab)
+	  (when (not (string= fullfile file))
+	    (semanticdb-file-table-object-put-hash fullfile tab)
+	    )
+	  ;; Done!
+	  tab))
+       )
+      )))
+
+(defvar semanticdb-out-of-buffer-create-table-fcn nil
+  "When non-nil, a function for creating a semanticdb table.
+This should take a filename to be parsed.")
+(make-variable-buffer-local 'semanticdb-out-of-buffer-create-table-fcn)
+
+(defun semanticdb-create-table-for-file-not-in-buffer (filename)
+  "Create a table for the file FILENAME.
+If there are no language specific configurations, this
+function will read in the buffer, parse it, and kill the buffer."
+  (if (and semanticdb-out-of-buffer-create-table-fcn
+	   (not (file-remote-p filename)))
+      ;; Use external parser only of the file is accessible to the
+      ;; local file system.
+      (funcall semanticdb-out-of-buffer-create-table-fcn filename)
+    (save-excursion
+      (let* ( ;; Remember the buffer to kill
+	     (kill-buffer-flag (find-buffer-visiting filename))
+	     (buffer-to-kill (or kill-buffer-flag
+				 (semantic-find-file-noselect filename t))))
+
+	;; This shouldn't ever be set.  Debug some issue here?
+	;; (when kill-buffer-flag (debug))
+
+	(set-buffer buffer-to-kill)
+	;; Find file should automatically do this for us.
+	;; Sometimes the DB table doesn't contains tags and needs
+	;; a refresh.  For example, when the file is loaded for
+	;; the first time, and the idle scheduler didn't get a
+	;; chance to trigger a parse before the file buffer is
+	;; killed.
+	(when semanticdb-current-table
+	  (semantic-fetch-tags))
+	(prog1
+	    semanticdb-current-table
+	  (when (not kill-buffer-flag)
+	    ;; If we had to find the file, then we should kill it
+	    ;; to keep the master buffer list clean.
+	    (kill-buffer buffer-to-kill)
+	    )))))
+  )
+
+(defun semanticdb-file-stream (file)
+  "Return a list of tags belonging to FILE.
+If file has database tags available in the database, return them.
+If file does not have tags available, then load the file, and create them."
+  (let ((table (semanticdb-file-table-object file)))
+    (when table
+      (semanticdb-get-tags table))))
+
+(provide 'semantic/db)
+
+;;; semanticdb.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/decorate.el	Fri Aug 28 15:19:20 2009 +0000
@@ -0,0 +1,320 @@
+;;; semantic-decorate.el --- Utilities for decorating/highlighting tokens.
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2005, 2006, 2007, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; 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:
+;;
+;; Text representing a semantic tag is wrapped in an overlay.
+;; This overlay can be used for highlighting, or setting other
+;; editing properties on a tag, such as "read only."
+;;
+
+(require 'semantic)
+(require 'pulse)
+
+;;; Code:
+
+;;; Highlighting Basics
+(defun semantic-highlight-tag (tag &optional face)
+  "Specify that TAG should be highlighted.
+Optional FACE specifies the face to use."
+  (let ((o (semantic-tag-overlay tag)))
+    (semantic-overlay-put o 'old-face
+			  (cons (semantic-overlay-get o 'face)
+				(semantic-overlay-get o 'old-face)))
+    (semantic-overlay-put o 'face (or face 'semantic-tag-highlight-face))
+    ))
+
+(defun semantic-unhighlight-tag (tag)
+  "Unhighlight TAG, restoring it's previous face."
+  (let ((o (semantic-tag-overlay tag)))
+    (semantic-overlay-put o 'face (car (semantic-overlay-get o 'old-face)))
+    (semantic-overlay-put o 'old-face (cdr (semantic-overlay-get o 'old-face)))
+    ))
+
+;;; Momentary Highlighting - One line
+(defun semantic-momentary-highlight-one-tag-line (tag &optional face)
+  "Highlight the first line of TAG, unhighlighting before next command.
+Optional argument FACE specifies the face to do the highlighting."
+  (save-excursion
+    ;; Go to first line in tag
+    (semantic-go-to-tag tag)
+    (pulse-momentary-highlight-one-line (point))))
+
+;;; Momentary Highlighting - Whole Tag
+(defun semantic-momentary-highlight-tag (tag &optional face)
+  "Highlight TAG, removing highlighting when the user hits a key.
+Optional argument FACE is the face to use for highlighting.
+If FACE is not specified, then `highlight' will be used."
+  (when (semantic-tag-with-position-p tag)
+    (if (not (semantic-overlay-p (semantic-tag-overlay tag)))
+	;; No overlay, but a position.  Highlight the first line only.
+	(semantic-momentary-highlight-one-tag-line tag face)
+      ;; The tag has an overlay, highlight the whole thing
+      (pulse-momentary-highlight-overlay (semantic-tag-overlay tag)
+					 face)
+      )))
+
+(defun semantic-set-tag-face (tag face)
+  "Specify that TAG should use FACE for display."
+  (semantic-overlay-put (semantic-tag-overlay tag) 'face face))
+
+(defun semantic-set-tag-invisible (tag &optional visible)
+  "Enable the text in TAG to be made invisible.
+If VISIBLE is non-nil, make the text visible."
+  (semantic-overlay-put (semantic-tag-overlay tag) 'invisible
+			(not visible)))
+
+(defun semantic-tag-invisible-p (tag)
+  "Return non-nil if TAG is invisible."
+  (semantic-overlay-get (semantic-tag-overlay tag) 'invisible))
+
+(defun semantic-set-tag-intangible (tag &optional tangible)
+  "Enable the text in TAG to be made intangible.
+If TANGIBLE is non-nil, make the text visible.
+This function does not have meaning in XEmacs because it seems that
+the extent 'intangible' property does not exist."
+  (semantic-overlay-put (semantic-tag-overlay tag) 'intangible
+			(not tangible)))
+
+(defun semantic-tag-intangible-p (tag)
+  "Return non-nil if TAG is intangible.
+This function does not have meaning in XEmacs because it seems that
+the extent 'intangible' property does not exist."
+  (semantic-overlay-get (semantic-tag-overlay tag) 'intangible))
+
+(defun semantic-overlay-signal-read-only
+  (overlay after start end &optional len)
+  "Hook used in modification hooks to prevent modification.
+Allows deletion of the entire text.
+Argument OVERLAY, AFTER, START, END, and LEN are passed in by the system."
+  ;; Stolen blithly from cpp.el in Emacs 21.1
+  (if (and (not after)
+	   (or (< (semantic-overlay-start overlay) start)
+	       (> (semantic-overlay-end overlay) end)))
+      (error "This text is read only")))
+
+(defun semantic-set-tag-read-only (tag &optional writable)
+  "Enable the text in TAG to be made read-only.
+Optional argument WRITABLE should be non-nil to make the text writable
+instead of read-only."
+  (let ((o (semantic-tag-overlay tag))
+	(hook (if writable nil '(semantic-overlay-signal-read-only))))
+    (if (featurep 'xemacs)
+        ;; XEmacs extents have a 'read-only' property.
+        (semantic-overlay-put o 'read-only (not writable))
+      (semantic-overlay-put o 'modification-hooks hook)
+      (semantic-overlay-put o 'insert-in-front-hooks hook)
+      (semantic-overlay-put o 'insert-behind-hooks hook))))
+
+(defun semantic-tag-read-only-p (tag)
+  "Return non-nil if the current TAG is marked read only."
+  (let ((o (semantic-tag-overlay tag)))
+    (if (featurep 'xemacs)
+        ;; XEmacs extents have a 'read-only' property.
+        (semantic-overlay-get o 'read-only)
+      (member 'semantic-overlay-signal-read-only
+              (semantic-overlay-get o 'modification-hooks)))))
+
+;;; backwards compatability
+
+(semantic-alias-obsolete 'semantic-highlight-token
+			 'semantic-highlight-tag)
+(semantic-alias-obsolete 'semantic-unhighlight-token
+			 'semantic-unhighlight-tag)
+(semantic-alias-obsolete 'semantic-momentary-highlight-token
+			 'semantic-momentary-highlight-tag)
+(semantic-alias-obsolete 'semantic-set-token-face
+			 'semantic-set-tag-face)
+(semantic-alias-obsolete 'semantic-set-token-invisible
+			 'semantic-set-tag-invisible)
+(semantic-alias-obsolete 'semantic-token-invisible-p
+			 'semantic-tag-invisible-p)
+(semantic-alias-obsolete 'semantic-set-token-intangible
+			 'semantic-set-tag-intangible)
+(semantic-alias-obsolete 'semantic-token-intangible-p
+			 'semantic-tag-intangible-p)
+(semantic-alias-obsolete 'semantic-set-token-read-only
+			 'semantic-set-tag-read-only)
+(semantic-alias-obsolete 'semantic-token-read-only-p
+			 'semantic-tag-read-only-p)
+
+;;; Secondary overlays
+;;
+;; Some types of decoration require a second overlay to be made.
+;; It could be for images, arrows, or whatever.
+;; We need a way to create such an overlay, and make sure it
+;; gets whacked, but doesn't show up in the master list
+;; of overlays used for searching.
+(defun semantic-tag-secondary-overlays (tag)
+  "Return a list of secondary overlays active on TAG."
+  (semantic--tag-get-property tag 'secondary-overlays))
+
+(defun semantic-tag-create-secondary-overlay (tag &optional link-hook)
+  "Create a secondary overlay for TAG.
+Returns an overlay.  The overlay is also saved in TAG.
+LINK-HOOK is a function called whenever TAG is to be linked into
+a buffer.  It should take TAG and OVERLAY as arguments.
+The LINK-HOOK should be used to position and set properties on the
+generated secondary overlay."
+  (if (not (semantic-tag-overlay tag))
+      ;; do nothing if there is no overlay
+      nil
+    (let* ((os (semantic-tag-start tag))
+	   (oe (semantic-tag-end tag))
+	   (o (semantic-make-overlay os oe (semantic-tag-buffer tag) t))
+	   (attr (semantic-tag-secondary-overlays tag))
+	   )
+      (semantic--tag-put-property tag 'secondary-overlays (cons o attr))
+      (semantic-overlay-put o 'semantic-secondary t)
+      (semantic-overlay-put o 'semantic-link-hook link-hook)
+      (semantic-tag-add-hook tag 'link-hook 'semantic--tag-link-secondary-overlays)
+      (semantic-tag-add-hook tag 'unlink-hook 'semantic--tag-unlink-secondary-overlays)
+      (semantic-tag-add-hook tag 'unlink-copy-hook 'semantic--tag-unlink-copy-secondary-overlays)
+      (run-hook-with-args link-hook tag o)
+      o)))
+
+(defun semantic-tag-get-secondary-overlay (tag property)
+  "Return secondary overlays from TAG with PROPERTY.
+PROPERTY is a symbol and all overlays with that symbol are returned.."
+  (let* ((olsearch (semantic-tag-secondary-overlays tag))
+	 (o nil))
+    (while olsearch
+      (when (semantic-overlay-get (car olsearch) property)
+	(setq o (cons (car olsearch) o)))
+      (setq olsearch (cdr olsearch)))
+    o))
+
+(defun semantic-tag-delete-secondary-overlay (tag overlay-or-property)
+  "Delete from TAG the secondary overlay OVERLAY-OR-PROPERTY.
+If OVERLAY-OR-PROPERTY is an overlay, delete that overlay.
+If OVERLAY-OR-PROPERTY is a symbol, find the overlay with that property."
+  (let* ((o overlay-or-property))
+    (if (semantic-overlay-p o)
+	(setq o (list o))
+      (setq o (semantic-tag-get-secondary-overlay tag overlay-or-property)))
+    (while (semantic-overlay-p (car o))
+      ;; We don't really need to worry about the hooks.
+      ;; They will clean themselves up eventually ??
+      (semantic--tag-put-property
+       tag 'secondary-overlays
+       (delete (car o) (semantic-tag-secondary-overlays tag)))
+      (semantic-overlay-delete (car o))
+      (setq o (cdr o)))))
+
+(defun semantic--tag-unlink-copy-secondary-overlays (tag)
+  "Unlink secondary overlays from TAG which is a copy.
+This means we don't destroy the overlays, only remove reference
+from them in TAG."
+  (let ((ol (semantic-tag-secondary-overlays tag)))
+    (while ol
+      ;; Else, remove all  traces of ourself from the tag
+      ;; Note to self: Does this prevent multiple types of secondary
+      ;; overlays per tag?
+      (semantic-tag-remove-hook tag 'link-hook 'semantic--tag-link-secondary-overlays)
+      (semantic-tag-remove-hook tag 'unlink-hook 'semantic--tag-unlink-secondary-overlays)
+      (semantic-tag-remove-hook tag 'unlink-copy-hook 'semantic--tag-unlink-copy-secondary-overlays)
+      ;; Next!
+      (setq ol (cdr ol)))
+    (semantic--tag-put-property tag 'secondary-overlays nil)
+    ))
+
+(defun semantic--tag-unlink-secondary-overlays (tag)
+  "Unlink secondary overlays from TAG."
+  (let ((ol (semantic-tag-secondary-overlays tag))
+	(nl nil))
+    (while ol
+      (if (semantic-overlay-get (car ol) 'semantic-link-hook)
+	  ;; Only put in a proxy if there is a link-hook.  If there is no link-hook
+	  ;; the decorating mode must know when tags are unlinked on its own.
+	  (setq nl (cons (semantic-overlay-get (car ol) 'semantic-link-hook)
+			 nl))
+	;; Else, remove all  traces of ourself from the tag
+	;; Note to self: Does this prevent multiple types of secondary
+	;; overlays per tag?
+	(semantic-tag-remove-hook tag 'link-hook 'semantic--tag-link-secondary-overlays)
+	(semantic-tag-remove-hook tag 'unlink-hook 'semantic--tag-unlink-secondary-overlays)
+	(semantic-tag-remove-hook tag 'unlink-copy-hook 'semantic--tag-unlink-copy-secondary-overlays)
+	)
+      (semantic-overlay-delete (car ol))
+      (setq ol (cdr ol)))
+    (semantic--tag-put-property tag 'secondary-overlays (nreverse nl))
+    ))
+
+(defun semantic--tag-link-secondary-overlays (tag)
+  "Unlink secondary overlays from TAG."
+  (let ((ol (semantic-tag-secondary-overlays tag)))
+    ;; Wipe out old values.
+    (semantic--tag-put-property tag 'secondary-overlays nil)
+    ;; Run all the link hooks.
+    (while ol
+      (semantic-tag-create-secondary-overlay tag (car ol))
+      (setq ol (cdr ol)))
+    ))
+
+;;; Secondary Overlay Uses
+;;
+;; States to put on tags that depend on a secondary overlay.
+(defun semantic-set-tag-folded (tag &optional folded)
+  "Fold TAG, such that only the first line of text is shown.
+Optional argument FOLDED should be non-nil to fold the tag.
+nil implies the tag should be fully shown."
+    ;; If they are different, do the deed.
+    (let ((o (semantic-tag-folded-p tag)))
+      (if (not folded)
+	  ;; We unfold.
+	  (when o
+	    (semantic-tag-delete-secondary-overlay tag 'semantic-folded))
+	(unless o
+	  ;; Add the foldn
+	  (setq o (semantic-tag-create-secondary-overlay tag))
+	  ;; mark as folded
+	  (semantic-overlay-put o 'semantic-folded t)
+	  ;; Move to cover end of tag
+	  (save-excursion
+	    (goto-char (semantic-tag-start tag))
+	    (end-of-line)
+	    (semantic-overlay-move o (point) (semantic-tag-end tag)))
+	  ;; We need to modify the invisibility spec for this to
+	  ;; work.
+	  (if (or (eq buffer-invisibility-spec t)
+		  (not (assoc 'semantic-fold buffer-invisibility-spec)))
+	      (add-to-invisibility-spec '(semantic-fold . t)))
+	  (semantic-overlay-put o 'invisible 'semantic-fold)
+	  (overlay-put o 'isearch-open-invisible
+		       'semantic-set-tag-folded-isearch)))
+	  ))
+
+(defun semantic-set-tag-folded-isearch (overlay)
+  "Called by isearch if it discovers text in the folded region.
+OVERLAY is passed in by isearch."
+  (semantic-set-tag-folded (semantic-current-tag) nil)
+  )
+
+(defun semantic-tag-folded-p (tag)
+  "Non-nil if TAG is currently folded."
+  (semantic-tag-get-secondary-overlay tag 'semantic-folded)
+  )
+
+(provide 'semantic/decorate)
+
+;;; semantic-decorate.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/lex-spp.el	Fri Aug 28 15:19:20 2009 +0000
@@ -0,0 +1,1187 @@
+;;; semantic-lex-spp.el --- Semantic Lexical Pre-processor
+
+;;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+
+;; 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:
+;;
+;; The Semantic Preprocessor works with semantic-lex to provide a phase
+;; during lexical analysis to do the work of a pre-processor.
+;;
+;; A pre-processor identifies lexical syntax mixed in with another language
+;; and replaces some keyword tokens with streams of alternate tokens.
+;;
+;; If you use SPP in your language, be sure to specify this in your
+;; semantic language setup function:
+;;
+;; (add-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook nil t)
+;;
+;;
+;; Special Lexical Tokens:
+;;
+;; There are several special lexical tokens that are used by the
+;; Semantic PreProcessor lexer.  They are:
+;;
+;; Declarations:
+;;   spp-macro-def - A definition of a lexical macro.
+;;   spp-macro-undef - A removal of a definition of a lexical macro.
+;;   spp-system-include - A system level include file
+;;   spp-include - An include file
+;;   spp-concat - A lexical token representing textual concatenation
+;;           of symbol parts.
+;;
+;; Operational tokens:
+;;   spp-arg-list - Represents an argument list to a macro.
+;;   spp-symbol-merge - A request for multiple symbols to be textually merged.
+;;
+;;; TODO:
+;;
+;; Use `semantic-push-parser-warning' for situations where there are likely
+;; macros that are undefined unexpectedly, or other problem.
+;;
+;; TODO:
+;;
+;; Try to handle the case of:
+;;
+;; #define NN namespace nn {
+;; #define NN_END }
+;;
+;; NN
+;;   int mydecl() {}
+;; NN_END
+;;
+
+(require 'semantic/lex)
+
+;;; Code:
+(defvar semantic-lex-spp-macro-symbol-obarray nil
+  "Table of macro keywords used by the Semantic Preprocessor.
+These symbols will be used in addition to those in
+`semantic-lex-spp-dynamic-macro-symbol-obarray'.")
+(make-variable-buffer-local 'semantic-lex-spp-macro-symbol-obarray)
+
+(defvar semantic-lex-spp-project-macro-symbol-obarray nil
+  "Table of macro keywords for this project.
+These symbols will be used in addition to those in
+`semantic-lex-spp-dynamic-macro-symbol-obarray'.")
+(make-variable-buffer-local 'semantic-lex-spp-project-macro-symbol-obarray)
+
+(defvar semantic-lex-spp-dynamic-macro-symbol-obarray nil
+  "Table of macro keywords used during lexical analysis.
+Macros are lexical symbols which are replaced by other lexical
+tokens during lexical analysis.  During analysis symbols can be
+added and removed from this symbol table.")
+(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray)
+
+(defvar semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil
+  "A stack of obarrays for temporarilly scoped macro values.")
+(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray-stack)
+
+(defvar semantic-lex-spp-expanded-macro-stack nil
+  "The stack of lexical SPP macros we have expanded.")
+;; The above is not buffer local.  Some macro expansions need to be
+;; dumped into a secondary buffer for re-lexing.
+
+;;; NON-RECURSIVE MACRO STACK
+;; C Pre-processor does not allow recursive macros.  Here are some utils
+;; for managing the symbol stack of where we've been.
+
+(defmacro semantic-lex-with-macro-used (name &rest body)
+  "With the macro NAME currently being expanded, execute BODY.
+Pushes NAME into the macro stack.  The above stack is checked
+by `semantic-lex-spp-symbol' to not return true for any symbol
+currently being expanded."
+  `(unwind-protect
+       (progn
+	 (push ,name semantic-lex-spp-expanded-macro-stack)
+	 ,@body)
+     (pop semantic-lex-spp-expanded-macro-stack)))
+(put 'semantic-lex-with-macro-used 'lisp-indent-function 1)
+
+(add-hook
+ 'edebug-setup-hook
+ #'(lambda ()
+
+     (def-edebug-spec semantic-lex-with-macro-used
+       (symbolp def-body)
+       )
+
+     ))
+
+;;; MACRO TABLE UTILS
+;;
+;; The dynamic macro table is a buffer local variable that is modified
+;; during the analysis.  OBARRAYs are used, so the language must
+;; have symbols that are compatible with Emacs Lisp symbols.
+;;
+(defsubst semantic-lex-spp-symbol (name)
+  "Return spp symbol with NAME or nil if not found.
+The searcy priority is:
+  1. DYNAMIC symbols
+  2. PROJECT specified symbols.
+  3. SYSTEM specified symbols."
+  (and
+   ;; Only strings...
+   (stringp name)
+   ;; Make sure we don't recurse.
+   (not (member name semantic-lex-spp-expanded-macro-stack))
+   ;; Do the check of the various tables.
+   (or
+    ;; DYNAMIC
+    (and (arrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
+	 (intern-soft name semantic-lex-spp-dynamic-macro-symbol-obarray))
+    ;; PROJECT
+    (and (arrayp semantic-lex-spp-project-macro-symbol-obarray)
+	 (intern-soft name semantic-lex-spp-project-macro-symbol-obarray))
+    ;; SYSTEM
+    (and (arrayp semantic-lex-spp-macro-symbol-obarray)
+	 (intern-soft name semantic-lex-spp-macro-symbol-obarray))
+    ;; ...
+    )))
+
+(defsubst semantic-lex-spp-symbol-p (name)
+  "Return non-nil if a keyword with NAME exists in any keyword table."
+  (if (semantic-lex-spp-symbol name)
+      t))
+
+(defsubst semantic-lex-spp-dynamic-map ()
+  "Return the dynamic macro map for the current buffer."
+  (or semantic-lex-spp-dynamic-macro-symbol-obarray
+      (setq semantic-lex-spp-dynamic-macro-symbol-obarray
+	    (make-vector 13 0))))
+
+(defsubst semantic-lex-spp-dynamic-map-stack ()
+  "Return the dynamic macro map for the current buffer."
+  (or semantic-lex-spp-dynamic-macro-symbol-obarray-stack
+      (setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack
+	    (make-vector 13 0))))
+
+(defun semantic-lex-spp-symbol-set (name value &optional obarray-in)
+  "Set value of spp symbol with NAME to VALUE and return VALUE.
+If optional OBARRAY-IN is non-nil, then use that obarray instead of
+the dynamic map."
+  (if (and (stringp value) (string= value "")) (setq value nil))
+  (set (intern name (or obarray-in
+			(semantic-lex-spp-dynamic-map)))
+       value))
+
+(defsubst semantic-lex-spp-symbol-remove (name &optional obarray)
+  "Remove the spp symbol with NAME.
+If optional OBARRAY is non-nil, then use that obarray instead of
+the dynamic map."
+  (unintern name (or obarray
+		     (semantic-lex-spp-dynamic-map))))
+
+(defun semantic-lex-spp-symbol-push (name value)
+  "Push macro NAME with VALUE into the map.
+Reverse with `semantic-lex-spp-symbol-pop'."
+  (let* ((map (semantic-lex-spp-dynamic-map))
+	 (stack (semantic-lex-spp-dynamic-map-stack))
+	 (mapsym (intern name map))
+	 (stacksym (intern name stack))
+	 (mapvalue (when (boundp mapsym) (symbol-value mapsym)))
+	 )
+    (when (boundp mapsym)
+      ;; Make sure there is a stack
+      (if (not (boundp stacksym)) (set stacksym nil))
+      ;; If there is a value to push, then push it.
+      (set stacksym (cons mapvalue (symbol-value stacksym)))
+      )
+    ;; Set our new value here.
+    (set mapsym value)
+    ))
+
+(defun semantic-lex-spp-symbol-pop (name)
+  "Pop macro NAME from the stackmap into the orig map.
+Reverse with `semantic-lex-spp-symbol-pop'."
+  (let* ((map (semantic-lex-spp-dynamic-map))
+	 (stack (semantic-lex-spp-dynamic-map-stack))
+	 (mapsym (intern name map))
+	 (stacksym (intern name stack))
+	 (oldvalue nil)
+	 )
+    (if (or (not (boundp stacksym) )
+	    (= (length (symbol-value stacksym)) 0))
+	;; Nothing to pop, remove it.
+	(unintern name map)
+      ;; If there is a value to pop, then add it to the map.
+      (set mapsym (car (symbol-value stacksym)))
+      (set stacksym (cdr (symbol-value stacksym)))
+      )))
+
+(defsubst semantic-lex-spp-symbol-stream (name)
+  "Return replacement stream of macro with NAME."
+  (let ((spp (semantic-lex-spp-symbol name)))
+    (if spp
+        (symbol-value spp))))
+
+(defun semantic-lex-make-spp-table (specs)
+  "Convert spp macro list SPECS into an obarray and return it.
+SPECS must be a list of (NAME . REPLACEMENT) elements, where:
+
+NAME is the name of the spp macro symbol to define.
+REPLACEMENT a string that would be substituted in for NAME."
+
+  ;; Create the symbol hash table
+  (let ((semantic-lex-spp-macro-symbol-obarray (make-vector 13 0))
+        spec)
+    ;; fill it with stuff
+    (while specs
+      (setq spec  (car specs)
+            specs (cdr specs))
+      (semantic-lex-spp-symbol-set
+       (car spec)
+       (cdr spec)
+       semantic-lex-spp-macro-symbol-obarray))
+    semantic-lex-spp-macro-symbol-obarray))
+
+(defun semantic-lex-spp-save-table ()
+  "Return a list of spp macros and values.
+The return list is meant to be saved in a semanticdb table."
+  (let (macros)
+    (when (arrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
+      (mapatoms
+       #'(lambda (symbol)
+	   (setq macros (cons (cons (symbol-name symbol)
+				    (symbol-value symbol))
+			      macros)))
+       semantic-lex-spp-dynamic-macro-symbol-obarray))
+    macros))
+
+(defun semantic-lex-spp-macros ()
+  "Return a list of spp macros as Lisp symbols.
+The value of each symbol is the replacement stream."
+  (let (macros)
+    (when (arrayp semantic-lex-spp-macro-symbol-obarray)
+      (mapatoms
+       #'(lambda (symbol)
+	   (setq macros (cons symbol macros)))
+       semantic-lex-spp-macro-symbol-obarray))
+    (when (arrayp semantic-lex-spp-project-macro-symbol-obarray)
+      (mapatoms
+       #'(lambda (symbol)
+	   (setq macros (cons symbol macros)))
+       semantic-lex-spp-project-macro-symbol-obarray))
+    (when (arrayp semantic-lex-spp-dynamic-macro-symbol-obarray)
+      (mapatoms
+       #'(lambda (symbol)
+	   (setq macros (cons symbol macros)))
+       semantic-lex-spp-dynamic-macro-symbol-obarray))
+    macros))
+
+(defun semantic-lex-spp-set-dynamic-table (new-entries)
+  "Set the dynamic symbol table to NEW-ENTRIES.
+For use with semanticdb restoration of state."
+  (dolist (e new-entries)
+    ;; Default obarray for below is the dynamic map.
+    (semantic-lex-spp-symbol-set (car e) (cdr e))))
+
+(defun semantic-lex-spp-reset-hook (start end)
+  "Reset anything needed by SPP for parsing.
+In this case, reset the dynamic macro symbol table if
+START is (point-min).
+END is not used."
+  (when (= start (point-min))
+    (setq semantic-lex-spp-dynamic-macro-symbol-obarray nil
+	  semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil
+	  ;; This shouldn't not be nil, but reset just in case.
+	  semantic-lex-spp-expanded-macro-stack nil)
+    ))
+
+;;; MACRO EXPANSION: Simple cases
+;;
+;; If a user fills in the table with simple strings, we can
+;; support that by converting them into tokens with the
+;; various analyzers that are available.
+
+(defun semantic-lex-spp-extract-regex-and-compare (analyzer value)
+  "Extract a regexp from an ANALYZER and use to match VALUE.
+Return non-nil if it matches"
+  (let* ((condition (car analyzer))
+	 (regex (cond ((eq (car condition) 'looking-at)
+		       (nth 1 condition))
+		      (t
+		       nil))))
+    (when regex
+      (string-match regex value))
+    ))
+
+(defun semantic-lex-spp-simple-macro-to-macro-stream (val beg end argvalues)
+  "Convert lexical macro contents VAL into a macro expansion stream.
+These are for simple macro expansions that a user may have typed in directly.
+As such, we need to analyze the input text, to figure out what kind of real
+lexical token we should be inserting in its place.
+
+Argument VAL is the value of some macro to be converted into a stream.
+BEG and END are the token bounds of the macro to be expanded
+that will somehow gain a much longer token stream.
+ARGVALUES are values for any arg list, or nil."
+  (cond
+   ;; We perform a replacement.  Technically, this should
+   ;; be a full lexical step over the "val" string, but take
+   ;; a guess that its just a keyword or existing symbol.
+   ;;
+   ;; Probably a really bad idea.  See how it goes.
+   ((semantic-lex-spp-extract-regex-and-compare
+     semantic-lex-symbol-or-keyword val)
+    (semantic-lex-push-token
+     (semantic-lex-token (or (semantic-lex-keyword-p val) 'symbol)
+			 beg end
+			 val)))
+
+   ;; Ok, the rest of these are various types of syntax.
+   ;; Conveniences for users that type in their symbol table.
+   ((semantic-lex-spp-extract-regex-and-compare
+     semantic-lex-punctuation val)
+    (semantic-lex-token 'punctuation beg end val))
+   ((semantic-lex-spp-extract-regex-and-compare
+     semantic-lex-number val)
+    (semantic-lex-token 'number beg end val))
+   ((semantic-lex-spp-extract-regex-and-compare
+     semantic-lex-paren-or-list val)
+    (semantic-lex-token 'semantic-list beg end val))
+   ((semantic-lex-spp-extract-regex-and-compare
+     semantic-lex-string val)
+    (semantic-lex-token 'string beg end val))
+   (t nil)
+   ))
+
+;;; MACRO EXPANSION : Lexical token replacement
+;;
+;; When substituting in a macro from a token stream of formatted
+;; semantic lex tokens, things can be much more complicated.
+;;
+;; Some macros have arguments that get set into the dynamic macro
+;; table during replacement.
+;;
+;; In general, the macro tokens are substituted into the regular
+;; token stream, but placed under the characters of the original
+;; macro symbol.
+;;
+;; Argument lists are saved as a lexical token at the beginning
+;; of a replacement value.
+
+(defun semantic-lex-spp-one-token-to-txt (tok)
+  "Convert the token TOK into a string.
+If TOK is made of multiple tokens, convert those to text.  This
+conversion is needed if a macro has a merge symbol in it that
+combines the text of two previously distinct symbols.  For
+exampe, in c:
+
+#define (a,b) a ## b;"
+  (let ((txt (semantic-lex-token-text tok))
+	(sym nil)
+	)
+    (cond ((and (eq (car tok) 'symbol)
+		(setq sym (semantic-lex-spp-symbol txt))
+		(not (semantic-lex-spp-macro-with-args (symbol-value sym)))
+		)
+	   ;; Now that we have a symbol,
+	   (let ((val (symbol-value sym)))
+	     (cond ((and (consp val)
+			 (symbolp (car val)))
+		    (semantic-lex-spp-one-token-to-txt val))
+		   ((and (consp val)
+			 (consp (car val))
+			 (symbolp (car (car val))))
+		    (mapconcat (lambda (subtok)
+				 (semantic-lex-spp-one-token-to-txt subtok))
+			       val
+			       ""))
+		   ;; If val is nil, that's probably wrong.
+		   ;; Found a system header case where this was true.
+		   ((null val) "")
+		   ;; Debug wierd stuff.
+		   (t (debug)))
+	     ))
+	  ((stringp txt)
+	   txt)
+	  (t nil))
+    ))
+
+(defun semantic-lex-spp-macro-with-args (val)
+  "If the macro value VAL has an argument list, return the arglist."
+  (when (and val (consp val) (consp (car val))
+	     (eq 'spp-arg-list (car (car val))))
+    (car (cdr (car val)))))
+
+(defun semantic-lex-spp-token-macro-to-macro-stream (val beg end argvalues)
+  "Convert lexical macro contents VAL into a macro expansion stream.
+Argument VAL is the value of some macro to be converted into a stream.
+BEG and END are the token bounds of the macro to be expanded
+that will somehow gain a much longer token stream.
+ARGVALUES are values for any arg list, or nil.
+See comments in code for information about how token streams are processed
+and what valid VAL values are."
+
+  ;; A typical VAL value might be either a stream of tokens.
+  ;; Tokens saved into a macro stream always includes the text from the
+  ;; buffer, since the locations specified probably don't represent
+  ;; that text anymore, or even the same buffer.
+  ;;
+  ;; CASE 1: Simple token stream
+  ;;
+  ;; #define SUPER mysuper::
+  ;;  ==>
+  ;;((symbol "mysuper" 480 . 487)
+  ;; (punctuation ":" 487 . 488)
+  ;; (punctuation ":" 488 . 489))
+  ;;
+  ;; CASE 2: Token stream with argument list
+  ;;
+  ;; #define INT_FCN(name) int name (int in)
+  ;;  ==>
+  ;; ((spp-arg-list ("name") 558 . 564)
+  ;;  (INT "int" 565 . 568)
+  ;;  (symbol "name" 569 . 573)
+  ;;  (semantic-list "(int in)" 574 . 582))
+  ;;
+  ;; In the second case, a macro with an argument list as the a rgs as the
+  ;; first entry.
+  ;;
+  ;; CASE 3: Symbol text merge
+  ;;
+  ;; #define TMP(a) foo_ ## a
+  ;;   ==>
+  ;; ((spp-arg-list ("a") 20 . 23)
+  ;;  (spp-symbol-merge ((symbol "foo_" 24 . 28) (symbol "a" 32 . 33))
+  ;; 		          24 . 33))
+  ;;
+  ;; Usually in conjunction with a macro with an argument, merging symbol
+  ;; parts is a way of fabricating new symbols from pieces inside the macro.
+  ;; These macros use `spp-symbol-merge' tokens whose TEXT part is another
+  ;; token stream.  This sub-stream ought to consist of only 2 SYMBOL pieces,
+  ;; though I suppose keywords might be ok.  The end result of this example
+  ;; merge symbol would be (symbol "foo_A" 24 . 33) where A is the symbol
+  ;; passed in from the arg list "a".
+  ;;
+  ;; CASE 4: Nested token streams
+  ;;
+  ;; #define FOO(f) f
+  ;; #define BLA bla FOO(foo)
+  ;;  ==>
+  ;; ((INT "int" 82 . 85)
+  ;;  (symbol "FOO" 86 . 89)
+  ;;  (semantic-list "(foo)" 89 . 94))
+  ;;
+  ;; Nested token FOO shows up in the table of macros, and gets replace
+  ;; inline.  This is the same as case 2.
+
+  (let ((arglist (semantic-lex-spp-macro-with-args val))
+	(argalist nil)
+	(val-tmp nil)
+	(v nil)
+	)
+    ;; CASE 2: Dealing with the arg list.
+    (when arglist
+      ;;  Skip the arg list.
+      (setq val (cdr val))
+
+      ;; Push args into the replacement list.
+      (let ((AV argvalues))
+	(dolist (A arglist)
+	  (let* ((argval (car AV)))
+
+	    (semantic-lex-spp-symbol-push A argval)
+	    (setq argalist (cons (cons A argval) argalist))
+	    (setq AV (cdr AV)))))
+      )
+
+    ;; Set val-tmp after stripping arguments.
+    (setq val-tmp val)
+
+    ;; CASE 1: Push everything else onto the list.
+    ;;   Once the arg list is stripped off, CASE 2 is the same
+    ;;   as CASE 1.
+    (while val-tmp
+      (setq v (car val-tmp))
+      (setq val-tmp (cdr val-tmp))
+
+      (let* (;; The text of the current lexical token.
+	     (txt (car (cdr v)))
+	     ;; Try to convert txt into a macro declaration.  If it is
+	     ;; not a macro, use nil.
+	     (txt-macro-or-nil (semantic-lex-spp-symbol txt))
+	     ;; If our current token is a macro, then pull off the argument
+	     ;; list.
+	     (macro-and-args
+	      (when txt-macro-or-nil
+		(semantic-lex-spp-macro-with-args (symbol-value txt-macro-or-nil)))
+	      )
+	     ;; We need to peek at the next token when testing for
+	     ;; used macros with arg lists.
+	     (next-tok-class (semantic-lex-token-class (car val-tmp)))
+	     )
+
+	(cond
+	 ;; CASE 3: Merge symbols together.
+	 ((eq (semantic-lex-token-class v) 'spp-symbol-merge)
+	  ;; We need to merge the tokens in the 'text segement together,
+	  ;; and produce a single symbol from it.
+	  (let ((newsym
+		 (mapconcat (lambda (tok)
+			      (semantic-lex-spp-one-token-to-txt tok))
+			    txt
+			    "")))
+	    (semantic-lex-push-token
+	     (semantic-lex-token 'symbol beg end newsym))
+	    ))
+
+	 ;; CASE 2: Argument replacement.   If a discovered symbol is in
+	 ;;    the active list of arguments, then we need to substitute
+	 ;;    in the new value.
+	 ((and (eq (semantic-lex-token-class v) 'symbol) txt-macro-or-nil
+	       (or (and macro-and-args (eq next-tok-class 'semantic-list))
+		   (not macro-and-args))
+	       )
+	  (let ((AV nil))
+	    (when macro-and-args
+	      (setq AV
+		    (semantic-lex-spp-stream-for-arglist (car val-tmp)))
+	      ;; We used up these args.  Pull from the stream.
+	      (setq val-tmp (cdr val-tmp))
+	      )
+
+	    (semantic-lex-with-macro-used txt
+	      ;; Don't recurse directly into this same fcn, because it is
+	      ;; convenient to have plain string replacements too.
+	      (semantic-lex-spp-macro-to-macro-stream
+	       (symbol-value txt-macro-or-nil)
+	       beg end AV))
+	    ))
+
+	 ;; This is a HACK for the C parser.  The 'macros text
+	 ;; property is some storage so that the parser can do
+	 ;; some C specific text manipulations.
+	 ((eq (semantic-lex-token-class v) 'semantic-list)
+	  ;; Push our arg list onto the semantic list.
+	  (when argalist
+	    (setq txt (concat txt)) ; Copy the text.
+	    (put-text-property 0 1 'macros argalist txt))
+	  (semantic-lex-push-token
+	   (semantic-lex-token (semantic-lex-token-class v) beg end txt))
+	  )
+
+	 ;; CASE 1: Just another token in the stream.
+	 (t
+	  ;; Nothing new.
+	  (semantic-lex-push-token
+	   (semantic-lex-token (semantic-lex-token-class v) beg end txt))
+	  )
+	 )))
+
+    ;; CASE 2: The arg list we pushed onto the symbol table
+    ;;         must now be removed.
+    (dolist (A arglist)
+      (semantic-lex-spp-symbol-pop A))
+    ))
+
+;;; Macro Merging
+;;
+;; Used when token streams from different macros include eachother.
+;; Merged macro streams perform in place replacements.
+
+(defun semantic-lex-spp-merge-streams (raw-stream)
+  "Merge elements from the RAW-STREAM together.
+Handle spp-concat symbol concatenation.
+Handle Nested macro replacements.
+Return the cooked stream."
+  (let ((cooked-stream nil))
+    ;; Merge the stream
+    (while raw-stream
+      (cond ((eq (semantic-lex-token-class (car raw-stream)) 'spp-concat)
+	     ;; handle hashhash, by skipping it.
+	     (setq raw-stream (cdr raw-stream))
+	     ;; Now merge the symbols.
+	     (let ((prev-tok (car cooked-stream))
+		   (next-tok (car raw-stream)))
+	       (setq cooked-stream (cdr cooked-stream))
+	       (push (semantic-lex-token
+		      'spp-symbol-merge
+		      (semantic-lex-token-start prev-tok)
+		      (semantic-lex-token-end next-tok)
+		      (list prev-tok next-tok))
+		     cooked-stream)
+	       ))
+	    (t
+	     (push (car raw-stream) cooked-stream))
+	    )
+      (setq raw-stream (cdr raw-stream))
+      )
+
+    (nreverse cooked-stream))
+  )
+
+;;; MACRO EXPANSION
+;;
+;; There are two types of expansion.
+;;
+;; 1. Expansion using a value made up of lexical tokens.
+;; 2. User input replacement from a plain string.
+
+(defun semantic-lex-spp-macro-to-macro-stream (val beg end argvalues)
+  "Convert lexical macro contents VAL into a macro expansion stream.
+Argument VAL is the value of some macro to be converted into a stream.
+BEG and END are the token bounds of the macro to be expanded
+that will somehow gain a much longer token stream.
+ARGVALUES are values for any arg list, or nil."
+  (cond
+   ;; If val is nil, then just skip it.
+   ((null val) t)
+   ;; If it is a token, then return that token rebuilt.
+   ((and (consp val) (car val) (symbolp (car val)))
+    (semantic-lex-push-token
+     (semantic-lex-token (car val) beg end (semantic-lex-token-text val))))
+   ;; Test for a token list.
+   ((and (consp val) (consp (car val)) (car (car val))
+	 (symbolp (car (car val))))
+    (semantic-lex-spp-token-macro-to-macro-stream val beg end argvalues))
+   ;; Test for miscellaneous strings.
+   ((stringp val)
+    (semantic-lex-spp-simple-macro-to-macro-stream val beg end argvalues))
+   ))
+
+;;; --------------------------------------------------------
+;;;
+;;; ANALYZERS:
+;;;
+
+;;; Symbol Is Macro
+;;
+;; An analyser that will push tokens from a macro in place
+;; of the macro symbol.
+;;
+(defun semantic-lex-spp-anlyzer-do-replace (sym val beg end)
+  "Do the lexical replacement for SYM with VAL.
+Argument BEG and END specify the bounds of SYM in the buffer."
+  (if (not val)
+      (setq semantic-lex-end-point end)
+    (let ((arg-in nil)
+	  (arg-parsed nil)
+	  (arg-split nil)
+	  )
+
+      ;; Check for arguments.
+      (setq arg-in (semantic-lex-spp-macro-with-args val))
+
+      (when arg-in
+	(save-excursion
+	  (goto-char end)
+	  (setq arg-parsed
+		(semantic-lex-spp-one-token-and-move-for-macro
+		 (point-at-eol)))
+	  (setq end (semantic-lex-token-end arg-parsed))
+
+	  (when (and (listp arg-parsed) (eq (car arg-parsed) 'semantic-list))
+	    (setq arg-split
+		  ;; Use lex to split up the contents of the argument list.
+		  (semantic-lex-spp-stream-for-arglist arg-parsed)
+		  ))
+	  ))
+
+      ;; if we have something to sub in, then do it.
+      (semantic-lex-spp-macro-to-macro-stream val beg end arg-split)
+      (setq semantic-lex-end-point end)
+      )
+    ))
+
+(defvar semantic-lex-spp-replacements-enabled t
+  "Non-nil means do replacements when finding keywords.
+Disable this only to prevent recursive expansion issues.")
+
+(defun semantic-lex-spp-analyzer-push-tokens-for-symbol (str beg end)
+  "Push lexical tokens for the symbol or keyword STR.
+STR occurs in the current buffer between BEG and END."
+  (let (sym val)
+    (cond
+     ;;
+     ;; It is a macro.  Prepare for a replacement.
+     ((and semantic-lex-spp-replacements-enabled
+	   (semantic-lex-spp-symbol-p str))
+      (setq sym (semantic-lex-spp-symbol str)
+	    val (symbol-value sym)
+	    count 0)
+
+      (let ((semantic-lex-spp-expanded-macro-stack
+	     semantic-lex-spp-expanded-macro-stack))
+
+	(semantic-lex-with-macro-used str
+	  ;; Do direct replacements of single value macros of macros.
+	  ;; This solves issues with a macro containing one symbol that
+	  ;; is another macro, and get arg lists passed around.
+	  (while (and val (consp val)
+		      (semantic-lex-token-p (car val))
+		      (eq (length val) 1)
+		      (eq (semantic-lex-token-class (car val)) 'symbol)
+		      (semantic-lex-spp-symbol-p (semantic-lex-token-text (car val)))
+		      (< count 10)
+		      )
+	    (setq str (semantic-lex-token-text (car val)))
+	    (setq sym (semantic-lex-spp-symbol str)
+		  val (symbol-value sym))
+	    ;; Prevent recursion
+	    (setq count (1+ count))
+	    ;; This prevents a different kind of recursion.
+	    (push str semantic-lex-spp-expanded-macro-stack)
+	    )
+
+	  (semantic-lex-spp-anlyzer-do-replace sym val beg end))
+
+	))
+     ;; Anything else.
+     (t
+      ;; A regular keyword.
+      (semantic-lex-push-token
+       (semantic-lex-token (or (semantic-lex-keyword-p str) 'symbol)
+			   beg end))))
+    ))
+
+(define-lex-regex-analyzer semantic-lex-spp-replace-or-symbol-or-keyword
+  "Like 'semantic-lex-symbol-or-keyword' plus preprocessor macro replacement."
+  "\\(\\sw\\|\\s_\\)+"
+  (let ((str (match-string 0))
+	(beg (match-beginning 0))
+	(end (match-end 0)))
+    (semantic-lex-spp-analyzer-push-tokens-for-symbol str beg end)))
+
+;;; ANALYZERS FOR NEW MACROS
+;;
+;; These utilities and analyzer declaration function are for
+;; creating an analyzer which produces new macros in the macro table.
+;;
+;; There are two analyzers.  One for new macros, and one for removing
+;; a macro.
+
+(defun semantic-lex-spp-first-token-arg-list (token)
+  "If TOKEN is a semantic-list, turn it into a an SPP ARG LIST."
+  (when (and (consp token)
+	     (symbolp (car token))
+	     (eq 'semantic-list (car token)))
+    ;; Convert TOKEN in place.
+    (let ((argsplit (cedet-split-string (semantic-lex-token-text token)
+					"[(), ]" t)))
+      (setcar token 'spp-arg-list)
+      (setcar (nthcdr 1 token) argsplit))
+    ))
+
+(defun semantic-lex-spp-one-token-and-move-for-macro (max)
+  "Lex up one token, and move to end of that token.
+Don't go past MAX."
+  (let ((ans (semantic-lex (point) max 0 0)))
+    (if (not ans)
+	(progn (goto-char max)
+	       nil)
+      (when (> (semantic-lex-token-end (car ans)) max)
+	(let ((bounds (semantic-lex-token-bounds (car ans))))
+	  (setcdr bounds max)))
+      (goto-char (semantic-lex-token-end (car ans)))
+      (car ans))
+    ))
+
+(defun semantic-lex-spp-stream-for-arglist (token)
+  "Lex up the contents of the arglist TOKEN.
+Parsing starts inside the parens, and ends at the end of TOKEN."
+  (let ((end (semantic-lex-token-end token))
+	(fresh-toks nil)
+	(toks nil))
+    (save-excursion
+
+      (if (stringp (nth 1 token))
+	  ;; If the 2nd part of the token is a string, then we have
+	  ;; a token specifically extracted from a buffer.  Possibly
+	  ;; a different buffer.  This means we need to do something
+	  ;; nice to parse its contents.
+	  (let ((txt (semantic-lex-token-text token)))
+	    (semantic-lex-spp-lex-text-string
+	     (substring txt 1 (1- (length txt)))))
+
+	;; This part is like the original
+	(goto-char (semantic-lex-token-start token))
+	;; A cheat for going into the semantic list.
+	(forward-char 1)
+	(setq fresh-toks (semantic-lex-spp-stream-for-macro (1- end)))
+	(dolist (tok fresh-toks)
+	  (when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
+	    (setq toks (cons tok toks))))
+
+	(nreverse toks)))))
+
+(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."
+  (let* ((buf (get-buffer-create " *SPP parse hack*"))
+	 (mode major-mode)
+	 (fresh-toks nil)
+	 (toks nil)
+	 (origbuff (current-buffer))
+	 (important-vars '(semantic-lex-spp-macro-symbol-obarray
+			   semantic-lex-spp-project-macro-symbol-obarray
+			   semantic-lex-spp-dynamic-macro-symbol-obarray
+			   semantic-lex-spp-dynamic-macro-symbol-obarray-stack
+			   semantic-lex-spp-expanded-macro-stack
+			   ))
+	 )
+    (set-buffer buf)
+    (erase-buffer)
+    ;; Below is a painful hack to make sure everything is setup correctly.
+    (when (not (eq major-mode mode))
+      (funcall mode)
+      ;; Hack in mode-local
+      (activate-mode-local-bindings)
+      ;; CHEATER!  The following 3 lines are from
+      ;; `semantic-new-buffer-fcn', but we don't want to turn
+      ;; on all the other annoying modes for this little task.
+      (setq semantic-new-buffer-fcn-was-run t)
+      (semantic-lex-init)
+      (semantic-clear-toplevel-cache)
+      (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
+		   t)
+      ;; Second Cheat: copy key variables reguarding macro state from the
+      ;; the originating buffer we are parsing.
+      (dolist (V important-vars)
+	(set V (semantic-buffer-local-value V origbuff)))
+      )
+    (insert text)
+    (goto-char (point-min))
+
+    (setq fresh-toks (semantic-lex-spp-stream-for-macro (point-max)))
+    (dolist (tok fresh-toks)
+      (when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
+	(setq toks (cons tok toks))))
+
+    (nreverse toks)))
+
+;;;; FIRST DRAFT
+;; This is the fist version of semantic-lex-spp-stream-for-arglist
+;; that worked pretty well.  It doesn't work if the TOKEN was derived
+;; from some other buffer, in which case it can get the wrong answer
+;; or throw an error if the token location in the originating buffer is
+;; larger than the current buffer.
+;;(defun semantic-lex-spp-stream-for-arglist-orig (token)
+;;  "Lex up the contents of the arglist TOKEN.
+;; Parsing starts inside the parens, and ends at the end of TOKEN."
+;;  (save-excursion
+;;    (let ((end (semantic-lex-token-end token))
+;;	  (fresh-toks nil)
+;;	  (toks nil))
+;;      (goto-char (semantic-lex-token-start token))
+;;      ;; A cheat for going into the semantic list.
+;;      (forward-char 1)
+;;      (setq fresh-toks (semantic-lex-spp-stream-for-macro (1- end)))
+;;      (dolist (tok fresh-toks)
+;;	(when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
+;;	  (setq toks (cons tok toks))))
+;;      (nreverse toks))
+;;    ))
+
+;;;; USING SPLIT
+;; This doesn't work, because some arguments passed into a macro
+;; might contain non-simple symbol words, which this doesn't handle.
+;;
+;; Thus, you need a full lex to occur.
+;; (defun semantic-lex-spp-stream-for-arglist-split (token)
+;;   "Lex up the contents of the arglist TOKEN.
+;; Parsing starts inside the parens, and ends at the end of TOKEN."
+;;   (let* ((txt (semantic-lex-token-text token))
+;; 	 (split (split-string (substring txt 1 (1- (length txt)))
+;; 			      "(), " t))
+;; 	 ;; Hack for lexing.
+;; 	 (semantic-lex-spp-analyzer-push-tokens-for-symbol nil))
+;;     (dolist (S split)
+;;       (semantic-lex-spp-analyzer-push-tokens-for-symbol S 0 1))
+;;     (reverse semantic-lex-spp-analyzer-push-tokens-for-symbol)))
+
+
+(defun semantic-lex-spp-stream-for-macro (eos)
+  "Lex up a stream of tokens for a #define statement.
+Parsing starts at the current point location.
+EOS is the end of the stream to lex for this macro."
+  (let ((stream nil))
+    (while (< (point) eos)
+      (let* ((tok (semantic-lex-spp-one-token-and-move-for-macro eos))
+	     (str (when tok
+		    (semantic-lex-token-text tok)))
+	     )
+	(if str
+	    (push (semantic-lex-token (semantic-lex-token-class tok)
+				      (semantic-lex-token-start tok)
+				      (semantic-lex-token-end tok)
+				      str)
+		  stream)
+	  ;; Nothing to push.
+	  nil)))
+    (goto-char eos)
+    ;; Fix the order
+    (nreverse stream)
+    ))
+
+(defmacro define-lex-spp-macro-declaration-analyzer (name doc regexp tokidx
+							  &rest valform)
+  "Define a lexical analyzer for defining new MACROS.
+NAME is the name of the analyzer.
+DOC is the documentation for the analyzer.
+REGEXP is a regular expression for the analyzer to match.
+See `define-lex-regex-analyzer' for more on regexp.
+TOKIDX is an index into REGEXP for which a new lexical token
+of type `spp-macro-def' is to be created.
+VALFORM are forms that return the value to be saved for this macro, or nil.
+When implementing a macro, you can use `semantic-lex-spp-stream-for-macro'
+to convert text into a lexical stream for storage in the macro."
+  (let ((start (make-symbol "start"))
+	(end (make-symbol "end"))
+	(val (make-symbol "val"))
+	(startpnt (make-symbol "startpnt"))
+	(endpnt (make-symbol "endpnt")))
+    `(define-lex-regex-analyzer ,name
+       ,doc
+       ,regexp
+       (let ((,start (match-beginning ,tokidx))
+	     (,end (match-end ,tokidx))
+	     (,startpnt semantic-lex-end-point)
+	     (,val (save-match-data ,@valform))
+	     (,endpnt semantic-lex-end-point))
+	 (semantic-lex-spp-symbol-set
+	  (buffer-substring-no-properties ,start ,end)
+	  ,val)
+	 (semantic-lex-push-token
+	  (semantic-lex-token 'spp-macro-def
+			      ,start ,end))
+	 ;; Preserve setting of the end point from the calling macro.
+	 (when (and (/= ,startpnt ,endpnt)
+		    (/= ,endpnt semantic-lex-end-point))
+	   (setq semantic-lex-end-point ,endpnt))
+	 ))))
+
+(defmacro define-lex-spp-macro-undeclaration-analyzer (name doc regexp tokidx)
+  "Undefine a lexical analyzer for defining new MACROS.
+NAME is the name of the analyzer.
+DOC is the documentation for the analyzer.
+REGEXP is a regular expression for the analyzer to match.
+See `define-lex-regex-analyzer' for more on regexp.
+TOKIDX is an index into REGEXP for which a new lexical token
+of type `spp-macro-undef' is to be created."
+  (let ((start (make-symbol "start"))
+	(end (make-symbol "end")))
+    `(define-lex-regex-analyzer ,name
+       ,doc
+       ,regexp
+       (let ((,start (match-beginning ,tokidx))
+	     (,end (match-end ,tokidx))
+	     )
+	 (semantic-lex-spp-symbol-remove
+	  (buffer-substring-no-properties ,start ,end))
+	 (semantic-lex-push-token
+	  (semantic-lex-token 'spp-macro-undef
+			      ,start ,end))
+	 ))))
+
+;;; INCLUDES
+;;
+;; These analyzers help a language define how include files
+;; are identified.  These are ONLY for languages that perform
+;; an actual textual includesion, and not for imports.
+;;
+;; This section is supposed to allow the macros from the headers to be
+;; added to the local dynamic macro table, but that hasn't been
+;; written yet.
+;;
+(defcustom semantic-lex-spp-use-headers-flag nil
+  "*Non-nil means to pre-parse headers as we go.
+For languages that use the Semantic pre-processor, this can
+improve the accuracy of parsed files where include files
+can change the state of what's parsed in the current file.
+
+Note: Note implemented yet"
+  :group 'semantic
+  :type 'boolean)
+
+(defun semantic-lex-spp-merge-header (name)
+  "Extract and merge any macros from the header with NAME.
+Finds the header file belonging to NAME, gets the macros
+from that file, and then merge the macros with our current
+symbol table."
+  (when semantic-lex-spp-use-headers-flag
+    ;; @todo - do this someday, ok?
+    ))
+
+(defmacro define-lex-spp-include-analyzer (name doc regexp tokidx
+						&rest valform)
+  "Define a lexical analyzer for defining a new INCLUDE lexical token.
+Macros defined in the found include will be added to our running table
+at the time the include statement is found.
+NAME is the name of the analyzer.
+DOC is the documentation for the analyzer.
+REGEXP is a regular expression for the analyzer to match.
+See `define-lex-regex-analyzer' for more on regexp.
+TOKIDX is an index into REGEXP for which a new lexical token
+of type `spp-macro-include' is to be created.
+VALFORM are forms that return the name of the thing being included, and the
+type of include.  The return value should be of the form:
+  (NAME . TYPE)
+where NAME is the name of the include, and TYPE is the type of the include,
+where a valid symbol is 'system, or nil."
+  (let ((start (make-symbol "start"))
+	(end (make-symbol "end"))
+	(val (make-symbol "val"))
+	(startpnt (make-symbol "startpnt"))
+	(endpnt (make-symbol "endpnt")))
+    `(define-lex-regex-analyzer ,name
+       ,doc
+       ,regexp
+       (let ((,start (match-beginning ,tokidx))
+	     (,end (match-end ,tokidx))
+	     (,startpnt semantic-lex-end-point)
+	     (,val (save-match-data ,@valform))
+	     (,endpnt semantic-lex-end-point))
+	 ;;(message "(car ,val) -> %S" (car ,val))
+	 (semantic-lex-spp-merge-header (car ,val))
+	 (semantic-lex-push-token
+	  (semantic-lex-token (if (eq (cdr ,val) 'system)
+				  'spp-system-include
+				'spp-include)
+			      ,start ,end
+			      (car ,val)))
+	 ;; Preserve setting of the end point from the calling macro.
+	 (when (and (/= ,startpnt ,endpnt)
+		    (/= ,endpnt semantic-lex-end-point))
+	   (setq semantic-lex-end-point ,endpnt))
+	 ))))
+
+;;; EIEIO USAGE
+;;
+;; Semanticdb can save off macro tables for quick lookup later.
+;;
+;; These routines are for saving macro lists into an EIEIO persistent
+;; file.
+(defvar semantic-lex-spp-macro-max-length-to-save 200
+  "*Maximum length of an SPP macro before we opt to not save it.")
+
+(defun semantic-lex-spp-table-write-slot-value (value)
+  "Write out the VALUE of a slot for EIEIO.
+The VALUE is a spp lexical table."
+  (if (not value)
+      (princ "nil")
+    (princ "\n        '(")
+    ;(princ value)
+    (dolist (sym value)
+      (princ "(")
+      (prin1 (car sym))
+      (let* ((first (car (cdr sym)))
+	     (rest (cdr sym)))
+	(when (not (listp first))
+	  (error "Error in macro \"%s\"" (car sym)))
+	(when (eq (car first) 'spp-arg-list)
+	  (princ " ")
+	  (prin1 first)
+	  (setq rest (cdr rest))
+	  )
+
+	(when rest
+	  (princ " . ")
+	  (let ((len (length (cdr rest))))
+	    (cond ((< len 2)
+		   (condition-case nil
+		       (prin1 rest)
+		     (error
+		      (princ "nil ;; Error writing macro\n"))))
+		  ((< len semantic-lex-spp-macro-max-length-to-save)
+		   (princ "\n              ")
+		   (condition-case nil
+		       (prin1 rest)
+		     (error
+		      (princ "nil ;; Error writing macro\n          ")))
+		   )
+		  (t ;; Too Long!
+		   (princ "nil ;; Too Long!\n          ")
+		   ))))
+	)
+      (princ ")\n          ")
+      )
+    (princ ")\n"))
+)
+
+;;; TESTS
+;;
+(defun semantic-lex-spp-write-test ()
+  "Test the semantic tag writer against the current buffer."
+  (interactive)
+  (with-output-to-temp-buffer "*SPP Write Test*"
+    (semantic-lex-spp-table-write-slot-value
+     (semantic-lex-spp-save-table))))
+
+(defun semantic-lex-spp-write-utest ()
+  "Unit test using the test spp file to test the slot write fcn."
+  (interactive)
+  (let* ((sem (locate-library "semantic-lex-spp.el"))
+	 (dir (file-name-directory sem)))
+    (save-excursion
+      (set-buffer (find-file-noselect
+		   (expand-file-name "tests/testsppreplace.c"
+				     dir)))
+      (semantic-lex-spp-write-test))))
+
+;;; MACRO TABLE DEBUG
+;;
+(defun semantic-lex-spp-describe (&optional buffer)
+  "Describe the current list of spp macros for BUFFER.
+If BUFFER is not provided, use the current buffer."
+  (interactive)
+  (let ((syms (save-excursion
+		(if buffer (set-buffer buffer))
+		(semantic-lex-spp-macros)))
+	(sym nil))
+    (with-output-to-temp-buffer "*SPP MACROS*"
+      (princ "Macro\t\tValue\n")
+      (while syms
+	(setq sym (car syms)
+	      syms (cdr syms))
+	(princ (symbol-name sym))
+	(princ "\t")
+	(if (< (length (symbol-name sym)) 8)
+	    (princ "\t"))
+	(prin1 (symbol-value sym))
+	(princ "\n")
+	))))
+
+;;; EDEBUG Handlers
+;;
+(add-hook
+ 'edebug-setup-hook
+ #'(lambda ()
+
+     (def-edebug-spec define-lex-spp-macro-declaration-analyzer
+       (&define name stringp stringp form def-body)
+       )
+
+     (def-edebug-spec define-lex-spp-macro-undeclaration-analyzer
+       (&define name stringp stringp form)
+       )
+
+     (def-edebug-spec define-lex-spp-include-analyzer
+       (&define name stringp stringp form def-body)
+       )
+     ))
+
+
+(provide 'semantic/lex-spp)
+
+;;; semantic-lex-spp.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/semantic/util-modes.el	Fri Aug 28 15:19:20 2009 +0000
@@ -0,0 +1,1228 @@
+;;; semantic-util-modes.el --- Semantic minor modes
+
+;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Authors: Eric M. Ludlam <zappo@gnu.org>
+;;          David Ponce <david@dponce.com>
+;; 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:
+;;
+;;  Semantic utility minor modes.
+;;
+
+;;; Code:
+(require 'semantic)
+
+(eval-when-compile
+  (require 'semantic/decorate)
+  )
+
+;;; Compatibility
+(if (fboundp 'propertize)
+    (defalias 'semantic-propertize 'propertize)
+  (defsubst semantic-propertize (string &rest properties)
+    "Return a copy of STRING with text properties added.
+Dummy implementation for compatibility which just return STRING and
+ignore PROPERTIES."
+    string)
+  )
+
+;;; Group for all semantic enhancing modes
+(defgroup semantic-modes nil
+  "Minor modes associated with the Semantic architecture."
+  :group 'semantic)
+
+;;;;
+;;;; Semantic minor modes stuff
+;;;;
+(defcustom semantic-update-mode-line t
+  "*If non-nil, show enabled minor modes in the mode line.
+Only minor modes that are not turned on globally are shown in the mode
+line."
+  :group 'semantic
+  :type 'boolean
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (set-default sym val)
+         ;; Update status of all Semantic enabled buffers
+         (semantic-map-buffers
+          #'semantic-mode-line-update)))
+
+(defcustom semantic-mode-line-prefix
+  (semantic-propertize "S" 'face 'bold)
+  "*Prefix added to minor mode indicators in the mode line."
+  :group 'semantic
+  :type 'string
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default)
+
+(defvar semantic-minor-modes-status nil
+  "String showing Semantic minor modes which are locally enabled.
+It is displayed in the mode line.")
+(make-variable-buffer-local 'semantic-minor-modes-status)
+
+(defvar semantic-minor-mode-alist nil
+  "Alist saying how to show Semantic minor modes in the mode line.
+Like variable `minor-mode-alist'.")
+
+(defun semantic-mode-line-update ()
+  "Update display of Semantic minor modes in the mode line.
+Only minor modes that are locally enabled are shown in the mode line."
+  (setq semantic-minor-modes-status nil)
+  (if semantic-update-mode-line
+      (let ((ml semantic-minor-mode-alist)
+            mm ms see)
+        (while ml
+          (setq mm (car ml)
+                ms (cadr mm)
+                mm (car mm)
+                ml (cdr ml))
+          (when (and (symbol-value mm)
+                     ;; Only show local minor mode status
+                     (not (memq mm semantic-init-hooks)))
+            (and ms
+                 (symbolp ms)
+                 (setq ms (symbol-value ms)))
+            (and (stringp ms)
+                 (not (member ms see)) ;; Don't duplicate same status
+                 (setq see (cons ms see)
+                       ms (if (string-match "^[ ]*\\(.+\\)" ms)
+                              (match-string 1 ms)))
+                 (setq semantic-minor-modes-status
+                       (if semantic-minor-modes-status
+                           (concat semantic-minor-modes-status "/" ms)
+                         ms)))))
+        (if semantic-minor-modes-status
+            (setq semantic-minor-modes-status
+                  (concat
+                   " "
+                   (if (string-match "^[ ]*\\(.+\\)"
+                                     semantic-mode-line-prefix)
+                       (match-string 1 semantic-mode-line-prefix)
+                     "S")
+                   "/"
+                   semantic-minor-modes-status))))))
+
+(defun semantic-desktop-ignore-this-minor-mode (buffer)
+  "Installed as a minor-mode initializer for Desktop mode.
+BUFFER is the buffer to not initialize a Semantic minor mode in."
+  nil)
+
+(defun semantic-add-minor-mode (toggle name &optional keymap)
+  "Register a new Semantic minor mode.
+TOGGLE is a symbol which is the name of a buffer-local variable that
+is toggled on or off to say whether the minor mode is active or not.
+It is also an interactive function to toggle the mode.
+
+NAME specifies what will appear in the mode line when the minor mode
+is active.  NAME should be either a string starting with a space, or a
+symbol whose value is such a string.
+
+Optional KEYMAP is the keymap for the minor mode that will be added to
+`minor-mode-map-alist'."
+  ;; Add a dymmy semantic minor mode to display the status
+  (or (assq 'semantic-minor-modes-status minor-mode-alist)
+      (setq minor-mode-alist (cons (list 'semantic-minor-modes-status
+                                         'semantic-minor-modes-status)
+                                   minor-mode-alist)))
+  (if (fboundp 'add-minor-mode)
+      ;; Emacs 21 & XEmacs
+      (add-minor-mode toggle "" keymap)
+    ;; Emacs 20
+    (or (assq toggle minor-mode-alist)
+        (setq minor-mode-alist (cons (list toggle "") minor-mode-alist)))
+    (or (not keymap)
+        (assq toggle minor-mode-map-alist)
+        (setq minor-mode-map-alist (cons (cons toggle keymap)
+                                         minor-mode-map-alist))))
+  ;; Record how to display this minor mode in the mode line
+  (let ((mm (assq toggle semantic-minor-mode-alist)))
+    (if mm
+        (setcdr mm (list name))
+      (setq semantic-minor-mode-alist (cons (list toggle name)
+                                       semantic-minor-mode-alist))))
+
+  ;; Semantic minor modes don't work w/ Desktop restore.
+  ;; This line will disable this minor mode from being restored
+  ;; by Desktop.
+  (when (boundp 'desktop-minor-mode-handlers)
+    (add-to-list 'desktop-minor-mode-handlers
+		 (cons toggle 'semantic-desktop-ignore-this-minor-mode)))
+  )
+
+(defun semantic-toggle-minor-mode-globally (mode &optional arg)
+  "Toggle minor mode MODE in every Semantic enabled buffer.
+Return non-nil if MODE is turned on in every Semantic enabled buffer.
+If ARG is positive, enable, if it is negative, disable.  If ARG is
+nil, then toggle.  Otherwise do nothing.  MODE must be a valid minor
+mode defined in `minor-mode-alist' and must be too an interactive
+function used to toggle the mode."
+  (or (and (fboundp mode) (assq mode minor-mode-alist))
+      (error "Semantic minor mode %s not found" mode))
+  (if (not arg)
+      (if (memq mode semantic-init-hooks)
+	  (setq arg -1)
+	(setq arg 1)))
+  ;; Add or remove the MODE toggle function from
+  ;; `semantic-init-hooks'.  Then turn MODE on or off in every
+  ;; Semantic enabled buffer.
+  (cond
+   ;; Turn off if ARG < 0
+   ((< arg 0)
+    (remove-hook 'semantic-init-hooks mode)
+    (semantic-map-buffers #'(lambda () (funcall mode -1)))
+    nil)
+   ;; Turn on if ARG > 0
+   ((> arg 0)
+    (add-hook 'semantic-init-hooks mode)
+    (semantic-map-buffers #'(lambda () (funcall mode 1)))
+    t)
+   ;; Otherwise just check MODE state
+   (t
+    (memq mode semantic-init-hooks))
+   ))
+
+;;;;
+;;;; Minor mode to highlight areas that a user edits.
+;;;;
+
+(defun global-semantic-highlight-edits-mode (&optional arg)
+  "Toggle global use of option `semantic-highlight-edits-mode'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-highlight-edits-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-highlight-edits-mode arg)))
+
+(defcustom global-semantic-highlight-edits-mode nil
+  "*If non-nil enable global use of variable `semantic-highlight-edits-mode'.
+When this mode is enabled, changes made to a buffer are highlighted
+until the buffer is reparsed."
+  :group 'semantic
+  :group 'semantic-modes
+  :type 'boolean
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-highlight-edits-mode (if val 1 -1))))
+
+(defcustom semantic-highlight-edits-mode-hook nil
+  "*Hook run at the end of function `semantic-highlight-edits-mode'."
+  :group 'semantic
+  :type 'hook)
+
+(defface semantic-highlight-edits-face
+  '((((class color) (background dark))
+     ;; Put this back to something closer to black later.
+     (:background "gray20"))
+    (((class color) (background light))
+     (:background "gray90")))
+  "*Face used to show dirty tokens in `semantic-highlight-edits-mode'."
+  :group 'semantic-faces)
+
+(defun semantic-highlight-edits-new-change-hook-fcn (overlay)
+  "Function set into `semantic-edits-new-change-hook'.
+Argument OVERLAY is the overlay created to mark the change.
+This function will set the face property on this overlay."
+  (semantic-overlay-put overlay 'face 'semantic-highlight-edits-face))
+
+(defvar semantic-highlight-edits-mode-map
+  (let ((km (make-sparse-keymap)))
+    km)
+  "Keymap for highlight-edits minor mode.")
+
+(defvar semantic-highlight-edits-mode nil
+  "Non-nil if highlight-edits minor mode is enabled.
+Use the command `semantic-highlight-edits-mode' to change this variable.")
+(make-variable-buffer-local 'semantic-highlight-edits-mode)
+
+(defun semantic-highlight-edits-mode-setup ()
+  "Setup option `semantic-highlight-edits-mode'.
+The minor mode can be turned on only if semantic feature is available
+and the current buffer was set up for parsing.  When minor mode is
+enabled parse the current buffer if needed.  Return non-nil if the
+minor mode is enabled."
+  (if semantic-highlight-edits-mode
+      (if (not (and (featurep 'semantic) (semantic-active-p)))
+	  (progn
+	    ;; Disable minor mode if semantic stuff not available
+	    (setq semantic-highlight-edits-mode nil)
+	    (error "Buffer %s was not set up for parsing"
+		   (buffer-name)))
+	(semantic-make-local-hook 'semantic-edits-new-change-hooks)
+	(add-hook 'semantic-edits-new-change-hooks
+		  'semantic-highlight-edits-new-change-hook-fcn nil t)
+	)
+    ;; Remove hooks
+    (remove-hook 'semantic-edits-new-change-hooks
+		 'semantic-highlight-edits-new-change-hook-fcn t)
+    )
+  semantic-highlight-edits-mode)
+
+(defun semantic-highlight-edits-mode (&optional arg)
+  "Minor mode for highlighting changes made in a buffer.
+Changes are tracked by semantic so that the incremental parser can work
+properly.
+This mode will highlight those changes as they are made, and clear them
+when the incremental parser accounts for those edits.
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-highlight-edits-mode 0 1))))
+  (setq semantic-highlight-edits-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-highlight-edits-mode)))
+  (semantic-highlight-edits-mode-setup)
+  (run-hooks 'semantic-highlight-edits-mode-hook)
+  (if (interactive-p)
+      (message "highlight-edits minor mode %sabled"
+               (if semantic-highlight-edits-mode "en" "dis")))
+  (semantic-mode-line-update)
+  semantic-highlight-edits-mode)
+
+(semantic-add-minor-mode 'semantic-highlight-edits-mode
+                         "e"
+                         semantic-highlight-edits-mode-map)
+
+
+;;;;
+;;;; Minor mode to show unmatched-syntax elements
+;;;;
+(defun global-semantic-show-unmatched-syntax-mode (&optional arg)
+  "Toggle global use of option `semantic-show-unmatched-syntax-mode'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-show-unmatched-syntax-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-show-unmatched-syntax-mode arg)))
+
+(defcustom global-semantic-show-unmatched-syntax-mode nil
+  "*If non-nil, enable global use of `semantic-show-unmatched-syntax-mode'.
+When this mode is enabled, syntax in the current buffer which the
+semantic parser cannot match is highlighted with a red underline."
+  :group 'semantic
+  :group 'semantic-modes
+  :type 'boolean
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-show-unmatched-syntax-mode (if val 1 -1))))
+
+(defcustom semantic-show-unmatched-syntax-mode-hook nil
+  "*Hook run at the end of function `semantic-show-unmatched-syntax-mode'."
+  :group 'semantic
+  :type 'hook)
+
+(defface semantic-unmatched-syntax-face
+  '((((class color) (background dark))
+     (:underline "red"))
+    (((class color) (background light))
+     (:underline "red")))
+  "*Face used to show unmatched syntax in.
+The face is used in  `semantic-show-unmatched-syntax-mode'."
+  :group 'semantic-faces)
+
+(defsubst semantic-unmatched-syntax-overlay-p (overlay)
+  "Return non-nil if OVERLAY is an unmatched syntax one."
+  (eq (semantic-overlay-get overlay 'semantic) 'unmatched))
+
+(defun semantic-showing-unmatched-syntax-p ()
+  "Return non-nil if an unmatched syntax overlay was found in buffer."
+  (let ((ol (semantic-overlays-in (point-min) (point-max)))
+        found)
+    (while (and ol (not found))
+      (setq found (semantic-unmatched-syntax-overlay-p (car ol))
+            ol    (cdr ol)))
+    found))
+
+(defun semantic-show-unmatched-lex-tokens-fetch ()
+  "Fetch a list of unmatched lexical tokens from the current buffer.
+Uses the overlays which have accurate bounds, and rebuilds what was
+originally passed in."
+  (let ((ol (semantic-overlays-in (point-min) (point-max)))
+	(ustc nil))
+    (while ol
+      (if (semantic-unmatched-syntax-overlay-p (car ol))
+	  (setq ustc (cons (cons 'thing
+				 (cons (semantic-overlay-start (car ol))
+				       (semantic-overlay-end (car ol))))
+			   ustc)))
+      (setq ol (cdr ol)))
+    (nreverse ustc))
+  )
+
+(defun semantic-clean-unmatched-syntax-in-region (beg end)
+  "Remove all unmatched syntax overlays between BEG and END."
+  (let ((ol (semantic-overlays-in beg end)))
+    (while ol
+      (if (semantic-unmatched-syntax-overlay-p (car ol))
+	  (semantic-overlay-delete (car ol)))
+      (setq ol (cdr ol)))))
+
+(defsubst semantic-clean-unmatched-syntax-in-buffer ()
+  "Remove all unmatched syntax overlays found in current buffer."
+  (semantic-clean-unmatched-syntax-in-region
+   (point-min) (point-max)))
+
+(defsubst semantic-clean-token-of-unmatched-syntax (token)
+  "Clean the area covered by TOKEN of unmatched syntax markers."
+  (semantic-clean-unmatched-syntax-in-region
+   (semantic-tag-start token) (semantic-tag-end token)))
+
+(defun semantic-show-unmatched-syntax (syntax)
+  "Function set into `semantic-unmatched-syntax-hook'.
+This will highlight elements in SYNTAX as unmatched syntax."
+  ;; This is called when `semantic-show-unmatched-syntax-mode' is
+  ;; enabled.  Highlight the unmatched syntax, and then add a semantic
+  ;; property to that overlay so we can add it to the official list of
+  ;; semantic supported overlays.  This gets it cleaned up for errors,
+  ;; buffer cleaning, and the like.
+  (semantic-clean-unmatched-syntax-in-buffer) ;Clear previous highlighting
+  (if syntax
+      (let (o)
+        (while syntax
+          (setq o (semantic-make-overlay (semantic-lex-token-start (car syntax))
+                                         (semantic-lex-token-end (car syntax))))
+          (semantic-overlay-put o 'semantic 'unmatched)
+          (semantic-overlay-put o 'face 'semantic-unmatched-syntax-face)
+          (setq syntax (cdr syntax))))
+    ))
+
+(defun semantic-next-unmatched-syntax (point &optional bound)
+  "Find the next overlay for unmatched syntax after POINT.
+Do not search past BOUND if non-nil."
+  (save-excursion
+    (goto-char point)
+    (let ((os point) (ol nil))
+      (while (and os (< os (or bound (point-max))) (not ol))
+	(setq os (semantic-overlay-next-change os))
+	(when os
+	  ;; Get overlays at position
+	  (setq ol (semantic-overlays-at os))
+	  ;; find the overlay that belongs to semantic
+	  ;; and starts at the found position.
+	  (while (and ol (listp ol))
+	    (and (semantic-unmatched-syntax-overlay-p (car ol))
+                 (setq ol (car ol)))
+	    (if (listp ol)
+                (setq ol (cdr ol))))))
+      ol)))
+
+(defvar semantic-show-unmatched-syntax-mode-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km "\C-c,`" 'semantic-show-unmatched-syntax-next)
+    km)
+  "Keymap for command `semantic-show-unmatched-syntax-mode'.")
+
+(defvar semantic-show-unmatched-syntax-mode nil
+  "Non-nil if show-unmatched-syntax minor mode is enabled.
+Use the command `semantic-show-unmatched-syntax-mode' to change this
+variable.")
+(make-variable-buffer-local 'semantic-show-unmatched-syntax-mode)
+
+(defun semantic-show-unmatched-syntax-mode-setup ()
+  "Setup the `semantic-show-unmatched-syntax' minor mode.
+The minor mode can be turned on only if semantic feature is available
+and the current buffer was set up for parsing.  When minor mode is
+enabled parse the current buffer if needed.  Return non-nil if the
+minor mode is enabled."
+  (if semantic-show-unmatched-syntax-mode
+      (if (not (and (featurep 'semantic) (semantic-active-p)))
+          (progn
+            ;; Disable minor mode if semantic stuff not available
+            (setq semantic-show-unmatched-syntax-mode nil)
+            (error "Buffer %s was not set up for parsing"
+                   (buffer-name)))
+        ;; Add hooks
+        (semantic-make-local-hook 'semantic-unmatched-syntax-hook)
+        (add-hook 'semantic-unmatched-syntax-hook
+                  'semantic-show-unmatched-syntax nil t)
+	(semantic-make-local-hook 'semantic-pre-clean-token-hooks)
+	(add-hook 'semantic-pre-clean-token-hooks
+		  'semantic-clean-token-of-unmatched-syntax nil t)
+        ;; Show unmatched syntax elements
+	(if (not (semantic--umatched-syntax-needs-refresh-p))
+	    (semantic-show-unmatched-syntax
+	     (semantic-unmatched-syntax-tokens))))
+    ;; Remove hooks
+    (remove-hook 'semantic-unmatched-syntax-hook
+                 'semantic-show-unmatched-syntax t)
+    (remove-hook 'semantic-pre-clean-token-hooks
+		 'semantic-clean-token-of-unmatched-syntax t)
+    ;; Cleanup unmatched-syntax highlighting
+    (semantic-clean-unmatched-syntax-in-buffer))
+  semantic-show-unmatched-syntax-mode)
+
+(defun semantic-show-unmatched-syntax-mode (&optional arg)
+  "Minor mode to highlight unmatched lexical syntax tokens.
+When a parser executes, some elements in the buffer may not match any
+parser rules.  These text characters are considered unmatched syntax.
+Often time, the display of unmatched syntax can expose coding
+problems before the compiler is run.
+
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled.
+
+\\{semantic-show-unmatched-syntax-mode-map}"
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-show-unmatched-syntax-mode 0 1))))
+  (setq semantic-show-unmatched-syntax-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-show-unmatched-syntax-mode)))
+  (semantic-show-unmatched-syntax-mode-setup)
+  (run-hooks 'semantic-show-unmatched-syntax-mode-hook)
+  (if (interactive-p)
+      (message "show-unmatched-syntax minor mode %sabled"
+               (if semantic-show-unmatched-syntax-mode "en" "dis")))
+  (semantic-mode-line-update)
+  semantic-show-unmatched-syntax-mode)
+
+(semantic-add-minor-mode 'semantic-show-unmatched-syntax-mode
+                         "u"
+                         semantic-show-unmatched-syntax-mode-map)
+
+(defun semantic-show-unmatched-syntax-next ()
+  "Move forward to the next occurrence of unmatched syntax."
+  (interactive)
+  (let ((o (semantic-next-unmatched-syntax (point))))
+    (if o
+	(goto-char (semantic-overlay-start o)))))
+
+
+;;;;
+;;;; Minor mode to display the parser state in the modeline.
+;;;;
+
+(defcustom global-semantic-show-parser-state-mode nil
+  "*If non-nil enable global use of `semantic-show-parser-state-mode'.
+When enabled, the current parse state of the current buffer is displayed
+in the mode line. See `semantic-show-parser-state-marker' for details
+on what is displayed."
+  :group 'semantic
+  :type 'boolean
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-show-parser-state-mode (if val 1 -1))))
+
+(defun global-semantic-show-parser-state-mode (&optional arg)
+  "Toggle global use of option `semantic-show-parser-state-mode'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-show-parser-state-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-show-parser-state-mode arg)))
+
+(defcustom semantic-show-parser-state-mode-hook nil
+  "*Hook run at the end of function `semantic-show-parser-state-mode'."
+  :group 'semantic
+  :type 'hook)
+
+(defvar semantic-show-parser-state-mode-map
+  (let ((km (make-sparse-keymap)))
+    km)
+  "Keymap for show-parser-state minor mode.")
+
+(defvar semantic-show-parser-state-mode nil
+  "Non-nil if show-parser-state minor mode is enabled.
+Use the command `semantic-show-parser-state-mode' to change this variable.")
+(make-variable-buffer-local 'semantic-show-parser-state-mode)
+
+(defun semantic-show-parser-state-mode-setup ()
+  "Setup option `semantic-show-parser-state-mode'.
+The minor mode can be turned on only if semantic feature is available
+and the current buffer was set up for parsing.  When minor mode is
+enabled parse the current buffer if needed.  Return non-nil if the
+minor mode is enabled."
+  (if semantic-show-parser-state-mode
+      (if (not (and (featurep 'semantic) (semantic-active-p)))
+          (progn
+            ;; Disable minor mode if semantic stuff not available
+            (setq semantic-show-parser-state-mode nil)
+            (error "Buffer %s was not set up for parsing"
+                   (buffer-name)))
+	;; Set up mode line
+
+	(when (not
+	       (memq 'semantic-show-parser-state-string mode-line-modified))
+	  (setq mode-line-modified
+		(append mode-line-modified
+			'(semantic-show-parser-state-string))))
+	;; Add hooks
+        (semantic-make-local-hook 'semantic-edits-new-change-hooks)
+        (add-hook 'semantic-edits-new-change-hooks
+                  'semantic-show-parser-state-marker nil t)
+	(semantic-make-local-hook 'semantic-edits-incremental-reparse-failed-hooks)
+	(add-hook 'semantic-edits-incremental-reparse-failed-hooks
+		  'semantic-show-parser-state-marker nil t)
+	(semantic-make-local-hook 'semantic-after-partial-cache-change-hook)
+	(add-hook 'semantic-after-partial-cache-change-hook
+		  'semantic-show-parser-state-marker nil t)
+	(semantic-make-local-hook 'semantic-after-toplevel-cache-change-hook)
+	(add-hook 'semantic-after-toplevel-cache-change-hook
+		  'semantic-show-parser-state-marker nil t)
+	(semantic-show-parser-state-marker)
+
+	(semantic-make-local-hook 'semantic-before-auto-parse-hooks)
+	(add-hook 'semantic-before-auto-parse-hooks
+		  'semantic-show-parser-state-auto-marker nil t)
+	(semantic-make-local-hook 'semantic-after-auto-parse-hooks)
+	(add-hook 'semantic-after-auto-parse-hooks
+		  'semantic-show-parser-state-marker nil t)
+
+	(semantic-make-local-hook 'semantic-before-idle-scheduler-reparse-hooks)
+	(add-hook 'semantic-before-idle-scheduler-reparse-hooks
+		  'semantic-show-parser-state-auto-marker nil t)
+	(semantic-make-local-hook 'semantic-after-idle-scheduler-reparse-hooks)
+	(add-hook 'semantic-after-idle-scheduler-reparse-hooks
+		  'semantic-show-parser-state-marker nil t)
+        )
+    ;; Remove parts of mode line
+    (setq mode-line-modified
+	  (delq 'semantic-show-parser-state-string mode-line-modified))
+    ;; Remove hooks
+    (remove-hook 'semantic-edits-new-change-hooks
+		 'semantic-show-parser-state-marker t)
+    (remove-hook 'semantic-edits-incremental-reparse-failed-hooks
+		 'semantic-show-parser-state-marker t)
+    (remove-hook 'semantic-after-partial-cache-change-hook
+		 'semantic-show-parser-state-marker t)
+    (remove-hook 'semantic-after-toplevel-cache-change-hook
+		 'semantic-show-parser-state-marker t)
+
+    (remove-hook 'semantic-before-auto-parse-hooks
+		 'semantic-show-parser-state-auto-marker t)
+    (remove-hook 'semantic-after-auto-parse-hooks
+		 'semantic-show-parser-state-marker t)
+
+    (remove-hook 'semantic-before-idle-scheduler-reparse-hooks
+		 'semantic-show-parser-state-auto-marker t)
+    (remove-hook 'semantic-after-idle-scheduler-reparse-hooks
+		 'semantic-show-parser-state-marker t)
+    )
+  semantic-show-parser-state-mode)
+
+(defun semantic-show-parser-state-mode (&optional arg)
+  "Minor mode for displaying parser cache state in the modeline.
+The cache can be in one of three states.  They are
+Up to date, Partial reprase needed, and Full reparse needed.
+The state is indicated in the modeline with the following characters:
+ `-'  ->  The cache is up to date.
+ `!'  ->  The cache requires a full update.
+ `~'  ->  The cache needs to be incrementally parsed.
+ `%'  ->  The cache is not currently parseable.
+ `@'  ->  Auto-parse in progress (not set here.)
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-show-parser-state-mode 0 1))))
+  (setq semantic-show-parser-state-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-show-parser-state-mode)))
+  (semantic-show-parser-state-mode-setup)
+  (run-hooks 'semantic-show-parser-state-mode-hook)
+  (if (interactive-p)
+      (message "show-parser-state minor mode %sabled"
+               (if semantic-show-parser-state-mode "en" "dis")))
+  (semantic-mode-line-update)
+  semantic-show-parser-state-mode)
+
+(semantic-add-minor-mode 'semantic-show-parser-state-mode
+                         ""
+                         semantic-show-parser-state-mode-map)
+
+(defvar semantic-show-parser-state-string nil
+  "String showing the parser state for this buffer.
+See `semantic-show-parser-state-marker' for details.")
+(make-variable-buffer-local 'semantic-show-parser-state-string)
+
+(defun semantic-show-parser-state-marker (&rest ignore)
+  "Set `semantic-show-parser-state-string' to indicate parser state.
+This marker is one of the following:
+ `-'  ->  The cache is up to date.
+ `!'  ->  The cache requires a full update.
+ `~'  ->  The cache needs to be incrementally parsed.
+ `%'  ->  The cache is not currently parseable.
+ `@'  ->  Auto-parse in progress (not set here.)
+Arguments IGNORE are ignored, and accepted so this can be used as a hook
+in many situations."
+  (setq semantic-show-parser-state-string
+	(cond ((semantic-parse-tree-needs-rebuild-p)
+	       "!")
+	      ((semantic-parse-tree-needs-update-p)
+	       "^")
+	      ((semantic-parse-tree-unparseable-p)
+	       "%")
+	      (t
+               "-")))
+  ;;(message "Setup mode line indicator to [%s]" semantic-show-parser-state-string)
+  (semantic-mode-line-update))
+
+(defun semantic-show-parser-state-auto-marker ()
+  "Hook function run before an autoparse.
+Set up `semantic-show-parser-state-marker' to show `@'
+to indicate a parse in progress."
+  (unless (semantic-parse-tree-up-to-date-p)
+    (setq semantic-show-parser-state-string "@")
+    (semantic-mode-line-update)
+    ;; For testing.
+    ;;(sit-for 1)
+    ))
+
+
+;;;;
+;;;; Minor mode to make function decls sticky.
+;;;;
+
+(defun global-semantic-stickyfunc-mode (&optional arg)
+  "Toggle global use of option `semantic-stickyfunc-mode'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-stickyfunc-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-stickyfunc-mode arg)))
+
+(defcustom global-semantic-stickyfunc-mode nil
+  "*If non-nil, enable global use of `semantic-stickyfunc-mode'.
+This minor mode only works for Emacs 21 or later.
+When enabled, the header line is enabled, and the first line
+of the current function or method is displayed in it.
+This makes it appear that the first line of that tag is
+`sticky' to the top of the window."
+  :group 'semantic
+  :group 'semantic-modes
+  :type 'boolean
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-stickyfunc-mode (if val 1 -1))))
+
+(defcustom semantic-stickyfunc-mode-hook nil
+  "*Hook run at the end of function `semantic-stickyfunc-mode'."
+  :group 'semantic
+  :type 'hook)
+
+(defvar semantic-stickyfunc-mode-map
+  (let ((km (make-sparse-keymap)))
+    (define-key km [ header-line down-mouse-1 ] 'semantic-stickyfunc-menu)
+    km)
+  "Keymap for stickyfunc minor mode.")
+
+(defvar semantic-stickyfunc-popup-menu nil
+  "Menu used if the user clicks on the header line used by stickyfunc mode.")
+
+(easy-menu-define
+  semantic-stickyfunc-popup-menu
+  semantic-stickyfunc-mode-map
+  "Stickyfunc Menu"
+  '("Stickyfunc Mode"  :visible (progn nil)
+    [ "Copy Headerline Tag" senator-copy-tag
+      :active (semantic-current-tag)
+      :help "Copy the current tag to the tag ring"]
+    [ "Kill Headerline Tag" senator-kill-tag
+      :active (semantic-current-tag)
+      :help "Kill tag text to the kill ring, and copy the tag to the tag ring"
+      ]
+    [ "Copy Headerline Tag to Register" senator-copy-tag-to-register
+      :active (semantic-current-tag)
+      :help "Copy the current tag to a register"
+      ]
+    [ "Narrow To Headerline Tag" senator-narrow-to-defun
+      :active (semantic-current-tag)
+      :help "Narrow to the bounds of the current tag."]
+    [ "Fold Headerline Tag" senator-fold-tag-toggle
+      :active (semantic-current-tag)
+      :style toggle
+      :selected (let ((tag (semantic-current-tag)))
+		  (and tag (semantic-tag-folded-p tag)))
+      :help "Fold the current tag to one line"
+      ]
+    "---"
+    [ "About This Header Line"
+      (lambda () (interactive)
+	(describe-function 'semantic-stickyfunc-mode)) t])
+  )
+
+(defvar semantic-stickyfunc-mode nil
+  "Non-nil if stickyfunc minor mode is enabled.
+Use the command `semantic-stickyfunc-mode' to change this variable.")
+(make-variable-buffer-local 'semantic-stickyfunc-mode)
+
+(defcustom semantic-stickyfunc-indent-string
+  (if (and window-system (not (featurep 'xemacs)))
+      (concat
+       (condition-case nil
+	   ;; Test scroll bar location
+	   (let ((charwidth (frame-char-width))
+		 (scrollpos (frame-parameter (selected-frame)
+					     'vertical-scroll-bars))
+		 )
+	     (if (or (eq scrollpos 'left)
+		     ;; Now wait a minute.  If you turn scroll-bar-mode
+		     ;; on, then off, the new value is t, not left.
+		     ;; Will this mess up older emacs where the default
+		     ;; was on the right?  I don't think so since they don't
+		     ;; support a header line.
+		     (eq scrollpos t))
+		 (let ((w (when (boundp 'scroll-bar-width)
+			    (symbol-value 'scroll-bar-width))))
+
+		   (if (not w)
+		       (setq w (frame-parameter (selected-frame)
+						'scroll-bar-width)))
+
+		   ;; in 21.2, the frame parameter is sometimes empty
+		   ;; so we need to get the value here.
+		   (if (not w)
+		       (setq w (+ (get 'scroll-bar-width 'x-frame-parameter)
+				  ;; In 21.4, or perhaps 22.1 the x-frame
+				  ;; parameter is different from the frame
+				  ;; parameter by only 1 pixel.
+				  1)))
+
+		   (if (not w)
+		       "  "
+		     (setq w (+ 2 w))   ; Some sort of border around
+					; the scrollbar.
+		     (make-string (/ w charwidth) ? )))
+	       ""))
+	 (error ""))
+       (condition-case nil
+	   ;; Test fringe size.
+	   (let* ((f (window-fringes))
+		  (fw (car f))
+		  (numspace (/ fw (frame-char-width)))
+		  )
+	     (make-string numspace ? ))
+	 (error
+	  ;; Well, the fancy new Emacs functions failed.  Try older
+	  ;; tricks.
+	  (condition-case nil
+	      ;; I'm not so sure what's up with the 21.1-21.3 fringe.
+	      ;; It looks to be about 1 space wide.
+	      (if (get 'fringe 'face)
+		  " "
+		"")
+	    (error ""))))
+       )
+    ;; Not Emacs or a window system means no scrollbar or fringe,
+    ;; and perhaps not even a header line to worry about.
+    "")
+  "*String used to indent the stickyfunc header.
+Customize this string to match the space used by scrollbars and
+fringe so it does not appear that the code is moving left/right
+when it lands in the sticky line."
+  :group 'semantic
+  :type 'string)
+
+(defvar semantic-stickyfunc-old-hlf nil
+  "Value of the header line when entering sticky func mode.")
+
+(defconst semantic-stickyfunc-header-line-format
+  (cond ((featurep 'xemacs)
+	 nil)
+	((>= emacs-major-version 22)
+	 '(:eval (list
+		  ;; Magic bit I found on emacswiki.
+		  (propertize " " 'display '((space :align-to 0)))
+		  (semantic-stickyfunc-fetch-stickyline))))
+	((= emacs-major-version 21)
+	 '(:eval (list semantic-stickyfunc-indent-string
+		       (semantic-stickyfunc-fetch-stickyline))))
+	(t nil))
+  "The header line format used by sticky func mode.")
+
+(defun semantic-stickyfunc-mode-setup ()
+  "Setup option `semantic-stickyfunc-mode'.
+For semantic enabled buffers, make the function declaration for the top most
+function \"sticky\".  This is accomplished by putting the first line of
+text for that function in Emacs 21's header line."
+  (if semantic-stickyfunc-mode
+      (progn
+	(unless (and (featurep 'semantic) (semantic-active-p))
+	  ;; Disable minor mode if semantic stuff not available
+	  (setq semantic-stickyfunc-mode nil)
+	  (error "Buffer %s was not set up for parsing" (buffer-name)))
+	(unless (boundp 'default-header-line-format)
+	  ;; Disable if there are no header lines to use.
+	  (setq semantic-stickyfunc-mode nil)
+	  (error "Sticky Function mode requires Emacs 21"))
+	;; Enable the mode
+	;; Save previous buffer local value of header line format.
+	(when (and (local-variable-p 'header-line-format (current-buffer))
+		   (not (eq header-line-format
+			    semantic-stickyfunc-header-line-format)))
+	  (set (make-local-variable 'semantic-stickyfunc-old-hlf)
+	       header-line-format))
+	(setq header-line-format semantic-stickyfunc-header-line-format)
+	)
+    ;; Disable sticky func mode
+    ;; Restore previous buffer local value of header line format if
+    ;; the current one is the sticky func one.
+    (when (eq header-line-format semantic-stickyfunc-header-line-format)
+      (kill-local-variable 'header-line-format)
+      (when (local-variable-p 'semantic-stickyfunc-old-hlf (current-buffer))
+	(setq header-line-format semantic-stickyfunc-old-hlf)
+	(kill-local-variable 'semantic-stickyfunc-old-hlf))))
+  semantic-stickyfunc-mode)
+
+(defun semantic-stickyfunc-mode (&optional arg)
+  "Minor mode to show the title of a tag in the header line.
+Enables/disables making the header line of functions sticky.
+A function (or other tag class specified by
+`semantic-stickyfunc-sticky-classes') has a header line, meaning the
+first line which describes the rest of the construct.  This first
+line is what is displayed in the Emacs 21 header line.
+
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-stickyfunc-mode 0 1))))
+  (setq semantic-stickyfunc-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-stickyfunc-mode)))
+  (semantic-stickyfunc-mode-setup)
+  (run-hooks 'semantic-stickyfunc-mode-hook)
+  (if (interactive-p)
+      (message "Stickyfunc minor mode %sabled"
+               (if semantic-stickyfunc-mode "en" "dis")))
+  (semantic-mode-line-update)
+  semantic-stickyfunc-mode)
+
+(defvar semantic-stickyfunc-sticky-classes
+  '(function type)
+  "List of tag classes which sticky func will display in the header line.")
+(make-variable-buffer-local 'semantic-stickyfunc-sticky-classes)
+
+(defun semantic-stickyfunc-tag-to-stick ()
+  "Return the tag to stick at the current point."
+  (let ((tags (nreverse (semantic-find-tag-by-overlay (point)))))
+    ;; Get rid of non-matching tags.
+    (while (and tags
+		(not (member
+		      (semantic-tag-class (car tags))
+		      semantic-stickyfunc-sticky-classes))
+		)
+      (setq tags (cdr tags)))
+    (car tags)))
+
+(defun semantic-stickyfunc-fetch-stickyline ()
+  "Make the function at the top of the current window sticky.
+Capture it's function declaration, and place it in the header line.
+If there is no function, disable the header line."
+  (let ((str
+	 (save-excursion
+	   (goto-char (window-start (selected-window)))
+	   (forward-line -1)
+	   (end-of-line)
+	   ;; Capture this function
+	   (let* ((tag (semantic-stickyfunc-tag-to-stick)))
+	     ;; TAG is nil if there was nothing of the apropriate type there.
+	     (if (not tag)
+		 ;; Set it to be the text under the header line
+		 (buffer-substring (point-at-bol) (point-at-eol))
+	       ;; Get it
+	       (goto-char (semantic-tag-start tag))
+               ;; Klaus Berndl <klaus.berndl@sdm.de>:
+               ;; goto the tag name; this is especially needed for languages
+               ;; like c++ where a often used style is like:
+               ;;     void
+               ;;     ClassX::methodM(arg1...)
+               ;;     {
+               ;;       ...
+               ;;     }
+               ;; Without going to the tag-name we would get"void" in the
+               ;; header line which is IMHO not really useful
+               (search-forward (semantic-tag-name tag) nil t)
+	       (buffer-substring (point-at-bol) (point-at-eol))
+	       ))))
+	(start 0))
+    (while (string-match "%" str start)
+      (setq str (replace-match "%%" t t str 0)
+	    start (1+ (match-end 0)))
+      )
+    ;; In 21.4 (or 22.1) the heder doesn't expand tabs.  Hmmmm.
+    ;; We should replace them here.
+    ;;
+    ;; This hack assumes that tabs are kept smartly at tab boundaries
+    ;; instead of in a tab boundary where it might only represent 4 spaces.
+    (while (string-match "\t" str start)
+      (setq str (replace-match "        " t t str 0)))
+    str))
+
+(defun semantic-stickyfunc-menu (event)
+  "Popup a menu that can help a user understand stickyfunc-mode.
+Argument EVENT describes the event that caused this function to be called."
+  (interactive "e")
+  (let* ((startwin (selected-window))
+	 (win (car (car (cdr event))))
+	 )
+    (select-window win t)
+    (save-excursion
+      (goto-char (window-start win))
+      (sit-for 0)
+      (popup-menu semantic-stickyfunc-popup-menu event)
+      )
+    (select-window startwin)))
+
+
+(semantic-add-minor-mode 'semantic-stickyfunc-mode
+                         "" ;; Don't need indicator.  It's quite visible
+                         semantic-stickyfunc-mode-map)
+
+
+
+;;;;
+;;;; Minor mode to make highlight the current function
+;;;;
+
+;; Highlight the first like of the function we are in if it is different
+;; from the the tag going off the top of the screen.
+(defun global-semantic-highlight-func-mode (&optional arg)
+  "Toggle global use of option `semantic-highlight-func-mode'.
+If ARG is positive, enable, if it is negative, disable.
+If ARG is nil, then toggle."
+  (interactive "P")
+  (setq global-semantic-highlight-func-mode
+        (semantic-toggle-minor-mode-globally
+         'semantic-highlight-func-mode arg)))
+
+(defcustom global-semantic-highlight-func-mode nil
+  "*If non-nil, enable global use of `semantic-highlight-func-mode'.
+When enabled, the first line of the current tag is highlighted."
+  :group 'semantic
+  :group 'semantic-modes
+  :type 'boolean
+  :require 'semantic/util-modes
+  :initialize 'custom-initialize-default
+  :set (lambda (sym val)
+         (global-semantic-highlight-func-mode (if val 1 -1))))
+
+(defcustom semantic-highlight-func-mode-hook nil
+  "*Hook run at the end of function `semantic-highlight-func-mode'."
+  :group 'semantic
+  :type 'hook)
+
+(defvar semantic-highlight-func-mode-map
+  (let ((km (make-sparse-keymap))
+	(m3  (if (featurep 'xemacs) [ button3 ] [ mouse-3 ]))
+	)
+    (define-key km m3 'semantic-highlight-func-menu)
+    km)
+  "Keymap for highlight-func minor mode.")
+
+(defvar semantic-highlight-func-popup-menu nil
+  "Menu used if the user clicks on the header line used by `semantic-highlight-func-mode'.")
+
+(easy-menu-define
+  semantic-highlight-func-popup-menu
+  semantic-highlight-func-mode-map
+  "Highlight-Func Menu"
+  '("Highlight-Func Mode"  :visible (progn nil)
+    [ "Copy Tag" senator-copy-tag
+      :active (semantic-current-tag)
+      :help "Copy the current tag to the tag ring"]
+    [ "Kill Tag" senator-kill-tag
+      :active (semantic-current-tag)
+      :help "Kill tag text to the kill ring, and copy the tag to the tag ring"
+      ]
+    [ "Copy Tag to Register" senator-copy-tag-to-register
+      :active (semantic-current-tag)
+      :help "Copy the current tag to a register"
+      ]
+    [ "Narrow To Tag" senator-narrow-to-defun
+      :active (semantic-current-tag)
+      :help "Narrow to the bounds of the current tag."]
+    [ "Fold Tag" senator-fold-tag-toggle
+      :active (semantic-current-tag)
+      :style toggle
+      :selected (let ((tag (semantic-stickyfunc-tag-to-stick)))
+		  (and tag (semantic-tag-folded-p tag)))
+      :help "Fold the current tag to one line"
+      ]
+    "---"
+    [ "About This Tag" semantic-describe-tag t])
+  )
+
+(defun semantic-highlight-func-menu (event)
+  "Popup a menu that displays things to do to the current tag.
+Argument EVENT describes the event that caused this function to be called."
+  (interactive "e")
+  (let* ((startwin (selected-window))
+	 (win (semantic-event-window event))
+	 )
+    (select-window win t)
+    (save-excursion
+      ;(goto-char (window-start win))
+      (mouse-set-point event)
+      (sit-for 0)
+      (semantic-popup-menu semantic-highlight-func-popup-menu)
+      )
+    (select-window startwin)))
+
+(defvar semantic-highlight-func-mode nil
+  "Non-nil if highlight-func minor mode is enabled.
+Use the command `semantic-highlight-func-mode' to change this variable.")
+(make-variable-buffer-local 'semantic-highlight-func-mode)
+
+(defvar semantic-highlight-func-ct-overlay nil
+  "Overlay used to highlight the tag the cursor is in.")
+(make-variable-buffer-local 'semantic-highlight-func-ct-overlay)
+
+(defface semantic-highlight-func-current-tag-face
+  '((((class color) (background dark))
+     ;; Put this back to something closer to black later.
+     (:background "gray20"))
+    (((class color) (background light))
+     (:background "gray90")))
+  "Face used to show the top of current function."
+  :group 'semantic-faces)
+
+
+(defun semantic-highlight-func-mode-setup ()
+  "Setup option `semantic-highlight-func-mode'.
+For semantic enabled buffers, highlight the first line of the
+current tag declaration."
+  (if semantic-highlight-func-mode
+      (progn
+	(unless (and (featurep 'semantic) (semantic-active-p))
+	  ;; Disable minor mode if semantic stuff not available
+	  (setq semantic-highlight-func-mode nil)
+	  (error "Buffer %s was not set up for parsing" (buffer-name)))
+	;; Setup our hook
+	(add-hook 'post-command-hook 'semantic-highlight-func-highlight-current-tag nil t)
+	)
+    ;; Disable highlight func mode
+    (remove-hook 'post-command-hook 'semantic-highlight-func-highlight-current-tag t)
+    (semantic-highlight-func-highlight-current-tag t)
+    )
+  semantic-highlight-func-mode)
+
+(defun semantic-highlight-func-mode (&optional arg)
+  "Minor mode to highlight the first line of the current tag.
+Enables/disables making the header line of functions sticky.
+A function (or other tag class specified by
+`semantic-stickfunc-sticky-classes') is highlighted, meaning the
+first line which describes the rest of the construct.
+
+See `semantic-stickfunc-mode' for putting a function in the
+header line.  This mode recycles the stickyfunc configuration
+classes list.
+
+With prefix argument ARG, turn on if positive, otherwise off.  The
+minor mode can be turned on only if semantic feature is available and
+the current buffer was set up for parsing.  Return non-nil if the
+minor mode is enabled."
+  (interactive
+   (list (or current-prefix-arg
+             (if semantic-highlight-func-mode 0 1))))
+  (setq semantic-highlight-func-mode
+        (if arg
+            (>
+             (prefix-numeric-value arg)
+             0)
+          (not semantic-highlight-func-mode)))
+  (semantic-highlight-func-mode-setup)
+  (run-hooks 'semantic-highlight-func-mode-hook)
+  (if (interactive-p)
+      (message "Highlight-Func minor mode %sabled"
+               (if semantic-highlight-func-mode "en" "dis")))
+  semantic-highlight-func-mode)
+
+(defun semantic-highlight-func-highlight-current-tag (&optional disable)
+  "Highlight the current tag under point.
+Optional argument DISABLE will turn off any active highlight.
+If the current tag for this buffer is different from the last time this
+function was called, move the overlay."
+  (when (and (not (minibufferp))
+	     (or (not semantic-highlight-func-ct-overlay)
+		 (eq (semantic-overlay-buffer
+		      semantic-highlight-func-ct-overlay)
+		     (current-buffer))))
+    (let* ((tag (semantic-stickyfunc-tag-to-stick))
+	   (ol semantic-highlight-func-ct-overlay))
+      (when (not ol)
+	;; No overlay in this buffer.  Make one.
+	(setq ol (semantic-make-overlay (point-min) (point-min)
+					(current-buffer) t nil))
+	(semantic-overlay-put ol 'highlight-func t)
+	(semantic-overlay-put ol 'face 'semantic-highlight-func-current-tag-face)
+	(semantic-overlay-put ol 'keymap semantic-highlight-func-mode-map)
+	(semantic-overlay-put ol 'help-echo
+			      "Current Function : mouse-3 - Context menu")
+	(setq semantic-highlight-func-ct-overlay ol)
+	)
+
+      ;; TAG is nil if there was nothing of the apropriate type there.
+      (if (or (not tag) disable)
+	  ;; No tag, make the overlay go away.
+	  (progn
+	    (semantic-overlay-put ol 'tag nil)
+	    (semantic-overlay-move ol (point-min) (point-min) (current-buffer))
+	    )
+
+	;; We have a tag, if it is the same, do nothing.
+	(unless (eq (semantic-overlay-get ol 'tag) tag)
+	  (save-excursion
+	    (goto-char (semantic-tag-start tag))
+	    (search-forward (semantic-tag-name tag) nil t)
+	    (semantic-overlay-put ol 'tag tag)
+	    (semantic-overlay-move ol (point-at-bol) (point-at-eol))
+	    )
+	  )
+	)))
+  nil)
+
+(semantic-add-minor-mode 'semantic-highlight-func-mode
+                         "" ;; Don't need indicator.  It's quite visible
+                         nil)
+
+(provide 'semantic/util-modes)
+
+;;; semantic-util-modes.el ends here