*** empty log message ***

6 files changed, 7683 insertions, 0 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 44e8ad862db..7be61485f1b 100644
--- a/lisp/ChangeLog
+++ b/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
diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el
new file mode 100644
index 00000000000..c8e1d0df693
--- /dev/null
+++ b/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
diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el
new file mode 100644
index 00000000000..2008685a788
--- /dev/null
+++ b/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
diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el
new file mode 100644
index 00000000000..5af9ef6925c
--- /dev/null
+++ b/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
diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el
new file mode 100644
index 00000000000..bbe135e45ec
--- /dev/null
+++ b/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
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
new file mode 100644
index 00000000000..477dbd9d386
--- /dev/null
+++ b/lisp/progmodes/ebnf2ps.el
@@ -0,0 +1,5339 @@
+;;; ebnf2ps --- Translate an EBNF to a syntatic chart on PostScript
+
+;; 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/12/11 21:41:24 vinicius>
+;; Version:    3.1
+
+(defconst ebnf-version "3.1"
+  "ebnf2ps.el, v 3.1 <99/12/11 vinicius>
+
+Vinicius's last change version.  When reporting bugs, please also
+report the version of Emacs, if any, that ebnf2ps was running with.
+
+Please send all bug fixes and enhancements to
+        Vinicius Jose Latorre <vinicius@cpqd.com.br>.
+")
+
+;; 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:
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Introduction
+;; ------------
+;;
+;; This package translates an EBNF to a syntatic chart on PostScript.
+;;
+;; To use ebnf2ps, insert in your ~/.emacs:
+;;
+;;        (require 'ebnf2ps)
+;;
+;; ebnf2ps uses ps-print package (version 3.05.1 or later), so see ps-print to
+;; know how to set options like landscape printing, page headings, margins, etc.
+;;
+;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
+;;       ebnf2ps, they behave as it's turned off.
+;;
+;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
+;;
+;;    M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
+;;
+;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
+;;
+;; ebnf2ps was tested with GNU Emacs 20.4.1.
+;;
+;;
+;; Using ebnf2ps
+;; -------------
+;;
+;; ebnf2ps provides six commands for generating PostScript syntatic chart images
+;; of Emacs buffers:
+;;
+;;        ebnf-print-buffer
+;;        ebnf-print-region
+;;        ebnf-spool-buffer
+;;        ebnf-spool-region
+;;        ebnf-eps-buffer
+;;        ebnf-eps-region
+;;
+;; These commands all perform essentially the same function: they generate
+;; PostScript syntatic chart images suitable for printing on a PostScript
+;; printer or displaying with GhostScript.  These commands are collectively
+;; referred to as "ebnf- commands".
+;;
+;; The word "print", "spool" and "eps" in the command name determines when the
+;; PostScript image is sent to the printer (or file):
+;;
+;;        print  - The PostScript image is immediately sent to the printer;
+;;
+;;        spool  - The PostScript image is saved temporarily in an Emacs buffer.
+;;                 Many images may be spooled locally before printing them.  To
+;;                 send the spooled images to the printer, use the command
+;;                 `ebnf-despool'.
+;;
+;;        eps    - The PostScript image is immediately sent to a EPS file.
+;;
+;; The spooling mechanism is the same as used by ps-print and was designed for
+;; printing lots of small files to save paper that would otherwise be wasted on
+;; banner pages, and to make it easier to find your output at the printer (it's
+;; easier to pick up one 50-page printout than to find 50 single-page
+;; printouts).  As ebnf2ps and ps-print use the same Emacs buffer to spool
+;; images, you can intermix the spooling of ebnf2ps and ps-print images.
+;;
+;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
+;; won't accidentally quit from Emacs while you have unprinted PostScript
+;; waiting in the spool buffer.  If you do attempt to exit with spooled
+;; PostScript, you'll be asked if you want to print it, and if you decline,
+;; you'll be asked to confirm the exit; this is modeled on the confirmation that
+;; Emacs uses for modified buffers.
+;;
+;; The word "buffer" or "region" in the command name determines how much of the
+;; buffer is printed:
+;;
+;;        buffer  - Print the entire buffer.
+;;
+;;        region  - Print just the current region.
+;;
+;; Two ebnf- command examples:
+;;
+;;        ebnf-print-buffer  - translate and print the entire buffer, and send
+;;                             it immediately to the printer.
+;;
+;;        ebnf-spool-region  - translate and print just the current region, and
+;;                             spool the image in Emacs to send to the printer
+;;                             later.
+;;
+;; Note that `ebnf-eps-buffer' and `ebnf-eps-region' never spool the EPS image,
+;; so they don't use the ps-print spooling mechanism.  See section "Actions in
+;; Comments" for an explanation about EPS file generation.
+;;
+;;
+;; Invoking Ebnf2ps
+;; ----------------
+;;
+;; To translate and print your buffer, type
+;;
+;;        M-x ebnf-print-buffer
+;;
+;; or substitute one of the other four ebnf- commands.  The command will
+;; generate the PostScript image and print or spool it as specified.  By giving
+;; the command a prefix argument
+;;
+;;        C-u M-x ebnf-print-buffer
+;;
+;; it will save the PostScript image to a file instead of sending it to the
+;; printer; you will be prompted for the name of the file to save the image to.
+;; The prefix argument is ignored by the commands that spool their images, but
+;; you may save the spooled images to a file by giving a prefix argument to
+;; `ebnf-despool':
+;;
+;;        C-u M-x ebnf-despool
+;;
+;; When invoked this way, `ebnf-despool' will prompt you for the name of the
+;; file to save to.
+;;
+;; The prefix argument is also ignored by `ebnf-eps-buffer' and
+;; `ebnf-eps-region'.
+;;
+;; Any of the `ebnf-' commands can be bound to keys.  Here are some examples:
+;;
+;;   (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
+;;   (global-set-key '(shift f22) 'ebnf-print-region)
+;;   (global-set-key '(control f22) 'ebnf-despool)
+;;
+;;
+;; 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 (see text below)
+;;    $"C"              default terminal (see text below)
+;;    $?C?              default special (see text below)
+;;    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".
+;;
+;; Try to use the above EBNF to test ebnf2ps.
+;;
+;; The `default' terminal, non-terminal and special is a way to indicate a
+;; default path in a production.  For example, the production:
+;;
+;;    X = [ $A ( B | $C ) | D ].
+;;
+;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
+;;
+;; The terminal name is controlled by `ebnf-terminal-regexp' and
+;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
+;; name besides that enclosed by `"'.
+;;
+;; Let's see an example:
+;;
+;;    (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
+;;    (setq ebnf-case-fold-search nil) ; exact matching
+;;
+;; If you have the production:
+;;
+;;    Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
+;;
+;; The names are classified as:
+;;
+;;    Logical  Expression               non-terminal
+;;    "("  OR  AND  "XOR"  ")"          terminal
+;;
+;; The line comment is controlled by `ebnf-lex-comment-char'.  The default value
+;; is ?\; (character `;').
+;;
+;; The end of production is controlled by `ebnf-lex-eop-char'.  The default
+;; value is ?. (character `.').
+;;
+;; The variable `ebnf-syntax' specifies which syntax to recognize:
+;;
+;;    `ebnf'            ebnf2ps recognizes the syntax described above.
+;;                      The following variables *ONLY* have effect with this
+;;                      setting:
+;;                      `ebnf-terminal-regexp', `ebnf-case-fold-search',
+;;                      `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
+;;
+;;    `iso-ebnf'        ebnf2ps recognizes the syntax described in the URL:
+;;                      `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
+;;                      ("International Standard of the ISO EBNF Notation").
+;;                      The following variables *ONLY* have effect with this
+;;                      setting:
+;;                      `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
+;;
+;;    `yacc'            ebnf2ps recognizes the Yacc/Bison syntax.
+;;                      The following variable *ONLY* has effect with this
+;;                      setting:
+;;                      `ebnf-yac-ignore-error-recovery'.
+;;
+;; Any other value is treated as `ebnf'.
+;;
+;; The default value is `ebnf'.
+;;
+;;
+;; Optimizations
+;; -------------
+;;
+;; The following EBNF optimizations are done:
+;;
+;;    [ { A }* ]          ==> { A }*
+;;    [ { A }+ ]          ==> { A }*
+;;    [ A ] +             ==> { A }*
+;;    { A }* +            ==> { A }*
+;;    { A }+ +            ==> { A }+
+;;    { A }-              ==> { A }+
+;;    [ A ]-              ==> A
+;;    ( A | EMPTY )-      ==> A
+;;    ( A | B | EMPTY )-  ==> A | B
+;;    [ A | B ]           ==> A | B | EMPTY
+;;    n * EMPTY           ==> EMPTY
+;;    EMPTY +             ==> EMPTY
+;;    EMPTY / EMPTY       ==> EMPTY
+;;    EMPTY - A           ==> EMPTY
+;;
+;; The following optimizations are done when `ebnf-optimize' is non-nil:
+;;
+;; 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.
+;;
+;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
+;;
+;;
+;; Form Feed
+;; ---------
+;;
+;; You may use form feed (^L \014) to force a production to start on a new page,
+;; for example:
+;;
+;;    a) A = B | C.
+;;       ^L
+;;       X = Y | Z.
+;;
+;;    b) A = B ^L | C.
+;;       X = Y | Z.
+;;
+;;    c) A = B ^L^L^L | C.^L
+;;       ^L
+;;       X = Y | Z.
+;;
+;; In all examples above, only the production X will start on a new page.
+;;
+;;
+;; Actions in Comments
+;; -------------------
+;;
+;; ebnf2ps accepts the following actions in comments:
+;;
+;;    ;>        the next production starts in the same line as the current one.
+;;              It is useful when `ebnf-horizontal-orientation' is nil.
+;;
+;;    ;<        the next production starts in the next line.
+;;              It is useful when `ebnf-horizontal-orientation' is non-nil.
+;;
+;;    ;[EPS     open a new EPS file.  The EPS file name has the form:
+;;                      <PREFIX><NAME>.eps
+;;              where <PREFIX> is given by variable `ebnf-eps-prefix' and <NAME>
+;;              is the string given by ;[ action comment, this string is mapped
+;;              to form a valid file name (see documentation for
+;;              `ebnf-eps-buffer' or `ebnf-eps-region').
+;;              It has effect only during `ebnf-eps-buffer' or
+;;              `ebnf-eps-region' execution.
+;;              It's an error to try to open an already opened EPS file.
+;;
+;;    ;]EPS     close an opened EPS file.
+;;              It has effect only during `ebnf-eps-buffer' or
+;;              `ebnf-eps-region' execution.
+;;              It's an error to try to close a not opened EPS file.
+;;
+;; So if you have:
+;;
+;;    (setq ebnf-horizontal-orientation nil)
+;;
+;;    A = t.
+;;    C = x.
+;;    ;> C and B are drawn in the same line
+;;    B = y.
+;;    W = v.
+;;
+;; The graphical result is:
+;;
+;;    +---+
+;;    | A |
+;;    +---+
+;;
+;;    +---------+   +-----+
+;;    |         |   |     |
+;;    |    C    |   |     |
+;;    |         |   |  B  |
+;;    +---------+   |     |
+;;                  |     |
+;;                  +-----+
+;;
+;;    +-----------+
+;;    |     W     |
+;;    +-----------+
+;;
+;; Note that if ascending production sort is used, the productions A and B will
+;; be drawn in the same line instead of C and B.
+;;
+;; If consecutive actions occur, only the last one takes effect, so if you have:
+;;
+;;    A = X.
+;;    ;<
+;;    ^L
+;;    ;>
+;;    B = Y.
+;;
+;; Only the ;> will take effect, that is, A and B will be drawn in the same
+;; line.
+;;
+;; In ISO EBNF the above actions are specified as (*>*), (*<*), (*[EPS*) and
+;; (*]EPS*).  The first example above should be written:
+;;
+;;    A = t;
+;;    C = x;
+;;    (*> C and B are drawn in the same line *)
+;;    B = y;
+;;    W = v;
+;;
+;; For an example of EPS action when executing `ebnf-eps-buffer' or
+;; `ebnf-eps-region':
+;;
+;;    Z = B0.
+;;    ;[CC
+;;    ;[AA
+;;    A = B1.
+;;    ;[BB
+;;    C = B2.
+;;    ;]AA
+;;    B = B3.
+;;    ;]BB
+;;    ;]CC
+;;    D = B4.
+;;    E = B5.
+;;    ;[CC
+;;    F = B6.
+;;    ;]CC
+;;    G = B7.
+;;
+;; The following table summarizes the results:
+;;
+;; EPS FILE NAME    NO SORT    ASCENDING SORT    DESCENDING SORT
+;; ebnf--AA.eps     A C        A C               C A
+;; ebnf--BB.eps     C B        B C               C B
+;; ebnf--CC.eps     A C B F    A B C F           F C B A
+;; ebnf--D.eps      D          D                 D
+;; ebnf--E.eps      E          E                 E
+;; ebnf--G.eps      G          G                 G
+;; ebnf--Z.eps      Z          Z                 Z
+;;
+;; As you can see if EPS actions is not used, each single production is
+;; generated per EPS file.  To avoid overriding EPS files, use names in ;[ that
+;; it's not an existing production name.
+;;
+;; In the following case:
+;;
+;;    A = B0.
+;;    ;[AA
+;;    A = B1.
+;;    ;[BB
+;;    A = B2.
+;;
+;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
+;;
+;;
+;; Utilities
+;; ---------
+;;
+;; Some tools are provided to help you.
+;;
+;; `ebnf-setup' returns the current setup.
+;;
+;; `ebnf-syntax-buffer' does a syntatic analysis of your EBNF in the current
+;; buffer.
+;;
+;; `ebnf-syntax-region' does a syntatic analysis of your EBNF in the current
+;; region.
+;;
+;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
+;;
+;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound
+;; to keys in the same way as `ebnf-' commands.
+;;
+;;
+;; Hooks
+;; -----
+;;
+;; ebn2ps has the following hook variables:
+;;
+;; `ebnf-hook'
+;;    It is evaluated once before any ebnf2ps process.
+;;
+;; `ebnf-production-hook'
+;;    It is evaluated on each beginning of production.
+;;
+;; `ebnf-page-hook'
+;;    It is evaluated on each beginning of page.
+;;
+;;
+;; Options
+;; -------
+;;
+;; Below it's shown a brief description of ebnf2ps options, please, see the
+;; options declaration in the code for a long documentation.
+;;
+;; `ebnf-horizontal-orientation'        Non-nil means productions are drawn
+;;                                      horizontally.
+;;
+;; `ebnf-horizontal-max-height'         Non-nil means to use maximum production
+;;                                      height in horizontal orientation.
+;;
+;; `ebnf-production-horizontal-space'   Specify horizontal space in points
+;;                                      between productions.
+;;
+;; `ebnf-production-vertical-space'     Specify vertical space in points between
+;;                                      productions.
+;;
+;; `ebnf-justify-sequence'              Specify justification of terms in a
+;;                                      sequence inside alternatives.
+;;
+;; `ebnf-terminal-regexp'               Specify how it's a terminal name.
+;;
+;; `ebnf-case-fold-search'              Non-nil means ignore case on matching.
+;;
+;; `ebnf-terminal-font'                 Specify terminal font.
+;;
+;; `ebnf-terminal-shape'                Specify terminal box shape.
+;;
+;; `ebnf-terminal-shadow'               Non-nil means terminal box will have a
+;;                                      shadow.
+;;
+;; `ebnf-terminal-border-width'         Specify border width for terminal box.
+;;
+;; `ebnf-terminal-border-color'         Specify border color for terminal box.
+;;
+;; `ebnf-sort-production'               Specify how productions are sorted.
+;;
+;; `ebnf-production-font'               Specify production font.
+;;
+;; `ebnf-non-terminal-font'             Specify non-terminal font.
+;;
+;; `ebnf-non-terminal-shape'            Specify non-terminal box shape.
+;;
+;; `ebnf-non-terminal-shadow'           Non-nil means non-terminal box will have
+;;                                      a shadow.
+;;
+;; `ebnf-non-terminal-border-width'     Specify border width for non-terminal
+;;                                      box.
+;;
+;; `ebnf-non-terminal-border-color'     Specify border color for non-terminal
+;;                                      box.
+;;
+;; `ebnf-special-font'                  Specify special font.
+;;
+;; `ebnf-special-shape'                 Specify special box shape.
+;;
+;; `ebnf-special-shadow'                Non-nil means special box will have a
+;;                                      shadow.
+;;
+;; `ebnf-special-border-width'          Specify border width for special box.
+;;
+;; `ebnf-special-border-color'          Specify border color for special box.
+;;
+;; `ebnf-except-font'                   Specify except font.
+;;
+;; `ebnf-except-shape'                  Specify except box shape.
+;;
+;; `ebnf-except-shadow'                 Non-nil means except box will have a
+;;                                      shadow.
+;;
+;; `ebnf-except-border-width'           Specify border width for except box.
+;;
+;; `ebnf-except-border-color'           Specify border color for except box.
+;;
+;; `ebnf-repeat-font'                   Specify repeat font.
+;;
+;; `ebnf-repeat-shape'                  Specify repeat box shape.
+;;
+;; `ebnf-repeat-shadow'                 Non-nil means repeat box will have a
+;;                                      shadow.
+;;
+;; `ebnf-repeat-border-width'           Specify border width for repeat box.
+;;
+;; `ebnf-repeat-border-color'           Specify border color for repeat box.
+;;
+;; `ebnf-entry-percentage'              Specify entry height on alternatives.
+;;
+;; `ebnf-arrow-shape'                   Specify the arrow shape.
+;;
+;; `ebnf-chart-shape'                   Specify chart flow shape.
+;;
+;; `ebnf-color-p'                       Non-nil means use color.
+;;
+;; `ebnf-line-width'                    Specify flow line width.
+;;
+;; `ebnf-line-color'                    Specify flow line color.
+;;
+;; `ebnf-user-arrow'                    Specify a user arrow shape (a PostScript
+;;                                      code).
+;;
+;; `ebnf-debug-ps'                      Non-nil means to generate PostScript
+;;                                      debug procedures.
+;;
+;; `ebnf-lex-comment-char'              Specify the line comment character.
+;;
+;; `ebnf-lex-eop-char'                  Specify the end of production character.
+;;
+;; `ebnf-syntax'                        Specify syntax to be recognized.
+;;
+;; `ebnf-iso-alternative-p'             Non-nil means use alternative ISO EBNF.
+;;
+;; `ebnf-iso-normalize-p'               Non-nil means normalize ISO EBNF syntax
+;;                                      names.
+;;
+;; `ebnf-default-width'                 Specify additional border width over
+;;                                      default terminal, non-terminal or
+;;                                      special.
+;;
+;; `ebnf-eps-prefix'                    Specify EPS prefix file name.
+;;
+;; `ebnf-use-float-format'              Non-nil means use `%f' float format.
+;;
+;; `ebnf-yac-ignore-error-recovery'     Non-nil means ignore error recovery.
+;;
+;; `ebnf-ignore-empty-rule'             Non-nil means ignore empty rules.
+;;
+;; `ebnf-optimize'                      Non-nil means optimize syntatic chart of
+;;                                      rules.
+;;
+;; To set the above options you may:
+;;
+;; a) insert the code in your ~/.emacs, like:
+;;
+;;       (setq ebnf-terminal-shape 'bevel)
+;;
+;;    This way always keep your default settings when you enter a new Emacs
+;;    session.
+;;
+;; b) or use `set-variable' in your Emacs session, like:
+;;
+;;       M-x set-variable RET ebnf-terminal-shape RET bevel RET
+;;
+;;    This way keep your settings only during the current Emacs session.
+;;
+;; c) or use customization, for example:
+;;       click on menu-bar *Help* option,
+;;       then click on *Customize*,
+;;       then click on *Browse Customization Groups*,
+;;       expand *PostScript* group,
+;;       expand *Ebnf2ps* group
+;;       and then customize ebnf2ps options.
+;;    Through this way, you may choose if the settings are kept or not when
+;;    you leave out the current Emacs session.
+;;
+;; d) or see the option value:
+;;
+;;       C-h v ebnf-terminal-shape RET
+;;
+;;    and click the *customize* hypertext button.
+;;    Through this way, you may choose if the settings are kept or not when
+;;    you leave out the current Emacs session.
+;;
+;; e) or invoke:
+;;
+;;       M-x ebnf-customize RET
+;;
+;;    and then customize ebnf2ps options.
+;;    Through this way, you may choose if the settings are kept or not when
+;;    you leave out the current Emacs session.
+;;
+;;
+;; Styles
+;; ------
+;;
+;; Sometimes you need to change the EBNF style you are using, for example,
+;; change the shapes and colors.  These changes may force you to set some
+;; variables and after use, set back the variables to the old values.
+;;
+;; To help to handle this situation, ebnf2ps has the following commands to
+;; handle styles:
+;;
+;; `ebnf-insert-style'  Insert a new style NAME with inheritance INHERITS and
+;;                      values VALUES.
+;;
+;; `ebnf-merge-style'   Merge values of style NAME with style VALUES.
+;;
+;; `ebnf-apply-style'   Set STYLE to current style.
+;;
+;; `ebnf-reset-style'   Reset current style.
+;;
+;; `ebnf-push-style'    Push the current style and set STYLE to current style.
+;;
+;; `ebnf-pop-style'     Pop a style and set it to current style.
+;;
+;; These commands helps to put together a lot of variable settings in a group
+;; and name this group.  So when you wish to apply these settings it's only
+;; needed to give the name.
+;;
+;; There is also a notion of simple inheritance of style; so if you declare that
+;; a style A inherits from a style B, all settings of B is applied first and
+;; then the settings of A is applied.  This is useful when you wish to modify
+;; some aspects of an existing style, but at same time wish to keep it
+;; unmodified.
+;;
+;; See documentation for `ebnf-style-database'.
+;;
+;;
+;; Layout
+;; ------
+;;
+;; Below it is the layout of minimum area to draw each element, and it's used
+;; the following terms:
+;;
+;;    font height       is given by:
+;;                      (terminal font height + non-terminal font height) / 2
+;;
+;;    entry             is the vertical position used to know where it should be
+;;                      drawn the flow line in the current element.
+;;
+;;
+;;    * SPECIAL, TERMINAL and NON-TERMINAL
+;;
+;;           +==============+...................................
+;;           |              |      } font height / 2  } entry  }
+;;           |   XXXXXXXX...|.......                  }        }
+;;       ====+   XXXXXXXX   +====  } text height ......        } height
+;;       :   |   XXXXXXXX...|...:...                           }
+;;       :   |   :      :   |   :  } font height / 2           }
+;;       :   +==============+...:...............................
+;;       :   :   :      :   :   :
+;;       :   :   :      :   :   :......................
+;;       :   :   :      :   :      } font height      }
+;;       :   :   :      :   :.......                  }
+;;       :   :   :      :          } font height / 2  }
+;;       :   :   :      :...........                  }
+;;       :   :   :                 } text width       } width
+;;       :   :   :..................                  }
+;;       :   :                     } font height / 2  }
+;;       :   :......................                  }
+;;       :                         } font height      }
+;;       :.............................................
+;;
+;;
+;;    * OPTIONAL
+;;
+;;              +==========+.....................................
+;;              |          |         }        }                 }
+;;              |          |         } entry  }                 }
+;;              |          |         }        }                 }
+;;       ===+===+          +===+===...        } element height  } height
+;;       :   \  |          |  /   :           }                 }
+;;       :    + |          | +    :           }                 }
+;;       :    | +==========+.|.................                 }
+;;       :    | :          : |    :           } font height     }
+;;       :    +==============+...................................
+;;       :      :          :      :
+;;       :      :          :      :......................
+;;       :      :          :         } font height * 2  }
+;;       :      :          :..........                  }
+;;       :      :                    } element width    } width
+;;       :      :.....................                  }
+;;       :                           } font height * 2  }
+;;       :...............................................
+;;
+;;
+;;    * ALTERNATIVE
+;;
+;;               +===+...................................
+;;            +==+ A +==+       } A height     }        }
+;;            |  +===+..|........              } entry  }
+;;            +         +       } font height  }        }
+;;           /   +===+...\.......              }        }
+;;       ===+====+ B +====+===  } B height .....        } height
+;;       :   \   +===+.../.......                       }
+;;       :    +         +    :  } font height           }
+;;       :    |  +===+..|........                       }
+;;       :    +==+ C +==+    :  } C height              }
+;;       :     : +===+...................................
+;;       :     :       :     :
+;;       :     :       :     :......................
+;;       :     :       :        } font height * 2  }
+;;       :     :       :.........                  }
+;;       :     :                } max width        } width
+;;       :     :.................                  }
+;;       :                      } font height * 2  }
+;;       :..........................................
+;;
+;;       NOTES:
+;;          1. An empty alternative has zero of height.
+;;
+;;          2. The variable `ebnf-entry-percentage' is used to determine the
+;;             entry point.
+;;
+;;
+;;    * ZERO OR MORE
+;;
+;;               +===========+...............................
+;;             +=+ separator +=+        } separator height  }
+;;            /  +===========+..\........                   }
+;;           +                   +      }                   }
+;;           |                   |      } font height       }
+;;           +                   +      }                   }
+;;            \  +===========+../........                   } height = entry
+;;             +=+ element   +=+        } element height    }
+;;            /: +===========+..\........                   }
+;;           + :               : +      }                   }
+;;           + :               : +      } font height       }
+;;          /  :               :  \     }                   }
+;;       ==+=======================+==.......................
+;;       :     :               :     :
+;;       :     :               :     :.......................
+;;       :     :               :        } font height * 2   }
+;;       :     :               :.........                   }
+;;       :     :                        } max width         } width
+;;       :     :.........................                   }
+;;       :                              } font height * 2   }
+;;       :...................................................
+;;
+;;
+;;    * ONE OR MORE
+;;
+;;            +===========+......................................
+;;          +=+ separator +=+      } separator height  }        }
+;;         /  +===========+..\......                   }        }
+;;        +                   +    }                   } entry  }
+;;        |                   |    } font height       }        } height
+;;        +                   +    }                   }        }
+;;         \  +===========+../......                   }        }
+;;       ===+=+ element   +=+===   } element height ....        }
+;;       :  : +===========+......................................
+;;       :  :               :  :
+;;       :  :               :  :........................
+;;       :  :               :      } font height * 2   }
+;;       :  :               :.......                   }
+;;       :  :                      } max width         } width
+;;       :  :.......................                   }
+;;       :                         } font height * 2   }
+;;       :..............................................
+;;
+;;
+;;    * PRODUCTION
+;;
+;;       XXXXXX:......................................
+;;       XXXXXX:           } production font height  }
+;;       XXXXXX:............                         }
+;;                         } font height             }
+;;           +======+.......                         } height = entry
+;;           |      |      }                         }
+;;       ====+      +====  } element height          }
+;;       :   |      |   :  }                         }
+;;       :   +======+.................................
+;;       :   :      :   :
+;;       :   :      :   :......................
+;;       :   :      :      } font height * 2  }
+;;       :   :      :.......                  }
+;;       :   :             } element width    } width
+;;       :   :..............                  }
+;;       :                 } font height * 2  }
+;;       :.....................................
+;;
+;;
+;;    * REPEAT
+;;
+;;           +================+...................................
+;;           |                |      } font height / 2  } entry  }
+;;           |        +===+...|.......                  }        }
+;;       ====+  N *   | X |   +====  } X height .........        } height
+;;       :   |  :  :  +===+...|...:...                           }
+;;       :   |  :  :  :   :   |   :  } font height / 2           }
+;;       :   +================+...:...............................
+;;       :   :  :  :  :   :   :   :
+;;       :   :  :  :  :   :   :   :......................
+;;       :   :  :  :  :   :   :      } font height      }
+;;       :   :  :  :  :   :   :.......                  }
+;;       :   :  :  :  :   :          } font height / 2  }
+;;       :   :  :  :  :   :...........                  }
+;;       :   :  :  :  :              } X width          }
+;;       :   :  :  :  :...............                  }
+;;       :   :  :  :                 } font height / 2  } width
+;;       :   :  :  :..................                  }
+;;       :   :  :                    } text width       }
+;;       :   :  :.....................                  }
+;;       :   :                       } font height / 2  }
+;;       :   :........................                  }
+;;       :                           } font height      }
+;;       :...............................................
+;;
+;;
+;;    * EXCEPT
+;;
+;;           +==================+...................................
+;;           |                  |      } font height / 2  } entry  }
+;;           |  +===+   +===+...|.......                  }        }
+;;       ====+  | X | - | y |   +====  } max height .......        } height
+;;       :   |  +===+   +===+...|...:...                           }
+;;       :   |  :   :   :   :   |   :  } font height / 2           }
+;;       :   +==================+...:...............................
+;;       :   :  :   :   :   :   :   :
+;;       :   :  :   :   :   :   :   :......................
+;;       :   :  :   :   :   :   :      } font height      }
+;;       :   :  :   :   :   :   :.......                  }
+;;       :   :  :   :   :   :          } font height / 2  }
+;;       :   :  :   :   :   :...........                  }
+;;       :   :  :   :   :              } Y width          }
+;;       :   :  :   :   :...............                  }
+;;       :   :  :   :                  } font height      } width
+;;       :   :  :   :...................                  }
+;;       :   :  :                      } X width          }
+;;       :   :  :.......................                  }
+;;       :   :                         } font height / 2  }
+;;       :   :..........................                  }
+;;       :                             } font height      }
+;;       :.................................................
+;;
+;;       NOTE: If Y element is empty, it's draw nothing at Y place.
+;;
+;;
+;; Internal Structures
+;; -------------------
+;;
+;; ebnf2ps has two passes.  The first pass does a lexical and syntatic analysis
+;; of current buffer and generates an intermediate representation.  The second
+;; pass uses the intermediate representation to generate the PostScript syntatic
+;; chart.
+;;
+;; The intermediate representation is a list of vectors, the vector element
+;; represents a syntatic chart element.  Below is a vector representation for
+;; each syntatic chart element.
+;;
+;; [production   WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME    PRODUCTION ACTION]
+;; [alternative  WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
+;; [sequence     WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
+;; [terminal     WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME    DEFAULT]
+;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME    DEFAULT]
+;; [special      WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME    DEFAULT]
+;; [empty        WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
+;; [optional     WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
+;; [one-or-more  WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
+;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
+;; [repeat       WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES   ELEMENT]
+;; [except       WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
+;;
+;; The first vector position is a function symbol used to generate PostScript
+;; for this element.
+;; WIDTH-FUN is a function symbol called to adjust the element width.
+;; DIM-FUN is a function symbol called to set the element dimensions.
+;; ENTRY is the element entry point.
+;; HEIGHT and WIDTH are the element height and width, respectively.
+;; NAME is a string that it's the element name.
+;; DEFAULT is a boolean that indicates if it's a `default' element.
+;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
+;; one.
+;; LIST is a list of vector that represents the list part for alternatives and
+;; sequences.
+;; SEPARATOR is a vector that represents the sub-element used to separate the
+;; list elements.
+;; TIMES is a string representing the number of times that ELEMENT is repeated
+;; on a repeat construction.
+;; ACTION indicates some action that should be done before production is
+;; generated.  The current actions are:
+;;
+;;    nil               no action.
+;;
+;;    form-feed         current production starts on a new page.
+;;
+;;    newline           current production starts on next line, this is useful
+;;                      when `ebnf-horizontal-orientation' is non-nil.
+;;
+;;    keep-line         current production continues on the current line, this
+;;                      is useful when `ebnf-horizontal-orientation' is nil.
+;;
+;;
+;; Things To Change
+;; ----------------
+;;
+;; . Handle situations when syntatic chart is out of paper.
+;; . Use other alphabet than ascii.
+;; . Optimizations...
+;;
+;;
+;; Acknowledgements
+;; ----------------
+;;
+;; Thanks to all who emailed comments.
+;;
+;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;; code:
+
+
+(require 'ps-print)
+
+(and (string< ps-print-version "3.05.1")
+     (error "`ebnf2ps' requires `ps-print' package version 3.05.1 or later"))
+
+
+;; temporary fix for ps-print
+(or (fboundp 'set-buffer-multibyte)
+    (defun set-buffer-multibyte (arg)
+      (setq enable-multibyte-characters arg)))
+
+(or (fboundp 'string-as-unibyte)
+    (defun string-as-unibyte (arg) arg))
+
+(or (fboundp 'string-as-multibyte)
+    (defun string-as-multibyte (arg) arg))
+
+(or (fboundp 'charset-after)
+    (defun charset-after (&optional arg)
+      (char-charset (char-after arg))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; User Variables:
+
+
+;;; Interface to the command system
+
+(defgroup postscript nil
+  "PostScript Group"
+  :tag "PostScript"
+  :group 'emacs)
+
+
+(defgroup ebnf2ps nil
+  "Translate an EBNF to a syntatic chart on PostScript"
+  :prefix "ebnf-"
+  :group 'wp
+  :group 'postscript)
+
+
+(defgroup ebnf-special nil
+  "Special customization"
+  :prefix "ebnf-"
+  :tag "Special"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-except nil
+  "Except customization"
+  :prefix "ebnf-"
+  :tag "Except"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-repeat nil
+  "Repeat customization"
+  :prefix "ebnf-"
+  :tag "Repeat"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-terminal nil
+  "Terminal customization"
+  :prefix "ebnf-"
+  :tag "Terminal"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-non-terminal nil
+  "Non-Terminal customization"
+  :prefix "ebnf-"
+  :tag "Non-Terminal"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-production nil
+  "Production customization"
+  :prefix "ebnf-"
+  :tag "Production"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-shape nil
+  "Shapes customization"
+  :prefix "ebnf-"
+  :tag "Shape"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-displacement nil
+  "Displacement customization"
+  :prefix "ebnf-"
+  :tag "Displacement"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-syntatic nil
+  "Syntatic customization"
+  :prefix "ebnf-"
+  :tag "Syntatic"
+  :group 'ebnf2ps)
+
+
+(defgroup ebnf-optimization nil
+  "Optimization customization"
+  :prefix "ebnf-"
+  :tag "Optimization"
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-horizontal-orientation nil
+  "*Non-nil means productions are drawn horizontally."
+  :type 'boolean
+  :group 'ebnf-displacement)
+
+
+(defcustom ebnf-horizontal-max-height nil
+  "*Non-nil means to use maximum production height in horizontal orientation.
+
+It is only used when `ebnf-horizontal-orientation' is non-nil."
+  :type 'boolean
+  :group 'ebnf-displacement)
+
+
+(defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
+  "*Specify horizontal space in points between productions.
+
+Value less or equal to zero forces ebnf2ps to set a proper default value."
+  :type 'number
+  :group 'ebnf-displacement)
+
+
+(defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
+  "*Specify vertical space in points between productions.
+
+Value less or equal to zero forces ebnf2ps to set a proper default value."
+  :type 'number
+  :group 'ebnf-displacement)
+
+
+(defcustom ebnf-justify-sequence 'center
+  "*Specify justification of terms in a sequence inside alternatives.
+
+Valid values are:
+
+   `left'               left justification
+   `right'              right justification
+   any other value      centralize"
+  :type '(radio :tag "Sequence Justification"
+                (const left) (const right) (other :tag "center" center))
+  :group 'ebnf-displacement)
+
+
+(defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
+  "*Specify special font.
+
+See documentation for `ebnf-production-font'."
+  :type '(list :tag "Special Font"
+               (number :tag "Font Size")
+               (symbol :tag "Font Name")
+               (choice :tag "Foreground Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (choice :tag "Background Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (repeat :tag "Font Attributes" :inline t
+                       (choice (const bold)      (const italic)
+                               (const underline) (const strikeout)
+                               (const overline)  (const shadow)
+                               (const box)       (const outline))))
+  :group 'ebnf-special)
+
+
+(defcustom ebnf-special-shape 'bevel
+  "*Specify special box shape.
+
+See documentation for `ebnf-non-terminal-shape'."
+  :type '(radio :tag "Special Shape"
+                (const miter) (const round) (const bevel))
+  :group 'ebnf-special)
+
+
+(defcustom ebnf-special-shadow nil
+  "*Non-nil means special box will have a shadow."
+  :type 'boolean
+  :group 'ebnf-special)
+
+
+(defcustom ebnf-special-border-width 0.5
+  "*Specify border width for special box."
+  :type 'number
+  :group 'ebnf-special)
+
+
+(defcustom ebnf-special-border-color "Black"
+  "*Specify border color for special box."
+  :type 'string
+  :group 'ebnf-special)
+
+
+(defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
+  "*Specify except font.
+
+See documentation for `ebnf-production-font'."
+  :type '(list :tag "Except Font"
+               (number :tag "Font Size")
+               (symbol :tag "Font Name")
+               (choice :tag "Foreground Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (choice :tag "Background Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (repeat :tag "Font Attributes" :inline t
+                       (choice (const bold)      (const italic)
+                               (const underline) (const strikeout)
+                               (const overline)  (const shadow)
+                               (const box)       (const outline))))
+  :group 'ebnf-except)
+
+
+(defcustom ebnf-except-shape 'bevel
+  "*Specify except box shape.
+
+See documentation for `ebnf-non-terminal-shape'."
+  :type '(radio :tag "Except Shape"
+                (const miter) (const round) (const bevel))
+  :group 'ebnf-except)
+
+
+(defcustom ebnf-except-shadow nil
+  "*Non-nil means except box will have a shadow."
+  :type 'boolean
+  :group 'ebnf-except)
+
+
+(defcustom ebnf-except-border-width 0.25
+  "*Specify border width for except box."
+  :type 'number
+  :group 'ebnf-except)
+
+
+(defcustom ebnf-except-border-color "Black"
+  "*Specify border color for except box."
+  :type 'string
+  :group 'ebnf-except)
+
+
+(defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
+  "*Specify repeat font.
+
+See documentation for `ebnf-production-font'."
+  :type '(list :tag "Repeat Font"
+               (number :tag "Font Size")
+               (symbol :tag "Font Name")
+               (choice :tag "Foreground Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (choice :tag "Background Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (repeat :tag "Font Attributes" :inline t
+                       (choice (const bold)      (const italic)
+                               (const underline) (const strikeout)
+                               (const overline)  (const shadow)
+                               (const box)       (const outline))))
+  :group 'ebnf-repeat)
+
+
+(defcustom ebnf-repeat-shape 'bevel
+  "*Specify repeat box shape.
+
+See documentation for `ebnf-non-terminal-shape'."
+  :type '(radio :tag "Repeat Shape"
+                (const miter) (const round) (const bevel))
+  :group 'ebnf-repeat)
+
+
+(defcustom ebnf-repeat-shadow nil
+  "*Non-nil means repeat box will have a shadow."
+  :type 'boolean
+  :group 'ebnf-repeat)
+
+
+(defcustom ebnf-repeat-border-width 0.0
+  "*Specify border width for repeat box."
+  :type 'number
+  :group 'ebnf-repeat)
+
+
+(defcustom ebnf-repeat-border-color "Black"
+  "*Specify border color for repeat box."
+  :type 'string
+  :group 'ebnf-repeat)
+
+
+(defcustom ebnf-terminal-font '(7 Courier "Black" "White")
+  "*Specify terminal font.
+
+See documentation for `ebnf-production-font'."
+  :type '(list :tag "Terminal Font"
+               (number :tag "Font Size")
+               (symbol :tag "Font Name")
+               (choice :tag "Foreground Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (choice :tag "Background Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (repeat :tag "Font Attributes" :inline t
+                       (choice (const bold)      (const italic)
+                               (const underline) (const strikeout)
+                               (const overline)  (const shadow)
+                               (const box)       (const outline))))
+  :group 'ebnf-terminal)
+
+
+(defcustom ebnf-terminal-shape 'miter
+  "*Specify terminal box shape.
+
+See documentation for `ebnf-non-terminal-shape'."
+  :type '(radio :tag "Terminal Shape"
+                (const miter) (const round) (const bevel))
+  :group 'ebnf-terminal)
+
+
+(defcustom ebnf-terminal-shadow nil
+  "*Non-nil means terminal box will have a shadow."
+  :type 'boolean
+  :group 'ebnf-terminal)
+
+
+(defcustom ebnf-terminal-border-width 1.0
+  "*Specify border width for terminal box."
+  :type 'number
+  :group 'ebnf-terminal)
+
+
+(defcustom ebnf-terminal-border-color "Black"
+  "*Specify border color for terminal box."
+  :type 'string
+  :group 'ebnf-terminal)
+
+
+(defcustom ebnf-sort-production nil
+  "*Specify how productions are sorted.
+
+Valid values are:
+
+   nil                  don't sort productions.
+   `ascending'          ascending sort.
+   any other value      descending sort."
+  :type '(radio :tag "Production Sort"
+                (const :tag "Ascending" ascending)
+                (const :tag "Descending" descending)
+                (other :tag "No Sort" nil))
+  :group 'ebnf-production)
+
+
+(defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
+  "*Specify production header font.
+
+It is a list with the following form:
+
+   (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
+
+Where:
+SIZE is the font size.
+NAME is the font name symbol.
+ATTRIBUTE is one of the following symbols:
+   bold      - use bold font.
+   italic    - use italic font.
+   underline - put a line under text.
+   strikeout - like underline, but the line is in middle of text.
+   overline  - like underline, but the line is over the text.
+   shadow    - text will have a shadow.
+   box       - text will be surrounded by a box.
+   outline   - print characters as hollow outlines.
+FOREGROUND is a foreground string color name; if it's nil, the default color is
+\"Black\".
+BACKGROUND is a background string color name; if it's nil, the default color is
+\"White\".
+
+See `ps-font-info-database' for valid font name."
+  :type '(list :tag "Production Font"
+               (number :tag "Font Size")
+               (symbol :tag "Font Name")
+               (choice :tag "Foreground Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (choice :tag "Background Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (repeat :tag "Font Attributes" :inline t
+                       (choice (const bold)      (const italic)
+                               (const underline) (const strikeout)
+                               (const overline)  (const shadow)
+                               (const box)       (const outline))))
+  :group 'ebnf-production)
+
+
+(defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
+  "*Specify non-terminal font.
+
+See documentation for `ebnf-production-font'."
+  :type '(list :tag "Non-Terminal Font"
+               (number :tag "Font Size")
+               (symbol :tag "Font Name")
+               (choice :tag "Foreground Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (choice :tag "Background Color"
+                       (string :tag "Name")
+                       (other :tag "Default" nil))
+               (repeat :tag "Font Attributes" :inline t
+                       (choice (const bold)      (const italic)
+                               (const underline) (const strikeout)
+                               (const overline)  (const shadow)
+                               (const box)       (const outline))))
+  :group 'ebnf-non-terminal)
+
+
+(defcustom ebnf-non-terminal-shape 'round
+  "*Specify non-terminal box shape.
+
+Valid values are:
+
+   `miter'      +-------+
+                |       |
+                +-------+
+
+   `round'       -------
+                (       )
+                 -------
+
+   `bevel'      /-------\\
+                |       |
+                \\-------/
+
+Any other value is treated as `miter'."
+  :type '(radio :tag "Non-Terminal Shape"
+                (const miter) (const round) (const bevel))
+  :group 'ebnf-non-terminal)
+
+
+(defcustom ebnf-non-terminal-shadow nil
+  "*Non-nil means non-terminal box will have a shadow."
+  :type 'boolean
+  :group 'ebnf-non-terminal)
+
+
+(defcustom ebnf-non-terminal-border-width 1.0
+  "*Specify border width for non-terminal box."
+  :type 'number
+  :group 'ebnf-non-terminal)
+
+
+(defcustom ebnf-non-terminal-border-color "Black"
+  "*Specify border color for non-terminal box."
+  :type 'string
+  :group 'ebnf-non-terminal)
+
+
+(defcustom ebnf-arrow-shape 'hollow
+  "*Specify the arrow shape.
+
+Valid values are:
+
+   `none'       ======
+
+   `semi-up'       *               `transparent'  *
+                    *                             |*
+                =====*                            | *
+                                                ==+==*
+                                                  | *
+                                                  |*
+                                                  *
+
+   `semi-down'  =====*             `hollow'       *
+                    *                             |*
+                   *                              | *
+                                                ==+  *
+                                                  | *
+                                                  |*
+                                                  *
+
+   `simple'        *               `full'         *
+                    *                             |*
+                =====*                            |X*
+                    *                           ==+XX*
+                   *                              |X*
+                                                  |*
+                                                  *
+
+   `user'       See also documentation for variable `ebnf-user-arrow'.
+
+Any other value is treated as `none'."
+  :type '(radio :tag "Arrow Shape"
+                (const none)        (const semi-up)
+                (const semi-down)   (const simple)
+                (const transparent) (const hollow)
+                (const full)        (const user))
+  :group 'ebnf-shape)
+
+
+(defcustom ebnf-chart-shape 'round
+  "*Specify chart flow shape.
+
+See documentation for `ebnf-non-terminal-shape'."
+  :type '(radio :tag "Chart Flow Shape"
+                (const miter) (const round) (const bevel))
+  :group 'ebnf-shape)
+
+
+(defcustom ebnf-user-arrow nil
+  "*Specify a user arrow shape (a PostScript code).
+
+PostScript code should draw a right arrow.
+
+The anatomy of a right arrow is:
+
+   ...... Initial position
+   :
+   :     *.................
+   :     | *       }      }
+   :     |   *     } hT4  }
+   v     |     *   }      }
+   ======+======*...      } hT2
+   :     |     *:  }      }
+   :     |   *  :  } hT4  }
+   :     | *    :  }      }
+   :     *.................
+   :     :      :
+   :     :      :..........
+   :     :         } hT2  }
+   :     :..........      } hT
+   :               } hT2  }
+   :.......................
+
+Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can be
+used to generate your own arrow.  As these variables are used along PostScript
+execution, *DON'T* modify the values of them.  Instead, copy the values, if you
+need to modify them.
+
+The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
+
+The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
+symbol `user'.
+
+See function `ebnf-user-arrow' for valid values and how values are processed."
+  :type '(radio :tag "User Arrow Shape"
+                (const nil)
+                string
+                symbol
+                (repeat :tag "List"
+                        (radio string
+                               symbol
+                               sexp)))
+  :group 'ebnf-shape)
+
+
+(defcustom ebnf-syntax 'ebnf
+  "*Specify syntax to be recognized.
+
+Valid values are:
+
+   `ebnf'       ebnf2ps recognizes the syntax described above.
+                The following variables *ONLY* have effect with this
+                setting:
+                `ebnf-terminal-regexp', `ebnf-case-fold-search',
+                `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
+
+   `iso-ebnf'   ebnf2ps recognizes the syntax described in the URL:
+                `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
+                (\"International Standard of the ISO EBNF Notation\").
+                The following variables *ONLY* have effect with this
+                setting:
+                `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
+
+   `yacc'       ebnf2ps recognizes the Yacc/Bison syntax.
+                The following variable *ONLY* has effect with this
+                setting:
+                `ebnf-yac-ignore-error-recovery'.
+
+Any other value is treated as `ebnf'."
+  :type '(radio :tag "Syntax"
+                (const ebnf) (const iso-ebnf) (const yacc))
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-lex-comment-char ?\;
+  "*Specify the line comment character.
+
+It's used only when `ebnf-syntax' is `ebnf'."
+  :type 'character
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-lex-eop-char ?.
+  "*Specify the end of production character.
+
+It's used only when `ebnf-syntax' is `ebnf'."
+  :type 'character
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-terminal-regexp nil
+  "*Specify how it's a terminal name.
+
+If it's nil, the terminal name must be enclosed by `\"'.
+If it's a string, it should be a regexp that it'll be used to determine a
+terminal name; terminal name may also be enclosed by `\"'.
+
+It's used only when `ebnf-syntax' is `ebnf'."
+  :type '(radio :tag "Terminal Name"
+                (const nil) regexp)
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-case-fold-search nil
+  "*Non-nil means ignore case on matching.
+
+It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
+`ebnf'."
+  :type 'boolean
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-iso-alternative-p nil
+  "*Non-nil means use alternative ISO EBNF.
+
+It's only used when `ebnf-syntax' is `iso-ebnf'.
+
+This variable affects the following symbol set:
+
+   STANDARD   ALTERNATIVE
+      |    ==>   / or !
+      [    ==>   (/
+      ]    ==>   /)
+      {    ==>   (:
+      }    ==>   :)
+      ;    ==>   ."
+  :type 'boolean
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-iso-normalize-p nil
+  "*Non-nil means normalize ISO EBNF syntax names.
+
+Normalize a name means that several contiguous spaces inside name become a
+single space, so \"A  B   C\" is normalized to  \"A B C\".
+
+It's only used when `ebnf-syntax' is `iso-ebnf'."
+  :type 'boolean
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-eps-prefix "ebnf--"
+  "*Specify EPS prefix file name.
+
+See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
+  :type 'string
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-entry-percentage 0.5    ; middle
+  "*Specify entry height on alternatives.
+
+It must be a float between 0.0 (top) and 1.0 (bottom)."
+  :type 'number
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-default-width 0.6
+  "*Specify additional border width over default terminal, non-terminal or
+special."
+  :type 'number
+  :group 'ebnf2ps)
+
+
+;; Printing color requires x-color-values.
+(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
+                            (fboundp 'color-instance-rgb-components)) ; XEmacs
+  "*Non-nil means use color."
+  :type 'boolean
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-line-width 1.0
+  "*Specify flow line width."
+  :type 'number
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-line-color "Black"
+  "*Specify flow line color."
+  :type 'string
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-debug-ps nil
+  "*Non-nil means to generate PostScript debug procedures.
+
+It is intended to help PostScript programmers in debugging."
+  :type 'boolean
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-use-float-format t
+  "*Non-nil means use `%f' float format.
+
+The advantage of using float format is that ebnf2ps generates a little short
+PostScript file.
+
+If it occurs the error message:
+
+   Invalid format operation %f
+
+when executing ebnf2ps, set `ebnf-use-float-format' to nil."
+  :type 'boolean
+  :group 'ebnf2ps)
+
+
+(defcustom ebnf-yac-ignore-error-recovery nil
+  "*Non-nil means ignore error recovery.
+
+It's only used when `ebnf-syntax' is `yacc'."
+  :type 'boolean
+  :group 'ebnf-syntatic)
+
+
+(defcustom ebnf-ignore-empty-rule nil
+  "*Non-nil means ignore empty rules.
+
+It's interesting to set this variable if your Yacc/Bison grammar has a lot of
+middle action rule."
+  :type 'boolean
+  :group 'ebnf-optimization)
+
+
+(defcustom ebnf-optimize nil
+  "*Non-nil means optimize syntatic chart of rules.
+
+The following optimizations are done:
+
+   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.
+
+The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
+  :type 'boolean
+  :group 'ebnf-optimization)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Customization
+
+
+;;;###autoload
+(defun ebnf-customize ()
+  "Customization for ebnf group."
+  (interactive)
+  (customize-group 'ebnf2ps))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; User commands
+
+
+;;;###autoload
+(defun ebnf-print-buffer (&optional filename)
+  "Generate and print a PostScript syntatic chart image of the buffer.
+
+When called with a numeric prefix argument (C-u), prompts the user for
+the name of a file to save the PostScript image in, instead of sending
+it to the printer.
+
+More specifically, the FILENAME argument is treated as follows: if it
+is nil, send the image to the printer.  If FILENAME is a string, save
+the PostScript image in a file with that name.  If FILENAME is a
+number, prompt the user for the name of the file to save in."
+  (interactive (list (ps-print-preprint current-prefix-arg)))
+  (ebnf-print-region (point-min) (point-max) filename))
+
+
+;;;###autoload
+(defun ebnf-print-region (from to &optional filename)
+  "Generate and print a PostScript syntatic chart image of the region.
+Like `ebnf-print-buffer', but prints just the current region."
+  (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
+  (run-hooks 'ebnf-hook)
+  (or (ebnf-spool-region from to)
+      (ps-do-despool filename)))
+
+
+;;;###autoload
+(defun ebnf-spool-buffer ()
+  "Generate and spool a PostScript syntatic chart image of the buffer.
+Like `ebnf-print-buffer' except that the PostScript image is saved in a
+local buffer to be sent to the printer later.
+
+Use the command `ebnf-despool' to send the spooled images to the printer."
+  (interactive)
+  (ebnf-spool-region (point-min) (point-max)))
+
+
+;;;###autoload
+(defun ebnf-spool-region (from to)
+  "Generate a PostScript syntatic chart image of the region and spool locally.
+Like `ebnf-spool-buffer', but spools just the current region.
+
+Use the command `ebnf-despool' to send the spooled images to the printer."
+  (interactive "r")
+  (ebnf-generate-region from to 'ebnf-generate))
+
+
+;;;###autoload
+(defun ebnf-eps-buffer ()
+  "Generate a PostScript syntatic chart image of the buffer in a EPS file.
+
+Indeed, for each production is generated a EPS file.
+The EPS file name has the following form:
+
+   <PREFIX><PRODUCTION>.eps
+
+<PREFIX>     is given by variable `ebnf-eps-prefix'.
+             The default value is \"ebnf--\".
+
+<PRODUCTION> is the production name.
+             The production name is mapped to form a valid file name.
+             For example, the production name \"A/B + C\" is mapped to
+             \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
+
+WARNING: It's *NOT* asked any confirmation to override an existing file."
+  (interactive)
+  (ebnf-eps-region (point-min) (point-max)))
+
+
+;;;###autoload
+(defun ebnf-eps-region (from to)
+  "Generate a PostScript syntatic chart image of the region in a EPS file.
+
+Indeed, for each production is generated a EPS file.
+The EPS file name has the following form:
+
+   <PREFIX><PRODUCTION>.eps
+
+<PREFIX>     is given by variable `ebnf-eps-prefix'.
+             The default value is \"ebnf--\".
+
+<PRODUCTION> is the production name.
+             The production name is mapped to form a valid file name.
+             For example, the production name \"A/B + C\" is mapped to
+             \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
+
+WARNING: It's *NOT* asked any confirmation to override an existing file."
+  (interactive "r")
+  (let ((ebnf-eps-executing t))
+    (ebnf-generate-region from to 'ebnf-generate-eps)))
+
+
+;;;###autoload
+(defalias 'ebnf-despool 'ps-despool)
+
+
+;;;###autoload
+(defun ebnf-syntax-buffer ()
+  "Does a syntatic analysis of the current buffer."
+  (interactive)
+  (ebnf-syntax-region (point-min) (point-max)))
+
+
+;;;###autoload
+(defun ebnf-syntax-region (from to)
+  "Does a syntatic analysis of a region."
+  (interactive "r")
+  (ebnf-generate-region from to nil))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utilities
+
+
+;;;###autoload
+(defun ebnf-setup ()
+  "Return the current ebnf2ps setup."
+  (format
+   "
+\(setq ebnf-special-font                %s
+      ebnf-special-shape               %s
+      ebnf-special-shadow              %S
+      ebnf-special-border-width        %S
+      ebnf-special-border-color        %S
+      ebnf-except-font                 %s
+      ebnf-except-shape                %s
+      ebnf-except-shadow               %S
+      ebnf-except-border-width         %S
+      ebnf-except-border-color         %S
+      ebnf-repeat-font                 %s
+      ebnf-repeat-shape                %s
+      ebnf-repeat-shadow               %S
+      ebnf-repeat-border-width         %S
+      ebnf-repeat-border-color         %S
+      ebnf-terminal-regexp             %S
+      ebnf-case-fold-search            %S
+      ebnf-terminal-font               %s
+      ebnf-terminal-shape              %s
+      ebnf-terminal-shadow             %S
+      ebnf-terminal-border-width       %S
+      ebnf-terminal-border-color       %S
+      ebnf-non-terminal-font           %s
+      ebnf-non-terminal-shape          %s
+      ebnf-non-terminal-shadow         %S
+      ebnf-non-terminal-border-width   %S
+      ebnf-non-terminal-border-color   %S
+      ebnf-sort-production             %s
+      ebnf-production-font             %s
+      ebnf-arrow-shape                 %s
+      ebnf-chart-shape                 %s
+      ebnf-user-arrow                  %s
+      ebnf-horizontal-orientation      %S
+      ebnf-horizontal-max-height       %S
+      ebnf-production-horizontal-space %S
+      ebnf-production-vertical-space   %S
+      ebnf-justify-sequence            %s
+      ebnf-lex-comment-char            ?\\%03o
+      ebnf-lex-eop-char                ?\\%03o
+      ebnf-syntax                      %s
+      ebnf-iso-alternative-p           %S
+      ebnf-iso-normalize-p             %S
+      ebnf-eps-prefix                  %S
+      ebnf-entry-percentage            %S
+      ebnf-color-p                     %S
+      ebnf-line-width                  %S
+      ebnf-line-color                  %S
+      ebnf-debug-ps                    %S
+      ebnf-use-float-format            %S
+      ebnf-yac-ignore-error-recovery   %S
+      ebnf-ignore-empty-rule           %S
+      ebnf-optimize                    %S)
+"
+   (ps-print-quote ebnf-special-font)
+   (ps-print-quote ebnf-special-shape)
+   ebnf-special-shadow
+   ebnf-special-border-width
+   ebnf-special-border-color
+   (ps-print-quote ebnf-except-font)
+   (ps-print-quote ebnf-except-shape)
+   ebnf-except-shadow
+   ebnf-except-border-width
+   ebnf-except-border-color
+   (ps-print-quote ebnf-repeat-font)
+   (ps-print-quote ebnf-repeat-shape)
+   ebnf-repeat-shadow
+   ebnf-repeat-border-width
+   ebnf-repeat-border-color
+   ebnf-terminal-regexp
+   ebnf-case-fold-search
+   (ps-print-quote ebnf-terminal-font)
+   (ps-print-quote ebnf-terminal-shape)
+   ebnf-terminal-shadow
+   ebnf-terminal-border-width
+   ebnf-terminal-border-color
+   (ps-print-quote ebnf-non-terminal-font)
+   (ps-print-quote ebnf-non-terminal-shape)
+   ebnf-non-terminal-shadow
+   ebnf-non-terminal-border-width
+   ebnf-non-terminal-border-color
+   (ps-print-quote ebnf-sort-production)
+   (ps-print-quote ebnf-production-font)
+   (ps-print-quote ebnf-arrow-shape)
+   (ps-print-quote ebnf-chart-shape)
+   (ps-print-quote ebnf-user-arrow)
+   ebnf-horizontal-orientation
+   ebnf-horizontal-max-height
+   ebnf-production-horizontal-space
+   ebnf-production-vertical-space
+   (ps-print-quote ebnf-justify-sequence)
+   ebnf-lex-comment-char
+   ebnf-lex-eop-char
+   (ps-print-quote ebnf-syntax)
+   ebnf-iso-alternative-p
+   ebnf-iso-normalize-p
+   ebnf-eps-prefix
+   ebnf-entry-percentage
+   ebnf-color-p
+   ebnf-line-width
+   ebnf-line-color
+   ebnf-debug-ps
+   ebnf-use-float-format
+   ebnf-yac-ignore-error-recovery
+   ebnf-ignore-empty-rule
+   ebnf-optimize))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Style variables
+
+
+(defvar ebnf-stack-style nil
+  "Used in functions `ebnf-reset-style', `ebnf-push-style' and
+`ebnf-pop-style'.")
+
+
+(defvar ebnf-current-style 'default
+  "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
+
+
+(defconst ebnf-style-custom-list
+  '(ebnf-special-font
+    ebnf-special-shape
+    ebnf-special-shadow
+    ebnf-special-border-width
+    ebnf-special-border-color
+    ebnf-except-font
+    ebnf-except-shape
+    ebnf-except-shadow
+    ebnf-except-border-width
+    ebnf-except-border-color
+    ebnf-repeat-font
+    ebnf-repeat-shape
+    ebnf-repeat-shadow
+    ebnf-repeat-border-width
+    ebnf-repeat-border-color
+    ebnf-terminal-regexp
+    ebnf-case-fold-search
+    ebnf-terminal-font
+    ebnf-terminal-shape
+    ebnf-terminal-shadow
+    ebnf-terminal-border-width
+    ebnf-terminal-border-color
+    ebnf-non-terminal-font
+    ebnf-non-terminal-shape
+    ebnf-non-terminal-shadow
+    ebnf-non-terminal-border-width
+    ebnf-non-terminal-border-color
+    ebnf-sort-production
+    ebnf-production-font
+    ebnf-arrow-shape
+    ebnf-chart-shape
+    ebnf-user-arrow
+    ebnf-horizontal-orientation
+    ebnf-horizontal-max-height
+    ebnf-production-horizontal-space
+    ebnf-production-vertical-space
+    ebnf-justify-sequence
+    ebnf-lex-comment-char
+    ebnf-lex-eop-char
+    ebnf-syntax
+    ebnf-iso-alternative-p
+    ebnf-iso-normalize-p
+    ebnf-eps-prefix
+    ebnf-entry-percentage
+    ebnf-color-p
+    ebnf-line-width
+    ebnf-line-color
+    ebnf-debug-ps
+    ebnf-use-float-format
+    ebnf-yac-ignore-error-recovery
+    ebnf-ignore-empty-rule
+    ebnf-optimize)
+  "List of valid symbol custom variable.")
+
+
+(defvar ebnf-style-database
+  '(;; EBNF default
+    (default
+      nil
+      (ebnf-special-font          . '(7 Courier "Black" "Gray95" bold italic))
+      (ebnf-special-shape               . 'bevel)
+      (ebnf-special-shadow              . nil)
+      (ebnf-special-border-width        . 0.5)
+      (ebnf-special-border-color        . "Black")
+      (ebnf-except-font           . '(7 Courier "Black" "Gray90" bold italic))
+      (ebnf-except-shape                . 'bevel)
+      (ebnf-except-shadow               . nil)
+      (ebnf-except-border-width         . 0.25)
+      (ebnf-except-border-color         . "Black")
+      (ebnf-repeat-font           . '(7 Courier "Black" "Gray85" bold italic))
+      (ebnf-repeat-shape                . 'bevel)
+      (ebnf-repeat-shadow               . nil)
+      (ebnf-repeat-border-width         . 0.0)
+      (ebnf-repeat-border-color         . "Black")
+      (ebnf-terminal-regexp             . nil)
+      (ebnf-case-fold-search            . nil)
+      (ebnf-terminal-font               . '(7  Courier   "Black" "White"))
+      (ebnf-terminal-shape              . 'miter)
+      (ebnf-terminal-shadow             . nil)
+      (ebnf-terminal-border-width       . 1.0)
+      (ebnf-terminal-border-color       . "Black")
+      (ebnf-non-terminal-font           . '(7  Helvetica "Black" "White"))
+      (ebnf-non-terminal-shape          . 'round)
+      (ebnf-non-terminal-shadow         . nil)
+      (ebnf-non-terminal-border-width   . 1.0)
+      (ebnf-non-terminal-border-color   . "Black")
+      (ebnf-sort-production             . nil)
+      (ebnf-production-font             . '(10 Helvetica "Black" "White" bold))
+      (ebnf-arrow-shape                 . 'hollow)
+      (ebnf-chart-shape                 . 'round)
+      (ebnf-user-arrow                  . nil)
+      (ebnf-horizontal-orientation      . nil)
+      (ebnf-horizontal-max-height       . nil)
+      (ebnf-production-horizontal-space . 0.0)
+      (ebnf-production-vertical-space   . 0.0)
+      (ebnf-justify-sequence            . 'center)
+      (ebnf-lex-comment-char            . ?\;)
+      (ebnf-lex-eop-char                . ?.)
+      (ebnf-syntax                      . 'ebnf)
+      (ebnf-iso-alternative-p           . nil)
+      (ebnf-iso-normalize-p             . nil)
+      (ebnf-eps-prefix                  . "ebnf--")
+      (ebnf-entry-percentage            . 0.5)
+      (ebnf-color-p   . (or (fboundp 'x-color-values) ; Emacs
+                            (fboundp 'color-instance-rgb-components))) ; XEmacs
+      (ebnf-line-width                  . 1.0)
+      (ebnf-line-color                  . "Black")
+      (ebnf-debug-ps                    . nil)
+      (ebnf-use-float-format            . t)
+      (ebnf-yac-ignore-error-recovery   . nil)
+      (ebnf-ignore-empty-rule           . nil)
+      (ebnf-optimize                    . nil))
+    ;; Happy EBNF default
+    (happy
+     default
+     (ebnf-justify-sequence            . 'left)
+     (ebnf-lex-comment-char            . ?\#)
+     (ebnf-lex-eop-char                . ?\;))
+    ;; ISO EBNF default
+    (iso-ebnf
+     default
+     (ebnf-syntax                      . 'iso-ebnf))
+    ;; Yacc/Bison default
+    (yacc
+     default
+     (ebnf-syntax                      . 'yacc))
+    )
+  "Style database.
+
+Each element has the following form:
+
+   (CUSTOM INHERITS (VAR . VALUE)...)
+
+CUSTOM is a symbol name style.
+INHERITS is a symbol name style from which the current style inherits the
+context.  If INHERITS is nil, means that there is no inheritance.
+VAR is a valid ebnf2ps symbol custom variable.  See `ebnf-style-custom-list' for
+valid symbol variable.
+VALUE is a sexp which it'll be evaluated to set the value to VAR.  So, don't
+forget to quote symbols and constant lists.  See `default' style for an
+example.
+
+Don't handle this variable directly.  Use functions `ebnf-insert-style' and
+`ebnf-merge-style'.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Style commands
+
+
+;;;###autoload
+(defun ebnf-insert-style (name inherits &rest values)
+  "Insert a new style NAME with inheritance INHERITS and values VALUES."
+  (interactive)
+  (and (assoc name ebnf-style-database)
+       (error "Style name already exists: %s" name))
+  (or (assoc inherits ebnf-style-database)
+      (error "Style inheritance name does'nt exist: %s" inherits))
+  (setq ebnf-style-database
+        (cons (cons name (cons inherits (ebnf-check-style-values values)))
+              ebnf-style-database)))
+
+
+;;;###autoload
+(defun ebnf-merge-style (name &rest values)
+  "Merge values of style NAME with style VALUES."
+  (interactive)
+  (let ((style (or (assoc name ebnf-style-database)
+                   (error "Style name does'nt exist: %s" name)))
+        (merge (ebnf-check-style-values values))
+        val elt new check)
+    ;; modify value of existing variables
+    (setq val (nthcdr 2 style))
+    (while merge
+      (setq check (car merge)
+            merge (cdr merge)
+            elt   (assoc (car check) val))
+      (if elt
+          (setcdr elt (cdr check))
+        (setq new (cons check new))))
+    ;; insert new variables
+    (nconc style (nreverse new))))
+
+
+;;;###autoload
+(defun ebnf-apply-style (style)
+  "Set STYLE to current style.
+
+It returns the old style symbol."
+  (interactive)
+  (prog1
+      ebnf-current-style
+    (and (ebnf-apply-style1 style)
+         (setq ebnf-current-style style))))
+
+
+;;;###autoload
+(defun ebnf-reset-style (&optional style)
+  "Reset current style.
+
+It returns the old style symbol."
+  (interactive)
+  (setq ebnf-stack-style nil)
+  (ebnf-apply-style (or style 'default)))
+
+
+;;;###autoload
+(defun ebnf-push-style (&optional style)
+  "Push the current style and set STYLE to current style.
+
+It returns the old style symbol."
+  (interactive)
+  (prog1
+      ebnf-current-style
+    (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
+    (and style
+         (ebnf-apply-style style))))
+
+
+;;;###autoload
+(defun ebnf-pop-style ()
+  "Pop a style and set it to current style.
+
+It returns the old style symbol."
+  (interactive)
+  (prog1
+      (ebnf-apply-style (car ebnf-stack-style))
+    (setq ebnf-stack-style (cdr ebnf-stack-style))))
+
+
+(defun ebnf-apply-style1 (style)
+  (let ((value (cdr (assoc style ebnf-style-database))))
+    (prog1
+        value
+      (and (car value) (ebnf-apply-style1 (car value)))
+      (while (setq value (cdr value))
+        (set (caar value) (eval (cdar value)))))))
+
+
+(defun ebnf-check-style-values (values)
+  (let (style)
+    (while values
+      (and (memq (car values) ebnf-style-custom-list)
+           (setq style (cons (car values) style)))
+      (setq values (cdr values)))
+    (nreverse style)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal variables
+
+
+(make-local-hook 'ebnf-hook)
+(make-local-hook 'ebnf-production-hook)
+(make-local-hook 'ebnf-page-hook)
+
+
+(defvar ebnf-eps-buffer-name " *EPS*")
+(defvar ebnf-parser-func     nil)
+(defvar ebnf-eps-executing   nil)
+(defvar ebnf-eps-upper-x     0.0)
+(make-variable-buffer-local 'ebnf-eps-upper-x)
+(defvar ebnf-eps-upper-y     0.0)
+(make-variable-buffer-local 'ebnf-eps-upper-y)
+(defvar ebnf-eps-prod-width  0.0)
+(make-variable-buffer-local 'ebnf-eps-prod-width)
+(defvar ebnf-eps-max-height 0.0)
+(make-variable-buffer-local 'ebnf-eps-max-height)
+(defvar ebnf-eps-max-width  0.0)
+(make-variable-buffer-local 'ebnf-eps-max-width)
+
+
+(defvar ebnf-eps-context nil
+  "List of EPS file name during parsing.
+
+See section \"Actions in Comments\" in ebnf2ps documentation.")
+
+
+(defvar ebnf-eps-production-list nil
+  "Alist associating production name with EPS file name list.
+
+Each element has the following form:
+
+   (PRODUCTION EPS-FILENAME...)
+
+PRODUCTION is the production name.
+EPS-FILENAME is the EPS file name.
+
+It's generated during parsing and used during EPS generation.
+
+See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
+documentation.")
+
+
+(defconst ebnf-arrow-shape-alist
+  '((none        . 0)
+    (semi-up     . 1)
+    (semi-down   . 2)
+    (simple      . 3)
+    (transparent . 4)
+    (hollow      . 5)
+    (full        . 6)
+    (user        . 7))
+  "Alist associating values for `ebnf-arrow-shape'.
+
+See documentation for `ebnf-arrow-shape'.")
+
+
+(defconst ebnf-terminal-shape-alist
+  '((miter . 0)
+    (round . 1)
+    (bevel . 2))
+  "Alist associating values from `ebnf-terminal-shape' to a bit vector.
+
+See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
+`ebnf-chart-shape'.")
+
+
+(defvar ebnf-limit            nil)
+(defvar ebnf-action           nil)
+(defvar ebnf-action-list      nil)
+
+
+(defvar ebnf-default-p        nil)
+
+
+(defvar ebnf-font-height-P    0)
+(defvar ebnf-font-height-T    0)
+(defvar ebnf-font-height-NT   0)
+(defvar ebnf-font-height-S    0)
+(defvar ebnf-font-height-E    0)
+(defvar ebnf-font-height-R    0)
+(defvar ebnf-font-width-P     0)
+(defvar ebnf-font-width-T     0)
+(defvar ebnf-font-width-NT    0)
+(defvar ebnf-font-width-S     0)
+(defvar ebnf-font-width-E     0)
+(defvar ebnf-font-width-R     0)
+(defvar ebnf-space-T          0)
+(defvar ebnf-space-NT         0)
+(defvar ebnf-space-S          0)
+(defvar ebnf-space-E          0)
+(defvar ebnf-space-R          0)
+
+
+(defvar ebnf-basic-width      0)
+(defvar ebnf-basic-height     0)
+(defvar ebnf-vertical-space   0)
+(defvar ebnf-horizontal-space 0)
+
+
+(defvar ebnf-settings         nil)
+(defvar ebnf-fonts-required   nil)
+
+
+(defconst ebnf-debug
+  "
+% === begin EBNF procedures to help debugging
+
+% Mark visually current point:  string debug
+/debug
+{/-s- exch def
+ currentpoint
+ gsave -s- show grestore
+ gsave
+ 20 20 rlineto
+ 0 -40 rlineto
+ -40 40 rlineto
+ 0 -40 rlineto
+ 20 20 rlineto
+ stroke
+ grestore
+ moveto
+}def
+
+% Show number value:  number string debug-number
+/debug-number
+{gsave
+ 20 0 rmoveto show ([) show 60 string cvs show (]) show
+ grestore
+}def
+
+% === end   EBNF procedures to help debugging
+
+"
+  "This is intended to help debugging PostScript programming.")
+
+
+(defconst ebnf-prologue
+  "
+% === begin EBNF engine
+
+% --- Basic Definitions
+
+/fS F
+/SpaceS FontHeight 0.5 mul def
+/HeightS FontHeight FontHeight add def
+
+/fE F
+/SpaceE FontHeight 0.5 mul def
+/HeightE FontHeight FontHeight add def
+
+/fR F
+/SpaceR FontHeight 0.5 mul def
+/HeightR FontHeight FontHeight add def
+
+/fT F
+/SpaceT FontHeight 0.5 mul def
+/HeightT FontHeight FontHeight add def
+
+/fNT F
+/SpaceNT FontHeight 0.5 mul def
+/HeightNT FontHeight FontHeight add def
+
+/T HeightT HeightNT add 0.5 mul def
+/hT T 0.5 mul def
+/hT2 hT 0.5 mul def
+/hT4 hT 0.25 mul def
+
+/Er 0.1 def     % Error factor
+
+
+/c{currentpoint}bind def
+/xyi{/xi c /yi exch def def}bind def
+/xyo{/xo c /yo exch def def}bind def
+/xyp{/xp c /yp exch def def}bind def
+/xyt{/xt c /yt exch def def}bind def
+
+% vertical movement: x y height vm
+/vm{add moveto}bind def
+
+% horizontal movement: x y width hm
+/hm{3 -1 roll exch add exch moveto}bind def
+
+% set color: [R G B] SetRGB
+/SetRGB{aload pop setrgbcolor}bind def
+
+% filling gray area: gray-scale FillGray
+/FillGray{gsave setgray fill grestore}bind def
+
+% filling color area: [R G B] FillRGB
+/FillRGB{gsave SetRGB fill grestore}bind def
+
+/Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
+/StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
+/Gstroke{gsave Stroke grestore}bind def
+
+% Empty Line: width EL
+/EL{0 rlineto Gstroke}bind def
+
+% --- Arrows
+
+/Down{hT2 neg hT4 neg rlineto}bind def
+
+/Arrow
+{hT2 neg hT4 rmoveto
+ hT2 hT4 neg rlineto
+ Down
+}bind def
+
+/ArrowPath{c newpath moveto Arrow closepath}bind def
+
+%>Right Arrow: RA
+%    \\
+% *---+
+%    /
+/RA-vector
+[{}                                     % 0 - none
+ {hT2 neg hT4 rlineto}                  % 1 - semi-up
+ {Down}                                 % 2 - semi-down
+ {Arrow}                                % 3 - simple
+ {Gstroke ArrowPath}                    % 4 - transparent
+ {Gstroke ArrowPath 1 FillGray}         % 5 - hollow
+ {Gstroke ArrowPath LineColor FillRGB}  % 6 - full
+ {Gstroke gsave UserArrow grestore}     % 7 - user
+]def
+
+/RA
+{hT 0 rlineto
+ c
+ RA-vector ArrowShape get exec
+ Gstroke
+ moveto
+}def
+
+% rotation DrawArrow
+/DrawArrow
+{gsave
+ 0 0 translate
+ rotate
+ RA
+ c
+ grestore
+ rmoveto
+}def
+
+%>Left Arrow: LA
+%  /
+% +---*
+%  \\
+/LA{180 DrawArrow}def
+
+%>Up Arrow: UA
+%  +
+% /|\\
+%  |
+%  *
+/UA{90 DrawArrow}def
+
+%>Down Arrow: DA
+%  *
+%  |
+% \\|/
+%  +
+/DA{270 DrawArrow}def
+
+% --- Corners
+
+%>corner Right Descendent: height arrow corner_RD
+%   _             | arrow
+%  /   height > 0 |  0 - none
+% |               |  1 - right
+% *    ---------- |  2 - left
+% |               |  3 - vertical
+%  \\   height < 0 |
+%   -             |
+/cRD0-vector
+[% 0 - none
+ {0 h rlineto
+  hT 0 rlineto}
+ % 1 - right
+ {0 h rlineto
+  RA}
+ % 2 - left
+ {hT 0 rmoveto xyi
+  LA
+  0 h neg rlineto
+  xi yi moveto}
+ % 3 - vertical
+ {hT h rmoveto xyi
+  hT neg 0 rlineto
+  h 0 gt{DA}{UA}ifelse
+  xi yi moveto}
+]def
+
+/cRD-vector
+[{cRD0-vector arrow get exec}   % 0 - miter
+ {0 0 0 h hT h rcurveto}        % 1 - rounded
+ {hT h rlineto}                 % 2 - bevel
+]def
+
+/corner_RD
+{/arrow exch def /h exch def
+ cRD-vector ChartShape get exec
+ Gstroke
+}def
+
+%>corner Right Ascendent: height arrow corner_RA
+%                 | arrow
+%    | height > 0 |  0 - none
+%   /             |  1 - right
+% *-   ---------- |  2 - left
+%   \\             |  3 - vertical
+%    | height < 0 |
+%                 |
+/cRA0-vector
+[% 0 - none
+ {hT 0 rlineto
+  0 h rlineto}
+ % 1 - right
+ {RA
+  0 h rlineto}
+ % 2 - left
+ {hT h rmoveto xyi
+  0 h neg rlineto
+  LA
+  xi yi moveto}
+ % 3 - vertical
+ {hT h rmoveto xyi
+  h 0 gt{DA}{UA}ifelse
+  hT neg 0 rlineto
+  xi yi moveto}
+]def
+
+/cRA-vector
+[{cRA0-vector arrow get exec}   % 0 - miter
+ {0 0 hT 0 hT h rcurveto}       % 1 - rounded
+ {hT h rlineto}                 % 2 - bevel
+]def
+
+/corner_RA
+{/arrow exch def /h exch def
+ cRA-vector ChartShape get exec
+ Gstroke
+}def
+
+%>corner Left Descendent: height arrow corner_LD
+%  _              | arrow
+%   \\  height > 0 |  0 - none
+%    |            |  1 - right
+%    * ---------- |  2 - left
+%    |            |  3 - vertical
+%   /  height < 0 |
+%  -              |
+/cLD0-vector
+[% 0 - none
+ {0 h rlineto
+  hT neg 0 rlineto}
+ % 1 - right
+ {hT neg h rmoveto xyi
+  RA
+  0 h neg rlineto
+  xi yi moveto}
+ % 2 - left
+ {0 h rlineto
+  LA}
+ % 3 - vertical
+ {hT neg h rmoveto xyi
+  hT 0 rlineto
+  h 0 gt{DA}{UA}ifelse
+  xi yi moveto}
+]def
+
+/cLD-vector
+[{cLD0-vector arrow get exec}   % 0 - miter
+ {0 0 0 h hT neg h rcurveto}    % 1 - rounded
+ {hT neg h rlineto}             % 2 - bevel
+]def
+
+/corner_LD
+{/arrow exch def /h exch def
+ cLD-vector ChartShape get exec
+ Gstroke
+}def
+
+%>corner Left Ascendent: height arrow corner_LA
+%                 | arrow
+% |    height > 0 |  0 - none
+%  \\              |  1 - right
+%   -* ---------- |  2 - left
+%  /              |  3 - vertical
+% |    height < 0 |
+%                 |
+/cLA0-vector
+[% 0 - none
+ {hT neg 0 rlineto
+  0 h rlineto}
+ % 1 - right
+ {hT neg h rmoveto xyi
+  0 h neg rlineto
+  RA
+  xi yi moveto}
+ % 2 - left
+ {LA
+  0 h rlineto}
+ % 3 - vertical
+ {hT neg h rmoveto xyi
+  h 0 gt{DA}{UA}ifelse
+  hT 0 rlineto
+  xi yi moveto}
+]def
+
+/cLA-vector
+[{cLA0-vector arrow get exec}           % 0 - miter
+ {0 0 hT neg 0 hT neg h rcurveto}       % 1 - rounded
+ {hT neg h rlineto}                     % 2 - bevel
+]def
+
+/corner_LA
+{/arrow exch def /h exch def
+ cLA-vector ChartShape get exec
+ Gstroke
+}def
+
+% --- Flow Stuff
+
+% height prepare_height |- line_height corner_height corner_height
+/prepare_height
+{dup 0 gt
+ {T sub hT}
+ {T add hT neg}ifelse
+ dup
+}def
+
+%>Left Alternative: height LAlt
+%      _
+%     /
+%    |   height > 0
+%    |
+%   /
+% *-     ----------
+%   \\
+%    |
+%    |   height < 0
+%     \\
+%      -
+/LAlt
+{dup 0 eq
+ {T exch rlineto}
+ {dup abs T lt
+  {0.5 mul dup
+   1 corner_RA
+   0 corner_RD}
+  {prepare_height
+   1 corner_RA
+   exch 0 exch rlineto
+   0 corner_RD
+  }ifelse
+ }ifelse
+}def
+
+%>Left Loop: height LLoop
+%   _
+%  /
+% |      height > 0
+% |
+%  \\
+%   -*   ----------
+%  /
+% |
+% |      height < 0
+%  \\
+%   -
+/LLoop
+{prepare_height
+ 3 corner_LA
+ exch 0 exch rlineto
+ 0 corner_RD
+}def
+
+%>Right Alternative: height RAlt
+% _
+%  \\
+%   |    height > 0
+%   |
+%    \\
+%     -* ----------
+%    /
+%   |
+%   |    height < 0
+%  /
+% -
+/RAlt
+{dup 0 eq
+ {T neg exch rlineto}
+ {dup abs T lt
+  {0.5 mul dup
+   1 corner_LA
+   0 corner_LD}
+  {prepare_height
+   1 corner_LA
+   exch 0 exch rlineto
+   0 corner_LD
+  }ifelse
+ }ifelse
+}def
+
+%>Right Loop: height RLoop
+%  _
+%   \\
+%    |   height > 0
+%    |
+%   /
+% *-     ----------
+%   \\
+%    |
+%    |   height < 0
+%   /
+%  -
+/RLoop
+{prepare_height
+ 1 corner_RA
+ exch 0 exch rlineto
+ 0 corner_LD
+}def
+
+% --- Terminal, Non-terminal and Special Basics
+
+% string width prepare-width |- string
+/prepare-width
+{/width exch def
+ dup stringwidth pop space add space add width exch sub 0.5 mul
+ /w exch def
+}def
+
+% string width begin-right
+/begin-right
+{xyo
+ prepare-width
+ w hT sub EL
+ RA
+}def
+
+% end-right
+/end-right
+{xo width add Er add yo moveto
+ w Er add neg EL
+ xo yo moveto
+}def
+
+% string width begin-left
+/begin-left
+{xyo
+ prepare-width
+ w EL
+}def
+
+% end-left
+/end-left
+{xo width add Er add yo moveto
+ hT w sub Er add EL
+ LA
+ xo yo moveto
+}def
+
+/ShapePath-vector
+[% 0 - miter
+ {xx yy moveto
+  xx YY lineto
+  XX YY lineto
+  XX yy lineto}
+ % 1 - rounded
+ {/half YY yy sub 0.5 mul abs def
+  xx half add YY moveto
+  0 0 half neg 0 half neg half neg rcurveto
+  0 0 0 half neg half half neg rcurveto
+  XX xx sub abs half sub half sub 0 rlineto
+  0 0 half 0 half half rcurveto
+  0 0 0 half half neg half rcurveto}
+ % 2 - bevel
+ {/quarter YY yy sub 0.25 mul abs def
+  xx quarter add YY moveto
+  quarter neg quarter neg rlineto
+  0 quarter quarter add neg rlineto
+  quarter quarter neg rlineto
+  XX xx sub abs quarter sub quarter sub 0 rlineto
+  quarter quarter rlineto
+  0 quarter quarter add rlineto
+  quarter neg quarter rlineto}
+]def
+
+/doShapePath
+{newpath
+ ShapePath-vector shape get exec
+ closepath
+}def
+
+/doShapeShadow
+{gsave
+ Xshadow Xshadow add Xshadow add
+ Yshadow Yshadow add Yshadow add translate
+ doShapePath
+ 0.9 FillGray
+ grestore
+}def
+
+/doShape
+{gsave
+ doShapePath
+ shapecolor FillRGB
+ StrokeShape
+ grestore
+}def
+
+% string SBound |- string
+/SBound
+{/xx c dup /yy exch def
+ FontHeight add /YY exch def def
+ dup stringwidth pop xx add /XX exch def
+ Effect 8 and 0 ne
+ {/yy yy YShadow add def
+  /XX XX XShadow add def
+ }if
+}def
+
+% string SBox
+/SBox
+{gsave
+ c space sub moveto
+ SBound
+ /XX XX space add space add def
+ /YY YY space add def
+ /yy yy space sub def
+ shadow{doShapeShadow}if
+ doShape
+ space Descent abs rmoveto
+ foreground SetRGB S
+ grestore
+}def
+
+% --- Terminal
+
+% TeRminal: string TR
+/TR
+{/Effect EffectT def
+ /shape ShapeT def
+ /shapecolor BackgroundT def
+ /borderwidth BorderWidthT def
+ /bordercolor BorderColorT def
+ /foreground ForegroundT def
+ /shadow ShadowT def
+ SBox
+}def
+
+%>Right Terminal: string width RT |- x y
+/RT
+{xyt
+ /fT F
+ /space SpaceT def
+ begin-right
+ TR
+ end-right
+ xt yt
+}def
+
+%>Left Terminal: string width LT |- x y
+/LT
+{xyt
+ /fT F
+ /space SpaceT def
+ begin-left
+ TR
+ end-left
+ xt yt
+}def
+
+%>Right Terminal Default: string width RTD |- x y
+/RTD
+{/-save- BorderWidthT def
+ /BorderWidthT BorderWidthT DefaultWidth add def
+ RT
+ /BorderWidthT -save- def
+}def
+
+%>Left Terminal Default: string width LTD |- x y
+/LTD
+{/-save- BorderWidthT def
+ /BorderWidthT BorderWidthT DefaultWidth add def
+ LT
+ /BorderWidthT -save- def
+}def
+
+% --- Non-Terminal
+
+% Non-Terminal: string NT
+/NT
+{/Effect EffectNT def
+ /shape ShapeNT def
+ /shapecolor BackgroundNT def
+ /borderwidth BorderWidthNT def
+ /bordercolor BorderColorNT def
+ /foreground ForegroundNT def
+ /shadow ShadowNT def
+ SBox
+}def
+
+%>Right Non-Terminal: string width RNT |- x y
+/RNT
+{xyt
+ /fNT F
+ /space SpaceNT def
+ begin-right
+ NT
+ end-right
+ xt yt
+}def
+
+%>Left Non-Terminal: string width LNT |- x y
+/LNT
+{xyt
+ /fNT F
+ /space SpaceNT def
+ begin-left
+ NT
+ end-left
+ xt yt
+}def
+
+%>Right Non-Terminal Default: string width RNTD |- x y
+/RNTD
+{/-save- BorderWidthNT def
+ /BorderWidthNT BorderWidthNT DefaultWidth add def
+ RNT
+ /BorderWidthNT -save- def
+}def
+
+%>Left Non-Terminal Default: string width LNTD |- x y
+/LNTD
+{/-save- BorderWidthNT def
+ /BorderWidthNT BorderWidthNT DefaultWidth add def
+ LNT
+ /BorderWidthNT -save- def
+}def
+
+% --- Special
+
+% SPecial: string SP
+/SP
+{/Effect EffectS def
+ /shape ShapeS def
+ /shapecolor BackgroundS def
+ /borderwidth BorderWidthS def
+ /bordercolor BorderColorS def
+ /foreground ForegroundS def
+ /shadow ShadowS def
+ SBox
+}def
+
+%>Right SPecial: string width RSP |- x y
+/RSP
+{xyt
+ /fS F
+ /space SpaceS def
+ begin-right
+ SP
+ end-right
+ xt yt
+}def
+
+%>Left SPecial: string width LSP |- x y
+/LSP
+{xyt
+ /fS F
+ /space SpaceS def
+ begin-left
+ SP
+ end-left
+ xt yt
+}def
+
+%>Right SPecial Default: string width RSPD |- x y
+/RSPD
+{/-save- BorderWidthS def
+ /BorderWidthS BorderWidthS DefaultWidth add def
+ RSP
+ /BorderWidthS -save- def
+}def
+
+%>Left SPecial Default: string width LSPD |- x y
+/LSPD
+{/-save- BorderWidthS def
+ /BorderWidthS BorderWidthS DefaultWidth add def
+ LSP
+ /BorderWidthS -save- def
+}def
+
+% --- Repeat and Except basics
+
+/begin-direction
+{/w width rwidth sub 0.5 mul def
+ width 0 rmoveto}def
+
+/end-direction
+{gsave
+ /xx c entry add /YY exch def def
+ /yy YY height sub def
+ /XX xx rwidth add def
+ shadow{doShapeShadow}if
+ doShape
+ grestore
+}def
+
+/right-direction
+{begin-direction
+ w neg EL
+ xt yt moveto
+ w hT sub EL RA
+ end-direction
+}def
+
+/left-direction
+{begin-direction
+ hT w sub EL LA
+ xt yt moveto
+ w EL
+ end-direction
+}def
+
+% --- Repeat
+
+% entry height width rwidth begin-repeat
+/begin-repeat
+{/rwidth exch def
+ /width exch def
+ /height exch def
+ /entry exch def
+ /fR F
+ /space SpaceR def
+ /Effect EffectR def
+ /shape ShapeR def
+ /shapecolor BackgroundR def
+ /borderwidth BorderWidthR def
+ /bordercolor BorderColorR def
+ /foreground ForegroundR def
+ /shadow ShadowR def
+ xyt
+}def
+
+% string end-repeat |- x y
+/end-repeat
+{gsave
+ space Descent rmoveto
+ foreground SetRGB S
+ c Descent sub
+ grestore
+ exch space add exch moveto
+ xt yt
+}def
+
+%>Right RePeat: string entry height width rwidth RRP |- x y
+/RRP{begin-repeat right-direction end-repeat}def
+
+%>Left RePeat: string entry height width rwidth LRP |- x y
+/LRP{begin-repeat left-direction end-repeat}def
+
+% --- Except
+
+% entry height width rwidth begin-except
+/begin-except
+{/rwidth exch def
+ /width exch def
+ /height exch def
+ /entry exch def
+ /fE F
+ /space SpaceE def
+ /Effect EffectE def
+ /shape ShapeE def
+ /shapecolor BackgroundE def
+ /borderwidth BorderWidthE def
+ /bordercolor BorderColorE def
+ /foreground ForegroundE def
+ /shadow ShadowE def
+ xyt
+}def
+
+% x-width end-except |- x y
+/end-except
+{gsave
+ space space add add Descent rmoveto
+ (-) foreground SetRGB S
+ grestore
+ space 0 rmoveto
+ xt yt
+}def
+
+%>Right EXcept: x-width entry height width rwidth REX |- x y
+/REX{begin-except right-direction end-except}def
+
+%>Left EXcept: x-width entry height width rwidth LEX |- x y
+/LEX{begin-except left-direction end-except}def
+
+% --- Sequence
+
+%>Beginning Of Sequence: BOS |- x y
+/BOS{currentpoint}bind def
+
+%>End Of Sequence: x y x1 y1 EOS |- x y
+/EOS{pop pop}bind def
+
+% --- Production
+
+%>Beginning Of Production: string width height BOP |- y x
+/BOP
+{xyp
+ neg yp add /yw exch def
+ xp add T sub /xw exch def
+ /Effect EffectP def
+ /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
+ /Effect 0 def
+ ( :) S false BG
+ xw yw moveto
+ hT EL RA
+ xp yw moveto
+ T EL
+ yp xp
+}def
+
+%>End Of Production: y x delta EOP
+/EOPH{add exch moveto}bind def                  % horizontal
+/EOPV{exch pop sub 0 exch moveto}bind def       % vertical
+
+% --- Empty Alternative
+
+%>Empty Alternative: width EA |- x y
+/EA
+{gsave
+ Er add 0 rlineto
+ Stroke
+ grestore
+ c
+}def
+
+% --- Alternative
+
+%>AlTernative: h1 h2 ... hn n width AT |- x y
+/AT
+{xyo xo add /xw exch def
+ xw yo moveto
+ Er EL
+ {xw yo moveto
+  dup RAlt
+  xo yo moveto
+  LAlt}repeat
+ xo yo
+}def
+
+% --- Optional
+
+%>OPtional: height width OP |- x y
+/OP
+{xyo
+ T sub /ow exch def
+ ow Er sub 0 rmoveto
+ T Er add EL
+ neg dup RAlt
+ ow T sub neg EL
+ xo yo moveto
+ LAlt
+ xo yo moveto
+ T EL
+ xo yo
+}def
+
+% --- List Flow
+
+%>One or More: height width OM |- x y
+/OM
+{xyo
+ /ow exch def
+ ow Er add 0 rmoveto
+ T Er add neg EL
+ dup RLoop
+ xo T add yo moveto
+ LLoop
+ xo yo moveto
+ T EL
+ xo yo
+}def
+
+%>Zero or More: h2 h1 width ZM |- x y
+/ZM
+{xyo
+ Er add EL
+ Er neg 0 rmoveto
+ dup RAlt
+ exch dup RLoop
+ xo yo moveto
+ exch dup LAlt
+ exch LLoop
+ yo add xo T add exch moveto
+ xo yo
+}def
+
+% === end EBNF engine
+
+"
+  "EBNF PostScript prologue")
+
+
+(defconst ebnf-eps-prologue
+  "
+/#ebnf2ps#dict 230 dict def
+#ebnf2ps#dict begin
+
+% Initiliaze variables to avoid name-conflicting with document variables.
+% This is the case when using `bind' operator.
+/-fillp-                0 def           /h              0 def
+/-ox-                   0 def           /half           0 def
+/-oy-                   0 def           /height         0 def
+/-save-                 0 def           /ow             0 def
+/Ascent                 0 def           /quarter        0 def
+/Descent                0 def           /rXX            0 def
+/Effect                 0 def           /rYY            0 def
+/FontHeight             0 def           /rwidth         0 def
+/LineThickness          0 def           /rxx            0 def
+/OverlinePosition       0 def           /ryy            0 def
+/SpaceBackground        0 def           /shadow         0 def
+/StrikeoutPosition      0 def           /shape          0 def
+/UnderlinePosition      0 def           /shapecolor     0 def
+/XBox                   0 def           /space          0 def
+/XX                     0 def           /st             1 string def
+/Xshadow                0 def           /w              0 def
+/YBox                   0 def           /width          0 def
+/YY                     0 def           /xi             0 def
+/Yshadow                0 def           /xo             0 def
+/arrow                  0 def           /xp             0 def
+/bg                     false def       /xt             0 def
+/bgcolor                0 def           /xw             0 def
+/bordercolor            0 def           /xx             0 def
+/borderwidth            0 def           /yi             0 def
+/dd                     0 def           /yo             0 def
+/entry                  0 def           /yp             0 def
+/foreground             0 def           /yt             0 def
+                                        /yy             0 def
+
+
+% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
+/ISOLatin1Encoding where
+{pop}
+{% -- The ISO Latin-1 encoding vector isn't known, so define it.
+ % -- The first half is the same as the standard encoding,
+ % -- except for minus instead of hyphen at code 055.
+ /ISOLatin1Encoding
+  StandardEncoding 0  45 getinterval aload pop
+  /minus
+  StandardEncoding 46 82 getinterval aload pop
+ %*** NOTE: the following are missing in the Adobe documentation,
+ %*** but appear in the displayed table:
+ %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
+ % 0200 (128)
+  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+  /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+  /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
+  /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
+ % 0240 (160)
+  /space /exclamdown /cent /sterling
+        /currency /yen /brokenbar /section
+  /dieresis /copyright /ordfeminine /guillemotleft
+        /logicalnot /hyphen /registered /macron
+  /degree /plusminus /twosuperior /threesuperior
+        /acute /mu /paragraph /periodcentered
+  /cedilla /onesuperior /ordmasculine /guillemotright
+        /onequarter /onehalf /threequarters /questiondown
+ % 0300 (192)
+  /Agrave /Aacute /Acircumflex /Atilde
+        /Adieresis /Aring /AE /Ccedilla
+  /Egrave /Eacute /Ecircumflex /Edieresis
+        /Igrave /Iacute /Icircumflex /Idieresis
+  /Eth /Ntilde /Ograve /Oacute
+        /Ocircumflex /Otilde /Odieresis /multiply
+  /Oslash /Ugrave /Uacute /Ucircumflex
+        /Udieresis /Yacute /Thorn /germandbls
+ % 0340 (224)
+  /agrave /aacute /acircumflex /atilde
+        /adieresis /aring /ae /ccedilla
+  /egrave /eacute /ecircumflex /edieresis
+        /igrave /iacute /icircumflex /idieresis
+  /eth /ntilde /ograve /oacute
+        /ocircumflex /otilde /odieresis /divide
+  /oslash /ugrave /uacute /ucircumflex
+        /udieresis /yacute /thorn /ydieresis
+ 256 packedarray def
+}ifelse
+
+/reencodeFontISO        %def
+{dup
+ length 12 add dict     % Make a new font (a new dict the same size
+                        % as the old one) with room for our new symbols.
+
+ begin                  % Make the new font the current dictionary.
+  {1 index /FID ne
+   {def}{pop pop}ifelse
+  }forall               % Copy each of the symbols from the old dictionary
+                        % to the new one except for the font ID.
+
+  currentdict /FontType get 0 ne
+  {/Encoding ISOLatin1Encoding def}if   % Override the encoding with
+                                        % the ISOLatin1 encoding.
+
+  % Use the font's bounding box to determine the ascent, descent,
+  % and overall height; don't forget that these values have to be
+  % transformed using the font's matrix.
+
+  %          ^    (x2 y2)
+  %          |       |
+  %          |       v
+  %          |  +----+ - -
+  %          |  |    |   ^
+  %          |  |    |   | Ascent (usually > 0)
+  %          |  |    |   |
+  % (0 0) -> +--+----+-------->
+  %             |    |   |
+  %             |    |   v Descent (usually < 0)
+  % (x1 y1) --> +----+ - -
+
+  currentdict /FontType get 0 ne
+  {/FontBBox load aload pop             % -- x1 y1 x2 y2
+   FontMatrix transform /Ascent  exch def pop
+   FontMatrix transform /Descent exch def pop}
+  {/PrimaryFont FDepVector 0 get def
+   PrimaryFont /FontBBox get aload pop
+   PrimaryFont /FontMatrix get transform /Ascent exch def pop
+   PrimaryFont /FontMatrix get transform /Descent exch def pop
+  }ifelse
+
+  /FontHeight Ascent Descent sub def    % use `sub' because descent < 0
+
+  % Define these in case they're not in the FontInfo
+  % (also, here they're easier to get to).
+  /UnderlinePosition  Descent 0.70 mul def
+  /OverlinePosition   Descent UnderlinePosition sub Ascent add def
+  /StrikeoutPosition  Ascent 0.30 mul def
+  /LineThickness      FontHeight 0.05 mul def
+  /Xshadow            FontHeight  0.08 mul def
+  /Yshadow            FontHeight -0.09 mul def
+  /SpaceBackground    Descent neg UnderlinePosition add def
+  /XBox               Descent neg def
+  /YBox               LineThickness 0.7 mul def
+
+  currentdict   % Leave the new font on the stack
+ end            % Stop using the font as the current dictionary
+ definefont     % Put the font into the font dictionary
+ pop            % Discard the returned font
+}bind def
+
+% Font definition
+/DefFont{findfont exch scalefont reencodeFontISO}def
+
+% Font selection
+/F
+{findfont
+ dup /Ascent            get /Ascent            exch def
+ dup /Descent           get /Descent           exch def
+ dup /FontHeight        get /FontHeight        exch def
+ dup /UnderlinePosition get /UnderlinePosition exch def
+ dup /OverlinePosition  get /OverlinePosition  exch def
+ dup /StrikeoutPosition get /StrikeoutPosition exch def
+ dup /LineThickness     get /LineThickness     exch def
+ dup /Xshadow           get /Xshadow           exch def
+ dup /Yshadow           get /Yshadow           exch def
+ dup /SpaceBackground   get /SpaceBackground   exch def
+ dup /XBox              get /XBox              exch def
+ dup /YBox              get /YBox              exch def
+ setfont
+}def
+
+/BG
+{dup /bg exch def
+ {mark 4 1 roll ]}
+ {[ 1.0 1.0 1.0 ]}
+ ifelse
+ /bgcolor exch def
+}def
+
+% stack:  --
+/FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
+
+% stack:  fill-or-not lower-x lower-y upper-x upper-y  |-  --
+/doRect
+{/rYY exch def
+ /rXX exch def
+ /ryy exch def
+ /rxx exch def
+ gsave
+ newpath
+ rXX rYY moveto
+ rxx rYY lineto
+ rxx ryy lineto
+ rXX ryy lineto
+ closepath
+ % top of stack: fill-or-not
+ {FillBgColor}
+ {LineThickness setlinewidth stroke}
+ ifelse
+ grestore
+}bind def
+
+% stack:  string fill-or-not  |-  --
+/doOutline
+{/-fillp- exch def
+ /-ox- currentpoint /-oy- exch def def
+ gsave
+ LineThickness setlinewidth
+ {st 0 3 -1 roll put
+  st dup true charpath
+  -fillp- {gsave FillBgColor grestore}if
+  stroke stringwidth
+  -oy- add /-oy- exch def
+  -ox- add /-ox- exch def
+  -ox- -oy- moveto
+ }forall
+ grestore
+ -ox- -oy- moveto
+}bind def
+
+% stack:  fill-or-not delta  |-  --
+/doBox
+{/dd exch def
+ xx XBox sub dd sub yy YBox sub dd sub
+ XX XBox add dd add YY YBox add dd add
+ doRect
+}bind def
+
+% stack:  string  |-  --
+/doShadow
+{gsave
+ Xshadow Yshadow rmoveto
+ false doOutline
+ grestore
+}bind def
+
+% stack:  position  |-  --
+/Hline
+{currentpoint exch pop add dup
+ gsave
+ newpath
+ xx exch moveto
+ XX exch lineto
+ closepath
+ LineThickness setlinewidth stroke
+ grestore
+}bind def
+
+% stack:  string  |-  --
+% effect: 1  - underline  2   - strikeout  4  - overline
+%         8  - shadow     16  - box        32 - outline
+/S
+{/xx currentpoint dup Descent add /yy exch def
+ Ascent add /YY exch def def
+ dup stringwidth pop xx add /XX exch def
+ Effect 8 and 0 ne
+ {/yy yy Yshadow add def
+  /XX XX Xshadow add def
+ }if
+ bg
+ {true
+  Effect 16 and 0 ne
+  {SpaceBackground doBox}
+  {xx yy XX YY doRect}
+  ifelse
+ }if                                            % background
+ Effect 16 and 0 ne{false 0 doBox}if            % box
+ Effect 8  and 0 ne{dup doShadow}if             % shadow
+ Effect 32 and 0 ne
+ {true doOutline}                               % outline
+ {show}                                         % normal text
+ ifelse
+ Effect 1  and 0 ne{UnderlinePosition Hline}if  % underline
+ Effect 2  and 0 ne{StrikeoutPosition Hline}if  % strikeout
+ Effect 4  and 0 ne{OverlinePosition  Hline}if  % overline
+}bind def
+
+"
+  "EBNF EPS prologue")
+
+
+(defconst ebnf-eps-begin
+  "
+end
+
+% x y #ebnf2ps#begin
+/#ebnf2ps#begin
+{#ebnf2ps#dict begin /#ebnf2ps#save save def
+ moveto false BG 0.0 0.0 0.0 setrgbcolor}def
+
+/#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
+
+%%EndPrologue
+"
+  "EBNF EPS begin")
+
+
+(defconst ebnf-eps-end
+  "#ebnf2ps#end
+%%EOF
+"
+  "EBNF EPS end")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Formatting
+
+
+(defvar ebnf-format-float "%1.3f")
+
+
+(defun ebnf-format-float (&rest floats)
+  (mapconcat
+   #'(lambda (float)
+       (format ebnf-format-float float))
+   floats
+   " "))
+
+
+(defun ebnf-format-color (format-str color default)
+  (let* ((the-color (or color default))
+         (rgb (mapcar 'ps-color-value (ps-color-values the-color))))
+    (format format-str
+            (concat "["
+                    (ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
+                    "]")
+            the-color)))
+
+
+(defvar ebnf-message-float "%3.2f")
+
+
+(defsubst ebnf-message-float (format-str value)
+  (message format-str
+           (format ebnf-message-float value)))
+
+
+(defsubst ebnf-message-info (messag)
+  (message "%s...%3d%%"
+           messag
+           (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Macros
+
+
+(defmacro ebnf-node-kind (vec &optional value)
+  (if value
+      `(aset ,vec 0 ,value)
+    `(aref ,vec 0)))
+
+
+(defmacro ebnf-node-width-func (node width)
+  `(funcall (aref ,node 1) ,node ,width))
+
+
+(defmacro ebnf-node-dimension-func (node &optional value)
+  (if value
+      `(aset ,node 2 ,value)
+    `(funcall (aref ,node 2) ,node)))
+
+
+(defmacro ebnf-node-entry (vec &optional value)
+  (if value
+      `(aset ,vec 3 ,value)
+    `(aref ,vec 3)))
+
+
+(defmacro ebnf-node-height (vec &optional value)
+  (if value
+      `(aset ,vec 4 ,value)
+    `(aref ,vec 4)))
+
+
+(defmacro ebnf-node-width (vec &optional value)
+  (if value
+      `(aset ,vec 5 ,value)
+    `(aref ,vec 5)))
+
+
+(defmacro ebnf-node-name (vec)
+  `(aref ,vec 6))
+
+
+(defmacro ebnf-node-list (vec &optional value)
+  (if value
+      `(aset ,vec 6 ,value)
+    `(aref ,vec 6)))
+
+
+(defmacro ebnf-node-default (vec)
+  `(aref ,vec 7))
+
+
+(defmacro ebnf-node-production (vec &optional value)
+  (if value
+      `(aset ,vec 7 ,value)
+    `(aref ,vec 7)))
+
+
+(defmacro ebnf-node-separator (vec &optional value)
+  (if value
+      `(aset ,vec 7 ,value)
+    `(aref ,vec 7)))
+
+
+(defmacro ebnf-node-action (vec &optional value)
+  (if value
+      `(aset ,vec 8 ,value)
+    `(aref ,vec 8)))
+
+
+(defmacro ebnf-node-generation (node)
+  `(funcall (ebnf-node-kind ,node) ,node))
+
+
+(defmacro ebnf-max-width (prod)
+  `(max (ebnf-node-width ,prod)
+        (+ (* (length (ebnf-node-name ,prod))
+              ebnf-font-width-P)
+           ebnf-production-horizontal-space)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PostScript generation
+
+
+(defun ebnf-generate-eps (ebnf-tree)
+  (let* ((ps-color-p           (and ebnf-color-p (ps-color-device)))
+         (ps-print-color-scale (if ps-color-p
+                                   (float (car (ps-color-values "white")))
+                                 1.0))
+         (ebnf-total           (length ebnf-tree))
+         (ebnf-nprod           0)
+         (old-ps-output        (symbol-function 'ps-output))
+         (old-ps-output-string (symbol-function 'ps-output-string))
+         (eps-buffer           (get-buffer-create ebnf-eps-buffer-name))
+         ebnf-debug-ps error-msg horizontal
+         prod prod-name prod-width prod-height prod-list file-list)
+    ;; redefines `ps-output' and `ps-output-string'
+    (defalias 'ps-output        'ebnf-eps-output)
+    (defalias 'ps-output-string 'ps-output-string-prim)
+    ;; generate EPS file
+    (save-excursion
+      (condition-case data
+          (progn
+            (while ebnf-tree
+              (setq prod        (car ebnf-tree)
+                    prod-name   (ebnf-node-name prod)
+                    prod-width  (ebnf-max-width prod)
+                    prod-height (ebnf-node-height prod)
+                    horizontal  (memq (ebnf-node-action prod) ebnf-action-list))
+              ;; generate production in EPS buffer
+              (save-excursion
+                (set-buffer eps-buffer)
+                (setq ebnf-eps-upper-x    0.0
+                      ebnf-eps-upper-y    0.0
+                      ebnf-eps-max-width  prod-width
+                      ebnf-eps-max-height prod-height)
+                (ebnf-generate-production prod))
+              (if (setq prod-list (cdr (assoc prod-name
+                                              ebnf-eps-production-list)))
+                  ;; insert EPS buffer in all buffer associated with production
+                  (ebnf-eps-production-list prod-list 'file-list horizontal
+                                            prod-width prod-height eps-buffer)
+                ;; write EPS file for production
+                (ebnf-eps-finish-and-write eps-buffer
+                                           (ebnf-eps-filename prod-name)))
+              ;; prepare for next loop
+              (save-excursion
+                (set-buffer eps-buffer)
+                (erase-buffer))
+              (setq ebnf-tree (cdr ebnf-tree)))
+            ;; write and kill temporary buffers
+            (ebnf-eps-write-kill-temp file-list t)
+            (setq file-list nil))
+        ;; handler
+        ((quit error)
+         (setq error-msg (error-message-string data)))))
+    ;; restore `ps-output' and `ps-output-string'
+    (defalias 'ps-output        old-ps-output)
+    (defalias 'ps-output-string old-ps-output-string)
+    ;; kill temporary buffers
+    (kill-buffer eps-buffer)
+    (ebnf-eps-write-kill-temp file-list nil)
+    (and error-msg (error error-msg))
+    (message " ")))
+
+
+;; write and kill temporary buffers
+(defun ebnf-eps-write-kill-temp (file-list write-p)
+  (while file-list
+    (let ((buffer (get-buffer (concat " *" (car file-list) "*"))))
+      (when buffer
+        (and write-p
+             (ebnf-eps-finish-and-write buffer (car file-list)))
+        (kill-buffer buffer)))
+    (setq file-list (cdr file-list))))
+
+
+;; insert EPS buffer in all buffer associated with production
+(defun ebnf-eps-production-list (prod-list file-list-sym horizontal
+                                           prod-width prod-height eps-buffer)
+  (while prod-list
+    (add-to-list file-list-sym (car prod-list))
+    (save-excursion
+      (set-buffer (get-buffer-create (concat " *" (car prod-list) "*")))
+      (goto-char (point-max))
+      (cond
+       ;; first production
+       ((zerop (buffer-size))
+        (setq ebnf-eps-upper-x    0.0
+              ebnf-eps-upper-y    0.0
+              ebnf-eps-max-width  prod-width
+              ebnf-eps-max-height prod-height))
+       ;; horizontal
+       (horizontal
+        (ebnf-eop-horizontal ebnf-eps-prod-width)
+        (setq ebnf-eps-max-width  (+ ebnf-eps-max-width
+                                     ebnf-production-horizontal-space
+                                     prod-width)
+              ebnf-eps-max-height (max ebnf-eps-max-height prod-height)))
+       ;; vertical
+       (t
+        (ebnf-eop-vertical ebnf-eps-max-height)
+        (setq ebnf-eps-upper-x    (max ebnf-eps-upper-x ebnf-eps-max-width)
+              ebnf-eps-upper-y    (if (zerop ebnf-eps-upper-y)
+                                      ebnf-eps-max-height
+                                    (+ ebnf-eps-upper-y
+                                       ebnf-production-vertical-space
+                                       ebnf-eps-max-height))
+              ebnf-eps-max-width  prod-width
+              ebnf-eps-max-height prod-height))
+       )
+      (setq ebnf-eps-prod-width prod-width)
+      (insert-buffer eps-buffer))
+    (setq prod-list (cdr prod-list))))
+
+
+(defun ebnf-generate (ebnf-tree)
+  (let* ((ps-color-p           (and ebnf-color-p (ps-color-device)))
+         (ps-print-color-scale (if ps-color-p
+                                   (float (car (ps-color-values "white")))
+                                 1.0))
+         ps-zebra-stripes ps-line-number ps-razzle-dazzle
+         ps-print-hook
+         ps-print-begin-sheet-hook
+         ps-print-begin-page-hook
+         ps-print-begin-column-hook)
+    (ps-generate (current-buffer) (point-min) (point-max)
+                 'ebnf-generate-postscript)))
+
+
+(defvar ebnf-tree      nil)
+(defvar ebnf-direction "R")
+(defvar ebnf-total     0)
+(defvar ebnf-nprod     0)
+
+
+(defun ebnf-generate-postscript (from to)
+  (ebnf-begin-file)
+  (if ebnf-horizontal-max-height
+      (ebnf-generate-with-max-height)
+    (ebnf-generate-without-max-height))
+  (message " "))
+
+
+(defun ebnf-generate-with-max-height ()
+  (let ((ebnf-total (length ebnf-tree))
+        (ebnf-nprod 0)
+        next-line max-height prod the-width)
+    (while ebnf-tree
+      ;; find next line point
+      (setq next-line  ebnf-tree
+            prod       (car ebnf-tree)
+            max-height (ebnf-node-height prod))
+      (ebnf-begin-line prod (ebnf-max-width prod))
+      (while (and (setq next-line (cdr next-line))
+                  (setq prod      (car next-line))
+                  (memq (ebnf-node-action prod) ebnf-action-list)
+                  (setq the-width (ebnf-max-width prod))
+                  (<= the-width ps-width-remaining))
+        (setq max-height         (max max-height (ebnf-node-height prod))
+              ps-width-remaining (- ps-width-remaining
+                                    (+ the-width
+                                       ebnf-production-horizontal-space))))
+      ;; generate current line
+      (ebnf-newline max-height)
+      (setq prod (car ebnf-tree))
+      (ebnf-generate-production prod)
+      (while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line))
+        (ebnf-eop-horizontal (ebnf-max-width prod))
+        (setq prod (car ebnf-tree))
+        (ebnf-generate-production prod))
+      (ebnf-eop-vertical max-height))))
+
+
+(defun ebnf-generate-without-max-height ()
+  (let ((ebnf-total (length ebnf-tree))
+        (ebnf-nprod 0)
+        max-height prod bef-width cur-width)
+    (while ebnf-tree
+      ;; generate current line
+      (setq prod       (car ebnf-tree)
+            max-height (ebnf-node-height prod)
+            bef-width  (ebnf-max-width prod))
+      (ebnf-begin-line prod bef-width)
+      (ebnf-generate-production prod)
+      (while (and (setq ebnf-tree (cdr ebnf-tree))
+                  (setq prod      (car ebnf-tree))
+                  (memq (ebnf-node-action prod) ebnf-action-list)
+                  (setq cur-width (ebnf-max-width prod))
+                  (<= cur-width ps-width-remaining)
+                  (<= (ebnf-node-height prod) ps-height-remaining))
+        (ebnf-eop-horizontal bef-width)
+        (ebnf-generate-production prod)
+        (setq bef-width          cur-width
+              max-height         (max max-height (ebnf-node-height prod))
+              ps-width-remaining (- ps-width-remaining
+                                    (+ cur-width
+                                       ebnf-production-horizontal-space))))
+      (ebnf-eop-vertical max-height)
+      ;; prepare next line
+      (ebnf-newline max-height))))
+
+
+(defun ebnf-begin-line (prod width)
+  (and (or (eq (ebnf-node-action prod) 'form-feed)
+           (> (ebnf-node-height prod) ps-height-remaining))
+       (ebnf-new-page))
+  (setq ps-width-remaining (- ps-width-remaining
+                              (+ width
+                                 ebnf-production-horizontal-space))))
+
+
+(defun ebnf-newline (height)
+  (and (> height ps-height-remaining)
+       (ebnf-new-page))
+  (setq ps-width-remaining  ps-print-width
+        ps-height-remaining (- ps-height-remaining
+                               (+ height
+                                  ebnf-production-vertical-space))))
+
+
+;; [production width-fun dim-fun entry height width name production action]
+(defun ebnf-generate-production (production)
+  (ebnf-message-info "Generating")
+  (run-hooks 'ebnf-production-hook)
+  (ps-output-string (ebnf-node-name production))
+  (ps-output " "
+             (ebnf-format-float
+              (ebnf-node-width production)
+              (+ ebnf-basic-height
+                 (ebnf-node-entry (ebnf-node-production production))))
+             " BOP\n")
+  (ebnf-node-generation (ebnf-node-production production))
+  (ps-output "EOS\n"))
+
+
+;; [alternative width-fun dim-fun entry height width list]
+(defun ebnf-generate-alternative (alternative)
+  (let ((alt   (ebnf-node-list alternative))
+        (entry (ebnf-node-entry alternative))
+        (nlist 0)
+        alt-height alt-entry)
+    (while alt
+      (ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt))))
+                 " ")
+      (setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space)
+            nlist (1+ nlist)
+            alt   (cdr alt)))
+    (ps-output (format "%d " nlist)
+               (ebnf-format-float (ebnf-node-width alternative))
+               " AT\n")
+    (setq alt (ebnf-node-list alternative))
+    (when alt
+      (ebnf-node-generation (car alt))
+      (setq alt-height (- (ebnf-node-height (car alt))
+                          (ebnf-node-entry (car alt)))))
+    (while (setq alt (cdr alt))
+      (setq alt-entry (ebnf-node-entry (car alt)))
+      (ebnf-vertical-movement
+       (- (+ alt-height ebnf-vertical-space alt-entry)))
+      (ebnf-node-generation (car alt))
+      (setq alt-height (- (ebnf-node-height (car alt)) alt-entry))))
+  (ps-output "EOS\n"))
+
+
+;; [sequence width-fun dim-fun entry height width list]
+(defun ebnf-generate-sequence (sequence)
+  (ps-output "BOS\n")
+  (let ((seq (ebnf-node-list sequence))
+        seq-width)
+    (when seq
+      (ebnf-node-generation (car seq))
+      (setq seq-width (ebnf-node-width (car seq))))
+    (while (setq seq (cdr seq))
+      (ebnf-horizontal-movement seq-width)
+      (ebnf-node-generation (car seq))
+      (setq seq-width (ebnf-node-width (car seq)))))
+  (ps-output "EOS\n"))
+
+
+;; [terminal width-fun dim-fun entry height width name]
+(defun ebnf-generate-terminal (terminal)
+  (ebnf-gen-terminal terminal "T"))
+
+
+;; [non-terminal width-fun dim-fun entry height width name]
+(defun ebnf-generate-non-terminal (non-terminal)
+  (ebnf-gen-terminal non-terminal "NT"))
+
+
+;; [empty width-fun dim-fun entry height width]
+(defun ebnf-generate-empty (empty)
+  (ebnf-empty-alternative (ebnf-node-width empty)))
+
+
+;; [optional width-fun dim-fun entry height width element]
+(defun ebnf-generate-optional (optional)
+  (let ((the-optional (ebnf-node-list optional)))
+    (ps-output (ebnf-format-float
+                (+ (- (ebnf-node-height the-optional)
+                      (ebnf-node-entry optional))
+                   ebnf-vertical-space)
+                (ebnf-node-width optional))
+               " OP\n")
+    (ebnf-node-generation the-optional)
+    (ps-output "EOS\n")))
+
+
+;; [one-or-more width-fun dim-fun entry height width element separator]
+(defun ebnf-generate-one-or-more (one-or-more)
+  (let* ((width (ebnf-node-width one-or-more))
+         (sep   (ebnf-node-separator one-or-more))
+         (entry (- (ebnf-node-entry one-or-more)
+                   (if sep
+                       (ebnf-node-entry sep)
+                     0))))
+    (ps-output (ebnf-format-float entry width)
+               " OM\n")
+    (ebnf-node-generation (ebnf-node-list one-or-more))
+    (ebnf-vertical-movement entry)
+    (if sep
+        (let ((ebnf-direction "L"))
+          (ebnf-node-generation sep))
+      (ebnf-empty-alternative (- width ebnf-horizontal-space))))
+  (ps-output "EOS\n"))
+
+
+;; [zero-or-more width-fun dim-fun entry height width element separator]
+(defun ebnf-generate-zero-or-more (zero-or-more)
+  (let* ((width      (ebnf-node-width zero-or-more))
+         (node-list  (ebnf-node-list zero-or-more))
+         (list-entry (ebnf-node-entry node-list))
+         (node-sep   (ebnf-node-separator zero-or-more))
+         (entry      (+ list-entry
+                        ebnf-vertical-space
+                        (if node-sep
+                            (- (ebnf-node-height node-sep)
+                               (ebnf-node-entry node-sep))
+                          0))))
+    (ps-output (ebnf-format-float entry
+                                  (+ (- (ebnf-node-height node-list)
+                                        list-entry)
+                                     ebnf-vertical-space)
+                                  width)
+               " ZM\n")
+    (ebnf-node-generation (ebnf-node-list zero-or-more))
+    (ebnf-vertical-movement entry)
+    (if (ebnf-node-separator zero-or-more)
+        (let ((ebnf-direction "L"))
+          (ebnf-node-generation (ebnf-node-separator zero-or-more)))
+      (ebnf-empty-alternative (- width ebnf-horizontal-space))))
+  (ps-output "EOS\n"))
+
+
+;; [special width-fun dim-fun entry height width name]
+(defun ebnf-generate-special (special)
+  (ebnf-gen-terminal special "SP"))
+
+
+;; [repeat width-fun dim-fun entry height width times element]
+(defun ebnf-generate-repeat (repeat)
+  (let ((times   (ebnf-node-name repeat))
+        (element (ebnf-node-separator repeat)))
+    (ps-output-string times)
+    (ps-output " "
+               (ebnf-format-float
+                (ebnf-node-entry repeat)
+                (ebnf-node-height repeat)
+                (ebnf-node-width repeat)
+                (if element
+                    (+ (ebnf-node-width element)
+                       ebnf-space-R ebnf-space-R ebnf-space-R
+                       (* (length times) ebnf-font-width-R))
+                  0.0))
+               " " ebnf-direction "RP\n")
+    (and element
+         (ebnf-node-generation element)))
+  (ps-output "EOS\n"))
+
+
+;; [except width-fun dim-fun entry height width element element]
+(defun ebnf-generate-except (except)
+  (let* ((element   (ebnf-node-list except))
+         (exception (ebnf-node-separator except))
+         (width     (ebnf-node-width element)))
+    (ps-output (ebnf-format-float
+                width
+                (ebnf-node-entry except)
+                (ebnf-node-height except)
+                (ebnf-node-width except)
+                (+ width
+                   ebnf-space-E ebnf-space-E ebnf-space-E
+                   ebnf-font-width-E
+                   (if exception
+                       (+ (ebnf-node-width exception) ebnf-space-E)
+                     0.0)))
+               " " ebnf-direction "EX\n")
+    (ebnf-node-generation (ebnf-node-list except))
+    (when exception
+      (ebnf-horizontal-movement (+ width ebnf-space-E
+                                   ebnf-font-width-E ebnf-space-E))
+      (ebnf-node-generation exception)))
+  (ps-output "EOS\n"))
+
+
+(defun ebnf-gen-terminal (node code)
+  (ps-output-string (ebnf-node-name node))
+  (ps-output " " (ebnf-format-float (ebnf-node-width node))
+             " " ebnf-direction code
+             (if (ebnf-node-default node)
+                 "D\n"
+               "\n")))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal functions
+
+
+(defvar ebnf-map-name
+  (let ((map (make-vector 256 ?\_)))
+    (mapcar #'(lambda (char)
+                (aset map char char))
+            (concat "#$%&+-.0123456789=?@~"
+                    "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+                    "abcdefghijklmnopqrstuvwxyz"))
+    map))
+
+
+(defun ebnf-eps-filename (str)
+  (let* ((len  (length str))
+         (stri 0)
+         (new  (make-string len ?\ )))
+    (while (< stri len)
+      (aset new stri (aref ebnf-map-name (aref str stri)))
+      (setq stri (1+ stri)))
+    (concat ebnf-eps-prefix new ".eps")))
+
+
+(defun ebnf-eps-output (&rest args)
+  (while args
+    (insert (car args))
+    (setq args (cdr args))))
+
+
+(defun ebnf-generate-region (from to gen-func)
+  (run-hooks 'ebnf-hook)
+  (let ((ebnf-limit (max from to))
+        the-point)
+    (save-excursion
+      (save-restriction
+        (save-match-data
+          (condition-case data
+              (let ((tree (ebnf-parse-and-sort (min from to))))
+                (when gen-func
+                  (funcall gen-func
+                           (ebnf-dimensions
+                            (ebnf-optimize
+                             (ebnf-eliminate-empty-rules tree))))))
+            ;; handler
+            ((quit error)
+             (ding)
+             (setq the-point (max (1- (point)) (point-min)))
+             (message (error-message-string data)))))))
+    (cond
+     (the-point
+      (goto-char the-point))
+     (gen-func
+      nil)
+     (t
+      (message "EBNF syntatic analysis: NO ERRORS.")))))
+
+
+(defun ebnf-parse-and-sort (start)
+  (ebnf-begin-job)
+  (let ((tree (funcall ebnf-parser-func start)))
+    (if ebnf-sort-production
+        (progn
+          (message "Sorting...")
+          (sort tree
+                (if (eq ebnf-sort-production 'ascending)
+                    'ebnf-sorter-ascending
+                  'ebnf-sorter-descending)))
+      (nreverse tree))))
+
+
+(defun ebnf-sorter-ascending (first second)
+  (string< (ebnf-node-name first)
+           (ebnf-node-name second)))
+
+
+(defun ebnf-sorter-descending (first second)
+  (string< (ebnf-node-name second)
+           (ebnf-node-name first)))
+
+
+(defun ebnf-empty-alternative (width)
+  (ps-output (ebnf-format-float width) " EA\n"))
+
+
+(defun ebnf-vertical-movement (height)
+  (ps-output (ebnf-format-float height) " vm\n"))
+
+
+(defun ebnf-horizontal-movement (width)
+  (ps-output (ebnf-format-float width) " hm\n"))
+
+
+(defun ebnf-entry (height)
+  (* height ebnf-entry-percentage))
+
+
+(defun ebnf-eop-vertical (height)
+  (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space))
+             " EOPV\n\n"))
+
+
+(defun ebnf-eop-horizontal (width)
+  (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space))
+             " EOPH\n\n"))
+
+
+(defun ebnf-new-page ()
+  (when (< ps-height-remaining ps-print-height)
+    (run-hooks 'ebnf-page-hook)
+    (ps-next-page)
+    (ps-output "\n")))
+
+
+(defsubst ebnf-font-size (font) (nth 0 font))
+(defsubst ebnf-font-name (font) (nth 1 font))
+(defsubst ebnf-font-foreground (font) (nth 2 font))
+(defsubst ebnf-font-background (font) (nth 3 font))
+(defsubst ebnf-font-list (font) (nthcdr 4 font))
+(defsubst ebnf-font-attributes (font)
+  (lsh (ps-extension-bit (cdr font)) -2))
+
+
+(defconst ebnf-font-name-select
+  (vector 'normal 'bold 'italic 'bold-italic))
+
+
+(defun ebnf-font-name-select (font)
+  (let* ((font-list  (ebnf-font-list font))
+         (font-index (+ (if (memq 'bold   font-list) 1 0)
+                        (if (memq 'italic font-list) 2 0)))
+         (name       (ebnf-font-name font))
+         (database   (cdr (assoc name ps-font-info-database)))
+         (info-list  (or (cdr (assoc 'fonts database))
+                         (error "Invalid font: %s" name))))
+    (or (cdr (assoc (aref ebnf-font-name-select font-index)
+                    info-list))
+        (error "Invalid attributes for font %s" name))))
+
+
+(defun ebnf-font-select (font select)
+  (let* ((name     (ebnf-font-name font))
+         (database (cdr (assoc name ps-font-info-database)))
+         (size     (cdr (assoc 'size database)))
+         (base     (cdr (assoc select database))))
+    (if (and size base)
+        (/ (* (ebnf-font-size font) base)
+           size)
+      (error "Invalid font: %s" name))))
+
+
+(defsubst ebnf-font-width (font)
+  (ebnf-font-select font 'avg-char-width))
+(defsubst ebnf-font-height (font)
+  (ebnf-font-select font 'line-height))
+
+
+(defun ebnf-begin-job ()
+  (ps-printing-region nil)
+  (if ebnf-use-float-format
+      (setq ebnf-format-float  "%1.3f"
+            ebnf-message-float "%3.2f")
+    (setq ebnf-format-float  "%s"
+          ebnf-message-float "%s"))
+  (ebnf-otz-initialize)
+  ;; to avoid compilation gripes when calling autoloaded functions
+  (funcall (cond ((eq ebnf-syntax 'iso-ebnf)
+                  (setq ebnf-parser-func 'ebnf-iso-parser)
+                  'ebnf-iso-initialize)
+                 ((eq ebnf-syntax 'yacc)
+                  (setq ebnf-parser-func 'ebnf-yac-parser)
+                  'ebnf-yac-initialize)
+                 (t
+                  (setq ebnf-parser-func 'ebnf-bnf-parser)
+                  'ebnf-bnf-initialize)))
+  (and ebnf-terminal-regexp             ; ensures that it's a string or nil
+       (not (stringp ebnf-terminal-regexp))
+       (setq ebnf-terminal-regexp nil))
+  (or (and ebnf-eps-prefix              ; ensures that it's a string
+           (stringp ebnf-eps-prefix))
+      (setq ebnf-eps-prefix "ebnf--"))
+  (setq ebnf-entry-percentage           ; ensures value between 0.0 and 1.0
+        (min (max ebnf-entry-percentage 0.0) 1.0)
+        ebnf-action-list         (if ebnf-horizontal-orientation
+                                     '(nil keep-line)
+                                   '(keep-line))
+        ebnf-settings            nil
+        ebnf-fonts-required      nil
+        ebnf-action              nil
+        ebnf-default-p           nil
+        ebnf-eps-context         nil
+        ebnf-eps-production-list nil
+        ebnf-eps-upper-x         0.0
+        ebnf-eps-upper-y         0.0
+        ebnf-font-height-P       (ebnf-font-height ebnf-production-font)
+        ebnf-font-height-T       (ebnf-font-height ebnf-terminal-font)
+        ebnf-font-height-NT      (ebnf-font-height ebnf-non-terminal-font)
+        ebnf-font-height-S       (ebnf-font-height ebnf-special-font)
+        ebnf-font-height-E       (ebnf-font-height ebnf-except-font)
+        ebnf-font-height-R       (ebnf-font-height ebnf-repeat-font)
+        ebnf-font-width-P        (ebnf-font-width ebnf-production-font)
+        ebnf-font-width-T        (ebnf-font-width ebnf-terminal-font)
+        ebnf-font-width-NT       (ebnf-font-width ebnf-non-terminal-font)
+        ebnf-font-width-S        (ebnf-font-width ebnf-special-font)
+        ebnf-font-width-E        (ebnf-font-width ebnf-except-font)
+        ebnf-font-width-R        (ebnf-font-width ebnf-repeat-font)
+        ebnf-space-T             (* ebnf-font-height-T 0.5)
+        ebnf-space-NT            (* ebnf-font-height-NT 0.5)
+        ebnf-space-S             (* ebnf-font-height-S 0.5)
+        ebnf-space-E             (* ebnf-font-height-E 0.5)
+        ebnf-space-R             (* ebnf-font-height-R 0.5))
+  (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT)))
+    (setq ebnf-basic-width      (* basic 0.5)
+          ebnf-horizontal-space (+ basic basic)
+          ebnf-basic-height     ebnf-basic-width
+          ebnf-vertical-space   ebnf-basic-width)
+    ;; ensures value is greater than zero
+    (or (and (numberp ebnf-production-horizontal-space)
+             (> ebnf-production-horizontal-space 0.0))
+        (setq ebnf-production-horizontal-space basic))
+    ;; ensures value is greater than zero
+    (or (and (numberp ebnf-production-vertical-space)
+             (> ebnf-production-vertical-space 0.0))
+        (setq ebnf-production-vertical-space basic))))
+
+
+(defsubst ebnf-shape-value (sym alist)
+  (or (cdr (assq sym alist)) 0))
+
+
+(defsubst ebnf-boolean (value)
+  (if value "true" "false"))
+
+
+(defun ebnf-begin-file ()
+  (ps-flush-output)
+  (save-excursion
+    (set-buffer ps-spool-buffer)
+    (goto-char (point-min))
+    (and (search-forward "%%Creator: " nil t)
+         (not (search-forward "& ebnf2ps v"
+                              (save-excursion (end-of-line) (point))
+                              t))
+         (progn
+           ;; adjust creator comment
+           (end-of-line)
+           (backward-char)
+           (insert " & ebnf2ps v" ebnf-version)
+           ;; insert ebnf settings & engine
+           (goto-char (point-max))
+           (search-backward "\n%%EndPrologue\n")
+           (ebnf-insert-ebnf-prologue)
+           (ps-output "\n")))))
+
+
+(defun ebnf-eps-finish-and-write (buffer filename)
+  (save-excursion
+    (set-buffer buffer)
+    (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
+          ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
+                               ebnf-eps-max-height
+                             (+ ebnf-eps-upper-y
+                                ebnf-production-vertical-space
+                                ebnf-eps-max-height)))
+    ;; prologue
+    (goto-char (point-min))
+    (insert
+     "%!PS-Adobe-3.0 EPSF-3.0"
+     "\n%%BoundingBox: 0 0 "
+     (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
+     "\n%%Title: " filename
+     "\n%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
+     "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
+     "\n%%DocumentNeededResources: font "
+     (or ebnf-fonts-required
+         (setq ebnf-fonts-required
+               (let ((fonts (ps-remove-duplicates
+                             (mapcar 'ebnf-font-name-select
+                                     (list ebnf-production-font
+                                           ebnf-terminal-font
+                                           ebnf-non-terminal-font
+                                           ebnf-special-font
+                                           ebnf-except-font
+                                           ebnf-repeat-font)))))
+                 (concat (car fonts)
+                         (and (cdr fonts) "\n%%+ font ")
+                         (mapconcat 'identity (cdr fonts) "\n%%+ font ")))))
+     "\n%%Pages: 0\n%%EndComments\n\n%%BeginPrologue\n"
+     ebnf-eps-prologue)
+    (ebnf-insert-ebnf-prologue)
+    (insert ebnf-eps-begin
+            "\n0 " (ebnf-format-float
+                    (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7)))
+            " #ebnf2ps#begin\n")
+    ;; epilogue
+    (goto-char (point-max))
+    (insert ebnf-eps-end)
+    ;; write file
+    (message "Saving...")
+    (setq filename (expand-file-name filename))
+    (let ((coding-system-for-write 'raw-text-unix))
+      (write-region (point-min) (point-max) filename))
+    (message "Wrote %s" filename)))
+
+
+(defun ebnf-insert-ebnf-prologue ()
+  (insert
+   (or ebnf-settings
+       (setq ebnf-settings
+             (concat
+              "\n\n% === begin EBNF settings\n\n"
+              ;; production
+              (format "/fP            %s /%s DefFont\n"
+                      (ebnf-format-float (ebnf-font-size ebnf-production-font))
+                      (ebnf-font-name-select ebnf-production-font))
+              (ebnf-format-color "/ForegroundP   %s def %% %s\n"
+                                 (ebnf-font-foreground ebnf-production-font)
+                                 "Black")
+              (ebnf-format-color "/BackgroundP   %s def %% %s\n"
+                                 (ebnf-font-background ebnf-production-font)
+                                 "White")
+              (format "/EffectP       %d def\n"
+                      (ebnf-font-attributes ebnf-production-font))
+              ;; terminal
+              (format "/fT            %s /%s DefFont\n"
+                      (ebnf-format-float (ebnf-font-size ebnf-terminal-font))
+                      (ebnf-font-name-select ebnf-terminal-font))
+              (ebnf-format-color "/ForegroundT   %s def %% %s\n"
+                                 (ebnf-font-foreground ebnf-terminal-font)
+                                 "Black")
+              (ebnf-format-color "/BackgroundT   %s def %% %s\n"
+                                 (ebnf-font-background ebnf-terminal-font)
+                                 "White")
+              (format "/EffectT       %d def\n"
+                      (ebnf-font-attributes ebnf-terminal-font))
+              (format "/BorderWidthT  %s def\n"
+                      (ebnf-format-float ebnf-terminal-border-width))
+              (ebnf-format-color "/BorderColorT  %s def %% %s\n"
+                                 ebnf-terminal-border-color
+                                 "Black")
+              (format "/ShapeT        %d def\n"
+                      (ebnf-shape-value ebnf-terminal-shape
+                                        ebnf-terminal-shape-alist))
+              (format "/ShadowT       %s def\n"
+                      (ebnf-boolean ebnf-terminal-shadow))
+              ;; non-terminal
+              (format "/fNT           %s /%s DefFont\n"
+                      (ebnf-format-float
+                       (ebnf-font-size ebnf-non-terminal-font))
+                      (ebnf-font-name-select ebnf-non-terminal-font))
+              (ebnf-format-color "/ForegroundNT  %s def %% %s\n"
+                                 (ebnf-font-foreground ebnf-non-terminal-font)
+                                 "Black")
+              (ebnf-format-color "/BackgroundNT  %s def %% %s\n"
+                                 (ebnf-font-background ebnf-non-terminal-font)
+                                 "White")
+              (format "/EffectNT      %d def\n"
+                      (ebnf-font-attributes ebnf-non-terminal-font))
+              (format "/BorderWidthNT %s def\n"
+                      (ebnf-format-float ebnf-non-terminal-border-width))
+              (ebnf-format-color "/BorderColorNT %s def %% %s\n"
+                                 ebnf-non-terminal-border-color
+                                 "Black")
+              (format "/ShapeNT       %d def\n"
+                      (ebnf-shape-value ebnf-non-terminal-shape
+                                        ebnf-terminal-shape-alist))
+              (format "/ShadowNT      %s def\n"
+                      (ebnf-boolean ebnf-non-terminal-shadow))
+              ;; special
+              (format "/fS            %s /%s DefFont\n"
+                      (ebnf-format-float (ebnf-font-size ebnf-special-font))
+                      (ebnf-font-name-select ebnf-special-font))
+              (ebnf-format-color "/ForegroundS   %s def %% %s\n"
+                                 (ebnf-font-foreground ebnf-special-font)
+                                 "Black")
+              (ebnf-format-color "/BackgroundS   %s def %% %s\n"
+                                 (ebnf-font-background ebnf-special-font)
+                                 "Gray95")
+              (format "/EffectS       %d def\n"
+                      (ebnf-font-attributes ebnf-special-font))
+              (format "/BorderWidthS  %s def\n"
+                      (ebnf-format-float ebnf-special-border-width))
+              (ebnf-format-color "/BorderColorS  %s def %% %s\n"
+                                 ebnf-special-border-color
+                                 "Black")
+              (format "/ShapeS        %d def\n"
+                      (ebnf-shape-value ebnf-special-shape
+                                        ebnf-terminal-shape-alist))
+              (format "/ShadowS       %s def\n"
+                      (ebnf-boolean ebnf-special-shadow))
+              ;; except
+              (format "/fE            %s /%s DefFont\n"
+                      (ebnf-format-float (ebnf-font-size ebnf-except-font))
+                      (ebnf-font-name-select ebnf-except-font))
+              (ebnf-format-color "/ForegroundE   %s def %% %s\n"
+                                 (ebnf-font-foreground ebnf-except-font)
+                                 "Black")
+              (ebnf-format-color "/BackgroundE   %s def %% %s\n"
+                                 (ebnf-font-background ebnf-except-font)
+                                 "Gray90")
+              (format "/EffectE       %d def\n"
+                      (ebnf-font-attributes ebnf-except-font))
+              (format "/BorderWidthE  %s def\n"
+                      (ebnf-format-float ebnf-except-border-width))
+              (ebnf-format-color "/BorderColorE  %s def %% %s\n"
+                                 ebnf-except-border-color
+                                 "Black")
+              (format "/ShapeE        %d def\n"
+                      (ebnf-shape-value ebnf-except-shape
+                                        ebnf-terminal-shape-alist))
+              (format "/ShadowE       %s def\n"
+                      (ebnf-boolean ebnf-except-shadow))
+              ;; repeat
+              (format "/fR            %s /%s DefFont\n"
+                      (ebnf-format-float (ebnf-font-size ebnf-repeat-font))
+                      (ebnf-font-name-select ebnf-repeat-font))
+              (ebnf-format-color "/ForegroundR   %s def %% %s\n"
+                                 (ebnf-font-foreground ebnf-repeat-font)
+                                 "Black")
+              (ebnf-format-color "/BackgroundR   %s def %% %s\n"
+                                 (ebnf-font-background ebnf-repeat-font)
+                                 "Gray85")
+              (format "/EffectR       %d def\n"
+                      (ebnf-font-attributes ebnf-repeat-font))
+              (format "/BorderWidthR  %s def\n"
+                      (ebnf-format-float ebnf-repeat-border-width))
+              (ebnf-format-color "/BorderColorR  %s def %% %s\n"
+                                 ebnf-repeat-border-color
+                                 "Black")
+              (format "/ShapeR        %d def\n"
+                      (ebnf-shape-value ebnf-repeat-shape
+                                        ebnf-terminal-shape-alist))
+              (format "/ShadowR       %s def\n"
+                      (ebnf-boolean ebnf-repeat-shadow))
+              ;; miscellaneous
+              (format "/DefaultWidth  %s def\n"
+                      (ebnf-format-float ebnf-default-width))
+              (format "/LineWidth     %s def\n"
+                      (ebnf-format-float ebnf-line-width))
+              (ebnf-format-color "/LineColor     %s def %% %s\n"
+                                 ebnf-line-color
+                                 "Black")
+              (format "/ArrowShape    %d def\n"
+                      (ebnf-shape-value ebnf-arrow-shape
+                                        ebnf-arrow-shape-alist))
+              (format "/ChartShape    %d def\n"
+                      (ebnf-shape-value ebnf-chart-shape
+                                        ebnf-terminal-shape-alist))
+              (format "/UserArrow{%s}def\n"
+                      (ebnf-user-arrow ebnf-user-arrow))
+              "\n% === end   EBNF settings\n\n"
+              (and ebnf-debug-ps ebnf-debug))))
+   ebnf-prologue))
+
+
+(defun ebnf-user-arrow (user-arrow)
+  "Return a user arrow shape from USER-ARROW (a PostScript code).
+
+This function is only called when `ebnf-arrow-shape' is set to symbol `user'.
+
+If is a string, should be a PostScript procedure body.
+If is a variable symbol, should contain a string.
+If is a function symbol, it is called and the result is applied recursively.
+If is a cons and car is a function symbol, it is called as:
+   (funcall (car cons) (cdr cons))
+and the result is applied recursively.
+If is a cons and car is not a function symbol, it is applied recursively on
+car and cdr, and the results are concatened as:
+   (concat RESULT-FROM-CAR \" \" RESULT-FROM-CDR)
+If is a list and car is a function symbol, it is called as:
+   (apply (car list) (cdr list))
+and the result is applied recursively.
+If is a list and car is not a function symbol, it is applied recursively on
+each element and the resulting list is concatened as:
+   (mapconcat 'identity RESULTING-LIST \" \")
+Otherwise, it is treated as an empty string."
+  (cond
+   ((null user-arrow)
+    "")
+   ((stringp user-arrow)
+    user-arrow)
+   ((and (symbolp user-arrow) (fboundp user-arrow))
+    (ebnf-user-arrow (funcall user-arrow)))
+   ((and (symbolp user-arrow) (boundp user-arrow))
+    (ebnf-user-arrow (symbol-value user-arrow)))
+   ((consp user-arrow)
+    (if (and (symbolp (car user-arrow)) (fboundp (car user-arrow)))
+        (ebnf-user-arrow (funcall (car user-arrow) (cdr user-arrow)))
+      (concat (ebnf-user-arrow (car user-arrow))
+              " "
+              (ebnf-user-arrow (cdr user-arrow)))))
+   ((listp user-arrow)
+    (if (and (symbolp (car user-arrow))
+             (fboundp (car user-arrow)))
+        (ebnf-user-arrow (apply (car user-arrow) (cdr user-arrow)))
+      (mapconcat 'ebnf-user-arrow user-arrow " ")))
+   (t
+    "")
+   ))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Adjusting dimensions
+
+
+(defun ebnf-dimensions (tree)
+  (let ((ebnf-total (length tree))
+        (ebnf-nprod 0))
+    (mapcar 'ebnf-production-dimension tree))
+  tree)
+
+
+;; [empty width-fun dim-fun entry height width]
+;;(defun ebnf-empty-dimension (empty)
+;;  )
+
+
+;; [production width-fun dim-fun entry height width name production action]
+(defun ebnf-production-dimension (production)
+  (ebnf-message-info "Calculating dimensions")
+  (ebnf-node-dimension-func (ebnf-node-production production))
+  (let* ((prod   (ebnf-node-production production))
+         (height (+ ebnf-font-height-P
+                    ebnf-basic-height
+                    (ebnf-node-height prod))))
+    (ebnf-node-entry  production height)
+    (ebnf-node-height production height)
+    (ebnf-node-width  production (+ (ebnf-node-width prod)
+                                    ebnf-horizontal-space))))
+
+
+;; [terminal width-fun dim-fun entry height width name]
+(defun ebnf-terminal-dimension (terminal)
+  (ebnf-terminal-dimension1 terminal
+                            ebnf-font-height-T
+                            ebnf-font-width-T
+                            ebnf-space-T))
+
+
+;; [non-terminal width-fun dim-fun entry height width name]
+(defun ebnf-non-terminal-dimension (non-terminal)
+  (ebnf-terminal-dimension1 non-terminal
+                            ebnf-font-height-NT
+                            ebnf-font-width-NT
+                            ebnf-space-NT))
+
+
+;; [special width-fun dim-fun entry height width name]
+(defun ebnf-special-dimension (special)
+  (ebnf-terminal-dimension1 special
+                            ebnf-font-height-S
+                            ebnf-font-width-S
+                            ebnf-space-S))
+
+
+(defun ebnf-terminal-dimension1 (node font-height font-width space)
+  (let ((height (+ space font-height space))
+        (len    (length (ebnf-node-name node))))
+    (ebnf-node-entry  node (* height 0.5))
+    (ebnf-node-height node height)
+    (ebnf-node-width  node (+ ebnf-basic-width space
+                              (* len font-width)
+                              space ebnf-basic-width))))
+
+
+(defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
+
+
+;; [repeat width-fun dim-fun entry height width times element]
+(defun ebnf-repeat-dimension (repeat)
+  (let ((times   (ebnf-node-name repeat))
+        (element (ebnf-node-separator repeat)))
+    (if element
+        (ebnf-node-dimension-func element)
+      (setq element ebnf-null-vector))
+    (ebnf-node-entry  repeat (+ (ebnf-node-entry element)
+                                ebnf-space-R))
+    (ebnf-node-height repeat (+ (max (ebnf-node-height element)
+                                     ebnf-font-height-S)
+                                ebnf-space-R ebnf-space-R))
+    (ebnf-node-width  repeat (+ (ebnf-node-width element)
+                                ebnf-space-R ebnf-space-R ebnf-space-R
+                                ebnf-horizontal-space
+                                (* (length times) ebnf-font-width-R)))))
+
+
+;; [except width-fun dim-fun entry height width element element]
+(defun ebnf-except-dimension (except)
+  (let ((factor  (ebnf-node-list except))
+        (element (ebnf-node-separator except)))
+    (ebnf-node-dimension-func factor)
+    (if element
+        (ebnf-node-dimension-func element)
+      (setq element ebnf-null-vector))
+    (ebnf-node-entry  except (+ (max (ebnf-node-entry factor)
+                                     (ebnf-node-entry element))
+                                ebnf-space-E))
+    (ebnf-node-height except (+ (max (ebnf-node-height factor)
+                                     (ebnf-node-height element))
+                                ebnf-space-E ebnf-space-E))
+    (ebnf-node-width  except (+ (ebnf-node-width factor)
+                                (ebnf-node-width element)
+                                ebnf-space-E ebnf-space-E
+                                ebnf-space-E ebnf-space-E
+                                ebnf-font-width-E
+                                ebnf-horizontal-space))))
+
+
+;; [alternative width-fun dim-fun entry height width list]
+(defun ebnf-alternative-dimension (alternative)
+  (let ((body (ebnf-node-list alternative))
+        (lis  (ebnf-node-list alternative)))
+    (while lis
+      (ebnf-node-dimension-func (car lis))
+      (setq lis (cdr lis)))
+    (let ((height 0.0)
+          (width  0.0)
+          (alt    body)
+          (tail   (car (last body)))
+          (entry  (ebnf-node-entry (car body)))
+          node)
+      (while alt
+        (setq node   (car alt)
+              alt    (cdr alt)
+              height (+ (ebnf-node-height node) height)
+              width  (max (ebnf-node-width node) width)))
+      (ebnf-adjust-width body width)
+      (setq height (+ height (* (1- (length body)) ebnf-vertical-space)))
+      (ebnf-node-entry  alternative (+ entry
+                                       (ebnf-entry
+                                        (- height entry
+                                           (- (ebnf-node-height tail)
+                                              (ebnf-node-entry tail))))))
+      (ebnf-node-height alternative height)
+      (ebnf-node-width  alternative (+ width ebnf-horizontal-space))
+      (ebnf-node-list   alternative body))))
+
+
+;; [optional width-fun dim-fun entry height width element]
+(defun ebnf-optional-dimension (optional)
+  (let ((body (ebnf-node-list optional)))
+    (ebnf-node-dimension-func body)
+    (ebnf-node-entry  optional (ebnf-node-entry body))
+    (ebnf-node-height optional (+ (ebnf-node-height body)
+                                  ebnf-vertical-space))
+    (ebnf-node-width  optional (+ (ebnf-node-width body)
+                                  ebnf-horizontal-space))))
+
+
+;; [one-or-more width-fun dim-fun entry height width element separator]
+(defun ebnf-one-or-more-dimension (or-more)
+  (let ((list-part (ebnf-node-list or-more))
+        (sep-part  (ebnf-node-separator or-more)))
+    (ebnf-node-dimension-func list-part)
+    (and sep-part
+         (ebnf-node-dimension-func sep-part))
+    (let ((height (+ (if sep-part
+                         (ebnf-node-height sep-part)
+                       0.0)
+                     ebnf-vertical-space
+                     (ebnf-node-height list-part)))
+          (width  (max (if sep-part
+                           (ebnf-node-width sep-part)
+                         0.0)
+                       (ebnf-node-width list-part))))
+      (when sep-part
+        (ebnf-adjust-width list-part width)
+        (ebnf-adjust-width sep-part width))
+      (ebnf-node-entry  or-more (+ (- height (ebnf-node-height list-part))
+                                   (ebnf-node-entry list-part)))
+      (ebnf-node-height or-more height)
+      (ebnf-node-width  or-more (+ width ebnf-horizontal-space)))))
+
+
+;; [zero-or-more width-fun dim-fun entry height width element separator]
+(defun ebnf-zero-or-more-dimension (or-more)
+  (let ((list-part (ebnf-node-list or-more))
+        (sep-part  (ebnf-node-separator or-more)))
+    (ebnf-node-dimension-func list-part)
+    (and sep-part
+         (ebnf-node-dimension-func sep-part))
+    (let ((height (+ (if sep-part
+                         (ebnf-node-height sep-part)
+                       0.0)
+                     ebnf-vertical-space
+                     (ebnf-node-height list-part)
+                     ebnf-vertical-space))
+          (width  (max (if sep-part
+                           (ebnf-node-width sep-part)
+                         0.0)
+                       (ebnf-node-width list-part))))
+      (when sep-part
+        (ebnf-adjust-width list-part width)
+        (ebnf-adjust-width sep-part width))
+      (ebnf-node-entry  or-more height)
+      (ebnf-node-height or-more height)
+      (ebnf-node-width  or-more (+ width ebnf-horizontal-space)))))
+
+
+;; [sequence width-fun dim-fun entry height width list]
+(defun ebnf-sequence-dimension (sequence)
+  (let ((above 0.0)
+        (below 0.0)
+        (width 0.0)
+        (lis   (ebnf-node-list sequence))
+        entry node)
+    (while lis
+      (setq node (car lis)
+            lis  (cdr lis))
+      (ebnf-node-dimension-func node)
+      (setq entry (ebnf-node-entry node)
+            above (max above entry)
+            below (max below (- (ebnf-node-height node) entry))
+            width (+ width (ebnf-node-width node))))
+    (ebnf-node-entry  sequence above)
+    (ebnf-node-height sequence (+ above below))
+    (ebnf-node-width  sequence width)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Adjusting width
+
+
+(defun ebnf-adjust-width (node width)
+  (cond
+   ((listp node)
+    (prog1
+        node
+      (while node
+        (setcar node (ebnf-adjust-width (car node) width))
+        (setq node (cdr node)))))
+   ((vectorp node)
+    (cond
+     ;; nothing to be done
+     ((= width (ebnf-node-width node))
+      node)
+     ;; left justify term
+     ((eq ebnf-justify-sequence 'left)
+      (ebnf-adjust-empty node width nil))
+     ;; right justify terms
+     ((eq ebnf-justify-sequence 'right)
+      (ebnf-adjust-empty node width t))
+     ;; centralize terms
+     (t
+      (ebnf-node-width-func node width)
+      (ebnf-node-width node width)
+      node)
+     ))
+   (t
+    node)
+   ))
+
+
+(defun ebnf-adjust-empty (node width last-p)
+  (if (eq (ebnf-node-kind node) 'ebnf-generate-empty)
+      (progn
+        (ebnf-node-width node width)
+        node)
+    (let ((empty (ebnf-make-empty (- width (ebnf-node-width node)))))
+      (ebnf-make-dup-sequence node
+                              (if last-p
+                                  (list empty node)
+                                (list node empty))))))
+
+
+;; [terminal     width-fun dim-fun entry height width name]
+;; [non-terminal width-fun dim-fun entry height width name]
+;; [empty        width-fun dim-fun entry height width]
+;; [special      width-fun dim-fun entry height width name]
+;; [repeat       width-fun dim-fun entry height width times element]
+;; [except       width-fun dim-fun entry height width element element]
+;;(defun ebnf-terminal-width (terminal width)
+;;  )
+
+
+;; [alternative width-fun dim-fun entry height width list]
+;; [optional    width-fun dim-fun entry height width element]
+(defun ebnf-alternative-width (alternative width)
+  (ebnf-adjust-width (ebnf-node-list alternative)
+                     (- width ebnf-horizontal-space)))
+
+
+;; [one-or-more  width-fun dim-fun entry height width element separator]
+;; [zero-or-more width-fun dim-fun entry height width element separator]
+(defun ebnf-list-width (or-more width)
+  (setq width (- width ebnf-horizontal-space))
+  (ebnf-node-list or-more
+                  (ebnf-justify-list or-more
+                                     (ebnf-node-list or-more)
+                                     width))
+  (ebnf-node-separator or-more
+                       (ebnf-justify-list or-more
+                                          (ebnf-node-separator or-more)
+                                          width)))
+
+
+;; [sequence width-fun dim-fun entry height width list]
+(defun ebnf-sequence-width (sequence width)
+  (ebnf-node-list sequence
+                  (ebnf-justify-list sequence (ebnf-node-list sequence) width)))
+
+
+(defun ebnf-justify-list (node seq width)
+  (let ((seq-width (ebnf-node-width node)))
+    (if (= width seq-width)
+        seq
+      (cond
+       ;; left justify terms
+       ((eq ebnf-justify-sequence 'left)
+        (ebnf-justify node seq seq-width width t))
+       ;; right justify terms
+       ((eq ebnf-justify-sequence 'right)
+        (ebnf-justify node seq seq-width width nil))
+       ;; centralize terms
+       (t
+        (let ((the-width (/ (- width seq-width) (length seq)))
+              (lis seq))
+          (while lis
+            (ebnf-adjust-width (car lis)
+                               (+ (ebnf-node-width (car lis))
+                                  the-width))
+            (setq lis (cdr lis)))
+          seq))
+       ))))
+
+
+(defun ebnf-justify (node seq seq-width width last-p)
+  (let ((term (car (if last-p (last seq) seq))))
+    (cond
+     ;; adjust empty term
+     ((eq (ebnf-node-kind term) 'ebnf-generate-empty)
+      (ebnf-node-width term (+ (- width seq-width)
+                               (ebnf-node-width term)))
+      seq)
+     ;; insert empty at end ==> left justify
+     (last-p
+      (nconc seq
+             (list (ebnf-make-empty (- width seq-width)))))
+     ;; insert empty at beginning ==> right justify
+     (t
+      (cons (ebnf-make-empty (- width seq-width))
+            seq))
+     )))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Functions used by parsers
+
+
+(defun ebnf-eps-add-context (name)
+  (let ((filename (ebnf-eps-filename name)))
+    (if (member filename ebnf-eps-context)
+        (error "Try to open an already opened EPS file: %s" filename)
+      (setq ebnf-eps-context (cons filename ebnf-eps-context)))))
+
+
+(defun ebnf-eps-remove-context (name)
+  (let ((filename (ebnf-eps-filename name)))
+    (if (member filename ebnf-eps-context)
+        (setq ebnf-eps-context (delete filename ebnf-eps-context))
+      (error "Try to close a not opened EPS file: %s" filename))))
+
+
+(defun ebnf-eps-add-production (header)
+  (and ebnf-eps-executing
+       ebnf-eps-context
+       (let ((prod (assoc header ebnf-eps-production-list)))
+         (if prod
+             (setcdr prod (append ebnf-eps-context (cdr prod)))
+           (setq ebnf-eps-production-list
+                 (cons (cons header (ebnf-dup-list ebnf-eps-context))
+                       ebnf-eps-production-list))))))
+
+
+(defun ebnf-dup-list (old)
+  (let (new)
+    (while old
+      (setq new (cons (car old) new)
+            old (cdr old)))
+    (nreverse new)))
+
+
+(defun ebnf-buffer-substring (chars)
+  (buffer-substring-no-properties
+   (point)
+   (progn
+     (skip-chars-forward chars ebnf-limit)
+     (point))))
+
+
+(defun ebnf-string (chars eos-char kind)
+  (forward-char)
+  (buffer-substring-no-properties
+   (point)
+   (progn
+     (skip-chars-forward (concat chars "\240-\377") ebnf-limit)
+     (if (or (eobp) (/= (following-char) eos-char))
+         (error "Illegal %s: missing `%c'." kind eos-char)
+       (forward-char)
+       (1- (point))))))
+
+
+(defun ebnf-get-string ()
+  (forward-char)
+  (buffer-substring-no-properties (point) (ebnf-end-of-string)))
+
+
+(defun ebnf-end-of-string ()
+  (let ((n 1))
+    (while (> (logand n 1) 0)
+      (skip-chars-forward "^\"" ebnf-limit)
+      (setq n (- (skip-chars-backward "\\\\")))
+      (goto-char (+ (point) n 1))))
+  (if (= (preceding-char) ?\")
+      (1- (point))
+    (error "Missing `\"'.")))
+
+
+(defun ebnf-trim-right (str)
+  (let* ((len   (1- (length str)))
+         (index len))
+    (while (and (> index 0) (= (aref str index) ?\ ))
+      (setq index (1- index)))
+    (if (= index len)
+        str
+      (substring str 0 (1+ index)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Vector creation
+
+
+(defun ebnf-make-empty (&optional width)
+  (vector 'ebnf-generate-empty
+          'ignore
+          'ignore
+          0.0
+          0.0
+          (or width ebnf-horizontal-space)))
+
+
+(defun ebnf-make-terminal (name)
+  (ebnf-make-terminal1 name
+                       'ebnf-generate-terminal
+                       'ebnf-terminal-dimension))
+
+
+(defun ebnf-make-non-terminal (name)
+  (ebnf-make-terminal1 name
+                       'ebnf-generate-non-terminal
+                       'ebnf-non-terminal-dimension))
+
+
+(defun ebnf-make-special (name)
+  (ebnf-make-terminal1 name
+                       'ebnf-generate-special
+                       'ebnf-special-dimension))
+
+
+(defun ebnf-make-terminal1 (name gen-func dim-func)
+  (vector gen-func
+          'ignore
+          dim-func
+          0.0
+          0.0
+          0.0
+          (let ((len (length name)))
+            (cond ((> len 2) name)
+                  ((= len 2) (concat " " name))
+                  ((= len 1) (concat " " name " "))
+                  (t         "   ")))
+          ebnf-default-p))
+
+
+(defun ebnf-make-one-or-more (list-part &optional sep-part)
+  (ebnf-make-or-more1 'ebnf-generate-one-or-more
+                      'ebnf-one-or-more-dimension
+                      list-part
+                      sep-part))
+
+
+(defun ebnf-make-zero-or-more (list-part &optional sep-part)
+  (ebnf-make-or-more1 'ebnf-generate-zero-or-more
+                      'ebnf-zero-or-more-dimension
+                      list-part
+                      sep-part))
+
+
+(defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
+  (vector gen-func
+          'ebnf-list-width
+          dim-func
+          0.0
+          0.0
+          0.0
+          (if (listp list-part)
+              (ebnf-make-sequence list-part)
+            list-part)
+          (if (and sep-part (listp sep-part))
+              (ebnf-make-sequence sep-part)
+            sep-part)))
+
+
+(defun ebnf-make-production (name prod action)
+  (vector 'ebnf-generate-production
+          'ignore
+          'ebnf-production-dimension
+          0.0
+          0.0
+          0.0
+          name
+          prod
+          action))
+
+
+(defun ebnf-make-alternative (body)
+  (vector 'ebnf-generate-alternative
+          'ebnf-alternative-width
+          'ebnf-alternative-dimension
+          0.0
+          0.0
+          0.0
+          body))
+
+
+(defun ebnf-make-optional (body)
+  (vector 'ebnf-generate-optional
+          'ebnf-alternative-width
+          'ebnf-optional-dimension
+          0.0
+          0.0
+          0.0
+          body))
+
+
+(defun ebnf-make-except (factor exception)
+  (vector 'ebnf-generate-except
+          'ignore
+          'ebnf-except-dimension
+          0.0
+          0.0
+          0.0
+          factor
+          exception))
+
+
+(defun ebnf-make-repeat (times primary)
+  (vector 'ebnf-generate-repeat
+          'ignore
+          'ebnf-repeat-dimension
+          0.0
+          0.0
+          0.0
+          (concat times " *")
+          primary))
+
+
+(defun ebnf-make-sequence (seq)
+  (vector 'ebnf-generate-sequence
+          'ebnf-sequence-width
+          'ebnf-sequence-dimension
+          0.0
+          0.0
+          0.0
+          seq))
+
+
+(defun ebnf-make-dup-sequence (node seq)
+  (vector 'ebnf-generate-sequence
+          'ebnf-sequence-width
+          'ebnf-sequence-dimension
+           (ebnf-node-entry node)
+           (ebnf-node-height node)
+           (ebnf-node-width node)
+           seq))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Optimizers used by parsers
+
+
+(defun ebnf-token-except (element exception)
+  (cons (prog1
+            (car exception)
+          (setq exception (cdr exception)))
+        (and element                    ; EMPTY - A ==> EMPTY
+             (let ((kind (ebnf-node-kind element)))
+               (cond
+                ;; [ A ]- ==> A
+                ((and (null exception)
+                      (eq kind 'ebnf-generate-optional))
+                 (ebnf-node-list element))
+                ;; { A }- ==> { A }+
+                ((and (null exception)
+                      (eq kind 'ebnf-generate-zero-or-more))
+                 (ebnf-node-kind element 'ebnf-generate-one-or-more)
+                 (ebnf-node-dimension-func element 'ebnf-one-or-more-dimension)
+                 element)
+                ;; ( A | EMPTY )-      ==> A
+                ;; ( A | B | EMPTY )-  ==> A | B
+                ((and (null exception)
+                      (eq kind 'ebnf-generate-alternative)
+                      (eq (ebnf-node-kind (car (last (ebnf-node-list element))))
+                          'ebnf-generate-empty))
+                 (let ((elt (ebnf-node-list element))
+                       bef)
+                   (while (cdr elt)
+                     (setq bef elt
+                           elt (cdr elt)))
+                   (if (null bef)
+                       ;; this should not happen!!?!
+                       (setq element (ebnf-make-empty
+                                      (ebnf-node-width element)))
+                     (setcdr bef nil)
+                     (setq elt (ebnf-node-list element))
+                     (and (= (length elt) 1)
+                          (setq element (car elt))))
+                   element))
+                ;; A - B
+                (t
+                 (ebnf-make-except element exception))
+                )))))
+
+
+(defun ebnf-token-repeat (times repeat)
+  (if (null (cdr repeat))
+      ;; n * EMPTY ==> EMPTY
+      repeat
+    ;; n * term
+    (cons (car repeat)
+          (ebnf-make-repeat times (cdr repeat)))))
+
+
+(defun ebnf-token-optional (body)
+  (let ((kind (ebnf-node-kind body)))
+    (cond
+     ;; [ EMPTY ] ==> EMPTY
+     ((eq kind 'ebnf-generate-empty)
+      nil)
+     ;; [ { A }* ] ==> { A }*
+     ((eq kind 'ebnf-generate-zero-or-more)
+      body)
+     ;; [ { A }+ ] ==> { A }*
+     ((eq kind 'ebnf-generate-one-or-more)
+      (ebnf-node-kind body 'ebnf-generate-zero-or-more)
+      body)
+     ;; [ A | B ] ==> A | B | EMPTY
+     ((eq kind 'ebnf-generate-alternative)
+      (ebnf-node-list body (nconc (ebnf-node-list body)
+                                  (list (ebnf-make-empty))))
+      body)
+     ;; [ A ]
+     (t
+      (ebnf-make-optional body))
+     )))
+
+
+(defun ebnf-token-alternative (body sequence)
+  (if (null body)
+      (if (cdr sequence)
+          sequence
+        (cons (car sequence)
+              (ebnf-make-empty)))
+    (cons (car sequence)
+          (let ((seq (cdr sequence)))
+            (if (and (= (length body) 1) (null seq))
+                (car body)
+              (ebnf-make-alternative (nreverse (if seq
+                                                   (cons seq body)
+                                                 body))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Variables used by parsers
+
+
+(defconst ebnf-comment-table
+  (let ((table (make-vector 256 nil)))
+    ;; Override special comment character:
+    (aset table ?< 'newline)
+    (aset table ?> 'keep-line)
+    table)
+  "Vector used to map characters to a special comment token.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; To make this file smaller, some commands go in a separate file.
+;; But autoload them here to make the separation invisible.
+
+(autoload 'ebnf-bnf-parser            "ebnf-bnf"
+  "EBNF parser.")
+
+(autoload 'ebnf-bnf-initialize        "ebnf-bnf"
+  "Initialize EBNF token table.")
+
+(autoload 'ebnf-iso-parser            "ebnf-iso"
+  "ISO EBNF parser.")
+
+(autoload 'ebnf-iso-initialize        "ebnf-iso"
+  "Initialize ISO EBNF token table.")
+
+(autoload 'ebnf-yac-parser            "ebnf-yac"
+  "Yacc/Bison parser.")
+
+(autoload 'ebnf-yac-initialize        "ebnf-yac"
+  "Initializations for Yacc/Bison parser.")
+
+(autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
+  "Eliminate empty rules.")
+
+(autoload 'ebnf-optimize              "ebnf-otz"
+  "Syntatic chart optimizer.")
+
+(autoload 'ebnf-otz-initialize        "ebnf-otz"
+  "Initialize optimizer.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(provide 'ebnf2ps)
+
+
+;;; ebnf2ps.el ends here