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 ;; Time-stamp: <2006/09/26 21:49:46 vinicius>
9 ;; Keywords: wp, ebnf, PostScript
11 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28 ;; Boston, MA 02110-1301, USA.
30 (defconst ebnf-version "4.3"
31 "ebnf2ps.el, v 4.3 <2006/09/26 vinicius>
33 Vinicius's last change version. When reporting bugs, please also
34 report the version of Emacs, if any, that ebnf2ps was running with.
36 Please send all bug fixes and enhancements to
37 Vinicius Jose Latorre <viniciusjl@ig.com.br>.
43 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; This package translates an EBNF to a syntactic chart on PostScript.
50 ;; To use ebnf2ps, insert in your ~/.emacs:
54 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
55 ;; know how to set options like landscape printing, page headings, margins,
58 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
59 ;; ebnf2ps, they behave as it's turned off.
61 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
63 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
65 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
67 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
73 ;; ebnf2ps provides the following commands for generating PostScript syntactic
74 ;; chart images of Emacs buffers:
76 ;; ebnf-print-directory
80 ;; ebnf-spool-directory
89 ;; These commands all perform essentially the same function: they generate
90 ;; PostScript syntactic chart images suitable for printing on a PostScript
91 ;; printer or displaying with GhostScript. These commands are collectively
92 ;; referred to as "ebnf- commands".
94 ;; The word "print", "spool" and "eps" in the command name determines when the
95 ;; PostScript image is sent to the printer (or file):
97 ;; print - The PostScript image is immediately sent to the printer;
99 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
100 ;; Many images may be spooled locally before printing them. To
101 ;; send the spooled images to the printer, use the command
104 ;; eps - The PostScript image is immediately sent to a EPS file.
106 ;; The spooling mechanism is the same as used by ps-print and was designed for
107 ;; printing lots of small files to save paper that would otherwise be wasted on
108 ;; banner pages, and to make it easier to find your output at the printer (it's
109 ;; easier to pick up one 50-page printout than to find 50 single-page
110 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
111 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
113 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
114 ;; won't accidentally quit from Emacs while you have unprinted PostScript
115 ;; waiting in the spool buffer. If you do attempt to exit with spooled
116 ;; PostScript, you'll be asked if you want to print it, and if you decline,
117 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
118 ;; that Emacs uses for modified buffers.
120 ;; The word "directory", "file", "buffer" or "region" in the command name
121 ;; determines how much of the buffer is printed:
123 ;; directory - Read files in the directory and print them.
125 ;; file - Read file and print it.
127 ;; buffer - Print the entire buffer.
129 ;; region - Print just the current region.
131 ;; Two ebnf- command examples:
133 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
134 ;; immediately to the printer.
136 ;; ebnf-spool-region - translate and print just the current region, and
137 ;; spool the image in Emacs to send to the printer
140 ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and
141 ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print
142 ;; spooling mechanism. See section "Actions in Comments" for an explanation
143 ;; about EPS file generation.
149 ;; To translate and print your buffer, type
151 ;; M-x ebnf-print-buffer
153 ;; or substitute one of the other four ebnf- commands. The command will
154 ;; generate the PostScript image and print or spool it as specified. By giving
155 ;; the command a prefix argument
157 ;; C-u M-x ebnf-print-buffer
159 ;; it will save the PostScript image to a file instead of sending it to the
160 ;; printer; you will be prompted for the name of the file to save the image to.
161 ;; The prefix argument is ignored by the commands that spool their images, but
162 ;; you may save the spooled images to a file by giving a prefix argument to
165 ;; C-u M-x ebnf-despool
167 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
170 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
171 ;; `ebnf-eps-region'.
173 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
175 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
176 ;; (global-set-key '(shift f22) 'ebnf-print-region)
177 ;; (global-set-key '(control f22) 'ebnf-despool)
180 ;; Invoking Ebnf2ps in Batch
181 ;; -------------------------
183 ;; It's possible also to run ebnf2ps in batch, this is useful when, for
184 ;; example, you have a directory with a lot of files containing the EBNF to be
185 ;; translated to PostScript.
187 ;; To run ebnf2ps in batch type, for example:
189 ;; emacs -batch -l setup-ebnf2ps.el -f ebnf-eps-directory
191 ;; Where setup-ebnf2ps.el should be a file containing:
193 ;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
194 ;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
195 ;; (require 'ebnf2ps)
196 ;; ;; insert here your ebnf2ps settings
197 ;; (setq ebnf-terminal-shape 'bevel)
204 ;; BNF (Backus Naur Form) notation is defined like languages, and like
205 ;; languages there are rules about name formation and syntax. In this section
206 ;; it's defined a BNF syntax that it's called simply EBNF (Extended BNF).
207 ;; ebnf2ps package also deal with other BNF notation. Please, see the variable
208 ;; `ebnf-syntax' documentation below in this section.
210 ;; The current EBNF that ebnf2ps accepts has the following constructions:
212 ;; ; comment (until end of line)
216 ;; $A default non-terminal (see text below)
217 ;; $"C" default terminal (see text below)
218 ;; $?C? default special (see text below)
219 ;; A = B. production (A is the header and B the body)
220 ;; C D sequence (C occurs before D)
221 ;; C | D alternative (C or D occurs)
222 ;; A - B exception (A excluding B, B without any non-terminal)
223 ;; n * A repetition (A repeats at least n (integer) times)
224 ;; n * n A repetition (A repeats exactly n (integer) times)
225 ;; n * m A repetition (A repeats at least n (integer) and at most
226 ;; m (integer) times)
227 ;; (C) group (expression C is grouped together)
228 ;; [C] optional (C may or not occurs)
229 ;; C+ one or more occurrences of C
230 ;; {C}+ one or more occurrences of C
231 ;; {C}* zero or more occurrences of C
232 ;; {C} zero or more occurrences of 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}*]
236 ;; {C || D} equivalent to: [C {D C}*]
238 ;; The EBNF syntax written using the notation above is:
240 ;; EBNF = {production}+.
242 ;; production = non_terminal "=" body ".". ;; production
244 ;; body = {sequence || "|"}*. ;; alternative
246 ;; sequence = {exception}*. ;; sequence
248 ;; exception = repeat [ "-" repeat]. ;; exception
250 ;; repeat = [ integer "*" [ integer ]] term. ;; repetition
253 ;; | [factor] "+" ;; one-or-more
254 ;; | [factor] "/" [factor] ;; one-or-more
257 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
258 ;; | [ "$" ] non_terminal ;; non-terminal
259 ;; | [ "$" ] "?" special "?" ;; special
260 ;; | "(" body ")" ;; group
261 ;; | "[" body "]" ;; zero-or-one
262 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
263 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
264 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
267 ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
268 ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
269 ;; ;; and lower), 8-bit accentuated characters,
270 ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
271 ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
273 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
274 ;; ;; that is, a valid terminal accepts any printable character (including
275 ;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
276 ;; ;; terminal. Also, accepts escaped characters, that is, a character
277 ;; ;; pair starting with `\' followed by a printable character, for
278 ;; ;; example: \", \\.
280 ;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
281 ;; ;; that is, a valid special accepts any printable character (including
282 ;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
283 ;; ;; delimit a special.
285 ;; integer = "[0-9]+".
286 ;; ;; that is, an integer is a sequence of one or more decimal digits.
288 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
289 ;; ;; that is, a comment starts with the character `;' and terminates at end
290 ;; ;; of line. Also, it only accepts printable characters (including 8-bit
291 ;; ;; accentuated characters) and tabs.
293 ;; Try to use the above EBNF to test ebnf2ps.
295 ;; The `default' terminal, non-terminal and special is a way to indicate a
296 ;; default path in a production. For example, the production:
298 ;; X = [ $A ( B | $C ) | D ].
300 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
302 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
303 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
304 ;; name besides that enclosed by `"'.
306 ;; Let's see an example:
308 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
309 ;; (setq ebnf-case-fold-search nil) ; exact matching
311 ;; If you have the production:
313 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
315 ;; The names are classified as:
317 ;; Logical Expression non-terminal
318 ;; "(" OR AND "XOR" ")" terminal
320 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
321 ;; value is ?\; (character `;').
323 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
324 ;; value is ?. (character `.').
326 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
328 ;; `ebnf' ebnf2ps recognizes the syntax described above.
329 ;; The following variables *ONLY* have effect with this
331 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
332 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
334 ;; `abnf' ebnf2ps recognizes the syntax described in the URL:
335 ;; `http://www.ietf.org/rfc/rfc2234.txt'
336 ;; ("Augmented BNF for Syntax Specifications: ABNF").
338 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
339 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
340 ;; ("International Standard of the ISO EBNF Notation").
341 ;; The following variables *ONLY* have effect with this
343 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
345 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
346 ;; The following variable *ONLY* has effect with this
348 ;; `ebnf-yac-ignore-error-recovery'.
350 ;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
351 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
352 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
354 ;; `dtd' ebnf2ps recognizes the syntax described in the URL:
355 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
356 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
358 ;; Any other value is treated as `ebnf'.
360 ;; The default value is `ebnf'.
366 ;; The following EBNF optimizations are done:
368 ;; [ { A }* ] ==> { A }*
369 ;; [ { A }+ ] ==> { A }*
370 ;; [ A ] + ==> { A }*
371 ;; { A }* + ==> { A }*
372 ;; { A }+ + ==> { A }+
375 ;; ( A | EMPTY )- ==> A
376 ;; ( A | B | EMPTY )- ==> A | B
377 ;; [ A | B ] ==> A | B | EMPTY
378 ;; n * EMPTY ==> EMPTY
380 ;; EMPTY / EMPTY ==> EMPTY
381 ;; EMPTY - A ==> EMPTY
383 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
386 ;; 1. A = B | A C. ==> A = B {C}*.
387 ;; 2. A = B | A B. ==> A = {B}+.
388 ;; 3. A = | A B. ==> A = {B}*.
389 ;; 4. A = B | A C B. ==> A = {B || C}+.
390 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
393 ;; 6. A = B | . ==> A = [B].
394 ;; 7. A = | B . ==> A = [B].
397 ;; 8. A = B C | B D. ==> A = B (C | D).
398 ;; 9. A = C B | D B. ==> A = (C | D) B.
399 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
401 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
407 ;; You may use form feed (^L \014) to force a production to start on a new
408 ;; page, for example:
417 ;; c) A = B ^L^L^L | C.^L
421 ;; In all examples above, only the production X will start on a new page.
424 ;; Actions in Comments
425 ;; -------------------
427 ;; ebnf2ps accepts the following actions in comments:
429 ;; ;^ same as form feed. See section Form Feed above.
431 ;; ;> the next production starts in the same line as the current one.
432 ;; It is useful when `ebnf-horizontal-orientation' is nil.
434 ;; ;< the next production starts in the next line.
435 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
437 ;; ;[EPS open a new EPS file. The EPS file name has the form:
438 ;; <PREFIX><NAME>.eps
439 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
440 ;; <NAME> is the string given by ;[ action comment, this string is
441 ;; mapped to form a valid file name (see documentation for
442 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
443 ;; It has effect only during `ebnf-eps-buffer' or
444 ;; `ebnf-eps-region' execution.
445 ;; It's an error to try to open an already opened EPS file.
447 ;; ;]EPS close an opened EPS file.
448 ;; It has effect only during `ebnf-eps-buffer' or
449 ;; `ebnf-eps-region' execution.
450 ;; It's an error to try to close a not opened EPS file.
454 ;; (setq ebnf-horizontal-orientation nil)
458 ;; ;> C and B are drawn in the same line
462 ;; The graphical result is:
468 ;; +---------+ +-----+
480 ;; Note that if ascending production sort is used, the productions A and B will
481 ;; be drawn in the same line instead of C and B.
483 ;; If consecutive actions occur, only the last one takes effect, so if you
492 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
495 ;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*)
496 ;; and (*]EPS*). The first example above should be written:
500 ;; (*> C and B are drawn in the same line *)
504 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
505 ;; `ebnf-eps-region':
524 ;; The following table summarizes the results:
526 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
527 ;; ebnf--AA.eps A C A C C A
528 ;; ebnf--BB.eps C B B C C B
529 ;; ebnf--CC.eps A C B F A B C F F C B A
535 ;; As you can see if EPS actions is not used, each single production is
536 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
537 ;; it's not an existing production name.
539 ;; In the following case:
547 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
553 ;; Some tools are provided to help you.
555 ;; `ebnf-setup' returns the current setup.
557 ;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the
560 ;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given
563 ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
566 ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current
569 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
571 ;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer',
572 ;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same
573 ;; way as `ebnf-' commands.
579 ;; ebn2ps has the following hook variables:
582 ;; It is evaluated once before any ebnf2ps process.
584 ;; `ebnf-production-hook'
585 ;; It is evaluated on each beginning of production.
588 ;; It is evaluated on each beginning of page.
594 ;; Below it's shown a brief description of ebnf2ps options, please, see the
595 ;; options declaration in the code for a long documentation.
597 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
600 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
601 ;; height in horizontal orientation.
603 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
604 ;; between productions.
606 ;; `ebnf-production-vertical-space' Specify vertical space in points
607 ;; between productions.
609 ;; `ebnf-justify-sequence' Specify justification of terms in a
610 ;; sequence inside alternatives.
612 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
614 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
616 ;; `ebnf-terminal-font' Specify terminal font.
618 ;; `ebnf-terminal-shape' Specify terminal box shape.
620 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
623 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
625 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
627 ;; `ebnf-production-name-p' Non-nil means production name will be
630 ;; `ebnf-sort-production' Specify how productions are sorted.
632 ;; `ebnf-production-font' Specify production font.
634 ;; `ebnf-non-terminal-font' Specify non-terminal font.
636 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
638 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
641 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
644 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
647 ;; `ebnf-special-show-delimiter' Non-nil means special delimiter
648 ;; (character `?') is shown.
650 ;; `ebnf-special-font' Specify special font.
652 ;; `ebnf-special-shape' Specify special box shape.
654 ;; `ebnf-special-shadow' Non-nil means special box will have a
657 ;; `ebnf-special-border-width' Specify border width for special box.
659 ;; `ebnf-special-border-color' Specify border color for special box.
661 ;; `ebnf-except-font' Specify except font.
663 ;; `ebnf-except-shape' Specify except box shape.
665 ;; `ebnf-except-shadow' Non-nil means except box will have a
668 ;; `ebnf-except-border-width' Specify border width for except box.
670 ;; `ebnf-except-border-color' Specify border color for except box.
672 ;; `ebnf-repeat-font' Specify repeat font.
674 ;; `ebnf-repeat-shape' Specify repeat box shape.
676 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
679 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
681 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
683 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
685 ;; `ebnf-arrow-shape' Specify the arrow shape.
687 ;; `ebnf-chart-shape' Specify chart flow shape.
689 ;; `ebnf-color-p' Non-nil means use color.
691 ;; `ebnf-line-width' Specify flow line width.
693 ;; `ebnf-line-color' Specify flow line color.
695 ;; `ebnf-arrow-extra-width' Specify extra width for arrow shape
698 ;; `ebnf-arrow-scale' Specify the arrow scale.
700 ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
703 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
706 ;; `ebnf-lex-comment-char' Specify the line comment character.
708 ;; `ebnf-lex-eop-char' Specify the end of production
711 ;; `ebnf-syntax' Specify syntax to be recognized.
713 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
715 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
718 ;; `ebnf-default-width' Specify additional border width over
719 ;; default terminal, non-terminal or
722 ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains
725 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
727 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
729 ;; `ebnf-stop-on-error' Non-nil means signal error and stop.
730 ;; Nil means signal error and continue.
732 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
734 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
736 ;; `ebnf-optimize' Non-nil means optimize syntactic chart
739 ;; To set the above options you may:
741 ;; a) insert the code in your ~/.emacs, like:
743 ;; (setq ebnf-terminal-shape 'bevel)
745 ;; This way always keep your default settings when you enter a new Emacs
748 ;; b) or use `set-variable' in your Emacs session, like:
750 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
752 ;; This way keep your settings only during the current Emacs session.
754 ;; c) or use customization, for example:
755 ;; click on menu-bar *Help* option,
756 ;; then click on *Customize*,
757 ;; then click on *Browse Customization Groups*,
758 ;; expand *PostScript* group,
759 ;; expand *Ebnf2ps* group
760 ;; and then customize ebnf2ps options.
761 ;; Through this way, you may choose if the settings are kept or not when
762 ;; you leave out the current Emacs session.
764 ;; d) or see the option value:
766 ;; C-h v ebnf-terminal-shape RET
768 ;; and click the *customize* hypertext button.
769 ;; Through this way, you may choose if the settings are kept or not when
770 ;; you leave out the current Emacs session.
774 ;; M-x ebnf-customize RET
776 ;; and then customize ebnf2ps options.
777 ;; Through this way, you may choose if the settings are kept or not when
778 ;; you leave out the current Emacs session.
784 ;; Sometimes you need to change the EBNF style you are using, for example,
785 ;; change the shapes and colors. These changes may force you to set some
786 ;; variables and after use, set back the variables to the old values.
788 ;; To help to handle this situation, ebnf2ps has the following commands to
791 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
794 ;; `ebnf-delete-style' Delete style NAME.
796 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
798 ;; `ebnf-apply-style' Set STYLE as the current style.
800 ;; `ebnf-reset-style' Reset current style.
802 ;; `ebnf-push-style' Push the current style and set STYLE as the current
805 ;; `ebnf-pop-style' Pop a style and set it as the current style.
807 ;; These commands help to put together a lot of variable settings in a group
808 ;; and name this group. So when you wish to apply these settings it's only
809 ;; needed to give the name.
811 ;; There is also a notion of simple inheritance of style; so, if you declare
812 ;; that a style A inherits from a style B, all settings of B is applied first
813 ;; and then the settings of A is applied. This is useful when you wish to
814 ;; modify some aspects of an existing style, but at same time wish to keep it
817 ;; See documentation for `ebnf-style-database'.
823 ;; Below it is the layout of minimum area to draw each element, and it's used
824 ;; the following terms:
826 ;; font height is given by:
827 ;; (terminal font height + non-terminal font height) / 2
829 ;; entry is the vertical position used to know where it should
830 ;; be drawn the flow line in the current element.
832 ;; extra is given by `ebnf-arrow-extra-width'.
835 ;; * SPECIAL, TERMINAL and NON-TERMINAL
837 ;; +==============+...................................
838 ;; | | } font height / 2 } entry }
839 ;; | XXXXXXXX...|....... } }
840 ;; ====+ XXXXXXXX +==== } text height ...... } height
841 ;; : | XXXXXXXX...|...:... }
842 ;; : | : : | : } font height / 2 }
843 ;; : +==============+...:...............................
845 ;; : : : : : :.........................
846 ;; : : : : : } font height }
847 ;; : : : : :....... }
848 ;; : : : : } font height / 2 }
849 ;; : : : :........... }
850 ;; : : : } text width } width
851 ;; : : :.................. }
852 ;; : : } font height / 2 }
853 ;; : :...................... }
854 ;; : } font height + extra }
855 ;; :.................................................
860 ;; +==========+.....................................
864 ;; ===+===+ +===+===... } element height } height
867 ;; : | +==========+.|................. }
868 ;; : | : : | : } font height }
869 ;; : +==============+...................................
871 ;; : : : :......................
872 ;; : : : } font height * 2 }
874 ;; : : } element width } width
875 ;; : :..................... }
876 ;; : } font height * 2 }
877 ;; :...............................................
882 ;; +===+...................................
883 ;; +==+ A +==+ } A height } }
884 ;; | +===+..|........ } entry }
885 ;; + + } font height } }
886 ;; / +===+...\....... } }
887 ;; ===+====+ B +====+=== } B height ..... } height
888 ;; : \ +===+.../....... }
889 ;; : + + : } font height }
890 ;; : | +===+..|........ }
891 ;; : +==+ C +==+ : } C height }
892 ;; : : +===+...................................
894 ;; : : : :......................
895 ;; : : : } font height * 2 }
897 ;; : : } max width } width
898 ;; : :................. }
899 ;; : } font height * 2 }
900 ;; :..........................................
903 ;; 1. An empty alternative has zero of height.
905 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
911 ;; +===========+...............................
912 ;; +=+ separator +=+ } separator height }
913 ;; / +===========+..\........ }
915 ;; | | } font height }
917 ;; \ +===========+../........ } height = entry
918 ;; +=+ element +=+ } element height }
919 ;; /: +===========+..\........ }
921 ;; + : : + } font height }
923 ;; ==+=======================+==.......................
925 ;; : : : :.......................
926 ;; : : : } font height * 2 }
928 ;; : : } max width } width
929 ;; : :......................... }
930 ;; : } font height * 2 }
931 ;; :...................................................
936 ;; +===========+......................................
937 ;; +=+ separator +=+ } separator height } }
938 ;; / +===========+..\...... } }
940 ;; | | } font height } } height
942 ;; \ +===========+../...... } }
943 ;; ===+=+ element +=+=== } element height .... }
944 ;; : : +===========+......................................
946 ;; : : : :........................
947 ;; : : : } font height * 2 }
949 ;; : : } max width } width
950 ;; : :....................... }
951 ;; : } font height * 2 }
952 ;; :..............................................
957 ;; XXXXXX:......................................
958 ;; XXXXXX: } production font height }
959 ;; XXXXXX:............ }
961 ;; +======+....... } height = entry
963 ;; ====+ +==== } element height }
965 ;; : +======+.................................
967 ;; : : : :......................
968 ;; : : : } font height * 2 }
970 ;; : : } element width } width
971 ;; : :.............. }
972 ;; : } font height * 2 }
973 ;; :.....................................
978 ;; +================+...................................
979 ;; | | } font height / 2 } entry }
980 ;; | +===+...|....... } }
981 ;; ====+ N * | X | +==== } X height ......... } height
982 ;; : | : : +===+...|...:... }
983 ;; : | : : : : | : } font height / 2 }
984 ;; : +================+...:...............................
986 ;; : : : : : : : :..........................
987 ;; : : : : : : : } font height }
988 ;; : : : : : : :....... }
989 ;; : : : : : : } font height / 2 }
990 ;; : : : : : :........... }
991 ;; : : : : : } X width }
992 ;; : : : : :............... }
993 ;; : : : : } font height / 2 } width
994 ;; : : : :.................. }
995 ;; : : : } text width }
996 ;; : : :..................... }
997 ;; : : } font height / 2 }
998 ;; : :........................ }
999 ;; : } font height + extra }
1000 ;; :...................................................
1005 ;; +==================+...................................
1006 ;; | | } font height / 2 } entry }
1007 ;; | +===+ +===+...|....... } }
1008 ;; ====+ | X | - | y | +==== } max height ....... } height
1009 ;; : | +===+ +===+...|...:... }
1010 ;; : | : : : : | : } font height / 2 }
1011 ;; : +==================+...:...............................
1013 ;; : : : : : : : :..........................
1014 ;; : : : : : : : } font height }
1015 ;; : : : : : : :....... }
1016 ;; : : : : : : } font height / 2 }
1017 ;; : : : : : :........... }
1018 ;; : : : : : } Y width }
1019 ;; : : : : :............... }
1020 ;; : : : : } font height } width
1021 ;; : : : :................... }
1022 ;; : : : } X width }
1023 ;; : : :....................... }
1024 ;; : : } font height / 2 }
1025 ;; : :.......................... }
1026 ;; : } font height + extra }
1027 ;; :.....................................................
1029 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
1032 ;; Internal Structures
1033 ;; -------------------
1035 ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis
1036 ;; of current buffer and generates an intermediate representation. The second
1037 ;; pass uses the intermediate representation to generate the PostScript
1040 ;; The intermediate representation is a list of vectors, the vector element
1041 ;; represents a syntactic chart element. Below is a vector representation for
1042 ;; each syntactic chart element.
1044 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
1045 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1046 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1047 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1048 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1049 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1050 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
1051 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
1052 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1053 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1054 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
1055 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
1057 ;; The first vector position is a function symbol used to generate PostScript
1058 ;; for this element.
1059 ;; WIDTH-FUN is a function symbol called to adjust the element width.
1060 ;; DIM-FUN is a function symbol called to set the element dimensions.
1061 ;; ENTRY is the element entry point.
1062 ;; HEIGHT and WIDTH are the element height and width, respectively.
1063 ;; NAME is a string that it's the element name.
1064 ;; DEFAULT is a boolean that indicates if it's a `default' element.
1065 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
1067 ;; LIST is a list of vector that represents the list part for alternatives and
1069 ;; SEPARATOR is a vector that represents the sub-element used to separate the
1071 ;; TIMES is a string representing the number of times that ELEMENT is repeated
1072 ;; on a repeat construction.
1073 ;; ACTION indicates some action that should be done before production is
1074 ;; generated. The current actions are:
1078 ;; form-feed current production starts on a new page.
1080 ;; newline current production starts on next line, this is useful
1081 ;; when `ebnf-horizontal-orientation' is non-nil.
1083 ;; keep-line current production continues on the current line, this
1084 ;; is useful when `ebnf-horizontal-orientation' is nil.
1090 ;; . Handle situations when syntactic chart is out of paper.
1091 ;; . Use other alphabet than ascii.
1092 ;; . Optimizations...
1098 ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
1099 ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale',
1100 ;; `ebnf-production-name-p', `ebnf-stop-on-error',
1101 ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
1102 ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
1106 ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
1107 ;; with some Bison features (%right, %left and %prec pragmas). His suggestion
1108 ;; was extended to deal with %nonassoc pragma too.
1110 ;; Thanks to all who emailed comments.
1113 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1120 (and (string< ps-print-version "5.2.3")
1121 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1124 ;; to avoid gripes with Emacs 20
1125 (or (fboundp 'assq-delete-all)
1126 (defun assq-delete-all (key alist)
1127 "Delete from ALIST all elements whose car is KEY.
1128 Return the modified alist.
1129 Elements of ALIST that are not conses are ignored."
1132 (if (and (consp (car tail))
1133 (eq (car (car tail)) key))
1134 (setq alist (delq (car tail) alist)))
1135 (setq tail (cdr tail)))
1139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1143 ;;; Interface to the command system
1145 (defgroup postscript nil
1152 (defgroup ebnf2ps nil
1153 "Translate an EBNF to a syntactic chart on PostScript."
1160 (defgroup ebnf-special nil
1161 "Special customization."
1168 (defgroup ebnf-except nil
1169 "Except customization."
1176 (defgroup ebnf-repeat nil
1177 "Repeat customization."
1184 (defgroup ebnf-terminal nil
1185 "Terminal customization."
1192 (defgroup ebnf-non-terminal nil
1193 "Non-Terminal customization."
1200 (defgroup ebnf-production nil
1201 "Production customization."
1208 (defgroup ebnf-shape nil
1209 "Shapes customization."
1216 (defgroup ebnf-displacement nil
1217 "Displacement customization."
1224 (defgroup ebnf-syntactic nil
1225 "Syntactic customization."
1232 (defgroup ebnf-optimization nil
1233 "Optimization customization."
1240 (defcustom ebnf-horizontal-orientation nil
1241 "*Non-nil means productions are drawn horizontally."
1244 :group 'ebnf-displacement)
1247 (defcustom ebnf-horizontal-max-height nil
1248 "*Non-nil means to use maximum production height in horizontal orientation.
1250 It is only used when `ebnf-horizontal-orientation' is non-nil."
1253 :group 'ebnf-displacement)
1256 (defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
1257 "*Specify horizontal space in points between productions.
1259 Value less or equal to zero forces ebnf2ps to set a proper default value."
1262 :group 'ebnf-displacement)
1265 (defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
1266 "*Specify vertical space in points between productions.
1268 Value less or equal to zero forces ebnf2ps to set a proper default value."
1271 :group 'ebnf-displacement)
1274 (defcustom ebnf-justify-sequence 'center
1275 "*Specify justification of terms in a sequence inside alternatives.
1279 `left' left justification
1280 `right' right justification
1281 any other value centralize"
1282 :type '(radio :tag "Sequence Justification"
1283 (const left) (const right) (other :tag "center" center))
1285 :group 'ebnf-displacement)
1288 (defcustom ebnf-special-show-delimiter t
1289 "*Non-nil means special delimiter (character `?') is shown."
1292 :group 'ebnf-special)
1295 (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
1296 "*Specify special font.
1298 See documentation for `ebnf-production-font'."
1299 :type '(list :tag "Special Font"
1300 (number :tag "Font Size")
1301 (symbol :tag "Font Name")
1302 (choice :tag "Foreground Color"
1303 (string :tag "Name")
1304 (other :tag "Default" nil))
1305 (choice :tag "Background Color"
1306 (string :tag "Name")
1307 (other :tag "Default" nil))
1308 (repeat :tag "Font Attributes" :inline t
1309 (choice (const bold) (const italic)
1310 (const underline) (const strikeout)
1311 (const overline) (const shadow)
1312 (const box) (const outline))))
1314 :group 'ebnf-special)
1317 (defcustom ebnf-special-shape 'bevel
1318 "*Specify special box shape.
1320 See documentation for `ebnf-non-terminal-shape'."
1321 :type '(radio :tag "Special Shape"
1322 (const miter) (const round) (const bevel))
1324 :group 'ebnf-special)
1327 (defcustom ebnf-special-shadow nil
1328 "*Non-nil means special box will have a shadow."
1331 :group 'ebnf-special)
1334 (defcustom ebnf-special-border-width 0.5
1335 "*Specify border width for special box."
1338 :group 'ebnf-special)
1341 (defcustom ebnf-special-border-color "Black"
1342 "*Specify border color for special box."
1345 :group 'ebnf-special)
1348 (defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
1349 "*Specify except font.
1351 See documentation for `ebnf-production-font'."
1352 :type '(list :tag "Except Font"
1353 (number :tag "Font Size")
1354 (symbol :tag "Font Name")
1355 (choice :tag "Foreground Color"
1356 (string :tag "Name")
1357 (other :tag "Default" nil))
1358 (choice :tag "Background Color"
1359 (string :tag "Name")
1360 (other :tag "Default" nil))
1361 (repeat :tag "Font Attributes" :inline t
1362 (choice (const bold) (const italic)
1363 (const underline) (const strikeout)
1364 (const overline) (const shadow)
1365 (const box) (const outline))))
1367 :group 'ebnf-except)
1370 (defcustom ebnf-except-shape 'bevel
1371 "*Specify except box shape.
1373 See documentation for `ebnf-non-terminal-shape'."
1374 :type '(radio :tag "Except Shape"
1375 (const miter) (const round) (const bevel))
1377 :group 'ebnf-except)
1380 (defcustom ebnf-except-shadow nil
1381 "*Non-nil means except box will have a shadow."
1384 :group 'ebnf-except)
1387 (defcustom ebnf-except-border-width 0.25
1388 "*Specify border width for except box."
1391 :group 'ebnf-except)
1394 (defcustom ebnf-except-border-color "Black"
1395 "*Specify border color for except box."
1398 :group 'ebnf-except)
1401 (defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
1402 "*Specify repeat font.
1404 See documentation for `ebnf-production-font'."
1405 :type '(list :tag "Repeat Font"
1406 (number :tag "Font Size")
1407 (symbol :tag "Font Name")
1408 (choice :tag "Foreground Color"
1409 (string :tag "Name")
1410 (other :tag "Default" nil))
1411 (choice :tag "Background Color"
1412 (string :tag "Name")
1413 (other :tag "Default" nil))
1414 (repeat :tag "Font Attributes" :inline t
1415 (choice (const bold) (const italic)
1416 (const underline) (const strikeout)
1417 (const overline) (const shadow)
1418 (const box) (const outline))))
1420 :group 'ebnf-repeat)
1423 (defcustom ebnf-repeat-shape 'bevel
1424 "*Specify repeat box shape.
1426 See documentation for `ebnf-non-terminal-shape'."
1427 :type '(radio :tag "Repeat Shape"
1428 (const miter) (const round) (const bevel))
1430 :group 'ebnf-repeat)
1433 (defcustom ebnf-repeat-shadow nil
1434 "*Non-nil means repeat box will have a shadow."
1437 :group 'ebnf-repeat)
1440 (defcustom ebnf-repeat-border-width 0.0
1441 "*Specify border width for repeat box."
1444 :group 'ebnf-repeat)
1447 (defcustom ebnf-repeat-border-color "Black"
1448 "*Specify border color for repeat box."
1451 :group 'ebnf-repeat)
1454 (defcustom ebnf-terminal-font '(7 Courier "Black" "White")
1455 "*Specify terminal font.
1457 See documentation for `ebnf-production-font'."
1458 :type '(list :tag "Terminal Font"
1459 (number :tag "Font Size")
1460 (symbol :tag "Font Name")
1461 (choice :tag "Foreground Color"
1462 (string :tag "Name")
1463 (other :tag "Default" nil))
1464 (choice :tag "Background Color"
1465 (string :tag "Name")
1466 (other :tag "Default" nil))
1467 (repeat :tag "Font Attributes" :inline t
1468 (choice (const bold) (const italic)
1469 (const underline) (const strikeout)
1470 (const overline) (const shadow)
1471 (const box) (const outline))))
1473 :group 'ebnf-terminal)
1476 (defcustom ebnf-terminal-shape 'miter
1477 "*Specify terminal box shape.
1479 See documentation for `ebnf-non-terminal-shape'."
1480 :type '(radio :tag "Terminal Shape"
1481 (const miter) (const round) (const bevel))
1483 :group 'ebnf-terminal)
1486 (defcustom ebnf-terminal-shadow nil
1487 "*Non-nil means terminal box will have a shadow."
1490 :group 'ebnf-terminal)
1493 (defcustom ebnf-terminal-border-width 1.0
1494 "*Specify border width for terminal box."
1497 :group 'ebnf-terminal)
1500 (defcustom ebnf-terminal-border-color "Black"
1501 "*Specify border color for terminal box."
1504 :group 'ebnf-terminal)
1507 (defcustom ebnf-production-name-p t
1508 "*Non-nil means production name will be printed."
1511 :group 'ebnf-production)
1514 (defcustom ebnf-sort-production nil
1515 "*Specify how productions are sorted.
1519 nil don't sort productions.
1520 `ascending' ascending sort.
1521 any other value descending sort."
1522 :type '(radio :tag "Production Sort"
1523 (const :tag "Ascending" ascending)
1524 (const :tag "Descending" descending)
1525 (other :tag "No Sort" nil))
1527 :group 'ebnf-production)
1530 (defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
1531 "*Specify production header font.
1533 It is a list with the following form:
1535 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1538 SIZE is the font size.
1539 NAME is the font name symbol.
1540 ATTRIBUTE is one of the following symbols:
1541 bold - use bold font.
1542 italic - use italic font.
1543 underline - put a line under text.
1544 strikeout - like underline, but the line is in middle of text.
1545 overline - like underline, but the line is over the text.
1546 shadow - text will have a shadow.
1547 box - text will be surrounded by a box.
1548 outline - print characters as hollow outlines.
1549 FOREGROUND is a foreground string color name; if it's nil, the default color is
1551 BACKGROUND is a background string color name; if it's nil, the default color is
1554 See `ps-font-info-database' for valid font name."
1555 :type '(list :tag "Production Font"
1556 (number :tag "Font Size")
1557 (symbol :tag "Font Name")
1558 (choice :tag "Foreground Color"
1559 (string :tag "Name")
1560 (other :tag "Default" nil))
1561 (choice :tag "Background Color"
1562 (string :tag "Name")
1563 (other :tag "Default" nil))
1564 (repeat :tag "Font Attributes" :inline t
1565 (choice (const bold) (const italic)
1566 (const underline) (const strikeout)
1567 (const overline) (const shadow)
1568 (const box) (const outline))))
1570 :group 'ebnf-production)
1573 (defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
1574 "*Specify non-terminal font.
1576 See documentation for `ebnf-production-font'."
1577 :type '(list :tag "Non-Terminal Font"
1578 (number :tag "Font Size")
1579 (symbol :tag "Font Name")
1580 (choice :tag "Foreground Color"
1581 (string :tag "Name")
1582 (other :tag "Default" nil))
1583 (choice :tag "Background Color"
1584 (string :tag "Name")
1585 (other :tag "Default" nil))
1586 (repeat :tag "Font Attributes" :inline t
1587 (choice (const bold) (const italic)
1588 (const underline) (const strikeout)
1589 (const overline) (const shadow)
1590 (const box) (const outline))))
1592 :group 'ebnf-non-terminal)
1595 (defcustom ebnf-non-terminal-shape 'round
1596 "*Specify non-terminal box shape.
1612 Any other value is treated as `miter'."
1613 :type '(radio :tag "Non-Terminal Shape"
1614 (const miter) (const round) (const bevel))
1616 :group 'ebnf-non-terminal)
1619 (defcustom ebnf-non-terminal-shadow nil
1620 "*Non-nil means non-terminal box will have a shadow."
1623 :group 'ebnf-non-terminal)
1626 (defcustom ebnf-non-terminal-border-width 1.0
1627 "*Specify border width for non-terminal box."
1630 :group 'ebnf-non-terminal)
1633 (defcustom ebnf-non-terminal-border-color "Black"
1634 "*Specify border color for non-terminal box."
1637 :group 'ebnf-non-terminal)
1640 (defcustom ebnf-arrow-shape 'hollow
1641 "*Specify the arrow shape.
1647 `semi-up' * `transparent' *
1655 `semi-down' =====* `hollow' *
1671 `semi-up-hollow' `semi-up-full'
1677 `semi-down-hollow' `semi-down-full'
1683 `user' See also documentation for variable `ebnf-user-arrow'.
1685 Any other value is treated as `none'."
1686 :type '(radio :tag "Arrow Shape"
1687 (const none) (const semi-up)
1688 (const semi-down) (const simple)
1689 (const transparent) (const hollow)
1690 (const full) (const semi-up-hollow)
1691 (const semi-down-hollow) (const semi-up-full)
1692 (const semi-down-full) (const user))
1697 (defcustom ebnf-chart-shape 'round
1698 "*Specify chart flow shape.
1700 See documentation for `ebnf-non-terminal-shape'."
1701 :type '(radio :tag "Chart Flow Shape"
1702 (const miter) (const round) (const bevel))
1707 (defcustom ebnf-user-arrow nil
1708 "*Specify a sexp for user arrow shape (a PostScript code).
1710 When evaluated, the sexp should return nil or a string containing PostScript
1711 code. PostScript code should draw a right arrow.
1713 The anatomy of a right arrow is:
1715 ...... Initial position
1717 : *.................
1721 ======+======*... } hT2
1725 : *.................
1731 :.......................
1733 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1734 be used to generate your own arrow. As these variables are used along
1735 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1736 values, if you need to modify them.
1738 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1740 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1742 :type '(sexp :tag "User Arrow Shape")
1747 (defcustom ebnf-syntax 'ebnf
1748 "*Specify syntax to be recognized.
1752 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1754 The following variables *ONLY* have effect with this
1756 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1757 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1759 `abnf' ebnf2ps recognizes the syntax described in the URL:
1760 `http://www.ietf.org/rfc/rfc2234.txt'
1761 (\"Augmented BNF for Syntax Specifications: ABNF\").
1763 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1764 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1765 (\"International Standard of the ISO EBNF Notation\").
1766 The following variables *ONLY* have effect with this
1768 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1770 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1771 The following variable *ONLY* has effect with this
1773 `ebnf-yac-ignore-error-recovery'.
1775 `ebnfx' ebnf2ps recognizes the syntax described in the URL:
1776 `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
1777 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1779 `dtd' ebnf2ps recognizes the syntax described in the URL:
1780 `http://www.w3.org/TR/2004/REC-xml-20040204/'
1781 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1783 Any other value is treated as `ebnf'."
1784 :type '(radio :tag "Syntax"
1785 (const ebnf) (const abnf) (const iso-ebnf)
1786 (const yacc) (const ebnfx) (const dtd))
1788 :group 'ebnf-syntactic)
1791 (defcustom ebnf-lex-comment-char ?\;
1792 "*Specify the line comment character.
1794 It's used only when `ebnf-syntax' is `ebnf'."
1797 :group 'ebnf-syntactic)
1800 (defcustom ebnf-lex-eop-char ?.
1801 "*Specify the end of production character.
1803 It's used only when `ebnf-syntax' is `ebnf'."
1806 :group 'ebnf-syntactic)
1809 (defcustom ebnf-terminal-regexp nil
1810 "*Specify how it's a terminal name.
1812 If it's nil, the terminal name must be enclosed by `\"'.
1813 If it's a string, it should be a regexp that it'll be used to determine a
1814 terminal name; terminal name may also be enclosed by `\"'.
1816 It's used only when `ebnf-syntax' is `ebnf'."
1817 :type '(radio :tag "Terminal Name"
1820 :group 'ebnf-syntactic)
1823 (defcustom ebnf-case-fold-search nil
1824 "*Non-nil means ignore case on matching.
1826 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1830 :group 'ebnf-syntactic)
1833 (defcustom ebnf-iso-alternative-p nil
1834 "*Non-nil means use alternative ISO EBNF.
1836 It's only used when `ebnf-syntax' is `iso-ebnf'.
1838 This variable affects the following symbol set:
1840 STANDARD ALTERNATIVE
1849 :group 'ebnf-syntactic)
1852 (defcustom ebnf-iso-normalize-p nil
1853 "*Non-nil means normalize ISO EBNF syntax names.
1855 Normalize a name means that several contiguous spaces inside name become a
1856 single space, so \"A B C\" is normalized to \"A B C\".
1858 It's only used when `ebnf-syntax' is `iso-ebnf'."
1861 :group 'ebnf-syntactic)
1864 (defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
1865 "*Specify file name suffix that contains EBNF.
1867 See `ebnf-eps-directory' command."
1873 (defcustom ebnf-eps-prefix "ebnf--"
1874 "*Specify EPS prefix file name.
1876 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1882 (defcustom ebnf-entry-percentage 0.5 ; middle
1883 "*Specify entry height on alternatives.
1885 It must be a float between 0.0 (top) and 1.0 (bottom)."
1891 (defcustom ebnf-default-width 0.6
1892 "*Specify additional border width over default terminal, non-terminal or
1899 ;; Printing color requires x-color-values.
1900 (defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
1901 (fboundp 'color-instance-rgb-components)) ; XEmacs
1902 "*Non-nil means use color."
1908 (defcustom ebnf-line-width 1.0
1909 "*Specify flow line width."
1915 (defcustom ebnf-line-color "Black"
1916 "*Specify flow line color."
1922 (defcustom ebnf-arrow-extra-width
1923 (if (eq ebnf-arrow-shape 'none)
1925 (* (sqrt 5.0) 0.65 ebnf-line-width))
1926 "*Specify extra width for arrow shape drawing.
1928 The extra width is used to avoid that the arrowhead and the terminal border
1929 overlap. It depens on `ebnf-arrow-shape' and `ebnf-line-width'."
1935 (defcustom ebnf-arrow-scale 1.0
1936 "*Specify the arrow scale.
1938 Values lower than 1.0, shrink the arrow.
1939 Values greater than 1.0, expand the arrow."
1945 (defcustom ebnf-debug-ps nil
1946 "*Non-nil means to generate PostScript debug procedures.
1948 It is intended to help PostScript programmers in debugging."
1954 (defcustom ebnf-use-float-format t
1955 "*Non-nil means use `%f' float format.
1957 The advantage of using float format is that ebnf2ps generates a little short
1960 If it occurs the error message:
1962 Invalid format operation %f
1964 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1970 (defcustom ebnf-stop-on-error nil
1971 "*Non-nil means signal error and stop. nil means signal error and continue."
1977 (defcustom ebnf-yac-ignore-error-recovery nil
1978 "*Non-nil means ignore error recovery.
1980 It's only used when `ebnf-syntax' is `yacc'."
1983 :group 'ebnf-syntactic)
1986 (defcustom ebnf-ignore-empty-rule nil
1987 "*Non-nil means ignore empty rules.
1989 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1990 middle action rule."
1993 :group 'ebnf-optimization)
1996 (defcustom ebnf-optimize nil
1997 "*Non-nil means optimize syntactic chart of rules.
1999 The following optimizations are done:
2002 1. A = B | A C. ==> A = B {C}*.
2003 2. A = B | A B. ==> A = {B}+.
2004 3. A = | A B. ==> A = {B}*.
2005 4. A = B | A C B. ==> A = {B || C}+.
2006 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
2009 6. A = B | . ==> A = [B].
2010 7. A = | B . ==> A = [B].
2013 8. A = B C | B D. ==> A = B (C | D).
2014 9. A = C B | D B. ==> A = (C | D) B.
2015 10. A = B C E | B D E. ==> A = B (C | D) E.
2017 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
2020 :group 'ebnf-optimization)
2023 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2024 ;; To make this file smaller, some commands go in a separate file.
2025 ;; But autoload them here to make the separation invisible.
2026 ;; Autoload is here to avoid compilation gripes.
2028 (autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
2029 "Eliminate empty rules.")
2031 (autoload 'ebnf-optimize "ebnf-otz"
2032 "Syntactic chart optimizer.")
2034 (autoload 'ebnf-otz-initialize "ebnf-otz"
2035 "Initialize optimizer.")
2038 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2043 (defun ebnf-customize ()
2044 "Customization for ebnf group."
2046 (customize-group 'ebnf2ps))
2049 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2054 (defun ebnf-print-directory (&optional directory)
2055 "Generate and print a PostScript syntactic chart image of DIRECTORY.
2057 If DIRECTORY is nil, it's used `default-directory'.
2059 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2062 See also `ebnf-print-buffer'."
2064 (list (read-file-name "Directory containing EBNF files (print): "
2065 nil default-directory)))
2066 (ebnf-directory 'ebnf-print-buffer directory))
2070 (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done)
2071 "Generate and print a PostScript syntactic chart image of the file FILE.
2073 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2074 killed after process termination.
2076 See also `ebnf-print-buffer'."
2077 (interactive "fEBNF file to generate PostScript and print from: ")
2078 (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done))
2082 (defun ebnf-print-buffer (&optional filename)
2083 "Generate and print a PostScript syntactic chart image of the buffer.
2085 When called with a numeric prefix argument (C-u), prompts the user for
2086 the name of a file to save the PostScript image in, instead of sending
2089 More specifically, the FILENAME argument is treated as follows: if it
2090 is nil, send the image to the printer. If FILENAME is a string, save
2091 the PostScript image in a file with that name. If FILENAME is a
2092 number, prompt the user for the name of the file to save in."
2093 (interactive (list (ps-print-preprint current-prefix-arg)))
2094 (ebnf-print-region (point-min) (point-max) filename))
2098 (defun ebnf-print-region (from to &optional filename)
2099 "Generate and print a PostScript syntactic chart image of the region.
2100 Like `ebnf-print-buffer', but prints just the current region."
2101 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
2102 (run-hooks 'ebnf-hook)
2103 (or (ebnf-spool-region from to)
2104 (ps-do-despool filename)))
2108 (defun ebnf-spool-directory (&optional directory)
2109 "Generate and spool a PostScript syntactic chart image of DIRECTORY.
2111 If DIRECTORY is nil, it's used `default-directory'.
2113 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2116 See also `ebnf-spool-buffer'."
2118 (list (read-file-name "Directory containing EBNF files (spool): "
2119 nil default-directory)))
2120 (ebnf-directory 'ebnf-spool-buffer directory))
2124 (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done)
2125 "Generate and spool a PostScript syntactic chart image of the file FILE.
2127 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2128 killed after process termination.
2130 See also `ebnf-spool-buffer'."
2131 (interactive "fEBNF file to generate PostScript and spool from: ")
2132 (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done))
2136 (defun ebnf-spool-buffer ()
2137 "Generate and spool a PostScript syntactic chart image of the buffer.
2138 Like `ebnf-print-buffer' except that the PostScript image is saved in a
2139 local buffer to be sent to the printer later.
2141 Use the command `ebnf-despool' to send the spooled images to the printer."
2143 (ebnf-spool-region (point-min) (point-max)))
2147 (defun ebnf-spool-region (from to)
2148 "Generate a PostScript syntactic chart image of the region and spool locally.
2149 Like `ebnf-spool-buffer', but spools just the current region.
2151 Use the command `ebnf-despool' to send the spooled images to the printer."
2153 (ebnf-generate-region from to 'ebnf-generate))
2157 (defun ebnf-eps-directory (&optional directory)
2158 "Generate EPS files from EBNF files in DIRECTORY.
2160 If DIRECTORY is nil, it's used `default-directory'.
2162 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2165 See also `ebnf-eps-buffer'."
2167 (list (read-file-name "Directory containing EBNF files (EPS): "
2168 nil default-directory)))
2169 (ebnf-directory 'ebnf-eps-buffer directory))
2173 (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done)
2174 "Generate an EPS file from EBNF file FILE.
2176 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2177 killed after EPS generation.
2179 See also `ebnf-eps-buffer'."
2180 (interactive "fEBNF file to generate EPS file from: ")
2181 (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done))
2185 (defun ebnf-eps-buffer ()
2186 "Generate a PostScript syntactic chart image of the buffer in a EPS file.
2188 Indeed, for each production is generated a EPS file.
2189 The EPS file name has the following form:
2191 <PREFIX><PRODUCTION>.eps
2193 <PREFIX> is given by variable `ebnf-eps-prefix'.
2194 The default value is \"ebnf--\".
2196 <PRODUCTION> is the production name.
2197 The production name is mapped to form a valid file name.
2198 For example, the production name \"A/B + C\" is mapped to
2199 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2201 WARNING: It's *NOT* asked any confirmation to override an existing file."
2203 (ebnf-eps-region (point-min) (point-max)))
2207 (defun ebnf-eps-region (from to)
2208 "Generate a PostScript syntactic chart image of the region in a EPS file.
2210 Indeed, for each production is generated a EPS file.
2211 The EPS file name has the following form:
2213 <PREFIX><PRODUCTION>.eps
2215 <PREFIX> is given by variable `ebnf-eps-prefix'.
2216 The default value is \"ebnf--\".
2218 <PRODUCTION> is the production name.
2219 The production name is mapped to form a valid file name.
2220 For example, the production name \"A/B + C\" is mapped to
2221 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2223 WARNING: It's *NOT* asked any confirmation to override an existing file."
2225 (let ((ebnf-eps-executing t))
2226 (ebnf-generate-region from to 'ebnf-generate-eps)))
2230 (defalias 'ebnf-despool 'ps-despool)
2234 (defun ebnf-syntax-directory (&optional directory)
2235 "Does a syntactic analysis of the files in DIRECTORY.
2237 If DIRECTORY is nil, it's used `default-directory'.
2239 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2242 See also `ebnf-syntax-buffer'."
2244 (list (read-file-name "Directory containing EBNF files (syntax): "
2245 nil default-directory)))
2246 (ebnf-directory 'ebnf-syntax-buffer directory))
2250 (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done)
2251 "Does a syntactic analysis of the FILE.
2253 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2254 killed after syntax checking.
2256 See also `ebnf-syntax-buffer'."
2257 (interactive "fEBNF file to check syntax: ")
2258 (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done))
2262 (defun ebnf-syntax-buffer ()
2263 "Does a syntactic analysis of the current buffer."
2265 (ebnf-syntax-region (point-min) (point-max)))
2269 (defun ebnf-syntax-region (from to)
2270 "Does a syntactic analysis of a region."
2272 (ebnf-generate-region from to nil))
2275 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2280 (defun ebnf-setup ()
2281 "Return the current ebnf2ps setup."
2284 ;;; ebnf2ps.el version %s
2286 \(setq ebnf-special-show-delimiter %S
2287 ebnf-special-font %s
2288 ebnf-special-shape %s
2289 ebnf-special-shadow %S
2290 ebnf-special-border-width %S
2291 ebnf-special-border-color %S
2293 ebnf-except-shape %s
2294 ebnf-except-shadow %S
2295 ebnf-except-border-width %S
2296 ebnf-except-border-color %S
2298 ebnf-repeat-shape %s
2299 ebnf-repeat-shadow %S
2300 ebnf-repeat-border-width %S
2301 ebnf-repeat-border-color %S
2302 ebnf-terminal-regexp %S
2303 ebnf-case-fold-search %S
2304 ebnf-terminal-font %s
2305 ebnf-terminal-shape %s
2306 ebnf-terminal-shadow %S
2307 ebnf-terminal-border-width %S
2308 ebnf-terminal-border-color %S
2309 ebnf-non-terminal-font %s
2310 ebnf-non-terminal-shape %s
2311 ebnf-non-terminal-shadow %S
2312 ebnf-non-terminal-border-width %S
2313 ebnf-non-terminal-border-color %S
2314 ebnf-production-name-p %S
2315 ebnf-sort-production %s
2316 ebnf-production-font %s
2320 ebnf-horizontal-orientation %S
2321 ebnf-horizontal-max-height %S
2322 ebnf-production-horizontal-space %S
2323 ebnf-production-vertical-space %S
2324 ebnf-justify-sequence %s
2325 ebnf-lex-comment-char ?\\%03o
2326 ebnf-lex-eop-char ?\\%03o
2328 ebnf-iso-alternative-p %S
2329 ebnf-iso-normalize-p %S
2330 ebnf-file-suffix-regexp %S
2332 ebnf-entry-percentage %S
2337 ebnf-use-float-format %S
2338 ebnf-stop-on-error %S
2339 ebnf-yac-ignore-error-recovery %S
2340 ebnf-ignore-empty-rule %S
2343 ;;; ebnf2ps.el - end of settings
2346 ebnf-special-show-delimiter
2347 (ps-print-quote ebnf-special-font)
2348 (ps-print-quote ebnf-special-shape)
2350 ebnf-special-border-width
2351 ebnf-special-border-color
2352 (ps-print-quote ebnf-except-font)
2353 (ps-print-quote ebnf-except-shape)
2355 ebnf-except-border-width
2356 ebnf-except-border-color
2357 (ps-print-quote ebnf-repeat-font)
2358 (ps-print-quote ebnf-repeat-shape)
2360 ebnf-repeat-border-width
2361 ebnf-repeat-border-color
2362 ebnf-terminal-regexp
2363 ebnf-case-fold-search
2364 (ps-print-quote ebnf-terminal-font)
2365 (ps-print-quote ebnf-terminal-shape)
2366 ebnf-terminal-shadow
2367 ebnf-terminal-border-width
2368 ebnf-terminal-border-color
2369 (ps-print-quote ebnf-non-terminal-font)
2370 (ps-print-quote ebnf-non-terminal-shape)
2371 ebnf-non-terminal-shadow
2372 ebnf-non-terminal-border-width
2373 ebnf-non-terminal-border-color
2374 ebnf-production-name-p
2375 (ps-print-quote ebnf-sort-production)
2376 (ps-print-quote ebnf-production-font)
2377 (ps-print-quote ebnf-arrow-shape)
2378 (ps-print-quote ebnf-chart-shape)
2379 (ps-print-quote ebnf-user-arrow)
2380 ebnf-horizontal-orientation
2381 ebnf-horizontal-max-height
2382 ebnf-production-horizontal-space
2383 ebnf-production-vertical-space
2384 (ps-print-quote ebnf-justify-sequence)
2385 ebnf-lex-comment-char
2387 (ps-print-quote ebnf-syntax)
2388 ebnf-iso-alternative-p
2389 ebnf-iso-normalize-p
2390 ebnf-file-suffix-regexp
2392 ebnf-entry-percentage
2397 ebnf-use-float-format
2399 ebnf-yac-ignore-error-recovery
2400 ebnf-ignore-empty-rule
2404 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2408 (defvar ebnf-stack-style nil
2409 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2413 (defvar ebnf-current-style 'default
2414 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2417 (defconst ebnf-style-custom-list
2418 '(ebnf-special-show-delimiter
2422 ebnf-special-border-width
2423 ebnf-special-border-color
2427 ebnf-except-border-width
2428 ebnf-except-border-color
2432 ebnf-repeat-border-width
2433 ebnf-repeat-border-color
2434 ebnf-terminal-regexp
2435 ebnf-case-fold-search
2438 ebnf-terminal-shadow
2439 ebnf-terminal-border-width
2440 ebnf-terminal-border-color
2441 ebnf-non-terminal-font
2442 ebnf-non-terminal-shape
2443 ebnf-non-terminal-shadow
2444 ebnf-non-terminal-border-width
2445 ebnf-non-terminal-border-color
2446 ebnf-production-name-p
2447 ebnf-sort-production
2448 ebnf-production-font
2452 ebnf-horizontal-orientation
2453 ebnf-horizontal-max-height
2454 ebnf-production-horizontal-space
2455 ebnf-production-vertical-space
2456 ebnf-justify-sequence
2457 ebnf-lex-comment-char
2460 ebnf-iso-alternative-p
2461 ebnf-iso-normalize-p
2462 ebnf-file-suffix-regexp
2464 ebnf-entry-percentage
2469 ebnf-use-float-format
2471 ebnf-yac-ignore-error-recovery
2472 ebnf-ignore-empty-rule
2474 "List of valid symbol custom variable.")
2477 (defvar ebnf-style-database
2481 (ebnf-special-show-delimiter . t)
2482 (ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic))
2483 (ebnf-special-shape . 'bevel)
2484 (ebnf-special-shadow . nil)
2485 (ebnf-special-border-width . 0.5)
2486 (ebnf-special-border-color . "Black")
2487 (ebnf-except-font . '(7 Courier "Black" "Gray90" bold italic))
2488 (ebnf-except-shape . 'bevel)
2489 (ebnf-except-shadow . nil)
2490 (ebnf-except-border-width . 0.25)
2491 (ebnf-except-border-color . "Black")
2492 (ebnf-repeat-font . '(7 Courier "Black" "Gray85" bold italic))
2493 (ebnf-repeat-shape . 'bevel)
2494 (ebnf-repeat-shadow . nil)
2495 (ebnf-repeat-border-width . 0.0)
2496 (ebnf-repeat-border-color . "Black")
2497 (ebnf-terminal-regexp . nil)
2498 (ebnf-case-fold-search . nil)
2499 (ebnf-terminal-font . '(7 Courier "Black" "White"))
2500 (ebnf-terminal-shape . 'miter)
2501 (ebnf-terminal-shadow . nil)
2502 (ebnf-terminal-border-width . 1.0)
2503 (ebnf-terminal-border-color . "Black")
2504 (ebnf-non-terminal-font . '(7 Helvetica "Black" "White"))
2505 (ebnf-non-terminal-shape . 'round)
2506 (ebnf-non-terminal-shadow . nil)
2507 (ebnf-non-terminal-border-width . 1.0)
2508 (ebnf-non-terminal-border-color . "Black")
2509 (ebnf-production-name-p . t)
2510 (ebnf-sort-production . nil)
2511 (ebnf-production-font . '(10 Helvetica "Black" "White" bold))
2512 (ebnf-arrow-shape . 'hollow)
2513 (ebnf-chart-shape . 'round)
2514 (ebnf-user-arrow . nil)
2515 (ebnf-horizontal-orientation . nil)
2516 (ebnf-horizontal-max-height . nil)
2517 (ebnf-production-horizontal-space . 0.0)
2518 (ebnf-production-vertical-space . 0.0)
2519 (ebnf-justify-sequence . 'center)
2520 (ebnf-lex-comment-char . ?\;)
2521 (ebnf-lex-eop-char . ?.)
2522 (ebnf-syntax . 'ebnf)
2523 (ebnf-iso-alternative-p . nil)
2524 (ebnf-iso-normalize-p . nil)
2525 (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$")
2526 (ebnf-eps-prefix . "ebnf--")
2527 (ebnf-entry-percentage . 0.5)
2528 (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
2529 (fboundp 'color-instance-rgb-components))) ; XEmacs
2530 (ebnf-line-width . 1.0)
2531 (ebnf-line-color . "Black")
2532 (ebnf-debug-ps . nil)
2533 (ebnf-use-float-format . t)
2534 (ebnf-stop-on-error . nil)
2535 (ebnf-yac-ignore-error-recovery . nil)
2536 (ebnf-ignore-empty-rule . nil)
2537 (ebnf-optimize . nil))
2538 ;; Happy EBNF default
2541 (ebnf-justify-sequence . 'left)
2542 (ebnf-lex-comment-char . ?\#)
2543 (ebnf-lex-eop-char . ?\;))
2547 (ebnf-syntax . 'abnf))
2551 (ebnf-syntax . 'iso-ebnf))
2552 ;; Yacc/Bison default
2555 (ebnf-syntax . 'yacc))
2559 (ebnf-syntax . 'ebnfx))
2563 (ebnf-syntax . 'dtd))
2567 Each element has the following form:
2569 (NAME INHERITS (VAR . VALUE)...)
2573 NAME is a symbol name style.
2575 INHERITS is a symbol name style from which the current style inherits
2576 the context. If INHERITS is nil, means that there is no
2579 This is a simple inheritance of style; so if you declare that a
2580 style A inherits from a style B, all settings of B is applied
2581 first and then the settings of A is applied. This is useful
2582 when you wish to modify some aspects of an existing style, but
2583 at same time wish to keep it unmodified.
2585 VAR is a valid ebnf2ps symbol custom variable.
2586 See `ebnf-style-custom-list' for valid symbol variable.
2588 VALUE is a sexp which it'll be evaluated to set the value to VAR.
2589 So, don't forget to quote symbols and constant lists.
2590 See `default' style for an example.
2592 Don't handle this variable directly. Use functions `ebnf-insert-style',
2593 `ebnf-delete-style' and `ebnf-merge-style'.")
2596 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2601 (defun ebnf-insert-style (name inherits &rest values)
2602 "Insert a new style NAME with inheritance INHERITS and values VALUES.
2604 See `ebnf-style-database' documentation."
2605 (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
2606 (and (assoc name ebnf-style-database)
2607 (error "Style name already exists: %s" name))
2608 (or (assoc inherits ebnf-style-database)
2609 (error "Style inheritance name does'nt exist: %s" inherits))
2610 (setq ebnf-style-database
2611 (cons (cons name (cons inherits (ebnf-check-style-values values)))
2612 ebnf-style-database)))
2616 (defun ebnf-delete-style (name)
2619 See `ebnf-style-database' documentation."
2620 (interactive "SDelete style name: ")
2621 (or (assoc name ebnf-style-database)
2622 (error "Style name doesn't exist: %s" name))
2623 (let ((db ebnf-style-database))
2625 (and (eq (nth 1 (car db)) name)
2626 (error "Style name `%s' is inherited by `%s' style"
2627 name (nth 0 (car db))))
2628 (setq db (cdr db))))
2629 (setq ebnf-style-database (assq-delete-all name ebnf-style-database)))
2633 (defun ebnf-merge-style (name &rest values)
2634 "Merge values of style NAME with style VALUES.
2636 See `ebnf-style-database' documentation."
2637 (interactive "SStyle name: \nXStyle values: ")
2638 (let ((style (or (assoc name ebnf-style-database)
2639 (error "Style name does'nt exist: %s" name)))
2640 (merge (ebnf-check-style-values values))
2642 ;; modify value of existing variables
2643 (setq val (nthcdr 2 style))
2645 (setq check (car merge)
2647 elt (assoc (car check) val))
2649 (setcdr elt (cdr check))
2650 (setq new (cons check new))))
2651 ;; insert new variables
2652 (nconc style (nreverse new))))
2656 (defun ebnf-apply-style (style)
2657 "Set STYLE as the current style.
2659 It returns the old style symbol.
2661 See `ebnf-style-database' documentation."
2662 (interactive "SApply style: ")
2665 (and (ebnf-apply-style1 style)
2666 (setq ebnf-current-style style))))
2670 (defun ebnf-reset-style (&optional style)
2671 "Reset current style.
2673 It returns the old style symbol.
2675 See `ebnf-style-database' documentation."
2676 (interactive "SReset style: ")
2677 (setq ebnf-stack-style nil)
2678 (ebnf-apply-style (or style 'default)))
2682 (defun ebnf-push-style (&optional style)
2683 "Push the current style and set STYLE as the current style.
2685 It returns the old style symbol.
2687 See `ebnf-style-database' documentation."
2688 (interactive "SPush style: ")
2691 (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
2693 (ebnf-apply-style style))))
2697 (defun ebnf-pop-style ()
2698 "Pop a style and set it as the current style.
2700 It returns the old style symbol.
2702 See `ebnf-style-database' documentation."
2705 (ebnf-apply-style (car ebnf-stack-style))
2706 (setq ebnf-stack-style (cdr ebnf-stack-style))))
2709 (defun ebnf-apply-style1 (style)
2710 (let ((value (cdr (assoc style ebnf-style-database))))
2713 (and (car value) (ebnf-apply-style1 (car value)))
2714 (while (setq value (cdr value))
2715 (set (caar value) (eval (cdar value)))))))
2718 (defun ebnf-check-style-values (values)
2721 (and (memq (caar values) ebnf-style-custom-list)
2722 (setq style (cons (car values) style)))
2723 (setq values (cdr values)))
2727 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2728 ;; Internal variables
2731 (defvar ebnf-eps-buffer-name " *EPS*")
2732 (defvar ebnf-parser-func nil)
2733 (defvar ebnf-eps-executing nil)
2734 (defvar ebnf-eps-upper-x 0.0)
2735 (make-variable-buffer-local 'ebnf-eps-upper-x)
2736 (defvar ebnf-eps-upper-y 0.0)
2737 (make-variable-buffer-local 'ebnf-eps-upper-y)
2738 (defvar ebnf-eps-prod-width 0.0)
2739 (make-variable-buffer-local 'ebnf-eps-prod-width)
2740 (defvar ebnf-eps-max-height 0.0)
2741 (make-variable-buffer-local 'ebnf-eps-max-height)
2742 (defvar ebnf-eps-max-width 0.0)
2743 (make-variable-buffer-local 'ebnf-eps-max-width)
2746 (defvar ebnf-eps-context nil
2747 "List of EPS file name during parsing.
2749 See section \"Actions in Comments\" in ebnf2ps documentation.")
2752 (defvar ebnf-eps-production-list nil
2753 "Alist associating production name with EPS file name list.
2755 Each element has the following form:
2757 (PRODUCTION EPS-FILENAME...)
2759 PRODUCTION is the production name.
2760 EPS-FILENAME is the EPS file name.
2762 It's generated during parsing and used during EPS generation.
2764 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2768 (defconst ebnf-arrow-shape-alist
2776 (semi-up-hollow . 7)
2778 (semi-down-hollow . 9)
2779 (semi-down-full . 10)
2781 "Alist associating values for `ebnf-arrow-shape'.
2783 See documentation for `ebnf-arrow-shape'.")
2786 (defconst ebnf-terminal-shape-alist
2790 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2792 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2793 `ebnf-chart-shape'.")
2796 (defvar ebnf-limit nil)
2797 (defvar ebnf-action nil)
2798 (defvar ebnf-action-list nil)
2801 (defvar ebnf-default-p nil)
2804 (defvar ebnf-font-height-P 0)
2805 (defvar ebnf-font-height-T 0)
2806 (defvar ebnf-font-height-NT 0)
2807 (defvar ebnf-font-height-S 0)
2808 (defvar ebnf-font-height-E 0)
2809 (defvar ebnf-font-height-R 0)
2810 (defvar ebnf-font-width-P 0)
2811 (defvar ebnf-font-width-T 0)
2812 (defvar ebnf-font-width-NT 0)
2813 (defvar ebnf-font-width-S 0)
2814 (defvar ebnf-font-width-E 0)
2815 (defvar ebnf-font-width-R 0)
2816 (defvar ebnf-space-T 0)
2817 (defvar ebnf-space-NT 0)
2818 (defvar ebnf-space-S 0)
2819 (defvar ebnf-space-E 0)
2820 (defvar ebnf-space-R 0)
2823 (defvar ebnf-basic-width 0)
2824 (defvar ebnf-basic-height 0)
2825 (defvar ebnf-vertical-space 0)
2826 (defvar ebnf-horizontal-space 0)
2829 (defvar ebnf-settings nil)
2830 (defvar ebnf-fonts-required nil)
2833 (defconst ebnf-debug
2835 % === begin EBNF procedures to help debugging
2837 % Mark visually current point: string debug
2841 gsave -s- show grestore
2853 % Show number value: number string debug-number
2856 20 0 rmoveto show ([) show 60 string cvs show (]) show
2860 % === end EBNF procedures to help debugging
2863 "This is intended to help debugging PostScript programming.")
2866 (defconst ebnf-prologue
2868 % === begin EBNF engine
2870 % --- Basic Definitions
2873 /SpaceS FontHeight 0.5 mul def
2874 /HeightS FontHeight FontHeight add def
2877 /SpaceE FontHeight 0.5 mul def
2878 /HeightE FontHeight FontHeight add def
2881 /SpaceR FontHeight 0.5 mul def
2882 /HeightR FontHeight FontHeight add def
2885 /SpaceT FontHeight 0.5 mul def
2886 /HeightT FontHeight FontHeight add def
2889 /SpaceNT FontHeight 0.5 mul def
2890 /HeightNT FontHeight FontHeight add def
2892 /T HeightT HeightNT add 0.5 mul def
2894 /hT2 hT 0.5 mul ArrowScale mul def
2895 /hT4 hT 0.25 mul ArrowScale mul def
2897 /Er 0.1 def % Error factor
2900 /c{currentpoint}bind def
2901 /xyi{/xi c /yi exch def def}bind def
2902 /xyo{/xo c /yo exch def def}bind def
2903 /xyp{/xp c /yp exch def def}bind def
2904 /xyt{/xt c /yt exch def def}bind def
2906 % vertical movement: x y height vm
2907 /vm{add moveto}bind def
2909 % horizontal movement: x y width hm
2910 /hm{3 -1 roll exch add exch moveto}bind def
2912 % set color: [R G B] SetRGB
2913 /SetRGB{aload pop setrgbcolor}bind def
2915 % filling gray area: gray-scale FillGray
2916 /FillGray{gsave setgray fill grestore}bind def
2918 % filling color area: [R G B] FillRGB
2919 /FillRGB{gsave SetRGB fill grestore}bind def
2921 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2922 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2923 /Gstroke{gsave Stroke grestore}bind def
2925 % Empty Line: width EL
2926 /EL{0 rlineto Gstroke}bind def
2930 /Down{hT2 neg hT4 neg rlineto}bind def
2933 {hT2 neg hT4 rmoveto
2938 /ArrowPath{c newpath moveto Arrow closepath}bind def
2962 {hT2 neg hT4 rlineto} % 1 - semi-up
2963 {Down} % 2 - semi-down
2964 {Arrow} % 3 - simple
2965 {Gstroke ArrowPath} % 4 - transparent
2966 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2967 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2968 {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
2969 {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
2970 {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
2971 {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
2972 {Gstroke gsave UserArrow grestore} % 11 - user
2978 RA-vector ArrowShape get exec
2981 ExtraWidth 0 rmoveto
2984 % rotation DrawArrow
2999 /LA{180 DrawArrow}def
3006 /UA{90 DrawArrow}def
3013 /DA{270 DrawArrow}def
3017 %>corner Right Descendent: height arrow corner_RD
3019 % / height > 0 | 0 - none
3021 % * ---------- | 2 - left
3040 h 0 gt{DA}{UA}ifelse
3045 [{cRD0-vector arrow get exec} % 0 - miter
3046 {0 0 0 h hT h rcurveto} % 1 - rounded
3047 {hT h rlineto} % 2 - bevel
3051 {/arrow exch def /h exch def
3052 cRD-vector ChartShape get exec
3056 %>corner Right Ascendent: height arrow corner_RA
3058 % | height > 0 | 0 - none
3060 % *- ---------- | 2 - left
3078 h 0 gt{DA}{UA}ifelse
3084 [{cRA0-vector arrow get exec} % 0 - miter
3085 {0 0 hT 0 hT h rcurveto} % 1 - rounded
3086 {hT h rlineto} % 2 - bevel
3090 {/arrow exch def /h exch def
3091 cRA-vector ChartShape get exec
3095 %>corner Left Descendent: height arrow corner_LD
3097 % \\ height > 0 | 0 - none
3099 % * ---------- | 2 - left
3108 {hT neg h rmoveto xyi
3116 {hT neg h rmoveto xyi
3118 h 0 gt{DA}{UA}ifelse
3123 [{cLD0-vector arrow get exec} % 0 - miter
3124 {0 0 0 h hT neg h rcurveto} % 1 - rounded
3125 {hT neg h rlineto} % 2 - bevel
3129 {/arrow exch def /h exch def
3130 cLD-vector ChartShape get exec
3134 %>corner Left Ascendent: height arrow corner_LA
3136 % | height > 0 | 0 - none
3138 % -* ---------- | 2 - left
3147 {hT neg h rmoveto xyi
3155 {hT neg h rmoveto xyi
3156 h 0 gt{DA}{UA}ifelse
3162 [{cLA0-vector arrow get exec} % 0 - miter
3163 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
3164 {hT neg h rlineto} % 2 - bevel
3168 {/arrow exch def /h exch def
3169 cLA-vector ChartShape get exec
3175 % height prepare_height |- line_height corner_height corner_height
3179 {T add hT neg}ifelse
3183 %>Left Alternative: height LAlt
3210 %>Left Loop: height LLoop
3229 %>Right Alternative: height RAlt
3243 {T neg exch rlineto}
3256 %>Right Loop: height RLoop
3275 % --- Terminal, Non-terminal and Special Basics
3277 % string width prepare-width |- string
3280 dup stringwidth pop space add space add width exch sub ExtraWidth sub 0.5 mul
3284 % string width begin-right
3294 {xo width add Er add yo moveto
3299 % string width begin-left
3308 {xo width add Er add yo moveto
3321 {/half YY yy sub 0.5 mul abs def
3322 xx half add YY moveto
3323 0 0 half neg 0 half neg half neg rcurveto
3324 0 0 0 half neg half half neg rcurveto
3325 XX xx sub abs half sub half sub 0 rlineto
3326 0 0 half 0 half half rcurveto
3327 0 0 0 half half neg half rcurveto}
3329 {/quarter YY yy sub 0.25 mul abs def
3330 xx quarter add YY moveto
3331 quarter neg quarter neg rlineto
3332 0 quarter quarter add neg rlineto
3333 quarter quarter neg rlineto
3334 XX xx sub abs quarter sub quarter sub 0 rlineto
3335 quarter quarter rlineto
3336 0 quarter quarter add rlineto
3337 quarter neg quarter rlineto}
3342 ShapePath-vector shape get exec
3348 Xshadow Xshadow add Xshadow add
3349 Yshadow Yshadow add Yshadow add translate
3363 % string SBound |- string
3365 {/xx c dup /yy exch def
3366 FontHeight add /YY exch def def
3367 dup stringwidth pop xx add /XX exch def
3369 {/yy yy YShadow add def
3370 /XX XX XShadow add def
3379 /XX XX space add space add def
3380 /YY YY space add def
3381 /yy yy space sub def
3382 shadow{doShapeShadow}if
3384 space Descent abs rmoveto
3391 % TeRminal: string TR
3393 {/Effect EffectT def
3395 /shapecolor BackgroundT def
3396 /borderwidth BorderWidthT def
3397 /bordercolor BorderColorT def
3398 /foreground ForegroundT def
3403 %>Right Terminal: string width RT |- x y
3414 %>Left Terminal: string width LT |- x y
3425 %>Right Terminal Default: string width RTD |- x y
3427 {/-save- BorderWidthT def
3428 /BorderWidthT BorderWidthT DefaultWidth add def
3430 /BorderWidthT -save- def
3433 %>Left Terminal Default: string width LTD |- x y
3435 {/-save- BorderWidthT def
3436 /BorderWidthT BorderWidthT DefaultWidth add def
3438 /BorderWidthT -save- def
3443 % Non-Terminal: string NT
3445 {/Effect EffectNT def
3447 /shapecolor BackgroundNT def
3448 /borderwidth BorderWidthNT def
3449 /bordercolor BorderColorNT def
3450 /foreground ForegroundNT def
3451 /shadow ShadowNT def
3455 %>Right Non-Terminal: string width RNT |- x y
3466 %>Left Non-Terminal: string width LNT |- x y
3477 %>Right Non-Terminal Default: string width RNTD |- x y
3479 {/-save- BorderWidthNT def
3480 /BorderWidthNT BorderWidthNT DefaultWidth add def
3482 /BorderWidthNT -save- def
3485 %>Left Non-Terminal Default: string width LNTD |- x y
3487 {/-save- BorderWidthNT def
3488 /BorderWidthNT BorderWidthNT DefaultWidth add def
3490 /BorderWidthNT -save- def
3495 % SPecial: string SP
3497 {/Effect EffectS def
3499 /shapecolor BackgroundS def
3500 /borderwidth BorderWidthS def
3501 /bordercolor BorderColorS def
3502 /foreground ForegroundS def
3507 %>Right SPecial: string width RSP |- x y
3518 %>Left SPecial: string width LSP |- x y
3529 %>Right SPecial Default: string width RSPD |- x y
3531 {/-save- BorderWidthS def
3532 /BorderWidthS BorderWidthS DefaultWidth add def
3534 /BorderWidthS -save- def
3537 %>Left SPecial Default: string width LSPD |- x y
3539 {/-save- BorderWidthS def
3540 /BorderWidthS BorderWidthS DefaultWidth add def
3542 /BorderWidthS -save- def
3545 % --- Repeat and Except basics
3548 {/w width rwidth sub 0.5 mul def
3553 /xx c entry add /YY exch def def
3554 /yy YY height sub def
3555 /XX xx rwidth add def
3556 shadow{doShapeShadow}if
3579 % entry height width rwidth begin-repeat
3589 /shapecolor BackgroundR def
3590 /borderwidth BorderWidthR def
3591 /bordercolor BorderColorR def
3592 /foreground ForegroundR def
3597 % string end-repeat |- x y
3600 space Descent rmoveto
3604 exch space add exch moveto
3608 %>Right RePeat: string entry height width rwidth RRP |- x y
3609 /RRP{begin-repeat right-direction end-repeat}def
3611 %>Left RePeat: string entry height width rwidth LRP |- x y
3612 /LRP{begin-repeat left-direction end-repeat}def
3616 % entry height width rwidth begin-except
3626 /shapecolor BackgroundE def
3627 /borderwidth BorderWidthE def
3628 /bordercolor BorderColorE def
3629 /foreground ForegroundE def
3634 % x-width end-except |- x y
3637 space space add add Descent rmoveto
3638 (-) foreground SetRGB S
3644 %>Right EXcept: x-width entry height width rwidth REX |- x y
3645 /REX{begin-except right-direction end-except}def
3647 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3648 /LEX{begin-except left-direction end-except}def
3652 %>Beginning Of Sequence: BOS |- x y
3653 /BOS{currentpoint}bind def
3655 %>End Of Sequence: x y x1 y1 EOS |- x y
3656 /EOS{pop pop}bind def
3660 %>Beginning Of Production: string width height BOP |- y x
3663 neg yp add /yw exch def
3664 xp add T sub /xw exch def
3665 dup length 0 gt % empty string ==> no production name
3666 {/Effect EffectP def
3667 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3677 %>End Of Production: y x delta EOP
3678 /EOPH{add exch moveto}bind def % horizontal
3679 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3681 % --- Empty Alternative
3683 %>Empty Alternative: width EA |- x y
3694 %>AlTernative: h1 h2 ... hn n width AT |- x y
3696 {xyo xo add /xw exch def
3708 %>OPtional: height width OP |- x y
3725 %>One or More: height width OM |- x y
3739 %>Zero or More: h2 h1 width ZM |- x y
3749 yo add xo T add exch moveto
3753 % === end EBNF engine
3756 "EBNF PostScript prologue")
3759 (defconst ebnf-eps-prologue
3761 /#ebnf2ps#dict 230 dict def
3764 % Initiliaze variables to avoid name-conflicting with document variables.
3765 % This is the case when using `bind' operator.
3766 /-fillp- 0 def /h 0 def
3767 /-ox- 0 def /half 0 def
3768 /-oy- 0 def /height 0 def
3769 /-save- 0 def /ow 0 def
3770 /Ascent 0 def /quarter 0 def
3771 /Descent 0 def /rXX 0 def
3772 /Effect 0 def /rYY 0 def
3773 /FontHeight 0 def /rwidth 0 def
3774 /LineThickness 0 def /rxx 0 def
3775 /OverlinePosition 0 def /ryy 0 def
3776 /SpaceBackground 0 def /shadow 0 def
3777 /StrikeoutPosition 0 def /shape 0 def
3778 /UnderlinePosition 0 def /shapecolor 0 def
3779 /XBox 0 def /space 0 def
3780 /XX 0 def /st 1 string def
3781 /Xshadow 0 def /w 0 def
3782 /YBox 0 def /width 0 def
3784 /Yshadow 0 def /xo 0 def
3785 /arrow 0 def /xp 0 def
3786 /bg false def /xt 0 def
3787 /bgcolor 0 def /xw 0 def
3788 /bordercolor 0 def /xx 0 def
3789 /borderwidth 0 def /yi 0 def
3791 /entry 0 def /yp 0 def
3792 /foreground 0 def /yt 0 def
3796 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3797 /ISOLatin1Encoding where
3799 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3800 % -- The first half is the same as the standard encoding,
3801 % -- except for minus instead of hyphen at code 055.
3803 StandardEncoding 0 45 getinterval aload pop
3805 StandardEncoding 46 82 getinterval aload pop
3806 %*** NOTE: the following are missing in the Adobe documentation,
3807 %*** but appear in the displayed table:
3808 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3810 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3811 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3812 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3813 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3815 /space /exclamdown /cent /sterling
3816 /currency /yen /brokenbar /section
3817 /dieresis /copyright /ordfeminine /guillemotleft
3818 /logicalnot /hyphen /registered /macron
3819 /degree /plusminus /twosuperior /threesuperior
3820 /acute /mu /paragraph /periodcentered
3821 /cedilla /onesuperior /ordmasculine /guillemotright
3822 /onequarter /onehalf /threequarters /questiondown
3824 /Agrave /Aacute /Acircumflex /Atilde
3825 /Adieresis /Aring /AE /Ccedilla
3826 /Egrave /Eacute /Ecircumflex /Edieresis
3827 /Igrave /Iacute /Icircumflex /Idieresis
3828 /Eth /Ntilde /Ograve /Oacute
3829 /Ocircumflex /Otilde /Odieresis /multiply
3830 /Oslash /Ugrave /Uacute /Ucircumflex
3831 /Udieresis /Yacute /Thorn /germandbls
3833 /agrave /aacute /acircumflex /atilde
3834 /adieresis /aring /ae /ccedilla
3835 /egrave /eacute /ecircumflex /edieresis
3836 /igrave /iacute /icircumflex /idieresis
3837 /eth /ntilde /ograve /oacute
3838 /ocircumflex /otilde /odieresis /divide
3839 /oslash /ugrave /uacute /ucircumflex
3840 /udieresis /yacute /thorn /ydieresis
3844 /reencodeFontISO %def
3846 length 12 add dict % Make a new font (a new dict the same size
3847 % as the old one) with room for our new symbols.
3849 begin % Make the new font the current dictionary.
3851 {def}{pop pop}ifelse
3852 }forall % Copy each of the symbols from the old dictionary
3853 % to the new one except for the font ID.
3855 currentdict /FontType get 0 ne
3856 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3857 % the ISOLatin1 encoding.
3859 % Use the font's bounding box to determine the ascent, descent,
3860 % and overall height; don't forget that these values have to be
3861 % transformed using the font's matrix.
3868 % | | | | Ascent (usually > 0)
3870 % (0 0) -> +--+----+-------->
3872 % | | v Descent (usually < 0)
3873 % (x1 y1) --> +----+ - -
3875 currentdict /FontType get 0 ne
3876 {/FontBBox load aload pop % -- x1 y1 x2 y2
3877 FontMatrix transform /Ascent exch def pop
3878 FontMatrix transform /Descent exch def pop}
3879 {/PrimaryFont FDepVector 0 get def
3880 PrimaryFont /FontBBox get aload pop
3881 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3882 PrimaryFont /FontMatrix get transform /Descent exch def pop
3885 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3887 % Define these in case they're not in the FontInfo
3888 % (also, here they're easier to get to).
3889 /UnderlinePosition Descent 0.70 mul def
3890 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3891 /StrikeoutPosition Ascent 0.30 mul def
3892 /LineThickness FontHeight 0.05 mul def
3893 /Xshadow FontHeight 0.08 mul def
3894 /Yshadow FontHeight -0.09 mul def
3895 /SpaceBackground Descent neg UnderlinePosition add def
3896 /XBox Descent neg def
3897 /YBox LineThickness 0.7 mul def
3899 currentdict % Leave the new font on the stack
3900 end % Stop using the font as the current dictionary
3901 definefont % Put the font into the font dictionary
3902 pop % Discard the returned font
3906 /DefFont{findfont exch scalefont reencodeFontISO}def
3911 dup /Ascent get /Ascent exch def
3912 dup /Descent get /Descent exch def
3913 dup /FontHeight get /FontHeight exch def
3914 dup /UnderlinePosition get /UnderlinePosition exch def
3915 dup /OverlinePosition get /OverlinePosition exch def
3916 dup /StrikeoutPosition get /StrikeoutPosition exch def
3917 dup /LineThickness get /LineThickness exch def
3918 dup /Xshadow get /Xshadow exch def
3919 dup /Yshadow get /Yshadow exch def
3920 dup /SpaceBackground get /SpaceBackground exch def
3921 dup /XBox get /XBox exch def
3922 dup /YBox get /YBox exch def
3935 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3937 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3950 % top of stack: fill-or-not
3952 {LineThickness setlinewidth stroke}
3957 % stack: string fill-or-not |- --
3960 /-ox- currentpoint /-oy- exch def def
3962 LineThickness setlinewidth
3964 st dup true charpath
3965 -fillp- {gsave FillBgColor grestore}if
3967 -oy- add /-oy- exch def
3968 -ox- add /-ox- exch def
3975 % stack: fill-or-not delta |- --
3978 xx XBox sub dd sub yy YBox sub dd sub
3979 XX XBox add dd add YY YBox add dd add
3983 % stack: string |- --
3986 Xshadow Yshadow rmoveto
3991 % stack: position |- --
3993 {currentpoint exch pop add dup
3999 LineThickness setlinewidth stroke
4003 % stack: string |- --
4004 % effect: 1 - underline 2 - strikeout 4 - overline
4005 % 8 - shadow 16 - box 32 - outline
4007 {/xx currentpoint dup Descent add /yy exch def
4008 Ascent add /YY exch def def
4009 dup stringwidth pop xx add /XX exch def
4011 {/yy yy Yshadow add def
4012 /XX XX Xshadow add def
4017 {SpaceBackground doBox}
4018 {xx yy XX YY doRect}
4021 Effect 16 and 0 ne{false 0 doBox}if % box
4022 Effect 8 and 0 ne{dup doShadow}if % shadow
4024 {true doOutline} % outline
4025 {show} % normal text
4027 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
4028 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
4029 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
4033 "EBNF EPS prologue")
4036 (defconst ebnf-eps-begin
4040 % x y #ebnf2ps#begin
4042 {#ebnf2ps#dict begin /#ebnf2ps#save save def
4043 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
4045 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
4052 (defconst ebnf-eps-end
4059 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4063 (defvar ebnf-format-float "%1.3f")
4066 (defun ebnf-format-float (&rest floats)
4069 (format ebnf-format-float float))
4074 (defun ebnf-format-color (format-str color default)
4075 (let* ((the-color (or color default))
4076 (rgb (ps-color-scale the-color)))
4079 (ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
4084 (defvar ebnf-message-float "%3.2f")
4087 (defsubst ebnf-message-float (format-str value)
4089 (format ebnf-message-float value)))
4092 (defvar ebnf-total 0)
4093 (defvar ebnf-nprod 0)
4096 (defsubst ebnf-message-info (messag)
4097 (message "%s...%3d%%"
4099 (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
4102 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4106 (defmacro ebnf-node-kind (vec &optional value)
4108 `(aset ,vec 0 ,value)
4112 (defmacro ebnf-node-width-func (node width)
4113 `(funcall (aref ,node 1) ,node ,width))
4116 (defmacro ebnf-node-dimension-func (node &optional value)
4118 `(aset ,node 2 ,value)
4119 `(funcall (aref ,node 2) ,node)))
4122 (defmacro ebnf-node-entry (vec &optional value)
4124 `(aset ,vec 3 ,value)
4128 (defmacro ebnf-node-height (vec &optional value)
4130 `(aset ,vec 4 ,value)
4134 (defmacro ebnf-node-width (vec &optional value)
4136 `(aset ,vec 5 ,value)
4140 (defmacro ebnf-node-name (vec)
4144 (defmacro ebnf-node-list (vec &optional value)
4146 `(aset ,vec 6 ,value)
4150 (defmacro ebnf-node-default (vec)
4154 (defmacro ebnf-node-production (vec &optional value)
4156 `(aset ,vec 7 ,value)
4160 (defmacro ebnf-node-separator (vec &optional value)
4162 `(aset ,vec 7 ,value)
4166 (defmacro ebnf-node-action (vec &optional value)
4168 `(aset ,vec 8 ,value)
4172 (defmacro ebnf-node-generation (node)
4173 `(funcall (ebnf-node-kind ,node) ,node))
4176 (defmacro ebnf-max-width (prod)
4177 `(max (ebnf-node-width ,prod)
4178 (+ (* (length (ebnf-node-name ,prod))
4180 ebnf-production-horizontal-space)))
4183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4184 ;; PostScript generation
4187 (defun ebnf-generate-eps (ebnf-tree)
4188 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
4189 (ps-print-color-scale (if ps-color-p
4190 (float (car (ps-color-values "white")))
4192 (ebnf-total (length ebnf-tree))
4194 (old-ps-output (symbol-function 'ps-output))
4195 (old-ps-output-string (symbol-function 'ps-output-string))
4196 (eps-buffer (get-buffer-create ebnf-eps-buffer-name))
4197 ebnf-debug-ps error-msg horizontal
4198 prod prod-name prod-width prod-height prod-list file-list)
4199 ;; redefines `ps-output' and `ps-output-string'
4200 (defalias 'ps-output 'ebnf-eps-output)
4201 (defalias 'ps-output-string 'ps-output-string-prim)
4202 ;; generate EPS file
4204 (condition-case data
4207 (setq prod (car ebnf-tree)
4208 prod-name (ebnf-node-name prod)
4209 prod-width (ebnf-max-width prod)
4210 prod-height (ebnf-node-height prod)
4211 horizontal (memq (ebnf-node-action prod)
4213 ;; generate production in EPS buffer
4215 (set-buffer eps-buffer)
4216 (setq ebnf-eps-upper-x 0.0
4217 ebnf-eps-upper-y 0.0
4218 ebnf-eps-max-width prod-width
4219 ebnf-eps-max-height prod-height)
4220 (ebnf-generate-production prod))
4221 (if (setq prod-list (cdr (assoc prod-name
4222 ebnf-eps-production-list)))
4223 ;; insert EPS buffer in all buffer associated with production
4224 (ebnf-eps-production-list prod-list 'file-list horizontal
4225 prod-width prod-height eps-buffer)
4226 ;; write EPS file for production
4227 (ebnf-eps-finish-and-write eps-buffer
4228 (ebnf-eps-filename prod-name)))
4229 ;; prepare for next loop
4231 (set-buffer eps-buffer)
4233 (setq ebnf-tree (cdr ebnf-tree)))
4234 ;; write and kill temporary buffers
4235 (ebnf-eps-write-kill-temp file-list t)
4236 (setq file-list nil))
4239 (setq error-msg (error-message-string data)))))
4240 ;; restore `ps-output' and `ps-output-string'
4241 (defalias 'ps-output old-ps-output)
4242 (defalias 'ps-output-string old-ps-output-string)
4243 ;; kill temporary buffers
4244 (kill-buffer eps-buffer)
4245 (ebnf-eps-write-kill-temp file-list nil)
4246 (and error-msg (error error-msg))
4250 ;; write and kill temporary buffers
4251 (defun ebnf-eps-write-kill-temp (file-list write-p)
4253 (let ((buffer (get-buffer (concat " *" (car file-list) "*"))))
4256 (ebnf-eps-finish-and-write buffer (car file-list)))
4257 (kill-buffer buffer)))
4258 (setq file-list (cdr file-list))))
4261 ;; insert EPS buffer in all buffer associated with production
4262 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
4263 prod-width prod-height eps-buffer)
4265 (add-to-list file-list-sym (car prod-list))
4267 (set-buffer (get-buffer-create (concat " *" (car prod-list) "*")))
4268 (goto-char (point-max))
4271 ((zerop (buffer-size))
4272 (setq ebnf-eps-upper-x 0.0
4273 ebnf-eps-upper-y 0.0
4274 ebnf-eps-max-width prod-width
4275 ebnf-eps-max-height prod-height))
4278 (ebnf-eop-horizontal ebnf-eps-prod-width)
4279 (setq ebnf-eps-max-width (+ ebnf-eps-max-width
4280 ebnf-production-horizontal-space
4282 ebnf-eps-max-height (max ebnf-eps-max-height prod-height)))
4285 (ebnf-eop-vertical ebnf-eps-max-height)
4286 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
4287 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
4290 ebnf-production-vertical-space
4291 ebnf-eps-max-height))
4292 ebnf-eps-max-width prod-width
4293 ebnf-eps-max-height prod-height))
4295 (setq ebnf-eps-prod-width prod-width)
4296 (insert-buffer-substring eps-buffer))
4297 (setq prod-list (cdr prod-list))))
4300 (defun ebnf-generate (ebnf-tree)
4301 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
4302 (ps-print-color-scale (if ps-color-p
4303 (float (car (ps-color-values "white")))
4305 ps-zebra-stripes ps-line-number ps-razzle-dazzle
4307 ps-print-begin-sheet-hook
4308 ps-print-begin-page-hook
4309 ps-print-begin-column-hook)
4310 (ps-generate (current-buffer) (point-min) (point-max)
4311 'ebnf-generate-postscript)))
4314 (defvar ebnf-tree nil)
4315 (defvar ebnf-direction "R")
4318 (defun ebnf-generate-postscript (from to)
4320 (if ebnf-horizontal-max-height
4321 (ebnf-generate-with-max-height)
4322 (ebnf-generate-without-max-height))
4326 (defun ebnf-generate-with-max-height ()
4327 (let ((ebnf-total (length ebnf-tree))
4329 next-line max-height prod the-width)
4331 ;; find next line point
4332 (setq next-line ebnf-tree
4333 prod (car ebnf-tree)
4334 max-height (ebnf-node-height prod))
4335 (ebnf-begin-line prod (ebnf-max-width prod))
4336 (while (and (setq next-line (cdr next-line))
4337 (setq prod (car next-line))
4338 (memq (ebnf-node-action prod) ebnf-action-list)
4339 (setq the-width (ebnf-max-width prod))
4340 (<= the-width ps-width-remaining))
4341 (setq max-height (max max-height (ebnf-node-height prod))
4342 ps-width-remaining (- ps-width-remaining
4344 ebnf-production-horizontal-space))))
4345 ;; generate current line
4346 (ebnf-newline max-height)
4347 (setq prod (car ebnf-tree))
4348 (ebnf-generate-production prod)
4349 (while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line))
4350 (ebnf-eop-horizontal (ebnf-max-width prod))
4351 (setq prod (car ebnf-tree))
4352 (ebnf-generate-production prod))
4353 (ebnf-eop-vertical max-height))))
4356 (defun ebnf-generate-without-max-height ()
4357 (let ((ebnf-total (length ebnf-tree))
4359 max-height prod bef-width cur-width)
4361 ;; generate current line
4362 (setq prod (car ebnf-tree)
4363 max-height (ebnf-node-height prod)
4364 bef-width (ebnf-max-width prod))
4365 (ebnf-begin-line prod bef-width)
4366 (ebnf-generate-production prod)
4367 (while (and (setq ebnf-tree (cdr ebnf-tree))
4368 (setq prod (car ebnf-tree))
4369 (memq (ebnf-node-action prod) ebnf-action-list)
4370 (setq cur-width (ebnf-max-width prod))
4371 (<= cur-width ps-width-remaining)
4372 (<= (ebnf-node-height prod) ps-height-remaining))
4373 (ebnf-eop-horizontal bef-width)
4374 (ebnf-generate-production prod)
4375 (setq bef-width cur-width
4376 max-height (max max-height (ebnf-node-height prod))
4377 ps-width-remaining (- ps-width-remaining
4379 ebnf-production-horizontal-space))))
4380 (ebnf-eop-vertical max-height)
4381 ;; prepare next line
4382 (ebnf-newline max-height))))
4385 (defun ebnf-begin-line (prod width)
4386 (and (or (eq (ebnf-node-action prod) 'form-feed)
4387 (> (ebnf-node-height prod) ps-height-remaining))
4389 (setq ps-width-remaining (- ps-width-remaining
4391 ebnf-production-horizontal-space))))
4394 (defun ebnf-newline (height)
4395 (and (> height ps-height-remaining)
4397 (setq ps-width-remaining ps-print-width
4398 ps-height-remaining (- ps-height-remaining
4400 ebnf-production-vertical-space))))
4403 ;; [production width-fun dim-fun entry height width name production action]
4404 (defun ebnf-generate-production (production)
4405 (ebnf-message-info "Generating")
4406 (run-hooks 'ebnf-production-hook)
4407 (ps-output-string (if ebnf-production-name-p
4408 (ebnf-node-name production)
4412 (ebnf-node-width production)
4413 (+ (if ebnf-production-name-p
4416 (ebnf-node-entry (ebnf-node-production production))))
4418 (ebnf-node-generation (ebnf-node-production production))
4419 (ps-output "EOS\n"))
4422 ;; [alternative width-fun dim-fun entry height width list]
4423 (defun ebnf-generate-alternative (alternative)
4424 (let ((alt (ebnf-node-list alternative))
4425 (entry (ebnf-node-entry alternative))
4427 alt-height alt-entry)
4429 (ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt))))
4431 (setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space)
4434 (ps-output (format "%d " nlist)
4435 (ebnf-format-float (ebnf-node-width alternative))
4437 (setq alt (ebnf-node-list alternative))
4439 (ebnf-node-generation (car alt))
4440 (setq alt-height (- (ebnf-node-height (car alt))
4441 (ebnf-node-entry (car alt)))))
4442 (while (setq alt (cdr alt))
4443 (setq alt-entry (ebnf-node-entry (car alt)))
4444 (ebnf-vertical-movement
4445 (- (+ alt-height ebnf-vertical-space alt-entry)))
4446 (ebnf-node-generation (car alt))
4447 (setq alt-height (- (ebnf-node-height (car alt)) alt-entry))))
4448 (ps-output "EOS\n"))
4451 ;; [sequence width-fun dim-fun entry height width list]
4452 (defun ebnf-generate-sequence (sequence)
4454 (let ((seq (ebnf-node-list sequence))
4457 (ebnf-node-generation (car seq))
4458 (setq seq-width (ebnf-node-width (car seq))))
4459 (while (setq seq (cdr seq))
4460 (ebnf-horizontal-movement seq-width)
4461 (ebnf-node-generation (car seq))
4462 (setq seq-width (ebnf-node-width (car seq)))))
4463 (ps-output "EOS\n"))
4466 ;; [terminal width-fun dim-fun entry height width name]
4467 (defun ebnf-generate-terminal (terminal)
4468 (ebnf-gen-terminal terminal "T"))
4471 ;; [non-terminal width-fun dim-fun entry height width name]
4472 (defun ebnf-generate-non-terminal (non-terminal)
4473 (ebnf-gen-terminal non-terminal "NT"))
4476 ;; [empty width-fun dim-fun entry height width]
4477 (defun ebnf-generate-empty (empty)
4478 (ebnf-empty-alternative (ebnf-node-width empty)))
4481 ;; [optional width-fun dim-fun entry height width element]
4482 (defun ebnf-generate-optional (optional)
4483 (let ((the-optional (ebnf-node-list optional)))
4484 (ps-output (ebnf-format-float
4485 (+ (- (ebnf-node-height the-optional)
4486 (ebnf-node-entry optional))
4487 ebnf-vertical-space)
4488 (ebnf-node-width optional))
4490 (ebnf-node-generation the-optional)
4491 (ps-output "EOS\n")))
4494 ;; [one-or-more width-fun dim-fun entry height width element separator]
4495 (defun ebnf-generate-one-or-more (one-or-more)
4496 (let* ((width (ebnf-node-width one-or-more))
4497 (sep (ebnf-node-separator one-or-more))
4498 (entry (- (ebnf-node-entry one-or-more)
4500 (ebnf-node-entry sep)
4502 (ps-output (ebnf-format-float entry width)
4504 (ebnf-node-generation (ebnf-node-list one-or-more))
4505 (ebnf-vertical-movement entry)
4507 (let ((ebnf-direction "L"))
4508 (ebnf-node-generation sep))
4509 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4510 (ps-output "EOS\n"))
4513 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4514 (defun ebnf-generate-zero-or-more (zero-or-more)
4515 (let* ((width (ebnf-node-width zero-or-more))
4516 (node-list (ebnf-node-list zero-or-more))
4517 (list-entry (ebnf-node-entry node-list))
4518 (node-sep (ebnf-node-separator zero-or-more))
4519 (entry (+ list-entry
4522 (- (ebnf-node-height node-sep)
4523 (ebnf-node-entry node-sep))
4525 (ps-output (ebnf-format-float entry
4526 (+ (- (ebnf-node-height node-list)
4528 ebnf-vertical-space)
4531 (ebnf-node-generation (ebnf-node-list zero-or-more))
4532 (ebnf-vertical-movement entry)
4533 (if (ebnf-node-separator zero-or-more)
4534 (let ((ebnf-direction "L"))
4535 (ebnf-node-generation (ebnf-node-separator zero-or-more)))
4536 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4537 (ps-output "EOS\n"))
4540 ;; [special width-fun dim-fun entry height width name]
4541 (defun ebnf-generate-special (special)
4542 (ebnf-gen-terminal special "SP"))
4545 ;; [repeat width-fun dim-fun entry height width times element]
4546 (defun ebnf-generate-repeat (repeat)
4547 (let ((times (ebnf-node-name repeat))
4548 (element (ebnf-node-separator repeat)))
4549 (ps-output-string times)
4552 (ebnf-node-entry repeat)
4553 (ebnf-node-height repeat)
4554 (ebnf-node-width repeat)
4556 (+ (ebnf-node-width element)
4557 ebnf-space-R ebnf-space-R ebnf-space-R
4558 (* (length times) ebnf-font-width-R))
4560 " " ebnf-direction "RP\n")
4562 (ebnf-node-generation element)))
4563 (ps-output "EOS\n"))
4566 ;; [except width-fun dim-fun entry height width element element]
4567 (defun ebnf-generate-except (except)
4568 (let* ((element (ebnf-node-list except))
4569 (exception (ebnf-node-separator except))
4570 (width (ebnf-node-width element)))
4571 (ps-output (ebnf-format-float
4573 (ebnf-node-entry except)
4574 (ebnf-node-height except)
4575 (ebnf-node-width except)
4577 ebnf-space-E ebnf-space-E ebnf-space-E
4580 (+ (ebnf-node-width exception) ebnf-space-E)
4582 " " ebnf-direction "EX\n")
4583 (ebnf-node-generation (ebnf-node-list except))
4585 (ebnf-horizontal-movement (+ width ebnf-space-E
4586 ebnf-font-width-E ebnf-space-E))
4587 (ebnf-node-generation exception)))
4588 (ps-output "EOS\n"))
4591 (defun ebnf-gen-terminal (node code)
4592 (ps-output-string (ebnf-node-name node))
4593 (ps-output " " (ebnf-format-float (ebnf-node-width node))
4594 " " ebnf-direction code
4595 (if (ebnf-node-default node)
4600 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4601 ;; Internal functions
4604 (defun ebnf-directory (fun &optional directory)
4605 "Process files in DIRECTORY applying function FUN on each file.
4607 If DIRECTORY is nil, it's used `default-directory'.
4609 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
4611 (let ((files (directory-files (or directory default-directory)
4612 t ebnf-file-suffix-regexp)))
4614 (set-buffer (find-file-noselect (car files)))
4616 (setq buffer-backed-up t) ; Do not back it up.
4617 (save-buffer) ; Just save new version.
4618 (kill-buffer (current-buffer))
4619 (setq files (cdr files)))))
4622 (defun ebnf-file (fun file &optional do-not-kill-buffer-when-done)
4623 "Process file FILE applying function FUN.
4625 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
4626 killed after process termination."
4627 (set-buffer (find-file-noselect file))
4629 (or do-not-kill-buffer-when-done
4630 (kill-buffer (current-buffer))))
4633 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4634 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4635 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4636 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4637 (defun ebnf-range-regexp (prefix from to)
4640 (setq str (concat str (char-to-string from))
4642 (concat prefix str)))
4645 (defvar ebnf-map-name
4646 (let ((map (make-vector 256 ?\_)))
4647 (mapcar #'(lambda (char)
4648 (aset map char char))
4649 (concat "#$%&+-.0123456789=?@~"
4650 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4651 "abcdefghijklmnopqrstuvwxyz"))
4655 (defun ebnf-eps-filename (str)
4656 (let* ((len (length str))
4658 (new (make-string len ?\s)))
4660 (aset new stri (aref ebnf-map-name (aref str stri)))
4661 (setq stri (1+ stri)))
4662 (concat ebnf-eps-prefix new ".eps")))
4665 (defun ebnf-eps-output (&rest args)
4668 (setq args (cdr args))))
4671 (defun ebnf-generate-region (from to gen-func)
4672 (run-hooks 'ebnf-hook)
4673 (let ((ebnf-limit (max from to))
4674 (error-msg "SYNTAX")
4679 (condition-case data
4680 (let ((tree (ebnf-parse-and-sort (min from to))))
4682 (setq error-msg "EMPTY RULES"
4683 tree (ebnf-eliminate-empty-rules tree))
4684 (setq error-msg "OPTMIZE"
4685 tree (ebnf-optimize tree))
4686 (setq error-msg "DIMENSIONS"
4687 tree (ebnf-dimensions tree))
4688 (setq error-msg "GENERATION")
4689 (funcall gen-func tree))
4690 (setq error-msg nil)) ; here it's ok
4694 (setq the-point (max (1- (point)) (point-min))
4695 error-msg (concat error-msg ": "
4696 (error-message-string data)
4698 (and (string= error-msg "SYNTAX")
4699 (format "at position %d "
4701 (format "in buffer \"%s\"."
4702 (buffer-name)))))))))
4706 (goto-char the-point)
4707 (if ebnf-stop-on-error
4709 (message "%s" error-msg)))
4710 ;; generated output OK
4713 ;; syntax checked OK
4715 (message "EBNF syntactic analysis: NO ERRORS.")))))
4718 (defun ebnf-parse-and-sort (start)
4720 (let ((tree (funcall ebnf-parser-func start)))
4721 (if ebnf-sort-production
4723 (message "Sorting...")
4725 (if (eq ebnf-sort-production 'ascending)
4726 'ebnf-sorter-ascending
4727 'ebnf-sorter-descending)))
4731 (defun ebnf-sorter-ascending (first second)
4732 (string< (ebnf-node-name first)
4733 (ebnf-node-name second)))
4736 (defun ebnf-sorter-descending (first second)
4737 (string< (ebnf-node-name second)
4738 (ebnf-node-name first)))
4741 (defun ebnf-empty-alternative (width)
4742 (ps-output (ebnf-format-float width) " EA\n"))
4745 (defun ebnf-vertical-movement (height)
4746 (ps-output (ebnf-format-float height) " vm\n"))
4749 (defun ebnf-horizontal-movement (width)
4750 (ps-output (ebnf-format-float width) " hm\n"))
4753 (defun ebnf-entry (height)
4754 (* height ebnf-entry-percentage))
4757 (defun ebnf-eop-vertical (height)
4758 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space))
4762 (defun ebnf-eop-horizontal (width)
4763 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space))
4767 (defun ebnf-new-page ()
4768 (when (< ps-height-remaining ps-print-height)
4769 (run-hooks 'ebnf-page-hook)
4774 (defsubst ebnf-font-size (font) (nth 0 font))
4775 (defsubst ebnf-font-name (font) (nth 1 font))
4776 (defsubst ebnf-font-foreground (font) (nth 2 font))
4777 (defsubst ebnf-font-background (font) (nth 3 font))
4778 (defsubst ebnf-font-list (font) (nthcdr 4 font))
4779 (defsubst ebnf-font-attributes (font)
4780 (lsh (ps-extension-bit (cdr font)) -2))
4783 (defconst ebnf-font-name-select
4784 (vector 'normal 'bold 'italic 'bold-italic))
4787 (defun ebnf-font-name-select (font)
4788 (let* ((font-list (ebnf-font-list font))
4789 (font-index (+ (if (memq 'bold font-list) 1 0)
4790 (if (memq 'italic font-list) 2 0)))
4791 (name (ebnf-font-name font))
4792 (database (cdr (assoc name ps-font-info-database)))
4793 (info-list (or (cdr (assoc 'fonts database))
4794 (error "Invalid font: %s" name))))
4795 (or (cdr (assoc (aref ebnf-font-name-select font-index)
4797 (error "Invalid attributes for font %s" name))))
4800 (defun ebnf-font-select (font select)
4801 (let* ((name (ebnf-font-name font))
4802 (database (cdr (assoc name ps-font-info-database)))
4803 (size (cdr (assoc 'size database)))
4804 (base (cdr (assoc select database))))
4806 (/ (* (ebnf-font-size font) base)
4808 (error "Invalid font: %s" name))))
4811 (defsubst ebnf-font-width (font)
4812 (ebnf-font-select font 'avg-char-width))
4813 (defsubst ebnf-font-height (font)
4814 (ebnf-font-select font 'line-height))
4817 (defconst ebnf-syntax-alist
4818 ;; 0.syntax 1.parser 2.initializer
4819 '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize)
4820 (yacc ebnf-yac-parser ebnf-yac-initialize)
4821 (abnf ebnf-abn-parser ebnf-abn-initialize)
4822 (ebnf ebnf-bnf-parser ebnf-bnf-initialize)
4823 (ebnfx ebnf-ebx-parser ebnf-ebx-initialize)
4824 (dtd ebnf-dtd-parser ebnf-dtd-initialize))
4825 "Alist associating ebnf syntax with a parser and a initializer.")
4828 (defun ebnf-begin-job ()
4829 (ps-printing-region nil nil nil)
4830 (if ebnf-use-float-format
4831 (setq ebnf-format-float "%1.3f"
4832 ebnf-message-float "%3.2f")
4833 (setq ebnf-format-float "%s"
4834 ebnf-message-float "%s"))
4835 (ebnf-otz-initialize)
4836 ;; to avoid compilation gripes when calling autoloaded functions
4837 (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist)
4838 (assoc 'ebnf ebnf-syntax-alist))))
4839 (setq ebnf-parser-func (nth 1 init))
4840 (funcall (nth 2 init)))
4841 (and ebnf-terminal-regexp ; ensures that it's a string or nil
4842 (not (stringp ebnf-terminal-regexp))
4843 (setq ebnf-terminal-regexp nil))
4844 (or (and ebnf-eps-prefix ; ensures that it's a string
4845 (stringp ebnf-eps-prefix))
4846 (setq ebnf-eps-prefix "ebnf--"))
4847 (setq ebnf-entry-percentage ; ensures value between 0.0 and 1.0
4848 (min (max ebnf-entry-percentage 0.0) 1.0)
4849 ebnf-action-list (if ebnf-horizontal-orientation
4853 ebnf-fonts-required nil
4856 ebnf-eps-context nil
4857 ebnf-eps-production-list nil
4858 ebnf-eps-upper-x 0.0
4859 ebnf-eps-upper-y 0.0
4860 ebnf-font-height-P (ebnf-font-height ebnf-production-font)
4861 ebnf-font-height-T (ebnf-font-height ebnf-terminal-font)
4862 ebnf-font-height-NT (ebnf-font-height ebnf-non-terminal-font)
4863 ebnf-font-height-S (ebnf-font-height ebnf-special-font)
4864 ebnf-font-height-E (ebnf-font-height ebnf-except-font)
4865 ebnf-font-height-R (ebnf-font-height ebnf-repeat-font)
4866 ebnf-font-width-P (ebnf-font-width ebnf-production-font)
4867 ebnf-font-width-T (ebnf-font-width ebnf-terminal-font)
4868 ebnf-font-width-NT (ebnf-font-width ebnf-non-terminal-font)
4869 ebnf-font-width-S (ebnf-font-width ebnf-special-font)
4870 ebnf-font-width-E (ebnf-font-width ebnf-except-font)
4871 ebnf-font-width-R (ebnf-font-width ebnf-repeat-font)
4872 ebnf-space-T (* ebnf-font-height-T 0.5)
4873 ebnf-space-NT (* ebnf-font-height-NT 0.5)
4874 ebnf-space-S (* ebnf-font-height-S 0.5)
4875 ebnf-space-E (* ebnf-font-height-E 0.5)
4876 ebnf-space-R (* ebnf-font-height-R 0.5))
4877 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT)))
4878 (setq ebnf-basic-width (* basic 0.5)
4879 ebnf-horizontal-space (+ basic basic)
4880 ebnf-basic-height ebnf-basic-width
4881 ebnf-vertical-space ebnf-basic-width)
4882 ;; ensures value is greater than zero
4883 (or (and (numberp ebnf-production-horizontal-space)
4884 (> ebnf-production-horizontal-space 0.0))
4885 (setq ebnf-production-horizontal-space basic))
4886 ;; ensures value is greater than zero
4887 (or (and (numberp ebnf-production-vertical-space)
4888 (> ebnf-production-vertical-space 0.0))
4889 (setq ebnf-production-vertical-space basic))))
4892 (defsubst ebnf-shape-value (sym alist)
4893 (or (cdr (assq sym alist)) 0))
4896 (defsubst ebnf-boolean (value)
4897 (if value "true" "false"))
4900 (defun ebnf-begin-file ()
4903 (set-buffer ps-spool-buffer)
4904 (goto-char (point-min))
4905 (and (search-forward "%%Creator: " nil t)
4906 (not (search-forward "& ebnf2ps v"
4907 (save-excursion (end-of-line) (point))
4910 ;; adjust creator comment
4912 (insert " & ebnf2ps v" ebnf-version)
4913 ;; insert ebnf settings & engine
4914 (goto-char (point-max))
4915 (search-backward "\n%%EndProlog\n")
4916 (ebnf-insert-ebnf-prologue)
4917 (ps-output "\n")))))
4920 (defun ebnf-eps-finish-and-write (buffer filename)
4921 (when (buffer-modified-p buffer)
4924 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
4925 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
4928 ebnf-production-vertical-space
4929 ebnf-eps-max-height)))
4931 (goto-char (point-min))
4933 "%!PS-Adobe-3.0 EPSF-3.0"
4934 "\n%%BoundingBox: 0 0 "
4935 (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
4936 "\n%%Title: " filename
4937 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4938 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
4939 "\n%%DocumentNeededResources: font "
4940 (or ebnf-fonts-required
4941 (setq ebnf-fonts-required
4942 (mapconcat 'identity
4943 (ps-remove-duplicates
4944 (mapcar 'ebnf-font-name-select
4945 (list ebnf-production-font
4947 ebnf-non-terminal-font
4952 "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
4954 (ebnf-insert-ebnf-prologue)
4955 (insert ebnf-eps-begin
4956 "\n0 " (ebnf-format-float
4957 (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7)))
4958 " #ebnf2ps#begin\n")
4960 (goto-char (point-max))
4961 (insert ebnf-eps-end)
4963 (message "Saving...")
4964 (setq filename (expand-file-name filename))
4965 (let ((coding-system-for-write 'raw-text-unix))
4966 (write-region (point-min) (point-max) filename))
4967 (message "Wrote %s" filename))))
4970 (defun ebnf-insert-ebnf-prologue ()
4975 "\n\n% === begin EBNF settings\n\n"
4977 (format "/fP %s /%s DefFont\n"
4978 (ebnf-format-float (ebnf-font-size ebnf-production-font))
4979 (ebnf-font-name-select ebnf-production-font))
4980 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4981 (ebnf-font-foreground ebnf-production-font)
4983 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4984 (ebnf-font-background ebnf-production-font)
4986 (format "/EffectP %d def\n"
4987 (ebnf-font-attributes ebnf-production-font))
4989 (format "/fT %s /%s DefFont\n"
4990 (ebnf-format-float (ebnf-font-size ebnf-terminal-font))
4991 (ebnf-font-name-select ebnf-terminal-font))
4992 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4993 (ebnf-font-foreground ebnf-terminal-font)
4995 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4996 (ebnf-font-background ebnf-terminal-font)
4998 (format "/EffectT %d def\n"
4999 (ebnf-font-attributes ebnf-terminal-font))
5000 (format "/BorderWidthT %s def\n"
5001 (ebnf-format-float ebnf-terminal-border-width))
5002 (ebnf-format-color "/BorderColorT %s def %% %s\n"
5003 ebnf-terminal-border-color
5005 (format "/ShapeT %d def\n"
5006 (ebnf-shape-value ebnf-terminal-shape
5007 ebnf-terminal-shape-alist))
5008 (format "/ShadowT %s def\n"
5009 (ebnf-boolean ebnf-terminal-shadow))
5011 (format "/fNT %s /%s DefFont\n"
5013 (ebnf-font-size ebnf-non-terminal-font))
5014 (ebnf-font-name-select ebnf-non-terminal-font))
5015 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
5016 (ebnf-font-foreground ebnf-non-terminal-font)
5018 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
5019 (ebnf-font-background ebnf-non-terminal-font)
5021 (format "/EffectNT %d def\n"
5022 (ebnf-font-attributes ebnf-non-terminal-font))
5023 (format "/BorderWidthNT %s def\n"
5024 (ebnf-format-float ebnf-non-terminal-border-width))
5025 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
5026 ebnf-non-terminal-border-color
5028 (format "/ShapeNT %d def\n"
5029 (ebnf-shape-value ebnf-non-terminal-shape
5030 ebnf-terminal-shape-alist))
5031 (format "/ShadowNT %s def\n"
5032 (ebnf-boolean ebnf-non-terminal-shadow))
5034 (format "/fS %s /%s DefFont\n"
5035 (ebnf-format-float (ebnf-font-size ebnf-special-font))
5036 (ebnf-font-name-select ebnf-special-font))
5037 (ebnf-format-color "/ForegroundS %s def %% %s\n"
5038 (ebnf-font-foreground ebnf-special-font)
5040 (ebnf-format-color "/BackgroundS %s def %% %s\n"
5041 (ebnf-font-background ebnf-special-font)
5043 (format "/EffectS %d def\n"
5044 (ebnf-font-attributes ebnf-special-font))
5045 (format "/BorderWidthS %s def\n"
5046 (ebnf-format-float ebnf-special-border-width))
5047 (ebnf-format-color "/BorderColorS %s def %% %s\n"
5048 ebnf-special-border-color
5050 (format "/ShapeS %d def\n"
5051 (ebnf-shape-value ebnf-special-shape
5052 ebnf-terminal-shape-alist))
5053 (format "/ShadowS %s def\n"
5054 (ebnf-boolean ebnf-special-shadow))
5056 (format "/fE %s /%s DefFont\n"
5057 (ebnf-format-float (ebnf-font-size ebnf-except-font))
5058 (ebnf-font-name-select ebnf-except-font))
5059 (ebnf-format-color "/ForegroundE %s def %% %s\n"
5060 (ebnf-font-foreground ebnf-except-font)
5062 (ebnf-format-color "/BackgroundE %s def %% %s\n"
5063 (ebnf-font-background ebnf-except-font)
5065 (format "/EffectE %d def\n"
5066 (ebnf-font-attributes ebnf-except-font))
5067 (format "/BorderWidthE %s def\n"
5068 (ebnf-format-float ebnf-except-border-width))
5069 (ebnf-format-color "/BorderColorE %s def %% %s\n"
5070 ebnf-except-border-color
5072 (format "/ShapeE %d def\n"
5073 (ebnf-shape-value ebnf-except-shape
5074 ebnf-terminal-shape-alist))
5075 (format "/ShadowE %s def\n"
5076 (ebnf-boolean ebnf-except-shadow))
5078 (format "/fR %s /%s DefFont\n"
5079 (ebnf-format-float (ebnf-font-size ebnf-repeat-font))
5080 (ebnf-font-name-select ebnf-repeat-font))
5081 (ebnf-format-color "/ForegroundR %s def %% %s\n"
5082 (ebnf-font-foreground ebnf-repeat-font)
5084 (ebnf-format-color "/BackgroundR %s def %% %s\n"
5085 (ebnf-font-background ebnf-repeat-font)
5087 (format "/EffectR %d def\n"
5088 (ebnf-font-attributes ebnf-repeat-font))
5089 (format "/BorderWidthR %s def\n"
5090 (ebnf-format-float ebnf-repeat-border-width))
5091 (ebnf-format-color "/BorderColorR %s def %% %s\n"
5092 ebnf-repeat-border-color
5094 (format "/ShapeR %d def\n"
5095 (ebnf-shape-value ebnf-repeat-shape
5096 ebnf-terminal-shape-alist))
5097 (format "/ShadowR %s def\n"
5098 (ebnf-boolean ebnf-repeat-shadow))
5100 (format "/ExtraWidth %s def\n"
5101 (ebnf-format-float ebnf-arrow-extra-width))
5102 (format "/ArrowScale %s def\n"
5103 (ebnf-format-float ebnf-arrow-scale))
5104 (format "/DefaultWidth %s def\n"
5105 (ebnf-format-float ebnf-default-width))
5106 (format "/LineWidth %s def\n"
5107 (ebnf-format-float ebnf-line-width))
5108 (ebnf-format-color "/LineColor %s def %% %s\n"
5111 (format "/ArrowShape %d def\n"
5112 (ebnf-shape-value ebnf-arrow-shape
5113 ebnf-arrow-shape-alist))
5114 (format "/ChartShape %d def\n"
5115 (ebnf-shape-value ebnf-chart-shape
5116 ebnf-terminal-shape-alist))
5117 (format "/UserArrow{%s}def\n"
5118 (let ((arrow (eval ebnf-user-arrow)))
5122 "\n% === end EBNF settings\n\n"
5123 (and ebnf-debug-ps ebnf-debug))))
5127 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5128 ;; Adjusting dimensions
5131 (defun ebnf-dimensions (tree)
5132 (let ((ebnf-total (length tree))
5134 (mapcar 'ebnf-production-dimension tree))
5138 ;; [empty width-fun dim-fun entry height width]
5139 ;;(defun ebnf-empty-dimension (empty)
5143 ;; [production width-fun dim-fun entry height width name production action]
5144 (defun ebnf-production-dimension (production)
5145 (ebnf-message-info "Calculating dimensions")
5146 (ebnf-node-dimension-func (ebnf-node-production production))
5147 (let* ((prod (ebnf-node-production production))
5148 (height (+ (if ebnf-production-name-p
5151 ebnf-line-width ebnf-line-width
5153 (ebnf-node-height prod))))
5154 (ebnf-node-entry production height)
5155 (ebnf-node-height production height)
5156 (ebnf-node-width production (+ (ebnf-node-width prod)
5158 ebnf-horizontal-space))))
5161 ;; [terminal width-fun dim-fun entry height width name]
5162 (defun ebnf-terminal-dimension (terminal)
5163 (ebnf-terminal-dimension1 terminal
5169 ;; [non-terminal width-fun dim-fun entry height width name]
5170 (defun ebnf-non-terminal-dimension (non-terminal)
5171 (ebnf-terminal-dimension1 non-terminal
5177 ;; [special width-fun dim-fun entry height width name]
5178 (defun ebnf-special-dimension (special)
5179 (ebnf-terminal-dimension1 special
5185 (defun ebnf-terminal-dimension1 (node font-height font-width space)
5186 (let ((height (+ space font-height space))
5187 (len (length (ebnf-node-name node))))
5188 (ebnf-node-entry node (* height 0.5))
5189 (ebnf-node-height node height)
5190 (ebnf-node-width node (+ ebnf-basic-width ebnf-arrow-extra-width space
5192 space ebnf-basic-width))))
5195 (defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
5198 ;; [repeat width-fun dim-fun entry height width times element]
5199 (defun ebnf-repeat-dimension (repeat)
5200 (let ((times (ebnf-node-name repeat))
5201 (element (ebnf-node-separator repeat)))
5203 (ebnf-node-dimension-func element)
5204 (setq element ebnf-null-vector))
5205 (ebnf-node-entry repeat (+ (ebnf-node-entry element)
5207 (ebnf-node-height repeat (+ (max (ebnf-node-height element)
5209 ebnf-space-R ebnf-space-R))
5210 (ebnf-node-width repeat (+ (ebnf-node-width element)
5211 ebnf-arrow-extra-width
5212 ebnf-space-R ebnf-space-R ebnf-space-R
5213 ebnf-horizontal-space
5214 (* (length times) ebnf-font-width-R)))))
5217 ;; [except width-fun dim-fun entry height width element element]
5218 (defun ebnf-except-dimension (except)
5219 (let ((factor (ebnf-node-list except))
5220 (element (ebnf-node-separator except)))
5221 (ebnf-node-dimension-func factor)
5223 (ebnf-node-dimension-func element)
5224 (setq element ebnf-null-vector))
5225 (ebnf-node-entry except (+ (max (ebnf-node-entry factor)
5226 (ebnf-node-entry element))
5228 (ebnf-node-height except (+ (max (ebnf-node-height factor)
5229 (ebnf-node-height element))
5230 ebnf-space-E ebnf-space-E))
5231 (ebnf-node-width except (+ (ebnf-node-width factor)
5232 (ebnf-node-width element)
5233 ebnf-arrow-extra-width
5234 ebnf-space-E ebnf-space-E
5235 ebnf-space-E ebnf-space-E
5237 ebnf-horizontal-space))))
5240 ;; [alternative width-fun dim-fun entry height width list]
5241 (defun ebnf-alternative-dimension (alternative)
5242 (let ((body (ebnf-node-list alternative))
5243 (lis (ebnf-node-list alternative)))
5245 (ebnf-node-dimension-func (car lis))
5246 (setq lis (cdr lis)))
5250 (tail (car (last body)))
5251 (entry (ebnf-node-entry (car body)))
5254 (setq node (car alt)
5256 height (+ (ebnf-node-height node) height)
5257 width (max (ebnf-node-width node) width)))
5258 (ebnf-adjust-width body width)
5259 (setq height (+ height (* (1- (length body)) ebnf-vertical-space)))
5260 (ebnf-node-entry alternative (+ entry
5263 (- (ebnf-node-height tail)
5264 (ebnf-node-entry tail))))))
5265 (ebnf-node-height alternative height)
5266 (ebnf-node-width alternative (+ width ebnf-horizontal-space))
5267 (ebnf-node-list alternative body))))
5270 ;; [optional width-fun dim-fun entry height width element]
5271 (defun ebnf-optional-dimension (optional)
5272 (let ((body (ebnf-node-list optional)))
5273 (ebnf-node-dimension-func body)
5274 (ebnf-node-entry optional (ebnf-node-entry body))
5275 (ebnf-node-height optional (+ (ebnf-node-height body)
5276 ebnf-vertical-space))
5277 (ebnf-node-width optional (+ (ebnf-node-width body)
5278 ebnf-horizontal-space))))
5281 ;; [one-or-more width-fun dim-fun entry height width element separator]
5282 (defun ebnf-one-or-more-dimension (or-more)
5283 (let ((list-part (ebnf-node-list or-more))
5284 (sep-part (ebnf-node-separator or-more)))
5285 (ebnf-node-dimension-func list-part)
5287 (ebnf-node-dimension-func sep-part))
5288 (let ((height (+ (if sep-part
5289 (ebnf-node-height sep-part)
5292 (ebnf-node-height list-part)))
5293 (width (max (if sep-part
5294 (ebnf-node-width sep-part)
5296 (ebnf-node-width list-part))))
5298 (ebnf-adjust-width list-part width)
5299 (ebnf-adjust-width sep-part width))
5300 (ebnf-node-entry or-more (+ (- height (ebnf-node-height list-part))
5301 (ebnf-node-entry list-part)))
5302 (ebnf-node-height or-more height)
5303 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
5306 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5307 (defun ebnf-zero-or-more-dimension (or-more)
5308 (let ((list-part (ebnf-node-list or-more))
5309 (sep-part (ebnf-node-separator or-more)))
5310 (ebnf-node-dimension-func list-part)
5312 (ebnf-node-dimension-func sep-part))
5313 (let ((height (+ (if sep-part
5314 (ebnf-node-height sep-part)
5317 (ebnf-node-height list-part)
5318 ebnf-vertical-space))
5319 (width (max (if sep-part
5320 (ebnf-node-width sep-part)
5322 (ebnf-node-width list-part))))
5324 (ebnf-adjust-width list-part width)
5325 (ebnf-adjust-width sep-part width))
5326 (ebnf-node-entry or-more height)
5327 (ebnf-node-height or-more height)
5328 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
5331 ;; [sequence width-fun dim-fun entry height width list]
5332 (defun ebnf-sequence-dimension (sequence)
5336 (lis (ebnf-node-list sequence))
5339 (setq node (car lis)
5341 (ebnf-node-dimension-func node)
5342 (setq entry (ebnf-node-entry node)
5343 above (max above entry)
5344 below (max below (- (ebnf-node-height node) entry))
5345 width (+ width (ebnf-node-width node))))
5346 (ebnf-node-entry sequence above)
5347 (ebnf-node-height sequence (+ above below))
5348 (ebnf-node-width sequence width)))
5351 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5355 (defun ebnf-adjust-width (node width)
5361 (setcar node (ebnf-adjust-width (car node) width))
5362 (setq node (cdr node)))))
5365 ;; nothing to be done
5366 ((= width (ebnf-node-width node))
5368 ;; left justify term
5369 ((eq ebnf-justify-sequence 'left)
5370 (ebnf-adjust-empty node width nil))
5371 ;; right justify terms
5372 ((eq ebnf-justify-sequence 'right)
5373 (ebnf-adjust-empty node width t))
5376 (ebnf-node-width-func node width)
5377 (ebnf-node-width node width)
5385 (defun ebnf-adjust-empty (node width last-p)
5386 (if (eq (ebnf-node-kind node) 'ebnf-generate-empty)
5388 (ebnf-node-width node width)
5390 (let ((empty (ebnf-make-empty (- width (ebnf-node-width node)))))
5391 (ebnf-make-dup-sequence node
5394 (list node empty))))))
5397 ;; [terminal width-fun dim-fun entry height width name]
5398 ;; [non-terminal width-fun dim-fun entry height width name]
5399 ;; [empty width-fun dim-fun entry height width]
5400 ;; [special width-fun dim-fun entry height width name]
5401 ;; [repeat width-fun dim-fun entry height width times element]
5402 ;; [except width-fun dim-fun entry height width element element]
5403 ;;(defun ebnf-terminal-width (terminal width)
5407 ;; [alternative width-fun dim-fun entry height width list]
5408 ;; [optional width-fun dim-fun entry height width element]
5409 (defun ebnf-alternative-width (alternative width)
5410 (ebnf-adjust-width (ebnf-node-list alternative)
5411 (- width ebnf-horizontal-space)))
5414 ;; [one-or-more width-fun dim-fun entry height width element separator]
5415 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5416 (defun ebnf-element-width (or-more width)
5417 (setq width (- width ebnf-horizontal-space))
5418 (ebnf-node-list or-more
5419 (ebnf-justify-list or-more
5420 (ebnf-node-list or-more)
5422 (ebnf-node-separator or-more
5423 (ebnf-justify-list or-more
5424 (ebnf-node-separator or-more)
5428 ;; [sequence width-fun dim-fun entry height width list]
5429 (defun ebnf-sequence-width (sequence width)
5430 (ebnf-node-list sequence
5431 (ebnf-justify-list sequence
5432 (ebnf-node-list sequence)
5436 (defun ebnf-justify-list (node seq width)
5437 (let ((seq-width (ebnf-node-width node)))
5438 (if (= width seq-width)
5441 ;; left justify terms
5442 ((eq ebnf-justify-sequence 'left)
5443 (ebnf-justify node seq seq-width width t))
5444 ;; right justify terms
5445 ((eq ebnf-justify-sequence 'right)
5446 (ebnf-justify node seq seq-width width nil))
5447 ;; centralize terms -- element
5449 (ebnf-adjust-width seq width))
5450 ;; centralize terms -- list
5452 (let ((the-width (/ (- width seq-width) (length seq)))
5455 (ebnf-adjust-width (car lis)
5456 (+ (ebnf-node-width (car lis))
5458 (setq lis (cdr lis)))
5463 (defun ebnf-justify (node seq seq-width width last-p)
5464 (let ((term (car (if last-p (last seq) seq))))
5466 ;; adjust empty term
5467 ((eq (ebnf-node-kind term) 'ebnf-generate-empty)
5468 (ebnf-node-width term (+ (- width seq-width)
5469 (ebnf-node-width term)))
5471 ;; insert empty at end ==> left justify
5474 (list (ebnf-make-empty (- width seq-width)))))
5475 ;; insert empty at beginning ==> right justify
5477 (cons (ebnf-make-empty (- width seq-width))
5482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5483 ;; Functions used by parsers
5486 (defun ebnf-eps-add-context (name)
5487 (let ((filename (ebnf-eps-filename name)))
5488 (if (member filename ebnf-eps-context)
5489 (error "Try to open an already opened EPS file: %s" filename)
5490 (setq ebnf-eps-context (cons filename ebnf-eps-context)))))
5493 (defun ebnf-eps-remove-context (name)
5494 (let ((filename (ebnf-eps-filename name)))
5495 (if (member filename ebnf-eps-context)
5496 (setq ebnf-eps-context (delete filename ebnf-eps-context))
5497 (error "Try to close a not opened EPS file: %s" filename))))
5500 (defun ebnf-eps-add-production (header)
5501 (and ebnf-eps-executing
5503 (let ((prod (assoc header ebnf-eps-production-list)))
5505 (setcdr prod (append ebnf-eps-context (cdr prod)))
5506 (setq ebnf-eps-production-list
5507 (cons (cons header (ebnf-dup-list ebnf-eps-context))
5508 ebnf-eps-production-list))))))
5511 (defun ebnf-dup-list (old)
5514 (setq new (cons (car old) new)
5519 (defun ebnf-buffer-substring (chars)
5520 (buffer-substring-no-properties
5523 (skip-chars-forward chars ebnf-limit)
5527 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
5528 (defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377))
5531 (defun ebnf-string (chars eos-char kind)
5533 (buffer-substring-no-properties
5536 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5537 (skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit)
5538 (if (or (eobp) (/= (following-char) eos-char))
5539 (error "Invalid %s: missing `%c'" kind eos-char)
5544 (defun ebnf-get-string ()
5546 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5549 (defun ebnf-end-of-string ()
5551 (while (> (logand n 1) 0)
5552 (skip-chars-forward "^\"" ebnf-limit)
5553 (setq n (- (skip-chars-backward "\\\\")))
5554 (goto-char (+ (point) n 1))))
5555 (if (= (preceding-char) ?\")
5557 (error "Missing `\"'")))
5560 (defun ebnf-trim-right (str)
5561 (let* ((len (1- (length str)))
5563 (while (and (> index 0) (= (aref str index) ?\s))
5564 (setq index (1- index)))
5567 (substring str 0 (1+ index)))))
5570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5574 (defun ebnf-make-empty (&optional width)
5575 (vector 'ebnf-generate-empty
5580 (or width ebnf-horizontal-space)))
5583 (defun ebnf-make-terminal (name)
5584 (ebnf-make-terminal1 name
5585 'ebnf-generate-terminal
5586 'ebnf-terminal-dimension))
5589 (defun ebnf-make-non-terminal (name)
5590 (ebnf-make-terminal1 name
5591 'ebnf-generate-non-terminal
5592 'ebnf-non-terminal-dimension))
5595 (defun ebnf-make-special (name)
5596 (ebnf-make-terminal1 name
5597 'ebnf-generate-special
5598 'ebnf-special-dimension))
5601 (defun ebnf-make-terminal1 (name gen-func dim-func)
5608 (let ((len (length name)))
5609 (cond ((> len 3) name)
5610 ((= len 3) (concat name " "))
5611 ((= len 2) (concat " " name " "))
5612 ((= len 1) (concat " " name " "))
5617 (defun ebnf-make-one-or-more (list-part &optional sep-part)
5618 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5619 'ebnf-one-or-more-dimension
5624 (defun ebnf-make-zero-or-more (list-part &optional sep-part)
5625 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5626 'ebnf-zero-or-more-dimension
5631 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
5638 (if (listp list-part)
5639 (ebnf-make-sequence list-part)
5641 (if (and sep-part (listp sep-part))
5642 (ebnf-make-sequence sep-part)
5646 (defun ebnf-make-production (name prod action)
5647 (vector 'ebnf-generate-production
5649 'ebnf-production-dimension
5658 (defun ebnf-make-alternative (body)
5659 (vector 'ebnf-generate-alternative
5660 'ebnf-alternative-width
5661 'ebnf-alternative-dimension
5668 (defun ebnf-make-optional (body)
5669 (vector 'ebnf-generate-optional
5670 'ebnf-alternative-width
5671 'ebnf-optional-dimension
5678 (defun ebnf-make-except (factor exception)
5679 (vector 'ebnf-generate-except
5681 'ebnf-except-dimension
5689 (defun ebnf-make-repeat (times primary &optional upper)
5690 (vector 'ebnf-generate-repeat
5692 'ebnf-repeat-dimension
5696 (cond ((and times upper) ; L * U, L * L
5697 (if (string= times upper)
5698 (if (string= times "")
5701 (concat times " * " upper)))
5703 (concat times " *"))
5705 (concat "* " upper))
5711 (defun ebnf-make-sequence (seq)
5712 (vector 'ebnf-generate-sequence
5713 'ebnf-sequence-width
5714 'ebnf-sequence-dimension
5721 (defun ebnf-make-dup-sequence (node seq)
5722 (vector 'ebnf-generate-sequence
5723 'ebnf-sequence-width
5724 'ebnf-sequence-dimension
5725 (ebnf-node-entry node)
5726 (ebnf-node-height node)
5727 (ebnf-node-width node)
5731 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5732 ;; Optimizers used by parsers
5735 (defun ebnf-token-except (element exception)
5738 (setq exception (cdr exception)))
5739 (and element ; EMPTY - A ==> EMPTY
5740 (let ((kind (ebnf-node-kind element)))
5743 ((and (null exception)
5744 (eq kind 'ebnf-generate-optional))
5745 (ebnf-node-list element))
5746 ;; { A }- ==> { A }+
5747 ((and (null exception)
5748 (eq kind 'ebnf-generate-zero-or-more))
5749 (ebnf-node-kind element 'ebnf-generate-one-or-more)
5750 (ebnf-node-dimension-func element 'ebnf-one-or-more-dimension)
5752 ;; ( A | EMPTY )- ==> A
5753 ;; ( A | B | EMPTY )- ==> A | B
5754 ((and (null exception)
5755 (eq kind 'ebnf-generate-alternative)
5757 (car (last (ebnf-node-list element))))
5758 'ebnf-generate-empty))
5759 (let ((elt (ebnf-node-list element))
5765 ;; this should not happen!!?!
5766 (setq element (ebnf-make-empty
5767 (ebnf-node-width element)))
5769 (setq elt (ebnf-node-list element))
5770 (and (= (length elt) 1)
5771 (setq element (car elt))))
5775 (ebnf-make-except element exception))
5779 (defun ebnf-token-repeat (times repeat &optional upper)
5780 (if (null (cdr repeat))
5781 ;; n * EMPTY ==> EMPTY
5785 (ebnf-make-repeat times (cdr repeat) upper))))
5788 (defun ebnf-token-optional (body)
5789 (let ((kind (ebnf-node-kind body)))
5791 ;; [ EMPTY ] ==> EMPTY
5792 ((eq kind 'ebnf-generate-empty)
5794 ;; [ { A }* ] ==> { A }*
5795 ((eq kind 'ebnf-generate-zero-or-more)
5797 ;; [ { A }+ ] ==> { A }*
5798 ((eq kind 'ebnf-generate-one-or-more)
5799 (ebnf-node-kind body 'ebnf-generate-zero-or-more)
5801 ;; [ A | B ] ==> A | B | EMPTY
5802 ((eq kind 'ebnf-generate-alternative)
5803 (ebnf-node-list body (nconc (ebnf-node-list body)
5804 (list (ebnf-make-empty))))
5808 (ebnf-make-optional body))
5812 (defun ebnf-token-alternative (body sequence)
5816 (cons (car sequence)
5818 (cons (car sequence)
5819 (let ((seq (cdr sequence)))
5820 (if (and (= (length body) 1) (null seq))
5822 (ebnf-make-alternative (nreverse (if seq
5827 (defun ebnf-token-sequence (sequence)
5832 ;; sequence with only one element
5833 ((= (length sequence) 1)
5837 (ebnf-make-sequence (nreverse sequence)))
5841 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5842 ;; Variables used by parsers
5845 (defconst ebnf-comment-table
5846 (let ((table (make-vector 256 nil)))
5847 ;; Override special comment character:
5848 (aset table ?< 'newline)
5849 (aset table ?> 'keep-line)
5850 (aset table ?^ 'form-feed)
5852 "Vector used to map characters to a special comment token.")
5855 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5856 ;; To make this file smaller, some commands go in a separate file.
5857 ;; But autoload them here to make the separation invisible.
5859 (autoload 'ebnf-abn-parser "ebnf-abn"
5862 (autoload 'ebnf-abn-initialize "ebnf-abn"
5863 "Initialize ABNF token table.")
5865 (autoload 'ebnf-bnf-parser "ebnf-bnf"
5868 (autoload 'ebnf-bnf-initialize "ebnf-bnf"
5869 "Initialize EBNF token table.")
5871 (autoload 'ebnf-iso-parser "ebnf-iso"
5874 (autoload 'ebnf-iso-initialize "ebnf-iso"
5875 "Initialize ISO EBNF token table.")
5877 (autoload 'ebnf-yac-parser "ebnf-yac"
5878 "Yacc/Bison parser.")
5880 (autoload 'ebnf-yac-initialize "ebnf-yac"
5881 "Initializations for Yacc/Bison parser.")
5883 (autoload 'ebnf-ebx-parser "ebnf-ebx"
5886 (autoload 'ebnf-ebx-initialize "ebnf-ebx"
5887 "Initializations for EBNFX parser.")
5889 (autoload 'ebnf-dtd-parser "ebnf-dtd"
5892 (autoload 'ebnf-dtd-initialize "ebnf-dtd"
5893 "Initializations for DTD parser.")
5896 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5901 ;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
5902 ;;; ebnf2ps.el ends here