* cedet/ede/system.el (ede-upload-html-documentation)old-branches/cedet-branch

(ede-upload-distribution, ede-edit-web-page)
(ede-web-browse-home): Autoload.

* cedet/ede/proj-elisp.el: Add autoload for
semantic-ede-proj-target-grammar.

* cedet/semantic.el (navigate-menu): Show menu items only if
semantic-mode is enabled.

* cedet/ede.el: Remove comments.

* cedet/cedet.el (cedet-menu-map): Minor doc fix.

* cedet/semantic/grammar.el:
* cedet/semantic/grammar-wy.el:
* cedet/semantic/ede-grammar.el: New files.

* cedet/semantic/db-mode.el (global-semanticdb-minor-mode): Define
using define-minor-mode, so that the usual mode variable exists.

9 files changed, 2651 insertions, 88 deletions

diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el
index 8dcbfd6a414..c98dc9b8893 100644
--- a/lisp/cedet/cedet.el
+++ b/lisp/cedet/cedet.el
@@ -65,12 +65,12 @@
     (define-key map [global-semantic-idle-scheduler-mode]   'undefined)
     (define-key map [semantic-menu-separator] '("--"))
     (define-key map [semantic-mode]
-      '(menu-item "Enable parsers (Semantic)" semantic-mode
+      '(menu-item "Enable Parsers (Semantic)" semantic-mode
 		  :help "Enable language parsers (Semantic)"
 		  :visible (not (bound-and-true-p semantic-mode))))
     (define-key map [cedet-menu-separator] 'undefined)
     (define-key map [ede-mode]
-      '(menu-item "Enable Projects (EDE)" global-ede-mode
+      '(menu-item "Enable Project Support (EDE)" global-ede-mode
 		  :help "Enable the Emacs Development Environment (EDE)"
 		  :visible (not (bound-and-true-p global-ede-mode))))
     (define-key map [ede-menu-separator] '("--"))
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 8240961c257..65da831660e 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1981,18 +1981,6 @@ Display the results as a debug list."
 ;; 	    (def-edebug-spec ede-with-projectfile
 ;; 	      (form def-body))))
 
