*** empty log message ***

lisp/ChangeLog

@@ -1,3 +1,9 @@
+2000-01-27  Gerd Moellmann  <gerd@gnu.org>
+
+	* progmodes/ebnf2ps.el, progmodes/ebnf-bnf.el,
+	progmodes/ebnf-iso.el, progmodes/ebnf-otz.el,
+	progmodes/ebnf-yac.el: New files.
+
 2000-01-26  Dave Love  <fx@gnu.org>
 
 	* emacs-lisp/checkdoc.el (checkdoc-interactive-loop): Don't lose

lisp/progmodes/ebnf-bnf.el

@@ -0,0 +1,583 @@
+;;; ebnf-bnf --- Parser for EBNF
+
+;; Copyright (C) 1999 Vinicius Jose Latorre
+
+;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords:   wp, ebnf, PostScript
+;; Time-stamp: <99/11/20 18:05:05 vinicius>
+;; Version:    1.4
+
+;; This file is *NOT* (yet?) 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 program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; This is part of ebnf2ps package.
+;;
+;; This package defines a parser for EBNF.
+;;
+;; See ebnf2ps.el for documentation.
+;;
+;;
+;; EBNF Syntax
+;; -----------
+;;
+;; The current EBNF that ebnf2ps accepts has the following constructions:
+;;
+;;    ;			comment (until end of line)
+;;    A			non-terminal
+;;    "C"		terminal
+;;    ?C?		special
+;;    $A		default non-terminal
+;;    $"C"		default terminal
+;;    $?C?		default special
+;;    A = B.		production (A is the header and B the body)
+;;    C D		sequence (C occurs before D)
+;;    C | D		alternative (C or D occurs)
+;;    A - B		exception (A excluding B, B without any non-terminal)
+;;    n * A		repetition (A repeats n (integer) times)
+;;    (C)		group (expression C is grouped together)
+;;    [C]		optional (C may or not occurs)
+;;    C+		one or more occurrences of C
+;;    {C}+		one or more occurrences of C
+;;    {C}*		zero or more occurrences of C
+;;    {C}		zero or more occurrences of C
+;;    C / D		equivalent to: C {D C}*
+;;    {C || D}+		equivalent to: C {D C}*
+;;    {C || D}*		equivalent to: [C {D C}*]
+;;    {C || D}		equivalent to: [C {D C}*]
+;;
+;; The EBNF syntax written using the notation above is:
+;;
+;;    EBNF = {production}+.
+;;
+;;    production = non_terminal "=" body ".".   ;; production
+;;
+;;    body = {sequence || "|"}*.                ;; alternative
+;;
+;;    sequence = {exception}*.                  ;; sequence
+;;
+;;    exception = repeat [ "-" repeat].         ;; exception
+;;
+;;    repeat = [ integer "*" ] term.            ;; repetition
+;;
+;;    term = factor
+;;         | [factor] "+"                       ;; one-or-more
+;;         | [factor] "/" [factor]              ;; one-or-more
+;;         .
+;;
+;;    factor = [ "$" ] "\"" terminal "\""       ;; terminal
+;;           | [ "$" ] non_terminal             ;; non-terminal
+;;           | [ "$" ] "?" special "?"          ;; special
+;;           | "(" body ")"                     ;; group
+;;           | "[" body "]"                     ;; zero-or-one
+;;           | "{" body [ "||" body ] "}+"      ;; one-or-more
+;;           | "{" body [ "||" body ] "}*"      ;; zero-or-more
+;;           | "{" body [ "||" body ] "}"       ;; zero-or-more
+;;           .
+;;
+;;    non_terminal = "[A-Za-z\\240-\\377][!#%&'*-,0-:<>@-Z\\^-z~\\240-\\377]*".
+;;
+;;    terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
+;;
+;;    special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*".
+;;
+;;    integer = "[0-9]+".
+;;
+;;    comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
+;;
+;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; code:
+
+
+(require 'ebnf-otz)
+
+
+(defvar ebnf-bnf-lex nil
+  "Value returned by `ebnf-bnf-lex' function.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Syntatic analyzer
+
+
+;;; EBNF = {production}+.
+
+(defun ebnf-bnf-parser (start)
+  "EBNF parser."
+  (let ((total (+ (- ebnf-limit start) 1))
+	(bias (1- start))
+	(origin (point))
+	prod-list token rule)
+    (goto-char start)
+    (setq token (ebnf-bnf-lex))
+    (and (eq token 'end-of-input)
+	 (error "Invalid EBNF file format."))
+    (while (not (eq token 'end-of-input))
+      (ebnf-message-float
+       "Parsing...%s%%"
+       (/ (* (- (point) bias) 100.0) total))
+      (setq token (ebnf-production token)
+	    rule  (cdr token)
+	    token (car token))
+      (or (ebnf-add-empty-rule-list rule)
+	  (setq prod-list (cons rule prod-list))))
+    (goto-char origin)
+    prod-list))
+
+
+;;; production = non-terminal "=" body ".".
+
+(defun ebnf-production (token)
+  (let ((header ebnf-bnf-lex)
+	(action ebnf-action)
+	body)
+    (setq ebnf-action nil)
+    (or (eq token 'non-terminal)
+	(error "Invalid header production."))
+    (or (eq (ebnf-bnf-lex) 'equal)
+	(error "Invalid production: missing `='."))
+    (setq body (ebnf-body))
+    (or (eq (car body) 'period)
+	(error "Invalid production: missing `.'."))
+    (setq body (cdr body))
+    (ebnf-eps-add-production header)
+    (cons (ebnf-bnf-lex)
+	  (ebnf-make-production header body action))))
+
+
+;;; body = {sequence || "|"}*.
+
+(defun ebnf-body ()
+  (let (body sequence)
+    (while (eq (car (setq sequence (ebnf-sequence))) 'alternative)
+      (setq sequence (cdr sequence)
+	    body     (cons sequence body)))
+    (ebnf-token-alternative body sequence)))
+
+
+;;; sequence = {exception}*.
+
+(defun ebnf-sequence ()
+  (let ((token (ebnf-bnf-lex))
+	seq term)
+    (while (setq term  (ebnf-exception token)
+		 token (car term)
+		 term  (cdr term))
+      (setq seq (cons term seq)))
+    (cons token
+	  (cond
+	   ;; null sequence
+	   ((null seq)
+	    (ebnf-make-empty))
+	   ;; sequence with only one element
+	   ((= (length seq) 1)
+	    (car seq))
+	   ;; a real sequence
+	   (t
+	    (ebnf-make-sequence (nreverse seq)))
+	   ))))
+
+
+;;; exception = repeat [ "-" repeat].
+
+(defun ebnf-exception (token)
+  (let ((term (ebnf-repeat token)))
+    (if (not (eq (car term) 'except))
+	;; repeat
+	term
+      ;; repeat - repeat
+      (let ((exception (ebnf-repeat (ebnf-bnf-lex))))
+	(ebnf-no-non-terminal (cdr exception))
+	(ebnf-token-except (cdr term) exception)))))
+
+
+(defun ebnf-no-non-terminal (node)
+  (and (vectorp node)
+       (let ((kind (ebnf-node-kind node)))
+	 (cond
+	  ((eq kind 'ebnf-generate-non-terminal)
+	   (error "Exception sequence should not contain a non-terminal."))
+	  ((eq kind 'ebnf-generate-repeat)
+	   (ebnf-no-non-terminal (ebnf-node-separator node)))
+	  ((memq kind '(ebnf-generate-optional ebnf-generate-except))
+	   (ebnf-no-non-terminal (ebnf-node-list node)))
+	  ((memq kind '(ebnf-generate-one-or-more ebnf-generate-zero-or-more))
+	   (ebnf-no-non-terminal (ebnf-node-list node))
+	   (ebnf-no-non-terminal (ebnf-node-separator node)))
+	  ((memq kind '(ebnf-generate-alternative ebnf-generate-sequence))
+	   (let ((seq (ebnf-node-list node)))
+	     (while seq
+	       (ebnf-no-non-terminal (car seq))
+	       (setq seq (cdr seq)))))
+	  ))))
+
+
+;;; repeat = [ integer "*" ] term.
+
+(defun ebnf-repeat (token)
+  (if (not (eq token 'integer))
+      (ebnf-term token)
+    (let ((times ebnf-bnf-lex))
+      (or (eq (ebnf-bnf-lex) 'repeat)
+	  (error "Missing `*'."))
+      (ebnf-token-repeat times (ebnf-term (ebnf-bnf-lex))))))
+
+
+;;; term = factor
+;;;      | [factor] "+"                       ;; one-or-more
+;;;      | [factor] "/" [factor]              ;; one-or-more
+;;;      .
+
+(defun ebnf-term (token)
+  (let ((factor (ebnf-factor token)))
+    (and factor
+	 (setq token (ebnf-bnf-lex)))
+    (cond
+     ;; [factor] +
+     ((eq token 'one-or-more)
+      (cons (ebnf-bnf-lex)
+	    (and factor
+		 (let ((kind (ebnf-node-kind factor)))
+		   (cond
+		    ;; { A }+ + ==> { A }+
+		    ;; { A }* + ==> { A }*
+		    ((memq kind '(ebnf-generate-zero-or-more
+				  ebnf-generate-one-or-more))
+		     factor)
+		    ;; [ A ] + ==> { A }*
+		    ((eq kind 'ebnf-generate-optional)
+		     (ebnf-make-zero-or-more (list factor)))
+		    ;; A +
+		    (t
+		     (ebnf-make-one-or-more (list factor)))
+		    )))))
+     ;; [factor] / [factor]
+     ((eq token 'list)
+      (setq token (ebnf-bnf-lex))
+      (let ((sep (ebnf-factor token)))
+	(and sep
+	     (setq factor (or factor (ebnf-make-empty))))
+	(cons (if sep
+		  (ebnf-bnf-lex)
+		token)
+	      (and factor
+		   (ebnf-make-one-or-more factor sep)))))
+     ;; factor
+     (t
+      (cons token factor))
+     )))
+
+
+;;; factor = [ "$" ] "\"" terminal "\""         ;; terminal
+;;;        | [ "$" ] non_terminal               ;; non-terminal
+;;;        | [ "$" ] "?" special "?"            ;; special
+;;;        | "(" body ")"                       ;; group
+;;;        | "[" body "]"                       ;; zero-or-one
+;;;        | "{" body [ "||" body ] "}+"        ;; one-or-more
+;;;        | "{" body [ "||" body ] "}*"        ;; zero-or-more
+;;;        | "{" body [ "||" body ] "}"         ;; zero-or-more
+;;;        .
+
+(defun ebnf-factor (token)
+  (cond
+   ;; terminal
+   ((eq token 'terminal)
+    (ebnf-make-terminal ebnf-bnf-lex))
+   ;; non-terminal
+   ((eq token 'non-terminal)
+    (ebnf-make-non-terminal ebnf-bnf-lex))
+   ;; special
+   ((eq token 'special)
+    (ebnf-make-special ebnf-bnf-lex))
+   ;; group
+   ((eq token 'begin-group)
+    (let ((body (ebnf-body)))
+      (or (eq (car body) 'end-group)
+	  (error "Missing `)'."))
+      (cdr body)))
+   ;; optional
+   ((eq token 'begin-optional)
+    (let ((body (ebnf-body)))
+      (or (eq (car body) 'end-optional)
+	  (error "Missing `]'."))
+      (ebnf-token-optional (cdr body))))
+   ;; list
+   ((eq token 'begin-list)
+    (let* ((body      (ebnf-body))
+	   (token     (car body))
+	   (list-part (cdr body))
+	   sep-part)
+      (and (eq token 'list-separator)
+	   ;; { A || B }
+	   (setq body     (ebnf-body)	; get separator
+		 token    (car body)
+		 sep-part (cdr body)))
+      (cond
+       ;; { A }+
+       ((eq token 'end-one-or-more)
+	(ebnf-make-one-or-more list-part sep-part))
+       ;; { A }*
+       ((eq token 'end-zero-or-more)
+	(ebnf-make-zero-or-more list-part sep-part))
+       (t
+	(error "Missing `}+', `}*' or `}'."))
+       )))
+   ;; no term
+   (t
+    nil)
+   ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Lexical analyzer
+
+
+(defconst ebnf-bnf-token-table (make-vector 256 'error)
+  "Vector used to map characters to a lexical token.")
+
+
+(defun ebnf-bnf-initialize ()
+  "Initialize EBNF token table."
+  ;; control character & control 8-bit character are set to `error'
+  (let ((char ?\040))
+    ;; printable character:
+    (while (< char ?\060)
+      (aset ebnf-bnf-token-table char 'non-terminal)
+      (setq char (1+ char)))
+    ;; digits:
+    (while (< char ?\072)
+      (aset ebnf-bnf-token-table char 'integer)
+      (setq char (1+ char)))
+    ;; printable character:
+    (while (< char ?\177)
+      (aset ebnf-bnf-token-table char 'non-terminal)
+      (setq char (1+ char)))
+    ;; European 8-bit accentuated characters:
+    (setq char ?\240)
+    (while (< char ?\400)
+      (aset ebnf-bnf-token-table char 'non-terminal)
+      (setq char (1+ char)))
+    ;; Override space characters:
+    (aset ebnf-bnf-token-table ?\013 'space) ; [VT] vertical tab
+    (aset ebnf-bnf-token-table ?\n   'space) ; [NL] linefeed
+    (aset ebnf-bnf-token-table ?\r   'space) ; [CR] carriage return
+    (aset ebnf-bnf-token-table ?\t   'space) ; [HT] horizontal tab
+    (aset ebnf-bnf-token-table ?\    'space) ; [SP] space
+    ;; Override form feed character:
+    (aset ebnf-bnf-token-table ?\f 'form-feed) ; [FF] form feed
+    ;; Override other lexical characters:
+    (aset ebnf-bnf-token-table ?\" 'terminal)
+    (aset ebnf-bnf-token-table ?\? 'special)
+    (aset ebnf-bnf-token-table ?\( 'begin-group)
+    (aset ebnf-bnf-token-table ?\) 'end-group)
+    (aset ebnf-bnf-token-table ?*  'repeat)
+    (aset ebnf-bnf-token-table ?-  'except)
+    (aset ebnf-bnf-token-table ?=  'equal)
+    (aset ebnf-bnf-token-table ?\[ 'begin-optional)
+    (aset ebnf-bnf-token-table ?\] 'end-optional)
+    (aset ebnf-bnf-token-table ?\{ 'begin-list)
+    (aset ebnf-bnf-token-table ?|  'alternative)
+    (aset ebnf-bnf-token-table ?\} 'end-list)
+    (aset ebnf-bnf-token-table ?/  'list)
+    (aset ebnf-bnf-token-table ?+  'one-or-more)
+    (aset ebnf-bnf-token-table ?$  'default)
+    ;; Override comment character:
+    (aset ebnf-bnf-token-table ebnf-lex-comment-char 'comment)
+    ;; Override end of production character:
+    (aset ebnf-bnf-token-table ebnf-lex-eop-char     'period)))
+
+
+(defun ebnf-bnf-lex ()
+  "Lexical analyser for EBNF.
+
+Return a lexical token.
+
+See documentation for variable `ebnf-bnf-lex'."
+  (if (>= (point) ebnf-limit)
+      'end-of-input
+    (let (token)
+      ;; skip spaces and comments
+      (while (if (> (following-char) 255)
+		 (progn
+		   (setq token 'error)
+		   nil)
+	       (setq token (aref ebnf-bnf-token-table (following-char)))
+	       (cond
+		((eq token 'space)
+		 (skip-chars-forward " \013\n\r\t" ebnf-limit)
+		 (< (point) ebnf-limit))
+		((eq token 'comment)
+		 (ebnf-bnf-skip-comment))
+		((eq token 'form-feed)
+		 (forward-char)
+		 (setq ebnf-action 'form-feed))
+		(t nil)
+		)))
+      (setq ebnf-default-p nil)
+      (cond
+       ;; end of input
+       ((>= (point) ebnf-limit)
+	'end-of-input)
+       ;; error
+       ((eq token 'error)
+	(error "Illegal character."))
+       ;; default
+       ((eq token 'default)
+	(forward-char)
+	(if (memq (aref ebnf-bnf-token-table (following-char))
+		  '(terminal non-terminal special))
+	    (prog1
+		(ebnf-bnf-lex)
+	      (setq ebnf-default-p t))
+	  (error "Illegal `default' element.")))
+       ;; integer
+       ((eq token 'integer)
+	(setq ebnf-bnf-lex (ebnf-buffer-substring "0-9"))
+	'integer)
+       ;; special: ?special?
+       ((eq token 'special)
+	(setq ebnf-bnf-lex (concat "?"
+				   (ebnf-string " ->@-~" ?\? "special")
+				   "?"))
+	'special)
+       ;; terminal: "string"
+       ((eq token 'terminal)
+	(setq ebnf-bnf-lex (ebnf-unescape-string (ebnf-get-string)))
+	'terminal)
+       ;; non-terminal or terminal
+       ((eq token 'non-terminal)
+	(setq ebnf-bnf-lex (ebnf-buffer-substring
+			    "!#%&'*-,0-:<>@-Z\\^-z~\240-\377"))
+	(let ((case-fold-search ebnf-case-fold-search)
+	      match)
+	  (if (and ebnf-terminal-regexp
+		   (setq match (string-match ebnf-terminal-regexp
+					     ebnf-bnf-lex))
+		   (zerop match)
+		   (= (match-end 0) (length ebnf-bnf-lex)))
+	      'terminal
+	    'non-terminal)))
+       ;; end of list: }+, }*, }
+       ((eq token 'end-list)
+	(forward-char)
+	(cond
+	 ((= (following-char) ?+)
+	  (forward-char)
+	  'end-one-or-more)
+	 ((= (following-char) ?*)
+	  (forward-char)
+	  'end-zero-or-more)
+	 (t
+	  'end-zero-or-more)
+	 ))
+       ;; alternative: |, ||
+       ((eq token 'alternative)
+	(forward-char)
+	(if (/= (following-char) ?|)
+	    'alternative
+	  (forward-char)
+	  'list-separator))
+       ;; miscellaneous: {, (, ), [, ], ., =, /, +, -, *
+       (t
+	(forward-char)
+	token)
+       ))))
+
+
+(defconst ebnf-bnf-comment-chars "^\n\000-\010\016-\037\177-\237")
+
+
+(defun ebnf-bnf-skip-comment ()
+  (forward-char)
+  (cond
+   ;; open EPS file
+   ((and ebnf-eps-executing (= (following-char) ?\[))
+    (ebnf-eps-add-context (ebnf-bnf-eps-filename)))
+   ;; close EPS file
+   ((and ebnf-eps-executing (= (following-char) ?\]))
+    (ebnf-eps-remove-context (ebnf-bnf-eps-filename)))
+   ;; any other action in comment
+   (t
+    (setq ebnf-action (aref ebnf-comment-table (following-char)))
+    (skip-chars-forward ebnf-bnf-comment-chars ebnf-limit))
+   )
+  ;; check for a valid end of comment
+  (cond ((>= (point) ebnf-limit)
+	 nil)
+	((= (following-char) ?\n)
+	 (forward-char)
+	 t)
+	(t
+	 (error "Illegal character."))
+	))
+
+
+(defun ebnf-bnf-eps-filename ()
+  (forward-char)
+  (ebnf-buffer-substring ebnf-bnf-comment-chars))
+
+
+(defun ebnf-unescape-string (str)
+  (let* ((len (length str))
+	 (size (1- len))
+	 (istr 0)
+	 (n-esc 0))
+    ;; count number of escapes
+    (while (< istr size)
+      (setq istr (+ istr
+		    (if (= (aref str istr) ?\\)
+			(progn
+			  (setq n-esc (1+ n-esc))
+			  2)
+		      1))))
+    (if (zerop n-esc)
+	;; no escapes
+	str
+      ;; at least one escape
+      (let ((new (make-string (- len n-esc) ?\ ))
+	    (inew 0))
+	;; eliminate all escapes
+	(setq istr 0)
+	(while (> n-esc 0)
+	  (and (= (aref str istr) ?\\)
+	       (setq istr  (1+ istr)
+		     n-esc (1- n-esc)))
+	  (aset new inew (aref str istr))
+	  (setq inew (1+ inew)
+		istr (1+ istr)))
+	;; remaining string has no escape
+	(while (< istr len)
+	  (aset new inew (aref str istr))
+	  (setq inew (1+ inew)
+		istr (1+ istr)))
+	new))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(provide 'ebnf-bnf)
+
+
+;;; ebnf-bnf.el ends here

lisp/progmodes/ebnf-iso.el

@@ -0,0 +1,607 @@
+;;; ebnf-iso --- Parser for ISO EBNF
+
+;; Copyright (C) 1999 Vinicius Jose Latorre
+
+;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords:   wp, ebnf, PostScript
+;; Time-stamp: <99/11/20 18:04:11 vinicius>
+;; Version:    1.4
+
+;; This file is *NOT* (yet?) 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 program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; This is part of ebnf2ps package.
+;;
+;; This package defines a parser for ISO EBNF.
+;;
+;; See ebnf2ps.el for documentation.
+;;
+;;
+;; ISO EBNF Syntax
+;; ---------------
+;;
+;;	See the URL:
+;;	`http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
+;;	("International Standard of the ISO EBNF Notation").
+;;
+;;
+;; ISO EBNF = syntax rule, {syntax rule};
+;;
+;; syntax rule = meta identifier, '=', definition list, ';';
+;;
+;; definition list = single definition, {'|', single definition};
+;;
+;; single definition = term, {',', term};
+;;
+;; term = factor, ['-', exception];
+;;
+;; exception = factor (* without <meta identifier> *);
+;;
+;; factor = [integer, '*'], primary;
+;;
+;; primary = optional sequence | repeated sequence | special sequence
+;;         | grouped sequence | meta identifier | terminal string
+;;         | empty;
+;;
+;; empty = ;
+;;
+;; optional sequence = '[', definition list, ']';
+;;
+;; repeated sequence = '{', definition list, '}';
+;;
+;; grouped sequence = '(', definition list, ')';
+;;
+;; terminal string = "'", character - "'", {character - "'"}, "'"
+;;                 | '"', character - '"', {character - '"'}, '"';
+;;
+;; special sequence = '?', {character - '?'}, '?';
+;;
+;; meta identifier = letter, { letter | decimal digit | ' ' };
+;;
+;; integer = decimal digit, {decimal digit};
+;;
+;; comment = '(*', {comment symbol}, '*)';
+;;
+;; comment symbol = comment (* <== NESTED COMMENT *)
+;;                | terminal string | special sequence | character;
+;;
+;; letter = ? A-Z a-z ?;
+;;
+;; decimal digit = ? 0-9 ?;
+;;
+;; character = letter | decimal digit
+;;           | ',' | '=' | '|' | '/' | '!' | '*' | '(' | ')' | '[' | ']' | '{'
+;;           | '}' | "'" | '"' | '?' | '-' | ';' | '.' | ' ' | ':' | '+' | '_'
+;;           | '%' | '@' | '&' | '#' | '$' | '<' | '>' | '\' | '^' | '`' | '~';
+;;
+;;
+;; There is also the following alternative representation:
+;;
+;; STANDARD   ALTERNATIVE
+;;    |    ==>   / or !
+;;    [    ==>   (/
+;;    ]    ==>   /)
+;;    {    ==>   (:
+;;    }    ==>   :)
+;;    ;    ==>   .
+;;
+;;
+;; Differences Between ISO EBNF And ebnf2ps ISO EBNF
+;; -------------------------------------------------
+;;
+;; ISO EBNF accepts the characters given by <character> production above,
+;; HORIZONTAL TAB (^I), VERTICAL TAB (^K), NEWLINE (^J or ^M) and FORM FEED
+;; (^L), any other characters are illegal.  But ebnf2ps accepts also the
+;; european 8-bit accentuated characters (from \240 to \377).
+;;
+;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; code:
+
+
+(require 'ebnf-otz)
+
+
+(defvar ebnf-iso-lex nil
+  "Value returned by `ebnf-iso-lex' function.")
+
+
+(defconst ebnf-no-meta-identifier nil)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Syntatic analyzer
+
+
+;;; ISO EBNF = syntax rule, {syntax rule};
+
+(defun ebnf-iso-parser (start)
+  "ISO EBNF parser."
+  (let ((total (+ (- ebnf-limit start) 1))
+	(bias (1- start))
+	(origin (point))
+	syntax-list token rule)
+    (goto-char start)
+    (setq token (ebnf-iso-lex))
+    (and (eq token 'end-of-input)
+	 (error "Invalid ISO EBNF file format."))
+    (while (not (eq token 'end-of-input))
+      (ebnf-message-float
+       "Parsing...%s%%"
+       (/ (* (- (point) bias) 100.0) total))
+      (setq token (ebnf-iso-syntax-rule token)
+	    rule  (cdr token)
+	    token (car token))
+      (or (ebnf-add-empty-rule-list rule)
+	  (setq syntax-list (cons rule syntax-list))))
+    (goto-char origin)
+    syntax-list))
+
+
+;;; syntax rule = meta identifier, '=', definition list, ';';
+
+(defun ebnf-iso-syntax-rule (token)
+  (let ((header ebnf-iso-lex)
+	(action ebnf-action)
+	body)
+    (setq ebnf-action nil)
+    (or (eq token 'non-terminal)
+	(error "Invalid meta identifier syntax rule."))
+    (or (eq (ebnf-iso-lex) 'equal)
+	(error "Invalid syntax rule: missing `='."))
+    (setq body (ebnf-iso-definition-list))
+    (or (eq (car body) 'period)
+	(error "Invalid syntax rule: missing `;' or `.'."))
+    (setq body (cdr body))
+    (ebnf-eps-add-production header)
+    (cons (ebnf-iso-lex)
+	  (ebnf-make-production header body action))))
+
+
+;;; definition list = single definition, {'|', single definition};
+
+(defun ebnf-iso-definition-list ()
+  (let (body sequence)
+    (while (eq (car (setq sequence (ebnf-iso-single-definition)))
+	       'alternative)
+      (setq sequence (cdr sequence)
+	    body     (cons sequence body)))
+    (ebnf-token-alternative body sequence)))
+
+
+;;; single definition = term, {',', term};
+
+(defun ebnf-iso-single-definition ()
+  (let (token seq term)
+    (while (and (setq term  (ebnf-iso-term (ebnf-iso-lex))
+		      token (car term)
+		      term  (cdr term))
+		(eq token 'catenate))
+      (setq seq (cons term seq)))
+    (cons token
+	  (cond
+	   ;; null sequence
+	   ((null seq)
+	    term)
+	   ;; sequence with only one element
+	   ((and (null term) (= (length seq) 1))
+	    (car seq))
+	   ;; a real sequence
+	   (t
+	    (ebnf-make-sequence (nreverse (cons term seq))))
+	   ))))
+
+
+;;; term = factor, ['-', exception];
+;;;
+;;; exception = factor (* without <meta identifier> *);
+
+(defun ebnf-iso-term (token)
+  (let ((factor (ebnf-iso-factor token)))
+    (if (not (eq (car factor) 'except))
+	;; factor
+	factor
+      ;; factor - exception
+      (let ((ebnf-no-meta-identifier t))
+	(ebnf-token-except (cdr factor) (ebnf-iso-factor (ebnf-iso-lex)))))))
+
+
+;;; factor = [integer, '*'], primary;
+
+(defun ebnf-iso-factor (token)
+  (if (eq token 'integer)
+      (let ((times ebnf-iso-lex))
+	(or (eq (ebnf-iso-lex) 'repeat)
+	    (error "Missing `*'."))
+	(ebnf-token-repeat times (ebnf-iso-primary (ebnf-iso-lex))))
+    (ebnf-iso-primary token)))
+
+
+;;; primary = optional sequence | repeated sequence | special sequence
+;;;         | grouped sequence | meta identifier | terminal string
+;;;         | empty;
+;;;
+;;; empty = ;
+;;;
+;;; optional sequence = '[', definition list, ']';
+;;;
+;;; repeated sequence = '{', definition list, '}';
+;;;
+;;; grouped sequence = '(', definition list, ')';
+;;;
+;;; terminal string = "'", character - "'", {character - "'"}, "'"
+;;;                 | '"', character - '"', {character - '"'}, '"';
+;;;
+;;; special sequence = '?', {character - '?'}, '?';
+;;;
+;;; meta identifier = letter, {letter | decimal digit};
+
+(defun ebnf-iso-primary (token)
+  (let ((primary
+	 (cond
+	  ;; terminal string
+	  ((eq token 'terminal)
+	   (ebnf-make-terminal ebnf-iso-lex))
+	  ;; meta identifier
+	  ((eq token 'non-terminal)
+	   (ebnf-make-non-terminal ebnf-iso-lex))
+	  ;; special sequence
+	  ((eq token 'special)
+	   (ebnf-make-special ebnf-iso-lex))
+	  ;; grouped sequence
+	  ((eq token 'begin-group)
+	   (let ((body (ebnf-iso-definition-list)))
+	     (or (eq (car body) 'end-group)
+		 (error "Missing `)'."))
+	     (cdr body)))
+	  ;; optional sequence
+	  ((eq token 'begin-optional)
+	   (let ((body (ebnf-iso-definition-list)))
+	     (or (eq (car body) 'end-optional)
+		 (error "Missing `]' or `/)'."))
+	     (ebnf-token-optional (cdr body))))
+	  ;; repeated sequence
+	  ((eq token 'begin-zero-or-more)
+	   (let* ((body   (ebnf-iso-definition-list))
+		  (repeat (cdr body)))
+	     (or (eq (car body) 'end-zero-or-more)
+		 (error "Missing `}' or `:)'."))
+	     (ebnf-make-zero-or-more repeat)))
+	  ;; empty
+	  (t
+	   nil)
+	  )))
+    (cons (if primary
+	      (ebnf-iso-lex)
+	    token)
+	  primary)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Lexical analyzer
+
+
+(defconst ebnf-iso-token-table
+  ;; control character & 8-bit character are set to `error'
+  (let ((table (make-vector 256 'error))
+	(char ?\040))
+    ;; printable character
+    (while (< char ?\060)
+      (aset table char 'character)
+      (setq char (1+ char)))
+    ;; digits:
+    (while (< char ?\072)
+      (aset table char 'integer)
+      (setq char (1+ char)))
+    (while (< char ?\101)
+      (aset table char 'character)
+      (setq char (1+ char)))
+    ;; upper case letters:
+    (while (< char ?\133)
+      (aset table char 'non-terminal)
+      (setq char (1+ char)))
+    (while (< char ?\141)
+      (aset table char 'character)
+      (setq char (1+ char)))
+    ;; lower case letters:
+    (while (< char ?\173)
+      (aset table char 'non-terminal)
+      (setq char (1+ char)))
+    (while (< char ?\177)
+      (aset table char 'character)
+      (setq char (1+ char)))
+    ;; European 8-bit accentuated characters:
+    (setq char ?\240)
+    (while (< char ?\400)
+      (aset table char 'non-terminal)
+      (setq char (1+ char)))
+    ;; Override space characters:
+    (aset table ?\013 'space)		; [VT] vertical tab
+    (aset table ?\n   'space)		; [NL] linefeed
+    (aset table ?\r   'space)		; [CR] carriage return
+    (aset table ?\t   'space)		; [HT] horizontal tab
+    (aset table ?\    'space)		; [SP] space
+    ;; Override form feed character:
+    (aset table ?\f 'form-feed)		; [FF] form feed
+    ;; Override other lexical characters:
+    (aset table ?\" 'double-terminal)
+    (aset table ?\' 'single-terminal)
+    (aset table ?\? 'special)
+    (aset table ?*  'repeat)
+    (aset table ?,  'catenate)
+    (aset table ?-  'except)
+    (aset table ?=  'equal)
+    (aset table ?\) 'end-group)
+    table)
+  "Vector used to map characters to a lexical token.")
+
+
+(defun ebnf-iso-initialize ()
+  "Initialize ISO EBNF token table."
+  (if ebnf-iso-alternative-p
+      ;; Override alternative lexical characters:
+      (progn
+	(aset ebnf-iso-token-table ?\( 'left-parenthesis)
+	(aset ebnf-iso-token-table ?\[ 'character)
+	(aset ebnf-iso-token-table ?\] 'character)
+	(aset ebnf-iso-token-table ?\{ 'character)
+	(aset ebnf-iso-token-table ?\} 'character)
+	(aset ebnf-iso-token-table ?|  'character)
+	(aset ebnf-iso-token-table ?\; 'character)
+	(aset ebnf-iso-token-table ?/  'slash)
+	(aset ebnf-iso-token-table ?!  'alternative)
+	(aset ebnf-iso-token-table ?:  'colon)
+	(aset ebnf-iso-token-table ?.  'period))
+    ;; Override standard lexical characters:
+    (aset ebnf-iso-token-table ?\( 'begin-parenthesis)
+    (aset ebnf-iso-token-table ?\[ 'begin-optional)
+    (aset ebnf-iso-token-table ?\] 'end-optional)
+    (aset ebnf-iso-token-table ?\{ 'begin-zero-or-more)
+    (aset ebnf-iso-token-table ?\} 'end-zero-or-more)
+    (aset ebnf-iso-token-table ?|  'alternative)
+    (aset ebnf-iso-token-table ?\; 'period)
+    (aset ebnf-iso-token-table ?/  'character)
+    (aset ebnf-iso-token-table ?!  'character)
+    (aset ebnf-iso-token-table ?:  'character)
+    (aset ebnf-iso-token-table ?.  'character)))
+
+
+(defun ebnf-iso-lex ()
+  "Lexical analyser for ISO EBNF.
+
+Return a lexical token.
+
+See documentation for variable `ebnf-iso-lex'."
+  (if (>= (point) ebnf-limit)
+      'end-of-input
+    (let (token)
+      ;; skip spaces and comments
+      (while (if (> (following-char) 255)
+		 (progn
+		   (setq token 'error)
+		   nil)
+	       (setq token (aref ebnf-iso-token-table (following-char)))
+	       (cond
+		((eq token 'space)
+		 (skip-chars-forward " \013\n\r\t" ebnf-limit)
+		 (< (point) ebnf-limit))
+		((or (eq token 'begin-parenthesis)
+		     (eq token 'left-parenthesis))
+		 (forward-char)
+		 (if (/= (following-char) ?*)
+		     ;; no comment
+		     nil
+		   ;; comment
+		   (ebnf-iso-skip-comment)
+		   t))
+		((eq token 'form-feed)
+		 (forward-char)
+		 (setq ebnf-action 'form-feed))
+		(t nil)
+		)))
+      (cond
+       ;; end of input
+       ((>= (point) ebnf-limit)
+	'end-of-input)
+       ;; error
+       ((eq token 'error)
+	(error "Illegal character."))
+       ;; integer
+       ((eq token 'integer)
+	(setq ebnf-iso-lex (ebnf-buffer-substring "0-9"))
+	'integer)
+       ;; special: ?special?
+       ((eq token 'special)
+	(setq ebnf-iso-lex (concat "?"
+				   (ebnf-string " ->@-~" ?\? "special")
+				   "?"))
+	'special)
+       ;; terminal: "string"
+       ((eq token 'double-terminal)
+	(setq ebnf-iso-lex (ebnf-string " !#-~" ?\" "terminal"))
+	'terminal)
+       ;; terminal: 'string'
+       ((eq token 'single-terminal)
+	(setq ebnf-iso-lex (ebnf-string " -&(-~" ?\' "terminal"))
+	'terminal)
+       ;; non-terminal
+       ((eq token 'non-terminal)
+	(setq ebnf-iso-lex (ebnf-iso-normalize
+			    (ebnf-trim-right
+			     (ebnf-buffer-substring " 0-9A-Za-z\240-\377"))))
+	(and ebnf-no-meta-identifier
+	     (error "Exception sequence should not contain a meta identifier."))
+	'non-terminal)
+       ;; begin optional, begin list or begin group
+       ((eq token 'left-parenthesis)
+	(forward-char)
+	(cond ((= (following-char) ?/)
+	       (forward-char)
+	       'begin-optional)
+	      ((= (following-char) ?:)
+	       (forward-char)
+	       'begin-zero-or-more)
+	      (t
+	       'begin-group)
+	      ))
+       ;; end optional or alternative
+       ((eq token 'slash)
+	(forward-char)
+	(if (/= (following-char) ?\))
+	    'alternative
+	  (forward-char)
+	  'end-optional))
+       ;; end list
+       ((eq token 'colon)
+	(forward-char)
+	(if (/= (following-char) ?\))
+	    'character
+	  (forward-char)
+	  'end-zero-or-more))
+       ;; begin group
+       ((eq token 'begin-parenthesis)
+	'begin-group)
+       ;; miscellaneous
+       (t
+	(forward-char)
+	token)
+       ))))
+
+
+(defconst ebnf-iso-comment-chars "^*(\000-\010\016-\037\177-\237")
+
+
+(defun ebnf-iso-skip-comment ()
+  (forward-char)
+  (cond
+   ;; open EPS file
+   ((and ebnf-eps-executing (= (following-char) ?\[))
+    (ebnf-eps-add-context (ebnf-iso-eps-filename)))
+   ;; close EPS file
+   ((and ebnf-eps-executing (= (following-char) ?\]))
+    (ebnf-eps-remove-context (ebnf-iso-eps-filename)))
+   ;; any other action in comment
+   (t
+    (setq ebnf-action (aref ebnf-comment-table (following-char))))
+   )
+  (let ((pair 1))
+    (while (> pair 0)
+      (skip-chars-forward ebnf-iso-comment-chars ebnf-limit)
+      (cond ((>= (point) ebnf-limit)
+	     (error "Missing end of comment: `*)'."))
+	    ((= (following-char) ?*)
+	     (skip-chars-forward "*" ebnf-limit)
+	     (when (= (following-char) ?\))
+	       ;; end of comment
+	       (forward-char)
+	       (setq pair (1- pair))))
+	    ((= (following-char) ?\()
+	     (skip-chars-forward "(" ebnf-limit)
+	     (when (= (following-char) ?*)
+	       ;; beginning of comment
+	       (forward-char)
+	       (setq pair (1+ pair))))
+	    (t
+	     (error "Illegal character."))
+	    ))))
+
+
+(defun ebnf-iso-eps-filename ()
+  (forward-char)
+  (buffer-substring-no-properties
+   (point)
+   (let ((chars (concat ebnf-iso-comment-chars "\n"))
+	 found)
+     (while (not found)
+       (skip-chars-forward chars ebnf-limit)
+       (setq found
+	     (cond ((>= (point) ebnf-limit)
+		    (point))
+		   ((= (following-char) ?*)
+		    (skip-chars-forward "*" ebnf-limit)
+		    (if (/= (following-char) ?\))
+			nil
+		      (backward-char)
+		      (point)))
+		   ((= (following-char) ?\()
+		    (forward-char)
+		    (if (/= (following-char) ?*)
+			nil
+		      (backward-char)
+		      (point)))
+		   (t
+		    (point))
+		   )))
+     found)))
+
+
+(defun ebnf-iso-normalize (str)
+  (if (not ebnf-iso-normalize-p)
+      str
+    (let ((len (length str))
+	  (stri 0)
+	  (spaces 0))
+      ;; count exceeding spaces
+      (while (< stri len)
+	(if (/= (aref str stri) ?\ )
+	    (setq stri (1+ stri))
+	  (setq stri (1+ stri))
+	  (while (and (< stri len) (= (aref str stri) ?\ ))
+	    (setq stri   (1+ stri)
+		  spaces (1+ spaces)))))
+      (if (zerop spaces)
+	  ;; no exceeding space
+	  str
+	;; at least one exceeding space
+	(let ((new (make-string (- len spaces) ?\ ))
+	      (newi 0))
+	  ;; eliminate exceeding spaces
+	  (setq stri 0)
+	  (while (> spaces 0)
+	    (if (/= (aref str stri) ?\ )
+		(progn
+		  (aset new newi (aref str stri))
+		  (setq stri (1+ stri)
+			newi (1+ newi)))
+	      (aset new newi (aref str stri))
+	      (setq stri (1+ stri)
+		    newi (1+ newi))
+	      (while (and (> spaces 0) (= (aref str stri) ?\ ))
+		(setq stri   (1+ stri)
+		      spaces (1- spaces)))))
+	  ;; remaining is normalized
+	  (while (< stri len)
+	    (aset new newi (aref str stri))
+	    (setq stri (1+ stri)
+		  newi (1+ newi)))
+	  new)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(provide 'ebnf-iso)
+
+
+;;; ebnf-iso.el ends here

lisp/progmodes/ebnf-otz.el

@@ -0,0 +1,661 @@
+;;; ebnf-otz --- Syntatic chart OpTimiZer
+
+;; Copyright (C) 1999 Vinicius Jose Latorre
+
+;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords:   wp, ebnf, PostScript
+;; Time-stamp: <99/11/20 18:03:10 vinicius>
+;; Version:    1.0
+
+;; This file is *NOT* (yet?) 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 program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; This is part of ebnf2ps package.
+;;
+;; This package defines an optimizer for ebnf2ps.
+;;
+;; See ebnf2ps.el for documentation.
+;;
+;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; code:
+
+
+(require 'ebnf2ps)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defvar ebnf-empty-rule-list nil
+  "List of empty rule name.")
+
+
+(defun ebnf-add-empty-rule-list (rule)
+  "Add empty RULE in `ebnf-empty-rule-list'."
+  (and ebnf-ignore-empty-rule
+       (eq (ebnf-node-kind (ebnf-node-production rule))
+	   'ebnf-generate-empty)
+       (setq ebnf-empty-rule-list (cons (ebnf-node-name rule)
+					ebnf-empty-rule-list))))
+
+
+(defun ebnf-otz-initialize ()
+  "Initialize optimizer."
+  (setq ebnf-empty-rule-list nil))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Eliminate empty rules
+
+
+(defun ebnf-eliminate-empty-rules (syntax-list)
+  "Eliminate empty rules."
+  (while ebnf-empty-rule-list
+    (let ((ebnf-total (length syntax-list))
+	  (ebnf-nprod 0)
+	  (prod-list syntax-list)
+	  new-list before)
+      (while prod-list
+	(ebnf-message-info "Eliminating empty rules")
+	(let ((rule (car prod-list)))
+	  ;; if any non-terminal pertains to ebnf-empty-rule-list
+	  ;; then eliminate non-terminal from rule
+	  (if (ebnf-eliminate-empty rule)
+	      (setq before prod-list)
+	    ;; eliminate empty rule from syntax-list
+	    (setq new-list (cons (ebnf-node-name rule) new-list))
+	    (if before
+		(setcdr before (cdr prod-list))
+	      (setq syntax-list (cdr syntax-list)))))
+	(setq prod-list (cdr prod-list)))
+      (setq ebnf-empty-rule-list new-list)))
+  syntax-list)
+
+
+;; [production   width-func entry height width name production action]
+;; [sequence     width-func entry height width list]
+;; [alternative  width-func entry height width list]
+;; [non-terminal width-func entry height width name default]
+;; [empty        width-func entry height width]
+;; [terminal     width-func entry height width name default]
+;; [special      width-func entry height width name default]
+
+(defun ebnf-eliminate-empty (rule)
+  (let ((kind (ebnf-node-kind rule)))
+    (cond
+     ;; non-terminal
+     ((eq kind 'ebnf-generate-non-terminal)
+      (if (member (ebnf-node-name rule) ebnf-empty-rule-list)
+	  nil
+	rule))
+     ;; sequence
+     ((eq kind 'ebnf-generate-sequence)
+      (let ((seq    (ebnf-node-list rule))
+	    (header (ebnf-node-list rule))
+	    before elt)
+	(while seq
+	  (setq elt (car seq))
+	  (if (ebnf-eliminate-empty elt)
+	      (setq before seq)
+	    (if before
+		(setcdr before (cdr seq))
+	      (setq header (cdr header))))
+	  (setq seq (cdr seq)))
+	(when header
+	  (ebnf-node-list rule header)
+	  rule)))
+     ;; alternative
+     ((eq kind 'ebnf-generate-alternative)
+      (let ((seq    (ebnf-node-list rule))
+	    (header (ebnf-node-list rule))
+	    before elt)
+	(while seq
+	  (setq elt (car seq))
+	  (if (ebnf-eliminate-empty elt)
+	      (setq before seq)
+	    (if before
+		(setcdr before (cdr seq))
+	      (setq header (cdr header))))
+	  (setq seq (cdr seq)))
+	(when header
+	  (if (= (length header) 1)
+	      (car header)
+	    (ebnf-node-list rule header)
+	    rule))))
+     ;; production
+     ((eq kind 'ebnf-generate-production)
+      (let ((prod (ebnf-eliminate-empty (ebnf-node-production rule))))
+	(when prod
+	  (ebnf-node-production rule prod)
+	  rule)))
+     ;; terminal, special and empty
+     (t
+      rule)
+     )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Optimizations
+
+
+;; *To be implemented*:
+;;    left recursion:
+;;    A = B | A C B | A C D.   ==>   A = B {C (B | D)}*.
+
+;;    right recursion:
+;;    A = B | C A.             ==>   A = {C}* B.
+;;    A = B | D | C A | E A.   ==>   A = { C | E }* ( B | D ).
+
+;;    optional:
+;;    A = B | C B.             ==>   A = [C] B.
+;;    A = B | B C.             ==>   A = B [C].
+;;    A = D | B D | B C D.     ==>   A = [B [C]] D.
+
+
+;; *Already implemented*:
+;;    left recursion:
+;;    A = B | A C.             ==>   A = B {C}*.
+;;    A = B | A B.             ==>   A = {B}+.
+;;    A =   | A B.             ==>   A = {B}*.
+;;    A = B | A C B.           ==>   A = {B || C}+.
+;;    A = B | D | A C | A E.   ==>   A = ( B | D ) { C | E }*.
+
+;;    optional:
+;;    A = B | .                ==>   A = [B].
+;;    A =   | B .              ==>   A = [B].
+
+;;    factoration:
+;;    A = B C | B D.           ==>   A = B (C | D).
+;;    A = C B | D B.           ==>   A = (C | D) B.
+;;    A = B C E | B D E.       ==>   A = B (C | D) E.
+
+;;    none:
+;;    A = B | C | .            ==>   A = B | C | .
+;;    A = B | C A D.           ==>   A = B | C A D.
+
+(defun ebnf-optimize (syntax-list)
+  "Syntatic chart optimizer."
+  (if (not ebnf-optimize)
+      syntax-list
+    (let ((ebnf-total (length syntax-list))
+	  (ebnf-nprod 0)
+	  new)
+      (while syntax-list
+	(setq new (cons (ebnf-optimize1 (car syntax-list)) new)
+	      syntax-list (cdr syntax-list)))
+      (nreverse new))))
+
+
+;; left recursion:
+;; 1.  A = B | A C.             ==>   A = B {C}*.
+;; 2.  A = B | A B.             ==>   A = {B}+.
+;; 3.  A =   | A B.             ==>   A = {B}*.
+;; 4.  A = B | A C B.           ==>   A = {B || C}+.
+;; 5.  A = B | D | A C | A E.   ==>   A = ( B | D ) { C | E }*.
+
+;; optional:
+;; 6.  A = B | .                ==>   A = [B].
+;; 7.  A =   | B .              ==>   A = [B].
+
+;; factoration:
+;; 8.  A = B C | B D.           ==>   A = B (C | D).
+;; 9.  A = C B | D B.           ==>   A = (C | D) B.
+;; 10. A = B C E | B D E.       ==>   A = B (C | D) E.
+
+(defun ebnf-optimize1 (prod)
+  (ebnf-message-info "Optimizing syntatic chart")
+  (let ((production (ebnf-node-production prod)))
+    (and (eq (ebnf-node-kind production) 'ebnf-generate-alternative)
+	 (let* ((hlist (ebnf-split-header-prefix
+			(ebnf-node-list production)
+			(ebnf-node-name prod)))
+		(nlist (car hlist))
+		(zlist (cdr hlist))
+		(elist (ebnf-split-header-suffix nlist zlist)))
+	   (ebnf-node-production
+	    prod
+	    (cond
+	     ;; cases 2., 4.
+	     (elist
+	      (and (eq elist t)
+		   (setq elist nil))
+	      (setq elist (or (ebnf-prefix-suffix elist)
+			      elist))
+	      (let* ((nl (ebnf-extract-empty nlist))
+		     (el (or (ebnf-prefix-suffix (cdr nl))
+			     (ebnf-create-alternative (cdr nl)))))
+		(if (car nl)
+		    (ebnf-make-zero-or-more el elist)
+		  (ebnf-make-one-or-more el elist))))
+	     ;; cases 1., 3., 5.
+	     (zlist
+	      (let* ((xlist (cdr (ebnf-extract-empty zlist)))
+		     (znode (ebnf-make-zero-or-more
+			     (or (ebnf-prefix-suffix xlist)
+				 (ebnf-create-alternative xlist))))
+		     (nnode (ebnf-map-list-to-optional nlist)))
+		(and nnode
+		     (setq nlist (list nnode)))
+		(if (or (null nlist)
+			(and (= (length nlist) 1)
+			     (eq (ebnf-node-kind (car nlist))
+				 'ebnf-generate-empty)))
+		    znode
+		  (ebnf-make-sequence
+		   (list (or (ebnf-prefix-suffix nlist)
+			     (ebnf-create-alternative nlist))
+			 znode)))))
+	     ;; cases 6., 7.
+	     ((ebnf-map-node-to-optional production)
+	      )
+	     ;; cases 8., 9., 10.
+	     ((ebnf-prefix-suffix nlist)
+	      )
+	     ;; none
+	     (t
+	      production)
+	     ))))
+    prod))
+
+
+(defun ebnf-split-header-prefix (node-list header)
+  (let* ((hlist (ebnf-split-header-prefix1 node-list header))
+	 (nlist (car hlist))
+	 zlist empty-p)
+    (while (setq hlist (cdr hlist))
+      (let ((elt (car hlist)))
+	(if (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
+	    (setq zlist (cons
+			 (let ((seq (cdr (ebnf-node-list elt))))
+			   (if (= (length seq) 1)
+			       (car seq)
+			     (ebnf-node-list elt seq)
+			     elt))
+			 zlist))
+	  (setq empty-p t))))
+    (and empty-p
+	 (setq zlist (cons (ebnf-make-empty)
+			   zlist)))
+    (cons nlist (nreverse zlist))))
+
+
+(defun ebnf-split-header-prefix1 (node-list header)
+  (let (hlist nlist)
+    (while node-list
+      (if (ebnf-node-equal-header (car node-list) header)
+	  (setq hlist (cons (car node-list) hlist))
+	(setq nlist (cons (car node-list) nlist)))
+      (setq node-list (cdr node-list)))
+    (cons (nreverse nlist) (nreverse hlist))))
+
+
+(defun ebnf-node-equal-header (node header)
+  (let ((kind (ebnf-node-kind node)))
+    (cond
+     ((eq kind 'ebnf-generate-sequence)
+      (ebnf-node-equal-header (car (ebnf-node-list node)) header))
+     ((eq kind 'ebnf-generate-non-terminal)
+      (string= (ebnf-node-name node) header))
+     (t
+      nil)
+     )))
+
+
+(defun ebnf-map-node-to-optional (node)
+  (and (eq (ebnf-node-kind node) 'ebnf-generate-alternative)
+       (ebnf-map-list-to-optional (ebnf-node-list node))))
+
+
+(defun ebnf-map-list-to-optional (nlist)
+  (and (= (length nlist) 2)
+       (let ((first  (nth 0 nlist))
+	     (second (nth 1 nlist)))
+	 (cond
+	  ;; empty second
+	  ((eq (ebnf-node-kind first) 'ebnf-generate-empty)
+	   (ebnf-make-optional second))
+	  ;; first empty
+	  ((eq (ebnf-node-kind second) 'ebnf-generate-empty)
+	   (ebnf-make-optional first))
+	  ;; first second
+	  (t
+	   nil)
+	  ))))
+
+
+(defun ebnf-extract-empty (elist)
+  (let ((now elist)
+	before empty-p)
+    (while now
+      (if (not (eq (ebnf-node-kind (car now)) 'ebnf-generate-empty))
+	  (setq before now)
+	(setq empty-p t)
+	(if before
+	    (setcdr before (cdr now))
+	  (setq elist (cdr elist))))
+      (setq now (cdr now)))
+    (cons empty-p elist)))
+
+
+(defun ebnf-split-header-suffix (nlist zlist)
+  (let (new empty-p)
+    (and (cond
+	  ((= (length nlist) 1)
+	   (let ((ok t)
+		 (elt (car nlist)))
+	     (while (and ok zlist)
+	       (setq ok    (ebnf-split-header-suffix1 elt (car zlist))
+		     zlist (cdr zlist))
+	       (if (eq ok t)
+		   (setq empty-p t)
+		 (setq new (cons ok new))))
+	     ok))
+	  ((= (length nlist) (length zlist))
+	   (let ((ok t))
+	     (while (and ok zlist)
+	       (setq ok    (ebnf-split-header-suffix1 (car nlist) (car zlist))
+		     nlist (cdr nlist)
+		     zlist (cdr zlist))
+	       (if (eq ok t)
+		   (setq empty-p t)
+		 (setq new (cons ok new))))
+	     ok))
+	  (t
+	   nil)
+	  )
+	 (let* ((lis (ebnf-unique-list new))
+		(len (length lis)))
+	   (cond
+	    ((zerop len)
+	     t)
+	    ((= len 1)
+	     (setq lis (car lis))
+	     (if empty-p
+		 (ebnf-make-optional lis)
+	       lis))
+	    (t
+	     (and empty-p
+		  (setq lis (cons (ebnf-make-empty) lis)))
+	     (ebnf-create-alternative (nreverse lis)))
+	    )))))
+
+
+(defun ebnf-split-header-suffix1 (ne ze)
+  (cond
+   ((eq (ebnf-node-kind ne) 'ebnf-generate-sequence)
+    (and (eq (ebnf-node-kind ze) 'ebnf-generate-sequence)
+	 (let ((nl (ebnf-node-list ne))
+	       (zl (ebnf-node-list ze))
+	       len z)
+	   (and (>= (length zl) (length nl))
+		(let ((ok t))
+		  (setq len (- (length zl) (length nl))
+			z   (nthcdr len zl))
+		  (while (and ok z)
+		    (setq ok (ebnf-node-equal (car z) (car nl))
+			  z  (cdr z)
+			  nl (cdr nl)))
+		  ok)
+		(if (zerop len)
+		    t
+		  (setcdr (nthcdr (1- len) zl) nil)
+		  ze)))))
+   ((eq (ebnf-node-kind ze) 'ebnf-generate-sequence)
+    (let* ((zl  (ebnf-node-list ze))
+	   (len (length zl)))
+      (and (ebnf-node-equal ne (car (nthcdr (1- len) zl)))
+	   (cond
+	    ((= len 1)
+	     t)
+	    ((= len 2)
+	     (car zl))
+	    (t
+	     (setcdr (nthcdr (- len 2) zl) nil)
+	     ze)
+	    ))))
+   (t
+    (ebnf-node-equal ne ze))
+   ))
+
+
+(defun ebnf-prefix-suffix (lis)
+  (and lis (listp lis)
+       (let* ((prefix (ebnf-split-prefix lis))
+	      (suffix (ebnf-split-suffix (cdr prefix)))
+	      (middle (cdr suffix)))
+	 (setq prefix (car prefix)
+	       suffix (car suffix))
+	 (and (or prefix suffix)
+	      (ebnf-make-sequence
+	       (nconc prefix
+		      (and middle
+			   (list (or (ebnf-map-list-to-optional middle)
+				     (ebnf-create-alternative middle))))
+		      suffix))))))
+
+
+(defun ebnf-split-prefix (lis)
+  (let* ((len  (length lis))
+	 (tail lis)
+	 (head (if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)
+		   (ebnf-node-list (car lis))
+		 (list (car lis))))
+	 (ipre (1+ len)))
+    ;; determine prefix length
+    (while (and (> ipre 0) (setq tail (cdr tail)))
+      (let ((cur head)
+	    (this (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
+		      (ebnf-node-list (car tail))
+		    (list (car tail))))
+	    (i 0))
+	(while (and cur this
+		    (ebnf-node-equal (car cur) (car this)))
+	  (setq cur  (cdr cur)
+		this (cdr this)
+		i    (1+ i)))
+	(setq ipre (min ipre i))))
+    (if (or (zerop ipre) (> ipre len))
+	;; no prefix at all
+	(cons nil lis)
+      (let* ((tail   (nthcdr ipre head))
+	     ;; get prefix
+	     (prefix (progn
+		       (and tail
+			    (setcdr (nthcdr (1- ipre) head) nil))
+		       head))
+	     empty-p before)
+	;; adjust first element
+	(if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence))
+		(null tail))
+	    (setq lis     (cdr lis)
+		  tail    lis
+		  empty-p t)
+	  (if (= (length tail) 1)
+	      (setcar lis (car tail))
+	    (ebnf-node-list (car lis) tail))
+	  (setq tail (cdr lis)))
+	;; eliminate prefix from lis based on ipre
+	(while tail
+	  (let ((elt (car tail))
+		rest)
+	    (if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
+		     (setq rest (nthcdr ipre (ebnf-node-list elt))))
+		(progn
+		  (if (= (length rest) 1)
+		      (setcar tail (car rest))
+		    (ebnf-node-list elt rest))
+		  (setq before tail))
+	      (setq empty-p t)
+	      (if before
+		  (setcdr before (cdr tail))
+		(setq lis (cdr lis))))
+	    (setq tail (cdr tail))))
+	(cons prefix (ebnf-unique-list
+		      (if empty-p
+			  (nconc lis (list (ebnf-make-empty)))
+			lis)))))))
+
+
+(defun ebnf-split-suffix (lis)
+  (let* ((len  (length lis))
+	 (tail lis)
+	 (head (nreverse
+		(if (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence)
+		    (ebnf-node-list (car lis))
+		  (list (car lis)))))
+	 (isuf (1+ len)))
+    ;; determine suffix length
+    (while (and (> isuf 0) (setq tail (cdr tail)))
+      (let* ((cur head)
+	     (tlis (nreverse
+		    (if (eq (ebnf-node-kind (car tail)) 'ebnf-generate-sequence)
+			(ebnf-node-list (car tail))
+		      (list (car tail)))))
+	     (this tlis)
+	     (i 0))
+	(while (and cur this
+		    (ebnf-node-equal (car cur) (car this)))
+	  (setq cur  (cdr cur)
+		this (cdr this)
+		i    (1+ i)))
+	(nreverse tlis)
+	(setq isuf (min isuf i))))
+    (setq head (nreverse head))
+    (if (or (zerop isuf) (> isuf len))
+	;; no suffix at all
+	(cons nil lis)
+      (let* ((n      (- (length head) isuf))
+	     ;; get suffix
+	     (suffix (nthcdr n head))
+	     (tail   (and (> n 0)
+			  (progn
+			    (setcdr (nthcdr (1- n) head) nil)
+			    head)))
+	     before empty-p)
+	;; adjust first element
+	(if (or (not (eq (ebnf-node-kind (car lis)) 'ebnf-generate-sequence))
+		(null tail))
+	    (setq lis     (cdr lis)
+		  tail    lis
+		  empty-p t)
+	  (if (= (length tail) 1)
+	      (setcar lis (car tail))
+	    (ebnf-node-list (car lis) tail))
+	  (setq tail (cdr lis)))
+	;; eliminate suffix from lis based on isuf
+	(while tail
+	  (let ((elt (car tail))
+		rest)
+	    (if (and (eq (ebnf-node-kind elt) 'ebnf-generate-sequence)
+		     (setq rest (ebnf-node-list elt)
+			   n    (- (length rest) isuf))
+		     (> n 0))
+		(progn
+		  (if (= n 1)
+		      (setcar tail (car rest))
+		    (setcdr (nthcdr (1- n) rest) nil)
+		    (ebnf-node-list elt rest))
+		  (setq before tail))
+	      (setq empty-p t)
+	      (if before
+		  (setcdr before (cdr tail))
+		(setq lis (cdr lis))))
+	    (setq tail (cdr tail))))
+	(cons suffix (ebnf-unique-list
+		      (if empty-p
+			  (nconc lis (list (ebnf-make-empty)))
+			lis)))))))
+
+
+(defun ebnf-unique-list (nlist)
+  (let ((current nlist)
+	before)
+    (while current
+      (let ((tail (cdr current))
+	    (head (car current))
+	    remove-p)
+	(while tail
+	  (if (not (ebnf-node-equal head (car tail)))
+	      (setq tail (cdr tail))
+	    (setq remove-p t
+		  tail     nil)
+	    (if before
+		(setcdr before (cdr current))
+	      (setq nlist (cdr nlist)))))
+	(or remove-p
+	    (setq before current))
+	(setq current (cdr current))))
+    nlist))
+
+
+(defun ebnf-node-equal (A B)
+  (let ((kindA (ebnf-node-kind A))
+	(kindB (ebnf-node-kind B)))
+    (and (eq kindA kindB)
+	 (cond
+	  ;; empty
+	  ((eq kindA 'ebnf-generate-empty)
+	   t)
+	  ;; non-terminal, terminal, special
+	  ((memq kindA '(ebnf-generate-non-terminal
+			 ebnf-generate-terminal
+			 ebnf-generate-special))
+	   (string= (ebnf-node-name A) (ebnf-node-name B)))
+	  ;; alternative, sequence
+	  ((memq kindA '(ebnf-generate-alternative ; any order
+			 ebnf-generate-sequence)) ; order is important
+	   (let ((listA (ebnf-node-list A))
+		 (listB (ebnf-node-list B)))
+	     (and (= (length listA) (length listB))
+		  (let ((ok t))
+		    (while (and ok listA)
+		      (setq ok    (ebnf-node-equal (car listA) (car listB))
+			    listA (cdr listA)
+			    listB (cdr listB)))
+		    ok))))
+	  ;; production
+	  ((eq kindA 'ebnf-generate-production)
+	   (and (string= (ebnf-node-name A) (ebnf-node-name B))
+		(ebnf-node-equal (ebnf-node-production A)
+				 (ebnf-node-production B))))
+	  ;; otherwise
+	  (t
+	   nil)
+	  ))))
+
+
+(defun ebnf-create-alternative (alt)
+  (if (> (length alt) 1)
+      (ebnf-make-alternative alt)
+    (car alt)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(provide 'ebnf-otz)
+
+
+;;; ebnf-otz.el ends here

lisp/progmodes/ebnf-yac.el

@@ -0,0 +1,487 @@
+;;; ebnf-yac --- Parser for Yacc/Bison
+
+;; Copyright (C) 1999 Vinicius Jose Latorre
+
+;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords:   wp, ebnf, PostScript
+;; Time-stamp: <99/11/20 18:02:43 vinicius>
+;; Version:    1.0
+
+;; This file is *NOT* (yet?) 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 program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;
+;; This is part of ebnf2ps package.
+;;
+;; This package defines a parser for Yacc/Bison.
+;;
+;; See ebnf2ps.el for documentation.
+;;
+;;
+;; Yacc/Bison Syntax
+;; -----------------
+;;
+;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
+;;
+;; YACC-Definitions = "%token" [ "<" Name ">" ] Name-List
+;;                  | "any other Yacc definition"
+;;                  .
+;;
+;; YACC-Code = "any C definition".
+;;
+;; YACC-Rule = Name ":" Alternative ";".
+;;
+;; Alternative = { Sequence || "|" }*.
+;;
+;; Sequence = { Factor }*.
+;;
+;; Factor = Name
+;;        | "'" "character" "'"
+;;        | "error"
+;;        | "{" "C like commands" "}"
+;;        .
+;;
+;; Name-List = { Name || "," }*.
+;;
+;; Name = "[A-Za-z][A-Za-z0-9_.]*".
+;;
+;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
+;;         | "//" "any character" "\\n".
+;;
+;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; code:
+
+
+(require 'ebnf-otz)
+
+
+(defvar ebnf-yac-lex nil
+  "Value returned by `ebnf-yac-lex' function.")
+
+
+(defvar ebnf-yac-token-list nil
+  "List of `%TOKEN' names.")
+
+
+(defvar ebnf-yac-skip-char nil
+  "Non-nil means skip printable characters with no grammatical meaning.")
+
+
+(defvar ebnf-yac-error nil
+  "Non-nil means \"error\" occured.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Syntatic analyzer
+
+
+;;; YACC = { YACC-Definitions }* "%%" { YACC-Rule }* [ "%%" [ YACC-Code ] ].
+;;;
+;;; YACC-Code = "any C definition".
+
+(defun ebnf-yac-parser (start)
+  "yacc/Bison parser."
+  (let ((total (+ (- ebnf-limit start) 1))
+	(bias (1- start))
+	(origin (point))
+	syntax-list token rule)
+    (goto-char start)
+    (setq token (ebnf-yac-lex))
+    (and (eq token 'end-of-input)
+	 (error "Invalid Yacc/Bison file format."))
+    (or (eq (ebnf-yac-definitions token) 'yac-separator)
+	(error "Missing `%%%%'."))
+    (setq token (ebnf-yac-lex))
+    (while (not (memq token '(end-of-input yac-separator)))
+      (ebnf-message-float
+       "Parsing...%s%%"
+       (/ (* (- (point) bias) 100.0) total))
+      (setq token (ebnf-yac-rule token)
+	    rule  (cdr token)
+	    token (car token))
+      (or (ebnf-add-empty-rule-list rule)
+	  (setq syntax-list (cons rule syntax-list))))
+    (goto-char origin)
+    syntax-list))
+
+
+;;; YACC-Definitions = "%token" [ "<" Name ">" ] Name-List
+;;;                  | "any other Yacc definition"
+;;;                  .
+
+(defun ebnf-yac-definitions (token)
+  (let ((ebnf-yac-skip-char t))
+    (while (not (memq token '(yac-separator end-of-input)))
+      (setq token
+	    (cond
+	     ;; "%token" [ "<" Name ">" ] Name-List
+	     ((eq token 'yac-token)
+	      (setq token (ebnf-yac-lex))
+	      (when (eq token 'open-angle)
+		(or (eq (ebnf-yac-lex) 'non-terminal)
+		    (error "Missing type name."))
+		(or (eq (ebnf-yac-lex) 'close-angle)
+		    (error "Missing `>'."))
+		(setq token (ebnf-yac-lex)))
+	      (setq token               (ebnf-yac-name-list token)
+		    ebnf-yac-token-list (nconc (cdr token)
+					       ebnf-yac-token-list))
+	      (car token))
+	     ;; "any other Yacc definition"
+	     (t
+	      (ebnf-yac-lex))
+	     )))
+    token))
+
+
+;;; YACC-Rule = Name ":" Alternative ";".
+
+(defun ebnf-yac-rule (token)
+  (let ((header ebnf-yac-lex)
+	(action ebnf-action)
+	body)
+    (setq ebnf-action nil)
+    (or (eq token 'non-terminal)
+	(error "Invalid rule name."))
+    (or (eq (ebnf-yac-lex) 'colon)
+	(error "Invalid rule: missing `:'."))
+    (setq body (ebnf-yac-alternative))
+    (or (eq (car body) 'period)
+	(error "Invalid rule: missing `;'."))
+    (setq body (cdr body))
+    (ebnf-eps-add-production header)
+    (cons (ebnf-yac-lex)
+	  (ebnf-make-production header body action))))
+
+
+;;; Alternative = { Sequence || "|" }*.
+
+(defun ebnf-yac-alternative ()
+  (let (body sequence)
+    (while (eq (car (setq sequence (ebnf-yac-sequence)))
+	       'alternative)
+      (and (setq sequence (cdr sequence))
+	   (setq body     (cons sequence body))))
+    (ebnf-token-alternative body sequence)))
+
+
+;;; Sequence = { Factor }*.
+
+(defun ebnf-yac-sequence ()
+  (let (ebnf-yac-error token seq factor)
+    (while (setq token  (ebnf-yac-lex)
+		 factor (ebnf-yac-factor token))
+      (setq seq (cons factor seq)))
+    (cons token
+	  (cond
+	   ;; ignore error recovery
+	   ((and ebnf-yac-ignore-error-recovery ebnf-yac-error)
+	    nil)
+	   ;; null sequence
+	   ((null seq)
+	    (ebnf-make-empty))
+	   ;; sequence with only one element
+	   ((= (length seq) 1)
+	    (car seq))
+	   ;; a real sequence
+	   (t
+	    (ebnf-make-sequence (nreverse seq)))
+	   ))))
+
+
+;;; Factor = Name
+;;;        | "'" "character" "'"
+;;;        | "error"
+;;;        | "{" "C like commands" "}"
+;;;        .
+
+(defun ebnf-yac-factor (token)
+  (cond
+   ;; 'character'
+   ((eq token 'terminal)
+    (ebnf-make-terminal ebnf-yac-lex))
+   ;; Name
+   ((eq token 'non-terminal)
+    (ebnf-make-non-terminal ebnf-yac-lex))
+   ;; "error"
+   ((eq token 'yac-error)
+    (ebnf-make-special ebnf-yac-lex))
+   ;; not a factor
+   (t
+    nil)
+   ))
+
+
+;;; Name-List = { Name || "," }*.
+
+(defun ebnf-yac-name-list (token)
+  (let (names)
+    (when (eq token 'non-terminal)
+      (while (progn
+	       (setq names (cons ebnf-yac-lex names)
+		     token (ebnf-yac-lex))
+	       (eq token 'comma))
+	(or (eq (ebnf-yac-lex) 'non-terminal)
+	    (error "Missing token name."))))
+    (cons token names)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Lexical analyzer
+
+
+;;; Name = "[A-Za-z][A-Za-z0-9_.]*".
+;;;
+;;; Comment = "/*" "any character, but the sequence \"*/\"" "*/"
+;;;         | "//" "any character" "\\n".
+
+(defconst ebnf-yac-token-table
+  ;; control character & 8-bit character are set to `error'
+  (let ((table (make-vector 256 'error)))
+    ;; upper & lower case letters:
+    (mapcar
+     #'(lambda (char)
+	 (aset table char 'non-terminal))
+     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz")
+    ;; printable characters:
+    (mapcar
+     #'(lambda (char)
+	 (aset table char 'character))
+     "!#$&()*+-.0123456789=?@[\\]^_`~")
+    ;; Override space characters:
+    (aset table ?\n 'space)		; [NL] linefeed
+    (aset table ?\r 'space)		; [CR] carriage return
+    (aset table ?\t 'space)		; [HT] horizontal tab
+    (aset table ?\  'space)		; [SP] space
+    ;; Override form feed character:
+    (aset table ?\f 'form-feed)		; [FF] form feed
+    ;; Override other lexical characters:
+    (aset table ?<  'open-angle)
+    (aset table ?>  'close-angle)
+    (aset table ?,  'comma)
+    (aset table ?%  'yac-pragma)
+    (aset table ?/  'slash)
+    (aset table ?\{ 'yac-code)
+    (aset table ?\" 'string)
+    (aset table ?\' 'terminal)
+    (aset table ?:  'colon)
+    (aset table ?|  'alternative)
+    (aset table ?\; 'period)
+    table)
+  "Vector used to map characters to a lexical token.")
+
+
+(defun ebnf-yac-initialize ()
+  "Initializations for Yacc/Bison parser."
+  (setq ebnf-yac-token-list nil))
+
+
+(defun ebnf-yac-lex ()
+  "Lexical analyser for Yacc/Bison.
+
+Return a lexical token.
+
+See documentation for variable `ebnf-yac-lex'."
+  (if (>= (point) ebnf-limit)
+      'end-of-input
+    (let (token)
+      ;; skip spaces, code blocks and comments
+      (while (if (> (following-char) 255)
+		 (progn
+		   (setq token 'error)
+		   nil)
+	       (setq token (aref ebnf-yac-token-table (following-char)))
+	       (cond
+		((or (eq token 'space)
+		     (and ebnf-yac-skip-char
+			  (eq token 'character)))
+		 (ebnf-yac-skip-spaces))
+		((eq token 'yac-code)
+		 (ebnf-yac-skip-code))
+		((eq token 'slash)
+		 (ebnf-yac-handle-comment))
+		((eq token 'form-feed)
+		 (forward-char)
+		 (setq ebnf-action 'form-feed))
+		(t nil)
+		)))
+      (cond
+       ;; end of input
+       ((>= (point) ebnf-limit)
+	'end-of-input)
+       ;; error
+       ((eq token 'error)
+	(error "Illegal character."))
+       ;; "string"
+       ((eq token 'string)
+	(setq ebnf-yac-lex (ebnf-get-string))
+	'string)
+       ;; terminal: 'char'
+       ((eq token 'terminal)
+	(setq ebnf-yac-lex (ebnf-string " -&(-~" ?\' "terminal"))
+	'terminal)
+       ;; non-terminal, terminal or "error"
+       ((eq token 'non-terminal)
+	(setq ebnf-yac-lex (ebnf-buffer-substring "0-9A-Za-z_."))
+	(cond ((member ebnf-yac-lex ebnf-yac-token-list)
+	       'terminal)
+	      ((string= ebnf-yac-lex "error")
+	       (setq ebnf-yac-error t)
+	       'yac-error)
+	      (t
+	       'non-terminal)
+	      ))
+       ;; %% and Yacc pragmas (%TOKEN, %START, etc).
+       ((eq token 'yac-pragma)
+	(forward-char)
+	(cond
+	 ;; Yacc separator
+	 ((eq (following-char) ?%)
+	  (forward-char)
+	  'yac-separator)
+	 ;; %TOKEN
+	 ((string= (upcase (ebnf-buffer-substring "0-9A-Za-z_")) "TOKEN")
+	  'yac-token)
+	 ;; other Yacc pragmas
+	 (t
+	  'yac-pragma)
+	 ))
+       ;; miscellaneous
+       (t
+	(forward-char)
+	token)
+       ))))
+
+
+(defun ebnf-yac-skip-spaces ()
+  (skip-chars-forward
+   (if ebnf-yac-skip-char
+       "\n\r\t !#$&()*+-.0123456789=?@[\\\\]^_`~"
+     "\n\r\t ")
+   ebnf-limit)
+  (< (point) ebnf-limit))
+
+
+(defun ebnf-yac-skip-code ()
+  (forward-char)
+  (let ((pair 1))
+    (while (> pair 0)
+      (skip-chars-forward "^{}/'\"\000-\010\013\016-\037\177-\377" ebnf-limit)
+      (cond
+       ((= (following-char) ?{)
+	(forward-char)
+	(setq pair (1+ pair)))
+       ((= (following-char) ?})
+	(forward-char)
+	(setq pair (1- pair)))
+       ((= (following-char) ?/)
+	(ebnf-yac-handle-comment))
+       ((= (following-char) ?\")
+	(ebnf-get-string))
+       ((= (following-char) ?\')
+	(ebnf-string " -&(-~" ?\' "character"))
+       (t
+	(error "Illegal character."))
+       )))
+  (ebnf-yac-skip-spaces))
+
+
+(defun ebnf-yac-handle-comment ()
+  (forward-char)
+  (cond
+   ;; begin comment
+   ((= (following-char) ?*)
+    (ebnf-yac-skip-comment)
+    (ebnf-yac-skip-spaces))
+   ;; line comment
+   ((= (following-char) ?/)
+    (end-of-line)
+    (ebnf-yac-skip-spaces))
+   ;; no comment
+   (t nil)
+   ))
+
+
+(defconst ebnf-yac-comment-chars "^*\000-\010\013\016-\037\177-\237")
+
+
+(defun ebnf-yac-skip-comment ()
+  (forward-char)
+  (cond
+   ;; open EPS file
+   ((and ebnf-eps-executing (= (following-char) ?\[))
+    (ebnf-eps-add-context (ebnf-yac-eps-filename)))
+   ;; close EPS file
+   ((and ebnf-eps-executing (= (following-char) ?\]))
+    (ebnf-eps-remove-context (ebnf-yac-eps-filename)))
+   ;; any other action in comment
+   (t
+    (setq ebnf-action (aref ebnf-comment-table (following-char))))
+   )
+  (let ((not-end t))
+    (while not-end
+      (skip-chars-forward ebnf-yac-comment-chars ebnf-limit)
+      (cond ((>= (point) ebnf-limit)
+	     (error "Missing end of comment: `*/'."))
+	    ((= (following-char) ?*)
+	     (skip-chars-forward "*" ebnf-limit)
+	     (when (= (following-char) ?/)
+	       ;; end of comment
+	       (forward-char)
+	       (setq not-end nil)))
+	    (t
+	     (error "Illegal character."))
+	    ))))
+
+
+(defun ebnf-yac-eps-filename ()
+  (forward-char)
+  (buffer-substring-no-properties
+   (point)
+   (let ((chars (concat ebnf-yac-comment-chars "\n"))
+	 found)
+     (while (not found)
+       (skip-chars-forward chars ebnf-limit)
+       (setq found
+	     (cond ((>= (point) ebnf-limit)
+		    (point))
+		   ((= (following-char) ?*)
+		    (skip-chars-forward "*" ebnf-limit)
+		    (if (/= (following-char) ?\/)
+			nil
+		      (backward-char)
+		      (point)))
+		   (t
+		    (point))
+		   )))
+     found)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(provide 'ebnf-yac)
+
+
+;;; ebnf-yac.el ends here