1 ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 ;; Free Software Foundation, Inc.
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Keywords: wp, ebnf, PostScript
10 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 (defconst ebnf-version
"4.4"
28 "ebnf2ps.el, v 4.4 <2007/02/12 vinicius>
30 Vinicius's last change version. When reporting bugs, please also
31 report the version of Emacs, if any, that ebnf2ps was running with.
33 Please send all bug fixes and enhancements to
34 Vinicius Jose Latorre <viniciusjl@ig.com.br>.
40 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45 ;; This package translates an EBNF to a syntactic chart on PostScript.
47 ;; To use ebnf2ps, insert in your ~/.emacs:
51 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
52 ;; know how to set options like landscape printing, page headings, margins,
55 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
56 ;; ebnf2ps, they behave as it's turned off.
58 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
60 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
62 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
64 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
70 ;; ebnf2ps provides the following commands for generating PostScript syntactic
71 ;; chart images of Emacs buffers:
73 ;; ebnf-print-directory
77 ;; ebnf-spool-directory
86 ;; These commands all perform essentially the same function: they generate
87 ;; PostScript syntactic chart images suitable for printing on a PostScript
88 ;; printer or displaying with GhostScript. These commands are collectively
89 ;; referred to as "ebnf- commands".
91 ;; The word "print", "spool" and "eps" in the command name determines when the
92 ;; PostScript image is sent to the printer (or file):
94 ;; print - The PostScript image is immediately sent to the printer;
96 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
97 ;; Many images may be spooled locally before printing them. To
98 ;; send the spooled images to the printer, use the command
101 ;; eps - The PostScript image is immediately sent to an EPS file.
103 ;; The spooling mechanism is the same as used by ps-print and was designed for
104 ;; printing lots of small files to save paper that would otherwise be wasted on
105 ;; banner pages, and to make it easier to find your output at the printer (it's
106 ;; easier to pick up one 50-page printout than to find 50 single-page
107 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
108 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
110 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
111 ;; won't accidentally quit from Emacs while you have unprinted PostScript
112 ;; waiting in the spool buffer. If you do attempt to exit with spooled
113 ;; PostScript, you'll be asked if you want to print it, and if you decline,
114 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
115 ;; that Emacs uses for modified buffers.
117 ;; The word "directory", "file", "buffer" or "region" in the command name
118 ;; determines how much of the buffer is printed:
120 ;; directory - Read files in the directory and print them.
122 ;; file - Read file and print it.
124 ;; buffer - Print the entire buffer.
126 ;; region - Print just the current region.
128 ;; Two ebnf- command examples:
130 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
131 ;; immediately to the printer.
133 ;; ebnf-spool-region - translate and print just the current region, and
134 ;; spool the image in Emacs to send to the printer
137 ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and
138 ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print
139 ;; spooling mechanism. See section "Actions in Comments" for an explanation
140 ;; about EPS file generation.
146 ;; To translate and print your buffer, type
148 ;; M-x ebnf-print-buffer
150 ;; or substitute one of the other four ebnf- commands. The command will
151 ;; generate the PostScript image and print or spool it as specified. By giving
152 ;; the command a prefix argument
154 ;; C-u M-x ebnf-print-buffer
156 ;; it will save the PostScript image to a file instead of sending it to the
157 ;; printer; you will be prompted for the name of the file to save the image to.
158 ;; The prefix argument is ignored by the commands that spool their images, but
159 ;; you may save the spooled images to a file by giving a prefix argument to
162 ;; C-u M-x ebnf-despool
164 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
167 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
168 ;; `ebnf-eps-region'.
170 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
172 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
173 ;; (global-set-key '(shift f22) 'ebnf-print-region)
174 ;; (global-set-key '(control f22) 'ebnf-despool)
177 ;; Invoking Ebnf2ps in Batch
178 ;; -------------------------
180 ;; It's possible also to run ebnf2ps in batch, this is useful when, for
181 ;; example, you have a directory with a lot of files containing the EBNF to be
182 ;; translated to PostScript.
184 ;; To run ebnf2ps in batch type, for example:
186 ;; emacs -batch -l setup-ebnf2ps.el -f ebnf-eps-directory
188 ;; Where setup-ebnf2ps.el should be a file containing:
190 ;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
191 ;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
192 ;; (require 'ebnf2ps)
193 ;; ;; insert here your ebnf2ps settings
194 ;; (setq ebnf-terminal-shape 'bevel)
201 ;; BNF (Backus Naur Form) notation is defined like languages, and like
202 ;; languages there are rules about name formation and syntax. In this section
203 ;; it's defined a BNF syntax that it's called simply EBNF (Extended BNF).
204 ;; ebnf2ps package also deal with other BNF notation. Please, see the variable
205 ;; `ebnf-syntax' documentation below in this section.
207 ;; The current EBNF that ebnf2ps accepts has the following constructions:
209 ;; ; comment (until end of line)
213 ;; $A default non-terminal (see text below)
214 ;; $"C" default terminal (see text below)
215 ;; $?C? default special (see text below)
216 ;; A = B. production (A is the header and B the body)
217 ;; C D sequence (C occurs before D)
218 ;; C | D alternative (C or D occurs)
219 ;; A - B exception (A excluding B, B without any non-terminal)
220 ;; n * A repetition (A repeats at least n (integer) times)
221 ;; n * n A repetition (A repeats exactly n (integer) times)
222 ;; n * m A repetition (A repeats at least n (integer) and at most
223 ;; m (integer) times)
224 ;; (C) group (expression C is grouped together)
225 ;; [C] optional (C may or not occurs)
226 ;; C+ one or more occurrences of C
227 ;; {C}+ one or more occurrences of C
228 ;; {C}* zero or more occurrences of C
229 ;; {C} zero or more occurrences of C
230 ;; C / D equivalent to: C {D C}*
231 ;; {C || D}+ equivalent to: C {D C}*
232 ;; {C || D}* equivalent to: [C {D C}*]
233 ;; {C || D} equivalent to: [C {D C}*]
235 ;; The EBNF syntax written using the notation above is:
237 ;; EBNF = {production}+.
239 ;; production = non_terminal "=" body ".". ;; production
241 ;; body = {sequence || "|"}*. ;; alternative
243 ;; sequence = {exception}*. ;; sequence
245 ;; exception = repeat [ "-" repeat]. ;; exception
247 ;; repeat = [ integer "*" [ integer ]] term. ;; repetition
250 ;; | [factor] "+" ;; one-or-more
251 ;; | [factor] "/" [factor] ;; one-or-more
254 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
255 ;; | [ "$" ] non_terminal ;; non-terminal
256 ;; | [ "$" ] "?" special "?" ;; special
257 ;; | "(" body ")" ;; group
258 ;; | "[" body "]" ;; zero-or-one
259 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
260 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
261 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
264 ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
265 ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
266 ;; ;; and lower), 8-bit accentuated characters,
267 ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
268 ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
270 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
271 ;; ;; that is, a valid terminal accepts any printable character (including
272 ;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
273 ;; ;; terminal. Also, accepts escaped characters, that is, a character
274 ;; ;; pair starting with `\' followed by a printable character, for
275 ;; ;; example: \", \\.
277 ;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
278 ;; ;; that is, a valid special accepts any printable character (including
279 ;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
280 ;; ;; delimit a special.
282 ;; integer = "[0-9]+".
283 ;; ;; that is, an integer is a sequence of one or more decimal digits.
285 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
286 ;; ;; that is, a comment starts with the character `;' and terminates at end
287 ;; ;; of line. Also, it only accepts printable characters (including 8-bit
288 ;; ;; accentuated characters) and tabs.
290 ;; Try to use the above EBNF to test ebnf2ps.
292 ;; The `default' terminal, non-terminal and special is a way to indicate a
293 ;; default path in a production. For example, the production:
295 ;; X = [ $A ( B | $C ) | D ].
297 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
299 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
300 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
301 ;; name besides that enclosed by `"'.
303 ;; Let's see an example:
305 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
306 ;; (setq ebnf-case-fold-search nil) ; exact matching
308 ;; If you have the production:
310 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
312 ;; The names are classified as:
314 ;; Logical Expression non-terminal
315 ;; "(" OR AND "XOR" ")" terminal
317 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
318 ;; value is ?\; (character `;').
320 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
321 ;; value is ?. (character `.').
323 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
325 ;; `ebnf' ebnf2ps recognizes the syntax described above.
326 ;; The following variables *ONLY* have effect with this
328 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
329 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
331 ;; `abnf' ebnf2ps recognizes the syntax described in the URL:
332 ;; `http://www.ietf.org/rfc/rfc2234.txt'
333 ;; ("Augmented BNF for Syntax Specifications: ABNF").
335 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
336 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
337 ;; ("International Standard of the ISO EBNF Notation").
338 ;; The following variables *ONLY* have effect with this
340 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
342 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
343 ;; The following variable *ONLY* has effect with this
345 ;; `ebnf-yac-ignore-error-recovery'.
347 ;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
348 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
349 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
351 ;; `dtd' ebnf2ps recognizes the syntax described in the URL:
352 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
353 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
355 ;; Any other value is treated as `ebnf'.
357 ;; The default value is `ebnf'.
363 ;; The following EBNF optimizations are done:
365 ;; [ { A }* ] ==> { A }*
366 ;; [ { A }+ ] ==> { A }*
367 ;; [ A ] + ==> { A }*
368 ;; { A }* + ==> { A }*
369 ;; { A }+ + ==> { A }+
372 ;; ( A | EMPTY )- ==> A
373 ;; ( A | B | EMPTY )- ==> A | B
374 ;; [ A | B ] ==> A | B | EMPTY
375 ;; n * EMPTY ==> EMPTY
377 ;; EMPTY / EMPTY ==> EMPTY
378 ;; EMPTY - A ==> EMPTY
380 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
383 ;; 1. A = B | A C. ==> A = B {C}*.
384 ;; 2. A = B | A B. ==> A = {B}+.
385 ;; 3. A = | A B. ==> A = {B}*.
386 ;; 4. A = B | A C B. ==> A = {B || C}+.
387 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
390 ;; 6. A = B | . ==> A = [B].
391 ;; 7. A = | B . ==> A = [B].
394 ;; 8. A = B C | B D. ==> A = B (C | D).
395 ;; 9. A = C B | D B. ==> A = (C | D) B.
396 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
398 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
404 ;; You may use form feed (^L \014) to force a production to start on a new
405 ;; page, for example:
414 ;; c) A = B ^L^L^L | C.^L
418 ;; In all examples above, only the production X will start on a new page.
421 ;; Actions in Comments
422 ;; -------------------
424 ;; ebnf2ps accepts the following actions in comments:
426 ;; ;^ same as form feed. See section Form Feed above.
428 ;; ;> the next production starts in the same line as the current one.
429 ;; It is useful when `ebnf-horizontal-orientation' is nil.
431 ;; ;< the next production starts in the next line.
432 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
434 ;; ;[EPS open a new EPS file. The EPS file name has the form:
435 ;; <PREFIX><NAME>.eps
436 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
437 ;; <NAME> is the string given by ;[ action comment, this string is
438 ;; mapped to form a valid file name (see documentation for
439 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
440 ;; It has effect only during `ebnf-eps-buffer' or
441 ;; `ebnf-eps-region' execution.
442 ;; It's an error to try to open an already opened EPS file.
444 ;; ;]EPS close an opened EPS file.
445 ;; It has effect only during `ebnf-eps-buffer' or
446 ;; `ebnf-eps-region' execution.
447 ;; It's an error to try to close a not opened EPS file.
449 ;; ;Hheader generate a header in current EPS file. The header string can
450 ;; have the following formats:
452 ;; %% prints a % character.
454 ;; %H prints the `ebnf-eps-header' (which see) value.
456 ;; %F prints the `ebnf-eps-footer' (which see) value.
458 ;; Any other format is ignored, that is, if, for example, it's
459 ;; used %s then %s characters are stripped out from the header.
460 ;; If header is an empty string, no header is generated until a
461 ;; non-empty header is specified or `ebnf-eps-header' has a
462 ;; non-empty string value.
464 ;; ;Ffooter generate a footer in current EPS file. Similar to ;H action
469 ;; (setq ebnf-horizontal-orientation nil)
473 ;; ;> C and B are drawn in the same line
477 ;; The graphical result is:
483 ;; +---------+ +-----+
495 ;; Note that if ascending production sort is used, the productions A and B will
496 ;; be drawn in the same line instead of C and B.
498 ;; If consecutive actions occur, only the last one takes effect, so if you
507 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
510 ;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*)
511 ;; and (*]EPS*). The first example above should be written:
515 ;; (*> C and B are drawn in the same line *)
519 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
520 ;; `ebnf-eps-region':
539 ;; The following table summarizes the results:
541 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
542 ;; ebnf--AA.eps A C A C C A
543 ;; ebnf--BB.eps C B B C C B
544 ;; ebnf--CC.eps A C B F A B C F F C B A
550 ;; As you can see if EPS actions is not used, each single production is
551 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
552 ;; it's not an existing production name.
554 ;; In the following case:
562 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
568 ;; The buffer *Ebnf2ps Log* is where the ebnf2ps log messages are inserted.
569 ;; These messages are intended to help debugging ebnf2ps.
571 ;; The log messages are enabled by `ebnf-log' option (which see). The default
572 ;; value is nil, that is, no log messages are generated.
578 ;; Some tools are provided to help you.
580 ;; `ebnf-setup' returns the current setup.
582 ;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the
585 ;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given
588 ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
591 ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current
594 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
596 ;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer',
597 ;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same
598 ;; way as `ebnf-' commands.
604 ;; ebn2ps has the following hook variables:
607 ;; It is evaluated once before any ebnf2ps process.
609 ;; `ebnf-production-hook'
610 ;; It is evaluated on each beginning of production.
613 ;; It is evaluated on each beginning of page.
619 ;; Below it's shown a brief description of ebnf2ps options, please, see the
620 ;; options declaration in the code for a long documentation.
622 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
625 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
626 ;; height in horizontal orientation.
628 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
629 ;; between productions.
631 ;; `ebnf-production-vertical-space' Specify vertical space in points
632 ;; between productions.
634 ;; `ebnf-justify-sequence' Specify justification of terms in a
635 ;; sequence inside alternatives.
637 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
639 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
641 ;; `ebnf-terminal-font' Specify terminal font.
643 ;; `ebnf-terminal-shape' Specify terminal box shape.
645 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
648 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
650 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
652 ;; `ebnf-production-name-p' Non-nil means production name will be
655 ;; `ebnf-sort-production' Specify how productions are sorted.
657 ;; `ebnf-production-font' Specify production font.
659 ;; `ebnf-non-terminal-font' Specify non-terminal font.
661 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
663 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
666 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
669 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
672 ;; `ebnf-special-show-delimiter' Non-nil means special delimiter
673 ;; (character `?') is shown.
675 ;; `ebnf-special-font' Specify special font.
677 ;; `ebnf-special-shape' Specify special box shape.
679 ;; `ebnf-special-shadow' Non-nil means special box will have a
682 ;; `ebnf-special-border-width' Specify border width for special box.
684 ;; `ebnf-special-border-color' Specify border color for special box.
686 ;; `ebnf-except-font' Specify except font.
688 ;; `ebnf-except-shape' Specify except box shape.
690 ;; `ebnf-except-shadow' Non-nil means except box will have a
693 ;; `ebnf-except-border-width' Specify border width for except box.
695 ;; `ebnf-except-border-color' Specify border color for except box.
697 ;; `ebnf-repeat-font' Specify repeat font.
699 ;; `ebnf-repeat-shape' Specify repeat box shape.
701 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
704 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
706 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
708 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
710 ;; `ebnf-arrow-shape' Specify the arrow shape.
712 ;; `ebnf-chart-shape' Specify chart flow shape.
714 ;; `ebnf-color-p' Non-nil means use color.
716 ;; `ebnf-line-width' Specify flow line width.
718 ;; `ebnf-line-color' Specify flow line color.
720 ;; `ebnf-arrow-extra-width' Specify extra width for arrow shape
723 ;; `ebnf-arrow-scale' Specify the arrow scale.
725 ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
728 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
731 ;; `ebnf-lex-comment-char' Specify the line comment character.
733 ;; `ebnf-lex-eop-char' Specify the end of production
736 ;; `ebnf-syntax' Specify syntax to be recognized.
738 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
740 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
743 ;; `ebnf-default-width' Specify additional border width over
744 ;; default terminal, non-terminal or
747 ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains
750 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
752 ;; `ebnf-eps-header-font' Specify EPS header font.
754 ;; `ebnf-eps-header' Specify EPS header.
756 ;; `ebnf-eps-footer-font' Specify EPS footer font.
758 ;; `ebnf-eps-footer' Specify EPS footer.
760 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
762 ;; `ebnf-stop-on-error' Non-nil means signal error and stop.
763 ;; Nil means signal error and continue.
765 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
767 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
769 ;; `ebnf-optimize' Non-nil means optimize syntactic chart
772 ;; `ebnf-log' Non-nil means generate log messages.
774 ;; To set the above options you may:
776 ;; a) insert the code in your ~/.emacs, like:
778 ;; (setq ebnf-terminal-shape 'bevel)
780 ;; This way always keep your default settings when you enter a new Emacs
783 ;; b) or use `set-variable' in your Emacs session, like:
785 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
787 ;; This way keep your settings only during the current Emacs session.
789 ;; c) or use customization, for example:
790 ;; click on menu-bar *Help* option,
791 ;; then click on *Customize*,
792 ;; then click on *Browse Customization Groups*,
793 ;; expand *PostScript* group,
794 ;; expand *Ebnf2ps* group
795 ;; and then customize ebnf2ps options.
796 ;; Through this way, you may choose if the settings are kept or not when
797 ;; you leave out the current Emacs session.
799 ;; d) or see the option value:
801 ;; C-h v ebnf-terminal-shape RET
803 ;; and click the *customize* hypertext button.
804 ;; Through this way, you may choose if the settings are kept or not when
805 ;; you leave out the current Emacs session.
809 ;; M-x ebnf-customize RET
811 ;; and then customize ebnf2ps options.
812 ;; Through this way, you may choose if the settings are kept or not when
813 ;; you leave out the current Emacs session.
819 ;; Sometimes you need to change the EBNF style you are using, for example,
820 ;; change the shapes and colors. These changes may force you to set some
821 ;; variables and after use, set back the variables to the old values.
823 ;; To help to handle this situation, ebnf2ps has the following commands to
826 ;; `ebnf-find-style' Return style definition if NAME is already defined;
827 ;; otherwise, return nil.
829 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
832 ;; `ebnf-delete-style' Delete style NAME.
834 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
836 ;; `ebnf-apply-style' Set STYLE as the current style.
838 ;; `ebnf-reset-style' Reset current style.
840 ;; `ebnf-push-style' Push the current style and set STYLE as the current
843 ;; `ebnf-pop-style' Pop a style and set it as the current style.
845 ;; These commands help to put together a lot of variable settings in a group
846 ;; and name this group. So when you wish to apply these settings it's only
847 ;; needed to give the name.
849 ;; There is also a notion of simple inheritance of style: if you declare that
850 ;; style A inherits from style B, all settings of B are applied first and then
851 ;; the settings of A are applied. This is useful when you wish to modify some
852 ;; aspects of an existing style, but at same time wish to keep it unmodified.
854 ;; See documentation for `ebnf-style-database'.
860 ;; Below it is the layout of minimum area to draw each element, and it's used
861 ;; the following terms:
863 ;; font height is given by:
864 ;; (terminal font height + non-terminal font height) / 2
866 ;; entry is the vertical position used to know where it should
867 ;; be drawn the flow line in the current element.
869 ;; extra is given by `ebnf-arrow-extra-width'.
872 ;; * SPECIAL, TERMINAL and NON-TERMINAL
874 ;; +==============+...................................
875 ;; | | } font height / 2 } entry }
876 ;; | XXXXXXXX...|....... } }
877 ;; ====+ XXXXXXXX +==== } text height ...... } height
878 ;; : | XXXXXXXX...|...:... }
879 ;; : | : : | : } font height / 2 }
880 ;; : +==============+...:...............................
882 ;; : : : : : :.........................
883 ;; : : : : : } font height }
884 ;; : : : : :....... }
885 ;; : : : : } font height / 2 }
886 ;; : : : :........... }
887 ;; : : : } text width } width
888 ;; : : :.................. }
889 ;; : : } font height / 2 }
890 ;; : :...................... }
891 ;; : } font height + extra }
892 ;; :.................................................
897 ;; +==========+.....................................
901 ;; ===+===+ +===+===... } element height } height
904 ;; : | +==========+.|................. }
905 ;; : | : : | : } font height }
906 ;; : +==============+...................................
908 ;; : : : :......................
909 ;; : : : } font height * 2 }
911 ;; : : } element width } width
912 ;; : :..................... }
913 ;; : } font height * 2 }
914 ;; :...............................................
919 ;; +===+...................................
920 ;; +==+ A +==+ } A height } }
921 ;; | +===+..|........ } entry }
922 ;; + + } font height } }
923 ;; / +===+...\....... } }
924 ;; ===+====+ B +====+=== } B height ..... } height
925 ;; : \ +===+.../....... }
926 ;; : + + : } font height }
927 ;; : | +===+..|........ }
928 ;; : +==+ C +==+ : } C height }
929 ;; : : +===+...................................
931 ;; : : : :......................
932 ;; : : : } font height * 2 }
934 ;; : : } max width } width
935 ;; : :................. }
936 ;; : } font height * 2 }
937 ;; :..........................................
940 ;; 1. An empty alternative has zero of height.
942 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
948 ;; +===========+...............................
949 ;; +=+ separator +=+ } separator height }
950 ;; / +===========+..\........ }
952 ;; | | } font height }
954 ;; \ +===========+../........ } height = entry
955 ;; +=+ element +=+ } element height }
956 ;; /: +===========+..\........ }
958 ;; + : : + } font height }
960 ;; ==+=======================+==.......................
962 ;; : : : :.......................
963 ;; : : : } font height * 2 }
965 ;; : : } max width } width
966 ;; : :......................... }
967 ;; : } font height * 2 }
968 ;; :...................................................
973 ;; +===========+......................................
974 ;; +=+ separator +=+ } separator height } }
975 ;; / +===========+..\...... } }
977 ;; | | } font height } } height
979 ;; \ +===========+../...... } }
980 ;; ===+=+ element +=+=== } element height .... }
981 ;; : : +===========+......................................
983 ;; : : : :........................
984 ;; : : : } font height * 2 }
986 ;; : : } max width } width
987 ;; : :....................... }
988 ;; : } font height * 2 }
989 ;; :..............................................
994 ;; XXXXXX:......................................
995 ;; XXXXXX: } production font height }
996 ;; XXXXXX:............ }
998 ;; +======+....... } height = entry
1000 ;; ====+ +==== } element height }
1002 ;; : +======+.................................
1004 ;; : : : :......................
1005 ;; : : : } font height * 2 }
1007 ;; : : } element width } width
1008 ;; : :.............. }
1009 ;; : } font height * 2 }
1010 ;; :.....................................
1015 ;; +================+...................................
1016 ;; | | } font height / 2 } entry }
1017 ;; | +===+...|....... } }
1018 ;; ====+ N * | X | +==== } X height ......... } height
1019 ;; : | : : +===+...|...:... }
1020 ;; : | : : : : | : } font height / 2 }
1021 ;; : +================+...:...............................
1023 ;; : : : : : : : :..........................
1024 ;; : : : : : : : } font height }
1025 ;; : : : : : : :....... }
1026 ;; : : : : : : } font height / 2 }
1027 ;; : : : : : :........... }
1028 ;; : : : : : } X width }
1029 ;; : : : : :............... }
1030 ;; : : : : } font height / 2 } width
1031 ;; : : : :.................. }
1032 ;; : : : } text width }
1033 ;; : : :..................... }
1034 ;; : : } font height / 2 }
1035 ;; : :........................ }
1036 ;; : } font height + extra }
1037 ;; :...................................................
1042 ;; +==================+...................................
1043 ;; | | } font height / 2 } entry }
1044 ;; | +===+ +===+...|....... } }
1045 ;; ====+ | X | - | y | +==== } max height ....... } height
1046 ;; : | +===+ +===+...|...:... }
1047 ;; : | : : : : | : } font height / 2 }
1048 ;; : +==================+...:...............................
1050 ;; : : : : : : : :..........................
1051 ;; : : : : : : : } font height }
1052 ;; : : : : : : :....... }
1053 ;; : : : : : : } font height / 2 }
1054 ;; : : : : : :........... }
1055 ;; : : : : : } Y width }
1056 ;; : : : : :............... }
1057 ;; : : : : } font height } width
1058 ;; : : : :................... }
1059 ;; : : : } X width }
1060 ;; : : :....................... }
1061 ;; : : } font height / 2 }
1062 ;; : :.......................... }
1063 ;; : } font height + extra }
1064 ;; :.....................................................
1066 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
1069 ;; Internal Structures
1070 ;; -------------------
1072 ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis
1073 ;; of current buffer and generates an intermediate representation. The second
1074 ;; pass uses the intermediate representation to generate the PostScript
1077 ;; The intermediate representation is a list of vectors, the vector element
1078 ;; represents a syntactic chart element. Below is a vector representation for
1079 ;; each syntactic chart element.
1081 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
1082 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1083 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1084 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1085 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1086 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1087 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
1088 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
1089 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1090 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1091 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
1092 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
1094 ;; The first vector position is a function symbol used to generate PostScript
1095 ;; for this element.
1096 ;; WIDTH-FUN is a function symbol called to adjust the element width.
1097 ;; DIM-FUN is a function symbol called to set the element dimensions.
1098 ;; ENTRY is the element entry point.
1099 ;; HEIGHT and WIDTH are the element height and width, respectively.
1100 ;; NAME is a string that it's the element name.
1101 ;; DEFAULT is a boolean that indicates if it's a `default' element.
1102 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
1104 ;; LIST is a list of vector that represents the list part for alternatives and
1106 ;; SEPARATOR is a vector that represents the sub-element used to separate the
1108 ;; TIMES is a string representing the number of times that ELEMENT is repeated
1109 ;; on a repeat construction.
1110 ;; ACTION indicates some action that should be done before production is
1111 ;; generated. The current actions are:
1115 ;; form-feed current production starts on a new page.
1117 ;; newline current production starts on next line, this is useful
1118 ;; when `ebnf-horizontal-orientation' is non-nil.
1120 ;; keep-line current production continues on the current line, this
1121 ;; is useful when `ebnf-horizontal-orientation' is nil.
1127 ;; . Handle situations when syntactic chart is out of paper.
1128 ;; . Use other alphabet than ascii.
1129 ;; . Optimizations...
1135 ;; Thanks to Eli Zaretskii <eliz@gnu.org> for some doc fixes.
1137 ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
1138 ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale',
1139 ;; `ebnf-production-name-p', `ebnf-stop-on-error',
1140 ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
1141 ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
1145 ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
1146 ;; with some Bison features (%right, %left and %prec pragmas). His suggestion
1147 ;; was extended to deal with %nonassoc pragma too.
1149 ;; Thanks to all who emailed comments.
1152 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1159 (and (string< ps-print-version
"5.2.3")
1160 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1163 ;; to avoid gripes with Emacs 20
1164 (or (fboundp 'assq-delete-all
)
1165 (defun assq-delete-all (key alist
)
1166 "Delete from ALIST all elements whose car is KEY.
1167 Return the modified alist.
1168 Elements of ALIST that are not conses are ignored."
1171 (if (and (consp (car tail
))
1172 (eq (car (car tail
)) key
))
1173 (setq alist
(delq (car tail
) alist
)))
1174 (setq tail
(cdr tail
)))
1178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1182 ;;; Interface to the command system
1184 (defgroup postscript nil
1191 (defgroup ebnf2ps nil
1192 "Translate an EBNF to a syntactic chart on PostScript."
1199 (defgroup ebnf-special nil
1200 "Special customization."
1207 (defgroup ebnf-except nil
1208 "Except customization."
1215 (defgroup ebnf-repeat nil
1216 "Repeat customization."
1223 (defgroup ebnf-terminal nil
1224 "Terminal customization."
1231 (defgroup ebnf-non-terminal nil
1232 "Non-Terminal customization."
1239 (defgroup ebnf-production nil
1240 "Production customization."
1247 (defgroup ebnf-shape nil
1248 "Shapes customization."
1255 (defgroup ebnf-displacement nil
1256 "Displacement customization."
1263 (defgroup ebnf-syntactic nil
1264 "Syntactic customization."
1271 (defgroup ebnf-optimization nil
1272 "Optimization customization."
1279 (defcustom ebnf-horizontal-orientation nil
1280 "*Non-nil means productions are drawn horizontally."
1283 :group
'ebnf-displacement
)
1286 (defcustom ebnf-horizontal-max-height nil
1287 "*Non-nil means to use maximum production height in horizontal orientation.
1289 It is only used when `ebnf-horizontal-orientation' is non-nil."
1292 :group
'ebnf-displacement
)
1295 (defcustom ebnf-production-horizontal-space
0.0 ; use ebnf2ps default value
1296 "*Specify horizontal space in points between productions.
1298 Value less or equal to zero forces ebnf2ps to set a proper default value."
1301 :group
'ebnf-displacement
)
1304 (defcustom ebnf-production-vertical-space
0.0 ; use ebnf2ps default value
1305 "*Specify vertical space in points between productions.
1307 Value less or equal to zero forces ebnf2ps to set a proper default value."
1310 :group
'ebnf-displacement
)
1313 (defcustom ebnf-justify-sequence
'center
1314 "*Specify justification of terms in a sequence inside alternatives.
1318 `left' left justification
1319 `right' right justification
1320 any other value centralize"
1321 :type
'(radio :tag
"Sequence Justification"
1322 (const left
) (const right
) (other :tag
"center" center
))
1324 :group
'ebnf-displacement
)
1327 (defcustom ebnf-special-show-delimiter t
1328 "*Non-nil means special delimiter (character `?') is shown."
1331 :group
'ebnf-special
)
1334 (defcustom ebnf-special-font
'(7 Courier
"Black" "Gray95" bold italic
)
1335 "*Specify special font.
1337 See documentation for `ebnf-production-font'."
1338 :type
'(list :tag
"Special Font"
1339 (number :tag
"Font Size")
1340 (symbol :tag
"Font Name")
1341 (choice :tag
"Foreground Color"
1342 (string :tag
"Name")
1343 (other :tag
"Default" nil
))
1344 (choice :tag
"Background Color"
1345 (string :tag
"Name")
1346 (other :tag
"Default" nil
))
1347 (repeat :tag
"Font Attributes" :inline t
1348 (choice (const bold
) (const italic
)
1349 (const underline
) (const strikeout
)
1350 (const overline
) (const shadow
)
1351 (const box
) (const outline
))))
1353 :group
'ebnf-special
)
1356 (defcustom ebnf-special-shape
'bevel
1357 "*Specify special box shape.
1359 See documentation for `ebnf-non-terminal-shape'."
1360 :type
'(radio :tag
"Special Shape"
1361 (const miter
) (const round
) (const bevel
))
1363 :group
'ebnf-special
)
1366 (defcustom ebnf-special-shadow nil
1367 "*Non-nil means special box will have a shadow."
1370 :group
'ebnf-special
)
1373 (defcustom ebnf-special-border-width
0.5
1374 "*Specify border width for special box."
1377 :group
'ebnf-special
)
1380 (defcustom ebnf-special-border-color
"Black"
1381 "*Specify border color for special box."
1384 :group
'ebnf-special
)
1387 (defcustom ebnf-except-font
'(7 Courier
"Black" "Gray90" bold italic
)
1388 "*Specify except font.
1390 See documentation for `ebnf-production-font'."
1391 :type
'(list :tag
"Except Font"
1392 (number :tag
"Font Size")
1393 (symbol :tag
"Font Name")
1394 (choice :tag
"Foreground Color"
1395 (string :tag
"Name")
1396 (other :tag
"Default" nil
))
1397 (choice :tag
"Background Color"
1398 (string :tag
"Name")
1399 (other :tag
"Default" nil
))
1400 (repeat :tag
"Font Attributes" :inline t
1401 (choice (const bold
) (const italic
)
1402 (const underline
) (const strikeout
)
1403 (const overline
) (const shadow
)
1404 (const box
) (const outline
))))
1406 :group
'ebnf-except
)
1409 (defcustom ebnf-except-shape
'bevel
1410 "*Specify except box shape.
1412 See documentation for `ebnf-non-terminal-shape'."
1413 :type
'(radio :tag
"Except Shape"
1414 (const miter
) (const round
) (const bevel
))
1416 :group
'ebnf-except
)
1419 (defcustom ebnf-except-shadow nil
1420 "*Non-nil means except box will have a shadow."
1423 :group
'ebnf-except
)
1426 (defcustom ebnf-except-border-width
0.25
1427 "*Specify border width for except box."
1430 :group
'ebnf-except
)
1433 (defcustom ebnf-except-border-color
"Black"
1434 "*Specify border color for except box."
1437 :group
'ebnf-except
)
1440 (defcustom ebnf-repeat-font
'(7 Courier
"Black" "Gray85" bold italic
)
1441 "*Specify repeat font.
1443 See documentation for `ebnf-production-font'."
1444 :type
'(list :tag
"Repeat Font"
1445 (number :tag
"Font Size")
1446 (symbol :tag
"Font Name")
1447 (choice :tag
"Foreground Color"
1448 (string :tag
"Name")
1449 (other :tag
"Default" nil
))
1450 (choice :tag
"Background Color"
1451 (string :tag
"Name")
1452 (other :tag
"Default" nil
))
1453 (repeat :tag
"Font Attributes" :inline t
1454 (choice (const bold
) (const italic
)
1455 (const underline
) (const strikeout
)
1456 (const overline
) (const shadow
)
1457 (const box
) (const outline
))))
1459 :group
'ebnf-repeat
)
1462 (defcustom ebnf-repeat-shape
'bevel
1463 "*Specify repeat box shape.
1465 See documentation for `ebnf-non-terminal-shape'."
1466 :type
'(radio :tag
"Repeat Shape"
1467 (const miter
) (const round
) (const bevel
))
1469 :group
'ebnf-repeat
)
1472 (defcustom ebnf-repeat-shadow nil
1473 "*Non-nil means repeat box will have a shadow."
1476 :group
'ebnf-repeat
)
1479 (defcustom ebnf-repeat-border-width
0.0
1480 "*Specify border width for repeat box."
1483 :group
'ebnf-repeat
)
1486 (defcustom ebnf-repeat-border-color
"Black"
1487 "*Specify border color for repeat box."
1490 :group
'ebnf-repeat
)
1493 (defcustom ebnf-terminal-font
'(7 Courier
"Black" "White")
1494 "*Specify terminal font.
1496 See documentation for `ebnf-production-font'."
1497 :type
'(list :tag
"Terminal Font"
1498 (number :tag
"Font Size")
1499 (symbol :tag
"Font Name")
1500 (choice :tag
"Foreground Color"
1501 (string :tag
"Name")
1502 (other :tag
"Default" nil
))
1503 (choice :tag
"Background Color"
1504 (string :tag
"Name")
1505 (other :tag
"Default" nil
))
1506 (repeat :tag
"Font Attributes" :inline t
1507 (choice (const bold
) (const italic
)
1508 (const underline
) (const strikeout
)
1509 (const overline
) (const shadow
)
1510 (const box
) (const outline
))))
1512 :group
'ebnf-terminal
)
1515 (defcustom ebnf-terminal-shape
'miter
1516 "*Specify terminal box shape.
1518 See documentation for `ebnf-non-terminal-shape'."
1519 :type
'(radio :tag
"Terminal Shape"
1520 (const miter
) (const round
) (const bevel
))
1522 :group
'ebnf-terminal
)
1525 (defcustom ebnf-terminal-shadow nil
1526 "*Non-nil means terminal box will have a shadow."
1529 :group
'ebnf-terminal
)
1532 (defcustom ebnf-terminal-border-width
1.0
1533 "*Specify border width for terminal box."
1536 :group
'ebnf-terminal
)
1539 (defcustom ebnf-terminal-border-color
"Black"
1540 "*Specify border color for terminal box."
1543 :group
'ebnf-terminal
)
1546 (defcustom ebnf-production-name-p t
1547 "*Non-nil means production name will be printed."
1550 :group
'ebnf-production
)
1553 (defcustom ebnf-sort-production nil
1554 "*Specify how productions are sorted.
1558 nil don't sort productions.
1559 `ascending' ascending sort.
1560 any other value descending sort."
1561 :type
'(radio :tag
"Production Sort"
1562 (const :tag
"Ascending" ascending
)
1563 (const :tag
"Descending" descending
)
1564 (other :tag
"No Sort" nil
))
1566 :group
'ebnf-production
)
1569 (defcustom ebnf-production-font
'(10 Helvetica
"Black" "White" bold
)
1570 "*Specify production header font.
1572 It is a list with the following form:
1574 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1577 SIZE is the font size.
1578 NAME is the font name symbol.
1579 ATTRIBUTE is one of the following symbols:
1580 bold - use bold font.
1581 italic - use italic font.
1582 underline - put a line under text.
1583 strikeout - like underline, but the line is in middle of text.
1584 overline - like underline, but the line is over the text.
1585 shadow - text will have a shadow.
1586 box - text will be surrounded by a box.
1587 outline - print characters as hollow outlines.
1588 FOREGROUND is a foreground string color name; if it's nil, the default color is
1590 BACKGROUND is a background string color name; if it's nil, the default color is
1593 See `ps-font-info-database' for valid font name."
1594 :type
'(list :tag
"Production Font"
1595 (number :tag
"Font Size")
1596 (symbol :tag
"Font Name")
1597 (choice :tag
"Foreground Color"
1598 (string :tag
"Name")
1599 (other :tag
"Default" nil
))
1600 (choice :tag
"Background Color"
1601 (string :tag
"Name")
1602 (other :tag
"Default" nil
))
1603 (repeat :tag
"Font Attributes" :inline t
1604 (choice (const bold
) (const italic
)
1605 (const underline
) (const strikeout
)
1606 (const overline
) (const shadow
)
1607 (const box
) (const outline
))))
1609 :group
'ebnf-production
)
1612 (defcustom ebnf-non-terminal-font
'(7 Helvetica
"Black" "White")
1613 "*Specify non-terminal font.
1615 See documentation for `ebnf-production-font'."
1616 :type
'(list :tag
"Non-Terminal Font"
1617 (number :tag
"Font Size")
1618 (symbol :tag
"Font Name")
1619 (choice :tag
"Foreground Color"
1620 (string :tag
"Name")
1621 (other :tag
"Default" nil
))
1622 (choice :tag
"Background Color"
1623 (string :tag
"Name")
1624 (other :tag
"Default" nil
))
1625 (repeat :tag
"Font Attributes" :inline t
1626 (choice (const bold
) (const italic
)
1627 (const underline
) (const strikeout
)
1628 (const overline
) (const shadow
)
1629 (const box
) (const outline
))))
1631 :group
'ebnf-non-terminal
)
1634 (defcustom ebnf-non-terminal-shape
'round
1635 "*Specify non-terminal box shape.
1651 Any other value is treated as `miter'."
1652 :type
'(radio :tag
"Non-Terminal Shape"
1653 (const miter
) (const round
) (const bevel
))
1655 :group
'ebnf-non-terminal
)
1658 (defcustom ebnf-non-terminal-shadow nil
1659 "*Non-nil means non-terminal box will have a shadow."
1662 :group
'ebnf-non-terminal
)
1665 (defcustom ebnf-non-terminal-border-width
1.0
1666 "*Specify border width for non-terminal box."
1669 :group
'ebnf-non-terminal
)
1672 (defcustom ebnf-non-terminal-border-color
"Black"
1673 "*Specify border color for non-terminal box."
1676 :group
'ebnf-non-terminal
)
1679 (defcustom ebnf-arrow-shape
'hollow
1680 "*Specify the arrow shape.
1686 `semi-up' * `transparent' *
1694 `semi-down' =====* `hollow' *
1710 `semi-up-hollow' `semi-up-full'
1716 `semi-down-hollow' `semi-down-full'
1722 `user' See also documentation for variable `ebnf-user-arrow'.
1724 Any other value is treated as `none'."
1725 :type
'(radio :tag
"Arrow Shape"
1726 (const none
) (const semi-up
)
1727 (const semi-down
) (const simple
)
1728 (const transparent
) (const hollow
)
1729 (const full
) (const semi-up-hollow
)
1730 (const semi-down-hollow
) (const semi-up-full
)
1731 (const semi-down-full
) (const user
))
1736 (defcustom ebnf-chart-shape
'round
1737 "*Specify chart flow shape.
1739 See documentation for `ebnf-non-terminal-shape'."
1740 :type
'(radio :tag
"Chart Flow Shape"
1741 (const miter
) (const round
) (const bevel
))
1746 (defcustom ebnf-user-arrow nil
1747 "*Specify a sexp for user arrow shape (a PostScript code).
1749 When evaluated, the sexp should return nil or a string containing PostScript
1750 code. PostScript code should draw a right arrow.
1752 The anatomy of a right arrow is:
1754 ...... Initial position
1756 : *.................
1760 ======+======*... } hT2
1764 : *.................
1770 :.......................
1772 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1773 be used to generate your own arrow. As these variables are used along
1774 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1775 values, if you need to modify them.
1777 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1779 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1781 :type
'(sexp :tag
"User Arrow Shape")
1786 (defcustom ebnf-syntax
'ebnf
1787 "*Specify syntax to be recognized.
1791 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1793 The following variables *ONLY* have effect with this
1795 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1796 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1798 `abnf' ebnf2ps recognizes the syntax described in the URL:
1799 `http://www.ietf.org/rfc/rfc2234.txt'
1800 (\"Augmented BNF for Syntax Specifications: ABNF\").
1802 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1803 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1804 (\"International Standard of the ISO EBNF Notation\").
1805 The following variables *ONLY* have effect with this
1807 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1809 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1810 The following variable *ONLY* has effect with this
1812 `ebnf-yac-ignore-error-recovery'.
1814 `ebnfx' ebnf2ps recognizes the syntax described in the URL:
1815 `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
1816 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1818 `dtd' ebnf2ps recognizes the syntax described in the URL:
1819 `http://www.w3.org/TR/2004/REC-xml-20040204/'
1820 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1822 Any other value is treated as `ebnf'."
1823 :type
'(radio :tag
"Syntax"
1824 (const ebnf
) (const abnf
) (const iso-ebnf
)
1825 (const yacc
) (const ebnfx
) (const dtd
))
1827 :group
'ebnf-syntactic
)
1830 (defcustom ebnf-lex-comment-char ?\
;
1831 "*Specify the line comment character.
1833 It's used only when `ebnf-syntax' is `ebnf'."
1836 :group
'ebnf-syntactic
)
1839 (defcustom ebnf-lex-eop-char ?.
1840 "*Specify the end of production character.
1842 It's used only when `ebnf-syntax' is `ebnf'."
1845 :group
'ebnf-syntactic
)
1848 (defcustom ebnf-terminal-regexp nil
1849 "*Specify how it's a terminal name.
1851 If it's nil, the terminal name must be enclosed by `\"'.
1852 If it's a string, it should be a regexp that it'll be used to determine a
1853 terminal name; terminal name may also be enclosed by `\"'.
1855 It's used only when `ebnf-syntax' is `ebnf'."
1856 :type
'(radio :tag
"Terminal Name"
1859 :group
'ebnf-syntactic
)
1862 (defcustom ebnf-case-fold-search nil
1863 "*Non-nil means ignore case on matching.
1865 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1869 :group
'ebnf-syntactic
)
1872 (defcustom ebnf-iso-alternative-p nil
1873 "*Non-nil means use alternative ISO EBNF.
1875 It's only used when `ebnf-syntax' is `iso-ebnf'.
1877 This variable affects the following symbol set:
1879 STANDARD ALTERNATIVE
1888 :group
'ebnf-syntactic
)
1891 (defcustom ebnf-iso-normalize-p nil
1892 "*Non-nil means normalize ISO EBNF syntax names.
1894 Normalize a name means that several contiguous spaces inside name become a
1895 single space, so \"A B C\" is normalized to \"A B C\".
1897 It's only used when `ebnf-syntax' is `iso-ebnf'."
1900 :group
'ebnf-syntactic
)
1903 (defcustom ebnf-file-suffix-regexp
"\.[Bb][Nn][Ff]$"
1904 "*Specify file name suffix that contains EBNF.
1906 See `ebnf-eps-directory' command."
1912 (defcustom ebnf-eps-prefix
"ebnf--"
1913 "*Specify EPS prefix file name.
1915 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1921 (defcustom ebnf-eps-header-font
'(11 Helvetica
"Black" "White" bold
)
1922 "*Specify EPS header font.
1924 See documentation for `ebnf-production-font'.
1926 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1927 :type
'(list :tag
"EPS Header Font"
1928 (number :tag
"Font Size")
1929 (symbol :tag
"Font Name")
1930 (choice :tag
"Foreground Color"
1931 (string :tag
"Name")
1932 (other :tag
"Default" nil
))
1933 (choice :tag
"Background Color"
1934 (string :tag
"Name")
1935 (other :tag
"Default" nil
))
1936 (repeat :tag
"Font Attributes" :inline t
1937 (choice (const bold
) (const italic
)
1938 (const underline
) (const strikeout
)
1939 (const overline
) (const shadow
)
1940 (const box
) (const outline
))))
1945 (defcustom ebnf-eps-header nil
1946 "*Specify EPS header.
1948 The value should be a string, a symbol or nil.
1950 String is inserted unchanged.
1952 For symbol bounded to a function, the function is called and should return a
1953 string. For symbol bounded to a value, the value should be a string.
1955 If symbol is unbounded, it is silently ignored.
1957 Empty string or nil mean that no header will be generated.
1959 Note that when the header action comment (;H in EBNF syntax) is specified, the
1960 string in the header action comment is processed and, if it returns a non-empty
1961 string, it's used to generate the header. The header action comment accepts
1962 the following formats:
1964 %% prints a % character.
1966 %H prints the `ebnf-eps-header' value.
1968 %F prints the `ebnf-eps-footer' (which see) value.
1970 Any other format is ignored, that is, if, for example, it's used %s then %s
1971 characters are stripped out from the header. If header action comment is an
1972 empty string, no header is generated until a non-empty header is specified or
1973 `ebnf-eps-header' has a non-empty string value."
1974 :type
'(repeat (choice :menu-tag
"EPS Header"
1976 string symbol
(const :tag
"No Header" nil
)))
1981 (defcustom ebnf-eps-footer-font
'(7 Helvetica
"Black" "White" bold
)
1982 "*Specify EPS footer font.
1984 See documentation for `ebnf-production-font'.
1986 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1987 :type
'(list :tag
"EPS Footer Font"
1988 (number :tag
"Font Size")
1989 (symbol :tag
"Font Name")
1990 (choice :tag
"Foreground Color"
1991 (string :tag
"Name")
1992 (other :tag
"Default" nil
))
1993 (choice :tag
"Background Color"
1994 (string :tag
"Name")
1995 (other :tag
"Default" nil
))
1996 (repeat :tag
"Font Attributes" :inline t
1997 (choice (const bold
) (const italic
)
1998 (const underline
) (const strikeout
)
1999 (const overline
) (const shadow
)
2000 (const box
) (const outline
))))
2005 (defcustom ebnf-eps-footer nil
2006 "*Specify EPS footer.
2008 The value should be a string, a symbol or nil.
2010 String is inserted unchanged.
2012 For symbol bounded to a function, the function is called and should return a
2013 string. For symbol bounded to a value, the value should be a string.
2015 If symbol is unbounded, it is silently ignored.
2017 Empty string or nil mean that no footer will be generated.
2019 Note that when the footer action comment (;F in EBNF syntax) is specified, the
2020 string in the footer action comment is processed and, if it returns a non-empty
2021 string, it's used to generate the footer. The footer action comment accepts
2022 the following formats:
2024 %% prints a % character.
2026 %H prints the `ebnf-eps-header' (which see) value.
2028 %F prints the `ebnf-eps-footer' value.
2030 Any other format is ignored, that is, if, for example, it's used %s then %s
2031 characters are stripped out from the footer. If footer action comment is an
2032 empty string, no footer is generated until a non-empty footer is specified or
2033 `ebnf-eps-footer' has a non-empty string value."
2034 :type
'(repeat (choice :menu-tag
"EPS Footer"
2036 string symbol
(const :tag
"No Footer" nil
)))
2041 (defcustom ebnf-entry-percentage
0.5 ; middle
2042 "*Specify entry height on alternatives.
2044 It must be a float between 0.0 (top) and 1.0 (bottom)."
2050 (defcustom ebnf-default-width
0.6
2051 "*Specify additional border width over default terminal, non-terminal or
2058 ;; Printing color requires x-color-values.
2059 (defcustom ebnf-color-p
(or (fboundp 'x-color-values
) ; Emacs
2060 (fboundp 'color-instance-rgb-components
)) ; XEmacs
2061 "*Non-nil means use color."
2067 (defcustom ebnf-line-width
1.0
2068 "*Specify flow line width."
2074 (defcustom ebnf-line-color
"Black"
2075 "*Specify flow line color."
2081 (defcustom ebnf-arrow-extra-width
2082 (if (eq ebnf-arrow-shape
'none
)
2084 (* (sqrt 5.0) 0.65 ebnf-line-width
))
2085 "*Specify extra width for arrow shape drawing.
2087 The extra width is used to avoid that the arrowhead and the terminal border
2088 overlap. It depens on `ebnf-arrow-shape' and `ebnf-line-width'."
2094 (defcustom ebnf-arrow-scale
1.0
2095 "*Specify the arrow scale.
2097 Values lower than 1.0, shrink the arrow.
2098 Values greater than 1.0, expand the arrow."
2104 (defcustom ebnf-debug-ps nil
2105 "*Non-nil means to generate PostScript debug procedures.
2107 It is intended to help PostScript programmers in debugging."
2113 (defcustom ebnf-use-float-format t
2114 "*Non-nil means use `%f' float format.
2116 The advantage of using float format is that ebnf2ps generates a little short
2119 If it occurs the error message:
2121 Invalid format operation %f
2123 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
2129 (defcustom ebnf-stop-on-error nil
2130 "*Non-nil means signal error and stop. Otherwise, signal error and continue."
2136 (defcustom ebnf-yac-ignore-error-recovery nil
2137 "*Non-nil means ignore error recovery.
2139 It's only used when `ebnf-syntax' is `yacc'."
2142 :group
'ebnf-syntactic
)
2145 (defcustom ebnf-ignore-empty-rule nil
2146 "*Non-nil means ignore empty rules.
2148 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
2149 middle action rule."
2152 :group
'ebnf-optimization
)
2155 (defcustom ebnf-optimize nil
2156 "*Non-nil means optimize syntactic chart of rules.
2158 The following optimizations are done:
2161 1. A = B | A C. ==> A = B {C}*.
2162 2. A = B | A B. ==> A = {B}+.
2163 3. A = | A B. ==> A = {B}*.
2164 4. A = B | A C B. ==> A = {B || C}+.
2165 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
2168 6. A = B | . ==> A = [B].
2169 7. A = | B . ==> A = [B].
2172 8. A = B C | B D. ==> A = B (C | D).
2173 9. A = C B | D B. ==> A = (C | D) B.
2174 10. A = B C E | B D E. ==> A = B (C | D) E.
2176 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
2179 :group
'ebnf-optimization
)
2182 (defcustom ebnf-log nil
2183 "*Non-nil means generate log messages.
2185 The log messages are generated into the buffer *Ebnf2ps Log*.
2186 These messages are intended to help debugging ebnf2ps."
2192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2193 ;; To make this file smaller, some commands go in a separate file.
2194 ;; But autoload them here to make the separation invisible.
2195 ;; Autoload is here to avoid compilation gripes.
2197 (autoload 'ebnf-eliminate-empty-rules
"ebnf-otz"
2198 "Eliminate empty rules.")
2200 (autoload 'ebnf-optimize
"ebnf-otz"
2201 "Syntactic chart optimizer.")
2203 (autoload 'ebnf-otz-initialize
"ebnf-otz"
2204 "Initialize optimizer.")
2207 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2212 (defun ebnf-customize ()
2213 "Customization for ebnf group."
2215 (customize-group 'ebnf2ps
))
2218 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2223 (defun ebnf-print-directory (&optional directory
)
2224 "Generate and print a PostScript syntactic chart image of DIRECTORY.
2226 If DIRECTORY is nil, it's used `default-directory'.
2228 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2231 See also `ebnf-print-buffer'."
2233 (list (read-file-name "Directory containing EBNF files (print): "
2234 nil default-directory
)))
2235 (ebnf-log-header "(ebnf-print-directory %S)" directory
)
2236 (ebnf-directory 'ebnf-print-buffer directory
))
2240 (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done
)
2241 "Generate and print a PostScript syntactic chart image of the file FILE.
2243 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2244 killed after process termination.
2246 See also `ebnf-print-buffer'."
2247 (interactive "fEBNF file to generate PostScript and print from: ")
2248 (ebnf-log-header "(ebnf-print-file %S %S)" file do-not-kill-buffer-when-done
)
2249 (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done
))
2253 (defun ebnf-print-buffer (&optional filename
)
2254 "Generate and print a PostScript syntactic chart image of the buffer.
2256 When called with a numeric prefix argument (C-u), prompts the user for
2257 the name of a file to save the PostScript image in, instead of sending
2260 More specifically, the FILENAME argument is treated as follows: if it
2261 is nil, send the image to the printer. If FILENAME is a string, save
2262 the PostScript image in a file with that name. If FILENAME is a
2263 number, prompt the user for the name of the file to save in."
2264 (interactive (list (ps-print-preprint current-prefix-arg
)))
2265 (ebnf-log-header "(ebnf-print-buffer %S)" filename
)
2266 (ebnf-print-region (point-min) (point-max) filename
))
2270 (defun ebnf-print-region (from to
&optional filename
)
2271 "Generate and print a PostScript syntactic chart image of the region.
2272 Like `ebnf-print-buffer', but prints just the current region."
2273 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
2274 (ebnf-log-header "(ebnf-print-region %S %S %S)" from to filename
)
2275 (run-hooks 'ebnf-hook
)
2276 (or (ebnf-spool-region from to
)
2277 (ps-do-despool filename
)))
2281 (defun ebnf-spool-directory (&optional directory
)
2282 "Generate and spool a PostScript syntactic chart image of DIRECTORY.
2284 If DIRECTORY is nil, it's used `default-directory'.
2286 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2289 See also `ebnf-spool-buffer'."
2291 (list (read-file-name "Directory containing EBNF files (spool): "
2292 nil default-directory
)))
2293 (ebnf-log-header "(ebnf-spool-directory %S)" directory
)
2294 (ebnf-directory 'ebnf-spool-buffer directory
))
2298 (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done
)
2299 "Generate and spool a PostScript syntactic chart image of the file FILE.
2301 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2302 killed after process termination.
2304 See also `ebnf-spool-buffer'."
2305 (interactive "fEBNF file to generate PostScript and spool from: ")
2306 (ebnf-log-header "(ebnf-spool-file %S %S)" file do-not-kill-buffer-when-done
)
2307 (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done
))
2311 (defun ebnf-spool-buffer ()
2312 "Generate and spool a PostScript syntactic chart image of the buffer.
2313 Like `ebnf-print-buffer' except that the PostScript image is saved in a
2314 local buffer to be sent to the printer later.
2316 Use the command `ebnf-despool' to send the spooled images to the printer."
2318 (ebnf-log-header "(ebnf-spool-buffer)")
2319 (ebnf-spool-region (point-min) (point-max)))
2323 (defun ebnf-spool-region (from to
)
2324 "Generate a PostScript syntactic chart image of the region and spool locally.
2325 Like `ebnf-spool-buffer', but spools just the current region.
2327 Use the command `ebnf-despool' to send the spooled images to the printer."
2329 (ebnf-log-header "(ebnf-spool-region %S)" from to
)
2330 (ebnf-generate-region from to
'ebnf-generate
))
2334 (defun ebnf-eps-directory (&optional directory
)
2335 "Generate EPS files from EBNF files in DIRECTORY.
2337 If DIRECTORY is nil, it's used `default-directory'.
2339 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2342 See also `ebnf-eps-buffer'."
2344 (list (read-file-name "Directory containing EBNF files (EPS): "
2345 nil default-directory
)))
2346 (ebnf-log-header "(ebnf-eps-directory %S)" directory
)
2347 (ebnf-directory 'ebnf-eps-buffer directory
))
2351 (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done
)
2352 "Generate an EPS file from EBNF file FILE.
2354 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2355 killed after EPS generation.
2357 See also `ebnf-eps-buffer'."
2358 (interactive "fEBNF file to generate EPS file from: ")
2359 (ebnf-log-header "(ebnf-eps-file %S %S)" file do-not-kill-buffer-when-done
)
2360 (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done
))
2364 (defun ebnf-eps-buffer ()
2365 "Generate a PostScript syntactic chart image of the buffer in an EPS file.
2367 Generate an EPS file for each production in the buffer.
2368 The EPS file name has the following form:
2370 <PREFIX><PRODUCTION>.eps
2372 <PREFIX> is given by variable `ebnf-eps-prefix'.
2373 The default value is \"ebnf--\".
2375 <PRODUCTION> is the production name.
2376 Some characters in the production file name are replaced to
2377 produce a valid file name. For example, the production name
2378 \"A/B + C\" is modified to produce \"A_B_+_C\", and the EPS
2379 file name used in this case will be \"ebnf--A_B_+_C.eps\".
2381 WARNING: This function does *NOT* ask any confirmation to override existing
2384 (ebnf-log-header "(ebnf-eps-buffer)")
2385 (ebnf-eps-region (point-min) (point-max)))
2389 (defun ebnf-eps-region (from to
)
2390 "Generate a PostScript syntactic chart image of the region in an EPS file.
2392 Generate an EPS file for each production in the region.
2393 The EPS file name has the following form:
2395 <PREFIX><PRODUCTION>.eps
2397 <PREFIX> is given by variable `ebnf-eps-prefix'.
2398 The default value is \"ebnf--\".
2400 <PRODUCTION> is the production name.
2401 Some characters in the production file name are replaced to
2402 produce a valid file name. For example, the production name
2403 \"A/B + C\" is modified to produce \"A_B_+_C\", and the EPS
2404 file name used in this case will be \"ebnf--A_B_+_C.eps\".
2406 WARNING: This function does *NOT* ask any confirmation to override existing
2409 (ebnf-log-header "(ebnf-eps-region %S %S)" from to
)
2410 (let ((ebnf-eps-executing t
))
2411 (ebnf-generate-region from to
'ebnf-generate-eps
)))
2415 (defalias 'ebnf-despool
'ps-despool
)
2419 (defun ebnf-syntax-directory (&optional directory
)
2420 "Do a syntactic analysis of the files in DIRECTORY.
2422 If DIRECTORY is nil, use `default-directory'.
2424 Only the files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see)
2427 See also `ebnf-syntax-buffer'."
2429 (list (read-file-name "Directory containing EBNF files (syntax): "
2430 nil default-directory
)))
2431 (ebnf-log-header "(ebnf-syntax-directory %S)" directory
)
2432 (ebnf-directory 'ebnf-syntax-buffer directory
))
2436 (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done
)
2437 "Do a syntactic analysis of the named FILE.
2439 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2440 killed after syntax checking.
2442 See also `ebnf-syntax-buffer'."
2443 (interactive "fEBNF file to check syntax: ")
2444 (ebnf-log-header "(ebnf-syntax-file %S %S)" file do-not-kill-buffer-when-done
)
2445 (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done
))
2449 (defun ebnf-syntax-buffer ()
2450 "Do a syntactic analysis of the current buffer."
2452 (ebnf-log-header "(ebnf-syntax-buffer)")
2453 (ebnf-syntax-region (point-min) (point-max)))
2457 (defun ebnf-syntax-region (from to
)
2458 "Do a syntactic analysis of a region."
2460 (ebnf-log-header "(ebnf-syntax-region %S %S)" from to
)
2461 (ebnf-generate-region from to nil
))
2464 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2469 (defun ebnf-setup ()
2470 "Return the current ebnf2ps setup."
2473 ;;; ebnf2ps.el version %s
2475 ;;; Emacs version %S
2477 \(setq ebnf-special-show-delimiter %S
2478 ebnf-special-font %s
2479 ebnf-special-shape %s
2480 ebnf-special-shadow %S
2481 ebnf-special-border-width %S
2482 ebnf-special-border-color %S
2484 ebnf-except-shape %s
2485 ebnf-except-shadow %S
2486 ebnf-except-border-width %S
2487 ebnf-except-border-color %S
2489 ebnf-repeat-shape %s
2490 ebnf-repeat-shadow %S
2491 ebnf-repeat-border-width %S
2492 ebnf-repeat-border-color %S
2493 ebnf-terminal-regexp %S
2494 ebnf-case-fold-search %S
2495 ebnf-terminal-font %s
2496 ebnf-terminal-shape %s
2497 ebnf-terminal-shadow %S
2498 ebnf-terminal-border-width %S
2499 ebnf-terminal-border-color %S
2500 ebnf-non-terminal-font %s
2501 ebnf-non-terminal-shape %s
2502 ebnf-non-terminal-shadow %S
2503 ebnf-non-terminal-border-width %S
2504 ebnf-non-terminal-border-color %S
2505 ebnf-production-name-p %S
2506 ebnf-sort-production %s
2507 ebnf-production-font %s
2511 ebnf-horizontal-orientation %S
2512 ebnf-horizontal-max-height %S
2513 ebnf-production-horizontal-space %S
2514 ebnf-production-vertical-space %S
2515 ebnf-justify-sequence %s
2516 ebnf-lex-comment-char ?\\%03o
2517 ebnf-lex-eop-char ?\\%03o
2519 ebnf-iso-alternative-p %S
2520 ebnf-iso-normalize-p %S
2521 ebnf-file-suffix-regexp %S
2523 ebnf-eps-header-font %s
2525 ebnf-eps-footer-font %s
2527 ebnf-entry-percentage %S
2531 ebnf-arrow-extra-width %S
2534 ebnf-use-float-format %S
2535 ebnf-stop-on-error %S
2536 ebnf-yac-ignore-error-recovery %S
2537 ebnf-ignore-empty-rule %S
2541 ;;; ebnf2ps.el - end of settings
2545 ebnf-special-show-delimiter
2546 (ps-print-quote ebnf-special-font
)
2547 (ps-print-quote ebnf-special-shape
)
2549 ebnf-special-border-width
2550 ebnf-special-border-color
2551 (ps-print-quote ebnf-except-font
)
2552 (ps-print-quote ebnf-except-shape
)
2554 ebnf-except-border-width
2555 ebnf-except-border-color
2556 (ps-print-quote ebnf-repeat-font
)
2557 (ps-print-quote ebnf-repeat-shape
)
2559 ebnf-repeat-border-width
2560 ebnf-repeat-border-color
2561 ebnf-terminal-regexp
2562 ebnf-case-fold-search
2563 (ps-print-quote ebnf-terminal-font
)
2564 (ps-print-quote ebnf-terminal-shape
)
2565 ebnf-terminal-shadow
2566 ebnf-terminal-border-width
2567 ebnf-terminal-border-color
2568 (ps-print-quote ebnf-non-terminal-font
)
2569 (ps-print-quote ebnf-non-terminal-shape
)
2570 ebnf-non-terminal-shadow
2571 ebnf-non-terminal-border-width
2572 ebnf-non-terminal-border-color
2573 ebnf-production-name-p
2574 (ps-print-quote ebnf-sort-production
)
2575 (ps-print-quote ebnf-production-font
)
2576 (ps-print-quote ebnf-arrow-shape
)
2577 (ps-print-quote ebnf-chart-shape
)
2578 (ps-print-quote ebnf-user-arrow
)
2579 ebnf-horizontal-orientation
2580 ebnf-horizontal-max-height
2581 ebnf-production-horizontal-space
2582 ebnf-production-vertical-space
2583 (ps-print-quote ebnf-justify-sequence
)
2584 ebnf-lex-comment-char
2586 (ps-print-quote ebnf-syntax
)
2587 ebnf-iso-alternative-p
2588 ebnf-iso-normalize-p
2589 ebnf-file-suffix-regexp
2591 (ps-print-quote ebnf-eps-header-font
)
2592 (ps-print-quote ebnf-eps-header
)
2593 (ps-print-quote ebnf-eps-footer-font
)
2594 (ps-print-quote ebnf-eps-footer
)
2595 ebnf-entry-percentage
2599 ebnf-arrow-extra-width
2602 ebnf-use-float-format
2604 ebnf-yac-ignore-error-recovery
2605 ebnf-ignore-empty-rule
2610 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2614 (defvar ebnf-stack-style nil
2615 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2619 (defvar ebnf-current-style
'default
2620 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2623 (defconst ebnf-style-custom-list
2624 '(ebnf-special-show-delimiter
2628 ebnf-special-border-width
2629 ebnf-special-border-color
2633 ebnf-except-border-width
2634 ebnf-except-border-color
2638 ebnf-repeat-border-width
2639 ebnf-repeat-border-color
2640 ebnf-terminal-regexp
2641 ebnf-case-fold-search
2644 ebnf-terminal-shadow
2645 ebnf-terminal-border-width
2646 ebnf-terminal-border-color
2647 ebnf-non-terminal-font
2648 ebnf-non-terminal-shape
2649 ebnf-non-terminal-shadow
2650 ebnf-non-terminal-border-width
2651 ebnf-non-terminal-border-color
2652 ebnf-production-name-p
2653 ebnf-sort-production
2654 ebnf-production-font
2658 ebnf-horizontal-orientation
2659 ebnf-horizontal-max-height
2660 ebnf-production-horizontal-space
2661 ebnf-production-vertical-space
2662 ebnf-justify-sequence
2663 ebnf-lex-comment-char
2666 ebnf-iso-alternative-p
2667 ebnf-iso-normalize-p
2668 ebnf-file-suffix-regexp
2670 ebnf-eps-header-font
2672 ebnf-eps-footer-font
2674 ebnf-entry-percentage
2679 ebnf-use-float-format
2681 ebnf-yac-ignore-error-recovery
2682 ebnf-ignore-empty-rule
2684 "List of valid symbol custom variable.")
2687 (defvar ebnf-style-database
2691 (ebnf-special-show-delimiter . t
)
2692 (ebnf-special-font .
'(7 Courier
"Black" "Gray95" bold italic
))
2693 (ebnf-special-shape .
'bevel
)
2694 (ebnf-special-shadow . nil
)
2695 (ebnf-special-border-width .
0.5)
2696 (ebnf-special-border-color .
"Black")
2697 (ebnf-except-font .
'(7 Courier
"Black" "Gray90" bold italic
))
2698 (ebnf-except-shape .
'bevel
)
2699 (ebnf-except-shadow . nil
)
2700 (ebnf-except-border-width .
0.25)
2701 (ebnf-except-border-color .
"Black")
2702 (ebnf-repeat-font .
'(7 Courier
"Black" "Gray85" bold italic
))
2703 (ebnf-repeat-shape .
'bevel
)
2704 (ebnf-repeat-shadow . nil
)
2705 (ebnf-repeat-border-width .
0.0)
2706 (ebnf-repeat-border-color .
"Black")
2707 (ebnf-terminal-regexp . nil
)
2708 (ebnf-case-fold-search . nil
)
2709 (ebnf-terminal-font .
'(7 Courier
"Black" "White"))
2710 (ebnf-terminal-shape .
'miter
)
2711 (ebnf-terminal-shadow . nil
)
2712 (ebnf-terminal-border-width .
1.0)
2713 (ebnf-terminal-border-color .
"Black")
2714 (ebnf-non-terminal-font .
'(7 Helvetica
"Black" "White"))
2715 (ebnf-non-terminal-shape .
'round
)
2716 (ebnf-non-terminal-shadow . nil
)
2717 (ebnf-non-terminal-border-width .
1.0)
2718 (ebnf-non-terminal-border-color .
"Black")
2719 (ebnf-production-name-p . t
)
2720 (ebnf-sort-production . nil
)
2721 (ebnf-production-font .
'(10 Helvetica
"Black" "White" bold
))
2722 (ebnf-arrow-shape .
'hollow
)
2723 (ebnf-chart-shape .
'round
)
2724 (ebnf-user-arrow . nil
)
2725 (ebnf-horizontal-orientation . nil
)
2726 (ebnf-horizontal-max-height . nil
)
2727 (ebnf-production-horizontal-space .
0.0)
2728 (ebnf-production-vertical-space .
0.0)
2729 (ebnf-justify-sequence .
'center
)
2730 (ebnf-lex-comment-char . ?\
;)
2731 (ebnf-lex-eop-char . ?.
)
2732 (ebnf-syntax .
'ebnf
)
2733 (ebnf-iso-alternative-p . nil
)
2734 (ebnf-iso-normalize-p . nil
)
2735 (ebnf-file-suffix-regexp .
"\.[Bb][Nn][Ff]$")
2736 (ebnf-eps-prefix .
"ebnf--")
2737 (ebnf-eps-header-font .
'(11 Helvetica
"Black" "White" bold
))
2738 (ebnf-eps-header . nil
)
2739 (ebnf-eps-footer-font .
'(7 Helvetica
"Black" "White" bold
))
2740 (ebnf-eps-footer . nil
)
2741 (ebnf-entry-percentage .
0.5)
2742 (ebnf-color-p .
(or (fboundp 'x-color-values
) ; Emacs
2743 (fboundp 'color-instance-rgb-components
))) ; XEmacs
2744 (ebnf-line-width .
1.0)
2745 (ebnf-line-color .
"Black")
2746 (ebnf-debug-ps . nil
)
2747 (ebnf-use-float-format . t
)
2748 (ebnf-stop-on-error . nil
)
2749 (ebnf-yac-ignore-error-recovery . nil
)
2750 (ebnf-ignore-empty-rule . nil
)
2751 (ebnf-optimize . nil
))
2752 ;; Happy EBNF default
2755 (ebnf-justify-sequence .
'left
)
2756 (ebnf-lex-comment-char . ?\
#)
2757 (ebnf-lex-eop-char . ?\
;))
2761 (ebnf-syntax .
'abnf
))
2765 (ebnf-syntax .
'iso-ebnf
))
2766 ;; Yacc/Bison default
2769 (ebnf-syntax .
'yacc
))
2773 (ebnf-syntax .
'ebnfx
))
2777 (ebnf-syntax .
'dtd
))
2781 Each element has the following form:
2783 (NAME INHERITS (VAR . VALUE)...)
2787 NAME is a symbol name style.
2789 INHERITS is a symbol name style from which the current style inherits
2790 the context. If INHERITS is nil, then there is no inheritance.
2792 This is a simple inheritance of style: if you declare that
2793 style A inherits from style B, all settings of B are applied
2794 first, and then the settings of A are applied. This is useful
2795 when you wish to modify some aspects of an existing style, but
2796 at the same time wish to keep it unmodified.
2798 VAR is a valid ebnf2ps symbol custom variable.
2799 See `ebnf-style-custom-list' for valid symbol variables.
2801 VALUE is a sexp which will be evaluated to set the value of VAR.
2802 Don't forget to quote symbols and constant lists.
2803 See `default' style for an example.
2805 Don't use this variable directly. Use functions `ebnf-insert-style',
2806 `ebnf-delete-style' and `ebnf-merge-style'.")
2809 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2814 (defun ebnf-find-style (name)
2815 "Return style definition if NAME is already defined; otherwise, return nil.
2817 See `ebnf-style-database' documentation."
2818 (interactive "SStyle name: ")
2819 (assoc name ebnf-style-database
))
2823 (defun ebnf-insert-style (name inherits
&rest values
)
2824 "Insert a new style NAME with inheritance INHERITS and values VALUES.
2826 See `ebnf-style-database' documentation."
2827 (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
2828 (and (assoc name ebnf-style-database
)
2829 (error "Style name already exists: %s" name
))
2830 (or (assoc inherits ebnf-style-database
)
2831 (error "Style inheritance name doesn't exist: %s" inherits
))
2832 (setq ebnf-style-database
2833 (cons (cons name
(cons inherits
(ebnf-check-style-values values
)))
2834 ebnf-style-database
)))
2838 (defun ebnf-delete-style (name)
2841 See `ebnf-style-database' documentation."
2842 (interactive "SDelete style name: ")
2843 (or (assoc name ebnf-style-database
)
2844 (error "Style name doesn't exist: %s" name
))
2845 (let ((db ebnf-style-database
))
2847 (and (eq (nth 1 (car db
)) name
)
2848 (error "Style name `%s' is inherited by `%s' style"
2849 name
(nth 0 (car db
))))
2850 (setq db
(cdr db
))))
2851 (setq ebnf-style-database
(assq-delete-all name ebnf-style-database
)))
2855 (defun ebnf-merge-style (name &rest values
)
2856 "Merge values of style NAME with style VALUES.
2858 See `ebnf-style-database' documentation."
2859 (interactive "SStyle name: \nXStyle values: ")
2860 (let ((style (or (assoc name ebnf-style-database
)
2861 (error "Style name doesn't exist: %s" name
)))
2862 (merge (ebnf-check-style-values values
))
2864 ;; modify value of existing variables
2865 (setq val
(nthcdr 2 style
))
2867 (setq check
(car merge
)
2869 elt
(assoc (car check
) val
))
2871 (setcdr elt
(cdr check
))
2872 (setq new
(cons check new
))))
2873 ;; insert new variables
2874 (nconc style
(nreverse new
))))
2878 (defun ebnf-apply-style (style)
2879 "Set STYLE as the current style.
2881 Returns the old style symbol.
2883 See `ebnf-style-database' documentation."
2884 (interactive "SApply style: ")
2887 (and (ebnf-apply-style1 style
)
2888 (setq ebnf-current-style style
))))
2892 (defun ebnf-reset-style (&optional style
)
2893 "Reset current style.
2895 Returns the old style symbol.
2897 See `ebnf-style-database' documentation."
2898 (interactive "SReset style: ")
2899 (setq ebnf-stack-style nil
)
2900 (ebnf-apply-style (or style
'default
)))
2904 (defun ebnf-push-style (&optional style
)
2905 "Push the current style onto a stack and set STYLE as the current style.
2907 Returns the old style symbol.
2909 See also `ebnf-pop-style'.
2911 See `ebnf-style-database' documentation."
2912 (interactive "SPush style: ")
2915 (setq ebnf-stack-style
(cons ebnf-current-style ebnf-stack-style
))
2917 (ebnf-apply-style style
))))
2921 (defun ebnf-pop-style ()
2922 "Pop a style from the stack of pushed styles and set it as the current style.
2924 Returns the old style symbol.
2926 See also `ebnf-push-style'.
2928 See `ebnf-style-database' documentation."
2931 (ebnf-apply-style (car ebnf-stack-style
))
2932 (setq ebnf-stack-style
(cdr ebnf-stack-style
))))
2935 (defun ebnf-apply-style1 (style)
2936 (let ((value (cdr (assoc style ebnf-style-database
))))
2939 (and (car value
) (ebnf-apply-style1 (car value
)))
2940 (while (setq value
(cdr value
))
2941 (set (caar value
) (eval (cdar value
)))))))
2944 (defun ebnf-check-style-values (values)
2947 (and (memq (caar values
) ebnf-style-custom-list
)
2948 (setq style
(cons (car values
) style
)))
2949 (setq values
(cdr values
)))
2953 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2954 ;; Internal variables
2957 (defvar ebnf-eps-buffer-name
" *EPS*")
2958 (defvar ebnf-parser-func nil
)
2959 (defvar ebnf-eps-executing nil
)
2960 (defvar ebnf-eps-header-comment nil
)
2961 (defvar ebnf-eps-footer-comment nil
)
2962 (defvar ebnf-eps-upper-x
0.0)
2963 (make-variable-buffer-local 'ebnf-eps-upper-x
)
2964 (defvar ebnf-eps-upper-y
0.0)
2965 (make-variable-buffer-local 'ebnf-eps-upper-y
)
2966 (defvar ebnf-eps-prod-width
0.0)
2967 (make-variable-buffer-local 'ebnf-eps-prod-width
)
2968 (defvar ebnf-eps-max-height
0.0)
2969 (make-variable-buffer-local 'ebnf-eps-max-height
)
2970 (defvar ebnf-eps-max-width
0.0)
2971 (make-variable-buffer-local 'ebnf-eps-max-width
)
2974 (defvar ebnf-eps-context nil
2975 "List of EPS file name during parsing.
2977 See section \"Actions in Comments\" in ebnf2ps documentation.")
2980 (defvar ebnf-eps-file-alist nil
2981 "Alist associating file name with EPS header and footer.
2983 Each element has the following form:
2985 (EPS-FILENAME HEADER FOOTER)
2987 EPS-FILENAME is the EPS file name.
2988 HEADER is the header string or nil.
2989 FOOTER is the footer string or nil.
2991 It's generated during parsing and used during EPS generation.
2993 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2997 (defvar ebnf-eps-production-list nil
2998 "Alist associating production name with EPS file name list.
3000 Each element has the following form:
3002 (PRODUCTION EPS-FILENAME...)
3004 PRODUCTION is the production name.
3005 EPS-FILENAME is the EPS file name.
3007 This is generated during parsing and used during EPS generation.
3009 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
3013 (defconst ebnf-arrow-shape-alist
3021 (semi-up-hollow .
7)
3023 (semi-down-hollow .
9)
3024 (semi-down-full .
10)
3026 "Alist associating values for `ebnf-arrow-shape'.
3028 See documentation for `ebnf-arrow-shape'.")
3031 (defconst ebnf-terminal-shape-alist
3035 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
3037 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
3038 `ebnf-chart-shape'.")
3041 (defvar ebnf-limit nil
)
3042 (defvar ebnf-action nil
)
3043 (defvar ebnf-action-list nil
)
3046 (defvar ebnf-default-p nil
)
3049 (defvar ebnf-font-height-P
0)
3050 (defvar ebnf-font-height-T
0)
3051 (defvar ebnf-font-height-NT
0)
3052 (defvar ebnf-font-height-S
0)
3053 (defvar ebnf-font-height-E
0)
3054 (defvar ebnf-font-height-R
0)
3055 (defvar ebnf-font-width-P
0)
3056 (defvar ebnf-font-width-T
0)
3057 (defvar ebnf-font-width-NT
0)
3058 (defvar ebnf-font-width-S
0)
3059 (defvar ebnf-font-width-E
0)
3060 (defvar ebnf-font-width-R
0)
3061 (defvar ebnf-space-T
0)
3062 (defvar ebnf-space-NT
0)
3063 (defvar ebnf-space-S
0)
3064 (defvar ebnf-space-E
0)
3065 (defvar ebnf-space-R
0)
3068 (defvar ebnf-basic-width-extra
0)
3069 (defvar ebnf-basic-width
0)
3070 (defvar ebnf-basic-height
0)
3071 (defvar ebnf-basic-empty-height
0)
3072 (defvar ebnf-vertical-space
0)
3073 (defvar ebnf-horizontal-space
0)
3076 (defvar ebnf-settings nil
)
3077 (defvar ebnf-fonts-required nil
)
3080 (defconst ebnf-debug
3082 % === begin EBNF procedures to help debugging
3084 % Mark visually current point: string debug
3088 gsave -s- show grestore
3100 % Show number value: number string debug-number
3103 20 0 rmoveto show ([) show 60 string cvs show (]) show
3107 % === end EBNF procedures to help debugging
3110 "This is intended to help debugging PostScript programming.")
3113 (defconst ebnf-prologue
3115 % === begin EBNF engine
3117 % --- Basic Definitions
3120 /SpaceS FontHeight 0.5 mul def
3121 /HeightS FontHeight FontHeight add def
3124 /SpaceE FontHeight 0.5 mul def
3125 /HeightE FontHeight FontHeight add def
3128 /SpaceR FontHeight 0.5 mul def
3129 /HeightR FontHeight FontHeight add def
3132 /SpaceT FontHeight 0.5 mul def
3133 /HeightT FontHeight FontHeight add def
3136 /SpaceNT FontHeight 0.5 mul def
3137 /HeightNT FontHeight FontHeight add def
3139 /T HeightT HeightNT add 0.5 mul def
3141 /hT2 hT 0.5 mul ArrowScale mul def
3142 /hT4 hT 0.25 mul ArrowScale mul def
3144 /Er 0.1 def % Error factor
3147 /c{currentpoint}bind def
3148 /xyi{/xi c /yi exch def def}bind def
3149 /xyo{/xo c /yo exch def def}bind def
3150 /xyp{/xp c /yp exch def def}bind def
3151 /xyt{/xt c /yt exch def def}bind def
3153 % vertical movement: x y height vm
3154 /vm{add moveto}bind def
3156 % horizontal movement: x y width hm
3157 /hm{3 -1 roll exch add exch moveto}bind def
3159 % set color: [R G B] SetRGB
3160 /SetRGB{aload pop setrgbcolor}bind def
3162 % filling gray area: gray-scale FillGray
3163 /FillGray{gsave setgray fill grestore}bind def
3165 % filling color area: [R G B] FillRGB
3166 /FillRGB{gsave SetRGB fill grestore}bind def
3168 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
3169 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
3170 /Gstroke{gsave Stroke grestore}bind def
3172 % Empty Line: width EL
3173 /EL{0 rlineto Gstroke}bind def
3177 /Down{hT2 neg hT4 neg rlineto}bind def
3180 {hT2 neg hT4 rmoveto
3185 /ArrowPath{c newpath moveto Arrow closepath}bind def
3209 {hT2 neg hT4 rlineto} % 1 - semi-up
3210 {Down} % 2 - semi-down
3211 {Arrow} % 3 - simple
3212 {Gstroke ArrowPath} % 4 - transparent
3213 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
3214 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
3215 {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
3216 {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
3217 {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
3218 {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
3219 {Gstroke gsave UserArrow grestore} % 11 - user
3225 RA-vector ArrowShape get exec
3228 ExtraWidth 0 rmoveto
3231 % rotation DrawArrow
3246 /LA{180 DrawArrow}def
3253 /UA{90 DrawArrow}def
3260 /DA{270 DrawArrow}def
3264 %>corner Right Descendent: height arrow corner_RD
3266 % / height > 0 | 0 - none
3268 % * ---------- | 2 - left
3287 h 0 gt{DA}{UA}ifelse
3292 [{cRD0-vector arrow get exec} % 0 - miter
3293 {0 0 0 h hT h rcurveto} % 1 - rounded
3294 {hT h rlineto} % 2 - bevel
3298 {/arrow exch def /h exch def
3299 cRD-vector ChartShape get exec
3303 %>corner Right Ascendent: height arrow corner_RA
3305 % | height > 0 | 0 - none
3307 % *- ---------- | 2 - left
3325 h 0 gt{DA}{UA}ifelse
3331 [{cRA0-vector arrow get exec} % 0 - miter
3332 {0 0 hT 0 hT h rcurveto} % 1 - rounded
3333 {hT h rlineto} % 2 - bevel
3337 {/arrow exch def /h exch def
3338 cRA-vector ChartShape get exec
3342 %>corner Left Descendent: height arrow corner_LD
3344 % \\ height > 0 | 0 - none
3346 % * ---------- | 2 - left
3355 {hT neg h rmoveto xyi
3363 {hT neg h rmoveto xyi
3365 h 0 gt{DA}{UA}ifelse
3370 [{cLD0-vector arrow get exec} % 0 - miter
3371 {0 0 0 h hT neg h rcurveto} % 1 - rounded
3372 {hT neg h rlineto} % 2 - bevel
3376 {/arrow exch def /h exch def
3377 cLD-vector ChartShape get exec
3381 %>corner Left Ascendent: height arrow corner_LA
3383 % | height > 0 | 0 - none
3385 % -* ---------- | 2 - left
3394 {hT neg h rmoveto xyi
3402 {hT neg h rmoveto xyi
3403 h 0 gt{DA}{UA}ifelse
3409 [{cLA0-vector arrow get exec} % 0 - miter
3410 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
3411 {hT neg h rlineto} % 2 - bevel
3415 {/arrow exch def /h exch def
3416 cLA-vector ChartShape get exec
3422 % height prepare-height |- line_height corner_height corner_height
3426 {T add hT neg}ifelse
3430 %>Left Alternative: height LAlt
3457 %>Left Loop: height LLoop
3476 %>Right Alternative: height RAlt
3490 {T neg exch rlineto}
3503 %>Right Loop: height RLoop
3522 % --- Terminal, Non-terminal and Special Basics
3524 % string width prepare-width |- string
3527 dup stringwidth pop space add space add width exch sub ExtraWidth sub 0.5 mul
3531 % string width begin-right
3541 {xo width add Er add yo moveto
3546 % string width begin-left
3555 {xo width add Er add yo moveto
3568 {/half YY yy sub 0.5 mul abs def
3569 xx half add YY moveto
3570 0 0 half neg 0 half neg half neg rcurveto
3571 0 0 0 half neg half half neg rcurveto
3572 XX xx sub abs half sub half sub 0 rlineto
3573 0 0 half 0 half half rcurveto
3574 0 0 0 half half neg half rcurveto}
3576 {/quarter YY yy sub 0.25 mul abs def
3577 xx quarter add YY moveto
3578 quarter neg quarter neg rlineto
3579 0 quarter quarter add neg rlineto
3580 quarter quarter neg rlineto
3581 XX xx sub abs quarter sub quarter sub 0 rlineto
3582 quarter quarter rlineto
3583 0 quarter quarter add rlineto
3584 quarter neg quarter rlineto}
3589 ShapePath-vector shape get exec
3595 Xshadow Xshadow add Xshadow add
3596 Yshadow Yshadow add Yshadow add translate
3610 % string SBound |- string
3612 {/xx c dup /yy exch def
3613 FontHeight add /YY exch def def
3614 dup stringwidth pop xx add /XX exch def
3616 {/yy yy YShadow add def
3617 /XX XX XShadow add def
3626 /XX XX space add space add def
3627 /YY YY space add def
3628 /yy yy space sub def
3629 shadow{doShapeShadow}if
3631 space Descent abs rmoveto
3638 % TeRminal: string TR
3640 {/Effect EffectT def
3642 /shapecolor BackgroundT def
3643 /borderwidth BorderWidthT def
3644 /bordercolor BorderColorT def
3645 /foreground ForegroundT def
3650 %>Right Terminal: string width RT |- x y
3661 %>Left Terminal: string width LT |- x y
3672 %>Right Terminal Default: string width RTD |- x y
3674 {/-save- BorderWidthT def
3675 /BorderWidthT BorderWidthT DefaultWidth add def
3677 /BorderWidthT -save- def
3680 %>Left Terminal Default: string width LTD |- x y
3682 {/-save- BorderWidthT def
3683 /BorderWidthT BorderWidthT DefaultWidth add def
3685 /BorderWidthT -save- def
3690 % Non-Terminal: string NT
3692 {/Effect EffectNT def
3694 /shapecolor BackgroundNT def
3695 /borderwidth BorderWidthNT def
3696 /bordercolor BorderColorNT def
3697 /foreground ForegroundNT def
3698 /shadow ShadowNT def
3702 %>Right Non-Terminal: string width RNT |- x y
3713 %>Left Non-Terminal: string width LNT |- x y
3724 %>Right Non-Terminal Default: string width RNTD |- x y
3726 {/-save- BorderWidthNT def
3727 /BorderWidthNT BorderWidthNT DefaultWidth add def
3729 /BorderWidthNT -save- def
3732 %>Left Non-Terminal Default: string width LNTD |- x y
3734 {/-save- BorderWidthNT def
3735 /BorderWidthNT BorderWidthNT DefaultWidth add def
3737 /BorderWidthNT -save- def
3742 % SPecial: string SP
3744 {/Effect EffectS def
3746 /shapecolor BackgroundS def
3747 /borderwidth BorderWidthS def
3748 /bordercolor BorderColorS def
3749 /foreground ForegroundS def
3754 %>Right SPecial: string width RSP |- x y
3765 %>Left SPecial: string width LSP |- x y
3776 %>Right SPecial Default: string width RSPD |- x y
3778 {/-save- BorderWidthS def
3779 /BorderWidthS BorderWidthS DefaultWidth add def
3781 /BorderWidthS -save- def
3784 %>Left SPecial Default: string width LSPD |- x y
3786 {/-save- BorderWidthS def
3787 /BorderWidthS BorderWidthS DefaultWidth add def
3789 /BorderWidthS -save- def
3792 % --- Repeat and Except basics
3795 {/w width rwidth sub 0.5 mul def
3800 /xx c entry add /YY exch def def
3801 /yy YY height sub def
3802 /XX xx rwidth add def
3803 shadow{doShapeShadow}if
3826 % entry height width rwidth begin-repeat
3836 /shapecolor BackgroundR def
3837 /borderwidth BorderWidthR def
3838 /bordercolor BorderColorR def
3839 /foreground ForegroundR def
3844 % string end-repeat |- x y
3847 space Descent rmoveto
3851 exch space add exch moveto
3855 %>Right RePeat: string entry height width rwidth RRP |- x y
3856 /RRP{begin-repeat right-direction end-repeat}def
3858 %>Left RePeat: string entry height width rwidth LRP |- x y
3859 /LRP{begin-repeat left-direction end-repeat}def
3863 % entry height width rwidth begin-except
3873 /shapecolor BackgroundE def
3874 /borderwidth BorderWidthE def
3875 /bordercolor BorderColorE def
3876 /foreground ForegroundE def
3881 % x-width end-except |- x y
3884 space space add add Descent rmoveto
3885 (-) foreground SetRGB S
3891 %>Right EXcept: x-width entry height width rwidth REX |- x y
3892 /REX{begin-except right-direction end-except}def
3894 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3895 /LEX{begin-except left-direction end-except}def
3899 %>Beginning Of Sequence: BOS |- x y
3900 /BOS{currentpoint}bind def
3902 %>End Of Sequence: x y x1 y1 EOS |- x y
3903 /EOS{pop pop}bind def
3907 %>Beginning Of Production: string width height BOP |- y x
3910 neg yp add /yw exch def
3911 xp add T sub /xw exch def
3912 dup length 0 gt % empty string ==> no production name
3913 {/Effect EffectP def
3914 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3924 %>End Of Production: y x delta EOP
3925 /EOPH{add exch moveto}bind def % horizontal
3926 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3928 % --- Empty Alternative
3930 %>Empty Alternative: width EA |- x y
3941 %>AlTernative: h1 h2 ... hn n width AT |- x y
3943 {xyo xo add /xw exch def
3955 %>OPtional: height width OP |- x y
3972 %>One or More: height width OM |- x y
3986 %>Zero or More: h2 h1 width ZM |- x y
3996 yo add xo T add exch moveto
4000 % === end EBNF engine
4003 "EBNF PostScript prologue")
4006 (defconst ebnf-eps-prologue
4008 /#ebnf2ps#dict 230 dict def
4011 % Initiliaze variables to avoid name-conflicting with document variables.
4012 % This is the case when using `bind' operator.
4013 /-fillp- 0 def /h 0 def
4014 /-ox- 0 def /half 0 def
4015 /-oy- 0 def /height 0 def
4016 /-save- 0 def /ow 0 def
4017 /Ascent 0 def /quarter 0 def
4018 /Descent 0 def /rXX 0 def
4019 /Effect 0 def /rYY 0 def
4020 /FontHeight 0 def /rwidth 0 def
4021 /LineThickness 0 def /rxx 0 def
4022 /OverlinePosition 0 def /ryy 0 def
4023 /SpaceBackground 0 def /shadow 0 def
4024 /StrikeoutPosition 0 def /shape 0 def
4025 /UnderlinePosition 0 def /shapecolor 0 def
4026 /XBox 0 def /space 0 def
4027 /XX 0 def /st 1 string def
4028 /Xshadow 0 def /w 0 def
4029 /YBox 0 def /width 0 def
4031 /Yshadow 0 def /xo 0 def
4032 /arrow 0 def /xp 0 def
4033 /bg false def /xt 0 def
4034 /bgcolor 0 def /xw 0 def
4035 /bordercolor 0 def /xx 0 def
4036 /borderwidth 0 def /yi 0 def
4038 /entry 0 def /yp 0 def
4039 /foreground 0 def /yt 0 def
4043 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
4044 /ISOLatin1Encoding where
4046 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
4047 % -- The first half is the same as the standard encoding,
4048 % -- except for minus instead of hyphen at code 055.
4050 StandardEncoding 0 45 getinterval aload pop
4052 StandardEncoding 46 82 getinterval aload pop
4053 %*** NOTE: the following are missing in the Adobe documentation,
4054 %*** but appear in the displayed table:
4055 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
4057 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
4058 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
4059 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
4060 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
4062 /space /exclamdown /cent /sterling
4063 /currency /yen /brokenbar /section
4064 /dieresis /copyright /ordfeminine /guillemotleft
4065 /logicalnot /hyphen /registered /macron
4066 /degree /plusminus /twosuperior /threesuperior
4067 /acute /mu /paragraph /periodcentered
4068 /cedilla /onesuperior /ordmasculine /guillemotright
4069 /onequarter /onehalf /threequarters /questiondown
4071 /Agrave /Aacute /Acircumflex /Atilde
4072 /Adieresis /Aring /AE /Ccedilla
4073 /Egrave /Eacute /Ecircumflex /Edieresis
4074 /Igrave /Iacute /Icircumflex /Idieresis
4075 /Eth /Ntilde /Ograve /Oacute
4076 /Ocircumflex /Otilde /Odieresis /multiply
4077 /Oslash /Ugrave /Uacute /Ucircumflex
4078 /Udieresis /Yacute /Thorn /germandbls
4080 /agrave /aacute /acircumflex /atilde
4081 /adieresis /aring /ae /ccedilla
4082 /egrave /eacute /ecircumflex /edieresis
4083 /igrave /iacute /icircumflex /idieresis
4084 /eth /ntilde /ograve /oacute
4085 /ocircumflex /otilde /odieresis /divide
4086 /oslash /ugrave /uacute /ucircumflex
4087 /udieresis /yacute /thorn /ydieresis
4091 /reencodeFontISO %def
4093 length 12 add dict % Make a new font (a new dict the same size
4094 % as the old one) with room for our new symbols.
4096 begin % Make the new font the current dictionary.
4098 {def}{pop pop}ifelse
4099 }forall % Copy each of the symbols from the old dictionary
4100 % to the new one except for the font ID.
4102 currentdict /FontType get 0 ne
4103 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
4104 % the ISOLatin1 encoding.
4106 % Use the font's bounding box to determine the ascent, descent,
4107 % and overall height; don't forget that these values have to be
4108 % transformed using the font's matrix.
4115 % | | | | Ascent (usually > 0)
4117 % (0 0) -> +--+----+-------->
4119 % | | v Descent (usually < 0)
4120 % (x1 y1) --> +----+ - -
4122 currentdict /FontType get 0 ne
4123 {/FontBBox load aload pop % -- x1 y1 x2 y2
4124 FontMatrix transform /Ascent exch def pop
4125 FontMatrix transform /Descent exch def pop}
4126 {/PrimaryFont FDepVector 0 get def
4127 PrimaryFont /FontBBox get aload pop
4128 PrimaryFont /FontMatrix get transform /Ascent exch def pop
4129 PrimaryFont /FontMatrix get transform /Descent exch def pop
4132 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
4134 % Define these in case they're not in the FontInfo
4135 % (also, here they're easier to get to).
4136 /UnderlinePosition Descent 0.70 mul def
4137 /OverlinePosition Descent UnderlinePosition sub Ascent add def
4138 /StrikeoutPosition Ascent 0.30 mul def
4139 /LineThickness FontHeight 0.05 mul def
4140 /Xshadow FontHeight 0.08 mul def
4141 /Yshadow FontHeight -0.09 mul def
4142 /SpaceBackground Descent neg UnderlinePosition add def
4143 /XBox Descent neg def
4144 /YBox LineThickness 0.7 mul def
4146 currentdict % Leave the new font on the stack
4147 end % Stop using the font as the current dictionary
4148 definefont % Put the font into the font dictionary
4149 pop % Discard the returned font
4153 /DefFont{findfont exch scalefont reencodeFontISO}def
4158 dup /Ascent get /Ascent exch def
4159 dup /Descent get /Descent exch def
4160 dup /FontHeight get /FontHeight exch def
4161 dup /UnderlinePosition get /UnderlinePosition exch def
4162 dup /OverlinePosition get /OverlinePosition exch def
4163 dup /StrikeoutPosition get /StrikeoutPosition exch def
4164 dup /LineThickness get /LineThickness exch def
4165 dup /Xshadow get /Xshadow exch def
4166 dup /Yshadow get /Yshadow exch def
4167 dup /SpaceBackground get /SpaceBackground exch def
4168 dup /XBox get /XBox exch def
4169 dup /YBox get /YBox exch def
4182 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
4184 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
4197 % top of stack: fill-or-not
4199 {LineThickness setlinewidth stroke}
4204 % stack: string fill-or-not |- --
4207 /-ox- currentpoint /-oy- exch def def
4209 LineThickness setlinewidth
4211 st dup true charpath
4212 -fillp- {gsave FillBgColor grestore}if
4214 -oy- add /-oy- exch def
4215 -ox- add /-ox- exch def
4222 % stack: fill-or-not delta |- --
4225 xx XBox sub dd sub yy YBox sub dd sub
4226 XX XBox add dd add YY YBox add dd add
4230 % stack: string |- --
4233 Xshadow Yshadow rmoveto
4238 % stack: position |- --
4240 {currentpoint exch pop add dup
4246 LineThickness setlinewidth stroke
4250 % stack: string |- --
4251 % effect: 1 - underline 2 - strikeout 4 - overline
4252 % 8 - shadow 16 - box 32 - outline
4254 {/xx currentpoint dup Descent add /yy exch def
4255 Ascent add /YY exch def def
4256 dup stringwidth pop xx add /XX exch def
4258 {/yy yy Yshadow add def
4259 /XX XX Xshadow add def
4264 {SpaceBackground doBox}
4265 {xx yy XX YY doRect}
4268 Effect 16 and 0 ne{false 0 doBox}if % box
4269 Effect 8 and 0 ne{dup doShadow}if % shadow
4271 {true doOutline} % outline
4272 {show} % normal text
4274 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
4275 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
4276 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
4280 "EBNF EPS prologue")
4283 (defconst ebnf-eps-begin
4287 % x y #ebnf2ps#begin
4289 {#ebnf2ps#dict begin /#ebnf2ps#save save def
4290 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
4292 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
4299 (defconst ebnf-eps-end
4306 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4310 (defun ebnf-eps-header-footer (value)
4311 ;; evaluate header/footer value
4312 ;; return a string or nil
4313 (let ((tmp (if (symbolp value
)
4314 (cond ((fboundp value
) (funcall value
))
4315 ((boundp value
) (symbol-value value
))
4318 (and (stringp tmp
) tmp
)))
4321 (defun ebnf-eps-header ()
4322 ;; evaluate header value
4323 (ebnf-eps-header-footer ebnf-eps-header
))
4326 (defun ebnf-eps-footer ()
4327 ;; evaluate footer value
4328 (ebnf-eps-header-footer ebnf-eps-footer
))
4331 ;; hacked fom `ps-output-string-prim' (ps-print.el)
4332 (defun ebnf-eps-string (string)
4333 (let* ((str (string-as-unibyte string
))
4336 (new "(") ; insert start-string delimiter
4338 ;; Find and quote special characters as necessary for PS
4339 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4340 (while (setq start
(string-match "[^]-~ -'*-[]" str index
))
4341 (setq special
(aref str start
)
4343 (substring str index start
)
4344 (if (and (<= 0 special
) (<= special
255))
4345 (aref ps-string-escape-codes special
)
4346 ;; insert hexadecimal representation if character
4347 ;; code is out of range
4348 (format "\\%04X" special
)))
4352 (substring str index len
))
4353 ")"))) ; insert end-string delimiter
4356 (defun ebnf-eps-header-footer-comment (str)
4357 ;; parse header/footer comment string
4358 (let ((len (1- (length str
)))
4361 (while (setq start
(string-match "%" str index
))
4362 (setq fmt
(if (< start len
) (aref str
(1+ start
)) ?
\?)
4364 (substring str index start
)
4365 (cond ((= fmt ?%
) "%")
4366 ((= fmt ?H
) (ebnf-eps-header))
4367 ((= fmt ?F
) (ebnf-eps-footer))
4371 (ebnf-eps-string (concat new
4373 (substring str index
(1+ len
)))))))
4376 (defun ebnf-eps-header-footer-p (value)
4377 ;; return t if value is non-nil and is not an empty string
4378 (not (or (null value
)
4379 (and (stringp value
) (string= value
"")))))
4382 (defun ebnf-eps-header-comment (str)
4383 ;; set header comment if header is on
4384 (when (ebnf-eps-header-footer-p ebnf-eps-header
)
4385 (setq ebnf-eps-header-comment
(ebnf-eps-header-footer-comment str
))))
4388 (defun ebnf-eps-footer-comment (str)
4389 ;; set footer comment if footer is on
4390 (when (ebnf-eps-header-footer-p ebnf-eps-footer
)
4391 (setq ebnf-eps-footer-comment
(ebnf-eps-header-footer-comment str
))))
4394 (defun ebnf-eps-header-footer-file (filename)
4395 ;; associate header and footer with a filename
4396 (let ((filehf (assoc filename ebnf-eps-file-alist
))
4397 (header (or ebnf-eps-header-comment
(ebnf-eps-header)))
4398 (footer (or ebnf-eps-footer-comment
(ebnf-eps-footer))))
4400 (setq ebnf-eps-file-alist
(cons (list filename header footer
)
4401 ebnf-eps-file-alist
))
4402 (setcar (nthcdr 1 filehf
) header
)
4403 (setcar (nthcdr 2 filehf
) footer
))))
4406 (defun ebnf-eps-header-footer-set (filename)
4407 ;; set header and footer from a filename
4408 (let ((header-footer (assoc filename ebnf-eps-file-alist
)))
4409 (setq ebnf-eps-header-comment
(nth 1 header-footer
)
4410 ebnf-eps-footer-comment
(nth 2 header-footer
))))
4413 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4417 (defvar ebnf-format-float
"%1.3f")
4420 (defun ebnf-format-float (&rest floats
)
4423 (format ebnf-format-float float
))
4428 (defun ebnf-format-color (format-str color default
)
4429 (let* ((the-color (or color default
))
4430 (rgb (ps-color-scale the-color
)))
4433 (ebnf-format-float (nth 0 rgb
) (nth 1 rgb
) (nth 2 rgb
))
4438 (defvar ebnf-message-float
"%3.2f")
4441 (defsubst ebnf-message-float
(format-str value
)
4443 (format ebnf-message-float value
)))
4446 (defvar ebnf-total
0)
4447 (defvar ebnf-nprod
0)
4450 (defsubst ebnf-message-info
(messag)
4451 (message "%s...%3d%%"
4453 (round (/ (* (setq ebnf-nprod
(1+ ebnf-nprod
)) 100.0) ebnf-total
))))
4456 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4460 (defmacro ebnf-node-kind
(vec &optional value
)
4462 `(aset ,vec
0 ,value
)
4466 (defmacro ebnf-node-width-func
(node width
)
4467 `(funcall (aref ,node
1) ,node
,width
))
4470 (defmacro ebnf-node-dimension-func
(node &optional value
)
4472 `(aset ,node
2 ,value
)
4473 `(funcall (aref ,node
2) ,node
)))
4476 (defmacro ebnf-node-entry
(vec &optional value
)
4478 `(aset ,vec
3 ,value
)
4482 (defmacro ebnf-node-height
(vec &optional value
)
4484 `(aset ,vec
4 ,value
)
4488 (defmacro ebnf-node-width
(vec &optional value
)
4490 `(aset ,vec
5 ,value
)
4494 (defmacro ebnf-node-name
(vec)
4498 (defmacro ebnf-node-list
(vec &optional value
)
4500 `(aset ,vec
6 ,value
)
4504 (defmacro ebnf-node-default
(vec)
4508 (defmacro ebnf-node-production
(vec &optional value
)
4510 `(aset ,vec
7 ,value
)
4514 (defmacro ebnf-node-separator
(vec &optional value
)
4516 `(aset ,vec
7 ,value
)
4520 (defmacro ebnf-node-action
(vec &optional value
)
4522 `(aset ,vec
8 ,value
)
4526 (defmacro ebnf-node-generation
(node)
4527 `(funcall (ebnf-node-kind ,node
) ,node
))
4530 (defmacro ebnf-max-width
(prod)
4531 `(max (ebnf-node-width ,prod
)
4532 (+ (* (length (ebnf-node-name ,prod
))
4534 ebnf-production-horizontal-space
)))
4537 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4538 ;; PostScript generation
4541 (defun ebnf-generate-eps (ebnf-tree)
4542 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4543 (ps-print-color-scale (if ps-color-p
4544 (float (car (ps-color-values "white")))
4546 (ebnf-total (length ebnf-tree
))
4548 (old-ps-output (symbol-function 'ps-output
))
4549 (old-ps-output-string (symbol-function 'ps-output-string
))
4550 (eps-buffer (get-buffer-create ebnf-eps-buffer-name
))
4551 ebnf-debug-ps error-msg horizontal
4552 prod prod-name prod-width prod-height prod-list file-list
)
4553 ;; redefines `ps-output' and `ps-output-string'
4554 (defalias 'ps-output
'ebnf-eps-output
)
4555 (defalias 'ps-output-string
'ps-output-string-prim
)
4556 ;; generate EPS file
4558 (condition-case data
4561 (setq prod
(car ebnf-tree
)
4562 prod-name
(ebnf-node-name prod
)
4563 prod-width
(ebnf-max-width prod
)
4564 prod-height
(ebnf-node-height prod
)
4565 horizontal
(memq (ebnf-node-action prod
)
4567 ;; generate production in EPS buffer
4568 (with-current-buffer eps-buffer
4569 (setq ebnf-eps-upper-x
0.0
4570 ebnf-eps-upper-y
0.0
4571 ebnf-eps-max-width prod-width
4572 ebnf-eps-max-height prod-height
)
4573 (ebnf-generate-production prod
))
4574 (if (setq prod-list
(cdr (assoc prod-name
4575 ebnf-eps-production-list
)))
4576 ;; insert EPS buffer in all buffer associated with production
4577 (ebnf-eps-production-list prod-list
'file-list horizontal
4578 prod-width prod-height eps-buffer
)
4579 ;; write EPS file for production
4580 (ebnf-eps-finish-and-write eps-buffer
4581 (ebnf-eps-filename prod-name
)))
4582 ;; prepare for next loop
4583 (with-current-buffer eps-buffer
4585 (setq ebnf-tree
(cdr ebnf-tree
)))
4586 ;; write and kill temporary buffers
4587 (ebnf-eps-write-kill-temp file-list t
)
4588 (setq file-list nil
))
4591 (setq error-msg
(error-message-string data
)))))
4592 ;; restore `ps-output' and `ps-output-string'
4593 (defalias 'ps-output old-ps-output
)
4594 (defalias 'ps-output-string old-ps-output-string
)
4595 ;; kill temporary buffers
4596 (kill-buffer eps-buffer
)
4597 (ebnf-eps-write-kill-temp file-list nil
)
4598 (and error-msg
(error error-msg
))
4602 ;; write and kill temporary buffers
4603 (defun ebnf-eps-write-kill-temp (file-list write-p
)
4605 (let ((buffer (get-buffer (concat " *" (car file-list
) "*"))))
4608 (ebnf-eps-finish-and-write buffer
(car file-list
)))
4609 (kill-buffer buffer
)))
4610 (setq file-list
(cdr file-list
))))
4613 ;; insert EPS buffer in all buffer associated with production
4614 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
4615 prod-width prod-height eps-buffer
)
4617 (add-to-list file-list-sym
(car prod-list
))
4618 (with-current-buffer (get-buffer-create (concat " *" (car prod-list
) "*"))
4619 (goto-char (point-max))
4622 ((zerop (buffer-size))
4623 (setq ebnf-eps-upper-x
0.0
4624 ebnf-eps-upper-y
0.0
4625 ebnf-eps-max-width prod-width
4626 ebnf-eps-max-height prod-height
))
4629 (ebnf-eop-horizontal ebnf-eps-prod-width
)
4630 (setq ebnf-eps-max-width
(+ ebnf-eps-max-width
4631 ebnf-production-horizontal-space
4633 ebnf-eps-max-height
(max ebnf-eps-max-height prod-height
)))
4636 (ebnf-eop-vertical ebnf-eps-max-height
)
4637 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4638 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4641 ebnf-production-vertical-space
4642 ebnf-eps-max-height
))
4643 ebnf-eps-max-width prod-width
4644 ebnf-eps-max-height prod-height
))
4646 (setq ebnf-eps-prod-width prod-width
)
4647 (insert-buffer-substring eps-buffer
))
4648 (setq prod-list
(cdr prod-list
))))
4651 (defun ebnf-generate (ebnf-tree)
4652 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4653 (ps-print-color-scale (if ps-color-p
4654 (float (car (ps-color-values "white")))
4656 ps-zebra-stripes ps-line-number ps-razzle-dazzle
4658 ps-print-begin-sheet-hook
4659 ps-print-begin-page-hook
4660 ps-print-begin-column-hook
)
4661 (ps-generate (current-buffer) (point-min) (point-max)
4662 'ebnf-generate-postscript
)))
4665 (defvar ebnf-tree nil
)
4666 (defvar ebnf-direction
"R")
4669 (defun ebnf-generate-postscript (from to
)
4671 (if ebnf-horizontal-max-height
4672 (ebnf-generate-with-max-height)
4673 (ebnf-generate-without-max-height))
4677 (defun ebnf-generate-with-max-height ()
4678 (let ((ebnf-total (length ebnf-tree
))
4680 next-line max-height prod the-width
)
4682 ;; find next line point
4683 (setq next-line ebnf-tree
4684 prod
(car ebnf-tree
)
4685 max-height
(ebnf-node-height prod
))
4686 (ebnf-begin-line prod
(ebnf-max-width prod
))
4687 (while (and (setq next-line
(cdr next-line
))
4688 (setq prod
(car next-line
))
4689 (memq (ebnf-node-action prod
) ebnf-action-list
)
4690 (setq the-width
(ebnf-max-width prod
))
4691 (<= the-width ps-width-remaining
))
4692 (setq max-height
(max max-height
(ebnf-node-height prod
))
4693 ps-width-remaining
(- ps-width-remaining
4695 ebnf-production-horizontal-space
))))
4696 ;; generate current line
4697 (ebnf-newline max-height
)
4698 (setq prod
(car ebnf-tree
))
4699 (ebnf-generate-production prod
)
4700 (while (not (eq (setq ebnf-tree
(cdr ebnf-tree
)) next-line
))
4701 (ebnf-eop-horizontal (ebnf-max-width prod
))
4702 (setq prod
(car ebnf-tree
))
4703 (ebnf-generate-production prod
))
4704 (ebnf-eop-vertical max-height
))))
4707 (defun ebnf-generate-without-max-height ()
4708 (let ((ebnf-total (length ebnf-tree
))
4710 max-height prod bef-width cur-width
)
4712 ;; generate current line
4713 (setq prod
(car ebnf-tree
)
4714 max-height
(ebnf-node-height prod
)
4715 bef-width
(ebnf-max-width prod
))
4716 (ebnf-begin-line prod bef-width
)
4717 (ebnf-generate-production prod
)
4718 (while (and (setq ebnf-tree
(cdr ebnf-tree
))
4719 (setq prod
(car ebnf-tree
))
4720 (memq (ebnf-node-action prod
) ebnf-action-list
)
4721 (setq cur-width
(ebnf-max-width prod
))
4722 (<= cur-width ps-width-remaining
)
4723 (<= (ebnf-node-height prod
) ps-height-remaining
))
4724 (ebnf-eop-horizontal bef-width
)
4725 (ebnf-generate-production prod
)
4726 (setq bef-width cur-width
4727 max-height
(max max-height
(ebnf-node-height prod
))
4728 ps-width-remaining
(- ps-width-remaining
4730 ebnf-production-horizontal-space
))))
4731 (ebnf-eop-vertical max-height
)
4732 ;; prepare next line
4733 (ebnf-newline max-height
))))
4736 (defun ebnf-begin-line (prod width
)
4737 (and (or (eq (ebnf-node-action prod
) 'form-feed
)
4738 (> (ebnf-node-height prod
) ps-height-remaining
))
4740 (setq ps-width-remaining
(- ps-width-remaining
4742 ebnf-production-horizontal-space
))))
4745 (defun ebnf-newline (height)
4746 (and (> height ps-height-remaining
)
4748 (setq ps-width-remaining ps-print-width
4749 ps-height-remaining
(- ps-height-remaining
4751 ebnf-production-vertical-space
))))
4754 ;; [production width-fun dim-fun entry height width name production action]
4755 (defun ebnf-generate-production (production)
4756 (ebnf-message-info "Generating")
4757 (run-hooks 'ebnf-production-hook
)
4758 (ps-output-string (if ebnf-production-name-p
4759 (ebnf-node-name production
)
4763 (ebnf-node-width production
)
4764 (+ (if ebnf-production-name-p
4767 (ebnf-node-entry (ebnf-node-production production
))))
4769 (ebnf-node-generation (ebnf-node-production production
))
4770 (ps-output "EOS\n"))
4773 ;; [alternative width-fun dim-fun entry height width list]
4774 (defun ebnf-generate-alternative (alternative)
4775 (let ((alt (ebnf-node-list alternative
))
4776 (entry (ebnf-node-entry alternative
))
4778 alt-height alt-entry
)
4780 (ps-output (ebnf-format-float (- entry
(ebnf-node-entry (car alt
))))
4782 (setq entry
(- entry
(ebnf-node-height (car alt
)) ebnf-vertical-space
)
4785 (ps-output (format "%d " nlist
)
4786 (ebnf-format-float (ebnf-node-width alternative
))
4788 (setq alt
(ebnf-node-list alternative
))
4790 (ebnf-node-generation (car alt
))
4791 (setq alt-height
(- (ebnf-node-height (car alt
))
4792 (ebnf-node-entry (car alt
)))))
4793 (while (setq alt
(cdr alt
))
4794 (setq alt-entry
(ebnf-node-entry (car alt
)))
4795 (ebnf-vertical-movement
4796 (- (+ alt-height ebnf-vertical-space alt-entry
)))
4797 (ebnf-node-generation (car alt
))
4798 (setq alt-height
(- (ebnf-node-height (car alt
)) alt-entry
))))
4799 (ps-output "EOS\n"))
4802 ;; [sequence width-fun dim-fun entry height width list]
4803 (defun ebnf-generate-sequence (sequence)
4805 (let ((seq (ebnf-node-list sequence
))
4808 (ebnf-node-generation (car seq
))
4809 (setq seq-width
(ebnf-node-width (car seq
))))
4810 (while (setq seq
(cdr seq
))
4811 (ebnf-horizontal-movement seq-width
)
4812 (ebnf-node-generation (car seq
))
4813 (setq seq-width
(ebnf-node-width (car seq
)))))
4814 (ps-output "EOS\n"))
4817 ;; [terminal width-fun dim-fun entry height width name]
4818 (defun ebnf-generate-terminal (terminal)
4819 (ebnf-gen-terminal terminal
"T"))
4822 ;; [non-terminal width-fun dim-fun entry height width name]
4823 (defun ebnf-generate-non-terminal (non-terminal)
4824 (ebnf-gen-terminal non-terminal
"NT"))
4827 ;; [empty width-fun dim-fun entry height width]
4828 (defun ebnf-generate-empty (empty)
4829 (ebnf-empty-alternative (ebnf-node-width empty
)))
4832 ;; [optional width-fun dim-fun entry height width element]
4833 (defun ebnf-generate-optional (optional)
4834 (let ((the-optional (ebnf-node-list optional
)))
4835 (ps-output (ebnf-format-float
4836 (+ (- (ebnf-node-height the-optional
)
4837 (ebnf-node-entry optional
))
4838 ebnf-vertical-space
)
4839 (ebnf-node-width optional
))
4841 (ebnf-node-generation the-optional
)
4842 (ps-output "EOS\n")))
4845 ;; [one-or-more width-fun dim-fun entry height width element separator]
4846 (defun ebnf-generate-one-or-more (one-or-more)
4847 (let* ((width (ebnf-node-width one-or-more
))
4848 (sep (ebnf-node-separator one-or-more
))
4849 (entry (- (ebnf-node-entry one-or-more
)
4851 (ebnf-node-entry sep
)
4853 (ps-output (ebnf-format-float entry width
)
4855 (ebnf-node-generation (ebnf-node-list one-or-more
))
4856 (ebnf-vertical-movement entry
)
4858 (let ((ebnf-direction "L"))
4859 (ebnf-node-generation sep
))
4860 (ebnf-empty-alternative (- width
4861 ebnf-horizontal-space
4862 ebnf-basic-width-extra
))))
4863 (ps-output "EOS\n"))
4866 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4867 (defun ebnf-generate-zero-or-more (zero-or-more)
4868 (let* ((width (ebnf-node-width zero-or-more
))
4869 (node-list (ebnf-node-list zero-or-more
))
4870 (list-entry (ebnf-node-entry node-list
))
4871 (node-sep (ebnf-node-separator zero-or-more
))
4872 (entry (+ list-entry
4875 (- (ebnf-node-height node-sep
)
4876 (ebnf-node-entry node-sep
))
4877 ebnf-basic-empty-height
))))
4878 (ps-output (ebnf-format-float entry
4879 (+ (- (ebnf-node-height node-list
)
4881 ebnf-vertical-space
)
4884 (ebnf-node-generation (ebnf-node-list zero-or-more
))
4885 (ebnf-vertical-movement entry
)
4886 (if (ebnf-node-separator zero-or-more
)
4887 (let ((ebnf-direction "L"))
4888 (ebnf-node-generation (ebnf-node-separator zero-or-more
)))
4889 (ebnf-empty-alternative (- width
4890 ebnf-horizontal-space
4891 ebnf-basic-width-extra
))))
4892 (ps-output "EOS\n"))
4895 ;; [special width-fun dim-fun entry height width name]
4896 (defun ebnf-generate-special (special)
4897 (ebnf-gen-terminal special
"SP"))
4900 ;; [repeat width-fun dim-fun entry height width times element]
4901 (defun ebnf-generate-repeat (repeat)
4902 (let ((times (ebnf-node-name repeat
))
4903 (element (ebnf-node-separator repeat
)))
4904 (ps-output-string times
)
4907 (ebnf-node-entry repeat
)
4908 (ebnf-node-height repeat
)
4909 (ebnf-node-width repeat
)
4911 (+ (ebnf-node-width element
)
4912 ebnf-space-R ebnf-space-R ebnf-space-R
4913 (* (length times
) ebnf-font-width-R
))
4915 " " ebnf-direction
"RP\n")
4917 (ebnf-node-generation element
)))
4918 (ps-output "EOS\n"))
4921 ;; [except width-fun dim-fun entry height width element element]
4922 (defun ebnf-generate-except (except)
4923 (let* ((element (ebnf-node-list except
))
4924 (exception (ebnf-node-separator except
))
4925 (width (ebnf-node-width element
)))
4926 (ps-output (ebnf-format-float
4928 (ebnf-node-entry except
)
4929 (ebnf-node-height except
)
4930 (ebnf-node-width except
)
4932 ebnf-space-E ebnf-space-E ebnf-space-E
4935 (+ (ebnf-node-width exception
) ebnf-space-E
)
4937 " " ebnf-direction
"EX\n")
4938 (ebnf-node-generation (ebnf-node-list except
))
4940 (ebnf-horizontal-movement (+ width ebnf-space-E
4941 ebnf-font-width-E ebnf-space-E
))
4942 (ebnf-node-generation exception
)))
4943 (ps-output "EOS\n"))
4946 (defun ebnf-gen-terminal (node code
)
4947 (ps-output-string (ebnf-node-name node
))
4948 (ps-output " " (ebnf-format-float (ebnf-node-width node
))
4949 " " ebnf-direction code
4950 (if (ebnf-node-default node
)
4955 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4956 ;; Internal functions
4959 (defun ebnf-directory (fun &optional directory
)
4960 "Process files in DIRECTORY applying function FUN on each file.
4962 If DIRECTORY is nil, use `default-directory'.
4964 Only files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see) are
4966 (let ((files (directory-files (or directory default-directory
)
4967 t ebnf-file-suffix-regexp
)))
4969 (set-buffer (find-file-noselect (car files
)))
4971 (setq buffer-backed-up t
) ; Do not back it up.
4972 (save-buffer) ; Just save new version.
4973 (kill-buffer (current-buffer))
4974 (setq files
(cdr files
)))))
4977 (defun ebnf-file (fun file
&optional do-not-kill-buffer-when-done
)
4978 "Process the named FILE applying function FUN.
4980 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
4981 killed after process termination."
4982 (set-buffer (find-file-noselect file
))
4984 (or do-not-kill-buffer-when-done
4985 (kill-buffer (current-buffer))))
4988 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4989 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4990 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4991 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4992 (defun ebnf-range-regexp (prefix from to
)
4995 (setq str
(concat str
(char-to-string from
))
4997 (concat prefix str
)))
5000 (defvar ebnf-map-name
5001 (let ((map (make-vector 256 ?\_
)))
5002 (mapc #'(lambda (char)
5003 (aset map char char
))
5004 (concat "#$%&+-.0123456789=?@~"
5005 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
5006 "abcdefghijklmnopqrstuvwxyz"))
5010 (defun ebnf-eps-filename (str)
5011 (let* ((len (length str
))
5013 ;; to keep compatibility with Emacs 20 & 21:
5014 ;; DO NOT REPLACE `?\ ' BY `?\s'
5015 (new (make-string len ?\
)))
5017 (aset new stri
(aref ebnf-map-name
(aref str stri
)))
5018 (setq stri
(1+ stri
)))
5019 (concat ebnf-eps-prefix new
".eps")))
5022 (defun ebnf-eps-output (&rest args
)
5025 (setq args
(cdr args
))))
5028 (defun ebnf-generate-region (from to gen-func
)
5029 (run-hooks 'ebnf-hook
)
5030 (let ((ebnf-limit (max from to
))
5031 (error-msg "SYNTAX")
5036 (condition-case data
5037 (let ((tree (ebnf-parse-and-sort (min from to
))))
5039 (setq error-msg
"EMPTY RULES"
5040 tree
(ebnf-eliminate-empty-rules tree
))
5041 (setq error-msg
"OPTMIZE"
5042 tree
(ebnf-optimize tree
))
5043 (setq error-msg
"DIMENSIONS"
5044 tree
(ebnf-dimensions tree
))
5045 (setq error-msg
"GENERATION")
5046 (funcall gen-func tree
))
5047 (setq error-msg nil
)) ; here it's ok
5051 (setq the-point
(max (1- (point)) (point-min))
5052 error-msg
(concat error-msg
": "
5053 (error-message-string data
)
5055 (and (string= error-msg
"SYNTAX")
5056 (format "at position %d "
5058 (format "in buffer \"%s\"."
5059 (buffer-name)))))))))
5063 (goto-char the-point
)
5064 (if ebnf-stop-on-error
5066 (message "%s" error-msg
)))
5067 ;; generated output OK
5070 ;; syntax checked OK
5072 (message "EBNF syntactic analysis: NO ERRORS.")))))
5075 (defun ebnf-parse-and-sort (start)
5076 (ebnf-log "(ebnf-parse-and-sort %S)" start
)
5078 (let ((tree (funcall ebnf-parser-func start
)))
5079 (if ebnf-sort-production
5081 (message "Sorting...")
5083 (if (eq ebnf-sort-production
'ascending
)
5084 'ebnf-sorter-ascending
5085 'ebnf-sorter-descending
)))
5089 (defun ebnf-sorter-ascending (first second
)
5090 (string< (ebnf-node-name first
)
5091 (ebnf-node-name second
)))
5094 (defun ebnf-sorter-descending (first second
)
5095 (string< (ebnf-node-name second
)
5096 (ebnf-node-name first
)))
5099 (defun ebnf-empty-alternative (width)
5100 (ps-output (ebnf-format-float width
) " EA\n"))
5103 (defun ebnf-vertical-movement (height)
5104 (ps-output (ebnf-format-float height
) " vm\n"))
5107 (defun ebnf-horizontal-movement (width)
5108 (ps-output (ebnf-format-float width
) " hm\n"))
5111 (defun ebnf-entry (height)
5112 (* height ebnf-entry-percentage
))
5115 (defun ebnf-eop-vertical (height)
5116 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space
))
5120 (defun ebnf-eop-horizontal (width)
5121 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space
))
5125 (defun ebnf-new-page ()
5126 (when (< ps-height-remaining ps-print-height
)
5127 (run-hooks 'ebnf-page-hook
)
5132 (defsubst ebnf-font-size
(font) (nth 0 font
))
5133 (defsubst ebnf-font-name
(font) (nth 1 font
))
5134 (defsubst ebnf-font-foreground
(font) (nth 2 font
))
5135 (defsubst ebnf-font-background
(font) (nth 3 font
))
5136 (defsubst ebnf-font-list
(font) (nthcdr 4 font
))
5137 (defsubst ebnf-font-attributes
(font)
5138 (lsh (ps-extension-bit (cdr font
)) -
2))
5141 (defconst ebnf-font-name-select
5142 (vector 'normal
'bold
'italic
'bold-italic
))
5145 (defun ebnf-font-name-select (font)
5146 (let* ((font-list (ebnf-font-list font
))
5147 (font-index (+ (if (memq 'bold font-list
) 1 0)
5148 (if (memq 'italic font-list
) 2 0)))
5149 (name (ebnf-font-name font
))
5150 (database (cdr (assoc name ps-font-info-database
)))
5151 (info-list (or (cdr (assoc 'fonts database
))
5152 (error "Invalid font: %s" name
))))
5153 (or (cdr (assoc (aref ebnf-font-name-select font-index
)
5155 (error "Invalid attributes for font %s" name
))))
5158 (defun ebnf-font-select (font select
)
5159 (let* ((name (ebnf-font-name font
))
5160 (database (cdr (assoc name ps-font-info-database
)))
5161 (size (cdr (assoc 'size database
)))
5162 (base (cdr (assoc select database
))))
5164 (/ (* (ebnf-font-size font
) base
)
5166 (error "Invalid font: %s" name
))))
5169 (defsubst ebnf-font-width
(font)
5170 (ebnf-font-select font
'avg-char-width
))
5171 (defsubst ebnf-font-height
(font)
5172 (ebnf-font-select font
'line-height
))
5175 (defconst ebnf-syntax-alist
5176 ;; 0.syntax 1.parser 2.initializer
5177 '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize
)
5178 (yacc ebnf-yac-parser ebnf-yac-initialize
)
5179 (abnf ebnf-abn-parser ebnf-abn-initialize
)
5180 (ebnf ebnf-bnf-parser ebnf-bnf-initialize
)
5181 (ebnfx ebnf-ebx-parser ebnf-ebx-initialize
)
5182 (dtd ebnf-dtd-parser ebnf-dtd-initialize
))
5183 "Alist associating EBNF syntax with a parser and an initializer.")
5186 (defun ebnf-begin-job ()
5187 (ps-printing-region nil nil nil
)
5188 (if ebnf-use-float-format
5189 (setq ebnf-format-float
"%1.3f"
5190 ebnf-message-float
"%3.2f")
5191 (setq ebnf-format-float
"%s"
5192 ebnf-message-float
"%s"))
5193 (ebnf-otz-initialize)
5194 ;; to avoid compilation gripes when calling autoloaded functions
5195 (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist
)
5196 (assoc 'ebnf ebnf-syntax-alist
))))
5197 (setq ebnf-parser-func
(nth 1 init
))
5198 (funcall (nth 2 init
)))
5199 (and ebnf-terminal-regexp
; ensures that it's a string or nil
5200 (not (stringp ebnf-terminal-regexp
))
5201 (setq ebnf-terminal-regexp nil
))
5202 (or (and ebnf-eps-prefix
; ensures that it's a string
5203 (stringp ebnf-eps-prefix
))
5204 (setq ebnf-eps-prefix
"ebnf--"))
5205 (setq ebnf-entry-percentage
; ensures value between 0.0 and 1.0
5206 (min (max ebnf-entry-percentage
0.0) 1.0)
5207 ebnf-action-list
(if ebnf-horizontal-orientation
5211 ebnf-fonts-required nil
5214 ebnf-eps-context nil
5215 ebnf-eps-file-alist nil
5216 ebnf-eps-production-list nil
5217 ebnf-eps-header-comment nil
5218 ebnf-eps-footer-comment nil
5219 ebnf-eps-upper-x
0.0
5220 ebnf-eps-upper-y
0.0
5221 ebnf-font-height-P
(ebnf-font-height ebnf-production-font
)
5222 ebnf-font-height-T
(ebnf-font-height ebnf-terminal-font
)
5223 ebnf-font-height-NT
(ebnf-font-height ebnf-non-terminal-font
)
5224 ebnf-font-height-S
(ebnf-font-height ebnf-special-font
)
5225 ebnf-font-height-E
(ebnf-font-height ebnf-except-font
)
5226 ebnf-font-height-R
(ebnf-font-height ebnf-repeat-font
)
5227 ebnf-font-width-P
(ebnf-font-width ebnf-production-font
)
5228 ebnf-font-width-T
(ebnf-font-width ebnf-terminal-font
)
5229 ebnf-font-width-NT
(ebnf-font-width ebnf-non-terminal-font
)
5230 ebnf-font-width-S
(ebnf-font-width ebnf-special-font
)
5231 ebnf-font-width-E
(ebnf-font-width ebnf-except-font
)
5232 ebnf-font-width-R
(ebnf-font-width ebnf-repeat-font
)
5233 ebnf-space-T
(* ebnf-font-height-T
0.5)
5234 ebnf-space-NT
(* ebnf-font-height-NT
0.5)
5235 ebnf-space-S
(* ebnf-font-height-S
0.5)
5236 ebnf-space-E
(* ebnf-font-height-E
0.5)
5237 ebnf-space-R
(* ebnf-font-height-R
0.5))
5238 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT
)))
5239 (setq ebnf-basic-width
(* basic
0.5)
5240 ebnf-horizontal-space
(+ basic basic
)
5241 ebnf-basic-empty-height
(* ebnf-basic-width
0.5)
5242 ebnf-basic-height ebnf-basic-width
5243 ebnf-vertical-space ebnf-basic-width
5244 ebnf-basic-width-extra
(- ebnf-basic-width
5245 ebnf-arrow-extra-width
5246 0.1)) ; error factor
5247 ;; ensures value is greater than zero
5248 (or (and (numberp ebnf-production-horizontal-space
)
5249 (> ebnf-production-horizontal-space
0.0))
5250 (setq ebnf-production-horizontal-space basic
))
5251 ;; ensures value is greater than zero
5252 (or (and (numberp ebnf-production-vertical-space
)
5253 (> ebnf-production-vertical-space
0.0))
5254 (setq ebnf-production-vertical-space basic
)))
5255 (ebnf-log "(ebnf-begin-job)")
5256 (ebnf-log " ebnf-arrow-extra-width ............ : %7.3f" ebnf-arrow-extra-width
)
5257 (ebnf-log " ebnf-arrow-scale .................. : %7.3f" ebnf-arrow-scale
)
5258 (ebnf-log " ebnf-basic-width-extra ............ : %7.3f" ebnf-basic-width-extra
)
5259 (ebnf-log " ebnf-basic-width .................. : %7.3f (T)" ebnf-basic-width
)
5260 (ebnf-log " ebnf-horizontal-space ............. : %7.3f (4T)" ebnf-horizontal-space
)
5261 (ebnf-log " ebnf-basic-empty-height ........... : %7.3f (hT)" ebnf-basic-empty-height
)
5262 (ebnf-log " ebnf-basic-height ................. : %7.3f (T)" ebnf-basic-height
)
5263 (ebnf-log " ebnf-vertical-space ............... : %7.3f (T)" ebnf-vertical-space
)
5264 (ebnf-log " ebnf-production-horizontal-space .. : %7.3f (2T)" ebnf-production-horizontal-space
)
5265 (ebnf-log " ebnf-production-vertical-space .... : %7.3f (2T)" ebnf-production-vertical-space
))
5268 (defsubst ebnf-shape-value
(sym alist
)
5269 (or (cdr (assq sym alist
)) 0))
5272 (defsubst ebnf-boolean
(value)
5273 (if value
"true" "false"))
5276 (defun ebnf-begin-file ()
5278 (with-current-buffer ps-spool-buffer
5279 (goto-char (point-min))
5280 (and (search-forward "%%Creator: " nil t
)
5281 (not (search-forward "& ebnf2ps v"
5282 (save-excursion (end-of-line) (point))
5285 ;; adjust creator comment
5288 (insert " & ebnf2ps v" ebnf-version
)
5289 ;; insert ebnf settings & engine
5290 (goto-char (point-max))
5291 (search-backward "\n%%EndProlog\n")
5292 (ebnf-insert-ebnf-prologue)
5293 (ps-output "\n")))))
5296 (defun ebnf-eps-finish-and-write (buffer filename
)
5297 (when (buffer-modified-p buffer
)
5298 (with-current-buffer buffer
5299 (ebnf-eps-header-footer-set filename
)
5300 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
5301 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
5304 ebnf-production-vertical-space
5305 ebnf-eps-max-height
)))
5307 (goto-char (point-min))
5309 "%!PS-Adobe-3.0 EPSF-3.0"
5310 "\n%%BoundingBox: 0 0 "
5311 (format "%d %d" (1+ ebnf-eps-upper-x
) (1+ ebnf-eps-upper-y
))
5312 "\n%%Title: " filename
5313 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
5314 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version
")"
5315 "\n%%DocumentNeededResources: font "
5316 (or ebnf-fonts-required
5317 (setq ebnf-fonts-required
5318 (mapconcat 'identity
5319 (ps-remove-duplicates
5320 (mapcar 'ebnf-font-name-select
5321 (list ebnf-production-font
5323 ebnf-non-terminal-font
5327 ebnf-eps-header-font
5328 ebnf-eps-footer-font
)))
5330 "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
5332 (ebnf-insert-ebnf-prologue)
5333 (insert ebnf-eps-begin
5334 "\n0 " (ebnf-format-float
5335 (- ebnf-eps-upper-y
(* ebnf-font-height-P
0.7)))
5336 " #ebnf2ps#begin\n")
5338 (goto-char (point-max))
5339 (insert ebnf-eps-end
)
5341 (message "Saving...")
5342 (setq filename
(expand-file-name filename
))
5343 (let ((coding-system-for-write 'raw-text-unix
))
5344 (write-region (point-min) (point-max) filename
))
5345 (message "Wrote %s" filename
))))
5348 (defun ebnf-insert-ebnf-prologue ()
5353 "\n\n% === begin EBNF settings\n\n"
5354 (format "/Header %s def\n"
5355 (or ebnf-eps-header-comment
"()"))
5356 (format "/Footer %s def\n"
5357 (or ebnf-eps-footer-comment
"()"))
5359 (format "/ShowHeader %s def\n"
5361 (ebnf-eps-header-footer-p ebnf-eps-header
)))
5362 (format "/fH %s /%s DefFont\n"
5364 (ebnf-font-size ebnf-eps-header-font
))
5365 (ebnf-font-name-select ebnf-eps-header-font
))
5366 (ebnf-format-color "/ForegroundH %s def %% %s\n"
5367 (ebnf-font-foreground ebnf-eps-header-font
)
5369 (ebnf-format-color "/BackgroundH %s def %% %s\n"
5370 (ebnf-font-background ebnf-eps-header-font
)
5372 (format "/EffectH %d def\n"
5373 (ebnf-font-attributes ebnf-eps-header-font
))
5375 (format "/ShowFooter %s def\n"
5377 (ebnf-eps-header-footer-p ebnf-eps-footer
)))
5378 (format "/fF %s /%s DefFont\n"
5380 (ebnf-font-size ebnf-eps-footer-font
))
5381 (ebnf-font-name-select ebnf-eps-footer-font
))
5382 (ebnf-format-color "/ForegroundF %s def %% %s\n"
5383 (ebnf-font-foreground ebnf-eps-footer-font
)
5385 (ebnf-format-color "/BackgroundF %s def %% %s\n"
5386 (ebnf-font-background ebnf-eps-footer-font
)
5388 (format "/EffectF %d def\n"
5389 (ebnf-font-attributes ebnf-eps-footer-font
))
5391 (format "/fP %s /%s DefFont\n"
5392 (ebnf-format-float (ebnf-font-size ebnf-production-font
))
5393 (ebnf-font-name-select ebnf-production-font
))
5394 (ebnf-format-color "/ForegroundP %s def %% %s\n"
5395 (ebnf-font-foreground ebnf-production-font
)
5397 (ebnf-format-color "/BackgroundP %s def %% %s\n"
5398 (ebnf-font-background ebnf-production-font
)
5400 (format "/EffectP %d def\n"
5401 (ebnf-font-attributes ebnf-production-font
))
5403 (format "/fT %s /%s DefFont\n"
5404 (ebnf-format-float (ebnf-font-size ebnf-terminal-font
))
5405 (ebnf-font-name-select ebnf-terminal-font
))
5406 (ebnf-format-color "/ForegroundT %s def %% %s\n"
5407 (ebnf-font-foreground ebnf-terminal-font
)
5409 (ebnf-format-color "/BackgroundT %s def %% %s\n"
5410 (ebnf-font-background ebnf-terminal-font
)
5412 (format "/EffectT %d def\n"
5413 (ebnf-font-attributes ebnf-terminal-font
))
5414 (format "/BorderWidthT %s def\n"
5415 (ebnf-format-float ebnf-terminal-border-width
))
5416 (ebnf-format-color "/BorderColorT %s def %% %s\n"
5417 ebnf-terminal-border-color
5419 (format "/ShapeT %d def\n"
5420 (ebnf-shape-value ebnf-terminal-shape
5421 ebnf-terminal-shape-alist
))
5422 (format "/ShadowT %s def\n"
5423 (ebnf-boolean ebnf-terminal-shadow
))
5425 (format "/fNT %s /%s DefFont\n"
5427 (ebnf-font-size ebnf-non-terminal-font
))
5428 (ebnf-font-name-select ebnf-non-terminal-font
))
5429 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
5430 (ebnf-font-foreground ebnf-non-terminal-font
)
5432 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
5433 (ebnf-font-background ebnf-non-terminal-font
)
5435 (format "/EffectNT %d def\n"
5436 (ebnf-font-attributes ebnf-non-terminal-font
))
5437 (format "/BorderWidthNT %s def\n"
5438 (ebnf-format-float ebnf-non-terminal-border-width
))
5439 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
5440 ebnf-non-terminal-border-color
5442 (format "/ShapeNT %d def\n"
5443 (ebnf-shape-value ebnf-non-terminal-shape
5444 ebnf-terminal-shape-alist
))
5445 (format "/ShadowNT %s def\n"
5446 (ebnf-boolean ebnf-non-terminal-shadow
))
5448 (format "/fS %s /%s DefFont\n"
5449 (ebnf-format-float (ebnf-font-size ebnf-special-font
))
5450 (ebnf-font-name-select ebnf-special-font
))
5451 (ebnf-format-color "/ForegroundS %s def %% %s\n"
5452 (ebnf-font-foreground ebnf-special-font
)
5454 (ebnf-format-color "/BackgroundS %s def %% %s\n"
5455 (ebnf-font-background ebnf-special-font
)
5457 (format "/EffectS %d def\n"
5458 (ebnf-font-attributes ebnf-special-font
))
5459 (format "/BorderWidthS %s def\n"
5460 (ebnf-format-float ebnf-special-border-width
))
5461 (ebnf-format-color "/BorderColorS %s def %% %s\n"
5462 ebnf-special-border-color
5464 (format "/ShapeS %d def\n"
5465 (ebnf-shape-value ebnf-special-shape
5466 ebnf-terminal-shape-alist
))
5467 (format "/ShadowS %s def\n"
5468 (ebnf-boolean ebnf-special-shadow
))
5470 (format "/fE %s /%s DefFont\n"
5471 (ebnf-format-float (ebnf-font-size ebnf-except-font
))
5472 (ebnf-font-name-select ebnf-except-font
))
5473 (ebnf-format-color "/ForegroundE %s def %% %s\n"
5474 (ebnf-font-foreground ebnf-except-font
)
5476 (ebnf-format-color "/BackgroundE %s def %% %s\n"
5477 (ebnf-font-background ebnf-except-font
)
5479 (format "/EffectE %d def\n"
5480 (ebnf-font-attributes ebnf-except-font
))
5481 (format "/BorderWidthE %s def\n"
5482 (ebnf-format-float ebnf-except-border-width
))
5483 (ebnf-format-color "/BorderColorE %s def %% %s\n"
5484 ebnf-except-border-color
5486 (format "/ShapeE %d def\n"
5487 (ebnf-shape-value ebnf-except-shape
5488 ebnf-terminal-shape-alist
))
5489 (format "/ShadowE %s def\n"
5490 (ebnf-boolean ebnf-except-shadow
))
5492 (format "/fR %s /%s DefFont\n"
5493 (ebnf-format-float (ebnf-font-size ebnf-repeat-font
))
5494 (ebnf-font-name-select ebnf-repeat-font
))
5495 (ebnf-format-color "/ForegroundR %s def %% %s\n"
5496 (ebnf-font-foreground ebnf-repeat-font
)
5498 (ebnf-format-color "/BackgroundR %s def %% %s\n"
5499 (ebnf-font-background ebnf-repeat-font
)
5501 (format "/EffectR %d def\n"
5502 (ebnf-font-attributes ebnf-repeat-font
))
5503 (format "/BorderWidthR %s def\n"
5504 (ebnf-format-float ebnf-repeat-border-width
))
5505 (ebnf-format-color "/BorderColorR %s def %% %s\n"
5506 ebnf-repeat-border-color
5508 (format "/ShapeR %d def\n"
5509 (ebnf-shape-value ebnf-repeat-shape
5510 ebnf-terminal-shape-alist
))
5511 (format "/ShadowR %s def\n"
5512 (ebnf-boolean ebnf-repeat-shadow
))
5514 (format "/ExtraWidth %s def\n"
5515 (ebnf-format-float ebnf-arrow-extra-width
))
5516 (format "/ArrowScale %s def\n"
5517 (ebnf-format-float ebnf-arrow-scale
))
5518 (format "/DefaultWidth %s def\n"
5519 (ebnf-format-float ebnf-default-width
))
5520 (format "/LineWidth %s def\n"
5521 (ebnf-format-float ebnf-line-width
))
5522 (ebnf-format-color "/LineColor %s def %% %s\n"
5525 (format "/ArrowShape %d def\n"
5526 (ebnf-shape-value ebnf-arrow-shape
5527 ebnf-arrow-shape-alist
))
5528 (format "/ChartShape %d def\n"
5529 (ebnf-shape-value ebnf-chart-shape
5530 ebnf-terminal-shape-alist
))
5531 (format "/UserArrow{%s}def\n"
5532 (let ((arrow (eval ebnf-user-arrow
)))
5536 "\n% === end EBNF settings\n\n"
5537 (and ebnf-debug-ps ebnf-debug
))))
5541 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5542 ;; Adjusting dimensions
5545 (defun ebnf-dimensions (tree)
5546 (ebnf-log "(ebnf-dimensions tree)")
5547 (let ((ebnf-total (length tree
))
5549 (mapc 'ebnf-production-dimension tree
))
5553 ;; [empty width-fun dim-fun entry height width]
5554 ;;(defun ebnf-empty-dimension (empty)
5558 ;; [production width-fun dim-fun entry height width name production action]
5559 (defun ebnf-production-dimension (production)
5560 (ebnf-log "(ebnf-production-dimension production)")
5561 (ebnf-message-info "Calculating dimensions")
5562 (ebnf-node-dimension-func (ebnf-node-production production
))
5563 (let* ((prod (ebnf-node-production production
))
5564 (height (+ (if ebnf-production-name-p
5567 ebnf-line-width ebnf-line-width
5569 (ebnf-node-height prod
))))
5570 (ebnf-node-entry production height
)
5571 (ebnf-node-height production height
)
5572 (ebnf-node-width production
(+ (ebnf-node-width prod
)
5574 ebnf-horizontal-space
5575 ebnf-basic-width-extra
)))
5576 (ebnf-log " production name : %S" (ebnf-node-name production
))
5577 (ebnf-log " production entry : %7.3f" (ebnf-node-entry production
))
5578 (ebnf-log " production height : %7.3f" (ebnf-node-height production
))
5579 (ebnf-log " production width : %7.3f" (ebnf-node-width production
)))
5582 ;; [terminal width-fun dim-fun entry height width name]
5583 (defun ebnf-terminal-dimension (terminal)
5584 (ebnf-log "(ebnf-terminal-dimension terminal)")
5585 (ebnf-terminal-dimension1 terminal
5591 ;; [non-terminal width-fun dim-fun entry height width name]
5592 (defun ebnf-non-terminal-dimension (non-terminal)
5593 (ebnf-log "(ebnf-non-terminal-dimension non-terminal)")
5594 (ebnf-terminal-dimension1 non-terminal
5600 ;; [special width-fun dim-fun entry height width name]
5601 (defun ebnf-special-dimension (special)
5602 (ebnf-log "(ebnf-special-dimension special)")
5603 (ebnf-terminal-dimension1 special
5609 (defun ebnf-terminal-dimension1 (node font-height font-width space
)
5610 (let ((height (+ space font-height space
))
5611 (len (length (ebnf-node-name node
))))
5612 (ebnf-node-entry node
(* height
0.5))
5613 (ebnf-node-height node height
)
5614 (ebnf-node-width node
(+ ebnf-basic-width
5615 ebnf-arrow-extra-width
5620 (ebnf-log " name : %S" (ebnf-node-name node
))
5621 (ebnf-log " entry : %7.3f" (ebnf-node-entry node
))
5622 (ebnf-log " height : %7.3f" (ebnf-node-height node
))
5623 (ebnf-log " width : %7.3f" (ebnf-node-width node
)))
5626 (defconst ebnf-null-vector
(vector t t t
0.0 0.0 0.0))
5629 ;; [repeat width-fun dim-fun entry height width times element]
5630 (defun ebnf-repeat-dimension (repeat)
5631 (ebnf-log "(ebnf-repeat-dimension repeat)")
5632 (let ((times (ebnf-node-name repeat
))
5633 (element (ebnf-node-separator repeat
)))
5635 (ebnf-node-dimension-func element
)
5636 (setq element ebnf-null-vector
))
5637 (ebnf-node-entry repeat
(+ (ebnf-node-entry element
)
5639 (ebnf-node-height repeat
(+ (max (ebnf-node-height element
)
5641 ebnf-space-R ebnf-space-R
))
5642 (ebnf-node-width repeat
(+ (ebnf-node-width element
)
5643 ebnf-arrow-extra-width
5644 ebnf-space-R ebnf-space-R ebnf-space-R
5645 ebnf-horizontal-space
5646 (* (length times
) ebnf-font-width-R
))))
5647 (ebnf-log " repeat entry : %7.3f" (ebnf-node-entry repeat
))
5648 (ebnf-log " repeat height : %7.3f" (ebnf-node-height repeat
))
5649 (ebnf-log " repeat width : %7.3f" (ebnf-node-width repeat
)))
5652 ;; [except width-fun dim-fun entry height width element element]
5653 (defun ebnf-except-dimension (except)
5654 (ebnf-log "(ebnf-except-dimension except)")
5655 (let ((factor (ebnf-node-list except
))
5656 (element (ebnf-node-separator except
)))
5657 (ebnf-node-dimension-func factor
)
5659 (ebnf-node-dimension-func element
)
5660 (setq element ebnf-null-vector
))
5661 (ebnf-node-entry except
(+ (max (ebnf-node-entry factor
)
5662 (ebnf-node-entry element
))
5664 (ebnf-node-height except
(+ (max (ebnf-node-height factor
)
5665 (ebnf-node-height element
))
5666 ebnf-space-E ebnf-space-E
))
5667 (ebnf-node-width except
(+ (ebnf-node-width factor
)
5668 (ebnf-node-width element
)
5669 ebnf-arrow-extra-width
5670 ebnf-space-E ebnf-space-E
5671 ebnf-space-E ebnf-space-E
5673 ebnf-horizontal-space
)))
5674 (ebnf-log " except entry : %7.3f" (ebnf-node-entry except
))
5675 (ebnf-log " except height : %7.3f" (ebnf-node-height except
))
5676 (ebnf-log " except width : %7.3f" (ebnf-node-width except
)))
5679 ;; [alternative width-fun dim-fun entry height width list]
5680 (defun ebnf-alternative-dimension (alternative)
5681 (ebnf-log "(ebnf-alternative-dimension alternative)")
5682 (let ((body (ebnf-node-list alternative
))
5683 (lis (ebnf-node-list alternative
)))
5685 (ebnf-node-dimension-func (car lis
))
5686 (setq lis
(cdr lis
)))
5690 (tail (car (last body
)))
5691 (entry (ebnf-node-entry (car body
)))
5694 (setq node
(car alt
)
5696 height
(+ (ebnf-node-height node
) height
)
5697 width
(max (ebnf-node-width node
) width
)))
5698 (ebnf-adjust-width body width
)
5699 (setq height
(+ height
(* (1- (length body
)) ebnf-vertical-space
)))
5700 (ebnf-node-entry alternative
(+ entry
5703 (- (ebnf-node-height tail
)
5704 (ebnf-node-entry tail
))))))
5705 (ebnf-node-height alternative height
)
5706 (ebnf-node-width alternative
(+ width
5707 ebnf-horizontal-space
5708 ebnf-basic-width-extra
))
5709 (ebnf-node-list alternative body
)))
5710 (ebnf-log " alternative entry : %7.3f" (ebnf-node-entry alternative
))
5711 (ebnf-log " alternative height : %7.3f" (ebnf-node-height alternative
))
5712 (ebnf-log " alternative width : %7.3f" (ebnf-node-width alternative
)))
5715 ;; [optional width-fun dim-fun entry height width element]
5716 (defun ebnf-optional-dimension (optional)
5717 (ebnf-log "(ebnf-optional-dimension optional)")
5718 (let ((body (ebnf-node-list optional
)))
5719 (ebnf-node-dimension-func body
)
5720 (ebnf-node-entry optional
(ebnf-node-entry body
))
5721 (ebnf-node-height optional
(+ (ebnf-node-height body
)
5722 ebnf-vertical-space
))
5723 (ebnf-node-width optional
(+ (ebnf-node-width body
)
5724 ebnf-horizontal-space
)))
5725 (ebnf-log " optional entry : %7.3f" (ebnf-node-entry optional
))
5726 (ebnf-log " optional height : %7.3f" (ebnf-node-height optional
))
5727 (ebnf-log " optional width : %7.3f" (ebnf-node-width optional
)))
5730 ;; [one-or-more width-fun dim-fun entry height width element separator]
5731 (defun ebnf-one-or-more-dimension (or-more)
5732 (ebnf-log "(ebnf-one-or-more-dimension or-more)")
5733 (let ((list-part (ebnf-node-list or-more
))
5734 (sep-part (ebnf-node-separator or-more
)))
5735 (ebnf-node-dimension-func list-part
)
5737 (ebnf-node-dimension-func sep-part
))
5738 (let ((height (+ (if sep-part
5739 (ebnf-node-height sep-part
)
5740 ebnf-basic-empty-height
)
5742 (ebnf-node-height list-part
)))
5743 (width (max (if sep-part
5744 (ebnf-node-width sep-part
)
5746 (ebnf-node-width list-part
))))
5748 (ebnf-adjust-width list-part width
)
5749 (ebnf-adjust-width sep-part width
))
5750 (ebnf-node-entry or-more
(+ (- height
5751 (ebnf-node-height list-part
))
5752 (ebnf-node-entry list-part
)))
5753 (ebnf-node-height or-more height
)
5754 (ebnf-node-width or-more
(+ width
5755 ebnf-horizontal-space
5756 ebnf-basic-width-extra
))))
5757 (ebnf-log " one-or-more entry : %7.3f" (ebnf-node-entry or-more
))
5758 (ebnf-log " one-or-more height : %7.3f" (ebnf-node-height or-more
))
5759 (ebnf-log " one-or-more width : %7.3f" (ebnf-node-width or-more
)))
5762 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5763 (defun ebnf-zero-or-more-dimension (or-more)
5764 (ebnf-log "(ebnf-zero-or-more-dimension or-more)")
5765 (let ((list-part (ebnf-node-list or-more
))
5766 (sep-part (ebnf-node-separator or-more
)))
5767 (ebnf-node-dimension-func list-part
)
5769 (ebnf-node-dimension-func sep-part
))
5770 (let ((height (+ (if sep-part
5771 (ebnf-node-height sep-part
)
5772 ebnf-basic-empty-height
)
5774 (ebnf-node-height list-part
)
5775 ebnf-vertical-space
))
5776 (width (max (if sep-part
5777 (ebnf-node-width sep-part
)
5779 (ebnf-node-width list-part
))))
5781 (ebnf-adjust-width list-part width
)
5782 (ebnf-adjust-width sep-part width
))
5783 (ebnf-node-entry or-more height
)
5784 (ebnf-node-height or-more height
)
5785 (ebnf-node-width or-more
(+ width
5786 ebnf-horizontal-space
5787 ebnf-basic-width-extra
))))
5788 (ebnf-log " zero-or-more entry : %7.3f" (ebnf-node-entry or-more
))
5789 (ebnf-log " zero-or-more height : %7.3f" (ebnf-node-height or-more
))
5790 (ebnf-log " zero-or-more width : %7.3f" (ebnf-node-width or-more
)))
5793 ;; [sequence width-fun dim-fun entry height width list]
5794 (defun ebnf-sequence-dimension (sequence)
5795 (ebnf-log "(ebnf-sequence-dimension sequence)")
5799 (lis (ebnf-node-list sequence
))
5802 (setq node
(car lis
)
5804 (ebnf-node-dimension-func node
)
5805 (setq entry
(ebnf-node-entry node
)
5806 above
(max above entry
)
5807 below
(max below
(- (ebnf-node-height node
) entry
))
5808 width
(+ width
(ebnf-node-width node
))))
5809 (ebnf-node-entry sequence above
)
5810 (ebnf-node-height sequence
(+ above below
))
5811 (ebnf-node-width sequence width
))
5812 (ebnf-log " sequence entry : %7.3f" (ebnf-node-entry sequence
))
5813 (ebnf-log " sequence height : %7.3f" (ebnf-node-height sequence
))
5814 (ebnf-log " sequence width : %7.3f" (ebnf-node-width sequence
)))
5817 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5821 (defun ebnf-adjust-width (node width
)
5827 (setcar node
(ebnf-adjust-width (car node
) width
))
5828 (setq node
(cdr node
)))))
5831 ;; nothing to be done
5832 ((= width
(ebnf-node-width node
))
5834 ;; left justify term
5835 ((eq ebnf-justify-sequence
'left
)
5836 (ebnf-adjust-empty node width nil
))
5837 ;; right justify terms
5838 ((eq ebnf-justify-sequence
'right
)
5839 (ebnf-adjust-empty node width t
))
5842 (ebnf-node-width-func node width
)
5843 (ebnf-node-width node width
)
5851 (defun ebnf-adjust-empty (node width last-p
)
5852 (if (eq (ebnf-node-kind node
) 'ebnf-generate-empty
)
5854 (ebnf-node-width node width
)
5856 (let ((empty (ebnf-make-empty (- width
(ebnf-node-width node
)))))
5857 (ebnf-make-dup-sequence node
5860 (list node empty
))))))
5863 ;; [terminal width-fun dim-fun entry height width name]
5864 ;; [non-terminal width-fun dim-fun entry height width name]
5865 ;; [empty width-fun dim-fun entry height width]
5866 ;; [special width-fun dim-fun entry height width name]
5867 ;; [repeat width-fun dim-fun entry height width times element]
5868 ;; [except width-fun dim-fun entry height width element element]
5869 ;;(defun ebnf-terminal-width (terminal width)
5873 ;; [alternative width-fun dim-fun entry height width list]
5874 ;; [optional width-fun dim-fun entry height width element]
5875 (defun ebnf-alternative-width (alternative width
)
5876 (ebnf-adjust-width (ebnf-node-list alternative
)
5877 (- width ebnf-horizontal-space
)))
5880 ;; [one-or-more width-fun dim-fun entry height width element separator]
5881 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5882 (defun ebnf-element-width (or-more width
)
5883 (setq width
(- width ebnf-horizontal-space
))
5884 (ebnf-node-list or-more
5885 (ebnf-justify-list or-more
5886 (ebnf-node-list or-more
)
5888 (ebnf-node-separator or-more
5889 (ebnf-justify-list or-more
5890 (ebnf-node-separator or-more
)
5894 ;; [sequence width-fun dim-fun entry height width list]
5895 (defun ebnf-sequence-width (sequence width
)
5896 (ebnf-node-list sequence
5897 (ebnf-justify-list sequence
5898 (ebnf-node-list sequence
)
5902 (defun ebnf-justify-list (node seq width
)
5903 (let ((seq-width (ebnf-node-width node
)))
5904 (if (= width seq-width
)
5907 ;; left justify terms
5908 ((eq ebnf-justify-sequence
'left
)
5909 (ebnf-justify node seq seq-width width t
))
5910 ;; right justify terms
5911 ((eq ebnf-justify-sequence
'right
)
5912 (ebnf-justify node seq seq-width width nil
))
5913 ;; centralize terms -- element
5915 (ebnf-adjust-width seq width
))
5916 ;; centralize terms -- list
5918 (let ((the-width (/ (- width seq-width
) (length seq
)))
5921 (ebnf-adjust-width (car lis
)
5922 (+ (ebnf-node-width (car lis
))
5924 (setq lis
(cdr lis
)))
5929 (defun ebnf-justify (node seq seq-width width last-p
)
5930 (let ((term (car (if last-p
(last seq
) seq
))))
5932 ;; adjust empty term
5933 ((eq (ebnf-node-kind term
) 'ebnf-generate-empty
)
5934 (ebnf-node-width term
(+ (- width seq-width
)
5935 (ebnf-node-width term
)))
5937 ;; insert empty at end ==> left justify
5940 (list (ebnf-make-empty (- width seq-width
)))))
5941 ;; insert empty at beginning ==> right justify
5943 (cons (ebnf-make-empty (- width seq-width
))
5948 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5949 ;; Functions used by parsers
5952 (defun ebnf-eps-add-context (name)
5953 (let ((filename (ebnf-eps-filename name
)))
5954 (if (member filename ebnf-eps-context
)
5955 (error "Try to open an already opened EPS file: %s" filename
)
5956 (setq ebnf-eps-context
(cons filename ebnf-eps-context
)))
5957 (ebnf-eps-header-footer-file filename
)))
5960 (defun ebnf-eps-remove-context (name)
5961 (let ((filename (ebnf-eps-filename name
)))
5962 (if (member filename ebnf-eps-context
)
5963 (setq ebnf-eps-context
(delete filename ebnf-eps-context
))
5964 (error "Try to close a not opened EPS file: %s" filename
))))
5967 (defun ebnf-eps-add-production (header)
5968 (when ebnf-eps-executing
5969 (if ebnf-eps-context
5970 (let ((prod (assoc header ebnf-eps-production-list
)))
5972 (setcdr prod
(ebnf-dup-list
5973 (append ebnf-eps-context
(cdr prod
))))
5974 (setq ebnf-eps-production-list
5975 (cons (cons header
(ebnf-dup-list ebnf-eps-context
))
5976 ebnf-eps-production-list
))))
5977 (ebnf-eps-header-footer-file (ebnf-eps-filename header
)))))
5980 (defun ebnf-dup-list (old)
5983 (setq new
(cons (car old
) new
)
5988 (defun ebnf-buffer-substring (chars)
5989 (buffer-substring-no-properties
5992 (skip-chars-forward chars ebnf-limit
)
5996 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
5997 (defconst ebnf-8-bit-chars
(ebnf-range-regexp "" ?
\240 ?
\377))
6000 (defun ebnf-string (chars eos-char kind
)
6002 (buffer-substring-no-properties
6005 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
6006 (skip-chars-forward (concat chars ebnf-8-bit-chars
) ebnf-limit
)
6007 (if (or (eobp) (/= (following-char) eos-char
))
6008 (error "Invalid %s: missing `%c'" kind eos-char
)
6013 (defun ebnf-get-string ()
6015 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
6018 (defun ebnf-end-of-string ()
6020 (while (> (logand n
1) 0)
6021 (skip-chars-forward "^\"" ebnf-limit
)
6022 (setq n
(- (skip-chars-backward "\\\\")))
6023 (goto-char (+ (point) n
1))))
6024 (if (= (preceding-char) ?
\")
6026 (error "Missing `\"'")))
6029 (defun ebnf-trim-right (str)
6030 (let* ((len (1- (length str
)))
6032 ;; to keep compatibility with Emacs 20 & 21:
6033 ;; DO NOT REPLACE `?\ ' BY `?\s'
6034 (while (and (> index
0) (= (aref str index
) ?\
))
6035 (setq index
(1- index
)))
6038 (substring str
0 (1+ index
)))))
6041 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6045 (defun ebnf-make-empty (&optional width
)
6046 (vector 'ebnf-generate-empty
; 0 generator
6047 'ignore
; 1 width fun
6048 'ignore
; 2 dimension fun
6051 (or width ebnf-horizontal-space
))) ; 5 width
6054 (defun ebnf-make-terminal (name)
6055 (ebnf-make-terminal1 name
6056 'ebnf-generate-terminal
6057 'ebnf-terminal-dimension
))
6060 (defun ebnf-make-non-terminal (name)
6061 (ebnf-make-terminal1 name
6062 'ebnf-generate-non-terminal
6063 'ebnf-non-terminal-dimension
))
6066 (defun ebnf-make-special (name)
6067 (ebnf-make-terminal1 name
6068 'ebnf-generate-special
6069 'ebnf-special-dimension
))
6072 (defun ebnf-make-terminal1 (name gen-func dim-func
)
6073 (vector gen-func
; 0 generatore
6074 'ignore
; 1 width fun
6075 dim-func
; 2 dimension fun
6079 (let ((len (length name
))) ; 6 name
6080 (cond ((> len
3) name
)
6081 ((= len
3) (concat name
" "))
6082 ((= len
2) (concat " " name
" "))
6083 ((= len
1) (concat " " name
" "))
6085 ebnf-default-p
)) ; 7 is default?
6088 (defun ebnf-make-one-or-more (list-part &optional sep-part
)
6089 (ebnf-make-or-more1 'ebnf-generate-one-or-more
6090 'ebnf-one-or-more-dimension
6095 (defun ebnf-make-zero-or-more (list-part &optional sep-part
)
6096 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
6097 'ebnf-zero-or-more-dimension
6102 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part
)
6103 (vector gen-func
; 0 generator
6104 'ebnf-element-width
; 1 width fun
6105 dim-func
; 2 dimension fun
6109 (if (listp list-part
) ; 6 element
6110 (ebnf-make-sequence list-part
)
6112 (if (and sep-part
(listp sep-part
)) ; 7 separator
6113 (ebnf-make-sequence sep-part
)
6117 (defun ebnf-make-production (name prod action
)
6118 (vector 'ebnf-generate-production
; 0 generator
6119 'ignore
; 1 width fun
6120 'ebnf-production-dimension
; 2 dimension fun
6124 name
; 6 production name
6125 prod
; 7 production body
6126 action
)) ; 8 production action
6129 (defun ebnf-make-alternative (body)
6130 (vector 'ebnf-generate-alternative
; 0 generator
6131 'ebnf-alternative-width
; 1 width fun
6132 'ebnf-alternative-dimension
; 2 dimension fun
6136 body
)) ; 6 alternative list
6139 (defun ebnf-make-optional (body)
6140 (vector 'ebnf-generate-optional
; 0 generator
6141 'ebnf-alternative-width
; 1 width fun
6142 'ebnf-optional-dimension
; 2 dimension fun
6146 body
)) ; 6 optional element
6149 (defun ebnf-make-except (factor exception
)
6150 (vector 'ebnf-generate-except
; 0 generator
6151 'ignore
; 1 width fun
6152 'ebnf-except-dimension
; 2 dimension fun
6156 factor
; 6 base element
6157 exception
)) ; 7 exception element
6160 (defun ebnf-make-repeat (times primary
&optional upper
)
6161 (vector 'ebnf-generate-repeat
; 0 generator
6162 'ignore
; 1 width fun
6163 'ebnf-repeat-dimension
; 2 dimension fun
6168 (cond ((and times upper
) ; L * U, L * L
6169 (if (string= times upper
)
6170 (if (string= times
"")
6173 (concat times
" * " upper
)))
6175 (concat times
" *"))
6177 (concat "* " upper
))
6180 primary
)) ; 7 element
6183 (defun ebnf-make-sequence (seq)
6184 (vector 'ebnf-generate-sequence
; 0 generator
6185 'ebnf-sequence-width
; 1 width fun
6186 'ebnf-sequence-dimension
; 2 dimension fun
6193 (defun ebnf-make-dup-sequence (node seq
)
6194 (vector 'ebnf-generate-sequence
; 0 generator
6195 'ebnf-sequence-width
; 1 width fun
6196 'ebnf-sequence-dimension
; 2 dimension fun
6197 (ebnf-node-entry node
) ; 3 entry
6198 (ebnf-node-height node
) ; 4 height
6199 (ebnf-node-width node
) ; 5 width
6203 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6204 ;; Optimizers used by parsers
6207 (defun ebnf-token-except (element exception
)
6210 (setq exception
(cdr exception
)))
6211 (and element
; EMPTY - A ==> EMPTY
6212 (let ((kind (ebnf-node-kind element
)))
6215 ((and (null exception
)
6216 (eq kind
'ebnf-generate-optional
))
6217 (ebnf-node-list element
))
6218 ;; { A }- ==> { A }+
6219 ((and (null exception
)
6220 (eq kind
'ebnf-generate-zero-or-more
))
6221 (ebnf-node-kind element
'ebnf-generate-one-or-more
)
6222 (ebnf-node-dimension-func element
'ebnf-one-or-more-dimension
)
6224 ;; ( A | EMPTY )- ==> A
6225 ;; ( A | B | EMPTY )- ==> A | B
6226 ((and (null exception
)
6227 (eq kind
'ebnf-generate-alternative
)
6229 (car (last (ebnf-node-list element
))))
6230 'ebnf-generate-empty
))
6231 (let ((elt (ebnf-node-list element
))
6237 ;; this should not happen!!?!
6238 (setq element
(ebnf-make-empty
6239 (ebnf-node-width element
)))
6241 (setq elt
(ebnf-node-list element
))
6242 (and (= (length elt
) 1)
6243 (setq element
(car elt
))))
6247 (ebnf-make-except element exception
))
6251 (defun ebnf-token-repeat (times repeat
&optional upper
)
6252 (if (null (cdr repeat
))
6253 ;; n * EMPTY ==> EMPTY
6257 (ebnf-make-repeat times
(cdr repeat
) upper
))))
6260 (defun ebnf-token-optional (body)
6261 (let ((kind (ebnf-node-kind body
)))
6263 ;; [ EMPTY ] ==> EMPTY
6264 ((eq kind
'ebnf-generate-empty
)
6266 ;; [ { A }* ] ==> { A }*
6267 ((eq kind
'ebnf-generate-zero-or-more
)
6269 ;; [ { A }+ ] ==> { A }*
6270 ((eq kind
'ebnf-generate-one-or-more
)
6271 (ebnf-node-kind body
'ebnf-generate-zero-or-more
)
6273 ;; [ A | B ] ==> A | B | EMPTY
6274 ((eq kind
'ebnf-generate-alternative
)
6275 (ebnf-node-list body
(nconc (ebnf-node-list body
)
6276 (list (ebnf-make-empty))))
6280 (ebnf-make-optional body
))
6284 (defun ebnf-token-alternative (body sequence
)
6290 (cons (car sequence
) ; token
6292 (cons (car sequence
) ; token
6293 (let ((seq (cdr sequence
)))
6294 (if (and (= (length body
) 1) (null seq
))
6295 ;; alternative with one element
6297 ;; a real alternative
6298 (ebnf-make-alternative (nreverse (if seq
6303 (defun ebnf-token-sequence (sequence)
6308 ;; sequence with only one element
6309 ((= (length sequence
) 1)
6313 (ebnf-make-sequence (nreverse sequence
)))
6317 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6318 ;; Variables used by parsers
6321 (defconst ebnf-comment-table
6322 (let ((table (make-vector 256 nil
)))
6323 ;; Override special comment character:
6324 (aset table ?
< 'newline
)
6325 (aset table ?
> 'keep-line
)
6326 (aset table ?^
'form-feed
)
6328 "Vector used to map characters to a special comment token.")
6331 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6335 (defun ebnf-log-header (format-str &rest args
)
6340 "\n\n===============================================================\n\n"
6345 (defun ebnf-log (format-str &rest args
)
6347 (with-current-buffer (get-buffer-create "*Ebnf2ps Log*")
6348 (goto-char (point-max))
6349 (insert (apply 'format format-str args
) "\n"))))
6352 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6353 ;; To make this file smaller, some commands go in a separate file.
6354 ;; But autoload them here to make the separation invisible.
6356 (autoload 'ebnf-abn-parser
"ebnf-abn"
6359 (autoload 'ebnf-abn-initialize
"ebnf-abn"
6360 "Initialize ABNF token table.")
6362 (autoload 'ebnf-bnf-parser
"ebnf-bnf"
6365 (autoload 'ebnf-bnf-initialize
"ebnf-bnf"
6366 "Initialize EBNF token table.")
6368 (autoload 'ebnf-iso-parser
"ebnf-iso"
6371 (autoload 'ebnf-iso-initialize
"ebnf-iso"
6372 "Initialize ISO EBNF token table.")
6374 (autoload 'ebnf-yac-parser
"ebnf-yac"
6375 "Yacc/Bison parser.")
6377 (autoload 'ebnf-yac-initialize
"ebnf-yac"
6378 "Initializations for Yacc/Bison parser.")
6380 (autoload 'ebnf-ebx-parser
"ebnf-ebx"
6383 (autoload 'ebnf-ebx-initialize
"ebnf-ebx"
6384 "Initializations for EBNFX parser.")
6386 (autoload 'ebnf-dtd-parser
"ebnf-dtd"
6389 (autoload 'ebnf-dtd-initialize
"ebnf-dtd"
6390 "Initializations for DTD parser.")
6393 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6398 ;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
6399 ;;; ebnf2ps.el ends here