1 ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
3 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005
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/11/19 22:30:34 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
1117 (or (fboundp 'assq-delete-all
)
1118 (defun assq-delete-all (key alist
)
1119 "Delete from ALIST all elements whose car is KEY.
1120 Return the modified alist.
1121 Elements of ALIST that are not conses are ignored."
1124 (if (and (consp (car tail
))
1125 (eq (car (car tail
)) key
))
1126 (setq alist
(delq (car tail
) alist
)))
1127 (setq tail
(cdr tail
)))
1131 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1135 ;;; Interface to the command system
1137 (defgroup postscript nil
1144 (defgroup ebnf2ps nil
1145 "Translate an EBNF to a syntactic chart on PostScript"
1152 (defgroup ebnf-special nil
1153 "Special customization"
1160 (defgroup ebnf-except nil
1161 "Except customization"
1168 (defgroup ebnf-repeat nil
1169 "Repeat customization"
1176 (defgroup ebnf-terminal nil
1177 "Terminal customization"
1184 (defgroup ebnf-non-terminal nil
1185 "Non-Terminal customization"
1192 (defgroup ebnf-production nil
1193 "Production customization"
1200 (defgroup ebnf-shape nil
1201 "Shapes customization"
1208 (defgroup ebnf-displacement nil
1209 "Displacement customization"
1216 (defgroup ebnf-syntactic nil
1217 "Syntactic customization"
1224 (defgroup ebnf-optimization nil
1225 "Optimization customization"
1232 (defcustom ebnf-horizontal-orientation nil
1233 "*Non-nil means productions are drawn horizontally."
1236 :group
'ebnf-displacement
)
1239 (defcustom ebnf-horizontal-max-height nil
1240 "*Non-nil means to use maximum production height in horizontal orientation.
1242 It is only used when `ebnf-horizontal-orientation' is non-nil."
1245 :group
'ebnf-displacement
)
1248 (defcustom ebnf-production-horizontal-space
0.0 ; use ebnf2ps default value
1249 "*Specify horizontal space in points between productions.
1251 Value less or equal to zero forces ebnf2ps to set a proper default value."
1254 :group
'ebnf-displacement
)
1257 (defcustom ebnf-production-vertical-space
0.0 ; use ebnf2ps default value
1258 "*Specify vertical space in points between productions.
1260 Value less or equal to zero forces ebnf2ps to set a proper default value."
1263 :group
'ebnf-displacement
)
1266 (defcustom ebnf-justify-sequence
'center
1267 "*Specify justification of terms in a sequence inside alternatives.
1271 `left' left justification
1272 `right' right justification
1273 any other value centralize"
1274 :type
'(radio :tag
"Sequence Justification"
1275 (const left
) (const right
) (other :tag
"center" center
))
1277 :group
'ebnf-displacement
)
1280 (defcustom ebnf-special-show-delimiter t
1281 "*Non-nil means special delimiter (character `?') is shown."
1284 :group
'ebnf-special
)
1287 (defcustom ebnf-special-font
'(7 Courier
"Black" "Gray95" bold italic
)
1288 "*Specify special font.
1290 See documentation for `ebnf-production-font'."
1291 :type
'(list :tag
"Special Font"
1292 (number :tag
"Font Size")
1293 (symbol :tag
"Font Name")
1294 (choice :tag
"Foreground Color"
1295 (string :tag
"Name")
1296 (other :tag
"Default" nil
))
1297 (choice :tag
"Background Color"
1298 (string :tag
"Name")
1299 (other :tag
"Default" nil
))
1300 (repeat :tag
"Font Attributes" :inline t
1301 (choice (const bold
) (const italic
)
1302 (const underline
) (const strikeout
)
1303 (const overline
) (const shadow
)
1304 (const box
) (const outline
))))
1306 :group
'ebnf-special
)
1309 (defcustom ebnf-special-shape
'bevel
1310 "*Specify special box shape.
1312 See documentation for `ebnf-non-terminal-shape'."
1313 :type
'(radio :tag
"Special Shape"
1314 (const miter
) (const round
) (const bevel
))
1316 :group
'ebnf-special
)
1319 (defcustom ebnf-special-shadow nil
1320 "*Non-nil means special box will have a shadow."
1323 :group
'ebnf-special
)
1326 (defcustom ebnf-special-border-width
0.5
1327 "*Specify border width for special box."
1330 :group
'ebnf-special
)
1333 (defcustom ebnf-special-border-color
"Black"
1334 "*Specify border color for special box."
1337 :group
'ebnf-special
)
1340 (defcustom ebnf-except-font
'(7 Courier
"Black" "Gray90" bold italic
)
1341 "*Specify except font.
1343 See documentation for `ebnf-production-font'."
1344 :type
'(list :tag
"Except Font"
1345 (number :tag
"Font Size")
1346 (symbol :tag
"Font Name")
1347 (choice :tag
"Foreground Color"
1348 (string :tag
"Name")
1349 (other :tag
"Default" nil
))
1350 (choice :tag
"Background Color"
1351 (string :tag
"Name")
1352 (other :tag
"Default" nil
))
1353 (repeat :tag
"Font Attributes" :inline t
1354 (choice (const bold
) (const italic
)
1355 (const underline
) (const strikeout
)
1356 (const overline
) (const shadow
)
1357 (const box
) (const outline
))))
1359 :group
'ebnf-except
)
1362 (defcustom ebnf-except-shape
'bevel
1363 "*Specify except box shape.
1365 See documentation for `ebnf-non-terminal-shape'."
1366 :type
'(radio :tag
"Except Shape"
1367 (const miter
) (const round
) (const bevel
))
1369 :group
'ebnf-except
)
1372 (defcustom ebnf-except-shadow nil
1373 "*Non-nil means except box will have a shadow."
1376 :group
'ebnf-except
)
1379 (defcustom ebnf-except-border-width
0.25
1380 "*Specify border width for except box."
1383 :group
'ebnf-except
)
1386 (defcustom ebnf-except-border-color
"Black"
1387 "*Specify border color for except box."
1390 :group
'ebnf-except
)
1393 (defcustom ebnf-repeat-font
'(7 Courier
"Black" "Gray85" bold italic
)
1394 "*Specify repeat font.
1396 See documentation for `ebnf-production-font'."
1397 :type
'(list :tag
"Repeat Font"
1398 (number :tag
"Font Size")
1399 (symbol :tag
"Font Name")
1400 (choice :tag
"Foreground Color"
1401 (string :tag
"Name")
1402 (other :tag
"Default" nil
))
1403 (choice :tag
"Background Color"
1404 (string :tag
"Name")
1405 (other :tag
"Default" nil
))
1406 (repeat :tag
"Font Attributes" :inline t
1407 (choice (const bold
) (const italic
)
1408 (const underline
) (const strikeout
)
1409 (const overline
) (const shadow
)
1410 (const box
) (const outline
))))
1412 :group
'ebnf-repeat
)
1415 (defcustom ebnf-repeat-shape
'bevel
1416 "*Specify repeat box shape.
1418 See documentation for `ebnf-non-terminal-shape'."
1419 :type
'(radio :tag
"Repeat Shape"
1420 (const miter
) (const round
) (const bevel
))
1422 :group
'ebnf-repeat
)
1425 (defcustom ebnf-repeat-shadow nil
1426 "*Non-nil means repeat box will have a shadow."
1429 :group
'ebnf-repeat
)
1432 (defcustom ebnf-repeat-border-width
0.0
1433 "*Specify border width for repeat box."
1436 :group
'ebnf-repeat
)
1439 (defcustom ebnf-repeat-border-color
"Black"
1440 "*Specify border color for repeat box."
1443 :group
'ebnf-repeat
)
1446 (defcustom ebnf-terminal-font
'(7 Courier
"Black" "White")
1447 "*Specify terminal font.
1449 See documentation for `ebnf-production-font'."
1450 :type
'(list :tag
"Terminal Font"
1451 (number :tag
"Font Size")
1452 (symbol :tag
"Font Name")
1453 (choice :tag
"Foreground Color"
1454 (string :tag
"Name")
1455 (other :tag
"Default" nil
))
1456 (choice :tag
"Background Color"
1457 (string :tag
"Name")
1458 (other :tag
"Default" nil
))
1459 (repeat :tag
"Font Attributes" :inline t
1460 (choice (const bold
) (const italic
)
1461 (const underline
) (const strikeout
)
1462 (const overline
) (const shadow
)
1463 (const box
) (const outline
))))
1465 :group
'ebnf-terminal
)
1468 (defcustom ebnf-terminal-shape
'miter
1469 "*Specify terminal box shape.
1471 See documentation for `ebnf-non-terminal-shape'."
1472 :type
'(radio :tag
"Terminal Shape"
1473 (const miter
) (const round
) (const bevel
))
1475 :group
'ebnf-terminal
)
1478 (defcustom ebnf-terminal-shadow nil
1479 "*Non-nil means terminal box will have a shadow."
1482 :group
'ebnf-terminal
)
1485 (defcustom ebnf-terminal-border-width
1.0
1486 "*Specify border width for terminal box."
1489 :group
'ebnf-terminal
)
1492 (defcustom ebnf-terminal-border-color
"Black"
1493 "*Specify border color for terminal box."
1496 :group
'ebnf-terminal
)
1499 (defcustom ebnf-production-name-p t
1500 "*Non-nil means production name will be printed."
1503 :group
'ebnf-production
)
1506 (defcustom ebnf-sort-production nil
1507 "*Specify how productions are sorted.
1511 nil don't sort productions.
1512 `ascending' ascending sort.
1513 any other value descending sort."
1514 :type
'(radio :tag
"Production Sort"
1515 (const :tag
"Ascending" ascending
)
1516 (const :tag
"Descending" descending
)
1517 (other :tag
"No Sort" nil
))
1519 :group
'ebnf-production
)
1522 (defcustom ebnf-production-font
'(10 Helvetica
"Black" "White" bold
)
1523 "*Specify production header font.
1525 It is a list with the following form:
1527 (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
1530 SIZE is the font size.
1531 NAME is the font name symbol.
1532 ATTRIBUTE is one of the following symbols:
1533 bold - use bold font.
1534 italic - use italic font.
1535 underline - put a line under text.
1536 strikeout - like underline, but the line is in middle of text.
1537 overline - like underline, but the line is over the text.
1538 shadow - text will have a shadow.
1539 box - text will be surrounded by a box.
1540 outline - print characters as hollow outlines.
1541 FOREGROUND is a foreground string color name; if it's nil, the default color is
1543 BACKGROUND is a background string color name; if it's nil, the default color is
1546 See `ps-font-info-database' for valid font name."
1547 :type
'(list :tag
"Production Font"
1548 (number :tag
"Font Size")
1549 (symbol :tag
"Font Name")
1550 (choice :tag
"Foreground Color"
1551 (string :tag
"Name")
1552 (other :tag
"Default" nil
))
1553 (choice :tag
"Background Color"
1554 (string :tag
"Name")
1555 (other :tag
"Default" nil
))
1556 (repeat :tag
"Font Attributes" :inline t
1557 (choice (const bold
) (const italic
)
1558 (const underline
) (const strikeout
)
1559 (const overline
) (const shadow
)
1560 (const box
) (const outline
))))
1562 :group
'ebnf-production
)
1565 (defcustom ebnf-non-terminal-font
'(7 Helvetica
"Black" "White")
1566 "*Specify non-terminal font.
1568 See documentation for `ebnf-production-font'."
1569 :type
'(list :tag
"Non-Terminal Font"
1570 (number :tag
"Font Size")
1571 (symbol :tag
"Font Name")
1572 (choice :tag
"Foreground Color"
1573 (string :tag
"Name")
1574 (other :tag
"Default" nil
))
1575 (choice :tag
"Background Color"
1576 (string :tag
"Name")
1577 (other :tag
"Default" nil
))
1578 (repeat :tag
"Font Attributes" :inline t
1579 (choice (const bold
) (const italic
)
1580 (const underline
) (const strikeout
)
1581 (const overline
) (const shadow
)
1582 (const box
) (const outline
))))
1584 :group
'ebnf-non-terminal
)
1587 (defcustom ebnf-non-terminal-shape
'round
1588 "*Specify non-terminal box shape.
1604 Any other value is treated as `miter'."
1605 :type
'(radio :tag
"Non-Terminal Shape"
1606 (const miter
) (const round
) (const bevel
))
1608 :group
'ebnf-non-terminal
)
1611 (defcustom ebnf-non-terminal-shadow nil
1612 "*Non-nil means non-terminal box will have a shadow."
1615 :group
'ebnf-non-terminal
)
1618 (defcustom ebnf-non-terminal-border-width
1.0
1619 "*Specify border width for non-terminal box."
1622 :group
'ebnf-non-terminal
)
1625 (defcustom ebnf-non-terminal-border-color
"Black"
1626 "*Specify border color for non-terminal box."
1629 :group
'ebnf-non-terminal
)
1632 (defcustom ebnf-arrow-shape
'hollow
1633 "*Specify the arrow shape.
1639 `semi-up' * `transparent' *
1647 `semi-down' =====* `hollow' *
1663 `semi-up-hollow' `semi-up-full'
1669 `semi-down-hollow' `semi-down-full'
1675 `user' See also documentation for variable `ebnf-user-arrow'.
1677 Any other value is treated as `none'."
1678 :type
'(radio :tag
"Arrow Shape"
1679 (const none
) (const semi-up
)
1680 (const semi-down
) (const simple
)
1681 (const transparent
) (const hollow
)
1682 (const full
) (const semi-up-hollow
)
1683 (const semi-down-hollow
) (const semi-up-full
)
1684 (const semi-down-full
) (const user
))
1689 (defcustom ebnf-chart-shape
'round
1690 "*Specify chart flow shape.
1692 See documentation for `ebnf-non-terminal-shape'."
1693 :type
'(radio :tag
"Chart Flow Shape"
1694 (const miter
) (const round
) (const bevel
))
1699 (defcustom ebnf-user-arrow nil
1700 "*Specify a sexp for user arrow shape (a PostScript code).
1702 When evaluated, the sexp should return nil or a string containing PostScript
1703 code. PostScript code should draw a right arrow.
1705 The anatomy of a right arrow is:
1707 ...... Initial position
1709 : *.................
1713 ======+======*... } hT2
1717 : *.................
1723 :.......................
1725 Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
1726 be used to generate your own arrow. As these variables are used along
1727 PostScript execution, *DON'T* modify the values of them. Instead, copy the
1728 values, if you need to modify them.
1730 The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
1732 The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
1734 :type
'(sexp :tag
"User Arrow Shape")
1739 (defcustom ebnf-syntax
'ebnf
1740 "*Specify syntax to be recognized.
1744 `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
1746 The following variables *ONLY* have effect with this
1748 `ebnf-terminal-regexp', `ebnf-case-fold-search',
1749 `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
1751 `abnf' ebnf2ps recognizes the syntax described in the URL:
1752 `http://www.ietf.org/rfc/rfc2234.txt'
1753 (\"Augmented BNF for Syntax Specifications: ABNF\").
1755 `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
1756 `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
1757 (\"International Standard of the ISO EBNF Notation\").
1758 The following variables *ONLY* have effect with this
1760 `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
1762 `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
1763 The following variable *ONLY* has effect with this
1765 `ebnf-yac-ignore-error-recovery'.
1767 `ebnfx' ebnf2ps recognizes the syntax described in the URL:
1768 `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
1769 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1771 `dtd' ebnf2ps recognizes the syntax described in the URL:
1772 `http://www.w3.org/TR/2004/REC-xml-20040204/'
1773 (\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
1775 Any other value is treated as `ebnf'."
1776 :type
'(radio :tag
"Syntax"
1777 (const ebnf
) (const abnf
) (const iso-ebnf
)
1778 (const yacc
) (const ebnfx
) (const dtd
))
1780 :group
'ebnf-syntactic
)
1783 (defcustom ebnf-lex-comment-char ?\
;
1784 "*Specify the line comment character.
1786 It's used only when `ebnf-syntax' is `ebnf'."
1789 :group
'ebnf-syntactic
)
1792 (defcustom ebnf-lex-eop-char ?.
1793 "*Specify the end of production character.
1795 It's used only when `ebnf-syntax' is `ebnf'."
1798 :group
'ebnf-syntactic
)
1801 (defcustom ebnf-terminal-regexp nil
1802 "*Specify how it's a terminal name.
1804 If it's nil, the terminal name must be enclosed by `\"'.
1805 If it's a string, it should be a regexp that it'll be used to determine a
1806 terminal name; terminal name may also be enclosed by `\"'.
1808 It's used only when `ebnf-syntax' is `ebnf'."
1809 :type
'(radio :tag
"Terminal Name"
1812 :group
'ebnf-syntactic
)
1815 (defcustom ebnf-case-fold-search nil
1816 "*Non-nil means ignore case on matching.
1818 It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
1822 :group
'ebnf-syntactic
)
1825 (defcustom ebnf-iso-alternative-p nil
1826 "*Non-nil means use alternative ISO EBNF.
1828 It's only used when `ebnf-syntax' is `iso-ebnf'.
1830 This variable affects the following symbol set:
1832 STANDARD ALTERNATIVE
1841 :group
'ebnf-syntactic
)
1844 (defcustom ebnf-iso-normalize-p nil
1845 "*Non-nil means normalize ISO EBNF syntax names.
1847 Normalize a name means that several contiguous spaces inside name become a
1848 single space, so \"A B C\" is normalized to \"A B C\".
1850 It's only used when `ebnf-syntax' is `iso-ebnf'."
1853 :group
'ebnf-syntactic
)
1856 (defcustom ebnf-file-suffix-regexp
"\.[Bb][Nn][Ff]$"
1857 "*Specify file name suffix that contains EBNF.
1859 See `ebnf-eps-directory' command."
1865 (defcustom ebnf-eps-prefix
"ebnf--"
1866 "*Specify EPS prefix file name.
1868 See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
1874 (defcustom ebnf-entry-percentage
0.5 ; middle
1875 "*Specify entry height on alternatives.
1877 It must be a float between 0.0 (top) and 1.0 (bottom)."
1883 (defcustom ebnf-default-width
0.6
1884 "*Specify additional border width over default terminal, non-terminal or
1891 ;; Printing color requires x-color-values.
1892 (defcustom ebnf-color-p
(or (fboundp 'x-color-values
) ; Emacs
1893 (fboundp 'color-instance-rgb-components
)) ; XEmacs
1894 "*Non-nil means use color."
1900 (defcustom ebnf-line-width
1.0
1901 "*Specify flow line width."
1907 (defcustom ebnf-line-color
"Black"
1908 "*Specify flow line color."
1914 (defcustom ebnf-debug-ps nil
1915 "*Non-nil means to generate PostScript debug procedures.
1917 It is intended to help PostScript programmers in debugging."
1923 (defcustom ebnf-use-float-format t
1924 "*Non-nil means use `%f' float format.
1926 The advantage of using float format is that ebnf2ps generates a little short
1929 If it occurs the error message:
1931 Invalid format operation %f
1933 when executing ebnf2ps, set `ebnf-use-float-format' to nil."
1939 (defcustom ebnf-stop-on-error nil
1940 "*Non-nil means signal error and stop. Nil means signal error and continue."
1946 (defcustom ebnf-yac-ignore-error-recovery nil
1947 "*Non-nil means ignore error recovery.
1949 It's only used when `ebnf-syntax' is `yacc'."
1952 :group
'ebnf-syntactic
)
1955 (defcustom ebnf-ignore-empty-rule nil
1956 "*Non-nil means ignore empty rules.
1958 It's interesting to set this variable if your Yacc/Bison grammar has a lot of
1959 middle action rule."
1962 :group
'ebnf-optimization
)
1965 (defcustom ebnf-optimize nil
1966 "*Non-nil means optimize syntactic chart of rules.
1968 The following optimizations are done:
1971 1. A = B | A C. ==> A = B {C}*.
1972 2. A = B | A B. ==> A = {B}+.
1973 3. A = | A B. ==> A = {B}*.
1974 4. A = B | A C B. ==> A = {B || C}+.
1975 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
1978 6. A = B | . ==> A = [B].
1979 7. A = | B . ==> A = [B].
1982 8. A = B C | B D. ==> A = B (C | D).
1983 9. A = C B | D B. ==> A = (C | D) B.
1984 10. A = B C E | B D E. ==> A = B (C | D) E.
1986 The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
1989 :group
'ebnf-optimization
)
1992 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1993 ;; To make this file smaller, some commands go in a separate file.
1994 ;; But autoload them here to make the separation invisible.
1995 ;; Autoload is here to avoid compilation gripes.
1997 (autoload 'ebnf-eliminate-empty-rules
"ebnf-otz"
1998 "Eliminate empty rules.")
2000 (autoload 'ebnf-optimize
"ebnf-otz"
2001 "Syntactic chart optimizer.")
2003 (autoload 'ebnf-otz-initialize
"ebnf-otz"
2004 "Initialize optimizer.")
2007 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2012 (defun ebnf-customize ()
2013 "Customization for ebnf group."
2015 (customize-group 'ebnf2ps
))
2018 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2023 (defun ebnf-print-directory (&optional directory
)
2024 "Generate and print a PostScript syntactic chart image of DIRECTORY.
2026 If DIRECTORY is nil, it's used `default-directory'.
2028 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2031 See also `ebnf-print-buffer'."
2033 (list (read-file-name "Directory containing EBNF files (print): "
2034 nil default-directory
)))
2035 (ebnf-directory 'ebnf-print-buffer directory
))
2039 (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done
)
2040 "Generate and print a PostScript syntactic chart image of the file FILE.
2042 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2043 killed after process termination.
2045 See also `ebnf-print-buffer'."
2046 (interactive "fEBNF file to generate PostScript and print from: ")
2047 (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done
))
2051 (defun ebnf-print-buffer (&optional filename
)
2052 "Generate and print a PostScript syntactic chart image of the buffer.
2054 When called with a numeric prefix argument (C-u), prompts the user for
2055 the name of a file to save the PostScript image in, instead of sending
2058 More specifically, the FILENAME argument is treated as follows: if it
2059 is nil, send the image to the printer. If FILENAME is a string, save
2060 the PostScript image in a file with that name. If FILENAME is a
2061 number, prompt the user for the name of the file to save in."
2062 (interactive (list (ps-print-preprint current-prefix-arg
)))
2063 (ebnf-print-region (point-min) (point-max) filename
))
2067 (defun ebnf-print-region (from to
&optional filename
)
2068 "Generate and print a PostScript syntactic chart image of the region.
2069 Like `ebnf-print-buffer', but prints just the current region."
2070 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
2071 (run-hooks 'ebnf-hook
)
2072 (or (ebnf-spool-region from to
)
2073 (ps-do-despool filename
)))
2077 (defun ebnf-spool-directory (&optional directory
)
2078 "Generate and spool a PostScript syntactic chart image of DIRECTORY.
2080 If DIRECTORY is nil, it's used `default-directory'.
2082 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2085 See also `ebnf-spool-buffer'."
2087 (list (read-file-name "Directory containing EBNF files (spool): "
2088 nil default-directory
)))
2089 (ebnf-directory 'ebnf-spool-buffer directory
))
2093 (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done
)
2094 "Generate and spool a PostScript syntactic chart image of the file FILE.
2096 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2097 killed after process termination.
2099 See also `ebnf-spool-buffer'."
2100 (interactive "fEBNF file to generate PostScript and spool from: ")
2101 (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done
))
2105 (defun ebnf-spool-buffer ()
2106 "Generate and spool a PostScript syntactic chart image of the buffer.
2107 Like `ebnf-print-buffer' except that the PostScript image is saved in a
2108 local buffer to be sent to the printer later.
2110 Use the command `ebnf-despool' to send the spooled images to the printer."
2112 (ebnf-spool-region (point-min) (point-max)))
2116 (defun ebnf-spool-region (from to
)
2117 "Generate a PostScript syntactic chart image of the region and spool locally.
2118 Like `ebnf-spool-buffer', but spools just the current region.
2120 Use the command `ebnf-despool' to send the spooled images to the printer."
2122 (ebnf-generate-region from to
'ebnf-generate
))
2126 (defun ebnf-eps-directory (&optional directory
)
2127 "Generate EPS files from EBNF files in DIRECTORY.
2129 If DIRECTORY is nil, it's used `default-directory'.
2131 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2134 See also `ebnf-eps-buffer'."
2136 (list (read-file-name "Directory containing EBNF files (EPS): "
2137 nil default-directory
)))
2138 (ebnf-directory 'ebnf-eps-buffer directory
))
2142 (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done
)
2143 "Generate an EPS file from EBNF file FILE.
2145 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2146 killed after EPS generation.
2148 See also `ebnf-eps-buffer'."
2149 (interactive "fEBNF file to generate EPS file from: ")
2150 (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done
))
2154 (defun ebnf-eps-buffer ()
2155 "Generate a PostScript syntactic chart image of the buffer in a EPS file.
2157 Indeed, for each production is generated a EPS file.
2158 The EPS file name has the following form:
2160 <PREFIX><PRODUCTION>.eps
2162 <PREFIX> is given by variable `ebnf-eps-prefix'.
2163 The default value is \"ebnf--\".
2165 <PRODUCTION> is the production name.
2166 The production name is mapped to form a valid file name.
2167 For example, the production name \"A/B + C\" is mapped to
2168 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2170 WARNING: It's *NOT* asked any confirmation to override an existing file."
2172 (ebnf-eps-region (point-min) (point-max)))
2176 (defun ebnf-eps-region (from to
)
2177 "Generate a PostScript syntactic chart image of the region in a EPS file.
2179 Indeed, for each production is generated a EPS file.
2180 The EPS file name has the following form:
2182 <PREFIX><PRODUCTION>.eps
2184 <PREFIX> is given by variable `ebnf-eps-prefix'.
2185 The default value is \"ebnf--\".
2187 <PRODUCTION> is the production name.
2188 The production name is mapped to form a valid file name.
2189 For example, the production name \"A/B + C\" is mapped to
2190 \"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
2192 WARNING: It's *NOT* asked any confirmation to override an existing file."
2194 (let ((ebnf-eps-executing t
))
2195 (ebnf-generate-region from to
'ebnf-generate-eps
)))
2199 (defalias 'ebnf-despool
'ps-despool
)
2203 (defun ebnf-syntax-directory (&optional directory
)
2204 "Does a syntactic analysis of the files in DIRECTORY.
2206 If DIRECTORY is nil, it's used `default-directory'.
2208 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
2211 See also `ebnf-syntax-buffer'."
2213 (list (read-file-name "Directory containing EBNF files (syntax): "
2214 nil default-directory
)))
2215 (ebnf-directory 'ebnf-syntax-buffer directory
))
2219 (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done
)
2220 "Does a syntactic analysis of the FILE.
2222 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
2223 killed after syntax checking.
2225 See also `ebnf-syntax-buffer'."
2226 (interactive "fEBNF file to check syntax: ")
2227 (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done
))
2231 (defun ebnf-syntax-buffer ()
2232 "Does a syntactic analysis of the current buffer."
2234 (ebnf-syntax-region (point-min) (point-max)))
2238 (defun ebnf-syntax-region (from to
)
2239 "Does a syntactic analysis of a region."
2241 (ebnf-generate-region from to nil
))
2244 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2249 (defun ebnf-setup ()
2250 "Return the current ebnf2ps setup."
2253 ;;; ebnf2ps.el version %s
2255 \(setq ebnf-special-show-delimiter %S
2256 ebnf-special-font %s
2257 ebnf-special-shape %s
2258 ebnf-special-shadow %S
2259 ebnf-special-border-width %S
2260 ebnf-special-border-color %S
2262 ebnf-except-shape %s
2263 ebnf-except-shadow %S
2264 ebnf-except-border-width %S
2265 ebnf-except-border-color %S
2267 ebnf-repeat-shape %s
2268 ebnf-repeat-shadow %S
2269 ebnf-repeat-border-width %S
2270 ebnf-repeat-border-color %S
2271 ebnf-terminal-regexp %S
2272 ebnf-case-fold-search %S
2273 ebnf-terminal-font %s
2274 ebnf-terminal-shape %s
2275 ebnf-terminal-shadow %S
2276 ebnf-terminal-border-width %S
2277 ebnf-terminal-border-color %S
2278 ebnf-non-terminal-font %s
2279 ebnf-non-terminal-shape %s
2280 ebnf-non-terminal-shadow %S
2281 ebnf-non-terminal-border-width %S
2282 ebnf-non-terminal-border-color %S
2283 ebnf-production-name-p %S
2284 ebnf-sort-production %s
2285 ebnf-production-font %s
2289 ebnf-horizontal-orientation %S
2290 ebnf-horizontal-max-height %S
2291 ebnf-production-horizontal-space %S
2292 ebnf-production-vertical-space %S
2293 ebnf-justify-sequence %s
2294 ebnf-lex-comment-char ?\\%03o
2295 ebnf-lex-eop-char ?\\%03o
2297 ebnf-iso-alternative-p %S
2298 ebnf-iso-normalize-p %S
2299 ebnf-file-suffix-regexp %S
2301 ebnf-entry-percentage %S
2306 ebnf-use-float-format %S
2307 ebnf-stop-on-error %S
2308 ebnf-yac-ignore-error-recovery %S
2309 ebnf-ignore-empty-rule %S
2312 ;;; ebnf2ps.el - end of settings
2315 ebnf-special-show-delimiter
2316 (ps-print-quote ebnf-special-font
)
2317 (ps-print-quote ebnf-special-shape
)
2319 ebnf-special-border-width
2320 ebnf-special-border-color
2321 (ps-print-quote ebnf-except-font
)
2322 (ps-print-quote ebnf-except-shape
)
2324 ebnf-except-border-width
2325 ebnf-except-border-color
2326 (ps-print-quote ebnf-repeat-font
)
2327 (ps-print-quote ebnf-repeat-shape
)
2329 ebnf-repeat-border-width
2330 ebnf-repeat-border-color
2331 ebnf-terminal-regexp
2332 ebnf-case-fold-search
2333 (ps-print-quote ebnf-terminal-font
)
2334 (ps-print-quote ebnf-terminal-shape
)
2335 ebnf-terminal-shadow
2336 ebnf-terminal-border-width
2337 ebnf-terminal-border-color
2338 (ps-print-quote ebnf-non-terminal-font
)
2339 (ps-print-quote ebnf-non-terminal-shape
)
2340 ebnf-non-terminal-shadow
2341 ebnf-non-terminal-border-width
2342 ebnf-non-terminal-border-color
2343 ebnf-production-name-p
2344 (ps-print-quote ebnf-sort-production
)
2345 (ps-print-quote ebnf-production-font
)
2346 (ps-print-quote ebnf-arrow-shape
)
2347 (ps-print-quote ebnf-chart-shape
)
2348 (ps-print-quote ebnf-user-arrow
)
2349 ebnf-horizontal-orientation
2350 ebnf-horizontal-max-height
2351 ebnf-production-horizontal-space
2352 ebnf-production-vertical-space
2353 (ps-print-quote ebnf-justify-sequence
)
2354 ebnf-lex-comment-char
2356 (ps-print-quote ebnf-syntax
)
2357 ebnf-iso-alternative-p
2358 ebnf-iso-normalize-p
2359 ebnf-file-suffix-regexp
2361 ebnf-entry-percentage
2366 ebnf-use-float-format
2368 ebnf-yac-ignore-error-recovery
2369 ebnf-ignore-empty-rule
2373 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2377 (defvar ebnf-stack-style nil
2378 "Used in functions `ebnf-reset-style', `ebnf-push-style' and
2382 (defvar ebnf-current-style
'default
2383 "Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
2386 (defconst ebnf-style-custom-list
2387 '(ebnf-special-show-delimiter
2391 ebnf-special-border-width
2392 ebnf-special-border-color
2396 ebnf-except-border-width
2397 ebnf-except-border-color
2401 ebnf-repeat-border-width
2402 ebnf-repeat-border-color
2403 ebnf-terminal-regexp
2404 ebnf-case-fold-search
2407 ebnf-terminal-shadow
2408 ebnf-terminal-border-width
2409 ebnf-terminal-border-color
2410 ebnf-non-terminal-font
2411 ebnf-non-terminal-shape
2412 ebnf-non-terminal-shadow
2413 ebnf-non-terminal-border-width
2414 ebnf-non-terminal-border-color
2415 ebnf-production-name-p
2416 ebnf-sort-production
2417 ebnf-production-font
2421 ebnf-horizontal-orientation
2422 ebnf-horizontal-max-height
2423 ebnf-production-horizontal-space
2424 ebnf-production-vertical-space
2425 ebnf-justify-sequence
2426 ebnf-lex-comment-char
2429 ebnf-iso-alternative-p
2430 ebnf-iso-normalize-p
2431 ebnf-file-suffix-regexp
2433 ebnf-entry-percentage
2438 ebnf-use-float-format
2440 ebnf-yac-ignore-error-recovery
2441 ebnf-ignore-empty-rule
2443 "List of valid symbol custom variable.")
2446 (defvar ebnf-style-database
2450 (ebnf-special-show-delimiter . t
)
2451 (ebnf-special-font .
'(7 Courier
"Black" "Gray95" bold italic
))
2452 (ebnf-special-shape .
'bevel
)
2453 (ebnf-special-shadow . nil
)
2454 (ebnf-special-border-width .
0.5)
2455 (ebnf-special-border-color .
"Black")
2456 (ebnf-except-font .
'(7 Courier
"Black" "Gray90" bold italic
))
2457 (ebnf-except-shape .
'bevel
)
2458 (ebnf-except-shadow . nil
)
2459 (ebnf-except-border-width .
0.25)
2460 (ebnf-except-border-color .
"Black")
2461 (ebnf-repeat-font .
'(7 Courier
"Black" "Gray85" bold italic
))
2462 (ebnf-repeat-shape .
'bevel
)
2463 (ebnf-repeat-shadow . nil
)
2464 (ebnf-repeat-border-width .
0.0)
2465 (ebnf-repeat-border-color .
"Black")
2466 (ebnf-terminal-regexp . nil
)
2467 (ebnf-case-fold-search . nil
)
2468 (ebnf-terminal-font .
'(7 Courier
"Black" "White"))
2469 (ebnf-terminal-shape .
'miter
)
2470 (ebnf-terminal-shadow . nil
)
2471 (ebnf-terminal-border-width .
1.0)
2472 (ebnf-terminal-border-color .
"Black")
2473 (ebnf-non-terminal-font .
'(7 Helvetica
"Black" "White"))
2474 (ebnf-non-terminal-shape .
'round
)
2475 (ebnf-non-terminal-shadow . nil
)
2476 (ebnf-non-terminal-border-width .
1.0)
2477 (ebnf-non-terminal-border-color .
"Black")
2478 (ebnf-production-name-p . t
)
2479 (ebnf-sort-production . nil
)
2480 (ebnf-production-font .
'(10 Helvetica
"Black" "White" bold
))
2481 (ebnf-arrow-shape .
'hollow
)
2482 (ebnf-chart-shape .
'round
)
2483 (ebnf-user-arrow . nil
)
2484 (ebnf-horizontal-orientation . nil
)
2485 (ebnf-horizontal-max-height . nil
)
2486 (ebnf-production-horizontal-space .
0.0)
2487 (ebnf-production-vertical-space .
0.0)
2488 (ebnf-justify-sequence .
'center
)
2489 (ebnf-lex-comment-char . ?\
;)
2490 (ebnf-lex-eop-char . ?.
)
2491 (ebnf-syntax .
'ebnf
)
2492 (ebnf-iso-alternative-p . nil
)
2493 (ebnf-iso-normalize-p . nil
)
2494 (ebnf-file-suffix-regexp .
"\.[Bb][Nn][Ff]$")
2495 (ebnf-eps-prefix .
"ebnf--")
2496 (ebnf-entry-percentage .
0.5)
2497 (ebnf-color-p .
(or (fboundp 'x-color-values
) ; Emacs
2498 (fboundp 'color-instance-rgb-components
))) ; XEmacs
2499 (ebnf-line-width .
1.0)
2500 (ebnf-line-color .
"Black")
2501 (ebnf-debug-ps . nil
)
2502 (ebnf-use-float-format . t
)
2503 (ebnf-stop-on-error . nil
)
2504 (ebnf-yac-ignore-error-recovery . nil
)
2505 (ebnf-ignore-empty-rule . nil
)
2506 (ebnf-optimize . nil
))
2507 ;; Happy EBNF default
2510 (ebnf-justify-sequence .
'left
)
2511 (ebnf-lex-comment-char . ?\
#)
2512 (ebnf-lex-eop-char . ?\
;))
2516 (ebnf-syntax .
'abnf
))
2520 (ebnf-syntax .
'iso-ebnf
))
2521 ;; Yacc/Bison default
2524 (ebnf-syntax .
'yacc
))
2528 (ebnf-syntax .
'ebnfx
))
2532 (ebnf-syntax .
'dtd
))
2536 Each element has the following form:
2538 (NAME INHERITS (VAR . VALUE)...)
2542 NAME is a symbol name style.
2544 INHERITS is a symbol name style from which the current style inherits
2545 the context. If INHERITS is nil, means that there is no
2548 This is a simple inheritance of style; so if you declare that a
2549 style A inherits from a style B, all settings of B is applied
2550 first and then the settings of A is applied. This is useful
2551 when you wish to modify some aspects of an existing style, but
2552 at same time wish to keep it unmodified.
2554 VAR is a valid ebnf2ps symbol custom variable.
2555 See `ebnf-style-custom-list' for valid symbol variable.
2557 VALUE is a sexp which it'll be evaluated to set the value to VAR.
2558 So, don't forget to quote symbols and constant lists.
2559 See `default' style for an example.
2561 Don't handle this variable directly. Use functions `ebnf-insert-style',
2562 `ebnf-delete-style' and `ebnf-merge-style'.")
2565 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2570 (defun ebnf-insert-style (name inherits
&rest values
)
2571 "Insert a new style NAME with inheritance INHERITS and values VALUES.
2573 See `ebnf-style-database' documentation."
2574 (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
2575 (and (assoc name ebnf-style-database
)
2576 (error "Style name already exists: %s" name
))
2577 (or (assoc inherits ebnf-style-database
)
2578 (error "Style inheritance name does'nt exist: %s" inherits
))
2579 (setq ebnf-style-database
2580 (cons (cons name
(cons inherits
(ebnf-check-style-values values
)))
2581 ebnf-style-database
)))
2585 (defun ebnf-delete-style (name)
2588 See `ebnf-style-database' documentation."
2589 (interactive "SDelete style name: ")
2590 (or (assoc name ebnf-style-database
)
2591 (error "Style name doesn't exist: %s" name
))
2592 (let ((db ebnf-style-database
))
2594 (and (eq (nth 1 (car db
)) name
)
2595 (error "Style name `%s' is inherited by `%s' style"
2596 name
(nth 0 (car db
))))
2597 (setq db
(cdr db
))))
2598 (setq ebnf-style-database
(assq-delete-all name ebnf-style-database
)))
2602 (defun ebnf-merge-style (name &rest values
)
2603 "Merge values of style NAME with style VALUES.
2605 See `ebnf-style-database' documentation."
2606 (interactive "SStyle name: \nXStyle values: ")
2607 (let ((style (or (assoc name ebnf-style-database
)
2608 (error "Style name does'nt exist: %s" name
)))
2609 (merge (ebnf-check-style-values values
))
2611 ;; modify value of existing variables
2612 (setq val
(nthcdr 2 style
))
2614 (setq check
(car merge
)
2616 elt
(assoc (car check
) val
))
2618 (setcdr elt
(cdr check
))
2619 (setq new
(cons check new
))))
2620 ;; insert new variables
2621 (nconc style
(nreverse new
))))
2625 (defun ebnf-apply-style (style)
2626 "Set STYLE as the current style.
2628 It returns the old style symbol.
2630 See `ebnf-style-database' documentation."
2631 (interactive "SApply style: ")
2634 (and (ebnf-apply-style1 style
)
2635 (setq ebnf-current-style style
))))
2639 (defun ebnf-reset-style (&optional style
)
2640 "Reset current style.
2642 It returns the old style symbol.
2644 See `ebnf-style-database' documentation."
2645 (interactive "SReset style: ")
2646 (setq ebnf-stack-style nil
)
2647 (ebnf-apply-style (or style
'default
)))
2651 (defun ebnf-push-style (&optional style
)
2652 "Push the current style and set STYLE as the current style.
2654 It returns the old style symbol.
2656 See `ebnf-style-database' documentation."
2657 (interactive "SPush style: ")
2660 (setq ebnf-stack-style
(cons ebnf-current-style ebnf-stack-style
))
2662 (ebnf-apply-style style
))))
2666 (defun ebnf-pop-style ()
2667 "Pop a style and set it as the current style.
2669 It returns the old style symbol.
2671 See `ebnf-style-database' documentation."
2674 (ebnf-apply-style (car ebnf-stack-style
))
2675 (setq ebnf-stack-style
(cdr ebnf-stack-style
))))
2678 (defun ebnf-apply-style1 (style)
2679 (let ((value (cdr (assoc style ebnf-style-database
))))
2682 (and (car value
) (ebnf-apply-style1 (car value
)))
2683 (while (setq value
(cdr value
))
2684 (set (caar value
) (eval (cdar value
)))))))
2687 (defun ebnf-check-style-values (values)
2690 (and (memq (caar values
) ebnf-style-custom-list
)
2691 (setq style
(cons (car values
) style
)))
2692 (setq values
(cdr values
)))
2696 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2697 ;; Internal variables
2700 (defvar ebnf-eps-buffer-name
" *EPS*")
2701 (defvar ebnf-parser-func nil
)
2702 (defvar ebnf-eps-executing nil
)
2703 (defvar ebnf-eps-upper-x
0.0)
2704 (make-variable-buffer-local 'ebnf-eps-upper-x
)
2705 (defvar ebnf-eps-upper-y
0.0)
2706 (make-variable-buffer-local 'ebnf-eps-upper-y
)
2707 (defvar ebnf-eps-prod-width
0.0)
2708 (make-variable-buffer-local 'ebnf-eps-prod-width
)
2709 (defvar ebnf-eps-max-height
0.0)
2710 (make-variable-buffer-local 'ebnf-eps-max-height
)
2711 (defvar ebnf-eps-max-width
0.0)
2712 (make-variable-buffer-local 'ebnf-eps-max-width
)
2715 (defvar ebnf-eps-context nil
2716 "List of EPS file name during parsing.
2718 See section \"Actions in Comments\" in ebnf2ps documentation.")
2721 (defvar ebnf-eps-production-list nil
2722 "Alist associating production name with EPS file name list.
2724 Each element has the following form:
2726 (PRODUCTION EPS-FILENAME...)
2728 PRODUCTION is the production name.
2729 EPS-FILENAME is the EPS file name.
2731 It's generated during parsing and used during EPS generation.
2733 See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
2737 (defconst ebnf-arrow-shape-alist
2745 (semi-up-hollow .
7)
2747 (semi-down-hollow .
9)
2748 (semi-down-full .
10)
2750 "Alist associating values for `ebnf-arrow-shape'.
2752 See documentation for `ebnf-arrow-shape'.")
2755 (defconst ebnf-terminal-shape-alist
2759 "Alist associating values from `ebnf-terminal-shape' to a bit vector.
2761 See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
2762 `ebnf-chart-shape'.")
2765 (defvar ebnf-limit nil
)
2766 (defvar ebnf-action nil
)
2767 (defvar ebnf-action-list nil
)
2770 (defvar ebnf-default-p nil
)
2773 (defvar ebnf-font-height-P
0)
2774 (defvar ebnf-font-height-T
0)
2775 (defvar ebnf-font-height-NT
0)
2776 (defvar ebnf-font-height-S
0)
2777 (defvar ebnf-font-height-E
0)
2778 (defvar ebnf-font-height-R
0)
2779 (defvar ebnf-font-width-P
0)
2780 (defvar ebnf-font-width-T
0)
2781 (defvar ebnf-font-width-NT
0)
2782 (defvar ebnf-font-width-S
0)
2783 (defvar ebnf-font-width-E
0)
2784 (defvar ebnf-font-width-R
0)
2785 (defvar ebnf-space-T
0)
2786 (defvar ebnf-space-NT
0)
2787 (defvar ebnf-space-S
0)
2788 (defvar ebnf-space-E
0)
2789 (defvar ebnf-space-R
0)
2792 (defvar ebnf-basic-width
0)
2793 (defvar ebnf-basic-height
0)
2794 (defvar ebnf-vertical-space
0)
2795 (defvar ebnf-horizontal-space
0)
2798 (defvar ebnf-settings nil
)
2799 (defvar ebnf-fonts-required nil
)
2802 (defconst ebnf-debug
2804 % === begin EBNF procedures to help debugging
2806 % Mark visually current point: string debug
2810 gsave -s- show grestore
2822 % Show number value: number string debug-number
2825 20 0 rmoveto show ([) show 60 string cvs show (]) show
2829 % === end EBNF procedures to help debugging
2832 "This is intended to help debugging PostScript programming.")
2835 (defconst ebnf-prologue
2837 % === begin EBNF engine
2839 % --- Basic Definitions
2842 /SpaceS FontHeight 0.5 mul def
2843 /HeightS FontHeight FontHeight add def
2846 /SpaceE FontHeight 0.5 mul def
2847 /HeightE FontHeight FontHeight add def
2850 /SpaceR FontHeight 0.5 mul def
2851 /HeightR FontHeight FontHeight add def
2854 /SpaceT FontHeight 0.5 mul def
2855 /HeightT FontHeight FontHeight add def
2858 /SpaceNT FontHeight 0.5 mul def
2859 /HeightNT FontHeight FontHeight add def
2861 /T HeightT HeightNT add 0.5 mul def
2864 /hT4 hT 0.25 mul def
2866 /Er 0.1 def % Error factor
2869 /c{currentpoint}bind def
2870 /xyi{/xi c /yi exch def def}bind def
2871 /xyo{/xo c /yo exch def def}bind def
2872 /xyp{/xp c /yp exch def def}bind def
2873 /xyt{/xt c /yt exch def def}bind def
2875 % vertical movement: x y height vm
2876 /vm{add moveto}bind def
2878 % horizontal movement: x y width hm
2879 /hm{3 -1 roll exch add exch moveto}bind def
2881 % set color: [R G B] SetRGB
2882 /SetRGB{aload pop setrgbcolor}bind def
2884 % filling gray area: gray-scale FillGray
2885 /FillGray{gsave setgray fill grestore}bind def
2887 % filling color area: [R G B] FillRGB
2888 /FillRGB{gsave SetRGB fill grestore}bind def
2890 /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
2891 /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
2892 /Gstroke{gsave Stroke grestore}bind def
2894 % Empty Line: width EL
2895 /EL{0 rlineto Gstroke}bind def
2899 /Down{hT2 neg hT4 neg rlineto}bind def
2902 {hT2 neg hT4 rmoveto
2907 /ArrowPath{c newpath moveto Arrow closepath}bind def
2931 {hT2 neg hT4 rlineto} % 1 - semi-up
2932 {Down} % 2 - semi-down
2933 {Arrow} % 3 - simple
2934 {Gstroke ArrowPath} % 4 - transparent
2935 {Gstroke ArrowPath 1 FillGray} % 5 - hollow
2936 {Gstroke ArrowPath LineColor FillRGB} % 6 - full
2937 {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
2938 {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
2939 {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
2940 {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
2941 {Gstroke gsave UserArrow grestore} % 11 - user
2947 RA-vector ArrowShape get exec
2952 % rotation DrawArrow
2967 /LA{180 DrawArrow}def
2974 /UA{90 DrawArrow}def
2981 /DA{270 DrawArrow}def
2985 %>corner Right Descendent: height arrow corner_RD
2987 % / height > 0 | 0 - none
2989 % * ---------- | 2 - left
3008 h 0 gt{DA}{UA}ifelse
3013 [{cRD0-vector arrow get exec} % 0 - miter
3014 {0 0 0 h hT h rcurveto} % 1 - rounded
3015 {hT h rlineto} % 2 - bevel
3019 {/arrow exch def /h exch def
3020 cRD-vector ChartShape get exec
3024 %>corner Right Ascendent: height arrow corner_RA
3026 % | height > 0 | 0 - none
3028 % *- ---------- | 2 - left
3046 h 0 gt{DA}{UA}ifelse
3052 [{cRA0-vector arrow get exec} % 0 - miter
3053 {0 0 hT 0 hT h rcurveto} % 1 - rounded
3054 {hT h rlineto} % 2 - bevel
3058 {/arrow exch def /h exch def
3059 cRA-vector ChartShape get exec
3063 %>corner Left Descendent: height arrow corner_LD
3065 % \\ height > 0 | 0 - none
3067 % * ---------- | 2 - left
3076 {hT neg h rmoveto xyi
3084 {hT neg h rmoveto xyi
3086 h 0 gt{DA}{UA}ifelse
3091 [{cLD0-vector arrow get exec} % 0 - miter
3092 {0 0 0 h hT neg h rcurveto} % 1 - rounded
3093 {hT neg h rlineto} % 2 - bevel
3097 {/arrow exch def /h exch def
3098 cLD-vector ChartShape get exec
3102 %>corner Left Ascendent: height arrow corner_LA
3104 % | height > 0 | 0 - none
3106 % -* ---------- | 2 - left
3115 {hT neg h rmoveto xyi
3123 {hT neg h rmoveto xyi
3124 h 0 gt{DA}{UA}ifelse
3130 [{cLA0-vector arrow get exec} % 0 - miter
3131 {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
3132 {hT neg h rlineto} % 2 - bevel
3136 {/arrow exch def /h exch def
3137 cLA-vector ChartShape get exec
3143 % height prepare_height |- line_height corner_height corner_height
3147 {T add hT neg}ifelse
3151 %>Left Alternative: height LAlt
3178 %>Left Loop: height LLoop
3197 %>Right Alternative: height RAlt
3211 {T neg exch rlineto}
3224 %>Right Loop: height RLoop
3243 % --- Terminal, Non-terminal and Special Basics
3245 % string width prepare-width |- string
3248 dup stringwidth pop space add space add width exch sub 0.5 mul
3252 % string width begin-right
3262 {xo width add Er add yo moveto
3267 % string width begin-left
3276 {xo width add Er add yo moveto
3289 {/half YY yy sub 0.5 mul abs def
3290 xx half add YY moveto
3291 0 0 half neg 0 half neg half neg rcurveto
3292 0 0 0 half neg half half neg rcurveto
3293 XX xx sub abs half sub half sub 0 rlineto
3294 0 0 half 0 half half rcurveto
3295 0 0 0 half half neg half rcurveto}
3297 {/quarter YY yy sub 0.25 mul abs def
3298 xx quarter add YY moveto
3299 quarter neg quarter neg rlineto
3300 0 quarter quarter add neg rlineto
3301 quarter quarter neg rlineto
3302 XX xx sub abs quarter sub quarter sub 0 rlineto
3303 quarter quarter rlineto
3304 0 quarter quarter add rlineto
3305 quarter neg quarter rlineto}
3310 ShapePath-vector shape get exec
3316 Xshadow Xshadow add Xshadow add
3317 Yshadow Yshadow add Yshadow add translate
3331 % string SBound |- string
3333 {/xx c dup /yy exch def
3334 FontHeight add /YY exch def def
3335 dup stringwidth pop xx add /XX exch def
3337 {/yy yy YShadow add def
3338 /XX XX XShadow add def
3347 /XX XX space add space add def
3348 /YY YY space add def
3349 /yy yy space sub def
3350 shadow{doShapeShadow}if
3352 space Descent abs rmoveto
3359 % TeRminal: string TR
3361 {/Effect EffectT def
3363 /shapecolor BackgroundT def
3364 /borderwidth BorderWidthT def
3365 /bordercolor BorderColorT def
3366 /foreground ForegroundT def
3371 %>Right Terminal: string width RT |- x y
3382 %>Left Terminal: string width LT |- x y
3393 %>Right Terminal Default: string width RTD |- x y
3395 {/-save- BorderWidthT def
3396 /BorderWidthT BorderWidthT DefaultWidth add def
3398 /BorderWidthT -save- def
3401 %>Left Terminal Default: string width LTD |- x y
3403 {/-save- BorderWidthT def
3404 /BorderWidthT BorderWidthT DefaultWidth add def
3406 /BorderWidthT -save- def
3411 % Non-Terminal: string NT
3413 {/Effect EffectNT def
3415 /shapecolor BackgroundNT def
3416 /borderwidth BorderWidthNT def
3417 /bordercolor BorderColorNT def
3418 /foreground ForegroundNT def
3419 /shadow ShadowNT def
3423 %>Right Non-Terminal: string width RNT |- x y
3434 %>Left Non-Terminal: string width LNT |- x y
3445 %>Right Non-Terminal Default: string width RNTD |- x y
3447 {/-save- BorderWidthNT def
3448 /BorderWidthNT BorderWidthNT DefaultWidth add def
3450 /BorderWidthNT -save- def
3453 %>Left Non-Terminal Default: string width LNTD |- x y
3455 {/-save- BorderWidthNT def
3456 /BorderWidthNT BorderWidthNT DefaultWidth add def
3458 /BorderWidthNT -save- def
3463 % SPecial: string SP
3465 {/Effect EffectS def
3467 /shapecolor BackgroundS def
3468 /borderwidth BorderWidthS def
3469 /bordercolor BorderColorS def
3470 /foreground ForegroundS def
3475 %>Right SPecial: string width RSP |- x y
3486 %>Left SPecial: string width LSP |- x y
3497 %>Right SPecial Default: string width RSPD |- x y
3499 {/-save- BorderWidthS def
3500 /BorderWidthS BorderWidthS DefaultWidth add def
3502 /BorderWidthS -save- def
3505 %>Left SPecial Default: string width LSPD |- x y
3507 {/-save- BorderWidthS def
3508 /BorderWidthS BorderWidthS DefaultWidth add def
3510 /BorderWidthS -save- def
3513 % --- Repeat and Except basics
3516 {/w width rwidth sub 0.5 mul def
3521 /xx c entry add /YY exch def def
3522 /yy YY height sub def
3523 /XX xx rwidth add def
3524 shadow{doShapeShadow}if
3547 % entry height width rwidth begin-repeat
3557 /shapecolor BackgroundR def
3558 /borderwidth BorderWidthR def
3559 /bordercolor BorderColorR def
3560 /foreground ForegroundR def
3565 % string end-repeat |- x y
3568 space Descent rmoveto
3572 exch space add exch moveto
3576 %>Right RePeat: string entry height width rwidth RRP |- x y
3577 /RRP{begin-repeat right-direction end-repeat}def
3579 %>Left RePeat: string entry height width rwidth LRP |- x y
3580 /LRP{begin-repeat left-direction end-repeat}def
3584 % entry height width rwidth begin-except
3594 /shapecolor BackgroundE def
3595 /borderwidth BorderWidthE def
3596 /bordercolor BorderColorE def
3597 /foreground ForegroundE def
3602 % x-width end-except |- x y
3605 space space add add Descent rmoveto
3606 (-) foreground SetRGB S
3612 %>Right EXcept: x-width entry height width rwidth REX |- x y
3613 /REX{begin-except right-direction end-except}def
3615 %>Left EXcept: x-width entry height width rwidth LEX |- x y
3616 /LEX{begin-except left-direction end-except}def
3620 %>Beginning Of Sequence: BOS |- x y
3621 /BOS{currentpoint}bind def
3623 %>End Of Sequence: x y x1 y1 EOS |- x y
3624 /EOS{pop pop}bind def
3628 %>Beginning Of Production: string width height BOP |- y x
3631 neg yp add /yw exch def
3632 xp add T sub /xw exch def
3633 dup length 0 gt % empty string ==> no production name
3634 {/Effect EffectP def
3635 /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
3645 %>End Of Production: y x delta EOP
3646 /EOPH{add exch moveto}bind def % horizontal
3647 /EOPV{exch pop sub 0 exch moveto}bind def % vertical
3649 % --- Empty Alternative
3651 %>Empty Alternative: width EA |- x y
3662 %>AlTernative: h1 h2 ... hn n width AT |- x y
3664 {xyo xo add /xw exch def
3676 %>OPtional: height width OP |- x y
3693 %>One or More: height width OM |- x y
3707 %>Zero or More: h2 h1 width ZM |- x y
3717 yo add xo T add exch moveto
3721 % === end EBNF engine
3724 "EBNF PostScript prologue")
3727 (defconst ebnf-eps-prologue
3729 /#ebnf2ps#dict 230 dict def
3732 % Initiliaze variables to avoid name-conflicting with document variables.
3733 % This is the case when using `bind' operator.
3734 /-fillp- 0 def /h 0 def
3735 /-ox- 0 def /half 0 def
3736 /-oy- 0 def /height 0 def
3737 /-save- 0 def /ow 0 def
3738 /Ascent 0 def /quarter 0 def
3739 /Descent 0 def /rXX 0 def
3740 /Effect 0 def /rYY 0 def
3741 /FontHeight 0 def /rwidth 0 def
3742 /LineThickness 0 def /rxx 0 def
3743 /OverlinePosition 0 def /ryy 0 def
3744 /SpaceBackground 0 def /shadow 0 def
3745 /StrikeoutPosition 0 def /shape 0 def
3746 /UnderlinePosition 0 def /shapecolor 0 def
3747 /XBox 0 def /space 0 def
3748 /XX 0 def /st 1 string def
3749 /Xshadow 0 def /w 0 def
3750 /YBox 0 def /width 0 def
3752 /Yshadow 0 def /xo 0 def
3753 /arrow 0 def /xp 0 def
3754 /bg false def /xt 0 def
3755 /bgcolor 0 def /xw 0 def
3756 /bordercolor 0 def /xx 0 def
3757 /borderwidth 0 def /yi 0 def
3759 /entry 0 def /yp 0 def
3760 /foreground 0 def /yt 0 def
3764 % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
3765 /ISOLatin1Encoding where
3767 {% -- The ISO Latin-1 encoding vector isn't known, so define it.
3768 % -- The first half is the same as the standard encoding,
3769 % -- except for minus instead of hyphen at code 055.
3771 StandardEncoding 0 45 getinterval aload pop
3773 StandardEncoding 46 82 getinterval aload pop
3774 %*** NOTE: the following are missing in the Adobe documentation,
3775 %*** but appear in the displayed table:
3776 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
3778 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3779 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
3780 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
3781 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
3783 /space /exclamdown /cent /sterling
3784 /currency /yen /brokenbar /section
3785 /dieresis /copyright /ordfeminine /guillemotleft
3786 /logicalnot /hyphen /registered /macron
3787 /degree /plusminus /twosuperior /threesuperior
3788 /acute /mu /paragraph /periodcentered
3789 /cedilla /onesuperior /ordmasculine /guillemotright
3790 /onequarter /onehalf /threequarters /questiondown
3792 /Agrave /Aacute /Acircumflex /Atilde
3793 /Adieresis /Aring /AE /Ccedilla
3794 /Egrave /Eacute /Ecircumflex /Edieresis
3795 /Igrave /Iacute /Icircumflex /Idieresis
3796 /Eth /Ntilde /Ograve /Oacute
3797 /Ocircumflex /Otilde /Odieresis /multiply
3798 /Oslash /Ugrave /Uacute /Ucircumflex
3799 /Udieresis /Yacute /Thorn /germandbls
3801 /agrave /aacute /acircumflex /atilde
3802 /adieresis /aring /ae /ccedilla
3803 /egrave /eacute /ecircumflex /edieresis
3804 /igrave /iacute /icircumflex /idieresis
3805 /eth /ntilde /ograve /oacute
3806 /ocircumflex /otilde /odieresis /divide
3807 /oslash /ugrave /uacute /ucircumflex
3808 /udieresis /yacute /thorn /ydieresis
3812 /reencodeFontISO %def
3814 length 12 add dict % Make a new font (a new dict the same size
3815 % as the old one) with room for our new symbols.
3817 begin % Make the new font the current dictionary.
3819 {def}{pop pop}ifelse
3820 }forall % Copy each of the symbols from the old dictionary
3821 % to the new one except for the font ID.
3823 currentdict /FontType get 0 ne
3824 {/Encoding ISOLatin1Encoding def}if % Override the encoding with
3825 % the ISOLatin1 encoding.
3827 % Use the font's bounding box to determine the ascent, descent,
3828 % and overall height; don't forget that these values have to be
3829 % transformed using the font's matrix.
3836 % | | | | Ascent (usually > 0)
3838 % (0 0) -> +--+----+-------->
3840 % | | v Descent (usually < 0)
3841 % (x1 y1) --> +----+ - -
3843 currentdict /FontType get 0 ne
3844 {/FontBBox load aload pop % -- x1 y1 x2 y2
3845 FontMatrix transform /Ascent exch def pop
3846 FontMatrix transform /Descent exch def pop}
3847 {/PrimaryFont FDepVector 0 get def
3848 PrimaryFont /FontBBox get aload pop
3849 PrimaryFont /FontMatrix get transform /Ascent exch def pop
3850 PrimaryFont /FontMatrix get transform /Descent exch def pop
3853 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
3855 % Define these in case they're not in the FontInfo
3856 % (also, here they're easier to get to).
3857 /UnderlinePosition Descent 0.70 mul def
3858 /OverlinePosition Descent UnderlinePosition sub Ascent add def
3859 /StrikeoutPosition Ascent 0.30 mul def
3860 /LineThickness FontHeight 0.05 mul def
3861 /Xshadow FontHeight 0.08 mul def
3862 /Yshadow FontHeight -0.09 mul def
3863 /SpaceBackground Descent neg UnderlinePosition add def
3864 /XBox Descent neg def
3865 /YBox LineThickness 0.7 mul def
3867 currentdict % Leave the new font on the stack
3868 end % Stop using the font as the current dictionary
3869 definefont % Put the font into the font dictionary
3870 pop % Discard the returned font
3874 /DefFont{findfont exch scalefont reencodeFontISO}def
3879 dup /Ascent get /Ascent exch def
3880 dup /Descent get /Descent exch def
3881 dup /FontHeight get /FontHeight exch def
3882 dup /UnderlinePosition get /UnderlinePosition exch def
3883 dup /OverlinePosition get /OverlinePosition exch def
3884 dup /StrikeoutPosition get /StrikeoutPosition exch def
3885 dup /LineThickness get /LineThickness exch def
3886 dup /Xshadow get /Xshadow exch def
3887 dup /Yshadow get /Yshadow exch def
3888 dup /SpaceBackground get /SpaceBackground exch def
3889 dup /XBox get /XBox exch def
3890 dup /YBox get /YBox exch def
3903 /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
3905 % stack: fill-or-not lower-x lower-y upper-x upper-y |- --
3918 % top of stack: fill-or-not
3920 {LineThickness setlinewidth stroke}
3925 % stack: string fill-or-not |- --
3928 /-ox- currentpoint /-oy- exch def def
3930 LineThickness setlinewidth
3932 st dup true charpath
3933 -fillp- {gsave FillBgColor grestore}if
3935 -oy- add /-oy- exch def
3936 -ox- add /-ox- exch def
3943 % stack: fill-or-not delta |- --
3946 xx XBox sub dd sub yy YBox sub dd sub
3947 XX XBox add dd add YY YBox add dd add
3951 % stack: string |- --
3954 Xshadow Yshadow rmoveto
3959 % stack: position |- --
3961 {currentpoint exch pop add dup
3967 LineThickness setlinewidth stroke
3971 % stack: string |- --
3972 % effect: 1 - underline 2 - strikeout 4 - overline
3973 % 8 - shadow 16 - box 32 - outline
3975 {/xx currentpoint dup Descent add /yy exch def
3976 Ascent add /YY exch def def
3977 dup stringwidth pop xx add /XX exch def
3979 {/yy yy Yshadow add def
3980 /XX XX Xshadow add def
3985 {SpaceBackground doBox}
3986 {xx yy XX YY doRect}
3989 Effect 16 and 0 ne{false 0 doBox}if % box
3990 Effect 8 and 0 ne{dup doShadow}if % shadow
3992 {true doOutline} % outline
3993 {show} % normal text
3995 Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
3996 Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
3997 Effect 4 and 0 ne{OverlinePosition Hline}if % overline
4001 "EBNF EPS prologue")
4004 (defconst ebnf-eps-begin
4008 % x y #ebnf2ps#begin
4010 {#ebnf2ps#dict begin /#ebnf2ps#save save def
4011 moveto false BG 0.0 0.0 0.0 setrgbcolor}def
4013 /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
4020 (defconst ebnf-eps-end
4027 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4031 (defvar ebnf-format-float
"%1.3f")
4034 (defun ebnf-format-float (&rest floats
)
4037 (format ebnf-format-float float
))
4042 (defun ebnf-format-color (format-str color default
)
4043 (let* ((the-color (or color default
))
4044 (rgb (ps-color-scale the-color
)))
4047 (ebnf-format-float (nth 0 rgb
) (nth 1 rgb
) (nth 2 rgb
))
4052 (defvar ebnf-message-float
"%3.2f")
4055 (defsubst ebnf-message-float
(format-str value
)
4057 (format ebnf-message-float value
)))
4060 (defvar ebnf-total
0)
4061 (defvar ebnf-nprod
0)
4064 (defsubst ebnf-message-info
(messag)
4065 (message "%s...%3d%%"
4067 (round (/ (* (setq ebnf-nprod
(1+ ebnf-nprod
)) 100.0) ebnf-total
))))
4070 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4074 (defmacro ebnf-node-kind
(vec &optional value
)
4076 `(aset ,vec
0 ,value
)
4080 (defmacro ebnf-node-width-func
(node width
)
4081 `(funcall (aref ,node
1) ,node
,width
))
4084 (defmacro ebnf-node-dimension-func
(node &optional value
)
4086 `(aset ,node
2 ,value
)
4087 `(funcall (aref ,node
2) ,node
)))
4090 (defmacro ebnf-node-entry
(vec &optional value
)
4092 `(aset ,vec
3 ,value
)
4096 (defmacro ebnf-node-height
(vec &optional value
)
4098 `(aset ,vec
4 ,value
)
4102 (defmacro ebnf-node-width
(vec &optional value
)
4104 `(aset ,vec
5 ,value
)
4108 (defmacro ebnf-node-name
(vec)
4112 (defmacro ebnf-node-list
(vec &optional value
)
4114 `(aset ,vec
6 ,value
)
4118 (defmacro ebnf-node-default
(vec)
4122 (defmacro ebnf-node-production
(vec &optional value
)
4124 `(aset ,vec
7 ,value
)
4128 (defmacro ebnf-node-separator
(vec &optional value
)
4130 `(aset ,vec
7 ,value
)
4134 (defmacro ebnf-node-action
(vec &optional value
)
4136 `(aset ,vec
8 ,value
)
4140 (defmacro ebnf-node-generation
(node)
4141 `(funcall (ebnf-node-kind ,node
) ,node
))
4144 (defmacro ebnf-max-width
(prod)
4145 `(max (ebnf-node-width ,prod
)
4146 (+ (* (length (ebnf-node-name ,prod
))
4148 ebnf-production-horizontal-space
)))
4151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4152 ;; PostScript generation
4155 (defun ebnf-generate-eps (ebnf-tree)
4156 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4157 (ps-print-color-scale (if ps-color-p
4158 (float (car (ps-color-values "white")))
4160 (ebnf-total (length ebnf-tree
))
4162 (old-ps-output (symbol-function 'ps-output
))
4163 (old-ps-output-string (symbol-function 'ps-output-string
))
4164 (eps-buffer (get-buffer-create ebnf-eps-buffer-name
))
4165 ebnf-debug-ps error-msg horizontal
4166 prod prod-name prod-width prod-height prod-list file-list
)
4167 ;; redefines `ps-output' and `ps-output-string'
4168 (defalias 'ps-output
'ebnf-eps-output
)
4169 (defalias 'ps-output-string
'ps-output-string-prim
)
4170 ;; generate EPS file
4172 (condition-case data
4175 (setq prod
(car ebnf-tree
)
4176 prod-name
(ebnf-node-name prod
)
4177 prod-width
(ebnf-max-width prod
)
4178 prod-height
(ebnf-node-height prod
)
4179 horizontal
(memq (ebnf-node-action prod
)
4181 ;; generate production in EPS buffer
4183 (set-buffer eps-buffer
)
4184 (setq ebnf-eps-upper-x
0.0
4185 ebnf-eps-upper-y
0.0
4186 ebnf-eps-max-width prod-width
4187 ebnf-eps-max-height prod-height
)
4188 (ebnf-generate-production prod
))
4189 (if (setq prod-list
(cdr (assoc prod-name
4190 ebnf-eps-production-list
)))
4191 ;; insert EPS buffer in all buffer associated with production
4192 (ebnf-eps-production-list prod-list
'file-list horizontal
4193 prod-width prod-height eps-buffer
)
4194 ;; write EPS file for production
4195 (ebnf-eps-finish-and-write eps-buffer
4196 (ebnf-eps-filename prod-name
)))
4197 ;; prepare for next loop
4199 (set-buffer eps-buffer
)
4201 (setq ebnf-tree
(cdr ebnf-tree
)))
4202 ;; write and kill temporary buffers
4203 (ebnf-eps-write-kill-temp file-list t
)
4204 (setq file-list nil
))
4207 (setq error-msg
(error-message-string data
)))))
4208 ;; restore `ps-output' and `ps-output-string'
4209 (defalias 'ps-output old-ps-output
)
4210 (defalias 'ps-output-string old-ps-output-string
)
4211 ;; kill temporary buffers
4212 (kill-buffer eps-buffer
)
4213 (ebnf-eps-write-kill-temp file-list nil
)
4214 (and error-msg
(error error-msg
))
4218 ;; write and kill temporary buffers
4219 (defun ebnf-eps-write-kill-temp (file-list write-p
)
4221 (let ((buffer (get-buffer (concat " *" (car file-list
) "*"))))
4224 (ebnf-eps-finish-and-write buffer
(car file-list
)))
4225 (kill-buffer buffer
)))
4226 (setq file-list
(cdr file-list
))))
4229 ;; insert EPS buffer in all buffer associated with production
4230 (defun ebnf-eps-production-list (prod-list file-list-sym horizontal
4231 prod-width prod-height eps-buffer
)
4233 (add-to-list file-list-sym
(car prod-list
))
4235 (set-buffer (get-buffer-create (concat " *" (car prod-list
) "*")))
4236 (goto-char (point-max))
4239 ((zerop (buffer-size))
4240 (setq ebnf-eps-upper-x
0.0
4241 ebnf-eps-upper-y
0.0
4242 ebnf-eps-max-width prod-width
4243 ebnf-eps-max-height prod-height
))
4246 (ebnf-eop-horizontal ebnf-eps-prod-width
)
4247 (setq ebnf-eps-max-width
(+ ebnf-eps-max-width
4248 ebnf-production-horizontal-space
4250 ebnf-eps-max-height
(max ebnf-eps-max-height prod-height
)))
4253 (ebnf-eop-vertical ebnf-eps-max-height
)
4254 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4255 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4258 ebnf-production-vertical-space
4259 ebnf-eps-max-height
))
4260 ebnf-eps-max-width prod-width
4261 ebnf-eps-max-height prod-height
))
4263 (setq ebnf-eps-prod-width prod-width
)
4264 (insert-buffer eps-buffer
))
4265 (setq prod-list
(cdr prod-list
))))
4268 (defun ebnf-generate (ebnf-tree)
4269 (let* ((ps-color-p (and ebnf-color-p
(ps-color-device)))
4270 (ps-print-color-scale (if ps-color-p
4271 (float (car (ps-color-values "white")))
4273 ps-zebra-stripes ps-line-number ps-razzle-dazzle
4275 ps-print-begin-sheet-hook
4276 ps-print-begin-page-hook
4277 ps-print-begin-column-hook
)
4278 (ps-generate (current-buffer) (point-min) (point-max)
4279 'ebnf-generate-postscript
)))
4282 (defvar ebnf-tree nil
)
4283 (defvar ebnf-direction
"R")
4286 (defun ebnf-generate-postscript (from to
)
4288 (if ebnf-horizontal-max-height
4289 (ebnf-generate-with-max-height)
4290 (ebnf-generate-without-max-height))
4294 (defun ebnf-generate-with-max-height ()
4295 (let ((ebnf-total (length ebnf-tree
))
4297 next-line max-height prod the-width
)
4299 ;; find next line point
4300 (setq next-line ebnf-tree
4301 prod
(car ebnf-tree
)
4302 max-height
(ebnf-node-height prod
))
4303 (ebnf-begin-line prod
(ebnf-max-width prod
))
4304 (while (and (setq next-line
(cdr next-line
))
4305 (setq prod
(car next-line
))
4306 (memq (ebnf-node-action prod
) ebnf-action-list
)
4307 (setq the-width
(ebnf-max-width prod
))
4308 (<= the-width ps-width-remaining
))
4309 (setq max-height
(max max-height
(ebnf-node-height prod
))
4310 ps-width-remaining
(- ps-width-remaining
4312 ebnf-production-horizontal-space
))))
4313 ;; generate current line
4314 (ebnf-newline max-height
)
4315 (setq prod
(car ebnf-tree
))
4316 (ebnf-generate-production prod
)
4317 (while (not (eq (setq ebnf-tree
(cdr ebnf-tree
)) next-line
))
4318 (ebnf-eop-horizontal (ebnf-max-width prod
))
4319 (setq prod
(car ebnf-tree
))
4320 (ebnf-generate-production prod
))
4321 (ebnf-eop-vertical max-height
))))
4324 (defun ebnf-generate-without-max-height ()
4325 (let ((ebnf-total (length ebnf-tree
))
4327 max-height prod bef-width cur-width
)
4329 ;; generate current line
4330 (setq prod
(car ebnf-tree
)
4331 max-height
(ebnf-node-height prod
)
4332 bef-width
(ebnf-max-width prod
))
4333 (ebnf-begin-line prod bef-width
)
4334 (ebnf-generate-production prod
)
4335 (while (and (setq ebnf-tree
(cdr ebnf-tree
))
4336 (setq prod
(car ebnf-tree
))
4337 (memq (ebnf-node-action prod
) ebnf-action-list
)
4338 (setq cur-width
(ebnf-max-width prod
))
4339 (<= cur-width ps-width-remaining
)
4340 (<= (ebnf-node-height prod
) ps-height-remaining
))
4341 (ebnf-eop-horizontal bef-width
)
4342 (ebnf-generate-production prod
)
4343 (setq bef-width cur-width
4344 max-height
(max max-height
(ebnf-node-height prod
))
4345 ps-width-remaining
(- ps-width-remaining
4347 ebnf-production-horizontal-space
))))
4348 (ebnf-eop-vertical max-height
)
4349 ;; prepare next line
4350 (ebnf-newline max-height
))))
4353 (defun ebnf-begin-line (prod width
)
4354 (and (or (eq (ebnf-node-action prod
) 'form-feed
)
4355 (> (ebnf-node-height prod
) ps-height-remaining
))
4357 (setq ps-width-remaining
(- ps-width-remaining
4359 ebnf-production-horizontal-space
))))
4362 (defun ebnf-newline (height)
4363 (and (> height ps-height-remaining
)
4365 (setq ps-width-remaining ps-print-width
4366 ps-height-remaining
(- ps-height-remaining
4368 ebnf-production-vertical-space
))))
4371 ;; [production width-fun dim-fun entry height width name production action]
4372 (defun ebnf-generate-production (production)
4373 (ebnf-message-info "Generating")
4374 (run-hooks 'ebnf-production-hook
)
4375 (ps-output-string (if ebnf-production-name-p
4376 (ebnf-node-name production
)
4380 (ebnf-node-width production
)
4381 (+ (if ebnf-production-name-p
4384 (ebnf-node-entry (ebnf-node-production production
))))
4386 (ebnf-node-generation (ebnf-node-production production
))
4387 (ps-output "EOS\n"))
4390 ;; [alternative width-fun dim-fun entry height width list]
4391 (defun ebnf-generate-alternative (alternative)
4392 (let ((alt (ebnf-node-list alternative
))
4393 (entry (ebnf-node-entry alternative
))
4395 alt-height alt-entry
)
4397 (ps-output (ebnf-format-float (- entry
(ebnf-node-entry (car alt
))))
4399 (setq entry
(- entry
(ebnf-node-height (car alt
)) ebnf-vertical-space
)
4402 (ps-output (format "%d " nlist
)
4403 (ebnf-format-float (ebnf-node-width alternative
))
4405 (setq alt
(ebnf-node-list alternative
))
4407 (ebnf-node-generation (car alt
))
4408 (setq alt-height
(- (ebnf-node-height (car alt
))
4409 (ebnf-node-entry (car alt
)))))
4410 (while (setq alt
(cdr alt
))
4411 (setq alt-entry
(ebnf-node-entry (car alt
)))
4412 (ebnf-vertical-movement
4413 (- (+ alt-height ebnf-vertical-space alt-entry
)))
4414 (ebnf-node-generation (car alt
))
4415 (setq alt-height
(- (ebnf-node-height (car alt
)) alt-entry
))))
4416 (ps-output "EOS\n"))
4419 ;; [sequence width-fun dim-fun entry height width list]
4420 (defun ebnf-generate-sequence (sequence)
4422 (let ((seq (ebnf-node-list sequence
))
4425 (ebnf-node-generation (car seq
))
4426 (setq seq-width
(ebnf-node-width (car seq
))))
4427 (while (setq seq
(cdr seq
))
4428 (ebnf-horizontal-movement seq-width
)
4429 (ebnf-node-generation (car seq
))
4430 (setq seq-width
(ebnf-node-width (car seq
)))))
4431 (ps-output "EOS\n"))
4434 ;; [terminal width-fun dim-fun entry height width name]
4435 (defun ebnf-generate-terminal (terminal)
4436 (ebnf-gen-terminal terminal
"T"))
4439 ;; [non-terminal width-fun dim-fun entry height width name]
4440 (defun ebnf-generate-non-terminal (non-terminal)
4441 (ebnf-gen-terminal non-terminal
"NT"))
4444 ;; [empty width-fun dim-fun entry height width]
4445 (defun ebnf-generate-empty (empty)
4446 (ebnf-empty-alternative (ebnf-node-width empty
)))
4449 ;; [optional width-fun dim-fun entry height width element]
4450 (defun ebnf-generate-optional (optional)
4451 (let ((the-optional (ebnf-node-list optional
)))
4452 (ps-output (ebnf-format-float
4453 (+ (- (ebnf-node-height the-optional
)
4454 (ebnf-node-entry optional
))
4455 ebnf-vertical-space
)
4456 (ebnf-node-width optional
))
4458 (ebnf-node-generation the-optional
)
4459 (ps-output "EOS\n")))
4462 ;; [one-or-more width-fun dim-fun entry height width element separator]
4463 (defun ebnf-generate-one-or-more (one-or-more)
4464 (let* ((width (ebnf-node-width one-or-more
))
4465 (sep (ebnf-node-separator one-or-more
))
4466 (entry (- (ebnf-node-entry one-or-more
)
4468 (ebnf-node-entry sep
)
4470 (ps-output (ebnf-format-float entry width
)
4472 (ebnf-node-generation (ebnf-node-list one-or-more
))
4473 (ebnf-vertical-movement entry
)
4475 (let ((ebnf-direction "L"))
4476 (ebnf-node-generation sep
))
4477 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4478 (ps-output "EOS\n"))
4481 ;; [zero-or-more width-fun dim-fun entry height width element separator]
4482 (defun ebnf-generate-zero-or-more (zero-or-more)
4483 (let* ((width (ebnf-node-width zero-or-more
))
4484 (node-list (ebnf-node-list zero-or-more
))
4485 (list-entry (ebnf-node-entry node-list
))
4486 (node-sep (ebnf-node-separator zero-or-more
))
4487 (entry (+ list-entry
4490 (- (ebnf-node-height node-sep
)
4491 (ebnf-node-entry node-sep
))
4493 (ps-output (ebnf-format-float entry
4494 (+ (- (ebnf-node-height node-list
)
4496 ebnf-vertical-space
)
4499 (ebnf-node-generation (ebnf-node-list zero-or-more
))
4500 (ebnf-vertical-movement entry
)
4501 (if (ebnf-node-separator zero-or-more
)
4502 (let ((ebnf-direction "L"))
4503 (ebnf-node-generation (ebnf-node-separator zero-or-more
)))
4504 (ebnf-empty-alternative (- width ebnf-horizontal-space
))))
4505 (ps-output "EOS\n"))
4508 ;; [special width-fun dim-fun entry height width name]
4509 (defun ebnf-generate-special (special)
4510 (ebnf-gen-terminal special
"SP"))
4513 ;; [repeat width-fun dim-fun entry height width times element]
4514 (defun ebnf-generate-repeat (repeat)
4515 (let ((times (ebnf-node-name repeat
))
4516 (element (ebnf-node-separator repeat
)))
4517 (ps-output-string times
)
4520 (ebnf-node-entry repeat
)
4521 (ebnf-node-height repeat
)
4522 (ebnf-node-width repeat
)
4524 (+ (ebnf-node-width element
)
4525 ebnf-space-R ebnf-space-R ebnf-space-R
4526 (* (length times
) ebnf-font-width-R
))
4528 " " ebnf-direction
"RP\n")
4530 (ebnf-node-generation element
)))
4531 (ps-output "EOS\n"))
4534 ;; [except width-fun dim-fun entry height width element element]
4535 (defun ebnf-generate-except (except)
4536 (let* ((element (ebnf-node-list except
))
4537 (exception (ebnf-node-separator except
))
4538 (width (ebnf-node-width element
)))
4539 (ps-output (ebnf-format-float
4541 (ebnf-node-entry except
)
4542 (ebnf-node-height except
)
4543 (ebnf-node-width except
)
4545 ebnf-space-E ebnf-space-E ebnf-space-E
4548 (+ (ebnf-node-width exception
) ebnf-space-E
)
4550 " " ebnf-direction
"EX\n")
4551 (ebnf-node-generation (ebnf-node-list except
))
4553 (ebnf-horizontal-movement (+ width ebnf-space-E
4554 ebnf-font-width-E ebnf-space-E
))
4555 (ebnf-node-generation exception
)))
4556 (ps-output "EOS\n"))
4559 (defun ebnf-gen-terminal (node code
)
4560 (ps-output-string (ebnf-node-name node
))
4561 (ps-output " " (ebnf-format-float (ebnf-node-width node
))
4562 " " ebnf-direction code
4563 (if (ebnf-node-default node
)
4568 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4569 ;; Internal functions
4572 (defun ebnf-directory (fun &optional directory
)
4573 "Process files in DIRECTORY applying function FUN on each file.
4575 If DIRECTORY is nil, it's used `default-directory'.
4577 The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
4579 (let ((files (directory-files (or directory default-directory
)
4580 t ebnf-file-suffix-regexp
)))
4582 (set-buffer (find-file-noselect (car files
)))
4584 (setq buffer-backed-up t
) ; Do not back it up.
4585 (save-buffer) ; Just save new version.
4586 (kill-buffer (current-buffer))
4587 (setq files
(cdr files
)))))
4590 (defun ebnf-file (fun file
&optional do-not-kill-buffer-when-done
)
4591 "Process file FILE applying function FUN.
4593 If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
4594 killed after process termination."
4595 (set-buffer (find-file-noselect file
))
4597 (or do-not-kill-buffer-when-done
4598 (kill-buffer (current-buffer))))
4601 ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
4602 ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
4603 ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
4604 ;; from \177 to \237). It seems that version 20.7 has the same problem.
4605 (defun ebnf-range-regexp (prefix from to
)
4608 (setq str
(concat str
(char-to-string from
))
4610 (concat prefix str
)))
4613 (defvar ebnf-map-name
4614 (let ((map (make-vector 256 ?\_
)))
4615 (mapcar #'(lambda (char)
4616 (aset map char char
))
4617 (concat "#$%&+-.0123456789=?@~"
4618 "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
4619 "abcdefghijklmnopqrstuvwxyz"))
4623 (defun ebnf-eps-filename (str)
4624 (let* ((len (length str
))
4626 (new (make-string len ?\
)))
4628 (aset new stri
(aref ebnf-map-name
(aref str stri
)))
4629 (setq stri
(1+ stri
)))
4630 (concat ebnf-eps-prefix new
".eps")))
4633 (defun ebnf-eps-output (&rest args
)
4636 (setq args
(cdr args
))))
4639 (defun ebnf-generate-region (from to gen-func
)
4640 (run-hooks 'ebnf-hook
)
4641 (let ((ebnf-limit (max from to
))
4642 (error-msg "SYNTAX")
4647 (condition-case data
4648 (let ((tree (ebnf-parse-and-sort (min from to
))))
4650 (setq error-msg
"EMPTY RULES"
4651 tree
(ebnf-eliminate-empty-rules tree
))
4652 (setq error-msg
"OPTMIZE"
4653 tree
(ebnf-optimize tree
))
4654 (setq error-msg
"DIMENSIONS"
4655 tree
(ebnf-dimensions tree
))
4656 (setq error-msg
"GENERATION")
4657 (funcall gen-func tree
))
4658 (setq error-msg nil
)) ; here it's ok
4662 (setq the-point
(max (1- (point)) (point-min))
4663 error-msg
(concat error-msg
": "
4664 (error-message-string data
)
4666 (and (string= error-msg
"SYNTAX")
4667 (format "at position %d "
4669 (format "in buffer \"%s\"."
4670 (buffer-name)))))))))
4674 (goto-char the-point
)
4675 (if ebnf-stop-on-error
4677 (message error-msg
)))
4678 ;; generated output OK
4681 ;; syntax checked OK
4683 (message "EBNF syntactic analysis: NO ERRORS.")))))
4686 (defun ebnf-parse-and-sort (start)
4688 (let ((tree (funcall ebnf-parser-func start
)))
4689 (if ebnf-sort-production
4691 (message "Sorting...")
4693 (if (eq ebnf-sort-production
'ascending
)
4694 'ebnf-sorter-ascending
4695 'ebnf-sorter-descending
)))
4699 (defun ebnf-sorter-ascending (first second
)
4700 (string< (ebnf-node-name first
)
4701 (ebnf-node-name second
)))
4704 (defun ebnf-sorter-descending (first second
)
4705 (string< (ebnf-node-name second
)
4706 (ebnf-node-name first
)))
4709 (defun ebnf-empty-alternative (width)
4710 (ps-output (ebnf-format-float width
) " EA\n"))
4713 (defun ebnf-vertical-movement (height)
4714 (ps-output (ebnf-format-float height
) " vm\n"))
4717 (defun ebnf-horizontal-movement (width)
4718 (ps-output (ebnf-format-float width
) " hm\n"))
4721 (defun ebnf-entry (height)
4722 (* height ebnf-entry-percentage
))
4725 (defun ebnf-eop-vertical (height)
4726 (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space
))
4730 (defun ebnf-eop-horizontal (width)
4731 (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space
))
4735 (defun ebnf-new-page ()
4736 (when (< ps-height-remaining ps-print-height
)
4737 (run-hooks 'ebnf-page-hook
)
4742 (defsubst ebnf-font-size
(font) (nth 0 font
))
4743 (defsubst ebnf-font-name
(font) (nth 1 font
))
4744 (defsubst ebnf-font-foreground
(font) (nth 2 font
))
4745 (defsubst ebnf-font-background
(font) (nth 3 font
))
4746 (defsubst ebnf-font-list
(font) (nthcdr 4 font
))
4747 (defsubst ebnf-font-attributes
(font)
4748 (lsh (ps-extension-bit (cdr font
)) -
2))
4751 (defconst ebnf-font-name-select
4752 (vector 'normal
'bold
'italic
'bold-italic
))
4755 (defun ebnf-font-name-select (font)
4756 (let* ((font-list (ebnf-font-list font
))
4757 (font-index (+ (if (memq 'bold font-list
) 1 0)
4758 (if (memq 'italic font-list
) 2 0)))
4759 (name (ebnf-font-name font
))
4760 (database (cdr (assoc name ps-font-info-database
)))
4761 (info-list (or (cdr (assoc 'fonts database
))
4762 (error "Invalid font: %s" name
))))
4763 (or (cdr (assoc (aref ebnf-font-name-select font-index
)
4765 (error "Invalid attributes for font %s" name
))))
4768 (defun ebnf-font-select (font select
)
4769 (let* ((name (ebnf-font-name font
))
4770 (database (cdr (assoc name ps-font-info-database
)))
4771 (size (cdr (assoc 'size database
)))
4772 (base (cdr (assoc select database
))))
4774 (/ (* (ebnf-font-size font
) base
)
4776 (error "Invalid font: %s" name
))))
4779 (defsubst ebnf-font-width
(font)
4780 (ebnf-font-select font
'avg-char-width
))
4781 (defsubst ebnf-font-height
(font)
4782 (ebnf-font-select font
'line-height
))
4785 (defconst ebnf-syntax-alist
4786 ;; 0.syntax 1.parser 2.initializer
4787 '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize
)
4788 (yacc ebnf-yac-parser ebnf-yac-initialize
)
4789 (abnf ebnf-abn-parser ebnf-abn-initialize
)
4790 (ebnf ebnf-bnf-parser ebnf-bnf-initialize
)
4791 (ebnfx ebnf-ebx-parser ebnf-ebx-initialize
)
4792 (dtd ebnf-dtd-parser ebnf-dtd-initialize
))
4793 "Alist associating ebnf syntax with a parser and a initializer.")
4796 (defun ebnf-begin-job ()
4797 (ps-printing-region nil nil nil
)
4798 (if ebnf-use-float-format
4799 (setq ebnf-format-float
"%1.3f"
4800 ebnf-message-float
"%3.2f")
4801 (setq ebnf-format-float
"%s"
4802 ebnf-message-float
"%s"))
4803 (ebnf-otz-initialize)
4804 ;; to avoid compilation gripes when calling autoloaded functions
4805 (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist
)
4806 (assoc 'ebnf ebnf-syntax-alist
))))
4807 (setq ebnf-parser-func
(nth 1 init
))
4808 (funcall (nth 2 init
)))
4809 (and ebnf-terminal-regexp
; ensures that it's a string or nil
4810 (not (stringp ebnf-terminal-regexp
))
4811 (setq ebnf-terminal-regexp nil
))
4812 (or (and ebnf-eps-prefix
; ensures that it's a string
4813 (stringp ebnf-eps-prefix
))
4814 (setq ebnf-eps-prefix
"ebnf--"))
4815 (setq ebnf-entry-percentage
; ensures value between 0.0 and 1.0
4816 (min (max ebnf-entry-percentage
0.0) 1.0)
4817 ebnf-action-list
(if ebnf-horizontal-orientation
4821 ebnf-fonts-required nil
4824 ebnf-eps-context nil
4825 ebnf-eps-production-list nil
4826 ebnf-eps-upper-x
0.0
4827 ebnf-eps-upper-y
0.0
4828 ebnf-font-height-P
(ebnf-font-height ebnf-production-font
)
4829 ebnf-font-height-T
(ebnf-font-height ebnf-terminal-font
)
4830 ebnf-font-height-NT
(ebnf-font-height ebnf-non-terminal-font
)
4831 ebnf-font-height-S
(ebnf-font-height ebnf-special-font
)
4832 ebnf-font-height-E
(ebnf-font-height ebnf-except-font
)
4833 ebnf-font-height-R
(ebnf-font-height ebnf-repeat-font
)
4834 ebnf-font-width-P
(ebnf-font-width ebnf-production-font
)
4835 ebnf-font-width-T
(ebnf-font-width ebnf-terminal-font
)
4836 ebnf-font-width-NT
(ebnf-font-width ebnf-non-terminal-font
)
4837 ebnf-font-width-S
(ebnf-font-width ebnf-special-font
)
4838 ebnf-font-width-E
(ebnf-font-width ebnf-except-font
)
4839 ebnf-font-width-R
(ebnf-font-width ebnf-repeat-font
)
4840 ebnf-space-T
(* ebnf-font-height-T
0.5)
4841 ebnf-space-NT
(* ebnf-font-height-NT
0.5)
4842 ebnf-space-S
(* ebnf-font-height-S
0.5)
4843 ebnf-space-E
(* ebnf-font-height-E
0.5)
4844 ebnf-space-R
(* ebnf-font-height-R
0.5))
4845 (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT
)))
4846 (setq ebnf-basic-width
(* basic
0.5)
4847 ebnf-horizontal-space
(+ basic basic
)
4848 ebnf-basic-height ebnf-basic-width
4849 ebnf-vertical-space ebnf-basic-width
)
4850 ;; ensures value is greater than zero
4851 (or (and (numberp ebnf-production-horizontal-space
)
4852 (> ebnf-production-horizontal-space
0.0))
4853 (setq ebnf-production-horizontal-space basic
))
4854 ;; ensures value is greater than zero
4855 (or (and (numberp ebnf-production-vertical-space
)
4856 (> ebnf-production-vertical-space
0.0))
4857 (setq ebnf-production-vertical-space basic
))))
4860 (defsubst ebnf-shape-value
(sym alist
)
4861 (or (cdr (assq sym alist
)) 0))
4864 (defsubst ebnf-boolean
(value)
4865 (if value
"true" "false"))
4868 (defun ebnf-begin-file ()
4871 (set-buffer ps-spool-buffer
)
4872 (goto-char (point-min))
4873 (and (search-forward "%%Creator: " nil t
)
4874 (not (search-forward "& ebnf2ps v"
4875 (save-excursion (end-of-line) (point))
4878 ;; adjust creator comment
4881 (insert " & ebnf2ps v" ebnf-version
)
4882 ;; insert ebnf settings & engine
4883 (goto-char (point-max))
4884 (search-backward "\n%%EndProlog\n")
4885 (ebnf-insert-ebnf-prologue)
4886 (ps-output "\n")))))
4889 (defun ebnf-eps-finish-and-write (buffer filename
)
4890 (when (buffer-modified-p buffer
)
4893 (setq ebnf-eps-upper-x
(max ebnf-eps-upper-x ebnf-eps-max-width
)
4894 ebnf-eps-upper-y
(if (zerop ebnf-eps-upper-y
)
4897 ebnf-production-vertical-space
4898 ebnf-eps-max-height
)))
4900 (goto-char (point-min))
4902 "%!PS-Adobe-3.0 EPSF-3.0"
4903 "\n%%BoundingBox: 0 0 "
4904 (format "%d %d" (1+ ebnf-eps-upper-x
) (1+ ebnf-eps-upper-y
))
4905 "\n%%Title: " filename
4906 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4907 "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version
")"
4908 "\n%%DocumentNeededResources: font "
4909 (or ebnf-fonts-required
4910 (setq ebnf-fonts-required
4911 (mapconcat 'identity
4912 (ps-remove-duplicates
4913 (mapcar 'ebnf-font-name-select
4914 (list ebnf-production-font
4916 ebnf-non-terminal-font
4921 "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
4923 (ebnf-insert-ebnf-prologue)
4924 (insert ebnf-eps-begin
4925 "\n0 " (ebnf-format-float
4926 (- ebnf-eps-upper-y
(* ebnf-font-height-P
0.7)))
4927 " #ebnf2ps#begin\n")
4929 (goto-char (point-max))
4930 (insert ebnf-eps-end
)
4932 (message "Saving...")
4933 (setq filename
(expand-file-name filename
))
4934 (let ((coding-system-for-write 'raw-text-unix
))
4935 (write-region (point-min) (point-max) filename
))
4936 (message "Wrote %s" filename
))))
4939 (defun ebnf-insert-ebnf-prologue ()
4944 "\n\n% === begin EBNF settings\n\n"
4946 (format "/fP %s /%s DefFont\n"
4947 (ebnf-format-float (ebnf-font-size ebnf-production-font
))
4948 (ebnf-font-name-select ebnf-production-font
))
4949 (ebnf-format-color "/ForegroundP %s def %% %s\n"
4950 (ebnf-font-foreground ebnf-production-font
)
4952 (ebnf-format-color "/BackgroundP %s def %% %s\n"
4953 (ebnf-font-background ebnf-production-font
)
4955 (format "/EffectP %d def\n"
4956 (ebnf-font-attributes ebnf-production-font
))
4958 (format "/fT %s /%s DefFont\n"
4959 (ebnf-format-float (ebnf-font-size ebnf-terminal-font
))
4960 (ebnf-font-name-select ebnf-terminal-font
))
4961 (ebnf-format-color "/ForegroundT %s def %% %s\n"
4962 (ebnf-font-foreground ebnf-terminal-font
)
4964 (ebnf-format-color "/BackgroundT %s def %% %s\n"
4965 (ebnf-font-background ebnf-terminal-font
)
4967 (format "/EffectT %d def\n"
4968 (ebnf-font-attributes ebnf-terminal-font
))
4969 (format "/BorderWidthT %s def\n"
4970 (ebnf-format-float ebnf-terminal-border-width
))
4971 (ebnf-format-color "/BorderColorT %s def %% %s\n"
4972 ebnf-terminal-border-color
4974 (format "/ShapeT %d def\n"
4975 (ebnf-shape-value ebnf-terminal-shape
4976 ebnf-terminal-shape-alist
))
4977 (format "/ShadowT %s def\n"
4978 (ebnf-boolean ebnf-terminal-shadow
))
4980 (format "/fNT %s /%s DefFont\n"
4982 (ebnf-font-size ebnf-non-terminal-font
))
4983 (ebnf-font-name-select ebnf-non-terminal-font
))
4984 (ebnf-format-color "/ForegroundNT %s def %% %s\n"
4985 (ebnf-font-foreground ebnf-non-terminal-font
)
4987 (ebnf-format-color "/BackgroundNT %s def %% %s\n"
4988 (ebnf-font-background ebnf-non-terminal-font
)
4990 (format "/EffectNT %d def\n"
4991 (ebnf-font-attributes ebnf-non-terminal-font
))
4992 (format "/BorderWidthNT %s def\n"
4993 (ebnf-format-float ebnf-non-terminal-border-width
))
4994 (ebnf-format-color "/BorderColorNT %s def %% %s\n"
4995 ebnf-non-terminal-border-color
4997 (format "/ShapeNT %d def\n"
4998 (ebnf-shape-value ebnf-non-terminal-shape
4999 ebnf-terminal-shape-alist
))
5000 (format "/ShadowNT %s def\n"
5001 (ebnf-boolean ebnf-non-terminal-shadow
))
5003 (format "/fS %s /%s DefFont\n"
5004 (ebnf-format-float (ebnf-font-size ebnf-special-font
))
5005 (ebnf-font-name-select ebnf-special-font
))
5006 (ebnf-format-color "/ForegroundS %s def %% %s\n"
5007 (ebnf-font-foreground ebnf-special-font
)
5009 (ebnf-format-color "/BackgroundS %s def %% %s\n"
5010 (ebnf-font-background ebnf-special-font
)
5012 (format "/EffectS %d def\n"
5013 (ebnf-font-attributes ebnf-special-font
))
5014 (format "/BorderWidthS %s def\n"
5015 (ebnf-format-float ebnf-special-border-width
))
5016 (ebnf-format-color "/BorderColorS %s def %% %s\n"
5017 ebnf-special-border-color
5019 (format "/ShapeS %d def\n"
5020 (ebnf-shape-value ebnf-special-shape
5021 ebnf-terminal-shape-alist
))
5022 (format "/ShadowS %s def\n"
5023 (ebnf-boolean ebnf-special-shadow
))
5025 (format "/fE %s /%s DefFont\n"
5026 (ebnf-format-float (ebnf-font-size ebnf-except-font
))
5027 (ebnf-font-name-select ebnf-except-font
))
5028 (ebnf-format-color "/ForegroundE %s def %% %s\n"
5029 (ebnf-font-foreground ebnf-except-font
)
5031 (ebnf-format-color "/BackgroundE %s def %% %s\n"
5032 (ebnf-font-background ebnf-except-font
)
5034 (format "/EffectE %d def\n"
5035 (ebnf-font-attributes ebnf-except-font
))
5036 (format "/BorderWidthE %s def\n"
5037 (ebnf-format-float ebnf-except-border-width
))
5038 (ebnf-format-color "/BorderColorE %s def %% %s\n"
5039 ebnf-except-border-color
5041 (format "/ShapeE %d def\n"
5042 (ebnf-shape-value ebnf-except-shape
5043 ebnf-terminal-shape-alist
))
5044 (format "/ShadowE %s def\n"
5045 (ebnf-boolean ebnf-except-shadow
))
5047 (format "/fR %s /%s DefFont\n"
5048 (ebnf-format-float (ebnf-font-size ebnf-repeat-font
))
5049 (ebnf-font-name-select ebnf-repeat-font
))
5050 (ebnf-format-color "/ForegroundR %s def %% %s\n"
5051 (ebnf-font-foreground ebnf-repeat-font
)
5053 (ebnf-format-color "/BackgroundR %s def %% %s\n"
5054 (ebnf-font-background ebnf-repeat-font
)
5056 (format "/EffectR %d def\n"
5057 (ebnf-font-attributes ebnf-repeat-font
))
5058 (format "/BorderWidthR %s def\n"
5059 (ebnf-format-float ebnf-repeat-border-width
))
5060 (ebnf-format-color "/BorderColorR %s def %% %s\n"
5061 ebnf-repeat-border-color
5063 (format "/ShapeR %d def\n"
5064 (ebnf-shape-value ebnf-repeat-shape
5065 ebnf-terminal-shape-alist
))
5066 (format "/ShadowR %s def\n"
5067 (ebnf-boolean ebnf-repeat-shadow
))
5069 (format "/DefaultWidth %s def\n"
5070 (ebnf-format-float ebnf-default-width
))
5071 (format "/LineWidth %s def\n"
5072 (ebnf-format-float ebnf-line-width
))
5073 (ebnf-format-color "/LineColor %s def %% %s\n"
5076 (format "/ArrowShape %d def\n"
5077 (ebnf-shape-value ebnf-arrow-shape
5078 ebnf-arrow-shape-alist
))
5079 (format "/ChartShape %d def\n"
5080 (ebnf-shape-value ebnf-chart-shape
5081 ebnf-terminal-shape-alist
))
5082 (format "/UserArrow{%s}def\n"
5083 (let ((arrow (eval ebnf-user-arrow
)))
5087 "\n% === end EBNF settings\n\n"
5088 (and ebnf-debug-ps ebnf-debug
))))
5092 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5093 ;; Adjusting dimensions
5096 (defun ebnf-dimensions (tree)
5097 (let ((ebnf-total (length tree
))
5099 (mapcar 'ebnf-production-dimension tree
))
5103 ;; [empty width-fun dim-fun entry height width]
5104 ;;(defun ebnf-empty-dimension (empty)
5108 ;; [production width-fun dim-fun entry height width name production action]
5109 (defun ebnf-production-dimension (production)
5110 (ebnf-message-info "Calculating dimensions")
5111 (ebnf-node-dimension-func (ebnf-node-production production
))
5112 (let* ((prod (ebnf-node-production production
))
5113 (height (+ (if ebnf-production-name-p
5116 ebnf-line-width ebnf-line-width
5118 (ebnf-node-height prod
))))
5119 (ebnf-node-entry production height
)
5120 (ebnf-node-height production height
)
5121 (ebnf-node-width production
(+ (ebnf-node-width prod
)
5123 ebnf-horizontal-space
))))
5126 ;; [terminal width-fun dim-fun entry height width name]
5127 (defun ebnf-terminal-dimension (terminal)
5128 (ebnf-terminal-dimension1 terminal
5134 ;; [non-terminal width-fun dim-fun entry height width name]
5135 (defun ebnf-non-terminal-dimension (non-terminal)
5136 (ebnf-terminal-dimension1 non-terminal
5142 ;; [special width-fun dim-fun entry height width name]
5143 (defun ebnf-special-dimension (special)
5144 (ebnf-terminal-dimension1 special
5150 (defun ebnf-terminal-dimension1 (node font-height font-width space
)
5151 (let ((height (+ space font-height space
))
5152 (len (length (ebnf-node-name node
))))
5153 (ebnf-node-entry node
(* height
0.5))
5154 (ebnf-node-height node height
)
5155 (ebnf-node-width node
(+ ebnf-basic-width space
5157 space ebnf-basic-width
))))
5160 (defconst ebnf-null-vector
(vector t t t
0.0 0.0 0.0))
5163 ;; [repeat width-fun dim-fun entry height width times element]
5164 (defun ebnf-repeat-dimension (repeat)
5165 (let ((times (ebnf-node-name repeat
))
5166 (element (ebnf-node-separator repeat
)))
5168 (ebnf-node-dimension-func element
)
5169 (setq element ebnf-null-vector
))
5170 (ebnf-node-entry repeat
(+ (ebnf-node-entry element
)
5172 (ebnf-node-height repeat
(+ (max (ebnf-node-height element
)
5174 ebnf-space-R ebnf-space-R
))
5175 (ebnf-node-width repeat
(+ (ebnf-node-width element
)
5176 ebnf-space-R ebnf-space-R ebnf-space-R
5177 ebnf-horizontal-space
5178 (* (length times
) ebnf-font-width-R
)))))
5181 ;; [except width-fun dim-fun entry height width element element]
5182 (defun ebnf-except-dimension (except)
5183 (let ((factor (ebnf-node-list except
))
5184 (element (ebnf-node-separator except
)))
5185 (ebnf-node-dimension-func factor
)
5187 (ebnf-node-dimension-func element
)
5188 (setq element ebnf-null-vector
))
5189 (ebnf-node-entry except
(+ (max (ebnf-node-entry factor
)
5190 (ebnf-node-entry element
))
5192 (ebnf-node-height except
(+ (max (ebnf-node-height factor
)
5193 (ebnf-node-height element
))
5194 ebnf-space-E ebnf-space-E
))
5195 (ebnf-node-width except
(+ (ebnf-node-width factor
)
5196 (ebnf-node-width element
)
5197 ebnf-space-E ebnf-space-E
5198 ebnf-space-E ebnf-space-E
5200 ebnf-horizontal-space
))))
5203 ;; [alternative width-fun dim-fun entry height width list]
5204 (defun ebnf-alternative-dimension (alternative)
5205 (let ((body (ebnf-node-list alternative
))
5206 (lis (ebnf-node-list alternative
)))
5208 (ebnf-node-dimension-func (car lis
))
5209 (setq lis
(cdr lis
)))
5213 (tail (car (last body
)))
5214 (entry (ebnf-node-entry (car body
)))
5217 (setq node
(car alt
)
5219 height
(+ (ebnf-node-height node
) height
)
5220 width
(max (ebnf-node-width node
) width
)))
5221 (ebnf-adjust-width body width
)
5222 (setq height
(+ height
(* (1- (length body
)) ebnf-vertical-space
)))
5223 (ebnf-node-entry alternative
(+ entry
5226 (- (ebnf-node-height tail
)
5227 (ebnf-node-entry tail
))))))
5228 (ebnf-node-height alternative height
)
5229 (ebnf-node-width alternative
(+ width ebnf-horizontal-space
))
5230 (ebnf-node-list alternative body
))))
5233 ;; [optional width-fun dim-fun entry height width element]
5234 (defun ebnf-optional-dimension (optional)
5235 (let ((body (ebnf-node-list optional
)))
5236 (ebnf-node-dimension-func body
)
5237 (ebnf-node-entry optional
(ebnf-node-entry body
))
5238 (ebnf-node-height optional
(+ (ebnf-node-height body
)
5239 ebnf-vertical-space
))
5240 (ebnf-node-width optional
(+ (ebnf-node-width body
)
5241 ebnf-horizontal-space
))))
5244 ;; [one-or-more width-fun dim-fun entry height width element separator]
5245 (defun ebnf-one-or-more-dimension (or-more)
5246 (let ((list-part (ebnf-node-list or-more
))
5247 (sep-part (ebnf-node-separator or-more
)))
5248 (ebnf-node-dimension-func list-part
)
5250 (ebnf-node-dimension-func sep-part
))
5251 (let ((height (+ (if sep-part
5252 (ebnf-node-height sep-part
)
5255 (ebnf-node-height list-part
)))
5256 (width (max (if sep-part
5257 (ebnf-node-width sep-part
)
5259 (ebnf-node-width list-part
))))
5261 (ebnf-adjust-width list-part width
)
5262 (ebnf-adjust-width sep-part width
))
5263 (ebnf-node-entry or-more
(+ (- height
(ebnf-node-height list-part
))
5264 (ebnf-node-entry list-part
)))
5265 (ebnf-node-height or-more height
)
5266 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
5269 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5270 (defun ebnf-zero-or-more-dimension (or-more)
5271 (let ((list-part (ebnf-node-list or-more
))
5272 (sep-part (ebnf-node-separator or-more
)))
5273 (ebnf-node-dimension-func list-part
)
5275 (ebnf-node-dimension-func sep-part
))
5276 (let ((height (+ (if sep-part
5277 (ebnf-node-height sep-part
)
5280 (ebnf-node-height list-part
)
5281 ebnf-vertical-space
))
5282 (width (max (if sep-part
5283 (ebnf-node-width sep-part
)
5285 (ebnf-node-width list-part
))))
5287 (ebnf-adjust-width list-part width
)
5288 (ebnf-adjust-width sep-part width
))
5289 (ebnf-node-entry or-more height
)
5290 (ebnf-node-height or-more height
)
5291 (ebnf-node-width or-more
(+ width ebnf-horizontal-space
)))))
5294 ;; [sequence width-fun dim-fun entry height width list]
5295 (defun ebnf-sequence-dimension (sequence)
5299 (lis (ebnf-node-list sequence
))
5302 (setq node
(car lis
)
5304 (ebnf-node-dimension-func node
)
5305 (setq entry
(ebnf-node-entry node
)
5306 above
(max above entry
)
5307 below
(max below
(- (ebnf-node-height node
) entry
))
5308 width
(+ width
(ebnf-node-width node
))))
5309 (ebnf-node-entry sequence above
)
5310 (ebnf-node-height sequence
(+ above below
))
5311 (ebnf-node-width sequence width
)))
5314 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5318 (defun ebnf-adjust-width (node width
)
5324 (setcar node
(ebnf-adjust-width (car node
) width
))
5325 (setq node
(cdr node
)))))
5328 ;; nothing to be done
5329 ((= width
(ebnf-node-width node
))
5331 ;; left justify term
5332 ((eq ebnf-justify-sequence
'left
)
5333 (ebnf-adjust-empty node width nil
))
5334 ;; right justify terms
5335 ((eq ebnf-justify-sequence
'right
)
5336 (ebnf-adjust-empty node width t
))
5339 (ebnf-node-width-func node width
)
5340 (ebnf-node-width node width
)
5348 (defun ebnf-adjust-empty (node width last-p
)
5349 (if (eq (ebnf-node-kind node
) 'ebnf-generate-empty
)
5351 (ebnf-node-width node width
)
5353 (let ((empty (ebnf-make-empty (- width
(ebnf-node-width node
)))))
5354 (ebnf-make-dup-sequence node
5357 (list node empty
))))))
5360 ;; [terminal width-fun dim-fun entry height width name]
5361 ;; [non-terminal width-fun dim-fun entry height width name]
5362 ;; [empty width-fun dim-fun entry height width]
5363 ;; [special width-fun dim-fun entry height width name]
5364 ;; [repeat width-fun dim-fun entry height width times element]
5365 ;; [except width-fun dim-fun entry height width element element]
5366 ;;(defun ebnf-terminal-width (terminal width)
5370 ;; [alternative width-fun dim-fun entry height width list]
5371 ;; [optional width-fun dim-fun entry height width element]
5372 (defun ebnf-alternative-width (alternative width
)
5373 (ebnf-adjust-width (ebnf-node-list alternative
)
5374 (- width ebnf-horizontal-space
)))
5377 ;; [one-or-more width-fun dim-fun entry height width element separator]
5378 ;; [zero-or-more width-fun dim-fun entry height width element separator]
5379 (defun ebnf-element-width (or-more width
)
5380 (setq width
(- width ebnf-horizontal-space
))
5381 (ebnf-node-list or-more
5382 (ebnf-justify-list or-more
5383 (ebnf-node-list or-more
)
5385 (ebnf-node-separator or-more
5386 (ebnf-justify-list or-more
5387 (ebnf-node-separator or-more
)
5391 ;; [sequence width-fun dim-fun entry height width list]
5392 (defun ebnf-sequence-width (sequence width
)
5393 (ebnf-node-list sequence
5394 (ebnf-justify-list sequence
5395 (ebnf-node-list sequence
)
5399 (defun ebnf-justify-list (node seq width
)
5400 (let ((seq-width (ebnf-node-width node
)))
5401 (if (= width seq-width
)
5404 ;; left justify terms
5405 ((eq ebnf-justify-sequence
'left
)
5406 (ebnf-justify node seq seq-width width t
))
5407 ;; right justify terms
5408 ((eq ebnf-justify-sequence
'right
)
5409 (ebnf-justify node seq seq-width width nil
))
5410 ;; centralize terms -- element
5412 (ebnf-adjust-width seq width
))
5413 ;; centralize terms -- list
5415 (let ((the-width (/ (- width seq-width
) (length seq
)))
5418 (ebnf-adjust-width (car lis
)
5419 (+ (ebnf-node-width (car lis
))
5421 (setq lis
(cdr lis
)))
5426 (defun ebnf-justify (node seq seq-width width last-p
)
5427 (let ((term (car (if last-p
(last seq
) seq
))))
5429 ;; adjust empty term
5430 ((eq (ebnf-node-kind term
) 'ebnf-generate-empty
)
5431 (ebnf-node-width term
(+ (- width seq-width
)
5432 (ebnf-node-width term
)))
5434 ;; insert empty at end ==> left justify
5437 (list (ebnf-make-empty (- width seq-width
)))))
5438 ;; insert empty at beginning ==> right justify
5440 (cons (ebnf-make-empty (- width seq-width
))
5445 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5446 ;; Functions used by parsers
5449 (defun ebnf-eps-add-context (name)
5450 (let ((filename (ebnf-eps-filename name
)))
5451 (if (member filename ebnf-eps-context
)
5452 (error "Try to open an already opened EPS file: %s" filename
)
5453 (setq ebnf-eps-context
(cons filename ebnf-eps-context
)))))
5456 (defun ebnf-eps-remove-context (name)
5457 (let ((filename (ebnf-eps-filename name
)))
5458 (if (member filename ebnf-eps-context
)
5459 (setq ebnf-eps-context
(delete filename ebnf-eps-context
))
5460 (error "Try to close a not opened EPS file: %s" filename
))))
5463 (defun ebnf-eps-add-production (header)
5464 (and ebnf-eps-executing
5466 (let ((prod (assoc header ebnf-eps-production-list
)))
5468 (setcdr prod
(append ebnf-eps-context
(cdr prod
)))
5469 (setq ebnf-eps-production-list
5470 (cons (cons header
(ebnf-dup-list ebnf-eps-context
))
5471 ebnf-eps-production-list
))))))
5474 (defun ebnf-dup-list (old)
5477 (setq new
(cons (car old
) new
)
5482 (defun ebnf-buffer-substring (chars)
5483 (buffer-substring-no-properties
5486 (skip-chars-forward chars ebnf-limit
)
5490 ;; replace the range "\240-\377" (see `ebnf-range-regexp').
5491 (defconst ebnf-8-bit-chars
(ebnf-range-regexp "" ?
\240 ?
\377))
5494 (defun ebnf-string (chars eos-char kind
)
5496 (buffer-substring-no-properties
5499 ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
5500 (skip-chars-forward (concat chars ebnf-8-bit-chars
) ebnf-limit
)
5501 (if (or (eobp) (/= (following-char) eos-char
))
5502 (error "Invalid %s: missing `%c'" kind eos-char
)
5507 (defun ebnf-get-string ()
5509 (buffer-substring-no-properties (point) (ebnf-end-of-string)))
5512 (defun ebnf-end-of-string ()
5514 (while (> (logand n
1) 0)
5515 (skip-chars-forward "^\"" ebnf-limit
)
5516 (setq n
(- (skip-chars-backward "\\\\")))
5517 (goto-char (+ (point) n
1))))
5518 (if (= (preceding-char) ?
\")
5520 (error "Missing `\"'")))
5523 (defun ebnf-trim-right (str)
5524 (let* ((len (1- (length str
)))
5526 (while (and (> index
0) (= (aref str index
) ?\
))
5527 (setq index
(1- index
)))
5530 (substring str
0 (1+ index
)))))
5533 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5537 (defun ebnf-make-empty (&optional width
)
5538 (vector 'ebnf-generate-empty
5543 (or width ebnf-horizontal-space
)))
5546 (defun ebnf-make-terminal (name)
5547 (ebnf-make-terminal1 name
5548 'ebnf-generate-terminal
5549 'ebnf-terminal-dimension
))
5552 (defun ebnf-make-non-terminal (name)
5553 (ebnf-make-terminal1 name
5554 'ebnf-generate-non-terminal
5555 'ebnf-non-terminal-dimension
))
5558 (defun ebnf-make-special (name)
5559 (ebnf-make-terminal1 name
5560 'ebnf-generate-special
5561 'ebnf-special-dimension
))
5564 (defun ebnf-make-terminal1 (name gen-func dim-func
)
5571 (let ((len (length name
)))
5572 (cond ((> len
3) name
)
5573 ((= len
3) (concat name
" "))
5574 ((= len
2) (concat " " name
" "))
5575 ((= len
1) (concat " " name
" "))
5580 (defun ebnf-make-one-or-more (list-part &optional sep-part
)
5581 (ebnf-make-or-more1 'ebnf-generate-one-or-more
5582 'ebnf-one-or-more-dimension
5587 (defun ebnf-make-zero-or-more (list-part &optional sep-part
)
5588 (ebnf-make-or-more1 'ebnf-generate-zero-or-more
5589 'ebnf-zero-or-more-dimension
5594 (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part
)
5601 (if (listp list-part
)
5602 (ebnf-make-sequence list-part
)
5604 (if (and sep-part
(listp sep-part
))
5605 (ebnf-make-sequence sep-part
)
5609 (defun ebnf-make-production (name prod action
)
5610 (vector 'ebnf-generate-production
5612 'ebnf-production-dimension
5621 (defun ebnf-make-alternative (body)
5622 (vector 'ebnf-generate-alternative
5623 'ebnf-alternative-width
5624 'ebnf-alternative-dimension
5631 (defun ebnf-make-optional (body)
5632 (vector 'ebnf-generate-optional
5633 'ebnf-alternative-width
5634 'ebnf-optional-dimension
5641 (defun ebnf-make-except (factor exception
)
5642 (vector 'ebnf-generate-except
5644 'ebnf-except-dimension
5652 (defun ebnf-make-repeat (times primary
&optional upper
)
5653 (vector 'ebnf-generate-repeat
5655 'ebnf-repeat-dimension
5659 (cond ((and times upper
) ; L * U, L * L
5660 (if (string= times upper
)
5661 (if (string= times
"")
5664 (concat times
" * " upper
)))
5666 (concat times
" *"))
5668 (concat "* " upper
))
5674 (defun ebnf-make-sequence (seq)
5675 (vector 'ebnf-generate-sequence
5676 'ebnf-sequence-width
5677 'ebnf-sequence-dimension
5684 (defun ebnf-make-dup-sequence (node seq
)
5685 (vector 'ebnf-generate-sequence
5686 'ebnf-sequence-width
5687 'ebnf-sequence-dimension
5688 (ebnf-node-entry node
)
5689 (ebnf-node-height node
)
5690 (ebnf-node-width node
)
5694 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5695 ;; Optimizers used by parsers
5698 (defun ebnf-token-except (element exception
)
5701 (setq exception
(cdr exception
)))
5702 (and element
; EMPTY - A ==> EMPTY
5703 (let ((kind (ebnf-node-kind element
)))
5706 ((and (null exception
)
5707 (eq kind
'ebnf-generate-optional
))
5708 (ebnf-node-list element
))
5709 ;; { A }- ==> { A }+
5710 ((and (null exception
)
5711 (eq kind
'ebnf-generate-zero-or-more
))
5712 (ebnf-node-kind element
'ebnf-generate-one-or-more
)
5713 (ebnf-node-dimension-func element
'ebnf-one-or-more-dimension
)
5715 ;; ( A | EMPTY )- ==> A
5716 ;; ( A | B | EMPTY )- ==> A | B
5717 ((and (null exception
)
5718 (eq kind
'ebnf-generate-alternative
)
5720 (car (last (ebnf-node-list element
))))
5721 'ebnf-generate-empty
))
5722 (let ((elt (ebnf-node-list element
))
5728 ;; this should not happen!!?!
5729 (setq element
(ebnf-make-empty
5730 (ebnf-node-width element
)))
5732 (setq elt
(ebnf-node-list element
))
5733 (and (= (length elt
) 1)
5734 (setq element
(car elt
))))
5738 (ebnf-make-except element exception
))
5742 (defun ebnf-token-repeat (times repeat
&optional upper
)
5743 (if (null (cdr repeat
))
5744 ;; n * EMPTY ==> EMPTY
5748 (ebnf-make-repeat times
(cdr repeat
) upper
))))
5751 (defun ebnf-token-optional (body)
5752 (let ((kind (ebnf-node-kind body
)))
5754 ;; [ EMPTY ] ==> EMPTY
5755 ((eq kind
'ebnf-generate-empty
)
5757 ;; [ { A }* ] ==> { A }*
5758 ((eq kind
'ebnf-generate-zero-or-more
)
5760 ;; [ { A }+ ] ==> { A }*
5761 ((eq kind
'ebnf-generate-one-or-more
)
5762 (ebnf-node-kind body
'ebnf-generate-zero-or-more
)
5764 ;; [ A | B ] ==> A | B | EMPTY
5765 ((eq kind
'ebnf-generate-alternative
)
5766 (ebnf-node-list body
(nconc (ebnf-node-list body
)
5767 (list (ebnf-make-empty))))
5771 (ebnf-make-optional body
))
5775 (defun ebnf-token-alternative (body sequence
)
5779 (cons (car sequence
)
5781 (cons (car sequence
)
5782 (let ((seq (cdr sequence
)))
5783 (if (and (= (length body
) 1) (null seq
))
5785 (ebnf-make-alternative (nreverse (if seq
5790 (defun ebnf-token-sequence (sequence)
5795 ;; sequence with only one element
5796 ((= (length sequence
) 1)
5800 (ebnf-make-sequence (nreverse sequence
)))
5804 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5805 ;; Variables used by parsers
5808 (defconst ebnf-comment-table
5809 (let ((table (make-vector 256 nil
)))
5810 ;; Override special comment character:
5811 (aset table ?
< 'newline
)
5812 (aset table ?
> 'keep-line
)
5813 (aset table ?^
'form-feed
)
5815 "Vector used to map characters to a special comment token.")
5818 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5819 ;; To make this file smaller, some commands go in a separate file.
5820 ;; But autoload them here to make the separation invisible.
5822 (autoload 'ebnf-abn-parser
"ebnf-abn"
5825 (autoload 'ebnf-abn-initialize
"ebnf-abn"
5826 "Initialize ABNF token table.")
5828 (autoload 'ebnf-bnf-parser
"ebnf-bnf"
5831 (autoload 'ebnf-bnf-initialize
"ebnf-bnf"
5832 "Initialize EBNF token table.")
5834 (autoload 'ebnf-iso-parser
"ebnf-iso"
5837 (autoload 'ebnf-iso-initialize
"ebnf-iso"
5838 "Initialize ISO EBNF token table.")
5840 (autoload 'ebnf-yac-parser
"ebnf-yac"
5841 "Yacc/Bison parser.")
5843 (autoload 'ebnf-yac-initialize
"ebnf-yac"
5844 "Initializations for Yacc/Bison parser.")
5846 (autoload 'ebnf-ebx-parser
"ebnf-ebx"
5849 (autoload 'ebnf-ebx-initialize
"ebnf-ebx"
5850 "Initializations for EBNFX parser.")
5852 (autoload 'ebnf-dtd-parser
"ebnf-dtd"
5855 (autoload 'ebnf-dtd-initialize
"ebnf-dtd"
5856 "Initializations for DTD parser.")
5859 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5864 ;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
5865 ;;; ebnf2ps.el ends here