1 ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
4 ;; Free Software Foundation, Inc.
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Keywords: wp, ebnf, PostScript
10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
29 (defconst ebnf-version "4.3"
30 "ebnf2ps.el, v 4.3 <2006/09/26 vinicius>
32 Vinicius's last change version. When reporting bugs, please also
33 report the version of Emacs, if any, that ebnf2ps was running with.
35 Please send all bug fixes and enhancements to
36 Vinicius Jose Latorre <viniciusjl@ig.com.br>.
42 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;; This package translates an EBNF to a syntactic chart on PostScript.
49 ;; To use ebnf2ps, insert in your ~/.emacs:
53 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
54 ;; know how to set options like landscape printing, page headings, margins,
57 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
58 ;; ebnf2ps, they behave as it's turned off.
60 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
62 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
64 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
66 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
72 ;; ebnf2ps provides the following commands for generating PostScript syntactic
73 ;; chart images of Emacs buffers:
75 ;; ebnf-print-directory
79 ;; ebnf-spool-directory
88 ;; These commands all perform essentially the same function: they generate
89 ;; PostScript syntactic chart images suitable for printing on a PostScript
90 ;; printer or displaying with GhostScript. These commands are collectively
91 ;; referred to as "ebnf- commands".
93 ;; The word "print", "spool" and "eps" in the command name determines when the
94 ;; PostScript image is sent to the printer (or file):
96 ;; print - The PostScript image is immediately sent to the printer;
98 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
99 ;; Many images may be spooled locally before printing them. To
100 ;; send the spooled images to the printer, use the command
103 ;; eps - The PostScript image is immediately sent to a EPS file.
105 ;; The spooling mechanism is the same as used by ps-print and was designed for
106 ;; printing lots of small files to save paper that would otherwise be wasted on
107 ;; banner pages, and to make it easier to find your output at the printer (it's
108 ;; easier to pick up one 50-page printout than to find 50 single-page
109 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
110 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
112 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
113 ;; won't accidentally quit from Emacs while you have unprinted PostScript
114 ;; waiting in the spool buffer. If you do attempt to exit with spooled
115 ;; PostScript, you'll be asked if you want to print it, and if you decline,
116 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
117 ;; that Emacs uses for modified buffers.
119 ;; The word "directory", "file", "buffer" or "region" in the command name
120 ;; determines how much of the buffer is printed:
122 ;; directory - Read files in the directory and print them.
124 ;; file - Read file and print it.
126 ;; buffer - Print the entire buffer.
128 ;; region - Print just the current region.
130 ;; Two ebnf- command examples:
132 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
133 ;; immediately to the printer.
135 ;; ebnf-spool-region - translate and print just the current region, and
136 ;; spool the image in Emacs to send to the printer
139 ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and
140 ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print
141 ;; spooling mechanism. See section "Actions in Comments" for an explanation
142 ;; about EPS file generation.
148 ;; To translate and print your buffer, type
150 ;; M-x ebnf-print-buffer
152 ;; or substitute one of the other four ebnf- commands. The command will
153 ;; generate the PostScript image and print or spool it as specified. By giving
154 ;; the command a prefix argument
156 ;; C-u M-x ebnf-print-buffer
158 ;; it will save the PostScript image to a file instead of sending it to the
159 ;; printer; you will be prompted for the name of the file to save the image to.
160 ;; The prefix argument is ignored by the commands that spool their images, but
161 ;; you may save the spooled images to a file by giving a prefix argument to
164 ;; C-u M-x ebnf-despool
166 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
169 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
170 ;; `ebnf-eps-region'.
172 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
174 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
175 ;; (global-set-key '(shift f22) 'ebnf-print-region)
176 ;; (global-set-key '(control f22) 'ebnf-despool)
179 ;; Invoking Ebnf2ps in Batch
180 ;; -------------------------
182 ;; It's possible also to run ebnf2ps in batch, this is useful when, for
183 ;; example, you have a directory with a lot of files containing the EBNF to be
184 ;; translated to PostScript.
186 ;; To run ebnf2ps in batch type, for example:
188 ;; emacs -batch -l setup-ebnf2ps.el -f ebnf-eps-directory
190 ;; Where setup-ebnf2ps.el should be a file containing:
192 ;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
193 ;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
194 ;; (require 'ebnf2ps)
195 ;; ;; insert here your ebnf2ps settings
196 ;; (setq ebnf-terminal-shape 'bevel)
203 ;; BNF (Backus Naur Form) notation is defined like languages, and like
204 ;; languages there are rules about name formation and syntax. In this section
205 ;; it's defined a BNF syntax that it's called simply EBNF (Extended BNF).
206 ;; ebnf2ps package also deal with other BNF notation. Please, see the variable
207 ;; `ebnf-syntax' documentation below in this section.
209 ;; The current EBNF that ebnf2ps accepts has the following constructions:
211 ;; ; comment (until end of line)
215 ;; $A default non-terminal (see text below)
216 ;; $"C" default terminal (see text below)
217 ;; $?C? default special (see text below)
218 ;; A = B. production (A is the header and B the body)
219 ;; C D sequence (C occurs before D)
220 ;; C | D alternative (C or D occurs)
221 ;; A - B exception (A excluding B, B without any non-terminal)
222 ;; n * A repetition (A repeats at least n (integer) times)
223 ;; n * n A repetition (A repeats exactly n (integer) times)
224 ;; n * m A repetition (A repeats at least n (integer) and at most
225 ;; m (integer) times)
226 ;; (C) group (expression C is grouped together)
227 ;; [C] optional (C may or not occurs)
228 ;; C+ one or more occurrences of C
229 ;; {C}+ one or more occurrences of C
230 ;; {C}* zero or more occurrences of C
231 ;; {C} zero or more occurrences of C
232 ;; C / D equivalent to: C {D C}*
233 ;; {C || D}+ equivalent to: C {D C}*
234 ;; {C || D}* equivalent to: [C {D C}*]
235 ;; {C || D} equivalent to: [C {D C}*]
237 ;; The EBNF syntax written using the notation above is:
239 ;; EBNF = {production}+.
241 ;; production = non_terminal "=" body ".". ;; production
243 ;; body = {sequence || "|"}*. ;; alternative
245 ;; sequence = {exception}*. ;; sequence
247 ;; exception = repeat [ "-" repeat]. ;; exception
249 ;; repeat = [ integer "*" [ integer ]] term. ;; repetition
252 ;; | [factor] "+" ;; one-or-more
253 ;; | [factor] "/" [factor] ;; one-or-more
256 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
257 ;; | [ "$" ] non_terminal ;; non-terminal
258 ;; | [ "$" ] "?" special "?" ;; special
259 ;; | "(" body ")" ;; group
260 ;; | "[" body "]" ;; zero-or-one
261 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
262 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
263 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
266 ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
267 ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
268 ;; ;; and lower), 8-bit accentuated characters,
269 ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
270 ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
272 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
273 ;; ;; that is, a valid terminal accepts any printable character (including
274 ;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
275 ;; ;; terminal. Also, accepts escaped characters, that is, a character
276 ;; ;; pair starting with `\' followed by a printable character, for
277 ;; ;; example: \", \\.
279 ;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
280 ;; ;; that is, a valid special accepts any printable character (including
281 ;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
282 ;; ;; delimit a special.
284 ;; integer = "[0-9]+".
285 ;; ;; that is, an integer is a sequence of one or more decimal digits.
287 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
288 ;; ;; that is, a comment starts with the character `;' and terminates at end
289 ;; ;; of line. Also, it only accepts printable characters (including 8-bit
290 ;; ;; accentuated characters) and tabs.
292 ;; Try to use the above EBNF to test ebnf2ps.
294 ;; The `default' terminal, non-terminal and special is a way to indicate a
295 ;; default path in a production. For example, the production:
297 ;; X = [ $A ( B | $C ) | D ].
299 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
301 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
302 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
303 ;; name besides that enclosed by `"'.
305 ;; Let's see an example:
307 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
308 ;; (setq ebnf-case-fold-search nil) ; exact matching
310 ;; If you have the production:
312 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
314 ;; The names are classified as:
316 ;; Logical Expression non-terminal
317 ;; "(" OR AND "XOR" ")" terminal
319 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
320 ;; value is ?\; (character `;').
322 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
323 ;; value is ?. (character `.').
325 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
327 ;; `ebnf' ebnf2ps recognizes the syntax described above.
328 ;; The following variables *ONLY* have effect with this
330 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
331 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
333 ;; `abnf' ebnf2ps recognizes the syntax described in the URL:
334 ;; `http://www.ietf.org/rfc/rfc2234.txt'
335 ;; ("Augmented BNF for Syntax Specifications: ABNF").
337 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
338 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
339 ;; ("International Standard of the ISO EBNF Notation").
340 ;; The following variables *ONLY* have effect with this
342 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
344 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
345 ;; The following variable *ONLY* has effect with this
347 ;; `ebnf-yac-ignore-error-recovery'.
349 ;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
350 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
351 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
353 ;; `dtd' ebnf2ps recognizes the syntax described in the URL:
354 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
355 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
357 ;; Any other value is treated as `ebnf'.
359 ;; The default value is `ebnf'.
365 ;; The following EBNF optimizations are done:
367 ;; [ { A }* ] ==> { A }*
368 ;; [ { A }+ ] ==> { A }*
369 ;; [ A ] + ==> { A }*
370 ;; { A }* + ==> { A }*
371 ;; { A }+ + ==> { A }+
374 ;; ( A | EMPTY )- ==> A
375 ;; ( A | B | EMPTY )- ==> A | B
376 ;; [ A | B ] ==> A | B | EMPTY
377 ;; n * EMPTY ==> EMPTY
379 ;; EMPTY / EMPTY ==> EMPTY
380 ;; EMPTY - A ==> EMPTY
382 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
385 ;; 1. A = B | A C. ==> A = B {C}*.
386 ;; 2. A = B | A B. ==> A = {B}+.
387 ;; 3. A = | A B. ==> A = {B}*.
388 ;; 4. A = B | A C B. ==> A = {B || C}+.
389 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
392 ;; 6. A = B | . ==> A = [B].
393 ;; 7. A = | B . ==> A = [B].
396 ;; 8. A = B C | B D. ==> A = B (C | D).
397 ;; 9. A = C B | D B. ==> A = (C | D) B.
398 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
400 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
406 ;; You may use form feed (^L \014) to force a production to start on a new
407 ;; page, for example:
416 ;; c) A = B ^L^L^L | C.^L
420 ;; In all examples above, only the production X will start on a new page.
423 ;; Actions in Comments
424 ;; -------------------
426 ;; ebnf2ps accepts the following actions in comments:
428 ;; ;^ same as form feed. See section Form Feed above.
430 ;; ;> the next production starts in the same line as the current one.
431 ;; It is useful when `ebnf-horizontal-orientation' is nil.
433 ;; ;< the next production starts in the next line.
434 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
436 ;; ;[EPS open a new EPS file. The EPS file name has the form:
437 ;; <PREFIX><NAME>.eps
438 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
439 ;; <NAME> is the string given by ;[ action comment, this string is
440 ;; mapped to form a valid file name (see documentation for
441 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
442 ;; It has effect only during `ebnf-eps-buffer' or
443 ;; `ebnf-eps-region' execution.
444 ;; It's an error to try to open an already opened EPS file.
446 ;; ;]EPS close an opened EPS file.
447 ;; It has effect only during `ebnf-eps-buffer' or
448 ;; `ebnf-eps-region' execution.
449 ;; It's an error to try to close a not opened EPS file.
453 ;; (setq ebnf-horizontal-orientation nil)
457 ;; ;> C and B are drawn in the same line
461 ;; The graphical result is:
467 ;; +---------+ +-----+
479 ;; Note that if ascending production sort is used, the productions A and B will
480 ;; be drawn in the same line instead of C and B.
482 ;; If consecutive actions occur, only the last one takes effect, so if you
491 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
494 ;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*)
495 ;; and (*]EPS*). The first example above should be written:
499 ;; (*> C and B are drawn in the same line *)
503 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
504 ;; `ebnf-eps-region':
523 ;; The following table summarizes the results:
525 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
526 ;; ebnf--AA.eps A C A C C A
527 ;; ebnf--BB.eps C B B C C B
528 ;; ebnf--CC.eps A C B F A B C F F C B A
534 ;; As you can see if EPS actions is not used, each single production is
535 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
536 ;; it's not an existing production name.
538 ;; In the following case:
546 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
552 ;; Some tools are provided to help you.
554 ;; `ebnf-setup' returns the current setup.
556 ;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the
559 ;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given
562 ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
565 ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current
568 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
570 ;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer',
571 ;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same
572 ;; way as `ebnf-' commands.
578 ;; ebn2ps has the following hook variables:
581 ;; It is evaluated once before any ebnf2ps process.
583 ;; `ebnf-production-hook'
584 ;; It is evaluated on each beginning of production.
587 ;; It is evaluated on each beginning of page.
593 ;; Below it's shown a brief description of ebnf2ps options, please, see the
594 ;; options declaration in the code for a long documentation.
596 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
599 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
600 ;; height in horizontal orientation.
602 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
603 ;; between productions.
605 ;; `ebnf-production-vertical-space' Specify vertical space in points
606 ;; between productions.
608 ;; `ebnf-justify-sequence' Specify justification of terms in a
609 ;; sequence inside alternatives.
611 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
613 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
615 ;; `ebnf-terminal-font' Specify terminal font.
617 ;; `ebnf-terminal-shape' Specify terminal box shape.
619 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
622 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
624 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
626 ;; `ebnf-production-name-p' Non-nil means production name will be
629 ;; `ebnf-sort-production' Specify how productions are sorted.
631 ;; `ebnf-production-font' Specify production font.
633 ;; `ebnf-non-terminal-font' Specify non-terminal font.
635 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
637 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
640 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
643 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
646 ;; `ebnf-special-show-delimiter' Non-nil means special delimiter
647 ;; (character `?') is shown.
649 ;; `ebnf-special-font' Specify special font.
651 ;; `ebnf-special-shape' Specify special box shape.
653 ;; `ebnf-special-shadow' Non-nil means special box will have a
656 ;; `ebnf-special-border-width' Specify border width for special box.
658 ;; `ebnf-special-border-color' Specify border color for special box.
660 ;; `ebnf-except-font' Specify except font.
662 ;; `ebnf-except-shape' Specify except box shape.
664 ;; `ebnf-except-shadow' Non-nil means except box will have a
667 ;; `ebnf-except-border-width' Specify border width for except box.
669 ;; `ebnf-except-border-color' Specify border color for except box.
671 ;; `ebnf-repeat-font' Specify repeat font.
673 ;; `ebnf-repeat-shape' Specify repeat box shape.
675 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
678 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
680 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
682 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
684 ;; `ebnf-arrow-shape' Specify the arrow shape.
686 ;; `ebnf-chart-shape' Specify chart flow shape.
688 ;; `ebnf-color-p' Non-nil means use color.
690 ;; `ebnf-line-width' Specify flow line width.
692 ;; `ebnf-line-color' Specify flow line color.
694 ;; `ebnf-arrow-extra-width' Specify extra width for arrow shape
697 ;; `ebnf-arrow-scale' Specify the arrow scale.
699 ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
702 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
705 ;; `ebnf-lex-comment-char' Specify the line comment character.
707 ;; `ebnf-lex-eop-char' Specify the end of production
710 ;; `ebnf-syntax' Specify syntax to be recognized.
712 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
714 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
717 ;; `ebnf-default-width' Specify additional border width over
718 ;; default terminal, non-terminal or
721 ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains
724 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
726 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
728 ;; `ebnf-stop-on-error' Non-nil means signal error and stop.
729 ;; Nil means signal error and continue.
731 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
733 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
735 ;; `ebnf-optimize' Non-nil means optimize syntactic chart
738 ;; To set the above options you may:
740 ;; a) insert the code in your ~/.emacs, like:
742 ;; (setq ebnf-terminal-shape 'bevel)
744 ;; This way always keep your default settings when you enter a new Emacs
747 ;; b) or use `set-variable' in your Emacs session, like:
749 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
751 ;; This way keep your settings only during the current Emacs session.
753 ;; c) or use customization, for example:
754 ;; click on menu-bar *Help* option,
755 ;; then click on *Customize*,
756 ;; then click on *Browse Customization Groups*,
757 ;; expand *PostScript* group,
758 ;; expand *Ebnf2ps* group
759 ;; and then customize ebnf2ps options.
760 ;; Through this way, you may choose if the settings are kept or not when
761 ;; you leave out the current Emacs session.
763 ;; d) or see the option value:
765 ;; C-h v ebnf-terminal-shape RET
767 ;; and click the *customize* hypertext button.
768 ;; Through this way, you may choose if the settings are kept or not when
769 ;; you leave out the current Emacs session.
773 ;; M-x ebnf-customize RET
775 ;; and then customize ebnf2ps options.
776 ;; Through this way, you may choose if the settings are kept or not when
777 ;; you leave out the current Emacs session.
783 ;; Sometimes you need to change the EBNF style you are using, for example,
784 ;; change the shapes and colors. These changes may force you to set some
785 ;; variables and after use, set back the variables to the old values.
787 ;; To help to handle this situation, ebnf2ps has the following commands to
790 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
793 ;; `ebnf-delete-style' Delete style NAME.
795 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
797 ;; `ebnf-apply-style' Set STYLE as the current style.
799 ;; `ebnf-reset-style' Reset current style.
801 ;; `ebnf-push-style' Push the current style and set STYLE as the current
804 ;; `ebnf-pop-style' Pop a style and set it as the current style.
806 ;; These commands help to put together a lot of variable settings in a group
807 ;; and name this group. So when you wish to apply these settings it's only
808 ;; needed to give the name.
810 ;; There is also a notion of simple inheritance of style; so, if you declare
811 ;; that a style A inherits from a style B, all settings of B is applied first
812 ;; and then the settings of A is applied. This is useful when you wish to
813 ;; modify some aspects of an existing style, but at same time wish to keep it
816 ;; See documentation for `ebnf-style-database'.
822 ;; Below it is the layout of minimum area to draw each element, and it's used
823 ;; the following terms:
825 ;; font height is given by:
826 ;; (terminal font height + non-terminal font height) / 2
828 ;; entry is the vertical position used to know where it should
829 ;; be drawn the flow line in the current element.
831 ;; extra is given by `ebnf-arrow-extra-width'.
834 ;; * SPECIAL, TERMINAL and NON-TERMINAL
836 ;; +==============+...................................
837 ;; | | } font height / 2 } entry }
838 ;; | XXXXXXXX...|....... } }
839 ;; ====+ XXXXXXXX +==== } text height ...... } height
840 ;; : | XXXXXXXX...|...:... }
841 ;; : | : : | : } font height / 2 }
842 ;; : +==============+...:...............................
844 ;; : : : : : :.........................
845 ;; : : : : : } font height }
846 ;; : : : : :....... }
847 ;; : : : : } font height / 2 }
848 ;; : : : :........... }
849 ;; : : : } text width } width
850 ;; : : :.................. }
851 ;; : : } font height / 2 }
852 ;; : :...................... }
853 ;; : } font height + extra }
854 ;; :.................................................
859 ;; +==========+.....................................
863 ;; ===+===+ +===+===... } element height } height
866 ;; : | +==========+.|................. }
867 ;; : | : : | : } font height }
868 ;; : +==============+...................................
870 ;; : : : :......................
871 ;; : : : } font height * 2 }
873 ;; : : } element width } width
874 ;; : :..................... }
875 ;; : } font height * 2 }
876 ;; :...............................................
881 ;; +===+...................................
882 ;; +==+ A +==+ } A height } }
883 ;; | +===+..|........ } entry }
884 ;; + + } font height } }
885 ;; / +===+...\....... } }
886 ;; ===+====+ B +====+=== } B height ..... } height
887 ;; : \ +===+.../....... }
888 ;; : + + : } font height }
889 ;; : | +===+..|........ }
890 ;; : +==+ C +==+ : } C height }
891 ;; : : +===+...................................
893 ;; : : : :......................
894 ;; : : : } font height * 2 }
896 ;; : : } max width } width
897 ;; : :................. }
898 ;; : } font height * 2 }
899 ;; :..........................................
902 ;; 1. An empty alternative has zero of height.
904 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
910 ;; +===========+...............................
911 ;; +=+ separator +=+ } separator height }
912 ;; / +===========+..\........ }
914 ;; | | } font height }
916 ;; \ +===========+../........ } height = entry
917 ;; +=+ element +=+ } element height }
918 ;; /: +===========+..\........ }
920 ;; + : : + } font height }
922 ;; ==+=======================+==.......................
924 ;; : : : :.......................
925 ;; : : : } font height * 2 }
927 ;; : : } max width } width
928 ;; : :......................... }
929 ;; : } font height * 2 }
930 ;; :...................................................
935 ;; +===========+......................................
936 ;; +=+ separator +=+ } separator height } }
937 ;; / +===========+..\...... } }
939 ;; | | } font height } } height
941 ;; \ +===========+../...... } }
942 ;; ===+=+ element +=+=== } element height .... }
943 ;; : : +===========+......................................
945 ;; : : : :........................
946 ;; : : : } font height * 2 }
948 ;; : : } max width } width
949 ;; : :....................... }
950 ;; : } font height * 2 }
951 ;; :..............................................
956 ;; XXXXXX:......................................
957 ;; XXXXXX: } production font height }
958 ;; XXXXXX:............ }
960 ;; +======+....... } height = entry
962 ;; ====+ +==== } element height }
964 ;; : +======+.................................
966 ;; : : : :......................
967 ;; : : : } font height * 2 }
969 ;; : : } element width } width
970 ;; : :.............. }
971 ;; : } font height * 2 }
972 ;; :.....................................
977 ;; +================+...................................
978 ;; | | } font height / 2 } entry }
979 ;; | +===+...|....... } }
980 ;; ====+ N * | X | +==== } X height ......... } height
981 ;; : | : : +===+...|...:... }
982 ;; : | : : : : | : } font height / 2 }
983 ;; : +================+...:...............................
985 ;; : : : : : : : :..........................
986 ;; : : : : : : : } font height }
987 ;; : : : : : : :....... }
988 ;; : : : : : : } font height / 2 }
989 ;; : : : : : :........... }
990 ;; : : : : : } X width }
991 ;; : : : : :............... }
992 ;; : : : : } font height / 2 } width
993 ;; : : : :.................. }
994 ;; : : : } text width }
995 ;; : : :..................... }
996 ;; : : } font height / 2 }
997 ;; : :........................ }
998 ;; : } font height + extra }
999 ;; :...................................................
1004 ;; +==================+...................................
1005 ;; | | } font height / 2 } entry }
1006 ;; | +===+ +===+...|....... } }
1007 ;; ====+ | X | - | y | +==== } max height ....... } height
1008 ;; : | +===+ +===+...|...:... }
1009 ;; : | : : : : | : } font height / 2 }
1010 ;; : +==================+...:...............................
1012 ;; : : : : : : : :..........................
1013 ;; : : : : : : : } font height }
1014 ;; : : : : : : :....... }
1015 ;; : : : : : : } font height / 2 }
1016 ;; : : : : : :........... }
1017 ;; : : : : : } Y width }
1018 ;; : : : : :............... }
1019 ;; : : : : } font height } width
1020 ;; : : : :................... }
1021 ;; : : : } X width }
1022 ;; : : :....................... }
1023 ;; : : } font height / 2 }
1024 ;; : :.......................... }
1025 ;; : } font height + extra }
1026 ;; :.....................................................
1028 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
1031 ;; Internal Structures
1032 ;; -------------------
1034 ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis
1035 ;; of current buffer and generates an intermediate representation. The second
1036 ;; pass uses the intermediate representation to generate the PostScript
1039 ;; The intermediate representation is a list of vectors, the vector element
1040 ;; represents a syntactic chart element. Below is a vector representation for
1041 ;; each syntactic chart element.
1043 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
1044 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1045 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1046 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1047 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1048 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1049 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
1050 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
1051 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1052 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1053 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
1054 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
1056 ;; The first vector position is a function symbol used to generate PostScript
1057 ;; for this element.
1058 ;; WIDTH-FUN is a function symbol called to adjust the element width.
1059 ;; DIM-FUN is a function symbol called to set the element dimensions.
1060 ;; ENTRY is the element entry point.
1061 ;; HEIGHT and WIDTH are the element height and width, respectively.
1062 ;; NAME is a string that it's the element name.
1063 ;; DEFAULT is a boolean that indicates if it's a `default' element.
1064 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
1066 ;; LIST is a list of vector that represents the list part for alternatives and
1068 ;; SEPARATOR is a vector that represents the sub-element used to separate the
1070 ;; TIMES is a string representing the number of times that ELEMENT is repeated
1071 ;; on a repeat construction.
1072 ;; ACTION indicates some action that should be done before production is
1073 ;; generated. The current actions are:
1077 ;; form-feed current production starts on a new page.
1079 ;; newline current production starts on next line, this is useful
1080 ;; when `ebnf-horizontal-orientation' is non-nil.
1082 ;; keep-line current production continues on the current line, this
1083 ;; is useful when `ebnf-horizontal-orientation' is nil.
1089 ;; . Handle situations when syntactic chart is out of paper.
1090 ;; . Use other alphabet than ascii.
1091 ;; . Optimizations...
1097 ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
1098 ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale',
1099 ;; `ebnf-production-name-p', `ebnf-stop-on-error',
1100 ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
1101 ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
1105 ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
1106 ;; with some Bison features (%right, %left and %prec pragmas). His suggestion
1107 ;; was extended to deal with %nonassoc pragma too.
1109 ;; Thanks to all who emailed comments.
1112 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1119 (and (string< ps-print-version "5.2.3")
1120 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1123 ;; to avoid gripes with Emacs 20
1124 (or (fboundp 'assq-delete-all)
1125 (defun assq-delete-all (key alist)
1126 "Delete from ALIST all elements whose car is KEY.
1127 Return the modified alist.
1128 Elements of ALIST that are not conses are ignored."
1131 (if (and (consp (car tail))
1132 (eq (car (car tail)) key))
1133 (setq alist (delq (car tail) alist)))
1134 (setq tail (cdr tail)))
1138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1142 ;;; Interface to the command system
1144 (defgroup postscript nil
1151 (defgroup ebnf2ps nil
1152 "Translate an EBNF to a syntactic chart on PostScript."
1159 (defgroup ebnf-special nil
1160 "Special customization."
1167 (defgroup ebnf-except nil
1168 "Except customization."
1175 (defgroup ebnf-repeat nil
1176 "Repeat customization."
1183 (defgroup ebnf-terminal nil
1184 "Terminal customization."
1191 (defgroup ebnf-non-terminal nil
1192 "Non-Terminal customization."
1199 (defgroup ebnf-production nil
1200 "Production customization."
1207 (defgroup ebnf-shape nil
1208 "Shapes customization."
1215 (defgroup ebnf-displacement nil
1216 "Displacement customization."
1223 (defgroup ebnf-syntactic nil
1224 "Syntactic customization."
1231 (defgroup ebnf-optimization nil
1232 "Optimization customization."
1239 (defcustom ebnf-horizontal-orientation nil
1240 "*Non-nil means productions are drawn horizontally."
1243 :group 'ebnf-displacement)
1246 (defcustom ebnf-horizontal-max-height nil
1247 "*Non-nil means to use maximum production height in horizontal orientation.
1249 It is only used when `ebnf-horizontal-orientation' is non-nil."
1252 :group 'ebnf-displacement)
1255 (defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
1256 "*Specify horizontal space in points between productions.
1258 Value less or equal to zero forces ebnf2ps to set a proper default value."
1261 :group 'ebnf-displacement)
1264 (defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
1265 "*Specify vertical space in points between productions.
1267 Value less or equal to zero forces ebnf2ps to set a proper default value."
1270 :group 'ebnf-displacement)
1273 (defcustom ebnf-justify-sequence 'center
1274 "*Specify justification of terms in a sequence inside alternatives.
1278 `left' left justification
1279 `right' right justification
1280 any other value centralize"
1281 :type '(radio :tag "Sequence Justification"
1282 (const left) (const right) (other :tag "center" center))
1284 :group 'ebnf-displacement)
1287 (defcustom ebnf-special-show-delimiter t
1288 "*Non-nil means special delimiter (character `?') is shown."
1291 :group 'ebnf-special)
1294 (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
1295 "*Specify special font.
1297 See documentation for `ebnf-production-font'."
1298 :type '(list :tag "Special Font"
1299 (number :tag "Font Size")
1300 (symbol :tag "Font Name")
1301 (choice :tag "Foreground Color"
1302 (string :tag "Name")
1303 (other :tag "Default" nil))
1304 (choice :tag "Background Color"
1305 (string :tag "Name")
1306 (other :tag "Default" nil))
1307 (repeat :tag "Font Attributes" :inline t
1308 (choice (const bold) (const italic)
1309 (const underline) (const strikeout)
1310 (const overline) (const shadow)
1311 (const box) (const outline))))
1313 :group 'ebnf-special)
1316 (defcustom ebnf-special-shape 'bevel
1317 "*Specify special box shape.
1319 See documentation for `ebnf-non-terminal-shape'."
1320 :type '(radio :tag "Special Shape"
1321 (const miter) (const round) (const bevel))
1323 :group 'ebnf-special)
1326 (defcustom ebnf-special-shadow nil
1327 "*Non-nil means special box will have a shadow."
1330 :group 'ebnf-special)
1333 (defcustom ebnf-special-border-width 0.5
1334 "*Specify border width for special box."
1337 :group 'ebnf-special)
1340 (defcustom ebnf-special-border-color "Black"
1341 "*Specify border color for special box."
1344 :group 'ebnf-special)
1347 (defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
1348 "*Specify except font.
1350 See documentation for `ebnf-production-font'."
1351 :type '(list :tag "Except Font"
1352 (number :tag "Font Size")
1353 (symbol :tag "Font Name")
1354 (choice :tag "Foreground Color"
1355 (string :tag "Name")
1356 (other :tag "Default" nil))
1357 (choice :tag "Background Color"
1358 (string :tag "Name")
1359 (other :tag "Default" nil))
1360 (repeat :tag "Font Attributes" :inline t
1361 (choice (const bold) (const italic)
1362 (const underline) (const strikeout)
1363 (const overline) (const shadow)
1364 (const box) (const outline))))
1366 :group 'ebnf-except)
1369 (defcustom ebnf-except-shape 'bevel
1370 "*Specify except box shape.
1372 See documentation for `ebnf-non-terminal-shape'."
1373 :type '(radio :tag "Except Shape"
1374 (const miter) (const round) (const bevel))
1376 :group 'ebnf-except)
1379 (defcustom ebnf-except-shadow nil
1380 "*Non-nil means except box will have a shadow."
1383 :group 'ebnf-except)
1386 (defcustom ebnf-except-border-width 0.25
1387 "*Specify border width for except box."
1390 :group 'ebnf-except)
1393 (defcustom ebnf-except-border-color "Black"
1394 "*Specify border color for except box."
1397 :group 'ebnf-except)
1400 (defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
1401 "*Specify repeat font.
1403 See documentation for `ebnf-production-font'."
1404 :type '(list :tag "Repeat Font"
1405 (number :tag "Font Size")
1406 (symbol :tag "Font Name")
1407 (choice :tag "Foreground Color"
1408 (string :tag "Name")
1409 (other :tag "Default" nil))
1410 (choice :tag "Background Color"
1411 (string :tag "Name")
1412 (other :tag "Default" nil))
1413 (repeat :tag "Font Attributes" :inline t
1414 (choice (const bold) (const italic)
1415 (const underline) (const strikeout)
1416 (const overline) (const shadow)
1417 (const box) (const outline))))
1419 :group 'ebnf-repeat)
1422 (defcustom ebnf-repeat-shape 'bevel
1423 "*Specify repeat box shape.
1425 See documentation for `ebnf-non-terminal-shape'."
1426 :type '(radio :tag "Repeat Shape"
1427 (const miter) (const round) (const bevel))
1429 :group 'ebnf-repeat)
1432 (defcustom ebnf-repeat-shadow nil
1433 "*Non-nil means repeat box will have a shadow."
1436 :group 'ebnf-repeat)
1439 (defcustom ebnf-repeat-border-width 0.0
1440 "*Specify border width for repeat box."
1443 :group 'ebnf-repeat)
1446 (defcustom ebnf-repeat-border-color "Black"
1447 "*Specify border color for repeat box."
1450 :group 'ebnf-repeat)
1453 (defcustom ebnf-terminal-font '(7 Courier "Black" "White")
1454 "*Specify terminal font.
1456 See documentation for `ebnf-production-font'."
1457 :type '(list :tag "Terminal Font"
1458 (number :tag "Font Size")
1459 (symbol :tag "Font Name")
1460 (choice :tag "Foreground Color"
1461 (string :tag "Name")
1462 (other :tag "Default" nil))
1463 (choice :tag "Background Color"
1464 (string :tag "Name")
1465 (other :tag "Default" nil))
1466 (repeat :tag "Font Attributes" :inline t
1467 (choice (const bold) (const italic)
1468 (const underline) (const strikeout)
1469 (const overline) (const shadow)
1470 (const box) (const outline))))
1472 :group 'ebnf-terminal)
1475 (defcustom ebnf-terminal-shape 'miter
1476 "*Specify terminal box shape.
1478 See documentation for `ebnf-non-terminal-shape'."
1479 :type '(radio :tag "Terminal Shape"
1480 (const miter) (const round) (const bevel))
1482 :group 'ebnf-terminal)
1485 (defcustom ebnf-terminal-shadow nil
1486 "*Non-nil means terminal box will have a shadow."
1489 :group 'ebnf-terminal)
1492 (defcustom ebnf-terminal-border-width 1.0
1493 "*Specify border width for terminal box."
1496 :group 'ebnf-terminal)
1499 (defcustom ebnf-terminal-border-color "Black"
1500 "*Specify border color for terminal box."
1503 :group 'ebnf-terminal)
1506 (defcustom ebnf-production-name-p t
1507 "*Non-nil means production name will be printed."
1510 :group 'ebnf-production)
1513 (defcustom ebnf-sort-production nil
1514 "*Specify how productions are sorted.
1518 nil don't sort productions.
1519 `ascending' ascending sort.
1520 any other value descending sort."
1521 :type '(radio :tag "Production Sort"
1522 (const :tag "Ascending" ascending)
1523 (const :tag "Descending" descending)
1524 (other :tag "No Sort" nil))
1526 :group 'ebnf-production)
1529 (defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
1530 "*Specify production header font.
1532 It is a list with the following form:
1534 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1537 SIZE is the font size.
1538 NAME is the font name symbol.
1539 ATTRIBUTE is one of the following symbols:
1540 bold - use bold font.
1541 italic - use italic font.
1542 underline - put a line under text.
1543 strikeout - like underline, but the line is in middle of text.
1544 overline - like underline, but the line is over the text.
1545 shadow - text will have a shadow.
1546 box - text will be surrounded by a box.
1547 outline - print characters as hollow outlines.
1548 FOREGROUND is a foreground string color name; if it's nil, the default color is
1550 BACKGROUND is a background string color name; if it's nil, the default color is
1553 See `ps-font-info-database' for valid font name."
1554 :type '(list :tag "Production Font"
1555 (number :tag "Font Size")
1556 (symbol :tag "Font Name")
1557 (choice :tag "Foreground Color"
1558 (string :tag "Name")
1559 (other :tag "Default" nil))
1560 (choice :tag "Background Color"
1561 (string :tag "Name")
1562 (other :tag "Default" nil))
1563 (repeat :tag "Font Attributes" :inline t
1564 (choice (const bold) (const italic)
1565 (const underline) (const strikeout)
1566 (const overline) (const shadow)
1567 (const box) (const outline))))
1569 :group 'ebnf-production)
1572 (defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
1573 "*Specify non-terminal font.
1575 See documentation for `ebnf-production-font'."
1576 :type '(list :tag "Non-Terminal Font"
1577 (number :tag "Font Size")
1578 (symbol :tag "Font Name")
1579 (choice :tag "Foreground Color"
1580 (string :tag "Name")
1581 (other :tag "Default" nil))
1582 (choice :tag "Background Color"
1583 (string :tag "Name")
1584 (other :tag "Default" nil))
1585 (repeat :tag "Font Attributes" :inline t
1586 (choice (const bold) (const italic)
1587 (const underline) (const strikeout)
1588 (const overline) (const shadow)
1589 (const box) (const outline))))
1591 :group 'ebnf-non-terminal)
1594 (defcustom ebnf-non-terminal-shape 'round
1595 "*Specify non-terminal box shape.
1611 Any other value is treated as `miter'."
1612 :type '(radio :tag "Non-Terminal Shape"
1613 (const miter) (const round) (const bevel))
1615 :group 'ebnf-non-terminal)
1618 (defcustom ebnf-non-terminal-shadow nil
1619 "*Non-nil means non-terminal box will have a shadow."
1622 :group 'ebnf-non-terminal)
1625 (defcustom ebnf-non-terminal-border-width 1.0
1626 "*Specify border width for non-terminal box."
1629 :group 'ebnf-non-terminal)
1632 (defcustom ebnf-non-terminal-border-color "Black"
1633 "*Specify border color for non-terminal box."
1636 :group 'ebnf-non-terminal)
1639 (defcustom ebnf-arrow-shape 'hollow
1640 "*Specify the arrow shape.
1646 `semi-up' * `transparent' *
1654 `semi-down' =====* `hollow' *
1670 `semi-up-hollow' `semi-up-full'
1676 `semi-down-hollow' `semi-down-full'
1682 `user' See also documentation for variable `ebnf-user-arrow'.
1684 Any other value is treated as `none'."
1685 :type '(radio :tag "Arrow Shape"
1686 (const none) (const semi-up)
1687 (const semi-down) (const simple)
1688 (const transparent) (const hollow)
1689 (const full) (const semi-up-hollow)
1690 (const semi-down-hollow) (const semi-up-full)
1691 (const semi-down-full) (const user))
1696 (defcustom ebnf-chart-shape 'round
1697 "*Specify chart flow shape.
1699 See documentation for `ebnf-non-terminal-shape'."
1700 :type '(radio :tag "Chart Flow Shape"
1701 (const miter) (const round) (const bevel))
1706 (defcustom ebnf-user-arrow nil
1707 "*Specify a sexp for user arrow shape (a PostScript code).
1709 When evaluated, the sexp should return nil or a string containing PostScript
1710 code. PostScript code should draw a right arrow.
1712 The anatomy of a right arrow is:
1714 ...... Initial position
1716 : *.................
1720 ======+======*... } hT2
1724 : *.................
1730 :.......................
1732 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1733 be used to generate your own arrow. As these variables are used along
1734 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1735 values, if you need to modify them.
1737 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1739 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1741 :type '(sexp :tag "User Arrow Shape")
1746 (defcustom ebnf-syntax 'ebnf
1747 "*Specify syntax to be recognized.
1751 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1753 The following variables *ONLY* have effect with this
1755 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1756 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1758 `abnf' ebnf2ps recognizes the syntax described in the URL:
1759 `http://www.ietf.org/rfc/rfc2234.txt'
1760 (\"Augmented BNF for Syntax Specifications: ABNF\").
1762 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1763 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1764 (\"International Standard of the ISO EBNF Notation\").
1765 The following variables *ONLY* have effect with this
1767 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1769 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1770 The following variable *ONLY* has effect with this
1772 `ebnf-yac-ignore-error-recovery'.
1774 `ebnfx' ebnf2ps recognizes the syntax described in the URL:
1775 `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
1776 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1778 `dtd' ebnf2ps recognizes the syntax described in the URL:
1779 `http://www.w3.org/TR/2004/REC-xml-20040204/'
1780 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1782 Any other value is treated as `ebnf'."
1783 :type '(radio :tag "Syntax"
1784 (const ebnf) (const abnf) (const iso-ebnf)
1785 (const yacc) (const ebnfx) (const dtd))
1787 :group 'ebnf-syntactic)
1790 (defcustom ebnf-lex-comment-char ?\;
1791 "*Specify the line comment character.
1793 It's used only when `ebnf-syntax' is `ebnf'."
1796 :group 'ebnf-syntactic)
1799 (defcustom ebnf-lex-eop-char ?.
1800 "*Specify the end of production character.
1802 It's used only when `ebnf-syntax' is `ebnf'."
1805 :group 'ebnf-syntactic)
1808 (defcustom ebnf-terminal-regexp nil
1809 "*Specify how it's a terminal name.
1811 If it's nil, the terminal name must be enclosed by `\"'.
1812 If it's a string, it should be a regexp that it'll be used to determine a
1813 terminal name; terminal name may also be enclosed by `\"'.
1815 It's used only when `ebnf-syntax' is `ebnf'."
1816 :type '(radio :tag "Terminal Name"
1819 :group 'ebnf-syntactic)
1822 (defcustom ebnf-case-fold-search nil
1823 "*Non-nil means ignore case on matching.
1825 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1829 :group 'ebnf-syntactic)
1832 (defcustom ebnf-iso-alternative-p nil
1833 "*Non-nil means use alternative ISO EBNF.
1835 It's only used when `ebnf-syntax' is `iso-ebnf'.
1837 This variable affects the following symbol set:
1839 STANDARD ALTERNATIVE
1848 :group 'ebnf-syntactic)
1851 (defcustom ebnf-iso-normalize-p nil
1852 "*Non-nil means normalize ISO EBNF syntax names.
1854 Normalize a name means that several contiguous spaces inside name become a
1855 single space, so \"A B C\" is normalized to \"A B C\".
1857 It's only used when `ebnf-syntax' is `iso-ebnf'."
1860 :group 'ebnf-syntactic)
1863 (defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
1864 "*Specify file name suffix that contains EBNF.
1866 See `ebnf-eps-directory' command."
1872 (defcustom ebnf-eps-prefix "ebnf--"
1873 "*Specify EPS prefix file name.
1875 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1881 (defcustom ebnf-entry-percentage 0.5 ; middle
1882 "*Specify entry height on alternatives.
1884 It must be a float between 0.0 (top) and 1.0 (bottom)."
1890 (defcustom ebnf-default-width 0.6
1891 "*Specify additional border width over default terminal, non-terminal or
1898 ;; Printing color requires x-color-values.
1899 (defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
1900 (fboundp 'color-instance-rgb-components)) ; XEmacs
1901 "*Non-nil means use color."
1907 (defcustom ebnf-line-width 1.0
1908 "*Specify flow line width."
1914 (defcustom ebnf-line-color "Black"
1915 "*Specify flow line color."
1921 (defcustom ebnf-arrow-extra-width
1922 (if (eq ebnf-arrow-shape 'none)
1924 (* (sqrt 5.0) 0.65 ebnf-line-width))
1925 "*Specify extra width for arrow shape drawing.
1927 The extra width is used to avoid that the arrowhead and the terminal border
1928 overlap. It depens on `ebnf-arrow-shape' and `ebnf-line-width'."
1934 (defcustom ebnf-arrow-scale 1.0
1935 "*Specify the arrow scale.
1937 Values lower than 1.0, shrink the arrow.
1938 Values greater than 1.0, expand the arrow."
1944 (defcustom ebnf-debug-ps nil
1945 "*Non-nil means to generate PostScript debug procedures.
1947 It is intended to help PostScript programmers in debugging."
1953 (defcustom ebnf-use-float-format t
1954 "*Non-nil means use `%f' float format.
1956 The advantage of using float format is that ebnf2ps generates a little short
1959 If it occurs the error message:
1961 Invalid format operation %f
1963 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1969 (defcustom ebnf-stop-on-error nil
1970 "*Non-nil means signal error and stop. Otherwise, signal error and continue."
1976 (defcustom ebnf-yac-ignore-error-recovery nil
1977 "*Non-nil means ignore error recovery.
1979 It's only used when `ebnf-syntax' is `yacc'."
1982 :group 'ebnf-syntactic)
1985 (defcustom ebnf-ignore-empty-rule nil
1986 "*Non-nil means ignore empty rules.
1988 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1989 middle action rule."
1992 :group 'ebnf-optimization)
1995 (defcustom ebnf-optimize nil
1996 "*Non-nil means optimize syntactic chart of rules.
1998 The following optimizations are done:
2001 1. A = B | A C. ==> A = B {C}*.
2002 2. A = B | A B. ==> A = {B}+.
2003 3. A = | A B. ==> A = {B}*.
2004 4. A = B | A C B. ==> A = {B || C}+.
2005 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
2008 6. A = B | . ==> A = [B].
2009 7. A = | B . ==> A = [B].
2012 8. A = B C | B D. ==> A = B (C | D).
2013 9. A = C B | D B. ==> A = (C | D) B.
2014 10. A = B C E | B D E. ==> A = B (C | D) E.
2016 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
2019 :group 'ebnf-optimization)
2022 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2023 ;; To make this file smaller, some commands go in a separate file.
2024 ;; But autoload them here to make the separation invisible.
2025 ;; Autoload is here to avoid compilation gripes.
2027 (autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
2028 "Eliminate empty rules.")
2030 (autoload 'ebnf-optimize "ebnf-otz"
2031 "Syntactic chart optimizer.")
2033 (autoload 'ebnf-otz-initialize "ebnf-otz"
2034 "Initialize optimizer.")
2037 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2042 (defun ebnf-customize ()
2043 "Customization for ebnf group."
2045 (customize-group 'ebnf2ps))
2048 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2053 (defun ebnf-print-directory (&optional directory)
2054 "Generate and print a PostScript syntactic chart image of DIRECTORY.
2056 If DIRECTORY is nil, it's used `default-directory'.
2058 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2061 See also `ebnf-print-buffer'."
2063 (list (read-file-name "Directory containing EBNF files (print): "
2064 nil default-directory)))
2065 (ebnf-directory 'ebnf-print-buffer directory))
2069 (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done)
2070 "Generate and print a PostScript syntactic chart image of the file FILE.
2072 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2073 killed after process termination.
2075 See also `ebnf-print-buffer'."
2076 (interactive "fEBNF file to generate PostScript and print from: ")
2077 (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done))
2081 (defun ebnf-print-buffer (&optional filename)
2082 "Generate and print a PostScript syntactic chart image of the buffer.
2084 When called with a numeric prefix argument (C-u), prompts the user for
2085 the name of a file to save the PostScript image in, instead of sending
2088 More specifically, the FILENAME argument is treated as follows: if it
2089 is nil, send the image to the printer. If FILENAME is a string, save
2090 the PostScript image in a file with that name. If FILENAME is a
2091 number, prompt the user for the name of the file to save in."
2092 (interactive (list (ps-print-preprint current-prefix-arg)))
2093 (ebnf-print-region (point-min) (point-max) filename))
2097 (defun ebnf-print-region (from to &optional filename)
2098 "Generate and print a PostScript syntactic chart image of the region.
2099 Like `ebnf-print-buffer', but prints just the current region."
2100 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
2101 (run-hooks 'ebnf-hook)
2102 (or (ebnf-spool-region from to)
2103 (ps-do-despool filename)))
2107 (defun ebnf-spool-directory (&optional directory)
2108 "Generate and spool a PostScript syntactic chart image of DIRECTORY.
2110 If DIRECTORY is nil, it's used `default-directory'.
2112 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2115 See also `ebnf-spool-buffer'."
2117 (list (read-file-name "Directory containing EBNF files (spool): "
2118 nil default-directory)))
2119 (ebnf-directory 'ebnf-spool-buffer directory))
2123 (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done)
2124 "Generate and spool a PostScript syntactic chart image of the file FILE.
2126 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2127 killed after process termination.
2129 See also `ebnf-spool-buffer'."
2130 (interactive "fEBNF file to generate PostScript and spool from: ")
2131 (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done))
2135 (defun ebnf-spool-buffer ()
2136 "Generate and spool a PostScript syntactic chart image of the buffer.
2137 Like `ebnf-print-buffer' except that the PostScript image is saved in a
2138 local buffer to be sent to the printer later.
2140 Use the command `ebnf-despool' to send the spooled images to the printer."
2142 (ebnf-spool-region (point-min) (point-max)))
2146 (defun ebnf-spool-region (from to)
2147 "Generate a PostScript syntactic chart image of the region and spool locally.
2148 Like `ebnf-spool-buffer', but spools just the current region.
2150 Use the command `ebnf-despool' to send the spooled images to the printer."
2152 (ebnf-generate-region from to 'ebnf-generate))
2156 (defun ebnf-eps-directory (&optional directory)
2157 "Generate EPS files from EBNF files in DIRECTORY.
2159 If DIRECTORY is nil, it's used `default-directory'.
2161 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2164 See also `ebnf-eps-buffer'."
2166 (list (read-file-name "Directory containing EBNF files (EPS): "
2167 nil default-directory)))
2168 (ebnf-directory 'ebnf-eps-buffer directory))
2172 (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done)
2173 "Generate an EPS file from EBNF file FILE.
2175 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2176 killed after EPS generation.
2178 See also `ebnf-eps-buffer'."
2179 (interactive "fEBNF file to generate EPS file from: ")
2180 (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done))
2184 (defun ebnf-eps-buffer ()
2185 "Generate a PostScript syntactic chart image of the buffer in a EPS file.
2187 Indeed, for each production is generated a EPS file.
2188 The EPS file name has the following form:
2190 <PREFIX><PRODUCTION>.eps
2192 <PREFIX> is given by variable `ebnf-eps-prefix'.
2193 The default value is \"ebnf--\".
2195 <PRODUCTION> is the production name.
2196 The production name is mapped to form a valid file name.
2197 For example, the production name \"A/B + C\" is mapped to
2198 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2200 WARNING: It's *NOT* asked any confirmation to override an existing file."
2202 (ebnf-eps-region (point-min) (point-max)))
2206 (defun ebnf-eps-region (from to)
2207 "Generate a PostScript syntactic chart image of the region in a EPS file.
2209 Indeed, for each production is generated a EPS file.
2210 The EPS file name has the following form:
2212 <PREFIX><PRODUCTION>.eps
2214 <PREFIX> is given by variable `ebnf-eps-prefix'.
2215 The default value is \"ebnf--\".
2217 <PRODUCTION> is the production name.
2218 The production name is mapped to form a valid file name.
2219 For example, the production name \"A/B + C\" is mapped to
2220 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2222 WARNING: It's *NOT* asked any confirmation to override an existing file."
2224 (let ((ebnf-eps-executing t))
2225 (ebnf-generate-region from to 'ebnf-generate-eps)))
2229 (defalias 'ebnf-despool 'ps-despool)
2233 (defun ebnf-syntax-directory (&optional directory)
2234 "Does a syntactic analysis of the files in DIRECTORY.
2236 If DIRECTORY is nil, it's used `default-directory'.
2238 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2241 See also `ebnf-syntax-buffer'."
2243 (list (read-file-name "Directory containing EBNF files (syntax): "
2244 nil default-directory)))
2245 (ebnf-directory 'ebnf-syntax-buffer directory))
2249 (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done)
2250 "Does a syntactic analysis of the FILE.
2252 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2253 killed after syntax checking.
2255 See also `ebnf-syntax-buffer'."
2256 (interactive "fEBNF file to check syntax: ")
2257 (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done))
2261 (defun ebnf-syntax-buffer ()
2262 "Does a syntactic analysis of the current buffer."
2264 (ebnf-syntax-region (point-min) (point-max)))
2268 (defun ebnf-syntax-region (from to)
2269 "Does a syntactic analysis of a region."
2271 (ebnf-generate-region from to nil))
2274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2279 (defun ebnf-setup ()
2280 "Return the current ebnf2ps setup."
2283 ;;; ebnf2ps.el version %s
2285 \(setq ebnf-special-show-delimiter %S
2286 ebnf-special-font %s
2287 ebnf-special-shape %s
2288 ebnf-special-shadow %S
2289 ebnf-special-border-width %S
2290 ebnf-special-border-color %S
2292 ebnf-except-shape %s
2293 ebnf-except-shadow %S
2294 ebnf-except-border-width %S
2295 ebnf-except-border-color %S
2297 ebnf-repeat-shape %s
2298 ebnf-repeat-shadow %S
2299 ebnf-repeat-border-width %S
2300 ebnf-repeat-border-color %S
2301 ebnf-terminal-regexp %S
2302 ebnf-case-fold-search %S
2303 ebnf-terminal-font %s
2304 ebnf-terminal-shape %s
2305 ebnf-terminal-shadow %S
2306 ebnf-terminal-border-width %S
2307 ebnf-terminal-border-color %S
2308 ebnf-non-terminal-font %s
2309 ebnf-non-terminal-shape %s
2310 ebnf-non-terminal-shadow %S
2311 ebnf-non-terminal-border-width %S
2312 ebnf-non-terminal-border-color %S
2313 ebnf-production-name-p %S
2314 ebnf-sort-production %s
2315 ebnf-production-font %s
2319 ebnf-horizontal-orientation %S
2320 ebnf-horizontal-max-height %S
2321 ebnf-production-horizontal-space %S
2322 ebnf-production-vertical-space %S
2323 ebnf-justify-sequence %s
2324 ebnf-lex-comment-char ?\\%03o
2325 ebnf-lex-eop-char ?\\%03o
2327 ebnf-iso-alternative-p %S
2328 ebnf-iso-normalize-p %S
2329 ebnf-file-suffix-regexp %S
2331 ebnf-entry-percentage %S
2336 ebnf-use-float-format %S
2337 ebnf-stop-on-error %S
2338 ebnf-yac-ignore-error-recovery %S
2339 ebnf-ignore-empty-rule %S
2342 ;;; ebnf2ps.el - end of settings
2345 ebnf-special-show-delimiter
2346 (ps-print-quote ebnf-special-font)
2347 (ps-print-quote ebnf-special-shape)
2349 ebnf-special-border-width
2350 ebnf-special-border-color
2351 (ps-print-quote ebnf-except-font)
2352 (ps-print-quote ebnf-except-shape)
2354 ebnf-except-border-width
2355 ebnf-except-border-color
2356 (ps-print-quote ebnf-repeat-font)
2357 (ps-print-quote ebnf-repeat-shape)
2359 ebnf-repeat-border-width
2360 ebnf-repeat-border-color
2361 ebnf-terminal-regexp
2362 ebnf-case-fold-search
2363 (ps-print-quote ebnf-terminal-font)
2364 (ps-print-quote ebnf-terminal-shape)
2365 ebnf-terminal-shadow
2366 ebnf-terminal-border-width
2367 ebnf-terminal-border-color
2368 (ps-print-quote ebnf-non-terminal-font)
2369 (ps-print-quote ebnf-non-terminal-shape)
2370 ebnf-non-terminal-shadow
2371 ebnf-non-terminal-border-width
2372 ebnf-non-terminal-border-color
2373 ebnf-production-name-p
2374 (ps-print-quote ebnf-sort-production)
2375 (ps-print-quote ebnf-production-font)
2376 (ps-print-quote ebnf-arrow-shape)
2377 (ps-print-quote ebnf-chart-shape)
2378 (ps-print-quote ebnf-user-arrow)
2379 ebnf-horizontal-orientation
2380 ebnf-horizontal-max-height
2381 ebnf-production-horizontal-space
2382 ebnf-production-vertical-space
2383 (ps-print-quote ebnf-justify-sequence)
2384 ebnf-lex-comment-char
2386 (ps-print-quote ebnf-syntax)
2387 ebnf-iso-alternative-p
2388 ebnf-iso-normalize-p
2389 ebnf-file-suffix-regexp
2391 ebnf-entry-percentage
2396 ebnf-use-float-format
2398 ebnf-yac-ignore-error-recovery
2399 ebnf-ignore-empty-rule
2403 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2407 (defvar ebnf-stack-style nil
2408 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2412 (defvar ebnf-current-style 'default
2413 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2416 (defconst ebnf-style-custom-list
2417 '(ebnf-special-show-delimiter
2421 ebnf-special-border-width
2422 ebnf-special-border-color
2426 ebnf-except-border-width
2427 ebnf-except-border-color
2431 ebnf-repeat-border-width
2432 ebnf-repeat-border-color
2433 ebnf-terminal-regexp
2434 ebnf-case-fold-search
2437 ebnf-terminal-shadow
2438 ebnf-terminal-border-width
2439 ebnf-terminal-border-color
2440 ebnf-non-terminal-font
2441 ebnf-non-terminal-shape
2442 ebnf-non-terminal-shadow
2443 ebnf-non-terminal-border-width
2444 ebnf-non-terminal-border-color
2445 ebnf-production-name-p
2446 ebnf-sort-production
2447 ebnf-production-font
2451 ebnf-horizontal-orientation
2452 ebnf-horizontal-max-height
2453 ebnf-production-horizontal-space
2454 ebnf-production-vertical-space
2455 ebnf-justify-sequence
2456 ebnf-lex-comment-char
2459 ebnf-iso-alternative-p
2460 ebnf-iso-normalize-p
2461 ebnf-file-suffix-regexp
2463 ebnf-entry-percentage
2468 ebnf-use-float-format
2470 ebnf-yac-ignore-error-recovery
2471 ebnf-ignore-empty-rule
2473 "List of valid symbol custom variable.")
2476 (defvar ebnf-style-database
2480 (ebnf-special-show-delimiter . t)
2481 (ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic))
2482 (ebnf-special-shape . 'bevel)
2483 (ebnf-special-shadow . nil)
2484 (ebnf-special-border-width . 0.5)
2485 (ebnf-special-border-color . "Black")
2486 (ebnf-except-font . '(7 Courier "Black" "Gray90" bold italic))
2487 (ebnf-except-shape . 'bevel)
2488 (ebnf-except-shadow . nil)
2489 (ebnf-except-border-width . 0.25)
2490 (ebnf-except-border-color . "Black")
2491 (ebnf-repeat-font . '(7 Courier "Black" "Gray85" bold italic))
2492 (ebnf-repeat-shape . 'bevel)
2493 (ebnf-repeat-shadow . nil)
2494 (ebnf-repeat-border-width . 0.0)
2495 (ebnf-repeat-border-color . "Black")
2496 (ebnf-terminal-regexp . nil)
2497 (ebnf-case-fold-search . nil)
2498 (ebnf-terminal-font . '(7 Courier "Black" "White"))
2499 (ebnf-terminal-shape . 'miter)
2500 (ebnf-terminal-shadow . nil)
2501 (ebnf-terminal-border-width . 1.0)
2502 (ebnf-terminal-border-color . "Black")
2503 (ebnf-non-terminal-font . '(7 Helvetica "Black" "White"))
2504 (ebnf-non-terminal-shape . 'round)
2505 (ebnf-non-terminal-shadow . nil)
2506 (ebnf-non-terminal-border-width . 1.0)
2507 (ebnf-non-terminal-border-color . "Black")
2508 (ebnf-production-name-p . t)
2509 (ebnf-sort-production . nil)
2510 (ebnf-production-font . '(10 Helvetica "Black" "White" bold))
2511 (ebnf-arrow-shape . 'hollow)
2512 (ebnf-chart-shape . 'round)
2513 (ebnf-user-arrow . nil)
2514 (ebnf-horizontal-orientation . nil)
2515 (ebnf-horizontal-max-height . nil)
2516 (ebnf-production-horizontal-space . 0.0)
2517 (ebnf-production-vertical-space . 0.0)
2518 (ebnf-justify-sequence . 'center)
2519 (ebnf-lex-comment-char . ?\;)
2520 (ebnf-lex-eop-char . ?.)
2521 (ebnf-syntax . 'ebnf)
2522 (ebnf-iso-alternative-p . nil)
2523 (ebnf-iso-normalize-p . nil)
2524 (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$")
2525 (ebnf-eps-prefix . "ebnf--")
2526 (ebnf-entry-percentage . 0.5)
2527 (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
2528 (fboundp 'color-instance-rgb-components))) ; XEmacs
2529 (ebnf-line-width . 1.0)
2530 (ebnf-line-color . "Black")
2531 (ebnf-debug-ps . nil)
2532 (ebnf-use-float-format . t)
2533 (ebnf-stop-on-error . nil)
2534 (ebnf-yac-ignore-error-recovery . nil)
2535 (ebnf-ignore-empty-rule . nil)
2536 (ebnf-optimize . nil))
2537 ;; Happy EBNF default
2540 (ebnf-justify-sequence . 'left)
2541 (ebnf-lex-comment-char . ?\#)
2542 (ebnf-lex-eop-char . ?\;))
2546 (ebnf-syntax . 'abnf))
2550 (ebnf-syntax . 'iso-ebnf))
2551 ;; Yacc/Bison default
2554 (ebnf-syntax . 'yacc))
2558 (ebnf-syntax . 'ebnfx))
2562 (ebnf-syntax . 'dtd))
2566 Each element has the following form:
2568 (NAME INHERITS (VAR . VALUE)...)
2572 NAME is a symbol name style.
2574 INHERITS is a symbol name style from which the current style inherits
2575 the context. If INHERITS is nil, means that there is no
2578 This is a simple inheritance of style; so if you declare that a
2579 style A inherits from a style B, all settings of B is applied
2580 first and then the settings of A is applied. This is useful
2581 when you wish to modify some aspects of an existing style, but
2582 at same time wish to keep it unmodified.
2584 VAR is a valid ebnf2ps symbol custom variable.
2585 See `ebnf-style-custom-list' for valid symbol variable.
2587 VALUE is a sexp which it'll be evaluated to set the value to VAR.
2588 So, don't forget to quote symbols and constant lists.
2589 See `default' style for an example.
2591 Don't handle this variable directly. Use functions `ebnf-insert-style',
2592 `ebnf-delete-style' and `ebnf-merge-style'.")
2595 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2600 (defun ebnf-insert-style (name inherits &rest values)
2601 "Insert a new style NAME with inheritance INHERITS and values VALUES.
2603 See `ebnf-style-database' documentation."
2604 (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
2605 (and (assoc name ebnf-style-database)
2606 (error "Style name already exists: %s" name))
2607 (or (assoc inherits ebnf-style-database)
2608 (error "Style inheritance name does'nt exist: %s" inherits))
2609 (setq ebnf-style-database
2610 (cons (cons name (cons inherits (ebnf-check-style-values values)))
2611 ebnf-style-database)))
2615 (defun ebnf-delete-style (name)
2618 See `ebnf-style-database' documentation."
2619 (interactive "SDelete style name: ")
2620 (or (assoc name ebnf-style-database)
2621 (error "Style name doesn't exist: %s" name))
2622 (let ((db ebnf-style-database))
2624 (and (eq (nth 1 (car db)) name)
2625 (error "Style name `%s' is inherited by `%s' style"
2626 name (nth 0 (car db))))
2627 (setq db (cdr db))))
2628 (setq ebnf-style-database (assq-delete-all name ebnf-style-database)))
2632 (defun ebnf-merge-style (name &rest values)
2633 "Merge values of style NAME with style VALUES.
2635 See `ebnf-style-database' documentation."
2636 (interactive "SStyle name: \nXStyle values: ")
2637 (let ((style (or (assoc name ebnf-style-database)
2638 (error "Style name does'nt exist: %s" name)))
2639 (merge (ebnf-check-style-values values))
2641 ;; modify value of existing variables
2642 (setq val (nthcdr 2 style))
2644 (setq check (car merge)
2646 elt (assoc (car check) val))
2648 (setcdr elt (cdr check))
2649 (setq new (cons check new))))
2650 ;; insert new variables
2651 (nconc style (nreverse new))))
2655 (defun ebnf-apply-style (style)
2656 "Set STYLE as the current style.
2658 It returns the old style symbol.
2660 See `ebnf-style-database' documentation."
2661 (interactive "SApply style: ")
2664 (and (ebnf-apply-style1 style)
2665 (setq ebnf-current-style style))))
2669 (defun ebnf-reset-style (&optional style)
2670 "Reset current style.
2672 It returns the old style symbol.
2674 See `ebnf-style-database' documentation."
2675 (interactive "SReset style: ")
2676 (setq ebnf-stack-style nil)
2677 (ebnf-apply-style (or style 'default)))
2681 (defun ebnf-push-style (&optional style)
2682 "Push the current style and set STYLE as the current style.
2684 It returns the old style symbol.
2686 See `ebnf-style-database' documentation."
2687 (interactive "SPush style: ")
2690 (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
2692 (ebnf-apply-style style))))
2696 (defun ebnf-pop-style ()
2697 "Pop a style and set it as the current style.
2699 It returns the old style symbol.
2701 See `ebnf-style-database' documentation."
2704 (ebnf-apply-style (car ebnf-stack-style))
2705 (setq ebnf-stack-style (cdr ebnf-stack-style))))
2708 (defun ebnf-apply-style1 (style)
2709 (let ((value (cdr (assoc style ebnf-style-database))))
2712 (and (car value) (ebnf-apply-style1 (car value)))
2713 (while (setq value (cdr value))
2714 (set (caar value) (eval (cdar value)))))))
2717 (defun ebnf-check-style-values (values)
2720 (and (memq (caar values) ebnf-style-custom-list)
2721 (setq style (cons (car values) style)))
2722 (setq values (cdr values)))
2726 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2727 ;; Internal variables
2730 (defvar ebnf-eps-buffer-name " *EPS*")
2731 (defvar ebnf-parser-func nil)
2732 (defvar ebnf-eps-executing nil)
2733 (defvar ebnf-eps-upper-x 0.0)
2734 (make-variable-buffer-local 'ebnf-eps-upper-x)
2735 (defvar ebnf-eps-upper-y 0.0)
2736 (make-variable-buffer-local 'ebnf-eps-upper-y)
2737 (defvar ebnf-eps-prod-width 0.0)
2738 (make-variable-buffer-local 'ebnf-eps-prod-width)
2739 (defvar ebnf-eps-max-height 0.0)
2740 (make-variable-buffer-local 'ebnf-eps-max-height)
2741 (defvar ebnf-eps-max-width 0.0)
2742 (make-variable-buffer-local 'ebnf-eps-max-width)
2745 (defvar ebnf-eps-context nil
2746 "List of EPS file name during parsing.
2748 See section \"Actions in Comments\" in ebnf2ps documentation.")
2751 (defvar ebnf-eps-production-list nil
2752 "Alist associating production name with EPS file name list.
2754 Each element has the following form:
2756 (PRODUCTION EPS-FILENAME...)
2758 PRODUCTION is the production name.
2759 EPS-FILENAME is the EPS file name.
2761 It's generated during parsing and used during EPS generation.
2763 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2767 (defconst ebnf-arrow-shape-alist
2775 (semi-up-hollow . 7)
2777 (semi-down-hollow . 9)
2778 (semi-down-full . 10)
2780 "Alist associating values for `ebnf-arrow-shape'.
2782 See documentation for `ebnf-arrow-shape'.")
2785 (defconst ebnf-terminal-shape-alist
2789 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2791 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2792 `ebnf-chart-shape'.")
2795 (defvar ebnf-limit nil)
2796 (defvar ebnf-action nil)
2797 (defvar ebnf-action-list nil)
2800 (defvar ebnf-default-p nil)
2803 (defvar ebnf-font-height-P 0)
2804 (defvar ebnf-font-height-T 0)
2805 (defvar ebnf-font-height-NT 0)
2806 (defvar ebnf-font-height-S 0)
2807 (defvar ebnf-font-height-E 0)
2808 (defvar ebnf-font-height-R 0)
2809 (defvar ebnf-font-width-P 0)
2810 (defvar ebnf-font-width-T 0)
2811 (defvar ebnf-font-width-NT 0)
2812 (defvar ebnf-font-width-S 0)
2813 (defvar ebnf-font-width-E 0)
2814 (defvar ebnf-font-width-R 0)
2815 (defvar ebnf-space-T 0)
2816 (defvar ebnf-space-NT 0)
2817 (defvar ebnf-space-S 0)
2818 (defvar ebnf-space-E 0)
2819 (defvar ebnf-space-R 0)
2822 (defvar ebnf-basic-width 0)
2823 (defvar ebnf-basic-height 0)
2824 (defvar ebnf-vertical-space 0)
2825 (defvar ebnf-horizontal-space 0)
2828 (defvar ebnf-settings nil)
2829 (defvar ebnf-fonts-required nil)
2832 (defconst ebnf-debug
2834 % === begin EBNF procedures to help debugging
2836 % Mark visually current point: string debug
2840 gsave -s- show grestore
2852 % Show number value: number string debug-number
2855 20 0 rmoveto show ([) show 60 string cvs show (]) show
2859 % === end EBNF procedures to help debugging
2862 "This is intended to help debugging PostScript programming.")
2865 (defconst ebnf-prologue
2867 % === begin EBNF engine
2869 % --- Basic Definitions
2872 /SpaceS FontHeight 0.5 mul def
2873 /HeightS FontHeight FontHeight add def
2876 /SpaceE FontHeight 0.5 mul def
2877 /HeightE FontHeight FontHeight add def
2880 /SpaceR FontHeight 0.5 mul def
2881 /HeightR FontHeight FontHeight add def
2884 /SpaceT FontHeight 0.5 mul def
2885 /HeightT FontHeight FontHeight add def
2888 /SpaceNT FontHeight 0.5 mul def
2889 /HeightNT FontHeight FontHeight add def
2891 /T HeightT HeightNT add 0.5 mul def
2893 /hT2 hT 0.5 mul ArrowScale mul def
2894 /hT4 hT 0.25 mul ArrowScale mul def
2896 /Er 0.1 def % Error factor
2899 /c{currentpoint}bind def
2900 /xyi{/xi c /yi exch def def}bind def
2901 /xyo{/xo c /yo exch def def}bind def
2902 /xyp{/xp c /yp exch def def}bind def
2903 /xyt{/xt c /yt exch def def}bind def
2905 % vertical movement: x y height vm
2906 /vm{add moveto}bind def
2908 % horizontal movement: x y width hm
2909 /hm{3 -1 roll exch add exch moveto}bind def
2911 % set color: [R G B] SetRGB
2912 /SetRGB{aload pop setrgbcolor}bind def
2914 % filling gray area: gray-scale FillGray
2915 /FillGray{gsave setgray fill grestore}bind def
2917 % filling color area: [R G B] FillRGB
2918 /FillRGB{gsave SetRGB fill grestore}bind def
2920 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2921 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2922 /Gstroke{gsave Stroke grestore}bind def
2924 % Empty Line: width EL
2925 /EL{0 rlineto Gstroke}bind def
2929 /Down{hT2 neg hT4 neg rlineto}bind def
2932 {hT2 neg hT4 rmoveto
2937 /ArrowPath{c newpath moveto Arrow closepath}bind def
2961 {hT2 neg hT4 rlineto} % 1 - semi-up
2962 {Down} % 2 - semi-down
2963 {Arrow} % 3 - simple
2964 {Gstroke ArrowPath} % 4 - transparent
2965 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2966 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2967 {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
2968 {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
2969 {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
2970 {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
2971 {Gstroke gsave UserArrow grestore} % 11 - user
2977 RA-vector ArrowShape get exec
2980 ExtraWidth 0 rmoveto
2983 % rotation DrawArrow
2998 /LA{180 DrawArrow}def
3005 /UA{90 DrawArrow}def
3012 /DA{270 DrawArrow}def
3016 %>corner Right Descendent: height arrow corner_RD
3018 % / height > 0 | 0 - none
3020 % * ---------- | 2 - left
3039 h 0 gt{DA}{UA}ifelse
3044 [{cRD0-vector arrow get exec} % 0 - miter
3045 {0 0 0 h hT h rcurveto} % 1 - rounded
3046 {hT h rlineto} % 2 - bevel
3050 {/arrow exch def /h exch def
3051 cRD-vector ChartShape get exec
3055 %>corner Right Ascendent: height arrow corner_RA
3057 % | height > 0 | 0 - none
3059 % *- ---------- | 2 - left
3077 h 0 gt{DA}{UA}ifelse
3083 [{cRA0-vector arrow get exec} % 0 - miter
3084 {0 0 hT 0 hT h rcurveto} % 1 - rounded
3085 {hT h rlineto} % 2 - bevel
3089 {/arrow exch def /h exch def
3090 cRA-vector ChartShape get exec
3094 %>corner Left Descendent: height arrow corner_LD
3096 % \\ height > 0 | 0 - none
3098 % * ---------- | 2 - left
3107 {hT neg h rmoveto xyi
3115 {hT neg h rmoveto xyi
3117 h 0 gt{DA}{UA}ifelse
3122 [{cLD0-vector arrow get exec} % 0 - miter
3123 {0 0 0 h hT neg h rcurveto} % 1 - rounded
3124 {hT neg h rlineto} % 2 - bevel
3128 {/arrow exch def /h exch def
3129 cLD-vector ChartShape get exec
3133 %>corner Left Ascendent: height arrow corner_LA
3135 % | height > 0 | 0 - none
3137 % -* ---------- | 2 - left
3146 {hT neg h rmoveto xyi
3154 {hT neg h rmoveto xyi
3155 h 0 gt{DA}{UA}ifelse
3161 [{cLA0-vector arrow get exec} % 0 - miter
3162 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
3163 {hT neg h rlineto} % 2 - bevel
3167 {/arrow exch def /h exch def
3168 cLA-vector ChartShape get exec
3174 % height prepare_height |- line_height corner_height corner_height
3178 {T add hT neg}ifelse
3182 %>Left Alternative: height LAlt
3209 %>Left Loop: height LLoop
3228 %>Right Alternative: height RAlt
3242 {T neg exch rlineto}
3255 %>Right Loop: height RLoop
3274 % --- Terminal, Non-terminal and Special Basics
3276 % string width prepare-width |- string
3279 dup stringwidth pop space add space add width exch sub ExtraWidth sub 0.5 mul
3283 % string width begin-right
3293 {xo width add Er add yo moveto
3298 % string width begin-left
3307 {xo width add Er add yo moveto
3320 {/half YY yy sub 0.5 mul abs def
3321 xx half add YY moveto
3322 0 0 half neg 0 half neg half neg rcurveto
3323 0 0 0 half neg half half neg rcurveto
3324 XX xx sub abs half sub half sub 0 rlineto
3325 0 0 half 0 half half rcurveto
3326 0 0 0 half half neg half rcurveto}
3328 {/quarter YY yy sub 0.25 mul abs def
3329 xx quarter add YY moveto
3330 quarter neg quarter neg rlineto
3331 0 quarter quarter add neg rlineto
3332 quarter quarter neg rlineto
3333 XX xx sub abs quarter sub quarter sub 0 rlineto
3334 quarter quarter rlineto
3335 0 quarter quarter add rlineto
3336 quarter neg quarter rlineto}
3341 ShapePath-vector shape get exec
3347 Xshadow Xshadow add Xshadow add
3348 Yshadow Yshadow add Yshadow add translate
3362 % string SBound |- string
3364 {/xx c dup /yy exch def
3365 FontHeight add /YY exch def def
3366 dup stringwidth pop xx add /XX exch def
3368 {/yy yy YShadow add def
3369 /XX XX XShadow add def
3378 /XX XX space add space add def
3379 /YY YY space add def
3380 /yy yy space sub def
3381 shadow{doShapeShadow}if
3383 space Descent abs rmoveto
3390 % TeRminal: string TR
3392 {/Effect EffectT def
3394 /shapecolor BackgroundT def
3395 /borderwidth BorderWidthT def
3396 /bordercolor BorderColorT def
3397 /foreground ForegroundT def
3402 %>Right Terminal: string width RT |- x y
3413 %>Left Terminal: string width LT |- x y
3424 %>Right Terminal Default: string width RTD |- x y
3426 {/-save- BorderWidthT def
3427 /BorderWidthT BorderWidthT DefaultWidth add def
3429 /BorderWidthT -save- def
3432 %>Left Terminal Default: string width LTD |- x y
3434 {/-save- BorderWidthT def
3435 /BorderWidthT BorderWidthT DefaultWidth add def
3437 /BorderWidthT -save- def
3442 % Non-Terminal: string NT
3444 {/Effect EffectNT def
3446 /shapecolor BackgroundNT def
3447 /borderwidth BorderWidthNT def
3448 /bordercolor BorderColorNT def
3449 /foreground ForegroundNT def
3450 /shadow ShadowNT def
3454 %>Right Non-Terminal: string width RNT |- x y
3465 %>Left Non-Terminal: string width LNT |- x y
3476 %>Right Non-Terminal Default: string width RNTD |- x y
3478 {/-save- BorderWidthNT def
3479 /BorderWidthNT BorderWidthNT DefaultWidth add def
3481 /BorderWidthNT -save- def
3484 %>Left Non-Terminal Default: string width LNTD |- x y
3486 {/-save- BorderWidthNT def
3487 /BorderWidthNT BorderWidthNT DefaultWidth add def
3489 /BorderWidthNT -save- def
3494 % SPecial: string SP
3496 {/Effect EffectS def
3498 /shapecolor BackgroundS def
3499 /borderwidth BorderWidthS def
3500 /bordercolor BorderColorS def
3501 /foreground ForegroundS def
3506 %>Right SPecial: string width RSP |- x y
3517 %>Left SPecial: string width LSP |- x y
3528 %>Right SPecial Default: string width RSPD |- x y
3530 {/-save- BorderWidthS def
3531 /BorderWidthS BorderWidthS DefaultWidth add def
3533 /BorderWidthS -save- def
3536 %>Left SPecial Default: string width LSPD |- x y
3538 {/-save- BorderWidthS def
3539 /BorderWidthS BorderWidthS DefaultWidth add def
3541 /BorderWidthS -save- def
3544 % --- Repeat and Except basics
3547 {/w width rwidth sub 0.5 mul def
3552 /xx c entry add /YY exch def def
3553 /yy YY height sub def
3554 /XX xx rwidth add def
3555 shadow{doShapeShadow}if
3578 % entry height width rwidth begin-repeat
3588 /shapecolor BackgroundR def
3589 /borderwidth BorderWidthR def
3590 /bordercolor BorderColorR def
3591 /foreground ForegroundR def
3596 % string end-repeat |- x y
3599 space Descent rmoveto
3603 exch space add exch moveto
3607 %>Right RePeat: string entry height width rwidth RRP |- x y
3608 /RRP{begin-repeat right-direction end-repeat}def
3610 %>Left RePeat: string entry height width rwidth LRP |- x y
3611 /LRP{begin-repeat left-direction end-repeat}def
3615 % entry height width rwidth begin-except
3625 /shapecolor BackgroundE def
3626 /borderwidth BorderWidthE def
3627 /bordercolor BorderColorE def
3628 /foreground ForegroundE def
3633 % x-width end-except |- x y
3636 space space add add Descent rmoveto
3637 (-) foreground SetRGB S
3643 %>Right EXcept: x-width entry height width rwidth REX |- x y
3644 /REX{begin-except right-direction end-except}def
3646 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3647 /LEX{begin-except left-direction end-except}def
3651 %>Beginning Of Sequence: BOS |- x y
3652 /BOS{currentpoint}bind def
3654 %>End Of Sequence: x y x1 y1 EOS |- x y
3655 /EOS{pop pop}bind def
3659 %>Beginning Of Production: string width height BOP |- y x
3662 neg yp add /yw exch def
3663 xp add T sub /xw exch def
3664 dup length 0 gt % empty string ==> no production name
3665 {/Effect EffectP def
3666 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3676 %>End Of Production: y x delta EOP
3677 /EOPH{add exch moveto}bind def % horizontal
3678 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3680 % --- Empty Alternative
3682 %>Empty Alternative: width EA |- x y
3693 %>AlTernative: h1 h2 ... hn n width AT |- x y
3695 {xyo xo add /xw exch def
3707 %>OPtional: height width OP |- x y
3724 %>One or More: height width OM |- x y
3738 %>Zero or More: h2 h1 width ZM |- x y
3748 yo add xo T add exch moveto
3752 % === end EBNF engine
3755 "EBNF PostScript prologue")
3758 (defconst ebnf-eps-prologue
3760 /#ebnf2ps#dict 230 dict def
3763 % Initiliaze variables to avoid name-conflicting with document variables.
3764 % This is the case when using `bind' operator.
3765 /-fillp- 0 def /h 0 def
3766 /-ox- 0 def /half 0 def
3767 /-oy- 0 def /height 0 def
3768 /-save- 0 def /ow 0 def
3769 /Ascent 0 def /quarter 0 def
3770 /Descent 0 def /rXX 0 def
3771 /Effect 0 def /rYY 0 def
3772 /FontHeight 0 def /rwidth 0 def
3773 /LineThickness 0 def /rxx 0 def
3774 /OverlinePosition 0 def /ryy 0 def
3775 /SpaceBackground 0 def /shadow 0 def
3776 /StrikeoutPosition 0 def /shape 0 def
3777 /UnderlinePosition 0 def /shapecolor 0 def
3778 /XBox 0 def /space 0 def
3779 /XX 0 def /st 1 string def
3780 /Xshadow 0 def /w 0 def
3781 /YBox 0 def /width 0 def
3783 /Yshadow 0 def /xo 0 def
3784 /arrow 0 def /xp 0 def
3785 /bg false def /xt 0 def
3786 /bgcolor 0 def /xw 0 def
3787 /bordercolor 0 def /xx 0 def
3788 /borderwidth 0 def /yi 0 def
3790 /entry 0 def /yp 0 def
3791 /foreground 0 def /yt 0 def
3795 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3796 /ISOLatin1Encoding where
3798 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3799 % -- The first half is the same as the standard encoding,
3800 % -- except for minus instead of hyphen at code 055.
3802 StandardEncoding 0 45 getinterval aload pop
3804 StandardEncoding 46 82 getinterval aload pop
3805 %*** NOTE: the following are missing in the Adobe documentation,
3806 %*** but appear in the displayed table:
3807 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3809 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3810 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3811 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3812 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3814 /space /exclamdown /cent /sterling
3815 /currency /yen /brokenbar /section
3816 /dieresis /copyright /ordfeminine /guillemotleft
3817 /logicalnot /hyphen /registered /macron
3818 /degree /plusminus /twosuperior /threesuperior
3819 /acute /mu /paragraph /periodcentered
3820 /cedilla /onesuperior /ordmasculine /guillemotright
3821 /onequarter /onehalf /threequarters /questiondown
3823 /Agrave /Aacute /Acircumflex /Atilde
3824 /Adieresis /Aring /AE /Ccedilla
3825 /Egrave /Eacute /Ecircumflex /Edieresis
3826 /Igrave /Iacute /Icircumflex /Idieresis
3827 /Eth /Ntilde /Ograve /Oacute
3828 /Ocircumflex /Otilde /Odieresis /multiply
3829 /Oslash /Ugrave /Uacute /Ucircumflex
3830 /Udieresis /Yacute /Thorn /germandbls
3832 /agrave /aacute /acircumflex /atilde
3833 /adieresis /aring /ae /ccedilla
3834 /egrave /eacute /ecircumflex /edieresis
3835 /igrave /iacute /icircumflex /idieresis
3836 /eth /ntilde /ograve /oacute
3837 /ocircumflex /otilde /odieresis /divide
3838 /oslash /ugrave /uacute /ucircumflex
3839 /udieresis /yacute /thorn /ydieresis
3843 /reencodeFontISO %def
3845 length 12 add dict % Make a new font (a new dict the same size
3846 % as the old one) with room for our new symbols.
3848 begin % Make the new font the current dictionary.
3850 {def}{pop pop}ifelse
3851 }forall % Copy each of the symbols from the old dictionary
3852 % to the new one except for the font ID.
3854 currentdict /FontType get 0 ne
3855 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3856 % the ISOLatin1 encoding.
3858 % Use the font's bounding box to determine the ascent, descent,
3859 % and overall height; don't forget that these values have to be
3860 % transformed using the font's matrix.
3867 % | | | | Ascent (usually > 0)
3869 % (0 0) -> +--+----+-------->
3871 % | | v Descent (usually < 0)
3872 % (x1 y1) --> +----+ - -
3874 currentdict /FontType get 0 ne
3875 {/FontBBox load aload pop % -- x1 y1 x2 y2
3876 FontMatrix transform /Ascent exch def pop
3877 FontMatrix transform /Descent exch def pop}
3878 {/PrimaryFont FDepVector 0 get def
3879 PrimaryFont /FontBBox get aload pop
3880 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3881 PrimaryFont /FontMatrix get transform /Descent exch def pop
3884 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3886 % Define these in case they're not in the FontInfo
3887 % (also, here they're easier to get to).
3888 /UnderlinePosition Descent 0.70 mul def
3889 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3890 /StrikeoutPosition Ascent 0.30 mul def
3891 /LineThickness FontHeight 0.05 mul def
3892 /Xshadow FontHeight 0.08 mul def
3893 /Yshadow FontHeight -0.09 mul def
3894 /SpaceBackground Descent neg UnderlinePosition add def
3895 /XBox Descent neg def
3896 /YBox LineThickness 0.7 mul def
3898 currentdict % Leave the new font on the stack
3899 end % Stop using the font as the current dictionary
3900 definefont % Put the font into the font dictionary
3901 pop % Discard the returned font
3905 /DefFont{findfont exch scalefont reencodeFontISO}def
3910 dup /Ascent get /Ascent exch def
3911 dup /Descent get /Descent exch def
3912 dup /FontHeight get /FontHeight exch def
3913 dup /UnderlinePosition get /UnderlinePosition exch def
3914 dup /OverlinePosition get /OverlinePosition exch def
3915 dup /StrikeoutPosition get /StrikeoutPosition exch def
3916 dup /LineThickness get /LineThickness exch def
3917 dup /Xshadow get /Xshadow exch def
3918 dup /Yshadow get /Yshadow exch def
3919 dup /SpaceBackground get /SpaceBackground exch def
3920 dup /XBox get /XBox exch def
3921 dup /YBox get /YBox exch def
3934 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3936 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3949 % top of stack: fill-or-not
3951 {LineThickness setlinewidth stroke}
3956 % stack: string fill-or-not |- --
3959 /-ox- currentpoint /-oy- exch def def
3961 LineThickness setlinewidth
3963 st dup true charpath
3964 -fillp- {gsave FillBgColor grestore}if
3966 -oy- add /-oy- exch def
3967 -ox- add /-ox- exch def
3974 % stack: fill-or-not delta |- --
3977 xx XBox sub dd sub yy YBox sub dd sub
3978 XX XBox add dd add YY YBox add dd add
3982 % stack: string |- --
3985 Xshadow Yshadow rmoveto
3990 % stack: position |- --
3992 {currentpoint exch pop add dup
3998 LineThickness setlinewidth stroke
4002 % stack: string |- --
4003 % effect: 1 - underline 2 - strikeout 4 - overline
4004 % 8 - shadow 16 - box 32 - outline
4006 {/xx currentpoint dup Descent add /yy exch def
4007 Ascent add /YY exch def def
4008 dup stringwidth pop xx add /XX exch def
4010 {/yy yy Yshadow add def
4011 /XX XX Xshadow add def
4016 {SpaceBackground doBox}
4017 {xx yy XX YY doRect}
4020 Effect 16 and 0 ne{false 0 doBox}if % box
4021 Effect 8 and 0 ne{dup doShadow}if % shadow
4023 {true doOutline} % outline
4024 {show} % normal text
4026 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
4027 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
4028 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
4032 "EBNF EPS prologue")
4035 (defconst ebnf-eps-begin
4039 % x y #ebnf2ps#begin
4041 {#ebnf2ps#dict begin /#ebnf2ps#save save def
4042 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
4044 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
4051 (defconst ebnf-eps-end
4058 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4062 (defvar ebnf-format-float "%1.3f")
4065 (defun ebnf-format-float (&rest floats)
4068 (format ebnf-format-float float))
4073 (defun ebnf-format-color (format-str color default)
4074 (let* ((the-color (or color default))
4075 (rgb (ps-color-scale the-color)))
4078 (ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
4083 (defvar ebnf-message-float "%3.2f")
4086 (defsubst ebnf-message-float (format-str value)
4088 (format ebnf-message-float value)))
4091 (defvar ebnf-total 0)
4092 (defvar ebnf-nprod 0)
4095 (defsubst ebnf-message-info (messag)
4096 (message "%s...%3d%%"
4098 (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
4101 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4105 (defmacro ebnf-node-kind (vec &optional value)
4107 `(aset ,vec 0 ,value)
4111 (defmacro ebnf-node-width-func (node width)
4112 `(funcall (aref ,node 1) ,node ,width))
4115 (defmacro ebnf-node-dimension-func (node &optional value)
4117 `(aset ,node 2 ,value)
4118 `(funcall (aref ,node 2) ,node)))
4121 (defmacro ebnf-node-entry (vec &optional value)
4123 `(aset ,vec 3 ,value)
4127 (defmacro ebnf-node-height (vec &optional value)
4129 `(aset ,vec 4 ,value)
4133 (defmacro ebnf-node-width (vec &optional value)
4135 `(aset ,vec 5 ,value)
4139 (defmacro ebnf-node-name (vec)
4143 (defmacro ebnf-node-list (vec &optional value)
4145 `(aset ,vec 6 ,value)
4149 (defmacro ebnf-node-default (vec)
4153 (defmacro ebnf-node-production (vec &optional value)
4155 `(aset ,vec 7 ,value)
4159 (defmacro ebnf-node-separator (vec &optional value)
4161 `(aset ,vec 7 ,value)
4165 (defmacro ebnf-node-action (vec &optional value)
4167 `(aset ,vec 8 ,value)
4171 (defmacro ebnf-node-generation (node)
4172 `(funcall (ebnf-node-kind ,node) ,node))
4175 (defmacro ebnf-max-width (prod)
4176 `(max (ebnf-node-width ,prod)
4177 (+ (* (length (ebnf-node-name ,prod))
4179 ebnf-production-horizontal-space)))
4182 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4183 ;; PostScript generation
4186 (defun ebnf-generate-eps (ebnf-tree)
4187 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
4188 (ps-print-color-scale (if ps-color-p
4189 (float (car (ps-color-values "white")))
4191 (ebnf-total (length ebnf-tree))
4193 (old-ps-output (symbol-function 'ps-output))
4194 (old-ps-output-string (symbol-function 'ps-output-string))
4195 (eps-buffer (get-buffer-create ebnf-eps-buffer-name))
4196 ebnf-debug-ps error-msg horizontal
4197 prod prod-name prod-width prod-height prod-list file-list)
4198 ;; redefines `ps-output' and `ps-output-string'
4199 (defalias 'ps-output 'ebnf-eps-output)
4200 (defalias 'ps-output-string 'ps-output-string-prim)
4201 ;; generate EPS file
4203 (condition-case data
4206 (setq prod (car ebnf-tree)
4207 prod-name (ebnf-node-name prod)
4208 prod-width (ebnf-max-width prod)
4209 prod-height (ebnf-node-height prod)
4210 horizontal (memq (ebnf-node-action prod)
4212 ;; generate production in EPS buffer
4214 (set-buffer eps-buffer)
4215 (setq ebnf-eps-upper-x 0.0
4216 ebnf-eps-upper-y 0.0
4217 ebnf-eps-max-width prod-width
4218 ebnf-eps-max-height prod-height)
4219 (ebnf-generate-production prod))
4220 (if (setq prod-list (cdr (assoc prod-name
4221 ebnf-eps-production-list)))
4222 ;; insert EPS buffer in all buffer associated with production
4223 (ebnf-eps-production-list prod-list 'file-list horizontal
4224 prod-width prod-height eps-buffer)
4225 ;; write EPS file for production
4226 (ebnf-eps-finish-and-write eps-buffer
4227 (ebnf-eps-filename prod-name)))
4228 ;; prepare for next loop
4230 (set-buffer eps-buffer)
4232 (setq ebnf-tree (cdr ebnf-tree)))
4233 ;; write and kill temporary buffers
4234 (ebnf-eps-write-kill-temp file-list t)
4235 (setq file-list nil))
4238 (setq error-msg (error-message-string data)))))
4239 ;; restore `ps-output' and `ps-output-string'
4240 (defalias 'ps-output old-ps-output)
4241 (defalias 'ps-output-string old-ps-output-string)
4242 ;; kill temporary buffers
4243 (kill-buffer eps-buffer)
4244 (ebnf-eps-write-kill-temp file-list nil)
4245 (and error-msg (error error-msg))
4249 ;; write and kill temporary buffers
4250 (defun ebnf-eps-write-kill-temp (file-list write-p)
4252 (let ((buffer (get-buffer (concat " *" (car file-list) "*"))))
4255 (ebnf-eps-finish-and-write buffer (car file-list)))
4256 (kill-buffer buffer)))
4257 (setq file-list (cdr file-list))))
4260 ;; insert EPS buffer in all buffer associated with production
4261 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
4262 prod-width prod-height eps-buffer)
4264 (add-to-list file-list-sym (car prod-list))
4266 (set-buffer (get-buffer-create (concat " *" (car prod-list) "*")))
4267 (goto-char (point-max))
4270 ((zerop (buffer-size))
4271 (setq ebnf-eps-upper-x 0.0
4272 ebnf-eps-upper-y 0.0
4273 ebnf-eps-max-width prod-width
4274 ebnf-eps-max-height prod-height))
4277 (ebnf-eop-horizontal ebnf-eps-prod-width)
4278 (setq ebnf-eps-max-width (+ ebnf-eps-max-width
4279 ebnf-production-horizontal-space
4281 ebnf-eps-max-height (max ebnf-eps-max-height prod-height)))
4284 (ebnf-eop-vertical ebnf-eps-max-height)
4285 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
4286 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
4289 ebnf-production-vertical-space
4290 ebnf-eps-max-height))
4291 ebnf-eps-max-width prod-width
4292 ebnf-eps-max-height prod-height))
4294 (setq ebnf-eps-prod-width prod-width)
4295 (insert-buffer-substring eps-buffer))
4296 (setq prod-list (cdr prod-list))))
4299 (defun ebnf-generate (ebnf-tree)
4300 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
4301 (ps-print-color-scale (if ps-color-p
4302 (float (car (ps-color-values "white")))
4304 ps-zebra-stripes ps-line-number ps-razzle-dazzle
4306 ps-print-begin-sheet-hook
4307 ps-print-begin-page-hook
4308 ps-print-begin-column-hook)
4309 (ps-generate (current-buffer) (point-min) (point-max)
4310 'ebnf-generate-postscript)))
4313 (defvar ebnf-tree nil)
4314 (defvar ebnf-direction "R")
4317 (defun ebnf-generate-postscript (from to)
4319 (if ebnf-horizontal-max-height
4320 (ebnf-generate-with-max-height)
4321 (ebnf-generate-without-max-height))
4325 (defun ebnf-generate-with-max-height ()
4326 (let ((ebnf-total (length ebnf-tree))
4328 next-line max-height prod the-width)
4330 ;; find next line point
4331 (setq next-line ebnf-tree
4332 prod (car ebnf-tree)
4333 max-height (ebnf-node-height prod))
4334 (ebnf-begin-line prod (ebnf-max-width prod))
4335 (while (and (setq next-line (cdr next-line))
4336 (setq prod (car next-line))
4337 (memq (ebnf-node-action prod) ebnf-action-list)
4338 (setq the-width (ebnf-max-width prod))
4339 (<= the-width ps-width-remaining))
4340 (setq max-height (max max-height (ebnf-node-height prod))
4341 ps-width-remaining (- ps-width-remaining
4343 ebnf-production-horizontal-space))))
4344 ;; generate current line
4345 (ebnf-newline max-height)
4346 (setq prod (car ebnf-tree))
4347 (ebnf-generate-production prod)
4348 (while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line))
4349 (ebnf-eop-horizontal (ebnf-max-width prod))
4350 (setq prod (car ebnf-tree))
4351 (ebnf-generate-production prod))
4352 (ebnf-eop-vertical max-height))))
4355 (defun ebnf-generate-without-max-height ()
4356 (let ((ebnf-total (length ebnf-tree))
4358 max-height prod bef-width cur-width)
4360 ;; generate current line
4361 (setq prod (car ebnf-tree)
4362 max-height (ebnf-node-height prod)
4363 bef-width (ebnf-max-width prod))
4364 (ebnf-begin-line prod bef-width)
4365 (ebnf-generate-production prod)
4366 (while (and (setq ebnf-tree (cdr ebnf-tree))
4367 (setq prod (car ebnf-tree))
4368 (memq (ebnf-node-action prod) ebnf-action-list)
4369 (setq cur-width (ebnf-max-width prod))
4370 (<= cur-width ps-width-remaining)
4371 (<= (ebnf-node-height prod) ps-height-remaining))
4372 (ebnf-eop-horizontal bef-width)
4373 (ebnf-generate-production prod)
4374 (setq bef-width cur-width
4375 max-height (max max-height (ebnf-node-height prod))
4376 ps-width-remaining (- ps-width-remaining
4378 ebnf-production-horizontal-space))))
4379 (ebnf-eop-vertical max-height)
4380 ;; prepare next line
4381 (ebnf-newline max-height))))
4384 (defun ebnf-begin-line (prod width)
4385 (and (or (eq (ebnf-node-action prod) 'form-feed)
4386 (> (ebnf-node-height prod) ps-height-remaining))
4388 (setq ps-width-remaining (- ps-width-remaining
4390 ebnf-production-horizontal-space))))
4393 (defun ebnf-newline (height)
4394 (and (> height ps-height-remaining)
4396 (setq ps-width-remaining ps-print-width
4397 ps-height-remaining (- ps-height-remaining
4399 ebnf-production-vertical-space))))
4402 ;; [production width-fun dim-fun entry height width name production action]
4403 (defun ebnf-generate-production (production)
4404 (ebnf-message-info "Generating")
4405 (run-hooks 'ebnf-production-hook)
4406 (ps-output-string (if ebnf-production-name-p
4407 (ebnf-node-name production)
4411 (ebnf-node-width production)
4412 (+ (if ebnf-production-name-p
4415 (ebnf-node-entry (ebnf-node-production production))))
4417 (ebnf-node-generation (ebnf-node-production production))
4418 (ps-output "EOS\n"))
4421 ;; [alternative width-fun dim-fun entry height width list]
4422 (defun ebnf-generate-alternative (alternative)
4423 (let ((alt (ebnf-node-list alternative))
4424 (entry (ebnf-node-entry alternative))
4426 alt-height alt-entry)
4428 (ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt))))
4430 (setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space)
4433 (ps-output (format "%d " nlist)
4434 (ebnf-format-float (ebnf-node-width alternative))
4436 (setq alt (ebnf-node-list alternative))
4438 (ebnf-node-generation (car alt))
4439 (setq alt-height (- (ebnf-node-height (car alt))
4440 (ebnf-node-entry (car alt)))))
4441 (while (setq alt (cdr alt))
4442 (setq alt-entry (ebnf-node-entry (car alt)))
4443 (ebnf-vertical-movement
4444 (- (+ alt-height ebnf-vertical-space alt-entry)))
4445 (ebnf-node-generation (car alt))
4446 (setq alt-height (- (ebnf-node-height (car alt)) alt-entry))))
4447 (ps-output "EOS\n"))
4450 ;; [sequence width-fun dim-fun entry height width list]
4451 (defun ebnf-generate-sequence (sequence)
4453 (let ((seq (ebnf-node-list sequence))
4456 (ebnf-node-generation (car seq))
4457 (setq seq-width (ebnf-node-width (car seq))))
4458 (while (setq seq (cdr seq))
4459 (ebnf-horizontal-movement seq-width)
4460 (ebnf-node-generation (car seq))
4461 (setq seq-width (ebnf-node-width (car seq)))))
4462 (ps-output "EOS\n"))
4465 ;; [terminal width-fun dim-fun entry height width name]
4466 (defun ebnf-generate-terminal (terminal)
4467 (ebnf-gen-terminal terminal "T"))
4470 ;; [non-terminal width-fun dim-fun entry height width name]
4471 (defun ebnf-generate-non-terminal (non-terminal)
4472 (ebnf-gen-terminal non-terminal "NT"))
4475 ;; [empty width-fun dim-fun entry height width]
4476 (defun ebnf-generate-empty (empty)
4477 (ebnf-empty-alternative (ebnf-node-width empty)))
4480 ;; [optional width-fun dim-fun entry height width element]
4481 (defun ebnf-generate-optional (optional)
4482 (let ((the-optional (ebnf-node-list optional)))
4483 (ps-output (ebnf-format-float
4484 (+ (- (ebnf-node-height the-optional)
4485 (ebnf-node-entry optional))
4486 ebnf-vertical-space)
4487 (ebnf-node-width optional))
4489 (ebnf-node-generation the-optional)
4490 (ps-output "EOS\n")))
4493 ;; [one-or-more width-fun dim-fun entry height width element separator]
4494 (defun ebnf-generate-one-or-more (one-or-more)
4495 (let* ((width (ebnf-node-width one-or-more))
4496 (sep (ebnf-node-separator one-or-more))
4497 (entry (- (ebnf-node-entry one-or-more)
4499 (ebnf-node-entry sep)
4501 (ps-output (ebnf-format-float entry width)
4503 (ebnf-node-generation (ebnf-node-list one-or-more))
4504 (ebnf-vertical-movement entry)
4506 (let ((ebnf-direction "L"))
4507 (ebnf-node-generation sep))
4508 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4509 (ps-output "EOS\n"))
4512 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4513 (defun ebnf-generate-zero-or-more (zero-or-more)
4514 (let* ((width (ebnf-node-width zero-or-more))
4515 (node-list (ebnf-node-list zero-or-more))
4516 (list-entry (ebnf-node-entry node-list))
4517 (node-sep (ebnf-node-separator zero-or-more))
4518 (entry (+ list-entry
4521 (- (ebnf-node-height node-sep)
4522 (ebnf-node-entry node-sep))
4524 (ps-output (ebnf-format-float entry
4525 (+ (- (ebnf-node-height node-list)
4527 ebnf-vertical-space)
4530 (ebnf-node-generation (ebnf-node-list zero-or-more))
4531 (ebnf-vertical-movement entry)
4532 (if (ebnf-node-separator zero-or-more)
4533 (let ((ebnf-direction "L"))
4534 (ebnf-node-generation (ebnf-node-separator zero-or-more)))
4535 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4536 (ps-output "EOS\n"))
4539 ;; [special width-fun dim-fun entry height width name]
4540 (defun ebnf-generate-special (special)
4541 (ebnf-gen-terminal special "SP"))
4544 ;; [repeat width-fun dim-fun entry height width times element]
4545 (defun ebnf-generate-repeat (repeat)
4546 (let ((times (ebnf-node-name repeat))
4547 (element (ebnf-node-separator repeat)))
4548 (ps-output-string times)
4551 (ebnf-node-entry repeat)
4552 (ebnf-node-height repeat)
4553 (ebnf-node-width repeat)
4555 (+ (ebnf-node-width element)
4556 ebnf-space-R ebnf-space-R ebnf-space-R
4557 (* (length times) ebnf-font-width-R))
4559 " " ebnf-direction "RP\n")
4561 (ebnf-node-generation element)))
4562 (ps-output "EOS\n"))
4565 ;; [except width-fun dim-fun entry height width element element]
4566 (defun ebnf-generate-except (except)
4567 (let* ((element (ebnf-node-list except))
4568 (exception (ebnf-node-separator except))
4569 (width (ebnf-node-width element)))
4570 (ps-output (ebnf-format-float
4572 (ebnf-node-entry except)
4573 (ebnf-node-height except)
4574 (ebnf-node-width except)
4576 ebnf-space-E ebnf-space-E ebnf-space-E
4579 (+ (ebnf-node-width exception) ebnf-space-E)
4581 " " ebnf-direction "EX\n")
4582 (ebnf-node-generation (ebnf-node-list except))
4584 (ebnf-horizontal-movement (+ width ebnf-space-E
4585 ebnf-font-width-E ebnf-space-E))
4586 (ebnf-node-generation exception)))
4587 (ps-output "EOS\n"))
4590 (defun ebnf-gen-terminal (node code)
4591 (ps-output-string (ebnf-node-name node))
4592 (ps-output " " (ebnf-format-float (ebnf-node-width node))
4593 " " ebnf-direction code
4594 (if (ebnf-node-default node)
4599 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4600 ;; Internal functions
4603 (defun ebnf-directory (fun &optional directory)
4604 "Process files in DIRECTORY applying function FUN on each file.
4606 If DIRECTORY is nil, it's used `default-directory'.
4608 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
4610 (let ((files (directory-files (or directory default-directory)
4611 t ebnf-file-suffix-regexp)))
4613 (set-buffer (find-file-noselect (car files)))
4615 (setq buffer-backed-up t) ; Do not back it up.
4616 (save-buffer) ; Just save new version.
4617 (kill-buffer (current-buffer))
4618 (setq files (cdr files)))))
4621 (defun ebnf-file (fun file &optional do-not-kill-buffer-when-done)
4622 "Process file FILE applying function FUN.
4624 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
4625 killed after process termination."
4626 (set-buffer (find-file-noselect file))
4628 (or do-not-kill-buffer-when-done
4629 (kill-buffer (current-buffer))))
4632 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4633 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4634 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4635 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4636 (defun ebnf-range-regexp (prefix from to)
4639 (setq str (concat str (char-to-string from))
4641 (concat prefix str)))
4644 (defvar ebnf-map-name
4645 (let ((map (make-vector 256 ?\_)))
4646 (mapcar #'(lambda (char)
4647 (aset map char char))
4648 (concat "#$%&+-.0123456789=?@~"
4649 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4650 "abcdefghijklmnopqrstuvwxyz"))
4654 (defun ebnf-eps-filename (str)
4655 (let* ((len (length str))
4657 (new (make-string len ?\s)))
4659 (aset new stri (aref ebnf-map-name (aref str stri)))
4660 (setq stri (1+ stri)))
4661 (concat ebnf-eps-prefix new ".eps")))
4664 (defun ebnf-eps-output (&rest args)
4667 (setq args (cdr args))))
4670 (defun ebnf-generate-region (from to gen-func)
4671 (run-hooks 'ebnf-hook)
4672 (let ((ebnf-limit (max from to))
4673 (error-msg "SYNTAX")
4678 (condition-case data
4679 (let ((tree (ebnf-parse-and-sort (min from to))))
4681 (setq error-msg "EMPTY RULES"
4682 tree (ebnf-eliminate-empty-rules tree))
4683 (setq error-msg "OPTMIZE"
4684 tree (ebnf-optimize tree))
4685 (setq error-msg "DIMENSIONS"
4686 tree (ebnf-dimensions tree))
4687 (setq error-msg "GENERATION")
4688 (funcall gen-func tree))
4689 (setq error-msg nil)) ; here it's ok
4693 (setq the-point (max (1- (point)) (point-min))
4694 error-msg (concat error-msg ": "
4695 (error-message-string data)
4697 (and (string= error-msg "SYNTAX")
4698 (format "at position %d "
4700 (format "in buffer \"%s\"."
4701 (buffer-name)))))))))
4705 (goto-char the-point)
4706 (if ebnf-stop-on-error
4708 (message "%s" error-msg)))
4709 ;; generated output OK
4712 ;; syntax checked OK
4714 (message "EBNF syntactic analysis: NO ERRORS.")))))
4717 (defun ebnf-parse-and-sort (start)
4719 (let ((tree (funcall ebnf-parser-func start)))
4720 (if ebnf-sort-production
4722 (message "Sorting...")
4724 (if (eq ebnf-sort-production 'ascending)
4725 'ebnf-sorter-ascending
4726 'ebnf-sorter-descending)))
4730 (defun ebnf-sorter-ascending (first second)
4731 (string< (ebnf-node-name first)
4732 (ebnf-node-name second)))
4735 (defun ebnf-sorter-descending (first second)
4736 (string< (ebnf-node-name second)
4737 (ebnf-node-name first)))
4740 (defun ebnf-empty-alternative (width)
4741 (ps-output (ebnf-format-float width) " EA\n"))
4744 (defun ebnf-vertical-movement (height)
4745 (ps-output (ebnf-format-float height) " vm\n"))
4748 (defun ebnf-horizontal-movement (width)
4749 (ps-output (ebnf-format-float width) " hm\n"))
4752 (defun ebnf-entry (height)
4753 (* height ebnf-entry-percentage))
4756 (defun ebnf-eop-vertical (height)
4757 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space))
4761 (defun ebnf-eop-horizontal (width)
4762 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space))
4766 (defun ebnf-new-page ()
4767 (when (< ps-height-remaining ps-print-height)
4768 (run-hooks 'ebnf-page-hook)
4773 (defsubst ebnf-font-size (font) (nth 0 font))
4774 (defsubst ebnf-font-name (font) (nth 1 font))
4775 (defsubst ebnf-font-foreground (font) (nth 2 font))
4776 (defsubst ebnf-font-background (font) (nth 3 font))
4777 (defsubst ebnf-font-list (font) (nthcdr 4 font))
4778 (defsubst ebnf-font-attributes (font)
4779 (lsh (ps-extension-bit (cdr font)) -2))
4782 (defconst ebnf-font-name-select
4783 (vector 'normal 'bold 'italic 'bold-italic))
4786 (defun ebnf-font-name-select (font)
4787 (let* ((font-list (ebnf-font-list font))
4788 (font-index (+ (if (memq 'bold font-list) 1 0)
4789 (if (memq 'italic font-list) 2 0)))
4790 (name (ebnf-font-name font))
4791 (database (cdr (assoc name ps-font-info-database)))
4792 (info-list (or (cdr (assoc 'fonts database))
4793 (error "Invalid font: %s" name))))
4794 (or (cdr (assoc (aref ebnf-font-name-select font-index)
4796 (error "Invalid attributes for font %s" name))))
4799 (defun ebnf-font-select (font select)
4800 (let* ((name (ebnf-font-name font))
4801 (database (cdr (assoc name ps-font-info-database)))
4802 (size (cdr (assoc 'size database)))
4803 (base (cdr (assoc select database))))
4805 (/ (* (ebnf-font-size font) base)
4807 (error "Invalid font: %s" name))))
4810 (defsubst ebnf-font-width (font)
4811 (ebnf-font-select font 'avg-char-width))
4812 (defsubst ebnf-font-height (font)
4813 (ebnf-font-select font 'line-height))
4816 (defconst ebnf-syntax-alist
4817 ;; 0.syntax 1.parser 2.initializer
4818 '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize)
4819 (yacc ebnf-yac-parser ebnf-yac-initialize)
4820 (abnf ebnf-abn-parser ebnf-abn-initialize)
4821 (ebnf ebnf-bnf-parser ebnf-bnf-initialize)
4822 (ebnfx ebnf-ebx-parser ebnf-ebx-initialize)
4823 (dtd ebnf-dtd-parser ebnf-dtd-initialize))
4824 "Alist associating ebnf syntax with a parser and a initializer.")
4827 (defun ebnf-begin-job ()
4828 (ps-printing-region nil nil nil)
4829 (if ebnf-use-float-format
4830 (setq ebnf-format-float "%1.3f"
4831 ebnf-message-float "%3.2f")
4832 (setq ebnf-format-float "%s"
4833 ebnf-message-float "%s"))
4834 (ebnf-otz-initialize)
4835 ;; to avoid compilation gripes when calling autoloaded functions
4836 (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist)
4837 (assoc 'ebnf ebnf-syntax-alist))))
4838 (setq ebnf-parser-func (nth 1 init))
4839 (funcall (nth 2 init)))
4840 (and ebnf-terminal-regexp ; ensures that it's a string or nil
4841 (not (stringp ebnf-terminal-regexp))
4842 (setq ebnf-terminal-regexp nil))
4843 (or (and ebnf-eps-prefix ; ensures that it's a string
4844 (stringp ebnf-eps-prefix))
4845 (setq ebnf-eps-prefix "ebnf--"))
4846 (setq ebnf-entry-percentage ; ensures value between 0.0 and 1.0
4847 (min (max ebnf-entry-percentage 0.0) 1.0)
4848 ebnf-action-list (if ebnf-horizontal-orientation
4852 ebnf-fonts-required nil
4855 ebnf-eps-context nil
4856 ebnf-eps-production-list nil
4857 ebnf-eps-upper-x 0.0
4858 ebnf-eps-upper-y 0.0
4859 ebnf-font-height-P (ebnf-font-height ebnf-production-font)
4860 ebnf-font-height-T (ebnf-font-height ebnf-terminal-font)
4861 ebnf-font-height-NT (ebnf-font-height ebnf-non-terminal-font)
4862 ebnf-font-height-S (ebnf-font-height ebnf-special-font)
4863 ebnf-font-height-E (ebnf-font-height ebnf-except-font)
4864 ebnf-font-height-R (ebnf-font-height ebnf-repeat-font)
4865 ebnf-font-width-P (ebnf-font-width ebnf-production-font)
4866 ebnf-font-width-T (ebnf-font-width ebnf-terminal-font)
4867 ebnf-font-width-NT (ebnf-font-width ebnf-non-terminal-font)
4868 ebnf-font-width-S (ebnf-font-width ebnf-special-font)
4869 ebnf-font-width-E (ebnf-font-width ebnf-except-font)
4870 ebnf-font-width-R (ebnf-font-width ebnf-repeat-font)
4871 ebnf-space-T (* ebnf-font-height-T 0.5)
4872 ebnf-space-NT (* ebnf-font-height-NT 0.5)
4873 ebnf-space-S (* ebnf-font-height-S 0.5)
4874 ebnf-space-E (* ebnf-font-height-E 0.5)
4875 ebnf-space-R (* ebnf-font-height-R 0.5))
4876 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT)))
4877 (setq ebnf-basic-width (* basic 0.5)
4878 ebnf-horizontal-space (+ basic basic)
4879 ebnf-basic-height ebnf-basic-width
4880 ebnf-vertical-space ebnf-basic-width)
4881 ;; ensures value is greater than zero
4882 (or (and (numberp ebnf-production-horizontal-space)
4883 (> ebnf-production-horizontal-space 0.0))
4884 (setq ebnf-production-horizontal-space basic))
4885 ;; ensures value is greater than zero
4886 (or (and (numberp ebnf-production-vertical-space)
4887 (> ebnf-production-vertical-space 0.0))
4888 (setq ebnf-production-vertical-space basic))))
4891 (defsubst ebnf-shape-value (sym alist)
4892 (or (cdr (assq sym alist)) 0))
4895 (defsubst ebnf-boolean (value)
4896 (if value "true" "false"))
4899 (defun ebnf-begin-file ()
4902 (set-buffer ps-spool-buffer)
4903 (goto-char (point-min))
4904 (and (search-forward "%%Creator: " nil t)
4905 (not (search-forward "& ebnf2ps v"
4906 (save-excursion (end-of-line) (point))
4909 ;; adjust creator comment
4911 (insert " & ebnf2ps v" ebnf-version)
4912 ;; insert ebnf settings & engine
4913 (goto-char (point-max))
4914 (search-backward "\n%%EndProlog\n")
4915 (ebnf-insert-ebnf-prologue)
4916 (ps-output "\n")))))
4919 (defun ebnf-eps-finish-and-write (buffer filename)
4920 (when (buffer-modified-p buffer)
4923 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
4924 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
4927 ebnf-production-vertical-space
4928 ebnf-eps-max-height)))
4930 (goto-char (point-min))
4932 "%!PS-Adobe-3.0 EPSF-3.0"
4933 "\n%%BoundingBox: 0 0 "
4934 (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
4935 "\n%%Title: " filename
4936 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4937 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
4938 "\n%%DocumentNeededResources: font "
4939 (or ebnf-fonts-required
4940 (setq ebnf-fonts-required
4941 (mapconcat 'identity
4942 (ps-remove-duplicates
4943 (mapcar 'ebnf-font-name-select
4944 (list ebnf-production-font
4946 ebnf-non-terminal-font
4951 "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
4953 (ebnf-insert-ebnf-prologue)
4954 (insert ebnf-eps-begin
4955 "\n0 " (ebnf-format-float
4956 (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7)))
4957 " #ebnf2ps#begin\n")
4959 (goto-char (point-max))
4960 (insert ebnf-eps-end)
4962 (message "Saving...")
4963 (setq filename (expand-file-name filename))
4964 (let ((coding-system-for-write 'raw-text-unix))
4965 (write-region (point-min) (point-max) filename))
4966 (message "Wrote %s" filename))))
4969 (defun ebnf-insert-ebnf-prologue ()
4974 "\n\n% === begin EBNF settings\n\n"
4976 (format "/fP %s /%s DefFont\n"
4977 (ebnf-format-float (ebnf-font-size ebnf-production-font))
4978 (ebnf-font-name-select ebnf-production-font))
4979 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4980 (ebnf-font-foreground ebnf-production-font)
4982 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4983 (ebnf-font-background ebnf-production-font)
4985 (format "/EffectP %d def\n"
4986 (ebnf-font-attributes ebnf-production-font))
4988 (format "/fT %s /%s DefFont\n"
4989 (ebnf-format-float (ebnf-font-size ebnf-terminal-font))
4990 (ebnf-font-name-select ebnf-terminal-font))
4991 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4992 (ebnf-font-foreground ebnf-terminal-font)
4994 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4995 (ebnf-font-background ebnf-terminal-font)
4997 (format "/EffectT %d def\n"
4998 (ebnf-font-attributes ebnf-terminal-font))
4999 (format "/BorderWidthT %s def\n"
5000 (ebnf-format-float ebnf-terminal-border-width))
5001 (ebnf-format-color "/BorderColorT %s def %% %s\n"
5002 ebnf-terminal-border-color
5004 (format "/ShapeT %d def\n"
5005 (ebnf-shape-value ebnf-terminal-shape
5006 ebnf-terminal-shape-alist))
5007 (format "/ShadowT %s def\n"
5008 (ebnf-boolean ebnf-terminal-shadow))
5010 (format "/fNT %s /%s DefFont\n"
5012 (ebnf-font-size ebnf-non-terminal-font))
5013 (ebnf-font-name-select ebnf-non-terminal-font))
5014 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
5015 (ebnf-font-foreground ebnf-non-terminal-font)
5017 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
5018 (ebnf-font-background ebnf-non-terminal-font)
5020 (format "/EffectNT %d def\n"
5021 (ebnf-font-attributes ebnf-non-terminal-font))
5022 (format "/BorderWidthNT %s def\n"
5023 (ebnf-format-float ebnf-non-terminal-border-width))
5024 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
5025 ebnf-non-terminal-border-color
5027 (format "/ShapeNT %d def\n"
5028 (ebnf-shape-value ebnf-non-terminal-shape
5029 ebnf-terminal-shape-alist))
5030 (format "/ShadowNT %s def\n"
5031 (ebnf-boolean ebnf-non-terminal-shadow))
5033 (format "/fS %s /%s DefFont\n"
5034 (ebnf-format-float (ebnf-font-size ebnf-special-font))
5035 (ebnf-font-name-select ebnf-special-font))
5036 (ebnf-format-color "/ForegroundS %s def %% %s\n"
5037 (ebnf-font-foreground ebnf-special-font)
5039 (ebnf-format-color "/BackgroundS %s def %% %s\n"
5040 (ebnf-font-background ebnf-special-font)
5042 (format "/EffectS %d def\n"
5043 (ebnf-font-attributes ebnf-special-font))
5044 (format "/BorderWidthS %s def\n"
5045 (ebnf-format-float ebnf-special-border-width))
5046 (ebnf-format-color "/BorderColorS %s def %% %s\n"
5047 ebnf-special-border-color
5049 (format "/ShapeS %d def\n"
5050 (ebnf-shape-value ebnf-special-shape
5051 ebnf-terminal-shape-alist))
5052 (format "/ShadowS %s def\n"
5053 (ebnf-boolean ebnf-special-shadow))
5055 (format "/fE %s /%s DefFont\n"
5056 (ebnf-format-float (ebnf-font-size ebnf-except-font))
5057 (ebnf-font-name-select ebnf-except-font))
5058 (ebnf-format-color "/ForegroundE %s def %% %s\n"
5059 (ebnf-font-foreground ebnf-except-font)
5061 (ebnf-format-color "/BackgroundE %s def %% %s\n"
5062 (ebnf-font-background ebnf-except-font)
5064 (format "/EffectE %d def\n"
5065 (ebnf-font-attributes ebnf-except-font))
5066 (format "/BorderWidthE %s def\n"
5067 (ebnf-format-float ebnf-except-border-width))
5068 (ebnf-format-color "/BorderColorE %s def %% %s\n"
5069 ebnf-except-border-color
5071 (format "/ShapeE %d def\n"
5072 (ebnf-shape-value ebnf-except-shape
5073 ebnf-terminal-shape-alist))
5074 (format "/ShadowE %s def\n"
5075 (ebnf-boolean ebnf-except-shadow))
5077 (format "/fR %s /%s DefFont\n"
5078 (ebnf-format-float (ebnf-font-size ebnf-repeat-font))
5079 (ebnf-font-name-select ebnf-repeat-font))
5080 (ebnf-format-color "/ForegroundR %s def %% %s\n"
5081 (ebnf-font-foreground ebnf-repeat-font)
5083 (ebnf-format-color "/BackgroundR %s def %% %s\n"
5084 (ebnf-font-background ebnf-repeat-font)
5086 (format "/EffectR %d def\n"
5087 (ebnf-font-attributes ebnf-repeat-font))
5088 (format "/BorderWidthR %s def\n"
5089 (ebnf-format-float ebnf-repeat-border-width))
5090 (ebnf-format-color "/BorderColorR %s def %% %s\n"
5091 ebnf-repeat-border-color
5093 (format "/ShapeR %d def\n"
5094 (ebnf-shape-value ebnf-repeat-shape
5095 ebnf-terminal-shape-alist))
5096 (format "/ShadowR %s def\n"
5097 (ebnf-boolean ebnf-repeat-shadow))
5099 (format "/ExtraWidth %s def\n"
5100 (ebnf-format-float ebnf-arrow-extra-width))
5101 (format "/ArrowScale %s def\n"
5102 (ebnf-format-float ebnf-arrow-scale))
5103 (format "/DefaultWidth %s def\n"
5104 (ebnf-format-float ebnf-default-width))
5105 (format "/LineWidth %s def\n"
5106 (ebnf-format-float ebnf-line-width))
5107 (ebnf-format-color "/LineColor %s def %% %s\n"
5110 (format "/ArrowShape %d def\n"
5111 (ebnf-shape-value ebnf-arrow-shape
5112 ebnf-arrow-shape-alist))
5113 (format "/ChartShape %d def\n"
5114 (ebnf-shape-value ebnf-chart-shape
5115 ebnf-terminal-shape-alist))
5116 (format "/UserArrow{%s}def\n"
5117 (let ((arrow (eval ebnf-user-arrow)))
5121 "\n% === end EBNF settings\n\n"
5122 (and ebnf-debug-ps ebnf-debug))))
5126 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5127 ;; Adjusting dimensions
5130 (defun ebnf-dimensions (tree)
5131 (let ((ebnf-total (length tree))
5133 (mapcar 'ebnf-production-dimension tree))
5137 ;; [empty width-fun dim-fun entry height width]
5138 ;;(defun ebnf-empty-dimension (empty)
5142 ;; [production width-fun dim-fun entry height width name production action]
5143 (defun ebnf-production-dimension (production)
5144 (ebnf-message-info "Calculating dimensions")
5145 (ebnf-node-dimension-func (ebnf-node-production production))
5146 (let* ((prod (ebnf-node-production production))
5147 (height (+ (if ebnf-production-name-p
5150 ebnf-line-width ebnf-line-width
5152 (ebnf-node-height prod))))
5153 (ebnf-node-entry production height)
5154 (ebnf-node-height production height)
5155 (ebnf-node-width production (+ (ebnf-node-width prod)
5157 ebnf-horizontal-space))))
5160 ;; [terminal width-fun dim-fun entry height width name]
5161 (defun ebnf-terminal-dimension (terminal)
5162 (ebnf-terminal-dimension1 terminal
5168 ;; [non-terminal width-fun dim-fun entry height width name]
5169 (defun ebnf-non-terminal-dimension (non-terminal)
5170 (ebnf-terminal-dimension1 non-terminal
5176 ;; [special width-fun dim-fun entry height width name]
5177 (defun ebnf-special-dimension (special)
5178 (ebnf-terminal-dimension1 special
5184 (defun ebnf-terminal-dimension1 (node font-height font-width space)
5185 (let ((height (+ space font-height space))
5186 (len (length (ebnf-node-name node))))
5187 (ebnf-node-entry node (* height 0.5))
5188 (ebnf-node-height node height)
5189 (ebnf-node-width node (+ ebnf-basic-width ebnf-arrow-extra-width space
5191 space ebnf-basic-width))))
5194 (defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
5197 ;; [repeat width-fun dim-fun entry height width times element]
5198 (defun ebnf-repeat-dimension (repeat)
5199 (let ((times (ebnf-node-name repeat))
5200 (element (ebnf-node-separator repeat)))
5202 (ebnf-node-dimension-func element)
5203 (setq element ebnf-null-vector))
5204 (ebnf-node-entry repeat (+ (ebnf-node-entry element)
5206 (ebnf-node-height repeat (+ (max (ebnf-node-height element)
5208 ebnf-space-R ebnf-space-R))
5209 (ebnf-node-width repeat (+ (ebnf-node-width element)
5210 ebnf-arrow-extra-width
5211 ebnf-space-R ebnf-space-R ebnf-space-R
5212 ebnf-horizontal-space
5213 (* (length times) ebnf-font-width-R)))))
5216 ;; [except width-fun dim-fun entry height width element element]
5217 (defun ebnf-except-dimension (except)
5218 (let ((factor (ebnf-node-list except))
5219 (element (ebnf-node-separator except)))
5220 (ebnf-node-dimension-func factor)
5222 (ebnf-node-dimension-func element)
5223 (setq element ebnf-null-vector))
5224 (ebnf-node-entry except (+ (max (ebnf-node-entry factor)
5225 (ebnf-node-entry element))
5227 (ebnf-node-height except (+ (max (ebnf-node-height factor)
5228 (ebnf-node-height element))
5229 ebnf-space-E ebnf-space-E))
5230 (ebnf-node-width except (+ (ebnf-node-width factor)
5231 (ebnf-node-width element)
5232 ebnf-arrow-extra-width
5233 ebnf-space-E ebnf-space-E
5234 ebnf-space-E ebnf-space-E
5236 ebnf-horizontal-space))))
5239 ;; [alternative width-fun dim-fun entry height width list]
5240 (defun ebnf-alternative-dimension (alternative)
5241 (let ((body (ebnf-node-list alternative))
5242 (lis (ebnf-node-list alternative)))
5244 (ebnf-node-dimension-func (car lis))
5245 (setq lis (cdr lis)))
5249 (tail (car (last body)))
5250 (entry (ebnf-node-entry (car body)))
5253 (setq node (car alt)
5255 height (+ (ebnf-node-height node) height)
5256 width (max (ebnf-node-width node) width)))
5257 (ebnf-adjust-width body width)
5258 (setq height (+ height (* (1- (length body)) ebnf-vertical-space)))
5259 (ebnf-node-entry alternative (+ entry
5262 (- (ebnf-node-height tail)
5263 (ebnf-node-entry tail))))))
5264 (ebnf-node-height alternative height)
5265 (ebnf-node-width alternative (+ width ebnf-horizontal-space))
5266 (ebnf-node-list alternative body))))
5269 ;; [optional width-fun dim-fun entry height width element]
5270 (defun ebnf-optional-dimension (optional)
5271 (let ((body (ebnf-node-list optional)))
5272 (ebnf-node-dimension-func body)
5273 (ebnf-node-entry optional (ebnf-node-entry body))
5274 (ebnf-node-height optional (+ (ebnf-node-height body)
5275 ebnf-vertical-space))
5276 (ebnf-node-width optional (+ (ebnf-node-width body)
5277 ebnf-horizontal-space))))
5280 ;; [one-or-more width-fun dim-fun entry height width element separator]
5281 (defun ebnf-one-or-more-dimension (or-more)
5282 (let ((list-part (ebnf-node-list or-more))
5283 (sep-part (ebnf-node-separator or-more)))
5284 (ebnf-node-dimension-func list-part)
5286 (ebnf-node-dimension-func sep-part))
5287 (let ((height (+ (if sep-part
5288 (ebnf-node-height sep-part)
5291 (ebnf-node-height list-part)))
5292 (width (max (if sep-part
5293 (ebnf-node-width sep-part)
5295 (ebnf-node-width list-part))))
5297 (ebnf-adjust-width list-part width)
5298 (ebnf-adjust-width sep-part width))
5299 (ebnf-node-entry or-more (+ (- height (ebnf-node-height list-part))
5300 (ebnf-node-entry list-part)))
5301 (ebnf-node-height or-more height)
5302 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
5305 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5306 (defun ebnf-zero-or-more-dimension (or-more)
5307 (let ((list-part (ebnf-node-list or-more))
5308 (sep-part (ebnf-node-separator or-more)))
5309 (ebnf-node-dimension-func list-part)
5311 (ebnf-node-dimension-func sep-part))
5312 (let ((height (+ (if sep-part
5313 (ebnf-node-height sep-part)
5316 (ebnf-node-height list-part)
5317 ebnf-vertical-space))
5318 (width (max (if sep-part
5319 (ebnf-node-width sep-part)
5321 (ebnf-node-width list-part))))
5323 (ebnf-adjust-width list-part width)
5324 (ebnf-adjust-width sep-part width))
5325 (ebnf-node-entry or-more height)
5326 (ebnf-node-height or-more height)
5327 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
5330 ;; [sequence width-fun dim-fun entry height width list]
5331 (defun ebnf-sequence-dimension (sequence)
5335 (lis (ebnf-node-list sequence))
5338 (setq node (car lis)
5340 (ebnf-node-dimension-func node)
5341 (setq entry (ebnf-node-entry node)
5342 above (max above entry)
5343 below (max below (- (ebnf-node-height node) entry))
5344 width (+ width (ebnf-node-width node))))
5345 (ebnf-node-entry sequence above)
5346 (ebnf-node-height sequence (+ above below))
5347 (ebnf-node-width sequence width)))
5350 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5354 (defun ebnf-adjust-width (node width)
5360 (setcar node (ebnf-adjust-width (car node) width))
5361 (setq node (cdr node)))))
5364 ;; nothing to be done
5365 ((= width (ebnf-node-width node))
5367 ;; left justify term
5368 ((eq ebnf-justify-sequence 'left)
5369 (ebnf-adjust-empty node width nil))
5370 ;; right justify terms
5371 ((eq ebnf-justify-sequence 'right)
5372 (ebnf-adjust-empty node width t))
5375 (ebnf-node-width-func node width)
5376 (ebnf-node-width node width)
5384 (defun ebnf-adjust-empty (node width last-p)
5385 (if (eq (ebnf-node-kind node) 'ebnf-generate-empty)
5387 (ebnf-node-width node width)
5389 (let ((empty (ebnf-make-empty (- width (ebnf-node-width node)))))
5390 (ebnf-make-dup-sequence node
5393 (list node empty))))))
5396 ;; [terminal width-fun dim-fun entry height width name]
5397 ;; [non-terminal width-fun dim-fun entry height width name]
5398 ;; [empty width-fun dim-fun entry height width]
5399 ;; [special width-fun dim-fun entry height width name]
5400 ;; [repeat width-fun dim-fun entry height width times element]
5401 ;; [except width-fun dim-fun entry height width element element]
5402 ;;(defun ebnf-terminal-width (terminal width)
5406 ;; [alternative width-fun dim-fun entry height width list]
5407 ;; [optional width-fun dim-fun entry height width element]
5408 (defun ebnf-alternative-width (alternative width)
5409 (ebnf-adjust-width (ebnf-node-list alternative)
5410 (- width ebnf-horizontal-space)))
5413 ;; [one-or-more width-fun dim-fun entry height width element separator]
5414 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5415 (defun ebnf-element-width (or-more width)
5416 (setq width (- width ebnf-horizontal-space))
5417 (ebnf-node-list or-more
5418 (ebnf-justify-list or-more
5419 (ebnf-node-list or-more)
5421 (ebnf-node-separator or-more
5422 (ebnf-justify-list or-more
5423 (ebnf-node-separator or-more)
5427 ;; [sequence width-fun dim-fun entry height width list]
5428 (defun ebnf-sequence-width (sequence width)
5429 (ebnf-node-list sequence
5430 (ebnf-justify-list sequence
5431 (ebnf-node-list sequence)
5435 (defun ebnf-justify-list (node seq width)
5436 (let ((seq-width (ebnf-node-width node)))
5437 (if (= width seq-width)
5440 ;; left justify terms
5441 ((eq ebnf-justify-sequence 'left)
5442 (ebnf-justify node seq seq-width width t))
5443 ;; right justify terms
5444 ((eq ebnf-justify-sequence 'right)
5445 (ebnf-justify node seq seq-width width nil))
5446 ;; centralize terms -- element
5448 (ebnf-adjust-width seq width))
5449 ;; centralize terms -- list
5451 (let ((the-width (/ (- width seq-width) (length seq)))
5454 (ebnf-adjust-width (car lis)
5455 (+ (ebnf-node-width (car lis))
5457 (setq lis (cdr lis)))
5462 (defun ebnf-justify (node seq seq-width width last-p)
5463 (let ((term (car (if last-p (last seq) seq))))
5465 ;; adjust empty term
5466 ((eq (ebnf-node-kind term) 'ebnf-generate-empty)
5467 (ebnf-node-width term (+ (- width seq-width)
5468 (ebnf-node-width term)))
5470 ;; insert empty at end ==> left justify
5473 (list (ebnf-make-empty (- width seq-width)))))
5474 ;; insert empty at beginning ==> right justify
5476 (cons (ebnf-make-empty (- width seq-width))
5481 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5482 ;; Functions used by parsers
5485 (defun ebnf-eps-add-context (name)
5486 (let ((filename (ebnf-eps-filename name)))
5487 (if (member filename ebnf-eps-context)
5488 (error "Try to open an already opened EPS file: %s" filename)
5489 (setq ebnf-eps-context (cons filename ebnf-eps-context)))))
5492 (defun ebnf-eps-remove-context (name)
5493 (let ((filename (ebnf-eps-filename name)))
5494 (if (member filename ebnf-eps-context)
5495 (setq ebnf-eps-context (delete filename ebnf-eps-context))
5496 (error "Try to close a not opened EPS file: %s" filename))))
5499 (defun ebnf-eps-add-production (header)
5500 (and ebnf-eps-executing
5502 (let ((prod (assoc header ebnf-eps-production-list)))
5504 (setcdr prod (append ebnf-eps-context (cdr prod)))
5505 (setq ebnf-eps-production-list
5506 (cons (cons header (ebnf-dup-list ebnf-eps-context))
5507 ebnf-eps-production-list))))))
5510 (defun ebnf-dup-list (old)
5513 (setq new (cons (car old) new)
5518 (defun ebnf-buffer-substring (chars)
5519 (buffer-substring-no-properties
5522 (skip-chars-forward chars ebnf-limit)
5526 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
5527 (defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377))
5530 (defun ebnf-string (chars eos-char kind)
5532 (buffer-substring-no-properties
5535 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5536 (skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit)
5537 (if (or (eobp) (/= (following-char) eos-char))
5538 (error "Invalid %s: missing `%c'" kind eos-char)
5543 (defun ebnf-get-string ()
5545 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5548 (defun ebnf-end-of-string ()
5550 (while (> (logand n 1) 0)
5551 (skip-chars-forward "^\"" ebnf-limit)
5552 (setq n (- (skip-chars-backward "\\\\")))
5553 (goto-char (+ (point) n 1))))
5554 (if (= (preceding-char) ?\")
5556 (error "Missing `\"'")))
5559 (defun ebnf-trim-right (str)
5560 (let* ((len (1- (length str)))
5562 (while (and (> index 0) (= (aref str index) ?\s))
5563 (setq index (1- index)))
5566 (substring str 0 (1+ index)))))
5569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5573 (defun ebnf-make-empty (&optional width)
5574 (vector 'ebnf-generate-empty
5579 (or width ebnf-horizontal-space)))
5582 (defun ebnf-make-terminal (name)
5583 (ebnf-make-terminal1 name
5584 'ebnf-generate-terminal
5585 'ebnf-terminal-dimension))
5588 (defun ebnf-make-non-terminal (name)
5589 (ebnf-make-terminal1 name
5590 'ebnf-generate-non-terminal
5591 'ebnf-non-terminal-dimension))
5594 (defun ebnf-make-special (name)
5595 (ebnf-make-terminal1 name
5596 'ebnf-generate-special
5597 'ebnf-special-dimension))
5600 (defun ebnf-make-terminal1 (name gen-func dim-func)
5607 (let ((len (length name)))
5608 (cond ((> len 3) name)
5609 ((= len 3) (concat name " "))
5610 ((= len 2) (concat " " name " "))
5611 ((= len 1) (concat " " name " "))
5616 (defun ebnf-make-one-or-more (list-part &optional sep-part)
5617 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5618 'ebnf-one-or-more-dimension
5623 (defun ebnf-make-zero-or-more (list-part &optional sep-part)
5624 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5625 'ebnf-zero-or-more-dimension
5630 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
5637 (if (listp list-part)
5638 (ebnf-make-sequence list-part)
5640 (if (and sep-part (listp sep-part))
5641 (ebnf-make-sequence sep-part)
5645 (defun ebnf-make-production (name prod action)
5646 (vector 'ebnf-generate-production
5648 'ebnf-production-dimension
5657 (defun ebnf-make-alternative (body)
5658 (vector 'ebnf-generate-alternative
5659 'ebnf-alternative-width
5660 'ebnf-alternative-dimension
5667 (defun ebnf-make-optional (body)
5668 (vector 'ebnf-generate-optional
5669 'ebnf-alternative-width
5670 'ebnf-optional-dimension
5677 (defun ebnf-make-except (factor exception)
5678 (vector 'ebnf-generate-except
5680 'ebnf-except-dimension
5688 (defun ebnf-make-repeat (times primary &optional upper)
5689 (vector 'ebnf-generate-repeat
5691 'ebnf-repeat-dimension
5695 (cond ((and times upper) ; L * U, L * L
5696 (if (string= times upper)
5697 (if (string= times "")
5700 (concat times " * " upper)))
5702 (concat times " *"))
5704 (concat "* " upper))
5710 (defun ebnf-make-sequence (seq)
5711 (vector 'ebnf-generate-sequence
5712 'ebnf-sequence-width
5713 'ebnf-sequence-dimension
5720 (defun ebnf-make-dup-sequence (node seq)
5721 (vector 'ebnf-generate-sequence
5722 'ebnf-sequence-width
5723 'ebnf-sequence-dimension
5724 (ebnf-node-entry node)
5725 (ebnf-node-height node)
5726 (ebnf-node-width node)
5730 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5731 ;; Optimizers used by parsers
5734 (defun ebnf-token-except (element exception)
5737 (setq exception (cdr exception)))
5738 (and element ; EMPTY - A ==> EMPTY
5739 (let ((kind (ebnf-node-kind element)))
5742 ((and (null exception)
5743 (eq kind 'ebnf-generate-optional))
5744 (ebnf-node-list element))
5745 ;; { A }- ==> { A }+
5746 ((and (null exception)
5747 (eq kind 'ebnf-generate-zero-or-more))
5748 (ebnf-node-kind element 'ebnf-generate-one-or-more)
5749 (ebnf-node-dimension-func element 'ebnf-one-or-more-dimension)
5751 ;; ( A | EMPTY )- ==> A
5752 ;; ( A | B | EMPTY )- ==> A | B
5753 ((and (null exception)
5754 (eq kind 'ebnf-generate-alternative)
5756 (car (last (ebnf-node-list element))))
5757 'ebnf-generate-empty))
5758 (let ((elt (ebnf-node-list element))
5764 ;; this should not happen!!?!
5765 (setq element (ebnf-make-empty
5766 (ebnf-node-width element)))
5768 (setq elt (ebnf-node-list element))
5769 (and (= (length elt) 1)
5770 (setq element (car elt))))
5774 (ebnf-make-except element exception))
5778 (defun ebnf-token-repeat (times repeat &optional upper)
5779 (if (null (cdr repeat))
5780 ;; n * EMPTY ==> EMPTY
5784 (ebnf-make-repeat times (cdr repeat) upper))))
5787 (defun ebnf-token-optional (body)
5788 (let ((kind (ebnf-node-kind body)))
5790 ;; [ EMPTY ] ==> EMPTY
5791 ((eq kind 'ebnf-generate-empty)
5793 ;; [ { A }* ] ==> { A }*
5794 ((eq kind 'ebnf-generate-zero-or-more)
5796 ;; [ { A }+ ] ==> { A }*
5797 ((eq kind 'ebnf-generate-one-or-more)
5798 (ebnf-node-kind body 'ebnf-generate-zero-or-more)
5800 ;; [ A | B ] ==> A | B | EMPTY
5801 ((eq kind 'ebnf-generate-alternative)
5802 (ebnf-node-list body (nconc (ebnf-node-list body)
5803 (list (ebnf-make-empty))))
5807 (ebnf-make-optional body))
5811 (defun ebnf-token-alternative (body sequence)
5815 (cons (car sequence)
5817 (cons (car sequence)
5818 (let ((seq (cdr sequence)))
5819 (if (and (= (length body) 1) (null seq))
5821 (ebnf-make-alternative (nreverse (if seq
5826 (defun ebnf-token-sequence (sequence)
5831 ;; sequence with only one element
5832 ((= (length sequence) 1)
5836 (ebnf-make-sequence (nreverse sequence)))
5840 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5841 ;; Variables used by parsers
5844 (defconst ebnf-comment-table
5845 (let ((table (make-vector 256 nil)))
5846 ;; Override special comment character:
5847 (aset table ?< 'newline)
5848 (aset table ?> 'keep-line)
5849 (aset table ?^ 'form-feed)
5851 "Vector used to map characters to a special comment token.")
5854 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5855 ;; To make this file smaller, some commands go in a separate file.
5856 ;; But autoload them here to make the separation invisible.
5858 (autoload 'ebnf-abn-parser "ebnf-abn"
5861 (autoload 'ebnf-abn-initialize "ebnf-abn"
5862 "Initialize ABNF token table.")
5864 (autoload 'ebnf-bnf-parser "ebnf-bnf"
5867 (autoload 'ebnf-bnf-initialize "ebnf-bnf"
5868 "Initialize EBNF token table.")
5870 (autoload 'ebnf-iso-parser "ebnf-iso"
5873 (autoload 'ebnf-iso-initialize "ebnf-iso"
5874 "Initialize ISO EBNF token table.")
5876 (autoload 'ebnf-yac-parser "ebnf-yac"
5877 "Yacc/Bison parser.")
5879 (autoload 'ebnf-yac-initialize "ebnf-yac"
5880 "Initializations for Yacc/Bison parser.")
5882 (autoload 'ebnf-ebx-parser "ebnf-ebx"
5885 (autoload 'ebnf-ebx-initialize "ebnf-ebx"
5886 "Initializations for EBNFX parser.")
5888 (autoload 'ebnf-dtd-parser "ebnf-dtd"
5891 (autoload 'ebnf-dtd-initialize "ebnf-dtd"
5892 "Initializations for DTD parser.")
5895 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5900 ;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
5901 ;;; ebnf2ps.el ends here