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: <99/12/11 21:41:24 vinicius>
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
28 (defconst ebnf-version "3.1"
29 "ebnf2ps.el, v 3.1 <99/12/11 vinicius>
31 Vinicius's last change version. When reporting bugs, please also
32 report the version of Emacs, if any, that ebnf2ps was running with.
34 Please send all bug fixes and enhancements to
35 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
41 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
46 ;; This package translates an EBNF to a syntatic chart on PostScript.
48 ;; To use ebnf2ps, insert in your ~/.emacs:
52 ;; ebnf2ps uses ps-print package (version 3.05.1 or later), so see ps-print to
53 ;; know how to set options like landscape printing, page headings, margins, etc.
55 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
56 ;; ebnf2ps, they behave as it's turned off.
58 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
60 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
62 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
64 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
70 ;; ebnf2ps provides six commands for generating PostScript syntatic chart images
80 ;; These commands all perform essentially the same function: they generate
81 ;; PostScript syntatic chart images suitable for printing on a PostScript
82 ;; printer or displaying with GhostScript. These commands are collectively
83 ;; referred to as "ebnf- commands".
85 ;; The word "print", "spool" and "eps" in the command name determines when the
86 ;; PostScript image is sent to the printer (or file):
88 ;; print - The PostScript image is immediately sent to the printer;
90 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
91 ;; Many images may be spooled locally before printing them. To
92 ;; send the spooled images to the printer, use the command
95 ;; eps - The PostScript image is immediately sent to a EPS file.
97 ;; The spooling mechanism is the same as used by ps-print and was designed for
98 ;; printing lots of small files to save paper that would otherwise be wasted on
99 ;; banner pages, and to make it easier to find your output at the printer (it's
100 ;; easier to pick up one 50-page printout than to find 50 single-page
101 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
102 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
104 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
105 ;; won't accidentally quit from Emacs while you have unprinted PostScript
106 ;; waiting in the spool buffer. If you do attempt to exit with spooled
107 ;; PostScript, you'll be asked if you want to print it, and if you decline,
108 ;; you'll be asked to confirm the exit; this is modeled on the confirmation that
109 ;; Emacs uses for modified buffers.
111 ;; The word "buffer" or "region" in the command name determines how much of the
112 ;; buffer is printed:
114 ;; buffer - Print the entire buffer.
116 ;; region - Print just the current region.
118 ;; Two ebnf- command examples:
120 ;; ebnf-print-buffer - translate and print the entire buffer, and send
121 ;; it immediately to the printer.
123 ;; ebnf-spool-region - translate and print just the current region, and
124 ;; spool the image in Emacs to send to the printer
127 ;; Note that `ebnf-eps-buffer' and `ebnf-eps-region' never spool the EPS image,
128 ;; so they don't use the ps-print spooling mechanism. See section "Actions in
129 ;; Comments" for an explanation about EPS file generation.
135 ;; To translate and print your buffer, type
137 ;; M-x ebnf-print-buffer
139 ;; or substitute one of the other four ebnf- commands. The command will
140 ;; generate the PostScript image and print or spool it as specified. By giving
141 ;; the command a prefix argument
143 ;; C-u M-x ebnf-print-buffer
145 ;; it will save the PostScript image to a file instead of sending it to the
146 ;; printer; you will be prompted for the name of the file to save the image to.
147 ;; The prefix argument is ignored by the commands that spool their images, but
148 ;; you may save the spooled images to a file by giving a prefix argument to
151 ;; C-u M-x ebnf-despool
153 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
156 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
157 ;; `ebnf-eps-region'.
159 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
161 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
162 ;; (global-set-key '(shift f22) 'ebnf-print-region)
163 ;; (global-set-key '(control f22) 'ebnf-despool)
169 ;; The current EBNF that ebnf2ps accepts has the following constructions:
171 ;; ; comment (until end of line)
175 ;; $A default non-terminal (see text below)
176 ;; $"C" default terminal (see text below)
177 ;; $?C? default special (see text below)
178 ;; A = B. production (A is the header and B the body)
179 ;; C D sequence (C occurs before D)
180 ;; C | D alternative (C or D occurs)
181 ;; A - B exception (A excluding B, B without any non-terminal)
182 ;; n * A repetition (A repeats n (integer) times)
183 ;; (C) group (expression C is grouped together)
184 ;; [C] optional (C may or not occurs)
185 ;; C+ one or more occurrences of C
186 ;; {C}+ one or more occurrences of C
187 ;; {C}* zero or more occurrences of C
188 ;; {C} zero or more occurrences of C
189 ;; C / D equivalent to: C {D C}*
190 ;; {C || D}+ equivalent to: C {D C}*
191 ;; {C || D}* equivalent to: [C {D C}*]
192 ;; {C || D} equivalent to: [C {D C}*]
194 ;; The EBNF syntax written using the notation above is:
196 ;; EBNF = {production}+.
198 ;; production = non_terminal "=" body ".". ;; production
200 ;; body = {sequence || "|"}*. ;; alternative
202 ;; sequence = {exception}*. ;; sequence
204 ;; exception = repeat [ "-" repeat]. ;; exception
206 ;; repeat = [ integer "*" ] term. ;; repetition
209 ;; | [factor] "+" ;; one-or-more
210 ;; | [factor] "/" [factor] ;; one-or-more
213 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
214 ;; | [ "$" ] non_terminal ;; non-terminal
215 ;; | [ "$" ] "?" special "?" ;; special
216 ;; | "(" body ")" ;; group
217 ;; | "[" body "]" ;; zero-or-one
218 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
219 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
220 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
223 ;; non_terminal = "[A-Za-z\\240-\\377][!#%&'*-,0-:<>@-Z\\^-z~\\240-\\377]*".
225 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
227 ;; special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*".
229 ;; integer = "[0-9]+".
231 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
233 ;; Try to use the above EBNF to test ebnf2ps.
235 ;; The `default' terminal, non-terminal and special is a way to indicate a
236 ;; default path in a production. For example, the production:
238 ;; X = [ $A ( B | $C ) | D ].
240 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
242 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
243 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
244 ;; name besides that enclosed by `"'.
246 ;; Let's see an example:
248 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
249 ;; (setq ebnf-case-fold-search nil) ; exact matching
251 ;; If you have the production:
253 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
255 ;; The names are classified as:
257 ;; Logical Expression non-terminal
258 ;; "(" OR AND "XOR" ")" terminal
260 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default value
261 ;; is ?\; (character `;').
263 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
264 ;; value is ?. (character `.').
266 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
268 ;; `ebnf' ebnf2ps recognizes the syntax described above.
269 ;; The following variables *ONLY* have effect with this
271 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
272 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
274 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
275 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
276 ;; ("International Standard of the ISO EBNF Notation").
277 ;; The following variables *ONLY* have effect with this
279 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
281 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
282 ;; The following variable *ONLY* has effect with this
284 ;; `ebnf-yac-ignore-error-recovery'.
286 ;; Any other value is treated as `ebnf'.
288 ;; The default value is `ebnf'.
294 ;; The following EBNF optimizations are done:
296 ;; [ { A }* ] ==> { A }*
297 ;; [ { A }+ ] ==> { A }*
298 ;; [ A ] + ==> { A }*
299 ;; { A }* + ==> { A }*
300 ;; { A }+ + ==> { A }+
303 ;; ( A | EMPTY )- ==> A
304 ;; ( A | B | EMPTY )- ==> A | B
305 ;; [ A | B ] ==> A | B | EMPTY
306 ;; n * EMPTY ==> EMPTY
308 ;; EMPTY / EMPTY ==> EMPTY
309 ;; EMPTY - A ==> EMPTY
311 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
314 ;; 1. A = B | A C. ==> A = B {C}*.
315 ;; 2. A = B | A B. ==> A = {B}+.
316 ;; 3. A = | A B. ==> A = {B}*.
317 ;; 4. A = B | A C B. ==> A = {B || C}+.
318 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
321 ;; 6. A = B | . ==> A = [B].
322 ;; 7. A = | B . ==> A = [B].
325 ;; 8. A = B C | B D. ==> A = B (C | D).
326 ;; 9. A = C B | D B. ==> A = (C | D) B.
327 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
329 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
335 ;; You may use form feed (^L \014) to force a production to start on a new page,
345 ;; c) A = B ^L^L^L | C.^L
349 ;; In all examples above, only the production X will start on a new page.
352 ;; Actions in Comments
353 ;; -------------------
355 ;; ebnf2ps accepts the following actions in comments:
357 ;; ;> the next production starts in the same line as the current one.
358 ;; It is useful when `ebnf-horizontal-orientation' is nil.
360 ;; ;< the next production starts in the next line.
361 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
363 ;; ;[EPS open a new EPS file. The EPS file name has the form:
364 ;; <PREFIX><NAME>.eps
365 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and <NAME>
366 ;; is the string given by ;[ action comment, this string is mapped
367 ;; to form a valid file name (see documentation for
368 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
369 ;; It has effect only during `ebnf-eps-buffer' or
370 ;; `ebnf-eps-region' execution.
371 ;; It's an error to try to open an already opened EPS file.
373 ;; ;]EPS close an opened EPS file.
374 ;; It has effect only during `ebnf-eps-buffer' or
375 ;; `ebnf-eps-region' execution.
376 ;; It's an error to try to close a not opened EPS file.
380 ;; (setq ebnf-horizontal-orientation nil)
384 ;; ;> C and B are drawn in the same line
388 ;; The graphical result is:
394 ;; +---------+ +-----+
406 ;; Note that if ascending production sort is used, the productions A and B will
407 ;; be drawn in the same line instead of C and B.
409 ;; If consecutive actions occur, only the last one takes effect, so if you have:
417 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
420 ;; In ISO EBNF the above actions are specified as (*>*), (*<*), (*[EPS*) and
421 ;; (*]EPS*). The first example above should be written:
425 ;; (*> C and B are drawn in the same line *)
429 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
430 ;; `ebnf-eps-region':
449 ;; The following table summarizes the results:
451 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
452 ;; ebnf--AA.eps A C A C C A
453 ;; ebnf--BB.eps C B B C C B
454 ;; ebnf--CC.eps A C B F A B C F F C B A
460 ;; As you can see if EPS actions is not used, each single production is
461 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
462 ;; it's not an existing production name.
464 ;; In the following case:
472 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
478 ;; Some tools are provided to help you.
480 ;; `ebnf-setup' returns the current setup.
482 ;; `ebnf-syntax-buffer' does a syntatic analysis of your EBNF in the current
485 ;; `ebnf-syntax-region' does a syntatic analysis of your EBNF in the current
488 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
490 ;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound
491 ;; to keys in the same way as `ebnf-' commands.
497 ;; ebn2ps has the following hook variables:
500 ;; It is evaluated once before any ebnf2ps process.
502 ;; `ebnf-production-hook'
503 ;; It is evaluated on each beginning of production.
506 ;; It is evaluated on each beginning of page.
512 ;; Below it's shown a brief description of ebnf2ps options, please, see the
513 ;; options declaration in the code for a long documentation.
515 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
518 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
519 ;; height in horizontal orientation.
521 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
522 ;; between productions.
524 ;; `ebnf-production-vertical-space' Specify vertical space in points between
527 ;; `ebnf-justify-sequence' Specify justification of terms in a
528 ;; sequence inside alternatives.
530 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
532 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
534 ;; `ebnf-terminal-font' Specify terminal font.
536 ;; `ebnf-terminal-shape' Specify terminal box shape.
538 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
541 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
543 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
545 ;; `ebnf-sort-production' Specify how productions are sorted.
547 ;; `ebnf-production-font' Specify production font.
549 ;; `ebnf-non-terminal-font' Specify non-terminal font.
551 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
553 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will have
556 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
559 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
562 ;; `ebnf-special-font' Specify special font.
564 ;; `ebnf-special-shape' Specify special box shape.
566 ;; `ebnf-special-shadow' Non-nil means special box will have a
569 ;; `ebnf-special-border-width' Specify border width for special box.
571 ;; `ebnf-special-border-color' Specify border color for special box.
573 ;; `ebnf-except-font' Specify except font.
575 ;; `ebnf-except-shape' Specify except box shape.
577 ;; `ebnf-except-shadow' Non-nil means except box will have a
580 ;; `ebnf-except-border-width' Specify border width for except box.
582 ;; `ebnf-except-border-color' Specify border color for except box.
584 ;; `ebnf-repeat-font' Specify repeat font.
586 ;; `ebnf-repeat-shape' Specify repeat box shape.
588 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
591 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
593 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
595 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
597 ;; `ebnf-arrow-shape' Specify the arrow shape.
599 ;; `ebnf-chart-shape' Specify chart flow shape.
601 ;; `ebnf-color-p' Non-nil means use color.
603 ;; `ebnf-line-width' Specify flow line width.
605 ;; `ebnf-line-color' Specify flow line color.
607 ;; `ebnf-user-arrow' Specify a user arrow shape (a PostScript
610 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
613 ;; `ebnf-lex-comment-char' Specify the line comment character.
615 ;; `ebnf-lex-eop-char' Specify the end of production character.
617 ;; `ebnf-syntax' Specify syntax to be recognized.
619 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
621 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
624 ;; `ebnf-default-width' Specify additional border width over
625 ;; default terminal, non-terminal or
628 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
630 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
632 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
634 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
636 ;; `ebnf-optimize' Non-nil means optimize syntatic chart of
639 ;; To set the above options you may:
641 ;; a) insert the code in your ~/.emacs, like:
643 ;; (setq ebnf-terminal-shape 'bevel)
645 ;; This way always keep your default settings when you enter a new Emacs
648 ;; b) or use `set-variable' in your Emacs session, like:
650 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
652 ;; This way keep your settings only during the current Emacs session.
654 ;; c) or use customization, for example:
655 ;; click on menu-bar *Help* option,
656 ;; then click on *Customize*,
657 ;; then click on *Browse Customization Groups*,
658 ;; expand *PostScript* group,
659 ;; expand *Ebnf2ps* group
660 ;; and then customize ebnf2ps options.
661 ;; Through this way, you may choose if the settings are kept or not when
662 ;; you leave out the current Emacs session.
664 ;; d) or see the option value:
666 ;; C-h v ebnf-terminal-shape RET
668 ;; and click the *customize* hypertext button.
669 ;; Through this way, you may choose if the settings are kept or not when
670 ;; you leave out the current Emacs session.
674 ;; M-x ebnf-customize RET
676 ;; and then customize ebnf2ps options.
677 ;; Through this way, you may choose if the settings are kept or not when
678 ;; you leave out the current Emacs session.
684 ;; Sometimes you need to change the EBNF style you are using, for example,
685 ;; change the shapes and colors. These changes may force you to set some
686 ;; variables and after use, set back the variables to the old values.
688 ;; To help to handle this situation, ebnf2ps has the following commands to
691 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
694 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
696 ;; `ebnf-apply-style' Set STYLE to current style.
698 ;; `ebnf-reset-style' Reset current style.
700 ;; `ebnf-push-style' Push the current style and set STYLE to current style.
702 ;; `ebnf-pop-style' Pop a style and set it to current style.
704 ;; These commands helps to put together a lot of variable settings in a group
705 ;; and name this group. So when you wish to apply these settings it's only
706 ;; needed to give the name.
708 ;; There is also a notion of simple inheritance of style; so if you declare that
709 ;; a style A inherits from a style B, all settings of B is applied first and
710 ;; then the settings of A is applied. This is useful when you wish to modify
711 ;; some aspects of an existing style, but at same time wish to keep it
714 ;; See documentation for `ebnf-style-database'.
720 ;; Below it is the layout of minimum area to draw each element, and it's used
721 ;; the following terms:
723 ;; font height is given by:
724 ;; (terminal font height + non-terminal font height) / 2
726 ;; entry is the vertical position used to know where it should be
727 ;; drawn the flow line in the current element.
730 ;; * SPECIAL, TERMINAL and NON-TERMINAL
732 ;; +==============+...................................
733 ;; | | } font height / 2 } entry }
734 ;; | XXXXXXXX...|....... } }
735 ;; ====+ XXXXXXXX +==== } text height ...... } height
736 ;; : | XXXXXXXX...|...:... }
737 ;; : | : : | : } font height / 2 }
738 ;; : +==============+...:...............................
740 ;; : : : : : :......................
741 ;; : : : : : } font height }
742 ;; : : : : :....... }
743 ;; : : : : } font height / 2 }
744 ;; : : : :........... }
745 ;; : : : } text width } width
746 ;; : : :.................. }
747 ;; : : } font height / 2 }
748 ;; : :...................... }
750 ;; :.............................................
755 ;; +==========+.....................................
759 ;; ===+===+ +===+===... } element height } height
762 ;; : | +==========+.|................. }
763 ;; : | : : | : } font height }
764 ;; : +==============+...................................
766 ;; : : : :......................
767 ;; : : : } font height * 2 }
769 ;; : : } element width } width
770 ;; : :..................... }
771 ;; : } font height * 2 }
772 ;; :...............................................
777 ;; +===+...................................
778 ;; +==+ A +==+ } A height } }
779 ;; | +===+..|........ } entry }
780 ;; + + } font height } }
781 ;; / +===+...\....... } }
782 ;; ===+====+ B +====+=== } B height ..... } height
783 ;; : \ +===+.../....... }
784 ;; : + + : } font height }
785 ;; : | +===+..|........ }
786 ;; : +==+ C +==+ : } C height }
787 ;; : : +===+...................................
789 ;; : : : :......................
790 ;; : : : } font height * 2 }
792 ;; : : } max width } width
793 ;; : :................. }
794 ;; : } font height * 2 }
795 ;; :..........................................
798 ;; 1. An empty alternative has zero of height.
800 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
806 ;; +===========+...............................
807 ;; +=+ separator +=+ } separator height }
808 ;; / +===========+..\........ }
810 ;; | | } font height }
812 ;; \ +===========+../........ } height = entry
813 ;; +=+ element +=+ } element height }
814 ;; /: +===========+..\........ }
816 ;; + : : + } font height }
818 ;; ==+=======================+==.......................
820 ;; : : : :.......................
821 ;; : : : } font height * 2 }
823 ;; : : } max width } width
824 ;; : :......................... }
825 ;; : } font height * 2 }
826 ;; :...................................................
831 ;; +===========+......................................
832 ;; +=+ separator +=+ } separator height } }
833 ;; / +===========+..\...... } }
835 ;; | | } font height } } height
837 ;; \ +===========+../...... } }
838 ;; ===+=+ element +=+=== } element height .... }
839 ;; : : +===========+......................................
841 ;; : : : :........................
842 ;; : : : } font height * 2 }
844 ;; : : } max width } width
845 ;; : :....................... }
846 ;; : } font height * 2 }
847 ;; :..............................................
852 ;; XXXXXX:......................................
853 ;; XXXXXX: } production font height }
854 ;; XXXXXX:............ }
856 ;; +======+....... } height = entry
858 ;; ====+ +==== } element height }
860 ;; : +======+.................................
862 ;; : : : :......................
863 ;; : : : } font height * 2 }
865 ;; : : } element width } width
866 ;; : :.............. }
867 ;; : } font height * 2 }
868 ;; :.....................................
873 ;; +================+...................................
874 ;; | | } font height / 2 } entry }
875 ;; | +===+...|....... } }
876 ;; ====+ N * | X | +==== } X height ......... } height
877 ;; : | : : +===+...|...:... }
878 ;; : | : : : : | : } font height / 2 }
879 ;; : +================+...:...............................
881 ;; : : : : : : : :......................
882 ;; : : : : : : : } font height }
883 ;; : : : : : : :....... }
884 ;; : : : : : : } font height / 2 }
885 ;; : : : : : :........... }
886 ;; : : : : : } X width }
887 ;; : : : : :............... }
888 ;; : : : : } font height / 2 } width
889 ;; : : : :.................. }
890 ;; : : : } text width }
891 ;; : : :..................... }
892 ;; : : } font height / 2 }
893 ;; : :........................ }
895 ;; :...............................................
900 ;; +==================+...................................
901 ;; | | } font height / 2 } entry }
902 ;; | +===+ +===+...|....... } }
903 ;; ====+ | X | - | y | +==== } max height ....... } height
904 ;; : | +===+ +===+...|...:... }
905 ;; : | : : : : | : } font height / 2 }
906 ;; : +==================+...:...............................
908 ;; : : : : : : : :......................
909 ;; : : : : : : : } font height }
910 ;; : : : : : : :....... }
911 ;; : : : : : : } font height / 2 }
912 ;; : : : : : :........... }
913 ;; : : : : : } Y width }
914 ;; : : : : :............... }
915 ;; : : : : } font height } width
916 ;; : : : :................... }
918 ;; : : :....................... }
919 ;; : : } font height / 2 }
920 ;; : :.......................... }
922 ;; :.................................................
924 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
927 ;; Internal Structures
928 ;; -------------------
930 ;; ebnf2ps has two passes. The first pass does a lexical and syntatic analysis
931 ;; of current buffer and generates an intermediate representation. The second
932 ;; pass uses the intermediate representation to generate the PostScript syntatic
935 ;; The intermediate representation is a list of vectors, the vector element
936 ;; represents a syntatic chart element. Below is a vector representation for
937 ;; each syntatic chart element.
939 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
940 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
941 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
942 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
943 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
944 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
945 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
946 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
947 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
948 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
949 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
950 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
952 ;; The first vector position is a function symbol used to generate PostScript
954 ;; WIDTH-FUN is a function symbol called to adjust the element width.
955 ;; DIM-FUN is a function symbol called to set the element dimensions.
956 ;; ENTRY is the element entry point.
957 ;; HEIGHT and WIDTH are the element height and width, respectively.
958 ;; NAME is a string that it's the element name.
959 ;; DEFAULT is a boolean that indicates if it's a `default' element.
960 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
962 ;; LIST is a list of vector that represents the list part for alternatives and
964 ;; SEPARATOR is a vector that represents the sub-element used to separate the
966 ;; TIMES is a string representing the number of times that ELEMENT is repeated
967 ;; on a repeat construction.
968 ;; ACTION indicates some action that should be done before production is
969 ;; generated. The current actions are:
973 ;; form-feed current production starts on a new page.
975 ;; newline current production starts on next line, this is useful
976 ;; when `ebnf-horizontal-orientation' is non-nil.
978 ;; keep-line current production continues on the current line, this
979 ;; is useful when `ebnf-horizontal-orientation' is nil.
985 ;; . Handle situations when syntatic chart is out of paper.
986 ;; . Use other alphabet than ascii.
987 ;; . Optimizations...
993 ;; Thanks to all who emailed comments.
996 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1003 (and (string< ps-print-version "3.05.1")
1004 (error "`ebnf2ps' requires `ps-print' package version 3.05.1 or later"))
1007 ;; temporary fix for ps-print
1008 (or (fboundp 'set-buffer-multibyte)
1009 (defun set-buffer-multibyte (arg)
1010 (setq enable-multibyte-characters arg)))
1012 (or (fboundp 'string-as-unibyte)
1013 (defun string-as-unibyte (arg) arg))
1015 (or (fboundp 'string-as-multibyte)
1016 (defun string-as-multibyte (arg) arg))
1018 (or (fboundp 'charset-after)
1019 (defun charset-after (&optional arg)
1020 (char-charset (char-after arg))))
1023 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1027 ;;; Interface to the command system
1029 (defgroup postscript nil
1035 (defgroup ebnf2ps nil
1036 "Translate an EBNF to a syntatic chart on PostScript"
1042 (defgroup ebnf-special nil
1043 "Special customization"
1049 (defgroup ebnf-except nil
1050 "Except customization"
1056 (defgroup ebnf-repeat nil
1057 "Repeat customization"
1063 (defgroup ebnf-terminal nil
1064 "Terminal customization"
1070 (defgroup ebnf-non-terminal nil
1071 "Non-Terminal customization"
1077 (defgroup ebnf-production nil
1078 "Production customization"
1084 (defgroup ebnf-shape nil
1085 "Shapes customization"
1091 (defgroup ebnf-displacement nil
1092 "Displacement customization"
1098 (defgroup ebnf-syntatic nil
1099 "Syntatic customization"
1105 (defgroup ebnf-optimization nil
1106 "Optimization customization"
1112 (defcustom ebnf-horizontal-orientation nil
1113 "*Non-nil means productions are drawn horizontally."
1115 :group 'ebnf-displacement)
1118 (defcustom ebnf-horizontal-max-height nil
1119 "*Non-nil means to use maximum production height in horizontal orientation.
1121 It is only used when `ebnf-horizontal-orientation' is non-nil."
1123 :group 'ebnf-displacement)
1126 (defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
1127 "*Specify horizontal space in points between productions.
1129 Value less or equal to zero forces ebnf2ps to set a proper default value."
1131 :group 'ebnf-displacement)
1134 (defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
1135 "*Specify vertical space in points between productions.
1137 Value less or equal to zero forces ebnf2ps to set a proper default value."
1139 :group 'ebnf-displacement)
1142 (defcustom ebnf-justify-sequence 'center
1143 "*Specify justification of terms in a sequence inside alternatives.
1147 `left' left justification
1148 `right' right justification
1149 any other value centralize"
1150 :type '(radio :tag "Sequence Justification"
1151 (const left) (const right) (other :tag "center" center))
1152 :group 'ebnf-displacement)
1155 (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
1156 "*Specify special font.
1158 See documentation for `ebnf-production-font'."
1159 :type '(list :tag "Special Font"
1160 (number :tag "Font Size")
1161 (symbol :tag "Font Name")
1162 (choice :tag "Foreground Color"
1163 (string :tag "Name")
1164 (other :tag "Default" nil))
1165 (choice :tag "Background Color"
1166 (string :tag "Name")
1167 (other :tag "Default" nil))
1168 (repeat :tag "Font Attributes" :inline t
1169 (choice (const bold) (const italic)
1170 (const underline) (const strikeout)
1171 (const overline) (const shadow)
1172 (const box) (const outline))))
1173 :group 'ebnf-special)
1176 (defcustom ebnf-special-shape 'bevel
1177 "*Specify special box shape.
1179 See documentation for `ebnf-non-terminal-shape'."
1180 :type '(radio :tag "Special Shape"
1181 (const miter) (const round) (const bevel))
1182 :group 'ebnf-special)
1185 (defcustom ebnf-special-shadow nil
1186 "*Non-nil means special box will have a shadow."
1188 :group 'ebnf-special)
1191 (defcustom ebnf-special-border-width 0.5
1192 "*Specify border width for special box."
1194 :group 'ebnf-special)
1197 (defcustom ebnf-special-border-color "Black"
1198 "*Specify border color for special box."
1200 :group 'ebnf-special)
1203 (defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
1204 "*Specify except font.
1206 See documentation for `ebnf-production-font'."
1207 :type '(list :tag "Except Font"
1208 (number :tag "Font Size")
1209 (symbol :tag "Font Name")
1210 (choice :tag "Foreground Color"
1211 (string :tag "Name")
1212 (other :tag "Default" nil))
1213 (choice :tag "Background Color"
1214 (string :tag "Name")
1215 (other :tag "Default" nil))
1216 (repeat :tag "Font Attributes" :inline t
1217 (choice (const bold) (const italic)
1218 (const underline) (const strikeout)
1219 (const overline) (const shadow)
1220 (const box) (const outline))))
1221 :group 'ebnf-except)
1224 (defcustom ebnf-except-shape 'bevel
1225 "*Specify except box shape.
1227 See documentation for `ebnf-non-terminal-shape'."
1228 :type '(radio :tag "Except Shape"
1229 (const miter) (const round) (const bevel))
1230 :group 'ebnf-except)
1233 (defcustom ebnf-except-shadow nil
1234 "*Non-nil means except box will have a shadow."
1236 :group 'ebnf-except)
1239 (defcustom ebnf-except-border-width 0.25
1240 "*Specify border width for except box."
1242 :group 'ebnf-except)
1245 (defcustom ebnf-except-border-color "Black"
1246 "*Specify border color for except box."
1248 :group 'ebnf-except)
1251 (defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
1252 "*Specify repeat font.
1254 See documentation for `ebnf-production-font'."
1255 :type '(list :tag "Repeat Font"
1256 (number :tag "Font Size")
1257 (symbol :tag "Font Name")
1258 (choice :tag "Foreground Color"
1259 (string :tag "Name")
1260 (other :tag "Default" nil))
1261 (choice :tag "Background Color"
1262 (string :tag "Name")
1263 (other :tag "Default" nil))
1264 (repeat :tag "Font Attributes" :inline t
1265 (choice (const bold) (const italic)
1266 (const underline) (const strikeout)
1267 (const overline) (const shadow)
1268 (const box) (const outline))))
1269 :group 'ebnf-repeat)
1272 (defcustom ebnf-repeat-shape 'bevel
1273 "*Specify repeat box shape.
1275 See documentation for `ebnf-non-terminal-shape'."
1276 :type '(radio :tag "Repeat Shape"
1277 (const miter) (const round) (const bevel))
1278 :group 'ebnf-repeat)
1281 (defcustom ebnf-repeat-shadow nil
1282 "*Non-nil means repeat box will have a shadow."
1284 :group 'ebnf-repeat)
1287 (defcustom ebnf-repeat-border-width 0.0
1288 "*Specify border width for repeat box."
1290 :group 'ebnf-repeat)
1293 (defcustom ebnf-repeat-border-color "Black"
1294 "*Specify border color for repeat box."
1296 :group 'ebnf-repeat)
1299 (defcustom ebnf-terminal-font '(7 Courier "Black" "White")
1300 "*Specify terminal font.
1302 See documentation for `ebnf-production-font'."
1303 :type '(list :tag "Terminal Font"
1304 (number :tag "Font Size")
1305 (symbol :tag "Font Name")
1306 (choice :tag "Foreground Color"
1307 (string :tag "Name")
1308 (other :tag "Default" nil))
1309 (choice :tag "Background Color"
1310 (string :tag "Name")
1311 (other :tag "Default" nil))
1312 (repeat :tag "Font Attributes" :inline t
1313 (choice (const bold) (const italic)
1314 (const underline) (const strikeout)
1315 (const overline) (const shadow)
1316 (const box) (const outline))))
1317 :group 'ebnf-terminal)
1320 (defcustom ebnf-terminal-shape 'miter
1321 "*Specify terminal box shape.
1323 See documentation for `ebnf-non-terminal-shape'."
1324 :type '(radio :tag "Terminal Shape"
1325 (const miter) (const round) (const bevel))
1326 :group 'ebnf-terminal)
1329 (defcustom ebnf-terminal-shadow nil
1330 "*Non-nil means terminal box will have a shadow."
1332 :group 'ebnf-terminal)
1335 (defcustom ebnf-terminal-border-width 1.0
1336 "*Specify border width for terminal box."
1338 :group 'ebnf-terminal)
1341 (defcustom ebnf-terminal-border-color "Black"
1342 "*Specify border color for terminal box."
1344 :group 'ebnf-terminal)
1347 (defcustom ebnf-sort-production nil
1348 "*Specify how productions are sorted.
1352 nil don't sort productions.
1353 `ascending' ascending sort.
1354 any other value descending sort."
1355 :type '(radio :tag "Production Sort"
1356 (const :tag "Ascending" ascending)
1357 (const :tag "Descending" descending)
1358 (other :tag "No Sort" nil))
1359 :group 'ebnf-production)
1362 (defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
1363 "*Specify production header font.
1365 It is a list with the following form:
1367 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1370 SIZE is the font size.
1371 NAME is the font name symbol.
1372 ATTRIBUTE is one of the following symbols:
1373 bold - use bold font.
1374 italic - use italic font.
1375 underline - put a line under text.
1376 strikeout - like underline, but the line is in middle of text.
1377 overline - like underline, but the line is over the text.
1378 shadow - text will have a shadow.
1379 box - text will be surrounded by a box.
1380 outline - print characters as hollow outlines.
1381 FOREGROUND is a foreground string color name; if it's nil, the default color is
1383 BACKGROUND is a background string color name; if it's nil, the default color is
1386 See `ps-font-info-database' for valid font name."
1387 :type '(list :tag "Production Font"
1388 (number :tag "Font Size")
1389 (symbol :tag "Font Name")
1390 (choice :tag "Foreground Color"
1391 (string :tag "Name")
1392 (other :tag "Default" nil))
1393 (choice :tag "Background Color"
1394 (string :tag "Name")
1395 (other :tag "Default" nil))
1396 (repeat :tag "Font Attributes" :inline t
1397 (choice (const bold) (const italic)
1398 (const underline) (const strikeout)
1399 (const overline) (const shadow)
1400 (const box) (const outline))))
1401 :group 'ebnf-production)
1404 (defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
1405 "*Specify non-terminal font.
1407 See documentation for `ebnf-production-font'."
1408 :type '(list :tag "Non-Terminal Font"
1409 (number :tag "Font Size")
1410 (symbol :tag "Font Name")
1411 (choice :tag "Foreground Color"
1412 (string :tag "Name")
1413 (other :tag "Default" nil))
1414 (choice :tag "Background Color"
1415 (string :tag "Name")
1416 (other :tag "Default" nil))
1417 (repeat :tag "Font Attributes" :inline t
1418 (choice (const bold) (const italic)
1419 (const underline) (const strikeout)
1420 (const overline) (const shadow)
1421 (const box) (const outline))))
1422 :group 'ebnf-non-terminal)
1425 (defcustom ebnf-non-terminal-shape 'round
1426 "*Specify non-terminal box shape.
1442 Any other value is treated as `miter'."
1443 :type '(radio :tag "Non-Terminal Shape"
1444 (const miter) (const round) (const bevel))
1445 :group 'ebnf-non-terminal)
1448 (defcustom ebnf-non-terminal-shadow nil
1449 "*Non-nil means non-terminal box will have a shadow."
1451 :group 'ebnf-non-terminal)
1454 (defcustom ebnf-non-terminal-border-width 1.0
1455 "*Specify border width for non-terminal box."
1457 :group 'ebnf-non-terminal)
1460 (defcustom ebnf-non-terminal-border-color "Black"
1461 "*Specify border color for non-terminal box."
1463 :group 'ebnf-non-terminal)
1466 (defcustom ebnf-arrow-shape 'hollow
1467 "*Specify the arrow shape.
1473 `semi-up' * `transparent' *
1481 `semi-down' =====* `hollow' *
1497 `user' See also documentation for variable `ebnf-user-arrow'.
1499 Any other value is treated as `none'."
1500 :type '(radio :tag "Arrow Shape"
1501 (const none) (const semi-up)
1502 (const semi-down) (const simple)
1503 (const transparent) (const hollow)
1504 (const full) (const user))
1508 (defcustom ebnf-chart-shape 'round
1509 "*Specify chart flow shape.
1511 See documentation for `ebnf-non-terminal-shape'."
1512 :type '(radio :tag "Chart Flow Shape"
1513 (const miter) (const round) (const bevel))
1517 (defcustom ebnf-user-arrow nil
1518 "*Specify a user arrow shape (a PostScript code).
1520 PostScript code should draw a right arrow.
1522 The anatomy of a right arrow is:
1524 ...... Initial position
1526 : *.................
1530 ======+======*... } hT2
1534 : *.................
1540 :.......................
1542 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can be
1543 used to generate your own arrow. As these variables are used along PostScript
1544 execution, *DON'T* modify the values of them. Instead, copy the values, if you
1545 need to modify them.
1547 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1549 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1552 See function `ebnf-user-arrow' for valid values and how values are processed."
1553 :type '(radio :tag "User Arrow Shape"
1564 (defcustom ebnf-syntax 'ebnf
1565 "*Specify syntax to be recognized.
1569 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1571 The following variables *ONLY* have effect with this
1573 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1574 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1576 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1577 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1578 (\"International Standard of the ISO EBNF Notation\").
1579 The following variables *ONLY* have effect with this
1581 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1583 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1584 The following variable *ONLY* has effect with this
1586 `ebnf-yac-ignore-error-recovery'.
1588 Any other value is treated as `ebnf'."
1589 :type '(radio :tag "Syntax"
1590 (const ebnf) (const iso-ebnf) (const yacc))
1591 :group 'ebnf-syntatic)
1594 (defcustom ebnf-lex-comment-char ?\;
1595 "*Specify the line comment character.
1597 It's used only when `ebnf-syntax' is `ebnf'."
1599 :group 'ebnf-syntatic)
1602 (defcustom ebnf-lex-eop-char ?.
1603 "*Specify the end of production character.
1605 It's used only when `ebnf-syntax' is `ebnf'."
1607 :group 'ebnf-syntatic)
1610 (defcustom ebnf-terminal-regexp nil
1611 "*Specify how it's a terminal name.
1613 If it's nil, the terminal name must be enclosed by `\"'.
1614 If it's a string, it should be a regexp that it'll be used to determine a
1615 terminal name; terminal name may also be enclosed by `\"'.
1617 It's used only when `ebnf-syntax' is `ebnf'."
1618 :type '(radio :tag "Terminal Name"
1620 :group 'ebnf-syntatic)
1623 (defcustom ebnf-case-fold-search nil
1624 "*Non-nil means ignore case on matching.
1626 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1629 :group 'ebnf-syntatic)
1632 (defcustom ebnf-iso-alternative-p nil
1633 "*Non-nil means use alternative ISO EBNF.
1635 It's only used when `ebnf-syntax' is `iso-ebnf'.
1637 This variable affects the following symbol set:
1639 STANDARD ALTERNATIVE
1647 :group 'ebnf-syntatic)
1650 (defcustom ebnf-iso-normalize-p nil
1651 "*Non-nil means normalize ISO EBNF syntax names.
1653 Normalize a name means that several contiguous spaces inside name become a
1654 single space, so \"A B C\" is normalized to \"A B C\".
1656 It's only used when `ebnf-syntax' is `iso-ebnf'."
1658 :group 'ebnf-syntatic)
1661 (defcustom ebnf-eps-prefix "ebnf--"
1662 "*Specify EPS prefix file name.
1664 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1669 (defcustom ebnf-entry-percentage 0.5 ; middle
1670 "*Specify entry height on alternatives.
1672 It must be a float between 0.0 (top) and 1.0 (bottom)."
1677 (defcustom ebnf-default-width 0.6
1678 "*Specify additional border width over default terminal, non-terminal or
1684 ;; Printing color requires x-color-values.
1685 (defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
1686 (fboundp 'color-instance-rgb-components)) ; XEmacs
1687 "*Non-nil means use color."
1692 (defcustom ebnf-line-width 1.0
1693 "*Specify flow line width."
1698 (defcustom ebnf-line-color "Black"
1699 "*Specify flow line color."
1704 (defcustom ebnf-debug-ps nil
1705 "*Non-nil means to generate PostScript debug procedures.
1707 It is intended to help PostScript programmers in debugging."
1712 (defcustom ebnf-use-float-format t
1713 "*Non-nil means use `%f' float format.
1715 The advantage of using float format is that ebnf2ps generates a little short
1718 If it occurs the error message:
1720 Invalid format operation %f
1722 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1727 (defcustom ebnf-yac-ignore-error-recovery nil
1728 "*Non-nil means ignore error recovery.
1730 It's only used when `ebnf-syntax' is `yacc'."
1732 :group 'ebnf-syntatic)
1735 (defcustom ebnf-ignore-empty-rule nil
1736 "*Non-nil means ignore empty rules.
1738 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1739 middle action rule."
1741 :group 'ebnf-optimization)
1744 (defcustom ebnf-optimize nil
1745 "*Non-nil means optimize syntatic chart of rules.
1747 The following optimizations are done:
1750 1. A = B | A C. ==> A = B {C}*.
1751 2. A = B | A B. ==> A = {B}+.
1752 3. A = | A B. ==> A = {B}*.
1753 4. A = B | A C B. ==> A = {B || C}+.
1754 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
1757 6. A = B | . ==> A = [B].
1758 7. A = | B . ==> A = [B].
1761 8. A = B C | B D. ==> A = B (C | D).
1762 9. A = C B | D B. ==> A = (C | D) B.
1763 10. A = B C E | B D E. ==> A = B (C | D) E.
1765 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
1767 :group 'ebnf-optimization)
1770 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1775 (defun ebnf-customize ()
1776 "Customization for ebnf group."
1778 (customize-group 'ebnf2ps))
1781 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1786 (defun ebnf-print-buffer (&optional filename)
1787 "Generate and print a PostScript syntatic chart image of the buffer.
1789 When called with a numeric prefix argument (C-u), prompts the user for
1790 the name of a file to save the PostScript image in, instead of sending
1793 More specifically, the FILENAME argument is treated as follows: if it
1794 is nil, send the image to the printer. If FILENAME is a string, save
1795 the PostScript image in a file with that name. If FILENAME is a
1796 number, prompt the user for the name of the file to save in."
1797 (interactive (list (ps-print-preprint current-prefix-arg)))
1798 (ebnf-print-region (point-min) (point-max) filename))
1802 (defun ebnf-print-region (from to &optional filename)
1803 "Generate and print a PostScript syntatic chart image of the region.
1804 Like `ebnf-print-buffer', but prints just the current region."
1805 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
1806 (run-hooks 'ebnf-hook)
1807 (or (ebnf-spool-region from to)
1808 (ps-do-despool filename)))
1812 (defun ebnf-spool-buffer ()
1813 "Generate and spool a PostScript syntatic chart image of the buffer.
1814 Like `ebnf-print-buffer' except that the PostScript image is saved in a
1815 local buffer to be sent to the printer later.
1817 Use the command `ebnf-despool' to send the spooled images to the printer."
1819 (ebnf-spool-region (point-min) (point-max)))
1823 (defun ebnf-spool-region (from to)
1824 "Generate a PostScript syntatic chart image of the region and spool locally.
1825 Like `ebnf-spool-buffer', but spools just the current region.
1827 Use the command `ebnf-despool' to send the spooled images to the printer."
1829 (ebnf-generate-region from to 'ebnf-generate))
1833 (defun ebnf-eps-buffer ()
1834 "Generate a PostScript syntatic chart image of the buffer in a EPS file.
1836 Indeed, for each production is generated a EPS file.
1837 The EPS file name has the following form:
1839 <PREFIX><PRODUCTION>.eps
1841 <PREFIX> is given by variable `ebnf-eps-prefix'.
1842 The default value is \"ebnf--\".
1844 <PRODUCTION> is the production name.
1845 The production name is mapped to form a valid file name.
1846 For example, the production name \"A/B + C\" is mapped to
1847 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
1849 WARNING: It's *NOT* asked any confirmation to override an existing file."
1851 (ebnf-eps-region (point-min) (point-max)))
1855 (defun ebnf-eps-region (from to)
1856 "Generate a PostScript syntatic chart image of the region in a EPS file.
1858 Indeed, for each production is generated a EPS file.
1859 The EPS file name has the following form:
1861 <PREFIX><PRODUCTION>.eps
1863 <PREFIX> is given by variable `ebnf-eps-prefix'.
1864 The default value is \"ebnf--\".
1866 <PRODUCTION> is the production name.
1867 The production name is mapped to form a valid file name.
1868 For example, the production name \"A/B + C\" is mapped to
1869 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
1871 WARNING: It's *NOT* asked any confirmation to override an existing file."
1873 (let ((ebnf-eps-executing t))
1874 (ebnf-generate-region from to 'ebnf-generate-eps)))
1878 (defalias 'ebnf-despool 'ps-despool)
1882 (defun ebnf-syntax-buffer ()
1883 "Does a syntatic analysis of the current buffer."
1885 (ebnf-syntax-region (point-min) (point-max)))
1889 (defun ebnf-syntax-region (from to)
1890 "Does a syntatic analysis of a region."
1892 (ebnf-generate-region from to nil))
1895 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1900 (defun ebnf-setup ()
1901 "Return the current ebnf2ps setup."
1904 \(setq ebnf-special-font %s
1905 ebnf-special-shape %s
1906 ebnf-special-shadow %S
1907 ebnf-special-border-width %S
1908 ebnf-special-border-color %S
1910 ebnf-except-shape %s
1911 ebnf-except-shadow %S
1912 ebnf-except-border-width %S
1913 ebnf-except-border-color %S
1915 ebnf-repeat-shape %s
1916 ebnf-repeat-shadow %S
1917 ebnf-repeat-border-width %S
1918 ebnf-repeat-border-color %S
1919 ebnf-terminal-regexp %S
1920 ebnf-case-fold-search %S
1921 ebnf-terminal-font %s
1922 ebnf-terminal-shape %s
1923 ebnf-terminal-shadow %S
1924 ebnf-terminal-border-width %S
1925 ebnf-terminal-border-color %S
1926 ebnf-non-terminal-font %s
1927 ebnf-non-terminal-shape %s
1928 ebnf-non-terminal-shadow %S
1929 ebnf-non-terminal-border-width %S
1930 ebnf-non-terminal-border-color %S
1931 ebnf-sort-production %s
1932 ebnf-production-font %s
1936 ebnf-horizontal-orientation %S
1937 ebnf-horizontal-max-height %S
1938 ebnf-production-horizontal-space %S
1939 ebnf-production-vertical-space %S
1940 ebnf-justify-sequence %s
1941 ebnf-lex-comment-char ?\\%03o
1942 ebnf-lex-eop-char ?\\%03o
1944 ebnf-iso-alternative-p %S
1945 ebnf-iso-normalize-p %S
1947 ebnf-entry-percentage %S
1952 ebnf-use-float-format %S
1953 ebnf-yac-ignore-error-recovery %S
1954 ebnf-ignore-empty-rule %S
1957 (ps-print-quote ebnf-special-font)
1958 (ps-print-quote ebnf-special-shape)
1960 ebnf-special-border-width
1961 ebnf-special-border-color
1962 (ps-print-quote ebnf-except-font)
1963 (ps-print-quote ebnf-except-shape)
1965 ebnf-except-border-width
1966 ebnf-except-border-color
1967 (ps-print-quote ebnf-repeat-font)
1968 (ps-print-quote ebnf-repeat-shape)
1970 ebnf-repeat-border-width
1971 ebnf-repeat-border-color
1972 ebnf-terminal-regexp
1973 ebnf-case-fold-search
1974 (ps-print-quote ebnf-terminal-font)
1975 (ps-print-quote ebnf-terminal-shape)
1976 ebnf-terminal-shadow
1977 ebnf-terminal-border-width
1978 ebnf-terminal-border-color
1979 (ps-print-quote ebnf-non-terminal-font)
1980 (ps-print-quote ebnf-non-terminal-shape)
1981 ebnf-non-terminal-shadow
1982 ebnf-non-terminal-border-width
1983 ebnf-non-terminal-border-color
1984 (ps-print-quote ebnf-sort-production)
1985 (ps-print-quote ebnf-production-font)
1986 (ps-print-quote ebnf-arrow-shape)
1987 (ps-print-quote ebnf-chart-shape)
1988 (ps-print-quote ebnf-user-arrow)
1989 ebnf-horizontal-orientation
1990 ebnf-horizontal-max-height
1991 ebnf-production-horizontal-space
1992 ebnf-production-vertical-space
1993 (ps-print-quote ebnf-justify-sequence)
1994 ebnf-lex-comment-char
1996 (ps-print-quote ebnf-syntax)
1997 ebnf-iso-alternative-p
1998 ebnf-iso-normalize-p
2000 ebnf-entry-percentage
2005 ebnf-use-float-format
2006 ebnf-yac-ignore-error-recovery
2007 ebnf-ignore-empty-rule
2011 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2015 (defvar ebnf-stack-style nil
2016 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2020 (defvar ebnf-current-style 'default
2021 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2024 (defconst ebnf-style-custom-list
2028 ebnf-special-border-width
2029 ebnf-special-border-color
2033 ebnf-except-border-width
2034 ebnf-except-border-color
2038 ebnf-repeat-border-width
2039 ebnf-repeat-border-color
2040 ebnf-terminal-regexp
2041 ebnf-case-fold-search
2044 ebnf-terminal-shadow
2045 ebnf-terminal-border-width
2046 ebnf-terminal-border-color
2047 ebnf-non-terminal-font
2048 ebnf-non-terminal-shape
2049 ebnf-non-terminal-shadow
2050 ebnf-non-terminal-border-width
2051 ebnf-non-terminal-border-color
2052 ebnf-sort-production
2053 ebnf-production-font
2057 ebnf-horizontal-orientation
2058 ebnf-horizontal-max-height
2059 ebnf-production-horizontal-space
2060 ebnf-production-vertical-space
2061 ebnf-justify-sequence
2062 ebnf-lex-comment-char
2065 ebnf-iso-alternative-p
2066 ebnf-iso-normalize-p
2068 ebnf-entry-percentage
2073 ebnf-use-float-format
2074 ebnf-yac-ignore-error-recovery
2075 ebnf-ignore-empty-rule
2077 "List of valid symbol custom variable.")
2080 (defvar ebnf-style-database
2084 (ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic))
2085 (ebnf-special-shape . 'bevel)
2086 (ebnf-special-shadow . nil)
2087 (ebnf-special-border-width . 0.5)
2088 (ebnf-special-border-color . "Black")
2089 (ebnf-except-font . '(7 Courier "Black" "Gray90" bold italic))
2090 (ebnf-except-shape . 'bevel)
2091 (ebnf-except-shadow . nil)
2092 (ebnf-except-border-width . 0.25)
2093 (ebnf-except-border-color . "Black")
2094 (ebnf-repeat-font . '(7 Courier "Black" "Gray85" bold italic))
2095 (ebnf-repeat-shape . 'bevel)
2096 (ebnf-repeat-shadow . nil)
2097 (ebnf-repeat-border-width . 0.0)
2098 (ebnf-repeat-border-color . "Black")
2099 (ebnf-terminal-regexp . nil)
2100 (ebnf-case-fold-search . nil)
2101 (ebnf-terminal-font . '(7 Courier "Black" "White"))
2102 (ebnf-terminal-shape . 'miter)
2103 (ebnf-terminal-shadow . nil)
2104 (ebnf-terminal-border-width . 1.0)
2105 (ebnf-terminal-border-color . "Black")
2106 (ebnf-non-terminal-font . '(7 Helvetica "Black" "White"))
2107 (ebnf-non-terminal-shape . 'round)
2108 (ebnf-non-terminal-shadow . nil)
2109 (ebnf-non-terminal-border-width . 1.0)
2110 (ebnf-non-terminal-border-color . "Black")
2111 (ebnf-sort-production . nil)
2112 (ebnf-production-font . '(10 Helvetica "Black" "White" bold))
2113 (ebnf-arrow-shape . 'hollow)
2114 (ebnf-chart-shape . 'round)
2115 (ebnf-user-arrow . nil)
2116 (ebnf-horizontal-orientation . nil)
2117 (ebnf-horizontal-max-height . nil)
2118 (ebnf-production-horizontal-space . 0.0)
2119 (ebnf-production-vertical-space . 0.0)
2120 (ebnf-justify-sequence . 'center)
2121 (ebnf-lex-comment-char . ?\;)
2122 (ebnf-lex-eop-char . ?.)
2123 (ebnf-syntax . 'ebnf)
2124 (ebnf-iso-alternative-p . nil)
2125 (ebnf-iso-normalize-p . nil)
2126 (ebnf-eps-prefix . "ebnf--")
2127 (ebnf-entry-percentage . 0.5)
2128 (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
2129 (fboundp 'color-instance-rgb-components))) ; XEmacs
2130 (ebnf-line-width . 1.0)
2131 (ebnf-line-color . "Black")
2132 (ebnf-debug-ps . nil)
2133 (ebnf-use-float-format . t)
2134 (ebnf-yac-ignore-error-recovery . nil)
2135 (ebnf-ignore-empty-rule . nil)
2136 (ebnf-optimize . nil))
2137 ;; Happy EBNF default
2140 (ebnf-justify-sequence . 'left)
2141 (ebnf-lex-comment-char . ?\#)
2142 (ebnf-lex-eop-char . ?\;))
2146 (ebnf-syntax . 'iso-ebnf))
2147 ;; Yacc/Bison default
2150 (ebnf-syntax . 'yacc))
2154 Each element has the following form:
2156 (CUSTOM INHERITS (VAR . VALUE)...)
2158 CUSTOM is a symbol name style.
2159 INHERITS is a symbol name style from which the current style inherits the
2160 context. If INHERITS is nil, means that there is no inheritance.
2161 VAR is a valid ebnf2ps symbol custom variable. See `ebnf-style-custom-list' for
2162 valid symbol variable.
2163 VALUE is a sexp which it'll be evaluated to set the value to VAR. So, don't
2164 forget to quote symbols and constant lists. See `default' style for an
2167 Don't handle this variable directly. Use functions `ebnf-insert-style' and
2168 `ebnf-merge-style'.")
2171 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2176 (defun ebnf-insert-style (name inherits &rest values)
2177 "Insert a new style NAME with inheritance INHERITS and values VALUES."
2179 (and (assoc name ebnf-style-database)
2180 (error "Style name already exists: %s" name))
2181 (or (assoc inherits ebnf-style-database)
2182 (error "Style inheritance name does'nt exist: %s" inherits))
2183 (setq ebnf-style-database
2184 (cons (cons name (cons inherits (ebnf-check-style-values values)))
2185 ebnf-style-database)))
2189 (defun ebnf-merge-style (name &rest values)
2190 "Merge values of style NAME with style VALUES."
2192 (let ((style (or (assoc name ebnf-style-database)
2193 (error "Style name does'nt exist: %s" name)))
2194 (merge (ebnf-check-style-values values))
2196 ;; modify value of existing variables
2197 (setq val (nthcdr 2 style))
2199 (setq check (car merge)
2201 elt (assoc (car check) val))
2203 (setcdr elt (cdr check))
2204 (setq new (cons check new))))
2205 ;; insert new variables
2206 (nconc style (nreverse new))))
2210 (defun ebnf-apply-style (style)
2211 "Set STYLE to current style.
2213 It returns the old style symbol."
2217 (and (ebnf-apply-style1 style)
2218 (setq ebnf-current-style style))))
2222 (defun ebnf-reset-style (&optional style)
2223 "Reset current style.
2225 It returns the old style symbol."
2227 (setq ebnf-stack-style nil)
2228 (ebnf-apply-style (or style 'default)))
2232 (defun ebnf-push-style (&optional style)
2233 "Push the current style and set STYLE to current style.
2235 It returns the old style symbol."
2239 (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
2241 (ebnf-apply-style style))))
2245 (defun ebnf-pop-style ()
2246 "Pop a style and set it to current style.
2248 It returns the old style symbol."
2251 (ebnf-apply-style (car ebnf-stack-style))
2252 (setq ebnf-stack-style (cdr ebnf-stack-style))))
2255 (defun ebnf-apply-style1 (style)
2256 (let ((value (cdr (assoc style ebnf-style-database))))
2259 (and (car value) (ebnf-apply-style1 (car value)))
2260 (while (setq value (cdr value))
2261 (set (caar value) (eval (cdar value)))))))
2264 (defun ebnf-check-style-values (values)
2267 (and (memq (car values) ebnf-style-custom-list)
2268 (setq style (cons (car values) style)))
2269 (setq values (cdr values)))
2273 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2274 ;; Internal variables
2277 (make-local-hook 'ebnf-hook)
2278 (make-local-hook 'ebnf-production-hook)
2279 (make-local-hook 'ebnf-page-hook)
2282 (defvar ebnf-eps-buffer-name " *EPS*")
2283 (defvar ebnf-parser-func nil)
2284 (defvar ebnf-eps-executing nil)
2285 (defvar ebnf-eps-upper-x 0.0)
2286 (make-variable-buffer-local 'ebnf-eps-upper-x)
2287 (defvar ebnf-eps-upper-y 0.0)
2288 (make-variable-buffer-local 'ebnf-eps-upper-y)
2289 (defvar ebnf-eps-prod-width 0.0)
2290 (make-variable-buffer-local 'ebnf-eps-prod-width)
2291 (defvar ebnf-eps-max-height 0.0)
2292 (make-variable-buffer-local 'ebnf-eps-max-height)
2293 (defvar ebnf-eps-max-width 0.0)
2294 (make-variable-buffer-local 'ebnf-eps-max-width)
2297 (defvar ebnf-eps-context nil
2298 "List of EPS file name during parsing.
2300 See section \"Actions in Comments\" in ebnf2ps documentation.")
2303 (defvar ebnf-eps-production-list nil
2304 "Alist associating production name with EPS file name list.
2306 Each element has the following form:
2308 (PRODUCTION EPS-FILENAME...)
2310 PRODUCTION is the production name.
2311 EPS-FILENAME is the EPS file name.
2313 It's generated during parsing and used during EPS generation.
2315 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2319 (defconst ebnf-arrow-shape-alist
2328 "Alist associating values for `ebnf-arrow-shape'.
2330 See documentation for `ebnf-arrow-shape'.")
2333 (defconst ebnf-terminal-shape-alist
2337 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2339 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2340 `ebnf-chart-shape'.")
2343 (defvar ebnf-limit nil)
2344 (defvar ebnf-action nil)
2345 (defvar ebnf-action-list nil)
2348 (defvar ebnf-default-p nil)
2351 (defvar ebnf-font-height-P 0)
2352 (defvar ebnf-font-height-T 0)
2353 (defvar ebnf-font-height-NT 0)
2354 (defvar ebnf-font-height-S 0)
2355 (defvar ebnf-font-height-E 0)
2356 (defvar ebnf-font-height-R 0)
2357 (defvar ebnf-font-width-P 0)
2358 (defvar ebnf-font-width-T 0)
2359 (defvar ebnf-font-width-NT 0)
2360 (defvar ebnf-font-width-S 0)
2361 (defvar ebnf-font-width-E 0)
2362 (defvar ebnf-font-width-R 0)
2363 (defvar ebnf-space-T 0)
2364 (defvar ebnf-space-NT 0)
2365 (defvar ebnf-space-S 0)
2366 (defvar ebnf-space-E 0)
2367 (defvar ebnf-space-R 0)
2370 (defvar ebnf-basic-width 0)
2371 (defvar ebnf-basic-height 0)
2372 (defvar ebnf-vertical-space 0)
2373 (defvar ebnf-horizontal-space 0)
2376 (defvar ebnf-settings nil)
2377 (defvar ebnf-fonts-required nil)
2380 (defconst ebnf-debug
2382 % === begin EBNF procedures to help debugging
2384 % Mark visually current point: string debug
2388 gsave -s- show grestore
2400 % Show number value: number string debug-number
2403 20 0 rmoveto show ([) show 60 string cvs show (]) show
2407 % === end EBNF procedures to help debugging
2410 "This is intended to help debugging PostScript programming.")
2413 (defconst ebnf-prologue
2415 % === begin EBNF engine
2417 % --- Basic Definitions
2420 /SpaceS FontHeight 0.5 mul def
2421 /HeightS FontHeight FontHeight add def
2424 /SpaceE FontHeight 0.5 mul def
2425 /HeightE FontHeight FontHeight add def
2428 /SpaceR FontHeight 0.5 mul def
2429 /HeightR FontHeight FontHeight add def
2432 /SpaceT FontHeight 0.5 mul def
2433 /HeightT FontHeight FontHeight add def
2436 /SpaceNT FontHeight 0.5 mul def
2437 /HeightNT FontHeight FontHeight add def
2439 /T HeightT HeightNT add 0.5 mul def
2442 /hT4 hT 0.25 mul def
2444 /Er 0.1 def % Error factor
2447 /c{currentpoint}bind def
2448 /xyi{/xi c /yi exch def def}bind def
2449 /xyo{/xo c /yo exch def def}bind def
2450 /xyp{/xp c /yp exch def def}bind def
2451 /xyt{/xt c /yt exch def def}bind def
2453 % vertical movement: x y height vm
2454 /vm{add moveto}bind def
2456 % horizontal movement: x y width hm
2457 /hm{3 -1 roll exch add exch moveto}bind def
2459 % set color: [R G B] SetRGB
2460 /SetRGB{aload pop setrgbcolor}bind def
2462 % filling gray area: gray-scale FillGray
2463 /FillGray{gsave setgray fill grestore}bind def
2465 % filling color area: [R G B] FillRGB
2466 /FillRGB{gsave SetRGB fill grestore}bind def
2468 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2469 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2470 /Gstroke{gsave Stroke grestore}bind def
2472 % Empty Line: width EL
2473 /EL{0 rlineto Gstroke}bind def
2477 /Down{hT2 neg hT4 neg rlineto}bind def
2480 {hT2 neg hT4 rmoveto
2485 /ArrowPath{c newpath moveto Arrow closepath}bind def
2493 {hT2 neg hT4 rlineto} % 1 - semi-up
2494 {Down} % 2 - semi-down
2495 {Arrow} % 3 - simple
2496 {Gstroke ArrowPath} % 4 - transparent
2497 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2498 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2499 {Gstroke gsave UserArrow grestore} % 7 - user
2505 RA-vector ArrowShape get exec
2510 % rotation DrawArrow
2525 /LA{180 DrawArrow}def
2532 /UA{90 DrawArrow}def
2539 /DA{270 DrawArrow}def
2543 %>corner Right Descendent: height arrow corner_RD
2545 % / height > 0 | 0 - none
2547 % * ---------- | 2 - left
2566 h 0 gt{DA}{UA}ifelse
2571 [{cRD0-vector arrow get exec} % 0 - miter
2572 {0 0 0 h hT h rcurveto} % 1 - rounded
2573 {hT h rlineto} % 2 - bevel
2577 {/arrow exch def /h exch def
2578 cRD-vector ChartShape get exec
2582 %>corner Right Ascendent: height arrow corner_RA
2584 % | height > 0 | 0 - none
2586 % *- ---------- | 2 - left
2604 h 0 gt{DA}{UA}ifelse
2610 [{cRA0-vector arrow get exec} % 0 - miter
2611 {0 0 hT 0 hT h rcurveto} % 1 - rounded
2612 {hT h rlineto} % 2 - bevel
2616 {/arrow exch def /h exch def
2617 cRA-vector ChartShape get exec
2621 %>corner Left Descendent: height arrow corner_LD
2623 % \\ height > 0 | 0 - none
2625 % * ---------- | 2 - left
2634 {hT neg h rmoveto xyi
2642 {hT neg h rmoveto xyi
2644 h 0 gt{DA}{UA}ifelse
2649 [{cLD0-vector arrow get exec} % 0 - miter
2650 {0 0 0 h hT neg h rcurveto} % 1 - rounded
2651 {hT neg h rlineto} % 2 - bevel
2655 {/arrow exch def /h exch def
2656 cLD-vector ChartShape get exec
2660 %>corner Left Ascendent: height arrow corner_LA
2662 % | height > 0 | 0 - none
2664 % -* ---------- | 2 - left
2673 {hT neg h rmoveto xyi
2681 {hT neg h rmoveto xyi
2682 h 0 gt{DA}{UA}ifelse
2688 [{cLA0-vector arrow get exec} % 0 - miter
2689 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
2690 {hT neg h rlineto} % 2 - bevel
2694 {/arrow exch def /h exch def
2695 cLA-vector ChartShape get exec
2701 % height prepare_height |- line_height corner_height corner_height
2705 {T add hT neg}ifelse
2709 %>Left Alternative: height LAlt
2736 %>Left Loop: height LLoop
2755 %>Right Alternative: height RAlt
2769 {T neg exch rlineto}
2782 %>Right Loop: height RLoop
2801 % --- Terminal, Non-terminal and Special Basics
2803 % string width prepare-width |- string
2806 dup stringwidth pop space add space add width exch sub 0.5 mul
2810 % string width begin-right
2820 {xo width add Er add yo moveto
2825 % string width begin-left
2834 {xo width add Er add yo moveto
2847 {/half YY yy sub 0.5 mul abs def
2848 xx half add YY moveto
2849 0 0 half neg 0 half neg half neg rcurveto
2850 0 0 0 half neg half half neg rcurveto
2851 XX xx sub abs half sub half sub 0 rlineto
2852 0 0 half 0 half half rcurveto
2853 0 0 0 half half neg half rcurveto}
2855 {/quarter YY yy sub 0.25 mul abs def
2856 xx quarter add YY moveto
2857 quarter neg quarter neg rlineto
2858 0 quarter quarter add neg rlineto
2859 quarter quarter neg rlineto
2860 XX xx sub abs quarter sub quarter sub 0 rlineto
2861 quarter quarter rlineto
2862 0 quarter quarter add rlineto
2863 quarter neg quarter rlineto}
2868 ShapePath-vector shape get exec
2874 Xshadow Xshadow add Xshadow add
2875 Yshadow Yshadow add Yshadow add translate
2889 % string SBound |- string
2891 {/xx c dup /yy exch def
2892 FontHeight add /YY exch def def
2893 dup stringwidth pop xx add /XX exch def
2895 {/yy yy YShadow add def
2896 /XX XX XShadow add def
2905 /XX XX space add space add def
2906 /YY YY space add def
2907 /yy yy space sub def
2908 shadow{doShapeShadow}if
2910 space Descent abs rmoveto
2917 % TeRminal: string TR
2919 {/Effect EffectT def
2921 /shapecolor BackgroundT def
2922 /borderwidth BorderWidthT def
2923 /bordercolor BorderColorT def
2924 /foreground ForegroundT def
2929 %>Right Terminal: string width RT |- x y
2940 %>Left Terminal: string width LT |- x y
2951 %>Right Terminal Default: string width RTD |- x y
2953 {/-save- BorderWidthT def
2954 /BorderWidthT BorderWidthT DefaultWidth add def
2956 /BorderWidthT -save- def
2959 %>Left Terminal Default: string width LTD |- x y
2961 {/-save- BorderWidthT def
2962 /BorderWidthT BorderWidthT DefaultWidth add def
2964 /BorderWidthT -save- def
2969 % Non-Terminal: string NT
2971 {/Effect EffectNT def
2973 /shapecolor BackgroundNT def
2974 /borderwidth BorderWidthNT def
2975 /bordercolor BorderColorNT def
2976 /foreground ForegroundNT def
2977 /shadow ShadowNT def
2981 %>Right Non-Terminal: string width RNT |- x y
2992 %>Left Non-Terminal: string width LNT |- x y
3003 %>Right Non-Terminal Default: string width RNTD |- x y
3005 {/-save- BorderWidthNT def
3006 /BorderWidthNT BorderWidthNT DefaultWidth add def
3008 /BorderWidthNT -save- def
3011 %>Left Non-Terminal Default: string width LNTD |- x y
3013 {/-save- BorderWidthNT def
3014 /BorderWidthNT BorderWidthNT DefaultWidth add def
3016 /BorderWidthNT -save- def
3021 % SPecial: string SP
3023 {/Effect EffectS def
3025 /shapecolor BackgroundS def
3026 /borderwidth BorderWidthS def
3027 /bordercolor BorderColorS def
3028 /foreground ForegroundS def
3033 %>Right SPecial: string width RSP |- x y
3044 %>Left SPecial: string width LSP |- x y
3055 %>Right SPecial Default: string width RSPD |- x y
3057 {/-save- BorderWidthS def
3058 /BorderWidthS BorderWidthS DefaultWidth add def
3060 /BorderWidthS -save- def
3063 %>Left SPecial Default: string width LSPD |- x y
3065 {/-save- BorderWidthS def
3066 /BorderWidthS BorderWidthS DefaultWidth add def
3068 /BorderWidthS -save- def
3071 % --- Repeat and Except basics
3074 {/w width rwidth sub 0.5 mul def
3079 /xx c entry add /YY exch def def
3080 /yy YY height sub def
3081 /XX xx rwidth add def
3082 shadow{doShapeShadow}if
3105 % entry height width rwidth begin-repeat
3115 /shapecolor BackgroundR def
3116 /borderwidth BorderWidthR def
3117 /bordercolor BorderColorR def
3118 /foreground ForegroundR def
3123 % string end-repeat |- x y
3126 space Descent rmoveto
3130 exch space add exch moveto
3134 %>Right RePeat: string entry height width rwidth RRP |- x y
3135 /RRP{begin-repeat right-direction end-repeat}def
3137 %>Left RePeat: string entry height width rwidth LRP |- x y
3138 /LRP{begin-repeat left-direction end-repeat}def
3142 % entry height width rwidth begin-except
3152 /shapecolor BackgroundE def
3153 /borderwidth BorderWidthE def
3154 /bordercolor BorderColorE def
3155 /foreground ForegroundE def
3160 % x-width end-except |- x y
3163 space space add add Descent rmoveto
3164 (-) foreground SetRGB S
3170 %>Right EXcept: x-width entry height width rwidth REX |- x y
3171 /REX{begin-except right-direction end-except}def
3173 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3174 /LEX{begin-except left-direction end-except}def
3178 %>Beginning Of Sequence: BOS |- x y
3179 /BOS{currentpoint}bind def
3181 %>End Of Sequence: x y x1 y1 EOS |- x y
3182 /EOS{pop pop}bind def
3186 %>Beginning Of Production: string width height BOP |- y x
3189 neg yp add /yw exch def
3190 xp add T sub /xw exch def
3192 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3202 %>End Of Production: y x delta EOP
3203 /EOPH{add exch moveto}bind def % horizontal
3204 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3206 % --- Empty Alternative
3208 %>Empty Alternative: width EA |- x y
3219 %>AlTernative: h1 h2 ... hn n width AT |- x y
3221 {xyo xo add /xw exch def
3233 %>OPtional: height width OP |- x y
3250 %>One or More: height width OM |- x y
3264 %>Zero or More: h2 h1 width ZM |- x y
3274 yo add xo T add exch moveto
3278 % === end EBNF engine
3281 "EBNF PostScript prologue")
3284 (defconst ebnf-eps-prologue
3286 /#ebnf2ps#dict 230 dict def
3289 % Initiliaze variables to avoid name-conflicting with document variables.
3290 % This is the case when using `bind' operator.
3291 /-fillp- 0 def /h 0 def
3292 /-ox- 0 def /half 0 def
3293 /-oy- 0 def /height 0 def
3294 /-save- 0 def /ow 0 def
3295 /Ascent 0 def /quarter 0 def
3296 /Descent 0 def /rXX 0 def
3297 /Effect 0 def /rYY 0 def
3298 /FontHeight 0 def /rwidth 0 def
3299 /LineThickness 0 def /rxx 0 def
3300 /OverlinePosition 0 def /ryy 0 def
3301 /SpaceBackground 0 def /shadow 0 def
3302 /StrikeoutPosition 0 def /shape 0 def
3303 /UnderlinePosition 0 def /shapecolor 0 def
3304 /XBox 0 def /space 0 def
3305 /XX 0 def /st 1 string def
3306 /Xshadow 0 def /w 0 def
3307 /YBox 0 def /width 0 def
3309 /Yshadow 0 def /xo 0 def
3310 /arrow 0 def /xp 0 def
3311 /bg false def /xt 0 def
3312 /bgcolor 0 def /xw 0 def
3313 /bordercolor 0 def /xx 0 def
3314 /borderwidth 0 def /yi 0 def
3316 /entry 0 def /yp 0 def
3317 /foreground 0 def /yt 0 def
3321 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3322 /ISOLatin1Encoding where
3324 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3325 % -- The first half is the same as the standard encoding,
3326 % -- except for minus instead of hyphen at code 055.
3328 StandardEncoding 0 45 getinterval aload pop
3330 StandardEncoding 46 82 getinterval aload pop
3331 %*** NOTE: the following are missing in the Adobe documentation,
3332 %*** but appear in the displayed table:
3333 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3335 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3336 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3337 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3338 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3340 /space /exclamdown /cent /sterling
3341 /currency /yen /brokenbar /section
3342 /dieresis /copyright /ordfeminine /guillemotleft
3343 /logicalnot /hyphen /registered /macron
3344 /degree /plusminus /twosuperior /threesuperior
3345 /acute /mu /paragraph /periodcentered
3346 /cedilla /onesuperior /ordmasculine /guillemotright
3347 /onequarter /onehalf /threequarters /questiondown
3349 /Agrave /Aacute /Acircumflex /Atilde
3350 /Adieresis /Aring /AE /Ccedilla
3351 /Egrave /Eacute /Ecircumflex /Edieresis
3352 /Igrave /Iacute /Icircumflex /Idieresis
3353 /Eth /Ntilde /Ograve /Oacute
3354 /Ocircumflex /Otilde /Odieresis /multiply
3355 /Oslash /Ugrave /Uacute /Ucircumflex
3356 /Udieresis /Yacute /Thorn /germandbls
3358 /agrave /aacute /acircumflex /atilde
3359 /adieresis /aring /ae /ccedilla
3360 /egrave /eacute /ecircumflex /edieresis
3361 /igrave /iacute /icircumflex /idieresis
3362 /eth /ntilde /ograve /oacute
3363 /ocircumflex /otilde /odieresis /divide
3364 /oslash /ugrave /uacute /ucircumflex
3365 /udieresis /yacute /thorn /ydieresis
3369 /reencodeFontISO %def
3371 length 12 add dict % Make a new font (a new dict the same size
3372 % as the old one) with room for our new symbols.
3374 begin % Make the new font the current dictionary.
3376 {def}{pop pop}ifelse
3377 }forall % Copy each of the symbols from the old dictionary
3378 % to the new one except for the font ID.
3380 currentdict /FontType get 0 ne
3381 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3382 % the ISOLatin1 encoding.
3384 % Use the font's bounding box to determine the ascent, descent,
3385 % and overall height; don't forget that these values have to be
3386 % transformed using the font's matrix.
3393 % | | | | Ascent (usually > 0)
3395 % (0 0) -> +--+----+-------->
3397 % | | v Descent (usually < 0)
3398 % (x1 y1) --> +----+ - -
3400 currentdict /FontType get 0 ne
3401 {/FontBBox load aload pop % -- x1 y1 x2 y2
3402 FontMatrix transform /Ascent exch def pop
3403 FontMatrix transform /Descent exch def pop}
3404 {/PrimaryFont FDepVector 0 get def
3405 PrimaryFont /FontBBox get aload pop
3406 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3407 PrimaryFont /FontMatrix get transform /Descent exch def pop
3410 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3412 % Define these in case they're not in the FontInfo
3413 % (also, here they're easier to get to).
3414 /UnderlinePosition Descent 0.70 mul def
3415 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3416 /StrikeoutPosition Ascent 0.30 mul def
3417 /LineThickness FontHeight 0.05 mul def
3418 /Xshadow FontHeight 0.08 mul def
3419 /Yshadow FontHeight -0.09 mul def
3420 /SpaceBackground Descent neg UnderlinePosition add def
3421 /XBox Descent neg def
3422 /YBox LineThickness 0.7 mul def
3424 currentdict % Leave the new font on the stack
3425 end % Stop using the font as the current dictionary
3426 definefont % Put the font into the font dictionary
3427 pop % Discard the returned font
3431 /DefFont{findfont exch scalefont reencodeFontISO}def
3436 dup /Ascent get /Ascent exch def
3437 dup /Descent get /Descent exch def
3438 dup /FontHeight get /FontHeight exch def
3439 dup /UnderlinePosition get /UnderlinePosition exch def
3440 dup /OverlinePosition get /OverlinePosition exch def
3441 dup /StrikeoutPosition get /StrikeoutPosition exch def
3442 dup /LineThickness get /LineThickness exch def
3443 dup /Xshadow get /Xshadow exch def
3444 dup /Yshadow get /Yshadow exch def
3445 dup /SpaceBackground get /SpaceBackground exch def
3446 dup /XBox get /XBox exch def
3447 dup /YBox get /YBox exch def
3460 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3462 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3475 % top of stack: fill-or-not
3477 {LineThickness setlinewidth stroke}
3482 % stack: string fill-or-not |- --
3485 /-ox- currentpoint /-oy- exch def def
3487 LineThickness setlinewidth
3489 st dup true charpath
3490 -fillp- {gsave FillBgColor grestore}if
3492 -oy- add /-oy- exch def
3493 -ox- add /-ox- exch def
3500 % stack: fill-or-not delta |- --
3503 xx XBox sub dd sub yy YBox sub dd sub
3504 XX XBox add dd add YY YBox add dd add
3508 % stack: string |- --
3511 Xshadow Yshadow rmoveto
3516 % stack: position |- --
3518 {currentpoint exch pop add dup
3524 LineThickness setlinewidth stroke
3528 % stack: string |- --
3529 % effect: 1 - underline 2 - strikeout 4 - overline
3530 % 8 - shadow 16 - box 32 - outline
3532 {/xx currentpoint dup Descent add /yy exch def
3533 Ascent add /YY exch def def
3534 dup stringwidth pop xx add /XX exch def
3536 {/yy yy Yshadow add def
3537 /XX XX Xshadow add def
3542 {SpaceBackground doBox}
3543 {xx yy XX YY doRect}
3546 Effect 16 and 0 ne{false 0 doBox}if % box
3547 Effect 8 and 0 ne{dup doShadow}if % shadow
3549 {true doOutline} % outline
3550 {show} % normal text
3552 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
3553 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
3554 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
3558 "EBNF EPS prologue")
3561 (defconst ebnf-eps-begin
3565 % x y #ebnf2ps#begin
3567 {#ebnf2ps#dict begin /#ebnf2ps#save save def
3568 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
3570 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
3577 (defconst ebnf-eps-end
3584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3588 (defvar ebnf-format-float "%1.3f")
3591 (defun ebnf-format-float (&rest floats)
3594 (format ebnf-format-float float))
3599 (defun ebnf-format-color (format-str color default)
3600 (let* ((the-color (or color default))
3601 (rgb (mapcar 'ps-color-value (ps-color-values the-color))))
3604 (ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
3609 (defvar ebnf-message-float "%3.2f")
3612 (defsubst ebnf-message-float (format-str value)
3614 (format ebnf-message-float value)))
3617 (defsubst ebnf-message-info (messag)
3618 (message "%s...%3d%%"
3620 (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
3623 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3627 (defmacro ebnf-node-kind (vec &optional value)
3629 `(aset ,vec 0 ,value)
3633 (defmacro ebnf-node-width-func (node width)
3634 `(funcall (aref ,node 1) ,node ,width))
3637 (defmacro ebnf-node-dimension-func (node &optional value)
3639 `(aset ,node 2 ,value)
3640 `(funcall (aref ,node 2) ,node)))
3643 (defmacro ebnf-node-entry (vec &optional value)
3645 `(aset ,vec 3 ,value)
3649 (defmacro ebnf-node-height (vec &optional value)
3651 `(aset ,vec 4 ,value)
3655 (defmacro ebnf-node-width (vec &optional value)
3657 `(aset ,vec 5 ,value)
3661 (defmacro ebnf-node-name (vec)
3665 (defmacro ebnf-node-list (vec &optional value)
3667 `(aset ,vec 6 ,value)
3671 (defmacro ebnf-node-default (vec)
3675 (defmacro ebnf-node-production (vec &optional value)
3677 `(aset ,vec 7 ,value)
3681 (defmacro ebnf-node-separator (vec &optional value)
3683 `(aset ,vec 7 ,value)
3687 (defmacro ebnf-node-action (vec &optional value)
3689 `(aset ,vec 8 ,value)
3693 (defmacro ebnf-node-generation (node)
3694 `(funcall (ebnf-node-kind ,node) ,node))
3697 (defmacro ebnf-max-width (prod)
3698 `(max (ebnf-node-width ,prod)
3699 (+ (* (length (ebnf-node-name ,prod))
3701 ebnf-production-horizontal-space)))
3704 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3705 ;; PostScript generation
3708 (defun ebnf-generate-eps (ebnf-tree)
3709 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
3710 (ps-print-color-scale (if ps-color-p
3711 (float (car (ps-color-values "white")))
3713 (ebnf-total (length ebnf-tree))
3715 (old-ps-output (symbol-function 'ps-output))
3716 (old-ps-output-string (symbol-function 'ps-output-string))
3717 (eps-buffer (get-buffer-create ebnf-eps-buffer-name))
3718 ebnf-debug-ps error-msg horizontal
3719 prod prod-name prod-width prod-height prod-list file-list)
3720 ;; redefines `ps-output' and `ps-output-string'
3721 (defalias 'ps-output 'ebnf-eps-output)
3722 (defalias 'ps-output-string 'ps-output-string-prim)
3723 ;; generate EPS file
3725 (condition-case data
3728 (setq prod (car ebnf-tree)
3729 prod-name (ebnf-node-name prod)
3730 prod-width (ebnf-max-width prod)
3731 prod-height (ebnf-node-height prod)
3732 horizontal (memq (ebnf-node-action prod) ebnf-action-list))
3733 ;; generate production in EPS buffer
3735 (set-buffer eps-buffer)
3736 (setq ebnf-eps-upper-x 0.0
3737 ebnf-eps-upper-y 0.0
3738 ebnf-eps-max-width prod-width
3739 ebnf-eps-max-height prod-height)
3740 (ebnf-generate-production prod))
3741 (if (setq prod-list (cdr (assoc prod-name
3742 ebnf-eps-production-list)))
3743 ;; insert EPS buffer in all buffer associated with production
3744 (ebnf-eps-production-list prod-list 'file-list horizontal
3745 prod-width prod-height eps-buffer)
3746 ;; write EPS file for production
3747 (ebnf-eps-finish-and-write eps-buffer
3748 (ebnf-eps-filename prod-name)))
3749 ;; prepare for next loop
3751 (set-buffer eps-buffer)
3753 (setq ebnf-tree (cdr ebnf-tree)))
3754 ;; write and kill temporary buffers
3755 (ebnf-eps-write-kill-temp file-list t)
3756 (setq file-list nil))
3759 (setq error-msg (error-message-string data)))))
3760 ;; restore `ps-output' and `ps-output-string'
3761 (defalias 'ps-output old-ps-output)
3762 (defalias 'ps-output-string old-ps-output-string)
3763 ;; kill temporary buffers
3764 (kill-buffer eps-buffer)
3765 (ebnf-eps-write-kill-temp file-list nil)
3766 (and error-msg (error error-msg))
3770 ;; write and kill temporary buffers
3771 (defun ebnf-eps-write-kill-temp (file-list write-p)
3773 (let ((buffer (get-buffer (concat " *" (car file-list) "*"))))
3776 (ebnf-eps-finish-and-write buffer (car file-list)))
3777 (kill-buffer buffer)))
3778 (setq file-list (cdr file-list))))
3781 ;; insert EPS buffer in all buffer associated with production
3782 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
3783 prod-width prod-height eps-buffer)
3785 (add-to-list file-list-sym (car prod-list))
3787 (set-buffer (get-buffer-create (concat " *" (car prod-list) "*")))
3788 (goto-char (point-max))
3791 ((zerop (buffer-size))
3792 (setq ebnf-eps-upper-x 0.0
3793 ebnf-eps-upper-y 0.0
3794 ebnf-eps-max-width prod-width
3795 ebnf-eps-max-height prod-height))
3798 (ebnf-eop-horizontal ebnf-eps-prod-width)
3799 (setq ebnf-eps-max-width (+ ebnf-eps-max-width
3800 ebnf-production-horizontal-space
3802 ebnf-eps-max-height (max ebnf-eps-max-height prod-height)))
3805 (ebnf-eop-vertical ebnf-eps-max-height)
3806 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
3807 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
3810 ebnf-production-vertical-space
3811 ebnf-eps-max-height))
3812 ebnf-eps-max-width prod-width
3813 ebnf-eps-max-height prod-height))
3815 (setq ebnf-eps-prod-width prod-width)
3816 (insert-buffer eps-buffer))
3817 (setq prod-list (cdr prod-list))))
3820 (defun ebnf-generate (ebnf-tree)
3821 (let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
3822 (ps-print-color-scale (if ps-color-p
3823 (float (car (ps-color-values "white")))
3825 ps-zebra-stripes ps-line-number ps-razzle-dazzle
3827 ps-print-begin-sheet-hook
3828 ps-print-begin-page-hook
3829 ps-print-begin-column-hook)
3830 (ps-generate (current-buffer) (point-min) (point-max)
3831 'ebnf-generate-postscript)))
3834 (defvar ebnf-tree nil)
3835 (defvar ebnf-direction "R")
3836 (defvar ebnf-total 0)
3837 (defvar ebnf-nprod 0)
3840 (defun ebnf-generate-postscript (from to)
3842 (if ebnf-horizontal-max-height
3843 (ebnf-generate-with-max-height)
3844 (ebnf-generate-without-max-height))
3848 (defun ebnf-generate-with-max-height ()
3849 (let ((ebnf-total (length ebnf-tree))
3851 next-line max-height prod the-width)
3853 ;; find next line point
3854 (setq next-line ebnf-tree
3855 prod (car ebnf-tree)
3856 max-height (ebnf-node-height prod))
3857 (ebnf-begin-line prod (ebnf-max-width prod))
3858 (while (and (setq next-line (cdr next-line))
3859 (setq prod (car next-line))
3860 (memq (ebnf-node-action prod) ebnf-action-list)
3861 (setq the-width (ebnf-max-width prod))
3862 (<= the-width ps-width-remaining))
3863 (setq max-height (max max-height (ebnf-node-height prod))
3864 ps-width-remaining (- ps-width-remaining
3866 ebnf-production-horizontal-space))))
3867 ;; generate current line
3868 (ebnf-newline max-height)
3869 (setq prod (car ebnf-tree))
3870 (ebnf-generate-production prod)
3871 (while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line))
3872 (ebnf-eop-horizontal (ebnf-max-width prod))
3873 (setq prod (car ebnf-tree))
3874 (ebnf-generate-production prod))
3875 (ebnf-eop-vertical max-height))))
3878 (defun ebnf-generate-without-max-height ()
3879 (let ((ebnf-total (length ebnf-tree))
3881 max-height prod bef-width cur-width)
3883 ;; generate current line
3884 (setq prod (car ebnf-tree)
3885 max-height (ebnf-node-height prod)
3886 bef-width (ebnf-max-width prod))
3887 (ebnf-begin-line prod bef-width)
3888 (ebnf-generate-production prod)
3889 (while (and (setq ebnf-tree (cdr ebnf-tree))
3890 (setq prod (car ebnf-tree))
3891 (memq (ebnf-node-action prod) ebnf-action-list)
3892 (setq cur-width (ebnf-max-width prod))
3893 (<= cur-width ps-width-remaining)
3894 (<= (ebnf-node-height prod) ps-height-remaining))
3895 (ebnf-eop-horizontal bef-width)
3896 (ebnf-generate-production prod)
3897 (setq bef-width cur-width
3898 max-height (max max-height (ebnf-node-height prod))
3899 ps-width-remaining (- ps-width-remaining
3901 ebnf-production-horizontal-space))))
3902 (ebnf-eop-vertical max-height)
3903 ;; prepare next line
3904 (ebnf-newline max-height))))
3907 (defun ebnf-begin-line (prod width)
3908 (and (or (eq (ebnf-node-action prod) 'form-feed)
3909 (> (ebnf-node-height prod) ps-height-remaining))
3911 (setq ps-width-remaining (- ps-width-remaining
3913 ebnf-production-horizontal-space))))
3916 (defun ebnf-newline (height)
3917 (and (> height ps-height-remaining)
3919 (setq ps-width-remaining ps-print-width
3920 ps-height-remaining (- ps-height-remaining
3922 ebnf-production-vertical-space))))
3925 ;; [production width-fun dim-fun entry height width name production action]
3926 (defun ebnf-generate-production (production)
3927 (ebnf-message-info "Generating")
3928 (run-hooks 'ebnf-production-hook)
3929 (ps-output-string (ebnf-node-name production))
3932 (ebnf-node-width production)
3933 (+ ebnf-basic-height
3934 (ebnf-node-entry (ebnf-node-production production))))
3936 (ebnf-node-generation (ebnf-node-production production))
3937 (ps-output "EOS\n"))
3940 ;; [alternative width-fun dim-fun entry height width list]
3941 (defun ebnf-generate-alternative (alternative)
3942 (let ((alt (ebnf-node-list alternative))
3943 (entry (ebnf-node-entry alternative))
3945 alt-height alt-entry)
3947 (ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt))))
3949 (setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space)
3952 (ps-output (format "%d " nlist)
3953 (ebnf-format-float (ebnf-node-width alternative))
3955 (setq alt (ebnf-node-list alternative))
3957 (ebnf-node-generation (car alt))
3958 (setq alt-height (- (ebnf-node-height (car alt))
3959 (ebnf-node-entry (car alt)))))
3960 (while (setq alt (cdr alt))
3961 (setq alt-entry (ebnf-node-entry (car alt)))
3962 (ebnf-vertical-movement
3963 (- (+ alt-height ebnf-vertical-space alt-entry)))
3964 (ebnf-node-generation (car alt))
3965 (setq alt-height (- (ebnf-node-height (car alt)) alt-entry))))
3966 (ps-output "EOS\n"))
3969 ;; [sequence width-fun dim-fun entry height width list]
3970 (defun ebnf-generate-sequence (sequence)
3972 (let ((seq (ebnf-node-list sequence))
3975 (ebnf-node-generation (car seq))
3976 (setq seq-width (ebnf-node-width (car seq))))
3977 (while (setq seq (cdr seq))
3978 (ebnf-horizontal-movement seq-width)
3979 (ebnf-node-generation (car seq))
3980 (setq seq-width (ebnf-node-width (car seq)))))
3981 (ps-output "EOS\n"))
3984 ;; [terminal width-fun dim-fun entry height width name]
3985 (defun ebnf-generate-terminal (terminal)
3986 (ebnf-gen-terminal terminal "T"))
3989 ;; [non-terminal width-fun dim-fun entry height width name]
3990 (defun ebnf-generate-non-terminal (non-terminal)
3991 (ebnf-gen-terminal non-terminal "NT"))
3994 ;; [empty width-fun dim-fun entry height width]
3995 (defun ebnf-generate-empty (empty)
3996 (ebnf-empty-alternative (ebnf-node-width empty)))
3999 ;; [optional width-fun dim-fun entry height width element]
4000 (defun ebnf-generate-optional (optional)
4001 (let ((the-optional (ebnf-node-list optional)))
4002 (ps-output (ebnf-format-float
4003 (+ (- (ebnf-node-height the-optional)
4004 (ebnf-node-entry optional))
4005 ebnf-vertical-space)
4006 (ebnf-node-width optional))
4008 (ebnf-node-generation the-optional)
4009 (ps-output "EOS\n")))
4012 ;; [one-or-more width-fun dim-fun entry height width element separator]
4013 (defun ebnf-generate-one-or-more (one-or-more)
4014 (let* ((width (ebnf-node-width one-or-more))
4015 (sep (ebnf-node-separator one-or-more))
4016 (entry (- (ebnf-node-entry one-or-more)
4018 (ebnf-node-entry sep)
4020 (ps-output (ebnf-format-float entry width)
4022 (ebnf-node-generation (ebnf-node-list one-or-more))
4023 (ebnf-vertical-movement entry)
4025 (let ((ebnf-direction "L"))
4026 (ebnf-node-generation sep))
4027 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4028 (ps-output "EOS\n"))
4031 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4032 (defun ebnf-generate-zero-or-more (zero-or-more)
4033 (let* ((width (ebnf-node-width zero-or-more))
4034 (node-list (ebnf-node-list zero-or-more))
4035 (list-entry (ebnf-node-entry node-list))
4036 (node-sep (ebnf-node-separator zero-or-more))
4037 (entry (+ list-entry
4040 (- (ebnf-node-height node-sep)
4041 (ebnf-node-entry node-sep))
4043 (ps-output (ebnf-format-float entry
4044 (+ (- (ebnf-node-height node-list)
4046 ebnf-vertical-space)
4049 (ebnf-node-generation (ebnf-node-list zero-or-more))
4050 (ebnf-vertical-movement entry)
4051 (if (ebnf-node-separator zero-or-more)
4052 (let ((ebnf-direction "L"))
4053 (ebnf-node-generation (ebnf-node-separator zero-or-more)))
4054 (ebnf-empty-alternative (- width ebnf-horizontal-space))))
4055 (ps-output "EOS\n"))
4058 ;; [special width-fun dim-fun entry height width name]
4059 (defun ebnf-generate-special (special)
4060 (ebnf-gen-terminal special "SP"))
4063 ;; [repeat width-fun dim-fun entry height width times element]
4064 (defun ebnf-generate-repeat (repeat)
4065 (let ((times (ebnf-node-name repeat))
4066 (element (ebnf-node-separator repeat)))
4067 (ps-output-string times)
4070 (ebnf-node-entry repeat)
4071 (ebnf-node-height repeat)
4072 (ebnf-node-width repeat)
4074 (+ (ebnf-node-width element)
4075 ebnf-space-R ebnf-space-R ebnf-space-R
4076 (* (length times) ebnf-font-width-R))
4078 " " ebnf-direction "RP\n")
4080 (ebnf-node-generation element)))
4081 (ps-output "EOS\n"))
4084 ;; [except width-fun dim-fun entry height width element element]
4085 (defun ebnf-generate-except (except)
4086 (let* ((element (ebnf-node-list except))
4087 (exception (ebnf-node-separator except))
4088 (width (ebnf-node-width element)))
4089 (ps-output (ebnf-format-float
4091 (ebnf-node-entry except)
4092 (ebnf-node-height except)
4093 (ebnf-node-width except)
4095 ebnf-space-E ebnf-space-E ebnf-space-E
4098 (+ (ebnf-node-width exception) ebnf-space-E)
4100 " " ebnf-direction "EX\n")
4101 (ebnf-node-generation (ebnf-node-list except))
4103 (ebnf-horizontal-movement (+ width ebnf-space-E
4104 ebnf-font-width-E ebnf-space-E))
4105 (ebnf-node-generation exception)))
4106 (ps-output "EOS\n"))
4109 (defun ebnf-gen-terminal (node code)
4110 (ps-output-string (ebnf-node-name node))
4111 (ps-output " " (ebnf-format-float (ebnf-node-width node))
4112 " " ebnf-direction code
4113 (if (ebnf-node-default node)
4118 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4119 ;; Internal functions
4122 (defvar ebnf-map-name
4123 (let ((map (make-vector 256 ?\_)))
4124 (mapcar #'(lambda (char)
4125 (aset map char char))
4126 (concat "#$%&+-.0123456789=?@~"
4127 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4128 "abcdefghijklmnopqrstuvwxyz"))
4132 (defun ebnf-eps-filename (str)
4133 (let* ((len (length str))
4135 (new (make-string len ?\ )))
4137 (aset new stri (aref ebnf-map-name (aref str stri)))
4138 (setq stri (1+ stri)))
4139 (concat ebnf-eps-prefix new ".eps")))
4142 (defun ebnf-eps-output (&rest args)
4145 (setq args (cdr args))))
4148 (defun ebnf-generate-region (from to gen-func)
4149 (run-hooks 'ebnf-hook)
4150 (let ((ebnf-limit (max from to))
4155 (condition-case data
4156 (let ((tree (ebnf-parse-and-sort (min from to))))
4161 (ebnf-eliminate-empty-rules tree))))))
4165 (setq the-point (max (1- (point)) (point-min)))
4166 (message (error-message-string data)))))))
4169 (goto-char the-point))
4173 (message "EBNF syntatic analysis: NO ERRORS.")))))
4176 (defun ebnf-parse-and-sort (start)
4178 (let ((tree (funcall ebnf-parser-func start)))
4179 (if ebnf-sort-production
4181 (message "Sorting...")
4183 (if (eq ebnf-sort-production 'ascending)
4184 'ebnf-sorter-ascending
4185 'ebnf-sorter-descending)))
4189 (defun ebnf-sorter-ascending (first second)
4190 (string< (ebnf-node-name first)
4191 (ebnf-node-name second)))
4194 (defun ebnf-sorter-descending (first second)
4195 (string< (ebnf-node-name second)
4196 (ebnf-node-name first)))
4199 (defun ebnf-empty-alternative (width)
4200 (ps-output (ebnf-format-float width) " EA\n"))
4203 (defun ebnf-vertical-movement (height)
4204 (ps-output (ebnf-format-float height) " vm\n"))
4207 (defun ebnf-horizontal-movement (width)
4208 (ps-output (ebnf-format-float width) " hm\n"))
4211 (defun ebnf-entry (height)
4212 (* height ebnf-entry-percentage))
4215 (defun ebnf-eop-vertical (height)
4216 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space))
4220 (defun ebnf-eop-horizontal (width)
4221 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space))
4225 (defun ebnf-new-page ()
4226 (when (< ps-height-remaining ps-print-height)
4227 (run-hooks 'ebnf-page-hook)
4232 (defsubst ebnf-font-size (font) (nth 0 font))
4233 (defsubst ebnf-font-name (font) (nth 1 font))
4234 (defsubst ebnf-font-foreground (font) (nth 2 font))
4235 (defsubst ebnf-font-background (font) (nth 3 font))
4236 (defsubst ebnf-font-list (font) (nthcdr 4 font))
4237 (defsubst ebnf-font-attributes (font)
4238 (lsh (ps-extension-bit (cdr font)) -2))
4241 (defconst ebnf-font-name-select
4242 (vector 'normal 'bold 'italic 'bold-italic))
4245 (defun ebnf-font-name-select (font)
4246 (let* ((font-list (ebnf-font-list font))
4247 (font-index (+ (if (memq 'bold font-list) 1 0)
4248 (if (memq 'italic font-list) 2 0)))
4249 (name (ebnf-font-name font))
4250 (database (cdr (assoc name ps-font-info-database)))
4251 (info-list (or (cdr (assoc 'fonts database))
4252 (error "Invalid font: %s" name))))
4253 (or (cdr (assoc (aref ebnf-font-name-select font-index)
4255 (error "Invalid attributes for font %s" name))))
4258 (defun ebnf-font-select (font select)
4259 (let* ((name (ebnf-font-name font))
4260 (database (cdr (assoc name ps-font-info-database)))
4261 (size (cdr (assoc 'size database)))
4262 (base (cdr (assoc select database))))
4264 (/ (* (ebnf-font-size font) base)
4266 (error "Invalid font: %s" name))))
4269 (defsubst ebnf-font-width (font)
4270 (ebnf-font-select font 'avg-char-width))
4271 (defsubst ebnf-font-height (font)
4272 (ebnf-font-select font 'line-height))
4275 (defun ebnf-begin-job ()
4276 (ps-printing-region nil)
4277 (if ebnf-use-float-format
4278 (setq ebnf-format-float "%1.3f"
4279 ebnf-message-float "%3.2f")
4280 (setq ebnf-format-float "%s"
4281 ebnf-message-float "%s"))
4282 (ebnf-otz-initialize)
4283 ;; to avoid compilation gripes when calling autoloaded functions
4284 (funcall (cond ((eq ebnf-syntax 'iso-ebnf)
4285 (setq ebnf-parser-func 'ebnf-iso-parser)
4286 'ebnf-iso-initialize)
4287 ((eq ebnf-syntax 'yacc)
4288 (setq ebnf-parser-func 'ebnf-yac-parser)
4289 'ebnf-yac-initialize)
4291 (setq ebnf-parser-func 'ebnf-bnf-parser)
4292 'ebnf-bnf-initialize)))
4293 (and ebnf-terminal-regexp ; ensures that it's a string or nil
4294 (not (stringp ebnf-terminal-regexp))
4295 (setq ebnf-terminal-regexp nil))
4296 (or (and ebnf-eps-prefix ; ensures that it's a string
4297 (stringp ebnf-eps-prefix))
4298 (setq ebnf-eps-prefix "ebnf--"))
4299 (setq ebnf-entry-percentage ; ensures value between 0.0 and 1.0
4300 (min (max ebnf-entry-percentage 0.0) 1.0)
4301 ebnf-action-list (if ebnf-horizontal-orientation
4305 ebnf-fonts-required nil
4308 ebnf-eps-context nil
4309 ebnf-eps-production-list nil
4310 ebnf-eps-upper-x 0.0
4311 ebnf-eps-upper-y 0.0
4312 ebnf-font-height-P (ebnf-font-height ebnf-production-font)
4313 ebnf-font-height-T (ebnf-font-height ebnf-terminal-font)
4314 ebnf-font-height-NT (ebnf-font-height ebnf-non-terminal-font)
4315 ebnf-font-height-S (ebnf-font-height ebnf-special-font)
4316 ebnf-font-height-E (ebnf-font-height ebnf-except-font)
4317 ebnf-font-height-R (ebnf-font-height ebnf-repeat-font)
4318 ebnf-font-width-P (ebnf-font-width ebnf-production-font)
4319 ebnf-font-width-T (ebnf-font-width ebnf-terminal-font)
4320 ebnf-font-width-NT (ebnf-font-width ebnf-non-terminal-font)
4321 ebnf-font-width-S (ebnf-font-width ebnf-special-font)
4322 ebnf-font-width-E (ebnf-font-width ebnf-except-font)
4323 ebnf-font-width-R (ebnf-font-width ebnf-repeat-font)
4324 ebnf-space-T (* ebnf-font-height-T 0.5)
4325 ebnf-space-NT (* ebnf-font-height-NT 0.5)
4326 ebnf-space-S (* ebnf-font-height-S 0.5)
4327 ebnf-space-E (* ebnf-font-height-E 0.5)
4328 ebnf-space-R (* ebnf-font-height-R 0.5))
4329 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT)))
4330 (setq ebnf-basic-width (* basic 0.5)
4331 ebnf-horizontal-space (+ basic basic)
4332 ebnf-basic-height ebnf-basic-width
4333 ebnf-vertical-space ebnf-basic-width)
4334 ;; ensures value is greater than zero
4335 (or (and (numberp ebnf-production-horizontal-space)
4336 (> ebnf-production-horizontal-space 0.0))
4337 (setq ebnf-production-horizontal-space basic))
4338 ;; ensures value is greater than zero
4339 (or (and (numberp ebnf-production-vertical-space)
4340 (> ebnf-production-vertical-space 0.0))
4341 (setq ebnf-production-vertical-space basic))))
4344 (defsubst ebnf-shape-value (sym alist)
4345 (or (cdr (assq sym alist)) 0))
4348 (defsubst ebnf-boolean (value)
4349 (if value "true" "false"))
4352 (defun ebnf-begin-file ()
4355 (set-buffer ps-spool-buffer)
4356 (goto-char (point-min))
4357 (and (search-forward "%%Creator: " nil t)
4358 (not (search-forward "& ebnf2ps v"
4359 (save-excursion (end-of-line) (point))
4362 ;; adjust creator comment
4365 (insert " & ebnf2ps v" ebnf-version)
4366 ;; insert ebnf settings & engine
4367 (goto-char (point-max))
4368 (search-backward "\n%%EndPrologue\n")
4369 (ebnf-insert-ebnf-prologue)
4370 (ps-output "\n")))))
4373 (defun ebnf-eps-finish-and-write (buffer filename)
4376 (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
4377 ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
4380 ebnf-production-vertical-space
4381 ebnf-eps-max-height)))
4383 (goto-char (point-min))
4385 "%!PS-Adobe-3.0 EPSF-3.0"
4386 "\n%%BoundingBox: 0 0 "
4387 (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
4388 "\n%%Title: " filename
4389 "\n%%CreationDate: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
4390 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
4391 "\n%%DocumentNeededResources: font "
4392 (or ebnf-fonts-required
4393 (setq ebnf-fonts-required
4394 (let ((fonts (ps-remove-duplicates
4395 (mapcar 'ebnf-font-name-select
4396 (list ebnf-production-font
4398 ebnf-non-terminal-font
4401 ebnf-repeat-font)))))
4403 (and (cdr fonts) "\n%%+ font ")
4404 (mapconcat 'identity (cdr fonts) "\n%%+ font ")))))
4405 "\n%%Pages: 0\n%%EndComments\n\n%%BeginPrologue\n"
4407 (ebnf-insert-ebnf-prologue)
4408 (insert ebnf-eps-begin
4409 "\n0 " (ebnf-format-float
4410 (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7)))
4411 " #ebnf2ps#begin\n")
4413 (goto-char (point-max))
4414 (insert ebnf-eps-end)
4416 (message "Saving...")
4417 (setq filename (expand-file-name filename))
4418 (let ((coding-system-for-write 'raw-text-unix))
4419 (write-region (point-min) (point-max) filename))
4420 (message "Wrote %s" filename)))
4423 (defun ebnf-insert-ebnf-prologue ()
4428 "\n\n% === begin EBNF settings\n\n"
4430 (format "/fP %s /%s DefFont\n"
4431 (ebnf-format-float (ebnf-font-size ebnf-production-font))
4432 (ebnf-font-name-select ebnf-production-font))
4433 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4434 (ebnf-font-foreground ebnf-production-font)
4436 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4437 (ebnf-font-background ebnf-production-font)
4439 (format "/EffectP %d def\n"
4440 (ebnf-font-attributes ebnf-production-font))
4442 (format "/fT %s /%s DefFont\n"
4443 (ebnf-format-float (ebnf-font-size ebnf-terminal-font))
4444 (ebnf-font-name-select ebnf-terminal-font))
4445 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4446 (ebnf-font-foreground ebnf-terminal-font)
4448 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4449 (ebnf-font-background ebnf-terminal-font)
4451 (format "/EffectT %d def\n"
4452 (ebnf-font-attributes ebnf-terminal-font))
4453 (format "/BorderWidthT %s def\n"
4454 (ebnf-format-float ebnf-terminal-border-width))
4455 (ebnf-format-color "/BorderColorT %s def %% %s\n"
4456 ebnf-terminal-border-color
4458 (format "/ShapeT %d def\n"
4459 (ebnf-shape-value ebnf-terminal-shape
4460 ebnf-terminal-shape-alist))
4461 (format "/ShadowT %s def\n"
4462 (ebnf-boolean ebnf-terminal-shadow))
4464 (format "/fNT %s /%s DefFont\n"
4466 (ebnf-font-size ebnf-non-terminal-font))
4467 (ebnf-font-name-select ebnf-non-terminal-font))
4468 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
4469 (ebnf-font-foreground ebnf-non-terminal-font)
4471 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
4472 (ebnf-font-background ebnf-non-terminal-font)
4474 (format "/EffectNT %d def\n"
4475 (ebnf-font-attributes ebnf-non-terminal-font))
4476 (format "/BorderWidthNT %s def\n"
4477 (ebnf-format-float ebnf-non-terminal-border-width))
4478 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
4479 ebnf-non-terminal-border-color
4481 (format "/ShapeNT %d def\n"
4482 (ebnf-shape-value ebnf-non-terminal-shape
4483 ebnf-terminal-shape-alist))
4484 (format "/ShadowNT %s def\n"
4485 (ebnf-boolean ebnf-non-terminal-shadow))
4487 (format "/fS %s /%s DefFont\n"
4488 (ebnf-format-float (ebnf-font-size ebnf-special-font))
4489 (ebnf-font-name-select ebnf-special-font))
4490 (ebnf-format-color "/ForegroundS %s def %% %s\n"
4491 (ebnf-font-foreground ebnf-special-font)
4493 (ebnf-format-color "/BackgroundS %s def %% %s\n"
4494 (ebnf-font-background ebnf-special-font)
4496 (format "/EffectS %d def\n"
4497 (ebnf-font-attributes ebnf-special-font))
4498 (format "/BorderWidthS %s def\n"
4499 (ebnf-format-float ebnf-special-border-width))
4500 (ebnf-format-color "/BorderColorS %s def %% %s\n"
4501 ebnf-special-border-color
4503 (format "/ShapeS %d def\n"
4504 (ebnf-shape-value ebnf-special-shape
4505 ebnf-terminal-shape-alist))
4506 (format "/ShadowS %s def\n"
4507 (ebnf-boolean ebnf-special-shadow))
4509 (format "/fE %s /%s DefFont\n"
4510 (ebnf-format-float (ebnf-font-size ebnf-except-font))
4511 (ebnf-font-name-select ebnf-except-font))
4512 (ebnf-format-color "/ForegroundE %s def %% %s\n"
4513 (ebnf-font-foreground ebnf-except-font)
4515 (ebnf-format-color "/BackgroundE %s def %% %s\n"
4516 (ebnf-font-background ebnf-except-font)
4518 (format "/EffectE %d def\n"
4519 (ebnf-font-attributes ebnf-except-font))
4520 (format "/BorderWidthE %s def\n"
4521 (ebnf-format-float ebnf-except-border-width))
4522 (ebnf-format-color "/BorderColorE %s def %% %s\n"
4523 ebnf-except-border-color
4525 (format "/ShapeE %d def\n"
4526 (ebnf-shape-value ebnf-except-shape
4527 ebnf-terminal-shape-alist))
4528 (format "/ShadowE %s def\n"
4529 (ebnf-boolean ebnf-except-shadow))
4531 (format "/fR %s /%s DefFont\n"
4532 (ebnf-format-float (ebnf-font-size ebnf-repeat-font))
4533 (ebnf-font-name-select ebnf-repeat-font))
4534 (ebnf-format-color "/ForegroundR %s def %% %s\n"
4535 (ebnf-font-foreground ebnf-repeat-font)
4537 (ebnf-format-color "/BackgroundR %s def %% %s\n"
4538 (ebnf-font-background ebnf-repeat-font)
4540 (format "/EffectR %d def\n"
4541 (ebnf-font-attributes ebnf-repeat-font))
4542 (format "/BorderWidthR %s def\n"
4543 (ebnf-format-float ebnf-repeat-border-width))
4544 (ebnf-format-color "/BorderColorR %s def %% %s\n"
4545 ebnf-repeat-border-color
4547 (format "/ShapeR %d def\n"
4548 (ebnf-shape-value ebnf-repeat-shape
4549 ebnf-terminal-shape-alist))
4550 (format "/ShadowR %s def\n"
4551 (ebnf-boolean ebnf-repeat-shadow))
4553 (format "/DefaultWidth %s def\n"
4554 (ebnf-format-float ebnf-default-width))
4555 (format "/LineWidth %s def\n"
4556 (ebnf-format-float ebnf-line-width))
4557 (ebnf-format-color "/LineColor %s def %% %s\n"
4560 (format "/ArrowShape %d def\n"
4561 (ebnf-shape-value ebnf-arrow-shape
4562 ebnf-arrow-shape-alist))
4563 (format "/ChartShape %d def\n"
4564 (ebnf-shape-value ebnf-chart-shape
4565 ebnf-terminal-shape-alist))
4566 (format "/UserArrow{%s}def\n"
4567 (ebnf-user-arrow ebnf-user-arrow))
4568 "\n% === end EBNF settings\n\n"
4569 (and ebnf-debug-ps ebnf-debug))))
4573 (defun ebnf-user-arrow (user-arrow)
4574 "Return a user arrow shape from USER-ARROW (a PostScript code).
4576 This function is only called when `ebnf-arrow-shape' is set to symbol `user'.
4578 If is a string, should be a PostScript procedure body.
4579 If is a variable symbol, should contain a string.
4580 If is a function symbol, it is called and the result is applied recursively.
4581 If is a cons and car is a function symbol, it is called as:
4582 (funcall (car cons) (cdr cons))
4583 and the result is applied recursively.
4584 If is a cons and car is not a function symbol, it is applied recursively on
4585 car and cdr, and the results are concatened as:
4586 (concat RESULT-FROM-CAR \" \" RESULT-FROM-CDR)
4587 If is a list and car is a function symbol, it is called as:
4588 (apply (car list) (cdr list))
4589 and the result is applied recursively.
4590 If is a list and car is not a function symbol, it is applied recursively on
4591 each element and the resulting list is concatened as:
4592 (mapconcat 'identity RESULTING-LIST \" \")
4593 Otherwise, it is treated as an empty string."
4597 ((stringp user-arrow)
4599 ((and (symbolp user-arrow) (fboundp user-arrow))
4600 (ebnf-user-arrow (funcall user-arrow)))
4601 ((and (symbolp user-arrow) (boundp user-arrow))
4602 (ebnf-user-arrow (symbol-value user-arrow)))
4604 (if (and (symbolp (car user-arrow)) (fboundp (car user-arrow)))
4605 (ebnf-user-arrow (funcall (car user-arrow) (cdr user-arrow)))
4606 (concat (ebnf-user-arrow (car user-arrow))
4608 (ebnf-user-arrow (cdr user-arrow)))))
4610 (if (and (symbolp (car user-arrow))
4611 (fboundp (car user-arrow)))
4612 (ebnf-user-arrow (apply (car user-arrow) (cdr user-arrow)))
4613 (mapconcat 'ebnf-user-arrow user-arrow " ")))
4619 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4620 ;; Adjusting dimensions
4623 (defun ebnf-dimensions (tree)
4624 (let ((ebnf-total (length tree))
4626 (mapcar 'ebnf-production-dimension tree))
4630 ;; [empty width-fun dim-fun entry height width]
4631 ;;(defun ebnf-empty-dimension (empty)
4635 ;; [production width-fun dim-fun entry height width name production action]
4636 (defun ebnf-production-dimension (production)
4637 (ebnf-message-info "Calculating dimensions")
4638 (ebnf-node-dimension-func (ebnf-node-production production))
4639 (let* ((prod (ebnf-node-production production))
4640 (height (+ ebnf-font-height-P
4642 (ebnf-node-height prod))))
4643 (ebnf-node-entry production height)
4644 (ebnf-node-height production height)
4645 (ebnf-node-width production (+ (ebnf-node-width prod)
4646 ebnf-horizontal-space))))
4649 ;; [terminal width-fun dim-fun entry height width name]
4650 (defun ebnf-terminal-dimension (terminal)
4651 (ebnf-terminal-dimension1 terminal
4657 ;; [non-terminal width-fun dim-fun entry height width name]
4658 (defun ebnf-non-terminal-dimension (non-terminal)
4659 (ebnf-terminal-dimension1 non-terminal
4665 ;; [special width-fun dim-fun entry height width name]
4666 (defun ebnf-special-dimension (special)
4667 (ebnf-terminal-dimension1 special
4673 (defun ebnf-terminal-dimension1 (node font-height font-width space)
4674 (let ((height (+ space font-height space))
4675 (len (length (ebnf-node-name node))))
4676 (ebnf-node-entry node (* height 0.5))
4677 (ebnf-node-height node height)
4678 (ebnf-node-width node (+ ebnf-basic-width space
4680 space ebnf-basic-width))))
4683 (defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
4686 ;; [repeat width-fun dim-fun entry height width times element]
4687 (defun ebnf-repeat-dimension (repeat)
4688 (let ((times (ebnf-node-name repeat))
4689 (element (ebnf-node-separator repeat)))
4691 (ebnf-node-dimension-func element)
4692 (setq element ebnf-null-vector))
4693 (ebnf-node-entry repeat (+ (ebnf-node-entry element)
4695 (ebnf-node-height repeat (+ (max (ebnf-node-height element)
4697 ebnf-space-R ebnf-space-R))
4698 (ebnf-node-width repeat (+ (ebnf-node-width element)
4699 ebnf-space-R ebnf-space-R ebnf-space-R
4700 ebnf-horizontal-space
4701 (* (length times) ebnf-font-width-R)))))
4704 ;; [except width-fun dim-fun entry height width element element]
4705 (defun ebnf-except-dimension (except)
4706 (let ((factor (ebnf-node-list except))
4707 (element (ebnf-node-separator except)))
4708 (ebnf-node-dimension-func factor)
4710 (ebnf-node-dimension-func element)
4711 (setq element ebnf-null-vector))
4712 (ebnf-node-entry except (+ (max (ebnf-node-entry factor)
4713 (ebnf-node-entry element))
4715 (ebnf-node-height except (+ (max (ebnf-node-height factor)
4716 (ebnf-node-height element))
4717 ebnf-space-E ebnf-space-E))
4718 (ebnf-node-width except (+ (ebnf-node-width factor)
4719 (ebnf-node-width element)
4720 ebnf-space-E ebnf-space-E
4721 ebnf-space-E ebnf-space-E
4723 ebnf-horizontal-space))))
4726 ;; [alternative width-fun dim-fun entry height width list]
4727 (defun ebnf-alternative-dimension (alternative)
4728 (let ((body (ebnf-node-list alternative))
4729 (lis (ebnf-node-list alternative)))
4731 (ebnf-node-dimension-func (car lis))
4732 (setq lis (cdr lis)))
4736 (tail (car (last body)))
4737 (entry (ebnf-node-entry (car body)))
4740 (setq node (car alt)
4742 height (+ (ebnf-node-height node) height)
4743 width (max (ebnf-node-width node) width)))
4744 (ebnf-adjust-width body width)
4745 (setq height (+ height (* (1- (length body)) ebnf-vertical-space)))
4746 (ebnf-node-entry alternative (+ entry
4749 (- (ebnf-node-height tail)
4750 (ebnf-node-entry tail))))))
4751 (ebnf-node-height alternative height)
4752 (ebnf-node-width alternative (+ width ebnf-horizontal-space))
4753 (ebnf-node-list alternative body))))
4756 ;; [optional width-fun dim-fun entry height width element]
4757 (defun ebnf-optional-dimension (optional)
4758 (let ((body (ebnf-node-list optional)))
4759 (ebnf-node-dimension-func body)
4760 (ebnf-node-entry optional (ebnf-node-entry body))
4761 (ebnf-node-height optional (+ (ebnf-node-height body)
4762 ebnf-vertical-space))
4763 (ebnf-node-width optional (+ (ebnf-node-width body)
4764 ebnf-horizontal-space))))
4767 ;; [one-or-more width-fun dim-fun entry height width element separator]
4768 (defun ebnf-one-or-more-dimension (or-more)
4769 (let ((list-part (ebnf-node-list or-more))
4770 (sep-part (ebnf-node-separator or-more)))
4771 (ebnf-node-dimension-func list-part)
4773 (ebnf-node-dimension-func sep-part))
4774 (let ((height (+ (if sep-part
4775 (ebnf-node-height sep-part)
4778 (ebnf-node-height list-part)))
4779 (width (max (if sep-part
4780 (ebnf-node-width sep-part)
4782 (ebnf-node-width list-part))))
4784 (ebnf-adjust-width list-part width)
4785 (ebnf-adjust-width sep-part width))
4786 (ebnf-node-entry or-more (+ (- height (ebnf-node-height list-part))
4787 (ebnf-node-entry list-part)))
4788 (ebnf-node-height or-more height)
4789 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
4792 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4793 (defun ebnf-zero-or-more-dimension (or-more)
4794 (let ((list-part (ebnf-node-list or-more))
4795 (sep-part (ebnf-node-separator or-more)))
4796 (ebnf-node-dimension-func list-part)
4798 (ebnf-node-dimension-func sep-part))
4799 (let ((height (+ (if sep-part
4800 (ebnf-node-height sep-part)
4803 (ebnf-node-height list-part)
4804 ebnf-vertical-space))
4805 (width (max (if sep-part
4806 (ebnf-node-width sep-part)
4808 (ebnf-node-width list-part))))
4810 (ebnf-adjust-width list-part width)
4811 (ebnf-adjust-width sep-part width))
4812 (ebnf-node-entry or-more height)
4813 (ebnf-node-height or-more height)
4814 (ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
4817 ;; [sequence width-fun dim-fun entry height width list]
4818 (defun ebnf-sequence-dimension (sequence)
4822 (lis (ebnf-node-list sequence))
4825 (setq node (car lis)
4827 (ebnf-node-dimension-func node)
4828 (setq entry (ebnf-node-entry node)
4829 above (max above entry)
4830 below (max below (- (ebnf-node-height node) entry))
4831 width (+ width (ebnf-node-width node))))
4832 (ebnf-node-entry sequence above)
4833 (ebnf-node-height sequence (+ above below))
4834 (ebnf-node-width sequence width)))
4837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4841 (defun ebnf-adjust-width (node width)
4847 (setcar node (ebnf-adjust-width (car node) width))
4848 (setq node (cdr node)))))
4851 ;; nothing to be done
4852 ((= width (ebnf-node-width node))
4854 ;; left justify term
4855 ((eq ebnf-justify-sequence 'left)
4856 (ebnf-adjust-empty node width nil))
4857 ;; right justify terms
4858 ((eq ebnf-justify-sequence 'right)
4859 (ebnf-adjust-empty node width t))
4862 (ebnf-node-width-func node width)
4863 (ebnf-node-width node width)
4871 (defun ebnf-adjust-empty (node width last-p)
4872 (if (eq (ebnf-node-kind node) 'ebnf-generate-empty)
4874 (ebnf-node-width node width)
4876 (let ((empty (ebnf-make-empty (- width (ebnf-node-width node)))))
4877 (ebnf-make-dup-sequence node
4880 (list node empty))))))
4883 ;; [terminal width-fun dim-fun entry height width name]
4884 ;; [non-terminal width-fun dim-fun entry height width name]
4885 ;; [empty width-fun dim-fun entry height width]
4886 ;; [special width-fun dim-fun entry height width name]
4887 ;; [repeat width-fun dim-fun entry height width times element]
4888 ;; [except width-fun dim-fun entry height width element element]
4889 ;;(defun ebnf-terminal-width (terminal width)
4893 ;; [alternative width-fun dim-fun entry height width list]
4894 ;; [optional width-fun dim-fun entry height width element]
4895 (defun ebnf-alternative-width (alternative width)
4896 (ebnf-adjust-width (ebnf-node-list alternative)
4897 (- width ebnf-horizontal-space)))
4900 ;; [one-or-more width-fun dim-fun entry height width element separator]
4901 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4902 (defun ebnf-list-width (or-more width)
4903 (setq width (- width ebnf-horizontal-space))
4904 (ebnf-node-list or-more
4905 (ebnf-justify-list or-more
4906 (ebnf-node-list or-more)
4908 (ebnf-node-separator or-more
4909 (ebnf-justify-list or-more
4910 (ebnf-node-separator or-more)
4914 ;; [sequence width-fun dim-fun entry height width list]
4915 (defun ebnf-sequence-width (sequence width)
4916 (ebnf-node-list sequence
4917 (ebnf-justify-list sequence (ebnf-node-list sequence) width)))
4920 (defun ebnf-justify-list (node seq width)
4921 (let ((seq-width (ebnf-node-width node)))
4922 (if (= width seq-width)
4925 ;; left justify terms
4926 ((eq ebnf-justify-sequence 'left)
4927 (ebnf-justify node seq seq-width width t))
4928 ;; right justify terms
4929 ((eq ebnf-justify-sequence 'right)
4930 (ebnf-justify node seq seq-width width nil))
4933 (let ((the-width (/ (- width seq-width) (length seq)))
4936 (ebnf-adjust-width (car lis)
4937 (+ (ebnf-node-width (car lis))
4939 (setq lis (cdr lis)))
4944 (defun ebnf-justify (node seq seq-width width last-p)
4945 (let ((term (car (if last-p (last seq) seq))))
4947 ;; adjust empty term
4948 ((eq (ebnf-node-kind term) 'ebnf-generate-empty)
4949 (ebnf-node-width term (+ (- width seq-width)
4950 (ebnf-node-width term)))
4952 ;; insert empty at end ==> left justify
4955 (list (ebnf-make-empty (- width seq-width)))))
4956 ;; insert empty at beginning ==> right justify
4958 (cons (ebnf-make-empty (- width seq-width))
4963 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4964 ;; Functions used by parsers
4967 (defun ebnf-eps-add-context (name)
4968 (let ((filename (ebnf-eps-filename name)))
4969 (if (member filename ebnf-eps-context)
4970 (error "Try to open an already opened EPS file: %s" filename)
4971 (setq ebnf-eps-context (cons filename ebnf-eps-context)))))
4974 (defun ebnf-eps-remove-context (name)
4975 (let ((filename (ebnf-eps-filename name)))
4976 (if (member filename ebnf-eps-context)
4977 (setq ebnf-eps-context (delete filename ebnf-eps-context))
4978 (error "Try to close a not opened EPS file: %s" filename))))
4981 (defun ebnf-eps-add-production (header)
4982 (and ebnf-eps-executing
4984 (let ((prod (assoc header ebnf-eps-production-list)))
4986 (setcdr prod (append ebnf-eps-context (cdr prod)))
4987 (setq ebnf-eps-production-list
4988 (cons (cons header (ebnf-dup-list ebnf-eps-context))
4989 ebnf-eps-production-list))))))
4992 (defun ebnf-dup-list (old)
4995 (setq new (cons (car old) new)
5000 (defun ebnf-buffer-substring (chars)
5001 (buffer-substring-no-properties
5004 (skip-chars-forward chars ebnf-limit)
5008 (defun ebnf-string (chars eos-char kind)
5010 (buffer-substring-no-properties
5013 (skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5014 (if (or (eobp) (/= (following-char) eos-char))
5015 (error "Illegal %s: missing `%c'." kind eos-char)
5020 (defun ebnf-get-string ()
5022 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5025 (defun ebnf-end-of-string ()
5027 (while (> (logand n 1) 0)
5028 (skip-chars-forward "^\"" ebnf-limit)
5029 (setq n (- (skip-chars-backward "\\\\")))
5030 (goto-char (+ (point) n 1))))
5031 (if (= (preceding-char) ?\")
5033 (error "Missing `\"'.")))
5036 (defun ebnf-trim-right (str)
5037 (let* ((len (1- (length str)))
5039 (while (and (> index 0) (= (aref str index) ?\ ))
5040 (setq index (1- index)))
5043 (substring str 0 (1+ index)))))
5046 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5050 (defun ebnf-make-empty (&optional width)
5051 (vector 'ebnf-generate-empty
5056 (or width ebnf-horizontal-space)))
5059 (defun ebnf-make-terminal (name)
5060 (ebnf-make-terminal1 name
5061 'ebnf-generate-terminal
5062 'ebnf-terminal-dimension))
5065 (defun ebnf-make-non-terminal (name)
5066 (ebnf-make-terminal1 name
5067 'ebnf-generate-non-terminal
5068 'ebnf-non-terminal-dimension))
5071 (defun ebnf-make-special (name)
5072 (ebnf-make-terminal1 name
5073 'ebnf-generate-special
5074 'ebnf-special-dimension))
5077 (defun ebnf-make-terminal1 (name gen-func dim-func)
5084 (let ((len (length name)))
5085 (cond ((> len 2) name)
5086 ((= len 2) (concat " " name))
5087 ((= len 1) (concat " " name " "))
5092 (defun ebnf-make-one-or-more (list-part &optional sep-part)
5093 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5094 'ebnf-one-or-more-dimension
5099 (defun ebnf-make-zero-or-more (list-part &optional sep-part)
5100 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5101 'ebnf-zero-or-more-dimension
5106 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
5113 (if (listp list-part)
5114 (ebnf-make-sequence list-part)
5116 (if (and sep-part (listp sep-part))
5117 (ebnf-make-sequence sep-part)
5121 (defun ebnf-make-production (name prod action)
5122 (vector 'ebnf-generate-production
5124 'ebnf-production-dimension
5133 (defun ebnf-make-alternative (body)
5134 (vector 'ebnf-generate-alternative
5135 'ebnf-alternative-width
5136 'ebnf-alternative-dimension
5143 (defun ebnf-make-optional (body)
5144 (vector 'ebnf-generate-optional
5145 'ebnf-alternative-width
5146 'ebnf-optional-dimension
5153 (defun ebnf-make-except (factor exception)
5154 (vector 'ebnf-generate-except
5156 'ebnf-except-dimension
5164 (defun ebnf-make-repeat (times primary)
5165 (vector 'ebnf-generate-repeat
5167 'ebnf-repeat-dimension
5175 (defun ebnf-make-sequence (seq)
5176 (vector 'ebnf-generate-sequence
5177 'ebnf-sequence-width
5178 'ebnf-sequence-dimension
5185 (defun ebnf-make-dup-sequence (node seq)
5186 (vector 'ebnf-generate-sequence
5187 'ebnf-sequence-width
5188 'ebnf-sequence-dimension
5189 (ebnf-node-entry node)
5190 (ebnf-node-height node)
5191 (ebnf-node-width node)
5195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5196 ;; Optimizers used by parsers
5199 (defun ebnf-token-except (element exception)
5202 (setq exception (cdr exception)))
5203 (and element ; EMPTY - A ==> EMPTY
5204 (let ((kind (ebnf-node-kind element)))
5207 ((and (null exception)
5208 (eq kind 'ebnf-generate-optional))
5209 (ebnf-node-list element))
5210 ;; { A }- ==> { A }+
5211 ((and (null exception)
5212 (eq kind 'ebnf-generate-zero-or-more))
5213 (ebnf-node-kind element 'ebnf-generate-one-or-more)
5214 (ebnf-node-dimension-func element 'ebnf-one-or-more-dimension)
5216 ;; ( A | EMPTY )- ==> A
5217 ;; ( A | B | EMPTY )- ==> A | B
5218 ((and (null exception)
5219 (eq kind 'ebnf-generate-alternative)
5220 (eq (ebnf-node-kind (car (last (ebnf-node-list element))))
5221 'ebnf-generate-empty))
5222 (let ((elt (ebnf-node-list element))
5228 ;; this should not happen!!?!
5229 (setq element (ebnf-make-empty
5230 (ebnf-node-width element)))
5232 (setq elt (ebnf-node-list element))
5233 (and (= (length elt) 1)
5234 (setq element (car elt))))
5238 (ebnf-make-except element exception))
5242 (defun ebnf-token-repeat (times repeat)
5243 (if (null (cdr repeat))
5244 ;; n * EMPTY ==> EMPTY
5248 (ebnf-make-repeat times (cdr repeat)))))
5251 (defun ebnf-token-optional (body)
5252 (let ((kind (ebnf-node-kind body)))
5254 ;; [ EMPTY ] ==> EMPTY
5255 ((eq kind 'ebnf-generate-empty)
5257 ;; [ { A }* ] ==> { A }*
5258 ((eq kind 'ebnf-generate-zero-or-more)
5260 ;; [ { A }+ ] ==> { A }*
5261 ((eq kind 'ebnf-generate-one-or-more)
5262 (ebnf-node-kind body 'ebnf-generate-zero-or-more)
5264 ;; [ A | B ] ==> A | B | EMPTY
5265 ((eq kind 'ebnf-generate-alternative)
5266 (ebnf-node-list body (nconc (ebnf-node-list body)
5267 (list (ebnf-make-empty))))
5271 (ebnf-make-optional body))
5275 (defun ebnf-token-alternative (body sequence)
5279 (cons (car sequence)
5281 (cons (car sequence)
5282 (let ((seq (cdr sequence)))
5283 (if (and (= (length body) 1) (null seq))
5285 (ebnf-make-alternative (nreverse (if seq
5290 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5291 ;; Variables used by parsers
5294 (defconst ebnf-comment-table
5295 (let ((table (make-vector 256 nil)))
5296 ;; Override special comment character:
5297 (aset table ?< 'newline)
5298 (aset table ?> 'keep-line)
5300 "Vector used to map characters to a special comment token.")
5303 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5304 ;; To make this file smaller, some commands go in a separate file.
5305 ;; But autoload them here to make the separation invisible.
5307 (autoload 'ebnf-bnf-parser "ebnf-bnf"
5310 (autoload 'ebnf-bnf-initialize "ebnf-bnf"
5311 "Initialize EBNF token table.")
5313 (autoload 'ebnf-iso-parser "ebnf-iso"
5316 (autoload 'ebnf-iso-initialize "ebnf-iso"
5317 "Initialize ISO EBNF token table.")
5319 (autoload 'ebnf-yac-parser "ebnf-yac"
5320 "Yacc/Bison parser.")
5322 (autoload 'ebnf-yac-initialize "ebnf-yac"
5323 "Initializations for Yacc/Bison parser.")
5325 (autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
5326 "Eliminate empty rules.")
5328 (autoload 'ebnf-optimize "ebnf-otz"
5329 "Syntatic chart optimizer.")
5331 (autoload 'ebnf-otz-initialize "ebnf-otz"
5332 "Initialize optimizer.")
5335 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5341 ;;; ebnf2ps.el ends here