1 ;;; ebnf2ps --- Translate an EBNF to a syntatic chart on PostScript
3 ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
5 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
6 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
7 ;; Keywords: wp, ebnf, PostScript
8 ;; Time-stamp: <2000/07/29 13:09:47 vinicius>
10 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/Emacs.html
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
29 (defconst ebnf-version "3.2"
30 "ebnf2ps.el, v 3.2 <2000/07/29 vinicius>
32 Vinicius's last change version. When reporting bugs, please also
33 report the version of Emacs, if any, that ebnf2ps was running with.
35 Please send all bug fixes and enhancements to
36 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
42 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;; This package translates an EBNF to a syntatic chart on PostScript.
49 ;; To use ebnf2ps, insert in your ~/.emacs:
53 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
54 ;; know how to set options like landscape printing, page headings, margins,
57 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
58 ;; ebnf2ps, they behave as it's turned off.
60 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
62 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
64 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
66 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
72 ;; ebnf2ps provides six commands for generating PostScript syntatic chart
73 ;; images of Emacs buffers:
82 ;; These commands all perform essentially the same function: they generate
83 ;; PostScript syntatic chart images suitable for printing on a PostScript
84 ;; printer or displaying with GhostScript. These commands are collectively
85 ;; referred to as "ebnf- commands".
87 ;; The word "print", "spool" and "eps" in the command name determines when the
88 ;; PostScript image is sent to the printer (or file):
90 ;; print - The PostScript image is immediately sent to the printer;
92 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
93 ;; Many images may be spooled locally before printing them. To
94 ;; send the spooled images to the printer, use the command
97 ;; eps - The PostScript image is immediately sent to a EPS file.
99 ;; The spooling mechanism is the same as used by ps-print and was designed for
100 ;; printing lots of small files to save paper that would otherwise be wasted on
101 ;; banner pages, and to make it easier to find your output at the printer (it's
102 ;; easier to pick up one 50-page printout than to find 50 single-page
103 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
104 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
106 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
107 ;; won't accidentally quit from Emacs while you have unprinted PostScript
108 ;; waiting in the spool buffer. If you do attempt to exit with spooled
109 ;; PostScript, you'll be asked if you want to print it, and if you decline,
110 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
111 ;; that Emacs uses for modified buffers.
113 ;; The word "buffer" or "region" in the command name determines how much of the
114 ;; buffer is printed:
116 ;; buffer - Print the entire buffer.
118 ;; region - Print just the current region.
120 ;; Two ebnf- command examples:
122 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
123 ;; immediately to the printer.
125 ;; ebnf-spool-region - translate and print just the current region, and
126 ;; spool the image in Emacs to send to the printer
129 ;; Note that `ebnf-eps-buffer' and `ebnf-eps-region' never spool the EPS image,
130 ;; so they don't use the ps-print spooling mechanism. See section "Actions in
131 ;; Comments" for an explanation about EPS file generation.
137 ;; To translate and print your buffer, type
139 ;; M-x ebnf-print-buffer
141 ;; or substitute one of the other four ebnf- commands. The command will
142 ;; generate the PostScript image and print or spool it as specified. By giving
143 ;; the command a prefix argument
145 ;; C-u M-x ebnf-print-buffer
147 ;; it will save the PostScript image to a file instead of sending it to the
148 ;; printer; you will be prompted for the name of the file to save the image to.
149 ;; The prefix argument is ignored by the commands that spool their images, but
150 ;; you may save the spooled images to a file by giving a prefix argument to
153 ;; C-u M-x ebnf-despool
155 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
158 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
159 ;; `ebnf-eps-region'.
161 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
163 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
164 ;; (global-set-key '(shift f22) 'ebnf-print-region)
165 ;; (global-set-key '(control f22) 'ebnf-despool)
171 ;; The current EBNF that ebnf2ps accepts has the following constructions:
173 ;; ; comment (until end of line)
177 ;; $A default non-terminal (see text below)
178 ;; $"C" default terminal (see text below)
179 ;; $?C? default special (see text below)
180 ;; A = B. production (A is the header and B the body)
181 ;; C D sequence (C occurs before D)
182 ;; C | D alternative (C or D occurs)
183 ;; A - B exception (A excluding B, B without any non-terminal)
184 ;; n * A repetition (A repeats n (integer) times)
185 ;; (C) group (expression C is grouped together)
186 ;; [C] optional (C may or not occurs)
187 ;; C+ one or more occurrences of C
188 ;; {C}+ one or more occurrences of C
189 ;; {C}* zero or more occurrences of C
190 ;; {C} zero or more occurrences of C
191 ;; C / D equivalent to: C {D C}*
192 ;; {C || D}+ equivalent to: C {D C}*
193 ;; {C || D}* equivalent to: [C {D C}*]
194 ;; {C || D} equivalent to: [C {D C}*]
196 ;; The EBNF syntax written using the notation above is:
198 ;; EBNF = {production}+.
200 ;; production = non_terminal "=" body ".". ;; production
202 ;; body = {sequence || "|"}*. ;; alternative
204 ;; sequence = {exception}*. ;; sequence
206 ;; exception = repeat [ "-" repeat]. ;; exception
208 ;; repeat = [ integer "*" ] term. ;; repetition
211 ;; | [factor] "+" ;; one-or-more
212 ;; | [factor] "/" [factor] ;; one-or-more
215 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
216 ;; | [ "$" ] non_terminal ;; non-terminal
217 ;; | [ "$" ] "?" special "?" ;; special
218 ;; | "(" body ")" ;; group
219 ;; | "[" body "]" ;; zero-or-one
220 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
221 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
222 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
225 ;; non_terminal = "[A-Za-z\\240-\\377][!#%&'*-,0-:<>@-Z\\^-z~\\240-\\377]*".
227 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
229 ;; special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*".
231 ;; integer = "[0-9]+".
233 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
235 ;; Try to use the above EBNF to test ebnf2ps.
237 ;; The `default' terminal, non-terminal and special is a way to indicate a
238 ;; default path in a production. For example, the production:
240 ;; X = [ $A ( B | $C ) | D ].
242 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
244 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
245 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
246 ;; name besides that enclosed by `"'.
248 ;; Let's see an example:
250 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
251 ;; (setq ebnf-case-fold-search nil) ; exact matching
253 ;; If you have the production:
255 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
257 ;; The names are classified as:
259 ;; Logical Expression non-terminal
260 ;; "(" OR AND "XOR" ")" terminal
262 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
263 ;; value is ?\; (character `;').
265 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
266 ;; value is ?. (character `.').
268 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
270 ;; `ebnf' ebnf2ps recognizes the syntax described above.
271 ;; The following variables *ONLY* have effect with this
273 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
274 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
276 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
277 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
278 ;; ("International Standard of the ISO EBNF Notation").
279 ;; The following variables *ONLY* have effect with this
281 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
283 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
284 ;; The following variable *ONLY* has effect with this
286 ;; `ebnf-yac-ignore-error-recovery'.
288 ;; Any other value is treated as `ebnf'.
290 ;; The default value is `ebnf'.
296 ;; The following EBNF optimizations are done:
298 ;; [ { A }* ] ==> { A }*
299 ;; [ { A }+ ] ==> { A }*
300 ;; [ A ] + ==> { A }*
301 ;; { A }* + ==> { A }*
302 ;; { A }+ + ==> { A }+
305 ;; ( A | EMPTY )- ==> A
306 ;; ( A | B | EMPTY )- ==> A | B
307 ;; [ A | B ] ==> A | B | EMPTY
308 ;; n * EMPTY ==> EMPTY
310 ;; EMPTY / EMPTY ==> EMPTY
311 ;; EMPTY - A ==> EMPTY
313 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
316 ;; 1. A = B | A C. ==> A = B {C}*.
317 ;; 2. A = B | A B. ==> A = {B}+.
318 ;; 3. A = | A B. ==> A = {B}*.
319 ;; 4. A = B | A C B. ==> A = {B || C}+.
320 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
323 ;; 6. A = B | . ==> A = [B].
324 ;; 7. A = | B . ==> A = [B].
327 ;; 8. A = B C | B D. ==> A = B (C | D).
328 ;; 9. A = C B | D B. ==> A = (C | D) B.
329 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
331 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
337 ;; You may use form feed (^L \014) to force a production to start on a new
338 ;; page, for example:
347 ;; c) A = B ^L^L^L | C.^L
351 ;; In all examples above, only the production X will start on a new page.
354 ;; Actions in Comments
355 ;; -------------------
357 ;; ebnf2ps accepts the following actions in comments:
359 ;; ;> the next production starts in the same line as the current one.
360 ;; It is useful when `ebnf-horizontal-orientation' is nil.
362 ;; ;< the next production starts in the next line.
363 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
365 ;; ;[EPS open a new EPS file. The EPS file name has the form:
366 ;; <PREFIX><NAME>.eps
367 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
368 ;; <NAME> is the string given by ;[ action comment, this string is
369 ;; mapped to form a valid file name (see documentation for
370 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
371 ;; It has effect only during `ebnf-eps-buffer' or
372 ;; `ebnf-eps-region' execution.
373 ;; It's an error to try to open an already opened EPS file.
375 ;; ;]EPS close an opened EPS file.
376 ;; It has effect only during `ebnf-eps-buffer' or
377 ;; `ebnf-eps-region' execution.
378 ;; It's an error to try to close a not opened EPS file.
382 ;; (setq ebnf-horizontal-orientation nil)
386 ;; ;> C and B are drawn in the same line
390 ;; The graphical result is:
396 ;; +---------+ +-----+
408 ;; Note that if ascending production sort is used, the productions A and B will
409 ;; be drawn in the same line instead of C and B.
411 ;; If consecutive actions occur, only the last one takes effect, so if you
420 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
423 ;; In ISO EBNF the above actions are specified as (*>*), (*<*), (*[EPS*) and
424 ;; (*]EPS*). The first example above should be written:
428 ;; (*> C and B are drawn in the same line *)
432 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
433 ;; `ebnf-eps-region':
452 ;; The following table summarizes the results:
454 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
455 ;; ebnf--AA.eps A C A C C A
456 ;; ebnf--BB.eps C B B C C B
457 ;; ebnf--CC.eps A C B F A B C F F C B A
463 ;; As you can see if EPS actions is not used, each single production is
464 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
465 ;; it's not an existing production name.
467 ;; In the following case:
475 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
481 ;; Some tools are provided to help you.
483 ;; `ebnf-setup' returns the current setup.
485 ;; `ebnf-syntax-buffer' does a syntatic analysis of your EBNF in the current
488 ;; `ebnf-syntax-region' does a syntatic analysis of your EBNF in the current
491 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
493 ;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound
494 ;; to keys in the same way as `ebnf-' commands.
500 ;; ebn2ps has the following hook variables:
503 ;; It is evaluated once before any ebnf2ps process.
505 ;; `ebnf-production-hook'
506 ;; It is evaluated on each beginning of production.
509 ;; It is evaluated on each beginning of page.
515 ;; Below it's shown a brief description of ebnf2ps options, please, see the
516 ;; options declaration in the code for a long documentation.
518 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
521 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
522 ;; height in horizontal orientation.
524 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
525 ;; between productions.
527 ;; `ebnf-production-vertical-space' Specify vertical space in points
528 ;; between productions.
530 ;; `ebnf-justify-sequence' Specify justification of terms in a
531 ;; sequence inside alternatives.
533 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
535 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
537 ;; `ebnf-terminal-font' Specify terminal font.
539 ;; `ebnf-terminal-shape' Specify terminal box shape.
541 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
544 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
546 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
548 ;; `ebnf-sort-production' Specify how productions are sorted.
550 ;; `ebnf-production-font' Specify production font.
552 ;; `ebnf-non-terminal-font' Specify non-terminal font.
554 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
556 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
559 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
562 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
565 ;; `ebnf-special-font' Specify special font.
567 ;; `ebnf-special-shape' Specify special box shape.
569 ;; `ebnf-special-shadow' Non-nil means special box will have a
572 ;; `ebnf-special-border-width' Specify border width for special box.
574 ;; `ebnf-special-border-color' Specify border color for special box.
576 ;; `ebnf-except-font' Specify except font.
578 ;; `ebnf-except-shape' Specify except box shape.
580 ;; `ebnf-except-shadow' Non-nil means except box will have a
583 ;; `ebnf-except-border-width' Specify border width for except box.
585 ;; `ebnf-except-border-color' Specify border color for except box.
587 ;; `ebnf-repeat-font' Specify repeat font.
589 ;; `ebnf-repeat-shape' Specify repeat box shape.
591 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
594 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
596 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
598 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
600 ;; `ebnf-arrow-shape' Specify the arrow shape.
602 ;; `ebnf-chart-shape' Specify chart flow shape.
604 ;; `ebnf-color-p' Non-nil means use color.
606 ;; `ebnf-line-width' Specify flow line width.
608 ;; `ebnf-line-color' Specify flow line color.
610 ;; `ebnf-user-arrow' Specify a user arrow shape (a
613 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
616 ;; `ebnf-lex-comment-char' Specify the line comment character.
618 ;; `ebnf-lex-eop-char' Specify the end of production
621 ;; `ebnf-syntax' Specify syntax to be recognized.
623 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
625 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
628 ;; `ebnf-default-width' Specify additional border width over
629 ;; default terminal, non-terminal or
632 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
634 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
636 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
638 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
640 ;; `ebnf-optimize' Non-nil means optimize syntatic chart
643 ;; To set the above options you may:
645 ;; a) insert the code in your ~/.emacs, like:
647 ;; (setq ebnf-terminal-shape 'bevel)
649 ;; This way always keep your default settings when you enter a new Emacs
652 ;; b) or use `set-variable' in your Emacs session, like:
654 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
656 ;; This way keep your settings only during the current Emacs session.
658 ;; c) or use customization, for example:
659 ;; click on menu-bar *Help* option,
660 ;; then click on *Customize*,
661 ;; then click on *Browse Customization Groups*,
662 ;; expand *PostScript* group,
663 ;; expand *Ebnf2ps* group
664 ;; and then customize ebnf2ps options.
665 ;; Through this way, you may choose if the settings are kept or not when
666 ;; you leave out the current Emacs session.
668 ;; d) or see the option value:
670 ;; C-h v ebnf-terminal-shape RET
672 ;; and click the *customize* hypertext button.
673 ;; Through this way, you may choose if the settings are kept or not when
674 ;; you leave out the current Emacs session.
678 ;; M-x ebnf-customize RET
680 ;; and then customize ebnf2ps options.
681 ;; Through this way, you may choose if the settings are kept or not when
682 ;; you leave out the current Emacs session.
688 ;; Sometimes you need to change the EBNF style you are using, for example,
689 ;; change the shapes and colors. These changes may force you to set some
690 ;; variables and after use, set back the variables to the old values.
692 ;; To help to handle this situation, ebnf2ps has the following commands to
695 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
698 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
700 ;; `ebnf-apply-style' Set STYLE to current style.
702 ;; `ebnf-reset-style' Reset current style.
704 ;; `ebnf-push-style' Push the current style and set STYLE to current style.
706 ;; `ebnf-pop-style' Pop a style and set it to current style.
708 ;; These commands helps to put together a lot of variable settings in a group
709 ;; and name this group. So when you wish to apply these settings it's only
710 ;; needed to give the name.
712 ;; There is also a notion of simple inheritance of style; so if you declare
713 ;; that a style A inherits from a style B, all settings of B is applied first
714 ;; and then the settings of A is applied. This is useful when you wish to
715 ;; modify some aspects of an existing style, but at same time wish to keep it
718 ;; See documentation for `ebnf-style-database'.
724 ;; Below it is the layout of minimum area to draw each element, and it's used
725 ;; the following terms:
727 ;; font height is given by:
728 ;; (terminal font height + non-terminal font height) / 2
730 ;; entry is the vertical position used to know where it should
731 ;; be drawn the flow line in the current element.
734 ;; * SPECIAL, TERMINAL and NON-TERMINAL
736 ;; +==============+...................................
737 ;; | | } font height / 2 } entry }
738 ;; | XXXXXXXX...|....... } }
739 ;; ====+ XXXXXXXX +==== } text height ...... } height
740 ;; : | XXXXXXXX...|...:... }
741 ;; : | : : | : } font height / 2 }
742 ;; : +==============+...:...............................
744 ;; : : : : : :......................
745 ;; : : : : : } font height }
746 ;; : : : : :....... }
747 ;; : : : : } font height / 2 }
748 ;; : : : :........... }
749 ;; : : : } text width } width
750 ;; : : :.................. }
751 ;; : : } font height / 2 }
752 ;; : :...................... }
754 ;; :.............................................
759 ;; +==========+.....................................
763 ;; ===+===+ +===+===... } element height } height
766 ;; : | +==========+.|................. }
767 ;; : | : : | : } font height }
768 ;; : +==============+...................................
770 ;; : : : :......................
771 ;; : : : } font height * 2 }
773 ;; : : } element width } width
774 ;; : :..................... }
775 ;; : } font height * 2 }
776 ;; :...............................................
781 ;; +===+...................................
782 ;; +==+ A +==+ } A height } }
783 ;; | +===+..|........ } entry }
784 ;; + + } font height } }
785 ;; / +===+...\....... } }
786 ;; ===+====+ B +====+=== } B height ..... } height
787 ;; : \ +===+.../....... }
788 ;; : + + : } font height }
789 ;; : | +===+..|........ }
790 ;; : +==+ C +==+ : } C height }
791 ;; : : +===+...................................
793 ;; : : : :......................
794 ;; : : : } font height * 2 }
796 ;; : : } max width } width
797 ;; : :................. }
798 ;; : } font height * 2 }
799 ;; :..........................................
802 ;; 1. An empty alternative has zero of height.
804 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
810 ;; +===========+...............................
811 ;; +=+ separator +=+ } separator height }
812 ;; / +===========+..\........ }
814 ;; | | } font height }
816 ;; \ +===========+../........ } height = entry
817 ;; +=+ element +=+ } element height }
818 ;; /: +===========+..\........ }
820 ;; + : : + } font height }
822 ;; ==+=======================+==.......................
824 ;; : : : :.......................
825 ;; : : : } font height * 2 }
827 ;; : : } max width } width
828 ;; : :......................... }
829 ;; : } font height * 2 }
830 ;; :...................................................
835 ;; +===========+......................................
836 ;; +=+ separator +=+ } separator height } }
837 ;; / +===========+..\...... } }
839 ;; | | } font height } } height
841 ;; \ +===========+../...... } }
842 ;; ===+=+ element +=+=== } element height .... }
843 ;; : : +===========+......................................
845 ;; : : : :........................
846 ;; : : : } font height * 2 }
848 ;; : : } max width } width
849 ;; : :....................... }
850 ;; : } font height * 2 }
851 ;; :..............................................
856 ;; XXXXXX:......................................
857 ;; XXXXXX: } production font height }
858 ;; XXXXXX:............ }
860 ;; +======+....... } height = entry
862 ;; ====+ +==== } element height }
864 ;; : +======+.................................
866 ;; : : : :......................
867 ;; : : : } font height * 2 }
869 ;; : : } element width } width
870 ;; : :.............. }
871 ;; : } font height * 2 }
872 ;; :.....................................
877 ;; +================+...................................
878 ;; | | } font height / 2 } entry }
879 ;; | +===+...|....... } }
880 ;; ====+ N * | X | +==== } X height ......... } height
881 ;; : | : : +===+...|...:... }
882 ;; : | : : : : | : } font height / 2 }
883 ;; : +================+...:...............................
885 ;; : : : : : : : :......................
886 ;; : : : : : : : } font height }
887 ;; : : : : : : :....... }
888 ;; : : : : : : } font height / 2 }
889 ;; : : : : : :........... }
890 ;; : : : : : } X width }
891 ;; : : : : :............... }
892 ;; : : : : } font height / 2 } width
893 ;; : : : :.................. }
894 ;; : : : } text width }
895 ;; : : :..................... }
896 ;; : : } font height / 2 }
897 ;; : :........................ }
899 ;; :...............................................
904 ;; +==================+...................................
905 ;; | | } font height / 2 } entry }
906 ;; | +===+ +===+...|....... } }
907 ;; ====+ | X | - | y | +==== } max height ....... } height
908 ;; : | +===+ +===+...|...:... }
909 ;; : | : : : : | : } font height / 2 }
910 ;; : +==================+...:...............................
912 ;; : : : : : : : :......................
913 ;; : : : : : : : } font height }
914 ;; : : : : : : :....... }
915 ;; : : : : : : } font height / 2 }
916 ;; : : : : : :........... }
917 ;; : : : : : } Y width }
918 ;; : : : : :............... }
919 ;; : : : : } font height } width
920 ;; : : : :................... }
922 ;; : : :....................... }
923 ;; : : } font height / 2 }
924 ;; : :.......................... }
926 ;; :.................................................
928 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
931 ;; Internal Structures
932 ;; -------------------
934 ;; ebnf2ps has two passes. The first pass does a lexical and syntatic analysis
935 ;; of current buffer and generates an intermediate representation. The second
936 ;; pass uses the intermediate representation to generate the PostScript
939 ;; The intermediate representation is a list of vectors, the vector element
940 ;; represents a syntatic chart element. Below is a vector representation for
941 ;; each syntatic chart element.
943 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
944 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
945 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
946 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
947 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
948 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
949 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
950 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
951 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
952 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
953 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
954 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
956 ;; The first vector position is a function symbol used to generate PostScript
958 ;; WIDTH-FUN is a function symbol called to adjust the element width.
959 ;; DIM-FUN is a function symbol called to set the element dimensions.
960 ;; ENTRY is the element entry point.
961 ;; HEIGHT and WIDTH are the element height and width, respectively.
962 ;; NAME is a string that it's the element name.
963 ;; DEFAULT is a boolean that indicates if it's a `default' element.
964 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
966 ;; LIST is a list of vector that represents the list part for alternatives and
968 ;; SEPARATOR is a vector that represents the sub-element used to separate the
970 ;; TIMES is a string representing the number of times that ELEMENT is repeated
971 ;; on a repeat construction.
972 ;; ACTION indicates some action that should be done before production is
973 ;; generated. The current actions are:
977 ;; form-feed current production starts on a new page.
979 ;; newline current production starts on next line, this is useful
980 ;; when `ebnf-horizontal-orientation' is non-nil.
982 ;; keep-line current production continues on the current line, this
983 ;; is useful when `ebnf-horizontal-orientation' is nil.
989 ;; . Handle situations when syntatic chart is out of paper.
990 ;; . Use other alphabet than ascii.
991 ;; . Optimizations...
997 ;; Thanks to all who emailed comments.
1000 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1007 (and (string< ps-print-version "5.2.3")
1008 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1011 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1015 ;;; Interface to the command system
1017 (defgroup postscript nil
1023 (defgroup ebnf2ps nil
1024 "Translate an EBNF to a syntatic chart on PostScript"
1030 (defgroup ebnf-special nil
1031 "Special customization"
1037 (defgroup ebnf-except nil
1038 "Except customization"
1044 (defgroup ebnf-repeat nil
1045 "Repeat customization"
1051 (defgroup ebnf-terminal nil
1052 "Terminal customization"
1058 (defgroup ebnf-non-terminal nil
1059 "Non-Terminal customization"
1065 (defgroup ebnf-production nil
1066 "Production customization"
1072 (defgroup ebnf-shape nil
1073 "Shapes customization"
1079 (defgroup ebnf-displacement nil
1080 "Displacement customization"
1086 (defgroup ebnf-syntatic nil
1087 "Syntatic customization"
1093 (defgroup ebnf-optimization nil
1094 "Optimization customization"
1100 (defcustom ebnf-horizontal-orientation nil
1101 "*Non-nil means productions are drawn horizontally."
1103 :group 'ebnf-displacement)
1106 (defcustom ebnf-horizontal-max-height nil
1107 "*Non-nil means to use maximum production height in horizontal orientation.
1109 It is only used when `ebnf-horizontal-orientation' is non-nil."
1111 :group 'ebnf-displacement)
1114 (defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
1115 "*Specify horizontal space in points between productions.
1117 Value less or equal to zero forces ebnf2ps to set a proper default value."
1119 :group 'ebnf-displacement)
1122 (defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
1123 "*Specify vertical space in points between productions.
1125 Value less or equal to zero forces ebnf2ps to set a proper default value."
1127 :group 'ebnf-displacement)
1130 (defcustom ebnf-justify-sequence 'center
1131 "*Specify justification of terms in a sequence inside alternatives.
1135 `left' left justification
1136 `right' right justification
1137 any other value centralize"
1138 :type '(radio :tag "Sequence Justification"
1139 (const left) (const right) (other :tag "center" center))
1140 :group 'ebnf-displacement)
1143 (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
1144 "*Specify special font.
1146 See documentation for `ebnf-production-font'."
1147 :type '(list :tag "Special Font"
1148 (number :tag "Font Size")
1149 (symbol :tag "Font Name")
1150 (choice :tag "Foreground Color"
1151 (string :tag "Name")
1152 (other :tag "Default" nil))
1153 (choice :tag "Background Color"
1154 (string :tag "Name")
1155 (other :tag "Default" nil))
1156 (repeat :tag "Font Attributes" :inline t
1157 (choice (const bold) (const italic)
1158 (const underline) (const strikeout)
1159 (const overline) (const shadow)
1160 (const box) (const outline))))
1161 :group 'ebnf-special)
1164 (defcustom ebnf-special-shape 'bevel
1165 "*Specify special box shape.
1167 See documentation for `ebnf-non-terminal-shape'."
1168 :type '(radio :tag "Special Shape"
1169 (const miter) (const round) (const bevel))
1170 :group 'ebnf-special)
1173 (defcustom ebnf-special-shadow nil
1174 "*Non-nil means special box will have a shadow."
1176 :group 'ebnf-special)
1179 (defcustom ebnf-special-border-width 0.5
1180 "*Specify border width for special box."
1182 :group 'ebnf-special)
1185 (defcustom ebnf-special-border-color "Black"
1186 "*Specify border color for special box."
1188 :group 'ebnf-special)
1191 (defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
1192 "*Specify except font.
1194 See documentation for `ebnf-production-font'."
1195 :type '(list :tag "Except Font"
1196 (number :tag "Font Size")
1197 (symbol :tag "Font Name")
1198 (choice :tag "Foreground Color"
1199 (string :tag "Name")
1200 (other :tag "Default" nil))
1201 (choice :tag "Background Color"
1202 (string :tag "Name")
1203 (other :tag "Default" nil))
1204 (repeat :tag "Font Attributes" :inline t
1205 (choice (const bold) (const italic)
1206 (const underline) (const strikeout)
1207 (const overline) (const shadow)
1208 (const box) (const outline))))
1209 :group 'ebnf-except)
1212 (defcustom ebnf-except-shape 'bevel
1213 "*Specify except box shape.
1215 See documentation for `ebnf-non-terminal-shape'."
1216 :type '(radio :tag "Except Shape"
1217 (const miter) (const round) (const bevel))
1218 :group 'ebnf-except)
1221 (defcustom ebnf-except-shadow nil
1222 "*Non-nil means except box will have a shadow."
1224 :group 'ebnf-except)
1227 (defcustom ebnf-except-border-width 0.25
1228 "*Specify border width for except box."
1230 :group 'ebnf-except)
1233 (defcustom ebnf-except-border-color "Black"
1234 "*Specify border color for except box."
1236 :group 'ebnf-except)
1239 (defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
1240 "*Specify repeat font.
1242 See documentation for `ebnf-production-font'."
1243 :type '(list :tag "Repeat Font"
1244 (number :tag "Font Size")
1245 (symbol :tag "Font Name")
1246 (choice :tag "Foreground Color"
1247 (string :tag "Name")
1248 (other :tag "Default" nil))
1249 (choice :tag "Background Color"
1250 (string :tag "Name")
1251 (other :tag "Default" nil))
1252 (repeat :tag "Font Attributes" :inline t
1253 (choice (const bold) (const italic)
1254 (const underline) (const strikeout)
1255 (const overline) (const shadow)
1256 (const box) (const outline))))
1257 :group 'ebnf-repeat)
1260 (defcustom ebnf-repeat-shape 'bevel
1261 "*Specify repeat box shape.
1263 See documentation for `ebnf-non-terminal-shape'."
1264 :type '(radio :tag "Repeat Shape"
1265 (const miter) (const round) (const bevel))
1266 :group 'ebnf-repeat)
1269 (defcustom ebnf-repeat-shadow nil
1270 "*Non-nil means repeat box will have a shadow."
1272 :group 'ebnf-repeat)
1275 (defcustom ebnf-repeat-border-width 0.0
1276 "*Specify border width for repeat box."
1278 :group 'ebnf-repeat)
1281 (defcustom ebnf-repeat-border-color "Black"
1282 "*Specify border color for repeat box."
1284 :group 'ebnf-repeat)
1287 (defcustom ebnf-terminal-font '(7 Courier "Black" "White")
1288 "*Specify terminal font.
1290 See documentation for `ebnf-production-font'."
1291 :type '(list :tag "Terminal Font"
1292 (number :tag "Font Size")
1293 (symbol :tag "Font Name")
1294 (choice :tag "Foreground Color"
1295 (string :tag "Name")
1296 (other :tag "Default" nil))
1297 (choice :tag "Background Color"
1298 (string :tag "Name")
1299 (other :tag "Default" nil))
1300 (repeat :tag "Font Attributes" :inline t
1301 (choice (const bold) (const italic)
1302 (const underline) (const strikeout)
1303 (const overline) (const shadow)
1304 (const box) (const outline))))
1305 :group 'ebnf-terminal)
1308 (defcustom ebnf-terminal-shape 'miter
1309 "*Specify terminal box shape.
1311 See documentation for `ebnf-non-terminal-shape'."
1312 :type '(radio :tag "Terminal Shape"
1313 (const miter) (const round) (const bevel))
1314 :group 'ebnf-terminal)
1317 (defcustom ebnf-terminal-shadow nil
1318 "*Non-nil means terminal box will have a shadow."
1320 :group 'ebnf-terminal)
1323 (defcustom ebnf-terminal-border-width 1.0
1324 "*Specify border width for terminal box."
1326 :group 'ebnf-terminal)
1329 (defcustom ebnf-terminal-border-color "Black"
1330 "*Specify border color for terminal box."
1332 :group 'ebnf-terminal)
1335 (defcustom ebnf-sort-production nil
1336 "*Specify how productions are sorted.
1340 nil don't sort productions.
1341 `ascending' ascending sort.
1342 any other value descending sort."
1343 :type '(radio :tag "Production Sort"
1344 (const :tag "Ascending" ascending)
1345 (const :tag "Descending" descending)
1346 (other :tag "No Sort" nil))
1347 :group 'ebnf-production)
1350 (defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
1351 "*Specify production header font.
1353 It is a list with the following form:
1355 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1358 SIZE is the font size.
1359 NAME is the font name symbol.
1360 ATTRIBUTE is one of the following symbols:
1361 bold - use bold font.
1362 italic - use italic font.
1363 underline - put a line under text.
1364 strikeout - like underline, but the line is in middle of text.
1365 overline - like underline, but the line is over the text.
1366 shadow - text will have a shadow.
1367 box - text will be surrounded by a box.
1368 outline - print characters as hollow outlines.
1369 FOREGROUND is a foreground string color name; if it's nil, the default color is
1371 BACKGROUND is a background string color name; if it's nil, the default color is
1374 See `ps-font-info-database' for valid font name."
1375 :type '(list :tag "Production Font"
1376 (number :tag "Font Size")
1377 (symbol :tag "Font Name")
1378 (choice :tag "Foreground Color"
1379 (string :tag "Name")
1380 (other :tag "Default" nil))
1381 (choice :tag "Background Color"
1382 (string :tag "Name")
1383 (other :tag "Default" nil))
1384 (repeat :tag "Font Attributes" :inline t
1385 (choice (const bold) (const italic)
1386 (const underline) (const strikeout)
1387 (const overline) (const shadow)
1388 (const box) (const outline))))
1389 :group 'ebnf-production)
1392 (defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
1393 "*Specify non-terminal font.
1395 See documentation for `ebnf-production-font'."
1396 :type '(list :tag "Non-Terminal Font"
1397 (number :tag "Font Size")
1398 (symbol :tag "Font Name")
1399 (choice :tag "Foreground Color"
1400 (string :tag "Name")
1401 (other :tag "Default" nil))
1402 (choice :tag "Background Color"
1403 (string :tag "Name")
1404 (other :tag "Default" nil))
1405 (repeat :tag "Font Attributes" :inline t
1406 (choice (const bold) (const italic)
1407 (const underline) (const strikeout)
1408 (const overline) (const shadow)
1409 (const box) (const outline))))
1410 :group 'ebnf-non-terminal)
1413 (defcustom ebnf-non-terminal-shape 'round
1414 "*Specify non-terminal box shape.
1430 Any other value is treated as `miter'."
1431 :type '(radio :tag "Non-Terminal Shape"
1432 (const miter) (const round) (const bevel))
1433 :group 'ebnf-non-terminal)
1436 (defcustom ebnf-non-terminal-shadow nil
1437 "*Non-nil means non-terminal box will have a shadow."
1439 :group 'ebnf-non-terminal)
1442 (defcustom ebnf-non-terminal-border-width 1.0
1443 "*Specify border width for non-terminal box."
1445 :group 'ebnf-non-terminal)
1448 (defcustom ebnf-non-terminal-border-color "Black"
1449 "*Specify border color for non-terminal box."
1451 :group 'ebnf-non-terminal)
1454 (defcustom ebnf-arrow-shape 'hollow
1455 "*Specify the arrow shape.
1461 `semi-up' * `transparent' *
1469 `semi-down' =====* `hollow' *
1485 `user' See also documentation for variable `ebnf-user-arrow'.
1487 Any other value is treated as `none'."
1488 :type '(radio :tag "Arrow Shape"
1489 (const none) (const semi-up)
1490 (const semi-down) (const simple)
1491 (const transparent) (const hollow)
1492 (const full) (const user))
1496 (defcustom ebnf-chart-shape 'round
1497 "*Specify chart flow shape.
1499 See documentation for `ebnf-non-terminal-shape'."
1500 :type '(radio :tag "Chart Flow Shape"
1501 (const miter) (const round) (const bevel))
1505 (defcustom ebnf-user-arrow nil
1506 "*Specify a user arrow shape (a PostScript code).
1508 PostScript code should draw a right arrow.
1510 The anatomy of a right arrow is:
1512 ...... Initial position
1514 : *.................
1518 ======+======*... } hT2
1522 : *.................
1528 :.......................
1530 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1531 be used to generate your own arrow. As these variables are used along
1532 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1533 values, if you need to modify them.
1535 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1537 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1540 See function `ebnf-user-arrow' for valid values and how values are processed."
1541 :type '(radio :tag "User Arrow Shape"
1552 (defcustom ebnf-syntax 'ebnf
1553 "*Specify syntax to be recognized.
1557 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1559 The following variables *ONLY* have effect with this
1561 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1562 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1564 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1565 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1566 (\"International Standard of the ISO EBNF Notation\").
1567 The following variables *ONLY* have effect with this
1569 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1571 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1572 The following variable *ONLY* has effect with this
1574 `ebnf-yac-ignore-error-recovery'.
1576 Any other value is treated as `ebnf'."
1577 :type '(radio :tag "Syntax"
1578 (const ebnf) (const iso-ebnf) (const yacc))
1579 :group 'ebnf-syntatic)
1582 (defcustom ebnf-lex-comment-char ?\;
1583 "*Specify the line comment character.
1585 It's used only when `ebnf-syntax' is `ebnf'."
1587 :group 'ebnf-syntatic)
1590 (defcustom ebnf-lex-eop-char ?.
1591 "*Specify the end of production character.
1593 It's used only when `ebnf-syntax' is `ebnf'."
1595 :group 'ebnf-syntatic)
1598 (defcustom ebnf-terminal-regexp nil
1599 "*Specify how it's a terminal name.
1601 If it's nil, the terminal name must be enclosed by `\"'.
1602 If it's a string, it should be a regexp that it'll be used to determine a
1603 terminal name; terminal name may also be enclosed by `\"'.
1605 It's used only when `ebnf-syntax' is `ebnf'."
1606 :type '(radio :tag "Terminal Name"
1608 :group 'ebnf-syntatic)
1611 (defcustom ebnf-case-fold-search nil
1612 "*Non-nil means ignore case on matching.
1614 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1617 :group 'ebnf-syntatic)
1620 (defcustom ebnf-iso-alternative-p nil
1621 "*Non-nil means use alternative ISO EBNF.
1623 It's only used when `ebnf-syntax' is `iso-ebnf'.
1625 This variable affects the following symbol set:
1627 STANDARD ALTERNATIVE
1635 :group 'ebnf-syntatic)
1638 (defcustom ebnf-iso-normalize-p nil
1639 "*Non-nil means normalize ISO EBNF syntax names.
1641 Normalize a name means that several contiguous spaces inside name become a
1642 single space, so \"A B C\" is normalized to \"A B C\".
1644 It's only used when `ebnf-syntax' is `iso-ebnf'."
1646 :group 'ebnf-syntatic)
1649 (defcustom ebnf-eps-prefix "ebnf--"
1650 "*Specify EPS prefix file name.
1652 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1657 (defcustom ebnf-entry-percentage 0.5 ; middle
1658 "*Specify entry height on alternatives.
1660 It must be a float between 0.0 (top) and 1.0 (bottom)."
1665 (defcustom ebnf-default-width 0.6
1666 "*Specify additional border width over default terminal, non-terminal or
1672 ;; Printing color requires x-color-values.
1673 (defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
1674 (fboundp 'color-instance-rgb-components)) ; XEmacs
1675 "*Non-nil means use color."
1680 (defcustom ebnf-line-width 1.0
1681 "*Specify flow line width."
1686 (defcustom ebnf-line-color "Black"
1687 "*Specify flow line color."
1692 (defcustom ebnf-debug-ps nil
1693 "*Non-nil means to generate PostScript debug procedures.
1695 It is intended to help PostScript programmers in debugging."
1700 (defcustom ebnf-use-float-format t
1701 "*Non-nil means use `%f' float format.
1703 The advantage of using float format is that ebnf2ps generates a little short
1706 If it occurs the error message:
1708 Invalid format operation %f
1710 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1715 (defcustom ebnf-yac-ignore-error-recovery nil
1716 "*Non-nil means ignore error recovery.
1718 It's only used when `ebnf-syntax' is `yacc'."
1720 :group 'ebnf-syntatic)
1723 (defcustom ebnf-ignore-empty-rule nil
1724 "*Non-nil means ignore empty rules.
1726 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1727 middle action rule."
1729 :group 'ebnf-optimization)
1732 (defcustom ebnf-optimize nil
1733 "*Non-nil means optimize syntatic chart of rules.
1735 The following optimizations are done:
1738 1. A = B | A C. ==> A = B {C}*.
1739 2. A = B | A B. ==> A = {B}+.
1740 3. A = | A B. ==> A = {B}*.
1741 4. A = B | A C B. ==> A = {B || C}+.
1742 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
1745 6. A = B | . ==> A = [B].
1746 7. A = | B . ==> A = [B].
1749 8. A = B C | B D. ==> A = B (C | D).
1750 9. A = C B | D B. ==> A = (C | D) B.
1751 10. A = B C E | B D E. ==> A = B (C | D) E.
1753 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
1755 :group 'ebnf-optimization)
1758 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1763 (defun ebnf-customize ()
1764 "Customization for ebnf group."
1766 (customize-group 'ebnf2ps))
1769 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1774 (defun ebnf-print-buffer (&optional filename)
1775 "Generate and print a PostScript syntatic chart image of the buffer.
1777 When called with a numeric prefix argument (C-u), prompts the user for
1778 the name of a file to save the PostScript image in, instead of sending
1781 More specifically, the FILENAME argument is treated as follows: if it
1782 is nil, send the image to the printer. If FILENAME is a string, save
1783 the PostScript image in a file with that name. If FILENAME is a
1784 number, prompt the user for the name of the file to save in."
1785 (interactive (list (ps-print-preprint current-prefix-arg)))
1786 (ebnf-print-region (point-min) (point-max) filename))
1790 (defun ebnf-print-region (from to &optional filename)
1791 "Generate and print a PostScript syntatic chart image of the region.
1792 Like `ebnf-print-buffer', but prints just the current region."
1793 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
1794 (run-hooks 'ebnf-hook)
1795 (or (ebnf-spool-region from to)
1796 (ps-do-despool filename)))
1800 (defun ebnf-spool-buffer ()
1801 "Generate and spool a PostScript syntatic chart image of the buffer.
1802 Like `ebnf-print-buffer' except that the PostScript image is saved in a
1803 local buffer to be sent to the printer later.
1805 Use the command `ebnf-despool' to send the spooled images to the printer."
1807 (ebnf-spool-region (point-min) (point-max)))
1811 (defun ebnf-spool-region (from to)
1812 "Generate a PostScript syntatic chart image of the region and spool locally.
1813 Like `ebnf-spool-buffer', but spools just the current region.
1815 Use the command `ebnf-despool' to send the spooled images to the printer."
1817 (ebnf-generate-region from to 'ebnf-generate))
1821 (defun ebnf-eps-buffer ()
1822 "Generate a PostScript syntatic chart image of the buffer in a EPS file.
1824 Indeed, for each production is generated a EPS file.
1825 The EPS file name has the following form:
1827 <PREFIX><PRODUCTION>.eps
1829 <PREFIX> is given by variable `ebnf-eps-prefix'.
1830 The default value is \"ebnf--\".
1832 <PRODUCTION> is the production name.
1833 The production name is mapped to form a valid file name.
1834 For example, the production name \"A/B + C\" is mapped to
1835 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
1837 WARNING: It's *NOT* asked any confirmation to override an existing file."
1839 (ebnf-eps-region (point-min) (point-max)))
1843 (defun ebnf-eps-region (from to)
1844 "Generate a PostScript syntatic chart image of the region in a EPS file.
1846 Indeed, for each production is generated a EPS file.
1847 The EPS file name has the following form:
1849 <PREFIX><PRODUCTION>.eps
1851 <PREFIX> is given by variable `ebnf-eps-prefix'.
1852 The default value is \"ebnf--\".
1854 <PRODUCTION> is the production name.
1855 The production name is mapped to form a valid file name.
1856 For example, the production name \"A/B + C\" is mapped to
1857 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
1859 WARNING: It's *NOT* asked any confirmation to override an existing file."
1861 (let ((ebnf-eps-executing t))
1862 (ebnf-generate-region from to 'ebnf-generate-eps)))
1866 (defalias 'ebnf-despool 'ps-despool)
1870 (defun ebnf-syntax-buffer ()
1871 "Does a syntatic analysis of the current buffer."
1873 (ebnf-syntax-region (point-min) (point-max)))
1877 (defun ebnf-syntax-region (from to)
1878 "Does a syntatic analysis of a region."
1880 (ebnf-generate-region from to nil))
1883 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1888 (defun ebnf-setup ()
1889 "Return the current ebnf2ps setup."
1892 \(setq ebnf-special-font %s
1893 ebnf-special-shape %s
1894 ebnf-special-shadow %S
1895 ebnf-special-border-width %S
1896 ebnf-special-border-color %S
1898 ebnf-except-shape %s
1899 ebnf-except-shadow %S
1900 ebnf-except-border-width %S
1901 ebnf-except-border-color %S
1903 ebnf-repeat-shape %s
1904 ebnf-repeat-shadow %S
1905 ebnf-repeat-border-width %S
1906 ebnf-repeat-border-color %S
1907 ebnf-terminal-regexp %S
1908 ebnf-case-fold-search %S
1909 ebnf-terminal-font %s
1910 ebnf-terminal-shape %s
1911 ebnf-terminal-shadow %S
1912 ebnf-terminal-border-width %S
1913 ebnf-terminal-border-color %S
1914 ebnf-non-terminal-font %s
1915 ebnf-non-terminal-shape %s
1916 ebnf-non-terminal-shadow %S
1917 ebnf-non-terminal-border-width %S
1918 ebnf-non-terminal-border-color %S
1919 ebnf-sort-production %s
1920 ebnf-production-font %s
1924 ebnf-horizontal-orientation %S
1925 ebnf-horizontal-max-height %S
1926 ebnf-production-horizontal-space %S
1927 ebnf-production-vertical-space %S
1928 ebnf-justify-sequence %s
1929 ebnf-lex-comment-char ?\\%03o
1930 ebnf-lex-eop-char ?\\%03o
1932 ebnf-iso-alternative-p %S
1933 ebnf-iso-normalize-p %S
1935 ebnf-entry-percentage %S
1940 ebnf-use-float-format %S
1941 ebnf-yac-ignore-error-recovery %S
1942 ebnf-ignore-empty-rule %S
1945 (ps-print-quote ebnf-special-font)
1946 (ps-print-quote ebnf-special-shape)
1948 ebnf-special-border-width
1949 ebnf-special-border-color
1950 (ps-print-quote ebnf-except-font)
1951 (ps-print-quote ebnf-except-shape)
1953 ebnf-except-border-width
1954 ebnf-except-border-color
1955 (ps-print-quote ebnf-repeat-font)
1956 (ps-print-quote ebnf-repeat-shape)
1958 ebnf-repeat-border-width
1959 ebnf-repeat-border-color
1960 ebnf-terminal-regexp
1961 ebnf-case-fold-search
1962 (ps-print-quote ebnf-terminal-font)
1963 (ps-print-quote ebnf-terminal-shape)
1964 ebnf-terminal-shadow
1965 ebnf-terminal-border-width
1966 ebnf-terminal-border-color
1967 (ps-print-quote ebnf-non-terminal-font)
1968 (ps-print-quote ebnf-non-terminal-shape)
1969 ebnf-non-terminal-shadow
1970 ebnf-non-terminal-border-width
1971 ebnf-non-terminal-border-color
1972 (ps-print-quote ebnf-sort-production)
1973 (ps-print-quote ebnf-production-font)
1974 (ps-print-quote ebnf-arrow-shape)
1975 (ps-print-quote ebnf-chart-shape)
1976 (ps-print-quote ebnf-user-arrow)
1977 ebnf-horizontal-orientation
1978 ebnf-horizontal-max-height
1979 ebnf-production-horizontal-space
1980 ebnf-production-vertical-space
1981 (ps-print-quote ebnf-justify-sequence)
1982 ebnf-lex-comment-char
1984 (ps-print-quote ebnf-syntax)
1985 ebnf-iso-alternative-p
1986 ebnf-iso-normalize-p
1988 ebnf-entry-percentage
1993 ebnf-use-float-format
1994 ebnf-yac-ignore-error-recovery
1995 ebnf-ignore-empty-rule
1999 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2003 (defvar ebnf-stack-style nil
2004 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2008 (defvar ebnf-current-style 'default
2009 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2012 (defconst ebnf-style-custom-list
2016 ebnf-special-border-width
2017 ebnf-special-border-color
2021 ebnf-except-border-width
2022 ebnf-except-border-color
2026 ebnf-repeat-border-width
2027 ebnf-repeat-border-color
2028 ebnf-terminal-regexp
2029 ebnf-case-fold-search
2032 ebnf-terminal-shadow
2033 ebnf-terminal-border-width
2034 ebnf-terminal-border-color
2035 ebnf-non-terminal-font
2036 ebnf-non-terminal-shape
2037 ebnf-non-terminal-shadow
2038 ebnf-non-terminal-border-width
2039 ebnf-non-terminal-border-color
2040 ebnf-sort-production
2041 ebnf-production-font
2045 ebnf-horizontal-orientation
2046 ebnf-horizontal-max-height
2047 ebnf-production-horizontal-space
2048 ebnf-production-vertical-space
2049 ebnf-justify-sequence
2050 ebnf-lex-comment-char
2053 ebnf-iso-alternative-p
2054 ebnf-iso-normalize-p
2056 ebnf-entry-percentage
2061 ebnf-use-float-format
2062 ebnf-yac-ignore-error-recovery
2063 ebnf-ignore-empty-rule
2065 "List of valid symbol custom variable.")
2068 (defvar ebnf-style-database
2072 (ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic))
2073 (ebnf-special-shape . 'bevel)
2074 (ebnf-special-shadow . nil)
2075 (ebnf-special-border-width . 0.5)
2076 (ebnf-special-border-color . "Black")
2077 (ebnf-except-font . '(7 Courier "Black" "Gray90" bold italic))
2078 (ebnf-except-shape . 'bevel)
2079 (ebnf-except-shadow . nil)
2080 (ebnf-except-border-width . 0.25)
2081 (ebnf-except-border-color . "Black")
2082 (ebnf-repeat-font . '(7 Courier "Black" "Gray85" bold italic))
2083 (ebnf-repeat-shape . 'bevel)
2084 (ebnf-repeat-shadow . nil)
2085 (ebnf-repeat-border-width . 0.0)
2086 (ebnf-repeat-border-color . "Black")
2087 (ebnf-terminal-regexp . nil)
2088 (ebnf-case-fold-search . nil)
2089 (ebnf-terminal-font . '(7 Courier "Black" "White"))
2090 (ebnf-terminal-shape . 'miter)
2091 (ebnf-terminal-shadow . nil)
2092 (ebnf-terminal-border-width . 1.0)
2093 (ebnf-terminal-border-color . "Black")
2094 (ebnf-non-terminal-font . '(7 Helvetica "Black" "White"))
2095 (ebnf-non-terminal-shape . 'round)
2096 (ebnf-non-terminal-shadow . nil)
2097 (ebnf-non-terminal-border-width . 1.0)
2098 (ebnf-non-terminal-border-color . "Black")
2099 (ebnf-sort-production . nil)
2100 (ebnf-production-font . '(10 Helvetica "Black" "White" bold))
2101 (ebnf-arrow-shape . 'hollow)
2102 (ebnf-chart-shape . 'round)
2103 (ebnf-user-arrow . nil)
2104 (ebnf-horizontal-orientation . nil)
2105 (ebnf-horizontal-max-height . nil)
2106 (ebnf-production-horizontal-space . 0.0)
2107 (ebnf-production-vertical-space . 0.0)
2108 (ebnf-justify-sequence . 'center)
2109 (ebnf-lex-comment-char . ?\;)
2110 (ebnf-lex-eop-char . ?.)
2111 (ebnf-syntax . 'ebnf)
2112 (ebnf-iso-alternative-p . nil)
2113 (ebnf-iso-normalize-p . nil)
2114 (ebnf-eps-prefix . "ebnf--")
2115 (ebnf-entry-percentage . 0.5)
2116 (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
2117 (fboundp 'color-instance-rgb-components))) ; XEmacs
2118 (ebnf-line-width . 1.0)
2119 (ebnf-line-color . "Black")
2120 (ebnf-debug-ps . nil)
2121 (ebnf-use-float-format . t)
2122 (ebnf-yac-ignore-error-recovery . nil)
2123 (ebnf-ignore-empty-rule . nil)
2124 (ebnf-optimize . nil))
2125 ;; Happy EBNF default
2128 (ebnf-justify-sequence . 'left)
2129 (ebnf-lex-comment-char . ?\#)
2130 (ebnf-lex-eop-char . ?\;))
2134 (ebnf-syntax . 'iso-ebnf))
2135 ;; Yacc/Bison default
2138 (ebnf-syntax . 'yacc))
2142 Each element has the following form:
2144 (CUSTOM INHERITS (VAR . VALUE)...)
2146 CUSTOM is a symbol name style.
2147 INHERITS is a symbol name style from which the current style inherits the
2148 context. If INHERITS is nil, means that there is no inheritance.
2149 VAR is a valid ebnf2ps symbol custom variable. See `ebnf-style-custom-list'
2150 for valid symbol variable.
2151 VALUE is a sexp which it'll be evaluated to set the value to VAR. So, don't
2152 forget to quote symbols and constant lists. See `default' style for an
2155 Don't handle this variable directly. Use functions `ebnf-insert-style' and
2156 `ebnf-merge-style'.")
2159 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2164 (defun ebnf-insert-style (name inherits &rest values)
2165 "Insert a new style NAME with inheritance INHERITS and values VALUES."
2167 (and (assoc name ebnf-style-database)
2168 (error "Style name already exists: %s" name))
2169 (or (assoc inherits ebnf-style-database)
2170 (error "Style inheritance name does'nt exist: %s" inherits))
2171 (setq ebnf-style-database
2172 (cons (cons name (cons inherits (ebnf-check-style-values values)))
2173 ebnf-style-database)))
2177 (defun ebnf-merge-style (name &rest values)
2178 "Merge values of style NAME with style VALUES."
2180 (let ((style (or (assoc name ebnf-style-database)
2181 (error "Style name does'nt exist: %s" name)))
2182 (merge (ebnf-check-style-values values))
2184 ;; modify value of existing variables
2185 (setq val (nthcdr 2 style))
2187 (setq check (car merge)
2189 elt (assoc (car check) val))
2191 (setcdr elt (cdr check))
2192 (setq new (cons check new))))
2193 ;; insert new variables
2194 (nconc style (nreverse new))))
2198 (defun ebnf-apply-style (style)
2199 "Set STYLE to current style.
2201 It returns the old style symbol."
2205 (and (ebnf-apply-style1 style)
2206 (setq ebnf-current-style style))))
2210 (defun ebnf-reset-style (&optional style)
2211 "Reset current style.
2213 It returns the old style symbol."
2215 (setq ebnf-stack-style nil)
2216 (ebnf-apply-style (or style 'default)))
2220 (defun ebnf-push-style (&optional style)
2221 "Push the current style and set STYLE to current style.
2223 It returns the old style symbol."
2227 (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
2229 (ebnf-apply-style style))))
2233 (defun ebnf-pop-style ()
2234 "Pop a style and set it to current style.
2236 It returns the old style symbol."
2239 (ebnf-apply-style (car ebnf-stack-style))
2240 (setq ebnf-stack-style (cdr ebnf-stack-style))))
2243 (defun ebnf-apply-style1 (style)
2244 (let ((value (cdr (assoc style ebnf-style-database))))
2247 (and (car value) (ebnf-apply-style1 (car value)))
2248 (while (setq value (cdr value))
2249 (set (caar value) (eval (cdar value)))))))
2252 (defun ebnf-check-style-values (values)
2255 (and (memq (car values) ebnf-style-custom-list)
2256 (setq style (cons (car values) style)))
2257 (setq values (cdr values)))
2261 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2262 ;; Internal variables
2265 (make-local-hook 'ebnf-hook)
2266 (make-local-hook 'ebnf-production-hook)
2267 (make-local-hook 'ebnf-page-hook)
2270 (defvar ebnf-eps-buffer-name " *EPS*")
2271 (defvar ebnf-parser-func nil)
2272 (defvar ebnf-eps-executing nil)
2273 (defvar ebnf-eps-upper-x 0.0)
2274 (make-variable-buffer-local 'ebnf-eps-upper-x)
2275 (defvar ebnf-eps-upper-y 0.0)
2276 (make-variable-buffer-local 'ebnf-eps-upper-y)
2277 (defvar ebnf-eps-prod-width 0.0)
2278 (make-variable-buffer-local 'ebnf-eps-prod-width)
2279 (defvar ebnf-eps-max-height 0.0)
2280 (make-variable-buffer-local 'ebnf-eps-max-height)
2281 (defvar ebnf-eps-max-width 0.0)
2282 (make-variable-buffer-local 'ebnf-eps-max-width)
2285 (defvar ebnf-eps-context nil
2286 "List of EPS file name during parsing.
2288 See section \"Actions in Comments\" in ebnf2ps documentation.")
2291 (defvar ebnf-eps-production-list nil
2292 "Alist associating production name with EPS file name list.
2294 Each element has the following form:
2296 (PRODUCTION EPS-FILENAME...)
2298 PRODUCTION is the production name.
2299 EPS-FILENAME is the EPS file name.
2301 It's generated during parsing and used during EPS generation.
2303 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2307 (defconst ebnf-arrow-shape-alist
2316 "Alist associating values for `ebnf-arrow-shape'.
2318 See documentation for `ebnf-arrow-shape'.")
2321 (defconst ebnf-terminal-shape-alist
2325 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2327 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2328 `ebnf-chart-shape'.")
2331 (defvar ebnf-limit nil)
2332 (defvar ebnf-action nil)
2333 (defvar ebnf-action-list nil)
2336 (defvar ebnf-default-p nil)
2339 (defvar ebnf-font-height-P 0)
2340 (defvar ebnf-font-height-T 0)
2341 (defvar ebnf-font-height-NT 0)
2342 (defvar ebnf-font-height-S 0)
2343 (defvar ebnf-font-height-E 0)
2344 (defvar ebnf-font-height-R 0)
2345 (defvar ebnf-font-width-P 0)
2346 (defvar ebnf-font-width-T 0)
2347 (defvar ebnf-font-width-NT 0)
2348 (defvar ebnf-font-width-S 0)
2349 (defvar ebnf-font-width-E 0)
2350 (defvar ebnf-font-width-R 0)
2351 (defvar ebnf-space-T 0)
2352 (defvar ebnf-space-NT 0)
2353 (defvar ebnf-space-S 0)
2354 (defvar ebnf-space-E 0)
2355 (defvar ebnf-space-R 0)
2358 (defvar ebnf-basic-width 0)
2359 (defvar ebnf-basic-height 0)
2360 (defvar ebnf-vertical-space 0)
2361 (defvar ebnf-horizontal-space 0)
2364 (defvar ebnf-settings nil)
2365 (defvar ebnf-fonts-required nil)
2368 (defconst ebnf-debug
2370 % === begin EBNF procedures to help debugging
2372 % Mark visually current point: string debug
2376 gsave -s- show grestore
2388 % Show number value: number string debug-number
2391 20 0 rmoveto show ([) show 60 string cvs show (]) show
2395 % === end EBNF procedures to help debugging
2398 "This is intended to help debugging PostScript programming.")
2401 (defconst ebnf-prologue
2403 % === begin EBNF engine
2405 % --- Basic Definitions
2408 /SpaceS FontHeight 0.5 mul def
2409 /HeightS FontHeight FontHeight add def
2412 /SpaceE FontHeight 0.5 mul def
2413 /HeightE FontHeight FontHeight add def
2416 /SpaceR FontHeight 0.5 mul def
2417 /HeightR FontHeight FontHeight add def
2420 /SpaceT FontHeight 0.5 mul def
2421 /HeightT FontHeight FontHeight add def
2424 /SpaceNT FontHeight 0.5 mul def
2425 /HeightNT FontHeight FontHeight add def
2427 /T HeightT HeightNT add 0.5 mul def
2430 /hT4 hT 0.25 mul def
2432 /Er 0.1 def % Error factor
2435 /c{currentpoint}bind def
2436 /xyi{/xi c /yi exch def def}bind def
2437 /xyo{/xo c /yo exch def def}bind def
2438 /xyp{/xp c /yp exch def def}bind def
2439 /xyt{/xt c /yt exch def def}bind def
2441 % vertical movement: x y height vm
2442 /vm{add moveto}bind def
2444 % horizontal movement: x y width hm
2445 /hm{3 -1 roll exch add exch moveto}bind def
2447 % set color: [R G B] SetRGB
2448 /SetRGB{aload pop setrgbcolor}bind def
2450 % filling gray area: gray-scale FillGray
2451 /FillGray{gsave setgray fill grestore}bind def
2453 % filling color area: [R G B] FillRGB
2454 /FillRGB{gsave SetRGB fill grestore}bind def
2456 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2457 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2458 /Gstroke{gsave Stroke grestore}bind def
2460 % Empty Line: width EL
2461 /EL{0 rlineto Gstroke}bind def
2465 /Down{hT2 neg hT4 neg rlineto}bind def
2468 {hT2 neg hT4 rmoveto
2473 /ArrowPath{c newpath moveto Arrow closepath}bind def
2481 {hT2 neg hT4 rlineto} % 1 - semi-up
2482 {Down} % 2 - semi-down
2483 {Arrow} % 3 - simple
2484 {Gstroke ArrowPath} % 4 - transparent
2485 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2486 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2487 {Gstroke gsave UserArrow grestore} % 7 - user
2493 RA-vector ArrowShape get exec
2498 % rotation DrawArrow
2513 /LA{180 DrawArrow}def
2520 /UA{90 DrawArrow}def
2527 /DA{270 DrawArrow}def
2531 %>corner Right Descendent: height arrow corner_RD
2533 % / height > 0 | 0 - none
2535 % * ---------- | 2 - left
2554 h 0 gt{DA}{UA}ifelse
2559 [{cRD0-vector arrow get exec} % 0 - miter
2560 {0 0 0 h hT h rcurveto} % 1 - rounded
2561 {hT h rlineto} % 2 - bevel
2565 {/arrow exch def /h exch def
2566 cRD-vector ChartShape get exec
2570 %>corner Right Ascendent: height arrow corner_RA
2572 % | height > 0 | 0 - none
2574 % *- ---------- | 2 - left
2592 h 0 gt{DA}{UA}ifelse
2598 [{cRA0-vector arrow get exec} % 0 - miter
2599 {0 0 hT 0 hT h rcurveto} % 1 - rounded
2600 {hT h rlineto} % 2 - bevel
2604 {/arrow exch def /h exch def
2605 cRA-vector ChartShape get exec
2609 %>corner Left Descendent: height arrow corner_LD
2611 % \\ height > 0 | 0 - none
2613 % * ---------- | 2 - left
2622 {hT neg h rmoveto xyi
2630 {hT neg h rmoveto xyi
2632 h 0 gt{DA}{UA}ifelse
2637 [{cLD0-vector arrow get exec} % 0 - miter
2638 {0 0 0 h hT neg h rcurveto} % 1 - rounded
2639 {hT neg h rlineto} % 2 - bevel
2643 {/arrow exch def /h exch def
2644 cLD-vector ChartShape get exec
2648 %>corner Left Ascendent: height arrow corner_LA
2650 % | height > 0 | 0 - none
2652 % -* ---------- | 2 - left
2661 {hT neg h rmoveto xyi
2669 {hT neg h rmoveto xyi
2670 h 0 gt{DA}{UA}ifelse
2676 [{cLA0-vector arrow get exec} % 0 - miter
2677 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
2678 {hT neg h rlineto} % 2 - bevel
2682 {/arrow exch def /h exch def
2683 cLA-vector ChartShape get exec
2689 % height prepare_height |- line_height corner_height corner_height
2693 {T add hT neg}ifelse
2697 %>Left Alternative: height LAlt
2724 %>Left Loop: height LLoop
2743 %>Right Alternative: height RAlt
2757 {T neg exch rlineto}
2770 %>Right Loop: height RLoop
2789 % --- Terminal, Non-terminal and Special Basics
2791 % string width prepare-width |- string
2794 dup stringwidth pop space add space add width exch sub 0.5 mul
2798 % string width begin-right
2808 {xo width add Er add yo moveto
2813 % string width begin-left
2822 {xo width add Er add yo moveto
2835 {/half YY yy sub 0.5 mul abs def
2836 xx half add YY moveto
2837 0 0 half neg 0 half neg half neg rcurveto
2838 0 0 0 half neg half half neg rcurveto
2839 XX xx sub abs half sub half sub 0 rlineto
2840 0 0 half 0 half half rcurveto
2841 0 0 0 half half neg half rcurveto}
2843 {/quarter YY yy sub 0.25 mul abs def
2844 xx quarter add YY moveto
2845 quarter neg quarter neg rlineto
2846 0 quarter quarter add neg rlineto
2847 quarter quarter neg rlineto
2848 XX xx sub abs quarter sub quarter sub 0 rlineto
2849 quarter quarter rlineto
2850 0 quarter quarter add rlineto
2851 quarter neg quarter rlineto}
2856 ShapePath-vector shape get exec
2862 Xshadow Xshadow add Xshadow add
2863 Yshadow Yshadow add Yshadow add translate
2877 % string SBound |- string
2879 {/xx c dup /yy exch def
2880 FontHeight add /YY exch def def
2881 dup stringwidth pop xx add /XX exch def
2883 {/yy yy YShadow add def
2884 /XX XX XShadow add def
2893 /XX XX space add space add def
2894 /YY YY space add def
2895 /yy yy space sub def
2896 shadow{doShapeShadow}if
2898 space Descent abs rmoveto
2905 % TeRminal: string TR
2907 {/Effect EffectT def
2909 /shapecolor BackgroundT def
2910 /borderwidth BorderWidthT def
2911 /bordercolor BorderColorT def
2912 /foreground ForegroundT def
2917 %>Right Terminal: string width RT |- x y
2928 %>Left Terminal: string width LT |- x y
2939 %>Right Terminal Default: string width RTD |- x y
2941 {/-save- BorderWidthT def
2942 /BorderWidthT BorderWidthT DefaultWidth add def
2944 /BorderWidthT -save- def
2947 %>Left Terminal Default: string width LTD |- x y
2949 {/-save- BorderWidthT def
2950 /BorderWidthT BorderWidthT DefaultWidth add def
2952 /BorderWidthT -save- def
2957 % Non-Terminal: string NT
2959 {/Effect EffectNT def
2961 /shapecolor BackgroundNT def
2962 /borderwidth BorderWidthNT def
2963 /bordercolor BorderColorNT def
2964 /foreground ForegroundNT def
2965 /shadow ShadowNT def
2969 %>Right Non-Terminal: string width RNT |- x y
2980 %>Left Non-Terminal: string width LNT |- x y
2991 %>Right Non-Terminal Default: string width RNTD |- x y
2993 {/-save- BorderWidthNT def
2994 /BorderWidthNT BorderWidthNT DefaultWidth add def
2996 /BorderWidthNT -save- def
2999 %>Left Non-Terminal Default: string width LNTD |- x y
3001 {/-save- BorderWidthNT def
3002 /BorderWidthNT BorderWidthNT DefaultWidth add def
3004 /BorderWidthNT -save- def
3009 % SPecial: string SP
3011 {/Effect EffectS def
3013 /shapecolor BackgroundS def
3014 /borderwidth BorderWidthS def
3015 /bordercolor BorderColorS def
3016 /foreground ForegroundS def
3021 %>Right SPecial: string width RSP |- x y
3032 %>Left SPecial: string width LSP |- x y
3043 %>Right SPecial Default: string width RSPD |- x y
3045 {/-save- BorderWidthS def
3046 /BorderWidthS BorderWidthS DefaultWidth add def
3048 /BorderWidthS -save- def
3051 %>Left SPecial Default: string width LSPD |- x y
3053 {/-save- BorderWidthS def
3054 /BorderWidthS BorderWidthS DefaultWidth add def
3056 /BorderWidthS -save- def
3059 % --- Repeat and Except basics
3062 {/w width rwidth sub 0.5 mul def
3067 /xx c entry add /YY exch def def
3068 /yy YY height sub def
3069 /XX xx rwidth add def
3070 shadow{doShapeShadow}if
3093 % entry height width rwidth begin-repeat
3103 /shapecolor BackgroundR def
3104 /borderwidth BorderWidthR def
3105 /bordercolor BorderColorR def
3106 /foreground ForegroundR def
3111 % string end-repeat |- x y
3114 space Descent rmoveto
3118 exch space add exch moveto
3122 %>Right RePeat: string entry height width rwidth RRP |- x y
3123 /RRP{begin-repeat right-direction end-repeat}def
3125 %>Left RePeat: string entry height width rwidth LRP |- x y
3126 /LRP{begin-repeat left-direction end-repeat}def
3130 % entry height width rwidth begin-except
3140 /shapecolor BackgroundE def
3141 /borderwidth BorderWidthE def
3142 /bordercolor BorderColorE def
3143 /foreground ForegroundE def
3148 % x-width end-except |- x y
3151 space space add add Descent rmoveto
3152 (-) foreground SetRGB S
3158 %>Right EXcept: x-width entry height width rwidth REX |- x y
3159 /REX{begin-except right-direction end-except}def
3161 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3162 /LEX{begin-except left-direction end-except}def
3166 %>Beginning Of Sequence: BOS |- x y
3167 /BOS{currentpoint}bind def
3169 %>End Of Sequence: x y x1 y1 EOS |- x y
3170 /EOS{pop pop}bind def
3174 %>Beginning Of Production: string width height BOP |- y x
3177 neg yp add /yw exch def
3178 xp add T sub /xw exch def
3180 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3190 %>End Of Production: y x delta EOP
3191 /EOPH{add exch moveto}bind def % horizontal
3192 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3194 % --- Empty Alternative
3196 %>Empty Alternative: width EA |- x y
3207 %>AlTernative: h1 h2 ... hn n width AT |- x y
3209 {xyo xo add /xw exch def
3221 %>OPtional: height width OP |- x y
3238 %>One or More: height width OM |- x y
3252 %>Zero or More: h2 h1 width ZM |- x y
3262 yo add xo T add exch moveto
3266 % === end EBNF engine
3269 "EBNF PostScript prologue")
3272 (defconst ebnf-eps-prologue
3274 /#ebnf2ps#dict 230 dict def
3277 % Initiliaze variables to avoid name-conflicting with document variables.
3278 % This is the case when using `bind' operator.
3279 /-fillp- 0 def /h 0 def
3280 /-ox- 0 def /half 0 def
3281 /-oy- 0 def /height 0 def
3282 /-save- 0 def /ow 0 def
3283 /Ascent 0 def /quarter 0 def
3284 /Descent 0 def /rXX 0 def
3285 /Effect 0 def /rYY 0 def
3286 /FontHeight 0 def /rwidth 0 def
3287 /LineThickness 0 def /rxx 0 def
3288 /OverlinePosition 0 def /ryy 0 def
3289 /SpaceBackground 0 def /shadow 0 def
3290 /StrikeoutPosition 0 def /shape 0 def
3291 /UnderlinePosition 0 def /shapecolor 0 def
3292 /XBox 0 def /space 0 def
3293 /XX 0 def /st 1 string def
3294 /Xshadow 0 def /w 0 def
3295 /YBox 0 def /width 0 def
3297 /Yshadow 0 def /xo 0 def
3298 /arrow 0 def /xp 0 def
3299 /bg false def /xt 0 def
3300 /bgcolor 0 def /xw 0 def
3301 /bordercolor 0 def /xx 0 def
3302 /borderwidth 0 def /yi 0 def
3304 /entry 0 def /yp 0 def
3305 /foreground 0 def /yt 0 def
3309 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3310 /ISOLatin1Encoding where
3312 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3313 % -- The first half is the same as the standard encoding,
3314 % -- except for minus instead of hyphen at code 055.
3316 StandardEncoding 0 45 getinterval aload pop
3318 StandardEncoding 46 82 getinterval aload pop
3319 %*** NOTE: the following are missing in the Adobe documentation,
3320 %*** but appear in the displayed table:
3321 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3323 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3324 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3325 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3326 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3328 /space /exclamdown /cent /sterling
3329 /currency /yen /brokenbar /section
3330 /dieresis /copyright /ordfeminine /guillemotleft
3331 /logicalnot /hyphen /registered /macron
3332 /degree /plusminus /twosuperior /threesuperior
3333 /acute /mu /paragraph /periodcentered
3334 /cedilla /onesuperior /ordmasculine /guillemotright
3335 /onequarter /onehalf /threequarters /questiondown
3337 /Agrave /Aacute /Acircumflex /Atilde
3338 /Adieresis /Aring /AE /Ccedilla
3339 /Egrave /Eacute /Ecircumflex /Edieresis
3340 /Igrave /Iacute /Icircumflex /Idieresis
3341 /Eth /Ntilde /Ograve /Oacute
3342 /Ocircumflex /Otilde /Odieresis /multiply
3343 /Oslash /Ugrave /Uacute /Ucircumflex
3344 /Udieresis /Yacute /Thorn /germandbls
3346 /agrave /aacute /acircumflex /atilde
3347 /adieresis /aring /ae /ccedilla
3348 /egrave /eacute /ecircumflex /edieresis
3349 /igrave /iacute /icircumflex /idieresis
3350 /eth /ntilde /ograve /oacute
3351 /ocircumflex /otilde /odieresis /divide
3352 /oslash /ugrave /uacute /ucircumflex
3353 /udieresis /yacute /thorn /ydieresis
3357 /reencodeFontISO %def
3359 length 12 add dict % Make a new font (a new dict the same size
3360 % as the old one) with room for our new symbols.
3362 begin % Make the new font the current dictionary.
3364 {def}{pop pop}ifelse
3365 }forall % Copy each of the symbols from the old dictionary
3366 % to the new one except for the font ID.
3368 currentdict /FontType get 0 ne
3369 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3370 % the ISOLatin1 encoding.
3372 % Use the font's bounding box to determine the ascent, descent,
3373 % and overall height; don't forget that these values have to be
3374 % transformed using the font's matrix.
3381 % | | | | Ascent (usually > 0)
3383 % (0 0) -> +--+----+-------->
3385 % | | v Descent (usually < 0)
3386 % (x1 y1) --> +----+ - -
3388 currentdict /FontType get 0 ne
3389 {/FontBBox load aload pop % -- x1 y1 x2 y2
3390 FontMatrix transform /Ascent exch def pop
3391 FontMatrix transform /Descent exch def pop}
3392 {/PrimaryFont FDepVector 0 get def
3393 PrimaryFont /FontBBox get aload pop
3394 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3395 PrimaryFont /FontMatrix get transform /Descent exch def pop
3398 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3400 % Define these in case they're not in the FontInfo
3401 % (also, here they're easier to get to).
3402 /UnderlinePosition Descent 0.70 mul def
3403 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3404 /StrikeoutPosition Ascent 0.30 mul def
3405 /LineThickness FontHeight 0.05 mul def
3406 /Xshadow FontHeight 0.08 mul def
3407 /Yshadow FontHeight -0.09 mul def
3408 /SpaceBackground Descent neg UnderlinePosition add def
3409 /XBox Descent neg def
3410 /YBox LineThickness 0.7 mul def
3412 currentdict % Leave the new font on the stack
3413 end % Stop using the font as the current dictionary
3414 definefont % Put the font into the font dictionary
3415 pop % Discard the returned font
3419 /DefFont{findfont exch scalefont reencodeFontISO}def
3424 dup /Ascent get /Ascent exch def
3425 dup /Descent get /Descent exch def
3426 dup /FontHeight get /FontHeight exch def
3427 dup /UnderlinePosition get /UnderlinePosition exch def
3428 dup /OverlinePosition get /OverlinePosition exch def
3429 dup /StrikeoutPosition get /StrikeoutPosition exch def
3430 dup /LineThickness get /LineThickness exch def
3431 dup /Xshadow get /Xshadow exch def
3432 dup /Yshadow get /Yshadow exch def
3433 dup /SpaceBackground get /SpaceBackground exch def
3434 dup /XBox get /XBox exch def
3435 dup /YBox get /YBox exch def
3448 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3450 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3463 % top of stack: fill-or-not
3465 {LineThickness setlinewidth stroke}
3470 % stack: string fill-or-not |- --
3473 /-ox- currentpoint /-oy- exch def def
3475 LineThickness setlinewidth
3477 st dup true charpath
3478 -fillp- {gsave FillBgColor grestore}if
3480 -oy- add /-oy- exch def
3481 -ox- add /-ox- exch def
3488 % stack: fill-or-not delta |- --
3491 xx XBox sub dd sub yy YBox sub dd sub
3492 XX XBox add dd add YY YBox add dd add
3496 % stack: string |- --
3499 Xshadow Yshadow rmoveto
3504 % stack: position |- --
3506 {currentpoint exch pop add dup
3512 LineThickness setlinewidth stroke
3516 % stack: string |- --
3517 % effect: 1 - underline 2 - strikeout 4 - overline
3518 % 8 - shadow 16 - box 32 - outline
3520 {/xx currentpoint dup Descent add /yy exch def
3521 Ascent add /YY exch def def
3522 dup stringwidth pop xx add /XX exch def
3524 {/yy yy Yshadow add def
3525 /XX XX Xshadow add def
3530 {SpaceBackground doBox}
3531 {xx yy XX YY doRect}
3534 Effect 16 and 0 ne{false 0 doBox}if % box
3535 Effect 8 and 0 ne{dup doShadow}if % shadow
3537 {true doOutline} % outline
3538 {show} % normal text
3540 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
3541 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
3542 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
3546 "EBNF EPS prologue")
3549 (defconst ebnf-eps-begin
3553 % x y #ebnf2ps#begin
3555 {#ebnf2ps#dict begin /#ebnf2ps#save save def
3556 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
3558 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
3565 (defconst ebnf-eps-end
3572 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3576 (defvar ebnf-format-float "%1.3f")
3579 (defun ebnf-format-float (&rest floats)
3582 (format ebnf-format-float float))
3587 (defun ebnf-format-color (format-str color default)
3588 (let* ((the-color (or color default))
3589 (rgb (ps-color-scale the-color)))
3592 (ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
3597 (defvar ebnf-message-float "%3.2f")
3600 (defsubst ebnf-message-float (format-str value)
3602 (format ebnf-message-float value)))
3605 (defsubst ebnf-message-info (messag)
3606 (message "%s...%3d%%"
3608 (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
3611 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3615 (defmacro ebnf-node-kind (vec &optional value)
3617 `(aset ,vec 0 ,value)
3621 (defmacro ebnf-node-width-func (node width)
3622 `(funcall (aref ,node 1) ,node ,width))
3625 (defmacro ebnf-node-dimension-func (node &optional value)
3627 `(aset ,node 2 ,value)
3628 `(funcall (aref ,node 2) ,node)))
3631 (defmacro ebnf-node-entry (vec &optional value)
3633 `(aset ,vec 3 ,value)
3637 (defmacro ebnf-node-height (vec &optional value)
3639 `(aset ,vec 4 ,value)
3643 (defmacro ebnf-node-width (vec &optional value)
3645 `(aset ,vec 5 ,value)
3649 (defmacro ebnf-node-name (vec)
3653 (defmacro ebnf-node-list (vec &optional value)
3655 `(aset ,vec 6 ,value)
3659 (defmacro ebnf-node-default (vec)
3663 (defmacro ebnf-node-production (vec &optional value)
3665 `(aset ,vec 7 ,value)
3669 (defmacro ebnf-node-separator (vec &optional value)
3671 `(aset ,vec 7 ,value)
3675 (defmacro ebnf-node-action (vec &optional value)
3677 `(aset ,vec 8 ,value)
3681 (defmacro ebnf-node-generation (node)
3682 `(funcall (ebnf-node-kind ,node) ,node))
3685 (defmacro ebnf-max-width (prod)
3686 `(max (ebnf-node-width ,prod)
3687 (+ (* (length (ebnf-node-name ,prod))
3689 ebnf-production-horizontal-space)))
3692 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3693 ;; PostScript generation
3696 (defun ebnf-generate-eps (ebnf-tree)
3697 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
3698 (ps-print-color-scale (if ps-color-p
3699 (float (car (ps-color-values "white")))
3701 (ebnf-total (length ebnf-tree))
3703 (old-ps-output (symbol-function 'ps-output))
3704 (old-ps-output-string (symbol-function 'ps-output-string))
3705 (eps-buffer (get-buffer-create ebnf-eps-buffer-name))
3706 ebnf-debug-ps error-msg horizontal
3707 prod prod-name prod-width prod-height prod-list file-list)
3708 ;; redefines `ps-output' and `ps-output-string'
3709 (defalias 'ps-output 'ebnf-eps-output)
3710 (defalias 'ps-output-string 'ps-output-string-prim)
3711 ;; generate EPS file
3713 (condition-case data
3716 (setq prod (car ebnf-tree)
3717 prod-name (ebnf-node-name prod)
3718 prod-width (ebnf-max-width prod)
3719 prod-height (ebnf-node-height prod)
3720 horizontal (memq (ebnf-node-action prod)
3722 ;; generate production in EPS buffer
3724 (set-buffer eps-buffer)
3725 (setq ebnf-eps-upper-x 0.0
3726 ebnf-eps-upper-y 0.0
3727 ebnf-eps-max-width prod-width
3728 ebnf-eps-max-height prod-height)
3729 (ebnf-generate-production prod))
3730 (if (setq prod-list (cdr (assoc prod-name
3731 ebnf-eps-production-list)))
3732 ;; insert EPS buffer in all buffer associated with production
3733 (ebnf-eps-production-list prod-list 'file-list horizontal
3734 prod-width prod-height eps-buffer)
3735 ;; write EPS file for production
3736 (ebnf-eps-finish-and-write eps-buffer
3737 (ebnf-eps-filename prod-name)))
3738 ;; prepare for next loop
3740 (set-buffer eps-buffer)
3742 (setq ebnf-tree (cdr ebnf-tree)))
3743 ;; write and kill temporary buffers
3744 (ebnf-eps-write-kill-temp file-list t)
3745 (setq file-list nil))
3748 (setq error-msg (error-message-string data)))))
3749 ;; restore `ps-output' and `ps-output-string'
3750 (defalias 'ps-output old-ps-output)
3751 (defalias 'ps-output-string old-ps-output-string)
3752 ;; kill temporary buffers
3753 (kill-buffer eps-buffer)
3754 (ebnf-eps-write-kill-temp file-list nil)
3755 (and error-msg (error error-msg))
3759 ;; write and kill temporary buffers
3760 (defun ebnf-eps-write-kill-temp (file-list write-p)
3762 (let ((buffer (get-buffer (concat " *" (car file-list) "*"))))
3765 (ebnf-eps-finish-and-write buffer (car file-list)))
3766 (kill-buffer buffer)))
3767 (setq file-list (cdr file-list))))
3770 ;; insert EPS buffer in all buffer associated with production
3771 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
3772 prod-width prod-height eps-buffer)
3774 (add-to-list file-list-sym (car prod-list))
3776 (set-buffer (get-buffer-create (concat " *" (car prod-list) "*")))
3777 (goto-char (point-max))
3780 ((zerop (buffer-size))
3781 (setq ebnf-eps-upper-x 0.0
3782 ebnf-eps-upper-y 0.0
3783 ebnf-eps-max-width prod-width
3784 ebnf-eps-max-height prod-height))
3787 (ebnf-eop-horizontal ebnf-eps-prod-width)
3788 (setq ebnf-eps-max-width (+ ebnf-eps-max-width
3789 ebnf-production-horizontal-space
3791 ebnf-eps-max-height (max ebnf-eps-max-height prod-height)))
3794 (ebnf-eop-vertical ebnf-eps-max-height)
3795 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
3796 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
3799 ebnf-production-vertical-space
3800 ebnf-eps-max-height))
3801 ebnf-eps-max-width prod-width
3802 ebnf-eps-max-height prod-height))
3804 (setq ebnf-eps-prod-width prod-width)
3805 (insert-buffer eps-buffer))
3806 (setq prod-list (cdr prod-list))))
3809 (defun ebnf-generate (ebnf-tree)
3810 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
3811 (ps-print-color-scale (if ps-color-p
3812 (float (car (ps-color-values "white")))
3814 ps-zebra-stripes ps-line-number ps-razzle-dazzle
3816 ps-print-begin-sheet-hook
3817 ps-print-begin-page-hook
3818 ps-print-begin-column-hook)
3819 (ps-generate (current-buffer) (point-min) (point-max)
3820 'ebnf-generate-postscript)))
3823 (defvar ebnf-tree nil)
3824 (defvar ebnf-direction "R")
3825 (defvar ebnf-total 0)
3826 (defvar ebnf-nprod 0)
3829 (defun ebnf-generate-postscript (from to)
3831 (if ebnf-horizontal-max-height
3832 (ebnf-generate-with-max-height)
3833 (ebnf-generate-without-max-height))
3837 (defun ebnf-generate-with-max-height ()
3838 (let ((ebnf-total (length ebnf-tree))
3840 next-line max-height prod the-width)
3842 ;; find next line point
3843 (setq next-line ebnf-tree
3844 prod (car ebnf-tree)
3845 max-height (ebnf-node-height prod))
3846 (ebnf-begin-line prod (ebnf-max-width prod))
3847 (while (and (setq next-line (cdr next-line))
3848 (setq prod (car next-line))
3849 (memq (ebnf-node-action prod) ebnf-action-list)
3850 (setq the-width (ebnf-max-width prod))
3851 (<= the-width ps-width-remaining))
3852 (setq max-height (max max-height (ebnf-node-height prod))
3853 ps-width-remaining (- ps-width-remaining
3855 ebnf-production-horizontal-space))))
3856 ;; generate current line
3857 (ebnf-newline max-height)
3858 (setq prod (car ebnf-tree))
3859 (ebnf-generate-production prod)
3860 (while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line))
3861 (ebnf-eop-horizontal (ebnf-max-width prod))
3862 (setq prod (car ebnf-tree))
3863 (ebnf-generate-production prod))
3864 (ebnf-eop-vertical max-height))))
3867 (defun ebnf-generate-without-max-height ()
3868 (let ((ebnf-total (length ebnf-tree))
3870 max-height prod bef-width cur-width)
3872 ;; generate current line
3873 (setq prod (car ebnf-tree)
3874 max-height (ebnf-node-height prod)
3875 bef-width (ebnf-max-width prod))
3876 (ebnf-begin-line prod bef-width)
3877 (ebnf-generate-production prod)
3878 (while (and (setq ebnf-tree (cdr ebnf-tree))
3879 (setq prod (car ebnf-tree))
3880 (memq (ebnf-node-action prod) ebnf-action-list)
3881 (setq cur-width (ebnf-max-width prod))
3882 (<= cur-width ps-width-remaining)
3883 (<= (ebnf-node-height prod) ps-height-remaining))
3884 (ebnf-eop-horizontal bef-width)
3885 (ebnf-generate-production prod)
3886 (setq bef-width cur-width
3887 max-height (max max-height (ebnf-node-height prod))
3888 ps-width-remaining (- ps-width-remaining
3890 ebnf-production-horizontal-space))))
3891 (ebnf-eop-vertical max-height)
3892 ;; prepare next line
3893 (ebnf-newline max-height))))
3896 (defun ebnf-begin-line (prod width)
3897 (and (or (eq (ebnf-node-action prod) 'form-feed)
3898 (> (ebnf-node-height prod) ps-height-remaining))
3900 (setq ps-width-remaining (- ps-width-remaining
3902 ebnf-production-horizontal-space))))
3905 (defun ebnf-newline (height)
3906 (and (> height ps-height-remaining)
3908 (setq ps-width-remaining ps-print-width
3909 ps-height-remaining (- ps-height-remaining
3911 ebnf-production-vertical-space))))
3914 ;; [production width-fun dim-fun entry height width name production action]
3915 (defun ebnf-generate-production (production)
3916 (ebnf-message-info "Generating")
3917 (run-hooks 'ebnf-production-hook)
3918 (ps-output-string (ebnf-node-name production))
3921 (ebnf-node-width production)
3922 (+ ebnf-basic-height
3923 (ebnf-node-entry (ebnf-node-production production))))
3925 (ebnf-node-generation (ebnf-node-production production))
3926 (ps-output "EOS\n"))
3929 ;; [alternative width-fun dim-fun entry height width list]
3930 (defun ebnf-generate-alternative (alternative)
3931 (let ((alt (ebnf-node-list alternative))
3932 (entry (ebnf-node-entry alternative))
3934 alt-height alt-entry)
3936 (ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt))))
3938 (setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space)
3941 (ps-output (format "%d " nlist)
3942 (ebnf-format-float (ebnf-node-width alternative))
3944 (setq alt (ebnf-node-list alternative))
3946 (ebnf-node-generation (car alt))
3947 (setq alt-height (- (ebnf-node-height (car alt))
3948 (ebnf-node-entry (car alt)))))
3949 (while (setq alt (cdr alt))
3950 (setq alt-entry (ebnf-node-entry (car alt)))
3951 (ebnf-vertical-movement
3952 (- (+ alt-height ebnf-vertical-space alt-entry)))
3953 (ebnf-node-generation (car alt))
3954 (setq alt-height (- (ebnf-node-height (car alt)) alt-entry))))
3955 (ps-output "EOS\n"))
3958 ;; [sequence width-fun dim-fun entry height width list]
3959 (defun ebnf-generate-sequence (sequence)
3961 (let ((seq (ebnf-node-list sequence))
3964 (ebnf-node-generation (car seq))
3965 (setq seq-width (ebnf-node-width (car seq))))
3966 (while (setq seq (cdr seq))
3967 (ebnf-horizontal-movement seq-width)
3968 (ebnf-node-generation (car seq))
3969 (setq seq-width (ebnf-node-width (car seq)))))
3970 (ps-output "EOS\n"))
3973 ;; [terminal width-fun dim-fun entry height width name]
3974 (defun ebnf-generate-terminal (terminal)
3975 (ebnf-gen-terminal terminal "T"))
3978 ;; [non-terminal width-fun dim-fun entry height width name]
3979 (defun ebnf-generate-non-terminal (non-terminal)
3980 (ebnf-gen-terminal non-terminal "NT"))
3983 ;; [empty width-fun dim-fun entry height width]
3984 (defun ebnf-generate-empty (empty)
3985 (ebnf-empty-alternative (ebnf-node-width empty)))
3988 ;; [optional width-fun dim-fun entry height width element]
3989 (defun ebnf-generate-optional (optional)
3990 (let ((the-optional (ebnf-node-list optional)))
3991 (ps-output (ebnf-format-float
3992 (+ (- (ebnf-node-height the-optional)
3993 (ebnf-node-entry optional))
3994 ebnf-vertical-space)
3995 (ebnf-node-width optional))
3997 (ebnf-node-generation the-optional)
3998 (ps-output "EOS\n")))
4001 ;; [one-or-more width-fun dim-fun entry height width element separator]
4002 (defun ebnf-generate-one-or-more (one-or-more)
4003 (let* ((width (ebnf-node-width one-or-more))
4004 (sep (ebnf-node-separator one-or-more))
4005 (entry (- (ebnf-node-entry one-or-more)
4007 (ebnf-node-entry sep)
4009 (ps-output (ebnf-format-float entry width)
4011 (ebnf-node-generation (ebnf-node-list one-or-more))
4012 (ebnf-vertical-movement entry)
4014 (let ((ebnf-direction "L"))
4015 (ebnf-node-generation sep))
4016 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4017 (ps-output "EOS\n"))
4020 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4021 (defun ebnf-generate-zero-or-more (zero-or-more)
4022 (let* ((width (ebnf-node-width zero-or-more))
4023 (node-list (ebnf-node-list zero-or-more))
4024 (list-entry (ebnf-node-entry node-list))
4025 (node-sep (ebnf-node-separator zero-or-more))
4026 (entry (+ list-entry
4029 (- (ebnf-node-height node-sep)
4030 (ebnf-node-entry node-sep))
4032 (ps-output (ebnf-format-float entry
4033 (+ (- (ebnf-node-height node-list)
4035 ebnf-vertical-space)
4038 (ebnf-node-generation (ebnf-node-list zero-or-more))
4039 (ebnf-vertical-movement entry)
4040 (if (ebnf-node-separator zero-or-more)
4041 (let ((ebnf-direction "L"))
4042 (ebnf-node-generation (ebnf-node-separator zero-or-more)))
4043 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4044 (ps-output "EOS\n"))
4047 ;; [special width-fun dim-fun entry height width name]
4048 (defun ebnf-generate-special (special)
4049 (ebnf-gen-terminal special "SP"))
4052 ;; [repeat width-fun dim-fun entry height width times element]
4053 (defun ebnf-generate-repeat (repeat)
4054 (let ((times (ebnf-node-name repeat))
4055 (element (ebnf-node-separator repeat)))
4056 (ps-output-string times)
4059 (ebnf-node-entry repeat)
4060 (ebnf-node-height repeat)
4061 (ebnf-node-width repeat)
4063 (+ (ebnf-node-width element)
4064 ebnf-space-R ebnf-space-R ebnf-space-R
4065 (* (length times) ebnf-font-width-R))
4067 " " ebnf-direction "RP\n")
4069 (ebnf-node-generation element)))
4070 (ps-output "EOS\n"))
4073 ;; [except width-fun dim-fun entry height width element element]
4074 (defun ebnf-generate-except (except)
4075 (let* ((element (ebnf-node-list except))
4076 (exception (ebnf-node-separator except))
4077 (width (ebnf-node-width element)))
4078 (ps-output (ebnf-format-float
4080 (ebnf-node-entry except)
4081 (ebnf-node-height except)
4082 (ebnf-node-width except)
4084 ebnf-space-E ebnf-space-E ebnf-space-E
4087 (+ (ebnf-node-width exception) ebnf-space-E)
4089 " " ebnf-direction "EX\n")
4090 (ebnf-node-generation (ebnf-node-list except))
4092 (ebnf-horizontal-movement (+ width ebnf-space-E
4093 ebnf-font-width-E ebnf-space-E))
4094 (ebnf-node-generation exception)))
4095 (ps-output "EOS\n"))
4098 (defun ebnf-gen-terminal (node code)
4099 (ps-output-string (ebnf-node-name node))
4100 (ps-output " " (ebnf-format-float (ebnf-node-width node))
4101 " " ebnf-direction code
4102 (if (ebnf-node-default node)
4107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4108 ;; Internal functions
4111 (defvar ebnf-map-name
4112 (let ((map (make-vector 256 ?\_)))
4113 (mapcar #'(lambda (char)
4114 (aset map char char))
4115 (concat "#$%&+-.0123456789=?@~"
4116 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4117 "abcdefghijklmnopqrstuvwxyz"))
4121 (defun ebnf-eps-filename (str)
4122 (let* ((len (length str))
4124 (new (make-string len ?\ )))
4126 (aset new stri (aref ebnf-map-name (aref str stri)))
4127 (setq stri (1+ stri)))
4128 (concat ebnf-eps-prefix new ".eps")))
4131 (defun ebnf-eps-output (&rest args)
4134 (setq args (cdr args))))
4137 (defun ebnf-generate-region (from to gen-func)
4138 (run-hooks 'ebnf-hook)
4139 (let ((ebnf-limit (max from to))
4144 (condition-case data
4145 (let ((tree (ebnf-parse-and-sort (min from to))))
4150 (ebnf-eliminate-empty-rules tree))))))
4154 (setq the-point (max (1- (point)) (point-min)))
4155 (message (error-message-string data)))))))
4158 (goto-char the-point))
4162 (message "EBNF syntatic analysis: NO ERRORS.")))))
4165 (defun ebnf-parse-and-sort (start)
4167 (let ((tree (funcall ebnf-parser-func start)))
4168 (if ebnf-sort-production
4170 (message "Sorting...")
4172 (if (eq ebnf-sort-production 'ascending)
4173 'ebnf-sorter-ascending
4174 'ebnf-sorter-descending)))
4178 (defun ebnf-sorter-ascending (first second)
4179 (string< (ebnf-node-name first)
4180 (ebnf-node-name second)))
4183 (defun ebnf-sorter-descending (first second)
4184 (string< (ebnf-node-name second)
4185 (ebnf-node-name first)))
4188 (defun ebnf-empty-alternative (width)
4189 (ps-output (ebnf-format-float width) " EA\n"))
4192 (defun ebnf-vertical-movement (height)
4193 (ps-output (ebnf-format-float height) " vm\n"))
4196 (defun ebnf-horizontal-movement (width)
4197 (ps-output (ebnf-format-float width) " hm\n"))
4200 (defun ebnf-entry (height)
4201 (* height ebnf-entry-percentage))
4204 (defun ebnf-eop-vertical (height)
4205 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space))
4209 (defun ebnf-eop-horizontal (width)
4210 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space))
4214 (defun ebnf-new-page ()
4215 (when (< ps-height-remaining ps-print-height)
4216 (run-hooks 'ebnf-page-hook)
4221 (defsubst ebnf-font-size (font) (nth 0 font))
4222 (defsubst ebnf-font-name (font) (nth 1 font))
4223 (defsubst ebnf-font-foreground (font) (nth 2 font))
4224 (defsubst ebnf-font-background (font) (nth 3 font))
4225 (defsubst ebnf-font-list (font) (nthcdr 4 font))
4226 (defsubst ebnf-font-attributes (font)
4227 (lsh (ps-extension-bit (cdr font)) -2))
4230 (defconst ebnf-font-name-select
4231 (vector 'normal 'bold 'italic 'bold-italic))
4234 (defun ebnf-font-name-select (font)
4235 (let* ((font-list (ebnf-font-list font))
4236 (font-index (+ (if (memq 'bold font-list) 1 0)
4237 (if (memq 'italic font-list) 2 0)))
4238 (name (ebnf-font-name font))
4239 (database (cdr (assoc name ps-font-info-database)))
4240 (info-list (or (cdr (assoc 'fonts database))
4241 (error "Invalid font: %s" name))))
4242 (or (cdr (assoc (aref ebnf-font-name-select font-index)
4244 (error "Invalid attributes for font %s" name))))
4247 (defun ebnf-font-select (font select)
4248 (let* ((name (ebnf-font-name font))
4249 (database (cdr (assoc name ps-font-info-database)))
4250 (size (cdr (assoc 'size database)))
4251 (base (cdr (assoc select database))))
4253 (/ (* (ebnf-font-size font) base)
4255 (error "Invalid font: %s" name))))
4258 (defsubst ebnf-font-width (font)
4259 (ebnf-font-select font 'avg-char-width))
4260 (defsubst ebnf-font-height (font)
4261 (ebnf-font-select font 'line-height))
4264 (defun ebnf-begin-job ()
4265 (ps-printing-region nil nil)
4266 (if ebnf-use-float-format
4267 (setq ebnf-format-float "%1.3f"
4268 ebnf-message-float "%3.2f")
4269 (setq ebnf-format-float "%s"
4270 ebnf-message-float "%s"))
4271 (ebnf-otz-initialize)
4272 ;; to avoid compilation gripes when calling autoloaded functions
4273 (funcall (cond ((eq ebnf-syntax 'iso-ebnf)
4274 (setq ebnf-parser-func 'ebnf-iso-parser)
4275 'ebnf-iso-initialize)
4276 ((eq ebnf-syntax 'yacc)
4277 (setq ebnf-parser-func 'ebnf-yac-parser)
4278 'ebnf-yac-initialize)
4280 (setq ebnf-parser-func 'ebnf-bnf-parser)
4281 'ebnf-bnf-initialize)))
4282 (and ebnf-terminal-regexp ; ensures that it's a string or nil
4283 (not (stringp ebnf-terminal-regexp))
4284 (setq ebnf-terminal-regexp nil))
4285 (or (and ebnf-eps-prefix ; ensures that it's a string
4286 (stringp ebnf-eps-prefix))
4287 (setq ebnf-eps-prefix "ebnf--"))
4288 (setq ebnf-entry-percentage ; ensures value between 0.0 and 1.0
4289 (min (max ebnf-entry-percentage 0.0) 1.0)
4290 ebnf-action-list (if ebnf-horizontal-orientation
4294 ebnf-fonts-required nil
4297 ebnf-eps-context nil
4298 ebnf-eps-production-list nil
4299 ebnf-eps-upper-x 0.0
4300 ebnf-eps-upper-y 0.0
4301 ebnf-font-height-P (ebnf-font-height ebnf-production-font)
4302 ebnf-font-height-T (ebnf-font-height ebnf-terminal-font)
4303 ebnf-font-height-NT (ebnf-font-height ebnf-non-terminal-font)
4304 ebnf-font-height-S (ebnf-font-height ebnf-special-font)
4305 ebnf-font-height-E (ebnf-font-height ebnf-except-font)
4306 ebnf-font-height-R (ebnf-font-height ebnf-repeat-font)
4307 ebnf-font-width-P (ebnf-font-width ebnf-production-font)
4308 ebnf-font-width-T (ebnf-font-width ebnf-terminal-font)
4309 ebnf-font-width-NT (ebnf-font-width ebnf-non-terminal-font)
4310 ebnf-font-width-S (ebnf-font-width ebnf-special-font)
4311 ebnf-font-width-E (ebnf-font-width ebnf-except-font)
4312 ebnf-font-width-R (ebnf-font-width ebnf-repeat-font)
4313 ebnf-space-T (* ebnf-font-height-T 0.5)
4314 ebnf-space-NT (* ebnf-font-height-NT 0.5)
4315 ebnf-space-S (* ebnf-font-height-S 0.5)
4316 ebnf-space-E (* ebnf-font-height-E 0.5)
4317 ebnf-space-R (* ebnf-font-height-R 0.5))
4318 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT)))
4319 (setq ebnf-basic-width (* basic 0.5)
4320 ebnf-horizontal-space (+ basic basic)
4321 ebnf-basic-height ebnf-basic-width
4322 ebnf-vertical-space ebnf-basic-width)
4323 ;; ensures value is greater than zero
4324 (or (and (numberp ebnf-production-horizontal-space)
4325 (> ebnf-production-horizontal-space 0.0))
4326 (setq ebnf-production-horizontal-space basic))
4327 ;; ensures value is greater than zero
4328 (or (and (numberp ebnf-production-vertical-space)
4329 (> ebnf-production-vertical-space 0.0))
4330 (setq ebnf-production-vertical-space basic))))
4333 (defsubst ebnf-shape-value (sym alist)
4334 (or (cdr (assq sym alist)) 0))
4337 (defsubst ebnf-boolean (value)
4338 (if value "true" "false"))
4341 (defun ebnf-begin-file ()
4344 (set-buffer ps-spool-buffer)
4345 (goto-char (point-min))
4346 (and (search-forward "%%Creator: " nil t)
4347 (not (search-forward "& ebnf2ps v"
4348 (save-excursion (end-of-line) (point))
4351 ;; adjust creator comment
4354 (insert " & ebnf2ps v" ebnf-version)
4355 ;; insert ebnf settings & engine
4356 (goto-char (point-max))
4357 (search-backward "\n%%EndPrologue\n")
4358 (ebnf-insert-ebnf-prologue)
4359 (ps-output "\n")))))
4362 (defun ebnf-eps-finish-and-write (buffer filename)
4365 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
4366 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
4369 ebnf-production-vertical-space
4370 ebnf-eps-max-height)))
4372 (goto-char (point-min))
4374 "%!PS-Adobe-3.0 EPSF-3.0"
4375 "\n%%BoundingBox: 0 0 "
4376 (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
4377 "\n%%Title: " filename
4378 "\n%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
4379 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
4380 "\n%%DocumentNeededResources: font "
4381 (or ebnf-fonts-required
4382 (setq ebnf-fonts-required
4383 (let ((fonts (ps-remove-duplicates
4384 (mapcar 'ebnf-font-name-select
4385 (list ebnf-production-font
4387 ebnf-non-terminal-font
4390 ebnf-repeat-font)))))
4392 (and (cdr fonts) "\n%%+ font ")
4393 (mapconcat 'identity (cdr fonts) "\n%%+ font ")))))
4394 "\n%%Pages: 0\n%%EndComments\n\n%%BeginPrologue\n"
4396 (ebnf-insert-ebnf-prologue)
4397 (insert ebnf-eps-begin
4398 "\n0 " (ebnf-format-float
4399 (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7)))
4400 " #ebnf2ps#begin\n")
4402 (goto-char (point-max))
4403 (insert ebnf-eps-end)
4405 (message "Saving...")
4406 (setq filename (expand-file-name filename))
4407 (let ((coding-system-for-write 'raw-text-unix))
4408 (write-region (point-min) (point-max) filename))
4409 (message "Wrote %s" filename)))
4412 (defun ebnf-insert-ebnf-prologue ()
4417 "\n\n% === begin EBNF settings\n\n"
4419 (format "/fP %s /%s DefFont\n"
4420 (ebnf-format-float (ebnf-font-size ebnf-production-font))
4421 (ebnf-font-name-select ebnf-production-font))
4422 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4423 (ebnf-font-foreground ebnf-production-font)
4425 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4426 (ebnf-font-background ebnf-production-font)
4428 (format "/EffectP %d def\n"
4429 (ebnf-font-attributes ebnf-production-font))
4431 (format "/fT %s /%s DefFont\n"
4432 (ebnf-format-float (ebnf-font-size ebnf-terminal-font))
4433 (ebnf-font-name-select ebnf-terminal-font))
4434 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4435 (ebnf-font-foreground ebnf-terminal-font)
4437 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4438 (ebnf-font-background ebnf-terminal-font)
4440 (format "/EffectT %d def\n"
4441 (ebnf-font-attributes ebnf-terminal-font))
4442 (format "/BorderWidthT %s def\n"
4443 (ebnf-format-float ebnf-terminal-border-width))
4444 (ebnf-format-color "/BorderColorT %s def %% %s\n"
4445 ebnf-terminal-border-color
4447 (format "/ShapeT %d def\n"
4448 (ebnf-shape-value ebnf-terminal-shape
4449 ebnf-terminal-shape-alist))
4450 (format "/ShadowT %s def\n"
4451 (ebnf-boolean ebnf-terminal-shadow))
4453 (format "/fNT %s /%s DefFont\n"
4455 (ebnf-font-size ebnf-non-terminal-font))
4456 (ebnf-font-name-select ebnf-non-terminal-font))
4457 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
4458 (ebnf-font-foreground ebnf-non-terminal-font)
4460 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
4461 (ebnf-font-background ebnf-non-terminal-font)
4463 (format "/EffectNT %d def\n"
4464 (ebnf-font-attributes ebnf-non-terminal-font))
4465 (format "/BorderWidthNT %s def\n"
4466 (ebnf-format-float ebnf-non-terminal-border-width))
4467 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
4468 ebnf-non-terminal-border-color
4470 (format "/ShapeNT %d def\n"
4471 (ebnf-shape-value ebnf-non-terminal-shape
4472 ebnf-terminal-shape-alist))
4473 (format "/ShadowNT %s def\n"
4474 (ebnf-boolean ebnf-non-terminal-shadow))
4476 (format "/fS %s /%s DefFont\n"
4477 (ebnf-format-float (ebnf-font-size ebnf-special-font))
4478 (ebnf-font-name-select ebnf-special-font))
4479 (ebnf-format-color "/ForegroundS %s def %% %s\n"
4480 (ebnf-font-foreground ebnf-special-font)
4482 (ebnf-format-color "/BackgroundS %s def %% %s\n"
4483 (ebnf-font-background ebnf-special-font)
4485 (format "/EffectS %d def\n"
4486 (ebnf-font-attributes ebnf-special-font))
4487 (format "/BorderWidthS %s def\n"
4488 (ebnf-format-float ebnf-special-border-width))
4489 (ebnf-format-color "/BorderColorS %s def %% %s\n"
4490 ebnf-special-border-color
4492 (format "/ShapeS %d def\n"
4493 (ebnf-shape-value ebnf-special-shape
4494 ebnf-terminal-shape-alist))
4495 (format "/ShadowS %s def\n"
4496 (ebnf-boolean ebnf-special-shadow))
4498 (format "/fE %s /%s DefFont\n"
4499 (ebnf-format-float (ebnf-font-size ebnf-except-font))
4500 (ebnf-font-name-select ebnf-except-font))
4501 (ebnf-format-color "/ForegroundE %s def %% %s\n"
4502 (ebnf-font-foreground ebnf-except-font)
4504 (ebnf-format-color "/BackgroundE %s def %% %s\n"
4505 (ebnf-font-background ebnf-except-font)
4507 (format "/EffectE %d def\n"
4508 (ebnf-font-attributes ebnf-except-font))
4509 (format "/BorderWidthE %s def\n"
4510 (ebnf-format-float ebnf-except-border-width))
4511 (ebnf-format-color "/BorderColorE %s def %% %s\n"
4512 ebnf-except-border-color
4514 (format "/ShapeE %d def\n"
4515 (ebnf-shape-value ebnf-except-shape
4516 ebnf-terminal-shape-alist))
4517 (format "/ShadowE %s def\n"
4518 (ebnf-boolean ebnf-except-shadow))
4520 (format "/fR %s /%s DefFont\n"
4521 (ebnf-format-float (ebnf-font-size ebnf-repeat-font))
4522 (ebnf-font-name-select ebnf-repeat-font))
4523 (ebnf-format-color "/ForegroundR %s def %% %s\n"
4524 (ebnf-font-foreground ebnf-repeat-font)
4526 (ebnf-format-color "/BackgroundR %s def %% %s\n"
4527 (ebnf-font-background ebnf-repeat-font)
4529 (format "/EffectR %d def\n"
4530 (ebnf-font-attributes ebnf-repeat-font))
4531 (format "/BorderWidthR %s def\n"
4532 (ebnf-format-float ebnf-repeat-border-width))
4533 (ebnf-format-color "/BorderColorR %s def %% %s\n"
4534 ebnf-repeat-border-color
4536 (format "/ShapeR %d def\n"
4537 (ebnf-shape-value ebnf-repeat-shape
4538 ebnf-terminal-shape-alist))
4539 (format "/ShadowR %s def\n"
4540 (ebnf-boolean ebnf-repeat-shadow))
4542 (format "/DefaultWidth %s def\n"
4543 (ebnf-format-float ebnf-default-width))
4544 (format "/LineWidth %s def\n"
4545 (ebnf-format-float ebnf-line-width))
4546 (ebnf-format-color "/LineColor %s def %% %s\n"
4549 (format "/ArrowShape %d def\n"
4550 (ebnf-shape-value ebnf-arrow-shape
4551 ebnf-arrow-shape-alist))
4552 (format "/ChartShape %d def\n"
4553 (ebnf-shape-value ebnf-chart-shape
4554 ebnf-terminal-shape-alist))
4555 (format "/UserArrow{%s}def\n"
4556 (ebnf-user-arrow ebnf-user-arrow))
4557 "\n% === end EBNF settings\n\n"
4558 (and ebnf-debug-ps ebnf-debug))))
4562 (defun ebnf-user-arrow (user-arrow)
4563 "Return a user arrow shape from USER-ARROW (a PostScript code).
4565 This function is only called when `ebnf-arrow-shape' is set to symbol `user'.
4567 If is a string, should be a PostScript procedure body.
4568 If is a variable symbol, should contain a string.
4569 If is a function symbol, it is called and the result is applied recursively.
4570 If is a cons and car is a function symbol, it is called as:
4571 (funcall (car cons) (cdr cons))
4572 and the result is applied recursively.
4573 If is a cons and car is not a function symbol, it is applied recursively on
4574 car and cdr, and the results are concatened as:
4575 (concat RESULT-FROM-CAR \" \" RESULT-FROM-CDR)
4576 If is a list and car is a function symbol, it is called as:
4577 (apply (car list) (cdr list))
4578 and the result is applied recursively.
4579 If is a list and car is not a function symbol, it is applied recursively on
4580 each element and the resulting list is concatened as:
4581 (mapconcat 'identity RESULTING-LIST \" \")
4582 Otherwise, it is treated as an empty string."
4586 ((stringp user-arrow)
4588 ((and (symbolp user-arrow) (fboundp user-arrow))
4589 (ebnf-user-arrow (funcall user-arrow)))
4590 ((and (symbolp user-arrow) (boundp user-arrow))
4591 (ebnf-user-arrow (symbol-value user-arrow)))
4593 (if (and (symbolp (car user-arrow)) (fboundp (car user-arrow)))
4594 (ebnf-user-arrow (funcall (car user-arrow) (cdr user-arrow)))
4595 (concat (ebnf-user-arrow (car user-arrow))
4597 (ebnf-user-arrow (cdr user-arrow)))))
4599 (if (and (symbolp (car user-arrow))
4600 (fboundp (car user-arrow)))
4601 (ebnf-user-arrow (apply (car user-arrow) (cdr user-arrow)))
4602 (mapconcat 'ebnf-user-arrow user-arrow " ")))
4608 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4609 ;; Adjusting dimensions
4612 (defun ebnf-dimensions (tree)
4613 (let ((ebnf-total (length tree))
4615 (mapcar 'ebnf-production-dimension tree))
4619 ;; [empty width-fun dim-fun entry height width]
4620 ;;(defun ebnf-empty-dimension (empty)
4624 ;; [production width-fun dim-fun entry height width name production action]
4625 (defun ebnf-production-dimension (production)
4626 (ebnf-message-info "Calculating dimensions")
4627 (ebnf-node-dimension-func (ebnf-node-production production))
4628 (let* ((prod (ebnf-node-production production))
4629 (height (+ ebnf-font-height-P
4631 (ebnf-node-height prod))))
4632 (ebnf-node-entry production height)
4633 (ebnf-node-height production height)
4634 (ebnf-node-width production (+ (ebnf-node-width prod)
4635 ebnf-horizontal-space))))
4638 ;; [terminal width-fun dim-fun entry height width name]
4639 (defun ebnf-terminal-dimension (terminal)
4640 (ebnf-terminal-dimension1 terminal
4646 ;; [non-terminal width-fun dim-fun entry height width name]
4647 (defun ebnf-non-terminal-dimension (non-terminal)
4648 (ebnf-terminal-dimension1 non-terminal
4654 ;; [special width-fun dim-fun entry height width name]
4655 (defun ebnf-special-dimension (special)
4656 (ebnf-terminal-dimension1 special
4662 (defun ebnf-terminal-dimension1 (node font-height font-width space)
4663 (let ((height (+ space font-height space))
4664 (len (length (ebnf-node-name node))))
4665 (ebnf-node-entry node (* height 0.5))
4666 (ebnf-node-height node height)
4667 (ebnf-node-width node (+ ebnf-basic-width space
4669 space ebnf-basic-width))))
4672 (defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
4675 ;; [repeat width-fun dim-fun entry height width times element]
4676 (defun ebnf-repeat-dimension (repeat)
4677 (let ((times (ebnf-node-name repeat))
4678 (element (ebnf-node-separator repeat)))
4680 (ebnf-node-dimension-func element)
4681 (setq element ebnf-null-vector))
4682 (ebnf-node-entry repeat (+ (ebnf-node-entry element)
4684 (ebnf-node-height repeat (+ (max (ebnf-node-height element)
4686 ebnf-space-R ebnf-space-R))
4687 (ebnf-node-width repeat (+ (ebnf-node-width element)
4688 ebnf-space-R ebnf-space-R ebnf-space-R
4689 ebnf-horizontal-space
4690 (* (length times) ebnf-font-width-R)))))
4693 ;; [except width-fun dim-fun entry height width element element]
4694 (defun ebnf-except-dimension (except)
4695 (let ((factor (ebnf-node-list except))
4696 (element (ebnf-node-separator except)))
4697 (ebnf-node-dimension-func factor)
4699 (ebnf-node-dimension-func element)
4700 (setq element ebnf-null-vector))
4701 (ebnf-node-entry except (+ (max (ebnf-node-entry factor)
4702 (ebnf-node-entry element))
4704 (ebnf-node-height except (+ (max (ebnf-node-height factor)
4705 (ebnf-node-height element))
4706 ebnf-space-E ebnf-space-E))
4707 (ebnf-node-width except (+ (ebnf-node-width factor)
4708 (ebnf-node-width element)
4709 ebnf-space-E ebnf-space-E
4710 ebnf-space-E ebnf-space-E
4712 ebnf-horizontal-space))))
4715 ;; [alternative width-fun dim-fun entry height width list]
4716 (defun ebnf-alternative-dimension (alternative)
4717 (let ((body (ebnf-node-list alternative))
4718 (lis (ebnf-node-list alternative)))
4720 (ebnf-node-dimension-func (car lis))
4721 (setq lis (cdr lis)))
4725 (tail (car (last body)))
4726 (entry (ebnf-node-entry (car body)))
4729 (setq node (car alt)
4731 height (+ (ebnf-node-height node) height)
4732 width (max (ebnf-node-width node) width)))
4733 (ebnf-adjust-width body width)
4734 (setq height (+ height (* (1- (length body)) ebnf-vertical-space)))
4735 (ebnf-node-entry alternative (+ entry
4738 (- (ebnf-node-height tail)
4739 (ebnf-node-entry tail))))))
4740 (ebnf-node-height alternative height)
4741 (ebnf-node-width alternative (+ width ebnf-horizontal-space))
4742 (ebnf-node-list alternative body))))
4745 ;; [optional width-fun dim-fun entry height width element]
4746 (defun ebnf-optional-dimension (optional)
4747 (let ((body (ebnf-node-list optional)))
4748 (ebnf-node-dimension-func body)
4749 (ebnf-node-entry optional (ebnf-node-entry body))
4750 (ebnf-node-height optional (+ (ebnf-node-height body)
4751 ebnf-vertical-space))
4752 (ebnf-node-width optional (+ (ebnf-node-width body)
4753 ebnf-horizontal-space))))
4756 ;; [one-or-more width-fun dim-fun entry height width element separator]
4757 (defun ebnf-one-or-more-dimension (or-more)
4758 (let ((list-part (ebnf-node-list or-more))
4759 (sep-part (ebnf-node-separator or-more)))
4760 (ebnf-node-dimension-func list-part)
4762 (ebnf-node-dimension-func sep-part))
4763 (let ((height (+ (if sep-part
4764 (ebnf-node-height sep-part)
4767 (ebnf-node-height list-part)))
4768 (width (max (if sep-part
4769 (ebnf-node-width sep-part)
4771 (ebnf-node-width list-part))))
4773 (ebnf-adjust-width list-part width)
4774 (ebnf-adjust-width sep-part width))
4775 (ebnf-node-entry or-more (+ (- height (ebnf-node-height list-part))
4776 (ebnf-node-entry list-part)))
4777 (ebnf-node-height or-more height)
4778 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
4781 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4782 (defun ebnf-zero-or-more-dimension (or-more)
4783 (let ((list-part (ebnf-node-list or-more))
4784 (sep-part (ebnf-node-separator or-more)))
4785 (ebnf-node-dimension-func list-part)
4787 (ebnf-node-dimension-func sep-part))
4788 (let ((height (+ (if sep-part
4789 (ebnf-node-height sep-part)
4792 (ebnf-node-height list-part)
4793 ebnf-vertical-space))
4794 (width (max (if sep-part
4795 (ebnf-node-width sep-part)
4797 (ebnf-node-width list-part))))
4799 (ebnf-adjust-width list-part width)
4800 (ebnf-adjust-width sep-part width))
4801 (ebnf-node-entry or-more height)
4802 (ebnf-node-height or-more height)
4803 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
4806 ;; [sequence width-fun dim-fun entry height width list]
4807 (defun ebnf-sequence-dimension (sequence)
4811 (lis (ebnf-node-list sequence))
4814 (setq node (car lis)
4816 (ebnf-node-dimension-func node)
4817 (setq entry (ebnf-node-entry node)
4818 above (max above entry)
4819 below (max below (- (ebnf-node-height node) entry))
4820 width (+ width (ebnf-node-width node))))
4821 (ebnf-node-entry sequence above)
4822 (ebnf-node-height sequence (+ above below))
4823 (ebnf-node-width sequence width)))
4826 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4830 (defun ebnf-adjust-width (node width)
4836 (setcar node (ebnf-adjust-width (car node) width))
4837 (setq node (cdr node)))))
4840 ;; nothing to be done
4841 ((= width (ebnf-node-width node))
4843 ;; left justify term
4844 ((eq ebnf-justify-sequence 'left)
4845 (ebnf-adjust-empty node width nil))
4846 ;; right justify terms
4847 ((eq ebnf-justify-sequence 'right)
4848 (ebnf-adjust-empty node width t))
4851 (ebnf-node-width-func node width)
4852 (ebnf-node-width node width)
4860 (defun ebnf-adjust-empty (node width last-p)
4861 (if (eq (ebnf-node-kind node) 'ebnf-generate-empty)
4863 (ebnf-node-width node width)
4865 (let ((empty (ebnf-make-empty (- width (ebnf-node-width node)))))
4866 (ebnf-make-dup-sequence node
4869 (list node empty))))))
4872 ;; [terminal width-fun dim-fun entry height width name]
4873 ;; [non-terminal width-fun dim-fun entry height width name]
4874 ;; [empty width-fun dim-fun entry height width]
4875 ;; [special width-fun dim-fun entry height width name]
4876 ;; [repeat width-fun dim-fun entry height width times element]
4877 ;; [except width-fun dim-fun entry height width element element]
4878 ;;(defun ebnf-terminal-width (terminal width)
4882 ;; [alternative width-fun dim-fun entry height width list]
4883 ;; [optional width-fun dim-fun entry height width element]
4884 (defun ebnf-alternative-width (alternative width)
4885 (ebnf-adjust-width (ebnf-node-list alternative)
4886 (- width ebnf-horizontal-space)))
4889 ;; [one-or-more width-fun dim-fun entry height width element separator]
4890 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4891 (defun ebnf-list-width (or-more width)
4892 (setq width (- width ebnf-horizontal-space))
4893 (ebnf-node-list or-more
4894 (ebnf-justify-list or-more
4895 (ebnf-node-list or-more)
4897 (ebnf-node-separator or-more
4898 (ebnf-justify-list or-more
4899 (ebnf-node-separator or-more)
4903 ;; [sequence width-fun dim-fun entry height width list]
4904 (defun ebnf-sequence-width (sequence width)
4905 (ebnf-node-list sequence
4906 (ebnf-justify-list sequence
4907 (ebnf-node-list sequence)
4911 (defun ebnf-justify-list (node seq width)
4912 (let ((seq-width (ebnf-node-width node)))
4913 (if (= width seq-width)
4916 ;; left justify terms
4917 ((eq ebnf-justify-sequence 'left)
4918 (ebnf-justify node seq seq-width width t))
4919 ;; right justify terms
4920 ((eq ebnf-justify-sequence 'right)
4921 (ebnf-justify node seq seq-width width nil))
4924 (let ((the-width (/ (- width seq-width) (length seq)))
4927 (ebnf-adjust-width (car lis)
4928 (+ (ebnf-node-width (car lis))
4930 (setq lis (cdr lis)))
4935 (defun ebnf-justify (node seq seq-width width last-p)
4936 (let ((term (car (if last-p (last seq) seq))))
4938 ;; adjust empty term
4939 ((eq (ebnf-node-kind term) 'ebnf-generate-empty)
4940 (ebnf-node-width term (+ (- width seq-width)
4941 (ebnf-node-width term)))
4943 ;; insert empty at end ==> left justify
4946 (list (ebnf-make-empty (- width seq-width)))))
4947 ;; insert empty at beginning ==> right justify
4949 (cons (ebnf-make-empty (- width seq-width))
4954 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4955 ;; Functions used by parsers
4958 (defun ebnf-eps-add-context (name)
4959 (let ((filename (ebnf-eps-filename name)))
4960 (if (member filename ebnf-eps-context)
4961 (error "Try to open an already opened EPS file: %s" filename)
4962 (setq ebnf-eps-context (cons filename ebnf-eps-context)))))
4965 (defun ebnf-eps-remove-context (name)
4966 (let ((filename (ebnf-eps-filename name)))
4967 (if (member filename ebnf-eps-context)
4968 (setq ebnf-eps-context (delete filename ebnf-eps-context))
4969 (error "Try to close a not opened EPS file: %s" filename))))
4972 (defun ebnf-eps-add-production (header)
4973 (and ebnf-eps-executing
4975 (let ((prod (assoc header ebnf-eps-production-list)))
4977 (setcdr prod (append ebnf-eps-context (cdr prod)))
4978 (setq ebnf-eps-production-list
4979 (cons (cons header (ebnf-dup-list ebnf-eps-context))
4980 ebnf-eps-production-list))))))
4983 (defun ebnf-dup-list (old)
4986 (setq new (cons (car old) new)
4991 (defun ebnf-buffer-substring (chars)
4992 (buffer-substring-no-properties
4995 (skip-chars-forward chars ebnf-limit)
4999 ;; to avoid a bug of `skip-chars-forward' on version 20.4.1, that is, it
5000 ;; doesn't accept the range "\240-\377", but it accepts the character sequence
5001 ;; from \240 to \377. It seems that version 20.7 has the same problem.
5002 (defconst ebnf-8-bit-chars
5005 (while (<= char ?\377)
5006 (setq str (concat str (char-to-string char))
5011 (defun ebnf-string (chars eos-char kind)
5013 (buffer-substring-no-properties
5016 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5017 (skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit)
5018 (if (or (eobp) (/= (following-char) eos-char))
5019 (error "Illegal %s: missing `%c'." kind eos-char)
5024 (defun ebnf-get-string ()
5026 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5029 (defun ebnf-end-of-string ()
5031 (while (> (logand n 1) 0)
5032 (skip-chars-forward "^\"" ebnf-limit)
5033 (setq n (- (skip-chars-backward "\\\\")))
5034 (goto-char (+ (point) n 1))))
5035 (if (= (preceding-char) ?\")
5037 (error "Missing `\"'.")))
5040 (defun ebnf-trim-right (str)
5041 (let* ((len (1- (length str)))
5043 (while (and (> index 0) (= (aref str index) ?\ ))
5044 (setq index (1- index)))
5047 (substring str 0 (1+ index)))))
5050 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5054 (defun ebnf-make-empty (&optional width)
5055 (vector 'ebnf-generate-empty
5060 (or width ebnf-horizontal-space)))
5063 (defun ebnf-make-terminal (name)
5064 (ebnf-make-terminal1 name
5065 'ebnf-generate-terminal
5066 'ebnf-terminal-dimension))
5069 (defun ebnf-make-non-terminal (name)
5070 (ebnf-make-terminal1 name
5071 'ebnf-generate-non-terminal
5072 'ebnf-non-terminal-dimension))
5075 (defun ebnf-make-special (name)
5076 (ebnf-make-terminal1 name
5077 'ebnf-generate-special
5078 'ebnf-special-dimension))
5081 (defun ebnf-make-terminal1 (name gen-func dim-func)
5088 (let ((len (length name)))
5089 (cond ((> len 2) name)
5090 ((= len 2) (concat " " name))
5091 ((= len 1) (concat " " name " "))
5096 (defun ebnf-make-one-or-more (list-part &optional sep-part)
5097 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5098 'ebnf-one-or-more-dimension
5103 (defun ebnf-make-zero-or-more (list-part &optional sep-part)
5104 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5105 'ebnf-zero-or-more-dimension
5110 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
5117 (if (listp list-part)
5118 (ebnf-make-sequence list-part)
5120 (if (and sep-part (listp sep-part))
5121 (ebnf-make-sequence sep-part)
5125 (defun ebnf-make-production (name prod action)
5126 (vector 'ebnf-generate-production
5128 'ebnf-production-dimension
5137 (defun ebnf-make-alternative (body)
5138 (vector 'ebnf-generate-alternative
5139 'ebnf-alternative-width
5140 'ebnf-alternative-dimension
5147 (defun ebnf-make-optional (body)
5148 (vector 'ebnf-generate-optional
5149 'ebnf-alternative-width
5150 'ebnf-optional-dimension
5157 (defun ebnf-make-except (factor exception)
5158 (vector 'ebnf-generate-except
5160 'ebnf-except-dimension
5168 (defun ebnf-make-repeat (times primary)
5169 (vector 'ebnf-generate-repeat
5171 'ebnf-repeat-dimension
5179 (defun ebnf-make-sequence (seq)
5180 (vector 'ebnf-generate-sequence
5181 'ebnf-sequence-width
5182 'ebnf-sequence-dimension
5189 (defun ebnf-make-dup-sequence (node seq)
5190 (vector 'ebnf-generate-sequence
5191 'ebnf-sequence-width
5192 'ebnf-sequence-dimension
5193 (ebnf-node-entry node)
5194 (ebnf-node-height node)
5195 (ebnf-node-width node)
5199 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5200 ;; Optimizers used by parsers
5203 (defun ebnf-token-except (element exception)
5206 (setq exception (cdr exception)))
5207 (and element ; EMPTY - A ==> EMPTY
5208 (let ((kind (ebnf-node-kind element)))
5211 ((and (null exception)
5212 (eq kind 'ebnf-generate-optional))
5213 (ebnf-node-list element))
5214 ;; { A }- ==> { A }+
5215 ((and (null exception)
5216 (eq kind 'ebnf-generate-zero-or-more))
5217 (ebnf-node-kind element 'ebnf-generate-one-or-more)
5218 (ebnf-node-dimension-func element 'ebnf-one-or-more-dimension)
5220 ;; ( A | EMPTY )- ==> A
5221 ;; ( A | B | EMPTY )- ==> A | B
5222 ((and (null exception)
5223 (eq kind 'ebnf-generate-alternative)
5225 (car (last (ebnf-node-list element))))
5226 'ebnf-generate-empty))
5227 (let ((elt (ebnf-node-list element))
5233 ;; this should not happen!!?!
5234 (setq element (ebnf-make-empty
5235 (ebnf-node-width element)))
5237 (setq elt (ebnf-node-list element))
5238 (and (= (length elt) 1)
5239 (setq element (car elt))))
5243 (ebnf-make-except element exception))
5247 (defun ebnf-token-repeat (times repeat)
5248 (if (null (cdr repeat))
5249 ;; n * EMPTY ==> EMPTY
5253 (ebnf-make-repeat times (cdr repeat)))))
5256 (defun ebnf-token-optional (body)
5257 (let ((kind (ebnf-node-kind body)))
5259 ;; [ EMPTY ] ==> EMPTY
5260 ((eq kind 'ebnf-generate-empty)
5262 ;; [ { A }* ] ==> { A }*
5263 ((eq kind 'ebnf-generate-zero-or-more)
5265 ;; [ { A }+ ] ==> { A }*
5266 ((eq kind 'ebnf-generate-one-or-more)
5267 (ebnf-node-kind body 'ebnf-generate-zero-or-more)
5269 ;; [ A | B ] ==> A | B | EMPTY
5270 ((eq kind 'ebnf-generate-alternative)
5271 (ebnf-node-list body (nconc (ebnf-node-list body)
5272 (list (ebnf-make-empty))))
5276 (ebnf-make-optional body))
5280 (defun ebnf-token-alternative (body sequence)
5284 (cons (car sequence)
5286 (cons (car sequence)
5287 (let ((seq (cdr sequence)))
5288 (if (and (= (length body) 1) (null seq))
5290 (ebnf-make-alternative (nreverse (if seq
5295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5296 ;; Variables used by parsers
5299 (defconst ebnf-comment-table
5300 (let ((table (make-vector 256 nil)))
5301 ;; Override special comment character:
5302 (aset table ?< 'newline)
5303 (aset table ?> 'keep-line)
5305 "Vector used to map characters to a special comment token.")
5308 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5309 ;; To make this file smaller, some commands go in a separate file.
5310 ;; But autoload them here to make the separation invisible.
5312 (autoload 'ebnf-bnf-parser "ebnf-bnf"
5315 (autoload 'ebnf-bnf-initialize "ebnf-bnf"
5316 "Initialize EBNF token table.")
5318 (autoload 'ebnf-iso-parser "ebnf-iso"
5321 (autoload 'ebnf-iso-initialize "ebnf-iso"
5322 "Initialize ISO EBNF token table.")
5324 (autoload 'ebnf-yac-parser "ebnf-yac"
5325 "Yacc/Bison parser.")
5327 (autoload 'ebnf-yac-initialize "ebnf-yac"
5328 "Initializations for Yacc/Bison parser.")
5330 (autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
5331 "Eliminate empty rules.")
5333 (autoload 'ebnf-optimize "ebnf-otz"
5334 "Syntatic chart optimizer.")
5336 (autoload 'ebnf-otz-initialize "ebnf-otz"
5337 "Initialize optimizer.")
5340 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5346 ;;; ebnf2ps.el ends here