(defconst ebnf-version "4.3"
"ebnf2ps.el, v 4.3 <2006/09/26 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 <viniciusjl@ig.com.br>.
")
(require 'ps-print)
(and (string< ps-print-version "5.2.3")
(error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
(or (fboundp 'assq-delete-all)
(defun assq-delete-all (key alist)
"Delete from ALIST all elements whose car is KEY.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
(let ((tail alist))
(while tail
(if (and (consp (car tail))
(eq (car (car tail)) key))
(setq alist (delq (car tail) alist)))
(setq tail (cdr tail)))
alist)))
(defgroup postscript nil
"PostScript Group."
:tag "PostScript"
:version "20"
:group 'emacs)
(defgroup ebnf2ps nil
"Translate an EBNF to a syntactic chart on PostScript."
:prefix "ebnf-"
:version "20"
:group 'wp
:group 'postscript)
(defgroup ebnf-special nil
"Special customization."
:prefix "ebnf-"
:tag "Special"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-except nil
"Except customization."
:prefix "ebnf-"
:tag "Except"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-repeat nil
"Repeat customization."
:prefix "ebnf-"
:tag "Repeat"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-terminal nil
"Terminal customization."
:prefix "ebnf-"
:tag "Terminal"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-non-terminal nil
"Non-Terminal customization."
:prefix "ebnf-"
:tag "Non-Terminal"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-production nil
"Production customization."
:prefix "ebnf-"
:tag "Production"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-shape nil
"Shapes customization."
:prefix "ebnf-"
:tag "Shape"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-displacement nil
"Displacement customization."
:prefix "ebnf-"
:tag "Displacement"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-syntactic nil
"Syntactic customization."
:prefix "ebnf-"
:tag "Syntactic"
:version "20"
:group 'ebnf2ps)
(defgroup ebnf-optimization nil
"Optimization customization."
:prefix "ebnf-"
:tag "Optimization"
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-horizontal-orientation nil
"*Non-nil means productions are drawn horizontally."
:type 'boolean
:version "20"
: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
:version "20"
:group 'ebnf-displacement)
(defcustom ebnf-production-horizontal-space 0.0 "*Specify horizontal space in points between productions.
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
:version "20"
:group 'ebnf-displacement)
(defcustom ebnf-production-vertical-space 0.0 "*Specify vertical space in points between productions.
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
:version "20"
: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))
:version "20"
:group 'ebnf-displacement)
(defcustom ebnf-special-show-delimiter t
"*Non-nil means special delimiter (character `?') is shown."
:type 'boolean
:version "20"
:group 'ebnf-special)
(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))))
:version "20"
: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))
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-shadow nil
"*Non-nil means special box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-border-width 0.5
"*Specify border width for special box."
:type 'number
:version "20"
:group 'ebnf-special)
(defcustom ebnf-special-border-color "Black"
"*Specify border color for special box."
:type 'string
:version "20"
: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))))
:version "20"
: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))
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-shadow nil
"*Non-nil means except box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-border-width 0.25
"*Specify border width for except box."
:type 'number
:version "20"
:group 'ebnf-except)
(defcustom ebnf-except-border-color "Black"
"*Specify border color for except box."
:type 'string
:version "20"
: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))))
:version "20"
: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))
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-shadow nil
"*Non-nil means repeat box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-border-width 0.0
"*Specify border width for repeat box."
:type 'number
:version "20"
:group 'ebnf-repeat)
(defcustom ebnf-repeat-border-color "Black"
"*Specify border color for repeat box."
:type 'string
:version "20"
: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))))
:version "20"
: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))
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-shadow nil
"*Non-nil means terminal box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-border-width 1.0
"*Specify border width for terminal box."
:type 'number
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-terminal-border-color "Black"
"*Specify border color for terminal box."
:type 'string
:version "20"
:group 'ebnf-terminal)
(defcustom ebnf-production-name-p t
"*Non-nil means production name will be printed."
:type 'boolean
:version "20"
:group 'ebnf-production)
(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))
:version "20"
: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))))
:version "20"
: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))))
:version "20"
: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))
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-shadow nil
"*Non-nil means non-terminal box will have a shadow."
:type 'boolean
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-border-width 1.0
"*Specify border width for non-terminal box."
:type 'number
:version "20"
:group 'ebnf-non-terminal)
(defcustom ebnf-non-terminal-border-color "Black"
"*Specify border color for non-terminal box."
:type 'string
:version "20"
: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*
|*
*
`semi-up-hollow' `semi-up-full'
* *
|* |*
| * |X*
==+==* ==+==*
`semi-down-hollow' `semi-down-full'
==+==* ==+==*
| * |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 semi-up-hollow)
(const semi-down-hollow) (const semi-up-full)
(const semi-down-full) (const user))
:version "20"
: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))
:version "20"
:group 'ebnf-shape)
(defcustom ebnf-user-arrow nil
"*Specify a sexp for user arrow shape (a PostScript code).
When evaluated, the sexp should return nil or a string containing 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'."
:type '(sexp :tag "User Arrow Shape")
:version "20"
:group 'ebnf-shape)
(defcustom ebnf-syntax 'ebnf
"*Specify syntax to be recognized.
Valid values are:
`ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
documentation.
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'.
`abnf' ebnf2ps recognizes the syntax described in the URL:
`http://www.ietf.org/rfc/rfc2234.txt'
(\"Augmented BNF for Syntax Specifications: ABNF\").
`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'.
`ebnfx' ebnf2ps recognizes the syntax described in the URL:
`http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
`dtd' ebnf2ps recognizes the syntax described in the URL:
`http://www.w3.org/TR/2004/REC-xml-20040204/'
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
Any other value is treated as `ebnf'."
:type '(radio :tag "Syntax"
(const ebnf) (const abnf) (const iso-ebnf)
(const yacc) (const ebnfx) (const dtd))
:version "20"
:group 'ebnf-syntactic)
(defcustom ebnf-lex-comment-char ?\ "*Specify the line comment character.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
:version "20"
:group 'ebnf-syntactic)
(defcustom ebnf-lex-eop-char ?.
"*Specify the end of production character.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
:version "20"
:group 'ebnf-syntactic)
(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)
:version "20"
:group 'ebnf-syntactic)
(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
:version "20"
:group 'ebnf-syntactic)
(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
:version "20"
:group 'ebnf-syntactic)
(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
:version "20"
:group 'ebnf-syntactic)
(defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
"*Specify file name suffix that contains EBNF.
See `ebnf-eps-directory' command."
:type 'regexp
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-eps-prefix "ebnf--"
"*Specify EPS prefix file name.
See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
:type 'string
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-entry-percentage 0.5 "*Specify entry height on alternatives.
It must be a float between 0.0 (top) and 1.0 (bottom)."
:type 'number
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-default-width 0.6
"*Specify additional border width over default terminal, non-terminal or
special."
:type 'number
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-color-p (or (fboundp 'x-color-values) (fboundp 'color-instance-rgb-components)) "*Non-nil means use color."
:type 'boolean
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-line-width 1.0
"*Specify flow line width."
:type 'number
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-line-color "Black"
"*Specify flow line color."
:type 'string
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-arrow-extra-width
(if (eq ebnf-arrow-shape 'none)
0.0
(* (sqrt 5.0) 0.65 ebnf-line-width))
"*Specify extra width for arrow shape drawing.
The extra width is used to avoid that the arrowhead and the terminal border
overlap. It depens on `ebnf-arrow-shape' and `ebnf-line-width'."
:type 'number
:version "22"
:group 'ebnf-shape)
(defcustom ebnf-arrow-scale 1.0
"*Specify the arrow scale.
Values lower than 1.0, shrink the arrow.
Values greater than 1.0, expand the arrow."
:type 'number
:version "22"
:group 'ebnf-shape)
(defcustom ebnf-debug-ps nil
"*Non-nil means to generate PostScript debug procedures.
It is intended to help PostScript programmers in debugging."
:type 'boolean
:version "20"
: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
:version "20"
:group 'ebnf2ps)
(defcustom ebnf-stop-on-error nil
"*Non-nil means signal error and stop. Otherwise, signal error and continue."
:type 'boolean
:version "20"
: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
:version "20"
:group 'ebnf-syntactic)
(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
:version "20"
:group 'ebnf-optimization)
(defcustom ebnf-optimize nil
"*Non-nil means optimize syntactic 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].
factorization:
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
:version "20"
:group 'ebnf-optimization)
(autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
"Eliminate empty rules.")
(autoload 'ebnf-optimize "ebnf-otz"
"Syntactic chart optimizer.")
(autoload 'ebnf-otz-initialize "ebnf-otz"
"Initialize optimizer.")
(defun ebnf-customize ()
"Customization for ebnf group."
(interactive)
(customize-group 'ebnf2ps))
(defun ebnf-print-directory (&optional directory)
"Generate and print a PostScript syntactic chart image of DIRECTORY.
If DIRECTORY is nil, it's used `default-directory'.
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
processed.
See also `ebnf-print-buffer'."
(interactive
(list (read-file-name "Directory containing EBNF files (print): "
nil default-directory)))
(ebnf-directory 'ebnf-print-buffer directory))
(defun ebnf-print-file (file &optional do-not-kill-buffer-when-done)
"Generate and print a PostScript syntactic chart image of the file FILE.
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
killed after process termination.
See also `ebnf-print-buffer'."
(interactive "fEBNF file to generate PostScript and print from: ")
(ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done))
(defun ebnf-print-buffer (&optional filename)
"Generate and print a PostScript syntactic 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))
(defun ebnf-print-region (from to &optional filename)
"Generate and print a PostScript syntactic 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)))
(defun ebnf-spool-directory (&optional directory)
"Generate and spool a PostScript syntactic chart image of DIRECTORY.
If DIRECTORY is nil, it's used `default-directory'.
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
processed.
See also `ebnf-spool-buffer'."
(interactive
(list (read-file-name "Directory containing EBNF files (spool): "
nil default-directory)))
(ebnf-directory 'ebnf-spool-buffer directory))
(defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done)
"Generate and spool a PostScript syntactic chart image of the file FILE.
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
killed after process termination.
See also `ebnf-spool-buffer'."
(interactive "fEBNF file to generate PostScript and spool from: ")
(ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done))
(defun ebnf-spool-buffer ()
"Generate and spool a PostScript syntactic 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)))
(defun ebnf-spool-region (from to)
"Generate a PostScript syntactic 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))
(defun ebnf-eps-directory (&optional directory)
"Generate EPS files from EBNF files in DIRECTORY.
If DIRECTORY is nil, it's used `default-directory'.
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
processed.
See also `ebnf-eps-buffer'."
(interactive
(list (read-file-name "Directory containing EBNF files (EPS): "
nil default-directory)))
(ebnf-directory 'ebnf-eps-buffer directory))
(defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done)
"Generate an EPS file from EBNF file FILE.
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
killed after EPS generation.
See also `ebnf-eps-buffer'."
(interactive "fEBNF file to generate EPS file from: ")
(ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done))
(defun ebnf-eps-buffer ()
"Generate a PostScript syntactic chart image of the buffer in an EPS file.
Generate an EPS file for each production in the buffer.
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.
Some characters in the production file name are replaced to
produce a valid file name. For example, the production name
\"A/B + C\" is modified to produce \"A_B_+_C\", and the EPS
file name used in this case will be \"ebnf--A_B_+_C.eps\".
WARNING: This function does *NOT* ask any confirmation to override existing
files."
(interactive)
(ebnf-eps-region (point-min) (point-max)))
(defun ebnf-eps-region (from to)
"Generate a PostScript syntactic chart image of the region in an EPS file.
Generate an EPS file for each production in the region.
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.
Some characters in the production file name are replaced to
produce a valid file name. For example, the production name
\"A/B + C\" is modified to produce \"A_B_+_C\", and the EPS
file name used in this case will be \"ebnf--A_B_+_C.eps\".
WARNING: This function does *NOT* ask any confirmation to override existing
files."
(interactive "r")
(let ((ebnf-eps-executing t))
(ebnf-generate-region from to 'ebnf-generate-eps)))
(defalias 'ebnf-despool 'ps-despool)
(defun ebnf-syntax-directory (&optional directory)
"Do a syntactic analysis of the files in DIRECTORY.
If DIRECTORY is nil, use `default-directory'.
Only the files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see)
are processed.
See also `ebnf-syntax-buffer'."
(interactive
(list (read-file-name "Directory containing EBNF files (syntax): "
nil default-directory)))
(ebnf-directory 'ebnf-syntax-buffer directory))
(defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done)
"Do a syntactic analysis of the named FILE.
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
killed after syntax checking.
See also `ebnf-syntax-buffer'."
(interactive "fEBNF file to check syntax: ")
(ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done))
(defun ebnf-syntax-buffer ()
"Do a syntactic analysis of the current buffer."
(interactive)
(ebnf-syntax-region (point-min) (point-max)))
(defun ebnf-syntax-region (from to)
"Do a syntactic analysis of region."
(interactive "r")
(ebnf-generate-region from to nil))
(defun ebnf-setup ()
"Return the current ebnf2ps setup."
(format
"
;;; ebnf2ps.el version %s
\(setq ebnf-special-show-delimiter %S
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-production-name-p %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-file-suffix-regexp %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-stop-on-error %S
ebnf-yac-ignore-error-recovery %S
ebnf-ignore-empty-rule %S
ebnf-optimize %S)
;;; ebnf2ps.el - end of settings
"
ebnf-version
ebnf-special-show-delimiter
(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
ebnf-production-name-p
(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-file-suffix-regexp
ebnf-eps-prefix
ebnf-entry-percentage
ebnf-color-p
ebnf-line-width
ebnf-line-color
ebnf-debug-ps
ebnf-use-float-format
ebnf-stop-on-error
ebnf-yac-ignore-error-recovery
ebnf-ignore-empty-rule
ebnf-optimize))
(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-show-delimiter
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-production-name-p
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-file-suffix-regexp
ebnf-eps-prefix
ebnf-entry-percentage
ebnf-color-p
ebnf-line-width
ebnf-line-color
ebnf-debug-ps
ebnf-use-float-format
ebnf-stop-on-error
ebnf-yac-ignore-error-recovery
ebnf-ignore-empty-rule
ebnf-optimize)
"List of valid symbol custom variable.")
(defvar ebnf-style-database
'( (default
nil
(ebnf-special-show-delimiter . t)
(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-production-name-p . t)
(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-file-suffix-regexp . "\.[Bb][Nn][Ff]$")
(ebnf-eps-prefix . "ebnf--")
(ebnf-entry-percentage . 0.5)
(ebnf-color-p . (or (fboundp 'x-color-values) (fboundp 'color-instance-rgb-components))) (ebnf-line-width . 1.0)
(ebnf-line-color . "Black")
(ebnf-debug-ps . nil)
(ebnf-use-float-format . t)
(ebnf-stop-on-error . nil)
(ebnf-yac-ignore-error-recovery . nil)
(ebnf-ignore-empty-rule . nil)
(ebnf-optimize . nil))
(happy
default
(ebnf-justify-sequence . 'left)
(ebnf-lex-comment-char . ?\#)
(ebnf-lex-eop-char . ?\ (abnf
default
(ebnf-syntax . 'abnf))
(iso-ebnf
default
(ebnf-syntax . 'iso-ebnf))
(yacc
default
(ebnf-syntax . 'yacc))
(ebnfx
default
(ebnf-syntax . 'ebnfx))
(dtd
default
(ebnf-syntax . 'dtd))
)
"Style database.
Each element has the following form:
(NAME INHERITS (VAR . VALUE)...)
Where:
NAME is a symbol name style.
INHERITS is a symbol name style from which the current style inherits
the context. If INHERITS is nil, then there is no inheritance.
This is a simple inheritance of style: if you declare that
style A inherits from style B, all settings of B are applied
first, and then the settings of A are applied. This is useful
when you wish to modify some aspects of an existing style, but
at the same time wish to keep it unmodified.
VAR is a valid ebnf2ps symbol custom variable.
See `ebnf-style-custom-list' for valid symbol variables.
VALUE is a sexp which will be evaluated to set the value of VAR.
Don't forget to quote symbols and constant lists.
See `default' style for an example.
Don't use this variable directly. Use functions `ebnf-insert-style',
`ebnf-delete-style' and `ebnf-merge-style'.")
(defun ebnf-insert-style (name inherits &rest values)
"Insert a new style NAME with inheritance INHERITS and values VALUES.
See `ebnf-style-database' documentation."
(interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
(and (assoc name ebnf-style-database)
(error "Style name already exists: %s" name))
(or (assoc inherits ebnf-style-database)
(error "Style inheritance name doesn't exist: %s" inherits))
(setq ebnf-style-database
(cons (cons name (cons inherits (ebnf-check-style-values values)))
ebnf-style-database)))
(defun ebnf-delete-style (name)
"Delete style NAME.
See `ebnf-style-database' documentation."
(interactive "SDelete style name: ")
(or (assoc name ebnf-style-database)
(error "Style name doesn't exist: %s" name))
(let ((db ebnf-style-database))
(while db
(and (eq (nth 1 (car db)) name)
(error "Style name `%s' is inherited by `%s' style"
name (nth 0 (car db))))
(setq db (cdr db))))
(setq ebnf-style-database (assq-delete-all name ebnf-style-database)))
(defun ebnf-merge-style (name &rest values)
"Merge values of style NAME with style VALUES.
See `ebnf-style-database' documentation."
(interactive "SStyle name: \nXStyle values: ")
(let ((style (or (assoc name ebnf-style-database)
(error "Style name doesn't exist: %s" name)))
(merge (ebnf-check-style-values values))
val elt new check)
(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))))
(nconc style (nreverse new))))
(defun ebnf-apply-style (style)
"Set STYLE as the current style.
Returns the old style symbol.
See `ebnf-style-database' documentation."
(interactive "SApply style: ")
(prog1
ebnf-current-style
(and (ebnf-apply-style1 style)
(setq ebnf-current-style style))))
(defun ebnf-reset-style (&optional style)
"Reset current style.
Returns the old style symbol.
See `ebnf-style-database' documentation."
(interactive "SReset style: ")
(setq ebnf-stack-style nil)
(ebnf-apply-style (or style 'default)))
(defun ebnf-push-style (&optional style)
"Push the current style onto a stack and set STYLE as the current style.
Returns the old style symbol.
See also `ebnf-pop-style'.
See `ebnf-style-database' documentation."
(interactive "SPush style: ")
(prog1
ebnf-current-style
(setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
(and style
(ebnf-apply-style style))))
(defun ebnf-pop-style ()
"Pop a style from the stack of pushed styles and set it as the current style.
Returns the old style symbol.
See also `ebnf-push-style'.
See `ebnf-style-database' documentation."
(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 (caar values) ebnf-style-custom-list)
(setq style (cons (car values) style)))
(setq values (cdr values)))
(nreverse style)))
(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.
This is 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)
(semi-up-hollow . 7)
(semi-up-full . 8)
(semi-down-hollow . 9)
(semi-down-full . 10)
(user . 11))
"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 ArrowScale mul def
/hT4 hT 0.25 mul ArrowScale 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
/UpPath
{c newpath moveto
hT2 neg 0 rmoveto
0 hT4 rlineto
hT2 hT4 neg rlineto
closepath
}bind def
/DownPath
{c newpath moveto
hT2 neg 0 rmoveto
0 hT4 neg rlineto
hT2 hT4 rlineto
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 UpPath 1 FillGray} % 7 - semi-up-hollow
{Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
{Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
{Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
{Gstroke gsave UserArrow grestore} % 11 - user
]def
/RA
{hT 0 rlineto
c
RA-vector ArrowShape get exec
Gstroke
moveto
ExtraWidth 0 rmoveto
}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 ExtraWidth 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
dup length 0 gt % empty string ==> no production name
{/Effect EffectP def
/fP F ForegroundP SetRGB BackgroundP aload pop true BG S
/Effect 0 def
( :) S false BG}if
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
%%EndProlog
"
"EBNF EPS begin")
(defconst ebnf-eps-end
"#ebnf2ps#end
%%EOF
"
"EBNF EPS end")
(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 (ps-color-scale 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)))
(defvar ebnf-total 0)
(defvar ebnf-nprod 0)
(defsubst ebnf-message-info (messag)
(message "%s...%3d%%"
messag
(round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
(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)))
(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)
(defalias 'ps-output 'ebnf-eps-output)
(defalias 'ps-output-string 'ps-output-string-prim)
(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))
(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)))
(ebnf-eps-production-list prod-list 'file-list horizontal
prod-width prod-height eps-buffer)
(ebnf-eps-finish-and-write eps-buffer
(ebnf-eps-filename prod-name)))
(save-excursion
(set-buffer eps-buffer)
(erase-buffer))
(setq ebnf-tree (cdr ebnf-tree)))
(ebnf-eps-write-kill-temp file-list t)
(setq file-list nil))
((quit error)
(setq error-msg (error-message-string data)))))
(defalias 'ps-output old-ps-output)
(defalias 'ps-output-string old-ps-output-string)
(kill-buffer eps-buffer)
(ebnf-eps-write-kill-temp file-list nil)
(and error-msg (error error-msg))
(message " ")))
(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))))
(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
((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
(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)))
(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-substring 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")
(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
(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))))
(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
(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)
(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))))
(defun ebnf-generate-production (production)
(ebnf-message-info "Generating")
(run-hooks 'ebnf-production-hook)
(ps-output-string (if ebnf-production-name-p
(ebnf-node-name production)
""))
(ps-output " "
(ebnf-format-float
(ebnf-node-width production)
(+ (if ebnf-production-name-p
ebnf-basic-height
0.0)
(ebnf-node-entry (ebnf-node-production production))))
" BOP\n")
(ebnf-node-generation (ebnf-node-production production))
(ps-output "EOS\n"))
(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"))
(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"))
(defun ebnf-generate-terminal (terminal)
(ebnf-gen-terminal terminal "T"))
(defun ebnf-generate-non-terminal (non-terminal)
(ebnf-gen-terminal non-terminal "NT"))
(defun ebnf-generate-empty (empty)
(ebnf-empty-alternative (ebnf-node-width empty)))
(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")))
(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"))
(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"))
(defun ebnf-generate-special (special)
(ebnf-gen-terminal special "SP"))
(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"))
(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")))
(defun ebnf-directory (fun &optional directory)
"Process files in DIRECTORY applying function FUN on each file.
If DIRECTORY is nil, use `default-directory'.
Only files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see) are
processed."
(let ((files (directory-files (or directory default-directory)
t ebnf-file-suffix-regexp)))
(while files
(set-buffer (find-file-noselect (car files)))
(funcall fun)
(setq buffer-backed-up t) (save-buffer) (kill-buffer (current-buffer))
(setq files (cdr files)))))
(defun ebnf-file (fun file &optional do-not-kill-buffer-when-done)
"Process the named FILE applying function FUN.
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
killed after process termination."
(set-buffer (find-file-noselect file))
(funcall fun)
(or do-not-kill-buffer-when-done
(kill-buffer (current-buffer))))
(defun ebnf-range-regexp (prefix from to)
(let (str)
(while (<= from to)
(setq str (concat str (char-to-string from))
from (1+ from)))
(concat prefix str)))
(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 ?\s)))
(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))
(error-msg "SYNTAX")
the-point)
(save-excursion
(save-restriction
(save-match-data
(condition-case data
(let ((tree (ebnf-parse-and-sort (min from to))))
(when gen-func
(setq error-msg "EMPTY RULES"
tree (ebnf-eliminate-empty-rules tree))
(setq error-msg "OPTMIZE"
tree (ebnf-optimize tree))
(setq error-msg "DIMENSIONS"
tree (ebnf-dimensions tree))
(setq error-msg "GENERATION")
(funcall gen-func tree))
(setq error-msg nil)) ((quit error)
(ding)
(setq the-point (max (1- (point)) (point-min))
error-msg (concat error-msg ": "
(error-message-string data)
", "
(and (string= error-msg "SYNTAX")
(format "at position %d "
the-point))
(format "in buffer \"%s\"."
(buffer-name)))))))))
(cond
(error-msg
(goto-char the-point)
(if ebnf-stop-on-error
(error error-msg)
(message "%s" error-msg)))
(gen-func
nil)
(t
(message "EBNF syntactic 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))
(defconst ebnf-syntax-alist
'((iso-ebnf ebnf-iso-parser ebnf-iso-initialize)
(yacc ebnf-yac-parser ebnf-yac-initialize)
(abnf ebnf-abn-parser ebnf-abn-initialize)
(ebnf ebnf-bnf-parser ebnf-bnf-initialize)
(ebnfx ebnf-ebx-parser ebnf-ebx-initialize)
(dtd ebnf-dtd-parser ebnf-dtd-initialize))
"Alist associating EBNF syntax with a parser and an initializer.")
(defun ebnf-begin-job ()
(ps-printing-region nil nil 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)
(let ((init (or (assoc ebnf-syntax ebnf-syntax-alist)
(assoc 'ebnf ebnf-syntax-alist))))
(setq ebnf-parser-func (nth 1 init))
(funcall (nth 2 init)))
(and ebnf-terminal-regexp (not (stringp ebnf-terminal-regexp))
(setq ebnf-terminal-regexp nil))
(or (and ebnf-eps-prefix (stringp ebnf-eps-prefix))
(setq ebnf-eps-prefix "ebnf--"))
(setq ebnf-entry-percentage (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)
(or (and (numberp ebnf-production-horizontal-space)
(> ebnf-production-horizontal-space 0.0))
(setq ebnf-production-horizontal-space basic))
(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
(end-of-line)
(insert " & ebnf2ps v" ebnf-version)
(goto-char (point-max))
(search-backward "\n%%EndProlog\n")
(ebnf-insert-ebnf-prologue)
(ps-output "\n")))))
(defun ebnf-eps-finish-and-write (buffer filename)
(when (buffer-modified-p buffer)
(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)))
(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: " (format-time-string "%T %b %d %Y")
"\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
"\n%%DocumentNeededResources: font "
(or ebnf-fonts-required
(setq ebnf-fonts-required
(mapconcat 'identity
(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)))
"\n%%+ font ")))
"\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\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")
(goto-char (point-max))
(insert ebnf-eps-end)
(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"
(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))
(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))
(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))
(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))
(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))
(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))
(format "/ExtraWidth %s def\n"
(ebnf-format-float ebnf-arrow-extra-width))
(format "/ArrowScale %s def\n"
(ebnf-format-float ebnf-arrow-scale))
(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"
(let ((arrow (eval ebnf-user-arrow)))
(if (stringp arrow)
arrow
"")))
"\n% === end EBNF settings\n\n"
(and ebnf-debug-ps ebnf-debug))))
ebnf-prologue))
(defun ebnf-dimensions (tree)
(let ((ebnf-total (length tree))
(ebnf-nprod 0))
(mapcar 'ebnf-production-dimension tree))
tree)
(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 (+ (if ebnf-production-name-p
ebnf-font-height-P
0.0)
ebnf-line-width ebnf-line-width
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-line-width
ebnf-horizontal-space))))
(defun ebnf-terminal-dimension (terminal)
(ebnf-terminal-dimension1 terminal
ebnf-font-height-T
ebnf-font-width-T
ebnf-space-T))
(defun ebnf-non-terminal-dimension (non-terminal)
(ebnf-terminal-dimension1 non-terminal
ebnf-font-height-NT
ebnf-font-width-NT
ebnf-space-NT))
(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 ebnf-arrow-extra-width space
(* len font-width)
space ebnf-basic-width))))
(defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
(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-arrow-extra-width
ebnf-space-R ebnf-space-R ebnf-space-R
ebnf-horizontal-space
(* (length times) ebnf-font-width-R)))))
(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-arrow-extra-width
ebnf-space-E ebnf-space-E
ebnf-space-E ebnf-space-E
ebnf-font-width-E
ebnf-horizontal-space))))
(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))))
(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))))
(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)))))
(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)))))
(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)))
(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
((= width (ebnf-node-width node))
node)
((eq ebnf-justify-sequence 'left)
(ebnf-adjust-empty node width nil))
((eq ebnf-justify-sequence 'right)
(ebnf-adjust-empty node width t))
(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))))))
(defun ebnf-alternative-width (alternative width)
(ebnf-adjust-width (ebnf-node-list alternative)
(- width ebnf-horizontal-space)))
(defun ebnf-element-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)))
(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
((eq ebnf-justify-sequence 'left)
(ebnf-justify node seq seq-width width t))
((eq ebnf-justify-sequence 'right)
(ebnf-justify node seq seq-width width nil))
((vectorp seq)
(ebnf-adjust-width seq width))
(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
((eq (ebnf-node-kind term) 'ebnf-generate-empty)
(ebnf-node-width term (+ (- width seq-width)
(ebnf-node-width term)))
seq)
(last-p
(nconc seq
(list (ebnf-make-empty (- width seq-width)))))
(t
(cons (ebnf-make-empty (- width seq-width))
seq))
)))
(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))))
(defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377))
(defun ebnf-string (chars eos-char kind)
(forward-char)
(buffer-substring-no-properties
(point)
(progn
(skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit)
(if (or (eobp) (/= (following-char) eos-char))
(error "Invalid %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) ?\s))
(setq index (1- index)))
(if (= index len)
str
(substring str 0 (1+ index)))))
(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 3) name)
((= len 3) (concat 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-element-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 &optional upper)
(vector 'ebnf-generate-repeat
'ignore
'ebnf-repeat-dimension
0.0
0.0
0.0
(cond ((and times upper) (if (string= times upper)
(if (string= times "")
" * "
times)
(concat times " * " upper)))
(times (concat times " *"))
(upper (concat "* " upper))
(t " * "))
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))
(defun ebnf-token-except (element exception)
(cons (prog1
(car exception)
(setq exception (cdr exception)))
(and element (let ((kind (ebnf-node-kind element)))
(cond
((and (null exception)
(eq kind 'ebnf-generate-optional))
(ebnf-node-list element))
((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)
((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)
(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))
(t
(ebnf-make-except element exception))
)))))
(defun ebnf-token-repeat (times repeat &optional upper)
(if (null (cdr repeat))
repeat
(cons (car repeat)
(ebnf-make-repeat times (cdr repeat) upper))))
(defun ebnf-token-optional (body)
(let ((kind (ebnf-node-kind body)))
(cond
((eq kind 'ebnf-generate-empty)
nil)
((eq kind 'ebnf-generate-zero-or-more)
body)
((eq kind 'ebnf-generate-one-or-more)
(ebnf-node-kind body 'ebnf-generate-zero-or-more)
body)
((eq kind 'ebnf-generate-alternative)
(ebnf-node-list body (nconc (ebnf-node-list body)
(list (ebnf-make-empty))))
body)
(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))))))))
(defun ebnf-token-sequence (sequence)
(cond
((null sequence)
(ebnf-make-empty))
((= (length sequence) 1)
(car sequence))
(t
(ebnf-make-sequence (nreverse sequence)))
))
(defconst ebnf-comment-table
(let ((table (make-vector 256 nil)))
(aset table ?< 'newline)
(aset table ?> 'keep-line)
(aset table ?^ 'form-feed)
table)
"Vector used to map characters to a special comment token.")
(autoload 'ebnf-abn-parser "ebnf-abn"
"ABNF parser.")
(autoload 'ebnf-abn-initialize "ebnf-abn"
"Initialize ABNF token table.")
(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-ebx-parser "ebnf-ebx"
"EBNFX parser.")
(autoload 'ebnf-ebx-initialize "ebnf-ebx"
"Initializations for EBNFX parser.")
(autoload 'ebnf-dtd-parser "ebnf-dtd"
"DTD parser.")
(autoload 'ebnf-dtd-initialize "ebnf-dtd"
"Initializations for DTD parser.")
(provide 'ebnf2ps)