1 ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004
4 ;; Free Software Foundation, Inc.
6 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
7 ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Time-stamp: <2004/04/04 21:40:30 vinicius>
9 ;; Keywords: wp, ebnf, PostScript
11 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
13 ;; This file is part of GNU Emacs.
15 ;; GNU Emacs is free software; you can redistribute it and/or modify
16 ;; it under the terms of the GNU General Public License as published by
17 ;; the Free Software Foundation; either version 2, or (at your option)
20 ;; GNU Emacs is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
30 (defconst ebnf-version
"4.2"
31 "ebnf2ps.el, v 4.2 <2004/04/04 vinicius>
33 Vinicius's last change version. When reporting bugs, please also
34 report the version of Emacs, if any, that ebnf2ps was running with.
36 Please send all bug fixes and enhancements to
37 Vinicius Jose Latorre <viniciusjl@ig.com.br>.
43 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; This package translates an EBNF to a syntactic chart on PostScript.
50 ;; To use ebnf2ps, insert in your ~/.emacs:
54 ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
55 ;; know how to set options like landscape printing, page headings, margins,
58 ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
59 ;; ebnf2ps, they behave as it's turned off.
61 ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
63 ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
65 ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
67 ;; ebnf2ps was tested with GNU Emacs 20.4.1.
73 ;; ebnf2ps provides the following commands for generating PostScript syntactic
74 ;; chart images of Emacs buffers:
76 ;; ebnf-print-directory
80 ;; ebnf-spool-directory
89 ;; These commands all perform essentially the same function: they generate
90 ;; PostScript syntactic chart images suitable for printing on a PostScript
91 ;; printer or displaying with GhostScript. These commands are collectively
92 ;; referred to as "ebnf- commands".
94 ;; The word "print", "spool" and "eps" in the command name determines when the
95 ;; PostScript image is sent to the printer (or file):
97 ;; print - The PostScript image is immediately sent to the printer;
99 ;; spool - The PostScript image is saved temporarily in an Emacs buffer.
100 ;; Many images may be spooled locally before printing them. To
101 ;; send the spooled images to the printer, use the command
104 ;; eps - The PostScript image is immediately sent to a EPS file.
106 ;; The spooling mechanism is the same as used by ps-print and was designed for
107 ;; printing lots of small files to save paper that would otherwise be wasted on
108 ;; banner pages, and to make it easier to find your output at the printer (it's
109 ;; easier to pick up one 50-page printout than to find 50 single-page
110 ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
111 ;; images, you can intermix the spooling of ebnf2ps and ps-print images.
113 ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
114 ;; won't accidentally quit from Emacs while you have unprinted PostScript
115 ;; waiting in the spool buffer. If you do attempt to exit with spooled
116 ;; PostScript, you'll be asked if you want to print it, and if you decline,
117 ;; you'll be asked to confirm the exit; this is modeled on the confirmation
118 ;; that Emacs uses for modified buffers.
120 ;; The word "directory", "file", "buffer" or "region" in the command name
121 ;; determines how much of the buffer is printed:
123 ;; directory - Read files in the directory and print them.
125 ;; file - Read file and print it.
127 ;; buffer - Print the entire buffer.
129 ;; region - Print just the current region.
131 ;; Two ebnf- command examples:
133 ;; ebnf-print-buffer - translate and print the entire buffer, and send it
134 ;; immediately to the printer.
136 ;; ebnf-spool-region - translate and print just the current region, and
137 ;; spool the image in Emacs to send to the printer
140 ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and
141 ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print
142 ;; spooling mechanism. See section "Actions in Comments" for an explanation
143 ;; about EPS file generation.
149 ;; To translate and print your buffer, type
151 ;; M-x ebnf-print-buffer
153 ;; or substitute one of the other four ebnf- commands. The command will
154 ;; generate the PostScript image and print or spool it as specified. By giving
155 ;; the command a prefix argument
157 ;; C-u M-x ebnf-print-buffer
159 ;; it will save the PostScript image to a file instead of sending it to the
160 ;; printer; you will be prompted for the name of the file to save the image to.
161 ;; The prefix argument is ignored by the commands that spool their images, but
162 ;; you may save the spooled images to a file by giving a prefix argument to
165 ;; C-u M-x ebnf-despool
167 ;; When invoked this way, `ebnf-despool' will prompt you for the name of the
170 ;; The prefix argument is also ignored by `ebnf-eps-buffer' and
171 ;; `ebnf-eps-region'.
173 ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
175 ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
176 ;; (global-set-key '(shift f22) 'ebnf-print-region)
177 ;; (global-set-key '(control f22) 'ebnf-despool)
180 ;; Invoking Ebnf2ps in Batch
181 ;; -------------------------
183 ;; It's possible also to run ebnf2ps in batch, this is useful when, for
184 ;; example, you have a directory with a lot of files containing the EBNF to be
185 ;; translated to PostScript.
187 ;; To run ebnf2ps in batch type, for example:
189 ;; emacs -batch -l setup-ebnf2ps.el -f ebnf-eps-directory
191 ;; Where setup-ebnf2ps.el should be a file containing:
193 ;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
194 ;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
195 ;; (require 'ebnf2ps)
196 ;; ;; insert here your ebnf2ps settings
197 ;; (setq ebnf-terminal-shape 'bevel)
204 ;; BNF (Backus Naur Form) notation is defined like languages, and like
205 ;; languages there are rules about name formation and syntax. In this section
206 ;; it's defined a BNF syntax that it's called simply EBNF (Extended BNF).
207 ;; ebnf2ps package also deal with other BNF notation. Please, see the variable
208 ;; `ebnf-syntax' documentation below in this section.
210 ;; The current EBNF that ebnf2ps accepts has the following constructions:
212 ;; ; comment (until end of line)
216 ;; $A default non-terminal (see text below)
217 ;; $"C" default terminal (see text below)
218 ;; $?C? default special (see text below)
219 ;; A = B. production (A is the header and B the body)
220 ;; C D sequence (C occurs before D)
221 ;; C | D alternative (C or D occurs)
222 ;; A - B exception (A excluding B, B without any non-terminal)
223 ;; n * A repetition (A repeats at least n (integer) times)
224 ;; n * n A repetition (A repeats exactly n (integer) times)
225 ;; n * m A repetition (A repeats at least n (integer) and at most
226 ;; m (integer) times)
227 ;; (C) group (expression C is grouped together)
228 ;; [C] optional (C may or not occurs)
229 ;; C+ one or more occurrences of C
230 ;; {C}+ one or more occurrences of C
231 ;; {C}* zero or more occurrences of C
232 ;; {C} zero or more occurrences of C
233 ;; C / D equivalent to: C {D C}*
234 ;; {C || D}+ equivalent to: C {D C}*
235 ;; {C || D}* equivalent to: [C {D C}*]
236 ;; {C || D} equivalent to: [C {D C}*]
238 ;; The EBNF syntax written using the notation above is:
240 ;; EBNF = {production}+.
242 ;; production = non_terminal "=" body ".". ;; production
244 ;; body = {sequence || "|"}*. ;; alternative
246 ;; sequence = {exception}*. ;; sequence
248 ;; exception = repeat [ "-" repeat]. ;; exception
250 ;; repeat = [ integer "*" [ integer ]] term. ;; repetition
253 ;; | [factor] "+" ;; one-or-more
254 ;; | [factor] "/" [factor] ;; one-or-more
257 ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
258 ;; | [ "$" ] non_terminal ;; non-terminal
259 ;; | [ "$" ] "?" special "?" ;; special
260 ;; | "(" body ")" ;; group
261 ;; | "[" body "]" ;; zero-or-one
262 ;; | "{" body [ "||" body ] "}+" ;; one-or-more
263 ;; | "{" body [ "||" body ] "}*" ;; zero-or-more
264 ;; | "{" body [ "||" body ] "}" ;; zero-or-more
267 ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
268 ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
269 ;; ;; and lower), 8-bit accentuated characters,
270 ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
271 ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
273 ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
274 ;; ;; that is, a valid terminal accepts any printable character (including
275 ;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
276 ;; ;; terminal. Also, accepts escaped characters, that is, a character
277 ;; ;; pair starting with `\' followed by a printable character, for
278 ;; ;; example: \", \\.
280 ;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
281 ;; ;; that is, a valid special accepts any printable character (including
282 ;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
283 ;; ;; delimit a special.
285 ;; integer = "[0-9]+".
286 ;; ;; that is, an integer is a sequence of one or more decimal digits.
288 ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
289 ;; ;; that is, a comment starts with the character `;' and terminates at end
290 ;; ;; of line. Also, it only accepts printable characters (including 8-bit
291 ;; ;; accentuated characters) and tabs.
293 ;; Try to use the above EBNF to test ebnf2ps.
295 ;; The `default' terminal, non-terminal and special is a way to indicate a
296 ;; default path in a production. For example, the production:
298 ;; X = [ $A ( B | $C ) | D ].
300 ;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
302 ;; The terminal name is controlled by `ebnf-terminal-regexp' and
303 ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
304 ;; name besides that enclosed by `"'.
306 ;; Let's see an example:
308 ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
309 ;; (setq ebnf-case-fold-search nil) ; exact matching
311 ;; If you have the production:
313 ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
315 ;; The names are classified as:
317 ;; Logical Expression non-terminal
318 ;; "(" OR AND "XOR" ")" terminal
320 ;; The line comment is controlled by `ebnf-lex-comment-char'. The default
321 ;; value is ?\; (character `;').
323 ;; The end of production is controlled by `ebnf-lex-eop-char'. The default
324 ;; value is ?. (character `.').
326 ;; The variable `ebnf-syntax' specifies which syntax to recognize:
328 ;; `ebnf' ebnf2ps recognizes the syntax described above.
329 ;; The following variables *ONLY* have effect with this
331 ;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
332 ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
334 ;; `abnf' ebnf2ps recognizes the syntax described in the URL:
335 ;; `http://www.ietf.org/rfc/rfc2234.txt'
336 ;; ("Augmented BNF for Syntax Specifications: ABNF").
338 ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
339 ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
340 ;; ("International Standard of the ISO EBNF Notation").
341 ;; The following variables *ONLY* have effect with this
343 ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
345 ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
346 ;; The following variable *ONLY* has effect with this
348 ;; `ebnf-yac-ignore-error-recovery'.
350 ;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
351 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
352 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
354 ;; `dtd' ebnf2ps recognizes the syntax described in the URL:
355 ;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
356 ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
358 ;; Any other value is treated as `ebnf'.
360 ;; The default value is `ebnf'.
366 ;; The following EBNF optimizations are done:
368 ;; [ { A }* ] ==> { A }*
369 ;; [ { A }+ ] ==> { A }*
370 ;; [ A ] + ==> { A }*
371 ;; { A }* + ==> { A }*
372 ;; { A }+ + ==> { A }+
375 ;; ( A | EMPTY )- ==> A
376 ;; ( A | B | EMPTY )- ==> A | B
377 ;; [ A | B ] ==> A | B | EMPTY
378 ;; n * EMPTY ==> EMPTY
380 ;; EMPTY / EMPTY ==> EMPTY
381 ;; EMPTY - A ==> EMPTY
383 ;; The following optimizations are done when `ebnf-optimize' is non-nil:
386 ;; 1. A = B | A C. ==> A = B {C}*.
387 ;; 2. A = B | A B. ==> A = {B}+.
388 ;; 3. A = | A B. ==> A = {B}*.
389 ;; 4. A = B | A C B. ==> A = {B || C}+.
390 ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
393 ;; 6. A = B | . ==> A = [B].
394 ;; 7. A = | B . ==> A = [B].
397 ;; 8. A = B C | B D. ==> A = B (C | D).
398 ;; 9. A = C B | D B. ==> A = (C | D) B.
399 ;; 10. A = B C E | B D E. ==> A = B (C | D) E.
401 ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
407 ;; You may use form feed (^L \014) to force a production to start on a new
408 ;; page, for example:
417 ;; c) A = B ^L^L^L | C.^L
421 ;; In all examples above, only the production X will start on a new page.
424 ;; Actions in Comments
425 ;; -------------------
427 ;; ebnf2ps accepts the following actions in comments:
429 ;; ;^ same as form feed. See section Form Feed above.
431 ;; ;> the next production starts in the same line as the current one.
432 ;; It is useful when `ebnf-horizontal-orientation' is nil.
434 ;; ;< the next production starts in the next line.
435 ;; It is useful when `ebnf-horizontal-orientation' is non-nil.
437 ;; ;[EPS open a new EPS file. The EPS file name has the form:
438 ;; <PREFIX><NAME>.eps
439 ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
440 ;; <NAME> is the string given by ;[ action comment, this string is
441 ;; mapped to form a valid file name (see documentation for
442 ;; `ebnf-eps-buffer' or `ebnf-eps-region').
443 ;; It has effect only during `ebnf-eps-buffer' or
444 ;; `ebnf-eps-region' execution.
445 ;; It's an error to try to open an already opened EPS file.
447 ;; ;]EPS close an opened EPS file.
448 ;; It has effect only during `ebnf-eps-buffer' or
449 ;; `ebnf-eps-region' execution.
450 ;; It's an error to try to close a not opened EPS file.
454 ;; (setq ebnf-horizontal-orientation nil)
458 ;; ;> C and B are drawn in the same line
462 ;; The graphical result is:
468 ;; +---------+ +-----+
480 ;; Note that if ascending production sort is used, the productions A and B will
481 ;; be drawn in the same line instead of C and B.
483 ;; If consecutive actions occur, only the last one takes effect, so if you
492 ;; Only the ;> will take effect, that is, A and B will be drawn in the same
495 ;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*)
496 ;; and (*]EPS*). The first example above should be written:
500 ;; (*> C and B are drawn in the same line *)
504 ;; For an example of EPS action when executing `ebnf-eps-buffer' or
505 ;; `ebnf-eps-region':
524 ;; The following table summarizes the results:
526 ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
527 ;; ebnf--AA.eps A C A C C A
528 ;; ebnf--BB.eps C B B C C B
529 ;; ebnf--CC.eps A C B F A B C F F C B A
535 ;; As you can see if EPS actions is not used, each single production is
536 ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
537 ;; it's not an existing production name.
539 ;; In the following case:
547 ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
553 ;; Some tools are provided to help you.
555 ;; `ebnf-setup' returns the current setup.
557 ;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the
560 ;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given
563 ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
566 ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current
569 ;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
571 ;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer',
572 ;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same
573 ;; way as `ebnf-' commands.
579 ;; ebn2ps has the following hook variables:
582 ;; It is evaluated once before any ebnf2ps process.
584 ;; `ebnf-production-hook'
585 ;; It is evaluated on each beginning of production.
588 ;; It is evaluated on each beginning of page.
594 ;; Below it's shown a brief description of ebnf2ps options, please, see the
595 ;; options declaration in the code for a long documentation.
597 ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
600 ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
601 ;; height in horizontal orientation.
603 ;; `ebnf-production-horizontal-space' Specify horizontal space in points
604 ;; between productions.
606 ;; `ebnf-production-vertical-space' Specify vertical space in points
607 ;; between productions.
609 ;; `ebnf-justify-sequence' Specify justification of terms in a
610 ;; sequence inside alternatives.
612 ;; `ebnf-terminal-regexp' Specify how it's a terminal name.
614 ;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
616 ;; `ebnf-terminal-font' Specify terminal font.
618 ;; `ebnf-terminal-shape' Specify terminal box shape.
620 ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
623 ;; `ebnf-terminal-border-width' Specify border width for terminal box.
625 ;; `ebnf-terminal-border-color' Specify border color for terminal box.
627 ;; `ebnf-production-name-p' Non-nil means production name will be
630 ;; `ebnf-sort-production' Specify how productions are sorted.
632 ;; `ebnf-production-font' Specify production font.
634 ;; `ebnf-non-terminal-font' Specify non-terminal font.
636 ;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
638 ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
641 ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
644 ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
647 ;; `ebnf-special-show-delimiter' Non-nil means special delimiter
648 ;; (character `?') is shown.
650 ;; `ebnf-special-font' Specify special font.
652 ;; `ebnf-special-shape' Specify special box shape.
654 ;; `ebnf-special-shadow' Non-nil means special box will have a
657 ;; `ebnf-special-border-width' Specify border width for special box.
659 ;; `ebnf-special-border-color' Specify border color for special box.
661 ;; `ebnf-except-font' Specify except font.
663 ;; `ebnf-except-shape' Specify except box shape.
665 ;; `ebnf-except-shadow' Non-nil means except box will have a
668 ;; `ebnf-except-border-width' Specify border width for except box.
670 ;; `ebnf-except-border-color' Specify border color for except box.
672 ;; `ebnf-repeat-font' Specify repeat font.
674 ;; `ebnf-repeat-shape' Specify repeat box shape.
676 ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
679 ;; `ebnf-repeat-border-width' Specify border width for repeat box.
681 ;; `ebnf-repeat-border-color' Specify border color for repeat box.
683 ;; `ebnf-entry-percentage' Specify entry height on alternatives.
685 ;; `ebnf-arrow-shape' Specify the arrow shape.
687 ;; `ebnf-chart-shape' Specify chart flow shape.
689 ;; `ebnf-color-p' Non-nil means use color.
691 ;; `ebnf-line-width' Specify flow line width.
693 ;; `ebnf-line-color' Specify flow line color.
695 ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
698 ;; `ebnf-debug-ps' Non-nil means to generate PostScript
701 ;; `ebnf-lex-comment-char' Specify the line comment character.
703 ;; `ebnf-lex-eop-char' Specify the end of production
706 ;; `ebnf-syntax' Specify syntax to be recognized.
708 ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
710 ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
713 ;; `ebnf-default-width' Specify additional border width over
714 ;; default terminal, non-terminal or
717 ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains
720 ;; `ebnf-eps-prefix' Specify EPS prefix file name.
722 ;; `ebnf-use-float-format' Non-nil means use `%f' float format.
724 ;; `ebnf-stop-on-error' Non-nil means signal error and stop.
725 ;; Nil means signal error and continue.
727 ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
729 ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
731 ;; `ebnf-optimize' Non-nil means optimize syntactic chart
734 ;; To set the above options you may:
736 ;; a) insert the code in your ~/.emacs, like:
738 ;; (setq ebnf-terminal-shape 'bevel)
740 ;; This way always keep your default settings when you enter a new Emacs
743 ;; b) or use `set-variable' in your Emacs session, like:
745 ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
747 ;; This way keep your settings only during the current Emacs session.
749 ;; c) or use customization, for example:
750 ;; click on menu-bar *Help* option,
751 ;; then click on *Customize*,
752 ;; then click on *Browse Customization Groups*,
753 ;; expand *PostScript* group,
754 ;; expand *Ebnf2ps* group
755 ;; and then customize ebnf2ps options.
756 ;; Through this way, you may choose if the settings are kept or not when
757 ;; you leave out the current Emacs session.
759 ;; d) or see the option value:
761 ;; C-h v ebnf-terminal-shape RET
763 ;; and click the *customize* hypertext button.
764 ;; Through this way, you may choose if the settings are kept or not when
765 ;; you leave out the current Emacs session.
769 ;; M-x ebnf-customize RET
771 ;; and then customize ebnf2ps options.
772 ;; Through this way, you may choose if the settings are kept or not when
773 ;; you leave out the current Emacs session.
779 ;; Sometimes you need to change the EBNF style you are using, for example,
780 ;; change the shapes and colors. These changes may force you to set some
781 ;; variables and after use, set back the variables to the old values.
783 ;; To help to handle this situation, ebnf2ps has the following commands to
786 ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
789 ;; `ebnf-delete-style' Delete style NAME.
791 ;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
793 ;; `ebnf-apply-style' Set STYLE as the current style.
795 ;; `ebnf-reset-style' Reset current style.
797 ;; `ebnf-push-style' Push the current style and set STYLE as the current
800 ;; `ebnf-pop-style' Pop a style and set it as the current style.
802 ;; These commands help to put together a lot of variable settings in a group
803 ;; and name this group. So when you wish to apply these settings it's only
804 ;; needed to give the name.
806 ;; There is also a notion of simple inheritance of style; so, if you declare
807 ;; that a style A inherits from a style B, all settings of B is applied first
808 ;; and then the settings of A is applied. This is useful when you wish to
809 ;; modify some aspects of an existing style, but at same time wish to keep it
812 ;; See documentation for `ebnf-style-database'.
818 ;; Below it is the layout of minimum area to draw each element, and it's used
819 ;; the following terms:
821 ;; font height is given by:
822 ;; (terminal font height + non-terminal font height) / 2
824 ;; entry is the vertical position used to know where it should
825 ;; be drawn the flow line in the current element.
828 ;; * SPECIAL, TERMINAL and NON-TERMINAL
830 ;; +==============+...................................
831 ;; | | } font height / 2 } entry }
832 ;; | XXXXXXXX...|....... } }
833 ;; ====+ XXXXXXXX +==== } text height ...... } height
834 ;; : | XXXXXXXX...|...:... }
835 ;; : | : : | : } font height / 2 }
836 ;; : +==============+...:...............................
838 ;; : : : : : :......................
839 ;; : : : : : } font height }
840 ;; : : : : :....... }
841 ;; : : : : } font height / 2 }
842 ;; : : : :........... }
843 ;; : : : } text width } width
844 ;; : : :.................. }
845 ;; : : } font height / 2 }
846 ;; : :...................... }
848 ;; :.............................................
853 ;; +==========+.....................................
857 ;; ===+===+ +===+===... } element height } height
860 ;; : | +==========+.|................. }
861 ;; : | : : | : } font height }
862 ;; : +==============+...................................
864 ;; : : : :......................
865 ;; : : : } font height * 2 }
867 ;; : : } element width } width
868 ;; : :..................... }
869 ;; : } font height * 2 }
870 ;; :...............................................
875 ;; +===+...................................
876 ;; +==+ A +==+ } A height } }
877 ;; | +===+..|........ } entry }
878 ;; + + } font height } }
879 ;; / +===+...\....... } }
880 ;; ===+====+ B +====+=== } B height ..... } height
881 ;; : \ +===+.../....... }
882 ;; : + + : } font height }
883 ;; : | +===+..|........ }
884 ;; : +==+ C +==+ : } C height }
885 ;; : : +===+...................................
887 ;; : : : :......................
888 ;; : : : } font height * 2 }
890 ;; : : } max width } width
891 ;; : :................. }
892 ;; : } font height * 2 }
893 ;; :..........................................
896 ;; 1. An empty alternative has zero of height.
898 ;; 2. The variable `ebnf-entry-percentage' is used to determine the
904 ;; +===========+...............................
905 ;; +=+ separator +=+ } separator height }
906 ;; / +===========+..\........ }
908 ;; | | } font height }
910 ;; \ +===========+../........ } height = entry
911 ;; +=+ element +=+ } element height }
912 ;; /: +===========+..\........ }
914 ;; + : : + } font height }
916 ;; ==+=======================+==.......................
918 ;; : : : :.......................
919 ;; : : : } font height * 2 }
921 ;; : : } max width } width
922 ;; : :......................... }
923 ;; : } font height * 2 }
924 ;; :...................................................
929 ;; +===========+......................................
930 ;; +=+ separator +=+ } separator height } }
931 ;; / +===========+..\...... } }
933 ;; | | } font height } } height
935 ;; \ +===========+../...... } }
936 ;; ===+=+ element +=+=== } element height .... }
937 ;; : : +===========+......................................
939 ;; : : : :........................
940 ;; : : : } font height * 2 }
942 ;; : : } max width } width
943 ;; : :....................... }
944 ;; : } font height * 2 }
945 ;; :..............................................
950 ;; XXXXXX:......................................
951 ;; XXXXXX: } production font height }
952 ;; XXXXXX:............ }
954 ;; +======+....... } height = entry
956 ;; ====+ +==== } element height }
958 ;; : +======+.................................
960 ;; : : : :......................
961 ;; : : : } font height * 2 }
963 ;; : : } element width } width
964 ;; : :.............. }
965 ;; : } font height * 2 }
966 ;; :.....................................
971 ;; +================+...................................
972 ;; | | } font height / 2 } entry }
973 ;; | +===+...|....... } }
974 ;; ====+ N * | X | +==== } X height ......... } height
975 ;; : | : : +===+...|...:... }
976 ;; : | : : : : | : } font height / 2 }
977 ;; : +================+...:...............................
979 ;; : : : : : : : :......................
980 ;; : : : : : : : } font height }
981 ;; : : : : : : :....... }
982 ;; : : : : : : } font height / 2 }
983 ;; : : : : : :........... }
984 ;; : : : : : } X width }
985 ;; : : : : :............... }
986 ;; : : : : } font height / 2 } width
987 ;; : : : :.................. }
988 ;; : : : } text width }
989 ;; : : :..................... }
990 ;; : : } font height / 2 }
991 ;; : :........................ }
993 ;; :...............................................
998 ;; +==================+...................................
999 ;; | | } font height / 2 } entry }
1000 ;; | +===+ +===+...|....... } }
1001 ;; ====+ | X | - | y | +==== } max height ....... } height
1002 ;; : | +===+ +===+...|...:... }
1003 ;; : | : : : : | : } font height / 2 }
1004 ;; : +==================+...:...............................
1006 ;; : : : : : : : :......................
1007 ;; : : : : : : : } font height }
1008 ;; : : : : : : :....... }
1009 ;; : : : : : : } font height / 2 }
1010 ;; : : : : : :........... }
1011 ;; : : : : : } Y width }
1012 ;; : : : : :............... }
1013 ;; : : : : } font height } width
1014 ;; : : : :................... }
1015 ;; : : : } X width }
1016 ;; : : :....................... }
1017 ;; : : } font height / 2 }
1018 ;; : :.......................... }
1019 ;; : } font height }
1020 ;; :.................................................
1022 ;; NOTE: If Y element is empty, it's draw nothing at Y place.
1025 ;; Internal Structures
1026 ;; -------------------
1028 ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis
1029 ;; of current buffer and generates an intermediate representation. The second
1030 ;; pass uses the intermediate representation to generate the PostScript
1033 ;; The intermediate representation is a list of vectors, the vector element
1034 ;; represents a syntactic chart element. Below is a vector representation for
1035 ;; each syntactic chart element.
1037 ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
1038 ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1039 ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
1040 ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1041 ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1042 ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
1043 ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
1044 ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
1045 ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1046 ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
1047 ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
1048 ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
1050 ;; The first vector position is a function symbol used to generate PostScript
1051 ;; for this element.
1052 ;; WIDTH-FUN is a function symbol called to adjust the element width.
1053 ;; DIM-FUN is a function symbol called to set the element dimensions.
1054 ;; ENTRY is the element entry point.
1055 ;; HEIGHT and WIDTH are the element height and width, respectively.
1056 ;; NAME is a string that it's the element name.
1057 ;; DEFAULT is a boolean that indicates if it's a `default' element.
1058 ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
1060 ;; LIST is a list of vector that represents the list part for alternatives and
1062 ;; SEPARATOR is a vector that represents the sub-element used to separate the
1064 ;; TIMES is a string representing the number of times that ELEMENT is repeated
1065 ;; on a repeat construction.
1066 ;; ACTION indicates some action that should be done before production is
1067 ;; generated. The current actions are:
1071 ;; form-feed current production starts on a new page.
1073 ;; newline current production starts on next line, this is useful
1074 ;; when `ebnf-horizontal-orientation' is non-nil.
1076 ;; keep-line current production continues on the current line, this
1077 ;; is useful when `ebnf-horizontal-orientation' is nil.
1083 ;; . Handle situations when syntactic chart is out of paper.
1084 ;; . Use other alphabet than ascii.
1085 ;; . Optimizations...
1091 ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
1092 ;; - `ebnf-production-name-p', `ebnf-stop-on-error',
1093 ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
1094 ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
1098 ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
1099 ;; with some Bison features (%right, %left and %prec pragmas). His suggestion
1100 ;; was extended to deal with %nonassoc pragma too.
1102 ;; Thanks to all who emailed comments.
1105 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1112 (and (string< ps-print-version
"5.2.3")
1113 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
1116 ;; to avoid gripes with Emacs 20
1118 (or (fboundp 'assq-delete-all
)
1119 (defun assq-delete-all (key alist
)
1120 "Delete from ALIST all elements whose car is KEY.
1121 Return the modified alist.
1122 Elements of ALIST that are not conses are ignored."
1125 (if (and (consp (car tail
))
1126 (eq (car (car tail
)) key
))
1127 (setq alist
(delq (car tail
) alist
)))
1128 (setq tail
(cdr tail
)))
1132 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1136 ;;; Interface to the command system
1138 (defgroup postscript nil
1144 (defgroup ebnf2ps nil
1145 "Translate an EBNF to a syntactic chart on PostScript"
1151 (defgroup ebnf-special nil
1152 "Special customization"
1158 (defgroup ebnf-except nil
1159 "Except customization"
1165 (defgroup ebnf-repeat nil
1166 "Repeat customization"
1172 (defgroup ebnf-terminal nil
1173 "Terminal customization"
1179 (defgroup ebnf-non-terminal nil
1180 "Non-Terminal customization"
1186 (defgroup ebnf-production nil
1187 "Production customization"
1193 (defgroup ebnf-shape nil
1194 "Shapes customization"
1200 (defgroup ebnf-displacement nil
1201 "Displacement customization"
1207 (defgroup ebnf-syntactic nil
1208 "Syntactic customization"
1214 (defgroup ebnf-optimization nil
1215 "Optimization customization"
1221 (defcustom ebnf-horizontal-orientation nil
1222 "*Non-nil means productions are drawn horizontally."
1224 :group
'ebnf-displacement
)
1227 (defcustom ebnf-horizontal-max-height nil
1228 "*Non-nil means to use maximum production height in horizontal orientation.
1230 It is only used when `ebnf-horizontal-orientation' is non-nil."
1232 :group
'ebnf-displacement
)
1235 (defcustom ebnf-production-horizontal-space
0.0 ; use ebnf2ps default value
1236 "*Specify horizontal space in points between productions.
1238 Value less or equal to zero forces ebnf2ps to set a proper default value."
1240 :group
'ebnf-displacement
)
1243 (defcustom ebnf-production-vertical-space
0.0 ; use ebnf2ps default value
1244 "*Specify vertical space in points between productions.
1246 Value less or equal to zero forces ebnf2ps to set a proper default value."
1248 :group
'ebnf-displacement
)
1251 (defcustom ebnf-justify-sequence
'center
1252 "*Specify justification of terms in a sequence inside alternatives.
1256 `left' left justification
1257 `right' right justification
1258 any other value centralize"
1259 :type
'(radio :tag
"Sequence Justification"
1260 (const left
) (const right
) (other :tag
"center" center
))
1261 :group
'ebnf-displacement
)
1264 (defcustom ebnf-special-show-delimiter t
1265 "*Non-nil means special delimiter (character `?') is shown."
1267 :group
'ebnf-special
)
1270 (defcustom ebnf-special-font
'(7 Courier
"Black" "Gray95" bold italic
)
1271 "*Specify special font.
1273 See documentation for `ebnf-production-font'."
1274 :type
'(list :tag
"Special Font"
1275 (number :tag
"Font Size")
1276 (symbol :tag
"Font Name")
1277 (choice :tag
"Foreground Color"
1278 (string :tag
"Name")
1279 (other :tag
"Default" nil
))
1280 (choice :tag
"Background Color"
1281 (string :tag
"Name")
1282 (other :tag
"Default" nil
))
1283 (repeat :tag
"Font Attributes" :inline t
1284 (choice (const bold
) (const italic
)
1285 (const underline
) (const strikeout
)
1286 (const overline
) (const shadow
)
1287 (const box
) (const outline
))))
1288 :group
'ebnf-special
)
1291 (defcustom ebnf-special-shape
'bevel
1292 "*Specify special box shape.
1294 See documentation for `ebnf-non-terminal-shape'."
1295 :type
'(radio :tag
"Special Shape"
1296 (const miter
) (const round
) (const bevel
))
1297 :group
'ebnf-special
)
1300 (defcustom ebnf-special-shadow nil
1301 "*Non-nil means special box will have a shadow."
1303 :group
'ebnf-special
)
1306 (defcustom ebnf-special-border-width
0.5
1307 "*Specify border width for special box."
1309 :group
'ebnf-special
)
1312 (defcustom ebnf-special-border-color
"Black"
1313 "*Specify border color for special box."
1315 :group
'ebnf-special
)
1318 (defcustom ebnf-except-font
'(7 Courier
"Black" "Gray90" bold italic
)
1319 "*Specify except font.
1321 See documentation for `ebnf-production-font'."
1322 :type
'(list :tag
"Except Font"
1323 (number :tag
"Font Size")
1324 (symbol :tag
"Font Name")
1325 (choice :tag
"Foreground Color"
1326 (string :tag
"Name")
1327 (other :tag
"Default" nil
))
1328 (choice :tag
"Background Color"
1329 (string :tag
"Name")
1330 (other :tag
"Default" nil
))
1331 (repeat :tag
"Font Attributes" :inline t
1332 (choice (const bold
) (const italic
)
1333 (const underline
) (const strikeout
)
1334 (const overline
) (const shadow
)
1335 (const box
) (const outline
))))
1336 :group
'ebnf-except
)
1339 (defcustom ebnf-except-shape
'bevel
1340 "*Specify except box shape.
1342 See documentation for `ebnf-non-terminal-shape'."
1343 :type
'(radio :tag
"Except Shape"
1344 (const miter
) (const round
) (const bevel
))
1345 :group
'ebnf-except
)
1348 (defcustom ebnf-except-shadow nil
1349 "*Non-nil means except box will have a shadow."
1351 :group
'ebnf-except
)
1354 (defcustom ebnf-except-border-width
0.25
1355 "*Specify border width for except box."
1357 :group
'ebnf-except
)
1360 (defcustom ebnf-except-border-color
"Black"
1361 "*Specify border color for except box."
1363 :group
'ebnf-except
)
1366 (defcustom ebnf-repeat-font
'(7 Courier
"Black" "Gray85" bold italic
)
1367 "*Specify repeat font.
1369 See documentation for `ebnf-production-font'."
1370 :type
'(list :tag
"Repeat Font"
1371 (number :tag
"Font Size")
1372 (symbol :tag
"Font Name")
1373 (choice :tag
"Foreground Color"
1374 (string :tag
"Name")
1375 (other :tag
"Default" nil
))
1376 (choice :tag
"Background Color"
1377 (string :tag
"Name")
1378 (other :tag
"Default" nil
))
1379 (repeat :tag
"Font Attributes" :inline t
1380 (choice (const bold
) (const italic
)
1381 (const underline
) (const strikeout
)
1382 (const overline
) (const shadow
)
1383 (const box
) (const outline
))))
1384 :group
'ebnf-repeat
)
1387 (defcustom ebnf-repeat-shape
'bevel
1388 "*Specify repeat box shape.
1390 See documentation for `ebnf-non-terminal-shape'."
1391 :type
'(radio :tag
"Repeat Shape"
1392 (const miter
) (const round
) (const bevel
))
1393 :group
'ebnf-repeat
)
1396 (defcustom ebnf-repeat-shadow nil
1397 "*Non-nil means repeat box will have a shadow."
1399 :group
'ebnf-repeat
)
1402 (defcustom ebnf-repeat-border-width
0.0
1403 "*Specify border width for repeat box."
1405 :group
'ebnf-repeat
)
1408 (defcustom ebnf-repeat-border-color
"Black"
1409 "*Specify border color for repeat box."
1411 :group
'ebnf-repeat
)
1414 (defcustom ebnf-terminal-font
'(7 Courier
"Black" "White")
1415 "*Specify terminal font.
1417 See documentation for `ebnf-production-font'."
1418 :type
'(list :tag
"Terminal Font"
1419 (number :tag
"Font Size")
1420 (symbol :tag
"Font Name")
1421 (choice :tag
"Foreground Color"
1422 (string :tag
"Name")
1423 (other :tag
"Default" nil
))
1424 (choice :tag
"Background Color"
1425 (string :tag
"Name")
1426 (other :tag
"Default" nil
))
1427 (repeat :tag
"Font Attributes" :inline t
1428 (choice (const bold
) (const italic
)
1429 (const underline
) (const strikeout
)
1430 (const overline
) (const shadow
)
1431 (const box
) (const outline
))))
1432 :group
'ebnf-terminal
)
1435 (defcustom ebnf-terminal-shape
'miter
1436 "*Specify terminal box shape.
1438 See documentation for `ebnf-non-terminal-shape'."
1439 :type
'(radio :tag
"Terminal Shape"
1440 (const miter
) (const round
) (const bevel
))
1441 :group
'ebnf-terminal
)
1444 (defcustom ebnf-terminal-shadow nil
1445 "*Non-nil means terminal box will have a shadow."
1447 :group
'ebnf-terminal
)
1450 (defcustom ebnf-terminal-border-width
1.0
1451 "*Specify border width for terminal box."
1453 :group
'ebnf-terminal
)
1456 (defcustom ebnf-terminal-border-color
"Black"
1457 "*Specify border color for terminal box."
1459 :group
'ebnf-terminal
)
1462 (defcustom ebnf-production-name-p t
1463 "*Non-nil means production name will be printed."
1465 :group
'ebnf-production
)
1468 (defcustom ebnf-sort-production nil
1469 "*Specify how productions are sorted.
1473 nil don't sort productions.
1474 `ascending' ascending sort.
1475 any other value descending sort."
1476 :type
'(radio :tag
"Production Sort"
1477 (const :tag
"Ascending" ascending
)
1478 (const :tag
"Descending" descending
)
1479 (other :tag
"No Sort" nil
))
1480 :group
'ebnf-production
)
1483 (defcustom ebnf-production-font
'(10 Helvetica
"Black" "White" bold
)
1484 "*Specify production header font.
1486 It is a list with the following form:
1488 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1491 SIZE is the font size.
1492 NAME is the font name symbol.
1493 ATTRIBUTE is one of the following symbols:
1494 bold - use bold font.
1495 italic - use italic font.
1496 underline - put a line under text.
1497 strikeout - like underline, but the line is in middle of text.
1498 overline - like underline, but the line is over the text.
1499 shadow - text will have a shadow.
1500 box - text will be surrounded by a box.
1501 outline - print characters as hollow outlines.
1502 FOREGROUND is a foreground string color name; if it's nil, the default color is
1504 BACKGROUND is a background string color name; if it's nil, the default color is
1507 See `ps-font-info-database' for valid font name."
1508 :type
'(list :tag
"Production Font"
1509 (number :tag
"Font Size")
1510 (symbol :tag
"Font Name")
1511 (choice :tag
"Foreground Color"
1512 (string :tag
"Name")
1513 (other :tag
"Default" nil
))
1514 (choice :tag
"Background Color"
1515 (string :tag
"Name")
1516 (other :tag
"Default" nil
))
1517 (repeat :tag
"Font Attributes" :inline t
1518 (choice (const bold
) (const italic
)
1519 (const underline
) (const strikeout
)
1520 (const overline
) (const shadow
)
1521 (const box
) (const outline
))))
1522 :group
'ebnf-production
)
1525 (defcustom ebnf-non-terminal-font
'(7 Helvetica
"Black" "White")
1526 "*Specify non-terminal font.
1528 See documentation for `ebnf-production-font'."
1529 :type
'(list :tag
"Non-Terminal Font"
1530 (number :tag
"Font Size")
1531 (symbol :tag
"Font Name")
1532 (choice :tag
"Foreground Color"
1533 (string :tag
"Name")
1534 (other :tag
"Default" nil
))
1535 (choice :tag
"Background Color"
1536 (string :tag
"Name")
1537 (other :tag
"Default" nil
))
1538 (repeat :tag
"Font Attributes" :inline t
1539 (choice (const bold
) (const italic
)
1540 (const underline
) (const strikeout
)
1541 (const overline
) (const shadow
)
1542 (const box
) (const outline
))))
1543 :group
'ebnf-non-terminal
)
1546 (defcustom ebnf-non-terminal-shape
'round
1547 "*Specify non-terminal box shape.
1563 Any other value is treated as `miter'."
1564 :type
'(radio :tag
"Non-Terminal Shape"
1565 (const miter
) (const round
) (const bevel
))
1566 :group
'ebnf-non-terminal
)
1569 (defcustom ebnf-non-terminal-shadow nil
1570 "*Non-nil means non-terminal box will have a shadow."
1572 :group
'ebnf-non-terminal
)
1575 (defcustom ebnf-non-terminal-border-width
1.0
1576 "*Specify border width for non-terminal box."
1578 :group
'ebnf-non-terminal
)
1581 (defcustom ebnf-non-terminal-border-color
"Black"
1582 "*Specify border color for non-terminal box."
1584 :group
'ebnf-non-terminal
)
1587 (defcustom ebnf-arrow-shape
'hollow
1588 "*Specify the arrow shape.
1594 `semi-up' * `transparent' *
1602 `semi-down' =====* `hollow' *
1618 `semi-up-hollow' `semi-up-full'
1624 `semi-down-hollow' `semi-down-full'
1630 `user' See also documentation for variable `ebnf-user-arrow'.
1632 Any other value is treated as `none'."
1633 :type
'(radio :tag
"Arrow Shape"
1634 (const none
) (const semi-up
)
1635 (const semi-down
) (const simple
)
1636 (const transparent
) (const hollow
)
1637 (const full
) (const semi-up-hollow
)
1638 (const semi-down-hollow
) (const semi-up-full
)
1639 (const semi-down-full
) (const user
))
1643 (defcustom ebnf-chart-shape
'round
1644 "*Specify chart flow shape.
1646 See documentation for `ebnf-non-terminal-shape'."
1647 :type
'(radio :tag
"Chart Flow Shape"
1648 (const miter
) (const round
) (const bevel
))
1652 (defcustom ebnf-user-arrow nil
1653 "*Specify a sexp for user arrow shape (a PostScript code).
1655 When evaluated, the sexp should return nil or a string containing PostScript
1656 code. PostScript code should draw a right arrow.
1658 The anatomy of a right arrow is:
1660 ...... Initial position
1662 : *.................
1666 ======+======*... } hT2
1670 : *.................
1676 :.......................
1678 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1679 be used to generate your own arrow. As these variables are used along
1680 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1681 values, if you need to modify them.
1683 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1685 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1687 :type
'(sexp :tag
"User Arrow Shape")
1691 (defcustom ebnf-syntax
'ebnf
1692 "*Specify syntax to be recognized.
1696 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1698 The following variables *ONLY* have effect with this
1700 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1701 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1703 `abnf' ebnf2ps recognizes the syntax described in the URL:
1704 `http://www.ietf.org/rfc/rfc2234.txt'
1705 (\"Augmented BNF for Syntax Specifications: ABNF\").
1707 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1708 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1709 (\"International Standard of the ISO EBNF Notation\").
1710 The following variables *ONLY* have effect with this
1712 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1714 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1715 The following variable *ONLY* has effect with this
1717 `ebnf-yac-ignore-error-recovery'.
1719 `ebnfx' ebnf2ps recognizes the syntax described in the URL:
1720 `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
1721 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1723 `dtd' ebnf2ps recognizes the syntax described in the URL:
1724 `http://www.w3.org/TR/2004/REC-xml-20040204/'
1725 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1727 Any other value is treated as `ebnf'."
1728 :type
'(radio :tag
"Syntax"
1729 (const ebnf
) (const abnf
) (const iso-ebnf
)
1730 (const yacc
) (const ebnfx
) (const dtd
))
1731 :group
'ebnf-syntactic
)
1734 (defcustom ebnf-lex-comment-char ?\
;
1735 "*Specify the line comment character.
1737 It's used only when `ebnf-syntax' is `ebnf'."
1739 :group
'ebnf-syntactic
)
1742 (defcustom ebnf-lex-eop-char ?.
1743 "*Specify the end of production character.
1745 It's used only when `ebnf-syntax' is `ebnf'."
1747 :group
'ebnf-syntactic
)
1750 (defcustom ebnf-terminal-regexp nil
1751 "*Specify how it's a terminal name.
1753 If it's nil, the terminal name must be enclosed by `\"'.
1754 If it's a string, it should be a regexp that it'll be used to determine a
1755 terminal name; terminal name may also be enclosed by `\"'.
1757 It's used only when `ebnf-syntax' is `ebnf'."
1758 :type
'(radio :tag
"Terminal Name"
1760 :group
'ebnf-syntactic
)
1763 (defcustom ebnf-case-fold-search nil
1764 "*Non-nil means ignore case on matching.
1766 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1769 :group
'ebnf-syntactic
)
1772 (defcustom ebnf-iso-alternative-p nil
1773 "*Non-nil means use alternative ISO EBNF.
1775 It's only used when `ebnf-syntax' is `iso-ebnf'.
1777 This variable affects the following symbol set:
1779 STANDARD ALTERNATIVE
1787 :group
'ebnf-syntactic
)
1790 (defcustom ebnf-iso-normalize-p nil
1791 "*Non-nil means normalize ISO EBNF syntax names.
1793 Normalize a name means that several contiguous spaces inside name become a
1794 single space, so \"A B C\" is normalized to \"A B C\".
1796 It's only used when `ebnf-syntax' is `iso-ebnf'."
1798 :group
'ebnf-syntactic
)
1801 (defcustom ebnf-file-suffix-regexp
"\.[Bb][Nn][Ff]$"
1802 "*Specify file name suffix that contains EBNF.
1804 See `ebnf-eps-directory' command."
1809 (defcustom ebnf-eps-prefix
"ebnf--"
1810 "*Specify EPS prefix file name.
1812 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1817 (defcustom ebnf-entry-percentage
0.5 ; middle
1818 "*Specify entry height on alternatives.
1820 It must be a float between 0.0 (top) and 1.0 (bottom)."
1825 (defcustom ebnf-default-width
0.6
1826 "*Specify additional border width over default terminal, non-terminal or
1832 ;; Printing color requires x-color-values.
1833 (defcustom ebnf-color-p
(or (fboundp 'x-color-values
) ; Emacs
1834 (fboundp 'color-instance-rgb-components
)) ; XEmacs
1835 "*Non-nil means use color."
1840 (defcustom ebnf-line-width
1.0
1841 "*Specify flow line width."
1846 (defcustom ebnf-line-color
"Black"
1847 "*Specify flow line color."
1852 (defcustom ebnf-debug-ps nil
1853 "*Non-nil means to generate PostScript debug procedures.
1855 It is intended to help PostScript programmers in debugging."
1860 (defcustom ebnf-use-float-format t
1861 "*Non-nil means use `%f' float format.
1863 The advantage of using float format is that ebnf2ps generates a little short
1866 If it occurs the error message:
1868 Invalid format operation %f
1870 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1875 (defcustom ebnf-stop-on-error nil
1876 "*Non-nil means signal error and stop. Nil means signal error and continue."
1881 (defcustom ebnf-yac-ignore-error-recovery nil
1882 "*Non-nil means ignore error recovery.
1884 It's only used when `ebnf-syntax' is `yacc'."
1886 :group
'ebnf-syntactic
)
1889 (defcustom ebnf-ignore-empty-rule nil
1890 "*Non-nil means ignore empty rules.
1892 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1893 middle action rule."
1895 :group
'ebnf-optimization
)
1898 (defcustom ebnf-optimize nil
1899 "*Non-nil means optimize syntactic chart of rules.
1901 The following optimizations are done:
1904 1. A = B | A C. ==> A = B {C}*.
1905 2. A = B | A B. ==> A = {B}+.
1906 3. A = | A B. ==> A = {B}*.
1907 4. A = B | A C B. ==> A = {B || C}+.
1908 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
1911 6. A = B | . ==> A = [B].
1912 7. A = | B . ==> A = [B].
1915 8. A = B C | B D. ==> A = B (C | D).
1916 9. A = C B | D B. ==> A = (C | D) B.
1917 10. A = B C E | B D E. ==> A = B (C | D) E.
1919 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
1921 :group
'ebnf-optimization
)
1924 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1925 ;; To make this file smaller, some commands go in a separate file.
1926 ;; But autoload them here to make the separation invisible.
1927 ;; Autoload is here to avoid compilation gripes.
1929 (autoload 'ebnf-eliminate-empty-rules
"ebnf-otz"
1930 "Eliminate empty rules.")
1932 (autoload 'ebnf-optimize
"ebnf-otz"
1933 "Syntactic chart optimizer.")
1935 (autoload 'ebnf-otz-initialize
"ebnf-otz"
1936 "Initialize optimizer.")
1939 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1944 (defun ebnf-customize ()
1945 "Customization for ebnf group."
1947 (customize-group 'ebnf2ps
))
1950 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1955 (defun ebnf-print-directory (&optional directory
)
1956 "Generate and print a PostScript syntactic chart image of DIRECTORY.
1958 If DIRECTORY is nil, it's used `default-directory'.
1960 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
1963 See also `ebnf-print-buffer'."
1965 (list (read-file-name "Directory containing EBNF files (print): "
1966 nil default-directory
)))
1967 (ebnf-directory 'ebnf-print-buffer directory
))
1971 (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done
)
1972 "Generate and print a PostScript syntactic chart image of the file FILE.
1974 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
1975 killed after process termination.
1977 See also `ebnf-print-buffer'."
1978 (interactive "fEBNF file to generate PostScript and print from: ")
1979 (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done
))
1983 (defun ebnf-print-buffer (&optional filename
)
1984 "Generate and print a PostScript syntactic chart image of the buffer.
1986 When called with a numeric prefix argument (C-u), prompts the user for
1987 the name of a file to save the PostScript image in, instead of sending
1990 More specifically, the FILENAME argument is treated as follows: if it
1991 is nil, send the image to the printer. If FILENAME is a string, save
1992 the PostScript image in a file with that name. If FILENAME is a
1993 number, prompt the user for the name of the file to save in."
1994 (interactive (list (ps-print-preprint current-prefix-arg
)))
1995 (ebnf-print-region (point-min) (point-max) filename
))
1999 (defun ebnf-print-region (from to
&optional filename
)
2000 "Generate and print a PostScript syntactic chart image of the region.
2001 Like `ebnf-print-buffer', but prints just the current region."
2002 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
2003 (run-hooks 'ebnf-hook
)
2004 (or (ebnf-spool-region from to
)
2005 (ps-do-despool filename
)))
2009 (defun ebnf-spool-directory (&optional directory
)
2010 "Generate and spool a PostScript syntactic chart image of DIRECTORY.
2012 If DIRECTORY is nil, it's used `default-directory'.
2014 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2017 See also `ebnf-spool-buffer'."
2019 (list (read-file-name "Directory containing EBNF files (spool): "
2020 nil default-directory
)))
2021 (ebnf-directory 'ebnf-spool-buffer directory
))
2025 (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done
)
2026 "Generate and spool a PostScript syntactic chart image of the file FILE.
2028 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2029 killed after process termination.
2031 See also `ebnf-spool-buffer'."
2032 (interactive "fEBNF file to generate PostScript and spool from: ")
2033 (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done
))
2037 (defun ebnf-spool-buffer ()
2038 "Generate and spool a PostScript syntactic chart image of the buffer.
2039 Like `ebnf-print-buffer' except that the PostScript image is saved in a
2040 local buffer to be sent to the printer later.
2042 Use the command `ebnf-despool' to send the spooled images to the printer."
2044 (ebnf-spool-region (point-min) (point-max)))
2048 (defun ebnf-spool-region (from to
)
2049 "Generate a PostScript syntactic chart image of the region and spool locally.
2050 Like `ebnf-spool-buffer', but spools just the current region.
2052 Use the command `ebnf-despool' to send the spooled images to the printer."
2054 (ebnf-generate-region from to
'ebnf-generate
))
2058 (defun ebnf-eps-directory (&optional directory
)
2059 "Generate EPS files from EBNF files in DIRECTORY.
2061 If DIRECTORY is nil, it's used `default-directory'.
2063 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2066 See also `ebnf-eps-buffer'."
2068 (list (read-file-name "Directory containing EBNF files (EPS): "
2069 nil default-directory
)))
2070 (ebnf-directory 'ebnf-eps-buffer directory
))
2074 (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done
)
2075 "Generate an EPS file from EBNF file FILE.
2077 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2078 killed after EPS generation.
2080 See also `ebnf-eps-buffer'."
2081 (interactive "fEBNF file to generate EPS file from: ")
2082 (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done
))
2086 (defun ebnf-eps-buffer ()
2087 "Generate a PostScript syntactic chart image of the buffer in a EPS file.
2089 Indeed, for each production is generated a EPS file.
2090 The EPS file name has the following form:
2092 <PREFIX><PRODUCTION>.eps
2094 <PREFIX> is given by variable `ebnf-eps-prefix'.
2095 The default value is \"ebnf--\".
2097 <PRODUCTION> is the production name.
2098 The production name is mapped to form a valid file name.
2099 For example, the production name \"A/B + C\" is mapped to
2100 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2102 WARNING: It's *NOT* asked any confirmation to override an existing file."
2104 (ebnf-eps-region (point-min) (point-max)))
2108 (defun ebnf-eps-region (from to
)
2109 "Generate a PostScript syntactic chart image of the region in a EPS file.
2111 Indeed, for each production is generated a EPS file.
2112 The EPS file name has the following form:
2114 <PREFIX><PRODUCTION>.eps
2116 <PREFIX> is given by variable `ebnf-eps-prefix'.
2117 The default value is \"ebnf--\".
2119 <PRODUCTION> is the production name.
2120 The production name is mapped to form a valid file name.
2121 For example, the production name \"A/B + C\" is mapped to
2122 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2124 WARNING: It's *NOT* asked any confirmation to override an existing file."
2126 (let ((ebnf-eps-executing t
))
2127 (ebnf-generate-region from to
'ebnf-generate-eps
)))
2131 (defalias 'ebnf-despool
'ps-despool
)
2135 (defun ebnf-syntax-directory (&optional directory
)
2136 "Does a syntactic analysis of the files in DIRECTORY.
2138 If DIRECTORY is nil, it's used `default-directory'.
2140 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2143 See also `ebnf-syntax-buffer'."
2145 (list (read-file-name "Directory containing EBNF files (syntax): "
2146 nil default-directory
)))
2147 (ebnf-directory 'ebnf-syntax-buffer directory
))
2151 (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done
)
2152 "Does a syntactic analysis of the FILE.
2154 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2155 killed after syntax checking.
2157 See also `ebnf-syntax-buffer'."
2158 (interactive "fEBNF file to check syntax: ")
2159 (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done
))
2163 (defun ebnf-syntax-buffer ()
2164 "Does a syntactic analysis of the current buffer."
2166 (ebnf-syntax-region (point-min) (point-max)))
2170 (defun ebnf-syntax-region (from to
)
2171 "Does a syntactic analysis of a region."
2173 (ebnf-generate-region from to nil
))
2176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2181 (defun ebnf-setup ()
2182 "Return the current ebnf2ps setup."
2185 ;;; ebnf2ps.el version %s
2187 \(setq ebnf-special-show-delimiter %S
2188 ebnf-special-font %s
2189 ebnf-special-shape %s
2190 ebnf-special-shadow %S
2191 ebnf-special-border-width %S
2192 ebnf-special-border-color %S
2194 ebnf-except-shape %s
2195 ebnf-except-shadow %S
2196 ebnf-except-border-width %S
2197 ebnf-except-border-color %S
2199 ebnf-repeat-shape %s
2200 ebnf-repeat-shadow %S
2201 ebnf-repeat-border-width %S
2202 ebnf-repeat-border-color %S
2203 ebnf-terminal-regexp %S
2204 ebnf-case-fold-search %S
2205 ebnf-terminal-font %s
2206 ebnf-terminal-shape %s
2207 ebnf-terminal-shadow %S
2208 ebnf-terminal-border-width %S
2209 ebnf-terminal-border-color %S
2210 ebnf-non-terminal-font %s
2211 ebnf-non-terminal-shape %s
2212 ebnf-non-terminal-shadow %S
2213 ebnf-non-terminal-border-width %S
2214 ebnf-non-terminal-border-color %S
2215 ebnf-production-name-p %S
2216 ebnf-sort-production %s
2217 ebnf-production-font %s
2221 ebnf-horizontal-orientation %S
2222 ebnf-horizontal-max-height %S
2223 ebnf-production-horizontal-space %S
2224 ebnf-production-vertical-space %S
2225 ebnf-justify-sequence %s
2226 ebnf-lex-comment-char ?\\%03o
2227 ebnf-lex-eop-char ?\\%03o
2229 ebnf-iso-alternative-p %S
2230 ebnf-iso-normalize-p %S
2231 ebnf-file-suffix-regexp %S
2233 ebnf-entry-percentage %S
2238 ebnf-use-float-format %S
2239 ebnf-stop-on-error %S
2240 ebnf-yac-ignore-error-recovery %S
2241 ebnf-ignore-empty-rule %S
2244 ;;; ebnf2ps.el - end of settings
2247 ebnf-special-show-delimiter
2248 (ps-print-quote ebnf-special-font
)
2249 (ps-print-quote ebnf-special-shape
)
2251 ebnf-special-border-width
2252 ebnf-special-border-color
2253 (ps-print-quote ebnf-except-font
)
2254 (ps-print-quote ebnf-except-shape
)
2256 ebnf-except-border-width
2257 ebnf-except-border-color
2258 (ps-print-quote ebnf-repeat-font
)
2259 (ps-print-quote ebnf-repeat-shape
)
2261 ebnf-repeat-border-width
2262 ebnf-repeat-border-color
2263 ebnf-terminal-regexp
2264 ebnf-case-fold-search
2265 (ps-print-quote ebnf-terminal-font
)
2266 (ps-print-quote ebnf-terminal-shape
)
2267 ebnf-terminal-shadow
2268 ebnf-terminal-border-width
2269 ebnf-terminal-border-color
2270 (ps-print-quote ebnf-non-terminal-font
)
2271 (ps-print-quote ebnf-non-terminal-shape
)
2272 ebnf-non-terminal-shadow
2273 ebnf-non-terminal-border-width
2274 ebnf-non-terminal-border-color
2275 ebnf-production-name-p
2276 (ps-print-quote ebnf-sort-production
)
2277 (ps-print-quote ebnf-production-font
)
2278 (ps-print-quote ebnf-arrow-shape
)
2279 (ps-print-quote ebnf-chart-shape
)
2280 (ps-print-quote ebnf-user-arrow
)
2281 ebnf-horizontal-orientation
2282 ebnf-horizontal-max-height
2283 ebnf-production-horizontal-space
2284 ebnf-production-vertical-space
2285 (ps-print-quote ebnf-justify-sequence
)
2286 ebnf-lex-comment-char
2288 (ps-print-quote ebnf-syntax
)
2289 ebnf-iso-alternative-p
2290 ebnf-iso-normalize-p
2291 ebnf-file-suffix-regexp
2293 ebnf-entry-percentage
2298 ebnf-use-float-format
2300 ebnf-yac-ignore-error-recovery
2301 ebnf-ignore-empty-rule
2305 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2309 (defvar ebnf-stack-style nil
2310 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2314 (defvar ebnf-current-style
'default
2315 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2318 (defconst ebnf-style-custom-list
2319 '(ebnf-special-show-delimiter
2323 ebnf-special-border-width
2324 ebnf-special-border-color
2328 ebnf-except-border-width
2329 ebnf-except-border-color
2333 ebnf-repeat-border-width
2334 ebnf-repeat-border-color
2335 ebnf-terminal-regexp
2336 ebnf-case-fold-search
2339 ebnf-terminal-shadow
2340 ebnf-terminal-border-width
2341 ebnf-terminal-border-color
2342 ebnf-non-terminal-font
2343 ebnf-non-terminal-shape
2344 ebnf-non-terminal-shadow
2345 ebnf-non-terminal-border-width
2346 ebnf-non-terminal-border-color
2347 ebnf-production-name-p
2348 ebnf-sort-production
2349 ebnf-production-font
2353 ebnf-horizontal-orientation
2354 ebnf-horizontal-max-height
2355 ebnf-production-horizontal-space
2356 ebnf-production-vertical-space
2357 ebnf-justify-sequence
2358 ebnf-lex-comment-char
2361 ebnf-iso-alternative-p
2362 ebnf-iso-normalize-p
2363 ebnf-file-suffix-regexp
2365 ebnf-entry-percentage
2370 ebnf-use-float-format
2372 ebnf-yac-ignore-error-recovery
2373 ebnf-ignore-empty-rule
2375 "List of valid symbol custom variable.")
2378 (defvar ebnf-style-database
2382 (ebnf-special-show-delimiter . t
)
2383 (ebnf-special-font .
'(7 Courier
"Black" "Gray95" bold italic
))
2384 (ebnf-special-shape .
'bevel
)
2385 (ebnf-special-shadow . nil
)
2386 (ebnf-special-border-width .
0.5)
2387 (ebnf-special-border-color .
"Black")
2388 (ebnf-except-font .
'(7 Courier
"Black" "Gray90" bold italic
))
2389 (ebnf-except-shape .
'bevel
)
2390 (ebnf-except-shadow . nil
)
2391 (ebnf-except-border-width .
0.25)
2392 (ebnf-except-border-color .
"Black")
2393 (ebnf-repeat-font .
'(7 Courier
"Black" "Gray85" bold italic
))
2394 (ebnf-repeat-shape .
'bevel
)
2395 (ebnf-repeat-shadow . nil
)
2396 (ebnf-repeat-border-width .
0.0)
2397 (ebnf-repeat-border-color .
"Black")
2398 (ebnf-terminal-regexp . nil
)
2399 (ebnf-case-fold-search . nil
)
2400 (ebnf-terminal-font .
'(7 Courier
"Black" "White"))
2401 (ebnf-terminal-shape .
'miter
)
2402 (ebnf-terminal-shadow . nil
)
2403 (ebnf-terminal-border-width .
1.0)
2404 (ebnf-terminal-border-color .
"Black")
2405 (ebnf-non-terminal-font .
'(7 Helvetica
"Black" "White"))
2406 (ebnf-non-terminal-shape .
'round
)
2407 (ebnf-non-terminal-shadow . nil
)
2408 (ebnf-non-terminal-border-width .
1.0)
2409 (ebnf-non-terminal-border-color .
"Black")
2410 (ebnf-production-name-p . t
)
2411 (ebnf-sort-production . nil
)
2412 (ebnf-production-font .
'(10 Helvetica
"Black" "White" bold
))
2413 (ebnf-arrow-shape .
'hollow
)
2414 (ebnf-chart-shape .
'round
)
2415 (ebnf-user-arrow . nil
)
2416 (ebnf-horizontal-orientation . nil
)
2417 (ebnf-horizontal-max-height . nil
)
2418 (ebnf-production-horizontal-space .
0.0)
2419 (ebnf-production-vertical-space .
0.0)
2420 (ebnf-justify-sequence .
'center
)
2421 (ebnf-lex-comment-char . ?\
;)
2422 (ebnf-lex-eop-char . ?.
)
2423 (ebnf-syntax .
'ebnf
)
2424 (ebnf-iso-alternative-p . nil
)
2425 (ebnf-iso-normalize-p . nil
)
2426 (ebnf-file-suffix-regexp .
"\.[Bb][Nn][Ff]$")
2427 (ebnf-eps-prefix .
"ebnf--")
2428 (ebnf-entry-percentage .
0.5)
2429 (ebnf-color-p .
(or (fboundp 'x-color-values
) ; Emacs
2430 (fboundp 'color-instance-rgb-components
))) ; XEmacs
2431 (ebnf-line-width .
1.0)
2432 (ebnf-line-color .
"Black")
2433 (ebnf-debug-ps . nil
)
2434 (ebnf-use-float-format . t
)
2435 (ebnf-stop-on-error . nil
)
2436 (ebnf-yac-ignore-error-recovery . nil
)
2437 (ebnf-ignore-empty-rule . nil
)
2438 (ebnf-optimize . nil
))
2439 ;; Happy EBNF default
2442 (ebnf-justify-sequence .
'left
)
2443 (ebnf-lex-comment-char . ?\
#)
2444 (ebnf-lex-eop-char . ?\
;))
2448 (ebnf-syntax .
'abnf
))
2452 (ebnf-syntax .
'iso-ebnf
))
2453 ;; Yacc/Bison default
2456 (ebnf-syntax .
'yacc
))
2460 (ebnf-syntax .
'ebnfx
))
2464 (ebnf-syntax .
'dtd
))
2468 Each element has the following form:
2470 (NAME INHERITS (VAR . VALUE)...)
2474 NAME is a symbol name style.
2476 INHERITS is a symbol name style from which the current style inherits
2477 the context. If INHERITS is nil, means that there is no
2480 This is a simple inheritance of style; so if you declare that a
2481 style A inherits from a style B, all settings of B is applied
2482 first and then the settings of A is applied. This is useful
2483 when you wish to modify some aspects of an existing style, but
2484 at same time wish to keep it unmodified.
2486 VAR is a valid ebnf2ps symbol custom variable.
2487 See `ebnf-style-custom-list' for valid symbol variable.
2489 VALUE is a sexp which it'll be evaluated to set the value to VAR.
2490 So, don't forget to quote symbols and constant lists.
2491 See `default' style for an example.
2493 Don't handle this variable directly. Use functions `ebnf-insert-style',
2494 `ebnf-delete-style' and `ebnf-merge-style'.")
2497 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2502 (defun ebnf-insert-style (name inherits
&rest values
)
2503 "Insert a new style NAME with inheritance INHERITS and values VALUES.
2505 See `ebnf-style-database' documentation."
2506 (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
2507 (and (assoc name ebnf-style-database
)
2508 (error "Style name already exists: %s" name
))
2509 (or (assoc inherits ebnf-style-database
)
2510 (error "Style inheritance name does'nt exist: %s" inherits
))
2511 (setq ebnf-style-database
2512 (cons (cons name
(cons inherits
(ebnf-check-style-values values
)))
2513 ebnf-style-database
)))
2517 (defun ebnf-delete-style (name)
2520 See `ebnf-style-database' documentation."
2521 (interactive "SDelete style name: ")
2522 (or (assoc name ebnf-style-database
)
2523 (error "Style name doesn't exist: %s" name
))
2524 (let ((db ebnf-style-database
))
2526 (and (eq (nth 1 (car db
)) name
)
2527 (error "Style name `%s' is inherited by `%s' style"
2528 name
(nth 0 (car db
))))
2529 (setq db
(cdr db
))))
2530 (setq ebnf-style-database
(assq-delete-all name ebnf-style-database
)))
2534 (defun ebnf-merge-style (name &rest values
)
2535 "Merge values of style NAME with style VALUES.
2537 See `ebnf-style-database' documentation."
2538 (interactive "SStyle name: \nXStyle values: ")
2539 (let ((style (or (assoc name ebnf-style-database
)
2540 (error "Style name does'nt exist: %s" name
)))
2541 (merge (ebnf-check-style-values values
))
2543 ;; modify value of existing variables
2544 (setq val
(nthcdr 2 style
))
2546 (setq check
(car merge
)
2548 elt
(assoc (car check
) val
))
2550 (setcdr elt
(cdr check
))
2551 (setq new
(cons check new
))))
2552 ;; insert new variables
2553 (nconc style
(nreverse new
))))
2557 (defun ebnf-apply-style (style)
2558 "Set STYLE as the current style.
2560 It returns the old style symbol.
2562 See `ebnf-style-database' documentation."
2563 (interactive "SApply style: ")
2566 (and (ebnf-apply-style1 style
)
2567 (setq ebnf-current-style style
))))
2571 (defun ebnf-reset-style (&optional style
)
2572 "Reset current style.
2574 It returns the old style symbol.
2576 See `ebnf-style-database' documentation."
2577 (interactive "SReset style: ")
2578 (setq ebnf-stack-style nil
)
2579 (ebnf-apply-style (or style
'default
)))
2583 (defun ebnf-push-style (&optional style
)
2584 "Push the current style and set STYLE as the current style.
2586 It returns the old style symbol.
2588 See `ebnf-style-database' documentation."
2589 (interactive "SPush style: ")
2592 (setq ebnf-stack-style
(cons ebnf-current-style ebnf-stack-style
))
2594 (ebnf-apply-style style
))))
2598 (defun ebnf-pop-style ()
2599 "Pop a style and set it as the current style.
2601 It returns the old style symbol.
2603 See `ebnf-style-database' documentation."
2606 (ebnf-apply-style (car ebnf-stack-style
))
2607 (setq ebnf-stack-style
(cdr ebnf-stack-style
))))
2610 (defun ebnf-apply-style1 (style)
2611 (let ((value (cdr (assoc style ebnf-style-database
))))
2614 (and (car value
) (ebnf-apply-style1 (car value
)))
2615 (while (setq value
(cdr value
))
2616 (set (caar value
) (eval (cdar value
)))))))
2619 (defun ebnf-check-style-values (values)
2622 (and (memq (caar values
) ebnf-style-custom-list
)
2623 (setq style
(cons (car values
) style
)))
2624 (setq values
(cdr values
)))
2628 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2629 ;; Internal variables
2632 (defvar ebnf-eps-buffer-name
" *EPS*")
2633 (defvar ebnf-parser-func nil
)
2634 (defvar ebnf-eps-executing nil
)
2635 (defvar ebnf-eps-upper-x
0.0)
2636 (make-variable-buffer-local 'ebnf-eps-upper-x
)
2637 (defvar ebnf-eps-upper-y
0.0)
2638 (make-variable-buffer-local 'ebnf-eps-upper-y
)
2639 (defvar ebnf-eps-prod-width
0.0)
2640 (make-variable-buffer-local 'ebnf-eps-prod-width
)
2641 (defvar ebnf-eps-max-height
0.0)
2642 (make-variable-buffer-local 'ebnf-eps-max-height
)
2643 (defvar ebnf-eps-max-width
0.0)
2644 (make-variable-buffer-local 'ebnf-eps-max-width
)
2647 (defvar ebnf-eps-context nil
2648 "List of EPS file name during parsing.
2650 See section \"Actions in Comments\" in ebnf2ps documentation.")
2653 (defvar ebnf-eps-production-list nil
2654 "Alist associating production name with EPS file name list.
2656 Each element has the following form:
2658 (PRODUCTION EPS-FILENAME...)
2660 PRODUCTION is the production name.
2661 EPS-FILENAME is the EPS file name.
2663 It's generated during parsing and used during EPS generation.
2665 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2669 (defconst ebnf-arrow-shape-alist
2677 (semi-up-hollow .
7)
2679 (semi-down-hollow .
9)
2680 (semi-down-full .
10)
2682 "Alist associating values for `ebnf-arrow-shape'.
2684 See documentation for `ebnf-arrow-shape'.")
2687 (defconst ebnf-terminal-shape-alist
2691 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2693 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2694 `ebnf-chart-shape'.")
2697 (defvar ebnf-limit nil
)
2698 (defvar ebnf-action nil
)
2699 (defvar ebnf-action-list nil
)
2702 (defvar ebnf-default-p nil
)
2705 (defvar ebnf-font-height-P
0)
2706 (defvar ebnf-font-height-T
0)
2707 (defvar ebnf-font-height-NT
0)
2708 (defvar ebnf-font-height-S
0)
2709 (defvar ebnf-font-height-E
0)
2710 (defvar ebnf-font-height-R
0)
2711 (defvar ebnf-font-width-P
0)
2712 (defvar ebnf-font-width-T
0)
2713 (defvar ebnf-font-width-NT
0)
2714 (defvar ebnf-font-width-S
0)
2715 (defvar ebnf-font-width-E
0)
2716 (defvar ebnf-font-width-R
0)
2717 (defvar ebnf-space-T
0)
2718 (defvar ebnf-space-NT
0)
2719 (defvar ebnf-space-S
0)
2720 (defvar ebnf-space-E
0)
2721 (defvar ebnf-space-R
0)
2724 (defvar ebnf-basic-width
0)
2725 (defvar ebnf-basic-height
0)
2726 (defvar ebnf-vertical-space
0)
2727 (defvar ebnf-horizontal-space
0)
2730 (defvar ebnf-settings nil
)
2731 (defvar ebnf-fonts-required nil
)
2734 (defconst ebnf-debug
2736 % === begin EBNF procedures to help debugging
2738 % Mark visually current point: string debug
2742 gsave -s- show grestore
2754 % Show number value: number string debug-number
2757 20 0 rmoveto show ([) show 60 string cvs show (]) show
2761 % === end EBNF procedures to help debugging
2764 "This is intended to help debugging PostScript programming.")
2767 (defconst ebnf-prologue
2769 % === begin EBNF engine
2771 % --- Basic Definitions
2774 /SpaceS FontHeight 0.5 mul def
2775 /HeightS FontHeight FontHeight add def
2778 /SpaceE FontHeight 0.5 mul def
2779 /HeightE FontHeight FontHeight add def
2782 /SpaceR FontHeight 0.5 mul def
2783 /HeightR FontHeight FontHeight add def
2786 /SpaceT FontHeight 0.5 mul def
2787 /HeightT FontHeight FontHeight add def
2790 /SpaceNT FontHeight 0.5 mul def
2791 /HeightNT FontHeight FontHeight add def
2793 /T HeightT HeightNT add 0.5 mul def
2796 /hT4 hT 0.25 mul def
2798 /Er 0.1 def % Error factor
2801 /c{currentpoint}bind def
2802 /xyi{/xi c /yi exch def def}bind def
2803 /xyo{/xo c /yo exch def def}bind def
2804 /xyp{/xp c /yp exch def def}bind def
2805 /xyt{/xt c /yt exch def def}bind def
2807 % vertical movement: x y height vm
2808 /vm{add moveto}bind def
2810 % horizontal movement: x y width hm
2811 /hm{3 -1 roll exch add exch moveto}bind def
2813 % set color: [R G B] SetRGB
2814 /SetRGB{aload pop setrgbcolor}bind def
2816 % filling gray area: gray-scale FillGray
2817 /FillGray{gsave setgray fill grestore}bind def
2819 % filling color area: [R G B] FillRGB
2820 /FillRGB{gsave SetRGB fill grestore}bind def
2822 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2823 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2824 /Gstroke{gsave Stroke grestore}bind def
2826 % Empty Line: width EL
2827 /EL{0 rlineto Gstroke}bind def
2831 /Down{hT2 neg hT4 neg rlineto}bind def
2834 {hT2 neg hT4 rmoveto
2839 /ArrowPath{c newpath moveto Arrow closepath}bind def
2863 {hT2 neg hT4 rlineto} % 1 - semi-up
2864 {Down} % 2 - semi-down
2865 {Arrow} % 3 - simple
2866 {Gstroke ArrowPath} % 4 - transparent
2867 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2868 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2869 {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
2870 {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
2871 {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
2872 {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
2873 {Gstroke gsave UserArrow grestore} % 11 - user
2879 RA-vector ArrowShape get exec
2884 % rotation DrawArrow
2899 /LA{180 DrawArrow}def
2906 /UA{90 DrawArrow}def
2913 /DA{270 DrawArrow}def
2917 %>corner Right Descendent: height arrow corner_RD
2919 % / height > 0 | 0 - none
2921 % * ---------- | 2 - left
2940 h 0 gt{DA}{UA}ifelse
2945 [{cRD0-vector arrow get exec} % 0 - miter
2946 {0 0 0 h hT h rcurveto} % 1 - rounded
2947 {hT h rlineto} % 2 - bevel
2951 {/arrow exch def /h exch def
2952 cRD-vector ChartShape get exec
2956 %>corner Right Ascendent: height arrow corner_RA
2958 % | height > 0 | 0 - none
2960 % *- ---------- | 2 - left
2978 h 0 gt{DA}{UA}ifelse
2984 [{cRA0-vector arrow get exec} % 0 - miter
2985 {0 0 hT 0 hT h rcurveto} % 1 - rounded
2986 {hT h rlineto} % 2 - bevel
2990 {/arrow exch def /h exch def
2991 cRA-vector ChartShape get exec
2995 %>corner Left Descendent: height arrow corner_LD
2997 % \\ height > 0 | 0 - none
2999 % * ---------- | 2 - left
3008 {hT neg h rmoveto xyi
3016 {hT neg h rmoveto xyi
3018 h 0 gt{DA}{UA}ifelse
3023 [{cLD0-vector arrow get exec} % 0 - miter
3024 {0 0 0 h hT neg h rcurveto} % 1 - rounded
3025 {hT neg h rlineto} % 2 - bevel
3029 {/arrow exch def /h exch def
3030 cLD-vector ChartShape get exec
3034 %>corner Left Ascendent: height arrow corner_LA
3036 % | height > 0 | 0 - none
3038 % -* ---------- | 2 - left
3047 {hT neg h rmoveto xyi
3055 {hT neg h rmoveto xyi
3056 h 0 gt{DA}{UA}ifelse
3062 [{cLA0-vector arrow get exec} % 0 - miter
3063 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
3064 {hT neg h rlineto} % 2 - bevel
3068 {/arrow exch def /h exch def
3069 cLA-vector ChartShape get exec
3075 % height prepare_height |- line_height corner_height corner_height
3079 {T add hT neg}ifelse
3083 %>Left Alternative: height LAlt
3110 %>Left Loop: height LLoop
3129 %>Right Alternative: height RAlt
3143 {T neg exch rlineto}
3156 %>Right Loop: height RLoop
3175 % --- Terminal, Non-terminal and Special Basics
3177 % string width prepare-width |- string
3180 dup stringwidth pop space add space add width exch sub 0.5 mul
3184 % string width begin-right
3194 {xo width add Er add yo moveto
3199 % string width begin-left
3208 {xo width add Er add yo moveto
3221 {/half YY yy sub 0.5 mul abs def
3222 xx half add YY moveto
3223 0 0 half neg 0 half neg half neg rcurveto
3224 0 0 0 half neg half half neg rcurveto
3225 XX xx sub abs half sub half sub 0 rlineto
3226 0 0 half 0 half half rcurveto
3227 0 0 0 half half neg half rcurveto}
3229 {/quarter YY yy sub 0.25 mul abs def
3230 xx quarter add YY moveto
3231 quarter neg quarter neg rlineto
3232 0 quarter quarter add neg rlineto
3233 quarter quarter neg rlineto
3234 XX xx sub abs quarter sub quarter sub 0 rlineto
3235 quarter quarter rlineto
3236 0 quarter quarter add rlineto
3237 quarter neg quarter rlineto}
3242 ShapePath-vector shape get exec
3248 Xshadow Xshadow add Xshadow add
3249 Yshadow Yshadow add Yshadow add translate
3263 % string SBound |- string
3265 {/xx c dup /yy exch def
3266 FontHeight add /YY exch def def
3267 dup stringwidth pop xx add /XX exch def
3269 {/yy yy YShadow add def
3270 /XX XX XShadow add def
3279 /XX XX space add space add def
3280 /YY YY space add def
3281 /yy yy space sub def
3282 shadow{doShapeShadow}if
3284 space Descent abs rmoveto
3291 % TeRminal: string TR
3293 {/Effect EffectT def
3295 /shapecolor BackgroundT def
3296 /borderwidth BorderWidthT def
3297 /bordercolor BorderColorT def
3298 /foreground ForegroundT def
3303 %>Right Terminal: string width RT |- x y
3314 %>Left Terminal: string width LT |- x y
3325 %>Right Terminal Default: string width RTD |- x y
3327 {/-save- BorderWidthT def
3328 /BorderWidthT BorderWidthT DefaultWidth add def
3330 /BorderWidthT -save- def
3333 %>Left Terminal Default: string width LTD |- x y
3335 {/-save- BorderWidthT def
3336 /BorderWidthT BorderWidthT DefaultWidth add def
3338 /BorderWidthT -save- def
3343 % Non-Terminal: string NT
3345 {/Effect EffectNT def
3347 /shapecolor BackgroundNT def
3348 /borderwidth BorderWidthNT def
3349 /bordercolor BorderColorNT def
3350 /foreground ForegroundNT def
3351 /shadow ShadowNT def
3355 %>Right Non-Terminal: string width RNT |- x y
3366 %>Left Non-Terminal: string width LNT |- x y
3377 %>Right Non-Terminal Default: string width RNTD |- x y
3379 {/-save- BorderWidthNT def
3380 /BorderWidthNT BorderWidthNT DefaultWidth add def
3382 /BorderWidthNT -save- def
3385 %>Left Non-Terminal Default: string width LNTD |- x y
3387 {/-save- BorderWidthNT def
3388 /BorderWidthNT BorderWidthNT DefaultWidth add def
3390 /BorderWidthNT -save- def
3395 % SPecial: string SP
3397 {/Effect EffectS def
3399 /shapecolor BackgroundS def
3400 /borderwidth BorderWidthS def
3401 /bordercolor BorderColorS def
3402 /foreground ForegroundS def
3407 %>Right SPecial: string width RSP |- x y
3418 %>Left SPecial: string width LSP |- x y
3429 %>Right SPecial Default: string width RSPD |- x y
3431 {/-save- BorderWidthS def
3432 /BorderWidthS BorderWidthS DefaultWidth add def
3434 /BorderWidthS -save- def
3437 %>Left SPecial Default: string width LSPD |- x y
3439 {/-save- BorderWidthS def
3440 /BorderWidthS BorderWidthS DefaultWidth add def
3442 /BorderWidthS -save- def
3445 % --- Repeat and Except basics
3448 {/w width rwidth sub 0.5 mul def
3453 /xx c entry add /YY exch def def
3454 /yy YY height sub def
3455 /XX xx rwidth add def
3456 shadow{doShapeShadow}if
3479 % entry height width rwidth begin-repeat
3489 /shapecolor BackgroundR def
3490 /borderwidth BorderWidthR def
3491 /bordercolor BorderColorR def
3492 /foreground ForegroundR def
3497 % string end-repeat |- x y
3500 space Descent rmoveto
3504 exch space add exch moveto
3508 %>Right RePeat: string entry height width rwidth RRP |- x y
3509 /RRP{begin-repeat right-direction end-repeat}def
3511 %>Left RePeat: string entry height width rwidth LRP |- x y
3512 /LRP{begin-repeat left-direction end-repeat}def
3516 % entry height width rwidth begin-except
3526 /shapecolor BackgroundE def
3527 /borderwidth BorderWidthE def
3528 /bordercolor BorderColorE def
3529 /foreground ForegroundE def
3534 % x-width end-except |- x y
3537 space space add add Descent rmoveto
3538 (-) foreground SetRGB S
3544 %>Right EXcept: x-width entry height width rwidth REX |- x y
3545 /REX{begin-except right-direction end-except}def
3547 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3548 /LEX{begin-except left-direction end-except}def
3552 %>Beginning Of Sequence: BOS |- x y
3553 /BOS{currentpoint}bind def
3555 %>End Of Sequence: x y x1 y1 EOS |- x y
3556 /EOS{pop pop}bind def
3560 %>Beginning Of Production: string width height BOP |- y x
3563 neg yp add /yw exch def
3564 xp add T sub /xw exch def
3565 dup length 0 gt % empty string ==> no production name
3566 {/Effect EffectP def
3567 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3577 %>End Of Production: y x delta EOP
3578 /EOPH{add exch moveto}bind def % horizontal
3579 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3581 % --- Empty Alternative
3583 %>Empty Alternative: width EA |- x y
3594 %>AlTernative: h1 h2 ... hn n width AT |- x y
3596 {xyo xo add /xw exch def
3608 %>OPtional: height width OP |- x y
3625 %>One or More: height width OM |- x y
3639 %>Zero or More: h2 h1 width ZM |- x y
3649 yo add xo T add exch moveto
3653 % === end EBNF engine
3656 "EBNF PostScript prologue")
3659 (defconst ebnf-eps-prologue
3661 /#ebnf2ps#dict 230 dict def
3664 % Initiliaze variables to avoid name-conflicting with document variables.
3665 % This is the case when using `bind' operator.
3666 /-fillp- 0 def /h 0 def
3667 /-ox- 0 def /half 0 def
3668 /-oy- 0 def /height 0 def
3669 /-save- 0 def /ow 0 def
3670 /Ascent 0 def /quarter 0 def
3671 /Descent 0 def /rXX 0 def
3672 /Effect 0 def /rYY 0 def
3673 /FontHeight 0 def /rwidth 0 def
3674 /LineThickness 0 def /rxx 0 def
3675 /OverlinePosition 0 def /ryy 0 def
3676 /SpaceBackground 0 def /shadow 0 def
3677 /StrikeoutPosition 0 def /shape 0 def
3678 /UnderlinePosition 0 def /shapecolor 0 def
3679 /XBox 0 def /space 0 def
3680 /XX 0 def /st 1 string def
3681 /Xshadow 0 def /w 0 def
3682 /YBox 0 def /width 0 def
3684 /Yshadow 0 def /xo 0 def
3685 /arrow 0 def /xp 0 def
3686 /bg false def /xt 0 def
3687 /bgcolor 0 def /xw 0 def
3688 /bordercolor 0 def /xx 0 def
3689 /borderwidth 0 def /yi 0 def
3691 /entry 0 def /yp 0 def
3692 /foreground 0 def /yt 0 def
3696 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3697 /ISOLatin1Encoding where
3699 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3700 % -- The first half is the same as the standard encoding,
3701 % -- except for minus instead of hyphen at code 055.
3703 StandardEncoding 0 45 getinterval aload pop
3705 StandardEncoding 46 82 getinterval aload pop
3706 %*** NOTE: the following are missing in the Adobe documentation,
3707 %*** but appear in the displayed table:
3708 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3710 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3711 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3712 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3713 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3715 /space /exclamdown /cent /sterling
3716 /currency /yen /brokenbar /section
3717 /dieresis /copyright /ordfeminine /guillemotleft
3718 /logicalnot /hyphen /registered /macron
3719 /degree /plusminus /twosuperior /threesuperior
3720 /acute /mu /paragraph /periodcentered
3721 /cedilla /onesuperior /ordmasculine /guillemotright
3722 /onequarter /onehalf /threequarters /questiondown
3724 /Agrave /Aacute /Acircumflex /Atilde
3725 /Adieresis /Aring /AE /Ccedilla
3726 /Egrave /Eacute /Ecircumflex /Edieresis
3727 /Igrave /Iacute /Icircumflex /Idieresis
3728 /Eth /Ntilde /Ograve /Oacute
3729 /Ocircumflex /Otilde /Odieresis /multiply
3730 /Oslash /Ugrave /Uacute /Ucircumflex
3731 /Udieresis /Yacute /Thorn /germandbls
3733 /agrave /aacute /acircumflex /atilde
3734 /adieresis /aring /ae /ccedilla
3735 /egrave /eacute /ecircumflex /edieresis
3736 /igrave /iacute /icircumflex /idieresis
3737 /eth /ntilde /ograve /oacute
3738 /ocircumflex /otilde /odieresis /divide
3739 /oslash /ugrave /uacute /ucircumflex
3740 /udieresis /yacute /thorn /ydieresis
3744 /reencodeFontISO %def
3746 length 12 add dict % Make a new font (a new dict the same size
3747 % as the old one) with room for our new symbols.
3749 begin % Make the new font the current dictionary.
3751 {def}{pop pop}ifelse
3752 }forall % Copy each of the symbols from the old dictionary
3753 % to the new one except for the font ID.
3755 currentdict /FontType get 0 ne
3756 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3757 % the ISOLatin1 encoding.
3759 % Use the font's bounding box to determine the ascent, descent,
3760 % and overall height; don't forget that these values have to be
3761 % transformed using the font's matrix.
3768 % | | | | Ascent (usually > 0)
3770 % (0 0) -> +--+----+-------->
3772 % | | v Descent (usually < 0)
3773 % (x1 y1) --> +----+ - -
3775 currentdict /FontType get 0 ne
3776 {/FontBBox load aload pop % -- x1 y1 x2 y2
3777 FontMatrix transform /Ascent exch def pop
3778 FontMatrix transform /Descent exch def pop}
3779 {/PrimaryFont FDepVector 0 get def
3780 PrimaryFont /FontBBox get aload pop
3781 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3782 PrimaryFont /FontMatrix get transform /Descent exch def pop
3785 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3787 % Define these in case they're not in the FontInfo
3788 % (also, here they're easier to get to).
3789 /UnderlinePosition Descent 0.70 mul def
3790 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3791 /StrikeoutPosition Ascent 0.30 mul def
3792 /LineThickness FontHeight 0.05 mul def
3793 /Xshadow FontHeight 0.08 mul def
3794 /Yshadow FontHeight -0.09 mul def
3795 /SpaceBackground Descent neg UnderlinePosition add def
3796 /XBox Descent neg def
3797 /YBox LineThickness 0.7 mul def
3799 currentdict % Leave the new font on the stack
3800 end % Stop using the font as the current dictionary
3801 definefont % Put the font into the font dictionary
3802 pop % Discard the returned font
3806 /DefFont{findfont exch scalefont reencodeFontISO}def
3811 dup /Ascent get /Ascent exch def
3812 dup /Descent get /Descent exch def
3813 dup /FontHeight get /FontHeight exch def
3814 dup /UnderlinePosition get /UnderlinePosition exch def
3815 dup /OverlinePosition get /OverlinePosition exch def
3816 dup /StrikeoutPosition get /StrikeoutPosition exch def
3817 dup /LineThickness get /LineThickness exch def
3818 dup /Xshadow get /Xshadow exch def
3819 dup /Yshadow get /Yshadow exch def
3820 dup /SpaceBackground get /SpaceBackground exch def
3821 dup /XBox get /XBox exch def
3822 dup /YBox get /YBox exch def
3835 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3837 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3850 % top of stack: fill-or-not
3852 {LineThickness setlinewidth stroke}
3857 % stack: string fill-or-not |- --
3860 /-ox- currentpoint /-oy- exch def def
3862 LineThickness setlinewidth
3864 st dup true charpath
3865 -fillp- {gsave FillBgColor grestore}if
3867 -oy- add /-oy- exch def
3868 -ox- add /-ox- exch def
3875 % stack: fill-or-not delta |- --
3878 xx XBox sub dd sub yy YBox sub dd sub
3879 XX XBox add dd add YY YBox add dd add
3883 % stack: string |- --
3886 Xshadow Yshadow rmoveto
3891 % stack: position |- --
3893 {currentpoint exch pop add dup
3899 LineThickness setlinewidth stroke
3903 % stack: string |- --
3904 % effect: 1 - underline 2 - strikeout 4 - overline
3905 % 8 - shadow 16 - box 32 - outline
3907 {/xx currentpoint dup Descent add /yy exch def
3908 Ascent add /YY exch def def
3909 dup stringwidth pop xx add /XX exch def
3911 {/yy yy Yshadow add def
3912 /XX XX Xshadow add def
3917 {SpaceBackground doBox}
3918 {xx yy XX YY doRect}
3921 Effect 16 and 0 ne{false 0 doBox}if % box
3922 Effect 8 and 0 ne{dup doShadow}if % shadow
3924 {true doOutline} % outline
3925 {show} % normal text
3927 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
3928 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
3929 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
3933 "EBNF EPS prologue")
3936 (defconst ebnf-eps-begin
3940 % x y #ebnf2ps#begin
3942 {#ebnf2ps#dict begin /#ebnf2ps#save save def
3943 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
3945 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
3952 (defconst ebnf-eps-end
3959 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3963 (defvar ebnf-format-float
"%1.3f")
3966 (defun ebnf-format-float (&rest floats
)
3969 (format ebnf-format-float float
))
3974 (defun ebnf-format-color (format-str color default
)
3975 (let* ((the-color (or color default
))
3976 (rgb (ps-color-scale the-color
)))
3979 (ebnf-format-float (nth 0 rgb
) (nth 1 rgb
) (nth 2 rgb
))
3984 (defvar ebnf-message-float
"%3.2f")
3987 (defsubst ebnf-message-float
(format-str value
)
3989 (format ebnf-message-float value
)))
3992 (defvar ebnf-total
0)
3993 (defvar ebnf-nprod
0)
3996 (defsubst ebnf-message-info
(messag)
3997 (message "%s...%3d%%"
3999 (round (/ (* (setq ebnf-nprod
(1+ ebnf-nprod
)) 100.0) ebnf-total
))))
4002 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4006 (defmacro ebnf-node-kind
(vec &optional value
)
4008 `(aset ,vec
0 ,value
)
4012 (defmacro ebnf-node-width-func
(node width
)
4013 `(funcall (aref ,node
1) ,node
,width
))
4016 (defmacro ebnf-node-dimension-func
(node &optional value
)
4018 `(aset ,node
2 ,value
)
4019 `(funcall (aref ,node
2) ,node
)))
4022 (defmacro ebnf-node-entry
(vec &optional value
)
4024 `(aset ,vec
3 ,value
)
4028 (defmacro ebnf-node-height
(vec &optional value
)
4030 `(aset ,vec
4 ,value
)
4034 (defmacro ebnf-node-width
(vec &optional value
)
4036 `(aset ,vec
5 ,value
)
4040 (defmacro ebnf-node-name
(vec)
4044 (defmacro ebnf-node-list
(vec &optional value
)
4046 `(aset ,vec
6 ,value
)
4050 (defmacro ebnf-node-default
(vec)
4054 (defmacro ebnf-node-production
(vec &optional value
)
4056 `(aset ,vec
7 ,value
)
4060 (defmacro ebnf-node-separator
(vec &optional value
)
4062 `(aset ,vec
7 ,value
)
4066 (defmacro ebnf-node-action
(vec &optional value
)
4068 `(aset ,vec
8 ,value
)
4072 (defmacro ebnf-node-generation
(node)
4073 `(funcall (ebnf-node-kind ,node
) ,node
))
4076 (defmacro ebnf-max-width
(prod)
4077 `(max (ebnf-node-width ,prod
)
4078 (+ (* (length (ebnf-node-name ,prod
))
4080 ebnf-production-horizontal-space
)))
4083 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4084 ;; PostScript generation
4087 (defun ebnf-generate-eps (ebnf-tree)
4088 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4089 (ps-print-color-scale (if ps-color-p
4090 (float (car (ps-color-values "white")))
4092 (ebnf-total (length ebnf-tree
))
4094 (old-ps-output (symbol-function 'ps-output
))
4095 (old-ps-output-string (symbol-function 'ps-output-string
))
4096 (eps-buffer (get-buffer-create ebnf-eps-buffer-name
))
4097 ebnf-debug-ps error-msg horizontal
4098 prod prod-name prod-width prod-height prod-list file-list
)
4099 ;; redefines `ps-output' and `ps-output-string'
4100 (defalias 'ps-output
'ebnf-eps-output
)
4101 (defalias 'ps-output-string
'ps-output-string-prim
)
4102 ;; generate EPS file
4104 (condition-case data
4107 (setq prod
(car ebnf-tree
)
4108 prod-name
(ebnf-node-name prod
)
4109 prod-width
(ebnf-max-width prod
)
4110 prod-height
(ebnf-node-height prod
)
4111 horizontal
(memq (ebnf-node-action prod
)
4113 ;; generate production in EPS buffer
4115 (set-buffer eps-buffer
)
4116 (setq ebnf-eps-upper-x
0.0
4117 ebnf-eps-upper-y
0.0
4118 ebnf-eps-max-width prod-width
4119 ebnf-eps-max-height prod-height
)
4120 (ebnf-generate-production prod
))
4121 (if (setq prod-list
(cdr (assoc prod-name
4122 ebnf-eps-production-list
)))
4123 ;; insert EPS buffer in all buffer associated with production
4124 (ebnf-eps-production-list prod-list
'file-list horizontal
4125 prod-width prod-height eps-buffer
)
4126 ;; write EPS file for production
4127 (ebnf-eps-finish-and-write eps-buffer
4128 (ebnf-eps-filename prod-name
)))
4129 ;; prepare for next loop
4131 (set-buffer eps-buffer
)
4133 (setq ebnf-tree
(cdr ebnf-tree
)))
4134 ;; write and kill temporary buffers
4135 (ebnf-eps-write-kill-temp file-list t
)
4136 (setq file-list nil
))
4139 (setq error-msg
(error-message-string data
)))))
4140 ;; restore `ps-output' and `ps-output-string'
4141 (defalias 'ps-output old-ps-output
)
4142 (defalias 'ps-output-string old-ps-output-string
)
4143 ;; kill temporary buffers
4144 (kill-buffer eps-buffer
)
4145 (ebnf-eps-write-kill-temp file-list nil
)
4146 (and error-msg
(error error-msg
))
4150 ;; write and kill temporary buffers
4151 (defun ebnf-eps-write-kill-temp (file-list write-p
)
4153 (let ((buffer (get-buffer (concat " *" (car file-list
) "*"))))
4156 (ebnf-eps-finish-and-write buffer
(car file-list
)))
4157 (kill-buffer buffer
)))
4158 (setq file-list
(cdr file-list
))))
4161 ;; insert EPS buffer in all buffer associated with production
4162 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
4163 prod-width prod-height eps-buffer
)
4165 (add-to-list file-list-sym
(car prod-list
))
4167 (set-buffer (get-buffer-create (concat " *" (car prod-list
) "*")))
4168 (goto-char (point-max))
4171 ((zerop (buffer-size))
4172 (setq ebnf-eps-upper-x
0.0
4173 ebnf-eps-upper-y
0.0
4174 ebnf-eps-max-width prod-width
4175 ebnf-eps-max-height prod-height
))
4178 (ebnf-eop-horizontal ebnf-eps-prod-width
)
4179 (setq ebnf-eps-max-width
(+ ebnf-eps-max-width
4180 ebnf-production-horizontal-space
4182 ebnf-eps-max-height
(max ebnf-eps-max-height prod-height
)))
4185 (ebnf-eop-vertical ebnf-eps-max-height
)
4186 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4187 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4190 ebnf-production-vertical-space
4191 ebnf-eps-max-height
))
4192 ebnf-eps-max-width prod-width
4193 ebnf-eps-max-height prod-height
))
4195 (setq ebnf-eps-prod-width prod-width
)
4196 (insert-buffer eps-buffer
))
4197 (setq prod-list
(cdr prod-list
))))
4200 (defun ebnf-generate (ebnf-tree)
4201 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4202 (ps-print-color-scale (if ps-color-p
4203 (float (car (ps-color-values "white")))
4205 ps-zebra-stripes ps-line-number ps-razzle-dazzle
4207 ps-print-begin-sheet-hook
4208 ps-print-begin-page-hook
4209 ps-print-begin-column-hook
)
4210 (ps-generate (current-buffer) (point-min) (point-max)
4211 'ebnf-generate-postscript
)))
4214 (defvar ebnf-tree nil
)
4215 (defvar ebnf-direction
"R")
4218 (defun ebnf-generate-postscript (from to
)
4220 (if ebnf-horizontal-max-height
4221 (ebnf-generate-with-max-height)
4222 (ebnf-generate-without-max-height))
4226 (defun ebnf-generate-with-max-height ()
4227 (let ((ebnf-total (length ebnf-tree
))
4229 next-line max-height prod the-width
)
4231 ;; find next line point
4232 (setq next-line ebnf-tree
4233 prod
(car ebnf-tree
)
4234 max-height
(ebnf-node-height prod
))
4235 (ebnf-begin-line prod
(ebnf-max-width prod
))
4236 (while (and (setq next-line
(cdr next-line
))
4237 (setq prod
(car next-line
))
4238 (memq (ebnf-node-action prod
) ebnf-action-list
)
4239 (setq the-width
(ebnf-max-width prod
))
4240 (<= the-width ps-width-remaining
))
4241 (setq max-height
(max max-height
(ebnf-node-height prod
))
4242 ps-width-remaining
(- ps-width-remaining
4244 ebnf-production-horizontal-space
))))
4245 ;; generate current line
4246 (ebnf-newline max-height
)
4247 (setq prod
(car ebnf-tree
))
4248 (ebnf-generate-production prod
)
4249 (while (not (eq (setq ebnf-tree
(cdr ebnf-tree
)) next-line
))
4250 (ebnf-eop-horizontal (ebnf-max-width prod
))
4251 (setq prod
(car ebnf-tree
))
4252 (ebnf-generate-production prod
))
4253 (ebnf-eop-vertical max-height
))))
4256 (defun ebnf-generate-without-max-height ()
4257 (let ((ebnf-total (length ebnf-tree
))
4259 max-height prod bef-width cur-width
)
4261 ;; generate current line
4262 (setq prod
(car ebnf-tree
)
4263 max-height
(ebnf-node-height prod
)
4264 bef-width
(ebnf-max-width prod
))
4265 (ebnf-begin-line prod bef-width
)
4266 (ebnf-generate-production prod
)
4267 (while (and (setq ebnf-tree
(cdr ebnf-tree
))
4268 (setq prod
(car ebnf-tree
))
4269 (memq (ebnf-node-action prod
) ebnf-action-list
)
4270 (setq cur-width
(ebnf-max-width prod
))
4271 (<= cur-width ps-width-remaining
)
4272 (<= (ebnf-node-height prod
) ps-height-remaining
))
4273 (ebnf-eop-horizontal bef-width
)
4274 (ebnf-generate-production prod
)
4275 (setq bef-width cur-width
4276 max-height
(max max-height
(ebnf-node-height prod
))
4277 ps-width-remaining
(- ps-width-remaining
4279 ebnf-production-horizontal-space
))))
4280 (ebnf-eop-vertical max-height
)
4281 ;; prepare next line
4282 (ebnf-newline max-height
))))
4285 (defun ebnf-begin-line (prod width
)
4286 (and (or (eq (ebnf-node-action prod
) 'form-feed
)
4287 (> (ebnf-node-height prod
) ps-height-remaining
))
4289 (setq ps-width-remaining
(- ps-width-remaining
4291 ebnf-production-horizontal-space
))))
4294 (defun ebnf-newline (height)
4295 (and (> height ps-height-remaining
)
4297 (setq ps-width-remaining ps-print-width
4298 ps-height-remaining
(- ps-height-remaining
4300 ebnf-production-vertical-space
))))
4303 ;; [production width-fun dim-fun entry height width name production action]
4304 (defun ebnf-generate-production (production)
4305 (ebnf-message-info "Generating")
4306 (run-hooks 'ebnf-production-hook
)
4307 (ps-output-string (if ebnf-production-name-p
4308 (ebnf-node-name production
)
4312 (ebnf-node-width production
)
4313 (+ (if ebnf-production-name-p
4316 (ebnf-node-entry (ebnf-node-production production
))))
4318 (ebnf-node-generation (ebnf-node-production production
))
4319 (ps-output "EOS\n"))
4322 ;; [alternative width-fun dim-fun entry height width list]
4323 (defun ebnf-generate-alternative (alternative)
4324 (let ((alt (ebnf-node-list alternative
))
4325 (entry (ebnf-node-entry alternative
))
4327 alt-height alt-entry
)
4329 (ps-output (ebnf-format-float (- entry
(ebnf-node-entry (car alt
))))
4331 (setq entry
(- entry
(ebnf-node-height (car alt
)) ebnf-vertical-space
)
4334 (ps-output (format "%d " nlist
)
4335 (ebnf-format-float (ebnf-node-width alternative
))
4337 (setq alt
(ebnf-node-list alternative
))
4339 (ebnf-node-generation (car alt
))
4340 (setq alt-height
(- (ebnf-node-height (car alt
))
4341 (ebnf-node-entry (car alt
)))))
4342 (while (setq alt
(cdr alt
))
4343 (setq alt-entry
(ebnf-node-entry (car alt
)))
4344 (ebnf-vertical-movement
4345 (- (+ alt-height ebnf-vertical-space alt-entry
)))
4346 (ebnf-node-generation (car alt
))
4347 (setq alt-height
(- (ebnf-node-height (car alt
)) alt-entry
))))
4348 (ps-output "EOS\n"))
4351 ;; [sequence width-fun dim-fun entry height width list]
4352 (defun ebnf-generate-sequence (sequence)
4354 (let ((seq (ebnf-node-list sequence
))
4357 (ebnf-node-generation (car seq
))
4358 (setq seq-width
(ebnf-node-width (car seq
))))
4359 (while (setq seq
(cdr seq
))
4360 (ebnf-horizontal-movement seq-width
)
4361 (ebnf-node-generation (car seq
))
4362 (setq seq-width
(ebnf-node-width (car seq
)))))
4363 (ps-output "EOS\n"))
4366 ;; [terminal width-fun dim-fun entry height width name]
4367 (defun ebnf-generate-terminal (terminal)
4368 (ebnf-gen-terminal terminal
"T"))
4371 ;; [non-terminal width-fun dim-fun entry height width name]
4372 (defun ebnf-generate-non-terminal (non-terminal)
4373 (ebnf-gen-terminal non-terminal
"NT"))
4376 ;; [empty width-fun dim-fun entry height width]
4377 (defun ebnf-generate-empty (empty)
4378 (ebnf-empty-alternative (ebnf-node-width empty
)))
4381 ;; [optional width-fun dim-fun entry height width element]
4382 (defun ebnf-generate-optional (optional)
4383 (let ((the-optional (ebnf-node-list optional
)))
4384 (ps-output (ebnf-format-float
4385 (+ (- (ebnf-node-height the-optional
)
4386 (ebnf-node-entry optional
))
4387 ebnf-vertical-space
)
4388 (ebnf-node-width optional
))
4390 (ebnf-node-generation the-optional
)
4391 (ps-output "EOS\n")))
4394 ;; [one-or-more width-fun dim-fun entry height width element separator]
4395 (defun ebnf-generate-one-or-more (one-or-more)
4396 (let* ((width (ebnf-node-width one-or-more
))
4397 (sep (ebnf-node-separator one-or-more
))
4398 (entry (- (ebnf-node-entry one-or-more
)
4400 (ebnf-node-entry sep
)
4402 (ps-output (ebnf-format-float entry width
)
4404 (ebnf-node-generation (ebnf-node-list one-or-more
))
4405 (ebnf-vertical-movement entry
)
4407 (let ((ebnf-direction "L"))
4408 (ebnf-node-generation sep
))
4409 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4410 (ps-output "EOS\n"))
4413 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4414 (defun ebnf-generate-zero-or-more (zero-or-more)
4415 (let* ((width (ebnf-node-width zero-or-more
))
4416 (node-list (ebnf-node-list zero-or-more
))
4417 (list-entry (ebnf-node-entry node-list
))
4418 (node-sep (ebnf-node-separator zero-or-more
))
4419 (entry (+ list-entry
4422 (- (ebnf-node-height node-sep
)
4423 (ebnf-node-entry node-sep
))
4425 (ps-output (ebnf-format-float entry
4426 (+ (- (ebnf-node-height node-list
)
4428 ebnf-vertical-space
)
4431 (ebnf-node-generation (ebnf-node-list zero-or-more
))
4432 (ebnf-vertical-movement entry
)
4433 (if (ebnf-node-separator zero-or-more
)
4434 (let ((ebnf-direction "L"))
4435 (ebnf-node-generation (ebnf-node-separator zero-or-more
)))
4436 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4437 (ps-output "EOS\n"))
4440 ;; [special width-fun dim-fun entry height width name]
4441 (defun ebnf-generate-special (special)
4442 (ebnf-gen-terminal special
"SP"))
4445 ;; [repeat width-fun dim-fun entry height width times element]
4446 (defun ebnf-generate-repeat (repeat)
4447 (let ((times (ebnf-node-name repeat
))
4448 (element (ebnf-node-separator repeat
)))
4449 (ps-output-string times
)
4452 (ebnf-node-entry repeat
)
4453 (ebnf-node-height repeat
)
4454 (ebnf-node-width repeat
)
4456 (+ (ebnf-node-width element
)
4457 ebnf-space-R ebnf-space-R ebnf-space-R
4458 (* (length times
) ebnf-font-width-R
))
4460 " " ebnf-direction
"RP\n")
4462 (ebnf-node-generation element
)))
4463 (ps-output "EOS\n"))
4466 ;; [except width-fun dim-fun entry height width element element]
4467 (defun ebnf-generate-except (except)
4468 (let* ((element (ebnf-node-list except
))
4469 (exception (ebnf-node-separator except
))
4470 (width (ebnf-node-width element
)))
4471 (ps-output (ebnf-format-float
4473 (ebnf-node-entry except
)
4474 (ebnf-node-height except
)
4475 (ebnf-node-width except
)
4477 ebnf-space-E ebnf-space-E ebnf-space-E
4480 (+ (ebnf-node-width exception
) ebnf-space-E
)
4482 " " ebnf-direction
"EX\n")
4483 (ebnf-node-generation (ebnf-node-list except
))
4485 (ebnf-horizontal-movement (+ width ebnf-space-E
4486 ebnf-font-width-E ebnf-space-E
))
4487 (ebnf-node-generation exception
)))
4488 (ps-output "EOS\n"))
4491 (defun ebnf-gen-terminal (node code
)
4492 (ps-output-string (ebnf-node-name node
))
4493 (ps-output " " (ebnf-format-float (ebnf-node-width node
))
4494 " " ebnf-direction code
4495 (if (ebnf-node-default node
)
4500 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4501 ;; Internal functions
4504 (defun ebnf-directory (fun &optional directory
)
4505 "Process files in DIRECTORY applying function FUN on each file.
4507 If DIRECTORY is nil, it's used `default-directory'.
4509 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
4511 (let ((files (directory-files (or directory default-directory
)
4512 t ebnf-file-suffix-regexp
)))
4514 (set-buffer (find-file-noselect (car files
)))
4516 (setq buffer-backed-up t
) ; Do not back it up.
4517 (save-buffer) ; Just save new version.
4518 (kill-buffer (current-buffer))
4519 (setq files
(cdr files
)))))
4522 (defun ebnf-file (fun file
&optional do-not-kill-buffer-when-done
)
4523 "Process file FILE applying function FUN.
4525 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
4526 killed after process termination."
4527 (set-buffer (find-file-noselect file
))
4529 (or do-not-kill-buffer-when-done
4530 (kill-buffer (current-buffer))))
4533 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4534 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4535 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4536 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4537 (defun ebnf-range-regexp (prefix from to
)
4540 (setq str
(concat str
(char-to-string from
))
4542 (concat prefix str
)))
4545 (defvar ebnf-map-name
4546 (let ((map (make-vector 256 ?\_
)))
4547 (mapcar #'(lambda (char)
4548 (aset map char char
))
4549 (concat "#$%&+-.0123456789=?@~"
4550 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4551 "abcdefghijklmnopqrstuvwxyz"))
4555 (defun ebnf-eps-filename (str)
4556 (let* ((len (length str
))
4558 (new (make-string len ?\
)))
4560 (aset new stri
(aref ebnf-map-name
(aref str stri
)))
4561 (setq stri
(1+ stri
)))
4562 (concat ebnf-eps-prefix new
".eps")))
4565 (defun ebnf-eps-output (&rest args
)
4568 (setq args
(cdr args
))))
4571 (defun ebnf-generate-region (from to gen-func
)
4572 (run-hooks 'ebnf-hook
)
4573 (let ((ebnf-limit (max from to
))
4574 (error-msg "SYNTAX")
4579 (condition-case data
4580 (let ((tree (ebnf-parse-and-sort (min from to
))))
4582 (setq error-msg
"EMPTY RULES"
4583 tree
(ebnf-eliminate-empty-rules tree
))
4584 (setq error-msg
"OPTMIZE"
4585 tree
(ebnf-optimize tree
))
4586 (setq error-msg
"DIMENSIONS"
4587 tree
(ebnf-dimensions tree
))
4588 (setq error-msg
"GENERATION")
4589 (funcall gen-func tree
))
4590 (setq error-msg nil
)) ; here it's ok
4594 (setq the-point
(max (1- (point)) (point-min))
4595 error-msg
(concat error-msg
": "
4596 (error-message-string data
)
4598 (and (string= error-msg
"SYNTAX")
4599 (format "at position %d "
4601 (format "in buffer \"%s\"."
4602 (buffer-name)))))))))
4606 (goto-char the-point
)
4607 (if ebnf-stop-on-error
4609 (message error-msg
)))
4610 ;; generated output OK
4613 ;; syntax checked OK
4615 (message "EBNF syntactic analysis: NO ERRORS.")))))
4618 (defun ebnf-parse-and-sort (start)
4620 (let ((tree (funcall ebnf-parser-func start
)))
4621 (if ebnf-sort-production
4623 (message "Sorting...")
4625 (if (eq ebnf-sort-production
'ascending
)
4626 'ebnf-sorter-ascending
4627 'ebnf-sorter-descending
)))
4631 (defun ebnf-sorter-ascending (first second
)
4632 (string< (ebnf-node-name first
)
4633 (ebnf-node-name second
)))
4636 (defun ebnf-sorter-descending (first second
)
4637 (string< (ebnf-node-name second
)
4638 (ebnf-node-name first
)))
4641 (defun ebnf-empty-alternative (width)
4642 (ps-output (ebnf-format-float width
) " EA\n"))
4645 (defun ebnf-vertical-movement (height)
4646 (ps-output (ebnf-format-float height
) " vm\n"))
4649 (defun ebnf-horizontal-movement (width)
4650 (ps-output (ebnf-format-float width
) " hm\n"))
4653 (defun ebnf-entry (height)
4654 (* height ebnf-entry-percentage
))
4657 (defun ebnf-eop-vertical (height)
4658 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space
))
4662 (defun ebnf-eop-horizontal (width)
4663 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space
))
4667 (defun ebnf-new-page ()
4668 (when (< ps-height-remaining ps-print-height
)
4669 (run-hooks 'ebnf-page-hook
)
4674 (defsubst ebnf-font-size
(font) (nth 0 font
))
4675 (defsubst ebnf-font-name
(font) (nth 1 font
))
4676 (defsubst ebnf-font-foreground
(font) (nth 2 font
))
4677 (defsubst ebnf-font-background
(font) (nth 3 font
))
4678 (defsubst ebnf-font-list
(font) (nthcdr 4 font
))
4679 (defsubst ebnf-font-attributes
(font)
4680 (lsh (ps-extension-bit (cdr font
)) -
2))
4683 (defconst ebnf-font-name-select
4684 (vector 'normal
'bold
'italic
'bold-italic
))
4687 (defun ebnf-font-name-select (font)
4688 (let* ((font-list (ebnf-font-list font
))
4689 (font-index (+ (if (memq 'bold font-list
) 1 0)
4690 (if (memq 'italic font-list
) 2 0)))
4691 (name (ebnf-font-name font
))
4692 (database (cdr (assoc name ps-font-info-database
)))
4693 (info-list (or (cdr (assoc 'fonts database
))
4694 (error "Invalid font: %s" name
))))
4695 (or (cdr (assoc (aref ebnf-font-name-select font-index
)
4697 (error "Invalid attributes for font %s" name
))))
4700 (defun ebnf-font-select (font select
)
4701 (let* ((name (ebnf-font-name font
))
4702 (database (cdr (assoc name ps-font-info-database
)))
4703 (size (cdr (assoc 'size database
)))
4704 (base (cdr (assoc select database
))))
4706 (/ (* (ebnf-font-size font
) base
)
4708 (error "Invalid font: %s" name
))))
4711 (defsubst ebnf-font-width
(font)
4712 (ebnf-font-select font
'avg-char-width
))
4713 (defsubst ebnf-font-height
(font)
4714 (ebnf-font-select font
'line-height
))
4717 (defconst ebnf-syntax-alist
4718 ;; 0.syntax 1.parser 2.initializer
4719 '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize
)
4720 (yacc ebnf-yac-parser ebnf-yac-initialize
)
4721 (abnf ebnf-abn-parser ebnf-abn-initialize
)
4722 (ebnf ebnf-bnf-parser ebnf-bnf-initialize
)
4723 (ebnfx ebnf-ebx-parser ebnf-ebx-initialize
)
4724 (dtd ebnf-dtd-parser ebnf-dtd-initialize
))
4725 "Alist associating ebnf syntax with a parser and a initializer.")
4728 (defun ebnf-begin-job ()
4729 (ps-printing-region nil nil nil
)
4730 (if ebnf-use-float-format
4731 (setq ebnf-format-float
"%1.3f"
4732 ebnf-message-float
"%3.2f")
4733 (setq ebnf-format-float
"%s"
4734 ebnf-message-float
"%s"))
4735 (ebnf-otz-initialize)
4736 ;; to avoid compilation gripes when calling autoloaded functions
4737 (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist
)
4738 (assoc 'ebnf ebnf-syntax-alist
))))
4739 (setq ebnf-parser-func
(nth 1 init
))
4740 (funcall (nth 2 init
)))
4741 (and ebnf-terminal-regexp
; ensures that it's a string or nil
4742 (not (stringp ebnf-terminal-regexp
))
4743 (setq ebnf-terminal-regexp nil
))
4744 (or (and ebnf-eps-prefix
; ensures that it's a string
4745 (stringp ebnf-eps-prefix
))
4746 (setq ebnf-eps-prefix
"ebnf--"))
4747 (setq ebnf-entry-percentage
; ensures value between 0.0 and 1.0
4748 (min (max ebnf-entry-percentage
0.0) 1.0)
4749 ebnf-action-list
(if ebnf-horizontal-orientation
4753 ebnf-fonts-required nil
4756 ebnf-eps-context nil
4757 ebnf-eps-production-list nil
4758 ebnf-eps-upper-x
0.0
4759 ebnf-eps-upper-y
0.0
4760 ebnf-font-height-P
(ebnf-font-height ebnf-production-font
)
4761 ebnf-font-height-T
(ebnf-font-height ebnf-terminal-font
)
4762 ebnf-font-height-NT
(ebnf-font-height ebnf-non-terminal-font
)
4763 ebnf-font-height-S
(ebnf-font-height ebnf-special-font
)
4764 ebnf-font-height-E
(ebnf-font-height ebnf-except-font
)
4765 ebnf-font-height-R
(ebnf-font-height ebnf-repeat-font
)
4766 ebnf-font-width-P
(ebnf-font-width ebnf-production-font
)
4767 ebnf-font-width-T
(ebnf-font-width ebnf-terminal-font
)
4768 ebnf-font-width-NT
(ebnf-font-width ebnf-non-terminal-font
)
4769 ebnf-font-width-S
(ebnf-font-width ebnf-special-font
)
4770 ebnf-font-width-E
(ebnf-font-width ebnf-except-font
)
4771 ebnf-font-width-R
(ebnf-font-width ebnf-repeat-font
)
4772 ebnf-space-T
(* ebnf-font-height-T
0.5)
4773 ebnf-space-NT
(* ebnf-font-height-NT
0.5)
4774 ebnf-space-S
(* ebnf-font-height-S
0.5)
4775 ebnf-space-E
(* ebnf-font-height-E
0.5)
4776 ebnf-space-R
(* ebnf-font-height-R
0.5))
4777 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT
)))
4778 (setq ebnf-basic-width
(* basic
0.5)
4779 ebnf-horizontal-space
(+ basic basic
)
4780 ebnf-basic-height ebnf-basic-width
4781 ebnf-vertical-space ebnf-basic-width
)
4782 ;; ensures value is greater than zero
4783 (or (and (numberp ebnf-production-horizontal-space
)
4784 (> ebnf-production-horizontal-space
0.0))
4785 (setq ebnf-production-horizontal-space basic
))
4786 ;; ensures value is greater than zero
4787 (or (and (numberp ebnf-production-vertical-space
)
4788 (> ebnf-production-vertical-space
0.0))
4789 (setq ebnf-production-vertical-space basic
))))
4792 (defsubst ebnf-shape-value
(sym alist
)
4793 (or (cdr (assq sym alist
)) 0))
4796 (defsubst ebnf-boolean
(value)
4797 (if value
"true" "false"))
4800 (defun ebnf-begin-file ()
4803 (set-buffer ps-spool-buffer
)
4804 (goto-char (point-min))
4805 (and (search-forward "%%Creator: " nil t
)
4806 (not (search-forward "& ebnf2ps v"
4807 (save-excursion (end-of-line) (point))
4810 ;; adjust creator comment
4813 (insert " & ebnf2ps v" ebnf-version
)
4814 ;; insert ebnf settings & engine
4815 (goto-char (point-max))
4816 (search-backward "\n%%EndProlog\n")
4817 (ebnf-insert-ebnf-prologue)
4818 (ps-output "\n")))))
4821 (defun ebnf-eps-finish-and-write (buffer filename
)
4822 (when (buffer-modified-p buffer
)
4825 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4826 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4829 ebnf-production-vertical-space
4830 ebnf-eps-max-height
)))
4832 (goto-char (point-min))
4834 "%!PS-Adobe-3.0 EPSF-3.0"
4835 "\n%%BoundingBox: 0 0 "
4836 (format "%d %d" (1+ ebnf-eps-upper-x
) (1+ ebnf-eps-upper-y
))
4837 "\n%%Title: " filename
4838 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4839 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version
")"
4840 "\n%%DocumentNeededResources: font "
4841 (or ebnf-fonts-required
4842 (setq ebnf-fonts-required
4843 (mapconcat 'identity
4844 (ps-remove-duplicates
4845 (mapcar 'ebnf-font-name-select
4846 (list ebnf-production-font
4848 ebnf-non-terminal-font
4853 "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
4855 (ebnf-insert-ebnf-prologue)
4856 (insert ebnf-eps-begin
4857 "\n0 " (ebnf-format-float
4858 (- ebnf-eps-upper-y
(* ebnf-font-height-P
0.7)))
4859 " #ebnf2ps#begin\n")
4861 (goto-char (point-max))
4862 (insert ebnf-eps-end
)
4864 (message "Saving...")
4865 (setq filename
(expand-file-name filename
))
4866 (let ((coding-system-for-write 'raw-text-unix
))
4867 (write-region (point-min) (point-max) filename
))
4868 (message "Wrote %s" filename
))))
4871 (defun ebnf-insert-ebnf-prologue ()
4876 "\n\n% === begin EBNF settings\n\n"
4878 (format "/fP %s /%s DefFont\n"
4879 (ebnf-format-float (ebnf-font-size ebnf-production-font
))
4880 (ebnf-font-name-select ebnf-production-font
))
4881 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4882 (ebnf-font-foreground ebnf-production-font
)
4884 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4885 (ebnf-font-background ebnf-production-font
)
4887 (format "/EffectP %d def\n"
4888 (ebnf-font-attributes ebnf-production-font
))
4890 (format "/fT %s /%s DefFont\n"
4891 (ebnf-format-float (ebnf-font-size ebnf-terminal-font
))
4892 (ebnf-font-name-select ebnf-terminal-font
))
4893 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4894 (ebnf-font-foreground ebnf-terminal-font
)
4896 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4897 (ebnf-font-background ebnf-terminal-font
)
4899 (format "/EffectT %d def\n"
4900 (ebnf-font-attributes ebnf-terminal-font
))
4901 (format "/BorderWidthT %s def\n"
4902 (ebnf-format-float ebnf-terminal-border-width
))
4903 (ebnf-format-color "/BorderColorT %s def %% %s\n"
4904 ebnf-terminal-border-color
4906 (format "/ShapeT %d def\n"
4907 (ebnf-shape-value ebnf-terminal-shape
4908 ebnf-terminal-shape-alist
))
4909 (format "/ShadowT %s def\n"
4910 (ebnf-boolean ebnf-terminal-shadow
))
4912 (format "/fNT %s /%s DefFont\n"
4914 (ebnf-font-size ebnf-non-terminal-font
))
4915 (ebnf-font-name-select ebnf-non-terminal-font
))
4916 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
4917 (ebnf-font-foreground ebnf-non-terminal-font
)
4919 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
4920 (ebnf-font-background ebnf-non-terminal-font
)
4922 (format "/EffectNT %d def\n"
4923 (ebnf-font-attributes ebnf-non-terminal-font
))
4924 (format "/BorderWidthNT %s def\n"
4925 (ebnf-format-float ebnf-non-terminal-border-width
))
4926 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
4927 ebnf-non-terminal-border-color
4929 (format "/ShapeNT %d def\n"
4930 (ebnf-shape-value ebnf-non-terminal-shape
4931 ebnf-terminal-shape-alist
))
4932 (format "/ShadowNT %s def\n"
4933 (ebnf-boolean ebnf-non-terminal-shadow
))
4935 (format "/fS %s /%s DefFont\n"
4936 (ebnf-format-float (ebnf-font-size ebnf-special-font
))
4937 (ebnf-font-name-select ebnf-special-font
))
4938 (ebnf-format-color "/ForegroundS %s def %% %s\n"
4939 (ebnf-font-foreground ebnf-special-font
)
4941 (ebnf-format-color "/BackgroundS %s def %% %s\n"
4942 (ebnf-font-background ebnf-special-font
)
4944 (format "/EffectS %d def\n"
4945 (ebnf-font-attributes ebnf-special-font
))
4946 (format "/BorderWidthS %s def\n"
4947 (ebnf-format-float ebnf-special-border-width
))
4948 (ebnf-format-color "/BorderColorS %s def %% %s\n"
4949 ebnf-special-border-color
4951 (format "/ShapeS %d def\n"
4952 (ebnf-shape-value ebnf-special-shape
4953 ebnf-terminal-shape-alist
))
4954 (format "/ShadowS %s def\n"
4955 (ebnf-boolean ebnf-special-shadow
))
4957 (format "/fE %s /%s DefFont\n"
4958 (ebnf-format-float (ebnf-font-size ebnf-except-font
))
4959 (ebnf-font-name-select ebnf-except-font
))
4960 (ebnf-format-color "/ForegroundE %s def %% %s\n"
4961 (ebnf-font-foreground ebnf-except-font
)
4963 (ebnf-format-color "/BackgroundE %s def %% %s\n"
4964 (ebnf-font-background ebnf-except-font
)
4966 (format "/EffectE %d def\n"
4967 (ebnf-font-attributes ebnf-except-font
))
4968 (format "/BorderWidthE %s def\n"
4969 (ebnf-format-float ebnf-except-border-width
))
4970 (ebnf-format-color "/BorderColorE %s def %% %s\n"
4971 ebnf-except-border-color
4973 (format "/ShapeE %d def\n"
4974 (ebnf-shape-value ebnf-except-shape
4975 ebnf-terminal-shape-alist
))
4976 (format "/ShadowE %s def\n"
4977 (ebnf-boolean ebnf-except-shadow
))
4979 (format "/fR %s /%s DefFont\n"
4980 (ebnf-format-float (ebnf-font-size ebnf-repeat-font
))
4981 (ebnf-font-name-select ebnf-repeat-font
))
4982 (ebnf-format-color "/ForegroundR %s def %% %s\n"
4983 (ebnf-font-foreground ebnf-repeat-font
)
4985 (ebnf-format-color "/BackgroundR %s def %% %s\n"
4986 (ebnf-font-background ebnf-repeat-font
)
4988 (format "/EffectR %d def\n"
4989 (ebnf-font-attributes ebnf-repeat-font
))
4990 (format "/BorderWidthR %s def\n"
4991 (ebnf-format-float ebnf-repeat-border-width
))
4992 (ebnf-format-color "/BorderColorR %s def %% %s\n"
4993 ebnf-repeat-border-color
4995 (format "/ShapeR %d def\n"
4996 (ebnf-shape-value ebnf-repeat-shape
4997 ebnf-terminal-shape-alist
))
4998 (format "/ShadowR %s def\n"
4999 (ebnf-boolean ebnf-repeat-shadow
))
5001 (format "/DefaultWidth %s def\n"
5002 (ebnf-format-float ebnf-default-width
))
5003 (format "/LineWidth %s def\n"
5004 (ebnf-format-float ebnf-line-width
))
5005 (ebnf-format-color "/LineColor %s def %% %s\n"
5008 (format "/ArrowShape %d def\n"
5009 (ebnf-shape-value ebnf-arrow-shape
5010 ebnf-arrow-shape-alist
))
5011 (format "/ChartShape %d def\n"
5012 (ebnf-shape-value ebnf-chart-shape
5013 ebnf-terminal-shape-alist
))
5014 (format "/UserArrow{%s}def\n"
5015 (let ((arrow (eval ebnf-user-arrow
)))
5019 "\n% === end EBNF settings\n\n"
5020 (and ebnf-debug-ps ebnf-debug
))))
5024 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5025 ;; Adjusting dimensions
5028 (defun ebnf-dimensions (tree)
5029 (let ((ebnf-total (length tree
))
5031 (mapcar 'ebnf-production-dimension tree
))
5035 ;; [empty width-fun dim-fun entry height width]
5036 ;;(defun ebnf-empty-dimension (empty)
5040 ;; [production width-fun dim-fun entry height width name production action]
5041 (defun ebnf-production-dimension (production)
5042 (ebnf-message-info "Calculating dimensions")
5043 (ebnf-node-dimension-func (ebnf-node-production production
))
5044 (let* ((prod (ebnf-node-production production
))
5045 (height (+ (if ebnf-production-name-p
5048 ebnf-line-width ebnf-line-width
5050 (ebnf-node-height prod
))))
5051 (ebnf-node-entry production height
)
5052 (ebnf-node-height production height
)
5053 (ebnf-node-width production
(+ (ebnf-node-width prod
)
5055 ebnf-horizontal-space
))))
5058 ;; [terminal width-fun dim-fun entry height width name]
5059 (defun ebnf-terminal-dimension (terminal)
5060 (ebnf-terminal-dimension1 terminal
5066 ;; [non-terminal width-fun dim-fun entry height width name]
5067 (defun ebnf-non-terminal-dimension (non-terminal)
5068 (ebnf-terminal-dimension1 non-terminal
5074 ;; [special width-fun dim-fun entry height width name]
5075 (defun ebnf-special-dimension (special)
5076 (ebnf-terminal-dimension1 special
5082 (defun ebnf-terminal-dimension1 (node font-height font-width space
)
5083 (let ((height (+ space font-height space
))
5084 (len (length (ebnf-node-name node
))))
5085 (ebnf-node-entry node
(* height
0.5))
5086 (ebnf-node-height node height
)
5087 (ebnf-node-width node
(+ ebnf-basic-width space
5089 space ebnf-basic-width
))))
5092 (defconst ebnf-null-vector
(vector t t t
0.0 0.0 0.0))
5095 ;; [repeat width-fun dim-fun entry height width times element]
5096 (defun ebnf-repeat-dimension (repeat)
5097 (let ((times (ebnf-node-name repeat
))
5098 (element (ebnf-node-separator repeat
)))
5100 (ebnf-node-dimension-func element
)
5101 (setq element ebnf-null-vector
))
5102 (ebnf-node-entry repeat
(+ (ebnf-node-entry element
)
5104 (ebnf-node-height repeat
(+ (max (ebnf-node-height element
)
5106 ebnf-space-R ebnf-space-R
))
5107 (ebnf-node-width repeat
(+ (ebnf-node-width element
)
5108 ebnf-space-R ebnf-space-R ebnf-space-R
5109 ebnf-horizontal-space
5110 (* (length times
) ebnf-font-width-R
)))))
5113 ;; [except width-fun dim-fun entry height width element element]
5114 (defun ebnf-except-dimension (except)
5115 (let ((factor (ebnf-node-list except
))
5116 (element (ebnf-node-separator except
)))
5117 (ebnf-node-dimension-func factor
)
5119 (ebnf-node-dimension-func element
)
5120 (setq element ebnf-null-vector
))
5121 (ebnf-node-entry except
(+ (max (ebnf-node-entry factor
)
5122 (ebnf-node-entry element
))
5124 (ebnf-node-height except
(+ (max (ebnf-node-height factor
)
5125 (ebnf-node-height element
))
5126 ebnf-space-E ebnf-space-E
))
5127 (ebnf-node-width except
(+ (ebnf-node-width factor
)
5128 (ebnf-node-width element
)
5129 ebnf-space-E ebnf-space-E
5130 ebnf-space-E ebnf-space-E
5132 ebnf-horizontal-space
))))
5135 ;; [alternative width-fun dim-fun entry height width list]
5136 (defun ebnf-alternative-dimension (alternative)
5137 (let ((body (ebnf-node-list alternative
))
5138 (lis (ebnf-node-list alternative
)))
5140 (ebnf-node-dimension-func (car lis
))
5141 (setq lis
(cdr lis
)))
5145 (tail (car (last body
)))
5146 (entry (ebnf-node-entry (car body
)))
5149 (setq node
(car alt
)
5151 height
(+ (ebnf-node-height node
) height
)
5152 width
(max (ebnf-node-width node
) width
)))
5153 (ebnf-adjust-width body width
)
5154 (setq height
(+ height
(* (1- (length body
)) ebnf-vertical-space
)))
5155 (ebnf-node-entry alternative
(+ entry
5158 (- (ebnf-node-height tail
)
5159 (ebnf-node-entry tail
))))))
5160 (ebnf-node-height alternative height
)
5161 (ebnf-node-width alternative
(+ width ebnf-horizontal-space
))
5162 (ebnf-node-list alternative body
))))
5165 ;; [optional width-fun dim-fun entry height width element]
5166 (defun ebnf-optional-dimension (optional)
5167 (let ((body (ebnf-node-list optional
)))
5168 (ebnf-node-dimension-func body
)
5169 (ebnf-node-entry optional
(ebnf-node-entry body
))
5170 (ebnf-node-height optional
(+ (ebnf-node-height body
)
5171 ebnf-vertical-space
))
5172 (ebnf-node-width optional
(+ (ebnf-node-width body
)
5173 ebnf-horizontal-space
))))
5176 ;; [one-or-more width-fun dim-fun entry height width element separator]
5177 (defun ebnf-one-or-more-dimension (or-more)
5178 (let ((list-part (ebnf-node-list or-more
))
5179 (sep-part (ebnf-node-separator or-more
)))
5180 (ebnf-node-dimension-func list-part
)
5182 (ebnf-node-dimension-func sep-part
))
5183 (let ((height (+ (if sep-part
5184 (ebnf-node-height sep-part
)
5187 (ebnf-node-height list-part
)))
5188 (width (max (if sep-part
5189 (ebnf-node-width sep-part
)
5191 (ebnf-node-width list-part
))))
5193 (ebnf-adjust-width list-part width
)
5194 (ebnf-adjust-width sep-part width
))
5195 (ebnf-node-entry or-more
(+ (- height
(ebnf-node-height list-part
))
5196 (ebnf-node-entry list-part
)))
5197 (ebnf-node-height or-more height
)
5198 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
5201 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5202 (defun ebnf-zero-or-more-dimension (or-more)
5203 (let ((list-part (ebnf-node-list or-more
))
5204 (sep-part (ebnf-node-separator or-more
)))
5205 (ebnf-node-dimension-func list-part
)
5207 (ebnf-node-dimension-func sep-part
))
5208 (let ((height (+ (if sep-part
5209 (ebnf-node-height sep-part
)
5212 (ebnf-node-height list-part
)
5213 ebnf-vertical-space
))
5214 (width (max (if sep-part
5215 (ebnf-node-width sep-part
)
5217 (ebnf-node-width list-part
))))
5219 (ebnf-adjust-width list-part width
)
5220 (ebnf-adjust-width sep-part width
))
5221 (ebnf-node-entry or-more height
)
5222 (ebnf-node-height or-more height
)
5223 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
5226 ;; [sequence width-fun dim-fun entry height width list]
5227 (defun ebnf-sequence-dimension (sequence)
5231 (lis (ebnf-node-list sequence
))
5234 (setq node
(car lis
)
5236 (ebnf-node-dimension-func node
)
5237 (setq entry
(ebnf-node-entry node
)
5238 above
(max above entry
)
5239 below
(max below
(- (ebnf-node-height node
) entry
))
5240 width
(+ width
(ebnf-node-width node
))))
5241 (ebnf-node-entry sequence above
)
5242 (ebnf-node-height sequence
(+ above below
))
5243 (ebnf-node-width sequence width
)))
5246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5250 (defun ebnf-adjust-width (node width
)
5256 (setcar node
(ebnf-adjust-width (car node
) width
))
5257 (setq node
(cdr node
)))))
5260 ;; nothing to be done
5261 ((= width
(ebnf-node-width node
))
5263 ;; left justify term
5264 ((eq ebnf-justify-sequence
'left
)
5265 (ebnf-adjust-empty node width nil
))
5266 ;; right justify terms
5267 ((eq ebnf-justify-sequence
'right
)
5268 (ebnf-adjust-empty node width t
))
5271 (ebnf-node-width-func node width
)
5272 (ebnf-node-width node width
)
5280 (defun ebnf-adjust-empty (node width last-p
)
5281 (if (eq (ebnf-node-kind node
) 'ebnf-generate-empty
)
5283 (ebnf-node-width node width
)
5285 (let ((empty (ebnf-make-empty (- width
(ebnf-node-width node
)))))
5286 (ebnf-make-dup-sequence node
5289 (list node empty
))))))
5292 ;; [terminal width-fun dim-fun entry height width name]
5293 ;; [non-terminal width-fun dim-fun entry height width name]
5294 ;; [empty width-fun dim-fun entry height width]
5295 ;; [special width-fun dim-fun entry height width name]
5296 ;; [repeat width-fun dim-fun entry height width times element]
5297 ;; [except width-fun dim-fun entry height width element element]
5298 ;;(defun ebnf-terminal-width (terminal width)
5302 ;; [alternative width-fun dim-fun entry height width list]
5303 ;; [optional width-fun dim-fun entry height width element]
5304 (defun ebnf-alternative-width (alternative width
)
5305 (ebnf-adjust-width (ebnf-node-list alternative
)
5306 (- width ebnf-horizontal-space
)))
5309 ;; [one-or-more width-fun dim-fun entry height width element separator]
5310 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5311 (defun ebnf-element-width (or-more width
)
5312 (setq width
(- width ebnf-horizontal-space
))
5313 (ebnf-node-list or-more
5314 (ebnf-justify-list or-more
5315 (ebnf-node-list or-more
)
5317 (ebnf-node-separator or-more
5318 (ebnf-justify-list or-more
5319 (ebnf-node-separator or-more
)
5323 ;; [sequence width-fun dim-fun entry height width list]
5324 (defun ebnf-sequence-width (sequence width
)
5325 (ebnf-node-list sequence
5326 (ebnf-justify-list sequence
5327 (ebnf-node-list sequence
)
5331 (defun ebnf-justify-list (node seq width
)
5332 (let ((seq-width (ebnf-node-width node
)))
5333 (if (= width seq-width
)
5336 ;; left justify terms
5337 ((eq ebnf-justify-sequence
'left
)
5338 (ebnf-justify node seq seq-width width t
))
5339 ;; right justify terms
5340 ((eq ebnf-justify-sequence
'right
)
5341 (ebnf-justify node seq seq-width width nil
))
5342 ;; centralize terms -- element
5344 (ebnf-adjust-width seq width
))
5345 ;; centralize terms -- list
5347 (let ((the-width (/ (- width seq-width
) (length seq
)))
5350 (ebnf-adjust-width (car lis
)
5351 (+ (ebnf-node-width (car lis
))
5353 (setq lis
(cdr lis
)))
5358 (defun ebnf-justify (node seq seq-width width last-p
)
5359 (let ((term (car (if last-p
(last seq
) seq
))))
5361 ;; adjust empty term
5362 ((eq (ebnf-node-kind term
) 'ebnf-generate-empty
)
5363 (ebnf-node-width term
(+ (- width seq-width
)
5364 (ebnf-node-width term
)))
5366 ;; insert empty at end ==> left justify
5369 (list (ebnf-make-empty (- width seq-width
)))))
5370 ;; insert empty at beginning ==> right justify
5372 (cons (ebnf-make-empty (- width seq-width
))
5377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5378 ;; Functions used by parsers
5381 (defun ebnf-eps-add-context (name)
5382 (let ((filename (ebnf-eps-filename name
)))
5383 (if (member filename ebnf-eps-context
)
5384 (error "Try to open an already opened EPS file: %s" filename
)
5385 (setq ebnf-eps-context
(cons filename ebnf-eps-context
)))))
5388 (defun ebnf-eps-remove-context (name)
5389 (let ((filename (ebnf-eps-filename name
)))
5390 (if (member filename ebnf-eps-context
)
5391 (setq ebnf-eps-context
(delete filename ebnf-eps-context
))
5392 (error "Try to close a not opened EPS file: %s" filename
))))
5395 (defun ebnf-eps-add-production (header)
5396 (and ebnf-eps-executing
5398 (let ((prod (assoc header ebnf-eps-production-list
)))
5400 (setcdr prod
(append ebnf-eps-context
(cdr prod
)))
5401 (setq ebnf-eps-production-list
5402 (cons (cons header
(ebnf-dup-list ebnf-eps-context
))
5403 ebnf-eps-production-list
))))))
5406 (defun ebnf-dup-list (old)
5409 (setq new
(cons (car old
) new
)
5414 (defun ebnf-buffer-substring (chars)
5415 (buffer-substring-no-properties
5418 (skip-chars-forward chars ebnf-limit
)
5422 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
5423 (defconst ebnf-8-bit-chars
(ebnf-range-regexp "" ?
\240 ?
\377))
5426 (defun ebnf-string (chars eos-char kind
)
5428 (buffer-substring-no-properties
5431 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5432 (skip-chars-forward (concat chars ebnf-8-bit-chars
) ebnf-limit
)
5433 (if (or (eobp) (/= (following-char) eos-char
))
5434 (error "Illegal %s: missing `%c'" kind eos-char
)
5439 (defun ebnf-get-string ()
5441 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5444 (defun ebnf-end-of-string ()
5446 (while (> (logand n
1) 0)
5447 (skip-chars-forward "^\"" ebnf-limit
)
5448 (setq n
(- (skip-chars-backward "\\\\")))
5449 (goto-char (+ (point) n
1))))
5450 (if (= (preceding-char) ?
\")
5452 (error "Missing `\"'")))
5455 (defun ebnf-trim-right (str)
5456 (let* ((len (1- (length str
)))
5458 (while (and (> index
0) (= (aref str index
) ?\
))
5459 (setq index
(1- index
)))
5462 (substring str
0 (1+ index
)))))
5465 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5469 (defun ebnf-make-empty (&optional width
)
5470 (vector 'ebnf-generate-empty
5475 (or width ebnf-horizontal-space
)))
5478 (defun ebnf-make-terminal (name)
5479 (ebnf-make-terminal1 name
5480 'ebnf-generate-terminal
5481 'ebnf-terminal-dimension
))
5484 (defun ebnf-make-non-terminal (name)
5485 (ebnf-make-terminal1 name
5486 'ebnf-generate-non-terminal
5487 'ebnf-non-terminal-dimension
))
5490 (defun ebnf-make-special (name)
5491 (ebnf-make-terminal1 name
5492 'ebnf-generate-special
5493 'ebnf-special-dimension
))
5496 (defun ebnf-make-terminal1 (name gen-func dim-func
)
5503 (let ((len (length name
)))
5504 (cond ((> len
3) name
)
5505 ((= len
3) (concat name
" "))
5506 ((= len
2) (concat " " name
" "))
5507 ((= len
1) (concat " " name
" "))
5512 (defun ebnf-make-one-or-more (list-part &optional sep-part
)
5513 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5514 'ebnf-one-or-more-dimension
5519 (defun ebnf-make-zero-or-more (list-part &optional sep-part
)
5520 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5521 'ebnf-zero-or-more-dimension
5526 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part
)
5533 (if (listp list-part
)
5534 (ebnf-make-sequence list-part
)
5536 (if (and sep-part
(listp sep-part
))
5537 (ebnf-make-sequence sep-part
)
5541 (defun ebnf-make-production (name prod action
)
5542 (vector 'ebnf-generate-production
5544 'ebnf-production-dimension
5553 (defun ebnf-make-alternative (body)
5554 (vector 'ebnf-generate-alternative
5555 'ebnf-alternative-width
5556 'ebnf-alternative-dimension
5563 (defun ebnf-make-optional (body)
5564 (vector 'ebnf-generate-optional
5565 'ebnf-alternative-width
5566 'ebnf-optional-dimension
5573 (defun ebnf-make-except (factor exception
)
5574 (vector 'ebnf-generate-except
5576 'ebnf-except-dimension
5584 (defun ebnf-make-repeat (times primary
&optional upper
)
5585 (vector 'ebnf-generate-repeat
5587 'ebnf-repeat-dimension
5591 (cond ((and times upper
) ; L * U, L * L
5592 (if (string= times upper
)
5593 (if (string= times
"")
5596 (concat times
" * " upper
)))
5598 (concat times
" *"))
5600 (concat "* " upper
))
5606 (defun ebnf-make-sequence (seq)
5607 (vector 'ebnf-generate-sequence
5608 'ebnf-sequence-width
5609 'ebnf-sequence-dimension
5616 (defun ebnf-make-dup-sequence (node seq
)
5617 (vector 'ebnf-generate-sequence
5618 'ebnf-sequence-width
5619 'ebnf-sequence-dimension
5620 (ebnf-node-entry node
)
5621 (ebnf-node-height node
)
5622 (ebnf-node-width node
)
5626 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5627 ;; Optimizers used by parsers
5630 (defun ebnf-token-except (element exception
)
5633 (setq exception
(cdr exception
)))
5634 (and element
; EMPTY - A ==> EMPTY
5635 (let ((kind (ebnf-node-kind element
)))
5638 ((and (null exception
)
5639 (eq kind
'ebnf-generate-optional
))
5640 (ebnf-node-list element
))
5641 ;; { A }- ==> { A }+
5642 ((and (null exception
)
5643 (eq kind
'ebnf-generate-zero-or-more
))
5644 (ebnf-node-kind element
'ebnf-generate-one-or-more
)
5645 (ebnf-node-dimension-func element
'ebnf-one-or-more-dimension
)
5647 ;; ( A | EMPTY )- ==> A
5648 ;; ( A | B | EMPTY )- ==> A | B
5649 ((and (null exception
)
5650 (eq kind
'ebnf-generate-alternative
)
5652 (car (last (ebnf-node-list element
))))
5653 'ebnf-generate-empty
))
5654 (let ((elt (ebnf-node-list element
))
5660 ;; this should not happen!!?!
5661 (setq element
(ebnf-make-empty
5662 (ebnf-node-width element
)))
5664 (setq elt
(ebnf-node-list element
))
5665 (and (= (length elt
) 1)
5666 (setq element
(car elt
))))
5670 (ebnf-make-except element exception
))
5674 (defun ebnf-token-repeat (times repeat
&optional upper
)
5675 (if (null (cdr repeat
))
5676 ;; n * EMPTY ==> EMPTY
5680 (ebnf-make-repeat times
(cdr repeat
) upper
))))
5683 (defun ebnf-token-optional (body)
5684 (let ((kind (ebnf-node-kind body
)))
5686 ;; [ EMPTY ] ==> EMPTY
5687 ((eq kind
'ebnf-generate-empty
)
5689 ;; [ { A }* ] ==> { A }*
5690 ((eq kind
'ebnf-generate-zero-or-more
)
5692 ;; [ { A }+ ] ==> { A }*
5693 ((eq kind
'ebnf-generate-one-or-more
)
5694 (ebnf-node-kind body
'ebnf-generate-zero-or-more
)
5696 ;; [ A | B ] ==> A | B | EMPTY
5697 ((eq kind
'ebnf-generate-alternative
)
5698 (ebnf-node-list body
(nconc (ebnf-node-list body
)
5699 (list (ebnf-make-empty))))
5703 (ebnf-make-optional body
))
5707 (defun ebnf-token-alternative (body sequence
)
5711 (cons (car sequence
)
5713 (cons (car sequence
)
5714 (let ((seq (cdr sequence
)))
5715 (if (and (= (length body
) 1) (null seq
))
5717 (ebnf-make-alternative (nreverse (if seq
5722 (defun ebnf-token-sequence (sequence)
5727 ;; sequence with only one element
5728 ((= (length sequence
) 1)
5732 (ebnf-make-sequence (nreverse sequence
)))
5736 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5737 ;; Variables used by parsers
5740 (defconst ebnf-comment-table
5741 (let ((table (make-vector 256 nil
)))
5742 ;; Override special comment character:
5743 (aset table ?
< 'newline
)
5744 (aset table ?
> 'keep-line
)
5745 (aset table ?^
'form-feed
)
5747 "Vector used to map characters to a special comment token.")
5750 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5751 ;; To make this file smaller, some commands go in a separate file.
5752 ;; But autoload them here to make the separation invisible.
5754 (autoload 'ebnf-abn-parser
"ebnf-abn"
5757 (autoload 'ebnf-abn-initialize
"ebnf-abn"
5758 "Initialize ABNF token table.")
5760 (autoload 'ebnf-bnf-parser
"ebnf-bnf"
5763 (autoload 'ebnf-bnf-initialize
"ebnf-bnf"
5764 "Initialize EBNF token table.")
5766 (autoload 'ebnf-iso-parser
"ebnf-iso"
5769 (autoload 'ebnf-iso-initialize
"ebnf-iso"
5770 "Initialize ISO EBNF token table.")
5772 (autoload 'ebnf-yac-parser
"ebnf-yac"
5773 "Yacc/Bison parser.")
5775 (autoload 'ebnf-yac-initialize
"ebnf-yac"
5776 "Initializations for Yacc/Bison parser.")
5778 (autoload 'ebnf-ebx-parser
"ebnf-ebx"
5781 (autoload 'ebnf-ebx-initialize
"ebnf-ebx"
5782 "Initializations for EBNFX parser.")
5784 (autoload 'ebnf-dtd-parser
"ebnf-dtd"
5787 (autoload 'ebnf-dtd-initialize
"ebnf-dtd"
5788 "Initializations for DTD parser.")
5791 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5796 ;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
5797 ;;; ebnf2ps.el ends here