>Return-Path: <[EMAIL PROTECTED]>
>Mailing-List: contact [EMAIL PROTECTED]; run by ezmlm
>Delivered-To: mailing list [EMAIL PROTECTED]
>X-Sender: [EMAIL PROTECTED]
>Date: Thu, 21 Dec 2000 15:38:09 -0500
>To: John Straw <[EMAIL PROTECTED]>, [EMAIL PROTECTED]
>From: Paul Kinnucan <[EMAIL PROTECTED]>
>Subject: Re: Exception with JDE2.2.6 and XEmacs
>Cc: Gerd Boerrigter <[EMAIL PROTECTED]>,
>        [EMAIL PROTECTED]
>References: <[EMAIL PROTECTED]>
> <[EMAIL PROTECTED]>
> <[EMAIL PROTECTED]>
>
>Hi John,
>
>I had a similar problem on XEmacs and traced the problem to the defalias
>semantic-overlays-at. Eric provided the simple fix below
>
>;;      (defalias 'semantic-overlays-at 'extent-at)
>      (defalias 'semantic-overlays-at 
>       (lambda (pos) (extent-list nil pos pos)))
>
>which I included in my copy of semantic.el. I had assumed that Eric
>included the fix. However, in looking at the version of semantic.el in
>semantic-1.3.2, I  see that it does not include the fix. So I have attached
>a copy. Please let me know if it solves the problem in your case.
>
>- Paul
>
>
>At 01:19 PM 12/21/00 -0500, John Straw wrote:
>>Paul Kinnucan writes:
>> > Perhaps there is an obsolete version of semantic in your load-path.
Perhaps
>> > the obsolete version that started shipping with recent releases of
XEmacs.
>>
>>I believe I've traced the problem to the use of the function
>>semantic-overlay-get in the file semantic-util.el in semantic 1.3.2.
>>The XEmacs compatability code in semantic.el defines
>>semantic-overlay-get as a alias of extent-get.  When
>>semantic-overlay-get is used in semantic-util.el (in the
>>semantic-find-nonterminal-by-overlay function), the returned value is
>>treated as a list.  extent-get, according to its documentation,
>>doesn't return a list, it returns a single extent.  This is the cause
>>of the error which is reported by XEmacs.
>>
>>I patched semantic-util.el in the following way.  I've tried to
>>preserve the original code, but just fix the case where list
>>operations are applied to extents.  I'm sure that there is a more
>>elegant (or correct, even) way to do this.
>>
>>--- semantic-util.el.orig     Sat Nov 18 09:18:37 2000
>>+++ semantic-util.el  Thu Dec 21 10:28:59 2000
>>@@ -196,10 +196,11 @@
>>     (let ((ol (semantic-overlays-at (or positionormarker (point))))
>>        (ret nil))
>>       (while ol
>>-     (let ((tmp (semantic-overlay-get (car ol) 'semantic)))
>>+     (let ((tmp (semantic-overlay-get (if (listp ol) (car ol) ol) 'semantic)))
>>        (when tmp
>>          (setq ret (cons tmp ret))))
>>-     (setq ol (cdr ol)))
>>+     (setq ol (if (listp ol) (cdr ol) nil))
>>+     )
>>       (sort ret (lambda (a b) (< (semantic-token-start a)
>>                              (semantic-token-start b)))))))
>>
>>-- 
>>John Straw
[EMAIL PROTECTED]
>>
>;;; semantic.el --- Semantic buffer evaluator.
>
>;;; Copyright (C) 1999, 2000 Eric M. Ludlam
>
>;; Author: Eric M. Ludlam <[EMAIL PROTECTED]>
>;; Version: 1.3.2
>;; Keywords: syntax
>;; X-RCS: $Id: semantic.el,v 1.62 2000/11/18 14:09:50 zappo Exp $
>
>;; This file is not part of GNU Emacs.
>
>;; Semantic 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 2, or (at your option)
>;; any later version.
>
>;; This software 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; see the file COPYING.  If not, write to the
>;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
>;; Boston, MA 02111-1307, USA.
>
>;;; Commentary:
>;;
>;; API for determining semantic content of a buffer.  The mode using
>;; semantic must be a deterministic programming language.
>;;
>;; The output of a semantic bovine parse is parse tree.  While it is
>;; possible to assign actions in the bovine-table in a similar fashion
>;; to bison, this is not it's end goal.
>;;
>;; Bovine Table Tips & Tricks:
>;; ---------------------------
>;;
>;; Many of the tricks needed to create rules in bison or yacc can be
>;; used here.  The exceptions to this rule are that there is no need to
>;; declare bison tokens, and you cannot put "code" in the middle of a
>;; match rule.  In addition, you should avoid empty matching rules as
>;; I haven't quite gotten those to be reliable yet.
>;;
>;; The top-level bovine table is an association list of all the rules
>;; needed to parse your language, or language segment.  It is easiest
>;; to create one master rule file, and call the semantic bovinator on
>;; subsections passing down the nonterminal rule you want to match.
>;;
>;; Thus, every entry in the bovine table is of the form:
>;; ( NONTERMINAL-SYMBOL MATCH-LIST )
>;; 
>;; The nonterminal symbol is equivalent to the bison RESULT, and the
>;; MATCH-LIST is equivalent to the bison COMPONENTS.  Thus, the bison
>;; rule:
>;;        expseq: expseq1
>;;              | expseq2
>;;              ;
>;; becomes:
>;;        ( expseq ( expseq1 ) ( expseq2 ) )
>;; which defines RESULT expseq which can be either COMPONENT expseq1
>;; or expseq2.  These two table entries also use nonterminal results,
>;; and also use the DEFAULT RESULT LAMBDA (see below for details on
>;; the RESULT LAMBDA).
>;;
>;; You can also have recursive rules, as in bison.  For example the
>;; bison rule:
>;;        expseq1: exp
>;;               | expseq1 ',' exp
>;;               ;
>;; becomes:
>;;        (expseq1 (exp)
>;;                 (expseq1 punctuation "," exp
>;;                          (lambda (val start end)
>;;                                  ( -generator code- ))))
>;;
>;; This time, the second rule uses it's own RESULT LAMBDA.
>;;
>;; Lastly, you can also have STRING LITERALS in your rules, though
>;; these are different from Bison.  As can be seen above, a literal is
>;; a constant lexed symbol, such as `punctuation', followed by a string
>;; which is a *regular expression* which must match, or this rule will
>;; fail.
>;;
>;; In BISON, a given rule can have inline ACTIONS.  In the semantic
>;; bovinator, there can be only one ACTION which I will refer to here
>;; as the RESULT LAMBDA.  There are two default RESULT LAMBDAs which
>;; can be used which cover the default case.  The RESULT LAMBDA must
>;; return a valid nonterminal token.  A nonterminal token is always of the
>;; form ( NAME TOKEN VALUE1 VALUE2 ... START END).  NAME is the name
>;; to use for this token.  It is first so that a list of tokens is
>;; also an alist, or completion table.  Token should be the same
>;; symbol as the nonterminal token generated, though it does not have to
>;; be.  The values can be anything you want, including other tokens.
>;; START and END indicate where in the buffer this token is, and is
>;; easily derived from the START and END parameter passed down.
>;;
>;; A RESULT LAMBDA must take three parameters, VALS, START and END.
>;; VALS is the list of literals derived during the bovination of the
>;; match list, including punctuation, parens, and explicit
>;; matches.  other elements
>;;
>;; Here are some example match lists and their code:
>;;
>;; (expression (lambda (vals start end)
>;;                     (append (car vals) (list start end))))
>;;
>;; In this RESULT LAMBDA, VALS will be of length one, and it's first
>;; element will contain the nonterminal expression result.  It is
>;; likely to use a rule like this when there is a top level nonterminal
>;; symbol whose contents are several other single nonterminal rules.
>;; Because of this, we want to result that value with our START and END
>;; appended.
>;;
>;; NOTE: nonterminal values passed in as VALS always have their
>;;       START/END parts stripped!
>;;
>;; This example lambda is also one of the DEFAULT lambdas for the case
>;; of a single nonterminal result.  Thus, the above rule could also be
>;; written as (expression).
>;;
>;; A more complex example uses more flex elements.  Lets match this:
>;;
>;;    (defun myfunction (arguments) "docstring" ...)
>;;
>;; If we assume a flex depth of 1, we can write it this way:
>;;
>;; (open-paren "(" symbol "defun" symbol semantic-list string
>;;             (lambda (vals start end)
>;;                     (list (nth 2 vals) 'function nil (nth 3 vals)
>;;                           (nth 4 vals) start end)))
>;;
>;; The above will create a function token, whose format is
>;; predefined.  (See the symbol `semantic-toplevel-bovine-table' for
>;; details on some default symbols that should be provided.)
>;;
>;; From this we can see that VALS will have the value:
>;; ( "(" "defun" "myfunction" "(arguments)" "docstring")
>;;
>;; If we also want to return a list of arguments in our function
>;; token, we can replace `semantic-list' with the following recursive
>;; nonterminal rule.
>;;
>;; ( arg-list (semantic-list
>;;             (lambda (vals start end)
>;;                (semantic-bovinate-from-nonterminal start end 'argsyms))))
>;; ( argsyms
>;;   (open-paren argsyms (lambda (vals start end)
>;;                        (append (car (cdr vals)) (list start end))))
>;;   (symbol argsyms (lambda (vals start end)
>;;                    (append (cons (car vals) (car (cdr vals)))
>;;                            (list start end))))
>;;   (symbol close-paren (lambda (vals start end)
>;;                        (list (car vals) start end))))
>;;
>;; This recursive rule can find a parenthetic list with any number of
>;; symbols in it.
>;;
>;; Here we also see a new function, `semantic-bovinate-from-nonterminal'.
>;; This function takes START END and a nonterminal result symbol to
>;; match.  This will return a complete token, including START and
>;; END.  This function should ONLY BE USED IN A RESULT LAMBDA.  It
>;; uses knowledge of that scope to reduce the number of parameters
>;; that need to be passed in.  This is useful for decomposing complex
>;; syntactic elements, such as semantic-list.
>;;
>;; Token's and the VALS argument
>;; -----------------------------
>;;
>;; Not all syntactic tokens are represented by strings in the VALS argument
>;; to the match-list lambda expression.  Some are a dotted pair (START .
END).
>;; The following are represented as strings:
>;;  1) symbols
>;;  2) punctuation
>;;  3) open/close-paren
>;;  4) charquote
>;;  5) strings
>;; The following are represented as a dotted-pair.
>;;  1) semantic-list
>;;  2) comments
>;; Nonterminals are always lists which are generated in the lambda
>;; expression.
>;;
>;; Semantic Bovine Table Debugger
>;; ------------------------------
>;;
>;; The bovinator also includes a primitive debugger.  This debugger
>;; walks through the parsing process and see how it's being
>;; interpretted.  There are two steps in debuggin a bovine table.
>;;
>;; First, place the cursor in the source code where the table is
>;; defined.  Execute the command `semantic-bovinate-debug-set-table'.
>;; This tells the debugger where you table is.
>;;
>;; Next, place the cursor in a buffer you which to run the bovinator
>;; on, and execute the command `semantic-bovinate-buffer-debug'.  This
>;; will parse the table, and highlight the relevant areas and walk
>;; through the match list with the cursor, displaying the current list
>;; of values (which is always backwards.)
>;;
>;; DESIGN ISSUES:
>;; -------------
>;;
>;;  At the moment, the only thing I really dislike is the RESULT
>;;  LAMBDA format.  While having some good defaults is nice, the use
>;;  of append and list in the lambda seems unnecessarily complex.
>;;
>;;  Also of issue, I am still not sure I like the idea of stripping
>;;  BEGIN/END off of nonterminal tokens passed down in VALS.  While they
>;;  are often unnecessary, I can imagine that they could prove useful.
>;;  Only time will tell.
>
>;;; History:
>;; 
>
>(require 'working)
>(require 'semantic-util)
>
>(defgroup semantic nil
>  "File and tag browser frame."
>  )
>
>;;; Code:
>
>;;; Compatibility
>;;
>(if (featurep 'xemacs)
>    (progn
>      (defalias 'semantic-overlay-live-p 'extent-live-p)
>      (defalias 'semantic-make-overlay 'make-extent)
>      (defalias 'semantic-overlay-put 'set-extent-property)
>      (defalias 'semantic-overlay-get 'extent-property)
>      (defalias 'semantic-overlay-delete 'delete-extent)
>;;      (defalias 'semantic-overlays-at 'extent-at)
>      (defalias 'semantic-overlays-at 
>       (lambda (pos) (extent-list nil pos pos)))
>      (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-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-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-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-next-change 'next-overlay-change)
>  (defalias 'semantic-overlay-previous-change 'previous-overlay-change)
>  (defalias 'semantic-overlay-lists 'overlay-lists)
>  (defalias 'semantic-overlay-p 'overlayp)
>  )
>
>(defvar semantic-edebug nil
>  "When non-nil, activate the interactive parsing debugger.
>Do not set this yourself.  Call `semantic-bovinate-buffer-debug'.")
>
>
>(defcustom semantic-dump-parse nil
>  "When non-nil, dump parsing information."
>  :group 'semantic
>  :type 'boolean)
>
>(defvar semantic-toplevel-bovine-table nil
>  "Variable that defines how to bovinate top level items in a buffer.
>Set this in your major mode to return function and variable semantic
>types.
>
>The format of a BOVINE-TABLE is:
>
> ( ( NONTERMINAL-SYMBOL1 MATCH-LIST1 )
>   ( NONTERMINAL-SYMBOL2 MATCH-LIST2 )
>   ...
>   ( NONTERMINAL-SYMBOLn MATCH-LISTn )
> 
>Where each NONTERMINAL-SYMBOL is an artificial symbol which can appear
>in any child state.  As a starting place, one of the NONTERMINAL-SYMBOLS
>must be `bovine-toplevel'.
>
>A MATCH-LIST is a list of possible matches of the form:
>
> ( STATE-LIST1
>   STATE-LIST2
>   ...
>   STATE-LISTN )
>
>where STATE-LIST is of the form:
>  ( TYPE1 [ \"VALUE1\" ] TYPE2 [ \"VALUE2\" ] ... LAMBDA )
>
>where TYPE is one of the returned types of the token stream.
>VALUE is a value, or range of values to match against.  For
>example, a SYMBOL might need to match \"foo\".  Some TYPES will not
>have matching criteria.
>
>LAMBDA is a lambda expression which is evaled with the text of the
>type when it is found.  It is passed the list of all buffer text
>elements found since the last lambda expression.  It should return a
>semantic element (see below.)
>
>For consistency between languages, always use the following symbol
>forms.  It is fine to create new symbols, or to exclude some if they
>do not exist, however by using these symbols, you can maximize the
>number of language-independent programs available for use with your
>language.
>
>GENERIC ENTRIES:
>
> Bovine table entry return elements are up to the table author.  It is
>recommended, however, that the following format be used.
>
> (\"NAME\" type-symbol [\"TYPE\"] ... \"DOCSTRING\" OVERLAY)
>
>Where type-symbol is the type of return token found, and NAME is it's
>name.  If there is any typing information needed to describe this
>entry, make that come third.  Next, any additional information follows
>the optional type.  The last data entry can be the position in the buffer
>of DOCSTRING.  A docstring does not have to exist in the form used by
>Emacs Lisp.  It could be the text of a comment appearing just before a
>function call, or in line with a variable.
>
>The last element must be OVERLAY.
>The OVERLAY is automatically created by semantic from an input that
>consists of START and END.  When building a parser table, use START
>and END as positions in the buffer.
>
>It may seem odd to place NAME in slot 0, and the type-symbol in slot
>1, but this turns the returned elements into a list which can be used
>by alist based function.  This makes it ideal for passing into generic
>sorters, string completion functions, and list searching functions.
>
>In the below entry formats, \"NAME\" is a string which is the name of
>the object in question.  It is possible for this to be nil in some
>situations, and code dealing with entries should try to be aware of
>these situations.
>
>\"TYPE\" is a string representing the type of some objects.  For a
>variable, this could very well be another top level token representing
>a type nonterminal.
>
>TOP-LEVEL ENTRIES:
>
> (\"NAME\" variable \"TYPE\" CONST DEFAULT-VALUE MODIFIERS [OPTSUFFIX]
>           \"DOCSTRING\" OVERLAY)
>   The definition of a variable, or constant.
>   CONST is a boolean representing if this variable is considered a constant.
>   DEFAULT-VALUE can be something apropriate such a a string,
>                 or list of parsed elements.
>   MODIFIERS are details about a variable that are not covered in the TYPE.
>   OPTSUFFIX is an optional field specifying trailing modifiers such as
>             array dimentions or bit fields.
>   DOCSTRING is optional.
>
> (\"NAME\" function \"TYPE\" ( ARG-LIST ) MODIFIERS [THROWS]
>          \"DOCSTRING\" OVERLAY)
>   A function/procedure definition.
>   ARG-LIST is a list of variable definitions.
>   THROWS is an optional argument for functions or methods in languages
>   that support typed signal throwing.
>   DOCSTRING is optional.
>
> (\"NAME\" type \"TYPE\" ( PART-LIST ) ( PARENTS ) MODIFIERS
>          \"DOCSTRING\" OVERLAY)
>   A type definition.
>   TYPE of a type could be anything, such as (in C) struct, union, typedef,
>   or class.
>   PART-LIST is only useful for structs that have multiple individual parts.
>            (It is recommended that these be variables, functions or types).
>   PARENTS is strictly for classes where there is inheritance.
>   
>
> (\"FILE\" include SYSTEM \"DOCSTRING\" OVERLAY)
>   In C, an #include statement.  In elisp, a require statement.
>   Indicates additional locations of sources or definitions.
>   SYSTEM is true if this include is part of a set of system includes.
>
> (\"NAME\" package DETAIL \"DOCSTRING\" OVERLAY)
>   In Emacs Lisp, a `provide' statement.  DETAIL might be an
>   associated file name.
>
>OTHER ENTRIES:")
>(make-variable-buffer-local 'semantic-toplevel-bovine-table)
>
>(defvar semantic-symbol->name-assoc-list
>  '((variable . "Variables")
>    (function . "Functions")
>    (type . "Types")
>    (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-case-fold nil
>  "Value for `case-fold-search' when parsing.")
>(make-variable-buffer-local 'semantic-case-fold)
>
>(defvar semantic-flex-depth 0
>  "Default flexing depth.
>This specifies how many lists to create tokens in.")
>(make-variable-buffer-local 'semantic-flex-depth)
>
>(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-expand-nonterminal nil
>  "Function to call for each returned Non-terminal.
>Return a list of non-terminals derived from the first argument, or nil
>if it does not need to be expanded.")
>(make-variable-buffer-local 'semantic-expand-nonterminal)
>
>(defvar semantic-toplevel-bovine-cache nil
>  "A cached copy of a recent bovination, plus state.
>If no significant changes have been made (based on the state) then
>this is returned instead of re-parsing the buffer.")
>(make-variable-buffer-local 'semantic-toplevel-bovine-cache)
>
>(defvar semantic-toplevel-bovine-cache-check nil
>  "Non nil if the bovine cache is out of date.
>This is tracked with `semantic-change-function'.")
>(make-variable-buffer-local 'semantic-toplevel-bovine-cache-check)
>
>(defvar semantic-toplevel-bovinate-override nil
>  "Local variable set by major modes which provide their own bovination.
>This function should behave as the function `semantic-bovinate-toplevel'.")
>(make-variable-buffer-local 'semantic-toplevel-bovinate-override)
>
>(defvar semantic-after-toplevel-bovinate-hook nil
>  "Hooks run after a toplevel token parse.
>It is not run if the toplevel parse command is called, and buffer does
>not need to be reparsed.
>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 nonterminal cache is flushed.
>For language specific hooks, make sure you define this as a local hook.")
>
>(defvar semantic-reparse-needed-change-hook nil
>  "Hooks run when a user edit is detected as needing a reparse.
>For language specific hooks, make sure you define this as a local hook.")
>
>(defvar semantic-no-reparse-needed-change-hook nil
>  "Hooks run when a user edit is detected as not needing a reparse.
>If the hook returns non-nil, then declare that a reparse is needed.
>For language specific hooks, make sure you define this as a local hook.")
>
>
>;;; Utility API functions
>;;
>;; These functions use the flex and bovination engines to perform some
>;; simple tasks useful to other programs.  These are just the most
>;; critical entries.
>;;
>;; See semantic-util for a wider range of utility functions and macros.
>;;
>(defmacro semantic-token-token (token)
>  "Retrieve from TOKEN the token identifier.
>ie, the symbol 'variable, 'function, 'type, or other."
>  `(nth 1 ,token))
>
>(defun semantic-token-name (token)
>  "Retrieve the name of TOKEN."
>  (car token))
>
>(defun semantic-token-docstring (token &optional buffer)
>  "Retrieve the documentation of TOKEN.
>Optional argument BUFFER indicates where to get the text from.
>If not provided, then only the POSITION can be provided."
>  (let ((p (nth (- (length token) 2) token)))
>    (if (and p buffer)
>       (save-excursion
>         (set-buffer buffer)
>         (semantic-flex-text (car (semantic-flex p (1+ p)))))
>      p)))
>
>(defmacro semantic-token-overlay (token)
>  "Retrieve the OVERLAY part of TOKEN."
>  `(nth (- (length ,token) 1) ,token))
>
>(defmacro semantic-token-extent (token)
>  "Retrieve the extent (START END) of TOKEN."
>  `(let ((over (semantic-token-overlay ,token)))
>     (list (semantic-overlay-start over) (semantic-overlay-end over))))
>
>(defmacro semantic-token-start (token)
>  "Retrieve the start location of TOKEN."
>  `(semantic-overlay-start (semantic-token-overlay ,token)))
>
>(defmacro semantic-token-end (token)
>  "Retrieve the end location of TOKEN."
>  `(semantic-overlay-end (semantic-token-overlay ,token)))
>
>(defmacro semantic-token-buffer (token)
>  "Retrieve the buffer TOKEN resides in."
>  `(semantic-overlay-buffer (semantic-token-overlay ,token)))
>
>(defun semantic-token-p (token)
>  "Return non-nil if TOKEN is most likely a semantic token."
>  (and (listp token)
>       (stringp (car token))
>       (symbolp (car (cdr token)))))
>
>;;; Parsing functions
>;;
>(defvar semantic-overlay-error-recovery-stack nil
>  "List of overlays used during error recovery.")
>
>(defun semantic-overlay-stack-add (o)
>  "Add overlay O to the error recovery stack."
>  (setq semantic-overlay-error-recovery-stack
>       (if (listp o)
>           (append o semantic-overlay-error-recovery-stack)
>         (cons o semantic-overlay-error-recovery-stack))))
>
>(defun semantic-overlay-stack-clear ()
>  "Clear the overlay error recovery stack."
>  (while semantic-overlay-error-recovery-stack
>    (semantic-overlay-delete (car semantic-overlay-error-recovery-stack))
>    (setq semantic-overlay-error-recovery-stack
>         (cdr semantic-overlay-error-recovery-stack))))
>
>(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)))
>
>(defun semantic-clear-toplevel-cache ()
>  "Clear the toplevel bovin cache for the current buffer."
>  (interactive)
>  (run-hooks 'semantic-before-toplevel-cache-flush-hook)
>  (setq semantic-toplevel-bovine-cache nil)
>  ;; Nuke all semantic overlays.  This is faster than deleting based
>  ;; on our data structure.
>  (let ((l (semantic-overlay-lists)))
>    (mapcar 'semantic-delete-overlay-maybe (car l))
>    (mapcar 'semantic-delete-overlay-maybe (cdr l))
>    )
>  ;; Remove this hook which tracks if a buffer is up to date or not.
>  (remove-hook 'after-change-functions 'semantic-change-function t)
>  )
>(add-hook 'change-major-mode-hook 'semantic-clear-toplevel-cache)
>
>;;;###autoload
>(defun semantic-bovinate-toplevel (&optional checkcache)
>  "Bovinate the entire current buffer.
>If the optional argument CHECKCACHE is non-nil, then flush the cache iff
>there has been a size change."
>  (if (and semantic-toplevel-bovine-cache
>          checkcache
>          semantic-toplevel-bovine-cache-check)
>      (semantic-clear-toplevel-cache))
>  (prog1
>      (cond
>       (semantic-toplevel-bovinate-override
>       (funcall semantic-toplevel-bovinate-override checkcache))
>       ((and semantic-toplevel-bovine-cache
>            (car semantic-toplevel-bovine-cache)
>            ;; Add a rule that knows how to see if there have
>            ;; been "big chagnes"
>            )
>       (car semantic-toplevel-bovine-cache))
>       (t
>       (let ((ss (semantic-flex (point-min) (point-max)))
>             (res nil)
>             (semantic-overlay-error-recovery-stack nil))
>         ;; Init a dump
>         (if semantic-dump-parse (semantic-dump-buffer-init))
>         ;; Parse!
>         (working-status-forms (buffer-name) "done"
>           (setq res
>                 (semantic-bovinate-nonterminals
>                  ss 'bovine-toplevel semantic-flex-depth))
>           (working-status t))
>         (setq semantic-toplevel-bovine-cache
>               (list (nreverse res) (point-max))
>               semantic-toplevel-bovine-cache-check nil)
>         (add-hook 'after-change-functions 'semantic-change-function nil t)
>         (run-hooks 'semantic-after-toplevel-bovinate-hook)
>         (car semantic-toplevel-bovine-cache))))
>    ))
>
>(defun semantic-change-function (start end length)
>  "Run whenever a buffer controlled by `semantic-mode' change.
>Tracks when and how the buffer is re-parsed.
>Argument START, END, and LENGTH specify the bounds of the change."
>  (when (not semantic-toplevel-bovine-cache-check)
>    (let ((tl (condition-case nil
>                 (semantic-find-nonterminal-by-overlay-in-region
>                  (1- start) (1+ end))
>               (error nil))))
>      (if tl
>         ;; Loop over the token list
>         (while tl
>           (cond
>            ;; If we are completely enclosed in this overlay, throw away.
>            ((and (> start (semantic-token-start (car tl)))
>                  (< end (semantic-token-end (car tl))))
>             (if (and (eq (semantic-token-token (car tl)) 'type)
>                      (not (cdr tl))
>                      (semantic-token-type-parts (car tl)))
>                 (progn
>                   ;; This is between two items in a type with
>                   ;; stuff in it.
>                   (setq semantic-toplevel-bovine-cache-check t)
>                   (run-hooks 'semantic-reparse-needed-change-hook))
>               ;; This is might be ok, chuck it.
>               (if (run-hooks 'semantic-no-reparse-needed-change-hook)
>                   (progn
>                     ;; The hook says so, so flush it.
>                     (setq semantic-toplevel-bovine-cache-check t)
>                     (run-hooks 'semantic-reparse-needed-change-hook))
>                 nil)))
>            ;; If we  cover the beginning or end of this item, we must
>            ;; reparse this object.
>            (t
>             (setq semantic-toplevel-bovine-cache-check t)
>             (run-hooks 'semantic-reparse-needed-change-hook)))
>           ;; next
>           (setq tl (cdr tl)))
>       ;; There was no hit, perhaps we need to reparse this intermediate area.
>       (setq semantic-toplevel-bovine-cache-check t)
>       )
>      (if semantic-toplevel-bovine-cache-check
>         (message "Reparse needed...")))))
>
>(defun semantic-bovinate-nonterminals (stream nonterm &optional
>                                             depth returnonerror)
>  "Bovinate the entire stream STREAM starting with NONTERM.
>DEPTH is optional, and defaults to 0.
>Optional argument RETURNONERROR indicates that the parser should exit with
>the current results on a parse error."
>  (if (not depth) (setq depth semantic-flex-depth))
>  (let ((result nil) (case-fold-search semantic-case-fold))
>    (while stream
>      (let* ((nontermsym
>             (semantic-bovinate-nonterminal
>              stream semantic-toplevel-bovine-table nonterm))
>            (stream-overlays (car (cdr (cdr nontermsym))))
>            (tmpet nil)
>            (token (car (cdr nontermsym)))
>            (ncdr (- (length token) 2))
>            (startcdr (if (natnump ncdr) (nthcdr ncdr token))))
>       (if (not nontermsym)
>           (error "Parse error @ %d" (car (cdr (car stream)))))
>       (semantic-overlay-stack-add stream-overlays)
>       (if token
>           (let ((o (condition-case nil
>                        (semantic-make-overlay (car startcdr)
>                                               (car (cdr startcdr))
>                                               (current-buffer)
>                                               ;; Examin start/rear
>                                               ;; advance flags.
>                                               )
>                      (error (debug token)
>                             nil))))
>             ;; Convert START/END into an overlay.
>             (setcdr startcdr nil)
>             (setcar startcdr o)
>             (semantic-overlay-put o 'semantic token)
>             ;; Expand based on local configuration
>             (if (not semantic-expand-nonterminal)
>                 ;; no expanders
>                 (setq result (cons token result))
>               ;; Glom generated tokens
>               (setq tmpet (funcall semantic-expand-nonterminal token))
>               (if (not tmpet)
>                   (progn (setq result (cons token result))
>                          (semantic-overlay-stack-add o))
>                 ;; Fixup all overlays, start by deleting the old one
>                 (let ((motok tmpet) o start end)
>                   (while motok
>                     (setq startcdr (nthcdr (- (length (car motok)) 1)
>                                            (car motok))
>                           ;; this will support new overlays created by
>                           ;; the special function, or recycles
>                           start (if (semantic-overlay-live-p (car startcdr))
>                                     (semantic-overlay-start (car startcdr))
>                                   start)
>                           end (if (semantic-overlay-live-p (car startcdr))
>                                   (semantic-overlay-end (car startcdr))
>                                 end)
>                           o (semantic-make-overlay start end
>                                                    (current-buffer)))
>                     (if (semantic-overlay-live-p (car startcdr))
>                         (semantic-overlay-delete (semantic-token-overlay
>                                                   (car motok))))
>                     (semantic-overlay-stack-add o)
>                     (setcdr startcdr nil)
>                     (setcar startcdr o)
>                     (semantic-overlay-put o 'semantic (car motok))
>                     (setq motok (cdr motok))))
>                 (setq result (append tmpet result)))))
>         (if returnonerror (setq stream nil))
>         ;;(error "Parse error")
>         )
>       ;; Designated to ignore.
>       (setq stream (car nontermsym)))
>      (if stream
>         (working-status (floor
>                          (* 100.0 (/ (float (car (cdr (car stream))))
>                                      (float (point-max))))))))
>    result))
>
>
>;;; Semantic Bovination
>;;
>;; Take a semantic token stream, and convert it using the bovinator.
>;; The bovinator takes a state table, and converts the token stream
>;; into a new semantic stream defined by the bovination table.
>;;
>(defun semantic-bovinate-nonterminal (stream table &optional nonterminal)
>  "Bovinate STREAM based on the TABLE of nonterminal symbols.
>Optional argument NONTERMINAL is the nonterminal symbol to start with.
>Use `bovine-toplevel' if it is not provided."
>  (if (not nonterminal) (setq nonterminal 'bovine-toplevel))
>  (let ((ml (assq nonterminal table)))
>    (semantic-bovinate-stream stream (cdr ml) table)))
>
>(defsubst semantic-bovinate-symbol-nonterminal-p (sym table)
>  "Return non-nil if SYM is in TABLE, indicating it is NONTERMINAL."
>  ;; sym is always a sym, so assq should be ok.
>  (if (assq sym table) t nil))
>
>(defun semantic-bovinate-stream (stream matchlist table)
>  "Bovinate STREAM using MATCHLIST resolving nonterminals with TABLE.
>This is the core routine for converting a stream into a table.
>See the variable `semantic-toplevel-bovine-table' for details on the
>format of MATCHLIST.
>Return the list (STREAM SEMANTIC-STREAM OVERLAYS) where STREAM are those
>elements of STREAM that have not been used.  SEMANTIC-STREAM is the
>list of semantic tokens found.  OVERLAYS is the list of overlays found
>so far, to be used in the error recovery stack."
>  (let ((s   nil)                      ;Temp Stream Tracker
>       (lse nil)                       ;Local Semantic Element
>       (lte nil)                       ;Local matchlist element
>       (tev nil)                       ;Matchlist entry values from buffer
>       (val nil)                       ;Value found in buffer.
>       (cvl nil)                       ;collected values list.
>       (out nil)                       ;Output
>       (ov nil)                        ;Overlay
>       (s-stack nil)                   ;rollback stream stack
>       (start nil)                     ;the beginning and end.
>       (end nil)
>       (db-mlen (length matchlist))
>       (db-tlen 0)
>       (semantic-overlay-error-recovery-stack nil) ;part of error recovery
>       )
>    ;; prime the rollback stack
>    (setq s-stack (cons stream s-stack)
>         start (car (cdr (car stream)))
>         end (cdr (cdr (car stream))))
>    (while matchlist
>      (setq s (car s-stack)            ;init s from the stack.
>           cvl nil                     ;re-init the collected value list.
>           lte (car matchlist)         ;Get the local matchlist entry.
>           db-tlen (length lte))       ;length of the local match.
>      (if (or (byte-code-function-p (car lte))
>             (listp (car lte)))
>         ;; In this case, we have an EMPTY match!  Make stuff up.
>         (setq cvl (list nil)))
>      (while (and lte (not (or (byte-code-function-p (car lte))
>                              (listp (car lte)))))
>       ;; debugging!
>       (if (and lte semantic-edebug)
>           ;; The below reference to nonterminal is a hack and the byte
>           ;; compiler will complain about it.
>           (let ((r (semantic-bovinate-show (car s) nonterminal
>                                            (- db-mlen (length matchlist))
>                                            (- db-tlen (length lte))
>                                            cvl)))
>             (cond ((eq r 'fail)
>                    (setq lte '(trash 0 . 0)))
>                   (t nil))))
>       (cond
>        ;; We have a nonterminal symbol.  Recurse inline.
>        ((semantic-bovinate-symbol-nonterminal-p (car lte) table)
>         (let ((nontermout (semantic-bovinate-nonterminal s table (car lte))))
>           (setq s (car nontermout)
>                 val (car (cdr nontermout))
>                 ov (car (cdr (cdr nontermout))))
>           (if ov (semantic-overlay-stack-add ov))
>           (if val
>               (let ((len (length val))
>                     (strip (nreverse (cdr (cdr (reverse val))))))
>                 (if semantic-dump-parse
>                     (semantic-dump-detail (cdr nontermout)
>                                           (car lte)
>                                           ""
>                                           "NonTerm Match"))
>                 (setq end (nth (1- len) val) ;reset end to the end of exp
>                       cvl (cons strip cvl) ;prepend value of exp
>                       lte (cdr lte)) ;update the local table entry
>                 )
>             ;; No value means that we need to terminate this match.
>             (semantic-overlay-stack-clear)
>             (setq lte nil cvl nil)) ;No match, exit
>           ))
>        ;; Default case
>        (t
>         (setq lse (car s)             ;Get the local stream element
>               s (cdr s))              ;update stream.
>         ;; Do the compare
>         (if (eq (car lte) (car lse))  ;syntactic match
>             (let ((valdot (cdr lse)))
>               (setq val (semantic-flex-text lse))
>               ;; DEBUG SECTION
>               (if semantic-dump-parse
>                   (semantic-dump-detail
>                    (if (stringp (car (cdr lte)))
>                        (list (car (cdr lte)) (car lte))
>                      (list (car lte)))
>                    nonterminal val
>                    (if (stringp (car (cdr lte)))
>                        (if (string-match (car (cdr lte)) val)
>                            "Term Match" "Term Fail")
>                      "Term Type=")))
>               ;; END DEBUG SECTION
>               (setq lte (cdr lte))
>               (if (stringp (car lte))
>                   (progn
>                     (setq tev (car lte)
>                           lte (cdr lte))
>                     (if (string-match tev val)
>                         (setq cvl (cons val cvl)) ;append this value
>                       (semantic-overlay-stack-clear)
>                       (setq lte nil cvl nil))) ;clear the entry (exit)
>                 (setq cvl (cons
>                            (if (member (car lse)
>                                        '(comment semantic-list))
>                                valdot val) cvl))) ;append unchecked value.
>               (setq end (cdr (cdr lse)))
>               )
>           (if (and semantic-dump-parse nil)
>               (semantic-dump-detail (car lte)
>                                     nonterminal (semantic-flex-text lse)
>                                     "Term Type Fail"))
>           (semantic-overlay-stack-clear)
>           (setq lte nil cvl nil))     ;No more matches, exit
>         )))
>      (if (not cvl)                    ;lte=nil;  there was no match.
>         (setq matchlist (cdr matchlist)) ;Move to next matchlist entry
>       (setq out (if (car lte)
>; REMOVE THIS TO USE THE REFERENCE/COMPARE CODE
>;                    (let ((o (apply (car lte) ;call matchlist fn on values
>;                                    (nreverse cvl) start (list end))))
>;                      (if semantic-bovinate-create-reference
(semantic-bovinate-add-reference o))
>;                      (if semantic-bovinate-compare-reference
(semantic-bovinate-compare-against-reference o))
>;                      o
>;                      )
>                     (funcall (car lte)        ;call matchlist fn on values
>                              (nreverse cvl) start end)
>                   (cond ((and (= (length cvl) 1)
>                               (listp (car cvl))
>                               (not (numberp (car (car cvl)))) )
>                          (append (car cvl) (list start end)))
>                         (t
>                          (append (nreverse cvl) (list start end))))
>                   )
>             matchlist nil)            ;generate exit condition
>       (if (not end) (setq out nil))
>       ;; Nothin?
>       ))
>    (list s out semantic-overlay-error-recovery-stack)))
>
>
>;;; Bovine table functions
>;;
>;; These are functions that can be called from within a bovine table.
>;; Most of these have code auto-generated from other construct in the BNF.
>(defmacro semantic-lambda (&rest return-val)
>  "Create a lambda expression to return a list including RETURN-VAL.
>The return list is a lambda expression to be used in a bovine table."
>  `(lambda (vals start end)
>     (append ,@return-val (list start end))))
>
>(defun semantic-bovinate-from-nonterminal (start end nonterm
>                                                &optional depth length)
>  "Bovinate from within a nonterminal lambda from START to END.
>Depends on the existing environment created by `semantic-bovinate-stream'.
>Argument NONTERM is the nonterminal symbol to start with.
>Optional argument DEPTH is the depth of lists to dive into.
>Whan 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-bovinate-nonterminal
>                 (semantic-flex start end (or depth 1) length)
>                 ;; the byte compiler will complain about TABLE
>                 table
>                 nonterm))))
>
>(defun semantic-bovinate-from-nonterminal-full (start end nonterm
>                                                     &optional depth)
>  "Bovinate from within a nonterminal lambda from START to END.
>Iterates until all the space between START and END is exhausted.
>Depends on the existing environment created by `semantic-bovinate-stream'.
>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.
>Whan used in a `lambda' of a MATCH-LIST, there is no need to include
>a START and END part."
>  (nreverse
>   (semantic-bovinate-nonterminals (semantic-flex start end (or depth 1))
>                                  nonterm
>                                  depth)))
>
>(defun semantic-bovinate-block-until-header (start end nonterm &optional
depth)
>  "Bovinate between START and END starting with NONTERM.
>If NONTERM is nil, start with `bovine-block-toplevel'.
>Optinal 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-block-toplevel' can also support
>commands, use `semantic-bovinate-from-nonterminal-full'."
>  (nreverse
>   (semantic-bovinate-nonterminals (semantic-flex start end (or depth 1))
>                                  nonterm
>                                  depth
>                                  ;; This says stop on an error.
>                                  t)))
>
>
>;;; Debugging in bovine tables
>;;
>(defun semantic-dump-buffer-init ()
>  "Initialize the semantic dump buffer."
>  (save-excursion
>    (let ((obn (buffer-name)))
>      (set-buffer (get-buffer-create "*Semantic Dump*"))
>      (erase-buffer)
>      (insert "Parse dump of " obn "\n\n")
>      (insert (format "%-15s %-15s %10s %s\n\n"
>                     "Nonterm" "Comment" "Text" "Context"))
>      )))
>
>(defun semantic-dump-detail (lse nonterminal text comment)
>  "Dump info about this match.
>Argument LSE is the current syntactic element.
>Argument NONTERMINAL is the nonterminal matched.
>Argument TEXT is the text to match.
>Argument COMMENT is additional description."
>  (save-excursion
>    (set-buffer "*Semantic Dump*")
>    (goto-char (point-max))
>    (insert (format "%-15S %-15s %10s %S\n" nonterminal comment text lse)))
>  )
>
>(defvar semantic-bovinate-debug-table nil
>  "A marker where the current table we are debugging is.")
>
>(defun semantic-bovinate-debug-set-table ()
>  "Set the table for the next debug to be here."
>  (interactive)
>  (if (not (eq major-mode 'emacs-lisp-mode))
>      (error "Not an Emacs Lisp file"))
>  (beginning-of-defun)
>  (setq semantic-bovinate-debug-table (point-marker)))
>
>(defun semantic-bovinate-debug-buffer ()
>  "Bovinate the current buffer in debug mode."
>  (interactive)
>  (if (not semantic-bovinate-debug-table)
>      (error
>       "Call `semantic-bovinate-debug-set-table' from your semantic table"))
>  (let ((semantic-edebug t))
>    (delete-other-windows)
>    (split-window-vertically)
>    (switch-to-buffer (marker-buffer semantic-bovinate-debug-table))
>    (other-window 1)
>    (semantic-clear-toplevel-cache)
>    (semantic-bovinate-toplevel)))
>
>(defun semantic-bovinate-show (lse nonterminal matchlen tokenlen collection)
>  "Display some info about the current parse.
>Returns 'fail if the user quits, nil otherwise.
>LSE is the current listed syntax element.
>NONTERMINAL is the current nonterminal being parsed.
>MATCHLEN is the number of match lists tried.
>TOKENLEN is the number of match tokens tried.
>COLLECTION is the list of things collected so far."
>  (let ((ol1 nil) (ol2 nil) (ret nil))
>    (unwind-protect
>       (progn
>         (goto-char (car (cdr lse)))
>         (setq ol1 (semantic-make-overlay (car (cdr lse)) (cdr (cdr lse))))
>         (semantic-overlay-put ol1 'face 'highlight)
>         (goto-char (car (cdr lse)))
>         (if window-system nil (sit-for 1))
>         (other-window 1)
>         (set-buffer (marker-buffer semantic-bovinate-debug-table))
>         (goto-char semantic-bovinate-debug-table)
>         (re-search-forward
>          (concat "^\\s-*\\((\\|['`]((\\)\\(" (symbol-name nonterminal)
>                  "\\)[ \t\n]+(")
>          nil t)
>         (setq ol2 (semantic-make-overlay (match-beginning 2) (match-end 2)))
>         (semantic-overlay-put ol2 'face 'highlight)
>         (forward-char -2)
>         (forward-list matchlen)
>         (skip-chars-forward " \t\n(")
>         (forward-sexp tokenlen)
>         (message "%s: %S" lse collection)
>         (let ((e (read-event)))
>           (cond ((eq e ?f)            ;force a failure on this symbol.
>                  (setq ret 'fail))
>                 (t nil)))
>         (other-window 1)
>         )
>      (semantic-overlay-delete ol1)
>      (semantic-overlay-delete ol2))
>    ret))
>
>;;; Reference Debugging
>;;
>(defvar semantic-bovinate-create-reference nil
>  "Non nil to create a reference.")
>
>(defvar semantic-bovinate-reference-token-list nil
>  "A list generated as a referece (assumed valid).
>A second pass comares return values against this list.")
>
>(defun semantic-bovinate-add-reference (ref)
>  "Add REF to the reference list."
>  (setq semantic-bovinate-reference-token-list
>       (cons ref semantic-bovinate-reference-token-list)))
>
>(defvar semantic-bovinate-compare-reference nil
>  "Non nil to compare against a reference list.")
>
>(defvar semantic-bovinate-reference-temp-list nil
>  "List used when doing a compare.")
>
>(defun semantic-bovinate-compare-against-reference (ref)
>  "Compare REF against what was returned last time."
>  (if (not (equal ref (car semantic-bovinate-reference-temp-list)))
>      (let ((debug-on-error t))
>       (error "Stop: %d %S != %S"
>              (- (length semantic-bovinate-reference-token-list)
>                 (length semantic-bovinate-reference-temp-list))
>              (car semantic-bovinate-reference-temp-list)
>              ref))
>    (setq semantic-bovinate-reference-temp-list
>         (cdr semantic-bovinate-reference-temp-list))))
>          
>(defun bovinate-create-reference ()
>  "Create a reference list."
>  (interactive)
>  (condition-case nil
>      (progn
>       (semantic-clear-toplevel-cache)
>       (setq semantic-bovinate-create-reference t
>             semantic-bovinate-reference-token-list nil)
>       (bovinate)
>       (setq semantic-bovinate-reference-token-list
>             (nreverse semantic-bovinate-reference-token-list)))
>    (error nil))
>  (setq semantic-bovinate-create-reference nil))
>
>(defun bovinate-reference-compare ()
>  "Compare the current parsed output to the reference list.
>Create a reference with `bovinate-create-reference'."
>  (interactive)
>  (let ((semantic-bovinate-compare-reference t))
>    (semantic-clear-toplevel-cache)
>    (setq semantic-bovinate-reference-temp-list
>         semantic-bovinate-reference-token-list)
>    (bovinate)))
>
>
>;;; Semantic Flexing
>;;
>;; This is a simple scanner which uses the syntax table to generate
>;; a stream of simple tokens.
>;;
>;; A flex element is of the form:
>;;  (SYMBOL START . END)
>;; Where symbol is the type of thing it is.  START and END mark that
>;; objects boundary.
>
>(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)
>  "Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
>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))))))
>
>))
>
>(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.")
>(make-variable-buffer-local 'semantic-flex-extensions)
>
>(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)
>
>(defvar semantic-flex-syntax-modifications nil
>  "Updates to the syntax table for this buffer.
>These changes are active only while this file is being flexed.
>This is a list where each element is of the form:
>  (CHAR CLASS)
>Where CHAR is the char passed to `modify-syntax-entry',
>and CLASS is the string also passed to `modify-syntax-entry' to define
>what class of syntax CHAR is.")
>(make-variable-buffer-local 'semantic-flex-syntax-modifications)
>
>(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)
>
>(defun semantic-flex-make-keyword-table (keywords)
>  "Convert a list of KEYWORDS into an obarray.
>Save the obarry into `semantic-flex-keywords-obarray'."
>  ;; Create the symbol hash table
>  (let ((obarray (make-vector 13 nil)))
>    ;; fill it with stuff
>    (while keywords
>      (set (intern (car (car keywords)) obarray)
>          (cdr (car keywords)))
>      (setq keywords (cdr keywords)))
>    obarray))
>
>(defun semantic-flex-is-keyword (text)
>  "Return a symbol if TEXT is a keyword."
>  (let ((sym (intern-soft text semantic-flex-keywords-obarray)))
>    (if sym (symbol-value sym))))
>
>(defun semantic-flex-buffer (&optional depth)
>  "Sematically flex the current buffer.
>Optional argument DEPTH is the depth to scan into lists."
>  (semantic-flex (point-min) (point-max) 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 being a list, such
>as (symbol start-expression .  end-expresssion).
>END does not mark the end of text scanned, only the end of the beginning
>of text scanned.  Thus, if a string extended past END, the end of the
>return token will be larger than END.  To truly restrict scanning, using
>narrow-to-region'.
>The last argument, LENGTH specifies that `semantic-flex' should only return
>LENGTH tokens."
>  ;(message "Flexing muscles...")
>  (if (not semantic-flex-keywords-obarray)
>      (setq semantic-flex-keywords-obarray [ nil ]))
>  (let ((ts nil)
>       (sym 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 newlines when needed
>              (and semantic-flex-enable-newlines
>                   (looking-at "\n"))
>              (setq ts (cons (cons 'newline
>                                   (cons (match-beginning 0) (match-end 0)))
>                             ts)))
>             ;; special extentions, sometimes includes some whitespace.
>             ((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)))
>             ;; comment end is also EOL for some languages.
>             ((looking-at "\\(\\s-\\|\\s>\\)+"))
>             ;; symbols
>             ((looking-at "\\(\\sw\\|\\s_\\)+")
>              (setq ts (cons (cons
>                              ;; Get info on if this is a keyword or not
>                              (or (semantic-flex-is-keyword (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 (point-max))))
>                                        (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
>                                           (forward-sexp 1)
>                                           (setq ep (point)))))
>                             ts)))
>             ((looking-at cs)
>              (if semantic-ignore-comments
>                  ;; If the language doesn't deal with comments,
>                  ;; ignore them here.
>                  (progn (forward-comment 1)
>                         (setq ep (point)))
>                ;; Language wants comments, link them together.
>                (if (eq (car (car ts)) 'comment)
>                    (setcdr (cdr (car ts)) (save-excursion
>                                             (forward-comment 1)
>                                             (setq ep (point))))
>                  (setq ts (cons (cons 'comment
>                                       (cons (match-beginning 0)
>                                             (save-excursion
>                                               (forward-comment 1)
>                                               (setq ep (point)))))
>                                 ts)))))
>             ((looking-at "\\(\\s.\\|\\s$\\|\\s'\\)")
>              (setq ts (cons (cons 'punctuation
>                                   (cons (match-beginning 0) (match-end 0)))
>                             ts)))
>             (t (error "What is that?")))
>       (goto-char (or ep (match-end 0)))
>       (setq ep nil)))
>    (goto-char pos)
>    ;(message "Flexing muscles...done")
>    (nreverse ts)))
>
>(defun semantic-flex-text (semobj)
>  "Fetch the text associated with the semantic object SEMOBJ."
>  (buffer-substring-no-properties (car (cdr semobj)) (cdr (cdr semobj))))
>
>(defun semantic-flex-list (semlist depth)
>  "Flex the body of SEMLIST to DEPTH."
>  (semantic-flex (car (cdr semlist)) (cdr (cdr semlist)) depth))
>
>(defun semantic-flex-start (semobj)
>  "Fetch the start position of the semantic object SEMOBJ."
>  (nth 1 semobj))
>
>(defun semantic-flex-end (semobj)
>  "Fetch the end position of the semantic object SEMOBJ."
>  (cdr (cdr semobj)))
>
>;;; Settings and autoloads
>;;
>(autoload 'semantic-create-imenu-index "semantic-imenu"
>  "Create an imenu index for any buffer which supports Semantic.")
>(autoload 'bovinate "semantic-util"
>  "Bovinate the current buffer.  Show output in a temp buffer.
>Optional argument CLEAR will clear the cache before bovinating." t)
>(autoload 'bovinate-debug "semantic-util"
>  "Bovinate the current buffer and run in debug mode." t)
>
>(provide 'semantic)
>
>;;; semantic.el ends here
>
>

Reply via email to