1 ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
4 ;; Free Software Foundation, Inc.
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Time-stamp: <2004/02/28 18:19:37 vinicius>
9 ;; Keywords: wp, ebnf, PostScript
11 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
30 (defconst ebnf-version
"4.0"
31 "ebnf2ps.el, v 4.0 <2004/02/28 vinicius>
33 Vinicius's last change version. When reporting bugs, please also
34 report the version of Emacs, if any, that ebnf2ps was running with.
36 Please send all bug fixes and enhancements to
37 Vinicius Jose Latorre <viniciusjl@ig.com.br>.
43 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; This package translates an EBNF to a syntactic chart on PostScript.
50 ;; To use ebnf2ps, insert in your ~/.emacs:
54 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
55 ;; know how to set options like landscape printing, page headings, margins,
58 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
59 ;; ebnf2ps, they behave as it's turned off.
61 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
63 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
65 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
67 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
73 ;; ebnf2ps provides six commands for generating PostScript syntactic chart
74 ;; images of Emacs buffers:
76 ;; ebnf-print-directory
80 ;; ebnf-spool-directory
89 ;; These commands all perform essentially the same function: they generate
90 ;; PostScript syntactic chart images suitable for printing on a PostScript
91 ;; printer or displaying with GhostScript. These commands are collectively
92 ;; referred to as "ebnf- commands".
94 ;; The word "print", "spool" and "eps" in the command name determines when the
95 ;; PostScript image is sent to the printer (or file):
97 ;; print - The PostScript image is immediately sent to the printer;
99 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
100 ;; Many images may be spooled locally before printing them. To
101 ;; send the spooled images to the printer, use the command
104 ;; eps - The PostScript image is immediately sent to a EPS file.
106 ;; The spooling mechanism is the same as used by ps-print and was designed for
107 ;; printing lots of small files to save paper that would otherwise be wasted on
108 ;; banner pages, and to make it easier to find your output at the printer (it's
109 ;; easier to pick up one 50-page printout than to find 50 single-page
110 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
111 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
113 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
114 ;; won't accidentally quit from Emacs while you have unprinted PostScript
115 ;; waiting in the spool buffer. If you do attempt to exit with spooled
116 ;; PostScript, you'll be asked if you want to print it, and if you decline,
117 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
118 ;; that Emacs uses for modified buffers.
120 ;; The word "directory", "file", "buffer" or "region" in the command name
121 ;; determines how much of the buffer is printed:
123 ;; directory - Read files in the directory and print them.
125 ;; file - Read file and print it.
127 ;; buffer - Print the entire buffer.
129 ;; region - Print just the current region.
131 ;; Two ebnf- command examples:
133 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
134 ;; immediately to the printer.
136 ;; ebnf-spool-region - translate and print just the current region, and
137 ;; spool the image in Emacs to send to the printer
140 ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and
141 ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print
142 ;; spooling mechanism. See section "Actions in Comments" for an explanation
143 ;; about EPS file generation.
149 ;; To translate and print your buffer, type
151 ;; M-x ebnf-print-buffer
153 ;; or substitute one of the other four ebnf- commands. The command will
154 ;; generate the PostScript image and print or spool it as specified. By giving
155 ;; the command a prefix argument
157 ;; C-u M-x ebnf-print-buffer
159 ;; it will save the PostScript image to a file instead of sending it to the
160 ;; printer; you will be prompted for the name of the file to save the image to.
161 ;; The prefix argument is ignored by the commands that spool their images, but
162 ;; you may save the spooled images to a file by giving a prefix argument to
165 ;; C-u M-x ebnf-despool
167 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
170 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
171 ;; `ebnf-eps-region'.
173 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
175 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
176 ;; (global-set-key '(shift f22) 'ebnf-print-region)
177 ;; (global-set-key '(control f22) 'ebnf-despool)
183 ;; The current EBNF that ebnf2ps accepts has the following constructions:
185 ;; ; comment (until end of line)
189 ;; $A default non-terminal (see text below)
190 ;; $"C" default terminal (see text below)
191 ;; $?C? default special (see text below)
192 ;; A = B. production (A is the header and B the body)
193 ;; C D sequence (C occurs before D)
194 ;; C | D alternative (C or D occurs)
195 ;; A - B exception (A excluding B, B without any non-terminal)
196 ;; n * A repetition (A repeats at least n (integer) times)
197 ;; n * n A repetition (A repeats exactly n (integer) times)
198 ;; n * m A repetition (A repeats at least n (integer) and at most
199 ;; m (integer) times)
200 ;; (C) group (expression C is grouped together)
201 ;; [C] optional (C may or not occurs)
202 ;; C+ one or more occurrences of C
203 ;; {C}+ one or more occurrences of C
204 ;; {C}* zero or more occurrences of C
205 ;; {C} zero or more occurrences of C
206 ;; C / D equivalent to: C {D C}*
207 ;; {C || D}+ equivalent to: C {D C}*
208 ;; {C || D}* equivalent to: [C {D C}*]
209 ;; {C || D} equivalent to: [C {D C}*]
211 ;; The EBNF syntax written using the notation above is:
213 ;; EBNF = {production}+.
215 ;; production = non_terminal "=" body ".". ;; production
217 ;; body = {sequence || "|"}*. ;; alternative
219 ;; sequence = {exception}*. ;; sequence
221 ;; exception = repeat [ "-" repeat]. ;; exception
223 ;; repeat = [ integer "*" [ integer ]] term. ;; repetition
226 ;; | [factor] "+" ;; one-or-more
227 ;; | [factor] "/" [factor] ;; one-or-more
230 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
231 ;; | [ "$" ] non_terminal ;; non-terminal
232 ;; | [ "$" ] "?" special "?" ;; special
233 ;; | "(" body ")" ;; group
234 ;; | "[" body "]" ;; zero-or-one
235 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
236 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
237 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
240 ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
241 ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
242 ;; ;; and lower), 8-bit accentuated characters,
243 ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
244 ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
246 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
247 ;; ;; that is, a valid terminal accepts any printable character (including
248 ;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
249 ;; ;; terminal. Also, accepts escaped characters, that is, a character
250 ;; ;; pair starting with `\' followed by a printable character, for
251 ;; ;; example: \", \\.
253 ;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
254 ;; ;; that is, a valid special accepts any printable character (including
255 ;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
256 ;; ;; delimit a special.
258 ;; integer = "[0-9]+".
259 ;; ;; that is, an integer is a sequence of one or more decimal digits.
261 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
262 ;; ;; that is, a comment starts with the character `;' and terminates at end
263 ;; ;; of line. Also, it only accepts printable characters (including 8-bit
264 ;; ;; accentuated characters) and tabs.
266 ;; Try to use the above EBNF to test ebnf2ps.
268 ;; The `default' terminal, non-terminal and special is a way to indicate a
269 ;; default path in a production. For example, the production:
271 ;; X = [ $A ( B | $C ) | D ].
273 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
275 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
276 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
277 ;; name besides that enclosed by `"'.
279 ;; Let's see an example:
281 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
282 ;; (setq ebnf-case-fold-search nil) ; exact matching
284 ;; If you have the production:
286 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
288 ;; The names are classified as:
290 ;; Logical Expression non-terminal
291 ;; "(" OR AND "XOR" ")" terminal
293 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
294 ;; value is ?\; (character `;').
296 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
297 ;; value is ?. (character `.').
299 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
301 ;; `ebnf' ebnf2ps recognizes the syntax described above.
302 ;; The following variables *ONLY* have effect with this
304 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
305 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
307 ;; `abnf' ebnf2ps recognizes the syntax described in the URL:
308 ;; `http://www.ietf.org/rfc/rfc2234.txt'
309 ;; ("Augmented BNF for Syntax Specifications: ABNF").
311 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
312 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
313 ;; ("International Standard of the ISO EBNF Notation").
314 ;; The following variables *ONLY* have effect with this
316 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
318 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
319 ;; The following variable *ONLY* has effect with this
321 ;; `ebnf-yac-ignore-error-recovery'.
323 ;; Any other value is treated as `ebnf'.
325 ;; The default value is `ebnf'.
331 ;; The following EBNF optimizations are done:
333 ;; [ { A }* ] ==> { A }*
334 ;; [ { A }+ ] ==> { A }*
335 ;; [ A ] + ==> { A }*
336 ;; { A }* + ==> { A }*
337 ;; { A }+ + ==> { A }+
340 ;; ( A | EMPTY )- ==> A
341 ;; ( A | B | EMPTY )- ==> A | B
342 ;; [ A | B ] ==> A | B | EMPTY
343 ;; n * EMPTY ==> EMPTY
345 ;; EMPTY / EMPTY ==> EMPTY
346 ;; EMPTY - A ==> EMPTY
348 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
351 ;; 1. A = B | A C. ==> A = B {C}*.
352 ;; 2. A = B | A B. ==> A = {B}+.
353 ;; 3. A = | A B. ==> A = {B}*.
354 ;; 4. A = B | A C B. ==> A = {B || C}+.
355 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
358 ;; 6. A = B | . ==> A = [B].
359 ;; 7. A = | B . ==> A = [B].
362 ;; 8. A = B C | B D. ==> A = B (C | D).
363 ;; 9. A = C B | D B. ==> A = (C | D) B.
364 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
366 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
372 ;; You may use form feed (^L \014) to force a production to start on a new
373 ;; page, for example:
382 ;; c) A = B ^L^L^L | C.^L
386 ;; In all examples above, only the production X will start on a new page.
389 ;; Actions in Comments
390 ;; -------------------
392 ;; ebnf2ps accepts the following actions in comments:
394 ;; ;> the next production starts in the same line as the current one.
395 ;; It is useful when `ebnf-horizontal-orientation' is nil.
397 ;; ;< the next production starts in the next line.
398 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
400 ;; ;[EPS open a new EPS file. The EPS file name has the form:
401 ;; <PREFIX><NAME>.eps
402 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
403 ;; <NAME> is the string given by ;[ action comment, this string is
404 ;; mapped to form a valid file name (see documentation for
405 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
406 ;; It has effect only during `ebnf-eps-buffer' or
407 ;; `ebnf-eps-region' execution.
408 ;; It's an error to try to open an already opened EPS file.
410 ;; ;]EPS close an opened EPS file.
411 ;; It has effect only during `ebnf-eps-buffer' or
412 ;; `ebnf-eps-region' execution.
413 ;; It's an error to try to close a not opened EPS file.
417 ;; (setq ebnf-horizontal-orientation nil)
421 ;; ;> C and B are drawn in the same line
425 ;; The graphical result is:
431 ;; +---------+ +-----+
443 ;; Note that if ascending production sort is used, the productions A and B will
444 ;; be drawn in the same line instead of C and B.
446 ;; If consecutive actions occur, only the last one takes effect, so if you
455 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
458 ;; In ISO EBNF the above actions are specified as (*>*), (*<*), (*[EPS*) and
459 ;; (*]EPS*). The first example above should be written:
463 ;; (*> C and B are drawn in the same line *)
467 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
468 ;; `ebnf-eps-region':
487 ;; The following table summarizes the results:
489 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
490 ;; ebnf--AA.eps A C A C C A
491 ;; ebnf--BB.eps C B B C C B
492 ;; ebnf--CC.eps A C B F A B C F F C B A
498 ;; As you can see if EPS actions is not used, each single production is
499 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
500 ;; it's not an existing production name.
502 ;; In the following case:
510 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
516 ;; Some tools are provided to help you.
518 ;; `ebnf-setup' returns the current setup.
520 ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
523 ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current
526 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
528 ;; `ebnf-syntax-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound
529 ;; to keys in the same way as `ebnf-' commands.
535 ;; ebn2ps has the following hook variables:
538 ;; It is evaluated once before any ebnf2ps process.
540 ;; `ebnf-production-hook'
541 ;; It is evaluated on each beginning of production.
544 ;; It is evaluated on each beginning of page.
550 ;; Below it's shown a brief description of ebnf2ps options, please, see the
551 ;; options declaration in the code for a long documentation.
553 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
556 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
557 ;; height in horizontal orientation.
559 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
560 ;; between productions.
562 ;; `ebnf-production-vertical-space' Specify vertical space in points
563 ;; between productions.
565 ;; `ebnf-justify-sequence' Specify justification of terms in a
566 ;; sequence inside alternatives.
568 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
570 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
572 ;; `ebnf-terminal-font' Specify terminal font.
574 ;; `ebnf-terminal-shape' Specify terminal box shape.
576 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
579 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
581 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
583 ;; `ebnf-production-name-p' Non-nil means production name will be
586 ;; `ebnf-sort-production' Specify how productions are sorted.
588 ;; `ebnf-production-font' Specify production font.
590 ;; `ebnf-non-terminal-font' Specify non-terminal font.
592 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
594 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
597 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
600 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
603 ;; `ebnf-special-show-delimiter' Non-nil means special delimiter
604 ;; (character `?') is shown.
606 ;; `ebnf-special-font' Specify special font.
608 ;; `ebnf-special-shape' Specify special box shape.
610 ;; `ebnf-special-shadow' Non-nil means special box will have a
613 ;; `ebnf-special-border-width' Specify border width for special box.
615 ;; `ebnf-special-border-color' Specify border color for special box.
617 ;; `ebnf-except-font' Specify except font.
619 ;; `ebnf-except-shape' Specify except box shape.
621 ;; `ebnf-except-shadow' Non-nil means except box will have a
624 ;; `ebnf-except-border-width' Specify border width for except box.
626 ;; `ebnf-except-border-color' Specify border color for except box.
628 ;; `ebnf-repeat-font' Specify repeat font.
630 ;; `ebnf-repeat-shape' Specify repeat box shape.
632 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
635 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
637 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
639 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
641 ;; `ebnf-arrow-shape' Specify the arrow shape.
643 ;; `ebnf-chart-shape' Specify chart flow shape.
645 ;; `ebnf-color-p' Non-nil means use color.
647 ;; `ebnf-line-width' Specify flow line width.
649 ;; `ebnf-line-color' Specify flow line color.
651 ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
654 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
657 ;; `ebnf-lex-comment-char' Specify the line comment character.
659 ;; `ebnf-lex-eop-char' Specify the end of production
662 ;; `ebnf-syntax' Specify syntax to be recognized.
664 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
666 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
669 ;; `ebnf-default-width' Specify additional border width over
670 ;; default terminal, non-terminal or
673 ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains
676 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
678 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
680 ;; `ebnf-stop-on-error' Non-nil means signal error and stop.
681 ;; Nil means signal error and continue.
683 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
685 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
687 ;; `ebnf-optimize' Non-nil means optimize syntactic chart
690 ;; To set the above options you may:
692 ;; a) insert the code in your ~/.emacs, like:
694 ;; (setq ebnf-terminal-shape 'bevel)
696 ;; This way always keep your default settings when you enter a new Emacs
699 ;; b) or use `set-variable' in your Emacs session, like:
701 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
703 ;; This way keep your settings only during the current Emacs session.
705 ;; c) or use customization, for example:
706 ;; click on menu-bar *Help* option,
707 ;; then click on *Customize*,
708 ;; then click on *Browse Customization Groups*,
709 ;; expand *PostScript* group,
710 ;; expand *Ebnf2ps* group
711 ;; and then customize ebnf2ps options.
712 ;; Through this way, you may choose if the settings are kept or not when
713 ;; you leave out the current Emacs session.
715 ;; d) or see the option value:
717 ;; C-h v ebnf-terminal-shape RET
719 ;; and click the *customize* hypertext button.
720 ;; Through this way, you may choose if the settings are kept or not when
721 ;; you leave out the current Emacs session.
725 ;; M-x ebnf-customize RET
727 ;; and then customize ebnf2ps options.
728 ;; Through this way, you may choose if the settings are kept or not when
729 ;; you leave out the current Emacs session.
735 ;; Sometimes you need to change the EBNF style you are using, for example,
736 ;; change the shapes and colors. These changes may force you to set some
737 ;; variables and after use, set back the variables to the old values.
739 ;; To help to handle this situation, ebnf2ps has the following commands to
742 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
745 ;; `ebnf-delete-style' Delete style NAME.
747 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
749 ;; `ebnf-apply-style' Set STYLE as the current style.
751 ;; `ebnf-reset-style' Reset current style.
753 ;; `ebnf-push-style' Push the current style and set STYLE as the current
756 ;; `ebnf-pop-style' Pop a style and set it as the current style.
758 ;; These commands help to put together a lot of variable settings in a group
759 ;; and name this group. So when you wish to apply these settings it's only
760 ;; needed to give the name.
762 ;; There is also a notion of simple inheritance of style; so, if you declare
763 ;; that a style A inherits from a style B, all settings of B is applied first
764 ;; and then the settings of A is applied. This is useful when you wish to
765 ;; modify some aspects of an existing style, but at same time wish to keep it
768 ;; See documentation for `ebnf-style-database'.
774 ;; Below it is the layout of minimum area to draw each element, and it's used
775 ;; the following terms:
777 ;; font height is given by:
778 ;; (terminal font height + non-terminal font height) / 2
780 ;; entry is the vertical position used to know where it should
781 ;; be drawn the flow line in the current element.
784 ;; * SPECIAL, TERMINAL and NON-TERMINAL
786 ;; +==============+...................................
787 ;; | | } font height / 2 } entry }
788 ;; | XXXXXXXX...|....... } }
789 ;; ====+ XXXXXXXX +==== } text height ...... } height
790 ;; : | XXXXXXXX...|...:... }
791 ;; : | : : | : } font height / 2 }
792 ;; : +==============+...:...............................
794 ;; : : : : : :......................
795 ;; : : : : : } font height }
796 ;; : : : : :....... }
797 ;; : : : : } font height / 2 }
798 ;; : : : :........... }
799 ;; : : : } text width } width
800 ;; : : :.................. }
801 ;; : : } font height / 2 }
802 ;; : :...................... }
804 ;; :.............................................
809 ;; +==========+.....................................
813 ;; ===+===+ +===+===... } element height } height
816 ;; : | +==========+.|................. }
817 ;; : | : : | : } font height }
818 ;; : +==============+...................................
820 ;; : : : :......................
821 ;; : : : } font height * 2 }
823 ;; : : } element width } width
824 ;; : :..................... }
825 ;; : } font height * 2 }
826 ;; :...............................................
831 ;; +===+...................................
832 ;; +==+ A +==+ } A height } }
833 ;; | +===+..|........ } entry }
834 ;; + + } font height } }
835 ;; / +===+...\....... } }
836 ;; ===+====+ B +====+=== } B height ..... } height
837 ;; : \ +===+.../....... }
838 ;; : + + : } font height }
839 ;; : | +===+..|........ }
840 ;; : +==+ C +==+ : } C height }
841 ;; : : +===+...................................
843 ;; : : : :......................
844 ;; : : : } font height * 2 }
846 ;; : : } max width } width
847 ;; : :................. }
848 ;; : } font height * 2 }
849 ;; :..........................................
852 ;; 1. An empty alternative has zero of height.
854 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
860 ;; +===========+...............................
861 ;; +=+ separator +=+ } separator height }
862 ;; / +===========+..\........ }
864 ;; | | } font height }
866 ;; \ +===========+../........ } height = entry
867 ;; +=+ element +=+ } element height }
868 ;; /: +===========+..\........ }
870 ;; + : : + } font height }
872 ;; ==+=======================+==.......................
874 ;; : : : :.......................
875 ;; : : : } font height * 2 }
877 ;; : : } max width } width
878 ;; : :......................... }
879 ;; : } font height * 2 }
880 ;; :...................................................
885 ;; +===========+......................................
886 ;; +=+ separator +=+ } separator height } }
887 ;; / +===========+..\...... } }
889 ;; | | } font height } } height
891 ;; \ +===========+../...... } }
892 ;; ===+=+ element +=+=== } element height .... }
893 ;; : : +===========+......................................
895 ;; : : : :........................
896 ;; : : : } font height * 2 }
898 ;; : : } max width } width
899 ;; : :....................... }
900 ;; : } font height * 2 }
901 ;; :..............................................
906 ;; XXXXXX:......................................
907 ;; XXXXXX: } production font height }
908 ;; XXXXXX:............ }
910 ;; +======+....... } height = entry
912 ;; ====+ +==== } element height }
914 ;; : +======+.................................
916 ;; : : : :......................
917 ;; : : : } font height * 2 }
919 ;; : : } element width } width
920 ;; : :.............. }
921 ;; : } font height * 2 }
922 ;; :.....................................
927 ;; +================+...................................
928 ;; | | } font height / 2 } entry }
929 ;; | +===+...|....... } }
930 ;; ====+ N * | X | +==== } X height ......... } height
931 ;; : | : : +===+...|...:... }
932 ;; : | : : : : | : } font height / 2 }
933 ;; : +================+...:...............................
935 ;; : : : : : : : :......................
936 ;; : : : : : : : } font height }
937 ;; : : : : : : :....... }
938 ;; : : : : : : } font height / 2 }
939 ;; : : : : : :........... }
940 ;; : : : : : } X width }
941 ;; : : : : :............... }
942 ;; : : : : } font height / 2 } width
943 ;; : : : :.................. }
944 ;; : : : } text width }
945 ;; : : :..................... }
946 ;; : : } font height / 2 }
947 ;; : :........................ }
949 ;; :...............................................
954 ;; +==================+...................................
955 ;; | | } font height / 2 } entry }
956 ;; | +===+ +===+...|....... } }
957 ;; ====+ | X | - | y | +==== } max height ....... } height
958 ;; : | +===+ +===+...|...:... }
959 ;; : | : : : : | : } font height / 2 }
960 ;; : +==================+...:...............................
962 ;; : : : : : : : :......................
963 ;; : : : : : : : } font height }
964 ;; : : : : : : :....... }
965 ;; : : : : : : } font height / 2 }
966 ;; : : : : : :........... }
967 ;; : : : : : } Y width }
968 ;; : : : : :............... }
969 ;; : : : : } font height } width
970 ;; : : : :................... }
972 ;; : : :....................... }
973 ;; : : } font height / 2 }
974 ;; : :.......................... }
976 ;; :.................................................
978 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
981 ;; Internal Structures
982 ;; -------------------
984 ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis
985 ;; of current buffer and generates an intermediate representation. The second
986 ;; pass uses the intermediate representation to generate the PostScript
989 ;; The intermediate representation is a list of vectors, the vector element
990 ;; represents a syntactic chart element. Below is a vector representation for
991 ;; each syntactic chart element.
993 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
994 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
995 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
996 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
997 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
998 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
999 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
1000 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
1001 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1002 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1003 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
1004 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
1006 ;; The first vector position is a function symbol used to generate PostScript
1007 ;; for this element.
1008 ;; WIDTH-FUN is a function symbol called to adjust the element width.
1009 ;; DIM-FUN is a function symbol called to set the element dimensions.
1010 ;; ENTRY is the element entry point.
1011 ;; HEIGHT and WIDTH are the element height and width, respectively.
1012 ;; NAME is a string that it's the element name.
1013 ;; DEFAULT is a boolean that indicates if it's a `default' element.
1014 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
1016 ;; LIST is a list of vector that represents the list part for alternatives and
1018 ;; SEPARATOR is a vector that represents the sub-element used to separate the
1020 ;; TIMES is a string representing the number of times that ELEMENT is repeated
1021 ;; on a repeat construction.
1022 ;; ACTION indicates some action that should be done before production is
1023 ;; generated. The current actions are:
1027 ;; form-feed current production starts on a new page.
1029 ;; newline current production starts on next line, this is useful
1030 ;; when `ebnf-horizontal-orientation' is non-nil.
1032 ;; keep-line current production continues on the current line, this
1033 ;; is useful when `ebnf-horizontal-orientation' is nil.
1039 ;; . Handle situations when syntactic chart is out of paper.
1040 ;; . Use other alphabet than ascii.
1041 ;; . Optimizations...
1047 ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
1048 ;; - `ebnf-production-name-p', `ebnf-stop-on-error',
1049 ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
1050 ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
1054 ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
1055 ;; with some Bison features (%right, %left and %prec pragmas). His suggestion
1056 ;; was extended to deal with %nonassoc pragma too.
1058 ;; Thanks to all who emailed comments.
1061 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1068 (and (string< ps-print-version
"5.2.3")
1069 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1072 ;; to avoid gripes with Emacs 20
1074 (or (fboundp 'assq-delete-all
)
1075 (defun assq-delete-all (key alist
)
1076 "Delete from ALIST all elements whose car is KEY.
1077 Return the modified alist.
1078 Elements of ALIST that are not conses are ignored."
1081 (if (and (consp (car tail
))
1082 (eq (car (car tail
)) key
))
1083 (setq alist
(delq (car tail
) alist
)))
1084 (setq tail
(cdr tail
)))
1088 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1092 ;;; Interface to the command system
1094 (defgroup postscript nil
1100 (defgroup ebnf2ps nil
1101 "Translate an EBNF to a syntactic chart on PostScript"
1107 (defgroup ebnf-special nil
1108 "Special customization"
1114 (defgroup ebnf-except nil
1115 "Except customization"
1121 (defgroup ebnf-repeat nil
1122 "Repeat customization"
1128 (defgroup ebnf-terminal nil
1129 "Terminal customization"
1135 (defgroup ebnf-non-terminal nil
1136 "Non-Terminal customization"
1142 (defgroup ebnf-production nil
1143 "Production customization"
1149 (defgroup ebnf-shape nil
1150 "Shapes customization"
1156 (defgroup ebnf-displacement nil
1157 "Displacement customization"
1163 (defgroup ebnf-syntactic nil
1164 "Syntactic customization"
1170 (defgroup ebnf-optimization nil
1171 "Optimization customization"
1177 (defcustom ebnf-horizontal-orientation nil
1178 "*Non-nil means productions are drawn horizontally."
1180 :group
'ebnf-displacement
)
1183 (defcustom ebnf-horizontal-max-height nil
1184 "*Non-nil means to use maximum production height in horizontal orientation.
1186 It is only used when `ebnf-horizontal-orientation' is non-nil."
1188 :group
'ebnf-displacement
)
1191 (defcustom ebnf-production-horizontal-space
0.0 ; use ebnf2ps default value
1192 "*Specify horizontal space in points between productions.
1194 Value less or equal to zero forces ebnf2ps to set a proper default value."
1196 :group
'ebnf-displacement
)
1199 (defcustom ebnf-production-vertical-space
0.0 ; use ebnf2ps default value
1200 "*Specify vertical space in points between productions.
1202 Value less or equal to zero forces ebnf2ps to set a proper default value."
1204 :group
'ebnf-displacement
)
1207 (defcustom ebnf-justify-sequence
'center
1208 "*Specify justification of terms in a sequence inside alternatives.
1212 `left' left justification
1213 `right' right justification
1214 any other value centralize"
1215 :type
'(radio :tag
"Sequence Justification"
1216 (const left
) (const right
) (other :tag
"center" center
))
1217 :group
'ebnf-displacement
)
1220 (defcustom ebnf-special-show-delimiter t
1221 "*Non-nil means special delimiter (character `?') is shown."
1223 :group
'ebnf-special
)
1226 (defcustom ebnf-special-font
'(7 Courier
"Black" "Gray95" bold italic
)
1227 "*Specify special font.
1229 See documentation for `ebnf-production-font'."
1230 :type
'(list :tag
"Special Font"
1231 (number :tag
"Font Size")
1232 (symbol :tag
"Font Name")
1233 (choice :tag
"Foreground Color"
1234 (string :tag
"Name")
1235 (other :tag
"Default" nil
))
1236 (choice :tag
"Background Color"
1237 (string :tag
"Name")
1238 (other :tag
"Default" nil
))
1239 (repeat :tag
"Font Attributes" :inline t
1240 (choice (const bold
) (const italic
)
1241 (const underline
) (const strikeout
)
1242 (const overline
) (const shadow
)
1243 (const box
) (const outline
))))
1244 :group
'ebnf-special
)
1247 (defcustom ebnf-special-shape
'bevel
1248 "*Specify special box shape.
1250 See documentation for `ebnf-non-terminal-shape'."
1251 :type
'(radio :tag
"Special Shape"
1252 (const miter
) (const round
) (const bevel
))
1253 :group
'ebnf-special
)
1256 (defcustom ebnf-special-shadow nil
1257 "*Non-nil means special box will have a shadow."
1259 :group
'ebnf-special
)
1262 (defcustom ebnf-special-border-width
0.5
1263 "*Specify border width for special box."
1265 :group
'ebnf-special
)
1268 (defcustom ebnf-special-border-color
"Black"
1269 "*Specify border color for special box."
1271 :group
'ebnf-special
)
1274 (defcustom ebnf-except-font
'(7 Courier
"Black" "Gray90" bold italic
)
1275 "*Specify except font.
1277 See documentation for `ebnf-production-font'."
1278 :type
'(list :tag
"Except Font"
1279 (number :tag
"Font Size")
1280 (symbol :tag
"Font Name")
1281 (choice :tag
"Foreground Color"
1282 (string :tag
"Name")
1283 (other :tag
"Default" nil
))
1284 (choice :tag
"Background Color"
1285 (string :tag
"Name")
1286 (other :tag
"Default" nil
))
1287 (repeat :tag
"Font Attributes" :inline t
1288 (choice (const bold
) (const italic
)
1289 (const underline
) (const strikeout
)
1290 (const overline
) (const shadow
)
1291 (const box
) (const outline
))))
1292 :group
'ebnf-except
)
1295 (defcustom ebnf-except-shape
'bevel
1296 "*Specify except box shape.
1298 See documentation for `ebnf-non-terminal-shape'."
1299 :type
'(radio :tag
"Except Shape"
1300 (const miter
) (const round
) (const bevel
))
1301 :group
'ebnf-except
)
1304 (defcustom ebnf-except-shadow nil
1305 "*Non-nil means except box will have a shadow."
1307 :group
'ebnf-except
)
1310 (defcustom ebnf-except-border-width
0.25
1311 "*Specify border width for except box."
1313 :group
'ebnf-except
)
1316 (defcustom ebnf-except-border-color
"Black"
1317 "*Specify border color for except box."
1319 :group
'ebnf-except
)
1322 (defcustom ebnf-repeat-font
'(7 Courier
"Black" "Gray85" bold italic
)
1323 "*Specify repeat font.
1325 See documentation for `ebnf-production-font'."
1326 :type
'(list :tag
"Repeat Font"
1327 (number :tag
"Font Size")
1328 (symbol :tag
"Font Name")
1329 (choice :tag
"Foreground Color"
1330 (string :tag
"Name")
1331 (other :tag
"Default" nil
))
1332 (choice :tag
"Background Color"
1333 (string :tag
"Name")
1334 (other :tag
"Default" nil
))
1335 (repeat :tag
"Font Attributes" :inline t
1336 (choice (const bold
) (const italic
)
1337 (const underline
) (const strikeout
)
1338 (const overline
) (const shadow
)
1339 (const box
) (const outline
))))
1340 :group
'ebnf-repeat
)
1343 (defcustom ebnf-repeat-shape
'bevel
1344 "*Specify repeat box shape.
1346 See documentation for `ebnf-non-terminal-shape'."
1347 :type
'(radio :tag
"Repeat Shape"
1348 (const miter
) (const round
) (const bevel
))
1349 :group
'ebnf-repeat
)
1352 (defcustom ebnf-repeat-shadow nil
1353 "*Non-nil means repeat box will have a shadow."
1355 :group
'ebnf-repeat
)
1358 (defcustom ebnf-repeat-border-width
0.0
1359 "*Specify border width for repeat box."
1361 :group
'ebnf-repeat
)
1364 (defcustom ebnf-repeat-border-color
"Black"
1365 "*Specify border color for repeat box."
1367 :group
'ebnf-repeat
)
1370 (defcustom ebnf-terminal-font
'(7 Courier
"Black" "White")
1371 "*Specify terminal font.
1373 See documentation for `ebnf-production-font'."
1374 :type
'(list :tag
"Terminal Font"
1375 (number :tag
"Font Size")
1376 (symbol :tag
"Font Name")
1377 (choice :tag
"Foreground Color"
1378 (string :tag
"Name")
1379 (other :tag
"Default" nil
))
1380 (choice :tag
"Background Color"
1381 (string :tag
"Name")
1382 (other :tag
"Default" nil
))
1383 (repeat :tag
"Font Attributes" :inline t
1384 (choice (const bold
) (const italic
)
1385 (const underline
) (const strikeout
)
1386 (const overline
) (const shadow
)
1387 (const box
) (const outline
))))
1388 :group
'ebnf-terminal
)
1391 (defcustom ebnf-terminal-shape
'miter
1392 "*Specify terminal box shape.
1394 See documentation for `ebnf-non-terminal-shape'."
1395 :type
'(radio :tag
"Terminal Shape"
1396 (const miter
) (const round
) (const bevel
))
1397 :group
'ebnf-terminal
)
1400 (defcustom ebnf-terminal-shadow nil
1401 "*Non-nil means terminal box will have a shadow."
1403 :group
'ebnf-terminal
)
1406 (defcustom ebnf-terminal-border-width
1.0
1407 "*Specify border width for terminal box."
1409 :group
'ebnf-terminal
)
1412 (defcustom ebnf-terminal-border-color
"Black"
1413 "*Specify border color for terminal box."
1415 :group
'ebnf-terminal
)
1418 (defcustom ebnf-production-name-p t
1419 "*Non-nil means production name will be printed."
1421 :group
'ebnf-production
)
1424 (defcustom ebnf-sort-production nil
1425 "*Specify how productions are sorted.
1429 nil don't sort productions.
1430 `ascending' ascending sort.
1431 any other value descending sort."
1432 :type
'(radio :tag
"Production Sort"
1433 (const :tag
"Ascending" ascending
)
1434 (const :tag
"Descending" descending
)
1435 (other :tag
"No Sort" nil
))
1436 :group
'ebnf-production
)
1439 (defcustom ebnf-production-font
'(10 Helvetica
"Black" "White" bold
)
1440 "*Specify production header font.
1442 It is a list with the following form:
1444 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1447 SIZE is the font size.
1448 NAME is the font name symbol.
1449 ATTRIBUTE is one of the following symbols:
1450 bold - use bold font.
1451 italic - use italic font.
1452 underline - put a line under text.
1453 strikeout - like underline, but the line is in middle of text.
1454 overline - like underline, but the line is over the text.
1455 shadow - text will have a shadow.
1456 box - text will be surrounded by a box.
1457 outline - print characters as hollow outlines.
1458 FOREGROUND is a foreground string color name; if it's nil, the default color is
1460 BACKGROUND is a background string color name; if it's nil, the default color is
1463 See `ps-font-info-database' for valid font name."
1464 :type
'(list :tag
"Production Font"
1465 (number :tag
"Font Size")
1466 (symbol :tag
"Font Name")
1467 (choice :tag
"Foreground Color"
1468 (string :tag
"Name")
1469 (other :tag
"Default" nil
))
1470 (choice :tag
"Background Color"
1471 (string :tag
"Name")
1472 (other :tag
"Default" nil
))
1473 (repeat :tag
"Font Attributes" :inline t
1474 (choice (const bold
) (const italic
)
1475 (const underline
) (const strikeout
)
1476 (const overline
) (const shadow
)
1477 (const box
) (const outline
))))
1478 :group
'ebnf-production
)
1481 (defcustom ebnf-non-terminal-font
'(7 Helvetica
"Black" "White")
1482 "*Specify non-terminal font.
1484 See documentation for `ebnf-production-font'."
1485 :type
'(list :tag
"Non-Terminal Font"
1486 (number :tag
"Font Size")
1487 (symbol :tag
"Font Name")
1488 (choice :tag
"Foreground Color"
1489 (string :tag
"Name")
1490 (other :tag
"Default" nil
))
1491 (choice :tag
"Background Color"
1492 (string :tag
"Name")
1493 (other :tag
"Default" nil
))
1494 (repeat :tag
"Font Attributes" :inline t
1495 (choice (const bold
) (const italic
)
1496 (const underline
) (const strikeout
)
1497 (const overline
) (const shadow
)
1498 (const box
) (const outline
))))
1499 :group
'ebnf-non-terminal
)
1502 (defcustom ebnf-non-terminal-shape
'round
1503 "*Specify non-terminal box shape.
1519 Any other value is treated as `miter'."
1520 :type
'(radio :tag
"Non-Terminal Shape"
1521 (const miter
) (const round
) (const bevel
))
1522 :group
'ebnf-non-terminal
)
1525 (defcustom ebnf-non-terminal-shadow nil
1526 "*Non-nil means non-terminal box will have a shadow."
1528 :group
'ebnf-non-terminal
)
1531 (defcustom ebnf-non-terminal-border-width
1.0
1532 "*Specify border width for non-terminal box."
1534 :group
'ebnf-non-terminal
)
1537 (defcustom ebnf-non-terminal-border-color
"Black"
1538 "*Specify border color for non-terminal box."
1540 :group
'ebnf-non-terminal
)
1543 (defcustom ebnf-arrow-shape
'hollow
1544 "*Specify the arrow shape.
1550 `semi-up' * `transparent' *
1558 `semi-down' =====* `hollow' *
1574 `semi-up-hollow' `semi-up-full'
1580 `semi-down-hollow' `semi-down-full'
1586 `user' See also documentation for variable `ebnf-user-arrow'.
1588 Any other value is treated as `none'."
1589 :type
'(radio :tag
"Arrow Shape"
1590 (const none
) (const semi-up
)
1591 (const semi-down
) (const simple
)
1592 (const transparent
) (const hollow
)
1593 (const full
) (const semi-up-hollow
)
1594 (const semi-down-hollow
) (const semi-up-full
)
1595 (const semi-down-full
) (const user
))
1599 (defcustom ebnf-chart-shape
'round
1600 "*Specify chart flow shape.
1602 See documentation for `ebnf-non-terminal-shape'."
1603 :type
'(radio :tag
"Chart Flow Shape"
1604 (const miter
) (const round
) (const bevel
))
1608 (defcustom ebnf-user-arrow nil
1609 "*Specify a sexp for user arrow shape (a PostScript code).
1611 When evaluated, the sexp should return nil or a string containing PostScript
1612 code. PostScript code should draw a right arrow.
1614 The anatomy of a right arrow is:
1616 ...... Initial position
1618 : *.................
1622 ======+======*... } hT2
1626 : *.................
1632 :.......................
1634 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1635 be used to generate your own arrow. As these variables are used along
1636 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1637 values, if you need to modify them.
1639 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1641 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1643 :type
'(sexp :tag
"User Arrow Shape")
1647 (defcustom ebnf-syntax
'ebnf
1648 "*Specify syntax to be recognized.
1652 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1654 The following variables *ONLY* have effect with this
1656 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1657 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1659 `abnf' ebnf2ps recognizes the syntax described in the URL:
1660 `http://www.ietf.org/rfc/rfc2234.txt'
1661 (\"Augmented BNF for Syntax Specifications: ABNF\").
1663 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1664 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1665 (\"International Standard of the ISO EBNF Notation\").
1666 The following variables *ONLY* have effect with this
1668 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1670 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1671 The following variable *ONLY* has effect with this
1673 `ebnf-yac-ignore-error-recovery'.
1675 Any other value is treated as `ebnf'."
1676 :type
'(radio :tag
"Syntax"
1677 (const ebnf
) (const abnf
) (const iso-ebnf
) (const yacc
))
1678 :group
'ebnf-syntactic
)
1681 (defcustom ebnf-lex-comment-char ?\
;
1682 "*Specify the line comment character.
1684 It's used only when `ebnf-syntax' is `ebnf'."
1686 :group
'ebnf-syntactic
)
1689 (defcustom ebnf-lex-eop-char ?.
1690 "*Specify the end of production character.
1692 It's used only when `ebnf-syntax' is `ebnf'."
1694 :group
'ebnf-syntactic
)
1697 (defcustom ebnf-terminal-regexp nil
1698 "*Specify how it's a terminal name.
1700 If it's nil, the terminal name must be enclosed by `\"'.
1701 If it's a string, it should be a regexp that it'll be used to determine a
1702 terminal name; terminal name may also be enclosed by `\"'.
1704 It's used only when `ebnf-syntax' is `ebnf'."
1705 :type
'(radio :tag
"Terminal Name"
1707 :group
'ebnf-syntactic
)
1710 (defcustom ebnf-case-fold-search nil
1711 "*Non-nil means ignore case on matching.
1713 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1716 :group
'ebnf-syntactic
)
1719 (defcustom ebnf-iso-alternative-p nil
1720 "*Non-nil means use alternative ISO EBNF.
1722 It's only used when `ebnf-syntax' is `iso-ebnf'.
1724 This variable affects the following symbol set:
1726 STANDARD ALTERNATIVE
1734 :group
'ebnf-syntactic
)
1737 (defcustom ebnf-iso-normalize-p nil
1738 "*Non-nil means normalize ISO EBNF syntax names.
1740 Normalize a name means that several contiguous spaces inside name become a
1741 single space, so \"A B C\" is normalized to \"A B C\".
1743 It's only used when `ebnf-syntax' is `iso-ebnf'."
1745 :group
'ebnf-syntactic
)
1748 (defcustom ebnf-file-suffix-regexp
"\.[Bb][Nn][Ff]$"
1749 "*Specify file name suffix that contains EBNF.
1751 See `ebnf-eps-directory' command."
1756 (defcustom ebnf-eps-prefix
"ebnf--"
1757 "*Specify EPS prefix file name.
1759 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1764 (defcustom ebnf-entry-percentage
0.5 ; middle
1765 "*Specify entry height on alternatives.
1767 It must be a float between 0.0 (top) and 1.0 (bottom)."
1772 (defcustom ebnf-default-width
0.6
1773 "*Specify additional border width over default terminal, non-terminal or
1779 ;; Printing color requires x-color-values.
1780 (defcustom ebnf-color-p
(or (fboundp 'x-color-values
) ; Emacs
1781 (fboundp 'color-instance-rgb-components
)) ; XEmacs
1782 "*Non-nil means use color."
1787 (defcustom ebnf-line-width
1.0
1788 "*Specify flow line width."
1793 (defcustom ebnf-line-color
"Black"
1794 "*Specify flow line color."
1799 (defcustom ebnf-debug-ps nil
1800 "*Non-nil means to generate PostScript debug procedures.
1802 It is intended to help PostScript programmers in debugging."
1807 (defcustom ebnf-use-float-format t
1808 "*Non-nil means use `%f' float format.
1810 The advantage of using float format is that ebnf2ps generates a little short
1813 If it occurs the error message:
1815 Invalid format operation %f
1817 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1822 (defcustom ebnf-stop-on-error nil
1823 "*Non-nil means signal error and stop. Nil means signal error and continue."
1828 (defcustom ebnf-yac-ignore-error-recovery nil
1829 "*Non-nil means ignore error recovery.
1831 It's only used when `ebnf-syntax' is `yacc'."
1833 :group
'ebnf-syntactic
)
1836 (defcustom ebnf-ignore-empty-rule nil
1837 "*Non-nil means ignore empty rules.
1839 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1840 middle action rule."
1842 :group
'ebnf-optimization
)
1845 (defcustom ebnf-optimize nil
1846 "*Non-nil means optimize syntactic chart of rules.
1848 The following optimizations are done:
1851 1. A = B | A C. ==> A = B {C}*.
1852 2. A = B | A B. ==> A = {B}+.
1853 3. A = | A B. ==> A = {B}*.
1854 4. A = B | A C B. ==> A = {B || C}+.
1855 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
1858 6. A = B | . ==> A = [B].
1859 7. A = | B . ==> A = [B].
1862 8. A = B C | B D. ==> A = B (C | D).
1863 9. A = C B | D B. ==> A = (C | D) B.
1864 10. A = B C E | B D E. ==> A = B (C | D) E.
1866 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
1868 :group
'ebnf-optimization
)
1871 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1876 (defun ebnf-customize ()
1877 "Customization for ebnf group."
1879 (customize-group 'ebnf2ps
))
1882 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1887 (defun ebnf-print-directory (&optional directory
)
1888 "Generate and print a PostScript syntactic chart image of DIRECTORY.
1890 If DIRECTORY is nil, it's used `default-directory'.
1892 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
1895 See also `ebnf-print-buffer'."
1897 (list (read-file-name "Directory containing EBNF files (print): "
1898 nil default-directory
)))
1899 (ebnf-directory 'ebnf-print-buffer directory
))
1903 (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done
)
1904 "Generate and print a PostScript syntactic chart image of the file FILE.
1906 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
1907 killed after process termination.
1909 See also `ebnf-print-buffer'."
1910 (interactive "fEBNF file to generate PostScript and print from: ")
1911 (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done
))
1915 (defun ebnf-print-buffer (&optional filename
)
1916 "Generate and print a PostScript syntactic chart image of the buffer.
1918 When called with a numeric prefix argument (C-u), prompts the user for
1919 the name of a file to save the PostScript image in, instead of sending
1922 More specifically, the FILENAME argument is treated as follows: if it
1923 is nil, send the image to the printer. If FILENAME is a string, save
1924 the PostScript image in a file with that name. If FILENAME is a
1925 number, prompt the user for the name of the file to save in."
1926 (interactive (list (ps-print-preprint current-prefix-arg
)))
1927 (ebnf-print-region (point-min) (point-max) filename
))
1931 (defun ebnf-print-region (from to
&optional filename
)
1932 "Generate and print a PostScript syntactic chart image of the region.
1933 Like `ebnf-print-buffer', but prints just the current region."
1934 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
1935 (run-hooks 'ebnf-hook
)
1936 (or (ebnf-spool-region from to
)
1937 (ps-do-despool filename
)))
1941 (defun ebnf-spool-directory (&optional directory
)
1942 "Generate and spool a PostScript syntactic chart image of DIRECTORY.
1944 If DIRECTORY is nil, it's used `default-directory'.
1946 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
1949 See also `ebnf-spool-buffer'."
1951 (list (read-file-name "Directory containing EBNF files (spool): "
1952 nil default-directory
)))
1953 (ebnf-directory 'ebnf-spool-buffer directory
))
1957 (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done
)
1958 "Generate and spool a PostScript syntactic chart image of the file FILE.
1960 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
1961 killed after process termination.
1963 See also `ebnf-spool-buffer'."
1964 (interactive "fEBNF file to generate PostScript and spool from: ")
1965 (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done
))
1969 (defun ebnf-spool-buffer ()
1970 "Generate and spool a PostScript syntactic chart image of the buffer.
1971 Like `ebnf-print-buffer' except that the PostScript image is saved in a
1972 local buffer to be sent to the printer later.
1974 Use the command `ebnf-despool' to send the spooled images to the printer."
1976 (ebnf-spool-region (point-min) (point-max)))
1980 (defun ebnf-spool-region (from to
)
1981 "Generate a PostScript syntactic chart image of the region and spool locally.
1982 Like `ebnf-spool-buffer', but spools just the current region.
1984 Use the command `ebnf-despool' to send the spooled images to the printer."
1986 (ebnf-generate-region from to
'ebnf-generate
))
1990 (defun ebnf-eps-directory (&optional directory
)
1991 "Generate EPS files from EBNF files in DIRECTORY.
1993 If DIRECTORY is nil, it's used `default-directory'.
1995 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
1998 See also `ebnf-eps-buffer'."
2000 (list (read-file-name "Directory containing EBNF files (EPS): "
2001 nil default-directory
)))
2002 (ebnf-directory 'ebnf-eps-buffer directory
))
2006 (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done
)
2007 "Generate an EPS file from EBNF file FILE.
2009 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2010 killed after EPS generation.
2012 See also `ebnf-eps-buffer'."
2013 (interactive "fEBNF file to generate EPS file from: ")
2014 (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done
))
2018 (defun ebnf-eps-buffer ()
2019 "Generate a PostScript syntactic chart image of the buffer in a EPS file.
2021 Indeed, for each production is generated a EPS file.
2022 The EPS file name has the following form:
2024 <PREFIX><PRODUCTION>.eps
2026 <PREFIX> is given by variable `ebnf-eps-prefix'.
2027 The default value is \"ebnf--\".
2029 <PRODUCTION> is the production name.
2030 The production name is mapped to form a valid file name.
2031 For example, the production name \"A/B + C\" is mapped to
2032 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2034 WARNING: It's *NOT* asked any confirmation to override an existing file."
2036 (ebnf-eps-region (point-min) (point-max)))
2040 (defun ebnf-eps-region (from to
)
2041 "Generate a PostScript syntactic chart image of the region in a EPS file.
2043 Indeed, for each production is generated a EPS file.
2044 The EPS file name has the following form:
2046 <PREFIX><PRODUCTION>.eps
2048 <PREFIX> is given by variable `ebnf-eps-prefix'.
2049 The default value is \"ebnf--\".
2051 <PRODUCTION> is the production name.
2052 The production name is mapped to form a valid file name.
2053 For example, the production name \"A/B + C\" is mapped to
2054 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2056 WARNING: It's *NOT* asked any confirmation to override an existing file."
2058 (let ((ebnf-eps-executing t
))
2059 (ebnf-generate-region from to
'ebnf-generate-eps
)))
2063 (defalias 'ebnf-despool
'ps-despool
)
2067 (defun ebnf-syntax-buffer ()
2068 "Does a syntactic analysis of the current buffer."
2070 (ebnf-syntax-region (point-min) (point-max)))
2074 (defun ebnf-syntax-region (from to
)
2075 "Does a syntactic analysis of a region."
2077 (ebnf-generate-region from to nil
))
2080 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2085 (defun ebnf-setup ()
2086 "Return the current ebnf2ps setup."
2089 ;;; ebnf2ps.el version %s
2091 \(setq ebnf-special-show-delimiter %S
2092 ebnf-special-font %s
2093 ebnf-special-shape %s
2094 ebnf-special-shadow %S
2095 ebnf-special-border-width %S
2096 ebnf-special-border-color %S
2098 ebnf-except-shape %s
2099 ebnf-except-shadow %S
2100 ebnf-except-border-width %S
2101 ebnf-except-border-color %S
2103 ebnf-repeat-shape %s
2104 ebnf-repeat-shadow %S
2105 ebnf-repeat-border-width %S
2106 ebnf-repeat-border-color %S
2107 ebnf-terminal-regexp %S
2108 ebnf-case-fold-search %S
2109 ebnf-terminal-font %s
2110 ebnf-terminal-shape %s
2111 ebnf-terminal-shadow %S
2112 ebnf-terminal-border-width %S
2113 ebnf-terminal-border-color %S
2114 ebnf-non-terminal-font %s
2115 ebnf-non-terminal-shape %s
2116 ebnf-non-terminal-shadow %S
2117 ebnf-non-terminal-border-width %S
2118 ebnf-non-terminal-border-color %S
2119 ebnf-production-name-p %S
2120 ebnf-sort-production %s
2121 ebnf-production-font %s
2125 ebnf-horizontal-orientation %S
2126 ebnf-horizontal-max-height %S
2127 ebnf-production-horizontal-space %S
2128 ebnf-production-vertical-space %S
2129 ebnf-justify-sequence %s
2130 ebnf-lex-comment-char ?\\%03o
2131 ebnf-lex-eop-char ?\\%03o
2133 ebnf-iso-alternative-p %S
2134 ebnf-iso-normalize-p %S
2135 ebnf-file-suffix-regexp %S
2137 ebnf-entry-percentage %S
2142 ebnf-use-float-format %S
2143 ebnf-stop-on-error %S
2144 ebnf-yac-ignore-error-recovery %S
2145 ebnf-ignore-empty-rule %S
2148 ;;; ebnf2ps.el - end of settings
2151 ebnf-special-show-delimiter
2152 (ps-print-quote ebnf-special-font
)
2153 (ps-print-quote ebnf-special-shape
)
2155 ebnf-special-border-width
2156 ebnf-special-border-color
2157 (ps-print-quote ebnf-except-font
)
2158 (ps-print-quote ebnf-except-shape
)
2160 ebnf-except-border-width
2161 ebnf-except-border-color
2162 (ps-print-quote ebnf-repeat-font
)
2163 (ps-print-quote ebnf-repeat-shape
)
2165 ebnf-repeat-border-width
2166 ebnf-repeat-border-color
2167 ebnf-terminal-regexp
2168 ebnf-case-fold-search
2169 (ps-print-quote ebnf-terminal-font
)
2170 (ps-print-quote ebnf-terminal-shape
)
2171 ebnf-terminal-shadow
2172 ebnf-terminal-border-width
2173 ebnf-terminal-border-color
2174 (ps-print-quote ebnf-non-terminal-font
)
2175 (ps-print-quote ebnf-non-terminal-shape
)
2176 ebnf-non-terminal-shadow
2177 ebnf-non-terminal-border-width
2178 ebnf-non-terminal-border-color
2179 ebnf-production-name-p
2180 (ps-print-quote ebnf-sort-production
)
2181 (ps-print-quote ebnf-production-font
)
2182 (ps-print-quote ebnf-arrow-shape
)
2183 (ps-print-quote ebnf-chart-shape
)
2184 (ps-print-quote ebnf-user-arrow
)
2185 ebnf-horizontal-orientation
2186 ebnf-horizontal-max-height
2187 ebnf-production-horizontal-space
2188 ebnf-production-vertical-space
2189 (ps-print-quote ebnf-justify-sequence
)
2190 ebnf-lex-comment-char
2192 (ps-print-quote ebnf-syntax
)
2193 ebnf-iso-alternative-p
2194 ebnf-iso-normalize-p
2195 ebnf-file-suffix-regexp
2197 ebnf-entry-percentage
2202 ebnf-use-float-format
2204 ebnf-yac-ignore-error-recovery
2205 ebnf-ignore-empty-rule
2209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2213 (defvar ebnf-stack-style nil
2214 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2218 (defvar ebnf-current-style
'default
2219 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2222 (defconst ebnf-style-custom-list
2223 '(ebnf-special-show-delimiter
2227 ebnf-special-border-width
2228 ebnf-special-border-color
2232 ebnf-except-border-width
2233 ebnf-except-border-color
2237 ebnf-repeat-border-width
2238 ebnf-repeat-border-color
2239 ebnf-terminal-regexp
2240 ebnf-case-fold-search
2243 ebnf-terminal-shadow
2244 ebnf-terminal-border-width
2245 ebnf-terminal-border-color
2246 ebnf-non-terminal-font
2247 ebnf-non-terminal-shape
2248 ebnf-non-terminal-shadow
2249 ebnf-non-terminal-border-width
2250 ebnf-non-terminal-border-color
2251 ebnf-production-name-p
2252 ebnf-sort-production
2253 ebnf-production-font
2257 ebnf-horizontal-orientation
2258 ebnf-horizontal-max-height
2259 ebnf-production-horizontal-space
2260 ebnf-production-vertical-space
2261 ebnf-justify-sequence
2262 ebnf-lex-comment-char
2265 ebnf-iso-alternative-p
2266 ebnf-iso-normalize-p
2267 ebnf-file-suffix-regexp
2269 ebnf-entry-percentage
2274 ebnf-use-float-format
2276 ebnf-yac-ignore-error-recovery
2277 ebnf-ignore-empty-rule
2279 "List of valid symbol custom variable.")
2282 (defvar ebnf-style-database
2286 (ebnf-special-show-delimiter . t
)
2287 (ebnf-special-font .
'(7 Courier
"Black" "Gray95" bold italic
))
2288 (ebnf-special-shape .
'bevel
)
2289 (ebnf-special-shadow . nil
)
2290 (ebnf-special-border-width .
0.5)
2291 (ebnf-special-border-color .
"Black")
2292 (ebnf-except-font .
'(7 Courier
"Black" "Gray90" bold italic
))
2293 (ebnf-except-shape .
'bevel
)
2294 (ebnf-except-shadow . nil
)
2295 (ebnf-except-border-width .
0.25)
2296 (ebnf-except-border-color .
"Black")
2297 (ebnf-repeat-font .
'(7 Courier
"Black" "Gray85" bold italic
))
2298 (ebnf-repeat-shape .
'bevel
)
2299 (ebnf-repeat-shadow . nil
)
2300 (ebnf-repeat-border-width .
0.0)
2301 (ebnf-repeat-border-color .
"Black")
2302 (ebnf-terminal-regexp . nil
)
2303 (ebnf-case-fold-search . nil
)
2304 (ebnf-terminal-font .
'(7 Courier
"Black" "White"))
2305 (ebnf-terminal-shape .
'miter
)
2306 (ebnf-terminal-shadow . nil
)
2307 (ebnf-terminal-border-width .
1.0)
2308 (ebnf-terminal-border-color .
"Black")
2309 (ebnf-non-terminal-font .
'(7 Helvetica
"Black" "White"))
2310 (ebnf-non-terminal-shape .
'round
)
2311 (ebnf-non-terminal-shadow . nil
)
2312 (ebnf-non-terminal-border-width .
1.0)
2313 (ebnf-non-terminal-border-color .
"Black")
2314 (ebnf-production-name-p . t
)
2315 (ebnf-sort-production . nil
)
2316 (ebnf-production-font .
'(10 Helvetica
"Black" "White" bold
))
2317 (ebnf-arrow-shape .
'hollow
)
2318 (ebnf-chart-shape .
'round
)
2319 (ebnf-user-arrow . nil
)
2320 (ebnf-horizontal-orientation . nil
)
2321 (ebnf-horizontal-max-height . nil
)
2322 (ebnf-production-horizontal-space .
0.0)
2323 (ebnf-production-vertical-space .
0.0)
2324 (ebnf-justify-sequence .
'center
)
2325 (ebnf-lex-comment-char . ?\
;)
2326 (ebnf-lex-eop-char . ?.
)
2327 (ebnf-syntax .
'ebnf
)
2328 (ebnf-iso-alternative-p . nil
)
2329 (ebnf-iso-normalize-p . nil
)
2330 (ebnf-file-suffix-regexp .
"\.[Bb][Nn][Ff]$")
2331 (ebnf-eps-prefix .
"ebnf--")
2332 (ebnf-entry-percentage .
0.5)
2333 (ebnf-color-p .
(or (fboundp 'x-color-values
) ; Emacs
2334 (fboundp 'color-instance-rgb-components
))) ; XEmacs
2335 (ebnf-line-width .
1.0)
2336 (ebnf-line-color .
"Black")
2337 (ebnf-debug-ps . nil
)
2338 (ebnf-use-float-format . t
)
2339 (ebnf-stop-on-error . nil
)
2340 (ebnf-yac-ignore-error-recovery . nil
)
2341 (ebnf-ignore-empty-rule . nil
)
2342 (ebnf-optimize . nil
))
2343 ;; Happy EBNF default
2346 (ebnf-justify-sequence .
'left
)
2347 (ebnf-lex-comment-char . ?\
#)
2348 (ebnf-lex-eop-char . ?\
;))
2352 (ebnf-syntax .
'abnf
))
2356 (ebnf-syntax .
'iso-ebnf
))
2357 ;; Yacc/Bison default
2360 (ebnf-syntax .
'yacc
))
2364 Each element has the following form:
2366 (NAME INHERITS (VAR . VALUE)...)
2370 NAME is a symbol name style.
2372 INHERITS is a symbol name style from which the current style inherits
2373 the context. If INHERITS is nil, means that there is no
2376 This is a simple inheritance of style; so if you declare that a
2377 style A inherits from a style B, all settings of B is applied
2378 first and then the settings of A is applied. This is useful
2379 when you wish to modify some aspects of an existing style, but
2380 at same time wish to keep it unmodified.
2382 VAR is a valid ebnf2ps symbol custom variable.
2383 See `ebnf-style-custom-list' for valid symbol variable.
2385 VALUE is a sexp which it'll be evaluated to set the value to VAR.
2386 So, don't forget to quote symbols and constant lists.
2387 See `default' style for an example.
2389 Don't handle this variable directly. Use functions `ebnf-insert-style',
2390 `ebnf-delete-style' and `ebnf-merge-style'.")
2393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2398 (defun ebnf-insert-style (name inherits
&rest values
)
2399 "Insert a new style NAME with inheritance INHERITS and values VALUES.
2401 See `ebnf-style-database' documentation."
2402 (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
2403 (and (assoc name ebnf-style-database
)
2404 (error "Style name already exists: %s" name
))
2405 (or (assoc inherits ebnf-style-database
)
2406 (error "Style inheritance name does'nt exist: %s" inherits
))
2407 (setq ebnf-style-database
2408 (cons (cons name
(cons inherits
(ebnf-check-style-values values
)))
2409 ebnf-style-database
)))
2413 (defun ebnf-delete-style (name)
2416 See `ebnf-style-database' documentation."
2417 (interactive "SDelete style name: ")
2418 (or (assoc name ebnf-style-database
)
2419 (error "Style name doesn't exist: %s" name
))
2420 (let ((db ebnf-style-database
))
2422 (and (eq (nth 1 (car db
)) name
)
2423 (error "Style name `%s' is inherited by `%s' style"
2424 name
(nth 0 (car db
))))
2425 (setq db
(cdr db
))))
2426 (setq ebnf-style-database
(assq-delete-all name ebnf-style-database
)))
2430 (defun ebnf-merge-style (name &rest values
)
2431 "Merge values of style NAME with style VALUES.
2433 See `ebnf-style-database' documentation."
2434 (interactive "SStyle name: \nXStyle values: ")
2435 (let ((style (or (assoc name ebnf-style-database
)
2436 (error "Style name does'nt exist: %s" name
)))
2437 (merge (ebnf-check-style-values values
))
2439 ;; modify value of existing variables
2440 (setq val
(nthcdr 2 style
))
2442 (setq check
(car merge
)
2444 elt
(assoc (car check
) val
))
2446 (setcdr elt
(cdr check
))
2447 (setq new
(cons check new
))))
2448 ;; insert new variables
2449 (nconc style
(nreverse new
))))
2453 (defun ebnf-apply-style (style)
2454 "Set STYLE as the current style.
2456 It returns the old style symbol.
2458 See `ebnf-style-database' documentation."
2459 (interactive "SApply style: ")
2462 (and (ebnf-apply-style1 style
)
2463 (setq ebnf-current-style style
))))
2467 (defun ebnf-reset-style (&optional style
)
2468 "Reset current style.
2470 It returns the old style symbol.
2472 See `ebnf-style-database' documentation."
2473 (interactive "SReset style: ")
2474 (setq ebnf-stack-style nil
)
2475 (ebnf-apply-style (or style
'default
)))
2479 (defun ebnf-push-style (&optional style
)
2480 "Push the current style and set STYLE as the current style.
2482 It returns the old style symbol.
2484 See `ebnf-style-database' documentation."
2485 (interactive "SPush style: ")
2488 (setq ebnf-stack-style
(cons ebnf-current-style ebnf-stack-style
))
2490 (ebnf-apply-style style
))))
2494 (defun ebnf-pop-style ()
2495 "Pop a style and set it as the current style.
2497 It returns the old style symbol.
2499 See `ebnf-style-database' documentation."
2502 (ebnf-apply-style (car ebnf-stack-style
))
2503 (setq ebnf-stack-style
(cdr ebnf-stack-style
))))
2506 (defun ebnf-apply-style1 (style)
2507 (let ((value (cdr (assoc style ebnf-style-database
))))
2510 (and (car value
) (ebnf-apply-style1 (car value
)))
2511 (while (setq value
(cdr value
))
2512 (set (caar value
) (eval (cdar value
)))))))
2515 (defun ebnf-check-style-values (values)
2518 (and (memq (caar values
) ebnf-style-custom-list
)
2519 (setq style
(cons (car values
) style
)))
2520 (setq values
(cdr values
)))
2524 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2525 ;; Internal variables
2528 (defvar ebnf-eps-buffer-name
" *EPS*")
2529 (defvar ebnf-parser-func nil
)
2530 (defvar ebnf-eps-executing nil
)
2531 (defvar ebnf-eps-upper-x
0.0)
2532 (make-variable-buffer-local 'ebnf-eps-upper-x
)
2533 (defvar ebnf-eps-upper-y
0.0)
2534 (make-variable-buffer-local 'ebnf-eps-upper-y
)
2535 (defvar ebnf-eps-prod-width
0.0)
2536 (make-variable-buffer-local 'ebnf-eps-prod-width
)
2537 (defvar ebnf-eps-max-height
0.0)
2538 (make-variable-buffer-local 'ebnf-eps-max-height
)
2539 (defvar ebnf-eps-max-width
0.0)
2540 (make-variable-buffer-local 'ebnf-eps-max-width
)
2543 (defvar ebnf-eps-context nil
2544 "List of EPS file name during parsing.
2546 See section \"Actions in Comments\" in ebnf2ps documentation.")
2549 (defvar ebnf-eps-production-list nil
2550 "Alist associating production name with EPS file name list.
2552 Each element has the following form:
2554 (PRODUCTION EPS-FILENAME...)
2556 PRODUCTION is the production name.
2557 EPS-FILENAME is the EPS file name.
2559 It's generated during parsing and used during EPS generation.
2561 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2565 (defconst ebnf-arrow-shape-alist
2573 (semi-up-hollow .
7)
2575 (semi-down-hollow .
9)
2576 (semi-down-full .
10)
2578 "Alist associating values for `ebnf-arrow-shape'.
2580 See documentation for `ebnf-arrow-shape'.")
2583 (defconst ebnf-terminal-shape-alist
2587 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2589 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2590 `ebnf-chart-shape'.")
2593 (defvar ebnf-limit nil
)
2594 (defvar ebnf-action nil
)
2595 (defvar ebnf-action-list nil
)
2598 (defvar ebnf-default-p nil
)
2601 (defvar ebnf-font-height-P
0)
2602 (defvar ebnf-font-height-T
0)
2603 (defvar ebnf-font-height-NT
0)
2604 (defvar ebnf-font-height-S
0)
2605 (defvar ebnf-font-height-E
0)
2606 (defvar ebnf-font-height-R
0)
2607 (defvar ebnf-font-width-P
0)
2608 (defvar ebnf-font-width-T
0)
2609 (defvar ebnf-font-width-NT
0)
2610 (defvar ebnf-font-width-S
0)
2611 (defvar ebnf-font-width-E
0)
2612 (defvar ebnf-font-width-R
0)
2613 (defvar ebnf-space-T
0)
2614 (defvar ebnf-space-NT
0)
2615 (defvar ebnf-space-S
0)
2616 (defvar ebnf-space-E
0)
2617 (defvar ebnf-space-R
0)
2620 (defvar ebnf-basic-width
0)
2621 (defvar ebnf-basic-height
0)
2622 (defvar ebnf-vertical-space
0)
2623 (defvar ebnf-horizontal-space
0)
2626 (defvar ebnf-settings nil
)
2627 (defvar ebnf-fonts-required nil
)
2630 (defconst ebnf-debug
2632 % === begin EBNF procedures to help debugging
2634 % Mark visually current point: string debug
2638 gsave -s- show grestore
2650 % Show number value: number string debug-number
2653 20 0 rmoveto show ([) show 60 string cvs show (]) show
2657 % === end EBNF procedures to help debugging
2660 "This is intended to help debugging PostScript programming.")
2663 (defconst ebnf-prologue
2665 % === begin EBNF engine
2667 % --- Basic Definitions
2670 /SpaceS FontHeight 0.5 mul def
2671 /HeightS FontHeight FontHeight add def
2674 /SpaceE FontHeight 0.5 mul def
2675 /HeightE FontHeight FontHeight add def
2678 /SpaceR FontHeight 0.5 mul def
2679 /HeightR FontHeight FontHeight add def
2682 /SpaceT FontHeight 0.5 mul def
2683 /HeightT FontHeight FontHeight add def
2686 /SpaceNT FontHeight 0.5 mul def
2687 /HeightNT FontHeight FontHeight add def
2689 /T HeightT HeightNT add 0.5 mul def
2692 /hT4 hT 0.25 mul def
2694 /Er 0.1 def % Error factor
2697 /c{currentpoint}bind def
2698 /xyi{/xi c /yi exch def def}bind def
2699 /xyo{/xo c /yo exch def def}bind def
2700 /xyp{/xp c /yp exch def def}bind def
2701 /xyt{/xt c /yt exch def def}bind def
2703 % vertical movement: x y height vm
2704 /vm{add moveto}bind def
2706 % horizontal movement: x y width hm
2707 /hm{3 -1 roll exch add exch moveto}bind def
2709 % set color: [R G B] SetRGB
2710 /SetRGB{aload pop setrgbcolor}bind def
2712 % filling gray area: gray-scale FillGray
2713 /FillGray{gsave setgray fill grestore}bind def
2715 % filling color area: [R G B] FillRGB
2716 /FillRGB{gsave SetRGB fill grestore}bind def
2718 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2719 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2720 /Gstroke{gsave Stroke grestore}bind def
2722 % Empty Line: width EL
2723 /EL{0 rlineto Gstroke}bind def
2727 /Down{hT2 neg hT4 neg rlineto}bind def
2730 {hT2 neg hT4 rmoveto
2735 /ArrowPath{c newpath moveto Arrow closepath}bind def
2759 {hT2 neg hT4 rlineto} % 1 - semi-up
2760 {Down} % 2 - semi-down
2761 {Arrow} % 3 - simple
2762 {Gstroke ArrowPath} % 4 - transparent
2763 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2764 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2765 {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
2766 {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
2767 {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
2768 {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
2769 {Gstroke gsave UserArrow grestore} % 11 - user
2775 RA-vector ArrowShape get exec
2780 % rotation DrawArrow
2795 /LA{180 DrawArrow}def
2802 /UA{90 DrawArrow}def
2809 /DA{270 DrawArrow}def
2813 %>corner Right Descendent: height arrow corner_RD
2815 % / height > 0 | 0 - none
2817 % * ---------- | 2 - left
2836 h 0 gt{DA}{UA}ifelse
2841 [{cRD0-vector arrow get exec} % 0 - miter
2842 {0 0 0 h hT h rcurveto} % 1 - rounded
2843 {hT h rlineto} % 2 - bevel
2847 {/arrow exch def /h exch def
2848 cRD-vector ChartShape get exec
2852 %>corner Right Ascendent: height arrow corner_RA
2854 % | height > 0 | 0 - none
2856 % *- ---------- | 2 - left
2874 h 0 gt{DA}{UA}ifelse
2880 [{cRA0-vector arrow get exec} % 0 - miter
2881 {0 0 hT 0 hT h rcurveto} % 1 - rounded
2882 {hT h rlineto} % 2 - bevel
2886 {/arrow exch def /h exch def
2887 cRA-vector ChartShape get exec
2891 %>corner Left Descendent: height arrow corner_LD
2893 % \\ height > 0 | 0 - none
2895 % * ---------- | 2 - left
2904 {hT neg h rmoveto xyi
2912 {hT neg h rmoveto xyi
2914 h 0 gt{DA}{UA}ifelse
2919 [{cLD0-vector arrow get exec} % 0 - miter
2920 {0 0 0 h hT neg h rcurveto} % 1 - rounded
2921 {hT neg h rlineto} % 2 - bevel
2925 {/arrow exch def /h exch def
2926 cLD-vector ChartShape get exec
2930 %>corner Left Ascendent: height arrow corner_LA
2932 % | height > 0 | 0 - none
2934 % -* ---------- | 2 - left
2943 {hT neg h rmoveto xyi
2951 {hT neg h rmoveto xyi
2952 h 0 gt{DA}{UA}ifelse
2958 [{cLA0-vector arrow get exec} % 0 - miter
2959 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
2960 {hT neg h rlineto} % 2 - bevel
2964 {/arrow exch def /h exch def
2965 cLA-vector ChartShape get exec
2971 % height prepare_height |- line_height corner_height corner_height
2975 {T add hT neg}ifelse
2979 %>Left Alternative: height LAlt
3006 %>Left Loop: height LLoop
3025 %>Right Alternative: height RAlt
3039 {T neg exch rlineto}
3052 %>Right Loop: height RLoop
3071 % --- Terminal, Non-terminal and Special Basics
3073 % string width prepare-width |- string
3076 dup stringwidth pop space add space add width exch sub 0.5 mul
3080 % string width begin-right
3090 {xo width add Er add yo moveto
3095 % string width begin-left
3104 {xo width add Er add yo moveto
3117 {/half YY yy sub 0.5 mul abs def
3118 xx half add YY moveto
3119 0 0 half neg 0 half neg half neg rcurveto
3120 0 0 0 half neg half half neg rcurveto
3121 XX xx sub abs half sub half sub 0 rlineto
3122 0 0 half 0 half half rcurveto
3123 0 0 0 half half neg half rcurveto}
3125 {/quarter YY yy sub 0.25 mul abs def
3126 xx quarter add YY moveto
3127 quarter neg quarter neg rlineto
3128 0 quarter quarter add neg rlineto
3129 quarter quarter neg rlineto
3130 XX xx sub abs quarter sub quarter sub 0 rlineto
3131 quarter quarter rlineto
3132 0 quarter quarter add rlineto
3133 quarter neg quarter rlineto}
3138 ShapePath-vector shape get exec
3144 Xshadow Xshadow add Xshadow add
3145 Yshadow Yshadow add Yshadow add translate
3159 % string SBound |- string
3161 {/xx c dup /yy exch def
3162 FontHeight add /YY exch def def
3163 dup stringwidth pop xx add /XX exch def
3165 {/yy yy YShadow add def
3166 /XX XX XShadow add def
3175 /XX XX space add space add def
3176 /YY YY space add def
3177 /yy yy space sub def
3178 shadow{doShapeShadow}if
3180 space Descent abs rmoveto
3187 % TeRminal: string TR
3189 {/Effect EffectT def
3191 /shapecolor BackgroundT def
3192 /borderwidth BorderWidthT def
3193 /bordercolor BorderColorT def
3194 /foreground ForegroundT def
3199 %>Right Terminal: string width RT |- x y
3210 %>Left Terminal: string width LT |- x y
3221 %>Right Terminal Default: string width RTD |- x y
3223 {/-save- BorderWidthT def
3224 /BorderWidthT BorderWidthT DefaultWidth add def
3226 /BorderWidthT -save- def
3229 %>Left Terminal Default: string width LTD |- x y
3231 {/-save- BorderWidthT def
3232 /BorderWidthT BorderWidthT DefaultWidth add def
3234 /BorderWidthT -save- def
3239 % Non-Terminal: string NT
3241 {/Effect EffectNT def
3243 /shapecolor BackgroundNT def
3244 /borderwidth BorderWidthNT def
3245 /bordercolor BorderColorNT def
3246 /foreground ForegroundNT def
3247 /shadow ShadowNT def
3251 %>Right Non-Terminal: string width RNT |- x y
3262 %>Left Non-Terminal: string width LNT |- x y
3273 %>Right Non-Terminal Default: string width RNTD |- x y
3275 {/-save- BorderWidthNT def
3276 /BorderWidthNT BorderWidthNT DefaultWidth add def
3278 /BorderWidthNT -save- def
3281 %>Left Non-Terminal Default: string width LNTD |- x y
3283 {/-save- BorderWidthNT def
3284 /BorderWidthNT BorderWidthNT DefaultWidth add def
3286 /BorderWidthNT -save- def
3291 % SPecial: string SP
3293 {/Effect EffectS def
3295 /shapecolor BackgroundS def
3296 /borderwidth BorderWidthS def
3297 /bordercolor BorderColorS def
3298 /foreground ForegroundS def
3303 %>Right SPecial: string width RSP |- x y
3314 %>Left SPecial: string width LSP |- x y
3325 %>Right SPecial Default: string width RSPD |- x y
3327 {/-save- BorderWidthS def
3328 /BorderWidthS BorderWidthS DefaultWidth add def
3330 /BorderWidthS -save- def
3333 %>Left SPecial Default: string width LSPD |- x y
3335 {/-save- BorderWidthS def
3336 /BorderWidthS BorderWidthS DefaultWidth add def
3338 /BorderWidthS -save- def
3341 % --- Repeat and Except basics
3344 {/w width rwidth sub 0.5 mul def
3349 /xx c entry add /YY exch def def
3350 /yy YY height sub def
3351 /XX xx rwidth add def
3352 shadow{doShapeShadow}if
3375 % entry height width rwidth begin-repeat
3385 /shapecolor BackgroundR def
3386 /borderwidth BorderWidthR def
3387 /bordercolor BorderColorR def
3388 /foreground ForegroundR def
3393 % string end-repeat |- x y
3396 space Descent rmoveto
3400 exch space add exch moveto
3404 %>Right RePeat: string entry height width rwidth RRP |- x y
3405 /RRP{begin-repeat right-direction end-repeat}def
3407 %>Left RePeat: string entry height width rwidth LRP |- x y
3408 /LRP{begin-repeat left-direction end-repeat}def
3412 % entry height width rwidth begin-except
3422 /shapecolor BackgroundE def
3423 /borderwidth BorderWidthE def
3424 /bordercolor BorderColorE def
3425 /foreground ForegroundE def
3430 % x-width end-except |- x y
3433 space space add add Descent rmoveto
3434 (-) foreground SetRGB S
3440 %>Right EXcept: x-width entry height width rwidth REX |- x y
3441 /REX{begin-except right-direction end-except}def
3443 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3444 /LEX{begin-except left-direction end-except}def
3448 %>Beginning Of Sequence: BOS |- x y
3449 /BOS{currentpoint}bind def
3451 %>End Of Sequence: x y x1 y1 EOS |- x y
3452 /EOS{pop pop}bind def
3456 %>Beginning Of Production: string width height BOP |- y x
3459 neg yp add /yw exch def
3460 xp add T sub /xw exch def
3461 dup length 0 gt % empty string ==> no production name
3462 {/Effect EffectP def
3463 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3473 %>End Of Production: y x delta EOP
3474 /EOPH{add exch moveto}bind def % horizontal
3475 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3477 % --- Empty Alternative
3479 %>Empty Alternative: width EA |- x y
3490 %>AlTernative: h1 h2 ... hn n width AT |- x y
3492 {xyo xo add /xw exch def
3504 %>OPtional: height width OP |- x y
3521 %>One or More: height width OM |- x y
3535 %>Zero or More: h2 h1 width ZM |- x y
3545 yo add xo T add exch moveto
3549 % === end EBNF engine
3552 "EBNF PostScript prologue")
3555 (defconst ebnf-eps-prologue
3557 /#ebnf2ps#dict 230 dict def
3560 % Initiliaze variables to avoid name-conflicting with document variables.
3561 % This is the case when using `bind' operator.
3562 /-fillp- 0 def /h 0 def
3563 /-ox- 0 def /half 0 def
3564 /-oy- 0 def /height 0 def
3565 /-save- 0 def /ow 0 def
3566 /Ascent 0 def /quarter 0 def
3567 /Descent 0 def /rXX 0 def
3568 /Effect 0 def /rYY 0 def
3569 /FontHeight 0 def /rwidth 0 def
3570 /LineThickness 0 def /rxx 0 def
3571 /OverlinePosition 0 def /ryy 0 def
3572 /SpaceBackground 0 def /shadow 0 def
3573 /StrikeoutPosition 0 def /shape 0 def
3574 /UnderlinePosition 0 def /shapecolor 0 def
3575 /XBox 0 def /space 0 def
3576 /XX 0 def /st 1 string def
3577 /Xshadow 0 def /w 0 def
3578 /YBox 0 def /width 0 def
3580 /Yshadow 0 def /xo 0 def
3581 /arrow 0 def /xp 0 def
3582 /bg false def /xt 0 def
3583 /bgcolor 0 def /xw 0 def
3584 /bordercolor 0 def /xx 0 def
3585 /borderwidth 0 def /yi 0 def
3587 /entry 0 def /yp 0 def
3588 /foreground 0 def /yt 0 def
3592 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3593 /ISOLatin1Encoding where
3595 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3596 % -- The first half is the same as the standard encoding,
3597 % -- except for minus instead of hyphen at code 055.
3599 StandardEncoding 0 45 getinterval aload pop
3601 StandardEncoding 46 82 getinterval aload pop
3602 %*** NOTE: the following are missing in the Adobe documentation,
3603 %*** but appear in the displayed table:
3604 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3606 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3607 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3608 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3609 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3611 /space /exclamdown /cent /sterling
3612 /currency /yen /brokenbar /section
3613 /dieresis /copyright /ordfeminine /guillemotleft
3614 /logicalnot /hyphen /registered /macron
3615 /degree /plusminus /twosuperior /threesuperior
3616 /acute /mu /paragraph /periodcentered
3617 /cedilla /onesuperior /ordmasculine /guillemotright
3618 /onequarter /onehalf /threequarters /questiondown
3620 /Agrave /Aacute /Acircumflex /Atilde
3621 /Adieresis /Aring /AE /Ccedilla
3622 /Egrave /Eacute /Ecircumflex /Edieresis
3623 /Igrave /Iacute /Icircumflex /Idieresis
3624 /Eth /Ntilde /Ograve /Oacute
3625 /Ocircumflex /Otilde /Odieresis /multiply
3626 /Oslash /Ugrave /Uacute /Ucircumflex
3627 /Udieresis /Yacute /Thorn /germandbls
3629 /agrave /aacute /acircumflex /atilde
3630 /adieresis /aring /ae /ccedilla
3631 /egrave /eacute /ecircumflex /edieresis
3632 /igrave /iacute /icircumflex /idieresis
3633 /eth /ntilde /ograve /oacute
3634 /ocircumflex /otilde /odieresis /divide
3635 /oslash /ugrave /uacute /ucircumflex
3636 /udieresis /yacute /thorn /ydieresis
3640 /reencodeFontISO %def
3642 length 12 add dict % Make a new font (a new dict the same size
3643 % as the old one) with room for our new symbols.
3645 begin % Make the new font the current dictionary.
3647 {def}{pop pop}ifelse
3648 }forall % Copy each of the symbols from the old dictionary
3649 % to the new one except for the font ID.
3651 currentdict /FontType get 0 ne
3652 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3653 % the ISOLatin1 encoding.
3655 % Use the font's bounding box to determine the ascent, descent,
3656 % and overall height; don't forget that these values have to be
3657 % transformed using the font's matrix.
3664 % | | | | Ascent (usually > 0)
3666 % (0 0) -> +--+----+-------->
3668 % | | v Descent (usually < 0)
3669 % (x1 y1) --> +----+ - -
3671 currentdict /FontType get 0 ne
3672 {/FontBBox load aload pop % -- x1 y1 x2 y2
3673 FontMatrix transform /Ascent exch def pop
3674 FontMatrix transform /Descent exch def pop}
3675 {/PrimaryFont FDepVector 0 get def
3676 PrimaryFont /FontBBox get aload pop
3677 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3678 PrimaryFont /FontMatrix get transform /Descent exch def pop
3681 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3683 % Define these in case they're not in the FontInfo
3684 % (also, here they're easier to get to).
3685 /UnderlinePosition Descent 0.70 mul def
3686 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3687 /StrikeoutPosition Ascent 0.30 mul def
3688 /LineThickness FontHeight 0.05 mul def
3689 /Xshadow FontHeight 0.08 mul def
3690 /Yshadow FontHeight -0.09 mul def
3691 /SpaceBackground Descent neg UnderlinePosition add def
3692 /XBox Descent neg def
3693 /YBox LineThickness 0.7 mul def
3695 currentdict % Leave the new font on the stack
3696 end % Stop using the font as the current dictionary
3697 definefont % Put the font into the font dictionary
3698 pop % Discard the returned font
3702 /DefFont{findfont exch scalefont reencodeFontISO}def
3707 dup /Ascent get /Ascent exch def
3708 dup /Descent get /Descent exch def
3709 dup /FontHeight get /FontHeight exch def
3710 dup /UnderlinePosition get /UnderlinePosition exch def
3711 dup /OverlinePosition get /OverlinePosition exch def
3712 dup /StrikeoutPosition get /StrikeoutPosition exch def
3713 dup /LineThickness get /LineThickness exch def
3714 dup /Xshadow get /Xshadow exch def
3715 dup /Yshadow get /Yshadow exch def
3716 dup /SpaceBackground get /SpaceBackground exch def
3717 dup /XBox get /XBox exch def
3718 dup /YBox get /YBox exch def
3731 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3733 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3746 % top of stack: fill-or-not
3748 {LineThickness setlinewidth stroke}
3753 % stack: string fill-or-not |- --
3756 /-ox- currentpoint /-oy- exch def def
3758 LineThickness setlinewidth
3760 st dup true charpath
3761 -fillp- {gsave FillBgColor grestore}if
3763 -oy- add /-oy- exch def
3764 -ox- add /-ox- exch def
3771 % stack: fill-or-not delta |- --
3774 xx XBox sub dd sub yy YBox sub dd sub
3775 XX XBox add dd add YY YBox add dd add
3779 % stack: string |- --
3782 Xshadow Yshadow rmoveto
3787 % stack: position |- --
3789 {currentpoint exch pop add dup
3795 LineThickness setlinewidth stroke
3799 % stack: string |- --
3800 % effect: 1 - underline 2 - strikeout 4 - overline
3801 % 8 - shadow 16 - box 32 - outline
3803 {/xx currentpoint dup Descent add /yy exch def
3804 Ascent add /YY exch def def
3805 dup stringwidth pop xx add /XX exch def
3807 {/yy yy Yshadow add def
3808 /XX XX Xshadow add def
3813 {SpaceBackground doBox}
3814 {xx yy XX YY doRect}
3817 Effect 16 and 0 ne{false 0 doBox}if % box
3818 Effect 8 and 0 ne{dup doShadow}if % shadow
3820 {true doOutline} % outline
3821 {show} % normal text
3823 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
3824 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
3825 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
3829 "EBNF EPS prologue")
3832 (defconst ebnf-eps-begin
3836 % x y #ebnf2ps#begin
3838 {#ebnf2ps#dict begin /#ebnf2ps#save save def
3839 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
3841 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
3848 (defconst ebnf-eps-end
3855 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3859 (defvar ebnf-format-float
"%1.3f")
3862 (defun ebnf-format-float (&rest floats
)
3865 (format ebnf-format-float float
))
3870 (defun ebnf-format-color (format-str color default
)
3871 (let* ((the-color (or color default
))
3872 (rgb (ps-color-scale the-color
)))
3875 (ebnf-format-float (nth 0 rgb
) (nth 1 rgb
) (nth 2 rgb
))
3880 (defvar ebnf-message-float
"%3.2f")
3883 (defsubst ebnf-message-float
(format-str value
)
3885 (format ebnf-message-float value
)))
3888 (defvar ebnf-total
0)
3889 (defvar ebnf-nprod
0)
3892 (defsubst ebnf-message-info
(messag)
3893 (message "%s...%3d%%"
3895 (round (/ (* (setq ebnf-nprod
(1+ ebnf-nprod
)) 100.0) ebnf-total
))))
3898 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3902 (defmacro ebnf-node-kind
(vec &optional value
)
3904 `(aset ,vec
0 ,value
)
3908 (defmacro ebnf-node-width-func
(node width
)
3909 `(funcall (aref ,node
1) ,node
,width
))
3912 (defmacro ebnf-node-dimension-func
(node &optional value
)
3914 `(aset ,node
2 ,value
)
3915 `(funcall (aref ,node
2) ,node
)))
3918 (defmacro ebnf-node-entry
(vec &optional value
)
3920 `(aset ,vec
3 ,value
)
3924 (defmacro ebnf-node-height
(vec &optional value
)
3926 `(aset ,vec
4 ,value
)
3930 (defmacro ebnf-node-width
(vec &optional value
)
3932 `(aset ,vec
5 ,value
)
3936 (defmacro ebnf-node-name
(vec)
3940 (defmacro ebnf-node-list
(vec &optional value
)
3942 `(aset ,vec
6 ,value
)
3946 (defmacro ebnf-node-default
(vec)
3950 (defmacro ebnf-node-production
(vec &optional value
)
3952 `(aset ,vec
7 ,value
)
3956 (defmacro ebnf-node-separator
(vec &optional value
)
3958 `(aset ,vec
7 ,value
)
3962 (defmacro ebnf-node-action
(vec &optional value
)
3964 `(aset ,vec
8 ,value
)
3968 (defmacro ebnf-node-generation
(node)
3969 `(funcall (ebnf-node-kind ,node
) ,node
))
3972 (defmacro ebnf-max-width
(prod)
3973 `(max (ebnf-node-width ,prod
)
3974 (+ (* (length (ebnf-node-name ,prod
))
3976 ebnf-production-horizontal-space
)))
3979 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3980 ;; PostScript generation
3983 (defun ebnf-generate-eps (ebnf-tree)
3984 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
3985 (ps-print-color-scale (if ps-color-p
3986 (float (car (ps-color-values "white")))
3988 (ebnf-total (length ebnf-tree
))
3990 (old-ps-output (symbol-function 'ps-output
))
3991 (old-ps-output-string (symbol-function 'ps-output-string
))
3992 (eps-buffer (get-buffer-create ebnf-eps-buffer-name
))
3993 ebnf-debug-ps error-msg horizontal
3994 prod prod-name prod-width prod-height prod-list file-list
)
3995 ;; redefines `ps-output' and `ps-output-string'
3996 (defalias 'ps-output
'ebnf-eps-output
)
3997 (defalias 'ps-output-string
'ps-output-string-prim
)
3998 ;; generate EPS file
4000 (condition-case data
4003 (setq prod
(car ebnf-tree
)
4004 prod-name
(ebnf-node-name prod
)
4005 prod-width
(ebnf-max-width prod
)
4006 prod-height
(ebnf-node-height prod
)
4007 horizontal
(memq (ebnf-node-action prod
)
4009 ;; generate production in EPS buffer
4011 (set-buffer eps-buffer
)
4012 (setq ebnf-eps-upper-x
0.0
4013 ebnf-eps-upper-y
0.0
4014 ebnf-eps-max-width prod-width
4015 ebnf-eps-max-height prod-height
)
4016 (ebnf-generate-production prod
))
4017 (if (setq prod-list
(cdr (assoc prod-name
4018 ebnf-eps-production-list
)))
4019 ;; insert EPS buffer in all buffer associated with production
4020 (ebnf-eps-production-list prod-list
'file-list horizontal
4021 prod-width prod-height eps-buffer
)
4022 ;; write EPS file for production
4023 (ebnf-eps-finish-and-write eps-buffer
4024 (ebnf-eps-filename prod-name
)))
4025 ;; prepare for next loop
4027 (set-buffer eps-buffer
)
4029 (setq ebnf-tree
(cdr ebnf-tree
)))
4030 ;; write and kill temporary buffers
4031 (ebnf-eps-write-kill-temp file-list t
)
4032 (setq file-list nil
))
4035 (setq error-msg
(error-message-string data
)))))
4036 ;; restore `ps-output' and `ps-output-string'
4037 (defalias 'ps-output old-ps-output
)
4038 (defalias 'ps-output-string old-ps-output-string
)
4039 ;; kill temporary buffers
4040 (kill-buffer eps-buffer
)
4041 (ebnf-eps-write-kill-temp file-list nil
)
4042 (and error-msg
(error error-msg
))
4046 ;; write and kill temporary buffers
4047 (defun ebnf-eps-write-kill-temp (file-list write-p
)
4049 (let ((buffer (get-buffer (concat " *" (car file-list
) "*"))))
4052 (ebnf-eps-finish-and-write buffer
(car file-list
)))
4053 (kill-buffer buffer
)))
4054 (setq file-list
(cdr file-list
))))
4057 ;; insert EPS buffer in all buffer associated with production
4058 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
4059 prod-width prod-height eps-buffer
)
4061 (add-to-list file-list-sym
(car prod-list
))
4063 (set-buffer (get-buffer-create (concat " *" (car prod-list
) "*")))
4064 (goto-char (point-max))
4067 ((zerop (buffer-size))
4068 (setq ebnf-eps-upper-x
0.0
4069 ebnf-eps-upper-y
0.0
4070 ebnf-eps-max-width prod-width
4071 ebnf-eps-max-height prod-height
))
4074 (ebnf-eop-horizontal ebnf-eps-prod-width
)
4075 (setq ebnf-eps-max-width
(+ ebnf-eps-max-width
4076 ebnf-production-horizontal-space
4078 ebnf-eps-max-height
(max ebnf-eps-max-height prod-height
)))
4081 (ebnf-eop-vertical ebnf-eps-max-height
)
4082 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4083 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4086 ebnf-production-vertical-space
4087 ebnf-eps-max-height
))
4088 ebnf-eps-max-width prod-width
4089 ebnf-eps-max-height prod-height
))
4091 (setq ebnf-eps-prod-width prod-width
)
4092 (insert-buffer eps-buffer
))
4093 (setq prod-list
(cdr prod-list
))))
4096 (defun ebnf-generate (ebnf-tree)
4097 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4098 (ps-print-color-scale (if ps-color-p
4099 (float (car (ps-color-values "white")))
4101 ps-zebra-stripes ps-line-number ps-razzle-dazzle
4103 ps-print-begin-sheet-hook
4104 ps-print-begin-page-hook
4105 ps-print-begin-column-hook
)
4106 (ps-generate (current-buffer) (point-min) (point-max)
4107 'ebnf-generate-postscript
)))
4110 (defvar ebnf-tree nil
)
4111 (defvar ebnf-direction
"R")
4114 (defun ebnf-generate-postscript (from to
)
4116 (if ebnf-horizontal-max-height
4117 (ebnf-generate-with-max-height)
4118 (ebnf-generate-without-max-height))
4122 (defun ebnf-generate-with-max-height ()
4123 (let ((ebnf-total (length ebnf-tree
))
4125 next-line max-height prod the-width
)
4127 ;; find next line point
4128 (setq next-line ebnf-tree
4129 prod
(car ebnf-tree
)
4130 max-height
(ebnf-node-height prod
))
4131 (ebnf-begin-line prod
(ebnf-max-width prod
))
4132 (while (and (setq next-line
(cdr next-line
))
4133 (setq prod
(car next-line
))
4134 (memq (ebnf-node-action prod
) ebnf-action-list
)
4135 (setq the-width
(ebnf-max-width prod
))
4136 (<= the-width ps-width-remaining
))
4137 (setq max-height
(max max-height
(ebnf-node-height prod
))
4138 ps-width-remaining
(- ps-width-remaining
4140 ebnf-production-horizontal-space
))))
4141 ;; generate current line
4142 (ebnf-newline max-height
)
4143 (setq prod
(car ebnf-tree
))
4144 (ebnf-generate-production prod
)
4145 (while (not (eq (setq ebnf-tree
(cdr ebnf-tree
)) next-line
))
4146 (ebnf-eop-horizontal (ebnf-max-width prod
))
4147 (setq prod
(car ebnf-tree
))
4148 (ebnf-generate-production prod
))
4149 (ebnf-eop-vertical max-height
))))
4152 (defun ebnf-generate-without-max-height ()
4153 (let ((ebnf-total (length ebnf-tree
))
4155 max-height prod bef-width cur-width
)
4157 ;; generate current line
4158 (setq prod
(car ebnf-tree
)
4159 max-height
(ebnf-node-height prod
)
4160 bef-width
(ebnf-max-width prod
))
4161 (ebnf-begin-line prod bef-width
)
4162 (ebnf-generate-production prod
)
4163 (while (and (setq ebnf-tree
(cdr ebnf-tree
))
4164 (setq prod
(car ebnf-tree
))
4165 (memq (ebnf-node-action prod
) ebnf-action-list
)
4166 (setq cur-width
(ebnf-max-width prod
))
4167 (<= cur-width ps-width-remaining
)
4168 (<= (ebnf-node-height prod
) ps-height-remaining
))
4169 (ebnf-eop-horizontal bef-width
)
4170 (ebnf-generate-production prod
)
4171 (setq bef-width cur-width
4172 max-height
(max max-height
(ebnf-node-height prod
))
4173 ps-width-remaining
(- ps-width-remaining
4175 ebnf-production-horizontal-space
))))
4176 (ebnf-eop-vertical max-height
)
4177 ;; prepare next line
4178 (ebnf-newline max-height
))))
4181 (defun ebnf-begin-line (prod width
)
4182 (and (or (eq (ebnf-node-action prod
) 'form-feed
)
4183 (> (ebnf-node-height prod
) ps-height-remaining
))
4185 (setq ps-width-remaining
(- ps-width-remaining
4187 ebnf-production-horizontal-space
))))
4190 (defun ebnf-newline (height)
4191 (and (> height ps-height-remaining
)
4193 (setq ps-width-remaining ps-print-width
4194 ps-height-remaining
(- ps-height-remaining
4196 ebnf-production-vertical-space
))))
4199 ;; [production width-fun dim-fun entry height width name production action]
4200 (defun ebnf-generate-production (production)
4201 (ebnf-message-info "Generating")
4202 (run-hooks 'ebnf-production-hook
)
4203 (ps-output-string (if ebnf-production-name-p
4204 (ebnf-node-name production
)
4208 (ebnf-node-width production
)
4209 (+ (if ebnf-production-name-p
4212 (ebnf-node-entry (ebnf-node-production production
))))
4214 (ebnf-node-generation (ebnf-node-production production
))
4215 (ps-output "EOS\n"))
4218 ;; [alternative width-fun dim-fun entry height width list]
4219 (defun ebnf-generate-alternative (alternative)
4220 (let ((alt (ebnf-node-list alternative
))
4221 (entry (ebnf-node-entry alternative
))
4223 alt-height alt-entry
)
4225 (ps-output (ebnf-format-float (- entry
(ebnf-node-entry (car alt
))))
4227 (setq entry
(- entry
(ebnf-node-height (car alt
)) ebnf-vertical-space
)
4230 (ps-output (format "%d " nlist
)
4231 (ebnf-format-float (ebnf-node-width alternative
))
4233 (setq alt
(ebnf-node-list alternative
))
4235 (ebnf-node-generation (car alt
))
4236 (setq alt-height
(- (ebnf-node-height (car alt
))
4237 (ebnf-node-entry (car alt
)))))
4238 (while (setq alt
(cdr alt
))
4239 (setq alt-entry
(ebnf-node-entry (car alt
)))
4240 (ebnf-vertical-movement
4241 (- (+ alt-height ebnf-vertical-space alt-entry
)))
4242 (ebnf-node-generation (car alt
))
4243 (setq alt-height
(- (ebnf-node-height (car alt
)) alt-entry
))))
4244 (ps-output "EOS\n"))
4247 ;; [sequence width-fun dim-fun entry height width list]
4248 (defun ebnf-generate-sequence (sequence)
4250 (let ((seq (ebnf-node-list sequence
))
4253 (ebnf-node-generation (car seq
))
4254 (setq seq-width
(ebnf-node-width (car seq
))))
4255 (while (setq seq
(cdr seq
))
4256 (ebnf-horizontal-movement seq-width
)
4257 (ebnf-node-generation (car seq
))
4258 (setq seq-width
(ebnf-node-width (car seq
)))))
4259 (ps-output "EOS\n"))
4262 ;; [terminal width-fun dim-fun entry height width name]
4263 (defun ebnf-generate-terminal (terminal)
4264 (ebnf-gen-terminal terminal
"T"))
4267 ;; [non-terminal width-fun dim-fun entry height width name]
4268 (defun ebnf-generate-non-terminal (non-terminal)
4269 (ebnf-gen-terminal non-terminal
"NT"))
4272 ;; [empty width-fun dim-fun entry height width]
4273 (defun ebnf-generate-empty (empty)
4274 (ebnf-empty-alternative (ebnf-node-width empty
)))
4277 ;; [optional width-fun dim-fun entry height width element]
4278 (defun ebnf-generate-optional (optional)
4279 (let ((the-optional (ebnf-node-list optional
)))
4280 (ps-output (ebnf-format-float
4281 (+ (- (ebnf-node-height the-optional
)
4282 (ebnf-node-entry optional
))
4283 ebnf-vertical-space
)
4284 (ebnf-node-width optional
))
4286 (ebnf-node-generation the-optional
)
4287 (ps-output "EOS\n")))
4290 ;; [one-or-more width-fun dim-fun entry height width element separator]
4291 (defun ebnf-generate-one-or-more (one-or-more)
4292 (let* ((width (ebnf-node-width one-or-more
))
4293 (sep (ebnf-node-separator one-or-more
))
4294 (entry (- (ebnf-node-entry one-or-more
)
4296 (ebnf-node-entry sep
)
4298 (ps-output (ebnf-format-float entry width
)
4300 (ebnf-node-generation (ebnf-node-list one-or-more
))
4301 (ebnf-vertical-movement entry
)
4303 (let ((ebnf-direction "L"))
4304 (ebnf-node-generation sep
))
4305 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4306 (ps-output "EOS\n"))
4309 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4310 (defun ebnf-generate-zero-or-more (zero-or-more)
4311 (let* ((width (ebnf-node-width zero-or-more
))
4312 (node-list (ebnf-node-list zero-or-more
))
4313 (list-entry (ebnf-node-entry node-list
))
4314 (node-sep (ebnf-node-separator zero-or-more
))
4315 (entry (+ list-entry
4318 (- (ebnf-node-height node-sep
)
4319 (ebnf-node-entry node-sep
))
4321 (ps-output (ebnf-format-float entry
4322 (+ (- (ebnf-node-height node-list
)
4324 ebnf-vertical-space
)
4327 (ebnf-node-generation (ebnf-node-list zero-or-more
))
4328 (ebnf-vertical-movement entry
)
4329 (if (ebnf-node-separator zero-or-more
)
4330 (let ((ebnf-direction "L"))
4331 (ebnf-node-generation (ebnf-node-separator zero-or-more
)))
4332 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4333 (ps-output "EOS\n"))
4336 ;; [special width-fun dim-fun entry height width name]
4337 (defun ebnf-generate-special (special)
4338 (ebnf-gen-terminal special
"SP"))
4341 ;; [repeat width-fun dim-fun entry height width times element]
4342 (defun ebnf-generate-repeat (repeat)
4343 (let ((times (ebnf-node-name repeat
))
4344 (element (ebnf-node-separator repeat
)))
4345 (ps-output-string times
)
4348 (ebnf-node-entry repeat
)
4349 (ebnf-node-height repeat
)
4350 (ebnf-node-width repeat
)
4352 (+ (ebnf-node-width element
)
4353 ebnf-space-R ebnf-space-R ebnf-space-R
4354 (* (length times
) ebnf-font-width-R
))
4356 " " ebnf-direction
"RP\n")
4358 (ebnf-node-generation element
)))
4359 (ps-output "EOS\n"))
4362 ;; [except width-fun dim-fun entry height width element element]
4363 (defun ebnf-generate-except (except)
4364 (let* ((element (ebnf-node-list except
))
4365 (exception (ebnf-node-separator except
))
4366 (width (ebnf-node-width element
)))
4367 (ps-output (ebnf-format-float
4369 (ebnf-node-entry except
)
4370 (ebnf-node-height except
)
4371 (ebnf-node-width except
)
4373 ebnf-space-E ebnf-space-E ebnf-space-E
4376 (+ (ebnf-node-width exception
) ebnf-space-E
)
4378 " " ebnf-direction
"EX\n")
4379 (ebnf-node-generation (ebnf-node-list except
))
4381 (ebnf-horizontal-movement (+ width ebnf-space-E
4382 ebnf-font-width-E ebnf-space-E
))
4383 (ebnf-node-generation exception
)))
4384 (ps-output "EOS\n"))
4387 (defun ebnf-gen-terminal (node code
)
4388 (ps-output-string (ebnf-node-name node
))
4389 (ps-output " " (ebnf-format-float (ebnf-node-width node
))
4390 " " ebnf-direction code
4391 (if (ebnf-node-default node
)
4396 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4397 ;; Internal functions
4400 (defun ebnf-directory (fun &optional directory
)
4401 "Process files in DIRECTORY applying function FUN on each file.
4403 If DIRECTORY is nil, it's used `default-directory'.
4405 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
4407 (let ((files (directory-files (or directory default-directory
)
4408 t ebnf-file-suffix-regexp
)))
4410 (set-buffer (find-file-noselect (car files
)))
4412 (setq buffer-backed-up t
) ; Do not back it up.
4413 (save-buffer) ; Just save new version.
4414 (kill-buffer (current-buffer))
4415 (setq files
(cdr files
)))))
4418 (defun ebnf-file (fun file
&optional do-not-kill-buffer-when-done
)
4419 "Process file FILE applying function FUN.
4421 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
4422 killed after process termination."
4423 (set-buffer (find-file-noselect file
))
4425 (or do-not-kill-buffer-when-done
4426 (kill-buffer (current-buffer))))
4429 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4430 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4431 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4432 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4433 (defun ebnf-range-regexp (prefix from to
)
4436 (setq str
(concat str
(char-to-string from
))
4438 (concat prefix str
)))
4441 (defvar ebnf-map-name
4442 (let ((map (make-vector 256 ?\_
)))
4443 (mapcar #'(lambda (char)
4444 (aset map char char
))
4445 (concat "#$%&+-.0123456789=?@~"
4446 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4447 "abcdefghijklmnopqrstuvwxyz"))
4451 (defun ebnf-eps-filename (str)
4452 (let* ((len (length str
))
4454 (new (make-string len ?\
)))
4456 (aset new stri
(aref ebnf-map-name
(aref str stri
)))
4457 (setq stri
(1+ stri
)))
4458 (concat ebnf-eps-prefix new
".eps")))
4461 (defun ebnf-eps-output (&rest args
)
4464 (setq args
(cdr args
))))
4467 (defun ebnf-generate-region (from to gen-func
)
4468 (run-hooks 'ebnf-hook
)
4469 (let ((ebnf-limit (max from to
))
4470 (error-msg "SYNTAX")
4475 (condition-case data
4476 (let ((tree (ebnf-parse-and-sort (min from to
))))
4478 (setq error-msg
"EMPTY RULES"
4479 tree
(ebnf-eliminate-empty-rules tree
))
4480 (setq error-msg
"OPTMIZE"
4481 tree
(ebnf-optimize tree
))
4482 (setq error-msg
"DIMENSIONS"
4483 tree
(ebnf-dimensions tree
))
4484 (setq error-msg
"GENERATION")
4485 (funcall gen-func tree
))
4486 (setq error-msg nil
)) ; here it's ok
4490 (setq the-point
(max (1- (point)) (point-min))
4491 error-msg
(concat error-msg
": "
4492 (error-message-string data
)
4494 (and (string= error-msg
"SYNTAX")
4495 (format "at position %d "
4497 (format "in buffer \"%s\"."
4498 (buffer-name)))))))))
4502 (goto-char the-point
)
4503 (if ebnf-stop-on-error
4505 (message error-msg
)))
4506 ;; generated output OK
4509 ;; syntax checked OK
4511 (message "EBNF syntactic analysis: NO ERRORS.")))))
4514 (defun ebnf-parse-and-sort (start)
4516 (let ((tree (funcall ebnf-parser-func start
)))
4517 (if ebnf-sort-production
4519 (message "Sorting...")
4521 (if (eq ebnf-sort-production
'ascending
)
4522 'ebnf-sorter-ascending
4523 'ebnf-sorter-descending
)))
4527 (defun ebnf-sorter-ascending (first second
)
4528 (string< (ebnf-node-name first
)
4529 (ebnf-node-name second
)))
4532 (defun ebnf-sorter-descending (first second
)
4533 (string< (ebnf-node-name second
)
4534 (ebnf-node-name first
)))
4537 (defun ebnf-empty-alternative (width)
4538 (ps-output (ebnf-format-float width
) " EA\n"))
4541 (defun ebnf-vertical-movement (height)
4542 (ps-output (ebnf-format-float height
) " vm\n"))
4545 (defun ebnf-horizontal-movement (width)
4546 (ps-output (ebnf-format-float width
) " hm\n"))
4549 (defun ebnf-entry (height)
4550 (* height ebnf-entry-percentage
))
4553 (defun ebnf-eop-vertical (height)
4554 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space
))
4558 (defun ebnf-eop-horizontal (width)
4559 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space
))
4563 (defun ebnf-new-page ()
4564 (when (< ps-height-remaining ps-print-height
)
4565 (run-hooks 'ebnf-page-hook
)
4570 (defsubst ebnf-font-size
(font) (nth 0 font
))
4571 (defsubst ebnf-font-name
(font) (nth 1 font
))
4572 (defsubst ebnf-font-foreground
(font) (nth 2 font
))
4573 (defsubst ebnf-font-background
(font) (nth 3 font
))
4574 (defsubst ebnf-font-list
(font) (nthcdr 4 font
))
4575 (defsubst ebnf-font-attributes
(font)
4576 (lsh (ps-extension-bit (cdr font
)) -
2))
4579 (defconst ebnf-font-name-select
4580 (vector 'normal
'bold
'italic
'bold-italic
))
4583 (defun ebnf-font-name-select (font)
4584 (let* ((font-list (ebnf-font-list font
))
4585 (font-index (+ (if (memq 'bold font-list
) 1 0)
4586 (if (memq 'italic font-list
) 2 0)))
4587 (name (ebnf-font-name font
))
4588 (database (cdr (assoc name ps-font-info-database
)))
4589 (info-list (or (cdr (assoc 'fonts database
))
4590 (error "Invalid font: %s" name
))))
4591 (or (cdr (assoc (aref ebnf-font-name-select font-index
)
4593 (error "Invalid attributes for font %s" name
))))
4596 (defun ebnf-font-select (font select
)
4597 (let* ((name (ebnf-font-name font
))
4598 (database (cdr (assoc name ps-font-info-database
)))
4599 (size (cdr (assoc 'size database
)))
4600 (base (cdr (assoc select database
))))
4602 (/ (* (ebnf-font-size font
) base
)
4604 (error "Invalid font: %s" name
))))
4607 (defsubst ebnf-font-width
(font)
4608 (ebnf-font-select font
'avg-char-width
))
4609 (defsubst ebnf-font-height
(font)
4610 (ebnf-font-select font
'line-height
))
4613 (defconst ebnf-syntax-alist
4614 ;; 0.syntax 1.parser 2.initializer
4615 '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize
)
4616 (yacc ebnf-yac-parser ebnf-yac-initialize
)
4617 (abnf ebnf-abn-parser ebnf-abn-initialize
)
4618 (ebnf ebnf-bnf-parser ebnf-bnf-initialize
))
4619 "Alist associating ebnf syntax with a parser and a initializer.")
4622 (defun ebnf-begin-job ()
4623 (ps-printing-region nil nil nil
)
4624 (if ebnf-use-float-format
4625 (setq ebnf-format-float
"%1.3f"
4626 ebnf-message-float
"%3.2f")
4627 (setq ebnf-format-float
"%s"
4628 ebnf-message-float
"%s"))
4629 (ebnf-otz-initialize)
4630 ;; to avoid compilation gripes when calling autoloaded functions
4631 (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist
)
4632 (assoc 'ebnf ebnf-syntax-alist
))))
4633 (setq ebnf-parser-func
(nth 1 init
))
4634 (funcall (nth 2 init
)))
4635 (and ebnf-terminal-regexp
; ensures that it's a string or nil
4636 (not (stringp ebnf-terminal-regexp
))
4637 (setq ebnf-terminal-regexp nil
))
4638 (or (and ebnf-eps-prefix
; ensures that it's a string
4639 (stringp ebnf-eps-prefix
))
4640 (setq ebnf-eps-prefix
"ebnf--"))
4641 (setq ebnf-entry-percentage
; ensures value between 0.0 and 1.0
4642 (min (max ebnf-entry-percentage
0.0) 1.0)
4643 ebnf-action-list
(if ebnf-horizontal-orientation
4647 ebnf-fonts-required nil
4650 ebnf-eps-context nil
4651 ebnf-eps-production-list nil
4652 ebnf-eps-upper-x
0.0
4653 ebnf-eps-upper-y
0.0
4654 ebnf-font-height-P
(ebnf-font-height ebnf-production-font
)
4655 ebnf-font-height-T
(ebnf-font-height ebnf-terminal-font
)
4656 ebnf-font-height-NT
(ebnf-font-height ebnf-non-terminal-font
)
4657 ebnf-font-height-S
(ebnf-font-height ebnf-special-font
)
4658 ebnf-font-height-E
(ebnf-font-height ebnf-except-font
)
4659 ebnf-font-height-R
(ebnf-font-height ebnf-repeat-font
)
4660 ebnf-font-width-P
(ebnf-font-width ebnf-production-font
)
4661 ebnf-font-width-T
(ebnf-font-width ebnf-terminal-font
)
4662 ebnf-font-width-NT
(ebnf-font-width ebnf-non-terminal-font
)
4663 ebnf-font-width-S
(ebnf-font-width ebnf-special-font
)
4664 ebnf-font-width-E
(ebnf-font-width ebnf-except-font
)
4665 ebnf-font-width-R
(ebnf-font-width ebnf-repeat-font
)
4666 ebnf-space-T
(* ebnf-font-height-T
0.5)
4667 ebnf-space-NT
(* ebnf-font-height-NT
0.5)
4668 ebnf-space-S
(* ebnf-font-height-S
0.5)
4669 ebnf-space-E
(* ebnf-font-height-E
0.5)
4670 ebnf-space-R
(* ebnf-font-height-R
0.5))
4671 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT
)))
4672 (setq ebnf-basic-width
(* basic
0.5)
4673 ebnf-horizontal-space
(+ basic basic
)
4674 ebnf-basic-height ebnf-basic-width
4675 ebnf-vertical-space ebnf-basic-width
)
4676 ;; ensures value is greater than zero
4677 (or (and (numberp ebnf-production-horizontal-space
)
4678 (> ebnf-production-horizontal-space
0.0))
4679 (setq ebnf-production-horizontal-space basic
))
4680 ;; ensures value is greater than zero
4681 (or (and (numberp ebnf-production-vertical-space
)
4682 (> ebnf-production-vertical-space
0.0))
4683 (setq ebnf-production-vertical-space basic
))))
4686 (defsubst ebnf-shape-value
(sym alist
)
4687 (or (cdr (assq sym alist
)) 0))
4690 (defsubst ebnf-boolean
(value)
4691 (if value
"true" "false"))
4694 (defun ebnf-begin-file ()
4697 (set-buffer ps-spool-buffer
)
4698 (goto-char (point-min))
4699 (and (search-forward "%%Creator: " nil t
)
4700 (not (search-forward "& ebnf2ps v"
4701 (save-excursion (end-of-line) (point))
4704 ;; adjust creator comment
4707 (insert " & ebnf2ps v" ebnf-version
)
4708 ;; insert ebnf settings & engine
4709 (goto-char (point-max))
4710 (search-backward "\n%%EndProlog\n")
4711 (ebnf-insert-ebnf-prologue)
4712 (ps-output "\n")))))
4715 (defun ebnf-eps-finish-and-write (buffer filename
)
4718 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4719 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4722 ebnf-production-vertical-space
4723 ebnf-eps-max-height
)))
4725 (goto-char (point-min))
4727 "%!PS-Adobe-3.0 EPSF-3.0"
4728 "\n%%BoundingBox: 0 0 "
4729 (format "%d %d" (1+ ebnf-eps-upper-x
) (1+ ebnf-eps-upper-y
))
4730 "\n%%Title: " filename
4731 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4732 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version
")"
4733 "\n%%DocumentNeededResources: font "
4734 (or ebnf-fonts-required
4735 (setq ebnf-fonts-required
4736 (mapconcat 'identity
4737 (ps-remove-duplicates
4738 (mapcar 'ebnf-font-name-select
4739 (list ebnf-production-font
4741 ebnf-non-terminal-font
4746 "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
4748 (ebnf-insert-ebnf-prologue)
4749 (insert ebnf-eps-begin
4750 "\n0 " (ebnf-format-float
4751 (- ebnf-eps-upper-y
(* ebnf-font-height-P
0.7)))
4752 " #ebnf2ps#begin\n")
4754 (goto-char (point-max))
4755 (insert ebnf-eps-end
)
4757 (message "Saving...")
4758 (setq filename
(expand-file-name filename
))
4759 (let ((coding-system-for-write 'raw-text-unix
))
4760 (write-region (point-min) (point-max) filename
))
4761 (message "Wrote %s" filename
)))
4764 (defun ebnf-insert-ebnf-prologue ()
4769 "\n\n% === begin EBNF settings\n\n"
4771 (format "/fP %s /%s DefFont\n"
4772 (ebnf-format-float (ebnf-font-size ebnf-production-font
))
4773 (ebnf-font-name-select ebnf-production-font
))
4774 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4775 (ebnf-font-foreground ebnf-production-font
)
4777 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4778 (ebnf-font-background ebnf-production-font
)
4780 (format "/EffectP %d def\n"
4781 (ebnf-font-attributes ebnf-production-font
))
4783 (format "/fT %s /%s DefFont\n"
4784 (ebnf-format-float (ebnf-font-size ebnf-terminal-font
))
4785 (ebnf-font-name-select ebnf-terminal-font
))
4786 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4787 (ebnf-font-foreground ebnf-terminal-font
)
4789 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4790 (ebnf-font-background ebnf-terminal-font
)
4792 (format "/EffectT %d def\n"
4793 (ebnf-font-attributes ebnf-terminal-font
))
4794 (format "/BorderWidthT %s def\n"
4795 (ebnf-format-float ebnf-terminal-border-width
))
4796 (ebnf-format-color "/BorderColorT %s def %% %s\n"
4797 ebnf-terminal-border-color
4799 (format "/ShapeT %d def\n"
4800 (ebnf-shape-value ebnf-terminal-shape
4801 ebnf-terminal-shape-alist
))
4802 (format "/ShadowT %s def\n"
4803 (ebnf-boolean ebnf-terminal-shadow
))
4805 (format "/fNT %s /%s DefFont\n"
4807 (ebnf-font-size ebnf-non-terminal-font
))
4808 (ebnf-font-name-select ebnf-non-terminal-font
))
4809 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
4810 (ebnf-font-foreground ebnf-non-terminal-font
)
4812 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
4813 (ebnf-font-background ebnf-non-terminal-font
)
4815 (format "/EffectNT %d def\n"
4816 (ebnf-font-attributes ebnf-non-terminal-font
))
4817 (format "/BorderWidthNT %s def\n"
4818 (ebnf-format-float ebnf-non-terminal-border-width
))
4819 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
4820 ebnf-non-terminal-border-color
4822 (format "/ShapeNT %d def\n"
4823 (ebnf-shape-value ebnf-non-terminal-shape
4824 ebnf-terminal-shape-alist
))
4825 (format "/ShadowNT %s def\n"
4826 (ebnf-boolean ebnf-non-terminal-shadow
))
4828 (format "/fS %s /%s DefFont\n"
4829 (ebnf-format-float (ebnf-font-size ebnf-special-font
))
4830 (ebnf-font-name-select ebnf-special-font
))
4831 (ebnf-format-color "/ForegroundS %s def %% %s\n"
4832 (ebnf-font-foreground ebnf-special-font
)
4834 (ebnf-format-color "/BackgroundS %s def %% %s\n"
4835 (ebnf-font-background ebnf-special-font
)
4837 (format "/EffectS %d def\n"
4838 (ebnf-font-attributes ebnf-special-font
))
4839 (format "/BorderWidthS %s def\n"
4840 (ebnf-format-float ebnf-special-border-width
))
4841 (ebnf-format-color "/BorderColorS %s def %% %s\n"
4842 ebnf-special-border-color
4844 (format "/ShapeS %d def\n"
4845 (ebnf-shape-value ebnf-special-shape
4846 ebnf-terminal-shape-alist
))
4847 (format "/ShadowS %s def\n"
4848 (ebnf-boolean ebnf-special-shadow
))
4850 (format "/fE %s /%s DefFont\n"
4851 (ebnf-format-float (ebnf-font-size ebnf-except-font
))
4852 (ebnf-font-name-select ebnf-except-font
))
4853 (ebnf-format-color "/ForegroundE %s def %% %s\n"
4854 (ebnf-font-foreground ebnf-except-font
)
4856 (ebnf-format-color "/BackgroundE %s def %% %s\n"
4857 (ebnf-font-background ebnf-except-font
)
4859 (format "/EffectE %d def\n"
4860 (ebnf-font-attributes ebnf-except-font
))
4861 (format "/BorderWidthE %s def\n"
4862 (ebnf-format-float ebnf-except-border-width
))
4863 (ebnf-format-color "/BorderColorE %s def %% %s\n"
4864 ebnf-except-border-color
4866 (format "/ShapeE %d def\n"
4867 (ebnf-shape-value ebnf-except-shape
4868 ebnf-terminal-shape-alist
))
4869 (format "/ShadowE %s def\n"
4870 (ebnf-boolean ebnf-except-shadow
))
4872 (format "/fR %s /%s DefFont\n"
4873 (ebnf-format-float (ebnf-font-size ebnf-repeat-font
))
4874 (ebnf-font-name-select ebnf-repeat-font
))
4875 (ebnf-format-color "/ForegroundR %s def %% %s\n"
4876 (ebnf-font-foreground ebnf-repeat-font
)
4878 (ebnf-format-color "/BackgroundR %s def %% %s\n"
4879 (ebnf-font-background ebnf-repeat-font
)
4881 (format "/EffectR %d def\n"
4882 (ebnf-font-attributes ebnf-repeat-font
))
4883 (format "/BorderWidthR %s def\n"
4884 (ebnf-format-float ebnf-repeat-border-width
))
4885 (ebnf-format-color "/BorderColorR %s def %% %s\n"
4886 ebnf-repeat-border-color
4888 (format "/ShapeR %d def\n"
4889 (ebnf-shape-value ebnf-repeat-shape
4890 ebnf-terminal-shape-alist
))
4891 (format "/ShadowR %s def\n"
4892 (ebnf-boolean ebnf-repeat-shadow
))
4894 (format "/DefaultWidth %s def\n"
4895 (ebnf-format-float ebnf-default-width
))
4896 (format "/LineWidth %s def\n"
4897 (ebnf-format-float ebnf-line-width
))
4898 (ebnf-format-color "/LineColor %s def %% %s\n"
4901 (format "/ArrowShape %d def\n"
4902 (ebnf-shape-value ebnf-arrow-shape
4903 ebnf-arrow-shape-alist
))
4904 (format "/ChartShape %d def\n"
4905 (ebnf-shape-value ebnf-chart-shape
4906 ebnf-terminal-shape-alist
))
4907 (format "/UserArrow{%s}def\n"
4908 (let ((arrow (eval ebnf-user-arrow
)))
4912 "\n% === end EBNF settings\n\n"
4913 (and ebnf-debug-ps ebnf-debug
))))
4917 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4918 ;; Adjusting dimensions
4921 (defun ebnf-dimensions (tree)
4922 (let ((ebnf-total (length tree
))
4924 (mapcar 'ebnf-production-dimension tree
))
4928 ;; [empty width-fun dim-fun entry height width]
4929 ;;(defun ebnf-empty-dimension (empty)
4933 ;; [production width-fun dim-fun entry height width name production action]
4934 (defun ebnf-production-dimension (production)
4935 (ebnf-message-info "Calculating dimensions")
4936 (ebnf-node-dimension-func (ebnf-node-production production
))
4937 (let* ((prod (ebnf-node-production production
))
4938 (height (+ (if ebnf-production-name-p
4941 ebnf-line-width ebnf-line-width
4943 (ebnf-node-height prod
))))
4944 (ebnf-node-entry production height
)
4945 (ebnf-node-height production height
)
4946 (ebnf-node-width production
(+ (ebnf-node-width prod
)
4948 ebnf-horizontal-space
))))
4951 ;; [terminal width-fun dim-fun entry height width name]
4952 (defun ebnf-terminal-dimension (terminal)
4953 (ebnf-terminal-dimension1 terminal
4959 ;; [non-terminal width-fun dim-fun entry height width name]
4960 (defun ebnf-non-terminal-dimension (non-terminal)
4961 (ebnf-terminal-dimension1 non-terminal
4967 ;; [special width-fun dim-fun entry height width name]
4968 (defun ebnf-special-dimension (special)
4969 (ebnf-terminal-dimension1 special
4975 (defun ebnf-terminal-dimension1 (node font-height font-width space
)
4976 (let ((height (+ space font-height space
))
4977 (len (length (ebnf-node-name node
))))
4978 (ebnf-node-entry node
(* height
0.5))
4979 (ebnf-node-height node height
)
4980 (ebnf-node-width node
(+ ebnf-basic-width space
4982 space ebnf-basic-width
))))
4985 (defconst ebnf-null-vector
(vector t t t
0.0 0.0 0.0))
4988 ;; [repeat width-fun dim-fun entry height width times element]
4989 (defun ebnf-repeat-dimension (repeat)
4990 (let ((times (ebnf-node-name repeat
))
4991 (element (ebnf-node-separator repeat
)))
4993 (ebnf-node-dimension-func element
)
4994 (setq element ebnf-null-vector
))
4995 (ebnf-node-entry repeat
(+ (ebnf-node-entry element
)
4997 (ebnf-node-height repeat
(+ (max (ebnf-node-height element
)
4999 ebnf-space-R ebnf-space-R
))
5000 (ebnf-node-width repeat
(+ (ebnf-node-width element
)
5001 ebnf-space-R ebnf-space-R ebnf-space-R
5002 ebnf-horizontal-space
5003 (* (length times
) ebnf-font-width-R
)))))
5006 ;; [except width-fun dim-fun entry height width element element]
5007 (defun ebnf-except-dimension (except)
5008 (let ((factor (ebnf-node-list except
))
5009 (element (ebnf-node-separator except
)))
5010 (ebnf-node-dimension-func factor
)
5012 (ebnf-node-dimension-func element
)
5013 (setq element ebnf-null-vector
))
5014 (ebnf-node-entry except
(+ (max (ebnf-node-entry factor
)
5015 (ebnf-node-entry element
))
5017 (ebnf-node-height except
(+ (max (ebnf-node-height factor
)
5018 (ebnf-node-height element
))
5019 ebnf-space-E ebnf-space-E
))
5020 (ebnf-node-width except
(+ (ebnf-node-width factor
)
5021 (ebnf-node-width element
)
5022 ebnf-space-E ebnf-space-E
5023 ebnf-space-E ebnf-space-E
5025 ebnf-horizontal-space
))))
5028 ;; [alternative width-fun dim-fun entry height width list]
5029 (defun ebnf-alternative-dimension (alternative)
5030 (let ((body (ebnf-node-list alternative
))
5031 (lis (ebnf-node-list alternative
)))
5033 (ebnf-node-dimension-func (car lis
))
5034 (setq lis
(cdr lis
)))
5038 (tail (car (last body
)))
5039 (entry (ebnf-node-entry (car body
)))
5042 (setq node
(car alt
)
5044 height
(+ (ebnf-node-height node
) height
)
5045 width
(max (ebnf-node-width node
) width
)))
5046 (ebnf-adjust-width body width
)
5047 (setq height
(+ height
(* (1- (length body
)) ebnf-vertical-space
)))
5048 (ebnf-node-entry alternative
(+ entry
5051 (- (ebnf-node-height tail
)
5052 (ebnf-node-entry tail
))))))
5053 (ebnf-node-height alternative height
)
5054 (ebnf-node-width alternative
(+ width ebnf-horizontal-space
))
5055 (ebnf-node-list alternative body
))))
5058 ;; [optional width-fun dim-fun entry height width element]
5059 (defun ebnf-optional-dimension (optional)
5060 (let ((body (ebnf-node-list optional
)))
5061 (ebnf-node-dimension-func body
)
5062 (ebnf-node-entry optional
(ebnf-node-entry body
))
5063 (ebnf-node-height optional
(+ (ebnf-node-height body
)
5064 ebnf-vertical-space
))
5065 (ebnf-node-width optional
(+ (ebnf-node-width body
)
5066 ebnf-horizontal-space
))))
5069 ;; [one-or-more width-fun dim-fun entry height width element separator]
5070 (defun ebnf-one-or-more-dimension (or-more)
5071 (let ((list-part (ebnf-node-list or-more
))
5072 (sep-part (ebnf-node-separator or-more
)))
5073 (ebnf-node-dimension-func list-part
)
5075 (ebnf-node-dimension-func sep-part
))
5076 (let ((height (+ (if sep-part
5077 (ebnf-node-height sep-part
)
5080 (ebnf-node-height list-part
)))
5081 (width (max (if sep-part
5082 (ebnf-node-width sep-part
)
5084 (ebnf-node-width list-part
))))
5086 (ebnf-adjust-width list-part width
)
5087 (ebnf-adjust-width sep-part width
))
5088 (ebnf-node-entry or-more
(+ (- height
(ebnf-node-height list-part
))
5089 (ebnf-node-entry list-part
)))
5090 (ebnf-node-height or-more height
)
5091 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
5094 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5095 (defun ebnf-zero-or-more-dimension (or-more)
5096 (let ((list-part (ebnf-node-list or-more
))
5097 (sep-part (ebnf-node-separator or-more
)))
5098 (ebnf-node-dimension-func list-part
)
5100 (ebnf-node-dimension-func sep-part
))
5101 (let ((height (+ (if sep-part
5102 (ebnf-node-height sep-part
)
5105 (ebnf-node-height list-part
)
5106 ebnf-vertical-space
))
5107 (width (max (if sep-part
5108 (ebnf-node-width sep-part
)
5110 (ebnf-node-width list-part
))))
5112 (ebnf-adjust-width list-part width
)
5113 (ebnf-adjust-width sep-part width
))
5114 (ebnf-node-entry or-more height
)
5115 (ebnf-node-height or-more height
)
5116 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
5119 ;; [sequence width-fun dim-fun entry height width list]
5120 (defun ebnf-sequence-dimension (sequence)
5124 (lis (ebnf-node-list sequence
))
5127 (setq node
(car lis
)
5129 (ebnf-node-dimension-func node
)
5130 (setq entry
(ebnf-node-entry node
)
5131 above
(max above entry
)
5132 below
(max below
(- (ebnf-node-height node
) entry
))
5133 width
(+ width
(ebnf-node-width node
))))
5134 (ebnf-node-entry sequence above
)
5135 (ebnf-node-height sequence
(+ above below
))
5136 (ebnf-node-width sequence width
)))
5139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5143 (defun ebnf-adjust-width (node width
)
5149 (setcar node
(ebnf-adjust-width (car node
) width
))
5150 (setq node
(cdr node
)))))
5153 ;; nothing to be done
5154 ((= width
(ebnf-node-width node
))
5156 ;; left justify term
5157 ((eq ebnf-justify-sequence
'left
)
5158 (ebnf-adjust-empty node width nil
))
5159 ;; right justify terms
5160 ((eq ebnf-justify-sequence
'right
)
5161 (ebnf-adjust-empty node width t
))
5164 (ebnf-node-width-func node width
)
5165 (ebnf-node-width node width
)
5173 (defun ebnf-adjust-empty (node width last-p
)
5174 (if (eq (ebnf-node-kind node
) 'ebnf-generate-empty
)
5176 (ebnf-node-width node width
)
5178 (let ((empty (ebnf-make-empty (- width
(ebnf-node-width node
)))))
5179 (ebnf-make-dup-sequence node
5182 (list node empty
))))))
5185 ;; [terminal width-fun dim-fun entry height width name]
5186 ;; [non-terminal width-fun dim-fun entry height width name]
5187 ;; [empty width-fun dim-fun entry height width]
5188 ;; [special width-fun dim-fun entry height width name]
5189 ;; [repeat width-fun dim-fun entry height width times element]
5190 ;; [except width-fun dim-fun entry height width element element]
5191 ;;(defun ebnf-terminal-width (terminal width)
5195 ;; [alternative width-fun dim-fun entry height width list]
5196 ;; [optional width-fun dim-fun entry height width element]
5197 (defun ebnf-alternative-width (alternative width
)
5198 (ebnf-adjust-width (ebnf-node-list alternative
)
5199 (- width ebnf-horizontal-space
)))
5202 ;; [one-or-more width-fun dim-fun entry height width element separator]
5203 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5204 (defun ebnf-element-width (or-more width
)
5205 (setq width
(- width ebnf-horizontal-space
))
5206 (ebnf-node-list or-more
5207 (ebnf-justify-list or-more
5208 (ebnf-node-list or-more
)
5210 (ebnf-node-separator or-more
5211 (ebnf-justify-list or-more
5212 (ebnf-node-separator or-more
)
5216 ;; [sequence width-fun dim-fun entry height width list]
5217 (defun ebnf-sequence-width (sequence width
)
5218 (ebnf-node-list sequence
5219 (ebnf-justify-list sequence
5220 (ebnf-node-list sequence
)
5224 (defun ebnf-justify-list (node seq width
)
5225 (let ((seq-width (ebnf-node-width node
)))
5226 (if (= width seq-width
)
5229 ;; left justify terms
5230 ((eq ebnf-justify-sequence
'left
)
5231 (ebnf-justify node seq seq-width width t
))
5232 ;; right justify terms
5233 ((eq ebnf-justify-sequence
'right
)
5234 (ebnf-justify node seq seq-width width nil
))
5235 ;; centralize terms -- element
5237 (ebnf-adjust-width seq width
))
5238 ;; centralize terms -- list
5240 (let ((the-width (/ (- width seq-width
) (length seq
)))
5243 (ebnf-adjust-width (car lis
)
5244 (+ (ebnf-node-width (car lis
))
5246 (setq lis
(cdr lis
)))
5251 (defun ebnf-justify (node seq seq-width width last-p
)
5252 (let ((term (car (if last-p
(last seq
) seq
))))
5254 ;; adjust empty term
5255 ((eq (ebnf-node-kind term
) 'ebnf-generate-empty
)
5256 (ebnf-node-width term
(+ (- width seq-width
)
5257 (ebnf-node-width term
)))
5259 ;; insert empty at end ==> left justify
5262 (list (ebnf-make-empty (- width seq-width
)))))
5263 ;; insert empty at beginning ==> right justify
5265 (cons (ebnf-make-empty (- width seq-width
))
5270 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5271 ;; Functions used by parsers
5274 (defun ebnf-eps-add-context (name)
5275 (let ((filename (ebnf-eps-filename name
)))
5276 (if (member filename ebnf-eps-context
)
5277 (error "Try to open an already opened EPS file: %s" filename
)
5278 (setq ebnf-eps-context
(cons filename ebnf-eps-context
)))))
5281 (defun ebnf-eps-remove-context (name)
5282 (let ((filename (ebnf-eps-filename name
)))
5283 (if (member filename ebnf-eps-context
)
5284 (setq ebnf-eps-context
(delete filename ebnf-eps-context
))
5285 (error "Try to close a not opened EPS file: %s" filename
))))
5288 (defun ebnf-eps-add-production (header)
5289 (and ebnf-eps-executing
5291 (let ((prod (assoc header ebnf-eps-production-list
)))
5293 (setcdr prod
(append ebnf-eps-context
(cdr prod
)))
5294 (setq ebnf-eps-production-list
5295 (cons (cons header
(ebnf-dup-list ebnf-eps-context
))
5296 ebnf-eps-production-list
))))))
5299 (defun ebnf-dup-list (old)
5302 (setq new
(cons (car old
) new
)
5307 (defun ebnf-buffer-substring (chars)
5308 (buffer-substring-no-properties
5311 (skip-chars-forward chars ebnf-limit
)
5315 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
5316 (defconst ebnf-8-bit-chars
(ebnf-range-regexp "" ?
\240 ?
\377))
5319 (defun ebnf-string (chars eos-char kind
)
5321 (buffer-substring-no-properties
5324 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5325 (skip-chars-forward (concat chars ebnf-8-bit-chars
) ebnf-limit
)
5326 (if (or (eobp) (/= (following-char) eos-char
))
5327 (error "Illegal %s: missing `%c'" kind eos-char
)
5332 (defun ebnf-get-string ()
5334 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5337 (defun ebnf-end-of-string ()
5339 (while (> (logand n
1) 0)
5340 (skip-chars-forward "^\"" ebnf-limit
)
5341 (setq n
(- (skip-chars-backward "\\\\")))
5342 (goto-char (+ (point) n
1))))
5343 (if (= (preceding-char) ?
\")
5345 (error "Missing `\"'")))
5348 (defun ebnf-trim-right (str)
5349 (let* ((len (1- (length str
)))
5351 (while (and (> index
0) (= (aref str index
) ?\
))
5352 (setq index
(1- index
)))
5355 (substring str
0 (1+ index
)))))
5358 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5362 (defun ebnf-make-empty (&optional width
)
5363 (vector 'ebnf-generate-empty
5368 (or width ebnf-horizontal-space
)))
5371 (defun ebnf-make-terminal (name)
5372 (ebnf-make-terminal1 name
5373 'ebnf-generate-terminal
5374 'ebnf-terminal-dimension
))
5377 (defun ebnf-make-non-terminal (name)
5378 (ebnf-make-terminal1 name
5379 'ebnf-generate-non-terminal
5380 'ebnf-non-terminal-dimension
))
5383 (defun ebnf-make-special (name)
5384 (ebnf-make-terminal1 name
5385 'ebnf-generate-special
5386 'ebnf-special-dimension
))
5389 (defun ebnf-make-terminal1 (name gen-func dim-func
)
5396 (let ((len (length name
)))
5397 (cond ((> len
3) name
)
5398 ((= len
3) (concat name
" "))
5399 ((= len
2) (concat " " name
" "))
5400 ((= len
1) (concat " " name
" "))
5405 (defun ebnf-make-one-or-more (list-part &optional sep-part
)
5406 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5407 'ebnf-one-or-more-dimension
5412 (defun ebnf-make-zero-or-more (list-part &optional sep-part
)
5413 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5414 'ebnf-zero-or-more-dimension
5419 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part
)
5426 (if (listp list-part
)
5427 (ebnf-make-sequence list-part
)
5429 (if (and sep-part
(listp sep-part
))
5430 (ebnf-make-sequence sep-part
)
5434 (defun ebnf-make-production (name prod action
)
5435 (vector 'ebnf-generate-production
5437 'ebnf-production-dimension
5446 (defun ebnf-make-alternative (body)
5447 (vector 'ebnf-generate-alternative
5448 'ebnf-alternative-width
5449 'ebnf-alternative-dimension
5456 (defun ebnf-make-optional (body)
5457 (vector 'ebnf-generate-optional
5458 'ebnf-alternative-width
5459 'ebnf-optional-dimension
5466 (defun ebnf-make-except (factor exception
)
5467 (vector 'ebnf-generate-except
5469 'ebnf-except-dimension
5477 (defun ebnf-make-repeat (times primary
&optional upper
)
5478 (vector 'ebnf-generate-repeat
5480 'ebnf-repeat-dimension
5484 (cond ((and times upper
) ; L * U, L * L
5485 (if (string= times upper
)
5486 (if (string= times
"")
5489 (concat times
" * " upper
)))
5491 (concat times
" *"))
5493 (concat "* " upper
))
5499 (defun ebnf-make-sequence (seq)
5500 (vector 'ebnf-generate-sequence
5501 'ebnf-sequence-width
5502 'ebnf-sequence-dimension
5509 (defun ebnf-make-dup-sequence (node seq
)
5510 (vector 'ebnf-generate-sequence
5511 'ebnf-sequence-width
5512 'ebnf-sequence-dimension
5513 (ebnf-node-entry node
)
5514 (ebnf-node-height node
)
5515 (ebnf-node-width node
)
5519 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5520 ;; Optimizers used by parsers
5523 (defun ebnf-token-except (element exception
)
5526 (setq exception
(cdr exception
)))
5527 (and element
; EMPTY - A ==> EMPTY
5528 (let ((kind (ebnf-node-kind element
)))
5531 ((and (null exception
)
5532 (eq kind
'ebnf-generate-optional
))
5533 (ebnf-node-list element
))
5534 ;; { A }- ==> { A }+
5535 ((and (null exception
)
5536 (eq kind
'ebnf-generate-zero-or-more
))
5537 (ebnf-node-kind element
'ebnf-generate-one-or-more
)
5538 (ebnf-node-dimension-func element
'ebnf-one-or-more-dimension
)
5540 ;; ( A | EMPTY )- ==> A
5541 ;; ( A | B | EMPTY )- ==> A | B
5542 ((and (null exception
)
5543 (eq kind
'ebnf-generate-alternative
)
5545 (car (last (ebnf-node-list element
))))
5546 'ebnf-generate-empty
))
5547 (let ((elt (ebnf-node-list element
))
5553 ;; this should not happen!!?!
5554 (setq element
(ebnf-make-empty
5555 (ebnf-node-width element
)))
5557 (setq elt
(ebnf-node-list element
))
5558 (and (= (length elt
) 1)
5559 (setq element
(car elt
))))
5563 (ebnf-make-except element exception
))
5567 (defun ebnf-token-repeat (times repeat
&optional upper
)
5568 (if (null (cdr repeat
))
5569 ;; n * EMPTY ==> EMPTY
5573 (ebnf-make-repeat times
(cdr repeat
) upper
))))
5576 (defun ebnf-token-optional (body)
5577 (let ((kind (ebnf-node-kind body
)))
5579 ;; [ EMPTY ] ==> EMPTY
5580 ((eq kind
'ebnf-generate-empty
)
5582 ;; [ { A }* ] ==> { A }*
5583 ((eq kind
'ebnf-generate-zero-or-more
)
5585 ;; [ { A }+ ] ==> { A }*
5586 ((eq kind
'ebnf-generate-one-or-more
)
5587 (ebnf-node-kind body
'ebnf-generate-zero-or-more
)
5589 ;; [ A | B ] ==> A | B | EMPTY
5590 ((eq kind
'ebnf-generate-alternative
)
5591 (ebnf-node-list body
(nconc (ebnf-node-list body
)
5592 (list (ebnf-make-empty))))
5596 (ebnf-make-optional body
))
5600 (defun ebnf-token-alternative (body sequence
)
5604 (cons (car sequence
)
5606 (cons (car sequence
)
5607 (let ((seq (cdr sequence
)))
5608 (if (and (= (length body
) 1) (null seq
))
5610 (ebnf-make-alternative (nreverse (if seq
5615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5616 ;; Variables used by parsers
5619 (defconst ebnf-comment-table
5620 (let ((table (make-vector 256 nil
)))
5621 ;; Override special comment character:
5622 (aset table ?
< 'newline
)
5623 (aset table ?
> 'keep-line
)
5625 "Vector used to map characters to a special comment token.")
5628 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5629 ;; To make this file smaller, some commands go in a separate file.
5630 ;; But autoload them here to make the separation invisible.
5632 (autoload 'ebnf-abn-parser
"ebnf-abn"
5635 (autoload 'ebnf-abn-initialize
"ebnf-abn"
5636 "Initialize ABNF token table.")
5638 (autoload 'ebnf-bnf-parser
"ebnf-bnf"
5641 (autoload 'ebnf-bnf-initialize
"ebnf-bnf"
5642 "Initialize EBNF token table.")
5644 (autoload 'ebnf-iso-parser
"ebnf-iso"
5647 (autoload 'ebnf-iso-initialize
"ebnf-iso"
5648 "Initialize ISO EBNF token table.")
5650 (autoload 'ebnf-yac-parser
"ebnf-yac"
5651 "Yacc/Bison parser.")
5653 (autoload 'ebnf-yac-initialize
"ebnf-yac"
5654 "Initializations for Yacc/Bison parser.")
5656 (autoload 'ebnf-eliminate-empty-rules
"ebnf-otz"
5657 "Eliminate empty rules.")
5659 (autoload 'ebnf-optimize
"ebnf-otz"
5660 "Syntactic chart optimizer.")
5662 (autoload 'ebnf-otz-initialize
"ebnf-otz"
5663 "Initialize optimizer.")
5666 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5671 ;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
5672 ;;; ebnf2ps.el ends here