-;; (autoload 'ede-web-browse-home "ede-system" t
-;;   "Web browse this project's home page.")
-
-;; (autoload 'ede-edit-web-page "ede-system" t
-;;   "Edit the web site for this project.")
-
-;; (autoload 'ede-upload-distribution "ede-system" t
-;;   "Upload the dist for this project to the upload site.")
-
-;; (autoload 'ede-upload-html-documentation "ede-system" t
-;;   "Upload auto-generated HTML to the web site.")
-
 (provide 'ede)
 
 ;; Include this last because it depends on ede.
diff --git a/lisp/cedet/ede/proj-elisp.el b/lisp/cedet/ede/proj-elisp.el
index 068daae44de..1838bad00e0 100644
--- a/lisp/cedet/ede/proj-elisp.el
+++ b/lisp/cedet/ede/proj-elisp.el
@@ -29,6 +29,8 @@
 (require 'ede/pmake)
 (require 'ede/pconf)
 
+(autoload 'semantic-ede-proj-target-grammar "semantic/ede-grammar")
+
 ;;; Code:
 (defclass ede-proj-target-elisp (ede-proj-target-makefile)
   ((menu :initform nil)
diff --git a/lisp/cedet/ede/system.el b/lisp/cedet/ede/system.el
index ad917cf6b1b..db2b9a2c9a4 100644
--- a/lisp/cedet/ede/system.el
+++ b/lisp/cedet/ede/system.el
@@ -31,7 +31,8 @@
 ;;; Code:
 
 ;;; Web/FTP site node.
-;;
+
+;;;###autoload
 (defun ede-web-browse-home ()
   "Browse the home page of the current project."
   (interactive)
@@ -44,7 +45,7 @@
     (browse-url home)
     ))
 
-
+;;;###autoload
 (defun ede-edit-web-page ()
   "Edit the web site for this project."
   (interactive)
@@ -62,7 +63,7 @@
 	  (error "No project file found")))
     (find-file endfile)))
 
-
+;;;###autoload
 (defun ede-upload-distribution ()
   "Upload the current distribution to the correct location.
 Use /user@ftp.site.com: file names for FTP sites.
@@ -95,6 +96,7 @@ Download tramp, and use /r:machine: for names on remote sites w/out FTP access."
   (message "Done uploading files...")
   )
 
+;;;###autoload
 (defun ede-upload-html-documentation ()
   "Upload the current distributions documentation as HTML.
 Use /user@ftp.site.com: file names for FTP sites.
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 81214b4b63f..dfed8a8c194 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -934,42 +934,47 @@ Throw away all the old tags, and recreate the tag database."
   ;; Top level menu items:
   (define-key cedet-menu-map [semantic-force-refresh]
     '(menu-item "Reparse Buffer" semantic-force-refresh
-		:help "Force a full reparse of the current buffer."))
+		:help "Force a full reparse of the current buffer."
+		:visible semantic-mode))
   (define-key cedet-menu-map [semantic-edit-menu]
-    (cons "Edit Tags" edit-menu))
+    `(menu-item "Edit Tags" ,edit-menu
+		:visible semantic-mode))
   (define-key cedet-menu-map [navigate-menu]
-    (cons "Navigate Tags" navigate-menu))
+    `(menu-item "Navigate Tags" ,navigate-menu
+		:visible semantic-mode))
   (define-key cedet-menu-map [semantic-options-separator]
     '("--"))
   (define-key cedet-menu-map [global-semantic-highlight-func-mode]
-    (menu-bar-make-mm-toggle
-     global-semantic-highlight-func-mode
-     "Highlight Current Function"
-     "Highlight the tag at point"))
+    '(menu-item "Highlight Current Function" global-semantic-highlight-func-mode
+		:help "Highlight the tag at point"
+		:visible semantic-mode
+		:button (:toggle . global-semantic-highlight-func-mode)))
   (define-key cedet-menu-map [global-semantic-decoration-mode]
-    (menu-bar-make-mm-toggle
-     global-semantic-decoration-mode
-     "Decorate Tags"
-     "Decorate tags based on various attributes"))
+    '(menu-item "Decorate Tags" global-semantic-decoration-mode
+		:help "Decorate tags based on tag attributes"
+		:visible semantic-mode
+		:button (:toggle . (bound-and-true-p
+				    global-semantic-decoration-mode))))
   (define-key cedet-menu-map [global-semantic-idle-completions-mode]
-    (menu-bar-make-mm-toggle
-     global-semantic-idle-completions-mode
-     "Show Tag Completions"
-     "Show tag completions when idle"))
+    '(menu-item "Show Tag Completions" global-semantic-idle-completions-mode
+		:help "Show tag completions when idle"
+		:visible semantic-mode
+		:button (:toggle . global-semantic-idle-completions-mode)))
   (define-key cedet-menu-map [global-semantic-idle-summary-mode]
-    (menu-bar-make-mm-toggle
-     global-semantic-idle-summary-mode
-     "Show Tag Summaries"
-     "Show tag summaries when idle"))
+    '(menu-item "Show Tag Summaries" global-semantic-idle-summary-mode
+		:help "Show tag summaries when idle"
+		:visible semantic-mode
+		:button (:toggle . global-semantic-idle-summary-mode)))
   (define-key cedet-menu-map [global-semanticdb-minor-mode]
     '(menu-item "Semantic Database" global-semanticdb-minor-mode
 		:help "Store tag information in a database"
-		:button (:toggle . (semanticdb-minor-mode-p))))
+		:visible semantic-mode
+		:button (:toggle . global-semanticdb-minor-mode)))
   (define-key cedet-menu-map [global-semantic-idle-scheduler-mode]
-    (menu-bar-make-mm-toggle
-     global-semantic-idle-scheduler-mode
-     "Reparse When Idle"
-     "Keep a buffer's parse tree up to date when idle"))
+    '(menu-item "Reparse When Idle" global-semantic-idle-scheduler-mode
+		:help "Keep a buffer's parse tree up to date when idle"
+		:visible semantic-mode
+		:button (:toggle . global-semantic-idle-scheduler-mode)))
   (define-key cedet-menu-map [ede-menu-separator] 'undefined)
   (define-key cedet-menu-map [cedet-menu-separator] 'undefined)
   (define-key cedet-menu-map [semantic-menu-separator] '("--")))
@@ -1064,7 +1069,6 @@ Semantic mode.
     (remove-hook 'html-mode-hook 'semantic-default-html-setup)
 
     ;; FIXME: handle semanticdb-load-ebrowse-caches
-
     (dolist (mode semantic-submode-list)
       (if (and (boundp mode) (eval mode))
 	  (funcall mode -1)))))
diff --git a/lisp/cedet/semantic/db-mode.el b/lisp/cedet/semantic/db-mode.el
index 697a87dac13..ae612217232 100644
--- a/lisp/cedet/semantic/db-mode.el
+++ b/lisp/cedet/semantic/db-mode.el
@@ -37,26 +37,6 @@
 
 (declare-function semantic-lex-spp-set-dynamic-table "semantic/lex-spp")
 
-(defcustom semanticdb-global-mode nil
-  "*If non-nil enable the use of `semanticdb-minor-mode'."
-  :group 'semantic
-  :type 'boolean
-  :require 'semantic/db
-  :initialize 'custom-initialize-default
-  :set (lambda (sym val)
-         (global-semanticdb-minor-mode (if val 1 -1))
-         (custom-set-default sym val)))
-
-(defcustom semanticdb-mode-hook nil
-  "Hook run whenever `global-semanticdb-minor-mode' is run.
-Use `semanticdb-minor-mode-p' to determine if the mode has been turned
-on or off."
-  :group 'semanticdb
-  :type 'hook)
-
-(semantic-varalias-obsolete 'semanticdb-mode-hooks
-			    'semanticdb-mode-hook)
-
 ;;; Start/Stop database use
 ;;
 (defvar semanticdb-hooks
@@ -80,32 +60,27 @@ on or off."
 	  (symbol-value (car (cdr (car semanticdb-hooks))))))
 
 ;;;###autoload
-(defun global-semanticdb-minor-mode (&optional arg)
-  "Toggle the use of `semanticdb-minor-mode'.
-If ARG is positive, enable, if it is negative, disable.
-If ARG is nil, then toggle."
-  (interactive "P")
-  (if (not arg)
-      (if (semanticdb-minor-mode-p)
-	  (setq arg -1)
-	(setq arg 1)))
-  (let ((fn 'add-hook)
-	(h semanticdb-hooks)
-	(changed nil))
-    (if (< arg 0)
-	(setq changed semanticdb-global-mode
-	      semanticdb-global-mode nil
-              fn 'remove-hook)
-      (setq changed (not semanticdb-global-mode)
-	    semanticdb-global-mode t))
-    ;(message "ARG = %d" arg)
-    (when changed
-      (while h
-	(funcall fn (car (cdr (car h))) (car (car h)))
-	(setq h (cdr h)))
-      ;; Call a hook
-      (run-hooks 'semanticdb-mode-hook))
-    ))
+(define-minor-mode global-semanticdb-minor-mode
+  "Toggle Semantic DB mode.
+With ARG, turn Semantic DB mode on if ARG is positive, off otherwise.
+
+In Semantic DB mode, Semantic parsers store results in a
+database, which can be saved for future Emacs sessions."
+  :global t
+  :group 'semantic
+  (if global-semanticdb-minor-mode
+      ;; Enable
+      (dolist (elt semanticdb-hooks)
+	(add-hook (cadr elt) (car elt)))
+    ;; Disable
+    (dolist (elt semanticdb-hooks)
+      (add-hook (cadr elt) (car elt)))))
+
+(defvaralias 'semanticdb-mode-hook 'global-semanticdb-minor-mode-hook)
+(defvaralias 'semanticdb-global-mode 'global-semanticdb-minor-mode)
+(semantic-varalias-obsolete 'semanticdb-mode-hooks
+			    'global-semanticdb-minor-mode-hook)
+
 
 (defun semanticdb-toggle-global-mode ()
   "Toggle use of the Semantic Database feature.
diff --git a/lisp/cedet/semantic/ede-grammar.el b/lisp/cedet/semantic/ede-grammar.el
new file mode 100644
index 00000000000..c23b489c837
--- /dev/null
+++ b/lisp/cedet/semantic/ede-grammar.el
@@ -0,0 +1,202 @@
+;;; semantic/ede-grammar.el --- EDE support for Semantic Grammar Files
+
+;;;  Copyright (C) 2003, 2004, 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <zappo@gnu.org>
+;; Keywords: project, make
+
+;; 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:
+;;
+;; Handle .by or .wy files.
+
+(require 'semantic)
+(require 'ede/proj)
+(require 'ede/pmake)
+(require 'ede/pconf)
+(require 'ede/proj-elisp)
+(require 'semantic/grammar)
+
+;;; Code:
+(defclass semantic-ede-proj-target-grammar (ede-proj-target-makefile)
+  ((menu :initform nil)
+   (keybindings :initform nil)
+   (phony :initform t)
+   (sourcetype :initform
+	       (semantic-ede-source-grammar-wisent
+		semantic-ede-source-grammar-bovine
+		))
+   (availablecompilers :initform
+		       (semantic-ede-grammar-compiler-wisent
+			semantic-ede-grammar-compiler-bovine
+			))
+   )
+  "This target consists of a group of grammar files.
+A grammar target consists of grammar files that build Emacs Lisp programs for
+parsing different languages.")
+
+(defvar semantic-ede-source-grammar-wisent
+  (ede-sourcecode "semantic-ede-grammar-source-wisent"
+		  :name "Wisent Grammar"
+		  :sourcepattern "\\.wy$"
+		  )
+  "Semantic Grammar source code definition for wisent.")
+
+(defclass semantic-ede-grammar-compiler-class (ede-compiler)
+  nil
+  "Specialized compiler for semantic grammars.")
+
+(defvar semantic-ede-grammar-compiler-wisent
+  (semantic-ede-grammar-compiler-class
+   "ede-emacs-wisent-compiler"
+   :name "emacs"
+   :variables '(("EMACS" . "emacs"))
+   :commands
+   '(
+     "@echo \"(add-to-list 'load-path nil)\" > grammar-make-script"
+     "@for loadpath in . ${LOADPATH}; do \\"
+     "   echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> grammar-make-script; \\"
+     "done;"
+     "@echo \"(require 'semantic-load)\" >> grammar-make-script"
+     "@echo \"(require 'semantic-grammar)\" >> grammar-make-script"
+     ;; "@echo \"(setq debug-on-error t)\" >> grammar-make-script"
+     "\"$(EMACS)\" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^"
+     )
+   ;; :autoconf '("AM_PATH_LISPDIR")
+   :sourcetype '(semantic-ede-source-grammar-wisent)
+   :objectextention "-wy.elc"
+   )
+  "Compile Emacs Lisp programs.")
+
+
+(defvar semantic-ede-source-grammar-bovine
+  (ede-sourcecode "semantic-ede-grammar-source-bovine"
+		  :name "Bovine Grammar"
+		  :sourcepattern "\\.by$"
+		  )
+  "Semantic Grammar source code definition for the bovinator.")
+
+(defvar semantic-ede-grammar-compiler-bovine
+  (semantic-ede-grammar-compiler-class
+   "ede-emacs-wisent-compiler"
+   :name "emacs"
+   :variables '(("EMACS" . "emacs"))
+   :commands
+   '(
+     "@echo \"(add-to-list 'load-path nil)\" > grammar-make-script"
+     "@for loadpath in . ${LOADPATH}; do \\"
+     "   echo \"(add-to-list 'load-path \\\"$$loadpath\\\")\" >> grammar-make-script; \\"
+     "done;"
+     "@echo \"(require 'semantic-load)\" >> grammar-make-script"
+     "@echo \"(require 'semantic-grammar)\" >> grammar-make-script"
+     ;; "@echo \"(setq debug-on-error t)\" >> grammar-make-script"
+     "\"$(EMACS)\" -batch --no-site-file -l grammar-make-script -f semantic-grammar-batch-build-packages $^"
+     )
+   ;; :autoconf '("AM_PATH_LISPDIR")
+   :sourcetype '(semantic-ede-source-grammar-bovine)
+   :objectextention "-by.elc"
+   )
+  "Compile Emacs Lisp programs.")
+
+;;; Target options.
+(defmethod ede-buffer-mine ((this semantic-ede-proj-target-grammar) buffer)
+  "Return t if object THIS lays claim to the file in BUFFER.
+Lays claim to all -by.el, and -wy.el files."
+  ;; We need to be a little more careful than this, but at the moment it
+  ;; is common to have only one target of this class per directory.
+  (if (string-match "-[bw]y\\.elc?$" (buffer-file-name buffer))
+      t
+    (call-next-method) ; The usual thing.
+    ))
+
+(defmethod project-compile-target ((obj semantic-ede-proj-target-grammar))
+  "Compile all sources in a Lisp target OBJ."
+  (let* ((cb (current-buffer))
+	 (proj (ede-target-parent obj))
+	 (default-directory (oref proj directory)))
+    (mapc (lambda (src)
+	    (save-excursion
+	      (set-buffer (find-file-noselect src))
+	      (save-excursion
+		(semantic-grammar-create-package))
+	      (save-buffer)
+	      (let ((cf (concat (semantic-grammar-package) ".el")))
+		(if (or (not (file-exists-p cf))
+			(file-newer-than-file-p src cf))
+		    (byte-compile-file cf)))))
+	    (oref obj source)))
+  (message "All Semantic Grammar sources are up to date in %s" (object-name obj)))
+
+;;; Makefile generation functions
+;;
+(defmethod ede-proj-makefile-sourcevar ((this semantic-ede-proj-target-grammar))
+  "Return the variable name for THIS's sources."
+  (cond ((ede-proj-automake-p)
+	 (error "No Automake support for Semantic Grammars"))
+	(t (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR"))))
+
+(defmethod ede-proj-makefile-insert-variables :AFTER ((this semantic-ede-proj-target-grammar))
+  "Insert variables needed by target THIS."
+  (ede-proj-makefile-insert-loadpath-items
+   (ede-proj-elisp-packages-to-loadpath
+    (list "eieio" "semantic" "inversion" "ede")))
+  ;; eieio for object system needed in ede
+  ;; semantic because it is
+  ;; Inversion for versioning system.
+  ;; ede for project regeneration
+  (ede-pmake-insert-variable-shared
+      (concat (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL")
+    (insert
+     (mapconcat (lambda (src)
+		  (save-excursion
+		    (set-buffer (find-file-noselect src))
+		    (concat (semantic-grammar-package) ".el")))
+		(oref this source)
+		" ")))
+  )
+
+(defmethod ede-proj-makefile-insert-rules ((this semantic-ede-proj-target-grammar))
+  "Insert rules needed by THIS target."
+  ;; Add in some dependencies.
+;;  (mapc (lambda (src)
+;;	  (let ((nm (file-name-sans-extension src)))
+;;	    (insert nm "-wy.el: " src "\n"
+;;		    nm "-wy.elc: " nm "-wy.el\n\n")
+;;	    ))
+;;	(oref this source))
+  ;; Call the normal insertion of rules.
+  (call-next-method)
+  )
+
+(defmethod ede-proj-makefile-insert-dist-dependencies ((this semantic-ede-proj-target-grammar))
+  "Insert dist dependencies, or intermediate targets.
+This makes sure that all grammar lisp files are created before the dist
+runs, so they are always up to date.
+Argument THIS is the target that should insert stuff."
+  (call-next-method)
+  (insert " $(" (ede-pmake-varname this) "_SEMANTIC_GRAMMAR_EL)")
+  )
+
+;; (autoload 'ede-proj-target-elisp "ede/proj-elisp"
+;;   "Target class for Emacs/Semantic grammar files." nil nil)
+
+(ede-proj-register-target "semantic grammar"
+			  semantic-ede-proj-target-grammar)
+
+(provide 'semantic/ede-grammar)
+
+;;; semantic/ede-grammar.el ends here
diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el
new file mode 100644
index 00000000000..ae1aec7b466
--- /dev/null
+++ b/lisp/cedet/semantic/grammar-wy.el
@@ -0,0 +1,478 @@
+;;; semantic/grammar-wy.el --- Generated parser support file
+
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+
+;; Author: David Ponce <david@dponce.com>
+;; Keywords: syntax
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; This file is generated from the grammar file semantic-grammar.wy in
+;; the upstream CEDET repository.
+
+;;; Code:
+
+(require 'semantic/lex)
+(defvar semantic-grammar-lex-c-char-re)
+
+;; Current parsed nonterminal name.
+(defvar semantic-grammar-wy--nterm nil)
+;; Index of rule in a nonterminal clause.
+(defvar semantic-grammar-wy--rindx nil)
+
+;;; Declarations
+;;
+(defconst semantic-grammar-wy--keyword-table
+  (semantic-lex-make-keyword-table
+   '(("%default-prec" . DEFAULT-PREC)
+     ("%no-default-prec" . NO-DEFAULT-PREC)
+     ("%keyword" . KEYWORD)
+     ("%languagemode" . LANGUAGEMODE)
+     ("%left" . LEFT)
+     ("%nonassoc" . NONASSOC)
+     ("%package" . PACKAGE)
+     ("%prec" . PREC)
+     ("%put" . PUT)
+     ("%quotemode" . QUOTEMODE)
+     ("%right" . RIGHT)
+     ("%scopestart" . SCOPESTART)
+     ("%start" . START)
+     ("%token" . TOKEN)
+     ("%type" . TYPE)
+     ("%use-macros" . USE-MACROS))
+   'nil)
+  "Table of language keywords.")
+
+(defconst semantic-grammar-wy--token-table
+  (semantic-lex-make-type-table
+   '(("punctuation"
+      (GT . ">")
+      (LT . "<")
+      (OR . "|")
+      (SEMI . ";")
+      (COLON . ":"))
+     ("close-paren"
+      (RBRACE . "}")
+      (RPAREN . ")"))
+     ("open-paren"
+      (LBRACE . "{")
+      (LPAREN . "("))
+     ("block"
+      (BRACE_BLOCK . "(LBRACE RBRACE)")
+      (PAREN_BLOCK . "(LPAREN RPAREN)"))
+     ("code"
+      (EPILOGUE . "%%...EOF")
+      (PROLOGUE . "%{...%}"))
+     ("sexp"
+      (SEXP))
+     ("qlist"
+      (PREFIXED_LIST))
+     ("char"
+      (CHARACTER))
+     ("symbol"
+      (PERCENT_PERCENT . "\\`%%\\'")
+      (SYMBOL))
+     ("string"
+      (STRING)))
+   '(("punctuation" :declared t)
+     ("block" :declared t)
+     ("sexp" matchdatatype sexp)
+     ("sexp" syntax "\\=")
+     ("sexp" :declared t)
+     ("qlist" matchdatatype sexp)
+     ("qlist" syntax "\\s'\\s-*(")
+     ("qlist" :declared t)
+     ("char" syntax semantic-grammar-lex-c-char-re)
+     ("char" :declared t)
+     ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+")
+     ("symbol" :declared t)
+     ("string" :declared t)
+     ("keyword" :declared t)))
+  "Table of lexical tokens.")
+
+(defconst semantic-grammar-wy--parse-table
+  (progn
+    (eval-when-compile
+      (require 'semantic/wisent/comp))
+    (wisent-compile-grammar
+     '((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT)
+       nil
+       (grammar
+        ((prologue))
+        ((epilogue))
+        ((declaration))
+        ((nonterminal))
+        ((PERCENT_PERCENT)))
+       (prologue
+        ((PROLOGUE)
+         (wisent-raw-tag
+          (semantic-tag-new-code "prologue" nil))))
+       (epilogue
+        ((EPILOGUE)
+         (wisent-raw-tag
+          (semantic-tag-new-code "epilogue" nil))))
+       (declaration
+        ((decl)
+         (eval $1)))
+       (decl
+        ((default_prec_decl))
+        ((no_default_prec_decl))
+        ((languagemode_decl))
+        ((package_decl))
+        ((precedence_decl))
+        ((put_decl))
+        ((quotemode_decl))
+        ((scopestart_decl))
+        ((start_decl))
+        ((keyword_decl))
+        ((token_decl))
+        ((type_decl))
+        ((use_macros_decl)))
+       (default_prec_decl
+         ((DEFAULT-PREC)
+          `(wisent-raw-tag
+            (semantic-tag "default-prec" 'assoc :value
+                          '("t")))))
+       (no_default_prec_decl
+        ((NO-DEFAULT-PREC)
+         `(wisent-raw-tag
+           (semantic-tag "default-prec" 'assoc :value
+                         '("nil")))))
+       (languagemode_decl
+        ((LANGUAGEMODE symbols)
+         `(wisent-raw-tag
+           (semantic-tag ',(car $2)
+                         'languagemode :rest ',(cdr $2)))))
+       (package_decl
+        ((PACKAGE SYMBOL)
+         `(wisent-raw-tag
+           (semantic-tag-new-package ',$2 nil))))
+       (precedence_decl
+        ((associativity token_type_opt items)
+         `(wisent-raw-tag
+           (semantic-tag ',$1 'assoc :type ',$2 :value ',$3))))
+       (associativity
+        ((LEFT)
+         (progn "left"))
+        ((RIGHT)
+         (progn "right"))
+        ((NONASSOC)
+         (progn "nonassoc")))
+       (put_decl
+        ((PUT put_name put_value)
+         `(wisent-raw-tag
+           (semantic-tag ',$2 'put :value ',(list $3))))
+        ((PUT put_name put_value_list)
+         `(wisent-raw-tag
+           (semantic-tag ',$2 'put :value ',$3)))
+        ((PUT put_name_list put_value)
+         `(wisent-raw-tag
+           (semantic-tag ',(car $2)
+                         'put :rest ',(cdr $2)
+                         :value ',(list $3))))
+        ((PUT put_name_list put_value_list)
+         `(wisent-raw-tag
+           (semantic-tag ',(car $2)
+                         'put :rest ',(cdr $2)
+                         :value ',$3))))
+       (put_name_list
+        ((BRACE_BLOCK)
+         (mapcar 'semantic-tag-name
+                 (semantic-parse-region
+                  (car $region1)
+                  (cdr $region1)
+                  'put_names 1))))
+       (put_names
+        ((LBRACE)
+         nil)
+        ((RBRACE)
+         nil)
+        ((put_name)
+         (wisent-raw-tag
+          (semantic-tag $1 'put-name))))
+       (put_name
+        ((SYMBOL))
+        ((token_type)))
+       (put_value_list
+        ((BRACE_BLOCK)
+         (mapcar 'semantic-tag-code-detail
+                 (semantic-parse-region
+                  (car $region1)
+                  (cdr $region1)
+                  'put_values 1))))
+       (put_values
+        ((LBRACE)
+         nil)
+        ((RBRACE)
+         nil)
+        ((put_value)
+         (wisent-raw-tag
+          (semantic-tag-new-code "put-value" $1))))
+       (put_value
+        ((SYMBOL any_value)
+         (cons $1 $2)))
+       (scopestart_decl
+        ((SCOPESTART SYMBOL)
+         `(wisent-raw-tag
+           (semantic-tag ',$2 'scopestart))))
+       (quotemode_decl
+        ((QUOTEMODE SYMBOL)
+         `(wisent-raw-tag
+           (semantic-tag ',$2 'quotemode))))
+       (start_decl
+        ((START symbols)
+         `(wisent-raw-tag
+           (semantic-tag ',(car $2)
+                         'start :rest ',(cdr $2)))))
+       (keyword_decl
+        ((KEYWORD SYMBOL string_value)
+         `(wisent-raw-tag
+           (semantic-tag ',$2 'keyword :value ',$3))))
+       (token_decl
+        ((TOKEN token_type_opt SYMBOL string_value)
+         `(wisent-raw-tag
+           (semantic-tag ',$3 ',(if $2 'token 'keyword)
+                         :type ',$2 :value ',$4)))
+        ((TOKEN token_type_opt symbols)
+         `(wisent-raw-tag
+           (semantic-tag ',(car $3)
+                         'token :type ',$2 :rest ',(cdr $3)))))
+       (token_type_opt
+        (nil)
+        ((token_type)))
+       (token_type
+        ((LT SYMBOL GT)
+         (progn $2)))
+       (type_decl
+        ((TYPE token_type plist_opt)
+         `(wisent-raw-tag
+           (semantic-tag ',$2 'type :value ',$3))))
+       (plist_opt
+        (nil)
+        ((plist)))
+       (plist
+        ((plist put_value)
+         (append
+          (list $2)
+          $1))
+        ((put_value)
+         (list $1)))
+       (use_name_list
+        ((BRACE_BLOCK)
+         (mapcar 'semantic-tag-name
+                 (semantic-parse-region
+                  (car $region1)
+                  (cdr $region1)
+                  'use_names 1))))
+       (use_names
+        ((LBRACE)
+         nil)
+        ((RBRACE)
+         nil)
+        ((SYMBOL)
+         (wisent-raw-tag
+          (semantic-tag $1 'use-name))))
+       (use_macros_decl
+        ((USE-MACROS SYMBOL use_name_list)
+         `(wisent-raw-tag
+           (semantic-tag "macro" 'macro :type ',$2 :value ',$3))))
+       (string_value
+        ((STRING)
+         (read $1)))
+       (any_value
+        ((SYMBOL))
+        ((STRING))
+        ((PAREN_BLOCK))
+        ((PREFIXED_LIST))
+        ((SEXP)))
+       (symbols
+        ((lifo_symbols)
+         (nreverse $1)))
+       (lifo_symbols
+        ((lifo_symbols SYMBOL)
+         (cons $2 $1))
+        ((SYMBOL)
+         (list $1)))
+       (nonterminal
+        ((SYMBOL
+          (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0)
+          COLON rules SEMI)
+         (wisent-raw-tag
+          (semantic-tag $1 'nonterminal :children $4))))
+       (rules
+        ((lifo_rules)
+         (apply 'nconc
+                (nreverse $1))))
+       (lifo_rules
+        ((lifo_rules OR rule)
+         (cons $3 $1))
+        ((rule)
+         (list $1)))
+       (rule
+        ((rhs)
+         (let*
+             ((nterm semantic-grammar-wy--nterm)
+              (rindx semantic-grammar-wy--rindx)
+              (rhs $1)
+              comps prec action elt)
+           (setq semantic-grammar-wy--rindx
+                 (1+ semantic-grammar-wy--rindx))
+           (while rhs
+             (setq elt
+                   (car rhs)
+                   rhs
+                   (cdr rhs))
+             (cond
+              ((vectorp elt)
+               (if prec
+                   (error "duplicate %%prec in `%s:%d' rule" nterm rindx))
+               (setq prec
+                     (aref elt 0)))
+              ((consp elt)
+               (if
+                   (or action comps)
+                   (setq comps
+                         (cons elt comps)
+                         semantic-grammar-wy--rindx
+                         (1+ semantic-grammar-wy--rindx))
+                 (setq action
+                       (car elt))))
+              (t
+               (setq comps
+                     (cons elt comps)))))
+           (wisent-cook-tag
+            (wisent-raw-tag
+             (semantic-tag
+              (format "%s:%d" nterm rindx)
+              'rule :type
+              (if comps "group" "empty")
+              :value comps :prec prec :expr action))))))
+       (rhs
+        (nil)
+        ((rhs item)
+         (cons $2 $1))
+        ((rhs action)
+         (cons
+          (list $2)
+          $1))
+        ((rhs PREC item)
+         (cons
+          (vector $3)
+          $1)))
+       (action
+        ((PAREN_BLOCK))
+        ((PREFIXED_LIST))
+        ((BRACE_BLOCK)
+         (format "(progn\n%s)"
+                 (let
+                     ((s $1))
+                   (if
+                       (string-match "^{[
\n	 ]*" s)
+                       (setq s
+                             (substring s
+                                        (match-end 0))))
+                   (if
+                       (string-match "[
\n	 ]*}$" s)
+                       (setq s
+                             (substring s 0
+                                        (match-beginning 0))))
+                   s))))
+       (items
+        ((lifo_items)
+         (nreverse $1)))
+       (lifo_items
+        ((lifo_items item)
+         (cons $2 $1))
+        ((item)
+         (list $1)))
+       (item
+        ((SYMBOL))
+        ((CHARACTER))))
+     '(grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)))
+  "Parser table.")
+
+(defun semantic-grammar-wy--install-parser ()
+  "Setup the Semantic Parser."
+  (semantic-install-function-overrides
+   '((parse-stream . wisent-parse-stream)))
+  (setq semantic-parser-name "LALR"
+        semantic--parse-table semantic-grammar-wy--parse-table
+        semantic-debug-parser-source "semantic-grammar.wy"
+        semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table
+        semantic-lex-types-obarray semantic-grammar-wy--token-table)
+  ;; Collect unmatched syntax lexical tokens
+  (semantic-make-local-hook 'wisent-discarding-token-functions)
+  (add-hook 'wisent-discarding-token-functions
+            'wisent-collect-unmatched-syntax nil t))
+
+
+;;; Analyzers
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<sexp>-sexp-analyzer
+  "sexp analyzer for <sexp> tokens."
+  "\\="
+  'SEXP)
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<qlist>-sexp-analyzer
+  "sexp analyzer for <qlist> tokens."
+  "\\s'\\s-*("
+  'PREFIXED_LIST)
+
+(define-lex-keyword-type-analyzer semantic-grammar-wy--<keyword>-keyword-analyzer
+  "keyword analyzer for <keyword> tokens."
+  "\\(\\sw\\|\\s_\\)+")
+
+(define-lex-block-type-analyzer semantic-grammar-wy--<block>-block-analyzer
+  "block analyzer for <block> tokens."
+  "\\s(\\|\\s)"
+  '((("(" LPAREN PAREN_BLOCK)
+     ("{" LBRACE BRACE_BLOCK))
+    (")" RPAREN)
+    ("}" RBRACE))
+  )
+
+(define-lex-regex-type-analyzer semantic-grammar-wy--<char>-regexp-analyzer
+  "regexp analyzer for <char> tokens."
+  semantic-grammar-lex-c-char-re
+  nil
+  'CHARACTER)
+
+(define-lex-sexp-type-analyzer semantic-grammar-wy--<string>-sexp-analyzer
+  "sexp analyzer for <string> tokens."
+  "\\s\""
+  'STRING)
+
+(define-lex-regex-type-analyzer semantic-grammar-wy--<symbol>-regexp-analyzer
+  "regexp analyzer for <symbol> tokens."
+  ":?\\(\\sw\\|\\s_\\)+"
+  '((PERCENT_PERCENT . "\\`%%\\'"))
+  'SYMBOL)
+
+(define-lex-string-type-analyzer semantic-grammar-wy--<punctuation>-string-analyzer
+  "string analyzer for <punctuation> tokens."
+  "\\(\\s.\\|\\s$\\|\\s'\\)+"
+  '((GT . ">")
+    (LT . "<")
+    (OR . "|")
+    (SEMI . ";")
+    (COLON . ":"))
+  'punctuation)
+
+(provide 'semantic/grammar-wy)
+
+;;; semantic/grammar-wy.el ends here
diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el
new file mode 100644
index 00000000000..5d947551d48
--- /dev/null
+++ b/lisp/cedet/semantic/grammar.el
@@ -0,0 +1,1912 @@
+;;; semantic/grammar.el --- Major mode framework for Semantic grammars
+
+;;; Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008, 2009
+;;; Free Software Foundation, Inc.
+
+;; Author: David Ponce <david@dponce.com>
+;; Maintainer: David Ponce <david@dponce.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Major mode framework for editing Semantic's input grammar files.
+
+;;; History:
+;;
+
+;;; Code:
+
+(require 'semantic)
+(require 'semantic/ctxt)
+(require 'semantic/format)
+(require 'semantic/grammar-wy)
+(require 'semantic/idle)
+(declare-function semantic-momentary-highlight-tag "semantic/decorate")
+(declare-function semantic-analyze-context "semantic/analyze")
+(declare-function semantic-analyze-tags-of-class-list
+		  "semantic/analyze/complete")
+
+
+;; (eval-when-compile
+;;   (require 'semantic/analyze))
+
+(eval-when-compile
+  (require 'eldoc)
+  (require 'semantic/edit)
+  (require 'semantic/find))
+
+;;(require 'semantic/wisent)
+;; (require 'font-lock)
+;; (require 'pp)
+
+;; (eval-when-compile
+;; ;;  (require 'senator)
+;;   (require 'semantic/edit)
+;;   (require 'semantic/find)
+;;   (require 'semantic/format)
+;;   (require 'semantic/idle))
+
+
+;;;;
+;;;; Set up lexer
+;;;;
+
+(defconst semantic-grammar-lex-c-char-re "'\\s\\?.'"
+  "Regexp matching C-like character literals.")
+
+;; Most of the analyzers are auto-generated from the grammar, but the
+;; following which need special handling code.
+;;
+(define-lex-regex-analyzer semantic-grammar-lex-prologue
+  "Detect and create a prologue token."
+  "\\<%{"
+  ;; Zing to the end of this brace block.
+  (semantic-lex-push-token
+   (semantic-lex-token
+    'PROLOGUE (point)
+    (save-excursion
+      (semantic-lex-unterminated-syntax-protection 'PROLOGUE
+        (forward-char)
+        (forward-sexp 1)
+        (point))))))
+
+(defsubst semantic-grammar-epilogue-start ()
+  "Return the start position of the grammar epilogue."
+  (save-excursion
+    (goto-char (point-min))
+    (if (re-search-forward "^\\s-*\\<%%\\>\\s-*$" nil t 2)
+        (match-beginning 0)
+      (1+ (point-max)))))
+
+(define-lex-regex-analyzer semantic-grammar-lex-epilogue
+  "Detect and create an epilogue or percent-percent token."
+  "\\<%%\\>"
+  (let ((start (match-beginning 0))
+        (end   (match-end 0))
+        (class 'PERCENT_PERCENT))
+    (when (>= start (semantic-grammar-epilogue-start))
+      (setq class 'EPILOGUE
+            end   (point-max)))
+    (semantic-lex-push-token
+     (semantic-lex-token class start end))))
+
+(define-lex semantic-grammar-lexer
+  "Lexical analyzer that handles Semantic grammar buffers.
+It ignores whitespaces, newlines and comments."
+  semantic-lex-ignore-newline
+  semantic-lex-ignore-whitespace
+  ;; Must detect prologue/epilogue before other symbols/keywords!
+  semantic-grammar-lex-prologue
+  semantic-grammar-lex-epilogue
+  semantic-grammar-wy--<keyword>-keyword-analyzer
+  semantic-grammar-wy--<symbol>-regexp-analyzer
+  semantic-grammar-wy--<char>-regexp-analyzer
+  semantic-grammar-wy--<string>-sexp-analyzer
+  ;; Must detect comments after strings because `comment-start-skip'
+  ;; regexp match semicolons inside strings!
+  semantic-lex-ignore-comments
+  ;; Must detect prefixed list before punctuation because prefix chars
+  ;; are also punctuations!
+  semantic-grammar-wy--<qlist>-sexp-analyzer
+  ;; Must detect punctuations after comments because the semicolon can
+  ;; be a punctuation or a comment start!
+  semantic-grammar-wy--<punctuation>-string-analyzer
+  semantic-grammar-wy--<block>-block-analyzer
+  semantic-grammar-wy--<sexp>-sexp-analyzer)
+
+;;; Test the lexer
+;;
+(defun semantic-grammar-lex-buffer ()
+  "Run `semantic-grammar-lex' on current buffer."
+  (interactive)
+  (semantic-lex-init)
+  (setq semantic-lex-analyzer 'semantic-grammar-lexer)
+  (let ((token-stream
+         (semantic-lex (point-min) (point-max))))
+    (with-current-buffer (get-buffer-create "*semantic-grammar-lex*")
+      (erase-buffer)
+      (pp token-stream (current-buffer))
+      (goto-char (point-min))
+      (pop-to-buffer (current-buffer)))))
+
+;;;;
+;;;; Semantic action expansion
+;;;;
+
+(defun semantic-grammar-ASSOC (&rest args)
+  "Return expansion of built-in ASSOC expression.
+ARGS are ASSOC's key value list."
+  (let ((key t))
+    `(semantic-tag-make-assoc-list
+      ,@(mapcar #'(lambda (i)
+                    (prog1
+                        (if key
+                            (list 'quote i)
+                          i)
+                      (setq key (not key))))
+                args))))
+
+(defsubst semantic-grammar-quote-p (sym)
+  "Return non-nil if SYM is bound to the `quote' function."
+  (condition-case nil
+      (eq (indirect-function sym)
+          (indirect-function 'quote))
+    (error nil)))
+
+(defsubst semantic-grammar-backquote-p (sym)
+  "Return non-nil if SYM is bound to the `backquote' function."
+  (condition-case nil
+      (eq (indirect-function sym)
+          (indirect-function 'backquote))
+    (error nil)))
+
+;;;;
+;;;; API to access grammar tags
+;;;;
+
+(define-mode-local-override semantic-tag-components
+  semantic-grammar-mode (tag)
+  "Return the children of tag TAG."
+  (semantic-tag-get-attribute tag :children))
+
+(defun semantic-grammar-first-tag-name (class)
+  "Return the name of the first tag of class CLASS found.
+Warn if other tags of class CLASS exist."
+  (let* ((tags (semantic-find-tags-by-class
+                class (current-buffer))))
+    (if tags
+        (prog1
+            (semantic-tag-name (car tags))
+          (if (cdr tags)
+              (message "*** Ignore all but first declared %s"
+                       class))))))
+
+(defun semantic-grammar-tag-symbols (class)
+  "Return the list of symbols defined in tags of class CLASS.
+That is tag names plus names defined in tag attribute `:rest'."
+  (let* ((tags (semantic-find-tags-by-class
+                class (current-buffer))))
+    (apply 'append
+           (mapcar
+            #'(lambda (tag)
+                (mapcar
+                 'intern
+                 (cons (semantic-tag-name tag)
+                       (semantic-tag-get-attribute tag :rest))))
+            tags))))
+
+(defsubst semantic-grammar-item-text (item)
+  "Return the readable string form of ITEM."
+  (if (string-match semantic-grammar-lex-c-char-re item)
+      (concat "?" (substring item 1 -1))
+    item))
+
+(defsubst semantic-grammar-item-value (item)
+  "Return symbol or character value of ITEM string."
+  (if (string-match semantic-grammar-lex-c-char-re item)
+      (let ((c (read (concat "?" (substring item 1 -1)))))
+        (if (featurep 'xemacs)
+            ;; Handle characters as integers in XEmacs like in GNU Emacs.
+            (char-int c)
+          c))
+    (intern item)))
+
+(defun semantic-grammar-prologue ()
+  "Return grammar prologue code as a string value."
+  (let ((tag (semantic-find-first-tag-by-name
+              "prologue"
+              (semantic-find-tags-by-class 'code (current-buffer)))))
+    (if tag
+        (save-excursion
+          (concat
+           (buffer-substring
+            (progn
+              (goto-char (semantic-tag-start tag))
+              (skip-chars-forward "%{\r\n\t ")
+              (point))
+            (progn
+              (goto-char (semantic-tag-end tag))
+              (skip-chars-backward "\r\n\t %}")
+              (point)))
+           "\n"))
+      "")))
+
+(defun semantic-grammar-epilogue ()
+  "Return grammar epilogue code as a string value."
+  (let ((tag (semantic-find-first-tag-by-name
+              "epilogue"
+              (semantic-find-tags-by-class 'code (current-buffer)))))
+    (if tag
+        (save-excursion
+          (concat
+           (buffer-substring
+            (progn
+              (goto-char (semantic-tag-start tag))
+              (skip-chars-forward "%\r\n\t ")
+              (point))
+            (progn
+              (goto-char (semantic-tag-end tag))
+              (skip-chars-backward "\r\n\t")
+              ;; If a grammar footer is found, skip it.
+              (re-search-backward "^;;;\\s-+\\S-+\\s-+ends here"
+                                  (save-excursion
+                                    (beginning-of-line)
+                                    (point))
+                                  t)
+              (skip-chars-backward "\r\n\t")
+              (point)))
+           "\n"))
+      "")))
+
+(defsubst semantic-grammar-buffer-file (&optional buffer)
+  "Return name of file sans directory BUFFER is visiting.
+No argument or nil as argument means use the current buffer."
+  (file-name-nondirectory (buffer-file-name buffer)))
+
+(defun semantic-grammar-package ()
+  "Return the %package value as a string.
+If there is no %package statement in the grammar, return a default
+package name derived from the grammar file name.  For example, the
+default package name for the grammar file foo.wy is foo-wy, and for
+foo.by it is foo-by."
+  (or (semantic-grammar-first-tag-name 'package)
+      (let* ((file (semantic-grammar-buffer-file))
+             (ext  (file-name-extension file))
+             (i    (string-match (format "\\([.]\\)%s\\'" ext) file)))
+        (concat (substring file 0 i) "-" ext))))
+
+(defsubst semantic-grammar-languagemode ()
+  "Return the %languagemode value as a list of symbols or nil."
+  (semantic-grammar-tag-symbols 'languagemode))
+
+(defsubst semantic-grammar-start ()
+  "Return the %start value as a list of symbols or nil."
+  (semantic-grammar-tag-symbols 'start))
+
+(defsubst semantic-grammar-scopestart ()
+  "Return the %scopestart value as a symbol or nil."
+  (intern (or (semantic-grammar-first-tag-name 'scopestart) "nil")))
+
+(defsubst semantic-grammar-quotemode ()
+  "Return the %quotemode value as a symbol or nil."
+  (intern (or (semantic-grammar-first-tag-name 'quotemode) "nil")))
+
+(defsubst semantic-grammar-keywords ()
+  "Return the language keywords.
+That is an alist of (VALUE . TOKEN) where VALUE is the string value of
+the keyword and TOKEN is the terminal symbol identifying the keyword."
+  (mapcar
+   #'(lambda (key)
+       (cons (semantic-tag-get-attribute key :value)
+             (intern (semantic-tag-name key))))
+   (semantic-find-tags-by-class 'keyword (current-buffer))))
+
+(defun semantic-grammar-keyword-properties (keywords)
+  "Return the list of KEYWORDS properties."
+  (let ((puts (semantic-find-tags-by-class
+               'put (current-buffer)))
+        put keys key plist assoc pkey pval props)
+    (while puts
+      (setq put   (car puts)
+            puts  (cdr puts)
+            keys  (mapcar
+                   'intern
+                   (cons (semantic-tag-name put)
+                         (semantic-tag-get-attribute put :rest))))
+      (while keys
+        (setq key   (car keys)
+              keys  (cdr keys)
+              assoc (rassq key keywords))
+        (if (null assoc)
+            nil ;;(message "*** %%put to undefined keyword %s ignored" key)
+          (setq key   (car assoc)
+                plist (semantic-tag-get-attribute put :value))
+          (while plist
+            (setq pkey  (intern (caar plist))
+                  pval  (read (cdar plist))
+                  props (cons (list key pkey pval) props)
+                  plist (cdr plist))))))
+    props))
+
+(defun semantic-grammar-tokens ()
+  "Return defined lexical tokens.
+That is an alist (TYPE . DEFS) where type is a %token <type> symbol
+and DEFS is an alist of (TOKEN . VALUE).  TOKEN is the terminal symbol
+identifying the token and VALUE is the string value of the token or
+nil."
+  (let (tags alist assoc tag type term names value)
+
+    ;; Check for <type> in %left, %right & %nonassoc declarations
+    (setq tags (semantic-find-tags-by-class
+                'assoc (current-buffer)))
+    (while tags
+      (setq tag  (car tags)
+            tags (cdr tags))
+      (when (setq type (semantic-tag-type tag))
+        (setq names (semantic-tag-get-attribute tag :value)
+              assoc (assoc type alist))
+        (or assoc (setq assoc (list type)
+                        alist (cons assoc alist)))
+        (while names
+          (setq term  (car names)
+                names (cdr names))
+          (or (string-match semantic-grammar-lex-c-char-re term)
+              (setcdr assoc (cons (list (intern term))
+                                  (cdr assoc)))))))
+
+    ;; Then process %token declarations so they can override any
+    ;; previous specifications
+    (setq tags (semantic-find-tags-by-class
+                'token (current-buffer)))
+    (while tags
+      (setq tag  (car tags)
+            tags (cdr tags))
+      (setq names (cons (semantic-tag-name tag)
+                        (semantic-tag-get-attribute tag :rest))
+            type  (or (semantic-tag-type tag) "<no-type>")
+            value (semantic-tag-get-attribute tag :value)
+            assoc (assoc type alist))
+      (or assoc (setq assoc (list type)
+                      alist (cons assoc alist)))
+      (while names
+        (setq term  (intern (car names))
+              names (cdr names))
+        (setcdr assoc (cons (cons term value) (cdr assoc)))))
+    alist))
+
+(defun semantic-grammar-token-%type-properties (&optional props)
+  "Return properties set by %type statements.
+This declare a new type if necessary.
+If optional argument PROPS is non-nil, it is an existing list of
+properties where to add new properties."
+  (let (type)
+    (dolist (tag (semantic-find-tags-by-class 'type (current-buffer)))
+      (setq type (semantic-tag-name tag))
+      ;; Indicate to auto-generate the analyzer for this type
+      (push (list type :declared t) props)
+      (dolist (e (semantic-tag-get-attribute tag :value))
+        (push (list type (intern (car e)) (read (or (cdr e) "nil")))
+              props)))
+    props))
+
+(defun semantic-grammar-token-%put-properties (tokens)
+  "For types found in TOKENS, return properties set by %put statements."
+  (let (found props)
+    (dolist (put (semantic-find-tags-by-class 'put (current-buffer)))
+      (dolist (type (cons (semantic-tag-name put)
+                          (semantic-tag-get-attribute put :rest)))
+        (setq found (assoc type tokens))
+        (if (null found)
+            nil ;; %put <type> ignored, no token defined
+          (setq type (car found))
+          (dolist (e (semantic-tag-get-attribute put :value))
+            (push (list type (intern (car e)) (read (or (cdr e) "nil")))
+                  props)))))
+    props))
+
+(defsubst semantic-grammar-token-properties (tokens)
+  "Return properties of declared types.
+Types are explicitly declared by %type statements.  Types found in
+TOKENS are those declared implicitly by %token statements.
+Properties can be set by %put and %type statements.
+Properties set by %type statements take precedence over those set by
+%put statements."
+  (let ((props (semantic-grammar-token-%put-properties tokens)))
+    (semantic-grammar-token-%type-properties props)))
+
+(defun semantic-grammar-use-macros ()
+  "Return macro definitions from %use-macros statements.
+Also load the specified macro libraries."
+  (let (lib defs)
+    (dolist (tag (semantic-find-tags-by-class 'macro (current-buffer)))
+      (setq lib (intern (semantic-tag-type tag)))
+      (condition-case nil
+          ;;(load lib) ;; Be sure to use the latest macro library.
+          (require lib)
+        (error nil))
+      (dolist (mac (semantic-tag-get-attribute tag :value))
+        (push (cons (intern mac)
+                    (intern (format "%s-%s" lib mac)))
+              defs)))
+    (nreverse defs)))
+
+(defvar semantic-grammar-macros nil
+  "List of associations (MACRO-NAME . EXPANDER).")
+(make-variable-buffer-local 'semantic-grammar-macros)
+
+(defun semantic-grammar-macros ()
+  "Build and return the alist of defined macros."
+  (append
+   ;; Definitions found in tags.
+   (semantic-grammar-use-macros)
+   ;; Other pre-installed definitions.
+   semantic-grammar-macros))
+
+;;;;
+;;;; Overloaded functions that build parser data.
+;;;;
+
+;;; Keyword table builder
+;;
+(defun semantic-grammar-keywordtable-builder-default ()
+  "Return the default value of the keyword table."
+  (let ((keywords (semantic-grammar-keywords)))
+    `(semantic-lex-make-keyword-table
+      ',keywords
+      ',(semantic-grammar-keyword-properties keywords))))
+
+(define-overloadable-function semantic-grammar-keywordtable-builder ()
+  "Return the keyword table table value.")
+
+;;; Token table builder
+;;
+(defun semantic-grammar-tokentable-builder-default ()
+  "Return the default value of the table of lexical tokens."
+  (let ((tokens (semantic-grammar-tokens)))
+    `(semantic-lex-make-type-table
+      ',tokens
+      ',(semantic-grammar-token-properties tokens))))
+
+(define-overloadable-function semantic-grammar-tokentable-builder ()
+  "Return the value of the table of lexical tokens.")
+
+;;; Parser table builder
+;;
+(defun semantic-grammar-parsetable-builder-default ()
+  "Return the default value of the parse table."
+  (error "`semantic-grammar-parsetable-builder' not defined"))
+
+(define-overloadable-function semantic-grammar-parsetable-builder ()
+  "Return the parser table value.")
+
+;;; Parser setup code builder
+;;
+(defun semantic-grammar-setupcode-builder-default ()
+  "Return the default value of the setup code form."
+  (error "`semantic-grammar-setupcode-builder' not defined"))
+
+(define-overloadable-function semantic-grammar-setupcode-builder ()
+  "Return the parser setup code form.")
+
+;;;;
+;;;; Lisp code generation
+;;;;
+(defvar semantic--grammar-input-buffer  nil)
+(defvar semantic--grammar-output-buffer nil)
+
+(defsubst semantic-grammar-keywordtable ()
+  "Return the variable name of the keyword table."
+  (concat (file-name-sans-extension
+           (semantic-grammar-buffer-file
+            semantic--grammar-output-buffer))
+          "--keyword-table"))
+
+(defsubst semantic-grammar-tokentable ()
+  "Return the variable name of the token table."
+  (concat (file-name-sans-extension
+           (semantic-grammar-buffer-file
+            semantic--grammar-output-buffer))
+          "--token-table"))
+
+(defsubst semantic-grammar-parsetable ()
+  "Return the variable name of the parse table."
+  (concat (file-name-sans-extension
+           (semantic-grammar-buffer-file
+            semantic--grammar-output-buffer))
+          "--parse-table"))
+
+(defsubst semantic-grammar-setupfunction ()
+  "Return the name of the parser setup function."
+  (concat (file-name-sans-extension
+           (semantic-grammar-buffer-file
+            semantic--grammar-output-buffer))
+          "--install-parser"))
+
+(defmacro semantic-grammar-as-string (object)
+  "Return OBJECT as a string value."
+  `(if (stringp ,object)
+       ,object
+     ;;(require 'pp)
+     (pp-to-string ,object)))
+
+(defun semantic-grammar-insert-defconst (name value docstring)
+  "Insert declaration of constant NAME with VALUE and DOCSTRING."
+  (let ((start (point)))
+    (insert (format "(defconst %s\n%s%S)\n\n" name value docstring))
+    (save-excursion
+      (goto-char start)
+      (indent-sexp))))
+
+(defun semantic-grammar-insert-defun (name body docstring)
+  "Insert declaration of function NAME with BODY and DOCSTRING."
+  (let ((start (point)))
+    (insert (format "(defun %s ()\n%S\n%s)\n\n" name docstring body))
+    (save-excursion
+      (goto-char start)
+      (indent-sexp))))
+
+(defun semantic-grammar-insert-define (define)
+  "Insert the declaration specified by DEFINE expression.
+Typically a DEFINE expression should look like this:
+
+\(define-thing name docstring expression1 ...)"
+  ;;(require 'pp)
+  (let ((start (point)))
+    (insert (format "(%S %S" (car define) (nth 1 define)))
+    (dolist (item (nthcdr 2 define))
+      (insert "\n")
+      (delete-blank-lines)
+      (pp item (current-buffer)))
+    (insert ")\n\n")
+    (save-excursion
+      (goto-char start)
+      (indent-sexp))))
+
+(defconst semantic-grammar-header-template
+  '("\
+;;; " file " --- Generated parser support file
+
+" copy "
+
+;; Author: " user-full-name " <" user-mail-address ">
+;; Created: " date "
+;; Keywords: syntax
+;; X-RCS: " vcid "
+
+;; This file is not part of GNU Emacs.
+;;
+;; This program 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+
+;;; Commentary:
+;;
+;; PLEASE DO NOT MANUALLY EDIT THIS FILE!  It is automatically
+;; generated from the grammar file " gram ".
+
+;;; History:
+;;
+
+;;; Code:
+")
+  "Generated header template.
+The symbols in the template are local variables in
+`semantic-grammar-header'")
+
+(defconst semantic-grammar-footer-template
+  '("\
+
+\(provide '" libr ")
+
+;;; " file " ends here
+")
+  "Generated footer template.
+The symbols in the list are local variables in
+`semantic-grammar-footer'.")
+
+(defun semantic-grammar-copyright-line ()
+  "Return the grammar copyright line, or nil if not found."
+  (save-excursion
+    (goto-char (point-min))
+    (when (re-search-forward "^;;+[ \t]+Copyright (C) .*$"
+                             ;; Search only in the four top lines
+                             (save-excursion (forward-line 4) (point))
+                             t)
+      (match-string 0))))
+
+(defun semantic-grammar-header ()
+  "Return text of a generated standard header."
+  (let ((file (semantic-grammar-buffer-file
+               semantic--grammar-output-buffer))
+        (gram (semantic-grammar-buffer-file))
+        (date (format-time-string "%Y-%m-%d %T%z"))
+        (vcid (concat "$" "Id" "$")) ;; Avoid expansion
+        ;; Try to get the copyright from the input grammar, or
+        ;; generate a new one if not found.
+        (copy (or (semantic-grammar-copyright-line)
+                  (concat (format-time-string ";; Copyright (C) %Y ")
+                          user-full-name)))
+	(out ""))
+    (dolist (S semantic-grammar-header-template)
+      (cond ((stringp S)
+	     (setq out (concat out S)))
+	    ((symbolp S)
+	     (setq out (concat out (symbol-value S))))))
+    out))
+
+(defun semantic-grammar-footer ()
+  "Return text of a generated standard footer."
+  (let* ((file (semantic-grammar-buffer-file
+                semantic--grammar-output-buffer))
+         (libr (file-name-sans-extension file))
+	 (out ""))
+    (dolist (S semantic-grammar-footer-template)
+      (cond ((stringp S)
+	     (setq out (concat out S)))
+	    ((symbolp S)
+	     (setq out (concat out (symbol-value S))))))
+    out))
+
+(defun semantic-grammar-token-data ()
+  "Return the string value of the table of lexical tokens."
+  (semantic-grammar-as-string
+   (semantic-grammar-tokentable-builder)))
+
+(defun semantic-grammar-keyword-data ()
+  "Return the string value of the table of keywords."
+  (semantic-grammar-as-string
+   (semantic-grammar-keywordtable-builder)))
+
+(defun semantic-grammar-parser-data ()
+  "Return the parser table as a string value."
+  (semantic-grammar-as-string
+   (semantic-grammar-parsetable-builder)))
+
+(defun semantic-grammar-setup-data ()
+  "Return the parser setup code form as a string value."
+  (semantic-grammar-as-string
+   (semantic-grammar-setupcode-builder)))
+
+;;; Generation of lexical analyzers.
+;;
+(defvar semantic-grammar--lex-block-specs)
+
+(defsubst semantic-grammar--lex-delim-spec (block-spec)
+  "Return delimiters specification from BLOCK-SPEC."
+  (condition-case nil
+      (let* ((standard-input (cdr block-spec))
+             (delim-spec (read)))
+        (if (and (consp delim-spec)
+                 (car delim-spec) (symbolp (car delim-spec))
+                 (cadr delim-spec) (symbolp (cadr delim-spec)))
+            delim-spec
+          (error)))
+    (error
+     (error "Invalid delimiters specification %s in block token %s"
+            (cdr block-spec) (car block-spec)))))
+
+(defun semantic-grammar--lex-block-specs ()
+  "Compute lexical block specifications for the current buffer.
+Block definitions are read from the current table of lexical types."
+  (cond
+   ;; Block specifications have been parsed and are invalid.
+   ((eq semantic-grammar--lex-block-specs 'error)
+    nil
+    )
+   ;; Parse block specifications.
+   ((null semantic-grammar--lex-block-specs)
+    (condition-case err
+        (let* ((blocks       (cdr (semantic-lex-type-value "block" t)))
+               (open-delims  (cdr (semantic-lex-type-value "open-paren" t)))
+               (close-delims (cdr (semantic-lex-type-value "close-paren" t)))
+               olist clist block-spec delim-spec open-spec close-spec)
+          (dolist (block-spec blocks)
+            (setq delim-spec (semantic-grammar--lex-delim-spec block-spec)
+                  open-spec  (assq (car  delim-spec) open-delims)
+                  close-spec (assq (cadr delim-spec) close-delims))
+            (or open-spec
+                (error "Missing open-paren token %s required by block %s"
+                       (car delim-spec) (car block-spec)))
+            (or close-spec
+                (error "Missing close-paren token %s required by block %s"
+                       (cdr delim-spec) (car block-spec)))
+            ;; build alist ((OPEN-DELIM OPEN-SYM BLOCK-SYM) ...)
+            (push (list (cdr open-spec) (car open-spec) (car block-spec))
+                  olist)
+            ;; build alist ((CLOSE-DELIM CLOSE-SYM) ...)
+            (push (list (cdr close-spec) (car close-spec))
+                  clist))
+          (setq semantic-grammar--lex-block-specs (cons olist clist)))
+      (error
+       (setq semantic-grammar--lex-block-specs 'error)
+       (message "%s" (error-message-string err))
+       nil))
+    )
+   ;; Block specifications already parsed.
+   (t
+    semantic-grammar--lex-block-specs)))
+
+(defsubst semantic-grammar-quoted-form (exp)
+  "Return a quoted form of EXP if it isn't a self evaluating form."
+  (if (and (not (null exp))
+           (or (listp exp) (symbolp exp)))
+      (list 'quote exp)
+    exp))
+
+(defun semantic-grammar-insert-defanalyzer (type)
+  "Insert declaration of the lexical analyzer defined with TYPE."
+  (let* ((type-name  (symbol-name type))
+         (type-value (symbol-value type))
+         (syntax     (get type 'syntax))
+         (declared   (get type :declared))
+         spec mtype prefix name doc)
+    ;; Generate an analyzer if the corresponding type has been
+    ;; explicitly declared in a %type statement, and if at least the
+    ;; syntax property has been provided.
+    (when (and declared syntax)
+      (setq prefix (file-name-sans-extension
+                    (semantic-grammar-buffer-file
+                     semantic--grammar-output-buffer))
+            mtype (or (get type 'matchdatatype) 'regexp)
+            name (intern (format "%s--<%s>-%s-analyzer" prefix type mtype))
+            doc (format "%s analyzer for <%s> tokens." mtype type))
+      (cond
+       ;; Regexp match analyzer
+       ((eq mtype 'regexp)
+        (semantic-grammar-insert-define
+         `(define-lex-regex-type-analyzer ,name
+            ,doc ,syntax
+            ,(semantic-grammar-quoted-form (cdr type-value))
+            ',(or (car type-value) (intern type-name))))
+        )
+       ;; String compare analyzer
+       ((eq mtype 'string)
+        (semantic-grammar-insert-define
+         `(define-lex-string-type-analyzer ,name
+            ,doc ,syntax
+            ,(semantic-grammar-quoted-form (cdr type-value))
+            ',(or (car type-value) (intern type-name))))
+        )
+       ;; Block analyzer
+       ((and (eq mtype 'block)
+             (setq spec (semantic-grammar--lex-block-specs)))
+        (semantic-grammar-insert-define
+         `(define-lex-block-type-analyzer ,name
+            ,doc ,syntax
+            ,(semantic-grammar-quoted-form spec)))
+        )
+       ;; Sexp analyzer
+       ((eq mtype 'sexp)
+        (semantic-grammar-insert-define
+         `(define-lex-sexp-type-analyzer ,name
+            ,doc ,syntax
+            ',(or (car type-value) (intern type-name))))
+        )
+       ;; keyword analyzer
+       ((eq mtype 'keyword)
+        (semantic-grammar-insert-define
+         `(define-lex-keyword-type-analyzer ,name
+            ,doc ,syntax))
+        )
+       ))
+    ))
+
+(defun semantic-grammar-insert-defanalyzers ()
+  "Insert declarations of lexical analyzers."
+  (let (tokens props)
+    (with-current-buffer semantic--grammar-input-buffer
+      (setq tokens (semantic-grammar-tokens)
+            props  (semantic-grammar-token-properties tokens)))
+    (insert "(require 'semantic-lex)\n\n")
+    (let ((semantic-lex-types-obarray
+           (semantic-lex-make-type-table tokens props))
+          semantic-grammar--lex-block-specs)
+      (mapatoms 'semantic-grammar-insert-defanalyzer
+                semantic-lex-types-obarray))))
+
+;;; Generation of the grammar support file.
+;;
+(defcustom semantic-grammar-file-regexp "\\.[wb]y$"
+  "Regexp which matches grammar source files."
+  :group 'semantic
+  :type 'regexp)
+
+(defsubst semantic-grammar-noninteractive ()
+  "Return non-nil if running without interactive terminal."
+  (if (featurep 'xemacs)
+      (noninteractive)
+    noninteractive))
+
+(defun semantic-grammar-create-package (&optional force)
+  "Create package Lisp code from grammar in current buffer.
+Does nothing if the Lisp code seems up to date.
+If optional argument FORCE is non-nil, unconditionally re-generate the
+Lisp code."
+  (interactive "P")
+  (setq force (or force current-prefix-arg))
+  (semantic-fetch-tags)
+  (let* (
+         ;; Values of the following local variables are obtained from
+         ;; the grammar parsed tree in current buffer, that is before
+         ;; switching to the output file.
+         (package  (semantic-grammar-package))
+         (output   (concat package ".el"))
+         (semantic--grammar-input-buffer  (current-buffer))
+         (semantic--grammar-output-buffer (find-file-noselect output))
+         (header   (semantic-grammar-header))
+         (prologue (semantic-grammar-prologue))
+         (epilogue (semantic-grammar-epilogue))
+         (footer   (semantic-grammar-footer))
+         )
+    (if (and (not force)
+             (not (buffer-modified-p))
+             (file-newer-than-file-p
+              (buffer-file-name semantic--grammar-output-buffer)
+              (buffer-file-name semantic--grammar-input-buffer)))
+        (message "Package `%s' is up to date." package)
+      ;; Create the package
+      (set-buffer semantic--grammar-output-buffer)
+      ;; Use Unix EOLs, so that the file is portable to all platforms.
+      (setq buffer-file-coding-system 'raw-text-unix)
+      (erase-buffer)
+      (unless (eq major-mode 'emacs-lisp-mode)
+        (emacs-lisp-mode))
+
+;;;; Header + Prologue
+
+      (insert header
+              "\n;;; Prologue\n;;\n"
+              prologue
+              )
+      ;; Evaluate the prologue now, because it might provide definition
+      ;; of grammar macro expanders.
+      (eval-region (point-min) (point))
+
+      (save-excursion
+
+;;;; Declarations
+
+        (insert "\n;;; Declarations\n;;\n")
+
+        ;; `eval-defun' is not necessary to reset `defconst' values.
+        (semantic-grammar-insert-defconst
+         (semantic-grammar-keywordtable)
+         (with-current-buffer semantic--grammar-input-buffer
+           (semantic-grammar-keyword-data))
+         "Table of language keywords.")
+
+        (semantic-grammar-insert-defconst
+         (semantic-grammar-tokentable)
+         (with-current-buffer semantic--grammar-input-buffer
+           (semantic-grammar-token-data))
+         "Table of lexical tokens.")
+
+        (semantic-grammar-insert-defconst
+         (semantic-grammar-parsetable)
+         (with-current-buffer semantic--grammar-input-buffer
+           (semantic-grammar-parser-data))
+         "Parser table.")
+
+        (semantic-grammar-insert-defun
+         (semantic-grammar-setupfunction)
+         (with-current-buffer semantic--grammar-input-buffer
+           (semantic-grammar-setup-data))
+         "Setup the Semantic Parser.")
+
+;;;; Analyzers
+        (insert "\n;;; Analyzers\n;;\n")
+
+        (semantic-grammar-insert-defanalyzers)
+
+;;;; Epilogue & Footer
+
+        (insert "\n;;; Epilogue\n;;\n"
+                epilogue
+                footer
+                )
+
+        )
+
+      (save-buffer 16)
+
+      ;; If running in batch mode, there is nothing more to do.
+      ;; Save the generated file and quit.
+      (if (semantic-grammar-noninteractive)
+          (let ((version-control t)
+                (delete-old-versions t)
+                (make-backup-files t)
+                (vc-make-backup-files t))
+            (kill-buffer (current-buffer)))
+        ;; If running interactively, eval declarations and epilogue
+        ;; code, then pop to the buffer visiting the generated file.
+        (eval-region (point) (point-max))
+        (goto-char (point-min))
+        (pop-to-buffer (current-buffer))
+        ;; The generated code has been evaluated and updated into
+        ;; memory.  Now find all buffers that match the major modes we
+        ;; have created this language for, and force them to call our
+        ;; setup function again, refreshing all semantic data, and
+        ;; enabling them to work with the new code just created.
+;;;; FIXME?
+        ;; At this point, I don't know any user's defined setup code :-(
+        ;; At least, what I can do for now, is to run the generated
+        ;; parser-install function.
+        (semantic-map-mode-buffers
+         (semantic-grammar-setupfunction)
+         (semantic-grammar-languagemode)))
+      )
+    ;; Return the name of the generated package file.
+    output))
+
+(defun semantic-grammar-recreate-package ()
+  "Unconditionnaly create Lisp code from grammar in current buffer.
+Like \\[universal-argument] \\[semantic-grammar-create-package]."
+  (interactive)
+  (semantic-grammar-create-package t))
+
+(defun semantic-grammar-batch-build-one-package (file)
+  "Build a Lisp package from the grammar in FILE.
+That is, generate Lisp code from FILE, and `byte-compile' it.
+Return non-nil if there were no errors, nil if errors."
+  ;; We need this require so that we can find `byte-compile-dest-file'.
+  (require 'bytecomp)
+  (unless (auto-save-file-name-p file)
+    ;; Create the package
+    (let ((packagename
+           (condition-case err
+               (with-current-buffer (find-file-noselect file)
+                 (semantic-grammar-create-package))
+             (error
+              (message "%s" (error-message-string err))
+              nil))))
+      (when packagename
+        ;; Only byte compile if out of date
+        (if (file-newer-than-file-p
+             packagename (byte-compile-dest-file packagename))
+            (let (;; Some complex grammar table expressions need a few
+                  ;; more resources than the default.
+                  (max-specpdl-size    (max 3000 max-specpdl-size))
+                  (max-lisp-eval-depth (max 1000 max-lisp-eval-depth))
+                  )
+              ;; byte compile the resultant file
+              (byte-compile-file packagename))
+          t)))))
+
+(defun semantic-grammar-batch-build-packages ()
+  "Build Lisp packages from grammar files on the command line.
+That is, run `semantic-grammar-batch-build-one-package' for each file.
+Each file is processed even if an error occurred previously.
+Must be used from the command line, with `-batch'.
+For example, to process grammar files in current directory, invoke:
+
+  \"emacs -batch -f semantic-grammar-batch-build-packages .\".
+
+See also the variable `semantic-grammar-file-regexp'."
+  (or (semantic-grammar-noninteractive)
+      (error "\
+`semantic-grammar-batch-build-packages' must be used with -batch"
+             ))
+  (let ((status 0)
+        ;; Remove vc from find-file-hook.  It causes bad stuff to
+        ;; happen in Emacs 20.
+        (find-file-hook (delete 'vc-find-file-hook find-file-hook)))
+    (message "Compiling Grammars from: %s" (locate-library "semantic-grammar"))
+    (dolist (arg command-line-args-left)
+      (unless (and arg (file-exists-p arg))
+        (error "Argument %s is not a valid file name" arg))
+      (setq arg (expand-file-name arg))
+      (if (file-directory-p arg)
+          ;; Directory as argument
+          (dolist (src (condition-case nil
+                           (directory-files
+                            arg nil semantic-grammar-file-regexp)
+                         (error
+                          (error "Unable to read directory files"))))
+            (or (semantic-grammar-batch-build-one-package
+                 (expand-file-name src arg))
+                (setq status 1)))
+        ;; Specific file argument
+        (or (semantic-grammar-batch-build-one-package arg)
+            (setq status 1))))
+    (kill-emacs status)
+    ))
+
+;;;;
+;;;; Macros highlighting
+;;;;
+
+(defvar semantic--grammar-macros-regexp-1 nil)
+(make-variable-buffer-local 'semantic--grammar-macros-regexp-1)
+
+(defun semantic--grammar-macros-regexp-1 ()
+  "Return font-lock keyword regexp for pre-installed macro names."
+  (and semantic-grammar-macros
+       (not semantic--grammar-macros-regexp-1)
+       (condition-case nil
+           (setq semantic--grammar-macros-regexp-1
+                 (concat "(\\s-*"
+                         (regexp-opt
+                          (mapcar #'(lambda (e) (symbol-name (car e)))
+                                  semantic-grammar-macros)
+                          t)
+                         "\\>"))
+         (error nil)))
+  semantic--grammar-macros-regexp-1)
+
+(defconst semantic--grammar-macdecl-re
+  "\\<%use-macros\\>[ \t\r\n]+\\(\\sw\\|\\s_\\)+[ \t\r\n]+{"
+  "Regexp that matches a macro declaration statement.")
+
+(defvar semantic--grammar-macros-regexp-2 nil)
+(make-variable-buffer-local 'semantic--grammar-macros-regexp-2)
+
+(defun semantic--grammar-clear-macros-regexp-2 (&rest ignore)
+  "Clear the cached regexp that match macros local in this grammar.
+IGNORE arguments.
+Added to `before-change-functions' hooks to be run before each text
+change."
+  (setq semantic--grammar-macros-regexp-2 nil))
+
+(defun semantic--grammar-macros-regexp-2 ()
+  "Return the regexp that match macros local in this grammar."
+  (unless semantic--grammar-macros-regexp-2
+    (let (macs)
+      (save-excursion
+        (goto-char (point-min))
+        (while (re-search-forward semantic--grammar-macdecl-re nil t)
+          (condition-case nil
+              (setq macs (nconc macs
+                                (split-string
+                                 (buffer-substring-no-properties
+                                  (point)
+                                  (progn
+                                    (backward-char)
+                                    (forward-list 1)
+                                    (down-list -1)
+                                    (point))))))
+            (error nil)))
+        (when macs
+          (setq semantic--grammar-macros-regexp-2
+                (concat "(\\s-*" (regexp-opt macs t) "\\>"))))))
+  semantic--grammar-macros-regexp-2)
+
+(defun semantic--grammar-macros-matcher (end)
+  "Search for a grammar macro name to highlight.
+END is the limit of the search."
+  (let ((regexp (semantic--grammar-macros-regexp-1)))
+    (or (and regexp (re-search-forward regexp end t))
+        (and (setq regexp (semantic--grammar-macros-regexp-2))
+             (re-search-forward regexp end t)))))
+
+;;;;
+;;;; Define major mode
+;;;;
+
+(defvar semantic-grammar-syntax-table
+  (let ((table (make-syntax-table (standard-syntax-table))))
+    (modify-syntax-entry ?\: "."     table) ;; COLON
+    (modify-syntax-entry ?\> "."     table) ;; GT
+    (modify-syntax-entry ?\< "."     table) ;; LT
+    (modify-syntax-entry ?\| "."     table) ;; OR
+    (modify-syntax-entry ?\; ". 12"  table) ;; SEMI, Comment start ;;
+    (modify-syntax-entry ?\n ">"     table) ;; Comment end
+    (modify-syntax-entry ?\" "\""    table) ;; String
+    (modify-syntax-entry ?\% "w"     table) ;; Word
+    (modify-syntax-entry ?\- "_"     table) ;; Symbol
+    (modify-syntax-entry ?\. "_"     table) ;; Symbol
+    (modify-syntax-entry ?\\ "\\"    table) ;; Quote
+    (modify-syntax-entry ?\` "'"     table) ;; Prefix ` (backquote)
+    (modify-syntax-entry ?\' "'"     table) ;; Prefix ' (quote)
+    (modify-syntax-entry ?\, "'"     table) ;; Prefix , (comma)
+    (modify-syntax-entry ?\# "'"     table) ;; Prefix # (sharp)
+    table)
+  "Syntax table used in a Semantic grammar buffers.")
+
+(defvar semantic-grammar-mode-hook nil
+  "Hook run when starting Semantic grammar mode.")
+
+(defvar semantic-grammar-mode-keywords-1
+  `(("\\(\\<%%\\>\\|\\<%[{}]\\)"
+     0 font-lock-reference-face)
+    ("\\(%\\)\\(\\(\\sw\\|\\s_\\)+\\)"
+     (1 font-lock-reference-face)
+     (2 font-lock-keyword-face))
+    ("\\<error\\>"
+     0 (unless (semantic-grammar-in-lisp-p) 'bold))
+    ("^\\(\\(\\sw\\|\\s_\\)+\\)[ \n\r\t]*:"
+     1 font-lock-function-name-face)
+    (semantic--grammar-macros-matcher
+     1 ,(if (boundp 'font-lock-builtin-face)
+            'font-lock-builtin-face
+          'font-lock-preprocessor-face))
+    ("\\$\\(\\sw\\|\\s_\\)*"
+     0 font-lock-variable-name-face)
+    ("<\\(\\(\\sw\\|\\s_\\)+\\)>"
+     1 font-lock-type-face)
+    (,semantic-grammar-lex-c-char-re
+     0 ,(if (boundp 'font-lock-constant-face)
+            'font-lock-constant-face
+          'font-lock-string-face) t)
+    ;; Must highlight :keyword here, because ':' is a punctuation in
+    ;; grammar mode!
+    ("[\r\n\t ]+:\\sw+\\>"
+     0 font-lock-builtin-face)
+    ;; Append the Semantic keywords
+    ,@semantic-fw-font-lock-keywords
+    )
+  "Font Lock keywords used to highlight Semantic grammar buffers.")
+
+(defvar semantic-grammar-mode-keywords-2
+  (append semantic-grammar-mode-keywords-1
+          lisp-font-lock-keywords-1)
+  "Font Lock keywords used to highlight Semantic grammar buffers.")
+
+(defvar semantic-grammar-mode-keywords-3
+  (append semantic-grammar-mode-keywords-1
+          lisp-font-lock-keywords-2)
+  "Font Lock keywords used to highlight Semantic grammar buffers.")
+
+(defvar semantic-grammar-mode-keywords
+  semantic-grammar-mode-keywords-1
+  "Font Lock keywords used to highlight Semantic grammar buffers.")
+
+(defvar semantic-grammar-map
+  (let ((km (make-sparse-keymap)))
+
+    (define-key km "|" 'semantic-grammar-electric-punctuation)
+    (define-key km ";" 'semantic-grammar-electric-punctuation)
+    (define-key km "%" 'semantic-grammar-electric-punctuation)
+    (define-key km "(" 'semantic-grammar-electric-punctuation)
+    (define-key km ")" 'semantic-grammar-electric-punctuation)
+    (define-key km ":" 'semantic-grammar-electric-punctuation)
+
+    (define-key km "\t"       'semantic-grammar-indent)
+    (define-key km "\M-\t"    'semantic-grammar-complete)
+    (define-key km "\C-c\C-c" 'semantic-grammar-create-package)
+    (define-key km "\C-cm"    'semantic-grammar-find-macro-expander)
+    (define-key km "\C-cik"    'semantic-grammar-insert-keyword)
+;;  (define-key km "\C-cc"    'semantic-grammar-generate-and-load)
+;;  (define-key km "\C-cr"    'semantic-grammar-generate-one-rule)
+
+    km)
+  "Keymap used in `semantic-grammar-mode'.")
+
+(defvar semantic-grammar-menu
+  '("Grammar"
+    ["Indent Line" semantic-grammar-indent]
+    ["Complete Symbol" semantic-grammar-complete]
+    ["Find Macro" semantic-grammar-find-macro-expander]
+    "--"
+    ["Insert %keyword" semantic-grammar-insert-keyword]
+    "--"
+    ["Update Lisp Package" semantic-grammar-create-package]
+    ["Recreate Lisp Package" semantic-grammar-recreate-package]
+    )
+  "Common semantic grammar menu.")
+
+(defun semantic-grammar-setup-menu-emacs (symbol mode-menu)
+  "Setup a GNU Emacs grammar menu in variable SYMBOL.
+MODE-MENU is an optional specific menu whose items are appended to the
+common grammar menu."
+  (let ((items (make-symbol "items")))
+    `(unless (boundp ',symbol)
+       (easy-menu-define ,symbol (current-local-map)
+         "Grammar Menu" semantic-grammar-menu)
+       (let ((,items (cdr ,mode-menu)))
+         (when ,items
+           (easy-menu-add-item ,symbol nil "--")
+           (while ,items
+             (easy-menu-add-item ,symbol nil (car ,items))
+             (setq ,items (cdr ,items))))))
+    ))
+
+(defun semantic-grammar-setup-menu-xemacs (symbol mode-menu)
+  "Setup an XEmacs grammar menu in variable SYMBOL.
+MODE-MENU is an optional specific menu whose items are appended to the
+common grammar menu."
+  (let ((items (make-symbol "items"))
+        (path (make-symbol "path")))
+    `(progn
+       (unless (boundp ',symbol)
+         (easy-menu-define ,symbol nil
+           "Grammar Menu" (copy-sequence semantic-grammar-menu)))
+       (easy-menu-add ,symbol)
+       (let ((,items (cdr ,mode-menu))
+             (,path (list (car ,symbol))))
+         (when ,items
+           (easy-menu-add-item nil ,path "--")
+           (while ,items
+             (easy-menu-add-item nil ,path (car ,items))
+             (setq ,items (cdr ,items))))))
+    ))
+
+(defmacro semantic-grammar-setup-menu (&optional mode-menu)
+  "Setup a mode local grammar menu.
+MODE-MENU is an optional specific menu whose items are appended to the
+common grammar menu."
+  (let ((menu (intern (format "%s-menu" major-mode))))
+    (if (featurep 'xemacs)
+        (semantic-grammar-setup-menu-xemacs menu mode-menu)
+      (semantic-grammar-setup-menu-emacs menu mode-menu))))
+
+(defsubst semantic-grammar-in-lisp-p ()
+  "Return non-nil if point is in Lisp code."
+  (or (>= (point) (semantic-grammar-epilogue-start))
+      (condition-case nil
+          (save-excursion
+            (up-list -1)
+            t)
+        (error nil))))
+
+(defun semantic-grammar-edits-new-change-hook-fcn (overlay)
+  "Function set into `semantic-edits-new-change-hook'.
+Argument OVERLAY is the overlay created to mark the change.
+When OVERLAY marks a change in the scope of a nonterminal tag extend
+the change bounds to encompass the whole nonterminal tag."
+  (let ((outer (car (semantic-find-tag-by-overlay-in-region
+                     (semantic-edits-os overlay)
+                     (semantic-edits-oe overlay)))))
+    (if (semantic-tag-of-class-p outer 'nonterminal)
+        (semantic-overlay-move overlay
+                               (semantic-tag-start outer)
+                               (semantic-tag-end outer)))))
+
+(defun semantic-grammar-mode ()
+  "Initialize a buffer for editing Semantic grammars.
+
+\\{semantic-grammar-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'semantic-grammar-mode
+        mode-name "Semantic Grammar Framework")
+  (set (make-local-variable 'parse-sexp-ignore-comments) t)
+  (set (make-local-variable 'comment-start) ";;")
+  ;; Look within the line for a ; following an even number of backslashes
+  ;; after either a non-backslash or the line beginning.
+  (set (make-local-variable 'comment-start-skip)
+       "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
+  (set-syntax-table semantic-grammar-syntax-table)
+  (use-local-map semantic-grammar-map)
+  (set (make-local-variable 'indent-line-function)
+       'semantic-grammar-indent)
+  (set (make-local-variable 'fill-paragraph-function)
+       'lisp-fill-paragraph)
+  (set (make-local-variable 'font-lock-multiline)
+       'undecided)
+  (set (make-local-variable 'font-lock-defaults)
+       '((semantic-grammar-mode-keywords
+          semantic-grammar-mode-keywords-1
+          semantic-grammar-mode-keywords-2
+          semantic-grammar-mode-keywords-3)
+         nil  ;; perform string/comment fontification
+         nil  ;; keywords are case sensitive.
+         ;; This puts _ & - as a word constituant,
+         ;; simplifying our keywords significantly
+         ((?_ . "w") (?- . "w"))))
+  ;; Setup Semantic to parse grammar
+  (semantic-grammar-wy--install-parser)
+  (setq semantic-lex-comment-regex ";;"
+        semantic-lex-analyzer 'semantic-grammar-lexer
+        semantic-type-relation-separator-character '(":")
+        semantic-symbol->name-assoc-list
+        '(
+          (code         . "Setup Code")
+          (keyword      . "Keyword")
+          (token        . "Token")
+          (nonterminal  . "Nonterminal")
+          (rule         . "Rule")
+          ))
+  (set (make-local-variable 'semantic-format-face-alist)
+       '(
+         (code         . default)
+         (keyword      . font-lock-keyword-face)
+         (token        . font-lock-type-face)
+         (nonterminal  . font-lock-function-name-face)
+         (rule         . default)
+         ))
+  (set (make-local-variable 'semantic-stickyfunc-sticky-classes)
+       '(nonterminal))
+  ;; Before each change, clear the cached regexp used to highlight
+  ;; macros local in this grammar.
+  (semantic-make-local-hook 'before-change-functions)
+  (add-hook 'before-change-functions
+            'semantic--grammar-clear-macros-regexp-2 nil t)
+  ;; Handle safe re-parse of grammar rules.
+  (semantic-make-local-hook 'semantic-edits-new-change-hooks)
+  (add-hook 'semantic-edits-new-change-hooks
+            'semantic-grammar-edits-new-change-hook-fcn
+            nil t)
+  (semantic-run-mode-hooks 'semantic-grammar-mode-hook))
+
+;;;;
+;;;; Useful commands
+;;;;
+
+(defvar semantic-grammar-skip-quoted-syntax-table
+  (let ((st (copy-syntax-table semantic-grammar-syntax-table)))
+    (modify-syntax-entry ?\' "$" st)
+    st)
+  "Syntax table to skip a whole quoted expression in grammar code.
+Consider quote as a \"paired delimiter\", so `forward-sexp' will skip
+whole quoted expression.")
+
+(defsubst semantic-grammar-backward-item ()
+  "Move point to beginning of the previous grammar item."
+  (forward-comment (- (point-max)))
+  (if (zerop (skip-syntax-backward "."))
+      (if (eq (char-before) ?\')
+          (with-syntax-table
+              ;; Can't be Lisp code here!  Temporarily consider quote
+              ;; as a "paired delimiter", so `forward-sexp' can skip
+              ;; the whole quoted expression.
+              semantic-grammar-skip-quoted-syntax-table
+            (forward-sexp -1))
+        (forward-sexp -1))))
+
+(defun semantic-grammar-anchored-indentation ()
+  "Return indentation based on previous anchor character found."
+  (let (indent)
+    (save-excursion
+      (while (not indent)
+        (semantic-grammar-backward-item)
+        (cond
+         ((bobp)
+          (setq indent 0))
+         ((looking-at ":\\(\\s-\\|$\\)")
+          (setq indent (current-column))
+          (forward-char)
+          (skip-syntax-forward "-")
+          (if (eolp) (setq indent 2))
+          )
+         ((and (looking-at "[;%]")
+               (not (looking-at "\\<%prec\\>")))
+          (setq indent 0)
+          ))))
+    indent))
+
+(defun semantic-grammar-do-grammar-indent ()
+  "Indent a line of grammar.
+When called the point is not in Lisp code."
+  (let (indent n)
+    (save-excursion
+      (beginning-of-line)
+      (skip-syntax-forward "-")
+      (setq indent (current-column))
+      (cond
+       ((or (bobp)
+            (looking-at "\\(\\w\\|\\s_\\)+\\s-*:")
+            (and (looking-at "%")
+                 (not (looking-at "%prec\\>"))))
+        (setq n 0))
+       ((looking-at ":")
+        (setq n 2))
+       ((and (looking-at ";;")
+             (save-excursion (forward-comment (point-max))
+                             (looking-at ":")))
+        (setq n 1))
+       (t
+        (setq n (semantic-grammar-anchored-indentation))
+        (unless (zerop n)
+          (cond
+           ((looking-at ";;")
+            (setq n (1- n)))
+           ((looking-at "[|;]")
+            )
+           (t
+            (setq n (+ n 2)))))))
+      (when (/= n indent)
+        (beginning-of-line)
+        (delete-horizontal-space)
+        (indent-to n)))))
+
+(defvar semantic-grammar-brackets-as-parens-syntax-table
+  (let ((st (copy-syntax-table emacs-lisp-mode-syntax-table)))
+    (modify-syntax-entry ?\{ "(}  " st)
+    (modify-syntax-entry ?\} "){  " st)
+    st)
+  "Syntax table that consider brackets as parenthesis.
+So `lisp-indent-line' will work inside bracket blocks.")
+
+(defun semantic-grammar-do-lisp-indent ()
+  "Maybe run the Emacs Lisp indenter on a line of code.
+Return nil if not in a Lisp expression."
+    (condition-case nil
+        (save-excursion
+          (beginning-of-line)
+          (skip-chars-forward "\t ")
+          (let ((first (point)))
+            (or (>= first (semantic-grammar-epilogue-start))
+                (up-list -1))
+            (condition-case nil
+                (while t
+                  (up-list -1))
+              (error nil))
+            (beginning-of-line)
+            (save-restriction
+              (narrow-to-region (point) first)
+              (goto-char (point-max))
+              (with-syntax-table
+                  ;; Temporarily consider brackets as parenthesis so
+                  ;; `lisp-indent-line' can indent Lisp code inside
+                  ;; brackets.
+                  semantic-grammar-brackets-as-parens-syntax-table
+                (lisp-indent-line))))
+          t)
+      (error nil)))
+
+(defun semantic-grammar-indent ()
+  "Indent the current line.
+Use the Lisp or grammar indenter depending on point location."
+  (interactive)
+  (let ((orig (point))
+        first)
+    (or (semantic-grammar-do-lisp-indent)
+        (semantic-grammar-do-grammar-indent))
+    (setq first (save-excursion
+                  (beginning-of-line)
+                  (skip-chars-forward "\t ")
+                  (point)))
+    (if (or (< orig first) (/= orig (point)))
+        (goto-char first))))
+
+(defun semantic-grammar-electric-punctuation ()
+  "Insert and reindent for the symbol just typed in."
+  (interactive)
+  (self-insert-command 1)
+  (save-excursion
+    (semantic-grammar-indent)))
+
+(defun semantic-grammar-complete ()
+  "Attempt to complete the symbol under point.
+Completion is position sensitive.  If the cursor is in a match section of
+a rule, then nonterminals symbols are scanned.  If the cursor is in a Lisp
+expression then Lisp symbols are completed."
+  (interactive)
+  (if (semantic-grammar-in-lisp-p)
+      ;; We are in lisp code.  Do lisp completion.
+      (lisp-complete-symbol)
+    ;; We are not in lisp code.  Do rule completion.
+    (let* ((nonterms (semantic-find-tags-by-class 'nonterminal (current-buffer)))
+           (sym (car (semantic-ctxt-current-symbol)))
+           (ans (try-completion sym nonterms)))
+      (cond ((eq ans t)
+             ;; All done
+             (message "Symbols is already complete"))
+            ((and (stringp ans) (string= ans sym))
+             ;; Max matchable.  Show completions.
+	     (with-output-to-temp-buffer "*Completions*"
+	       (display-completion-list (all-completions sym nonterms)))
+	     )
+            ((stringp ans)
+             ;; Expand the completions
+             (forward-sexp -1)
+             (delete-region (point) (progn (forward-sexp 1) (point)))
+             (insert ans))
+            (t (message "No Completions."))
+            ))
+    ))
+
+(defun semantic-grammar-insert-keyword (name)
+  "Insert a new %keyword declaration with NAME.
+Assumes it is typed in with the correct casing."
+  (interactive "sKeyword: ")
+  (if (not (bolp)) (insert "\n"))
+  (insert "%keyword " (upcase name) "        \"" name "\"
+%put     " (upcase name) " summary
+\"\"\n")
+  (forward-char -2))
+
+;;; Macro facilities
+;;
+
+(defsubst semantic--grammar-macro-function-tag (name)
+  "Search for a function tag for the grammar macro with name NAME.
+Return the tag found or nil if not found."
+  (car (semantic-find-tags-by-class
+        'function
+        (or (semantic-find-tags-by-name name (current-buffer))
+            (and (featurep 'semanticdb)
+                 semanticdb-current-database
+                 (cdar (semanticdb-find-tags-by-name name nil t)))))))
+
+(defsubst semantic--grammar-macro-lib-part (def)
+  "Return the library part of the grammar macro defined by DEF."
+  (let ((suf (format "-%s\\'" (regexp-quote (symbol-name (car def)))))
+        (fun (symbol-name (cdr def))))
+    (substring fun 0 (string-match suf fun))))
+
+(defun semantic--grammar-macro-compl-elt (def &optional full)
+  "Return a completion entry for the grammar macro defined by DEF.
+If optional argument FULL is non-nil qualify the macro name with the
+library found in DEF."
+  (let ((mac (car def))
+        (lib (semantic--grammar-macro-lib-part def)))
+    (cons (if full
+              (format "%s/%s" mac lib)
+            (symbol-name mac))
+          (list mac lib))))
+
+(defun semantic--grammar-macro-compl-dict ()
+  "Return a completion dictionnary of macro definitions."
+  (let ((defs (semantic-grammar-macros))
+        def dups dict)
+    (while defs
+      (setq def  (car defs)
+            defs (cdr defs))
+      (if (or (assoc (car def) defs) (assoc (car def) dups))
+          (push def dups)
+        (push (semantic--grammar-macro-compl-elt def) dict)))
+    (while dups
+      (setq def  (car dups)
+            dups (cdr dups))
+      (push (semantic--grammar-macro-compl-elt def t) dict))
+    dict))
+
+(defun semantic-grammar-find-macro-expander (macro-name library)
+  "Visit the Emacs Lisp library where a grammar macro is implemented.
+MACRO-NAME is a symbol that identifies a grammar macro.
+LIBRARY is the name (sans extension) of the Emacs Lisp library where
+to start searching the macro implementation.  Lookup in included
+libraries, if necessary.
+Find a function tag (in current tags table) whose name contains MACRO-NAME.
+Select the buffer containing the tag's definition, and move point there."
+  (interactive
+   (let* ((dic (semantic--grammar-macro-compl-dict))
+          (def (assoc (completing-read "Macro: " dic nil 1) dic)))
+     (or (cdr def) '(nil nil))))
+  (when (and macro-name library)
+    (let* ((lib (format "%s.el" library))
+           (buf (find-file-noselect (or (locate-library lib t) lib)))
+           (tag (with-current-buffer buf
+                  (semantic--grammar-macro-function-tag
+                   (format "%s-%s" library macro-name)))))
+      (if tag
+          (progn
+	    (require 'semantic/decorate)
+            (pop-to-buffer (semantic-tag-buffer tag))
+            (goto-char (semantic-tag-start tag))
+            (semantic-momentary-highlight-tag tag))
+        (pop-to-buffer buf)
+        (message "No expander found in library %s for macro %s"
+                 library macro-name)))))
+
+;;; Additional help
+;;
+
+(defvar semantic-grammar-syntax-help
+  `(
+    ;; Lexical Symbols
+    ("symbol" . "Syntax: A symbol of alpha numeric and symbol characters")
+    ("number" . "Syntax: Numeric characters.")
+    ("punctuation" . "Syntax: Punctuation character.")
+    ("semantic-list" . "Syntax: A list delimited by any valid list characters")
+    ("open-paren" . "Syntax: Open Parenthesis character")
+    ("close-paren" . "Syntax: Close Parenthesis character")
+    ("string" . "Syntax: String character delimited text")
+    ("comment" . "Syntax: Comment character delimited text")
+    ;; Special Macros
+    ("EMPTY" . "Syntax: Match empty text")
+    ("ASSOC" . "Lambda Key: (ASSOC key1 value1 key2 value2 ...)")
+    ("EXPAND" . "Lambda Key: (EXPAND <list id> <rule>)")
+    ("EXPANDFULL" . "Lambda Key: (EXPANDFULL <list id> <rule>)")
+    ;; Tag Generator Macros
+    ("TAG" . "Generic Tag Generation: (TAG <name> <tag-class> [ :key value ]*)")
+    ("VARIABLE-TAG" . "(VARIABLE-TAG <name> <lang-type> <default-value> [ :key value ]*)")
+    ("FUNCTION-TAG" . "(FUNCTION-TAG <name> <lang-type> <arg-list> [ :key value ]*)")
+    ("TYPE-TAG" . "(TYPE-TAG <name> <lang-type> <part-list> <parents> [ :key value ]*)")
+    ("INCLUDE-TAG" . "(INCLUDE-TAG <name> <system-flag> [ :key value ]*)")
+    ("PACKAGE-TAG" . "(PACKAGE-TAG <name> <detail> [ :key value ]*)")
+    ("CODE-TAG" . "(CODE-TAG <name> <detail> [ :key value ]*)")
+    ("ALIAS-TAG" . "(ALIAS-TAG <name> <aliasclass> <definition> [:key value]*)")
+    ;; Special value macros
+    ("$1" . "Match Value: Value from match list in slot 1")
+    ("$2" . "Match Value: Value from match list in slot 2")
+    ("$3" . "Match Value: Value from match list in slot 3")
+    ("$4" . "Match Value: Value from match list in slot 4")
+    ("$5" . "Match Value: Value from match list in slot 5")
+    ("$6" . "Match Value: Value from match list in slot 6")
+    ("$7" . "Match Value: Value from match list in slot 7")
+    ("$8" . "Match Value: Value from match list in slot 8")
+    ("$9" . "Match Value: Value from match list in slot 9")
+    ;; Same, but with annoying , in front.
+    (",$1" . "Match Value: Value from match list in slot 1")
+    (",$2" . "Match Value: Value from match list in slot 2")
+    (",$3" . "Match Value: Value from match list in slot 3")
+    (",$4" . "Match Value: Value from match list in slot 4")
+    (",$5" . "Match Value: Value from match list in slot 5")
+    (",$6" . "Match Value: Value from match list in slot 6")
+    (",$7" . "Match Value: Value from match list in slot 7")
+    (",$8" . "Match Value: Value from match list in slot 8")
+    (",$9" . "Match Value: Value from match list in slot 9")
+    )
+  "Association of syntax elements, and the corresponding help.")
+
+(defun semantic-grammar-eldoc-get-macro-docstring (macro expander)
+  "Return a one-line docstring for the given grammar MACRO.
+EXPANDER is the name of the function that expands MACRO."
+  (require 'eldoc)
+  (if (and (eq expander (aref eldoc-last-data 0))
+           (eq 'function (aref eldoc-last-data 2)))
+      (aref eldoc-last-data 1)
+    (let ((doc (help-split-fundoc (documentation expander t) expander)))
+      (cond
+       (doc
+        (setq doc (car doc))
+        (string-match "\\`[^ )]* ?" doc)
+        (setq doc (concat "(" (substring doc (match-end 0)))))
+       (t
+        (setq doc (eldoc-function-argstring expander))))
+      (when doc
+        (setq doc
+	      (eldoc-docstring-format-sym-doc
+	       macro (format "==> %s %s" expander doc) 'default))
+        (eldoc-last-data-store expander doc 'function))
+      doc)))
+
+(define-mode-local-override semantic-idle-summary-current-symbol-info
+  semantic-grammar-mode ()
+  "Display additional eldoc information about grammar syntax elements.
+Syntax element is the current symbol at point.
+If it is associated a help string in `semantic-grammar-syntax-help',
+return that string.
+If it is a macro name, return a description of the associated expander
+function parameter list.
+If it is a function name, return a description of this function
+parameter list.
+It it is a variable name, return a brief (one-line) documentation
+string for the variable.
+If a default description of the current context can be obtained,
+return it.
+Otherwise return nil."
+  (require 'eldoc)
+  (let* ((elt (car (semantic-ctxt-current-symbol)))
+         (val (and elt (cdr (assoc elt semantic-grammar-syntax-help)))))
+    (when (and (not val) elt (semantic-grammar-in-lisp-p))
+      ;; Ensure to load macro definitions before doing `intern-soft'.
+      (setq val (semantic-grammar-macros)
+            elt (intern-soft elt)
+            val (and elt (cdr (assq elt val))))
+      (cond
+       ;; Grammar macro
+       ((and val (fboundp val))
+        (setq val (semantic-grammar-eldoc-get-macro-docstring elt val)))
+       ;; Function
+       ((and elt (fboundp elt))
+        (setq val (eldoc-get-fnsym-args-string elt)))
+       ;; Variable
+       ((and elt (boundp elt))
+        (setq val (eldoc-get-var-docstring elt)))
+       (t nil)))
+    (or val (semantic-idle-summary-current-symbol-info-default))))
+
+(define-mode-local-override semantic-tag-boundary-p
+  semantic-grammar-mode (tag)
+  "Return non-nil for tags that should have a boundary drawn.
+Only tags of type 'nonterminal will be so marked."
+  (let ((c (semantic-tag-class tag)))
+    (eq c 'nonterminal)))
+
+(define-mode-local-override semantic-ctxt-current-function
+  semantic-grammar-mode (&optional point)
+  "Determine the name of the current function at POINT."
+  (save-excursion
+    (and point (goto-char point))
+    (when (semantic-grammar-in-lisp-p)
+      (with-mode-local emacs-lisp-mode
+        (semantic-ctxt-current-function)))))
+
+(define-mode-local-override semantic-ctxt-current-argument
+  semantic-grammar-mode (&optional point)
+  "Determine the argument index of the called function at POINT."
+  (save-excursion
+    (and point (goto-char point))
+    (when (semantic-grammar-in-lisp-p)
+      (with-mode-local emacs-lisp-mode
+        (semantic-ctxt-current-argument)))))
+
+(define-mode-local-override semantic-ctxt-current-assignment
+  semantic-grammar-mode (&optional point)
+  "Determine the tag being assigned into at POINT."
+  (save-excursion
+    (and point (goto-char point))
+    (when (semantic-grammar-in-lisp-p)
+      (with-mode-local emacs-lisp-mode
+        (semantic-ctxt-current-assignment)))))
+
+(define-mode-local-override semantic-ctxt-current-class-list
+  semantic-grammar-mode (&optional point)
+  "Determine the class of tags that can be used at POINT."
+  (save-excursion
+    (and point (goto-char point))
+    (if (semantic-grammar-in-lisp-p)
+        (with-mode-local emacs-lisp-mode
+          (semantic-ctxt-current-class-list))
+      '(nonterminal keyword))))
+
+(define-mode-local-override semantic-ctxt-current-mode
+  semantic-grammar-mode (&optional point)
+  "Return the major mode active at POINT.
+POINT defaults to the value of point in current buffer.
+Return `emacs-lisp-mode' is POINT is within Lisp code, otherwise
+return the current major mode."
+  (save-excursion
+    (and point (goto-char point))
+    (if (semantic-grammar-in-lisp-p)
+        'emacs-lisp-mode
+      (semantic-ctxt-current-mode-default))))
+
+(define-mode-local-override semantic-format-tag-abbreviate
+  semantic-grammar-mode (tag &optional parent color)
+  "Return a string abbreviation of TAG.
+Optional PARENT is not used.
+Optional COLOR is used to flag if color is added to the text."
+  (let ((class (semantic-tag-class tag))
+        (name (semantic-format-tag-name tag parent color)))
+    (cond
+     ((eq class 'nonterminal)
+      (concat name ":"))
+     ((eq class 'setting)
+      "%settings%")
+     ((memq class '(rule keyword))
+      name)
+     (t
+      (concat "%" (symbol-name class) " " name)))))
+
+(define-mode-local-override semantic-format-tag-summarize
+  semantic-grammar-mode (tag &optional parent color)
+  "Return a string summarizing TAG.
+Optional PARENT is not used.
+Optional argument COLOR determines if color is added to the text."
+  (let ((class (semantic-tag-class tag))
+        (name (semantic-format-tag-name tag parent color))
+        (label nil)
+        (desc nil))
+    (cond
+     ((eq class 'nonterminal)
+      (setq label "Nonterminal: "
+            desc (format
+                  " with %d match lists."
+                  (length (semantic-tag-components tag)))))
+     ((eq class 'keyword)
+      (setq label "Keyword: ")
+      (let (summary)
+        (semantic--find-tags-by-function
+         #'(lambda (put)
+             (unless summary
+               (setq summary (cdr (assoc "summary"
+                                         (semantic-tag-get-attribute
+                                          put :value))))))
+         ;; Get `put' tag with TAG name.
+         (semantic-find-tags-by-name-regexp
+          (regexp-quote (semantic-tag-name tag))
+          (semantic-find-tags-by-class 'put (current-buffer))))
+        (setq desc (concat " = "
+                           (semantic-tag-get-attribute tag :value)
+                           (if summary
+                               (concat " - " (read summary))
+                             "")))))
+     ((eq class 'token)
+      (setq label "Token: ")
+      (let ((val   (semantic-tag-get-attribute tag :value))
+            (names (semantic-tag-get-attribute tag :rest))
+            (type  (semantic-tag-type tag)))
+        (if names
+            (setq name (mapconcat 'identity (cons name names) " ")))
+        (setq desc (concat
+                    (if type
+                        (format " <%s>" type)
+                      "")
+                    (if val
+                        (format "%s%S" val (if type " " ""))
+                      "")))))
+     ((eq class 'assoc)
+      (setq label "Assoc: ")
+      (let ((val   (semantic-tag-get-attribute tag :value))
+            (type  (semantic-tag-type tag)))
+        (setq desc (concat
+                    (if type
+                        (format " <%s>" type)
+                      "")
+                    (if val
+                        (concat " " (mapconcat 'identity val " "))
+                      "")))))
+     (t
+      (setq desc (semantic-format-tag-abbreviate tag parent color))))
+    (if (and color label)
+        (setq label (semantic--format-colorize-text label 'label)))
+    (if (and color label desc)
+        (setq desc (semantic--format-colorize-text desc 'comment)))
+    (if label
+        (concat label name desc)
+      ;; Just a description is the abbreviated version
+      desc)))
+
+;;; Semantic Analysis
+
+(define-mode-local-override semantic-analyze-current-context
+  semantic-grammar-mode (point)
+  "Provide a semantic analysis object describing a context in a grammar."
+  (require 'semantic/analyze)
+  (if (semantic-grammar-in-lisp-p)
+      (with-mode-local emacs-lisp-mode
+	(semantic-analyze-current-context point))
+
+    (let* ((context-return nil)
+	   (prefixandbounds (semantic-ctxt-current-symbol-and-bounds))
+	   (prefix (car prefixandbounds))
+	   (bounds (nth 2 prefixandbounds))
+	   (prefixsym nil)
+	   (prefixclass (semantic-ctxt-current-class-list))
+	   )
+
+      ;; Do context for rules when in a match list.
+      (setq prefixsym
+	    (semantic-find-first-tag-by-name
+	     (car prefix)
+	     (current-buffer)))
+
+      (setq context-return
+	    (semantic-analyze-context
+	     "context-for-semantic-grammar"
+	     :buffer (current-buffer)
+	     :scope nil
+	     :bounds bounds
+	     :prefix (if prefixsym
+			 (list prefixsym)
+		       prefix)
+	     :prefixtypes nil
+	     :prefixclass prefixclass
+	     ))
+
+      context-return)))
+
+(define-mode-local-override semantic-analyze-possible-completions
+  semantic-grammar-mode (context)
+  "Return a list of possible completions based on CONTEXT."
+  (require 'semantic/analyze/complete)
+  (if (semantic-grammar-in-lisp-p)
+      (with-mode-local emacs-lisp-mode
+	(semantic-analyze-possible-completions context))
+    (save-excursion
+      (set-buffer (oref context buffer))
+      (let* ((prefix (car (oref context :prefix)))
+	     (completetext (cond ((semantic-tag-p prefix)
+				  (semantic-tag-name prefix))
+				 ((stringp prefix)
+				  prefix)
+				 ((stringp (car prefix))
+				  (car prefix))))
+	     (tags (semantic-find-tags-for-completion completetext
+						      (current-buffer))))
+	(semantic-analyze-tags-of-class-list
+	 tags (oref context prefixclass)))
+      )))
+
+(provide 'semantic/grammar)
+
+;;; semantic/grammar.el ends here