1 ;;; ebnf2ps.el --- translate an EBNF to a syntatic chart on PostScript
3 ;; Copyright (C) 1999, 2000, 2001 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: <2001-07-15 01:05:00 pavel>
10 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/Emacs.html
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, USA.
29 (defconst ebnf-version
"3.5"
30 "ebnf2ps.el, v 3.5 <2001/02/02 vinicius>
33 Vinicius's last change version. When reporting bugs, please also
34 report the version of Emacs, if any, that ebnf2ps was running with.
36 Please send all bug fixes and enhancements to
37 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
43 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; This package translates an EBNF to a syntatic chart on PostScript.
50 ;; To use ebnf2ps, insert in your ~/.emacs:
54 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
55 ;; know how to set options like landscape printing, page headings, margins,
58 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
59 ;; ebnf2ps, they behave as it's turned off.
61 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
63 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
65 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
67 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
73 ;; ebnf2ps provides six commands for generating PostScript syntatic chart
74 ;; images of Emacs buffers:
83 ;; These commands all perform essentially the same function: they generate
84 ;; PostScript syntatic chart images suitable for printing on a PostScript
85 ;; printer or displaying with GhostScript. These commands are collectively
86 ;; referred to as "ebnf- commands".
88 ;; The word "print", "spool" and "eps" in the command name determines when the
89 ;; PostScript image is sent to the printer (or file):
91 ;; print - The PostScript image is immediately sent to the printer;
93 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
94 ;; Many images may be spooled locally before printing them. To
95 ;; send the spooled images to the printer, use the command
98 ;; eps - The PostScript image is immediately sent to a EPS file.
100 ;; The spooling mechanism is the same as used by ps-print and was designed for
101 ;; printing lots of small files to save paper that would otherwise be wasted on
102 ;; banner pages, and to make it easier to find your output at the printer (it's
103 ;; easier to pick up one 50-page printout than to find 50 single-page
104 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
105 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
107 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
108 ;; won't accidentally quit from Emacs while you have unprinted PostScript
109 ;; waiting in the spool buffer. If you do attempt to exit with spooled
110 ;; PostScript, you'll be asked if you want to print it, and if you decline,
111 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
112 ;; that Emacs uses for modified buffers.
114 ;; The word "buffer" or "region" in the command name determines how much of the
115 ;; buffer is printed:
117 ;; buffer - Print the entire buffer.
119 ;; region - Print just the current region.
121 ;; Two ebnf- command examples:
123 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
124 ;; immediately to the printer.
126 ;; ebnf-spool-region - translate and print just the current region, and
127 ;; spool the image in Emacs to send to the printer
130 ;; Note that `ebnf-eps-buffer' and `ebnf-eps-region' never spool the EPS image,
131 ;; so they don't use the ps-print spooling mechanism. See section "Actions in
132 ;; Comments" for an explanation about EPS file generation.
138 ;; To translate and print your buffer, type
140 ;; M-x ebnf-print-buffer
142 ;; or substitute one of the other four ebnf- commands. The command will
143 ;; generate the PostScript image and print or spool it as specified. By giving
144 ;; the command a prefix argument
146 ;; C-u M-x ebnf-print-buffer
148 ;; it will save the PostScript image to a file instead of sending it to the
149 ;; printer; you will be prompted for the name of the file to save the image to.
150 ;; The prefix argument is ignored by the commands that spool their images, but
151 ;; you may save the spooled images to a file by giving a prefix argument to
154 ;; C-u M-x ebnf-despool
156 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
159 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
160 ;; `ebnf-eps-region'.
162 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
164 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
165 ;; (global-set-key '(shift f22) 'ebnf-print-region)
166 ;; (global-set-key '(control f22) 'ebnf-despool)
172 ;; The current EBNF that ebnf2ps accepts has the following constructions:
174 ;; ; comment (until end of line)
178 ;; $A default non-terminal (see text below)
179 ;; $"C" default terminal (see text below)
180 ;; $?C? default special (see text below)
181 ;; A = B. production (A is the header and B the body)
182 ;; C D sequence (C occurs before D)
183 ;; C | D alternative (C or D occurs)
184 ;; A - B exception (A excluding B, B without any non-terminal)
185 ;; n * A repetition (A repeats n (integer) times)
186 ;; (C) group (expression C is grouped together)
187 ;; [C] optional (C may or not occurs)
188 ;; C+ one or more occurrences of C
189 ;; {C}+ one or more occurrences of C
190 ;; {C}* zero or more occurrences of C
191 ;; {C} zero or more occurrences of C
192 ;; C / D equivalent to: C {D C}*
193 ;; {C || D}+ equivalent to: C {D C}*
194 ;; {C || D}* equivalent to: [C {D C}*]
195 ;; {C || D} equivalent to: [C {D C}*]
197 ;; The EBNF syntax written using the notation above is:
199 ;; EBNF = {production}+.
201 ;; production = non_terminal "=" body ".". ;; production
203 ;; body = {sequence || "|"}*. ;; alternative
205 ;; sequence = {exception}*. ;; sequence
207 ;; exception = repeat [ "-" repeat]. ;; exception
209 ;; repeat = [ integer "*" ] term. ;; repetition
212 ;; | [factor] "+" ;; one-or-more
213 ;; | [factor] "/" [factor] ;; one-or-more
216 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
217 ;; | [ "$" ] non_terminal ;; non-terminal
218 ;; | [ "$" ] "?" special "?" ;; special
219 ;; | "(" body ")" ;; group
220 ;; | "[" body "]" ;; zero-or-one
221 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
222 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
223 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
226 ;; non_terminal = "[A-Za-z\\240-\\377][!#%&'*-,0-:<>@-Z\\^-z~\\240-\\377]*".
228 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
230 ;; special = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*".
232 ;; integer = "[0-9]+".
234 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
236 ;; Try to use the above EBNF to test ebnf2ps.
238 ;; The `default' terminal, non-terminal and special is a way to indicate a
239 ;; default path in a production. For example, the production:
241 ;; X = [ $A ( B | $C ) | D ].
243 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
245 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
246 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
247 ;; name besides that enclosed by `"'.
249 ;; Let's see an example:
251 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
252 ;; (setq ebnf-case-fold-search nil) ; exact matching
254 ;; If you have the production:
256 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
258 ;; The names are classified as:
260 ;; Logical Expression non-terminal
261 ;; "(" OR AND "XOR" ")" terminal
263 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
264 ;; value is ?\; (character `;').
266 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
267 ;; value is ?. (character `.').
269 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
271 ;; `ebnf' ebnf2ps recognizes the syntax described above.
272 ;; The following variables *ONLY* have effect with this
274 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
275 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
277 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
278 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
279 ;; ("International Standard of the ISO EBNF Notation").
280 ;; The following variables *ONLY* have effect with this
282 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
284 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
285 ;; The following variable *ONLY* has effect with this
287 ;; `ebnf-yac-ignore-error-recovery'.
289 ;; Any other value is treated as `ebnf'.
291 ;; The default value is `ebnf'.
297 ;; The following EBNF optimizations are done:
299 ;; [ { A }* ] ==> { A }*
300 ;; [ { A }+ ] ==> { A }*
301 ;; [ A ] + ==> { A }*
302 ;; { A }* + ==> { A }*
303 ;; { A }+ + ==> { A }+
306 ;; ( A | EMPTY )- ==> A
307 ;; ( A | B | EMPTY )- ==> A | B
308 ;; [ A | B ] ==> A | B | EMPTY
309 ;; n * EMPTY ==> EMPTY
311 ;; EMPTY / EMPTY ==> EMPTY
312 ;; EMPTY - A ==> EMPTY
314 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
317 ;; 1. A = B | A C. ==> A = B {C}*.
318 ;; 2. A = B | A B. ==> A = {B}+.
319 ;; 3. A = | A B. ==> A = {B}*.
320 ;; 4. A = B | A C B. ==> A = {B || C}+.
321 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
324 ;; 6. A = B | . ==> A = [B].
325 ;; 7. A = | B . ==> A = [B].
328 ;; 8. A = B C | B D. ==> A = B (C | D).
329 ;; 9. A = C B | D B. ==> A = (C | D) B.
330 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
332 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
338 ;; You may use form feed (^L \014) to force a production to start on a new
339 ;; page, for example:
348 ;; c) A = B ^L^L^L | C.^L
352 ;; In all examples above, only the production X will start on a new page.
355 ;; Actions in Comments
356 ;; -------------------
358 ;; ebnf2ps accepts the following actions in comments:
360 ;; ;> the next production starts in the same line as the current one.
361 ;; It is useful when `ebnf-horizontal-orientation' is nil.
363 ;; ;< the next production starts in the next line.
364 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
366 ;; ;[EPS open a new EPS file. The EPS file name has the form:
367 ;; <PREFIX><NAME>.eps
368 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
369 ;; <NAME> is the string given by ;[ action comment, this string is
370 ;; mapped to form a valid file name (see documentation for
371 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
372 ;; It has effect only during `ebnf-eps-buffer' or
373 ;; `ebnf-eps-region' execution.
374 ;; It's an error to try to open an already opened EPS file.
376 ;; ;]EPS close an opened EPS file.
377 ;; It has effect only during `ebnf-eps-buffer' or
378 ;; `ebnf-eps-region' execution.
379 ;; It's an error to try to close a not opened EPS file.
383 ;; (setq ebnf-horizontal-orientation nil)
387 ;; ;> C and B are drawn in the same line
391 ;; The graphical result is:
397 ;; +---------+ +-----+
409 ;; Note that if ascending production sort is used, the productions A and B will
410 ;; be drawn in the same line instead of C and B.
412 ;; If consecutive actions occur, only the last one takes effect, so if you
421 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
424 ;; In ISO EBNF the above actions are specified as (*>*), (*<*), (*[EPS*) and
425 ;; (*]EPS*). The first example above should be written:
429 ;; (*> C and B are drawn in the same line *)
433 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
434 ;; `ebnf-eps-region':
453 ;; The following table summarizes the results:
455 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
456 ;; ebnf--AA.eps A C A C C A
457 ;; ebnf--BB.eps C B B C C B
458 ;; ebnf--CC.eps A C B F A B C F F C B A
464 ;; As you can see if EPS actions is not used, each single production is
465 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
466 ;; it's not an existing production name.
468 ;; In the following case:
476 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
482 ;; Some tools are provided to help you.
484 ;; `ebnf-setup' returns the current setup.
486 ;; `ebnf-syntax-buffer' does a syntatic analysis of your EBNF in the current
489 ;; `ebnf-syntax-region' does a syntatic analysis of your EBNF in the current
492 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
494 ;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound
495 ;; to keys in the same way as `ebnf-' commands.
501 ;; ebn2ps has the following hook variables:
504 ;; It is evaluated once before any ebnf2ps process.
506 ;; `ebnf-production-hook'
507 ;; It is evaluated on each beginning of production.
510 ;; It is evaluated on each beginning of page.
516 ;; Below it's shown a brief description of ebnf2ps options, please, see the
517 ;; options declaration in the code for a long documentation.
519 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
522 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
523 ;; height in horizontal orientation.
525 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
526 ;; between productions.
528 ;; `ebnf-production-vertical-space' Specify vertical space in points
529 ;; between productions.
531 ;; `ebnf-justify-sequence' Specify justification of terms in a
532 ;; sequence inside alternatives.
534 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
536 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
538 ;; `ebnf-terminal-font' Specify terminal font.
540 ;; `ebnf-terminal-shape' Specify terminal box shape.
542 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
545 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
547 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
549 ;; `ebnf-sort-production' Specify how productions are sorted.
551 ;; `ebnf-production-font' Specify production font.
553 ;; `ebnf-non-terminal-font' Specify non-terminal font.
555 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
557 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
560 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
563 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
566 ;; `ebnf-special-font' Specify special font.
568 ;; `ebnf-special-shape' Specify special box shape.
570 ;; `ebnf-special-shadow' Non-nil means special box will have a
573 ;; `ebnf-special-border-width' Specify border width for special box.
575 ;; `ebnf-special-border-color' Specify border color for special box.
577 ;; `ebnf-except-font' Specify except font.
579 ;; `ebnf-except-shape' Specify except box shape.
581 ;; `ebnf-except-shadow' Non-nil means except box will have a
584 ;; `ebnf-except-border-width' Specify border width for except box.
586 ;; `ebnf-except-border-color' Specify border color for except box.
588 ;; `ebnf-repeat-font' Specify repeat font.
590 ;; `ebnf-repeat-shape' Specify repeat box shape.
592 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
595 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
597 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
599 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
601 ;; `ebnf-arrow-shape' Specify the arrow shape.
603 ;; `ebnf-chart-shape' Specify chart flow shape.
605 ;; `ebnf-color-p' Non-nil means use color.
607 ;; `ebnf-line-width' Specify flow line width.
609 ;; `ebnf-line-color' Specify flow line color.
611 ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
614 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
617 ;; `ebnf-lex-comment-char' Specify the line comment character.
619 ;; `ebnf-lex-eop-char' Specify the end of production
622 ;; `ebnf-syntax' Specify syntax to be recognized.
624 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
626 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
629 ;; `ebnf-default-width' Specify additional border width over
630 ;; default terminal, non-terminal or
633 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
635 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
637 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
639 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
641 ;; `ebnf-optimize' Non-nil means optimize syntatic chart
644 ;; To set the above options you may:
646 ;; a) insert the code in your ~/.emacs, like:
648 ;; (setq ebnf-terminal-shape 'bevel)
650 ;; This way always keep your default settings when you enter a new Emacs
653 ;; b) or use `set-variable' in your Emacs session, like:
655 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
657 ;; This way keep your settings only during the current Emacs session.
659 ;; c) or use customization, for example:
660 ;; click on menu-bar *Help* option,
661 ;; then click on *Customize*,
662 ;; then click on *Browse Customization Groups*,
663 ;; expand *PostScript* group,
664 ;; expand *Ebnf2ps* group
665 ;; and then customize ebnf2ps options.
666 ;; Through this way, you may choose if the settings are kept or not when
667 ;; you leave out the current Emacs session.
669 ;; d) or see the option value:
671 ;; C-h v ebnf-terminal-shape RET
673 ;; and click the *customize* hypertext button.
674 ;; Through this way, you may choose if the settings are kept or not when
675 ;; you leave out the current Emacs session.
679 ;; M-x ebnf-customize RET
681 ;; and then customize ebnf2ps options.
682 ;; Through this way, you may choose if the settings are kept or not when
683 ;; you leave out the current Emacs session.
689 ;; Sometimes you need to change the EBNF style you are using, for example,
690 ;; change the shapes and colors. These changes may force you to set some
691 ;; variables and after use, set back the variables to the old values.
693 ;; To help to handle this situation, ebnf2ps has the following commands to
696 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
699 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
701 ;; `ebnf-apply-style' Set STYLE to current style.
703 ;; `ebnf-reset-style' Reset current style.
705 ;; `ebnf-push-style' Push the current style and set STYLE to current style.
707 ;; `ebnf-pop-style' Pop a style and set it to current style.
709 ;; These commands helps to put together a lot of variable settings in a group
710 ;; and name this group. So when you wish to apply these settings it's only
711 ;; needed to give the name.
713 ;; There is also a notion of simple inheritance of style; so if you declare
714 ;; that a style A inherits from a style B, all settings of B is applied first
715 ;; and then the settings of A is applied. This is useful when you wish to
716 ;; modify some aspects of an existing style, but at same time wish to keep it
719 ;; See documentation for `ebnf-style-database'.
725 ;; Below it is the layout of minimum area to draw each element, and it's used
726 ;; the following terms:
728 ;; font height is given by:
729 ;; (terminal font height + non-terminal font height) / 2
731 ;; entry is the vertical position used to know where it should
732 ;; be drawn the flow line in the current element.
735 ;; * SPECIAL, TERMINAL and NON-TERMINAL
737 ;; +==============+...................................
738 ;; | | } font height / 2 } entry }
739 ;; | XXXXXXXX...|....... } }
740 ;; ====+ XXXXXXXX +==== } text height ...... } height
741 ;; : | XXXXXXXX...|...:... }
742 ;; : | : : | : } font height / 2 }
743 ;; : +==============+...:...............................
745 ;; : : : : : :......................
746 ;; : : : : : } font height }
747 ;; : : : : :....... }
748 ;; : : : : } font height / 2 }
749 ;; : : : :........... }
750 ;; : : : } text width } width
751 ;; : : :.................. }
752 ;; : : } font height / 2 }
753 ;; : :...................... }
755 ;; :.............................................
760 ;; +==========+.....................................
764 ;; ===+===+ +===+===... } element height } height
767 ;; : | +==========+.|................. }
768 ;; : | : : | : } font height }
769 ;; : +==============+...................................
771 ;; : : : :......................
772 ;; : : : } font height * 2 }
774 ;; : : } element width } width
775 ;; : :..................... }
776 ;; : } font height * 2 }
777 ;; :...............................................
782 ;; +===+...................................
783 ;; +==+ A +==+ } A height } }
784 ;; | +===+..|........ } entry }
785 ;; + + } font height } }
786 ;; / +===+...\....... } }
787 ;; ===+====+ B +====+=== } B height ..... } height
788 ;; : \ +===+.../....... }
789 ;; : + + : } font height }
790 ;; : | +===+..|........ }
791 ;; : +==+ C +==+ : } C height }
792 ;; : : +===+...................................
794 ;; : : : :......................
795 ;; : : : } font height * 2 }
797 ;; : : } max width } width
798 ;; : :................. }
799 ;; : } font height * 2 }
800 ;; :..........................................
803 ;; 1. An empty alternative has zero of height.
805 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
811 ;; +===========+...............................
812 ;; +=+ separator +=+ } separator height }
813 ;; / +===========+..\........ }
815 ;; | | } font height }
817 ;; \ +===========+../........ } height = entry
818 ;; +=+ element +=+ } element height }
819 ;; /: +===========+..\........ }
821 ;; + : : + } font height }
823 ;; ==+=======================+==.......................
825 ;; : : : :.......................
826 ;; : : : } font height * 2 }
828 ;; : : } max width } width
829 ;; : :......................... }
830 ;; : } font height * 2 }
831 ;; :...................................................
836 ;; +===========+......................................
837 ;; +=+ separator +=+ } separator height } }
838 ;; / +===========+..\...... } }
840 ;; | | } font height } } height
842 ;; \ +===========+../...... } }
843 ;; ===+=+ element +=+=== } element height .... }
844 ;; : : +===========+......................................
846 ;; : : : :........................
847 ;; : : : } font height * 2 }
849 ;; : : } max width } width
850 ;; : :....................... }
851 ;; : } font height * 2 }
852 ;; :..............................................
857 ;; XXXXXX:......................................
858 ;; XXXXXX: } production font height }
859 ;; XXXXXX:............ }
861 ;; +======+....... } height = entry
863 ;; ====+ +==== } element height }
865 ;; : +======+.................................
867 ;; : : : :......................
868 ;; : : : } font height * 2 }
870 ;; : : } element width } width
871 ;; : :.............. }
872 ;; : } font height * 2 }
873 ;; :.....................................
878 ;; +================+...................................
879 ;; | | } font height / 2 } entry }
880 ;; | +===+...|....... } }
881 ;; ====+ N * | X | +==== } X height ......... } height
882 ;; : | : : +===+...|...:... }
883 ;; : | : : : : | : } font height / 2 }
884 ;; : +================+...:...............................
886 ;; : : : : : : : :......................
887 ;; : : : : : : : } font height }
888 ;; : : : : : : :....... }
889 ;; : : : : : : } font height / 2 }
890 ;; : : : : : :........... }
891 ;; : : : : : } X width }
892 ;; : : : : :............... }
893 ;; : : : : } font height / 2 } width
894 ;; : : : :.................. }
895 ;; : : : } text width }
896 ;; : : :..................... }
897 ;; : : } font height / 2 }
898 ;; : :........................ }
900 ;; :...............................................
905 ;; +==================+...................................
906 ;; | | } font height / 2 } entry }
907 ;; | +===+ +===+...|....... } }
908 ;; ====+ | X | - | y | +==== } max height ....... } height
909 ;; : | +===+ +===+...|...:... }
910 ;; : | : : : : | : } font height / 2 }
911 ;; : +==================+...:...............................
913 ;; : : : : : : : :......................
914 ;; : : : : : : : } font height }
915 ;; : : : : : : :....... }
916 ;; : : : : : : } font height / 2 }
917 ;; : : : : : :........... }
918 ;; : : : : : } Y width }
919 ;; : : : : :............... }
920 ;; : : : : } font height } width
921 ;; : : : :................... }
923 ;; : : :....................... }
924 ;; : : } font height / 2 }
925 ;; : :.......................... }
927 ;; :.................................................
929 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
932 ;; Internal Structures
933 ;; -------------------
935 ;; ebnf2ps has two passes. The first pass does a lexical and syntatic analysis
936 ;; of current buffer and generates an intermediate representation. The second
937 ;; pass uses the intermediate representation to generate the PostScript
940 ;; The intermediate representation is a list of vectors, the vector element
941 ;; represents a syntatic chart element. Below is a vector representation for
942 ;; each syntatic chart element.
944 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
945 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
946 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
947 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
948 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
949 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
950 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
951 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
952 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
953 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
954 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
955 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
957 ;; The first vector position is a function symbol used to generate PostScript
959 ;; WIDTH-FUN is a function symbol called to adjust the element width.
960 ;; DIM-FUN is a function symbol called to set the element dimensions.
961 ;; ENTRY is the element entry point.
962 ;; HEIGHT and WIDTH are the element height and width, respectively.
963 ;; NAME is a string that it's the element name.
964 ;; DEFAULT is a boolean that indicates if it's a `default' element.
965 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
967 ;; LIST is a list of vector that represents the list part for alternatives and
969 ;; SEPARATOR is a vector that represents the sub-element used to separate the
971 ;; TIMES is a string representing the number of times that ELEMENT is repeated
972 ;; on a repeat construction.
973 ;; ACTION indicates some action that should be done before production is
974 ;; generated. The current actions are:
978 ;; form-feed current production starts on a new page.
980 ;; newline current production starts on next line, this is useful
981 ;; when `ebnf-horizontal-orientation' is non-nil.
983 ;; keep-line current production continues on the current line, this
984 ;; is useful when `ebnf-horizontal-orientation' is nil.
990 ;; . Handle situations when syntatic chart is out of paper.
991 ;; . Use other alphabet than ascii.
992 ;; . Optimizations...
998 ;; Thanks to all who emailed comments.
1001 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1008 (and (string< ps-print-version
"5.2.3")
1009 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1012 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1016 ;;; Interface to the command system
1018 (defgroup postscript nil
1024 (defgroup ebnf2ps nil
1025 "Translate an EBNF to a syntatic chart on PostScript"
1031 (defgroup ebnf-special nil
1032 "Special customization"
1038 (defgroup ebnf-except nil
1039 "Except customization"
1045 (defgroup ebnf-repeat nil
1046 "Repeat customization"
1052 (defgroup ebnf-terminal nil
1053 "Terminal customization"
1059 (defgroup ebnf-non-terminal nil
1060 "Non-Terminal customization"
1066 (defgroup ebnf-production nil
1067 "Production customization"
1073 (defgroup ebnf-shape nil
1074 "Shapes customization"
1080 (defgroup ebnf-displacement nil
1081 "Displacement customization"
1087 (defgroup ebnf-syntatic nil
1088 "Syntatic customization"
1094 (defgroup ebnf-optimization nil
1095 "Optimization customization"
1101 (defcustom ebnf-horizontal-orientation nil
1102 "*Non-nil means productions are drawn horizontally."
1104 :group
'ebnf-displacement
)
1107 (defcustom ebnf-horizontal-max-height nil
1108 "*Non-nil means to use maximum production height in horizontal orientation.
1110 It is only used when `ebnf-horizontal-orientation' is non-nil."
1112 :group
'ebnf-displacement
)
1115 (defcustom ebnf-production-horizontal-space
0.0 ; use ebnf2ps default value
1116 "*Specify horizontal space in points between productions.
1118 Value less or equal to zero forces ebnf2ps to set a proper default value."
1120 :group
'ebnf-displacement
)
1123 (defcustom ebnf-production-vertical-space
0.0 ; use ebnf2ps default value
1124 "*Specify vertical space in points between productions.
1126 Value less or equal to zero forces ebnf2ps to set a proper default value."
1128 :group
'ebnf-displacement
)
1131 (defcustom ebnf-justify-sequence
'center
1132 "*Specify justification of terms in a sequence inside alternatives.
1136 `left' left justification
1137 `right' right justification
1138 any other value centralize"
1139 :type
'(radio :tag
"Sequence Justification"
1140 (const left
) (const right
) (other :tag
"center" center
))
1141 :group
'ebnf-displacement
)
1144 (defcustom ebnf-special-font
'(7 Courier
"Black" "Gray95" bold italic
)
1145 "*Specify special font.
1147 See documentation for `ebnf-production-font'."
1148 :type
'(list :tag
"Special Font"
1149 (number :tag
"Font Size")
1150 (symbol :tag
"Font Name")
1151 (choice :tag
"Foreground Color"
1152 (string :tag
"Name")
1153 (other :tag
"Default" nil
))
1154 (choice :tag
"Background Color"
1155 (string :tag
"Name")
1156 (other :tag
"Default" nil
))
1157 (repeat :tag
"Font Attributes" :inline t
1158 (choice (const bold
) (const italic
)
1159 (const underline
) (const strikeout
)
1160 (const overline
) (const shadow
)
1161 (const box
) (const outline
))))
1162 :group
'ebnf-special
)
1165 (defcustom ebnf-special-shape
'bevel
1166 "*Specify special box shape.
1168 See documentation for `ebnf-non-terminal-shape'."
1169 :type
'(radio :tag
"Special Shape"
1170 (const miter
) (const round
) (const bevel
))
1171 :group
'ebnf-special
)
1174 (defcustom ebnf-special-shadow nil
1175 "*Non-nil means special box will have a shadow."
1177 :group
'ebnf-special
)
1180 (defcustom ebnf-special-border-width
0.5
1181 "*Specify border width for special box."
1183 :group
'ebnf-special
)
1186 (defcustom ebnf-special-border-color
"Black"
1187 "*Specify border color for special box."
1189 :group
'ebnf-special
)
1192 (defcustom ebnf-except-font
'(7 Courier
"Black" "Gray90" bold italic
)
1193 "*Specify except font.
1195 See documentation for `ebnf-production-font'."
1196 :type
'(list :tag
"Except Font"
1197 (number :tag
"Font Size")
1198 (symbol :tag
"Font Name")
1199 (choice :tag
"Foreground Color"
1200 (string :tag
"Name")
1201 (other :tag
"Default" nil
))
1202 (choice :tag
"Background Color"
1203 (string :tag
"Name")
1204 (other :tag
"Default" nil
))
1205 (repeat :tag
"Font Attributes" :inline t
1206 (choice (const bold
) (const italic
)
1207 (const underline
) (const strikeout
)
1208 (const overline
) (const shadow
)
1209 (const box
) (const outline
))))
1210 :group
'ebnf-except
)
1213 (defcustom ebnf-except-shape
'bevel
1214 "*Specify except box shape.
1216 See documentation for `ebnf-non-terminal-shape'."
1217 :type
'(radio :tag
"Except Shape"
1218 (const miter
) (const round
) (const bevel
))
1219 :group
'ebnf-except
)
1222 (defcustom ebnf-except-shadow nil
1223 "*Non-nil means except box will have a shadow."
1225 :group
'ebnf-except
)
1228 (defcustom ebnf-except-border-width
0.25
1229 "*Specify border width for except box."
1231 :group
'ebnf-except
)
1234 (defcustom ebnf-except-border-color
"Black"
1235 "*Specify border color for except box."
1237 :group
'ebnf-except
)
1240 (defcustom ebnf-repeat-font
'(7 Courier
"Black" "Gray85" bold italic
)
1241 "*Specify repeat font.
1243 See documentation for `ebnf-production-font'."
1244 :type
'(list :tag
"Repeat Font"
1245 (number :tag
"Font Size")
1246 (symbol :tag
"Font Name")
1247 (choice :tag
"Foreground Color"
1248 (string :tag
"Name")
1249 (other :tag
"Default" nil
))
1250 (choice :tag
"Background Color"
1251 (string :tag
"Name")
1252 (other :tag
"Default" nil
))
1253 (repeat :tag
"Font Attributes" :inline t
1254 (choice (const bold
) (const italic
)
1255 (const underline
) (const strikeout
)
1256 (const overline
) (const shadow
)
1257 (const box
) (const outline
))))
1258 :group
'ebnf-repeat
)
1261 (defcustom ebnf-repeat-shape
'bevel
1262 "*Specify repeat box shape.
1264 See documentation for `ebnf-non-terminal-shape'."
1265 :type
'(radio :tag
"Repeat Shape"
1266 (const miter
) (const round
) (const bevel
))
1267 :group
'ebnf-repeat
)
1270 (defcustom ebnf-repeat-shadow nil
1271 "*Non-nil means repeat box will have a shadow."
1273 :group
'ebnf-repeat
)
1276 (defcustom ebnf-repeat-border-width
0.0
1277 "*Specify border width for repeat box."
1279 :group
'ebnf-repeat
)
1282 (defcustom ebnf-repeat-border-color
"Black"
1283 "*Specify border color for repeat box."
1285 :group
'ebnf-repeat
)
1288 (defcustom ebnf-terminal-font
'(7 Courier
"Black" "White")
1289 "*Specify terminal font.
1291 See documentation for `ebnf-production-font'."
1292 :type
'(list :tag
"Terminal Font"
1293 (number :tag
"Font Size")
1294 (symbol :tag
"Font Name")
1295 (choice :tag
"Foreground Color"
1296 (string :tag
"Name")
1297 (other :tag
"Default" nil
))
1298 (choice :tag
"Background Color"
1299 (string :tag
"Name")
1300 (other :tag
"Default" nil
))
1301 (repeat :tag
"Font Attributes" :inline t
1302 (choice (const bold
) (const italic
)
1303 (const underline
) (const strikeout
)
1304 (const overline
) (const shadow
)
1305 (const box
) (const outline
))))
1306 :group
'ebnf-terminal
)
1309 (defcustom ebnf-terminal-shape
'miter
1310 "*Specify terminal box shape.
1312 See documentation for `ebnf-non-terminal-shape'."
1313 :type
'(radio :tag
"Terminal Shape"
1314 (const miter
) (const round
) (const bevel
))
1315 :group
'ebnf-terminal
)
1318 (defcustom ebnf-terminal-shadow nil
1319 "*Non-nil means terminal box will have a shadow."
1321 :group
'ebnf-terminal
)
1324 (defcustom ebnf-terminal-border-width
1.0
1325 "*Specify border width for terminal box."
1327 :group
'ebnf-terminal
)
1330 (defcustom ebnf-terminal-border-color
"Black"
1331 "*Specify border color for terminal box."
1333 :group
'ebnf-terminal
)
1336 (defcustom ebnf-sort-production nil
1337 "*Specify how productions are sorted.
1341 nil don't sort productions.
1342 `ascending' ascending sort.
1343 any other value descending sort."
1344 :type
'(radio :tag
"Production Sort"
1345 (const :tag
"Ascending" ascending
)
1346 (const :tag
"Descending" descending
)
1347 (other :tag
"No Sort" nil
))
1348 :group
'ebnf-production
)
1351 (defcustom ebnf-production-font
'(10 Helvetica
"Black" "White" bold
)
1352 "*Specify production header font.
1354 It is a list with the following form:
1356 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1359 SIZE is the font size.
1360 NAME is the font name symbol.
1361 ATTRIBUTE is one of the following symbols:
1362 bold - use bold font.
1363 italic - use italic font.
1364 underline - put a line under text.
1365 strikeout - like underline, but the line is in middle of text.
1366 overline - like underline, but the line is over the text.
1367 shadow - text will have a shadow.
1368 box - text will be surrounded by a box.
1369 outline - print characters as hollow outlines.
1370 FOREGROUND is a foreground string color name; if it's nil, the default color is
1372 BACKGROUND is a background string color name; if it's nil, the default color is
1375 See `ps-font-info-database' for valid font name."
1376 :type
'(list :tag
"Production Font"
1377 (number :tag
"Font Size")
1378 (symbol :tag
"Font Name")
1379 (choice :tag
"Foreground Color"
1380 (string :tag
"Name")
1381 (other :tag
"Default" nil
))
1382 (choice :tag
"Background Color"
1383 (string :tag
"Name")
1384 (other :tag
"Default" nil
))
1385 (repeat :tag
"Font Attributes" :inline t
1386 (choice (const bold
) (const italic
)
1387 (const underline
) (const strikeout
)
1388 (const overline
) (const shadow
)
1389 (const box
) (const outline
))))
1390 :group
'ebnf-production
)
1393 (defcustom ebnf-non-terminal-font
'(7 Helvetica
"Black" "White")
1394 "*Specify non-terminal font.
1396 See documentation for `ebnf-production-font'."
1397 :type
'(list :tag
"Non-Terminal Font"
1398 (number :tag
"Font Size")
1399 (symbol :tag
"Font Name")
1400 (choice :tag
"Foreground Color"
1401 (string :tag
"Name")
1402 (other :tag
"Default" nil
))
1403 (choice :tag
"Background Color"
1404 (string :tag
"Name")
1405 (other :tag
"Default" nil
))
1406 (repeat :tag
"Font Attributes" :inline t
1407 (choice (const bold
) (const italic
)
1408 (const underline
) (const strikeout
)
1409 (const overline
) (const shadow
)
1410 (const box
) (const outline
))))
1411 :group
'ebnf-non-terminal
)
1414 (defcustom ebnf-non-terminal-shape
'round
1415 "*Specify non-terminal box shape.
1431 Any other value is treated as `miter'."
1432 :type
'(radio :tag
"Non-Terminal Shape"
1433 (const miter
) (const round
) (const bevel
))
1434 :group
'ebnf-non-terminal
)
1437 (defcustom ebnf-non-terminal-shadow nil
1438 "*Non-nil means non-terminal box will have a shadow."
1440 :group
'ebnf-non-terminal
)
1443 (defcustom ebnf-non-terminal-border-width
1.0
1444 "*Specify border width for non-terminal box."
1446 :group
'ebnf-non-terminal
)
1449 (defcustom ebnf-non-terminal-border-color
"Black"
1450 "*Specify border color for non-terminal box."
1452 :group
'ebnf-non-terminal
)
1455 (defcustom ebnf-arrow-shape
'hollow
1456 "*Specify the arrow shape.
1462 `semi-up' * `transparent' *
1470 `semi-down' =====* `hollow' *
1486 `user' See also documentation for variable `ebnf-user-arrow'.
1488 Any other value is treated as `none'."
1489 :type
'(radio :tag
"Arrow Shape"
1490 (const none
) (const semi-up
)
1491 (const semi-down
) (const simple
)
1492 (const transparent
) (const hollow
)
1493 (const full
) (const user
))
1497 (defcustom ebnf-chart-shape
'round
1498 "*Specify chart flow shape.
1500 See documentation for `ebnf-non-terminal-shape'."
1501 :type
'(radio :tag
"Chart Flow Shape"
1502 (const miter
) (const round
) (const bevel
))
1506 (defcustom ebnf-user-arrow nil
1507 "*Specify a sexp for user arrow shape (a PostScript code).
1509 When evaluated, the sexp should return nil or a string containing PostScript
1510 code. PostScript code should draw a right arrow.
1512 The anatomy of a right arrow is:
1514 ...... Initial position
1516 : *.................
1520 ======+======*... } hT2
1524 : *.................
1530 :.......................
1532 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1533 be used to generate your own arrow. As these variables are used along
1534 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1535 values, if you need to modify them.
1537 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1539 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1541 :type
'(sexp :tag
"User Arrow Shape")
1545 (defcustom ebnf-syntax
'ebnf
1546 "*Specify syntax to be recognized.
1550 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1552 The following variables *ONLY* have effect with this
1554 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1555 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1557 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1558 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1559 (\"International Standard of the ISO EBNF Notation\").
1560 The following variables *ONLY* have effect with this
1562 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1564 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1565 The following variable *ONLY* has effect with this
1567 `ebnf-yac-ignore-error-recovery'.
1569 Any other value is treated as `ebnf'."
1570 :type
'(radio :tag
"Syntax"
1571 (const ebnf
) (const iso-ebnf
) (const yacc
))
1572 :group
'ebnf-syntatic
)
1575 (defcustom ebnf-lex-comment-char ?\
;
1576 "*Specify the line comment character.
1578 It's used only when `ebnf-syntax' is `ebnf'."
1580 :group
'ebnf-syntatic
)
1583 (defcustom ebnf-lex-eop-char ?.
1584 "*Specify the end of production character.
1586 It's used only when `ebnf-syntax' is `ebnf'."
1588 :group
'ebnf-syntatic
)
1591 (defcustom ebnf-terminal-regexp nil
1592 "*Specify how it's a terminal name.
1594 If it's nil, the terminal name must be enclosed by `\"'.
1595 If it's a string, it should be a regexp that it'll be used to determine a
1596 terminal name; terminal name may also be enclosed by `\"'.
1598 It's used only when `ebnf-syntax' is `ebnf'."
1599 :type
'(radio :tag
"Terminal Name"
1601 :group
'ebnf-syntatic
)
1604 (defcustom ebnf-case-fold-search nil
1605 "*Non-nil means ignore case on matching.
1607 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1610 :group
'ebnf-syntatic
)
1613 (defcustom ebnf-iso-alternative-p nil
1614 "*Non-nil means use alternative ISO EBNF.
1616 It's only used when `ebnf-syntax' is `iso-ebnf'.
1618 This variable affects the following symbol set:
1620 STANDARD ALTERNATIVE
1628 :group
'ebnf-syntatic
)
1631 (defcustom ebnf-iso-normalize-p nil
1632 "*Non-nil means normalize ISO EBNF syntax names.
1634 Normalize a name means that several contiguous spaces inside name become a
1635 single space, so \"A B C\" is normalized to \"A B C\".
1637 It's only used when `ebnf-syntax' is `iso-ebnf'."
1639 :group
'ebnf-syntatic
)
1642 (defcustom ebnf-eps-prefix
"ebnf--"
1643 "*Specify EPS prefix file name.
1645 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1650 (defcustom ebnf-entry-percentage
0.5 ; middle
1651 "*Specify entry height on alternatives.
1653 It must be a float between 0.0 (top) and 1.0 (bottom)."
1658 (defcustom ebnf-default-width
0.6
1659 "*Specify additional border width over default terminal, non-terminal or
1665 ;; Printing color requires x-color-values.
1666 (defcustom ebnf-color-p
(or (fboundp 'x-color-values
) ; Emacs
1667 (fboundp 'color-instance-rgb-components
)) ; XEmacs
1668 "*Non-nil means use color."
1673 (defcustom ebnf-line-width
1.0
1674 "*Specify flow line width."
1679 (defcustom ebnf-line-color
"Black"
1680 "*Specify flow line color."
1685 (defcustom ebnf-debug-ps nil
1686 "*Non-nil means to generate PostScript debug procedures.
1688 It is intended to help PostScript programmers in debugging."
1693 (defcustom ebnf-use-float-format t
1694 "*Non-nil means use `%f' float format.
1696 The advantage of using float format is that ebnf2ps generates a little short
1699 If it occurs the error message:
1701 Invalid format operation %f
1703 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1708 (defcustom ebnf-yac-ignore-error-recovery nil
1709 "*Non-nil means ignore error recovery.
1711 It's only used when `ebnf-syntax' is `yacc'."
1713 :group
'ebnf-syntatic
)
1716 (defcustom ebnf-ignore-empty-rule nil
1717 "*Non-nil means ignore empty rules.
1719 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1720 middle action rule."
1722 :group
'ebnf-optimization
)
1725 (defcustom ebnf-optimize nil
1726 "*Non-nil means optimize syntatic chart of rules.
1728 The following optimizations are done:
1731 1. A = B | A C. ==> A = B {C}*.
1732 2. A = B | A B. ==> A = {B}+.
1733 3. A = | A B. ==> A = {B}*.
1734 4. A = B | A C B. ==> A = {B || C}+.
1735 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
1738 6. A = B | . ==> A = [B].
1739 7. A = | B . ==> A = [B].
1742 8. A = B C | B D. ==> A = B (C | D).
1743 9. A = C B | D B. ==> A = (C | D) B.
1744 10. A = B C E | B D E. ==> A = B (C | D) E.
1746 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
1748 :group
'ebnf-optimization
)
1751 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1756 (defun ebnf-customize ()
1757 "Customization for ebnf group."
1759 (customize-group 'ebnf2ps
))
1762 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1767 (defun ebnf-print-buffer (&optional filename
)
1768 "Generate and print a PostScript syntatic chart image of the buffer.
1770 When called with a numeric prefix argument (C-u), prompts the user for
1771 the name of a file to save the PostScript image in, instead of sending
1774 More specifically, the FILENAME argument is treated as follows: if it
1775 is nil, send the image to the printer. If FILENAME is a string, save
1776 the PostScript image in a file with that name. If FILENAME is a
1777 number, prompt the user for the name of the file to save in."
1778 (interactive (list (ps-print-preprint current-prefix-arg
)))
1779 (ebnf-print-region (point-min) (point-max) filename
))
1783 (defun ebnf-print-region (from to
&optional filename
)
1784 "Generate and print a PostScript syntatic chart image of the region.
1785 Like `ebnf-print-buffer', but prints just the current region."
1786 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
1787 (run-hooks 'ebnf-hook
)
1788 (or (ebnf-spool-region from to
)
1789 (ps-do-despool filename
)))
1793 (defun ebnf-spool-buffer ()
1794 "Generate and spool a PostScript syntatic chart image of the buffer.
1795 Like `ebnf-print-buffer' except that the PostScript image is saved in a
1796 local buffer to be sent to the printer later.
1798 Use the command `ebnf-despool' to send the spooled images to the printer."
1800 (ebnf-spool-region (point-min) (point-max)))
1804 (defun ebnf-spool-region (from to
)
1805 "Generate a PostScript syntatic chart image of the region and spool locally.
1806 Like `ebnf-spool-buffer', but spools just the current region.
1808 Use the command `ebnf-despool' to send the spooled images to the printer."
1810 (ebnf-generate-region from to
'ebnf-generate
))
1814 (defun ebnf-eps-buffer ()
1815 "Generate a PostScript syntatic chart image of the buffer in a EPS file.
1817 Indeed, for each production is generated a EPS file.
1818 The EPS file name has the following form:
1820 <PREFIX><PRODUCTION>.eps
1822 <PREFIX> is given by variable `ebnf-eps-prefix'.
1823 The default value is \"ebnf--\".
1825 <PRODUCTION> is the production name.
1826 The production name is mapped to form a valid file name.
1827 For example, the production name \"A/B + C\" is mapped to
1828 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
1830 WARNING: It's *NOT* asked any confirmation to override an existing file."
1832 (ebnf-eps-region (point-min) (point-max)))
1836 (defun ebnf-eps-region (from to
)
1837 "Generate a PostScript syntatic chart image of the region in a EPS file.
1839 Indeed, for each production is generated a EPS file.
1840 The EPS file name has the following form:
1842 <PREFIX><PRODUCTION>.eps
1844 <PREFIX> is given by variable `ebnf-eps-prefix'.
1845 The default value is \"ebnf--\".
1847 <PRODUCTION> is the production name.
1848 The production name is mapped to form a valid file name.
1849 For example, the production name \"A/B + C\" is mapped to
1850 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
1852 WARNING: It's *NOT* asked any confirmation to override an existing file."
1854 (let ((ebnf-eps-executing t
))
1855 (ebnf-generate-region from to
'ebnf-generate-eps
)))
1859 (defalias 'ebnf-despool
'ps-despool
)
1863 (defun ebnf-syntax-buffer ()
1864 "Does a syntatic analysis of the current buffer."
1866 (ebnf-syntax-region (point-min) (point-max)))
1870 (defun ebnf-syntax-region (from to
)
1871 "Does a syntatic analysis of a region."
1873 (ebnf-generate-region from to nil
))
1876 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1881 (defun ebnf-setup ()
1882 "Return the current ebnf2ps setup."
1885 ;;; ebnf2ps.el version %s
1887 \(setq ebnf-special-font %s
1888 ebnf-special-shape %s
1889 ebnf-special-shadow %S
1890 ebnf-special-border-width %S
1891 ebnf-special-border-color %S
1893 ebnf-except-shape %s
1894 ebnf-except-shadow %S
1895 ebnf-except-border-width %S
1896 ebnf-except-border-color %S
1898 ebnf-repeat-shape %s
1899 ebnf-repeat-shadow %S
1900 ebnf-repeat-border-width %S
1901 ebnf-repeat-border-color %S
1902 ebnf-terminal-regexp %S
1903 ebnf-case-fold-search %S
1904 ebnf-terminal-font %s
1905 ebnf-terminal-shape %s
1906 ebnf-terminal-shadow %S
1907 ebnf-terminal-border-width %S
1908 ebnf-terminal-border-color %S
1909 ebnf-non-terminal-font %s
1910 ebnf-non-terminal-shape %s
1911 ebnf-non-terminal-shadow %S
1912 ebnf-non-terminal-border-width %S
1913 ebnf-non-terminal-border-color %S
1914 ebnf-sort-production %s
1915 ebnf-production-font %s
1919 ebnf-horizontal-orientation %S
1920 ebnf-horizontal-max-height %S
1921 ebnf-production-horizontal-space %S
1922 ebnf-production-vertical-space %S
1923 ebnf-justify-sequence %s
1924 ebnf-lex-comment-char ?\\%03o
1925 ebnf-lex-eop-char ?\\%03o
1927 ebnf-iso-alternative-p %S
1928 ebnf-iso-normalize-p %S
1930 ebnf-entry-percentage %S
1935 ebnf-use-float-format %S
1936 ebnf-yac-ignore-error-recovery %S
1937 ebnf-ignore-empty-rule %S
1940 ;;; ebnf2ps.el - end of settings
1943 (ps-print-quote ebnf-special-font
)
1944 (ps-print-quote ebnf-special-shape
)
1946 ebnf-special-border-width
1947 ebnf-special-border-color
1948 (ps-print-quote ebnf-except-font
)
1949 (ps-print-quote ebnf-except-shape
)
1951 ebnf-except-border-width
1952 ebnf-except-border-color
1953 (ps-print-quote ebnf-repeat-font
)
1954 (ps-print-quote ebnf-repeat-shape
)
1956 ebnf-repeat-border-width
1957 ebnf-repeat-border-color
1958 ebnf-terminal-regexp
1959 ebnf-case-fold-search
1960 (ps-print-quote ebnf-terminal-font
)
1961 (ps-print-quote ebnf-terminal-shape
)
1962 ebnf-terminal-shadow
1963 ebnf-terminal-border-width
1964 ebnf-terminal-border-color
1965 (ps-print-quote ebnf-non-terminal-font
)
1966 (ps-print-quote ebnf-non-terminal-shape
)
1967 ebnf-non-terminal-shadow
1968 ebnf-non-terminal-border-width
1969 ebnf-non-terminal-border-color
1970 (ps-print-quote ebnf-sort-production
)
1971 (ps-print-quote ebnf-production-font
)
1972 (ps-print-quote ebnf-arrow-shape
)
1973 (ps-print-quote ebnf-chart-shape
)
1974 (ps-print-quote ebnf-user-arrow
)
1975 ebnf-horizontal-orientation
1976 ebnf-horizontal-max-height
1977 ebnf-production-horizontal-space
1978 ebnf-production-vertical-space
1979 (ps-print-quote ebnf-justify-sequence
)
1980 ebnf-lex-comment-char
1982 (ps-print-quote ebnf-syntax
)
1983 ebnf-iso-alternative-p
1984 ebnf-iso-normalize-p
1986 ebnf-entry-percentage
1991 ebnf-use-float-format
1992 ebnf-yac-ignore-error-recovery
1993 ebnf-ignore-empty-rule
1997 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2001 (defvar ebnf-stack-style nil
2002 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2006 (defvar ebnf-current-style
'default
2007 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2010 (defconst ebnf-style-custom-list
2014 ebnf-special-border-width
2015 ebnf-special-border-color
2019 ebnf-except-border-width
2020 ebnf-except-border-color
2024 ebnf-repeat-border-width
2025 ebnf-repeat-border-color
2026 ebnf-terminal-regexp
2027 ebnf-case-fold-search
2030 ebnf-terminal-shadow
2031 ebnf-terminal-border-width
2032 ebnf-terminal-border-color
2033 ebnf-non-terminal-font
2034 ebnf-non-terminal-shape
2035 ebnf-non-terminal-shadow
2036 ebnf-non-terminal-border-width
2037 ebnf-non-terminal-border-color
2038 ebnf-sort-production
2039 ebnf-production-font
2043 ebnf-horizontal-orientation
2044 ebnf-horizontal-max-height
2045 ebnf-production-horizontal-space
2046 ebnf-production-vertical-space
2047 ebnf-justify-sequence
2048 ebnf-lex-comment-char
2051 ebnf-iso-alternative-p
2052 ebnf-iso-normalize-p
2054 ebnf-entry-percentage
2059 ebnf-use-float-format
2060 ebnf-yac-ignore-error-recovery
2061 ebnf-ignore-empty-rule
2063 "List of valid symbol custom variable.")
2066 (defvar ebnf-style-database
2070 (ebnf-special-font .
'(7 Courier
"Black" "Gray95" bold italic
))
2071 (ebnf-special-shape .
'bevel
)
2072 (ebnf-special-shadow . nil
)
2073 (ebnf-special-border-width .
0.5)
2074 (ebnf-special-border-color .
"Black")
2075 (ebnf-except-font .
'(7 Courier
"Black" "Gray90" bold italic
))
2076 (ebnf-except-shape .
'bevel
)
2077 (ebnf-except-shadow . nil
)
2078 (ebnf-except-border-width .
0.25)
2079 (ebnf-except-border-color .
"Black")
2080 (ebnf-repeat-font .
'(7 Courier
"Black" "Gray85" bold italic
))
2081 (ebnf-repeat-shape .
'bevel
)
2082 (ebnf-repeat-shadow . nil
)
2083 (ebnf-repeat-border-width .
0.0)
2084 (ebnf-repeat-border-color .
"Black")
2085 (ebnf-terminal-regexp . nil
)
2086 (ebnf-case-fold-search . nil
)
2087 (ebnf-terminal-font .
'(7 Courier
"Black" "White"))
2088 (ebnf-terminal-shape .
'miter
)
2089 (ebnf-terminal-shadow . nil
)
2090 (ebnf-terminal-border-width .
1.0)
2091 (ebnf-terminal-border-color .
"Black")
2092 (ebnf-non-terminal-font .
'(7 Helvetica
"Black" "White"))
2093 (ebnf-non-terminal-shape .
'round
)
2094 (ebnf-non-terminal-shadow . nil
)
2095 (ebnf-non-terminal-border-width .
1.0)
2096 (ebnf-non-terminal-border-color .
"Black")
2097 (ebnf-sort-production . nil
)
2098 (ebnf-production-font .
'(10 Helvetica
"Black" "White" bold
))
2099 (ebnf-arrow-shape .
'hollow
)
2100 (ebnf-chart-shape .
'round
)
2101 (ebnf-user-arrow . nil
)
2102 (ebnf-horizontal-orientation . nil
)
2103 (ebnf-horizontal-max-height . nil
)
2104 (ebnf-production-horizontal-space .
0.0)
2105 (ebnf-production-vertical-space .
0.0)
2106 (ebnf-justify-sequence .
'center
)
2107 (ebnf-lex-comment-char . ?\
;)
2108 (ebnf-lex-eop-char . ?.
)
2109 (ebnf-syntax .
'ebnf
)
2110 (ebnf-iso-alternative-p . nil
)
2111 (ebnf-iso-normalize-p . nil
)
2112 (ebnf-eps-prefix .
"ebnf--")
2113 (ebnf-entry-percentage .
0.5)
2114 (ebnf-color-p .
(or (fboundp 'x-color-values
) ; Emacs
2115 (fboundp 'color-instance-rgb-components
))) ; XEmacs
2116 (ebnf-line-width .
1.0)
2117 (ebnf-line-color .
"Black")
2118 (ebnf-debug-ps . nil
)
2119 (ebnf-use-float-format . t
)
2120 (ebnf-yac-ignore-error-recovery . nil
)
2121 (ebnf-ignore-empty-rule . nil
)
2122 (ebnf-optimize . nil
))
2123 ;; Happy EBNF default
2126 (ebnf-justify-sequence .
'left
)
2127 (ebnf-lex-comment-char . ?\
#)
2128 (ebnf-lex-eop-char . ?\
;))
2132 (ebnf-syntax .
'iso-ebnf
))
2133 ;; Yacc/Bison default
2136 (ebnf-syntax .
'yacc
))
2140 Each element has the following form:
2142 (CUSTOM INHERITS (VAR . VALUE)...)
2144 CUSTOM is a symbol name style.
2145 INHERITS is a symbol name style from which the current style inherits the
2146 context. If INHERITS is nil, means that there is no inheritance.
2147 VAR is a valid ebnf2ps symbol custom variable. See `ebnf-style-custom-list'
2148 for valid symbol variable.
2149 VALUE is a sexp which it'll be evaluated to set the value to VAR. So, don't
2150 forget to quote symbols and constant lists. See `default' style for an
2153 Don't handle this variable directly. Use functions `ebnf-insert-style' and
2154 `ebnf-merge-style'.")
2157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2162 (defun ebnf-insert-style (name inherits
&rest values
)
2163 "Insert a new style NAME with inheritance INHERITS and values VALUES."
2165 (and (assoc name ebnf-style-database
)
2166 (error "Style name already exists: %s" name
))
2167 (or (assoc inherits ebnf-style-database
)
2168 (error "Style inheritance name does'nt exist: %s" inherits
))
2169 (setq ebnf-style-database
2170 (cons (cons name
(cons inherits
(ebnf-check-style-values values
)))
2171 ebnf-style-database
)))
2175 (defun ebnf-merge-style (name &rest values
)
2176 "Merge values of style NAME with style VALUES."
2178 (let ((style (or (assoc name ebnf-style-database
)
2179 (error "Style name does'nt exist: %s" name
)))
2180 (merge (ebnf-check-style-values values
))
2182 ;; modify value of existing variables
2183 (setq val
(nthcdr 2 style
))
2185 (setq check
(car merge
)
2187 elt
(assoc (car check
) val
))
2189 (setcdr elt
(cdr check
))
2190 (setq new
(cons check new
))))
2191 ;; insert new variables
2192 (nconc style
(nreverse new
))))
2196 (defun ebnf-apply-style (style)
2197 "Set STYLE to current style.
2199 It returns the old style symbol."
2203 (and (ebnf-apply-style1 style
)
2204 (setq ebnf-current-style style
))))
2208 (defun ebnf-reset-style (&optional style
)
2209 "Reset current style.
2211 It returns the old style symbol."
2213 (setq ebnf-stack-style nil
)
2214 (ebnf-apply-style (or style
'default
)))
2218 (defun ebnf-push-style (&optional style
)
2219 "Push the current style and set STYLE to current style.
2221 It returns the old style symbol."
2225 (setq ebnf-stack-style
(cons ebnf-current-style ebnf-stack-style
))
2227 (ebnf-apply-style style
))))
2231 (defun ebnf-pop-style ()
2232 "Pop a style and set it to current style.
2234 It returns the old style symbol."
2237 (ebnf-apply-style (car ebnf-stack-style
))
2238 (setq ebnf-stack-style
(cdr ebnf-stack-style
))))
2241 (defun ebnf-apply-style1 (style)
2242 (let ((value (cdr (assoc style ebnf-style-database
))))
2245 (and (car value
) (ebnf-apply-style1 (car value
)))
2246 (while (setq value
(cdr value
))
2247 (set (caar value
) (eval (cdar value
)))))))
2250 (defun ebnf-check-style-values (values)
2253 (and (memq (car values
) ebnf-style-custom-list
)
2254 (setq style
(cons (car values
) style
)))
2255 (setq values
(cdr values
)))
2259 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2260 ;; Internal variables
2263 (make-local-hook 'ebnf-hook
)
2264 (make-local-hook 'ebnf-production-hook
)
2265 (make-local-hook 'ebnf-page-hook
)
2268 (defvar ebnf-eps-buffer-name
" *EPS*")
2269 (defvar ebnf-parser-func nil
)
2270 (defvar ebnf-eps-executing nil
)
2271 (defvar ebnf-eps-upper-x
0.0)
2272 (make-variable-buffer-local 'ebnf-eps-upper-x
)
2273 (defvar ebnf-eps-upper-y
0.0)
2274 (make-variable-buffer-local 'ebnf-eps-upper-y
)
2275 (defvar ebnf-eps-prod-width
0.0)
2276 (make-variable-buffer-local 'ebnf-eps-prod-width
)
2277 (defvar ebnf-eps-max-height
0.0)
2278 (make-variable-buffer-local 'ebnf-eps-max-height
)
2279 (defvar ebnf-eps-max-width
0.0)
2280 (make-variable-buffer-local 'ebnf-eps-max-width
)
2283 (defvar ebnf-eps-context nil
2284 "List of EPS file name during parsing.
2286 See section \"Actions in Comments\" in ebnf2ps documentation.")
2289 (defvar ebnf-eps-production-list nil
2290 "Alist associating production name with EPS file name list.
2292 Each element has the following form:
2294 (PRODUCTION EPS-FILENAME...)
2296 PRODUCTION is the production name.
2297 EPS-FILENAME is the EPS file name.
2299 It's generated during parsing and used during EPS generation.
2301 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2305 (defconst ebnf-arrow-shape-alist
2314 "Alist associating values for `ebnf-arrow-shape'.
2316 See documentation for `ebnf-arrow-shape'.")
2319 (defconst ebnf-terminal-shape-alist
2323 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2325 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2326 `ebnf-chart-shape'.")
2329 (defvar ebnf-limit nil
)
2330 (defvar ebnf-action nil
)
2331 (defvar ebnf-action-list nil
)
2334 (defvar ebnf-default-p nil
)
2337 (defvar ebnf-font-height-P
0)
2338 (defvar ebnf-font-height-T
0)
2339 (defvar ebnf-font-height-NT
0)
2340 (defvar ebnf-font-height-S
0)
2341 (defvar ebnf-font-height-E
0)
2342 (defvar ebnf-font-height-R
0)
2343 (defvar ebnf-font-width-P
0)
2344 (defvar ebnf-font-width-T
0)
2345 (defvar ebnf-font-width-NT
0)
2346 (defvar ebnf-font-width-S
0)
2347 (defvar ebnf-font-width-E
0)
2348 (defvar ebnf-font-width-R
0)
2349 (defvar ebnf-space-T
0)
2350 (defvar ebnf-space-NT
0)
2351 (defvar ebnf-space-S
0)
2352 (defvar ebnf-space-E
0)
2353 (defvar ebnf-space-R
0)
2356 (defvar ebnf-basic-width
0)
2357 (defvar ebnf-basic-height
0)
2358 (defvar ebnf-vertical-space
0)
2359 (defvar ebnf-horizontal-space
0)
2362 (defvar ebnf-settings nil
)
2363 (defvar ebnf-fonts-required nil
)
2366 (defconst ebnf-debug
2368 % === begin EBNF procedures to help debugging
2370 % Mark visually current point: string debug
2374 gsave -s- show grestore
2386 % Show number value: number string debug-number
2389 20 0 rmoveto show ([) show 60 string cvs show (]) show
2393 % === end EBNF procedures to help debugging
2396 "This is intended to help debugging PostScript programming.")
2399 (defconst ebnf-prologue
2401 % === begin EBNF engine
2403 % --- Basic Definitions
2406 /SpaceS FontHeight 0.5 mul def
2407 /HeightS FontHeight FontHeight add def
2410 /SpaceE FontHeight 0.5 mul def
2411 /HeightE FontHeight FontHeight add def
2414 /SpaceR FontHeight 0.5 mul def
2415 /HeightR FontHeight FontHeight add def
2418 /SpaceT FontHeight 0.5 mul def
2419 /HeightT FontHeight FontHeight add def
2422 /SpaceNT FontHeight 0.5 mul def
2423 /HeightNT FontHeight FontHeight add def
2425 /T HeightT HeightNT add 0.5 mul def
2428 /hT4 hT 0.25 mul def
2430 /Er 0.1 def % Error factor
2433 /c{currentpoint}bind def
2434 /xyi{/xi c /yi exch def def}bind def
2435 /xyo{/xo c /yo exch def def}bind def
2436 /xyp{/xp c /yp exch def def}bind def
2437 /xyt{/xt c /yt exch def def}bind def
2439 % vertical movement: x y height vm
2440 /vm{add moveto}bind def
2442 % horizontal movement: x y width hm
2443 /hm{3 -1 roll exch add exch moveto}bind def
2445 % set color: [R G B] SetRGB
2446 /SetRGB{aload pop setrgbcolor}bind def
2448 % filling gray area: gray-scale FillGray
2449 /FillGray{gsave setgray fill grestore}bind def
2451 % filling color area: [R G B] FillRGB
2452 /FillRGB{gsave SetRGB fill grestore}bind def
2454 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2455 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2456 /Gstroke{gsave Stroke grestore}bind def
2458 % Empty Line: width EL
2459 /EL{0 rlineto Gstroke}bind def
2463 /Down{hT2 neg hT4 neg rlineto}bind def
2466 {hT2 neg hT4 rmoveto
2471 /ArrowPath{c newpath moveto Arrow closepath}bind def
2479 {hT2 neg hT4 rlineto} % 1 - semi-up
2480 {Down} % 2 - semi-down
2481 {Arrow} % 3 - simple
2482 {Gstroke ArrowPath} % 4 - transparent
2483 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2484 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2485 {Gstroke gsave UserArrow grestore} % 7 - user
2491 RA-vector ArrowShape get exec
2496 % rotation DrawArrow
2511 /LA{180 DrawArrow}def
2518 /UA{90 DrawArrow}def
2525 /DA{270 DrawArrow}def
2529 %>corner Right Descendent: height arrow corner_RD
2531 % / height > 0 | 0 - none
2533 % * ---------- | 2 - left
2552 h 0 gt{DA}{UA}ifelse
2557 [{cRD0-vector arrow get exec} % 0 - miter
2558 {0 0 0 h hT h rcurveto} % 1 - rounded
2559 {hT h rlineto} % 2 - bevel
2563 {/arrow exch def /h exch def
2564 cRD-vector ChartShape get exec
2568 %>corner Right Ascendent: height arrow corner_RA
2570 % | height > 0 | 0 - none
2572 % *- ---------- | 2 - left
2590 h 0 gt{DA}{UA}ifelse
2596 [{cRA0-vector arrow get exec} % 0 - miter
2597 {0 0 hT 0 hT h rcurveto} % 1 - rounded
2598 {hT h rlineto} % 2 - bevel
2602 {/arrow exch def /h exch def
2603 cRA-vector ChartShape get exec
2607 %>corner Left Descendent: height arrow corner_LD
2609 % \\ height > 0 | 0 - none
2611 % * ---------- | 2 - left
2620 {hT neg h rmoveto xyi
2628 {hT neg h rmoveto xyi
2630 h 0 gt{DA}{UA}ifelse
2635 [{cLD0-vector arrow get exec} % 0 - miter
2636 {0 0 0 h hT neg h rcurveto} % 1 - rounded
2637 {hT neg h rlineto} % 2 - bevel
2641 {/arrow exch def /h exch def
2642 cLD-vector ChartShape get exec
2646 %>corner Left Ascendent: height arrow corner_LA
2648 % | height > 0 | 0 - none
2650 % -* ---------- | 2 - left
2659 {hT neg h rmoveto xyi
2667 {hT neg h rmoveto xyi
2668 h 0 gt{DA}{UA}ifelse
2674 [{cLA0-vector arrow get exec} % 0 - miter
2675 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
2676 {hT neg h rlineto} % 2 - bevel
2680 {/arrow exch def /h exch def
2681 cLA-vector ChartShape get exec
2687 % height prepare_height |- line_height corner_height corner_height
2691 {T add hT neg}ifelse
2695 %>Left Alternative: height LAlt
2722 %>Left Loop: height LLoop
2741 %>Right Alternative: height RAlt
2755 {T neg exch rlineto}
2768 %>Right Loop: height RLoop
2787 % --- Terminal, Non-terminal and Special Basics
2789 % string width prepare-width |- string
2792 dup stringwidth pop space add space add width exch sub 0.5 mul
2796 % string width begin-right
2806 {xo width add Er add yo moveto
2811 % string width begin-left
2820 {xo width add Er add yo moveto
2833 {/half YY yy sub 0.5 mul abs def
2834 xx half add YY moveto
2835 0 0 half neg 0 half neg half neg rcurveto
2836 0 0 0 half neg half half neg rcurveto
2837 XX xx sub abs half sub half sub 0 rlineto
2838 0 0 half 0 half half rcurveto
2839 0 0 0 half half neg half rcurveto}
2841 {/quarter YY yy sub 0.25 mul abs def
2842 xx quarter add YY moveto
2843 quarter neg quarter neg rlineto
2844 0 quarter quarter add neg rlineto
2845 quarter quarter neg rlineto
2846 XX xx sub abs quarter sub quarter sub 0 rlineto
2847 quarter quarter rlineto
2848 0 quarter quarter add rlineto
2849 quarter neg quarter rlineto}
2854 ShapePath-vector shape get exec
2860 Xshadow Xshadow add Xshadow add
2861 Yshadow Yshadow add Yshadow add translate
2875 % string SBound |- string
2877 {/xx c dup /yy exch def
2878 FontHeight add /YY exch def def
2879 dup stringwidth pop xx add /XX exch def
2881 {/yy yy YShadow add def
2882 /XX XX XShadow add def
2891 /XX XX space add space add def
2892 /YY YY space add def
2893 /yy yy space sub def
2894 shadow{doShapeShadow}if
2896 space Descent abs rmoveto
2903 % TeRminal: string TR
2905 {/Effect EffectT def
2907 /shapecolor BackgroundT def
2908 /borderwidth BorderWidthT def
2909 /bordercolor BorderColorT def
2910 /foreground ForegroundT def
2915 %>Right Terminal: string width RT |- x y
2926 %>Left Terminal: string width LT |- x y
2937 %>Right Terminal Default: string width RTD |- x y
2939 {/-save- BorderWidthT def
2940 /BorderWidthT BorderWidthT DefaultWidth add def
2942 /BorderWidthT -save- def
2945 %>Left Terminal Default: string width LTD |- x y
2947 {/-save- BorderWidthT def
2948 /BorderWidthT BorderWidthT DefaultWidth add def
2950 /BorderWidthT -save- def
2955 % Non-Terminal: string NT
2957 {/Effect EffectNT def
2959 /shapecolor BackgroundNT def
2960 /borderwidth BorderWidthNT def
2961 /bordercolor BorderColorNT def
2962 /foreground ForegroundNT def
2963 /shadow ShadowNT def
2967 %>Right Non-Terminal: string width RNT |- x y
2978 %>Left Non-Terminal: string width LNT |- x y
2989 %>Right Non-Terminal Default: string width RNTD |- x y
2991 {/-save- BorderWidthNT def
2992 /BorderWidthNT BorderWidthNT DefaultWidth add def
2994 /BorderWidthNT -save- def
2997 %>Left Non-Terminal Default: string width LNTD |- x y
2999 {/-save- BorderWidthNT def
3000 /BorderWidthNT BorderWidthNT DefaultWidth add def
3002 /BorderWidthNT -save- def
3007 % SPecial: string SP
3009 {/Effect EffectS def
3011 /shapecolor BackgroundS def
3012 /borderwidth BorderWidthS def
3013 /bordercolor BorderColorS def
3014 /foreground ForegroundS def
3019 %>Right SPecial: string width RSP |- x y
3030 %>Left SPecial: string width LSP |- x y
3041 %>Right SPecial Default: string width RSPD |- x y
3043 {/-save- BorderWidthS def
3044 /BorderWidthS BorderWidthS DefaultWidth add def
3046 /BorderWidthS -save- def
3049 %>Left SPecial Default: string width LSPD |- x y
3051 {/-save- BorderWidthS def
3052 /BorderWidthS BorderWidthS DefaultWidth add def
3054 /BorderWidthS -save- def
3057 % --- Repeat and Except basics
3060 {/w width rwidth sub 0.5 mul def
3065 /xx c entry add /YY exch def def
3066 /yy YY height sub def
3067 /XX xx rwidth add def
3068 shadow{doShapeShadow}if
3091 % entry height width rwidth begin-repeat
3101 /shapecolor BackgroundR def
3102 /borderwidth BorderWidthR def
3103 /bordercolor BorderColorR def
3104 /foreground ForegroundR def
3109 % string end-repeat |- x y
3112 space Descent rmoveto
3116 exch space add exch moveto
3120 %>Right RePeat: string entry height width rwidth RRP |- x y
3121 /RRP{begin-repeat right-direction end-repeat}def
3123 %>Left RePeat: string entry height width rwidth LRP |- x y
3124 /LRP{begin-repeat left-direction end-repeat}def
3128 % entry height width rwidth begin-except
3138 /shapecolor BackgroundE def
3139 /borderwidth BorderWidthE def
3140 /bordercolor BorderColorE def
3141 /foreground ForegroundE def
3146 % x-width end-except |- x y
3149 space space add add Descent rmoveto
3150 (-) foreground SetRGB S
3156 %>Right EXcept: x-width entry height width rwidth REX |- x y
3157 /REX{begin-except right-direction end-except}def
3159 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3160 /LEX{begin-except left-direction end-except}def
3164 %>Beginning Of Sequence: BOS |- x y
3165 /BOS{currentpoint}bind def
3167 %>End Of Sequence: x y x1 y1 EOS |- x y
3168 /EOS{pop pop}bind def
3172 %>Beginning Of Production: string width height BOP |- y x
3175 neg yp add /yw exch def
3176 xp add T sub /xw exch def
3178 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3188 %>End Of Production: y x delta EOP
3189 /EOPH{add exch moveto}bind def % horizontal
3190 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3192 % --- Empty Alternative
3194 %>Empty Alternative: width EA |- x y
3205 %>AlTernative: h1 h2 ... hn n width AT |- x y
3207 {xyo xo add /xw exch def
3219 %>OPtional: height width OP |- x y
3236 %>One or More: height width OM |- x y
3250 %>Zero or More: h2 h1 width ZM |- x y
3260 yo add xo T add exch moveto
3264 % === end EBNF engine
3267 "EBNF PostScript prologue")
3270 (defconst ebnf-eps-prologue
3272 /#ebnf2ps#dict 230 dict def
3275 % Initiliaze variables to avoid name-conflicting with document variables.
3276 % This is the case when using `bind' operator.
3277 /-fillp- 0 def /h 0 def
3278 /-ox- 0 def /half 0 def
3279 /-oy- 0 def /height 0 def
3280 /-save- 0 def /ow 0 def
3281 /Ascent 0 def /quarter 0 def
3282 /Descent 0 def /rXX 0 def
3283 /Effect 0 def /rYY 0 def
3284 /FontHeight 0 def /rwidth 0 def
3285 /LineThickness 0 def /rxx 0 def
3286 /OverlinePosition 0 def /ryy 0 def
3287 /SpaceBackground 0 def /shadow 0 def
3288 /StrikeoutPosition 0 def /shape 0 def
3289 /UnderlinePosition 0 def /shapecolor 0 def
3290 /XBox 0 def /space 0 def
3291 /XX 0 def /st 1 string def
3292 /Xshadow 0 def /w 0 def
3293 /YBox 0 def /width 0 def
3295 /Yshadow 0 def /xo 0 def
3296 /arrow 0 def /xp 0 def
3297 /bg false def /xt 0 def
3298 /bgcolor 0 def /xw 0 def
3299 /bordercolor 0 def /xx 0 def
3300 /borderwidth 0 def /yi 0 def
3302 /entry 0 def /yp 0 def
3303 /foreground 0 def /yt 0 def
3307 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3308 /ISOLatin1Encoding where
3310 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3311 % -- The first half is the same as the standard encoding,
3312 % -- except for minus instead of hyphen at code 055.
3314 StandardEncoding 0 45 getinterval aload pop
3316 StandardEncoding 46 82 getinterval aload pop
3317 %*** NOTE: the following are missing in the Adobe documentation,
3318 %*** but appear in the displayed table:
3319 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3321 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3322 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3323 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3324 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3326 /space /exclamdown /cent /sterling
3327 /currency /yen /brokenbar /section
3328 /dieresis /copyright /ordfeminine /guillemotleft
3329 /logicalnot /hyphen /registered /macron
3330 /degree /plusminus /twosuperior /threesuperior
3331 /acute /mu /paragraph /periodcentered
3332 /cedilla /onesuperior /ordmasculine /guillemotright
3333 /onequarter /onehalf /threequarters /questiondown
3335 /Agrave /Aacute /Acircumflex /Atilde
3336 /Adieresis /Aring /AE /Ccedilla
3337 /Egrave /Eacute /Ecircumflex /Edieresis
3338 /Igrave /Iacute /Icircumflex /Idieresis
3339 /Eth /Ntilde /Ograve /Oacute
3340 /Ocircumflex /Otilde /Odieresis /multiply
3341 /Oslash /Ugrave /Uacute /Ucircumflex
3342 /Udieresis /Yacute /Thorn /germandbls
3344 /agrave /aacute /acircumflex /atilde
3345 /adieresis /aring /ae /ccedilla
3346 /egrave /eacute /ecircumflex /edieresis
3347 /igrave /iacute /icircumflex /idieresis
3348 /eth /ntilde /ograve /oacute
3349 /ocircumflex /otilde /odieresis /divide
3350 /oslash /ugrave /uacute /ucircumflex
3351 /udieresis /yacute /thorn /ydieresis
3355 /reencodeFontISO %def
3357 length 12 add dict % Make a new font (a new dict the same size
3358 % as the old one) with room for our new symbols.
3360 begin % Make the new font the current dictionary.
3362 {def}{pop pop}ifelse
3363 }forall % Copy each of the symbols from the old dictionary
3364 % to the new one except for the font ID.
3366 currentdict /FontType get 0 ne
3367 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3368 % the ISOLatin1 encoding.
3370 % Use the font's bounding box to determine the ascent, descent,
3371 % and overall height; don't forget that these values have to be
3372 % transformed using the font's matrix.
3379 % | | | | Ascent (usually > 0)
3381 % (0 0) -> +--+----+-------->
3383 % | | v Descent (usually < 0)
3384 % (x1 y1) --> +----+ - -
3386 currentdict /FontType get 0 ne
3387 {/FontBBox load aload pop % -- x1 y1 x2 y2
3388 FontMatrix transform /Ascent exch def pop
3389 FontMatrix transform /Descent exch def pop}
3390 {/PrimaryFont FDepVector 0 get def
3391 PrimaryFont /FontBBox get aload pop
3392 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3393 PrimaryFont /FontMatrix get transform /Descent exch def pop
3396 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3398 % Define these in case they're not in the FontInfo
3399 % (also, here they're easier to get to).
3400 /UnderlinePosition Descent 0.70 mul def
3401 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3402 /StrikeoutPosition Ascent 0.30 mul def
3403 /LineThickness FontHeight 0.05 mul def
3404 /Xshadow FontHeight 0.08 mul def
3405 /Yshadow FontHeight -0.09 mul def
3406 /SpaceBackground Descent neg UnderlinePosition add def
3407 /XBox Descent neg def
3408 /YBox LineThickness 0.7 mul def
3410 currentdict % Leave the new font on the stack
3411 end % Stop using the font as the current dictionary
3412 definefont % Put the font into the font dictionary
3413 pop % Discard the returned font
3417 /DefFont{findfont exch scalefont reencodeFontISO}def
3422 dup /Ascent get /Ascent exch def
3423 dup /Descent get /Descent exch def
3424 dup /FontHeight get /FontHeight exch def
3425 dup /UnderlinePosition get /UnderlinePosition exch def
3426 dup /OverlinePosition get /OverlinePosition exch def
3427 dup /StrikeoutPosition get /StrikeoutPosition exch def
3428 dup /LineThickness get /LineThickness exch def
3429 dup /Xshadow get /Xshadow exch def
3430 dup /Yshadow get /Yshadow exch def
3431 dup /SpaceBackground get /SpaceBackground exch def
3432 dup /XBox get /XBox exch def
3433 dup /YBox get /YBox exch def
3446 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3448 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3461 % top of stack: fill-or-not
3463 {LineThickness setlinewidth stroke}
3468 % stack: string fill-or-not |- --
3471 /-ox- currentpoint /-oy- exch def def
3473 LineThickness setlinewidth
3475 st dup true charpath
3476 -fillp- {gsave FillBgColor grestore}if
3478 -oy- add /-oy- exch def
3479 -ox- add /-ox- exch def
3486 % stack: fill-or-not delta |- --
3489 xx XBox sub dd sub yy YBox sub dd sub
3490 XX XBox add dd add YY YBox add dd add
3494 % stack: string |- --
3497 Xshadow Yshadow rmoveto
3502 % stack: position |- --
3504 {currentpoint exch pop add dup
3510 LineThickness setlinewidth stroke
3514 % stack: string |- --
3515 % effect: 1 - underline 2 - strikeout 4 - overline
3516 % 8 - shadow 16 - box 32 - outline
3518 {/xx currentpoint dup Descent add /yy exch def
3519 Ascent add /YY exch def def
3520 dup stringwidth pop xx add /XX exch def
3522 {/yy yy Yshadow add def
3523 /XX XX Xshadow add def
3528 {SpaceBackground doBox}
3529 {xx yy XX YY doRect}
3532 Effect 16 and 0 ne{false 0 doBox}if % box
3533 Effect 8 and 0 ne{dup doShadow}if % shadow
3535 {true doOutline} % outline
3536 {show} % normal text
3538 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
3539 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
3540 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
3544 "EBNF EPS prologue")
3547 (defconst ebnf-eps-begin
3551 % x y #ebnf2ps#begin
3553 {#ebnf2ps#dict begin /#ebnf2ps#save save def
3554 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
3556 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
3563 (defconst ebnf-eps-end
3570 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3574 (defvar ebnf-format-float
"%1.3f")
3577 (defun ebnf-format-float (&rest floats
)
3580 (format ebnf-format-float float
))
3585 (defun ebnf-format-color (format-str color default
)
3586 (let* ((the-color (or color default
))
3587 (rgb (ps-color-scale the-color
)))
3590 (ebnf-format-float (nth 0 rgb
) (nth 1 rgb
) (nth 2 rgb
))
3595 (defvar ebnf-message-float
"%3.2f")
3598 (defsubst ebnf-message-float
(format-str value
)
3600 (format ebnf-message-float value
)))
3603 (defsubst ebnf-message-info
(messag)
3604 (message "%s...%3d%%"
3606 (round (/ (* (setq ebnf-nprod
(1+ ebnf-nprod
)) 100.0) ebnf-total
))))
3609 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3613 (defmacro ebnf-node-kind
(vec &optional value
)
3615 `(aset ,vec
0 ,value
)
3619 (defmacro ebnf-node-width-func
(node width
)
3620 `(funcall (aref ,node
1) ,node
,width
))
3623 (defmacro ebnf-node-dimension-func
(node &optional value
)
3625 `(aset ,node
2 ,value
)
3626 `(funcall (aref ,node
2) ,node
)))
3629 (defmacro ebnf-node-entry
(vec &optional value
)
3631 `(aset ,vec
3 ,value
)
3635 (defmacro ebnf-node-height
(vec &optional value
)
3637 `(aset ,vec
4 ,value
)
3641 (defmacro ebnf-node-width
(vec &optional value
)
3643 `(aset ,vec
5 ,value
)
3647 (defmacro ebnf-node-name
(vec)
3651 (defmacro ebnf-node-list
(vec &optional value
)
3653 `(aset ,vec
6 ,value
)
3657 (defmacro ebnf-node-default
(vec)
3661 (defmacro ebnf-node-production
(vec &optional value
)
3663 `(aset ,vec
7 ,value
)
3667 (defmacro ebnf-node-separator
(vec &optional value
)
3669 `(aset ,vec
7 ,value
)
3673 (defmacro ebnf-node-action
(vec &optional value
)
3675 `(aset ,vec
8 ,value
)
3679 (defmacro ebnf-node-generation
(node)
3680 `(funcall (ebnf-node-kind ,node
) ,node
))
3683 (defmacro ebnf-max-width
(prod)
3684 `(max (ebnf-node-width ,prod
)
3685 (+ (* (length (ebnf-node-name ,prod
))
3687 ebnf-production-horizontal-space
)))
3690 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3691 ;; PostScript generation
3694 (defun ebnf-generate-eps (ebnf-tree)
3695 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
3696 (ps-print-color-scale (if ps-color-p
3697 (float (car (ps-color-values "white")))
3699 (ebnf-total (length ebnf-tree
))
3701 (old-ps-output (symbol-function 'ps-output
))
3702 (old-ps-output-string (symbol-function 'ps-output-string
))
3703 (eps-buffer (get-buffer-create ebnf-eps-buffer-name
))
3704 ebnf-debug-ps error-msg horizontal
3705 prod prod-name prod-width prod-height prod-list file-list
)
3706 ;; redefines `ps-output' and `ps-output-string'
3707 (defalias 'ps-output
'ebnf-eps-output
)
3708 (defalias 'ps-output-string
'ps-output-string-prim
)
3709 ;; generate EPS file
3711 (condition-case data
3714 (setq prod
(car ebnf-tree
)
3715 prod-name
(ebnf-node-name prod
)
3716 prod-width
(ebnf-max-width prod
)
3717 prod-height
(ebnf-node-height prod
)
3718 horizontal
(memq (ebnf-node-action prod
)
3720 ;; generate production in EPS buffer
3722 (set-buffer eps-buffer
)
3723 (setq ebnf-eps-upper-x
0.0
3724 ebnf-eps-upper-y
0.0
3725 ebnf-eps-max-width prod-width
3726 ebnf-eps-max-height prod-height
)
3727 (ebnf-generate-production prod
))
3728 (if (setq prod-list
(cdr (assoc prod-name
3729 ebnf-eps-production-list
)))
3730 ;; insert EPS buffer in all buffer associated with production
3731 (ebnf-eps-production-list prod-list
'file-list horizontal
3732 prod-width prod-height eps-buffer
)
3733 ;; write EPS file for production
3734 (ebnf-eps-finish-and-write eps-buffer
3735 (ebnf-eps-filename prod-name
)))
3736 ;; prepare for next loop
3738 (set-buffer eps-buffer
)
3740 (setq ebnf-tree
(cdr ebnf-tree
)))
3741 ;; write and kill temporary buffers
3742 (ebnf-eps-write-kill-temp file-list t
)
3743 (setq file-list nil
))
3746 (setq error-msg
(error-message-string data
)))))
3747 ;; restore `ps-output' and `ps-output-string'
3748 (defalias 'ps-output old-ps-output
)
3749 (defalias 'ps-output-string old-ps-output-string
)
3750 ;; kill temporary buffers
3751 (kill-buffer eps-buffer
)
3752 (ebnf-eps-write-kill-temp file-list nil
)
3753 (and error-msg
(error error-msg
))
3757 ;; write and kill temporary buffers
3758 (defun ebnf-eps-write-kill-temp (file-list write-p
)
3760 (let ((buffer (get-buffer (concat " *" (car file-list
) "*"))))
3763 (ebnf-eps-finish-and-write buffer
(car file-list
)))
3764 (kill-buffer buffer
)))
3765 (setq file-list
(cdr file-list
))))
3768 ;; insert EPS buffer in all buffer associated with production
3769 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
3770 prod-width prod-height eps-buffer
)
3772 (add-to-list file-list-sym
(car prod-list
))
3774 (set-buffer (get-buffer-create (concat " *" (car prod-list
) "*")))
3775 (goto-char (point-max))
3778 ((zerop (buffer-size))
3779 (setq ebnf-eps-upper-x
0.0
3780 ebnf-eps-upper-y
0.0
3781 ebnf-eps-max-width prod-width
3782 ebnf-eps-max-height prod-height
))
3785 (ebnf-eop-horizontal ebnf-eps-prod-width
)
3786 (setq ebnf-eps-max-width
(+ ebnf-eps-max-width
3787 ebnf-production-horizontal-space
3789 ebnf-eps-max-height
(max ebnf-eps-max-height prod-height
)))
3792 (ebnf-eop-vertical ebnf-eps-max-height
)
3793 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
3794 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
3797 ebnf-production-vertical-space
3798 ebnf-eps-max-height
))
3799 ebnf-eps-max-width prod-width
3800 ebnf-eps-max-height prod-height
))
3802 (setq ebnf-eps-prod-width prod-width
)
3803 (insert-buffer eps-buffer
))
3804 (setq prod-list
(cdr prod-list
))))
3807 (defun ebnf-generate (ebnf-tree)
3808 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
3809 (ps-print-color-scale (if ps-color-p
3810 (float (car (ps-color-values "white")))
3812 ps-zebra-stripes ps-line-number ps-razzle-dazzle
3814 ps-print-begin-sheet-hook
3815 ps-print-begin-page-hook
3816 ps-print-begin-column-hook
)
3817 (ps-generate (current-buffer) (point-min) (point-max)
3818 'ebnf-generate-postscript
)))
3821 (defvar ebnf-tree nil
)
3822 (defvar ebnf-direction
"R")
3823 (defvar ebnf-total
0)
3824 (defvar ebnf-nprod
0)
3827 (defun ebnf-generate-postscript (from to
)
3829 (if ebnf-horizontal-max-height
3830 (ebnf-generate-with-max-height)
3831 (ebnf-generate-without-max-height))
3835 (defun ebnf-generate-with-max-height ()
3836 (let ((ebnf-total (length ebnf-tree
))
3838 next-line max-height prod the-width
)
3840 ;; find next line point
3841 (setq next-line ebnf-tree
3842 prod
(car ebnf-tree
)
3843 max-height
(ebnf-node-height prod
))
3844 (ebnf-begin-line prod
(ebnf-max-width prod
))
3845 (while (and (setq next-line
(cdr next-line
))
3846 (setq prod
(car next-line
))
3847 (memq (ebnf-node-action prod
) ebnf-action-list
)
3848 (setq the-width
(ebnf-max-width prod
))
3849 (<= the-width ps-width-remaining
))
3850 (setq max-height
(max max-height
(ebnf-node-height prod
))
3851 ps-width-remaining
(- ps-width-remaining
3853 ebnf-production-horizontal-space
))))
3854 ;; generate current line
3855 (ebnf-newline max-height
)
3856 (setq prod
(car ebnf-tree
))
3857 (ebnf-generate-production prod
)
3858 (while (not (eq (setq ebnf-tree
(cdr ebnf-tree
)) next-line
))
3859 (ebnf-eop-horizontal (ebnf-max-width prod
))
3860 (setq prod
(car ebnf-tree
))
3861 (ebnf-generate-production prod
))
3862 (ebnf-eop-vertical max-height
))))
3865 (defun ebnf-generate-without-max-height ()
3866 (let ((ebnf-total (length ebnf-tree
))
3868 max-height prod bef-width cur-width
)
3870 ;; generate current line
3871 (setq prod
(car ebnf-tree
)
3872 max-height
(ebnf-node-height prod
)
3873 bef-width
(ebnf-max-width prod
))
3874 (ebnf-begin-line prod bef-width
)
3875 (ebnf-generate-production prod
)
3876 (while (and (setq ebnf-tree
(cdr ebnf-tree
))
3877 (setq prod
(car ebnf-tree
))
3878 (memq (ebnf-node-action prod
) ebnf-action-list
)
3879 (setq cur-width
(ebnf-max-width prod
))
3880 (<= cur-width ps-width-remaining
)
3881 (<= (ebnf-node-height prod
) ps-height-remaining
))
3882 (ebnf-eop-horizontal bef-width
)
3883 (ebnf-generate-production prod
)
3884 (setq bef-width cur-width
3885 max-height
(max max-height
(ebnf-node-height prod
))
3886 ps-width-remaining
(- ps-width-remaining
3888 ebnf-production-horizontal-space
))))
3889 (ebnf-eop-vertical max-height
)
3890 ;; prepare next line
3891 (ebnf-newline max-height
))))
3894 (defun ebnf-begin-line (prod width
)
3895 (and (or (eq (ebnf-node-action prod
) 'form-feed
)
3896 (> (ebnf-node-height prod
) ps-height-remaining
))
3898 (setq ps-width-remaining
(- ps-width-remaining
3900 ebnf-production-horizontal-space
))))
3903 (defun ebnf-newline (height)
3904 (and (> height ps-height-remaining
)
3906 (setq ps-width-remaining ps-print-width
3907 ps-height-remaining
(- ps-height-remaining
3909 ebnf-production-vertical-space
))))
3912 ;; [production width-fun dim-fun entry height width name production action]
3913 (defun ebnf-generate-production (production)
3914 (ebnf-message-info "Generating")
3915 (run-hooks 'ebnf-production-hook
)
3916 (ps-output-string (ebnf-node-name production
))
3919 (ebnf-node-width production
)
3920 (+ ebnf-basic-height
3921 (ebnf-node-entry (ebnf-node-production production
))))
3923 (ebnf-node-generation (ebnf-node-production production
))
3924 (ps-output "EOS\n"))
3927 ;; [alternative width-fun dim-fun entry height width list]
3928 (defun ebnf-generate-alternative (alternative)
3929 (let ((alt (ebnf-node-list alternative
))
3930 (entry (ebnf-node-entry alternative
))
3932 alt-height alt-entry
)
3934 (ps-output (ebnf-format-float (- entry
(ebnf-node-entry (car alt
))))
3936 (setq entry
(- entry
(ebnf-node-height (car alt
)) ebnf-vertical-space
)
3939 (ps-output (format "%d " nlist
)
3940 (ebnf-format-float (ebnf-node-width alternative
))
3942 (setq alt
(ebnf-node-list alternative
))
3944 (ebnf-node-generation (car alt
))
3945 (setq alt-height
(- (ebnf-node-height (car alt
))
3946 (ebnf-node-entry (car alt
)))))
3947 (while (setq alt
(cdr alt
))
3948 (setq alt-entry
(ebnf-node-entry (car alt
)))
3949 (ebnf-vertical-movement
3950 (- (+ alt-height ebnf-vertical-space alt-entry
)))
3951 (ebnf-node-generation (car alt
))
3952 (setq alt-height
(- (ebnf-node-height (car alt
)) alt-entry
))))
3953 (ps-output "EOS\n"))
3956 ;; [sequence width-fun dim-fun entry height width list]
3957 (defun ebnf-generate-sequence (sequence)
3959 (let ((seq (ebnf-node-list sequence
))
3962 (ebnf-node-generation (car seq
))
3963 (setq seq-width
(ebnf-node-width (car seq
))))
3964 (while (setq seq
(cdr seq
))
3965 (ebnf-horizontal-movement seq-width
)
3966 (ebnf-node-generation (car seq
))
3967 (setq seq-width
(ebnf-node-width (car seq
)))))
3968 (ps-output "EOS\n"))
3971 ;; [terminal width-fun dim-fun entry height width name]
3972 (defun ebnf-generate-terminal (terminal)
3973 (ebnf-gen-terminal terminal
"T"))
3976 ;; [non-terminal width-fun dim-fun entry height width name]
3977 (defun ebnf-generate-non-terminal (non-terminal)
3978 (ebnf-gen-terminal non-terminal
"NT"))
3981 ;; [empty width-fun dim-fun entry height width]
3982 (defun ebnf-generate-empty (empty)
3983 (ebnf-empty-alternative (ebnf-node-width empty
)))
3986 ;; [optional width-fun dim-fun entry height width element]
3987 (defun ebnf-generate-optional (optional)
3988 (let ((the-optional (ebnf-node-list optional
)))
3989 (ps-output (ebnf-format-float
3990 (+ (- (ebnf-node-height the-optional
)
3991 (ebnf-node-entry optional
))
3992 ebnf-vertical-space
)
3993 (ebnf-node-width optional
))
3995 (ebnf-node-generation the-optional
)
3996 (ps-output "EOS\n")))
3999 ;; [one-or-more width-fun dim-fun entry height width element separator]
4000 (defun ebnf-generate-one-or-more (one-or-more)
4001 (let* ((width (ebnf-node-width one-or-more
))
4002 (sep (ebnf-node-separator one-or-more
))
4003 (entry (- (ebnf-node-entry one-or-more
)
4005 (ebnf-node-entry sep
)
4007 (ps-output (ebnf-format-float entry width
)
4009 (ebnf-node-generation (ebnf-node-list one-or-more
))
4010 (ebnf-vertical-movement entry
)
4012 (let ((ebnf-direction "L"))
4013 (ebnf-node-generation sep
))
4014 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4015 (ps-output "EOS\n"))
4018 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4019 (defun ebnf-generate-zero-or-more (zero-or-more)
4020 (let* ((width (ebnf-node-width zero-or-more
))
4021 (node-list (ebnf-node-list zero-or-more
))
4022 (list-entry (ebnf-node-entry node-list
))
4023 (node-sep (ebnf-node-separator zero-or-more
))
4024 (entry (+ list-entry
4027 (- (ebnf-node-height node-sep
)
4028 (ebnf-node-entry node-sep
))
4030 (ps-output (ebnf-format-float entry
4031 (+ (- (ebnf-node-height node-list
)
4033 ebnf-vertical-space
)
4036 (ebnf-node-generation (ebnf-node-list zero-or-more
))
4037 (ebnf-vertical-movement entry
)
4038 (if (ebnf-node-separator zero-or-more
)
4039 (let ((ebnf-direction "L"))
4040 (ebnf-node-generation (ebnf-node-separator zero-or-more
)))
4041 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4042 (ps-output "EOS\n"))
4045 ;; [special width-fun dim-fun entry height width name]
4046 (defun ebnf-generate-special (special)
4047 (ebnf-gen-terminal special
"SP"))
4050 ;; [repeat width-fun dim-fun entry height width times element]
4051 (defun ebnf-generate-repeat (repeat)
4052 (let ((times (ebnf-node-name repeat
))
4053 (element (ebnf-node-separator repeat
)))
4054 (ps-output-string times
)
4057 (ebnf-node-entry repeat
)
4058 (ebnf-node-height repeat
)
4059 (ebnf-node-width repeat
)
4061 (+ (ebnf-node-width element
)
4062 ebnf-space-R ebnf-space-R ebnf-space-R
4063 (* (length times
) ebnf-font-width-R
))
4065 " " ebnf-direction
"RP\n")
4067 (ebnf-node-generation element
)))
4068 (ps-output "EOS\n"))
4071 ;; [except width-fun dim-fun entry height width element element]
4072 (defun ebnf-generate-except (except)
4073 (let* ((element (ebnf-node-list except
))
4074 (exception (ebnf-node-separator except
))
4075 (width (ebnf-node-width element
)))
4076 (ps-output (ebnf-format-float
4078 (ebnf-node-entry except
)
4079 (ebnf-node-height except
)
4080 (ebnf-node-width except
)
4082 ebnf-space-E ebnf-space-E ebnf-space-E
4085 (+ (ebnf-node-width exception
) ebnf-space-E
)
4087 " " ebnf-direction
"EX\n")
4088 (ebnf-node-generation (ebnf-node-list except
))
4090 (ebnf-horizontal-movement (+ width ebnf-space-E
4091 ebnf-font-width-E ebnf-space-E
))
4092 (ebnf-node-generation exception
)))
4093 (ps-output "EOS\n"))
4096 (defun ebnf-gen-terminal (node code
)
4097 (ps-output-string (ebnf-node-name node
))
4098 (ps-output " " (ebnf-format-float (ebnf-node-width node
))
4099 " " ebnf-direction code
4100 (if (ebnf-node-default node
)
4105 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4106 ;; Internal functions
4109 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4110 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4111 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4112 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4113 (defun ebnf-range-regexp (prefix from to
)
4116 (setq str
(concat str
(char-to-string from
))
4118 (concat prefix str
)))
4121 (defvar ebnf-map-name
4122 (let ((map (make-vector 256 ?\_
)))
4123 (mapcar #'(lambda (char)
4124 (aset map char char
))
4125 (concat "#$%&+-.0123456789=?@~"
4126 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4127 "abcdefghijklmnopqrstuvwxyz"))
4131 (defun ebnf-eps-filename (str)
4132 (let* ((len (length str
))
4134 (new (make-string len ?\
)))
4136 (aset new stri
(aref ebnf-map-name
(aref str stri
)))
4137 (setq stri
(1+ stri
)))
4138 (concat ebnf-eps-prefix new
".eps")))
4141 (defun ebnf-eps-output (&rest args
)
4144 (setq args
(cdr args
))))
4147 (defun ebnf-generate-region (from to gen-func
)
4148 (run-hooks 'ebnf-hook
)
4149 (let ((ebnf-limit (max from to
))
4154 (condition-case data
4155 (let ((tree (ebnf-parse-and-sort (min from to
))))
4160 (ebnf-eliminate-empty-rules tree
))))))
4164 (setq the-point
(max (1- (point)) (point-min)))
4165 (message (error-message-string data
)))))))
4168 (goto-char the-point
))
4172 (message "EBNF syntatic analysis: NO ERRORS.")))))
4175 (defun ebnf-parse-and-sort (start)
4177 (let ((tree (funcall ebnf-parser-func start
)))
4178 (if ebnf-sort-production
4180 (message "Sorting...")
4182 (if (eq ebnf-sort-production
'ascending
)
4183 'ebnf-sorter-ascending
4184 'ebnf-sorter-descending
)))
4188 (defun ebnf-sorter-ascending (first second
)
4189 (string< (ebnf-node-name first
)
4190 (ebnf-node-name second
)))
4193 (defun ebnf-sorter-descending (first second
)
4194 (string< (ebnf-node-name second
)
4195 (ebnf-node-name first
)))
4198 (defun ebnf-empty-alternative (width)
4199 (ps-output (ebnf-format-float width
) " EA\n"))
4202 (defun ebnf-vertical-movement (height)
4203 (ps-output (ebnf-format-float height
) " vm\n"))
4206 (defun ebnf-horizontal-movement (width)
4207 (ps-output (ebnf-format-float width
) " hm\n"))
4210 (defun ebnf-entry (height)
4211 (* height ebnf-entry-percentage
))
4214 (defun ebnf-eop-vertical (height)
4215 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space
))
4219 (defun ebnf-eop-horizontal (width)
4220 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space
))
4224 (defun ebnf-new-page ()
4225 (when (< ps-height-remaining ps-print-height
)
4226 (run-hooks 'ebnf-page-hook
)
4231 (defsubst ebnf-font-size
(font) (nth 0 font
))
4232 (defsubst ebnf-font-name
(font) (nth 1 font
))
4233 (defsubst ebnf-font-foreground
(font) (nth 2 font
))
4234 (defsubst ebnf-font-background
(font) (nth 3 font
))
4235 (defsubst ebnf-font-list
(font) (nthcdr 4 font
))
4236 (defsubst ebnf-font-attributes
(font)
4237 (lsh (ps-extension-bit (cdr font
)) -
2))
4240 (defconst ebnf-font-name-select
4241 (vector 'normal
'bold
'italic
'bold-italic
))
4244 (defun ebnf-font-name-select (font)
4245 (let* ((font-list (ebnf-font-list font
))
4246 (font-index (+ (if (memq 'bold font-list
) 1 0)
4247 (if (memq 'italic font-list
) 2 0)))
4248 (name (ebnf-font-name font
))
4249 (database (cdr (assoc name ps-font-info-database
)))
4250 (info-list (or (cdr (assoc 'fonts database
))
4251 (error "Invalid font: %s" name
))))
4252 (or (cdr (assoc (aref ebnf-font-name-select font-index
)
4254 (error "Invalid attributes for font %s" name
))))
4257 (defun ebnf-font-select (font select
)
4258 (let* ((name (ebnf-font-name font
))
4259 (database (cdr (assoc name ps-font-info-database
)))
4260 (size (cdr (assoc 'size database
)))
4261 (base (cdr (assoc select database
))))
4263 (/ (* (ebnf-font-size font
) base
)
4265 (error "Invalid font: %s" name
))))
4268 (defsubst ebnf-font-width
(font)
4269 (ebnf-font-select font
'avg-char-width
))
4270 (defsubst ebnf-font-height
(font)
4271 (ebnf-font-select font
'line-height
))
4274 (defun ebnf-begin-job ()
4275 (ps-printing-region nil nil
)
4276 (if ebnf-use-float-format
4277 (setq ebnf-format-float
"%1.3f"
4278 ebnf-message-float
"%3.2f")
4279 (setq ebnf-format-float
"%s"
4280 ebnf-message-float
"%s"))
4281 (ebnf-otz-initialize)
4282 ;; to avoid compilation gripes when calling autoloaded functions
4283 (funcall (cond ((eq ebnf-syntax
'iso-ebnf
)
4284 (setq ebnf-parser-func
'ebnf-iso-parser
)
4285 'ebnf-iso-initialize
)
4286 ((eq ebnf-syntax
'yacc
)
4287 (setq ebnf-parser-func
'ebnf-yac-parser
)
4288 'ebnf-yac-initialize
)
4290 (setq ebnf-parser-func
'ebnf-bnf-parser
)
4291 'ebnf-bnf-initialize
)))
4292 (and ebnf-terminal-regexp
; ensures that it's a string or nil
4293 (not (stringp ebnf-terminal-regexp
))
4294 (setq ebnf-terminal-regexp nil
))
4295 (or (and ebnf-eps-prefix
; ensures that it's a string
4296 (stringp ebnf-eps-prefix
))
4297 (setq ebnf-eps-prefix
"ebnf--"))
4298 (setq ebnf-entry-percentage
; ensures value between 0.0 and 1.0
4299 (min (max ebnf-entry-percentage
0.0) 1.0)
4300 ebnf-action-list
(if ebnf-horizontal-orientation
4304 ebnf-fonts-required nil
4307 ebnf-eps-context nil
4308 ebnf-eps-production-list nil
4309 ebnf-eps-upper-x
0.0
4310 ebnf-eps-upper-y
0.0
4311 ebnf-font-height-P
(ebnf-font-height ebnf-production-font
)
4312 ebnf-font-height-T
(ebnf-font-height ebnf-terminal-font
)
4313 ebnf-font-height-NT
(ebnf-font-height ebnf-non-terminal-font
)
4314 ebnf-font-height-S
(ebnf-font-height ebnf-special-font
)
4315 ebnf-font-height-E
(ebnf-font-height ebnf-except-font
)
4316 ebnf-font-height-R
(ebnf-font-height ebnf-repeat-font
)
4317 ebnf-font-width-P
(ebnf-font-width ebnf-production-font
)
4318 ebnf-font-width-T
(ebnf-font-width ebnf-terminal-font
)
4319 ebnf-font-width-NT
(ebnf-font-width ebnf-non-terminal-font
)
4320 ebnf-font-width-S
(ebnf-font-width ebnf-special-font
)
4321 ebnf-font-width-E
(ebnf-font-width ebnf-except-font
)
4322 ebnf-font-width-R
(ebnf-font-width ebnf-repeat-font
)
4323 ebnf-space-T
(* ebnf-font-height-T
0.5)
4324 ebnf-space-NT
(* ebnf-font-height-NT
0.5)
4325 ebnf-space-S
(* ebnf-font-height-S
0.5)
4326 ebnf-space-E
(* ebnf-font-height-E
0.5)
4327 ebnf-space-R
(* ebnf-font-height-R
0.5))
4328 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT
)))
4329 (setq ebnf-basic-width
(* basic
0.5)
4330 ebnf-horizontal-space
(+ basic basic
)
4331 ebnf-basic-height ebnf-basic-width
4332 ebnf-vertical-space ebnf-basic-width
)
4333 ;; ensures value is greater than zero
4334 (or (and (numberp ebnf-production-horizontal-space
)
4335 (> ebnf-production-horizontal-space
0.0))
4336 (setq ebnf-production-horizontal-space basic
))
4337 ;; ensures value is greater than zero
4338 (or (and (numberp ebnf-production-vertical-space
)
4339 (> ebnf-production-vertical-space
0.0))
4340 (setq ebnf-production-vertical-space basic
))))
4343 (defsubst ebnf-shape-value
(sym alist
)
4344 (or (cdr (assq sym alist
)) 0))
4347 (defsubst ebnf-boolean
(value)
4348 (if value
"true" "false"))
4351 (defun ebnf-begin-file ()
4354 (set-buffer ps-spool-buffer
)
4355 (goto-char (point-min))
4356 (and (search-forward "%%Creator: " nil t
)
4357 (not (search-forward "& ebnf2ps v"
4358 (save-excursion (end-of-line) (point))
4361 ;; adjust creator comment
4364 (insert " & ebnf2ps v" ebnf-version
)
4365 ;; insert ebnf settings & engine
4366 (goto-char (point-max))
4367 (search-backward "\n%%EndPrologue\n")
4368 (ebnf-insert-ebnf-prologue)
4369 (ps-output "\n")))))
4372 (defun ebnf-eps-finish-and-write (buffer filename
)
4375 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4376 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4379 ebnf-production-vertical-space
4380 ebnf-eps-max-height
)))
4382 (goto-char (point-min))
4384 "%!PS-Adobe-3.0 EPSF-3.0"
4385 "\n%%BoundingBox: 0 0 "
4386 (format "%d %d" (1+ ebnf-eps-upper-x
) (1+ ebnf-eps-upper-y
))
4387 "\n%%Title: " filename
4388 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4389 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version
")"
4390 "\n%%DocumentNeededResources: font "
4391 (or ebnf-fonts-required
4392 (setq ebnf-fonts-required
4393 (mapconcat 'identity
4394 (ps-remove-duplicates
4395 (mapcar 'ebnf-font-name-select
4396 (list ebnf-production-font
4398 ebnf-non-terminal-font
4403 "\n%%Pages: 0\n%%EndComments\n\n%%BeginPrologue\n"
4405 (ebnf-insert-ebnf-prologue)
4406 (insert ebnf-eps-begin
4407 "\n0 " (ebnf-format-float
4408 (- ebnf-eps-upper-y
(* ebnf-font-height-P
0.7)))
4409 " #ebnf2ps#begin\n")
4411 (goto-char (point-max))
4412 (insert ebnf-eps-end
)
4414 (message "Saving...")
4415 (setq filename
(expand-file-name filename
))
4416 (let ((coding-system-for-write 'raw-text-unix
))
4417 (write-region (point-min) (point-max) filename
))
4418 (message "Wrote %s" filename
)))
4421 (defun ebnf-insert-ebnf-prologue ()
4426 "\n\n% === begin EBNF settings\n\n"
4428 (format "/fP %s /%s DefFont\n"
4429 (ebnf-format-float (ebnf-font-size ebnf-production-font
))
4430 (ebnf-font-name-select ebnf-production-font
))
4431 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4432 (ebnf-font-foreground ebnf-production-font
)
4434 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4435 (ebnf-font-background ebnf-production-font
)
4437 (format "/EffectP %d def\n"
4438 (ebnf-font-attributes ebnf-production-font
))
4440 (format "/fT %s /%s DefFont\n"
4441 (ebnf-format-float (ebnf-font-size ebnf-terminal-font
))
4442 (ebnf-font-name-select ebnf-terminal-font
))
4443 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4444 (ebnf-font-foreground ebnf-terminal-font
)
4446 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4447 (ebnf-font-background ebnf-terminal-font
)
4449 (format "/EffectT %d def\n"
4450 (ebnf-font-attributes ebnf-terminal-font
))
4451 (format "/BorderWidthT %s def\n"
4452 (ebnf-format-float ebnf-terminal-border-width
))
4453 (ebnf-format-color "/BorderColorT %s def %% %s\n"
4454 ebnf-terminal-border-color
4456 (format "/ShapeT %d def\n"
4457 (ebnf-shape-value ebnf-terminal-shape
4458 ebnf-terminal-shape-alist
))
4459 (format "/ShadowT %s def\n"
4460 (ebnf-boolean ebnf-terminal-shadow
))
4462 (format "/fNT %s /%s DefFont\n"
4464 (ebnf-font-size ebnf-non-terminal-font
))
4465 (ebnf-font-name-select ebnf-non-terminal-font
))
4466 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
4467 (ebnf-font-foreground ebnf-non-terminal-font
)
4469 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
4470 (ebnf-font-background ebnf-non-terminal-font
)
4472 (format "/EffectNT %d def\n"
4473 (ebnf-font-attributes ebnf-non-terminal-font
))
4474 (format "/BorderWidthNT %s def\n"
4475 (ebnf-format-float ebnf-non-terminal-border-width
))
4476 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
4477 ebnf-non-terminal-border-color
4479 (format "/ShapeNT %d def\n"
4480 (ebnf-shape-value ebnf-non-terminal-shape
4481 ebnf-terminal-shape-alist
))
4482 (format "/ShadowNT %s def\n"
4483 (ebnf-boolean ebnf-non-terminal-shadow
))
4485 (format "/fS %s /%s DefFont\n"
4486 (ebnf-format-float (ebnf-font-size ebnf-special-font
))
4487 (ebnf-font-name-select ebnf-special-font
))
4488 (ebnf-format-color "/ForegroundS %s def %% %s\n"
4489 (ebnf-font-foreground ebnf-special-font
)
4491 (ebnf-format-color "/BackgroundS %s def %% %s\n"
4492 (ebnf-font-background ebnf-special-font
)
4494 (format "/EffectS %d def\n"
4495 (ebnf-font-attributes ebnf-special-font
))
4496 (format "/BorderWidthS %s def\n"
4497 (ebnf-format-float ebnf-special-border-width
))
4498 (ebnf-format-color "/BorderColorS %s def %% %s\n"
4499 ebnf-special-border-color
4501 (format "/ShapeS %d def\n"
4502 (ebnf-shape-value ebnf-special-shape
4503 ebnf-terminal-shape-alist
))
4504 (format "/ShadowS %s def\n"
4505 (ebnf-boolean ebnf-special-shadow
))
4507 (format "/fE %s /%s DefFont\n"
4508 (ebnf-format-float (ebnf-font-size ebnf-except-font
))
4509 (ebnf-font-name-select ebnf-except-font
))
4510 (ebnf-format-color "/ForegroundE %s def %% %s\n"
4511 (ebnf-font-foreground ebnf-except-font
)
4513 (ebnf-format-color "/BackgroundE %s def %% %s\n"
4514 (ebnf-font-background ebnf-except-font
)
4516 (format "/EffectE %d def\n"
4517 (ebnf-font-attributes ebnf-except-font
))
4518 (format "/BorderWidthE %s def\n"
4519 (ebnf-format-float ebnf-except-border-width
))
4520 (ebnf-format-color "/BorderColorE %s def %% %s\n"
4521 ebnf-except-border-color
4523 (format "/ShapeE %d def\n"
4524 (ebnf-shape-value ebnf-except-shape
4525 ebnf-terminal-shape-alist
))
4526 (format "/ShadowE %s def\n"
4527 (ebnf-boolean ebnf-except-shadow
))
4529 (format "/fR %s /%s DefFont\n"
4530 (ebnf-format-float (ebnf-font-size ebnf-repeat-font
))
4531 (ebnf-font-name-select ebnf-repeat-font
))
4532 (ebnf-format-color "/ForegroundR %s def %% %s\n"
4533 (ebnf-font-foreground ebnf-repeat-font
)
4535 (ebnf-format-color "/BackgroundR %s def %% %s\n"
4536 (ebnf-font-background ebnf-repeat-font
)
4538 (format "/EffectR %d def\n"
4539 (ebnf-font-attributes ebnf-repeat-font
))
4540 (format "/BorderWidthR %s def\n"
4541 (ebnf-format-float ebnf-repeat-border-width
))
4542 (ebnf-format-color "/BorderColorR %s def %% %s\n"
4543 ebnf-repeat-border-color
4545 (format "/ShapeR %d def\n"
4546 (ebnf-shape-value ebnf-repeat-shape
4547 ebnf-terminal-shape-alist
))
4548 (format "/ShadowR %s def\n"
4549 (ebnf-boolean ebnf-repeat-shadow
))
4551 (format "/DefaultWidth %s def\n"
4552 (ebnf-format-float ebnf-default-width
))
4553 (format "/LineWidth %s def\n"
4554 (ebnf-format-float ebnf-line-width
))
4555 (ebnf-format-color "/LineColor %s def %% %s\n"
4558 (format "/ArrowShape %d def\n"
4559 (ebnf-shape-value ebnf-arrow-shape
4560 ebnf-arrow-shape-alist
))
4561 (format "/ChartShape %d def\n"
4562 (ebnf-shape-value ebnf-chart-shape
4563 ebnf-terminal-shape-alist
))
4564 (format "/UserArrow{%s}def\n"
4565 (let ((arrow (eval ebnf-user-arrow
)))
4569 "\n% === end EBNF settings\n\n"
4570 (and ebnf-debug-ps ebnf-debug
))))
4574 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4575 ;; Adjusting dimensions
4578 (defun ebnf-dimensions (tree)
4579 (let ((ebnf-total (length tree
))
4581 (mapcar 'ebnf-production-dimension tree
))
4585 ;; [empty width-fun dim-fun entry height width]
4586 ;;(defun ebnf-empty-dimension (empty)
4590 ;; [production width-fun dim-fun entry height width name production action]
4591 (defun ebnf-production-dimension (production)
4592 (ebnf-message-info "Calculating dimensions")
4593 (ebnf-node-dimension-func (ebnf-node-production production
))
4594 (let* ((prod (ebnf-node-production production
))
4595 (height (+ ebnf-font-height-P
4597 (ebnf-node-height prod
))))
4598 (ebnf-node-entry production height
)
4599 (ebnf-node-height production height
)
4600 (ebnf-node-width production
(+ (ebnf-node-width prod
)
4601 ebnf-horizontal-space
))))
4604 ;; [terminal width-fun dim-fun entry height width name]
4605 (defun ebnf-terminal-dimension (terminal)
4606 (ebnf-terminal-dimension1 terminal
4612 ;; [non-terminal width-fun dim-fun entry height width name]
4613 (defun ebnf-non-terminal-dimension (non-terminal)
4614 (ebnf-terminal-dimension1 non-terminal
4620 ;; [special width-fun dim-fun entry height width name]
4621 (defun ebnf-special-dimension (special)
4622 (ebnf-terminal-dimension1 special
4628 (defun ebnf-terminal-dimension1 (node font-height font-width space
)
4629 (let ((height (+ space font-height space
))
4630 (len (length (ebnf-node-name node
))))
4631 (ebnf-node-entry node
(* height
0.5))
4632 (ebnf-node-height node height
)
4633 (ebnf-node-width node
(+ ebnf-basic-width space
4635 space ebnf-basic-width
))))
4638 (defconst ebnf-null-vector
(vector t t t
0.0 0.0 0.0))
4641 ;; [repeat width-fun dim-fun entry height width times element]
4642 (defun ebnf-repeat-dimension (repeat)
4643 (let ((times (ebnf-node-name repeat
))
4644 (element (ebnf-node-separator repeat
)))
4646 (ebnf-node-dimension-func element
)
4647 (setq element ebnf-null-vector
))
4648 (ebnf-node-entry repeat
(+ (ebnf-node-entry element
)
4650 (ebnf-node-height repeat
(+ (max (ebnf-node-height element
)
4652 ebnf-space-R ebnf-space-R
))
4653 (ebnf-node-width repeat
(+ (ebnf-node-width element
)
4654 ebnf-space-R ebnf-space-R ebnf-space-R
4655 ebnf-horizontal-space
4656 (* (length times
) ebnf-font-width-R
)))))
4659 ;; [except width-fun dim-fun entry height width element element]
4660 (defun ebnf-except-dimension (except)
4661 (let ((factor (ebnf-node-list except
))
4662 (element (ebnf-node-separator except
)))
4663 (ebnf-node-dimension-func factor
)
4665 (ebnf-node-dimension-func element
)
4666 (setq element ebnf-null-vector
))
4667 (ebnf-node-entry except
(+ (max (ebnf-node-entry factor
)
4668 (ebnf-node-entry element
))
4670 (ebnf-node-height except
(+ (max (ebnf-node-height factor
)
4671 (ebnf-node-height element
))
4672 ebnf-space-E ebnf-space-E
))
4673 (ebnf-node-width except
(+ (ebnf-node-width factor
)
4674 (ebnf-node-width element
)
4675 ebnf-space-E ebnf-space-E
4676 ebnf-space-E ebnf-space-E
4678 ebnf-horizontal-space
))))
4681 ;; [alternative width-fun dim-fun entry height width list]
4682 (defun ebnf-alternative-dimension (alternative)
4683 (let ((body (ebnf-node-list alternative
))
4684 (lis (ebnf-node-list alternative
)))
4686 (ebnf-node-dimension-func (car lis
))
4687 (setq lis
(cdr lis
)))
4691 (tail (car (last body
)))
4692 (entry (ebnf-node-entry (car body
)))
4695 (setq node
(car alt
)
4697 height
(+ (ebnf-node-height node
) height
)
4698 width
(max (ebnf-node-width node
) width
)))
4699 (ebnf-adjust-width body width
)
4700 (setq height
(+ height
(* (1- (length body
)) ebnf-vertical-space
)))
4701 (ebnf-node-entry alternative
(+ entry
4704 (- (ebnf-node-height tail
)
4705 (ebnf-node-entry tail
))))))
4706 (ebnf-node-height alternative height
)
4707 (ebnf-node-width alternative
(+ width ebnf-horizontal-space
))
4708 (ebnf-node-list alternative body
))))
4711 ;; [optional width-fun dim-fun entry height width element]
4712 (defun ebnf-optional-dimension (optional)
4713 (let ((body (ebnf-node-list optional
)))
4714 (ebnf-node-dimension-func body
)
4715 (ebnf-node-entry optional
(ebnf-node-entry body
))
4716 (ebnf-node-height optional
(+ (ebnf-node-height body
)
4717 ebnf-vertical-space
))
4718 (ebnf-node-width optional
(+ (ebnf-node-width body
)
4719 ebnf-horizontal-space
))))
4722 ;; [one-or-more width-fun dim-fun entry height width element separator]
4723 (defun ebnf-one-or-more-dimension (or-more)
4724 (let ((list-part (ebnf-node-list or-more
))
4725 (sep-part (ebnf-node-separator or-more
)))
4726 (ebnf-node-dimension-func list-part
)
4728 (ebnf-node-dimension-func sep-part
))
4729 (let ((height (+ (if sep-part
4730 (ebnf-node-height sep-part
)
4733 (ebnf-node-height list-part
)))
4734 (width (max (if sep-part
4735 (ebnf-node-width sep-part
)
4737 (ebnf-node-width list-part
))))
4739 (ebnf-adjust-width list-part width
)
4740 (ebnf-adjust-width sep-part width
))
4741 (ebnf-node-entry or-more
(+ (- height
(ebnf-node-height list-part
))
4742 (ebnf-node-entry list-part
)))
4743 (ebnf-node-height or-more height
)
4744 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
4747 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4748 (defun ebnf-zero-or-more-dimension (or-more)
4749 (let ((list-part (ebnf-node-list or-more
))
4750 (sep-part (ebnf-node-separator or-more
)))
4751 (ebnf-node-dimension-func list-part
)
4753 (ebnf-node-dimension-func sep-part
))
4754 (let ((height (+ (if sep-part
4755 (ebnf-node-height sep-part
)
4758 (ebnf-node-height list-part
)
4759 ebnf-vertical-space
))
4760 (width (max (if sep-part
4761 (ebnf-node-width sep-part
)
4763 (ebnf-node-width list-part
))))
4765 (ebnf-adjust-width list-part width
)
4766 (ebnf-adjust-width sep-part width
))
4767 (ebnf-node-entry or-more height
)
4768 (ebnf-node-height or-more height
)
4769 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
4772 ;; [sequence width-fun dim-fun entry height width list]
4773 (defun ebnf-sequence-dimension (sequence)
4777 (lis (ebnf-node-list sequence
))
4780 (setq node
(car lis
)
4782 (ebnf-node-dimension-func node
)
4783 (setq entry
(ebnf-node-entry node
)
4784 above
(max above entry
)
4785 below
(max below
(- (ebnf-node-height node
) entry
))
4786 width
(+ width
(ebnf-node-width node
))))
4787 (ebnf-node-entry sequence above
)
4788 (ebnf-node-height sequence
(+ above below
))
4789 (ebnf-node-width sequence width
)))
4792 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4796 (defun ebnf-adjust-width (node width
)
4802 (setcar node
(ebnf-adjust-width (car node
) width
))
4803 (setq node
(cdr node
)))))
4806 ;; nothing to be done
4807 ((= width
(ebnf-node-width node
))
4809 ;; left justify term
4810 ((eq ebnf-justify-sequence
'left
)
4811 (ebnf-adjust-empty node width nil
))
4812 ;; right justify terms
4813 ((eq ebnf-justify-sequence
'right
)
4814 (ebnf-adjust-empty node width t
))
4817 (ebnf-node-width-func node width
)
4818 (ebnf-node-width node width
)
4826 (defun ebnf-adjust-empty (node width last-p
)
4827 (if (eq (ebnf-node-kind node
) 'ebnf-generate-empty
)
4829 (ebnf-node-width node width
)
4831 (let ((empty (ebnf-make-empty (- width
(ebnf-node-width node
)))))
4832 (ebnf-make-dup-sequence node
4835 (list node empty
))))))
4838 ;; [terminal width-fun dim-fun entry height width name]
4839 ;; [non-terminal width-fun dim-fun entry height width name]
4840 ;; [empty width-fun dim-fun entry height width]
4841 ;; [special width-fun dim-fun entry height width name]
4842 ;; [repeat width-fun dim-fun entry height width times element]
4843 ;; [except width-fun dim-fun entry height width element element]
4844 ;;(defun ebnf-terminal-width (terminal width)
4848 ;; [alternative width-fun dim-fun entry height width list]
4849 ;; [optional width-fun dim-fun entry height width element]
4850 (defun ebnf-alternative-width (alternative width
)
4851 (ebnf-adjust-width (ebnf-node-list alternative
)
4852 (- width ebnf-horizontal-space
)))
4855 ;; [one-or-more width-fun dim-fun entry height width element separator]
4856 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4857 (defun ebnf-list-width (or-more width
)
4858 (setq width
(- width ebnf-horizontal-space
))
4859 (ebnf-node-list or-more
4860 (ebnf-justify-list or-more
4861 (ebnf-node-list or-more
)
4863 (ebnf-node-separator or-more
4864 (ebnf-justify-list or-more
4865 (ebnf-node-separator or-more
)
4869 ;; [sequence width-fun dim-fun entry height width list]
4870 (defun ebnf-sequence-width (sequence width
)
4871 (ebnf-node-list sequence
4872 (ebnf-justify-list sequence
4873 (ebnf-node-list sequence
)
4877 (defun ebnf-justify-list (node seq width
)
4878 (let ((seq-width (ebnf-node-width node
)))
4879 (if (= width seq-width
)
4882 ;; left justify terms
4883 ((eq ebnf-justify-sequence
'left
)
4884 (ebnf-justify node seq seq-width width t
))
4885 ;; right justify terms
4886 ((eq ebnf-justify-sequence
'right
)
4887 (ebnf-justify node seq seq-width width nil
))
4890 (let ((the-width (/ (- width seq-width
) (length seq
)))
4893 (ebnf-adjust-width (car lis
)
4894 (+ (ebnf-node-width (car lis
))
4896 (setq lis
(cdr lis
)))
4901 (defun ebnf-justify (node seq seq-width width last-p
)
4902 (let ((term (car (if last-p
(last seq
) seq
))))
4904 ;; adjust empty term
4905 ((eq (ebnf-node-kind term
) 'ebnf-generate-empty
)
4906 (ebnf-node-width term
(+ (- width seq-width
)
4907 (ebnf-node-width term
)))
4909 ;; insert empty at end ==> left justify
4912 (list (ebnf-make-empty (- width seq-width
)))))
4913 ;; insert empty at beginning ==> right justify
4915 (cons (ebnf-make-empty (- width seq-width
))
4920 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4921 ;; Functions used by parsers
4924 (defun ebnf-eps-add-context (name)
4925 (let ((filename (ebnf-eps-filename name
)))
4926 (if (member filename ebnf-eps-context
)
4927 (error "Try to open an already opened EPS file: %s" filename
)
4928 (setq ebnf-eps-context
(cons filename ebnf-eps-context
)))))
4931 (defun ebnf-eps-remove-context (name)
4932 (let ((filename (ebnf-eps-filename name
)))
4933 (if (member filename ebnf-eps-context
)
4934 (setq ebnf-eps-context
(delete filename ebnf-eps-context
))
4935 (error "Try to close a not opened EPS file: %s" filename
))))
4938 (defun ebnf-eps-add-production (header)
4939 (and ebnf-eps-executing
4941 (let ((prod (assoc header ebnf-eps-production-list
)))
4943 (setcdr prod
(append ebnf-eps-context
(cdr prod
)))
4944 (setq ebnf-eps-production-list
4945 (cons (cons header
(ebnf-dup-list ebnf-eps-context
))
4946 ebnf-eps-production-list
))))))
4949 (defun ebnf-dup-list (old)
4952 (setq new
(cons (car old
) new
)
4957 (defun ebnf-buffer-substring (chars)
4958 (buffer-substring-no-properties
4961 (skip-chars-forward chars ebnf-limit
)
4965 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
4966 (defconst ebnf-8-bit-chars
(ebnf-range-regexp "" ?
\240 ?
\377))
4969 (defun ebnf-string (chars eos-char kind
)
4971 (buffer-substring-no-properties
4974 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
4975 (skip-chars-forward (concat chars ebnf-8-bit-chars
) ebnf-limit
)
4976 (if (or (eobp) (/= (following-char) eos-char
))
4977 (error "Illegal %s: missing `%c'" kind eos-char
)
4982 (defun ebnf-get-string ()
4984 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
4987 (defun ebnf-end-of-string ()
4989 (while (> (logand n
1) 0)
4990 (skip-chars-forward "^\"" ebnf-limit
)
4991 (setq n
(- (skip-chars-backward "\\\\")))
4992 (goto-char (+ (point) n
1))))
4993 (if (= (preceding-char) ?
\")
4995 (error "Missing `\"'")))
4998 (defun ebnf-trim-right (str)
4999 (let* ((len (1- (length str
)))
5001 (while (and (> index
0) (= (aref str index
) ?\
))
5002 (setq index
(1- index
)))
5005 (substring str
0 (1+ index
)))))
5008 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5012 (defun ebnf-make-empty (&optional width
)
5013 (vector 'ebnf-generate-empty
5018 (or width ebnf-horizontal-space
)))
5021 (defun ebnf-make-terminal (name)
5022 (ebnf-make-terminal1 name
5023 'ebnf-generate-terminal
5024 'ebnf-terminal-dimension
))
5027 (defun ebnf-make-non-terminal (name)
5028 (ebnf-make-terminal1 name
5029 'ebnf-generate-non-terminal
5030 'ebnf-non-terminal-dimension
))
5033 (defun ebnf-make-special (name)
5034 (ebnf-make-terminal1 name
5035 'ebnf-generate-special
5036 'ebnf-special-dimension
))
5039 (defun ebnf-make-terminal1 (name gen-func dim-func
)
5046 (let ((len (length name
)))
5047 (cond ((> len
2) name
)
5048 ((= len
2) (concat " " name
))
5049 ((= len
1) (concat " " name
" "))
5054 (defun ebnf-make-one-or-more (list-part &optional sep-part
)
5055 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5056 'ebnf-one-or-more-dimension
5061 (defun ebnf-make-zero-or-more (list-part &optional sep-part
)
5062 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5063 'ebnf-zero-or-more-dimension
5068 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part
)
5075 (if (listp list-part
)
5076 (ebnf-make-sequence list-part
)
5078 (if (and sep-part
(listp sep-part
))
5079 (ebnf-make-sequence sep-part
)
5083 (defun ebnf-make-production (name prod action
)
5084 (vector 'ebnf-generate-production
5086 'ebnf-production-dimension
5095 (defun ebnf-make-alternative (body)
5096 (vector 'ebnf-generate-alternative
5097 'ebnf-alternative-width
5098 'ebnf-alternative-dimension
5105 (defun ebnf-make-optional (body)
5106 (vector 'ebnf-generate-optional
5107 'ebnf-alternative-width
5108 'ebnf-optional-dimension
5115 (defun ebnf-make-except (factor exception
)
5116 (vector 'ebnf-generate-except
5118 'ebnf-except-dimension
5126 (defun ebnf-make-repeat (times primary
)
5127 (vector 'ebnf-generate-repeat
5129 'ebnf-repeat-dimension
5137 (defun ebnf-make-sequence (seq)
5138 (vector 'ebnf-generate-sequence
5139 'ebnf-sequence-width
5140 'ebnf-sequence-dimension
5147 (defun ebnf-make-dup-sequence (node seq
)
5148 (vector 'ebnf-generate-sequence
5149 'ebnf-sequence-width
5150 'ebnf-sequence-dimension
5151 (ebnf-node-entry node
)
5152 (ebnf-node-height node
)
5153 (ebnf-node-width node
)
5157 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5158 ;; Optimizers used by parsers
5161 (defun ebnf-token-except (element exception
)
5164 (setq exception
(cdr exception
)))
5165 (and element
; EMPTY - A ==> EMPTY
5166 (let ((kind (ebnf-node-kind element
)))
5169 ((and (null exception
)
5170 (eq kind
'ebnf-generate-optional
))
5171 (ebnf-node-list element
))
5172 ;; { A }- ==> { A }+
5173 ((and (null exception
)
5174 (eq kind
'ebnf-generate-zero-or-more
))
5175 (ebnf-node-kind element
'ebnf-generate-one-or-more
)
5176 (ebnf-node-dimension-func element
'ebnf-one-or-more-dimension
)
5178 ;; ( A | EMPTY )- ==> A
5179 ;; ( A | B | EMPTY )- ==> A | B
5180 ((and (null exception
)
5181 (eq kind
'ebnf-generate-alternative
)
5183 (car (last (ebnf-node-list element
))))
5184 'ebnf-generate-empty
))
5185 (let ((elt (ebnf-node-list element
))
5191 ;; this should not happen!!?!
5192 (setq element
(ebnf-make-empty
5193 (ebnf-node-width element
)))
5195 (setq elt
(ebnf-node-list element
))
5196 (and (= (length elt
) 1)
5197 (setq element
(car elt
))))
5201 (ebnf-make-except element exception
))
5205 (defun ebnf-token-repeat (times repeat
)
5206 (if (null (cdr repeat
))
5207 ;; n * EMPTY ==> EMPTY
5211 (ebnf-make-repeat times
(cdr repeat
)))))
5214 (defun ebnf-token-optional (body)
5215 (let ((kind (ebnf-node-kind body
)))
5217 ;; [ EMPTY ] ==> EMPTY
5218 ((eq kind
'ebnf-generate-empty
)
5220 ;; [ { A }* ] ==> { A }*
5221 ((eq kind
'ebnf-generate-zero-or-more
)
5223 ;; [ { A }+ ] ==> { A }*
5224 ((eq kind
'ebnf-generate-one-or-more
)
5225 (ebnf-node-kind body
'ebnf-generate-zero-or-more
)
5227 ;; [ A | B ] ==> A | B | EMPTY
5228 ((eq kind
'ebnf-generate-alternative
)
5229 (ebnf-node-list body
(nconc (ebnf-node-list body
)
5230 (list (ebnf-make-empty))))
5234 (ebnf-make-optional body
))
5238 (defun ebnf-token-alternative (body sequence
)
5242 (cons (car sequence
)
5244 (cons (car sequence
)
5245 (let ((seq (cdr sequence
)))
5246 (if (and (= (length body
) 1) (null seq
))
5248 (ebnf-make-alternative (nreverse (if seq
5253 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5254 ;; Variables used by parsers
5257 (defconst ebnf-comment-table
5258 (let ((table (make-vector 256 nil
)))
5259 ;; Override special comment character:
5260 (aset table ?
< 'newline
)
5261 (aset table ?
> 'keep-line
)
5263 "Vector used to map characters to a special comment token.")
5266 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5267 ;; To make this file smaller, some commands go in a separate file.
5268 ;; But autoload them here to make the separation invisible.
5270 (autoload 'ebnf-bnf-parser
"ebnf-bnf"
5273 (autoload 'ebnf-bnf-initialize
"ebnf-bnf"
5274 "Initialize EBNF token table.")
5276 (autoload 'ebnf-iso-parser
"ebnf-iso"
5279 (autoload 'ebnf-iso-initialize
"ebnf-iso"
5280 "Initialize ISO EBNF token table.")
5282 (autoload 'ebnf-yac-parser
"ebnf-yac"
5283 "Yacc/Bison parser.")
5285 (autoload 'ebnf-yac-initialize
"ebnf-yac"
5286 "Initializations for Yacc/Bison parser.")
5288 (autoload 'ebnf-eliminate-empty-rules
"ebnf-otz"
5289 "Eliminate empty rules.")
5291 (autoload 'ebnf-optimize
"ebnf-otz"
5292 "Syntatic chart optimizer.")
5294 (autoload 'ebnf-otz-initialize
"ebnf-otz"
5295 "Initialize optimizer.")
5298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5303 ;;; ebnf2ps.el ends here