]> git.eshelyaron.com Git - emacs.git/commitdiff
semantic.el, semantic-tag.el, semantic-lex.el, semantic-fw.el: Initial
authorChong Yidong <cyd@stupidchicken.com>
Sun, 23 Aug 2009 03:46:01 +0000 (03:46 +0000)
committerChong Yidong <cyd@stupidchicken.com>
Sun, 23 Aug 2009 03:46:01 +0000 (03:46 +0000)
version.

lisp/cedet/semantic-fw.el [new file with mode: 0644]
lisp/cedet/semantic-lex.el [new file with mode: 0644]
lisp/cedet/semantic-tag.el [new file with mode: 0644]
lisp/cedet/semantic.el [new file with mode: 0644]

diff --git a/lisp/cedet/semantic-fw.el b/lisp/cedet/semantic-fw.el
new file mode 100644 (file)
index 0000000..7f8e1bd
--- /dev/null
@@ -0,0 +1,530 @@
+;;; semantic-fw.el --- Framework for Semantic
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 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:
+;;
+;; Semantic has several core features shared across it's lex/parse/util
+;; stages.  This used to clutter semantic.el some.  These routines are all
+;; simple things that are not parser specific, but aid in making
+;; semantic flexible and compatible amongst different Emacs platforms.
+
+;;; No Requirements.
+
+;;; Code:
+;;
+(require 'mode-local)
+(require 'eieio)
+
+;;; Compatibility
+;;
+(if (featurep 'xemacs)
+    (progn
+      (defalias 'semantic-buffer-local-value 'symbol-value-in-buffer)
+      (defalias 'semantic-overlay-live-p
+        (lambda (o)
+          (and (extent-live-p o)
+               (not (extent-detached-p o))
+               (bufferp (extent-buffer o)))))
+      (defalias 'semantic-make-overlay
+       (lambda (beg end &optional buffer &rest rest)
+         "Xemacs `make-extent', supporting the front/rear advance options."
+         (let ((ol (make-extent beg end buffer)))
+           (when rest
+             (set-extent-property ol 'start-open (car rest))
+             (setq rest (cdr rest)))
+           (when rest
+             (set-extent-property ol 'end-open (car rest)))
+           ol)))
+      (defalias 'semantic-overlay-put             'set-extent-property)
+      (defalias 'semantic-overlay-get             'extent-property)
+      (defalias 'semantic-overlay-properties      'extent-properties)
+      (defalias 'semantic-overlay-move            'set-extent-endpoints)
+      (defalias 'semantic-overlay-delete          'delete-extent)
+      (defalias 'semantic-overlays-at
+        (lambda (pos)
+         (condition-case nil
+             (extent-list nil pos pos)
+           (error nil))
+         ))
+      (defalias 'semantic-overlays-in
+        (lambda (beg end) (extent-list nil beg end)))
+      (defalias 'semantic-overlay-buffer          'extent-buffer)
+      (defalias 'semantic-overlay-start           'extent-start-position)
+      (defalias 'semantic-overlay-end             'extent-end-position)
+      (defalias 'semantic-overlay-size            'extent-length)
+      (defalias 'semantic-overlay-next-change     'next-extent-change)
+      (defalias 'semantic-overlay-previous-change 'previous-extent-change)
+      (defalias 'semantic-overlay-lists
+        (lambda () (list (extent-list))))
+      (defalias 'semantic-overlay-p               'extentp)
+      (defalias 'semantic-event-window        'event-window)
+      (defun semantic-read-event ()
+        (let ((event (next-command-event)))
+          (if (key-press-event-p event)
+              (let ((c (event-to-character event)))
+                (if (char-equal c (quit-char))
+                    (keyboard-quit)
+                  c)))
+          event))
+      (defun semantic-popup-menu (menu)
+       "Blockinig version of `popup-menu'"
+       (popup-menu menu)
+       ;; Wait...
+       (while (popup-up-p) (dispatch-event (next-event))))
+      )
+  ;; Emacs Bindings
+  (defalias 'semantic-buffer-local-value      'buffer-local-value)
+  (defalias 'semantic-overlay-live-p          'overlay-buffer)
+  (defalias 'semantic-make-overlay            'make-overlay)
+  (defalias 'semantic-overlay-put             'overlay-put)
+  (defalias 'semantic-overlay-get             'overlay-get)
+  (defalias 'semantic-overlay-properties      'overlay-properties)
+  (defalias 'semantic-overlay-move            'move-overlay)
+  (defalias 'semantic-overlay-delete          'delete-overlay)
+  (defalias 'semantic-overlays-at             'overlays-at)
+  (defalias 'semantic-overlays-in             'overlays-in)
+  (defalias 'semantic-overlay-buffer          'overlay-buffer)
+  (defalias 'semantic-overlay-start           'overlay-start)
+  (defalias 'semantic-overlay-end             'overlay-end)
+  (defalias 'semantic-overlay-size            'overlay-size)
+  (defalias 'semantic-overlay-next-change     'next-overlay-change)
+  (defalias 'semantic-overlay-previous-change 'previous-overlay-change)
+  (defalias 'semantic-overlay-lists           'overlay-lists)
+  (defalias 'semantic-overlay-p               'overlayp)
+  (defalias 'semantic-read-event              'read-event)
+  (defalias 'semantic-popup-menu              'popup-menu)
+  (defun semantic-event-window (event)
+    "Extract the window from EVENT."
+    (car (car (cdr event))))
+  )
+
+(if (and (not (featurep 'xemacs))
+        (>= emacs-major-version 21))
+    (defalias 'semantic-make-local-hook 'identity)
+  (defalias 'semantic-make-local-hook 'make-local-hook)
+  )
+
+(if (featurep 'xemacs)
+    (defalias 'semantic-mode-line-update 'redraw-modeline)
+  (defalias 'semantic-mode-line-update 'force-mode-line-update))
+
+;; Since Emacs 22 major mode functions should use `run-mode-hooks' to
+;; run major mode hooks.
+(defalias 'semantic-run-mode-hooks
+  (if (fboundp 'run-mode-hooks)
+      'run-mode-hooks
+    'run-hooks))
+
+;; Fancy compat useage now handled in cedet-compat
+(defalias 'semantic-subst-char-in-string 'subst-char-in-string)
+
+
+(defun semantic-delete-overlay-maybe (overlay)
+  "Delete OVERLAY if it is a semantic token overlay."
+  (if (semantic-overlay-get overlay 'semantic)
+      (semantic-overlay-delete overlay)))
+
+(defalias 'semantic-compile-warn
+  (eval-when-compile
+    (if (fboundp 'byte-compile-warn)
+       'byte-compile-warn
+      'message)))
+
+(if (not (fboundp 'string-to-number))
+    (defalias 'string-to-number 'string-to-int))
+
+;;; Menu Item compatibility
+;;
+(defun semantic-menu-item (item)
+  "Build an XEmacs compatible menu item from vector ITEM.
+That is remove the unsupported :help stuff."
+  (if (featurep 'xemacs)
+      (let ((n (length item))
+            (i 0)
+            slot l)
+        (while (< i n)
+          (setq slot (aref item i))
+          (if (and (keywordp slot)
+                   (eq slot :help))
+              (setq i (1+ i))
+            (setq l (cons slot l)))
+          (setq i (1+ i)))
+        (apply #'vector (nreverse l)))
+    item))
+
+;;; Positional Data Cache
+;;
+(defvar semantic-cache-data-overlays nil
+  "List of all overlays waiting to be flushed.")
+
+(defun semantic-cache-data-to-buffer (buffer start end value name &optional lifespan)
+  "In BUFFER over the region START END, remember VALUE.
+NAME specifies a special name that can be searched for later to
+recover the cached data with `semantic-get-cache-data'.
+LIFESPAN indicates how long the data cache will be remembered.
+The default LIFESPAN is 'end-of-command.
+Possible Lifespans are:
+  'end-of-command - Remove the cache at the end of the currently
+                    executing command.
+  'exit-cache-zone - Remove when point leaves the overlay at the
+                    end of the currently executing command."
+  ;; Check if LIFESPAN is valid before to create any overlay
+  (or lifespan (setq lifespan 'end-of-command))
+  (or (memq lifespan '(end-of-command exit-cache-zone))
+      (error "semantic-cache-data-to-buffer: Unknown LIFESPAN: %s"
+             lifespan))
+  (let ((o (semantic-make-overlay start end buffer)))
+    (semantic-overlay-put o 'cache-name   name)
+    (semantic-overlay-put o 'cached-value value)
+    (semantic-overlay-put o 'lifespan     lifespan)
+    (setq semantic-cache-data-overlays
+          (cons o semantic-cache-data-overlays))
+    ;;(message "Adding to cache: %s" o)
+    (add-hook 'post-command-hook 'semantic-cache-data-post-command-hook)
+    ))
+
+(defun semantic-cache-data-post-command-hook ()
+  "Flush `semantic-cache-data-overlays' based 'lifespan property.
+Remove self from `post-command-hook' if it is empty."
+  (let ((newcache nil)
+        (oldcache semantic-cache-data-overlays))
+    (while oldcache
+      (let* ((o    (car oldcache))
+             (life (semantic-overlay-get o 'lifespan))
+             )
+        (if (or (eq life 'end-of-command)
+                (and (eq life 'exit-cache-zone)
+                     (not (member o (semantic-overlays-at (point))))))
+            (progn
+              ;;(message "Removing from cache: %s" o)
+              (semantic-overlay-delete o)
+              )
+          (setq newcache (cons o newcache))))
+      (setq oldcache (cdr oldcache)))
+    (setq semantic-cache-data-overlays (nreverse newcache)))
+
+  ;; Remove ourselves if we have removed all overlays.
+  (unless semantic-cache-data-overlays
+    (remove-hook 'post-command-hook
+                 'semantic-cache-data-post-command-hook)))
+
+(defun semantic-get-cache-data (name &optional point)
+  "Get cached data with NAME from optional POINT."
+  (save-excursion
+    (if point (goto-char point))
+    (let ((o (semantic-overlays-at (point)))
+          (ans nil))
+      (while (and (not ans) o)
+        (if (equal (semantic-overlay-get (car o) 'cache-name) name)
+            (setq ans (car o))
+          (setq o (cdr o))))
+      (when ans
+        (semantic-overlay-get ans 'cached-value)))))
+
+(defun semantic-test-data-cache ()
+  "Test the data cache."
+  (interactive)
+  (let ((data '(a b c)))
+    (save-excursion
+      (set-buffer (get-buffer-create " *semantic-test-data-cache*"))
+      (erase-buffer)
+      (insert "The Moose is Loose")
+      (goto-char (point-min))
+      (semantic-cache-data-to-buffer (current-buffer) (point) (+ (point) 5)
+                                    data 'moose 'exit-cache-zone)
+      (if (equal (semantic-get-cache-data 'moose) data)
+         (message "Successfully retrieved cached data.")
+       (error "Failed to retrieve cached data"))
+      )))
+
+;;; Obsoleting various functions & variables
+;;
+(defun semantic-overload-symbol-from-function (name)
+  "Return the symbol for overload used by NAME, the defined symbol."
+  (let ((sym-name (symbol-name name)))
+    (if (string-match "^semantic-" sym-name)
+       (intern (substring sym-name (match-end 0)))
+      name)))
+
+(defun semantic-alias-obsolete (oldfnalias newfn)
+  "Make OLDFNALIAS an alias for NEWFN.
+Mark OLDFNALIAS as obsolete, such that the byte compiler
+will throw a warning when it encounters this symbol."
+  (defalias oldfnalias newfn)
+  (make-obsolete oldfnalias newfn)
+  (when (and (function-overload-p newfn)
+             (not (overload-obsoleted-by newfn))
+             ;; Only throw this warning when byte compiling things.
+             (boundp 'byte-compile-current-file)
+             byte-compile-current-file
+            (not (string-match "cedet" byte-compile-current-file))
+            )
+    (make-obsolete-overload oldfnalias newfn)
+    (semantic-compile-warn
+     "%s: `%s' obsoletes overload `%s'"
+     byte-compile-current-file
+     newfn
+     (semantic-overload-symbol-from-function oldfnalias))
+    ))
+
+(defun semantic-varalias-obsolete (oldvaralias newvar)
+  "Make OLDVARALIAS an alias for variable NEWVAR.
+Mark OLDVARALIAS as obsolete, such that the byte compiler
+will throw a warning when it encounters this symbol."
+  (make-obsolete-variable oldvaralias newvar)
+  (condition-case nil
+      (defvaralias oldvaralias newvar)
+    (error
+     ;; Only throw this warning when byte compiling things.
+     (when (and (boundp 'byte-compile-current-file)
+                byte-compile-current-file)
+       (semantic-compile-warn
+        "variable `%s' obsoletes, but isn't alias of `%s'"
+        newvar oldvaralias)
+     ))))
+\f
+;;; Help debugging
+;;
+(defmacro semantic-safe (format &rest body)
+  "Turn into a FORMAT message any error caught during eval of BODY.
+Return the value of last BODY form or nil if an error occurred.
+FORMAT can have a %s escape which will be replaced with the actual
+error message.
+If `debug-on-error' is set, errors are not caught, so that you can
+debug them.
+Avoid using a large BODY since it is duplicated."
+  ;;(declare (debug t) (indent 1))
+  `(if debug-on-error
+       ;;(let ((inhibit-quit nil)) ,@body)
+       ;; Note to self: Doing the above screws up the wisent parser.
+       (progn ,@body)
+     (condition-case err
+        (progn ,@body)
+       (error
+        (message ,format (format "%S - %s" (current-buffer)
+                                 (error-message-string err)))
+        nil))))
+(put 'semantic-safe 'lisp-indent-function 1)
+
+;;; Misc utilities
+;;
+(defsubst semantic-map-buffers (function)
+  "Run FUNCTION for each Semantic enabled buffer found.
+FUNCTION does not have arguments.  When FUNCTION is entered
+`current-buffer' is a selected Semantic enabled buffer."
+  (mode-local-map-file-buffers function #'semantic-active-p))
+
+(defalias 'semantic-map-mode-buffers
+  'mode-local-map-mode-buffers)
+
+(semantic-alias-obsolete 'semantic-fetch-overload
+                         'fetch-overload)
+
+(semantic-alias-obsolete 'define-mode-overload-implementation
+                         'define-mode-local-override)
+
+(semantic-alias-obsolete 'semantic-with-mode-bindings
+                         'with-mode-local)
+
+(semantic-alias-obsolete 'define-semantic-child-mode
+                         'define-child-mode)
+
+(defun semantic-install-function-overrides (overrides &optional transient mode)
+  "Install the function OVERRIDES in the specified environment.
+OVERRIDES must be an alist ((OVERLOAD .  FUNCTION) ...) where OVERLOAD
+is a symbol identifying an overloadable entry, and FUNCTION is the
+function to override it with.
+If optional argument TRANSIENT is non-nil, installed overrides can in
+turn be overridden by next installation.
+If optional argument MODE is non-nil, it must be a major mode symbol.
+OVERRIDES will be installed globally for this major mode.  If MODE is
+nil, OVERRIDES will be installed locally in the current buffer.  This
+later installation should be done in MODE hook."
+  (mode-local-bind
+   ;; Add the semantic- prefix to OVERLOAD short names.
+   (mapcar
+    #'(lambda (e)
+        (let ((name (symbol-name (car e))))
+          (if (string-match "^semantic-" name)
+              e
+            (cons (intern (format "semantic-%s" name)) (cdr e)))))
+    overrides)
+   (list 'constant-flag (not transient)
+         'override-flag t)
+   mode))
+\f
+;;; User Interrupt handling
+;;
+(defvar semantic-current-input-throw-symbol nil
+  "The current throw symbol for `semantic-exit-on-input'.")
+
+(defmacro semantic-exit-on-input (symbol &rest forms)
+  "Using SYMBOL as an argument to `throw', execute FORMS.
+If FORMS includes a call to `semantic-thow-on-input', then
+if a user presses any key during execution, this form macro
+will exit with the value passed to `semantic-throw-on-input'.
+If FORMS completes, then the return value is the same as `progn'."
+  `(let ((semantic-current-input-throw-symbol ,symbol))
+     (catch ,symbol
+       ,@forms)))
+(put 'semantic-exit-on-input 'lisp-indent-function 1)
+
+(defmacro semantic-throw-on-input (from)
+  "Exit with `throw' when in `semantic-exit-on-input' on user input.
+FROM is an indication of where this function is called from as a value
+to pass to `throw'.  It is recommended to use the name of the function
+calling this one."
+  `(when (and semantic-current-input-throw-symbol
+              (or (input-pending-p) (accept-process-output)))
+     (throw semantic-current-input-throw-symbol ,from)))
+
+(defun semantic-test-throw-on-input ()
+  "Test that throw on input will work."
+  (interactive)
+  (semantic-throw-on-input 'done-die)
+  (message "Exit Code: %s"
+          (semantic-exit-on-input 'testing
+            (let ((inhibit-quit nil)
+                  (message-log-max nil))
+              (while t
+                (message "Looping ... press a key to test")
+                (semantic-throw-on-input 'test-inner-loop))
+              'exit)))
+  (when (input-pending-p)
+    (if (fboundp 'read-event)
+       (read-event)
+      (read-char)))
+  )
+\f
+;;; Special versions of Find File
+;;
+(defun semantic-find-file-noselect (file &optional nowarn rawfile wildcards)
+  "Call `find-file-noselect' with various features turned off.
+Use this when referencing a file that will be soon deleted.
+FILE, NOWARN, RAWFILE, and WILDCARDS are passed into `find-file-noselect'"
+  (let* ((recentf-exclude '( (lambda (f) t) ))
+        ;; This is a brave statement.  Don't waste time loading in
+        ;; lots of modes.  Especially decoration mode can waste a lot
+        ;; of time for a buffer we intend to kill.
+        (semantic-init-hooks nil)
+        ;; This disables the part of EDE that asks questions
+        (ede-auto-add-method 'never)
+        ;; Ask font-lock to not colorize these buffers, nor to
+        ;; whine about it either.
+        (font-lock-maximum-size 0)
+        (font-lock-verbose nil)
+        ;; Disable revision control
+        (vc-handled-backends nil)
+        ;; Don't prompt to insert a template if we visit an empty file
+        (auto-insert nil)
+        ;; We don't want emacs to query about unsafe local variables
+        (enable-local-variables
+         (if (featurep 'xemacs)
+             ;; XEmacs only has nil as an option?
+             nil
+           ;; Emacs 23 has the spiffy :safe option, nil otherwise.
+           (if (>= emacs-major-version 22)
+               nil
+             :safe)))
+        ;; ... or eval variables
+        (enable-local-eval nil)
+        )
+    (if (featurep 'xemacs)
+       (find-file-noselect file nowarn rawfile)
+      (find-file-noselect file nowarn rawfile wildcards))
+    ))
+
+\f
+;;; Editor goodies ;-)
+;;
+(defconst semantic-fw-font-lock-keywords
+  (eval-when-compile
+    (let* (
+           ;; Variable declarations
+          (vl nil)
+           (kv (if vl (regexp-opt vl t) ""))
+           ;; Function declarations
+          (vf '(
+                "define-lex"
+                "define-lex-analyzer"
+                "define-lex-block-analyzer"
+                "define-lex-regex-analyzer"
+                "define-lex-spp-macro-declaration-analyzer"
+                "define-lex-spp-macro-undeclaration-analyzer"
+                "define-lex-spp-include-analyzer"
+                "define-lex-simple-regex-analyzer"
+                "define-lex-keyword-type-analyzer"
+                "define-lex-sexp-type-analyzer"
+                "define-lex-regex-type-analyzer"
+                "define-lex-string-type-analyzer"
+                "define-lex-block-type-analyzer"
+                ;;"define-mode-overload-implementation"
+                ;;"define-semantic-child-mode"
+                "define-semantic-idle-service"
+                "define-semantic-decoration-style"
+                "define-wisent-lexer"
+                "semantic-alias-obsolete"
+                "semantic-varalias-obsolete"
+                "semantic-make-obsolete-overload"
+                "defcustom-mode-local-semantic-dependency-system-include-path"
+                ))
+           (kf (if vf (regexp-opt vf t) ""))
+           ;; Regexp depths
+           (kv-depth (if kv (regexp-opt-depth kv) nil))
+           (kf-depth (if kf (regexp-opt-depth kf) nil))
+           )
+      `((,(concat
+           ;; Declarative things
+           "(\\(" kv "\\|" kf "\\)"
+           ;; Whitespaces & names
+           "\\>[ \t]*\\(\\sw+\\)?[ \t]*\\(\\sw+\\)?"
+           )
+         (1 font-lock-keyword-face)
+         (,(+ 1 kv-depth kf-depth 1)
+          (cond ((match-beginning 2)
+                 font-lock-type-face)
+                ((match-beginning ,(+ 1 kv-depth 1))
+                 font-lock-function-name-face)
+                )
+          nil t)
+         (,(+ 1 kv-depth kf-depth 1 1)
+          (cond ((match-beginning 2)
+                 font-lock-variable-name-face)
+                )
+          nil t)))
+      ))
+  "Highlighted Semantic keywords.")
+
+;; (when (fboundp 'font-lock-add-keywords)
+;;   (font-lock-add-keywords 'emacs-lisp-mode
+;;                           semantic-fw-font-lock-keywords))
+\f
+;;; Interfacing with edebug
+;;
+(defun semantic-fw-add-edebug-spec ()
+  (def-edebug-spec semantic-exit-on-input 'def-body))
+
+(add-hook 'edebug-setup-hook 'semantic-fw-add-edebug-spec)
+
+(provide 'semantic-fw)
+
+;;; semantic-fw.el ends here
diff --git a/lisp/cedet/semantic-lex.el b/lisp/cedet/semantic-lex.el
new file mode 100644 (file)
index 0000000..171cd6c
--- /dev/null
@@ -0,0 +1,2089 @@
+;;; semantic-lex.el --- Lexical Analyzer builder
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 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:
+;;
+;; This file handles the creation of lexical analyzers for different
+;; languages in Emacs Lisp.  The purpose of a lexical analyzer is to
+;; convert a buffer into a list of lexical tokens.  Each token
+;; contains the token class (such as 'number, 'symbol, 'IF, etc) and
+;; the location in the buffer it was found.  Optionally, a token also
+;; contains a string representing what is at the designated buffer
+;; location.
+;;
+;; Tokens are pushed onto a token stream, which is basically a list of
+;; all the lexical tokens from the analyzed region.  The token stream
+;; is then handed to the grammar which parsers the file.
+;;
+;;; How it works
+;;
+;; Each analyzer specifies a condition and forms.  These conditions
+;; and forms are assembled into a function by `define-lex' that does
+;; the lexical analysis.
+;;
+;; In the lexical analyzer created with `define-lex', each condition
+;; is tested for a given point.  When the conditin is true, the forms
+;; run.
+;;
+;; The forms can push a lexical token onto the token stream.  The
+;; analyzer forms also must move the current analyzer point.  If the
+;; analyzer point is moved without pushing a token, then tne matched
+;; syntax is effectively ignored, or skipped.
+;;
+;; Thus, starting at the beginning of a region to be analyzed, each
+;; condition is tested.  One will match, and a lexical token might be
+;; pushed, and the point is moved to the end of the lexical token
+;; identified.  At the new position, the process occurs again until
+;; the end of the specified region is reached.
+;;
+;;; How to use semantic-lex
+;;
+;; To create a lexer for a language, use the `define-lex' macro.
+;;
+;; The `define-lex' macro accepts a list of lexical analyzers.  Each
+;; analyzer is created with `define-lex-analyzer', or one of the
+;; derivitive macros.  A single analyzer defines a regular expression
+;; to match text in a buffer, and a short segment of code to create
+;; one lexical token.
+;;
+;; Each analyzer has a NAME, DOC, a CONDITION, and possibly some
+;; FORMS.  The NAME is the name used in `define-lex'.  The DOC
+;; describes what the analyzer should do.
+;;
+;; The CONDITION evaluates the text at the current point in the
+;; current buffer.  If CONDITION is true, then the FORMS will be
+;; executed.
+;;
+;; The purpose of the FORMS is to push new lexical tokens onto the
+;; list of tokens for the current buffer, and to move point after the
+;; matched text.
+;;
+;; Some macros for creating one analyzer are:
+;;
+;;   define-lex-analyzer - A generic analyzer associating any style of
+;;              condition to forms.
+;;   define-lex-regex-analyzer - Matches a regular expression.
+;;   define-lex-simple-regex-analyzer - Matches a regular expressions,
+;;              and pushes the match.
+;;   define-lex-block-analyzer - Matches list syntax, and defines
+;;              handles open/close delimiters.
+;;
+;; These macros are used by the grammar compiler when lexical
+;; information is specified in a grammar:
+;;   define-lex- * -type-analyzer - Matches syntax specified in
+;;              a grammar, and pushes one token for it.  The * would
+;;              be `sexp' for things like lists or strings, and
+;;              `string' for things that need to match some special
+;;              string, such as "\\." where a literal match is needed.
+;;
+;;; Lexical Tables
+;;
+;; There are tables of different symbols managed in semantic-lex.el.
+;; They are:
+;;
+;;   Lexical keyword table - A Table of symbols declared in a grammar
+;;           file with the %keyword declaration.
+;;           Keywords are used by `semantic-lex-symbol-or-keyword'
+;;           to create lexical tokens based on the keyword.
+;;
+;;   Lexical type table - A table of symbols declared in a grammer
+;;           file with the %type declaration.
+;;           The grammar compiler uses the type table to create new
+;;           lexical analyzers.  These analyzers are then used to when
+;;           a new lexical analyzer is made for a language.
+;;
+;;; Lexical Types
+;;
+;; A lexical type defines a kind of lexical analyzer that will be
+;; automatically generated from a grammar file based on some
+;; predetermined attributes. For now these two attributes are
+;; recognized :
+;;
+;; * matchdatatype : define the kind of lexical analyzer. That is :
+;;
+;;   - regexp : define a regexp analyzer (see
+;;     `define-lex-regex-type-analyzer')
+;;
+;;   - string : define a string analyzer (see
+;;     `define-lex-string-type-analyzer')
+;;
+;;   - block : define a block type analyzer (see
+;;     `define-lex-block-type-analyzer')
+;;
+;;   - sexp : define a sexp analyzer (see
+;;     `define-lex-sexp-type-analyzer')
+;;
+;;   - keyword : define a keyword analyzer (see
+;;     `define-lex-keyword-type-analyzer')
+;;
+;; * syntax : define the syntax that matches a syntactic
+;;   expression. When syntax is matched the corresponding type
+;;   analyzer is entered and the resulting match data will be
+;;   interpreted based on the kind of analyzer (see matchdatatype
+;;   above).
+;;
+;; The following lexical types are predefined :
+;;
+;; +-------------+---------------+--------------------------------+
+;; | type        | matchdatatype | syntax                         |
+;; +-------------+---------------+--------------------------------+
+;; | punctuation | string        | "\\(\\s.\\|\\s$\\|\\s'\\)+"    |
+;; | keyword     | keyword       | "\\(\\sw\\|\\s_\\)+"           |
+;; | symbol      | regexp        | "\\(\\sw\\|\\s_\\)+"           |
+;; | string      | sexp          | "\\s\""                        |
+;; | number      | regexp        | semantic-lex-number-expression |
+;; | block       | block         | "\\s(\\|\\s)"                  |
+;; +-------------+---------------+--------------------------------+
+;;
+;; In a grammar you must use a %type expression to automatically generate
+;; the corresponding analyzers of that type.
+;;
+;; Here is an example to auto-generate punctuation analyzers
+;; with 'matchdatatype and 'syntax predefined (see table above)
+;;
+;; %type <punctuation> ;; will auto-generate this kind of analyzers
+;;
+;; It is equivalent to write :
+;;
+;; %type  <punctuation> syntax "\\(\\s.\\|\\s$\\|\\s'\\)+" matchdatatype string
+;;
+;; ;; Some punctuations based on the type defines above
+;;
+;; %token <punctuation> NOT         "!"
+;; %token <punctuation> NOTEQ       "!="
+;; %token <punctuation> MOD         "%"
+;; %token <punctuation> MODEQ       "%="
+;;
+
+;;; On the Semantic 1.x lexer
+;;
+;; In semantic 1.x, the lexical analyzer was an all purpose routine.
+;; To boost efficiency, the analyzer is now a series of routines that
+;; are constructed at build time into a single routine.  This will
+;; eliminate unneeded if statements to speed the lexer.
+
+(require 'semantic-fw)
+;;; Code:
+
+;;; Compatibility
+;;
+(eval-and-compile
+  (if (not (fboundp 'with-syntax-table))
+
+;; Copied from Emacs 21 for compatibility with released Emacses.
+(defmacro with-syntax-table (table &rest body)
+  "With syntax table of current buffer set to a copy of TABLE, evaluate BODY.
+The syntax table of the current buffer is saved, BODY is evaluated, and the
+saved table is restored, even in case of an abnormal exit.
+Value is what BODY returns."
+  (let ((old-table (make-symbol "table"))
+       (old-buffer (make-symbol "buffer")))
+    `(let ((,old-table (syntax-table))
+          (,old-buffer (current-buffer)))
+       (unwind-protect
+          (progn
+            (set-syntax-table (copy-syntax-table ,table))
+            ,@body)
+        (save-current-buffer
+          (set-buffer ,old-buffer)
+          (set-syntax-table ,old-table))))))
+
+))
+\f
+;;; Semantic 2.x lexical analysis
+;;
+(defun semantic-lex-map-symbols (fun table &optional property)
+  "Call function FUN on every symbol in TABLE.
+If optional PROPERTY is non-nil, call FUN only on every symbol which
+as a PROPERTY value.  FUN receives a symbol as argument."
+  (if (arrayp table)
+      (mapatoms
+       #'(lambda (symbol)
+           (if (or (null property) (get symbol property))
+               (funcall fun symbol)))
+       table)))
+
+;;; Lexical keyword table handling.
+;;
+;; These keywords are keywords defined for using in a grammar with the
+;; %keyword declaration, and are not keywords used in Emacs Lisp.
+
+(defvar semantic-flex-keywords-obarray nil
+  "Buffer local keyword obarray for the lexical analyzer.
+These keywords are matched explicitly, and converted into special symbols.")
+(make-variable-buffer-local 'semantic-flex-keywords-obarray)
+
+(defmacro semantic-lex-keyword-invalid (name)
+  "Signal that NAME is an invalid keyword name."
+  `(signal 'wrong-type-argument '(semantic-lex-keyword-p ,name)))
+
+(defsubst semantic-lex-keyword-symbol (name)
+  "Return keyword symbol with NAME or nil if not found."
+  (and (arrayp semantic-flex-keywords-obarray)
+       (stringp name)
+       (intern-soft name semantic-flex-keywords-obarray)))
+
+(defsubst semantic-lex-keyword-p (name)
+  "Return non-nil if a keyword with NAME exists in the keyword table.
+Return nil otherwise."
+  (and (setq name (semantic-lex-keyword-symbol name))
+       (symbol-value name)))
+
+(defsubst semantic-lex-keyword-set (name value)
+  "Set value of keyword with NAME to VALUE and return VALUE."
+  (set (intern name semantic-flex-keywords-obarray) value))
+
+(defsubst semantic-lex-keyword-value (name)
+  "Return value of keyword with NAME.
+Signal an error if a keyword with NAME does not exist."
+  (let ((keyword (semantic-lex-keyword-symbol name)))
+    (if keyword
+        (symbol-value keyword)
+      (semantic-lex-keyword-invalid name))))
+
+(defsubst semantic-lex-keyword-put (name property value)
+  "For keyword with NAME, set its PROPERTY to VALUE."
+  (let ((keyword (semantic-lex-keyword-symbol name)))
+    (if keyword
+        (put keyword property value)
+      (semantic-lex-keyword-invalid name))))
+
+(defsubst semantic-lex-keyword-get (name property)
+  "For keyword with NAME, return its PROPERTY value."
+  (let ((keyword (semantic-lex-keyword-symbol name)))
+    (if keyword
+        (get keyword property)
+      (semantic-lex-keyword-invalid name))))
+
+(defun semantic-lex-make-keyword-table (specs &optional propspecs)
+  "Convert keyword SPECS into an obarray and return it.
+SPECS must be a list of (NAME . TOKSYM) elements, where:
+
+  NAME is the name of the keyword symbol to define.
+  TOKSYM is the lexical token symbol of that keyword.
+
+If optional argument PROPSPECS is non nil, then interpret it, and
+apply those properties.
+PROPSPECS must be a list of (NAME PROPERTY VALUE) elements."
+  ;; Create the symbol hash table
+  (let ((semantic-flex-keywords-obarray (make-vector 13 0))
+        spec)
+    ;; fill it with stuff
+    (while specs
+      (setq spec  (car specs)
+            specs (cdr specs))
+      (semantic-lex-keyword-set (car spec) (cdr spec)))
+    ;; Apply all properties
+    (while propspecs
+      (setq spec (car propspecs)
+            propspecs (cdr propspecs))
+      (semantic-lex-keyword-put (car spec) (nth 1 spec) (nth 2 spec)))
+    semantic-flex-keywords-obarray))
+
+(defsubst semantic-lex-map-keywords (fun &optional property)
+  "Call function FUN on every lexical keyword.
+If optional PROPERTY is non-nil, call FUN only on every keyword which
+as a PROPERTY value.  FUN receives a lexical keyword as argument."
+  (semantic-lex-map-symbols
+   fun semantic-flex-keywords-obarray property))
+
+(defun semantic-lex-keywords (&optional property)
+  "Return a list of lexical keywords.
+If optional PROPERTY is non-nil, return only keywords which have a
+PROPERTY set."
+  (let (keywords)
+    (semantic-lex-map-keywords
+     #'(lambda (symbol) (setq keywords (cons symbol keywords)))
+     property)
+    keywords))
+\f
+;;; Type table handling.
+;;
+;; The lexical type table manages types that occur in a grammar file
+;; with the %type declaration.  Types represent different syntaxes.
+;; See code for `semantic-lex-preset-default-types' for the classic
+;; types of syntax.
+(defvar semantic-lex-types-obarray nil
+  "Buffer local types obarray for the lexical analyzer.")
+(make-variable-buffer-local 'semantic-lex-types-obarray)
+
+(defmacro semantic-lex-type-invalid (type)
+  "Signal that TYPE is an invalid lexical type name."
+  `(signal 'wrong-type-argument '(semantic-lex-type-p ,type)))
+
+(defsubst semantic-lex-type-symbol (type)
+  "Return symbol with TYPE or nil if not found."
+  (and (arrayp semantic-lex-types-obarray)
+       (stringp type)
+       (intern-soft type semantic-lex-types-obarray)))
+
+(defsubst semantic-lex-type-p (type)
+  "Return non-nil if a symbol with TYPE name exists."
+  (and (setq type (semantic-lex-type-symbol type))
+       (symbol-value type)))
+
+(defsubst semantic-lex-type-set (type value)
+  "Set value of symbol with TYPE name to VALUE and return VALUE."
+  (set (intern type semantic-lex-types-obarray) value))
+
+(defsubst semantic-lex-type-value (type &optional noerror)
+  "Return value of symbol with TYPE name.
+If optional argument NOERROR is non-nil return nil if a symbol with
+TYPE name does not exist.  Otherwise signal an error."
+  (let ((sym (semantic-lex-type-symbol type)))
+    (if sym
+        (symbol-value sym)
+      (unless noerror
+        (semantic-lex-type-invalid type)))))
+
+(defsubst semantic-lex-type-put (type property value &optional add)
+  "For symbol with TYPE name, set its PROPERTY to VALUE.
+If optional argument ADD is non-nil, create a new symbol with TYPE
+name if it does not already exist.  Otherwise signal an error."
+  (let ((sym (semantic-lex-type-symbol type)))
+    (unless sym
+      (or add (semantic-lex-type-invalid type))
+      (semantic-lex-type-set type nil)
+      (setq sym (semantic-lex-type-symbol type)))
+    (put sym property value)))
+
+(defsubst semantic-lex-type-get (type property &optional noerror)
+  "For symbol with TYPE name, return its PROPERTY value.
+If optional argument NOERROR is non-nil return nil if a symbol with
+TYPE name does not exist.  Otherwise signal an error."
+  (let ((sym (semantic-lex-type-symbol type)))
+    (if sym
+        (get sym property)
+      (unless noerror
+        (semantic-lex-type-invalid type)))))
+
+(defun semantic-lex-preset-default-types ()
+  "Install useful default properties for well known types."
+  (semantic-lex-type-put "punctuation" 'matchdatatype 'string t)
+  (semantic-lex-type-put "punctuation" 'syntax "\\(\\s.\\|\\s$\\|\\s'\\)+")
+  (semantic-lex-type-put "keyword" 'matchdatatype 'keyword t)
+  (semantic-lex-type-put "keyword" 'syntax "\\(\\sw\\|\\s_\\)+")
+  (semantic-lex-type-put "symbol"  'matchdatatype 'regexp t)
+  (semantic-lex-type-put "symbol"  'syntax "\\(\\sw\\|\\s_\\)+")
+  (semantic-lex-type-put "string"  'matchdatatype 'sexp t)
+  (semantic-lex-type-put "string"  'syntax "\\s\"")
+  (semantic-lex-type-put "number"  'matchdatatype 'regexp t)
+  (semantic-lex-type-put "number"  'syntax 'semantic-lex-number-expression)
+  (semantic-lex-type-put "block"   'matchdatatype 'block t)
+  (semantic-lex-type-put "block"   'syntax "\\s(\\|\\s)")
+  )
+
+(defun semantic-lex-make-type-table (specs &optional propspecs)
+  "Convert type SPECS into an obarray and return it.
+SPECS must be a list of (TYPE . TOKENS) elements, where:
+
+  TYPE is the name of the type symbol to define.
+  TOKENS is an list of (TOKSYM . MATCHER) elements, where:
+
+    TOKSYM is any lexical token symbol.
+    MATCHER is a string or regexp a text must match to be a such
+    lexical token.
+
+If optional argument PROPSPECS is non nil, then interpret it, and
+apply those properties.
+PROPSPECS must be a list of (TYPE PROPERTY VALUE)."
+  ;; Create the symbol hash table
+  (let* ((semantic-lex-types-obarray (make-vector 13 0))
+         spec type tokens token alist default)
+    ;; fill it with stuff
+    (while specs
+      (setq spec   (car specs)
+            specs  (cdr specs)
+            type   (car spec)
+            tokens (cdr spec)
+            default nil
+            alist   nil)
+      (while tokens
+        (setq token  (car tokens)
+              tokens (cdr tokens))
+        (if (cdr token)
+            (setq alist (cons token alist))
+          (setq token (car token))
+          (if default
+              (message
+               "*Warning* default value of <%s> tokens changed to %S, was %S"
+               type default token))
+          (setq default token)))
+      ;; Ensure the default matching spec is the first one.
+      (semantic-lex-type-set type (cons default (nreverse alist))))
+    ;; Install useful default types & properties
+    (semantic-lex-preset-default-types)
+    ;; Apply all properties
+    (while propspecs
+      (setq spec (car propspecs)
+            propspecs (cdr propspecs))
+      ;; Create the type if necessary.
+      (semantic-lex-type-put (car spec) (nth 1 spec) (nth 2 spec) t))
+    semantic-lex-types-obarray))
+
+(defsubst semantic-lex-map-types (fun &optional property)
+  "Call function FUN on every lexical type.
+If optional PROPERTY is non-nil, call FUN only on every type symbol
+which as a PROPERTY value.  FUN receives a type symbol as argument."
+  (semantic-lex-map-symbols
+   fun semantic-lex-types-obarray property))
+
+(defun semantic-lex-types (&optional property)
+  "Return a list of lexical type symbols.
+If optional PROPERTY is non-nil, return only type symbols which have
+PROPERTY set."
+  (let (types)
+    (semantic-lex-map-types
+     #'(lambda (symbol) (setq types (cons symbol types)))
+     property)
+    types))
+\f
+;;; Lexical Analyzer framework settings
+;;
+
+(defvar semantic-lex-analyzer 'semantic-flex
+  "The lexical analyzer used for a given buffer.
+See `semantic-lex' for documentation.
+For compatibility with Semantic 1.x it defaults to `semantic-flex'.")
+(make-variable-buffer-local 'semantic-lex-analyzer)
+
+(defvar semantic-lex-tokens
+  '(
+    (bol)
+    (charquote)
+    (close-paren)
+    (comment)
+    (newline)
+    (open-paren)
+    (punctuation)
+    (semantic-list)
+    (string)
+    (symbol)
+    (whitespace)
+    )
+  "An alist of of semantic token types.
+As of December 2001 (semantic 1.4beta13), this variable is not used in
+any code.  The only use is to refer to the doc-string from elsewhere.
+
+The key to this alist is the symbol representing token type that
+\\[semantic-flex] returns.  These are
+
+  - bol:           Empty string matching a beginning of line.
+                   This token is produced with
+                   `semantic-lex-beginning-of-line'.
+
+  - charquote:     String sequences that match `\\s\\+' regexp.
+                   This token is produced with `semantic-lex-charquote'.
+
+  - close-paren:   Characters that match `\\s)' regexp.
+                   These are typically `)', `}', `]', etc.
+                   This token is produced with
+                   `semantic-lex-close-paren'.
+
+  - comment:       A comment chunk.  These token types are not
+                   produced by default.
+                   This token is produced with `semantic-lex-comments'.
+                   Comments are ignored with `semantic-lex-ignore-comments'.
+                   Comments are treated as whitespace with
+                   `semantic-lex-comments-as-whitespace'.
+
+  - newline        Characters matching `\\s-*\\(\n\\|\\s>\\)' regexp.
+                   This token is produced with `semantic-lex-newline'.
+
+  - open-paren:    Characters that match `\\s(' regexp.
+                   These are typically `(', `{', `[', etc.
+                   If `semantic-lex-paren-or-list' is used,
+                   then `open-paren' is not usually generated unless
+                   the `depth' argument to \\[semantic-lex] is
+                   greater than 0.
+                   This token is always produced if the analyzer
+                   `semantic-lex-open-paren' is used.
+
+  - punctuation:   Characters matching `{\\(\\s.\\|\\s$\\|\\s'\\)'
+                   regexp.
+                   This token is produced with `semantic-lex-punctuation'.
+                   Always specify this analyzer after the comment
+                   analyzer.
+
+  - semantic-list: String delimited by matching parenthesis, braces,
+                   etc.  that the lexer skipped over, because the
+                   `depth' parameter to \\[semantic-flex] was not high
+                   enough.
+                   This token is produced with `semantic-lex-paren-or-list'.
+
+  - string:        Quoted strings, i.e., string sequences that start
+                   and end with characters matching `\\s\"'
+                   regexp.  The lexer relies on @code{forward-sexp} to
+                   find the matching end.
+                   This token is produced with `semantic-lex-string'.
+
+  - symbol:        String sequences that match `\\(\\sw\\|\\s_\\)+'
+                   regexp.
+                   This token is produced with
+                   `semantic-lex-symbol-or-keyword'.  Always add this analyzer
+                   after `semantic-lex-number', or other analyzers that
+                   match its regular expression.
+
+  - whitespace:    Characters that match `\\s-+' regexp.
+                   This token is produced with `semantic-lex-whitespace'.")
+
+(defvar semantic-lex-syntax-modifications nil
+  "Changes to the syntax table for this buffer.
+These changes are active only while the buffer is being flexed.
+This is a list where each element has the form:
+  (CHAR CLASS)
+CHAR is the char passed to `modify-syntax-entry',
+and CLASS is the string also passed to `modify-syntax-entry' to define
+what syntax class CHAR has.")
+(make-variable-buffer-local 'semantic-lex-syntax-modifications)
+
+(defvar semantic-lex-syntax-table nil
+  "Syntax table used by lexical analysis.
+See also `semantic-lex-syntax-modifications'.")
+(make-variable-buffer-local 'semantic-lex-syntax-table)
+
+(defvar semantic-lex-comment-regex nil
+  "Regular expression for identifying comment start during lexical analysis.
+This may be automatically set when semantic initializes in a mode, but
+may need to be overriden for some special languages.")
+(make-variable-buffer-local 'semantic-lex-comment-regex)
+
+(defvar semantic-lex-number-expression
+  ;; This expression was written by David Ponce for Java, and copied
+  ;; here for C and any other similar language.
+  (eval-when-compile
+    (concat "\\("
+            "\\<[0-9]+[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
+            "\\|"
+            "\\<[0-9]+[.][eE][-+]?[0-9]+[fFdD]?\\>"
+            "\\|"
+            "\\<[0-9]+[.][fFdD]\\>"
+            "\\|"
+            "\\<[0-9]+[.]"
+            "\\|"
+            "[.][0-9]+\\([eE][-+]?[0-9]+\\)?[fFdD]?\\>"
+            "\\|"
+            "\\<[0-9]+[eE][-+]?[0-9]+[fFdD]?\\>"
+            "\\|"
+            "\\<0[xX][0-9a-fA-F]+[lL]?\\>"
+            "\\|"
+            "\\<[0-9]+[lLfFdD]?\\>"
+            "\\)"
+            ))
+  "Regular expression for matching a number.
+If this value is nil, no number extraction is done during lex.
+This expression tries to match C and Java like numbers.
+
+DECIMAL_LITERAL:
+    [1-9][0-9]*
+  ;
+HEX_LITERAL:
+    0[xX][0-9a-fA-F]+
+  ;
+OCTAL_LITERAL:
+    0[0-7]*
+  ;
+INTEGER_LITERAL:
+    <DECIMAL_LITERAL>[lL]?
+  | <HEX_LITERAL>[lL]?
+  | <OCTAL_LITERAL>[lL]?
+  ;
+EXPONENT:
+    [eE][+-]?[09]+
+  ;
+FLOATING_POINT_LITERAL:
+    [0-9]+[.][0-9]*<EXPONENT>?[fFdD]?
+  | [.][0-9]+<EXPONENT>?[fFdD]?
+  | [0-9]+<EXPONENT>[fFdD]?
+  | [0-9]+<EXPONENT>?[fFdD]
+  ;")
+(make-variable-buffer-local 'semantic-lex-number-expression)
+
+(defvar semantic-lex-depth 0
+  "Default lexing depth.
+This specifies how many lists to create tokens in.")
+(make-variable-buffer-local 'semantic-lex-depth)
+
+(defvar semantic-lex-unterminated-syntax-end-function
+  (lambda (syntax syntax-start lex-end) lex-end)
+  "Function called when unterminated syntax is encountered.
+This should be set to one function.  That function should take three
+parameters.  The SYNTAX, or type of syntax which is unterminated.
+SYNTAX-START where the broken syntax begins.
+LEX-END is where the lexical analysis was asked to end.
+This function can be used for languages that can intelligently fix up
+broken syntax, or the exit lexical analysis via `throw' or `signal'
+when finding unterminated syntax.")
+
+;;; Interactive testing commands
+
+(defun semantic-lex-test (arg)
+  "Test the semantic lexer in the current buffer.
+If universal argument ARG, then try the whole buffer."
+  (interactive "P")
+  (let* ((start (current-time))
+        (result (semantic-lex
+                 (if arg (point-min) (point))
+                 (point-max)))
+        (end (current-time)))
+    (message "Elapsed Time: %.2f seconds."
+            (semantic-elapsed-time start end))
+    (pop-to-buffer "*Lexer Output*")
+    (require 'pp)
+    (erase-buffer)
+    (insert (pp-to-string result))
+    (goto-char (point-min))
+    ))
+
+(defun semantic-lex-test-full-depth (arg)
+  "Test the semantic lexer in the current buffer parsing through lists.
+Usually the lexer parses
+If universal argument ARG, then try the whole buffer."
+  (interactive "P")
+  (let* ((start (current-time))
+        (result (semantic-lex
+                 (if arg (point-min) (point))
+                 (point-max)
+                 100))
+        (end (current-time)))
+    (message "Elapsed Time: %.2f seconds."
+            (semantic-elapsed-time start end))
+    (pop-to-buffer "*Lexer Output*")
+    (require 'pp)
+    (erase-buffer)
+    (insert (pp-to-string result))
+    (goto-char (point-min))
+    ))
+
+(defun semantic-lex-test-region (beg end)
+  "Test the semantic lexer in the current buffer.
+Analyze the area between BEG and END."
+  (interactive "r")
+  (let ((result (semantic-lex beg end)))
+    (pop-to-buffer "*Lexer Output*")
+    (require 'pp)
+    (erase-buffer)
+    (insert (pp-to-string result))
+    (goto-char (point-min))
+    ))
+
+(defvar semantic-lex-debug nil
+  "When non-nil, debug the local lexical analyzer.")
+
+(defun semantic-lex-debug (arg)
+  "Debug the semantic lexer in the current buffer.
+Argument ARG specifies of the analyze the whole buffer, or start at point.
+While engaged, each token identified by the lexer will be highlighted
+in the target buffer   A description of the current token will be
+displayed in the minibuffer.  Press SPC to move to the next lexical token."
+  (interactive "P")
+  (require 'semantic-debug)
+  (let ((semantic-lex-debug t))
+    (semantic-lex-test arg)))
+
+(defun semantic-lex-highlight-token (token)
+  "Highlight the lexical TOKEN.
+TOKEN is a lexical token with a START And END position.
+Return the overlay."
+  (let ((o (semantic-make-overlay (semantic-lex-token-start token)
+                                 (semantic-lex-token-end token))))
+    (semantic-overlay-put o 'face 'highlight)
+    o))
+
+(defsubst semantic-lex-debug-break (token)
+  "Break during lexical analysis at TOKEN."
+  (when semantic-lex-debug
+    (let ((o nil))
+      (unwind-protect
+         (progn
+           (when token
+             (setq o (semantic-lex-highlight-token token)))
+           (semantic-read-event
+            (format "%S :: SPC - continue" token))
+           )
+       (when o
+         (semantic-overlay-delete o))))))
+
+;;; Lexical analyzer creation
+;;
+;; Code for creating a lex function from lists of analyzers.
+;;
+;; A lexical analyzer is created from a list of individual analyzers.
+;; Each individual analyzer specifies a single match, and code that
+;; goes with it.
+;;
+;; Creation of an analyzer assembles these analyzers into a new function
+;; with the behaviors of all the individual analyzers.
+;;
+(defmacro semantic-lex-one-token (analyzers)
+  "Calculate one token from the current buffer at point.
+Uses locally bound variables from `define-lex'.
+Argument ANALYZERS is the list of analyzers being used."
+  (cons 'cond (mapcar #'symbol-value analyzers)))
+
+(defvar semantic-lex-end-point nil
+  "The end point as tracked through lexical functions.")
+
+(defvar semantic-lex-current-depth nil
+  "The current depth as tracked through lexical functions.")
+
+(defvar semantic-lex-maximum-depth nil
+  "The maximum depth of parenthisis as tracked through lexical functions.")
+
+(defvar semantic-lex-token-stream nil
+  "The current token stream we are collecting.")
+
+(defvar semantic-lex-analysis-bounds nil
+  "The bounds of the current analysis.")
+
+(defvar semantic-lex-block-streams nil
+  "Streams of tokens inside collapsed blocks.
+This is an alist of (ANCHOR . STREAM) elements where ANCHOR is the
+start position of the block, and STREAM is the list of tokens in that
+block.")
+
+(defvar semantic-lex-reset-hooks nil
+  "List of hooks major-modes use to reset lexical analyzers.
+Hooks are called with START and END values for the current lexical pass.
+Should be set with `add-hook'specifying a LOCAL option.")
+
+;; Stack of nested blocks.
+(defvar semantic-lex-block-stack nil)
+;;(defvar semantic-lex-timeout 5
+;;  "*Number of sections of lexing before giving up.")
+
+(defmacro define-lex (name doc &rest analyzers)
+  "Create a new lexical analyzer with NAME.
+DOC is a documentation string describing this analyzer.
+ANALYZERS are small code snippets of analyzers to use when
+building the new NAMED analyzer.  Only use analyzers which
+are written to be used in `define-lex'.
+Each analyzer should be an analyzer created with `define-lex-analyzer'.
+Note: The order in which analyzers are listed is important.
+If two analyzers can match the same text, it is important to order the
+analyzers so that the one you want to match first occurs first.  For
+example, it is good to put a numbe analyzer in front of a symbol
+analyzer which might mistake a number for as a symbol."
+  `(defun ,name  (start end &optional depth length)
+     ,(concat doc "\nSee `semantic-lex' for more information.")
+     ;; Make sure the state of block parsing starts over.
+     (setq semantic-lex-block-streams nil)
+     ;; Allow specialty reset items.
+     (run-hook-with-args 'semantic-lex-reset-hooks start end)
+     ;; Lexing state.
+     (let* (;(starttime (current-time))
+           (starting-position (point))
+            (semantic-lex-token-stream nil)
+            (semantic-lex-block-stack nil)
+           (tmp-start start)
+            (semantic-lex-end-point start)
+            (semantic-lex-current-depth 0)
+            ;; Use the default depth when not specified.
+            (semantic-lex-maximum-depth
+            (or depth semantic-lex-depth))
+           ;; Bounds needed for unterminated syntax
+           (semantic-lex-analysis-bounds (cons start end))
+           ;; This entry prevents text properties from
+           ;; confusing our lexical analysis.  See Emacs 22 (CVS)
+           ;; version of C++ mode with template hack text properties.
+           (parse-sexp-lookup-properties nil)
+           )
+       ;; Maybe REMOVE THIS LATER.
+       ;; Trying to find incremental parser bug.
+       (when (> end (point-max))
+         (error ,(format "%s: end (%%d) > point-max (%%d)" name)
+                end (point-max)))
+       (with-syntax-table semantic-lex-syntax-table
+         (goto-char start)
+         (while (and (< (point) end)
+                     (or (not length)
+                        (<= (length semantic-lex-token-stream) length)))
+           (semantic-lex-one-token ,analyzers)
+          (when (eq semantic-lex-end-point tmp-start)
+            (error ,(format "%s: endless loop at %%d, after %%S" name)
+                    tmp-start (car semantic-lex-token-stream)))
+          (setq tmp-start semantic-lex-end-point)
+           (goto-char semantic-lex-end-point)
+          ;;(when (> (semantic-elapsed-time starttime (current-time))
+          ;;       semantic-lex-timeout)
+          ;;  (error "Timeout during lex at char %d" (point)))
+          (semantic-throw-on-input 'lex)
+          (semantic-lex-debug-break (car semantic-lex-token-stream))
+          ))
+       ;; Check that there is no unterminated block.
+       (when semantic-lex-block-stack
+         (let* ((last (pop semantic-lex-block-stack))
+                (blk last))
+           (while blk
+             (message
+              ,(format "%s: `%%s' block from %%S is unterminated" name)
+              (car blk) (cadr blk))
+             (setq blk (pop semantic-lex-block-stack)))
+           (semantic-lex-unterminated-syntax-detected (car last))))
+       ;; Return to where we started.
+       ;; Do not wrap in protective stuff so that if there is an error
+       ;; thrown, the user knows where.
+       (goto-char starting-position)
+       ;; Return the token stream
+       (nreverse semantic-lex-token-stream))))
+\f
+;;; Collapsed block tokens delimited by any tokens.
+;;
+(defun semantic-lex-start-block (syntax)
+  "Mark the last read token as the beginning of a SYNTAX block."
+  (if (or (not semantic-lex-maximum-depth)
+          (< semantic-lex-current-depth semantic-lex-maximum-depth))
+      (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+    (push (list syntax (car semantic-lex-token-stream))
+          semantic-lex-block-stack)))
+
+(defun semantic-lex-end-block (syntax)
+  "Process the end of a previously marked SYNTAX block.
+That is, collapse the tokens inside that block, including the
+beginning and end of block tokens, into a high level block token of
+class SYNTAX.
+The token at beginning of block is the one marked by a previous call
+to `semantic-lex-start-block'.  The current token is the end of block.
+The collapsed tokens are saved in `semantic-lex-block-streams'."
+  (if (null semantic-lex-block-stack)
+      (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+    (let* ((stream semantic-lex-token-stream)
+           (blk (pop semantic-lex-block-stack))
+           (bstream (cdr blk))
+           (first (car bstream))
+           (last (pop stream)) ;; The current token mark the EOBLK
+           tok)
+      (if (not (eq (car blk) syntax))
+          ;; SYNTAX doesn't match the syntax of the current block in
+          ;; the stack. So we encountered the end of the SYNTAX block
+          ;; before the end of the current one in the stack which is
+          ;; signaled unterminated.
+          (semantic-lex-unterminated-syntax-detected (car blk))
+        ;; Move tokens found inside the block from the main stream
+        ;; into a separate block stream.
+        (while (and stream (not (eq (setq tok (pop stream)) first)))
+          (push tok bstream))
+        ;; The token marked as beginning of block was not encountered.
+        ;; This should not happen!
+        (or (eq tok first)
+            (error "Token %S not found at beginning of block `%s'"
+                   first syntax))
+        ;; Save the block stream for future reuse, to avoid to redo
+        ;; the lexical analysis of the block content!
+        ;; Anchor the block stream with its start position, so we can
+        ;; use: (cdr (assq start semantic-lex-block-streams)) to
+        ;; quickly retrieve the lexical stream associated to a block.
+        (setcar blk (semantic-lex-token-start first))
+        (setcdr blk (nreverse bstream))
+        (push blk semantic-lex-block-streams)
+        ;; In the main stream, replace the tokens inside the block by
+        ;; a high level block token of class SYNTAX.
+        (setq semantic-lex-token-stream stream)
+        (semantic-lex-push-token
+         (semantic-lex-token
+          syntax (car blk) (semantic-lex-token-end last)))
+        ))))
+\f
+;;; Lexical token API
+;;
+;; Functions for accessing parts of a token.  Use these functions
+;; instead of accessing the list structure directly because the
+;; contents of the lexical may change.
+;;
+(defmacro semantic-lex-token (symbol start end &optional str)
+  "Create a lexical token.
+SYMBOL is a symbol representing the class of syntax found.
+START and END define the bounds of the token in the current buffer.
+Optional STR is the string for the token iff the the bounds
+in the buffer do not cover the string they represent.  (As from
+macro expansion.)"
+  ;; This if statement checks the existance of a STR argument at
+  ;; compile time, where STR is some symbol or constant.  If the
+  ;; variable STr (runtime) is nil, this will make an incorrect decision.
+  ;;
+  ;; It is like this to maintain the original speed of the compiled
+  ;; code.
+  (if str
+      `(cons ,symbol (cons ,str (cons ,start ,end)))
+    `(cons ,symbol (cons ,start ,end))))
+
+(defun semantic-lex-token-p (thing)
+  "Return non-nil if THING is a semantic lex token.
+This is an exhaustively robust check."
+  (and (consp thing)
+       (symbolp (car thing))
+       (or (and (numberp (nth 1 thing))
+               (numberp (nthcdr 2 thing)))
+          (and (stringp (nth 1 thing))
+               (numberp (nth 2 thing))
+               (numberp (nthcdr 3 thing)))
+          ))
+  )
+
+(defun semantic-lex-token-with-text-p (thing)
+  "Return non-nil if THING is a semantic lex token.
+This is an exhaustively robust check."
+  (and (consp thing)
+       (symbolp (car thing))
+       (= (length thing) 4)
+       (stringp (nth 1 thing))
+       (numberp (nth 2 thing))
+       (numberp (nth 3 thing)))
+  )
+
+(defun semantic-lex-token-without-text-p (thing)
+  "Return non-nil if THING is a semantic lex token.
+This is an exhaustively robust check."
+  (and (consp thing)
+       (symbolp (car thing))
+       (= (length thing) 3)
+       (numberp (nth 1 thing))
+       (numberp (nth 2 thing)))
+  )
+
+(defun semantic-lex-expand-block-specs (specs)
+  "Expand block specifications SPECS into a Lisp form.
+SPECS is a list of (BLOCK BEGIN END) elements where BLOCK, BEGIN, and
+END are token class symbols that indicate to produce one collapsed
+BLOCK token from tokens found between BEGIN and END ones.
+BLOCK must be a non-nil symbol, and at least one of the BEGIN or END
+symbols must be non-nil too.
+When BEGIN is non-nil, generate a call to `semantic-lex-start-block'
+when a BEGIN token class is encountered.
+When END is non-nil, generate a call to `semantic-lex-end-block' when
+an END token class is encountered."
+  (let ((class (make-symbol "class"))
+        (form nil))
+    (dolist (spec specs)
+      (when (car spec)
+        (when (nth 1 spec)
+          (push `((eq ',(nth 1 spec) ,class)
+                  (semantic-lex-start-block ',(car spec)))
+                form))
+        (when (nth 2 spec)
+          (push `((eq ',(nth 2 spec) ,class)
+                  (semantic-lex-end-block ',(car spec)))
+                form))))
+    (when form
+      `((let ((,class (semantic-lex-token-class
+                       (car semantic-lex-token-stream))))
+          (cond ,@(nreverse form))))
+      )))
+
+(defmacro semantic-lex-push-token (token &rest blockspecs)
+  "Push TOKEN in the lexical analyzer token stream.
+Return the lexical analysis current end point.
+If optional arguments BLOCKSPECS is non-nil, it specifies to process
+collapsed block tokens.  See `semantic-lex-expand-block-specs' for
+more details.
+This macro should only be called within the bounds of
+`define-lex-analyzer'.  It changes the values of the lexical analyzer
+variables `token-stream' and `semantic-lex-end-point'.  If you need to
+move `semantic-lex-end-point' somewhere else, just modify this
+variable after calling `semantic-lex-push-token'."
+  `(progn
+     (push ,token semantic-lex-token-stream)
+     ,@(semantic-lex-expand-block-specs blockspecs)
+     (setq semantic-lex-end-point
+           (semantic-lex-token-end (car semantic-lex-token-stream)))
+     ))
+
+(defsubst semantic-lex-token-class (token)
+  "Fetch the class of the lexical token TOKEN.
+See also the function `semantic-lex-token'."
+  (car token))
+
+(defsubst semantic-lex-token-bounds (token)
+  "Fetch the start and end locations of the lexical token TOKEN.
+Return a pair (START . END)."
+  (if (not (numberp (car (cdr token))))
+      (cdr (cdr token))
+    (cdr token)))
+
+(defsubst semantic-lex-token-start (token)
+  "Fetch the start position of the lexical token TOKEN.
+See also the function `semantic-lex-token'."
+  (car (semantic-lex-token-bounds token)))
+
+(defsubst semantic-lex-token-end (token)
+  "Fetch the end position of the lexical token TOKEN.
+See also the function `semantic-lex-token'."
+  (cdr (semantic-lex-token-bounds token)))
+
+(defsubst semantic-lex-token-text (token)
+  "Fetch the text associated with the lexical token TOKEN.
+See also the function `semantic-lex-token'."
+  (if (stringp (car (cdr token)))
+      (car (cdr token))
+    (buffer-substring-no-properties
+     (semantic-lex-token-start token)
+     (semantic-lex-token-end   token))))
+
+(defun semantic-lex-init ()
+  "Initialize any lexical state for this buffer."
+  (unless semantic-lex-comment-regex
+    (setq semantic-lex-comment-regex
+         (if comment-start-skip
+             (concat "\\(\\s<\\|" comment-start-skip "\\)")
+           "\\(\\s<\\)")))
+  ;; Setup the lexer syntax-table
+  (setq semantic-lex-syntax-table (copy-syntax-table (syntax-table)))
+  (dolist (mod semantic-lex-syntax-modifications)
+    (modify-syntax-entry
+     (car mod) (nth 1 mod) semantic-lex-syntax-table)))
+
+(define-overloadable-function semantic-lex (start end &optional depth length)
+  "Lexically analyze text in the current buffer between START and END.
+Optional argument DEPTH indicates at what level to scan over entire
+lists.  The last argument, LENGTH specifies that `semantic-lex'
+should only return LENGTH tokens.  The return value is a token stream.
+Each element is a list, such of the form
+  (symbol start-expression .  end-expression)
+where SYMBOL denotes the token type.
+See `semantic-lex-tokens' variable for details on token types.  END
+does not mark the end of the text scanned, only the end of the
+beginning of text scanned.  Thus, if a string extends past END, the
+end of the return token will be larger than END.  To truly restrict
+scanning, use `narrow-to-region'."
+  (funcall semantic-lex-analyzer start end depth length))
+
+(defsubst semantic-lex-buffer (&optional depth)
+  "Lex the current buffer.
+Optional argument DEPTH is the depth to scan into lists."
+  (semantic-lex (point-min) (point-max) depth))
+
+(defsubst semantic-lex-list (semlist depth)
+  "Lex the body of SEMLIST to DEPTH."
+  (semantic-lex (semantic-lex-token-start semlist)
+                (semantic-lex-token-end   semlist)
+                depth))
+\f
+;;; Analyzer creation macros
+;;
+;; An individual analyzer is a condition and code that goes with it.
+;;
+;; Created analyzers become variables with the code associated with them
+;; as the symbol value.  These analyzers are assembled into a lexer
+;; to create new lexical analyzers.
+;;
+(defsubst semantic-lex-unterminated-syntax-detected (syntax)
+  "Inside a lexical analyzer, use this when unterminated syntax was found.
+Argument SYNTAX indicates the type of syntax that is unterminated.
+The job of this function is to move (point) to a new logical location
+so that analysis can continue, if possible."
+  (goto-char
+   (funcall semantic-lex-unterminated-syntax-end-function
+           syntax
+           (car semantic-lex-analysis-bounds)
+           (cdr semantic-lex-analysis-bounds)
+           ))
+  (setq semantic-lex-end-point (point)))
+
+(defcustom semantic-lex-debug-analyzers nil
+  "Non nil means to debug analyzers with syntax protection.
+Only in effect if `debug-on-error' is also non-nil."
+  :group 'semantic
+  :type 'boolean)
+
+(defmacro semantic-lex-unterminated-syntax-protection (syntax &rest forms)
+  "For SYNTAX, execute FORMS with protection for unterminated syntax.
+If FORMS throws an error, treat this as a syntax problem, and
+execute the unterminated syntax code.  FORMS should return a position.
+Irreguardless of an error, the cursor should be moved to the end of
+the desired syntax, and a position returned.
+If `debug-on-error' is set, errors are not caught, so that you can
+debug them.
+Avoid using a large FORMS since it is duplicated."
+  `(if (and debug-on-error semantic-lex-debug-analyzers)
+       (progn ,@forms)
+     (condition-case nil
+         (progn ,@forms)
+       (error
+        (semantic-lex-unterminated-syntax-detected ,syntax)))))
+(put 'semantic-lex-unterminated-syntax-protection
+     'lisp-indent-function 1)
+
+(defmacro define-lex-analyzer (name doc condition &rest forms)
+  "Create a single lexical analyzer NAME with DOC.
+When an analyzer is called, the current buffer and point are
+positioned in a buffer at the location to be analyzed.
+CONDITION is an expression which returns t if FORMS should be run.
+Within the bounds of CONDITION and FORMS, the use of backquote
+can be used to evaluate expressions at compile time.
+While forms are running, the following variables will be locally bound:
+  `semantic-lex-analysis-bounds' - The bounds of the current analysis.
+                  of the form (START . END)
+  `semantic-lex-maximum-depth' - The maximum depth of semantic-list
+                  for the current analysis.
+  `semantic-lex-current-depth' - The current depth of `semantic-list' that has
+                  been decended.
+  `semantic-lex-end-point' - End Point after match.
+                   Analyzers should set this to a buffer location if their
+                   match string does not represent the end of the matched text.
+  `semantic-lex-token-stream' - The token list being collected.
+                   Add new lexical tokens to this list.
+Proper action in FORMS is to move the value of `semantic-lex-end-point' to
+after the location of the analyzed entry, and to add any discovered tokens
+at the beginning of `semantic-lex-token-stream'.
+This can be done by using `semantic-lex-push-token'."
+  `(eval-and-compile
+     (defvar ,name nil ,doc)
+     (defun ,name nil)
+     ;; Do this part separately so that re-evaluation rebuilds this code.
+     (setq ,name '(,condition ,@forms))
+     ;; Build a single lexical analyzer function, so the doc for
+     ;; function help is automatically provided, and perhaps the
+     ;; function could be useful for testing and debugging one
+     ;; analyzer.
+     (fset ',name (lambda () ,doc
+                   (let ((semantic-lex-token-stream nil)
+                         (semantic-lex-end-point (point))
+                         (semantic-lex-analysis-bounds
+                          (cons (point) (point-max)))
+                         (semantic-lex-current-depth 0)
+                         (semantic-lex-maximum-depth
+                          semantic-lex-depth)
+                         )
+                     (when ,condition ,@forms)
+                     semantic-lex-token-stream)))
+     ))
+
+(defmacro define-lex-regex-analyzer (name doc regexp &rest forms)
+  "Create a lexical analyzer with NAME and DOC that will match REGEXP.
+FORMS are evaluated upon a successful match.
+See `define-lex-analyzer' for more about analyzers."
+  `(define-lex-analyzer ,name
+     ,doc
+     (looking-at ,regexp)
+     ,@forms
+     ))
+
+(defmacro define-lex-simple-regex-analyzer (name doc regexp toksym
+                                                &optional index
+                                                &rest forms)
+  "Create a lexical analyzer with NAME and DOC that match REGEXP.
+TOKSYM is the symbol to use when creating a semantic lexical token.
+INDEX is the index into the match that defines the bounds of the token.
+Index should be a plain integer, and not specified in the macro as an
+expression.
+FORMS are evaluated upon a successful match BEFORE the new token is
+created.  It is valid to ignore FORMS.
+See `define-lex-analyzer' for more about analyzers."
+  `(define-lex-analyzer ,name
+     ,doc
+     (looking-at ,regexp)
+     ,@forms
+     (semantic-lex-push-token
+      (semantic-lex-token ,toksym
+                         (match-beginning ,(or index 0))
+                         (match-end ,(or index 0))))
+     ))
+
+(defmacro define-lex-block-analyzer (name doc spec1 &rest specs)
+  "Create a lexical analyzer NAME for paired delimiters blocks.
+It detects a paired delimiters block or the corresponding open or
+close delimiter depending on the value of the variable
+`semantic-lex-current-depth'.  DOC is the documentation string of the lexical
+analyzer.  SPEC1 and SPECS specify the token symbols and open, close
+delimiters used.  Each SPEC has the form:
+
+\(BLOCK-SYM (OPEN-DELIM OPEN-SYM) (CLOSE-DELIM CLOSE-SYM))
+
+where BLOCK-SYM is the symbol returned in a block token.  OPEN-DELIM
+and CLOSE-DELIM are respectively the open and close delimiters
+identifying a block.  OPEN-SYM and CLOSE-SYM are respectively the
+symbols returned in open and close tokens."
+  (let ((specs (cons spec1 specs))
+        spec open olist clist)
+    (while specs
+      (setq spec  (car specs)
+            specs (cdr specs)
+            open  (nth 1 spec)
+            ;; build alist ((OPEN-DELIM OPEN-SYM BLOCK-SYM) ...)
+            olist (cons (list (car open) (cadr open) (car spec)) olist)
+            ;; build alist ((CLOSE-DELIM CLOSE-SYM) ...)
+            clist (cons (nth 2 spec) clist)))
+    `(define-lex-analyzer ,name
+       ,doc
+       (and
+        (looking-at "\\(\\s(\\|\\s)\\)")
+        (let ((text (match-string 0)) match)
+          (cond
+           ((setq match (assoc text ',olist))
+            (if (or (not semantic-lex-maximum-depth)
+                   (< semantic-lex-current-depth semantic-lex-maximum-depth))
+                (progn
+                  (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+                 (semantic-lex-push-token
+                  (semantic-lex-token
+                   (nth 1 match)
+                   (match-beginning 0) (match-end 0))))
+             (semantic-lex-push-token
+              (semantic-lex-token
+               (nth 2 match)
+               (match-beginning 0)
+               (save-excursion
+                 (semantic-lex-unterminated-syntax-protection (nth 2 match)
+                   (forward-list 1)
+                   (point)))
+               ))
+             ))
+           ((setq match (assoc text ',clist))
+            (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+           (semantic-lex-push-token
+            (semantic-lex-token
+             (nth 1 match)
+             (match-beginning 0) (match-end 0)))))))
+       )))
+\f
+;;; Analyzers
+;;
+;; Pre-defined common analyzers.
+;;
+(define-lex-analyzer semantic-lex-default-action
+  "The default action when no other lexical actions match text.
+This action will just throw an error."
+  t
+  (error "Unmatched Text during Lexical Analysis"))
+
+(define-lex-analyzer semantic-lex-beginning-of-line
+  "Detect and create a beginning of line token (BOL)."
+  (and (bolp)
+       ;; Just insert a (bol N . N) token in the token stream,
+       ;; without moving the point.  N is the point at the
+       ;; beginning of line.
+       (semantic-lex-push-token (semantic-lex-token 'bol (point) (point)))
+       nil) ;; CONTINUE
+  ;; We identify and add the BOL token onto the stream, but since
+  ;; semantic-lex-end-point doesn't move, we always fail CONDITION, and have no
+  ;; FORMS body.
+  nil)
+
+(define-lex-simple-regex-analyzer semantic-lex-newline
+  "Detect and create newline tokens."
+  "\\s-*\\(\n\\|\\s>\\)"  'newline 1)
+
+(define-lex-regex-analyzer semantic-lex-newline-as-whitespace
+  "Detect and create newline tokens.
+Use this ONLY if newlines are not whitespace characters (such as when
+they are comment end characters) AND when you want whitespace tokens."
+  "\\s-*\\(\n\\|\\s>\\)"
+  ;; Language wants whitespaces.  Create a token for it.
+  (if (eq (semantic-lex-token-class (car semantic-lex-token-stream))
+         'whitespace)
+      ;; Merge whitespace tokens together if they are adjacent.  Two
+      ;; whitespace tokens may be sperated by a comment which is not in
+      ;; the token stream.
+      (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
+              (match-end 0))
+    (semantic-lex-push-token
+     (semantic-lex-token
+      'whitespace (match-beginning 0) (match-end 0)))))
+
+(define-lex-regex-analyzer semantic-lex-ignore-newline
+  "Detect and ignore newline tokens.
+Use this ONLY if newlines are not whitespace characters (such as when
+they are comment end characters)."
+  "\\s-*\\(\n\\|\\s>\\)"
+  (setq semantic-lex-end-point (match-end 0)))
+
+(define-lex-regex-analyzer semantic-lex-whitespace
+  "Detect and create whitespace tokens."
+  ;; catch whitespace when needed
+  "\\s-+"
+  ;; Language wants whitespaces.  Create a token for it.
+  (if (eq (semantic-lex-token-class (car semantic-lex-token-stream))
+         'whitespace)
+      ;; Merge whitespace tokens together if they are adjacent.  Two
+      ;; whitespace tokens may be sperated by a comment which is not in
+      ;; the token stream.
+      (progn
+        (setq semantic-lex-end-point (match-end 0))
+        (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
+                semantic-lex-end-point))
+    (semantic-lex-push-token
+     (semantic-lex-token
+      'whitespace (match-beginning 0) (match-end 0)))))
+
+(define-lex-regex-analyzer semantic-lex-ignore-whitespace
+  "Detect and skip over whitespace tokens."
+  ;; catch whitespace when needed
+  "\\s-+"
+  ;; Skip over the detected whitespace, do not create a token for it.
+  (setq semantic-lex-end-point (match-end 0)))
+
+(define-lex-simple-regex-analyzer semantic-lex-number
+  "Detect and create number tokens.
+See `semantic-lex-number-expression' for details on matching numbers,
+and number formats."
+  semantic-lex-number-expression 'number)
+
+(define-lex-regex-analyzer semantic-lex-symbol-or-keyword
+  "Detect and create symbol and keyword tokens."
+  "\\(\\sw\\|\\s_\\)+"
+  (semantic-lex-push-token
+   (semantic-lex-token
+    (or (semantic-lex-keyword-p (match-string 0)) 'symbol)
+    (match-beginning 0) (match-end 0))))
+
+(define-lex-simple-regex-analyzer semantic-lex-charquote
+  "Detect and create charquote tokens."
+  ;; Character quoting characters (ie, \n as newline)
+  "\\s\\+" 'charquote)
+
+(define-lex-simple-regex-analyzer semantic-lex-punctuation
+  "Detect and create punctuation tokens."
+  "\\(\\s.\\|\\s$\\|\\s'\\)" 'punctuation)
+
+(define-lex-analyzer semantic-lex-punctuation-type
+  "Detect and create a punctuation type token.
+Recognized punctuations are defined in the current table of lexical
+types, as the value of the `punctuation' token type."
+  (and (looking-at "\\(\\s.\\|\\s$\\|\\s'\\)+")
+       (let* ((key (match-string 0))
+              (pos (match-beginning 0))
+              (end (match-end 0))
+              (len (- end pos))
+              (lst (semantic-lex-type-value "punctuation" t))
+              (def (car lst)) ;; default lexical symbol or nil
+              (lst (cdr lst)) ;; alist of (LEX-SYM . PUNCT-STRING)
+              (elt nil))
+         (if lst
+             ;; Starting with the longest one, search if the
+             ;; punctuation string is defined for this language.
+             (while (and (> len 0) (not (setq elt (rassoc key lst))))
+               (setq len (1- len)
+                     key (substring key 0 len))))
+         (if elt ;; Return the punctuation token found
+             (semantic-lex-push-token
+             (semantic-lex-token (car elt) pos (+ pos len)))
+           (if def ;; Return a default generic token
+               (semantic-lex-push-token
+               (semantic-lex-token def pos end))
+             ;; Nothing match
+             )))))
+
+(define-lex-regex-analyzer semantic-lex-paren-or-list
+  "Detect open parenthesis.
+Return either a paren token or a semantic list token depending on
+`semantic-lex-current-depth'."
+  "\\s("
+  (if (or (not semantic-lex-maximum-depth)
+         (< semantic-lex-current-depth semantic-lex-maximum-depth))
+      (progn
+       (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+       (semantic-lex-push-token
+        (semantic-lex-token
+         'open-paren (match-beginning 0) (match-end 0))))
+    (semantic-lex-push-token
+     (semantic-lex-token
+      'semantic-list (match-beginning 0)
+      (save-excursion
+       (semantic-lex-unterminated-syntax-protection 'semantic-list
+         (forward-list 1)
+         (point))
+       )))
+    ))
+
+(define-lex-simple-regex-analyzer semantic-lex-open-paren
+  "Detect and create an open parenthisis token."
+  "\\s(" 'open-paren 0  (setq semantic-lex-current-depth (1+ semantic-lex-current-depth)))
+
+(define-lex-simple-regex-analyzer semantic-lex-close-paren
+  "Detect and create a close paren token."
+  "\\s)" 'close-paren 0 (setq semantic-lex-current-depth (1- semantic-lex-current-depth)))
+
+(define-lex-regex-analyzer semantic-lex-string
+  "Detect and create a string token."
+  "\\s\""
+  ;; Zing to the end of this string.
+  (semantic-lex-push-token
+   (semantic-lex-token
+    'string (point)
+    (save-excursion
+      (semantic-lex-unterminated-syntax-protection 'string
+       (forward-sexp 1)
+       (point))
+      ))))
+
+(define-lex-regex-analyzer semantic-lex-comments
+  "Detect and create a comment token."
+  semantic-lex-comment-regex
+  (save-excursion
+    (forward-comment 1)
+    ;; Generate newline token if enabled
+    (if (bolp) (backward-char 1))
+    (setq semantic-lex-end-point (point))
+    ;; Language wants comments or want them as whitespaces,
+    ;; link them together.
+    (if (eq (semantic-lex-token-class (car semantic-lex-token-stream)) 'comment)
+       (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
+               semantic-lex-end-point)
+      (semantic-lex-push-token
+       (semantic-lex-token
+       'comment (match-beginning 0) semantic-lex-end-point)))))
+
+(define-lex-regex-analyzer semantic-lex-comments-as-whitespace
+  "Detect comments and create a whitespace token."
+  semantic-lex-comment-regex
+  (save-excursion
+    (forward-comment 1)
+    ;; Generate newline token if enabled
+    (if (bolp) (backward-char 1))
+    (setq semantic-lex-end-point (point))
+    ;; Language wants comments or want them as whitespaces,
+    ;; link them together.
+    (if (eq (semantic-lex-token-class (car semantic-lex-token-stream)) 'whitespace)
+       (setcdr (semantic-lex-token-bounds (car semantic-lex-token-stream))
+               semantic-lex-end-point)
+      (semantic-lex-push-token
+       (semantic-lex-token
+       'whitespace (match-beginning 0) semantic-lex-end-point)))))
+
+(define-lex-regex-analyzer semantic-lex-ignore-comments
+  "Detect and create a comment token."
+  semantic-lex-comment-regex
+  (let ((comment-start-point (point)))
+    (forward-comment 1)
+    (if (eq (point) comment-start-point)
+       ;; In this case our start-skip string failed
+       ;; to work properly.  Lets try and move over
+       ;; whatever white space we matched to begin
+       ;; with.
+       (skip-syntax-forward "-.'"
+                            (save-excursion
+                              (end-of-line)
+                              (point)))
+      ;; We may need to back up so newlines or whitespace is generated.
+      (if (bolp)
+         (backward-char 1)))
+    (if (eq (point) comment-start-point)
+       (error "Strange comment syntax prevents lexical analysis"))
+    (setq semantic-lex-end-point (point))))
+\f
+;;; Comment lexer
+;;
+;; Predefined lexers that could be used instead of creating new
+;; analyers.
+
+(define-lex semantic-comment-lexer
+  "A simple lexical analyzer that handles comments.
+This lexer will only return comment tokens.  It is the default lexer
+used by `semantic-find-doc-snarf-comment' to snarf up the comment at
+point."
+  semantic-lex-ignore-whitespace
+  semantic-lex-ignore-newline
+  semantic-lex-comments
+  semantic-lex-default-action)
+
+;;; Test Lexer
+;;
+(define-lex semantic-simple-lexer
+  "A simple lexical analyzer that handles simple buffers.
+This lexer ignores comments and whitespace, and will return
+syntax as specified by the syntax table."
+  semantic-lex-ignore-whitespace
+  semantic-lex-ignore-newline
+  semantic-lex-number
+  semantic-lex-symbol-or-keyword
+  semantic-lex-charquote
+  semantic-lex-paren-or-list
+  semantic-lex-close-paren
+  semantic-lex-string
+  semantic-lex-ignore-comments
+  semantic-lex-punctuation
+  semantic-lex-default-action)
+\f
+;;; Analyzers generated from grammar.
+;;
+;; Some analyzers are hand written.  Analyzers created with these
+;; functions are generated from the grammar files.
+
+(defmacro define-lex-keyword-type-analyzer (name doc syntax)
+  "Define a keyword type analyzer NAME with DOC string.
+SYNTAX is the regexp that matches a keyword syntactic expression."
+  (let ((key (make-symbol "key")))
+    `(define-lex-analyzer ,name
+       ,doc
+       (and (looking-at ,syntax)
+            (let ((,key (semantic-lex-keyword-p (match-string 0))))
+              (when ,key
+                (semantic-lex-push-token
+                 (semantic-lex-token
+                  ,key (match-beginning 0) (match-end 0)))))))
+    ))
+
+(defmacro define-lex-sexp-type-analyzer (name doc syntax token)
+  "Define a sexp type analyzer NAME with DOC string.
+SYNTAX is the regexp that matches the beginning of the s-expression.
+TOKEN is the lexical token returned when SYNTAX matches."
+  `(define-lex-regex-analyzer ,name
+     ,doc
+     ,syntax
+     (semantic-lex-push-token
+      (semantic-lex-token
+       ,token (point)
+       (save-excursion
+         (semantic-lex-unterminated-syntax-protection ,token
+           (forward-sexp 1)
+           (point))))))
+  )
+
+(defmacro define-lex-regex-type-analyzer (name doc syntax matches default)
+  "Define a regexp type analyzer NAME with DOC string.
+SYNTAX is the regexp that matches a syntactic expression.
+MATCHES is an alist of lexical elements used to refine the syntactic
+expression.
+DEFAULT is the default lexical token returned when no MATCHES."
+  (if matches
+      (let* ((val (make-symbol "val"))
+             (lst (make-symbol "lst"))
+             (elt (make-symbol "elt"))
+             (pos (make-symbol "pos"))
+             (end (make-symbol "end")))
+        `(define-lex-analyzer ,name
+           ,doc
+           (and (looking-at ,syntax)
+                (let* ((,val (match-string 0))
+                       (,pos (match-beginning 0))
+                       (,end (match-end 0))
+                       (,lst ,matches)
+                       ,elt)
+                  (while (and ,lst (not ,elt))
+                    (if (string-match (cdar ,lst) ,val)
+                        (setq ,elt (caar ,lst))
+                      (setq ,lst (cdr ,lst))))
+                  (semantic-lex-push-token
+                   (semantic-lex-token (or ,elt ,default) ,pos ,end))))
+           ))
+    `(define-lex-simple-regex-analyzer ,name
+       ,doc
+       ,syntax ,default)
+    ))
+
+(defmacro define-lex-string-type-analyzer (name doc syntax matches default)
+  "Define a string type analyzer NAME with DOC string.
+SYNTAX is the regexp that matches a syntactic expression.
+MATCHES is an alist of lexical elements used to refine the syntactic
+expression.
+DEFAULT is the default lexical token returned when no MATCHES."
+  (if matches
+      (let* ((val (make-symbol "val"))
+             (lst (make-symbol "lst"))
+             (elt (make-symbol "elt"))
+             (pos (make-symbol "pos"))
+             (end (make-symbol "end"))
+             (len (make-symbol "len")))
+        `(define-lex-analyzer ,name
+           ,doc
+           (and (looking-at ,syntax)
+                (let* ((,val (match-string 0))
+                       (,pos (match-beginning 0))
+                       (,end (match-end 0))
+                       (,len (- ,end ,pos))
+                       (,lst ,matches)
+                       ,elt)
+               ;; Starting with the longest one, search if a lexical
+               ;; value match a token defined for this language.
+               (while (and (> ,len 0) (not (setq ,elt (rassoc ,val ,lst))))
+                 (setq ,len (1- ,len)
+                       ,val (substring ,val 0 ,len)))
+               (when ,elt ;; Adjust token end position.
+                 (setq ,elt (car ,elt)
+                       ,end (+ ,pos ,len)))
+               (semantic-lex-push-token
+                (semantic-lex-token (or ,elt ,default) ,pos ,end))))
+           ))
+    `(define-lex-simple-regex-analyzer ,name
+       ,doc
+       ,syntax ,default)
+    ))
+
+(defmacro define-lex-block-type-analyzer (name doc syntax matches)
+  "Define a block type analyzer NAME with DOC string.
+
+SYNTAX is the regexp that matches block delimiters,  typically the
+open (`\\\\s(') and close (`\\\\s)') parenthesis syntax classes.
+
+MATCHES is a pair (OPEN-SPECS . CLOSE-SPECS) that defines blocks.
+
+  OPEN-SPECS is a list of (OPEN-DELIM OPEN-TOKEN BLOCK-TOKEN) elements
+  where:
+
+    OPEN-DELIM is a string: the block open delimiter character.
+
+    OPEN-TOKEN is the lexical token class associated to the OPEN-DELIM
+    delimiter.
+
+    BLOCK-TOKEN is the lexical token class associated to the block
+    that starts at the OPEN-DELIM delimiter.
+
+  CLOSE-SPECS is a list of (CLOSE-DELIM CLOSE-TOKEN) elements where:
+
+    CLOSE-DELIM is a string: the block end delimiter character.
+
+    CLOSE-TOKEN is the lexical token class associated to the
+    CLOSE-DELIM delimiter.
+
+Each element in OPEN-SPECS must have a corresponding element in
+CLOSE-SPECS.
+
+The lexer will return a BLOCK-TOKEN token when the value of
+`semantic-lex-current-depth' is greater than or equal to the maximum
+depth of parenthesis tracking (see also the function `semantic-lex').
+Otherwise it will return OPEN-TOKEN and CLOSE-TOKEN tokens.
+
+TO DO: Put the following in the developer's guide and just put a
+reference here.
+
+In the grammar:
+
+The value of a block token must be a string that contains a readable
+sexp of the form:
+
+  \"(OPEN-TOKEN CLOSE-TOKEN)\"
+
+OPEN-TOKEN and CLOSE-TOKEN represent the block delimiters, and must be
+lexical tokens of respectively `open-paren' and `close-paren' types.
+Their value is the corresponding delimiter character as a string.
+
+Here is a small example to analyze a parenthesis block:
+
+  %token <block>       PAREN_BLOCK \"(LPAREN RPAREN)\"
+  %token <open-paren>  LPAREN      \"(\"
+  %token <close-paren> RPAREN      \")\"
+
+When the lexer encounters the open-paren delimiter \"(\":
+
+ - If the maximum depth of parenthesis tracking is not reached (that
+   is, current depth < max depth), it returns a (LPAREN start .  end)
+   token, then continue analysis inside the block.  Later, when the
+   corresponding close-paren delimiter \")\" will be encountered, it
+   will return a (RPAREN start . end) token.
+
+ - If the maximum depth of parenthesis tracking is reached (current
+   depth >= max depth), it returns the whole parenthesis block as
+   a (PAREN_BLOCK start . end) token."
+  (let* ((val (make-symbol "val"))
+         (lst (make-symbol "lst"))
+         (elt (make-symbol "elt")))
+    `(define-lex-analyzer ,name
+       ,doc
+       (and
+        (looking-at ,syntax) ;; "\\(\\s(\\|\\s)\\)"
+        (let ((,val (match-string 0))
+              (,lst ,matches)
+              ,elt)
+          (cond
+           ((setq ,elt (assoc ,val (car ,lst)))
+            (if (or (not semantic-lex-maximum-depth)
+                    (< semantic-lex-current-depth semantic-lex-maximum-depth))
+                (progn
+                  (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+                  (semantic-lex-push-token
+                   (semantic-lex-token
+                    (nth 1 ,elt)
+                    (match-beginning 0) (match-end 0))))
+              (semantic-lex-push-token
+               (semantic-lex-token
+                (nth 2 ,elt)
+                (match-beginning 0)
+                (save-excursion
+                  (semantic-lex-unterminated-syntax-protection (nth 2 ,elt)
+                    (forward-list 1)
+                    (point)))))))
+           ((setq ,elt (assoc ,val (cdr ,lst)))
+            (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+            (semantic-lex-push-token
+             (semantic-lex-token
+              (nth 1 ,elt)
+              (match-beginning 0) (match-end 0))))
+           ))))
+    ))
+\f
+;;; Lexical Safety
+;;
+;; The semantic lexers, unlike other lexers, can throw errors on
+;; unbalanced syntax.  Since editing is all about changeging test
+;; we need to provide a convenient way to protect against syntactic
+;; inequalities.
+
+(defmacro semantic-lex-catch-errors (symbol &rest forms)
+  "Using SYMBOL, execute FORMS catching lexical errors.
+If FORMS results in a call to the parser that throws a lexical error,
+the error will be caught here without the buffer's cache being thrown
+out of date.
+If there is an error, the syntax that failed is returned.
+If there is no error, then the last value of FORMS is returned."
+  (let ((ret (make-symbol "ret"))
+        (syntax (make-symbol "syntax"))
+        (start (make-symbol "start"))
+        (end (make-symbol "end")))
+    `(let* ((semantic-lex-unterminated-syntax-end-function
+             (lambda (,syntax ,start ,end)
+               (throw ',symbol ,syntax)))
+            ;; Delete the below when semantic-flex is fully retired.
+            (semantic-flex-unterminated-syntax-end-function
+             semantic-lex-unterminated-syntax-end-function)
+            (,ret (catch ',symbol
+                    (save-excursion
+                      ,@forms
+                      nil))))
+       ;; Great Sadness.  Assume that FORMS execute within the
+       ;; confines of the current buffer only!  Mark this thing
+       ;; unparseable iff the special symbol was thrown.  This
+       ;; will prevent future calls from parsing, but will allow
+       ;; then to still return the cache.
+       (when ,ret
+        ;; Leave this message off.  If an APP using this fcn wants
+        ;; a message, they can do it themselves.  This cleans up
+        ;; problems with the idle scheduler obscuring useful data.
+         ;;(message "Buffer not currently parsable (%S)." ,ret)
+         (semantic-parse-tree-unparseable))
+       ,ret)))
+(put 'semantic-lex-catch-errors 'lisp-indent-function 1)
+
+\f
+;;; Interfacing with edebug
+;;
+(add-hook
+ 'edebug-setup-hook
+ #'(lambda ()
+
+     (def-edebug-spec define-lex
+       (&define name stringp (&rest symbolp))
+       )
+     (def-edebug-spec define-lex-analyzer
+       (&define name stringp form def-body)
+       )
+     (def-edebug-spec define-lex-regex-analyzer
+       (&define name stringp form def-body)
+       )
+     (def-edebug-spec define-lex-simple-regex-analyzer
+       (&define name stringp form symbolp [ &optional form ] def-body)
+       )
+     (def-edebug-spec define-lex-block-analyzer
+       (&define name stringp form (&rest form))
+       )
+     (def-edebug-spec semantic-lex-catch-errors
+       (symbolp def-body)
+       )
+
+     ))
+\f
+;;; Compatibility with Semantic 1.x lexical analysis
+;;
+;; NOTE: DELETE THIS SOMEDAY SOON
+
+(semantic-alias-obsolete 'semantic-flex-start 'semantic-lex-token-start)
+(semantic-alias-obsolete 'semantic-flex-end 'semantic-lex-token-end)
+(semantic-alias-obsolete 'semantic-flex-text 'semantic-lex-token-text)
+(semantic-alias-obsolete 'semantic-flex-make-keyword-table 'semantic-lex-make-keyword-table)
+(semantic-alias-obsolete 'semantic-flex-keyword-p 'semantic-lex-keyword-p)
+(semantic-alias-obsolete 'semantic-flex-keyword-put 'semantic-lex-keyword-put)
+(semantic-alias-obsolete 'semantic-flex-keyword-get 'semantic-lex-keyword-get)
+(semantic-alias-obsolete 'semantic-flex-map-keywords 'semantic-lex-map-keywords)
+(semantic-alias-obsolete 'semantic-flex-keywords 'semantic-lex-keywords)
+(semantic-alias-obsolete 'semantic-flex-buffer 'semantic-lex-buffer)
+(semantic-alias-obsolete 'semantic-flex-list   'semantic-lex-list)
+
+;; This simple scanner uses the syntax table to generate a stream of
+;; simple tokens of the form:
+;;
+;;  (SYMBOL START . END)
+;;
+;; Where symbol is the type of thing it is.  START and END mark that
+;; objects boundary.
+
+(defvar semantic-flex-tokens semantic-lex-tokens
+  "An alist of of semantic token types.
+See variable `semantic-lex-tokens'.")
+
+(defvar semantic-flex-unterminated-syntax-end-function
+  (lambda (syntax syntax-start flex-end) flex-end)
+  "Function called when unterminated syntax is encountered.
+This should be set to one function.  That function should take three
+parameters.  The SYNTAX, or type of syntax which is unterminated.
+SYNTAX-START where the broken syntax begins.
+FLEX-END is where the lexical analysis was asked to end.
+This function can be used for languages that can intelligently fix up
+broken syntax, or the exit lexical analysis via `throw' or `signal'
+when finding unterminated syntax.")
+
+(defvar semantic-flex-extensions nil
+  "Buffer local extensions to the lexical analyzer.
+This should contain an alist with a key of a regex and a data element of
+a function.  The function should both move point, and return a lexical
+token of the form:
+  ( TYPE START .  END)
+nil is also a valid return value.
+TYPE can be any type of symbol, as long as it doesn't occur as a
+nonterminal in the language definition.")
+(make-variable-buffer-local 'semantic-flex-extensions)
+
+(defvar semantic-flex-syntax-modifications nil
+  "Changes to the syntax table for this buffer.
+These changes are active only while the buffer is being flexed.
+This is a list where each element has the form:
+  (CHAR CLASS)
+CHAR is the char passed to `modify-syntax-entry',
+and CLASS is the string also passed to `modify-syntax-entry' to define
+what syntax class CHAR has.")
+(make-variable-buffer-local 'semantic-flex-syntax-modifications)
+
+(defvar semantic-ignore-comments t
+  "Default comment handling.
+t means to strip comments when flexing.  Nil means to keep comments
+as part of the token stream.")
+(make-variable-buffer-local 'semantic-ignore-comments)
+
+(defvar semantic-flex-enable-newlines nil
+  "When flexing, report 'newlines as syntactic elements.
+Useful for languages where the newline is a special case terminator.
+Only set this on a per mode basis, not globally.")
+(make-variable-buffer-local 'semantic-flex-enable-newlines)
+
+(defvar semantic-flex-enable-whitespace nil
+  "When flexing, report 'whitespace as syntactic elements.
+Useful for languages where the syntax is whitespace dependent.
+Only set this on a per mode basis, not globally.")
+(make-variable-buffer-local 'semantic-flex-enable-whitespace)
+
+(defvar semantic-flex-enable-bol nil
+  "When flexing, report beginning of lines as syntactic elements.
+Useful for languages like python which are indentation sensitive.
+Only set this on a per mode basis, not globally.")
+(make-variable-buffer-local 'semantic-flex-enable-bol)
+
+(defvar semantic-number-expression semantic-lex-number-expression
+  "See variable `semantic-lex-number-expression'.")
+(make-variable-buffer-local 'semantic-number-expression)
+
+(defvar semantic-flex-depth 0
+  "Default flexing depth.
+This specifies how many lists to create tokens in.")
+(make-variable-buffer-local 'semantic-flex-depth)
+
+(defun semantic-flex (start end &optional depth length)
+  "Using the syntax table, do something roughly equivalent to flex.
+Semantically check between START and END.  Optional argument DEPTH
+indicates at what level to scan over entire lists.
+The return value is a token stream.  Each element is a list, such of
+the form (symbol start-expression .  end-expression) where SYMBOL
+denotes the token type.
+See `semantic-flex-tokens' variable for details on token types.
+END does not mark the end of the text scanned, only the end of the
+beginning of text scanned.  Thus, if a string extends past END, the
+end of the return token will be larger than END.  To truly restrict
+scanning, use `narrow-to-region'.
+The last argument, LENGTH specifies that `semantic-flex' should only
+return LENGTH tokens."
+  (message "`semantic-flex' is an obsolete function.  Use `define-lex' to create lexers.")
+  (if (not semantic-flex-keywords-obarray)
+      (setq semantic-flex-keywords-obarray [ nil ]))
+  (let ((ts nil)
+        (pos (point))
+        (ep nil)
+        (curdepth 0)
+        (cs (if comment-start-skip
+                (concat "\\(\\s<\\|" comment-start-skip "\\)")
+              (concat "\\(\\s<\\)")))
+        (newsyntax (copy-syntax-table (syntax-table)))
+        (mods semantic-flex-syntax-modifications)
+        ;; Use the default depth if it is not specified.
+        (depth (or depth semantic-flex-depth)))
+    ;; Update the syntax table
+    (while mods
+      (modify-syntax-entry (car (car mods)) (car (cdr (car mods))) newsyntax)
+      (setq mods (cdr mods)))
+    (with-syntax-table newsyntax
+      (goto-char start)
+      (while (and (< (point) end) (or (not length) (<= (length ts) length)))
+        (cond
+         ;; catch beginning of lines when needed.
+         ;; Must be done before catching any other tokens!
+         ((and semantic-flex-enable-bol
+               (bolp)
+               ;; Just insert a (bol N . N) token in the token stream,
+               ;; without moving the point.  N is the point at the
+               ;; beginning of line.
+               (setq ts (cons (cons 'bol (cons (point) (point))) ts))
+               nil)) ;; CONTINUE
+         ;; special extensions, includes whitespace, nl, etc.
+         ((and semantic-flex-extensions
+               (let ((fe semantic-flex-extensions)
+                     (r nil))
+                 (while fe
+                   (if (looking-at (car (car fe)))
+                       (setq ts (cons (funcall (cdr (car fe))) ts)
+                             r t
+                             fe nil
+                             ep (point)))
+                   (setq fe (cdr fe)))
+                 (if (and r (not (car ts))) (setq ts (cdr ts)))
+                 r)))
+         ;; catch newlines when needed
+         ((looking-at "\\s-*\\(\n\\|\\s>\\)")
+          (if semantic-flex-enable-newlines
+              (setq ep (match-end 1)
+                    ts (cons (cons 'newline
+                                   (cons (match-beginning 1) ep))
+                             ts))))
+         ;; catch whitespace when needed
+         ((looking-at "\\s-+")
+          (if semantic-flex-enable-whitespace
+              ;; Language wants whitespaces, link them together.
+              (if (eq (car (car ts)) 'whitespace)
+                  (setcdr (cdr (car ts)) (match-end 0))
+                (setq ts (cons (cons 'whitespace
+                                     (cons (match-beginning 0)
+                                           (match-end 0)))
+                               ts)))))
+         ;; numbers
+         ((and semantic-number-expression
+               (looking-at semantic-number-expression))
+          (setq ts (cons (cons 'number
+                               (cons (match-beginning 0)
+                                     (match-end 0)))
+                         ts)))
+         ;; symbols
+         ((looking-at "\\(\\sw\\|\\s_\\)+")
+          (setq ts (cons (cons
+                          ;; Get info on if this is a keyword or not
+                          (or (semantic-flex-keyword-p (match-string 0))
+                              'symbol)
+                          (cons (match-beginning 0) (match-end 0)))
+                         ts)))
+         ;; Character quoting characters (ie, \n as newline)
+         ((looking-at "\\s\\+")
+          (setq ts (cons (cons 'charquote
+                               (cons (match-beginning 0) (match-end 0)))
+                         ts)))
+         ;; Open parens, or semantic-lists.
+         ((looking-at "\\s(")
+          (if (or (not depth) (< curdepth depth))
+              (progn
+                (setq curdepth (1+ curdepth))
+                (setq ts (cons (cons 'open-paren
+                                     (cons (match-beginning 0) (match-end 0)))
+                               ts)))
+            (setq ts (cons
+                      (cons 'semantic-list
+                            (cons (match-beginning 0)
+                                  (save-excursion
+                                    (condition-case nil
+                                        (forward-list 1)
+                                      ;; This case makes flex robust
+                                      ;; to broken lists.
+                                      (error
+                                       (goto-char
+                                        (funcall
+                                         semantic-flex-unterminated-syntax-end-function
+                                         'semantic-list
+                                         start end))))
+                                    (setq ep (point)))))
+                      ts))))
+         ;; Close parens
+         ((looking-at "\\s)")
+          (setq ts (cons (cons 'close-paren
+                               (cons (match-beginning 0) (match-end 0)))
+                         ts))
+          (setq curdepth (1- curdepth)))
+         ;; String initiators
+         ((looking-at "\\s\"")
+          ;; Zing to the end of this string.
+          (setq ts (cons (cons 'string
+                               (cons (match-beginning 0)
+                                     (save-excursion
+                                       (condition-case nil
+                                           (forward-sexp 1)
+                                         ;; This case makes flex
+                                         ;; robust to broken strings.
+                                         (error
+                                          (goto-char
+                                           (funcall
+                                            semantic-flex-unterminated-syntax-end-function
+                                            'string
+                                            start end))))
+                                       (setq ep (point)))))
+                         ts)))
+         ;; comments
+         ((looking-at cs)
+          (if (and semantic-ignore-comments
+                   (not semantic-flex-enable-whitespace))
+              ;; If the language doesn't deal with comments nor
+              ;; whitespaces, ignore them here.
+              (let ((comment-start-point (point)))
+                (forward-comment 1)
+                (if (eq (point) comment-start-point)
+                    ;; In this case our start-skip string failed
+                    ;; to work properly.  Lets try and move over
+                    ;; whatever white space we matched to begin
+                    ;; with.
+                    (skip-syntax-forward "-.'"
+                                         (save-excursion
+                                           (end-of-line)
+                                           (point)))
+                  ;;(forward-comment 1)
+                  ;; Generate newline token if enabled
+                  (if (and semantic-flex-enable-newlines
+                           (bolp))
+                      (backward-char 1)))
+                (if (eq (point) comment-start-point)
+                    (error "Strange comment syntax prevents lexical analysis"))
+                (setq ep (point)))
+            (let ((tk (if semantic-ignore-comments 'whitespace 'comment)))
+              (save-excursion
+                (forward-comment 1)
+                ;; Generate newline token if enabled
+                (if (and semantic-flex-enable-newlines
+                         (bolp))
+                    (backward-char 1))
+                (setq ep (point)))
+              ;; Language wants comments or want them as whitespaces,
+              ;; link them together.
+              (if (eq (car (car ts)) tk)
+                  (setcdr (cdr (car ts)) ep)
+                (setq ts (cons (cons tk (cons (match-beginning 0) ep))
+                               ts))))))
+         ;; punctuation
+         ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
+          (setq ts (cons (cons 'punctuation
+                               (cons (match-beginning 0) (match-end 0)))
+                         ts)))
+         ;; unknown token
+         (t
+          (error "What is that?")))
+        (goto-char (or ep (match-end 0)))
+        (setq ep nil)))
+    ;; maybe catch the last beginning of line when needed
+    (and semantic-flex-enable-bol
+         (= (point) end)
+         (bolp)
+         (setq ts (cons (cons 'bol (cons (point) (point))) ts)))
+    (goto-char pos)
+    ;;(message "Flexing muscles...done")
+    (nreverse ts)))
+
+(provide 'semantic-lex)
+
+;;; semantic-lex.el ends here
diff --git a/lisp/cedet/semantic-tag.el b/lisp/cedet/semantic-tag.el
new file mode 100644 (file)
index 0000000..afd3333
--- /dev/null
@@ -0,0 +1,1569 @@
+;;; semantic-tag.el --- tag creation and access
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 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:
+;;
+;; I.  The core production of semantic is the list of tags produced by the
+;;    different parsers.  This file provides 3 APIs related to tag access:
+;;
+;;    1) Primitive Tag Access
+;;       There is a set of common features to all tags.  These access
+;;       functions can get these values.
+;;    2) Standard Tag Access
+;;       A Standard Tag should be produced by most traditional languages
+;;       with standard styles common to typed object oriented languages.
+;;       These functions can access these data elements from a tag.
+;;    3) Generic Tag Access
+;;       Access to tag structure in a more direct way.
+;;         ** May not be forward compatible.
+;;
+;; II.  There is also an API for tag creation.  Use `semantic-tag' to create
+;;     a new tag.
+;;
+;; III.  Tag Comparison.  Allows explicit or comparitive tests to see
+;;      if two tags are the same.
+
+;;; History:
+;;
+
+;;; Code:
+;;
+
+;; Keep this only so long as we have obsolete fcns.
+(require 'semantic-fw)
+
+(defconst semantic-tag-version semantic-version
+  "Version string of semantic tags made with this code.")
+
+(defconst semantic-tag-incompatible-version "1.0"
+  "Version string of semantic tags which are not currently compatible.
+These old style tags may be loaded from a file with semantic db.
+In this case, we must flush the old tags and start over.")
+\f
+;;; Primitive Tag access system:
+;;
+;; Raw tags in semantic are lists of 5 elements:
+;;
+;;   (NAME CLASS ATTRIBUTES PROPERTIES OVERLAY)
+;;
+;; Where:
+;;
+;;   - NAME is a string that represents the tag name.
+;;
+;;   - CLASS is a symbol that represent the class of the tag (for
+;;     example, usual classes are `type', `function', `variable',
+;;     `include', `package', `code').
+;;
+;;   - ATTRIBUTES is a public list of attributes that describes
+;;     language data represented by the tag (for example, a variable
+;;     can have a `:constant-flag' attribute, a function an `:arguments'
+;;     attribute, etc.).
+;;
+;;   - PROPERTIES is a private list of properties used internally.
+;;
+;;   - OVERLAY represent the location of data described by the tag.
+;;
+
+(defsubst semantic-tag-name (tag)
+  "Return the name of TAG.
+For functions, variables, classes, typedefs, etc., this is the identifier
+that is being defined.  For tags without an obvious associated name, this
+may be the statement type, e.g., this may return @code{print} for python's
+print statement."
+  (car tag))
+
+(defsubst semantic-tag-class (tag)
+  "Return the class of TAG.
+That is, the symbol 'variable, 'function, 'type, or other.
+There is no limit to the symbols that may represent the class of a tag.
+Each parser generates tags with classes defined by it.
+
+For functional languages, typical tag classes are:
+
+@table @code
+@item type
+Data types, named map for a memory block.
+@item function
+A function or method, or named execution location.
+@item variable
+A variable, or named storage for data.
+@item include
+Statement that represents a file from which more tags can be found.
+@item package
+Statement that declairs this file's package name.
+@item code
+Code that has not name or binding to any other symbol, such as in a script.
+@end table
+"
+  (nth 1 tag))
+
+(defsubst semantic-tag-attributes (tag)
+  "Return the list of public attributes of TAG.
+That is a property list: (ATTRIBUTE-1 VALUE-1 ATTRIBUTE-2 VALUE-2...)."
+  (nth 2 tag))
+
+(defsubst semantic-tag-properties (tag)
+  "Return the list of private properties of TAG.
+That is a property list: (PROPERTY-1 VALUE-1 PROPERTY-2 VALUE-2...)."
+  (nth 3 tag))
+
+(defsubst semantic-tag-overlay (tag)
+  "Return the OVERLAY part of TAG.
+That is, an overlay or an unloaded buffer representation.
+This function can also return an array of the form [ START END ].
+This occurs for tags that are not currently linked into a buffer."
+  (nth 4 tag))
+
+(defsubst semantic--tag-overlay-cdr (tag)
+  "Return the cons cell whose car is the OVERLAY part of TAG.
+That function is for internal use only."
+  (nthcdr 4 tag))
+
+(defsubst semantic--tag-set-overlay (tag overlay)
+  "Set the overlay part of TAG with OVERLAY.
+That function is for internal use only."
+  (setcar (semantic--tag-overlay-cdr tag) overlay))
+
+(defsubst semantic-tag-start (tag)
+  "Return the start location of TAG."
+  (let ((o (semantic-tag-overlay tag)))
+    (if (semantic-overlay-p o)
+        (semantic-overlay-start o)
+      (aref o 0))))
+
+(defsubst semantic-tag-end (tag)
+  "Return the end location of TAG."
+  (let ((o (semantic-tag-overlay tag)))
+    (if (semantic-overlay-p o)
+        (semantic-overlay-end o)
+      (aref o 1))))
+
+(defsubst semantic-tag-bounds (tag)
+  "Return the location (START END) of data TAG describes."
+  (list (semantic-tag-start tag)
+        (semantic-tag-end tag)))
+
+(defun semantic-tag-set-bounds (tag start end)
+  "In TAG, set the START and END location of data it describes."
+  (let ((o (semantic-tag-overlay tag)))
+    (if (semantic-overlay-p o)
+        (semantic-overlay-move o start end)
+      (semantic--tag-set-overlay tag (vector start end)))))
+
+(defun semantic-tag-in-buffer-p (tag)
+  "Return the buffer TAG resides in IFF tag is already in a buffer.
+If a tag is not in a buffer, return nil."
+  (let ((o (semantic-tag-overlay tag)))
+     ;; TAG is currently linked to a buffer, return it.
+    (when (and (semantic-overlay-p o)
+              (semantic-overlay-live-p o))
+      (semantic-overlay-buffer o))))
+
+(defsubst semantic--tag-get-property (tag property)
+  "From TAG, extract the value of PROPERTY.
+Return the value found, or nil if PROPERTY is not one of the
+properties of TAG.
+That function is for internal use only."
+  (plist-get (semantic-tag-properties tag) property))
+
+(defun semantic-tag-buffer (tag)
+  "Return the buffer TAG resides in.
+If TAG has an originating file, read that file into a (maybe new)
+buffer, and return it.
+Return nil if there is no buffer for this tag."
+  (let ((buff (semantic-tag-in-buffer-p tag)))
+    (if buff
+       buff
+      ;; TAG has an originating file, read that file into a buffer, and
+      ;; return it.
+     (if (semantic--tag-get-property tag :filename)
+        (find-file-noselect (semantic--tag-get-property tag :filename))
+       ;; TAG is not in Emacs right now, no buffer is available.
+       ))))
+
+(defun semantic-tag-mode (&optional tag)
+  "Return the major mode active for TAG.
+TAG defaults to the tag at point in current buffer.
+If TAG has a :mode property return it.
+If point is inside TAG bounds, return the major mode active at point.
+Return the major mode active at beginning of TAG otherwise.
+See also the function `semantic-ctxt-current-mode'."
+  (or tag (setq tag (semantic-current-tag)))
+  (or (semantic--tag-get-property tag :mode)
+      (let ((buffer (semantic-tag-buffer tag))
+            (start (semantic-tag-start tag))
+            (end   (semantic-tag-end tag)))
+        (save-excursion
+          (and buffer (set-buffer buffer))
+          ;; Unless point is inside TAG bounds, move it to the
+          ;; beginning of TAG.
+          (or (and (>= (point) start) (< (point) end))
+              (goto-char start))
+          (require 'semantic-ctxt)
+          (semantic-ctxt-current-mode)))))
+
+(defsubst semantic--tag-attributes-cdr (tag)
+  "Return the cons cell whose car is the ATTRIBUTES part of TAG.
+That function is for internal use only."
+  (nthcdr 2 tag))
+
+(defsubst semantic-tag-put-attribute (tag attribute value)
+  "Change value in TAG of ATTRIBUTE to VALUE.
+If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
+new ATTRIBUTE VALUE pair is added.
+Return TAG.
+Use this function in a parser when not all attributes are known at the
+same time."
+  (let* ((plist-cdr (semantic--tag-attributes-cdr tag)))
+    (when (consp plist-cdr)
+      (setcar plist-cdr
+              (semantic-tag-make-plist
+               (plist-put (car plist-cdr) attribute value))))
+    tag))
+
+(defun semantic-tag-put-attribute-no-side-effect (tag attribute value)
+  "Change value in TAG of ATTRIBUTE to VALUE without side effects.
+All cons cells in the attribute list are replicated so that there
+are no side effects if TAG is in shared lists.
+If ATTRIBUTE already exists, its value is set to VALUE, otherwise the
+new ATTRIBUTE VALUE pair is added.
+Return TAG."
+  (let* ((plist-cdr (semantic--tag-attributes-cdr tag)))
+    (when (consp plist-cdr)
+      (setcar plist-cdr
+              (semantic-tag-make-plist
+               (plist-put (copy-sequence (car plist-cdr))
+                          attribute value))))
+    tag))
+
+(defsubst semantic-tag-get-attribute (tag attribute)
+  "From TAG, return the value of ATTRIBUTE.
+ATTRIBUTE is a symbol whose specification value to get.
+Return the value found, or nil if ATTRIBUTE is not one of the
+attributes of TAG."
+  (plist-get (semantic-tag-attributes tag) attribute))
+
+;; These functions are for internal use only!
+(defsubst semantic--tag-properties-cdr (tag)
+  "Return the cons cell whose car is the PROPERTIES part of TAG.
+That function is for internal use only."
+  (nthcdr 3 tag))
+
+(defun semantic--tag-put-property (tag property value)
+  "Change value in TAG of PROPERTY to VALUE.
+If PROPERTY already exists, its value is set to VALUE, otherwise the
+new PROPERTY VALUE pair is added.
+Return TAG.
+That function is for internal use only."
+  (let* ((plist-cdr (semantic--tag-properties-cdr tag)))
+    (when (consp plist-cdr)
+      (setcar plist-cdr
+              (semantic-tag-make-plist
+               (plist-put (car plist-cdr) property value))))
+    tag))
+
+(defun semantic--tag-put-property-no-side-effect (tag property value)
+  "Change value in TAG of PROPERTY to VALUE without side effects.
+All cons cells in the property list are replicated so that there
+are no side effects if TAG is in shared lists.
+If PROPERTY already exists, its value is set to VALUE, otherwise the
+new PROPERTY VALUE pair is added.
+Return TAG.
+That function is for internal use only."
+  (let* ((plist-cdr (semantic--tag-properties-cdr tag)))
+    (when (consp plist-cdr)
+      (setcar plist-cdr
+              (semantic-tag-make-plist
+               (plist-put (copy-sequence (car plist-cdr))
+                          property value))))
+    tag))
+
+(defun semantic-tag-file-name (tag)
+  "Return the name of the file from which TAG originated.
+Return nil if that information can't be obtained.
+If TAG is from a loaded buffer, then that buffer's filename is used.
+If TAG is unlinked, but has a :filename property, then that is used."
+  (let ((buffer (semantic-tag-in-buffer-p tag)))
+    (if buffer
+        (buffer-file-name buffer)
+      (semantic--tag-get-property tag :filename))))
+\f
+;;; Tag tests and comparisons.
+;;
+;;;###autoload
+(defsubst semantic-tag-p (tag)
+  "Return non-nil if TAG is most likely a semantic tag."
+  (condition-case nil
+      (and (consp tag)
+          (stringp (car tag))                ; NAME
+          (symbolp (nth 1 tag)) (nth 1 tag)  ; TAG-CLASS
+          (listp (nth 2 tag))                ; ATTRIBUTES
+          (listp (nth 3 tag))                ; PROPERTIES
+          )
+    ;; If an error occurs, then it most certainly is not a tag.
+    (error nil)))
+
+(defsubst semantic-tag-of-class-p (tag class)
+  "Return non-nil if class of TAG is CLASS."
+  (eq (semantic-tag-class tag) class))
+
+(defsubst semantic-tag-type-members (tag)
+  "Return the members of the type that TAG describes.
+That is the value of the `:members' attribute."
+  (semantic-tag-get-attribute tag :members))
+
+(defun semantic-tag-with-position-p (tag)
+  "Return non-nil if TAG has positional information."
+  (and (semantic-tag-p tag)
+       (let ((o (semantic-tag-overlay tag)))
+        (or (and (semantic-overlay-p o)
+                 (semantic-overlay-live-p o))
+             (arrayp o)))))
+
+(defun semantic-equivalent-tag-p (tag1 tag2)
+  "Compare TAG1 and TAG2 and return non-nil if they are equivalent.
+Use `equal' on elements the name, class, and position.
+Use this function if tags are being copied and regrouped to test
+for if two tags represent the same thing, but may be constructed
+of different cons cells."
+  (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
+       (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
+       (or (and (not (semantic-tag-overlay tag1))
+               (not (semantic-tag-overlay tag2)))
+          (and (semantic-tag-overlay tag1)
+               (semantic-tag-overlay tag2)
+               (equal (semantic-tag-bounds tag1)
+                      (semantic-tag-bounds tag2))))))
+
+(defsubst semantic-tag-type (tag)
+  "Return the value of the `:type' attribute of TAG.
+For a function it would be the data type of the return value.
+For a variable, it is the storage type of that variable.
+For a data type, the type is the style of datatype, such as
+struct or union."
+  (semantic-tag-get-attribute tag :type))
+
+(defun semantic-tag-similar-p (tag1 tag2 &rest ignorable-attributes)
+  "Test to see if TAG1 and TAG2 are similar.
+Two tags are similar if their name, datatype, and various attributes
+are the same.
+
+Similar tags that have sub-tags such as arg lists or type members,
+are similar w/out checking the sub-list of tags.
+Optional argument IGNORABLE-ATTRIBUTES are attributes to ignore while comparing similarity."
+  (let* ((A1 (and (equal (semantic-tag-name tag1) (semantic-tag-name tag2))
+                 (semantic-tag-of-class-p tag1 (semantic-tag-class tag2))
+                 (semantic-tag-of-type-p tag1 (semantic-tag-type tag2))))
+        (attr1 (semantic-tag-attributes tag1))
+        (A2 (= (length attr1) (length (semantic-tag-attributes tag2))))
+        (A3 t)
+        )
+    (when (and (not A2) ignorable-attributes)
+      (setq A2 t))
+    (while (and A2 attr1 A3)
+      (let ((a (car attr1))
+           (v (car (cdr attr1))))
+
+       (cond ((or (eq a :type) ;; already tested above.
+                  (memq a ignorable-attributes)) ;; Ignore them...
+              nil)
+
+             ;; Don't test sublists of tags
+             ((and (listp v) (semantic-tag-p (car v)))
+              nil)
+
+             ;; The attributes are not the same?
+             ((not (equal v (semantic-tag-get-attribute tag2 a)))
+              (setq A3 nil))
+             (t
+              nil))
+       )
+      (setq attr1 (cdr (cdr attr1))))
+
+    (and A1 A2 A3)
+    ))
+
+(defun semantic-tag-similar-with-subtags-p (tag1 tag2 &rest ignorable-attributes)
+  "Test to see if TAG1 and TAG2 are similar.
+Uses `semantic-tag-similar-p' but also recurses through sub-tags, such
+as argument lists and type members.
+Optional argument IGNORABLE-ATTRIBUTES is passed down to
+`semantic-tag-similar-p'."
+  (let ((C1 (semantic-tag-components tag1))
+       (C2 (semantic-tag-components tag2))
+       )
+    (if (or (/= (length C1) (length C2))
+           (not (semantic-tag-similar-p tag1 tag2 ignorable-attributes))
+           )
+       ;; Basic test fails.
+       nil
+      ;; Else, check component lists.
+      (catch 'component-dissimilar
+       (while C1
+
+         (if (not (semantic-tag-similar-with-subtags-p
+                   (car C1) (car C2) ignorable-attributes))
+             (throw 'component-dissimilar nil))
+
+         (setq C1 (cdr C1))
+         (setq C2 (cdr C2))
+         )
+       ;; If we made it this far, we are ok.
+       t) )))
+
+
+(defun semantic-tag-of-type-p (tag type)
+  "Compare TAG's type against TYPE.  Non nil if equivalent.
+TYPE can be a string, or a tag of class 'type.
+This can be complex since some tags might have a :type that is a tag,
+while other tags might just have a string.  This function will also be
+return true of TAG's type is compared directly to the declaration of a
+data type."
+  (let* ((tagtype (semantic-tag-type tag))
+        (tagtypestring (cond ((stringp tagtype)
+                              tagtype)
+                             ((and (semantic-tag-p tagtype)
+                                   (semantic-tag-of-class-p tagtype 'type))
+                              (semantic-tag-name tagtype))
+                             (t "")))
+        (typestring (cond ((stringp type)
+                           type)
+                          ((and (semantic-tag-p type)
+                                (semantic-tag-of-class-p type 'type))
+                           (semantic-tag-name type))
+                          (t "")))
+        )
+    (and
+     tagtypestring
+     (or
+      ;; Matching strings (input type is string)
+      (and (stringp type)
+          (string= tagtypestring type))
+      ;; Matching strings (tag type is string)
+      (and (stringp tagtype)
+          (string= tagtype typestring))
+      ;; Matching tokens, and the type of the type is the same.
+      (and (string= tagtypestring typestring)
+          (if (and (semantic-tag-type tagtype) (semantic-tag-type type))
+              (equal (semantic-tag-type tagtype) (semantic-tag-type type))
+            t))
+      ))
+    ))
+
+(defun semantic-tag-type-compound-p (tag)
+  "Return non-nil the type of TAG is compound.
+Compound implies a structure or similar data type.
+Returns the list of tag members if it is compound."
+  (let* ((tagtype (semantic-tag-type tag))
+        )
+    (when (and (semantic-tag-p tagtype)
+              (semantic-tag-of-class-p tagtype 'type))
+      ;; We have the potential of this being a nifty compound type.
+      (semantic-tag-type-members tagtype)
+      )))
+
+(defun semantic-tag-faux-p (tag)
+  "Return non-nil if TAG is a FAUX tag.
+FAUX tags are created to represent a construct that is
+not known to exist in the code.
+
+Example: When the class browser sees methods to a class, but
+cannot find the class, it will create a faux tag to represent the
+class to store those methods."
+  (semantic--tag-get-property tag :faux-flag))
+\f
+;;; Tag creation
+;;
+
+;; Is this function still necessary?
+(defun semantic-tag-make-plist (args)
+  "Create a property list with ARGS.
+Args is a property list of the form (KEY1 VALUE1 ... KEYN VALUEN).
+Where KEY is a symbol, and VALUE is the value for that symbol.
+The return value will be a new property list, with these KEY/VALUE
+pairs eliminated:
+
+  - KEY associated to nil VALUE.
+  - KEY associated to an empty string VALUE.
+  - KEY associated to a zero VALUE."
+  (let (plist key val)
+    (while args
+      (setq key  (car args)
+            val  (nth 1 args)
+            args (nthcdr 2 args))
+      (or (member val '("" nil))
+          (and (numberp val) (zerop val))
+          (setq plist (cons key (cons val plist)))))
+    ;; It is not useful to reverse the new plist.
+    plist))
+
+(defsubst semantic-tag (name class &rest attributes)
+  "Create a generic semantic tag.
+NAME is a string representing the name of this tag.
+CLASS is the symbol that represents the class of tag this is,
+such as 'variable, or 'function.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (list name class (semantic-tag-make-plist attributes) nil nil))
+
+(defsubst semantic-tag-new-variable (name type &optional default-value &rest attributes)
+  "Create a semantic tag of class 'variable.
+NAME is the name of this variable.
+TYPE is a string or semantic tag representing the type of this variable.
+Optional DEFAULT-VALUE is a string representing the default value of this variable.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'variable
+         :type type
+         :default-value default-value
+         attributes))
+
+(defsubst semantic-tag-new-function (name type arg-list &rest attributes)
+  "Create a semantic tag of class 'function.
+NAME is the name of this function.
+TYPE is a string or semantic tag representing the type of this function.
+ARG-LIST is a list of strings or semantic tags representing the
+arguments of this function.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'function
+         :type type
+         :arguments arg-list
+         attributes))
+
+(defsubst semantic-tag-new-type (name type members parents &rest attributes)
+  "Create a semantic tag of class 'type.
+NAME is the name of this type.
+TYPE is a string or semantic tag representing the type of this type.
+MEMBERS is a list of strings or semantic tags representing the
+elements that make up this type if it is a composite type.
+PARENTS is a cons cell.  (EXPLICIT-PARENTS . INTERFACE-PARENTS)
+EXPLICIT-PARENTS can be a single string (Just one parent) or a
+list of parents (in a multiple inheritance situation).  It can also
+be nil.
+INTERFACE-PARENTS is a list of strings representing the names of
+all INTERFACES, or abstract classes inherited from.  It can also be
+nil.
+This slot can be interesting because the form:
+     ( nil \"string\")
+is a valid parent where there is no explicit parent, and only an
+interface.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'type
+         :type type
+         :members members
+         :superclasses (car parents)
+         :interfaces (cdr parents)
+         attributes))
+
+(defsubst semantic-tag-new-include (name system-flag &rest attributes)
+  "Create a semantic tag of class 'include.
+NAME is the name of this include.
+SYSTEM-FLAG represents that we were able to identify this include as belonging
+to the system, as opposed to belonging to the local project.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'include
+         :system-flag system-flag
+         attributes))
+
+(defsubst semantic-tag-new-package (name detail &rest attributes)
+  "Create a semantic tag of class 'package.
+NAME is the name of this package.
+DETAIL is extra information about this package, such as a location where
+it can be found.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'package
+         :detail detail
+         attributes))
+
+(defsubst semantic-tag-new-code (name detail &rest attributes)
+  "Create a semantic tag of class 'code.
+NAME is a name for this code.
+DETAIL is extra information about the code.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'code
+         :detail detail
+         attributes))
+
+(defsubst semantic-tag-set-faux (tag)
+  "Set TAG to be a new FAUX tag.
+FAUX tags represent constructs not found in the source code.
+You can identify a faux tag with `semantic-tag-faux-p'"
+  (semantic--tag-put-property tag :faux-flag t))
+
+(defsubst semantic-tag-set-name (tag name)
+  "Set TAG name to NAME."
+  (setcar tag name))
+
+;;; Copying and cloning tags.
+;;
+(defsubst semantic-tag-clone (tag &optional name)
+  "Clone TAG, creating a new TAG.
+If optional argument NAME is not nil it specifies a new name for the
+cloned tag."
+  ;; Right now, TAG is a list.
+  (list (or name (semantic-tag-name tag))
+        (semantic-tag-class tag)
+        (copy-sequence (semantic-tag-attributes tag))
+        (copy-sequence (semantic-tag-properties tag))
+        (semantic-tag-overlay tag)))
+
+(defun semantic-tag-copy (tag &optional name keep-file)
+  "Return a copy of TAG unlinked from the originating buffer.
+If optional argument NAME is non-nil it specifies a new name for the
+copied tag.
+If optional argument KEEP-FILE is non-nil, and TAG was linked to a
+buffer, the originating buffer file name is kept in the `:filename'
+property of the copied tag.
+If KEEP-FILE is a string, and the orginating buffer is NOT available,
+then KEEP-FILE is stored on the `:filename' property.
+This runs the tag hook `unlink-copy-hook`."
+  ;; Right now, TAG is a list.
+  (let ((copy (semantic-tag-clone tag name)))
+
+    ;; Keep the filename if needed.
+    (when keep-file
+      (semantic--tag-put-property
+       copy :filename (or (semantic-tag-file-name copy)
+                         (and (stringp keep-file)
+                              keep-file)
+                         )))
+
+    (when (semantic-tag-with-position-p tag)
+      ;; Convert the overlay to a vector, effectively 'unlinking' the tag.
+      (semantic--tag-set-overlay
+       copy (vector (semantic-tag-start copy) (semantic-tag-end copy)))
+
+      ;; Force the children to be copied also.
+      ;;(let ((chil (semantic--tag-copy-list
+      ;;            (semantic-tag-components-with-overlays tag)
+      ;;            keep-file)))
+      ;;;; Put the list into TAG.
+      ;;)
+
+      ;; Call the unlink-copy hook.  This should tell tools that
+      ;; this tag is not part of any buffer.
+      (when (semantic-overlay-p (semantic-tag-overlay tag))
+       (semantic--tag-run-hooks copy 'unlink-copy-hook))
+      )
+    copy))
+
+;;(defun semantic--tag-copy-list (tags &optional keep-file)
+;;  "Make copies of TAGS and return the list of TAGS."
+;;  (let ((out nil))
+;;    (dolist (tag tags out)
+;;      (setq out (cons (semantic-tag-copy tag nil keep-file)
+;;                   out))
+;;      )))
+
+(defun semantic--tag-copy-properties (tag1 tag2)
+  "Copy private properties from TAG1 to TAG2.
+Return TAG2.
+This function is for internal use only."
+  (let ((plist (semantic-tag-properties tag1)))
+    (while plist
+      (semantic--tag-put-property tag2 (car plist) (nth 1 plist))
+      (setq plist (nthcdr 2 plist)))
+    tag2))
+
+;;; DEEP COPIES
+;;
+(defun semantic-tag-deep-copy-one-tag (tag &optional filter)
+  "Make a deep copy of TAG, applying FILTER to each child-tag.
+Properties and overlay info are not copied.
+FILTER takes TAG as an argument, and should returns a semantic-tag.
+It is safe for FILTER to modify the input tag and return it."
+  (when (not filter) (setq filter 'identity))
+  (when (not (semantic-tag-p tag))
+    (signal 'wrong-type-argument (list tag 'semantic-tag-p)))
+  (funcall filter (list (semantic-tag-name tag)
+                        (semantic-tag-class tag)
+                        (semantic--tag-deep-copy-attributes
+                        (semantic-tag-attributes tag) filter)
+                        nil
+                        nil)))
+
+(defun semantic--tag-deep-copy-attributes (attrs &optional filter)
+  "Make a deep copy of ATTRS, applying FILTER to each child-tag.
+
+It is safe to modify ATTR, and return a permutaion of that list.
+
+FILTER takes TAG as an argument, and should returns a semantic-tag.
+It is safe for FILTER to modify the input tag and return it."
+  (when (car attrs)
+    (when (not (symbolp (car attrs))) (error "Bad Attribute List in tag"))
+    (cons (car attrs)
+          (cons (semantic--tag-deep-copy-value (nth 1 attrs) filter)
+                (semantic--tag-deep-copy-attributes (nthcdr 2 attrs) filter)))))
+
+(defun semantic--tag-deep-copy-value (value &optional filter)
+  "Make a deep copy of VALUE, applying FILTER to each child-tag.
+
+It is safe to  modify VALUE, and return a permutaion of that list.
+
+FILTER takes TAG as an argument, and should returns a semantic-tag.
+It is safe for FILTER to modify the input tag and return it."
+  (cond
+   ;; Another tag.
+   ((semantic-tag-p value)
+    (semantic-tag-deep-copy-one-tag value filter))
+
+   ;; A list of more tags
+   ((and (listp value) (semantic-tag-p (car value)))
+    (semantic--tag-deep-copy-tag-list value filter))
+
+   ;; Some arbitrary data.
+   (t value)))
+
+(defun semantic--tag-deep-copy-tag-list (tags &optional filter)
+  "Make a deep copy of TAGS, applying FILTER to each child-tag.
+
+It is safe to modify the TAGS list, and return a permutaion of that list.
+
+FILTER takes TAG as an argument, and should returns a semantic-tag.
+It is safe for FILTER to modify the input tag and return it."
+  (when (car tags)
+    (if (semantic-tag-p (car tags))
+        (cons (semantic-tag-deep-copy-one-tag (car tags) filter)
+              (semantic--tag-deep-copy-tag-list (cdr tags) filter))
+      (cons (car tags) (semantic--tag-deep-copy-tag-list (cdr tags) filter)))))
+
+\f
+;;; Standard Tag Access
+;;
+
+;;; Common
+;;
+
+(defsubst semantic-tag-modifiers (tag)
+  "Return the value of the `:typemodifiers' attribute of TAG."
+  (semantic-tag-get-attribute tag :typemodifiers))
+
+(defun semantic-tag-docstring (tag &optional buffer)
+  "Return the documentation of TAG.
+That is the value defined by the `:documentation' attribute.
+Optional argument BUFFER indicates where to get the text from.
+If not provided, then only the POSITION can be provided.
+
+If you want to get documentation for languages that do not store
+the documentation string in the tag itself, use
+`semantic-documentation-for-tag' instead."
+  (let ((p (semantic-tag-get-attribute tag :documentation)))
+    (cond
+     ((stringp p) p) ;; it is the doc string.
+
+     ((semantic-lex-token-with-text-p p)
+      (semantic-lex-token-text p))
+
+     ((and (semantic-lex-token-without-text-p p)
+          buffer)
+      (with-current-buffer buffer
+       (semantic-lex-token-text (car (semantic-lex p (1+ p))))))
+
+     (t nil))))
+
+;;; Generic attributes for tags of any class.
+;;
+(defsubst semantic-tag-named-parent (tag)
+  "Return the parent of TAG.
+That is the value of the `:parent' attribute.
+If a definition can occur outside an actual parent structure, but
+refers to that parent by name, then the :parent attribute should be used."
+  (semantic-tag-get-attribute tag :parent))
+
+;;; Tags of class `type'
+
+(defun semantic-tag-type-superclasses (tag)
+  "Return the list of superclass names of the type that TAG describes."
+  (let ((supers (semantic-tag-get-attribute tag :superclasses)))
+    (cond ((stringp supers)
+          ;; If we have a string, make it a list.
+          (list supers))
+         ((semantic-tag-p supers)
+          ;; If we have one tag, return just the name.
+          (list (semantic-tag-name supers)))
+         ((and (consp supers) (semantic-tag-p (car supers)))
+          ;; If we have a tag list, then return the names.
+          (mapcar (lambda (s) (semantic-tag-name s))
+                  supers))
+         ((consp supers)
+          ;; A list of something, return it.
+          supers))))
+
+(defun semantic--tag-find-parent-by-name (name supers)
+  "Find the superclass NAME in the list of SUPERS.
+If a simple search doesn't do it, try splitting up the names
+in SUPERS."
+  (let ((stag nil))
+    (setq stag (semantic-find-first-tag-by-name name supers))
+
+    (when (not stag)
+      (dolist (S supers)
+       (let* ((sname (semantic-tag-name S))
+              (splitparts (semantic-analyze-split-name sname))
+              (parts (if (stringp splitparts)
+                         (list splitparts)
+                       (nreverse splitparts))))
+         (when (string= name (car parts))
+           (setq stag S))
+         )))
+
+    stag))
+
+(defun semantic-tag-type-superclass-protection (tag parentstring)
+  "Return the inheritance protection in TAG from PARENTSTRING.
+PARENTSTRING is the name of the parent being inherited.
+The return protection is a symbol, 'public, 'protection, and 'private."
+  (let ((supers (semantic-tag-get-attribute tag :superclasses)))
+    (cond ((stringp supers)
+          'public)
+         ((semantic-tag-p supers)
+          (let ((prot (semantic-tag-get-attribute supers :protection)))
+            (or (cdr (assoc prot '(("public" . public)
+                                   ("protected" . protected)
+                                   ("private" . private))))
+                'public)))
+         ((and (consp supers) (stringp (car supers)))
+          'public)
+         ((and (consp supers) (semantic-tag-p (car supers)))
+          (let* ((stag (semantic--tag-find-parent-by-name parentstring supers))
+                 (prot (when stag
+                         (semantic-tag-get-attribute stag :protection))))
+            (or (cdr (assoc prot '(("public" . public)
+                                   ("protected" . protected)
+                                   ("private" . private))))
+                (when (equal prot "unspecified")
+                  (if (semantic-tag-of-type-p tag "class")
+                      'private
+                    'public))
+                'public))))
+    ))
+
+(defsubst semantic-tag-type-interfaces (tag)
+  "Return the list of interfaces of the type that TAG describes."
+  ;; @todo - make this as robust as the above.
+  (semantic-tag-get-attribute tag :interfaces))
+
+;;; Tags of class `function'
+;;
+(defsubst semantic-tag-function-arguments (tag)
+  "Return the arguments of the function that TAG describes.
+That is the value of the `:arguments' attribute."
+  (semantic-tag-get-attribute tag :arguments))
+
+(defsubst semantic-tag-function-throws (tag)
+  "Return the exceptions the function that TAG describes can throw.
+That is the value of the `:throws' attribute."
+  (semantic-tag-get-attribute tag :throws))
+
+(defsubst semantic-tag-function-parent (tag)
+  "Return the parent of the function that TAG describes.
+That is the value of the `:parent' attribute.
+A function has a parent if it is a method of a class, and if the
+function does not appear in body of it's parent class."
+  (semantic-tag-named-parent tag))
+
+(defsubst semantic-tag-function-destructor-p (tag)
+  "Return non-nil if TAG describes a destructor function.
+That is the value of the `:destructor-flag' attribute."
+  (semantic-tag-get-attribute tag :destructor-flag))
+
+(defsubst semantic-tag-function-constructor-p (tag)
+  "Return non-nil if TAG describes a constructor function.
+That is the value of the `:constructor-flag' attribute."
+  (semantic-tag-get-attribute tag :constructor-flag))
+
+;;; Tags of class `variable'
+;;
+(defsubst semantic-tag-variable-default (tag)
+  "Return the default value of the variable that TAG describes.
+That is the value of the attribute `:default-value'."
+  (semantic-tag-get-attribute tag :default-value))
+
+(defsubst semantic-tag-variable-constant-p (tag)
+  "Return non-nil if the variable that TAG describes is a constant.
+That is the value of the attribute `:constant-flag'."
+  (semantic-tag-get-attribute tag :constant-flag))
+
+;;; Tags of class `include'
+;;
+(defsubst semantic-tag-include-system-p (tag)
+  "Return non-nil if the include that TAG describes is a system include.
+That is the value of the attribute `:system-flag'."
+  (semantic-tag-get-attribute tag :system-flag))
+
+(define-overloadable-function semantic-tag-include-filename (tag)
+  "Return a filename representation of TAG.
+The default action is to return the `semantic-tag-name'.
+Some languages do not use full filenames in their include statements.
+Override this method to translate the code represenation
+into a filename.  (A relative filename if necessary.)
+
+See `semantic-dependency-tag-file' to expand an include
+tag to a full file name.")
+
+(defun semantic-tag-include-filename-default (tag)
+  "Return a filename representation of TAG.
+Returns `semantic-tag-name'."
+  (semantic-tag-name tag))
+
+;;; Tags of class `code'
+;;
+(defsubst semantic-tag-code-detail (tag)
+  "Return detail information from code that TAG describes.
+That is the value of the attribute `:detail'."
+  (semantic-tag-get-attribute tag :detail))
+
+;;; Tags of class `alias'
+;;
+(defsubst semantic-tag-new-alias (name meta-tag-class value &rest attributes)
+  "Create a semantic tag of class alias.
+NAME is a name for this alias.
+META-TAG-CLASS is the class of the tag this tag is an alias.
+VALUE is the aliased definition.
+ATTRIBUTES is a list of additional attributes belonging to this tag."
+  (apply 'semantic-tag name 'alias
+         :aliasclass meta-tag-class
+         :definition value
+         attributes))
+
+(defsubst semantic-tag-alias-class (tag)
+  "Return the class of tag TAG is an alias."
+  (semantic-tag-get-attribute tag :aliasclass))
+
+;;;###autoload
+(define-overloadable-function semantic-tag-alias-definition (tag)
+  "Return the definition TAG is an alias.
+The returned value is a tag of the class that
+`semantic-tag-alias-class' returns for TAG.
+The default is to return the value of the :definition attribute.
+Return nil if TAG is not of class 'alias."
+  (when (semantic-tag-of-class-p tag 'alias)
+    (:override
+     (semantic-tag-get-attribute tag :definition))))
+
+;;; Language Specific Tag access via overload
+;;
+;;;###autoload
+(define-overloadable-function semantic-tag-components (tag)
+  "Return a list of components for TAG.
+A Component is a part of TAG which itself may be a TAG.
+Examples include the elements of a structure in a
+tag of class `type, or the list of arguments to a
+tag of class 'function."
+  )
+
+(defun semantic-tag-components-default (tag)
+  "Return a list of components for TAG.
+Perform the described task in `semantic-tag-components'."
+  (cond ((semantic-tag-of-class-p tag 'type)
+        (semantic-tag-type-members tag))
+       ((semantic-tag-of-class-p tag 'function)
+        (semantic-tag-function-arguments tag))
+       (t nil)))
+
+;;;###autoload
+(define-overloadable-function semantic-tag-components-with-overlays (tag)
+  "Return the list of top level components belonging to TAG.
+Children are any sub-tags which contain overlays.
+
+Default behavior is to get `semantic-tag-components' in addition
+to the components of an anonymous types (if applicable.)
+
+Note for language authors:
+  If a mode defines a language tag that has tags in it with overlays
+you should still return them with this function.
+Ignoring this step will prevent several features from working correctly."
+  )
+
+(defun semantic-tag-components-with-overlays-default (tag)
+  "Return the list of top level components belonging to TAG.
+Children are any sub-tags which contain overlays.
+The default action collects regular components of TAG, in addition
+to any components beloning to an anonymous type."
+  (let ((explicit-children (semantic-tag-components tag))
+       (type (semantic-tag-type tag))
+       (anon-type-children nil)
+       (all-children nil))
+    ;; Identify if this tag has an anonymous structure as
+    ;; its type.  This implies it may have children with overlays.
+    (when (and type (semantic-tag-p type))
+      (setq anon-type-children (semantic-tag-components type))
+      ;; Add anonymous children
+      (while anon-type-children
+       (when (semantic-tag-with-position-p (car anon-type-children))
+         (setq all-children (cons (car anon-type-children) all-children)))
+       (setq anon-type-children (cdr anon-type-children))))
+    ;; Add explicit children
+    (while explicit-children
+      (when (semantic-tag-with-position-p (car explicit-children))
+       (setq all-children (cons (car explicit-children) all-children)))
+      (setq explicit-children (cdr explicit-children)))
+    ;; Return
+    (nreverse all-children)))
+
+(defun semantic-tag-children-compatibility (tag &optional positiononly)
+  "Return children of TAG.
+If POSITIONONLY is nil, use `semantic-tag-components'.
+If POSITIONONLY is non-nil, use `semantic-tag-components-with-overlays'.
+DO NOT use this fcn in new code.  Use one of the above instead."
+  (if positiononly
+      (semantic-tag-components-with-overlays tag)
+    (semantic-tag-components tag)))
+\f
+;;; Tag Region
+;;
+;; A Tag represents a region in a buffer.  You can narrow to that tag.
+;;
+(defun semantic-narrow-to-tag (&optional tag)
+  "Narrow to the region specified by the bounds of TAG.
+See `semantic-tag-bounds'."
+  (interactive)
+  (if (not tag) (setq tag (semantic-current-tag)))
+  (narrow-to-region (semantic-tag-start tag)
+                   (semantic-tag-end tag)))
+
+(defmacro semantic-with-buffer-narrowed-to-current-tag (&rest body)
+  "Execute BODY with the buffer narrowed to the current tag."
+  `(save-restriction
+     (semantic-narrow-to-tag (semantic-current-tag))
+     ,@body))
+(put 'semantic-with-buffer-narrowed-to-current-tag 'lisp-indent-function 0)
+(add-hook 'edebug-setup-hook
+         (lambda ()
+           (def-edebug-spec semantic-with-buffer-narrowed-to-current-tag
+             (def-body))))
+
+(defmacro semantic-with-buffer-narrowed-to-tag (tag &rest body)
+  "Narrow to TAG, and execute BODY."
+  `(save-restriction
+     (semantic-narrow-to-tag ,tag)
+     ,@body))
+(put 'semantic-with-buffer-narrowed-to-tag 'lisp-indent-function 1)
+(add-hook 'edebug-setup-hook
+         (lambda ()
+           (def-edebug-spec semantic-with-buffer-narrowed-to-tag
+             (def-body))))
+\f
+;;; Tag Hooks
+;;
+;; Semantic may want to provide special hooks when specific operations
+;; are about to happen on a given tag.  These routines allow for hook
+;; maintenance on a tag.
+
+;; Internal global variable used to manage tag hooks.  For example,
+;; some implementation of `remove-hook' checks that the hook variable
+;; is `default-boundp'.
+(defvar semantic--tag-hook-value)
+
+(defun semantic-tag-add-hook (tag hook function &optional append)
+  "Onto TAG, add to the value of HOOK the function FUNCTION.
+FUNCTION is added (if necessary) at the beginning of the hook list
+unless the optional argument APPEND is non-nil, in which case
+FUNCTION is added at the end.
+HOOK should be a symbol, and FUNCTION may be any valid function.
+See also the function `add-hook'."
+  (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)))
+    (add-hook 'semantic--tag-hook-value function append)
+    (semantic--tag-put-property tag hook semantic--tag-hook-value)
+    semantic--tag-hook-value))
+
+(defun semantic-tag-remove-hook (tag hook function)
+  "Onto TAG, remove from the value of HOOK the function FUNCTION.
+HOOK should be a symbol, and FUNCTION may be any valid function.  If
+FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in
+the list of hooks to run in HOOK, then nothing is done.
+See also the function `remove-hook'."
+  (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook)))
+    (remove-hook 'semantic--tag-hook-value function)
+    (semantic--tag-put-property tag hook semantic--tag-hook-value)
+    semantic--tag-hook-value))
+
+(defun semantic--tag-run-hooks (tag hook &rest args)
+  "Run for TAG all expressions saved on the property HOOK.
+Each hook expression must take at least one argument, the TAG.
+For any given situation, additional ARGS may be passed."
+  (let ((semantic--tag-hook-value (semantic--tag-get-property tag hook))
+       (arglist (cons tag args)))
+    (condition-case err
+       ;; If a hook bombs, ignore it!  Usually this is tied into
+       ;; some sort of critical system.
+       (apply 'run-hook-with-args 'semantic--tag-hook-value arglist)
+      (error (message "Error: %S" err)))))
+\f
+;;; Tags and Overlays
+;;
+;; Overlays are used so that we can quickly identify tags from
+;; buffer positions and regions using built in Emacs commands.
+;;
+
+(defsubst semantic--tag-unlink-list-from-buffer (tags)
+  "Convert TAGS from using an overlay to using an overlay proxy.
+This function is for internal use only."
+  (mapcar 'semantic--tag-unlink-from-buffer tags))
+
+(defun semantic--tag-unlink-from-buffer (tag)
+  "Convert TAG from using an overlay to using an overlay proxy.
+This function is for internal use only."
+  (when (semantic-tag-p tag)
+    (let ((o (semantic-tag-overlay tag)))
+      (when (semantic-overlay-p o)
+        (semantic--tag-set-overlay
+         tag (vector (semantic-overlay-start o)
+                     (semantic-overlay-end o)))
+        (semantic-overlay-delete o))
+      ;; Look for a link hook on TAG.
+      (semantic--tag-run-hooks tag 'unlink-hook)
+      ;; Fix the sub-tags which contain overlays.
+      (semantic--tag-unlink-list-from-buffer
+       (semantic-tag-components-with-overlays tag)))))
+
+(defsubst semantic--tag-link-list-to-buffer (tags)
+  "Convert TAGS from using an overlay proxy to using an overlay.
+This function is for internal use only."
+  (mapcar 'semantic--tag-link-to-buffer tags))
+
+(defun semantic--tag-link-to-buffer (tag)
+  "Convert TAG from using an overlay proxy to using an overlay.
+This function is for internal use only."
+  (when (semantic-tag-p tag)
+    (let ((o (semantic-tag-overlay tag)))
+      (when (and (vectorp o) (= (length o) 2))
+        (setq o (semantic-make-overlay (aref o 0) (aref o 1)
+                                       (current-buffer)))
+        (semantic--tag-set-overlay tag o)
+        (semantic-overlay-put o 'semantic tag)
+        ;; Clear the :filename property
+        (semantic--tag-put-property tag :filename nil))
+      ;; Look for a link hook on TAG.
+      (semantic--tag-run-hooks tag 'link-hook)
+      ;; Fix the sub-tags which contain overlays.
+      (semantic--tag-link-list-to-buffer
+       (semantic-tag-components-with-overlays tag)))))
+
+(defun semantic--tag-unlink-cache-from-buffer ()
+  "Convert all tags in the current cache to use overlay proxys.
+This function is for internal use only."
+  (semantic--tag-unlink-list-from-buffer
+   ;; @todo- use fetch-tags-fast?
+   (semantic-fetch-tags)))
+
+(defvar semantic--buffer-cache)
+
+(defun semantic--tag-link-cache-to-buffer ()
+  "Convert all tags in the current cache to use overlays.
+This function is for internal use only."
+  (condition-case nil
+      ;; In this unique case, we cannot call the usual toplevel fn.
+      ;; because we don't want a reparse, we want the old overlays.
+      (semantic--tag-link-list-to-buffer
+       semantic--buffer-cache)
+    ;; Recover when there is an error restoring the cache.
+    (error (message "Error recovering tag list")
+           (semantic-clear-toplevel-cache)
+           nil)))
+\f
+;;; Tag Cooking
+;;
+;; Raw tags from a parser follow a different positional format than
+;; those used in the buffer cache.  Raw tags need to be cooked into
+;; semantic cache friendly tags for use by the masses.
+;;
+(defsubst semantic--tag-expanded-p (tag)
+  "Return non-nil if TAG is expanded.
+This function is for internal use only.
+See also the function `semantic--expand-tag'."
+  ;; In fact a cooked tag is actually a list of cooked tags
+  ;; because a raw tag can be expanded in several cooked ones!
+  (when (consp tag)
+    (while (and (semantic-tag-p (car tag))
+                (vectorp (semantic-tag-overlay (car tag))))
+      (setq tag (cdr tag)))
+    (null tag)))
+
+(defvar semantic-tag-expand-function nil
+  "Function used to expand a tag.
+It is passed each tag production, and must return a list of tags
+derived from it, or nil if it does not need to be expanded.
+
+Languages with compound definitions should use this function to expand
+from one compound symbol into several.  For example, in C or Java the
+following definition is easily parsed into one tag:
+
+  int a, b;
+
+This function should take this compound tag and turn it into two tags,
+one for A, and the other for B.")
+(make-variable-buffer-local 'semantic-tag-expand-function)
+
+(defun semantic--tag-expand (tag)
+  "Convert TAG from a raw state to a cooked state, and expand it.
+Returns a list of cooked tags.
+
+  The parser returns raw tags with positional data START END at the
+end of the tag data structure (a list for now).  We convert it from
+that to a cooked state that uses an overlay proxy, that is, a vector
+\[START END].
+
+  The raw tag is changed with side effects and maybe expanded in
+several derived tags when the variable `semantic-tag-expand-function'
+is set.
+
+This function is for internal use only."
+  (if (semantic--tag-expanded-p tag)
+      ;; Just return TAG if it is already expanded (by a grammar
+      ;; semantic action), or if it isn't recognized as a valid
+      ;; semantic tag.
+      tag
+
+    ;; Try to cook the tag.  This code will be removed when tag will
+    ;; be directly created with the right format.
+    (condition-case nil
+        (let ((ocdr (semantic--tag-overlay-cdr tag)))
+          ;; OCDR contains the sub-list of TAG whose car is the
+          ;; OVERLAY part of TAG. That is, a list (OVERLAY START END).
+          ;; Convert it into an overlay proxy ([START END]).
+          (semantic--tag-set-overlay
+           tag (vector (nth 1 ocdr) (nth 2 ocdr)))
+          ;; Remove START END positions at end of tag.
+          (setcdr ocdr nil)
+          ;; At this point (length TAG) must be 5!
+          ;;(unless (= (length tag) 5)
+          ;;  (error "Tag expansion failed"))
+          )
+      (error
+       (message "A Rule must return a single tag-line list!")
+       (debug tag)
+       nil))
+
+;;    @todo - I think we've waited long enough.  Lets find out.
+;;
+;;    ;; Compatibility code to be removed in future versions.
+;;    (unless semantic-tag-expand-function
+;;      ;; This line throws a byte compiler warning.
+;;      (setq semantic-tag-expand-function semantic-expand-nonterminal)
+;;      )
+
+    ;; Expand based on local configuration
+    (if semantic-tag-expand-function
+        (or (funcall semantic-tag-expand-function tag)
+            (list tag))
+      (list tag))))
+\f
+;; Foreign tags
+;;
+(defmacro semantic-foreign-tag-invalid (tag)
+  "Signal that TAG is an invalid foreign tag."
+  `(signal 'wrong-type-argument '(semantic-foreign-tag-p ,tag)))
+
+(defsubst semantic-foreign-tag-p (tag)
+  "Return non-nil if TAG is a foreign tag.
+That is, a tag unlinked from the originating buffer, which carries the
+originating buffer file name, and major mode."
+  (and (semantic-tag-p tag)
+       (semantic--tag-get-property tag :foreign-flag)))
+
+(defsubst semantic-foreign-tag-check (tag)
+  "Check that TAG is a valid foreign tag.
+Signal an error if not."
+  (or (semantic-foreign-tag-p tag)
+      (semantic-foreign-tag-invalid tag)))
+
+(defun semantic-foreign-tag (&optional tag)
+  "Return a copy of TAG as a foreign tag, or nil if it can't be done.
+TAG defaults to the tag at point in current buffer.
+See also `semantic-foreign-tag-p'."
+  (or tag (setq tag (semantic-current-tag)))
+  (when (semantic-tag-p tag)
+    (let ((ftag (semantic-tag-copy tag nil t))
+         ;; Do extra work for the doc strings, since this is a
+         ;; common use case.
+         (doc (condition-case nil
+                  (semantic-documentation-for-tag tag)
+                (error nil))))
+      ;; A foreign tag must carry its originating buffer file name!
+      (when (semantic--tag-get-property ftag :filename)
+        (semantic--tag-put-property ftag :mode (semantic-tag-mode tag))
+       (semantic--tag-put-property ftag :documentation doc)
+        (semantic--tag-put-property ftag :foreign-flag t)
+        ftag))))
+
+;; High level obtain/insert foreign tag overloads
+;;
+;;;###autoload
+(define-overloadable-function semantic-obtain-foreign-tag (&optional tag)
+  "Obtain a foreign tag from TAG.
+TAG defaults to the tag at point in current buffer.
+Return the obtained foreign tag or nil if failed."
+  (semantic-foreign-tag tag))
+
+(defun semantic-insert-foreign-tag-default (foreign-tag)
+  "Insert FOREIGN-TAG into the current buffer.
+The default behavior assumes the current buffer is a language file,
+and attempts to insert a prototype/function call."
+  ;; Long term goal: Have a mechanism for a tempo-like template insert
+  ;; for the given tag.
+  (insert (semantic-format-tag-prototype foreign-tag)))
+
+;;;###autoload
+(define-overloadable-function semantic-insert-foreign-tag (foreign-tag)
+  "Insert FOREIGN-TAG into the current buffer.
+Signal an error if FOREIGN-TAG is not a valid foreign tag.
+This function is overridable with the symbol `insert-foreign-tag'."
+  (semantic-foreign-tag-check foreign-tag)
+  (:override)
+  (message (semantic-format-tag-summarize foreign-tag)))
+
+;;; Support log modes here
+(define-mode-local-override semantic-insert-foreign-tag
+  log-edit-mode (foreign-tag)
+  "Insert foreign tags into log-edit mode."
+  (insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
+
+(define-mode-local-override semantic-insert-foreign-tag
+  change-log-mode (foreign-tag)
+  "Insert foreign tags into log-edit mode."
+  (insert (concat "(" (semantic-format-tag-name foreign-tag) "): ")))
+
+\f
+;;; EDEBUG display support
+;;
+(eval-after-load "cedet-edebug"
+  '(progn
+     (cedet-edebug-add-print-override
+      '(semantic-tag-p object)
+      '(concat "#<TAG " (semantic-format-tag-name object) ">"))
+     (cedet-edebug-add-print-override
+      '(and (listp object) (semantic-tag-p (car object)))
+      '(cedet-edebug-prin1-recurse object))
+     ))
+\f
+;;; Compatibility
+;;
+(defconst semantic-token-version
+  semantic-tag-version)
+(defconst semantic-token-incompatible-version
+  semantic-tag-incompatible-version)
+
+(semantic-alias-obsolete 'semantic-token-name
+                         'semantic-tag-name)
+
+(semantic-alias-obsolete 'semantic-token-token
+                         'semantic-tag-class)
+
+(semantic-alias-obsolete 'semantic-token-extra-specs
+                         'semantic-tag-attributes)
+
+(semantic-alias-obsolete 'semantic-token-properties
+                         'semantic-tag-properties)
+
+(semantic-alias-obsolete 'semantic-token-properties-cdr
+                         'semantic--tag-properties-cdr)
+
+(semantic-alias-obsolete 'semantic-token-overlay
+                         'semantic-tag-overlay)
+
+(semantic-alias-obsolete 'semantic-token-overlay-cdr
+                         'semantic--tag-overlay-cdr)
+
+(semantic-alias-obsolete 'semantic-token-start
+                         'semantic-tag-start)
+
+(semantic-alias-obsolete 'semantic-token-end
+                         'semantic-tag-end)
+
+(semantic-alias-obsolete 'semantic-token-extent
+                         'semantic-tag-bounds)
+
+(semantic-alias-obsolete 'semantic-token-buffer
+                         'semantic-tag-buffer)
+
+(semantic-alias-obsolete 'semantic-token-put
+                         'semantic--tag-put-property)
+
+(semantic-alias-obsolete 'semantic-token-put-no-side-effect
+                         'semantic--tag-put-property-no-side-effect)
+
+(semantic-alias-obsolete 'semantic-token-get
+                         'semantic--tag-get-property)
+
+(semantic-alias-obsolete 'semantic-token-add-extra-spec
+                         'semantic-tag-put-attribute)
+
+(semantic-alias-obsolete 'semantic-token-extra-spec
+                         'semantic-tag-get-attribute)
+
+(semantic-alias-obsolete 'semantic-token-type
+                         'semantic-tag-type)
+
+(semantic-alias-obsolete 'semantic-token-modifiers
+                         'semantic-tag-modifiers)
+
+(semantic-alias-obsolete 'semantic-token-docstring
+                         'semantic-tag-docstring)
+
+(semantic-alias-obsolete 'semantic-token-type-parts
+                         'semantic-tag-type-members)
+
+(defsubst semantic-token-type-parent (tag)
+  "Return the parent of the type that TAG describes.
+The return value is a list.  A value of nil means no parents.
+The `car' of the list is either the parent class, or a list
+of parent classes.  The `cdr' of the list is the list of
+interfaces, or abstract classes which are parents of TAG."
+  (cons (semantic-tag-get-attribute tag :superclasses)
+        (semantic-tag-type-interfaces tag)))
+(make-obsolete 'semantic-token-type-parent
+              "\
+use `semantic-tag-type-superclass' \
+and `semantic-tag-type-interfaces' instead")
+
+(semantic-alias-obsolete 'semantic-token-type-parent-superclass
+                         'semantic-tag-type-superclasses)
+
+(semantic-alias-obsolete 'semantic-token-type-parent-implement
+                         'semantic-tag-type-interfaces)
+
+(semantic-alias-obsolete 'semantic-token-type-extra-specs
+                         'semantic-tag-attributes)
+
+(semantic-alias-obsolete 'semantic-token-type-extra-spec
+                         'semantic-tag-get-attribute)
+
+(semantic-alias-obsolete 'semantic-token-type-modifiers
+                         'semantic-tag-modifiers)
+
+(semantic-alias-obsolete 'semantic-token-function-args
+                         'semantic-tag-function-arguments)
+
+(semantic-alias-obsolete 'semantic-token-function-extra-specs
+                         'semantic-tag-attributes)
+
+(semantic-alias-obsolete 'semantic-token-function-extra-spec
+                         'semantic-tag-get-attribute)
+
+(semantic-alias-obsolete 'semantic-token-function-modifiers
+                         'semantic-tag-modifiers)
+
+(semantic-alias-obsolete 'semantic-token-function-throws
+                         'semantic-tag-function-throws)
+
+(semantic-alias-obsolete 'semantic-token-function-parent
+                         'semantic-tag-function-parent)
+
+(semantic-alias-obsolete 'semantic-token-function-destructor
+                         'semantic-tag-function-destructor-p)
+
+(semantic-alias-obsolete 'semantic-token-variable-default
+                        'semantic-tag-variable-default)
+
+(semantic-alias-obsolete 'semantic-token-variable-extra-specs
+                         'semantic-tag-attributes)
+
+(semantic-alias-obsolete 'semantic-token-variable-extra-spec
+                         'semantic-tag-get-attribute)
+
+(semantic-alias-obsolete 'semantic-token-variable-modifiers
+                         'semantic-tag-modifiers)
+
+(semantic-alias-obsolete 'semantic-token-variable-const
+                         'semantic-tag-variable-constant-p)
+
+(semantic-alias-obsolete 'semantic-token-variable-optsuffix
+                         'semantic-tag-variable-optsuffix)
+
+(semantic-alias-obsolete 'semantic-token-include-system
+                         'semantic-tag-include-system-p)
+
+(semantic-alias-obsolete 'semantic-token-p
+                         'semantic-tag-p)
+
+(semantic-alias-obsolete 'semantic-token-with-position-p
+                         'semantic-tag-with-position-p)
+
+(semantic-alias-obsolete 'semantic-tag-make-assoc-list
+                         'semantic-tag-make-plist)
+
+(semantic-alias-obsolete 'semantic-nonterminal-children
+                        'semantic-tag-children-compatibility)
+
+(semantic-alias-obsolete 'semantic-narrow-to-token
+                        'semantic-narrow-to-tag)
+
+(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-current-token
+                        'semantic-with-buffer-narrowed-to-current-tag)
+
+(semantic-alias-obsolete 'semantic-with-buffer-narrowed-to-token
+                        'semantic-with-buffer-narrowed-to-tag)
+
+(semantic-alias-obsolete 'semantic-deoverlay-token
+                         'semantic--tag-unlink-from-buffer)
+
+(semantic-alias-obsolete 'semantic-overlay-token
+                         'semantic--tag-link-to-buffer)
+
+(semantic-alias-obsolete 'semantic-deoverlay-list
+                         'semantic--tag-unlink-list-from-buffer)
+
+(semantic-alias-obsolete 'semantic-overlay-list
+                         'semantic--tag-link-list-to-buffer)
+
+(semantic-alias-obsolete 'semantic-deoverlay-cache
+                         'semantic--tag-unlink-cache-from-buffer)
+
+(semantic-alias-obsolete 'semantic-overlay-cache
+                         'semantic--tag-link-cache-to-buffer)
+
+(semantic-alias-obsolete 'semantic-cooked-token-p
+                         'semantic--tag-expanded-p)
+
+(semantic-varalias-obsolete 'semantic-expand-nonterminal
+                            'semantic-tag-expand-function)
+
+(semantic-alias-obsolete 'semantic-raw-to-cooked-token
+                         'semantic--tag-expand)
+
+;; Lets test this out during this short transition.
+(semantic-alias-obsolete 'semantic-clone-tag
+                         'semantic-tag-clone)
+
+(semantic-alias-obsolete 'semantic-token
+                         'semantic-tag)
+
+(semantic-alias-obsolete 'semantic-token-new-variable
+                         'semantic-tag-new-variable)
+
+(semantic-alias-obsolete 'semantic-token-new-function
+                         'semantic-tag-new-function)
+
+(semantic-alias-obsolete 'semantic-token-new-type
+                         'semantic-tag-new-type)
+
+(semantic-alias-obsolete 'semantic-token-new-include
+                         'semantic-tag-new-include)
+
+(semantic-alias-obsolete 'semantic-token-new-package
+                         'semantic-tag-new-package)
+
+(semantic-alias-obsolete 'semantic-equivalent-tokens-p
+                         'semantic-equivalent-tag-p)
+
+(provide 'semantic-tag)
+
+;;; semantic-tag.el ends here
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
new file mode 100644 (file)
index 0000000..7b7748b
--- /dev/null
@@ -0,0 +1,845 @@
+;;; semantic.el --- Semantic buffer evaluator.
+
+;;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;; 2007, 2008, 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:
+;;
+;; API for providing the semantic content of a buffer.
+;;
+;; The semantic API provides an interface to a series of different parser
+;; implementations.  Each parser outputs a parse tree in a similar format
+;; designed to handle typical functional and object oriented languages.
+
+(eval-and-compile
+  ;; Other package depend on this value at compile time via inversion.
+  (defvar semantic-version "2.0pre7"
+    "Current version of Semantic."))
+
+;; (require 'working)
+(require 'assoc)
+(require 'semantic-tag)
+(require 'semantic-lex)
+
+(declare-function inversion-test "inversion")
+
+(defun semantic-require-version (major minor &optional beta)
+  "Non-nil if this version of semantic does not satisfy a specific version.
+Arguments can be:
+
+  (MAJOR MINOR &optional BETA)
+
+  Values MAJOR and MINOR must be integers.  BETA can be an integer, or
+excluded if a released version is required.
+
+It is assumed that if the current version is newer than that specified,
+everything passes.  Exceptions occur when known incompatibilities are
+introduced."
+  (require 'inversion)
+  (inversion-test 'semantic
+                 (concat major "." minor
+                         (when beta (concat "beta" beta)))))
+
+(defgroup semantic nil
+  "Parser Generator and parser framework."
+  :group 'lisp)
+
+(defgroup semantic-faces nil
+  "Faces used for Semantic enabled tools."
+  :group 'semantic)
+
+(require 'semantic-fw)
+
+;;; Code:
+;;
+
+;;; Variables and Configuration
+;;
+(defvar semantic--parse-table nil
+  "Variable that defines how to parse top level items in a buffer.
+This variable is for internal use only, and its content depends on the
+external parser used.")
+(make-variable-buffer-local 'semantic--parse-table)
+(semantic-varalias-obsolete 'semantic-toplevel-bovine-table
+                           'semantic--parse-table)
+
+(defvar semantic-symbol->name-assoc-list
+  '((type     . "Types")
+    (variable . "Variables")
+    (function . "Functions")
+    (include  . "Dependencies")
+    (package  . "Provides"))
+  "Association between symbols returned, and a string.
+The string is used to represent a group of objects of the given type.
+It is sometimes useful for a language to use a different string
+in place of the default, even though that language will still
+return a symbol.  For example, Java return's includes, but the
+string can be replaced with `Imports'.")
+(make-variable-buffer-local 'semantic-symbol->name-assoc-list)
+
+(defvar semantic-symbol->name-assoc-list-for-type-parts nil
+  "Like `semantic-symbol->name-assoc-list' for type parts.
+Some tags that have children (see `semantic-tag-children-compatibility')
+will want to define the names of classes of tags differently than at
+the top level.  For example, in C++, a Function may be called a
+Method.  In addition, there may be new types of tags that exist only
+in classes, such as protection labels.")
+(make-variable-buffer-local 'semantic-symbol->name-assoc-list-for-type-parts)
+
+(defvar semantic-case-fold nil
+  "Value for `case-fold-search' when parsing.")
+(make-variable-buffer-local 'semantic-case-fold)
+
+(defvar semantic-expand-nonterminal nil
+  "Function to call for each nonterminal production.
+Return a list of non-terminals derived from the first argument, or nil
+if it does not need to be expanded.
+Languages with compound definitions should use this function to expand
+from one compound symbol into several.  For example, in C the definition
+  int a, b;
+is easily parsed into one tag.  This function should take this
+compound tag and turn it into two tags, one for A, and the other for B.")
+(make-variable-buffer-local 'semantic-expand-nonterminal)
+
+(defvar semantic--buffer-cache nil
+  "A cache of the fully parsed buffer.
+If no significant changes have been made (based on the state) then
+this is returned instead of re-parsing the buffer.
+
+  DO NOT USE THIS VARIABLE IN PROGRAMS.
+
+If you need a tag list, use `semantic-fetch-tags'.  If you need the
+cached values for some reason, chances are you can, add a hook to
+`semantic-after-toplevel-cache-change-hook'.")
+(make-variable-buffer-local 'semantic--buffer-cache)
+(semantic-varalias-obsolete 'semantic-toplevel-bovine-cache
+                           'semantic--buffer-cache)
+
+(defvar semantic-unmatched-syntax-cache nil
+  "A cached copy of unmatched syntax tokens.")
+(make-variable-buffer-local 'semantic-unmatched-syntax-cache)
+
+(defvar semantic-unmatched-syntax-cache-check nil
+  "Non nil if the unmatched syntax cache is out of date.
+This is tracked with `semantic-change-function'.")
+(make-variable-buffer-local 'semantic-unmatched-syntax-cache-check)
+
+(defvar semantic-edits-are-safe nil
+  "When non-nil, modifications do not require a reparse.
+This prevents tags from being marked dirty, and it prevents top level
+edits from causing a cache check.
+Use this when writing programs that could cause a full reparse, but
+will not change the tag structure, such as adding or updating
+`top-level' comments.")
+
+(defvar semantic-unmatched-syntax-hook nil
+  "Hooks run when semantic detects syntax not matched in a grammar.
+Each individual piece of syntax (such as a symbol or punctuation
+character) is called with this hook when it doesn't match in the
+grammar, and multiple unmatched syntax elements are not grouped
+together.  Each hook is called with one argument, which is a list of
+syntax tokens created by the semantic lexer.  Use the functions
+`semantic-lex-token-start', `semantic-lex-token-end' and
+`semantic-lex-token-text' to get information about these tokens.  The
+current buffer is the buffer these tokens are derived from.")
+
+(defvar semantic--before-fetch-tags-hook nil
+  "Hooks run before a buffer is parses for tags.
+It is called before any request for tags is made via the function
+`semantic-fetch-tags' by an application.
+If any hook returns a nil value, the cached value is returned
+immediately, even if it is empty.")
+(semantic-varalias-obsolete 'semantic-before-toplevel-bovination-hook
+                           'semantic--before-fetch-tags-hook)
+
+(defvar semantic-after-toplevel-bovinate-hook nil
+  "Hooks run after a toplevel parse.
+It is not run if the toplevel parse command is called, and buffer does
+not need to be fully reparsed.
+For language specific hooks, make sure you define this as a local hook.
+
+This hook should not be used any more.
+Use `semantic-after-toplevel-cache-change-hook' instead.")
+(make-obsolete-variable 'semantic-after-toplevel-bovinate-hook nil)
+
+(defvar semantic-after-toplevel-cache-change-hook nil
+  "Hooks run after the buffer tag list has changed.
+This list will change when a buffer is reparsed, or when the tag list
+in a buffer is cleared.  It is *NOT* called if the current tag list is
+partially reparsed.
+
+Hook functions must take one argument, which is the new list of tags
+associated with this buffer.
+
+For language specific hooks, make sure you define this as a local hook.")
+
+(defvar semantic-before-toplevel-cache-flush-hook nil
+  "Hooks run before the toplevel tag cache is flushed.
+For language specific hooks, make sure you define this as a local
+hook.  This hook is called before a corresponding
+`semantic-after-toplevel-cache-change-hook' which is also called
+during a flush when the cache is given a new value of nil.")
+
+(defcustom semantic-dump-parse nil
+  "When non-nil, dump parsing information."
+  :group 'semantic
+  :type 'boolean)
+
+(defvar semantic-parser-name "LL"
+  "Optional name of the parser used to parse input stream.")
+(make-variable-buffer-local 'semantic-parser-name)
+\f
+;;; Parse tree state management API
+;;
+(defvar semantic-parse-tree-state 'needs-rebuild
+  "State of the current parse tree.")
+(make-variable-buffer-local 'semantic-parse-tree-state)
+
+(defmacro semantic-parse-tree-unparseable ()
+  "Indicate that the current buffer is unparseable.
+It is also true that the parse tree will need either updating or
+a rebuild.  This state will be changed when the user edits the buffer."
+  `(setq semantic-parse-tree-state 'unparseable))
+
+(defmacro semantic-parse-tree-unparseable-p ()
+  "Return non-nil if the current buffer has been marked unparseable."
+  `(eq semantic-parse-tree-state 'unparseable))
+
+(defmacro semantic-parse-tree-set-needs-update ()
+  "Indicate that the current parse tree needs to be updated.
+The parse tree can be updated by `semantic-parse-changes'."
+  `(setq semantic-parse-tree-state 'needs-update))
+
+(defmacro semantic-parse-tree-needs-update-p ()
+  "Return non-nil if the current parse tree needs to be updated."
+  `(eq semantic-parse-tree-state 'needs-update))
+
+(defmacro semantic-parse-tree-set-needs-rebuild ()
+  "Indicate that the current parse tree needs to be rebuilt.
+The parse tree must be rebuilt by `semantic-parse-region'."
+  `(setq semantic-parse-tree-state 'needs-rebuild))
+
+(defmacro semantic-parse-tree-needs-rebuild-p ()
+  "Return non-nil if the current parse tree needs to be rebuilt."
+  `(eq semantic-parse-tree-state 'needs-rebuild))
+
+(defmacro semantic-parse-tree-set-up-to-date ()
+  "Indicate that the current parse tree is up to date."
+  `(setq semantic-parse-tree-state nil))
+
+(defmacro semantic-parse-tree-up-to-date-p ()
+  "Return non-nil if the current parse tree is up to date."
+  `(null semantic-parse-tree-state))
+
+;;; Interfacing with the system
+;;
+(defcustom semantic-inhibit-functions nil
+  "List of functions to call with no arguments before Semantic is setup.
+If any of these functions returns non-nil, the current buffer is not
+setup to use Semantic."
+  :group 'semantic
+  :type 'hook)
+
+(defvar semantic-init-hooks nil
+  "*Hooks run when a buffer is initialized with a parsing table.")
+
+(defvar semantic-init-mode-hooks nil
+  "*Hooks run when a buffer of a particular mode is initialized.")
+(make-variable-buffer-local 'semantic-init-mode-hooks)
+
+(defvar semantic-init-db-hooks nil
+  "Hooks run when a buffer is initialized with a parsing table for DBs.
+This hook is for database functions which intend to swap in a tag table.
+This guarantees that the DB will go before other modes that require
+a parse of the buffer.")
+
+(defvar semantic-new-buffer-fcn-was-run nil
+  "Non nil after `semantic-new-buffer-fcn' has been executed.")
+(make-variable-buffer-local 'semantic-new-buffer-fcn-was-run)
+
+(defsubst semantic-active-p ()
+  "Return non-nil if the current buffer was set up for parsing."
+  semantic-new-buffer-fcn-was-run)
+
+(defsubst semantic--umatched-syntax-needs-refresh-p  ()
+  "Return non-nil if the unmatched syntax cache needs a refresh.
+That is if it is dirty or if the current parse tree isn't up to date."
+  (or semantic-unmatched-syntax-cache-check
+      (not (semantic-parse-tree-up-to-date-p))))
+
+(defun semantic-new-buffer-fcn ()
+  "Setup the current buffer to use Semantic.
+If the major mode is ready for Semantic, and no
+`semantic-inhibit-functions' disabled it, the current buffer is setup
+to use Semantic, and `semantic-init-hook' is run."
+  ;; Do stuff if semantic was activated by a mode hook in this buffer,
+  ;; and not afterwards disabled.
+  (when (and semantic--parse-table
+             (not (semantic-active-p))
+             (not (run-hook-with-args-until-success
+                   'semantic-inhibit-functions)))
+    ;; Make sure that if this buffer is cloned, our tags and overlays
+    ;; don't go along for the ride.
+    (add-hook 'clone-indirect-buffer-hook 'semantic-clear-toplevel-cache
+             nil t)
+    ;; Specify that this function has done it's work.  At this point
+    ;; we can consider that semantic is active in this buffer.
+    (setq semantic-new-buffer-fcn-was-run t)
+    ;; Here are some buffer local variables we can initialize ourselves
+    ;; of a mode does not choose to do so.
+    (semantic-lex-init)
+    ;; Force this buffer to have its cache refreshed.
+    (semantic-clear-toplevel-cache)
+    ;; Call DB hooks before regular init hooks
+    (run-hooks 'semantic-init-db-hooks)
+    ;; Set up semantic modes
+    (run-hooks 'semantic-init-hooks)
+    ;; Set up major-mode specific semantic modes
+    (run-hooks 'semantic-init-mode-hooks)
+    ))
+
+(add-hook 'mode-local-init-hook 'semantic-new-buffer-fcn)
+
+;; Test the above hook.
+;;(add-hook 'semantic-init-hooks (lambda () (message "init for semantic")))
+
+(defun semantic-fetch-tags-fast ()
+  "For use in a hook.  When only a partial reparse is needed, reparse."
+  (condition-case nil
+      (if (semantic-parse-tree-needs-update-p)
+         (semantic-fetch-tags))
+    (error nil))
+  semantic--buffer-cache)
+
+(if (boundp 'eval-defun-hooks)
+    (add-hook 'eval-defun-hooks 'semantic-fetch-tags-fast))
+\f
+;;; Parsing Commands
+;;
+(eval-when-compile
+  (condition-case nil (require 'pp) (error nil)))
+
+(defvar semantic-edebug nil
+  "When non-nil, activate the interactive parsing debugger.
+Do not set this yourself.  Call `semantic-debug'.")
+
+(defun semantic-elapsed-time (start end)
+  "Copied from elp.el.  Was elp-elapsed-time.
+Argument START and END bound the time being calculated."
+  (+ (* (- (car end) (car start)) 65536.0)
+     (- (car (cdr end)) (car (cdr start)))
+     (/ (- (car (cdr (cdr end))) (car (cdr (cdr start)))) 1000000.0)))
+
+(defun bovinate (&optional clear)
+  "Parse the current buffer.  Show output in a temp buffer.
+Optional argument CLEAR will clear the cache before parsing.
+If CLEAR is negative, it will do a full reparse, and also not display
+the output buffer."
+  (interactive "P")
+  (if clear (semantic-clear-toplevel-cache))
+  (if (eq clear '-) (setq clear -1))
+  (let* ((start (current-time))
+        (out (semantic-fetch-tags))
+        (end (current-time)))
+    (message "Retrieving tags took %.2f seconds."
+            (semantic-elapsed-time start end))
+    (when (or (null clear) (not (listp clear)))
+      (pop-to-buffer "*Parser Output*")
+      (require 'pp)
+      (erase-buffer)
+      (insert (pp-to-string out))
+      (goto-char (point-min)))))
+\f
+;;; Functions of the parser plug-in API
+;;
+;; Overload these functions to create new types of parsers.
+;;
+(define-overloadable-function semantic-parse-stream (stream nonterminal)
+  "Parse STREAM, starting at the first NONTERMINAL rule.
+For bovine and wisent based parsers, STREAM is from the output of
+`semantic-lex', and NONTERMINAL is a rule in the apropriate language
+specific rules file.
+The default parser table used for bovine or wisent based parsers is
+`semantic--parse-table'.
+
+Must return a list: (STREAM TAGS) where STREAM is the unused elements
+from STREAM, and TAGS is the list of semantic tags found, usually only
+one tag is returned with the exception of compound statements")
+
+(define-overloadable-function semantic-parse-changes ()
+  "Reparse changes in the current buffer.
+The list of changes are tracked as a series of overlays in the buffer.
+When overloading this function, use `semantic-changes-in-region' to
+analyze.")
+
+(define-overloadable-function semantic-parse-region
+  (start end &optional nonterminal depth returnonerror)
+  "Parse the area between START and END, and return any tags found.
+If END needs to be extended due to a lexical token being too large, it
+will be silently ignored.
+
+Optional arguments:
+NONTERMINAL is the rule to start parsing at.
+DEPTH specifies the lexical depth to decend for parser that use
+lexical analysis as their first step.
+RETURNONERROR specifies that parsing should stop on the first
+unmatched syntax encountered.  When nil, parsing skips the syntax,
+adding it to the unmatched syntax cache.
+
+Must return a list of semantic tags wich have been cooked
+\(repositioned properly) but which DO NOT HAVE OVERLAYS associated
+with them.  When overloading this function, use `semantic--tag-expand'
+to cook raw tags.")
+
+(defun semantic-parse-region-default
+  (start end &optional nonterminal depth returnonerror)
+  "Parse the area between START and END, and return any tags found.
+If END needs to be extended due to a lexical token being too large, it
+will be silently ignored.
+Optional arguments:
+NONTERMINAL is the rule to start parsing at if it is known.
+DEPTH specifies the lexical depth to scan.
+RETURNONERROR specifies that parsing should end when encountering
+unterminated syntax."
+  (when (or (null semantic--parse-table) (eq semantic--parse-table t))
+    ;; If there is no table, or it was set to t, then we are here by
+    ;; some other mistake.  Do not throw an error deep in the parser.
+    (error "No support found to parse buffer %S" (buffer-name)))
+  (save-restriction
+    (widen)
+    (when (or (< end start) (> end (point-max)))
+      (error "Invalid parse region bounds %S, %S" start end))
+    (nreverse
+     (semantic-repeat-parse-whole-stream
+      (or (cdr (assq start semantic-lex-block-streams))
+         (semantic-lex start end depth))
+      nonterminal returnonerror))))
+\f
+;;; Parsing functions
+;;
+(defun semantic-set-unmatched-syntax-cache (unmatched-syntax)
+  "Set the unmatched syntax cache.
+Argument UNMATCHED-SYNTAX is the syntax to set into the cache."
+  ;; This function is not actually called by the main parse loop.
+  ;; This is intended for use by semanticdb.
+  (setq semantic-unmatched-syntax-cache unmatched-syntax
+       semantic-unmatched-syntax-cache-check nil)
+    ;; Refresh the display of unmatched syntax tokens if enabled
+  (run-hook-with-args 'semantic-unmatched-syntax-hook
+                      semantic-unmatched-syntax-cache))
+
+(defun semantic-clear-unmatched-syntax-cache ()
+  "Clear the cache of unmatched syntax tokens."
+  (setq semantic-unmatched-syntax-cache nil
+        semantic-unmatched-syntax-cache-check t))
+
+(defun semantic-unmatched-syntax-tokens ()
+  "Return the list of unmatched syntax tokens."
+  ;; If the cache need refresh then do a full re-parse.
+  (if (semantic--umatched-syntax-needs-refresh-p)
+      ;; To avoid a recursive call, temporarily disable
+      ;; `semantic-unmatched-syntax-hook'.
+      (let (semantic-unmatched-syntax-hook)
+        (condition-case nil
+            (progn
+              (semantic-clear-toplevel-cache)
+              (semantic-fetch-tags))
+          (quit
+           (message "semantic-unmatched-syntax-tokens:\
+ parsing of buffer canceled"))
+          )))
+    semantic-unmatched-syntax-cache)
+
+(defun semantic-clear-toplevel-cache ()
+  "Clear the toplevel tag cache for the current buffer.
+Clearing the cache will force a complete reparse next time a tag list
+is requested."
+  (interactive)
+  (run-hooks 'semantic-before-toplevel-cache-flush-hook)
+  (setq semantic--buffer-cache nil)
+  (semantic-clear-unmatched-syntax-cache)
+  (semantic-clear-parser-warnings)
+  ;; Nuke all semantic overlays.  This is faster than deleting based
+  ;; on our data structure.
+  (let ((l (semantic-overlay-lists)))
+    (mapc 'semantic-delete-overlay-maybe (car l))
+    (mapc 'semantic-delete-overlay-maybe (cdr l))
+    )
+  (semantic-parse-tree-set-needs-rebuild)
+  ;; Remove this hook which tracks if a buffer is up to date or not.
+  (remove-hook 'after-change-functions 'semantic-change-function t)
+  ;; Old model.  Delete someday.
+  ;;(run-hooks 'semantic-after-toplevel-bovinate-hook)
+
+  (run-hook-with-args 'semantic-after-toplevel-cache-change-hook
+                     semantic--buffer-cache)
+  )
+
+(defvar semantic-bovinate-nonterminal-check-obarray)
+
+(defun semantic--set-buffer-cache (tagtable)
+  "Set the toplevel cache cache to TAGTABLE."
+  (setq semantic--buffer-cache tagtable
+        semantic-unmatched-syntax-cache-check nil
+       ;; This is specific to the bovine parser.
+        semantic-bovinate-nonterminal-check-obarray nil)
+  (semantic-parse-tree-set-up-to-date)
+  (semantic-make-local-hook 'after-change-functions)
+  (add-hook 'after-change-functions 'semantic-change-function nil t)
+  (run-hook-with-args 'semantic-after-toplevel-cache-change-hook
+                     semantic--buffer-cache)
+  ;; Refresh the display of unmatched syntax tokens if enabled
+  (run-hook-with-args 'semantic-unmatched-syntax-hook
+                      semantic-unmatched-syntax-cache)
+  ;; Old Semantic 1.3 hook API.  Maybe useful forever?
+  (run-hooks 'semantic-after-toplevel-bovinate-hook)
+  )
+
+(defvar semantic-working-type 'percent
+  "*The type of working message to use when parsing.
+'percent means we are doing a linear parse through the buffer.
+'dynamic means we are reparsing specific tags.")
+(semantic-varalias-obsolete 'semantic-bovination-working-type
+                           'semantic-working-type)
+
+(defvar semantic-minimum-working-buffer-size (* 1024 5)
+  "*The minimum size of a buffer before working messages are displayed.
+Buffers smaller than will parse silently.
+Bufferse larger than this will display the working progress bar.")
+
+(defsubst semantic-parser-working-message (&optional arg)
+  "Return the message string displayed while parsing.
+If optional argument ARG is non-nil it is appended to the message
+string."
+  (if semantic-parser-name
+      (format "%s/%s" semantic-parser-name (or arg ""))
+    (format "%s" (or arg ""))))
+\f
+;;; Application Parser Entry Points
+;;
+;; The best way to call the parser from programs is via
+;; `semantic-fetch-tags'.  This, in turn, uses other internal
+;; API functions which plug-in parsers can take advantage of.
+
+(defun semantic-fetch-tags ()
+  "Fetch semantic tags from the current buffer.
+If the buffer cache is up to date, return that.
+If the buffer cache is out of date, attempt an incremental reparse.
+If the buffer has not been parsed before, or if the incremental reparse
+fails, then parse the entire buffer.
+If a lexcial error had been previously discovered and the buffer
+was marked unparseable, then do nothing, and return the cache."
+  (and
+   ;; Is this a semantic enabled buffer?
+   (semantic-active-p)
+   ;; Application hooks say the buffer is safe for parsing
+   (run-hook-with-args-until-failure
+    'semantic-before-toplevel-bovination-hook)
+   (run-hook-with-args-until-failure
+    'semantic--before-fetch-tags-hook)
+   ;; If the buffer was previously marked unparseable,
+   ;; then don't waste our time.
+   (not (semantic-parse-tree-unparseable-p))
+   ;; The parse tree actually needs to be refreshed
+   (not (semantic-parse-tree-up-to-date-p))
+   ;; So do it!
+   (let* ((gc-cons-threshold (max gc-cons-threshold 10000000))
+          (semantic-lex-block-streams nil)
+          (res nil))
+     (garbage-collect)
+     (cond
+
+;;;; Try the incremental parser to do a fast update.
+     ((semantic-parse-tree-needs-update-p)
+      (setq res (semantic-parse-changes))
+      (if (semantic-parse-tree-needs-rebuild-p)
+          ;; If the partial reparse fails, jump to a full reparse.
+          (semantic-fetch-tags)
+        ;; Clear the cache of unmatched syntax tokens
+        ;;
+        ;; NOTE TO SELF:
+        ;;
+        ;; Move this into the incremental parser.  This is a bug.
+        ;;
+        (semantic-clear-unmatched-syntax-cache)
+        (run-hook-with-args ;; Let hooks know the updated tags
+         'semantic-after-partial-cache-change-hook res))
+      )
+
+;;;; Parse the whole system.
+     ((semantic-parse-tree-needs-rebuild-p)
+      ;; (let ((working-status-dynamic-type
+      ;;            (if (< (point-max) semantic-minimum-working-buffer-size)
+      ;;                nil
+      ;;              working-status-dynamic-type))
+      ;;           (working-status-percentage-type
+      ;;            (if (< (point-max) semantic-minimum-working-buffer-size)
+      ;;                nil
+      ;;              working-status-percentage-type)))
+      ;;       (working-status-forms
+      ;;        (semantic-parser-working-message (buffer-name)) "done"
+      ;;        (setq res (semantic-parse-region (point-min) (point-max)))
+      ;;        (working-status t)))
+
+      ;; Use Emacs' built-in progress-reporter
+      (let ((semantic--progress-reporter
+            (and (>= (point-max) semantic-minimum-working-buffer-size)
+                 (eq semantic-working-type 'percent)
+                 (make-progress-reporter
+                  (semantic-parser-working-message (buffer-name))
+                  0 100))))
+       (setq res (semantic-parse-region (point-min) (point-max)))
+       (progress-reporter-done semantic--progress-reporter))
+
+      ;; Clear the caches when we see there were no errors.
+      ;; But preserve the unmatched syntax cache and warnings!
+      (let (semantic-unmatched-syntax-cache
+           semantic-unmatched-syntax-cache-check
+           semantic-parser-warnings)
+       (semantic-clear-toplevel-cache))
+      ;; Set up the new overlays
+      (semantic--tag-link-list-to-buffer res)
+      ;; Set up the cache with the new results
+      (semantic--set-buffer-cache res)
+      ))))
+
+  ;; Always return the current parse tree.
+  semantic--buffer-cache)
+
+(defun semantic-refresh-tags-safe ()
+  "Refreshes the current buffer's tags safely.
+
+Return non-nil if the refresh was successful.
+Return nil if there is some sort of syntax error preventing a reparse.
+
+Does nothing if the current buffer doesn't need reparsing."
+
+  ;; These checks actually occur in `semantic-fetch-tags', but if we
+  ;; do them here, then all the bovination hooks are not run, and
+  ;; we save lots of time.
+  (cond
+   ;; If the buffer was previously marked unparseable,
+   ;; then don't waste our time.
+   ((semantic-parse-tree-unparseable-p)
+    nil)
+   ;; The parse tree is already ok.
+   ((semantic-parse-tree-up-to-date-p)
+    t)
+   (t
+    (let* ((inhibit-quit nil)
+          (lexically-safe t)
+          )
+
+      (unwind-protect
+         ;; Perform the parsing.
+         (progn
+           (when (semantic-lex-catch-errors safe-refresh
+                   (save-excursion (semantic-fetch-tags))
+                   nil)
+             ;; If we are here, it is because the lexical step failed,
+             ;; proably due to unterminated lists or something like that.
+
+             ;; We do nothing, and just wait for the next idle timer
+             ;; to go off.  In the meantime, remember this, and make sure
+             ;; no other idle services can get executed.
+             (setq lexically-safe nil))
+           )
+       )
+      ;; Return if we are lexically safe
+      lexically-safe))))
+
+(defun semantic-bovinate-toplevel (&optional ignored)
+  "Backward Compatibility Function."
+  (semantic-fetch-tags))
+(make-obsolete 'semantic-bovinate-toplevel 'semantic-fetch-tags)
+
+;; Another approach is to let Emacs call the parser on idle time, when
+;; needed, use `semantic-fetch-available-tags' to only retrieve
+;; available tags, and setup the `semantic-after-*-hook' hooks to
+;; synchronize with new tags when they become available.
+
+(defsubst semantic-fetch-available-tags ()
+  "Fetch available semantic tags from the current buffer.
+That is, return tags currently in the cache without parsing the
+current buffer.
+Parse operations happen asynchronously when needed on Emacs idle time.
+Use the `semantic-after-toplevel-cache-change-hook' and
+`semantic-after-partial-cache-change-hook' hooks to synchronize with
+new tags when they become available."
+  semantic--buffer-cache)
+\f
+;;; Iterative parser helper function
+;;
+;; Iterative parsers are better than rule-based iterative functions
+;; in that they can handle obscure errors more cleanly.
+;;
+;; `semantic-repeat-parse-whole-stream' abstracts this action for
+;; other parser centric routines.
+;;
+(defun semantic-repeat-parse-whole-stream
+  (stream nonterm &optional returnonerror)
+  "Iteratively parse the entire stream STREAM starting with NONTERM.
+Optional argument RETURNONERROR indicates that the parser should exit
+with the current results on a parse error.
+This function returns semantic tags without overlays."
+  (let ((result nil)
+        (case-fold-search semantic-case-fold)
+        nontermsym tag)
+    (while stream
+      (setq nontermsym (semantic-parse-stream stream nonterm)
+            tag (car (cdr nontermsym)))
+      (if (not nontermsym)
+          (error "Parse error @ %d" (car (cdr (car stream)))))
+      (if (eq (car nontermsym) stream)
+         (error "Parser error: Infinite loop?"))
+      (if tag
+          (if (car tag)
+              (setq tag (mapcar
+                         #'(lambda (tag)
+                             ;; Set the 'reparse-symbol property to
+                             ;; NONTERM unless it was already setup
+                             ;; by a tag expander
+                             (or (semantic--tag-get-property
+                                  tag 'reparse-symbol)
+                                 (semantic--tag-put-property
+                                  tag 'reparse-symbol nonterm))
+                             tag)
+                         (semantic--tag-expand tag))
+                    result (append tag result))
+            ;; No error in this case, a purposeful nil means don't
+            ;; store anything.
+            )
+        (if returnonerror
+            (setq stream nil)
+          ;; The current item in the stream didn't match, so add it to
+          ;; the list of syntax items which didn't match.
+          (setq semantic-unmatched-syntax-cache
+                (cons (car stream) semantic-unmatched-syntax-cache))
+          ))
+      ;; Designated to ignore.
+      (setq stream (car nontermsym))
+      (if stream
+         ;; (if (eq semantic-working-type 'percent)
+         ;;     (working-status
+         ;;      (/ (* 100 (semantic-lex-token-start (car stream)))
+         ;;      (point-max)))
+         ;;   (working-dynamic-status))
+
+         ;; Use Emacs' built-in progress reporter:
+         (and (boundp 'semantic--progress-reporter)
+              semantic--progress-reporter
+              (progress-reporter-update
+               semantic--progress-reporter
+               (/ (* 100 (semantic-lex-token-start (car stream)))
+                  (point-max))))))
+    result))
+\f
+;;; Parsing Warnings:
+;;
+;; Parsing a buffer may result in non-critical things that we should
+;; alert the user to without interrupting the normal flow.
+;;
+;; Any parser can use this API to provide a list of warnings during a
+;; parse which a user may want to investigate.
+(defvar semantic-parser-warnings nil
+  "A list of parser warnings since the last full reparse.")
+(make-variable-buffer-local 'semantic-parser-warnings)
+
+(defun semantic-clear-parser-warnings ()
+  "Clear the current list of parser warnings for this buffer."
+  (setq semantic-parser-warnings nil))
+
+(defun semantic-push-parser-warning (warning start end)
+  "Add a parser WARNING that covers text from START to END."
+  (setq semantic-parser-warnings
+       (cons (cons warning (cons start end))
+             semantic-parser-warnings)))
+
+(defun semantic-dump-parser-warnings ()
+  "Dump any parser warnings."
+  (interactive)
+  (if semantic-parser-warnings
+      (let ((pw semantic-parser-warnings))
+       (pop-to-buffer "*Parser Warnings*")
+       (require 'pp)
+       (erase-buffer)
+       (insert (pp-to-string pw))
+       (goto-char (point-min)))
+    (message "No parser warnings.")))
+
+
+\f
+;;; Compatibility:
+;;
+;; Semantic 1.x parser action helper functions, used by some parsers.
+;; Please move away from these functions, and try using semantic 2.x
+;; interfaces instead.
+;;
+(defsubst semantic-bovinate-region-until-error
+  (start end nonterm &optional depth)
+  "NOTE: Use `semantic-parse-region' instead.
+
+Bovinate between START and END starting with NONTERM.
+Optional DEPTH specifies how many levels of parenthesis to enter.
+This command will parse until an error is encountered, and return
+the list of everything found until that moment.
+This is meant for finding variable definitions at the beginning of
+code blocks in methods.  If `bovine-inner-scope' can also support
+commands, use `semantic-bovinate-from-nonterminal-full'."
+  (semantic-parse-region start end nonterm depth t))
+(make-obsolete 'semantic-bovinate-region-until-error
+               'semantic-parse-region)
+
+(defsubst semantic-bovinate-from-nonterminal
+  (start end nonterm &optional depth length)
+  "Bovinate from within a nonterminal lambda from START to END.
+Argument NONTERM is the nonterminal symbol to start with.
+Optional argument DEPTH is the depth of lists to dive into.  When used
+in a `lambda' of a MATCH-LIST, there is no need to include a START and
+END part.
+Optional argument LENGTH specifies we are only interested in LENGTH
+tokens."
+  (car-safe (cdr (semantic-parse-stream
+                 (semantic-lex start end (or depth 1) length)
+                 nonterm))))
+
+(defsubst semantic-bovinate-from-nonterminal-full
+  (start end nonterm &optional depth)
+  "NOTE: Use `semantic-parse-region' instead.
+
+Bovinate from within a nonterminal lambda from START to END.
+Iterates until all the space between START and END is exhausted.
+Argument NONTERM is the nonterminal symbol to start with.
+If NONTERM is nil, use `bovine-block-toplevel'.
+Optional argument DEPTH is the depth of lists to dive into.
+When used in a `lambda' of a MATCH-LIST, there is no need to include
+a START and END part."
+  (semantic-parse-region start end nonterm (or depth 1)))
+(make-obsolete 'semantic-bovinate-from-nonterminal-full
+               'semantic-parse-region)
+
+(provide 'semantic)
+
+;;; semantic.el ends here
+
+;; Semantic-util is a part of the semantic API.  Include it last
+;; because it depends on semantic.
+(require 'semantic-util)