Commit | Line | Data |
---|---|---|
ab3256ed | 1 | ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript |
984ae001 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1999-2013 Free Software Foundation, Inc. |
984ae001 | 4 | |
ac4780a1 VJL |
5 | ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
6 | ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> | |
0b5ecd6d | 7 | ;; Keywords: wp, ebnf, PostScript |
3ced5caa | 8 | ;; Version: 4.4 |
502ca00a | 9 | ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre |
984ae001 | 10 | |
8d9ea7b1 | 11 | ;; This file is part of GNU Emacs. |
984ae001 | 12 | |
b1fc2b50 | 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
984ae001 | 14 | ;; it under the terms of the GNU General Public License as published by |
b1fc2b50 GM |
15 | ;; the Free Software Foundation, either version 3 of the License, or |
16 | ;; (at your option) any later version. | |
984ae001 | 17 | |
8d9ea7b1 | 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
984ae001 GM |
19 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
21 | ;; GNU General Public License for more details. | |
22 | ||
23 | ;; You should have received a copy of the GNU General Public License | |
b1fc2b50 | 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
984ae001 | 25 | |
3ced5caa VJL |
26 | (defconst ebnf-version "4.4" |
27 | "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> | |
8d9ea7b1 GM |
28 | |
29 | Vinicius's last change version. When reporting bugs, please also | |
30 | report the version of Emacs, if any, that ebnf2ps was running with. | |
31 | ||
32 | Please send all bug fixes and enhancements to | |
ac4780a1 | 33 | Vinicius Jose Latorre <viniciusjl@ig.com.br>. |
8d9ea7b1 GM |
34 | ") |
35 | ||
36 | ||
984ae001 GM |
37 | ;;; Commentary: |
38 | ||
39 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
40 | ;; | |
41 | ;; Introduction | |
42 | ;; ------------ | |
43 | ;; | |
ab3256ed | 44 | ;; This package translates an EBNF to a syntactic chart on PostScript. |
984ae001 | 45 | ;; |
865fe16f | 46 | ;; To use ebnf2ps, insert in your init file: |
984ae001 GM |
47 | ;; |
48 | ;; (require 'ebnf2ps) | |
49 | ;; | |
b685181e GM |
50 | ;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to |
51 | ;; know how to set options like landscape printing, page headings, margins, | |
52 | ;; etc. | |
984ae001 GM |
53 | ;; |
54 | ;; NOTE: ps-print zebra stripes and line number options doesn't have effect on | |
55 | ;; ebnf2ps, they behave as it's turned off. | |
56 | ;; | |
57 | ;; For good performance, be sure to byte-compile ebnf2ps.el, e.g. | |
58 | ;; | |
59 | ;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted> | |
60 | ;; | |
61 | ;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el. | |
62 | ;; | |
63 | ;; ebnf2ps was tested with GNU Emacs 20.4.1. | |
64 | ;; | |
65 | ;; | |
66 | ;; Using ebnf2ps | |
67 | ;; ------------- | |
68 | ;; | |
cc86f83f VJL |
69 | ;; ebnf2ps provides the following commands for generating PostScript syntactic |
70 | ;; chart images of Emacs buffers: | |
984ae001 | 71 | ;; |
ed0aa46c VJL |
72 | ;; ebnf-print-directory |
73 | ;; ebnf-print-file | |
74 | ;; ebnf-print-buffer | |
75 | ;; ebnf-print-region | |
76 | ;; ebnf-spool-directory | |
77 | ;; ebnf-spool-file | |
78 | ;; ebnf-spool-buffer | |
79 | ;; ebnf-spool-region | |
80 | ;; ebnf-eps-directory | |
81 | ;; ebnf-eps-file | |
82 | ;; ebnf-eps-buffer | |
83 | ;; ebnf-eps-region | |
984ae001 GM |
84 | ;; |
85 | ;; These commands all perform essentially the same function: they generate | |
ab3256ed | 86 | ;; PostScript syntactic chart images suitable for printing on a PostScript |
984ae001 GM |
87 | ;; printer or displaying with GhostScript. These commands are collectively |
88 | ;; referred to as "ebnf- commands". | |
89 | ;; | |
90 | ;; The word "print", "spool" and "eps" in the command name determines when the | |
91 | ;; PostScript image is sent to the printer (or file): | |
92 | ;; | |
ed0aa46c | 93 | ;; print - The PostScript image is immediately sent to the printer; |
984ae001 | 94 | ;; |
ed0aa46c VJL |
95 | ;; spool - The PostScript image is saved temporarily in an Emacs buffer. |
96 | ;; Many images may be spooled locally before printing them. To | |
97 | ;; send the spooled images to the printer, use the command | |
98 | ;; `ebnf-despool'. | |
984ae001 | 99 | ;; |
4303661c | 100 | ;; eps - The PostScript image is immediately sent to an EPS file. |
984ae001 GM |
101 | ;; |
102 | ;; The spooling mechanism is the same as used by ps-print and was designed for | |
103 | ;; printing lots of small files to save paper that would otherwise be wasted on | |
104 | ;; banner pages, and to make it easier to find your output at the printer (it's | |
105 | ;; easier to pick up one 50-page printout than to find 50 single-page | |
106 | ;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool | |
107 | ;; images, you can intermix the spooling of ebnf2ps and ps-print images. | |
108 | ;; | |
109 | ;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you | |
110 | ;; won't accidentally quit from Emacs while you have unprinted PostScript | |
111 | ;; waiting in the spool buffer. If you do attempt to exit with spooled | |
112 | ;; PostScript, you'll be asked if you want to print it, and if you decline, | |
b685181e GM |
113 | ;; you'll be asked to confirm the exit; this is modeled on the confirmation |
114 | ;; that Emacs uses for modified buffers. | |
984ae001 | 115 | ;; |
ac4780a1 VJL |
116 | ;; The word "directory", "file", "buffer" or "region" in the command name |
117 | ;; determines how much of the buffer is printed: | |
984ae001 | 118 | ;; |
ed0aa46c | 119 | ;; directory - Read files in the directory and print them. |
984ae001 | 120 | ;; |
ed0aa46c | 121 | ;; file - Read file and print it. |
ac4780a1 | 122 | ;; |
ed0aa46c | 123 | ;; buffer - Print the entire buffer. |
ac4780a1 | 124 | ;; |
ed0aa46c | 125 | ;; region - Print just the current region. |
984ae001 GM |
126 | ;; |
127 | ;; Two ebnf- command examples: | |
128 | ;; | |
ed0aa46c VJL |
129 | ;; ebnf-print-buffer - translate and print the entire buffer, and send it |
130 | ;; immediately to the printer. | |
984ae001 | 131 | ;; |
ed0aa46c VJL |
132 | ;; ebnf-spool-region - translate and print just the current region, and |
133 | ;; spool the image in Emacs to send to the printer | |
134 | ;; later. | |
984ae001 | 135 | ;; |
ac4780a1 VJL |
136 | ;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and |
137 | ;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print | |
138 | ;; spooling mechanism. See section "Actions in Comments" for an explanation | |
139 | ;; about EPS file generation. | |
984ae001 GM |
140 | ;; |
141 | ;; | |
142 | ;; Invoking Ebnf2ps | |
143 | ;; ---------------- | |
144 | ;; | |
145 | ;; To translate and print your buffer, type | |
146 | ;; | |
ed0aa46c | 147 | ;; M-x ebnf-print-buffer |
984ae001 GM |
148 | ;; |
149 | ;; or substitute one of the other four ebnf- commands. The command will | |
150 | ;; generate the PostScript image and print or spool it as specified. By giving | |
151 | ;; the command a prefix argument | |
152 | ;; | |
ed0aa46c | 153 | ;; C-u M-x ebnf-print-buffer |
984ae001 GM |
154 | ;; |
155 | ;; it will save the PostScript image to a file instead of sending it to the | |
156 | ;; printer; you will be prompted for the name of the file to save the image to. | |
157 | ;; The prefix argument is ignored by the commands that spool their images, but | |
158 | ;; you may save the spooled images to a file by giving a prefix argument to | |
159 | ;; `ebnf-despool': | |
160 | ;; | |
ed0aa46c | 161 | ;; C-u M-x ebnf-despool |
984ae001 GM |
162 | ;; |
163 | ;; When invoked this way, `ebnf-despool' will prompt you for the name of the | |
164 | ;; file to save to. | |
165 | ;; | |
166 | ;; The prefix argument is also ignored by `ebnf-eps-buffer' and | |
167 | ;; `ebnf-eps-region'. | |
168 | ;; | |
169 | ;; Any of the `ebnf-' commands can be bound to keys. Here are some examples: | |
170 | ;; | |
ed0aa46c VJL |
171 | ;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc |
172 | ;; (global-set-key '(shift f22) 'ebnf-print-region) | |
173 | ;; (global-set-key '(control f22) 'ebnf-despool) | |
984ae001 GM |
174 | ;; |
175 | ;; | |
6411a60a VJL |
176 | ;; Invoking Ebnf2ps in Batch |
177 | ;; ------------------------- | |
178 | ;; | |
179 | ;; It's possible also to run ebnf2ps in batch, this is useful when, for | |
180 | ;; example, you have a directory with a lot of files containing the EBNF to be | |
181 | ;; translated to PostScript. | |
182 | ;; | |
183 | ;; To run ebnf2ps in batch type, for example: | |
184 | ;; | |
185 | ;; emacs -batch -l setup-ebnf2ps.el -f ebnf-eps-directory | |
186 | ;; | |
187 | ;; Where setup-ebnf2ps.el should be a file containing: | |
188 | ;; | |
189 | ;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment | |
190 | ;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path)) | |
191 | ;; (require 'ebnf2ps) | |
192 | ;; ;; insert here your ebnf2ps settings | |
193 | ;; (setq ebnf-terminal-shape 'bevel) | |
194 | ;; ;; etc. | |
195 | ;; | |
196 | ;; | |
984ae001 GM |
197 | ;; EBNF Syntax |
198 | ;; ----------- | |
199 | ;; | |
6411a60a VJL |
200 | ;; BNF (Backus Naur Form) notation is defined like languages, and like |
201 | ;; languages there are rules about name formation and syntax. In this section | |
202 | ;; it's defined a BNF syntax that it's called simply EBNF (Extended BNF). | |
203 | ;; ebnf2ps package also deal with other BNF notation. Please, see the variable | |
204 | ;; `ebnf-syntax' documentation below in this section. | |
205 | ;; | |
984ae001 GM |
206 | ;; The current EBNF that ebnf2ps accepts has the following constructions: |
207 | ;; | |
208 | ;; ; comment (until end of line) | |
209 | ;; A non-terminal | |
210 | ;; "C" terminal | |
211 | ;; ?C? special | |
212 | ;; $A default non-terminal (see text below) | |
213 | ;; $"C" default terminal (see text below) | |
214 | ;; $?C? default special (see text below) | |
215 | ;; A = B. production (A is the header and B the body) | |
216 | ;; C D sequence (C occurs before D) | |
217 | ;; C | D alternative (C or D occurs) | |
218 | ;; A - B exception (A excluding B, B without any non-terminal) | |
7fd08a0a VJL |
219 | ;; n * A repetition (A repeats at least n (integer) times) |
220 | ;; n * n A repetition (A repeats exactly n (integer) times) | |
221 | ;; n * m A repetition (A repeats at least n (integer) and at most | |
222 | ;; m (integer) times) | |
984ae001 GM |
223 | ;; (C) group (expression C is grouped together) |
224 | ;; [C] optional (C may or not occurs) | |
225 | ;; C+ one or more occurrences of C | |
226 | ;; {C}+ one or more occurrences of C | |
227 | ;; {C}* zero or more occurrences of C | |
228 | ;; {C} zero or more occurrences of C | |
229 | ;; C / D equivalent to: C {D C}* | |
230 | ;; {C || D}+ equivalent to: C {D C}* | |
231 | ;; {C || D}* equivalent to: [C {D C}*] | |
232 | ;; {C || D} equivalent to: [C {D C}*] | |
233 | ;; | |
234 | ;; The EBNF syntax written using the notation above is: | |
235 | ;; | |
236 | ;; EBNF = {production}+. | |
237 | ;; | |
238 | ;; production = non_terminal "=" body ".". ;; production | |
239 | ;; | |
240 | ;; body = {sequence || "|"}*. ;; alternative | |
241 | ;; | |
242 | ;; sequence = {exception}*. ;; sequence | |
243 | ;; | |
244 | ;; exception = repeat [ "-" repeat]. ;; exception | |
245 | ;; | |
7fd08a0a | 246 | ;; repeat = [ integer "*" [ integer ]] term. ;; repetition |
984ae001 GM |
247 | ;; |
248 | ;; term = factor | |
249 | ;; | [factor] "+" ;; one-or-more | |
250 | ;; | [factor] "/" [factor] ;; one-or-more | |
251 | ;; . | |
252 | ;; | |
253 | ;; factor = [ "$" ] "\"" terminal "\"" ;; terminal | |
254 | ;; | [ "$" ] non_terminal ;; non-terminal | |
255 | ;; | [ "$" ] "?" special "?" ;; special | |
256 | ;; | "(" body ")" ;; group | |
257 | ;; | "[" body "]" ;; zero-or-one | |
258 | ;; | "{" body [ "||" body ] "}+" ;; one-or-more | |
259 | ;; | "{" body [ "||" body ] "}*" ;; zero-or-more | |
260 | ;; | "{" body [ "||" body ] "}" ;; zero-or-more | |
261 | ;; . | |
262 | ;; | |
0b5ecd6d | 263 | ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+". |
ac4780a1 VJL |
264 | ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper |
265 | ;; ;; and lower), 8-bit accentuated characters, | |
266 | ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":", | |
267 | ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~". | |
984ae001 GM |
268 | ;; |
269 | ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+". | |
ac4780a1 VJL |
270 | ;; ;; that is, a valid terminal accepts any printable character (including |
271 | ;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a | |
272 | ;; ;; terminal. Also, accepts escaped characters, that is, a character | |
273 | ;; ;; pair starting with `\' followed by a printable character, for | |
6f19f70a | 274 | ;; ;; example: \", \\. |
984ae001 | 275 | ;; |
ac4780a1 VJL |
276 | ;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*". |
277 | ;; ;; that is, a valid special accepts any printable character (including | |
278 | ;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to | |
279 | ;; ;; delimit a special. | |
984ae001 GM |
280 | ;; |
281 | ;; integer = "[0-9]+". | |
ac4780a1 | 282 | ;; ;; that is, an integer is a sequence of one or more decimal digits. |
984ae001 GM |
283 | ;; |
284 | ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n". | |
ac4780a1 VJL |
285 | ;; ;; that is, a comment starts with the character `;' and terminates at end |
286 | ;; ;; of line. Also, it only accepts printable characters (including 8-bit | |
287 | ;; ;; accentuated characters) and tabs. | |
984ae001 GM |
288 | ;; |
289 | ;; Try to use the above EBNF to test ebnf2ps. | |
290 | ;; | |
291 | ;; The `default' terminal, non-terminal and special is a way to indicate a | |
292 | ;; default path in a production. For example, the production: | |
293 | ;; | |
294 | ;; X = [ $A ( B | $C ) | D ]. | |
295 | ;; | |
296 | ;; Indicates that the default meaning for "X" is "A C" if "X" is empty. | |
297 | ;; | |
298 | ;; The terminal name is controlled by `ebnf-terminal-regexp' and | |
299 | ;; `ebnf-case-fold-search', so it's possible to match other kind of terminal | |
300 | ;; name besides that enclosed by `"'. | |
301 | ;; | |
302 | ;; Let's see an example: | |
303 | ;; | |
304 | ;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name | |
305 | ;; (setq ebnf-case-fold-search nil) ; exact matching | |
306 | ;; | |
307 | ;; If you have the production: | |
308 | ;; | |
309 | ;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")". | |
310 | ;; | |
311 | ;; The names are classified as: | |
312 | ;; | |
313 | ;; Logical Expression non-terminal | |
314 | ;; "(" OR AND "XOR" ")" terminal | |
315 | ;; | |
b685181e GM |
316 | ;; The line comment is controlled by `ebnf-lex-comment-char'. The default |
317 | ;; value is ?\; (character `;'). | |
984ae001 GM |
318 | ;; |
319 | ;; The end of production is controlled by `ebnf-lex-eop-char'. The default | |
320 | ;; value is ?. (character `.'). | |
321 | ;; | |
322 | ;; The variable `ebnf-syntax' specifies which syntax to recognize: | |
323 | ;; | |
324 | ;; `ebnf' ebnf2ps recognizes the syntax described above. | |
325 | ;; The following variables *ONLY* have effect with this | |
326 | ;; setting: | |
327 | ;; `ebnf-terminal-regexp', `ebnf-case-fold-search', | |
328 | ;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. | |
329 | ;; | |
ac4780a1 | 330 | ;; `abnf' ebnf2ps recognizes the syntax described in the URL: |
97818b07 | 331 | ;; `http://www.ietf.org/rfc/rfc2234.txt' |
ac4780a1 VJL |
332 | ;; ("Augmented BNF for Syntax Specifications: ABNF"). |
333 | ;; | |
984ae001 GM |
334 | ;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: |
335 | ;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' | |
336 | ;; ("International Standard of the ISO EBNF Notation"). | |
337 | ;; The following variables *ONLY* have effect with this | |
338 | ;; setting: | |
339 | ;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'. | |
340 | ;; | |
341 | ;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax. | |
342 | ;; The following variable *ONLY* has effect with this | |
343 | ;; setting: | |
344 | ;; `ebnf-yac-ignore-error-recovery'. | |
345 | ;; | |
6ca94f87 VJL |
346 | ;; `ebnfx' ebnf2ps recognizes the syntax described in the URL: |
347 | ;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' | |
348 | ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)") | |
349 | ;; | |
6411a60a VJL |
350 | ;; `dtd' ebnf2ps recognizes the syntax described in the URL: |
351 | ;; `http://www.w3.org/TR/2004/REC-xml-20040204/' | |
352 | ;; ("Extensible Markup Language (XML) 1.0 (Third Edition)") | |
353 | ;; | |
984ae001 GM |
354 | ;; Any other value is treated as `ebnf'. |
355 | ;; | |
356 | ;; The default value is `ebnf'. | |
357 | ;; | |
358 | ;; | |
359 | ;; Optimizations | |
360 | ;; ------------- | |
361 | ;; | |
362 | ;; The following EBNF optimizations are done: | |
363 | ;; | |
364 | ;; [ { A }* ] ==> { A }* | |
365 | ;; [ { A }+ ] ==> { A }* | |
366 | ;; [ A ] + ==> { A }* | |
367 | ;; { A }* + ==> { A }* | |
368 | ;; { A }+ + ==> { A }+ | |
369 | ;; { A }- ==> { A }+ | |
370 | ;; [ A ]- ==> A | |
371 | ;; ( A | EMPTY )- ==> A | |
372 | ;; ( A | B | EMPTY )- ==> A | B | |
373 | ;; [ A | B ] ==> A | B | EMPTY | |
374 | ;; n * EMPTY ==> EMPTY | |
375 | ;; EMPTY + ==> EMPTY | |
376 | ;; EMPTY / EMPTY ==> EMPTY | |
377 | ;; EMPTY - A ==> EMPTY | |
378 | ;; | |
379 | ;; The following optimizations are done when `ebnf-optimize' is non-nil: | |
380 | ;; | |
381 | ;; left recursion: | |
382 | ;; 1. A = B | A C. ==> A = B {C}*. | |
383 | ;; 2. A = B | A B. ==> A = {B}+. | |
384 | ;; 3. A = | A B. ==> A = {B}*. | |
385 | ;; 4. A = B | A C B. ==> A = {B || C}+. | |
386 | ;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*. | |
387 | ;; | |
388 | ;; optional: | |
389 | ;; 6. A = B | . ==> A = [B]. | |
390 | ;; 7. A = | B . ==> A = [B]. | |
391 | ;; | |
ad96a7ef | 392 | ;; factorization: |
984ae001 GM |
393 | ;; 8. A = B C | B D. ==> A = B (C | D). |
394 | ;; 9. A = C B | D B. ==> A = (C | D) B. | |
395 | ;; 10. A = B C E | B D E. ==> A = B (C | D) E. | |
396 | ;; | |
397 | ;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'. | |
398 | ;; | |
399 | ;; | |
400 | ;; Form Feed | |
401 | ;; --------- | |
402 | ;; | |
b685181e GM |
403 | ;; You may use form feed (^L \014) to force a production to start on a new |
404 | ;; page, for example: | |
984ae001 GM |
405 | ;; |
406 | ;; a) A = B | C. | |
407 | ;; ^L | |
408 | ;; X = Y | Z. | |
409 | ;; | |
410 | ;; b) A = B ^L | C. | |
411 | ;; X = Y | Z. | |
412 | ;; | |
413 | ;; c) A = B ^L^L^L | C.^L | |
414 | ;; ^L | |
415 | ;; X = Y | Z. | |
416 | ;; | |
417 | ;; In all examples above, only the production X will start on a new page. | |
418 | ;; | |
419 | ;; | |
420 | ;; Actions in Comments | |
421 | ;; ------------------- | |
422 | ;; | |
423 | ;; ebnf2ps accepts the following actions in comments: | |
424 | ;; | |
6411a60a VJL |
425 | ;; ;^ same as form feed. See section Form Feed above. |
426 | ;; | |
984ae001 GM |
427 | ;; ;> the next production starts in the same line as the current one. |
428 | ;; It is useful when `ebnf-horizontal-orientation' is nil. | |
429 | ;; | |
430 | ;; ;< the next production starts in the next line. | |
431 | ;; It is useful when `ebnf-horizontal-orientation' is non-nil. | |
432 | ;; | |
433 | ;; ;[EPS open a new EPS file. The EPS file name has the form: | |
434 | ;; <PREFIX><NAME>.eps | |
b685181e GM |
435 | ;; where <PREFIX> is given by variable `ebnf-eps-prefix' and |
436 | ;; <NAME> is the string given by ;[ action comment, this string is | |
437 | ;; mapped to form a valid file name (see documentation for | |
984ae001 GM |
438 | ;; `ebnf-eps-buffer' or `ebnf-eps-region'). |
439 | ;; It has effect only during `ebnf-eps-buffer' or | |
440 | ;; `ebnf-eps-region' execution. | |
441 | ;; It's an error to try to open an already opened EPS file. | |
442 | ;; | |
443 | ;; ;]EPS close an opened EPS file. | |
444 | ;; It has effect only during `ebnf-eps-buffer' or | |
445 | ;; `ebnf-eps-region' execution. | |
446 | ;; It's an error to try to close a not opened EPS file. | |
447 | ;; | |
3ced5caa VJL |
448 | ;; ;Hheader generate a header in current EPS file. The header string can |
449 | ;; have the following formats: | |
450 | ;; | |
451 | ;; %% prints a % character. | |
452 | ;; | |
453 | ;; %H prints the `ebnf-eps-header' (which see) value. | |
454 | ;; | |
455 | ;; %F prints the `ebnf-eps-footer' (which see) value. | |
456 | ;; | |
457 | ;; Any other format is ignored, that is, if, for example, it's | |
458 | ;; used %s then %s characters are stripped out from the header. | |
459 | ;; If header is an empty string, no header is generated until a | |
460 | ;; non-empty header is specified or `ebnf-eps-header' has a | |
461 | ;; non-empty string value. | |
462 | ;; | |
463 | ;; ;Ffooter generate a footer in current EPS file. Similar to ;H action | |
464 | ;; comment. | |
465 | ;; | |
984ae001 GM |
466 | ;; So if you have: |
467 | ;; | |
468 | ;; (setq ebnf-horizontal-orientation nil) | |
469 | ;; | |
470 | ;; A = t. | |
471 | ;; C = x. | |
472 | ;; ;> C and B are drawn in the same line | |
473 | ;; B = y. | |
474 | ;; W = v. | |
475 | ;; | |
476 | ;; The graphical result is: | |
477 | ;; | |
478 | ;; +---+ | |
479 | ;; | A | | |
480 | ;; +---+ | |
481 | ;; | |
482 | ;; +---------+ +-----+ | |
483 | ;; | | | | | |
484 | ;; | C | | | | |
485 | ;; | | | B | | |
486 | ;; +---------+ | | | |
487 | ;; | | | |
488 | ;; +-----+ | |
489 | ;; | |
490 | ;; +-----------+ | |
491 | ;; | W | | |
492 | ;; +-----------+ | |
493 | ;; | |
494 | ;; Note that if ascending production sort is used, the productions A and B will | |
495 | ;; be drawn in the same line instead of C and B. | |
496 | ;; | |
b685181e GM |
497 | ;; If consecutive actions occur, only the last one takes effect, so if you |
498 | ;; have: | |
984ae001 GM |
499 | ;; |
500 | ;; A = X. | |
501 | ;; ;< | |
502 | ;; ^L | |
503 | ;; ;> | |
504 | ;; B = Y. | |
505 | ;; | |
506 | ;; Only the ;> will take effect, that is, A and B will be drawn in the same | |
507 | ;; line. | |
508 | ;; | |
6411a60a VJL |
509 | ;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*) |
510 | ;; and (*]EPS*). The first example above should be written: | |
984ae001 GM |
511 | ;; |
512 | ;; A = t; | |
513 | ;; C = x; | |
514 | ;; (*> C and B are drawn in the same line *) | |
515 | ;; B = y; | |
516 | ;; W = v; | |
517 | ;; | |
518 | ;; For an example of EPS action when executing `ebnf-eps-buffer' or | |
519 | ;; `ebnf-eps-region': | |
520 | ;; | |
521 | ;; Z = B0. | |
522 | ;; ;[CC | |
523 | ;; ;[AA | |
524 | ;; A = B1. | |
525 | ;; ;[BB | |
526 | ;; C = B2. | |
527 | ;; ;]AA | |
528 | ;; B = B3. | |
529 | ;; ;]BB | |
530 | ;; ;]CC | |
531 | ;; D = B4. | |
532 | ;; E = B5. | |
533 | ;; ;[CC | |
534 | ;; F = B6. | |
535 | ;; ;]CC | |
536 | ;; G = B7. | |
537 | ;; | |
538 | ;; The following table summarizes the results: | |
539 | ;; | |
ed0aa46c VJL |
540 | ;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT |
541 | ;; ebnf--AA.eps A C A C C A | |
542 | ;; ebnf--BB.eps C B B C C B | |
543 | ;; ebnf--CC.eps A C B F A B C F F C B A | |
544 | ;; ebnf--D.eps D D D | |
545 | ;; ebnf--E.eps E E E | |
546 | ;; ebnf--G.eps G G G | |
547 | ;; ebnf--Z.eps Z Z Z | |
984ae001 GM |
548 | ;; |
549 | ;; As you can see if EPS actions is not used, each single production is | |
550 | ;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that | |
551 | ;; it's not an existing production name. | |
552 | ;; | |
553 | ;; In the following case: | |
554 | ;; | |
555 | ;; A = B0. | |
556 | ;; ;[AA | |
557 | ;; A = B1. | |
558 | ;; ;[BB | |
559 | ;; A = B2. | |
560 | ;; | |
561 | ;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps. | |
562 | ;; | |
563 | ;; | |
3ced5caa VJL |
564 | ;; Log Messages |
565 | ;; ------------ | |
566 | ;; | |
567 | ;; The buffer *Ebnf2ps Log* is where the ebnf2ps log messages are inserted. | |
568 | ;; These messages are intended to help debugging ebnf2ps. | |
569 | ;; | |
570 | ;; The log messages are enabled by `ebnf-log' option (which see). The default | |
571 | ;; value is nil, that is, no log messages are generated. | |
572 | ;; | |
573 | ;; | |
984ae001 GM |
574 | ;; Utilities |
575 | ;; --------- | |
576 | ;; | |
577 | ;; Some tools are provided to help you. | |
578 | ;; | |
579 | ;; `ebnf-setup' returns the current setup. | |
580 | ;; | |
cd0f9f85 VJL |
581 | ;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the |
582 | ;; given directory. | |
583 | ;; | |
584 | ;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given | |
585 | ;; file. | |
586 | ;; | |
ab3256ed | 587 | ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current |
984ae001 GM |
588 | ;; buffer. |
589 | ;; | |
ab3256ed | 590 | ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current |
984ae001 GM |
591 | ;; region. |
592 | ;; | |
593 | ;; `ebnf-customize' activates a customization buffer for ebnf2ps options. | |
594 | ;; | |
cd0f9f85 VJL |
595 | ;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer', |
596 | ;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same | |
597 | ;; way as `ebnf-' commands. | |
984ae001 GM |
598 | ;; |
599 | ;; | |
600 | ;; Hooks | |
601 | ;; ----- | |
602 | ;; | |
603 | ;; ebn2ps has the following hook variables: | |
604 | ;; | |
605 | ;; `ebnf-hook' | |
606 | ;; It is evaluated once before any ebnf2ps process. | |
607 | ;; | |
608 | ;; `ebnf-production-hook' | |
609 | ;; It is evaluated on each beginning of production. | |
610 | ;; | |
611 | ;; `ebnf-page-hook' | |
612 | ;; It is evaluated on each beginning of page. | |
613 | ;; | |
614 | ;; | |
615 | ;; Options | |
616 | ;; ------- | |
617 | ;; | |
618 | ;; Below it's shown a brief description of ebnf2ps options, please, see the | |
619 | ;; options declaration in the code for a long documentation. | |
620 | ;; | |
621 | ;; `ebnf-horizontal-orientation' Non-nil means productions are drawn | |
622 | ;; horizontally. | |
623 | ;; | |
624 | ;; `ebnf-horizontal-max-height' Non-nil means to use maximum production | |
625 | ;; height in horizontal orientation. | |
626 | ;; | |
627 | ;; `ebnf-production-horizontal-space' Specify horizontal space in points | |
628 | ;; between productions. | |
629 | ;; | |
b685181e GM |
630 | ;; `ebnf-production-vertical-space' Specify vertical space in points |
631 | ;; between productions. | |
984ae001 GM |
632 | ;; |
633 | ;; `ebnf-justify-sequence' Specify justification of terms in a | |
634 | ;; sequence inside alternatives. | |
635 | ;; | |
636 | ;; `ebnf-terminal-regexp' Specify how it's a terminal name. | |
637 | ;; | |
638 | ;; `ebnf-case-fold-search' Non-nil means ignore case on matching. | |
639 | ;; | |
640 | ;; `ebnf-terminal-font' Specify terminal font. | |
641 | ;; | |
642 | ;; `ebnf-terminal-shape' Specify terminal box shape. | |
643 | ;; | |
644 | ;; `ebnf-terminal-shadow' Non-nil means terminal box will have a | |
645 | ;; shadow. | |
646 | ;; | |
647 | ;; `ebnf-terminal-border-width' Specify border width for terminal box. | |
648 | ;; | |
649 | ;; `ebnf-terminal-border-color' Specify border color for terminal box. | |
650 | ;; | |
ac4780a1 VJL |
651 | ;; `ebnf-production-name-p' Non-nil means production name will be |
652 | ;; printed. | |
653 | ;; | |
984ae001 GM |
654 | ;; `ebnf-sort-production' Specify how productions are sorted. |
655 | ;; | |
656 | ;; `ebnf-production-font' Specify production font. | |
657 | ;; | |
658 | ;; `ebnf-non-terminal-font' Specify non-terminal font. | |
659 | ;; | |
660 | ;; `ebnf-non-terminal-shape' Specify non-terminal box shape. | |
661 | ;; | |
b685181e GM |
662 | ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will |
663 | ;; have a shadow. | |
984ae001 GM |
664 | ;; |
665 | ;; `ebnf-non-terminal-border-width' Specify border width for non-terminal | |
666 | ;; box. | |
667 | ;; | |
668 | ;; `ebnf-non-terminal-border-color' Specify border color for non-terminal | |
669 | ;; box. | |
670 | ;; | |
ac4780a1 VJL |
671 | ;; `ebnf-special-show-delimiter' Non-nil means special delimiter |
672 | ;; (character `?') is shown. | |
673 | ;; | |
984ae001 GM |
674 | ;; `ebnf-special-font' Specify special font. |
675 | ;; | |
676 | ;; `ebnf-special-shape' Specify special box shape. | |
677 | ;; | |
678 | ;; `ebnf-special-shadow' Non-nil means special box will have a | |
679 | ;; shadow. | |
680 | ;; | |
681 | ;; `ebnf-special-border-width' Specify border width for special box. | |
682 | ;; | |
683 | ;; `ebnf-special-border-color' Specify border color for special box. | |
684 | ;; | |
685 | ;; `ebnf-except-font' Specify except font. | |
686 | ;; | |
687 | ;; `ebnf-except-shape' Specify except box shape. | |
688 | ;; | |
689 | ;; `ebnf-except-shadow' Non-nil means except box will have a | |
690 | ;; shadow. | |
691 | ;; | |
692 | ;; `ebnf-except-border-width' Specify border width for except box. | |
693 | ;; | |
694 | ;; `ebnf-except-border-color' Specify border color for except box. | |
695 | ;; | |
696 | ;; `ebnf-repeat-font' Specify repeat font. | |
697 | ;; | |
698 | ;; `ebnf-repeat-shape' Specify repeat box shape. | |
699 | ;; | |
700 | ;; `ebnf-repeat-shadow' Non-nil means repeat box will have a | |
701 | ;; shadow. | |
702 | ;; | |
703 | ;; `ebnf-repeat-border-width' Specify border width for repeat box. | |
704 | ;; | |
705 | ;; `ebnf-repeat-border-color' Specify border color for repeat box. | |
706 | ;; | |
707 | ;; `ebnf-entry-percentage' Specify entry height on alternatives. | |
708 | ;; | |
709 | ;; `ebnf-arrow-shape' Specify the arrow shape. | |
710 | ;; | |
711 | ;; `ebnf-chart-shape' Specify chart flow shape. | |
712 | ;; | |
713 | ;; `ebnf-color-p' Non-nil means use color. | |
714 | ;; | |
715 | ;; `ebnf-line-width' Specify flow line width. | |
716 | ;; | |
717 | ;; `ebnf-line-color' Specify flow line color. | |
718 | ;; | |
ed0aa46c VJL |
719 | ;; `ebnf-arrow-extra-width' Specify extra width for arrow shape |
720 | ;; drawing. | |
721 | ;; | |
722 | ;; `ebnf-arrow-scale' Specify the arrow scale. | |
723 | ;; | |
bf061ba6 | 724 | ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a |
b685181e | 725 | ;; PostScript code). |
984ae001 GM |
726 | ;; |
727 | ;; `ebnf-debug-ps' Non-nil means to generate PostScript | |
728 | ;; debug procedures. | |
729 | ;; | |
730 | ;; `ebnf-lex-comment-char' Specify the line comment character. | |
731 | ;; | |
b685181e GM |
732 | ;; `ebnf-lex-eop-char' Specify the end of production |
733 | ;; character. | |
984ae001 GM |
734 | ;; |
735 | ;; `ebnf-syntax' Specify syntax to be recognized. | |
736 | ;; | |
737 | ;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF. | |
738 | ;; | |
739 | ;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax | |
740 | ;; names. | |
741 | ;; | |
742 | ;; `ebnf-default-width' Specify additional border width over | |
743 | ;; default terminal, non-terminal or | |
744 | ;; special. | |
745 | ;; | |
ac4780a1 VJL |
746 | ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains |
747 | ;; EBNF. | |
748 | ;; | |
984ae001 GM |
749 | ;; `ebnf-eps-prefix' Specify EPS prefix file name. |
750 | ;; | |
3ced5caa VJL |
751 | ;; `ebnf-eps-header-font' Specify EPS header font. |
752 | ;; | |
753 | ;; `ebnf-eps-header' Specify EPS header. | |
754 | ;; | |
755 | ;; `ebnf-eps-footer-font' Specify EPS footer font. | |
756 | ;; | |
757 | ;; `ebnf-eps-footer' Specify EPS footer. | |
758 | ;; | |
984ae001 GM |
759 | ;; `ebnf-use-float-format' Non-nil means use `%f' float format. |
760 | ;; | |
ac4780a1 VJL |
761 | ;; `ebnf-stop-on-error' Non-nil means signal error and stop. |
762 | ;; Nil means signal error and continue. | |
763 | ;; | |
984ae001 GM |
764 | ;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery. |
765 | ;; | |
766 | ;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules. | |
767 | ;; | |
ab3256ed | 768 | ;; `ebnf-optimize' Non-nil means optimize syntactic chart |
b685181e | 769 | ;; of rules. |
984ae001 | 770 | ;; |
3ced5caa VJL |
771 | ;; `ebnf-log' Non-nil means generate log messages. |
772 | ;; | |
984ae001 GM |
773 | ;; To set the above options you may: |
774 | ;; | |
865fe16f | 775 | ;; a) insert the code in your init file, like: |
984ae001 GM |
776 | ;; |
777 | ;; (setq ebnf-terminal-shape 'bevel) | |
778 | ;; | |
779 | ;; This way always keep your default settings when you enter a new Emacs | |
780 | ;; session. | |
781 | ;; | |
782 | ;; b) or use `set-variable' in your Emacs session, like: | |
783 | ;; | |
784 | ;; M-x set-variable RET ebnf-terminal-shape RET bevel RET | |
785 | ;; | |
786 | ;; This way keep your settings only during the current Emacs session. | |
787 | ;; | |
788 | ;; c) or use customization, for example: | |
789 | ;; click on menu-bar *Help* option, | |
790 | ;; then click on *Customize*, | |
791 | ;; then click on *Browse Customization Groups*, | |
792 | ;; expand *PostScript* group, | |
793 | ;; expand *Ebnf2ps* group | |
794 | ;; and then customize ebnf2ps options. | |
795 | ;; Through this way, you may choose if the settings are kept or not when | |
796 | ;; you leave out the current Emacs session. | |
797 | ;; | |
798 | ;; d) or see the option value: | |
799 | ;; | |
800 | ;; C-h v ebnf-terminal-shape RET | |
801 | ;; | |
802 | ;; and click the *customize* hypertext button. | |
803 | ;; Through this way, you may choose if the settings are kept or not when | |
804 | ;; you leave out the current Emacs session. | |
805 | ;; | |
806 | ;; e) or invoke: | |
807 | ;; | |
808 | ;; M-x ebnf-customize RET | |
809 | ;; | |
810 | ;; and then customize ebnf2ps options. | |
811 | ;; Through this way, you may choose if the settings are kept or not when | |
812 | ;; you leave out the current Emacs session. | |
813 | ;; | |
814 | ;; | |
815 | ;; Styles | |
816 | ;; ------ | |
817 | ;; | |
818 | ;; Sometimes you need to change the EBNF style you are using, for example, | |
819 | ;; change the shapes and colors. These changes may force you to set some | |
820 | ;; variables and after use, set back the variables to the old values. | |
821 | ;; | |
822 | ;; To help to handle this situation, ebnf2ps has the following commands to | |
823 | ;; handle styles: | |
824 | ;; | |
3ced5caa VJL |
825 | ;; `ebnf-find-style' Return style definition if NAME is already defined; |
826 | ;; otherwise, return nil. | |
827 | ;; | |
984ae001 GM |
828 | ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and |
829 | ;; values VALUES. | |
830 | ;; | |
ac4780a1 VJL |
831 | ;; `ebnf-delete-style' Delete style NAME. |
832 | ;; | |
984ae001 GM |
833 | ;; `ebnf-merge-style' Merge values of style NAME with style VALUES. |
834 | ;; | |
ac4780a1 | 835 | ;; `ebnf-apply-style' Set STYLE as the current style. |
984ae001 GM |
836 | ;; |
837 | ;; `ebnf-reset-style' Reset current style. | |
838 | ;; | |
ac4780a1 | 839 | ;; `ebnf-push-style' Push the current style and set STYLE as the current |
6f19f70a | 840 | ;; style. |
984ae001 | 841 | ;; |
ac4780a1 | 842 | ;; `ebnf-pop-style' Pop a style and set it as the current style. |
984ae001 | 843 | ;; |
ac4780a1 | 844 | ;; These commands help to put together a lot of variable settings in a group |
984ae001 GM |
845 | ;; and name this group. So when you wish to apply these settings it's only |
846 | ;; needed to give the name. | |
847 | ;; | |
4303661c VJL |
848 | ;; There is also a notion of simple inheritance of style: if you declare that |
849 | ;; style A inherits from style B, all settings of B are applied first and then | |
850 | ;; the settings of A are applied. This is useful when you wish to modify some | |
851 | ;; aspects of an existing style, but at same time wish to keep it unmodified. | |
984ae001 GM |
852 | ;; |
853 | ;; See documentation for `ebnf-style-database'. | |
854 | ;; | |
855 | ;; | |
856 | ;; Layout | |
857 | ;; ------ | |
858 | ;; | |
859 | ;; Below it is the layout of minimum area to draw each element, and it's used | |
860 | ;; the following terms: | |
861 | ;; | |
862 | ;; font height is given by: | |
863 | ;; (terminal font height + non-terminal font height) / 2 | |
864 | ;; | |
b685181e GM |
865 | ;; entry is the vertical position used to know where it should |
866 | ;; be drawn the flow line in the current element. | |
984ae001 | 867 | ;; |
ed0aa46c VJL |
868 | ;; extra is given by `ebnf-arrow-extra-width'. |
869 | ;; | |
984ae001 GM |
870 | ;; |
871 | ;; * SPECIAL, TERMINAL and NON-TERMINAL | |
872 | ;; | |
873 | ;; +==============+................................... | |
874 | ;; | | } font height / 2 } entry } | |
875 | ;; | XXXXXXXX...|....... } } | |
876 | ;; ====+ XXXXXXXX +==== } text height ...... } height | |
877 | ;; : | XXXXXXXX...|...:... } | |
878 | ;; : | : : | : } font height / 2 } | |
879 | ;; : +==============+...:............................... | |
880 | ;; : : : : : : | |
ed0aa46c VJL |
881 | ;; : : : : : :......................... |
882 | ;; : : : : : } font height } | |
883 | ;; : : : : :....... } | |
884 | ;; : : : : } font height / 2 } | |
885 | ;; : : : :........... } | |
886 | ;; : : : } text width } width | |
887 | ;; : : :.................. } | |
888 | ;; : : } font height / 2 } | |
889 | ;; : :...................... } | |
890 | ;; : } font height + extra } | |
891 | ;; :................................................. | |
984ae001 GM |
892 | ;; |
893 | ;; | |
894 | ;; * OPTIONAL | |
895 | ;; | |
896 | ;; +==========+..................................... | |
897 | ;; | | } } } | |
898 | ;; | | } entry } } | |
899 | ;; | | } } } | |
900 | ;; ===+===+ +===+===... } element height } height | |
901 | ;; : \ | | / : } } | |
902 | ;; : + | | + : } } | |
903 | ;; : | +==========+.|................. } | |
904 | ;; : | : : | : } font height } | |
905 | ;; : +==============+................................... | |
906 | ;; : : : : | |
907 | ;; : : : :...................... | |
908 | ;; : : : } font height * 2 } | |
909 | ;; : : :.......... } | |
910 | ;; : : } element width } width | |
911 | ;; : :..................... } | |
912 | ;; : } font height * 2 } | |
913 | ;; :............................................... | |
914 | ;; | |
915 | ;; | |
916 | ;; * ALTERNATIVE | |
917 | ;; | |
918 | ;; +===+................................... | |
919 | ;; +==+ A +==+ } A height } } | |
920 | ;; | +===+..|........ } entry } | |
921 | ;; + + } font height } } | |
922 | ;; / +===+...\....... } } | |
923 | ;; ===+====+ B +====+=== } B height ..... } height | |
924 | ;; : \ +===+.../....... } | |
925 | ;; : + + : } font height } | |
926 | ;; : | +===+..|........ } | |
927 | ;; : +==+ C +==+ : } C height } | |
928 | ;; : : +===+................................... | |
929 | ;; : : : : | |
930 | ;; : : : :...................... | |
931 | ;; : : : } font height * 2 } | |
932 | ;; : : :......... } | |
933 | ;; : : } max width } width | |
934 | ;; : :................. } | |
935 | ;; : } font height * 2 } | |
936 | ;; :.......................................... | |
937 | ;; | |
938 | ;; NOTES: | |
939 | ;; 1. An empty alternative has zero of height. | |
940 | ;; | |
941 | ;; 2. The variable `ebnf-entry-percentage' is used to determine the | |
942 | ;; entry point. | |
943 | ;; | |
944 | ;; | |
945 | ;; * ZERO OR MORE | |
946 | ;; | |
947 | ;; +===========+............................... | |
948 | ;; +=+ separator +=+ } separator height } | |
949 | ;; / +===========+..\........ } | |
950 | ;; + + } } | |
951 | ;; | | } font height } | |
952 | ;; + + } } | |
953 | ;; \ +===========+../........ } height = entry | |
954 | ;; +=+ element +=+ } element height } | |
955 | ;; /: +===========+..\........ } | |
956 | ;; + : : + } } | |
957 | ;; + : : + } font height } | |
958 | ;; / : : \ } } | |
959 | ;; ==+=======================+==....................... | |
960 | ;; : : : : | |
961 | ;; : : : :....................... | |
962 | ;; : : : } font height * 2 } | |
963 | ;; : : :......... } | |
964 | ;; : : } max width } width | |
965 | ;; : :......................... } | |
966 | ;; : } font height * 2 } | |
967 | ;; :................................................... | |
968 | ;; | |
969 | ;; | |
970 | ;; * ONE OR MORE | |
971 | ;; | |
972 | ;; +===========+...................................... | |
973 | ;; +=+ separator +=+ } separator height } } | |
974 | ;; / +===========+..\...... } } | |
975 | ;; + + } } entry } | |
976 | ;; | | } font height } } height | |
977 | ;; + + } } } | |
978 | ;; \ +===========+../...... } } | |
979 | ;; ===+=+ element +=+=== } element height .... } | |
980 | ;; : : +===========+...................................... | |
981 | ;; : : : : | |
982 | ;; : : : :........................ | |
983 | ;; : : : } font height * 2 } | |
984 | ;; : : :....... } | |
985 | ;; : : } max width } width | |
986 | ;; : :....................... } | |
987 | ;; : } font height * 2 } | |
988 | ;; :.............................................. | |
989 | ;; | |
990 | ;; | |
991 | ;; * PRODUCTION | |
992 | ;; | |
993 | ;; XXXXXX:...................................... | |
994 | ;; XXXXXX: } production font height } | |
995 | ;; XXXXXX:............ } | |
996 | ;; } font height } | |
997 | ;; +======+....... } height = entry | |
998 | ;; | | } } | |
999 | ;; ====+ +==== } element height } | |
1000 | ;; : | | : } } | |
1001 | ;; : +======+................................. | |
1002 | ;; : : : : | |
1003 | ;; : : : :...................... | |
1004 | ;; : : : } font height * 2 } | |
1005 | ;; : : :....... } | |
1006 | ;; : : } element width } width | |
1007 | ;; : :.............. } | |
1008 | ;; : } font height * 2 } | |
1009 | ;; :..................................... | |
1010 | ;; | |
1011 | ;; | |
1012 | ;; * REPEAT | |
1013 | ;; | |
1014 | ;; +================+................................... | |
1015 | ;; | | } font height / 2 } entry } | |
1016 | ;; | +===+...|....... } } | |
1017 | ;; ====+ N * | X | +==== } X height ......... } height | |
1018 | ;; : | : : +===+...|...:... } | |
1019 | ;; : | : : : : | : } font height / 2 } | |
1020 | ;; : +================+...:............................... | |
1021 | ;; : : : : : : : : | |
ed0aa46c VJL |
1022 | ;; : : : : : : : :.......................... |
1023 | ;; : : : : : : : } font height } | |
1024 | ;; : : : : : : :....... } | |
1025 | ;; : : : : : : } font height / 2 } | |
1026 | ;; : : : : : :........... } | |
1027 | ;; : : : : : } X width } | |
1028 | ;; : : : : :............... } | |
1029 | ;; : : : : } font height / 2 } width | |
1030 | ;; : : : :.................. } | |
1031 | ;; : : : } text width } | |
1032 | ;; : : :..................... } | |
1033 | ;; : : } font height / 2 } | |
1034 | ;; : :........................ } | |
1035 | ;; : } font height + extra } | |
1036 | ;; :................................................... | |
984ae001 GM |
1037 | ;; |
1038 | ;; | |
1039 | ;; * EXCEPT | |
1040 | ;; | |
1041 | ;; +==================+................................... | |
1042 | ;; | | } font height / 2 } entry } | |
1043 | ;; | +===+ +===+...|....... } } | |
1044 | ;; ====+ | X | - | y | +==== } max height ....... } height | |
1045 | ;; : | +===+ +===+...|...:... } | |
1046 | ;; : | : : : : | : } font height / 2 } | |
1047 | ;; : +==================+...:............................... | |
1048 | ;; : : : : : : : : | |
ed0aa46c VJL |
1049 | ;; : : : : : : : :.......................... |
1050 | ;; : : : : : : : } font height } | |
1051 | ;; : : : : : : :....... } | |
1052 | ;; : : : : : : } font height / 2 } | |
1053 | ;; : : : : : :........... } | |
1054 | ;; : : : : : } Y width } | |
1055 | ;; : : : : :............... } | |
1056 | ;; : : : : } font height } width | |
1057 | ;; : : : :................... } | |
1058 | ;; : : : } X width } | |
1059 | ;; : : :....................... } | |
1060 | ;; : : } font height / 2 } | |
1061 | ;; : :.......................... } | |
1062 | ;; : } font height + extra } | |
1063 | ;; :..................................................... | |
984ae001 GM |
1064 | ;; |
1065 | ;; NOTE: If Y element is empty, it's draw nothing at Y place. | |
1066 | ;; | |
1067 | ;; | |
1068 | ;; Internal Structures | |
1069 | ;; ------------------- | |
1070 | ;; | |
ab3256ed | 1071 | ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis |
984ae001 | 1072 | ;; of current buffer and generates an intermediate representation. The second |
b685181e | 1073 | ;; pass uses the intermediate representation to generate the PostScript |
ab3256ed | 1074 | ;; syntactic chart. |
984ae001 GM |
1075 | ;; |
1076 | ;; The intermediate representation is a list of vectors, the vector element | |
ab3256ed JB |
1077 | ;; represents a syntactic chart element. Below is a vector representation for |
1078 | ;; each syntactic chart element. | |
984ae001 | 1079 | ;; |
b685181e | 1080 | ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION] |
984ae001 GM |
1081 | ;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST] |
1082 | ;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST] | |
1083 | ;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT] | |
1084 | ;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT] | |
1085 | ;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT] | |
1086 | ;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH] | |
1087 | ;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT] | |
1088 | ;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR] | |
1089 | ;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR] | |
1090 | ;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT] | |
1091 | ;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT] | |
1092 | ;; | |
1093 | ;; The first vector position is a function symbol used to generate PostScript | |
1094 | ;; for this element. | |
1095 | ;; WIDTH-FUN is a function symbol called to adjust the element width. | |
1096 | ;; DIM-FUN is a function symbol called to set the element dimensions. | |
1097 | ;; ENTRY is the element entry point. | |
1098 | ;; HEIGHT and WIDTH are the element height and width, respectively. | |
1099 | ;; NAME is a string that it's the element name. | |
1100 | ;; DEFAULT is a boolean that indicates if it's a `default' element. | |
1101 | ;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current | |
1102 | ;; one. | |
1103 | ;; LIST is a list of vector that represents the list part for alternatives and | |
1104 | ;; sequences. | |
1105 | ;; SEPARATOR is a vector that represents the sub-element used to separate the | |
1106 | ;; list elements. | |
1107 | ;; TIMES is a string representing the number of times that ELEMENT is repeated | |
1108 | ;; on a repeat construction. | |
1109 | ;; ACTION indicates some action that should be done before production is | |
1110 | ;; generated. The current actions are: | |
1111 | ;; | |
1112 | ;; nil no action. | |
1113 | ;; | |
1114 | ;; form-feed current production starts on a new page. | |
1115 | ;; | |
1116 | ;; newline current production starts on next line, this is useful | |
1117 | ;; when `ebnf-horizontal-orientation' is non-nil. | |
1118 | ;; | |
1119 | ;; keep-line current production continues on the current line, this | |
1120 | ;; is useful when `ebnf-horizontal-orientation' is nil. | |
1121 | ;; | |
1122 | ;; | |
1123 | ;; Things To Change | |
1124 | ;; ---------------- | |
1125 | ;; | |
ab3256ed | 1126 | ;; . Handle situations when syntactic chart is out of paper. |
984ae001 GM |
1127 | ;; . Use other alphabet than ascii. |
1128 | ;; . Optimizations... | |
1129 | ;; | |
1130 | ;; | |
09ae5da1 PE |
1131 | ;; Acknowledgments |
1132 | ;; --------------- | |
984ae001 | 1133 | ;; |
4303661c VJL |
1134 | ;; Thanks to Eli Zaretskii <eliz@gnu.org> for some doc fixes. |
1135 | ;; | |
ea946fcc | 1136 | ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions: |
ed0aa46c VJL |
1137 | ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale', |
1138 | ;; `ebnf-production-name-p', `ebnf-stop-on-error', | |
ac4780a1 VJL |
1139 | ;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables. |
1140 | ;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory' | |
1141 | ;; commands. | |
1142 | ;; - some docs fix. | |
1143 | ;; | |
1144 | ;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal | |
1145 | ;; with some Bison features (%right, %left and %prec pragmas). His suggestion | |
1146 | ;; was extended to deal with %nonassoc pragma too. | |
1147 | ;; | |
984ae001 GM |
1148 | ;; Thanks to all who emailed comments. |
1149 | ;; | |
1150 | ;; | |
1151 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1152 | ||
e8af40ee | 1153 | ;;; Code: |
984ae001 GM |
1154 | |
1155 | ||
1156 | (require 'ps-print) | |
1157 | ||
b685181e GM |
1158 | (and (string< ps-print-version "5.2.3") |
1159 | (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) | |
984ae001 | 1160 | |
ea946fcc VJL |
1161 | |
1162 | ;; to avoid gripes with Emacs 20 | |
99439846 VJL |
1163 | (or (fboundp 'assq-delete-all) |
1164 | (defun assq-delete-all (key alist) | |
1165 | "Delete from ALIST all elements whose car is KEY. | |
ea946fcc VJL |
1166 | Return the modified alist. |
1167 | Elements of ALIST that are not conses are ignored." | |
99439846 VJL |
1168 | (let ((tail alist)) |
1169 | (while tail | |
1170 | (if (and (consp (car tail)) | |
1171 | (eq (car (car tail)) key)) | |
1172 | (setq alist (delq (car tail) alist))) | |
1173 | (setq tail (cdr tail))) | |
1174 | alist))) | |
ea946fcc | 1175 | |
984ae001 GM |
1176 | \f |
1177 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1178 | ;; User Variables: | |
1179 | ||
1180 | ||
1181 | ;;; Interface to the command system | |
1182 | ||
1183 | (defgroup postscript nil | |
cf20dee0 | 1184 | "Printing with PostScript" |
984ae001 | 1185 | :tag "PostScript" |
b11b1870 | 1186 | :version "20" |
cf20dee0 | 1187 | :group 'environment) |
984ae001 GM |
1188 | |
1189 | ||
1190 | (defgroup ebnf2ps nil | |
dfbe3e71 | 1191 | "Translate an EBNF to a syntactic chart on PostScript." |
984ae001 | 1192 | :prefix "ebnf-" |
b11b1870 | 1193 | :version "20" |
984ae001 GM |
1194 | :group 'wp |
1195 | :group 'postscript) | |
1196 | ||
1197 | ||
1198 | (defgroup ebnf-special nil | |
dfbe3e71 | 1199 | "Special customization." |
984ae001 GM |
1200 | :prefix "ebnf-" |
1201 | :tag "Special" | |
b11b1870 | 1202 | :version "20" |
984ae001 GM |
1203 | :group 'ebnf2ps) |
1204 | ||
1205 | ||
1206 | (defgroup ebnf-except nil | |
dfbe3e71 | 1207 | "Except customization." |
984ae001 GM |
1208 | :prefix "ebnf-" |
1209 | :tag "Except" | |
b11b1870 | 1210 | :version "20" |
984ae001 GM |
1211 | :group 'ebnf2ps) |
1212 | ||
1213 | ||
1214 | (defgroup ebnf-repeat nil | |
dfbe3e71 | 1215 | "Repeat customization." |
984ae001 GM |
1216 | :prefix "ebnf-" |
1217 | :tag "Repeat" | |
b11b1870 | 1218 | :version "20" |
984ae001 GM |
1219 | :group 'ebnf2ps) |
1220 | ||
1221 | ||
1222 | (defgroup ebnf-terminal nil | |
dfbe3e71 | 1223 | "Terminal customization." |
984ae001 GM |
1224 | :prefix "ebnf-" |
1225 | :tag "Terminal" | |
b11b1870 | 1226 | :version "20" |
984ae001 GM |
1227 | :group 'ebnf2ps) |
1228 | ||
1229 | ||
1230 | (defgroup ebnf-non-terminal nil | |
dfbe3e71 | 1231 | "Non-Terminal customization." |
984ae001 GM |
1232 | :prefix "ebnf-" |
1233 | :tag "Non-Terminal" | |
b11b1870 | 1234 | :version "20" |
984ae001 GM |
1235 | :group 'ebnf2ps) |
1236 | ||
1237 | ||
1238 | (defgroup ebnf-production nil | |
dfbe3e71 | 1239 | "Production customization." |
984ae001 GM |
1240 | :prefix "ebnf-" |
1241 | :tag "Production" | |
b11b1870 | 1242 | :version "20" |
984ae001 GM |
1243 | :group 'ebnf2ps) |
1244 | ||
1245 | ||
1246 | (defgroup ebnf-shape nil | |
dfbe3e71 | 1247 | "Shapes customization." |
984ae001 GM |
1248 | :prefix "ebnf-" |
1249 | :tag "Shape" | |
b11b1870 | 1250 | :version "20" |
984ae001 GM |
1251 | :group 'ebnf2ps) |
1252 | ||
1253 | ||
1254 | (defgroup ebnf-displacement nil | |
dfbe3e71 | 1255 | "Displacement customization." |
984ae001 GM |
1256 | :prefix "ebnf-" |
1257 | :tag "Displacement" | |
b11b1870 | 1258 | :version "20" |
984ae001 GM |
1259 | :group 'ebnf2ps) |
1260 | ||
1261 | ||
ab3256ed | 1262 | (defgroup ebnf-syntactic nil |
dfbe3e71 | 1263 | "Syntactic customization." |
984ae001 | 1264 | :prefix "ebnf-" |
ab3256ed | 1265 | :tag "Syntactic" |
b11b1870 | 1266 | :version "20" |
984ae001 GM |
1267 | :group 'ebnf2ps) |
1268 | ||
1269 | ||
1270 | (defgroup ebnf-optimization nil | |
dfbe3e71 | 1271 | "Optimization customization." |
984ae001 GM |
1272 | :prefix "ebnf-" |
1273 | :tag "Optimization" | |
b11b1870 | 1274 | :version "20" |
984ae001 GM |
1275 | :group 'ebnf2ps) |
1276 | ||
1277 | ||
1278 | (defcustom ebnf-horizontal-orientation nil | |
fb7ada5f | 1279 | "Non-nil means productions are drawn horizontally." |
984ae001 | 1280 | :type 'boolean |
b11b1870 | 1281 | :version "20" |
984ae001 GM |
1282 | :group 'ebnf-displacement) |
1283 | ||
1284 | ||
1285 | (defcustom ebnf-horizontal-max-height nil | |
fb7ada5f | 1286 | "Non-nil means to use maximum production height in horizontal orientation. |
984ae001 GM |
1287 | |
1288 | It is only used when `ebnf-horizontal-orientation' is non-nil." | |
1289 | :type 'boolean | |
b11b1870 | 1290 | :version "20" |
984ae001 GM |
1291 | :group 'ebnf-displacement) |
1292 | ||
1293 | ||
1294 | (defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value | |
fb7ada5f | 1295 | "Specify horizontal space in points between productions. |
984ae001 GM |
1296 | |
1297 | Value less or equal to zero forces ebnf2ps to set a proper default value." | |
1298 | :type 'number | |
b11b1870 | 1299 | :version "20" |
984ae001 GM |
1300 | :group 'ebnf-displacement) |
1301 | ||
1302 | ||
1303 | (defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value | |
fb7ada5f | 1304 | "Specify vertical space in points between productions. |
984ae001 GM |
1305 | |
1306 | Value less or equal to zero forces ebnf2ps to set a proper default value." | |
1307 | :type 'number | |
b11b1870 | 1308 | :version "20" |
984ae001 GM |
1309 | :group 'ebnf-displacement) |
1310 | ||
1311 | ||
1312 | (defcustom ebnf-justify-sequence 'center | |
fb7ada5f | 1313 | "Specify justification of terms in a sequence inside alternatives. |
984ae001 GM |
1314 | |
1315 | Valid values are: | |
1316 | ||
1317 | `left' left justification | |
1318 | `right' right justification | |
1319 | any other value centralize" | |
1320 | :type '(radio :tag "Sequence Justification" | |
1321 | (const left) (const right) (other :tag "center" center)) | |
b11b1870 | 1322 | :version "20" |
984ae001 GM |
1323 | :group 'ebnf-displacement) |
1324 | ||
1325 | ||
ac4780a1 | 1326 | (defcustom ebnf-special-show-delimiter t |
fb7ada5f | 1327 | "Non-nil means special delimiter (character `?') is shown." |
ac4780a1 | 1328 | :type 'boolean |
b11b1870 | 1329 | :version "20" |
ac4780a1 VJL |
1330 | :group 'ebnf-special) |
1331 | ||
1332 | ||
984ae001 | 1333 | (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic) |
fb7ada5f | 1334 | "Specify special font. |
984ae001 GM |
1335 | |
1336 | See documentation for `ebnf-production-font'." | |
1337 | :type '(list :tag "Special Font" | |
1338 | (number :tag "Font Size") | |
1339 | (symbol :tag "Font Name") | |
1340 | (choice :tag "Foreground Color" | |
1341 | (string :tag "Name") | |
1342 | (other :tag "Default" nil)) | |
1343 | (choice :tag "Background Color" | |
1344 | (string :tag "Name") | |
1345 | (other :tag "Default" nil)) | |
1346 | (repeat :tag "Font Attributes" :inline t | |
1347 | (choice (const bold) (const italic) | |
1348 | (const underline) (const strikeout) | |
1349 | (const overline) (const shadow) | |
1350 | (const box) (const outline)))) | |
b11b1870 | 1351 | :version "20" |
984ae001 GM |
1352 | :group 'ebnf-special) |
1353 | ||
1354 | ||
1355 | (defcustom ebnf-special-shape 'bevel | |
fb7ada5f | 1356 | "Specify special box shape. |
984ae001 GM |
1357 | |
1358 | See documentation for `ebnf-non-terminal-shape'." | |
1359 | :type '(radio :tag "Special Shape" | |
1360 | (const miter) (const round) (const bevel)) | |
b11b1870 | 1361 | :version "20" |
984ae001 GM |
1362 | :group 'ebnf-special) |
1363 | ||
1364 | ||
1365 | (defcustom ebnf-special-shadow nil | |
fb7ada5f | 1366 | "Non-nil means special box will have a shadow." |
984ae001 | 1367 | :type 'boolean |
b11b1870 | 1368 | :version "20" |
984ae001 GM |
1369 | :group 'ebnf-special) |
1370 | ||
1371 | ||
1372 | (defcustom ebnf-special-border-width 0.5 | |
fb7ada5f | 1373 | "Specify border width for special box." |
984ae001 | 1374 | :type 'number |
b11b1870 | 1375 | :version "20" |
984ae001 GM |
1376 | :group 'ebnf-special) |
1377 | ||
1378 | ||
1379 | (defcustom ebnf-special-border-color "Black" | |
fb7ada5f | 1380 | "Specify border color for special box." |
984ae001 | 1381 | :type 'string |
b11b1870 | 1382 | :version "20" |
984ae001 GM |
1383 | :group 'ebnf-special) |
1384 | ||
1385 | ||
1386 | (defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic) | |
fb7ada5f | 1387 | "Specify except font. |
984ae001 GM |
1388 | |
1389 | See documentation for `ebnf-production-font'." | |
1390 | :type '(list :tag "Except Font" | |
1391 | (number :tag "Font Size") | |
1392 | (symbol :tag "Font Name") | |
1393 | (choice :tag "Foreground Color" | |
1394 | (string :tag "Name") | |
1395 | (other :tag "Default" nil)) | |
1396 | (choice :tag "Background Color" | |
1397 | (string :tag "Name") | |
1398 | (other :tag "Default" nil)) | |
1399 | (repeat :tag "Font Attributes" :inline t | |
1400 | (choice (const bold) (const italic) | |
1401 | (const underline) (const strikeout) | |
1402 | (const overline) (const shadow) | |
1403 | (const box) (const outline)))) | |
b11b1870 | 1404 | :version "20" |
984ae001 GM |
1405 | :group 'ebnf-except) |
1406 | ||
1407 | ||
1408 | (defcustom ebnf-except-shape 'bevel | |
fb7ada5f | 1409 | "Specify except box shape. |
984ae001 GM |
1410 | |
1411 | See documentation for `ebnf-non-terminal-shape'." | |
1412 | :type '(radio :tag "Except Shape" | |
1413 | (const miter) (const round) (const bevel)) | |
b11b1870 | 1414 | :version "20" |
984ae001 GM |
1415 | :group 'ebnf-except) |
1416 | ||
1417 | ||
1418 | (defcustom ebnf-except-shadow nil | |
fb7ada5f | 1419 | "Non-nil means except box will have a shadow." |
984ae001 | 1420 | :type 'boolean |
b11b1870 | 1421 | :version "20" |
984ae001 GM |
1422 | :group 'ebnf-except) |
1423 | ||
1424 | ||
1425 | (defcustom ebnf-except-border-width 0.25 | |
fb7ada5f | 1426 | "Specify border width for except box." |
984ae001 | 1427 | :type 'number |
b11b1870 | 1428 | :version "20" |
984ae001 GM |
1429 | :group 'ebnf-except) |
1430 | ||
1431 | ||
1432 | (defcustom ebnf-except-border-color "Black" | |
fb7ada5f | 1433 | "Specify border color for except box." |
984ae001 | 1434 | :type 'string |
b11b1870 | 1435 | :version "20" |
984ae001 GM |
1436 | :group 'ebnf-except) |
1437 | ||
1438 | ||
1439 | (defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic) | |
fb7ada5f | 1440 | "Specify repeat font. |
984ae001 GM |
1441 | |
1442 | See documentation for `ebnf-production-font'." | |
1443 | :type '(list :tag "Repeat Font" | |
1444 | (number :tag "Font Size") | |
1445 | (symbol :tag "Font Name") | |
1446 | (choice :tag "Foreground Color" | |
1447 | (string :tag "Name") | |
1448 | (other :tag "Default" nil)) | |
1449 | (choice :tag "Background Color" | |
1450 | (string :tag "Name") | |
1451 | (other :tag "Default" nil)) | |
1452 | (repeat :tag "Font Attributes" :inline t | |
1453 | (choice (const bold) (const italic) | |
1454 | (const underline) (const strikeout) | |
1455 | (const overline) (const shadow) | |
1456 | (const box) (const outline)))) | |
b11b1870 | 1457 | :version "20" |
984ae001 GM |
1458 | :group 'ebnf-repeat) |
1459 | ||
1460 | ||
1461 | (defcustom ebnf-repeat-shape 'bevel | |
fb7ada5f | 1462 | "Specify repeat box shape. |
984ae001 GM |
1463 | |
1464 | See documentation for `ebnf-non-terminal-shape'." | |
1465 | :type '(radio :tag "Repeat Shape" | |
1466 | (const miter) (const round) (const bevel)) | |
b11b1870 | 1467 | :version "20" |
984ae001 GM |
1468 | :group 'ebnf-repeat) |
1469 | ||
1470 | ||
1471 | (defcustom ebnf-repeat-shadow nil | |
fb7ada5f | 1472 | "Non-nil means repeat box will have a shadow." |
984ae001 | 1473 | :type 'boolean |
b11b1870 | 1474 | :version "20" |
984ae001 GM |
1475 | :group 'ebnf-repeat) |
1476 | ||
1477 | ||
1478 | (defcustom ebnf-repeat-border-width 0.0 | |
fb7ada5f | 1479 | "Specify border width for repeat box." |
984ae001 | 1480 | :type 'number |
b11b1870 | 1481 | :version "20" |
984ae001 GM |
1482 | :group 'ebnf-repeat) |
1483 | ||
1484 | ||
1485 | (defcustom ebnf-repeat-border-color "Black" | |
fb7ada5f | 1486 | "Specify border color for repeat box." |
984ae001 | 1487 | :type 'string |
b11b1870 | 1488 | :version "20" |
984ae001 GM |
1489 | :group 'ebnf-repeat) |
1490 | ||
1491 | ||
1492 | (defcustom ebnf-terminal-font '(7 Courier "Black" "White") | |
fb7ada5f | 1493 | "Specify terminal font. |
984ae001 GM |
1494 | |
1495 | See documentation for `ebnf-production-font'." | |
1496 | :type '(list :tag "Terminal Font" | |
1497 | (number :tag "Font Size") | |
1498 | (symbol :tag "Font Name") | |
1499 | (choice :tag "Foreground Color" | |
1500 | (string :tag "Name") | |
1501 | (other :tag "Default" nil)) | |
1502 | (choice :tag "Background Color" | |
1503 | (string :tag "Name") | |
1504 | (other :tag "Default" nil)) | |
1505 | (repeat :tag "Font Attributes" :inline t | |
1506 | (choice (const bold) (const italic) | |
1507 | (const underline) (const strikeout) | |
1508 | (const overline) (const shadow) | |
1509 | (const box) (const outline)))) | |
b11b1870 | 1510 | :version "20" |
984ae001 GM |
1511 | :group 'ebnf-terminal) |
1512 | ||
1513 | ||
1514 | (defcustom ebnf-terminal-shape 'miter | |
fb7ada5f | 1515 | "Specify terminal box shape. |
984ae001 GM |
1516 | |
1517 | See documentation for `ebnf-non-terminal-shape'." | |
1518 | :type '(radio :tag "Terminal Shape" | |
1519 | (const miter) (const round) (const bevel)) | |
b11b1870 | 1520 | :version "20" |
984ae001 GM |
1521 | :group 'ebnf-terminal) |
1522 | ||
1523 | ||
1524 | (defcustom ebnf-terminal-shadow nil | |
fb7ada5f | 1525 | "Non-nil means terminal box will have a shadow." |
984ae001 | 1526 | :type 'boolean |
b11b1870 | 1527 | :version "20" |
984ae001 GM |
1528 | :group 'ebnf-terminal) |
1529 | ||
1530 | ||
1531 | (defcustom ebnf-terminal-border-width 1.0 | |
fb7ada5f | 1532 | "Specify border width for terminal box." |
984ae001 | 1533 | :type 'number |
b11b1870 | 1534 | :version "20" |
984ae001 GM |
1535 | :group 'ebnf-terminal) |
1536 | ||
1537 | ||
1538 | (defcustom ebnf-terminal-border-color "Black" | |
fb7ada5f | 1539 | "Specify border color for terminal box." |
984ae001 | 1540 | :type 'string |
b11b1870 | 1541 | :version "20" |
984ae001 GM |
1542 | :group 'ebnf-terminal) |
1543 | ||
1544 | ||
ac4780a1 | 1545 | (defcustom ebnf-production-name-p t |
fb7ada5f | 1546 | "Non-nil means production name will be printed." |
ac4780a1 | 1547 | :type 'boolean |
b11b1870 | 1548 | :version "20" |
ac4780a1 VJL |
1549 | :group 'ebnf-production) |
1550 | ||
1551 | ||
984ae001 | 1552 | (defcustom ebnf-sort-production nil |
fb7ada5f | 1553 | "Specify how productions are sorted. |
984ae001 GM |
1554 | |
1555 | Valid values are: | |
1556 | ||
1557 | nil don't sort productions. | |
1558 | `ascending' ascending sort. | |
1559 | any other value descending sort." | |
1560 | :type '(radio :tag "Production Sort" | |
1561 | (const :tag "Ascending" ascending) | |
1562 | (const :tag "Descending" descending) | |
1563 | (other :tag "No Sort" nil)) | |
b11b1870 | 1564 | :version "20" |
984ae001 GM |
1565 | :group 'ebnf-production) |
1566 | ||
1567 | ||
1568 | (defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold) | |
fb7ada5f | 1569 | "Specify production header font. |
984ae001 GM |
1570 | |
1571 | It is a list with the following form: | |
1572 | ||
1573 | (SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...) | |
1574 | ||
1575 | Where: | |
1576 | SIZE is the font size. | |
1577 | NAME is the font name symbol. | |
1578 | ATTRIBUTE is one of the following symbols: | |
1579 | bold - use bold font. | |
1580 | italic - use italic font. | |
1581 | underline - put a line under text. | |
1582 | strikeout - like underline, but the line is in middle of text. | |
1583 | overline - like underline, but the line is over the text. | |
1584 | shadow - text will have a shadow. | |
1585 | box - text will be surrounded by a box. | |
1586 | outline - print characters as hollow outlines. | |
1587 | FOREGROUND is a foreground string color name; if it's nil, the default color is | |
1588 | \"Black\". | |
1589 | BACKGROUND is a background string color name; if it's nil, the default color is | |
1590 | \"White\". | |
1591 | ||
1592 | See `ps-font-info-database' for valid font name." | |
1593 | :type '(list :tag "Production Font" | |
1594 | (number :tag "Font Size") | |
1595 | (symbol :tag "Font Name") | |
1596 | (choice :tag "Foreground Color" | |
1597 | (string :tag "Name") | |
1598 | (other :tag "Default" nil)) | |
1599 | (choice :tag "Background Color" | |
1600 | (string :tag "Name") | |
1601 | (other :tag "Default" nil)) | |
1602 | (repeat :tag "Font Attributes" :inline t | |
1603 | (choice (const bold) (const italic) | |
1604 | (const underline) (const strikeout) | |
1605 | (const overline) (const shadow) | |
1606 | (const box) (const outline)))) | |
b11b1870 | 1607 | :version "20" |
984ae001 GM |
1608 | :group 'ebnf-production) |
1609 | ||
1610 | ||
1611 | (defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White") | |
fb7ada5f | 1612 | "Specify non-terminal font. |
984ae001 GM |
1613 | |
1614 | See documentation for `ebnf-production-font'." | |
1615 | :type '(list :tag "Non-Terminal Font" | |
1616 | (number :tag "Font Size") | |
1617 | (symbol :tag "Font Name") | |
1618 | (choice :tag "Foreground Color" | |
1619 | (string :tag "Name") | |
1620 | (other :tag "Default" nil)) | |
1621 | (choice :tag "Background Color" | |
1622 | (string :tag "Name") | |
1623 | (other :tag "Default" nil)) | |
1624 | (repeat :tag "Font Attributes" :inline t | |
1625 | (choice (const bold) (const italic) | |
1626 | (const underline) (const strikeout) | |
1627 | (const overline) (const shadow) | |
1628 | (const box) (const outline)))) | |
b11b1870 | 1629 | :version "20" |
984ae001 GM |
1630 | :group 'ebnf-non-terminal) |
1631 | ||
1632 | ||
1633 | (defcustom ebnf-non-terminal-shape 'round | |
fb7ada5f | 1634 | "Specify non-terminal box shape. |
984ae001 GM |
1635 | |
1636 | Valid values are: | |
1637 | ||
1638 | `miter' +-------+ | |
1639 | | | | |
1640 | +-------+ | |
1641 | ||
1642 | `round' ------- | |
1643 | ( ) | |
1644 | ------- | |
1645 | ||
1646 | `bevel' /-------\\ | |
1647 | | | | |
1648 | \\-------/ | |
1649 | ||
1650 | Any other value is treated as `miter'." | |
1651 | :type '(radio :tag "Non-Terminal Shape" | |
1652 | (const miter) (const round) (const bevel)) | |
b11b1870 | 1653 | :version "20" |
984ae001 GM |
1654 | :group 'ebnf-non-terminal) |
1655 | ||
1656 | ||
1657 | (defcustom ebnf-non-terminal-shadow nil | |
fb7ada5f | 1658 | "Non-nil means non-terminal box will have a shadow." |
984ae001 | 1659 | :type 'boolean |
b11b1870 | 1660 | :version "20" |
984ae001 GM |
1661 | :group 'ebnf-non-terminal) |
1662 | ||
1663 | ||
1664 | (defcustom ebnf-non-terminal-border-width 1.0 | |
fb7ada5f | 1665 | "Specify border width for non-terminal box." |
984ae001 | 1666 | :type 'number |
b11b1870 | 1667 | :version "20" |
984ae001 GM |
1668 | :group 'ebnf-non-terminal) |
1669 | ||
1670 | ||
1671 | (defcustom ebnf-non-terminal-border-color "Black" | |
fb7ada5f | 1672 | "Specify border color for non-terminal box." |
984ae001 | 1673 | :type 'string |
b11b1870 | 1674 | :version "20" |
984ae001 GM |
1675 | :group 'ebnf-non-terminal) |
1676 | ||
1677 | ||
1678 | (defcustom ebnf-arrow-shape 'hollow | |
fb7ada5f | 1679 | "Specify the arrow shape. |
984ae001 GM |
1680 | |
1681 | Valid values are: | |
1682 | ||
1683 | `none' ====== | |
1684 | ||
1685 | `semi-up' * `transparent' * | |
1686 | * |* | |
1687 | =====* | * | |
1688 | ==+==* | |
1689 | | * | |
1690 | |* | |
1691 | * | |
1692 | ||
1693 | `semi-down' =====* `hollow' * | |
1694 | * |* | |
1695 | * | * | |
1696 | ==+ * | |
1697 | | * | |
1698 | |* | |
1699 | * | |
1700 | ||
1701 | `simple' * `full' * | |
1702 | * |* | |
1703 | =====* |X* | |
1704 | * ==+XX* | |
1705 | * |X* | |
1706 | |* | |
1707 | * | |
1708 | ||
ac4780a1 VJL |
1709 | `semi-up-hollow' `semi-up-full' |
1710 | * * | |
1711 | |* |* | |
1712 | | * |X* | |
1713 | ==+==* ==+==* | |
1714 | ||
1715 | `semi-down-hollow' `semi-down-full' | |
1716 | ==+==* ==+==* | |
1717 | | * |X* | |
1718 | |* |* | |
1719 | * * | |
1720 | ||
984ae001 GM |
1721 | `user' See also documentation for variable `ebnf-user-arrow'. |
1722 | ||
1723 | Any other value is treated as `none'." | |
1724 | :type '(radio :tag "Arrow Shape" | |
ac4780a1 VJL |
1725 | (const none) (const semi-up) |
1726 | (const semi-down) (const simple) | |
1727 | (const transparent) (const hollow) | |
1728 | (const full) (const semi-up-hollow) | |
1729 | (const semi-down-hollow) (const semi-up-full) | |
1730 | (const semi-down-full) (const user)) | |
b11b1870 | 1731 | :version "20" |
984ae001 GM |
1732 | :group 'ebnf-shape) |
1733 | ||
1734 | ||
1735 | (defcustom ebnf-chart-shape 'round | |
fb7ada5f | 1736 | "Specify chart flow shape. |
984ae001 GM |
1737 | |
1738 | See documentation for `ebnf-non-terminal-shape'." | |
1739 | :type '(radio :tag "Chart Flow Shape" | |
1740 | (const miter) (const round) (const bevel)) | |
b11b1870 | 1741 | :version "20" |
984ae001 GM |
1742 | :group 'ebnf-shape) |
1743 | ||
1744 | ||
1745 | (defcustom ebnf-user-arrow nil | |
fb7ada5f | 1746 | "Specify a sexp for user arrow shape (a PostScript code). |
984ae001 | 1747 | |
bf061ba6 GM |
1748 | When evaluated, the sexp should return nil or a string containing PostScript |
1749 | code. PostScript code should draw a right arrow. | |
984ae001 GM |
1750 | |
1751 | The anatomy of a right arrow is: | |
1752 | ||
1753 | ...... Initial position | |
1754 | : | |
1755 | : *................. | |
1756 | : | * } } | |
1757 | : | * } hT4 } | |
1758 | v | * } } | |
1759 | ======+======*... } hT2 | |
1760 | : | *: } } | |
1761 | : | * : } hT4 } | |
1762 | : | * : } } | |
1763 | : *................. | |
1764 | : : : | |
1765 | : : :.......... | |
1766 | : : } hT2 } | |
1767 | : :.......... } hT | |
1768 | : } hT2 } | |
1769 | :....................... | |
1770 | ||
b685181e GM |
1771 | Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can |
1772 | be used to generate your own arrow. As these variables are used along | |
1773 | PostScript execution, *DON'T* modify the values of them. Instead, copy the | |
1774 | values, if you need to modify them. | |
984ae001 GM |
1775 | |
1776 | The relation between these variables is: hT = 2 * hT2 = 4 * hT4. | |
1777 | ||
1778 | The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to | |
bf061ba6 GM |
1779 | symbol `user'." |
1780 | :type '(sexp :tag "User Arrow Shape") | |
b11b1870 | 1781 | :version "20" |
984ae001 GM |
1782 | :group 'ebnf-shape) |
1783 | ||
1784 | ||
1785 | (defcustom ebnf-syntax 'ebnf | |
fb7ada5f | 1786 | "Specify syntax to be recognized. |
984ae001 GM |
1787 | |
1788 | Valid values are: | |
1789 | ||
887448e1 GM |
1790 | `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps |
1791 | documentation. | |
984ae001 GM |
1792 | The following variables *ONLY* have effect with this |
1793 | setting: | |
1794 | `ebnf-terminal-regexp', `ebnf-case-fold-search', | |
1795 | `ebnf-lex-comment-char' and `ebnf-lex-eop-char'. | |
1796 | ||
ac4780a1 | 1797 | `abnf' ebnf2ps recognizes the syntax described in the URL: |
97818b07 | 1798 | `http://www.ietf.org/rfc/rfc2234.txt' |
ac4780a1 VJL |
1799 | (\"Augmented BNF for Syntax Specifications: ABNF\"). |
1800 | ||
984ae001 GM |
1801 | `iso-ebnf' ebnf2ps recognizes the syntax described in the URL: |
1802 | `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html' | |
1803 | (\"International Standard of the ISO EBNF Notation\"). | |
1804 | The following variables *ONLY* have effect with this | |
1805 | setting: | |
1806 | `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'. | |
1807 | ||
1808 | `yacc' ebnf2ps recognizes the Yacc/Bison syntax. | |
1809 | The following variable *ONLY* has effect with this | |
1810 | setting: | |
1811 | `ebnf-yac-ignore-error-recovery'. | |
1812 | ||
6ca94f87 VJL |
1813 | `ebnfx' ebnf2ps recognizes the syntax described in the URL: |
1814 | `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation' | |
1815 | (\"Extensible Markup Language (XML) 1.0 (Third Edition)\") | |
1816 | ||
6411a60a VJL |
1817 | `dtd' ebnf2ps recognizes the syntax described in the URL: |
1818 | `http://www.w3.org/TR/2004/REC-xml-20040204/' | |
1819 | (\"Extensible Markup Language (XML) 1.0 (Third Edition)\") | |
1820 | ||
984ae001 GM |
1821 | Any other value is treated as `ebnf'." |
1822 | :type '(radio :tag "Syntax" | |
6ca94f87 | 1823 | (const ebnf) (const abnf) (const iso-ebnf) |
6411a60a | 1824 | (const yacc) (const ebnfx) (const dtd)) |
b11b1870 | 1825 | :version "20" |
ab3256ed | 1826 | :group 'ebnf-syntactic) |
984ae001 GM |
1827 | |
1828 | ||
1829 | (defcustom ebnf-lex-comment-char ?\; | |
fb7ada5f | 1830 | "Specify the line comment character. |
984ae001 GM |
1831 | |
1832 | It's used only when `ebnf-syntax' is `ebnf'." | |
1833 | :type 'character | |
b11b1870 | 1834 | :version "20" |
ab3256ed | 1835 | :group 'ebnf-syntactic) |
984ae001 GM |
1836 | |
1837 | ||
1838 | (defcustom ebnf-lex-eop-char ?. | |
fb7ada5f | 1839 | "Specify the end of production character. |
984ae001 GM |
1840 | |
1841 | It's used only when `ebnf-syntax' is `ebnf'." | |
1842 | :type 'character | |
b11b1870 | 1843 | :version "20" |
ab3256ed | 1844 | :group 'ebnf-syntactic) |
984ae001 GM |
1845 | |
1846 | ||
1847 | (defcustom ebnf-terminal-regexp nil | |
fb7ada5f | 1848 | "Specify how it's a terminal name. |
984ae001 GM |
1849 | |
1850 | If it's nil, the terminal name must be enclosed by `\"'. | |
1851 | If it's a string, it should be a regexp that it'll be used to determine a | |
1852 | terminal name; terminal name may also be enclosed by `\"'. | |
1853 | ||
1854 | It's used only when `ebnf-syntax' is `ebnf'." | |
1855 | :type '(radio :tag "Terminal Name" | |
1856 | (const nil) regexp) | |
b11b1870 | 1857 | :version "20" |
ab3256ed | 1858 | :group 'ebnf-syntactic) |
984ae001 GM |
1859 | |
1860 | ||
1861 | (defcustom ebnf-case-fold-search nil | |
fb7ada5f | 1862 | "Non-nil means ignore case on matching. |
984ae001 GM |
1863 | |
1864 | It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is | |
1865 | `ebnf'." | |
1866 | :type 'boolean | |
b11b1870 | 1867 | :version "20" |
ab3256ed | 1868 | :group 'ebnf-syntactic) |
984ae001 GM |
1869 | |
1870 | ||
1871 | (defcustom ebnf-iso-alternative-p nil | |
fb7ada5f | 1872 | "Non-nil means use alternative ISO EBNF. |
984ae001 GM |
1873 | |
1874 | It's only used when `ebnf-syntax' is `iso-ebnf'. | |
1875 | ||
1876 | This variable affects the following symbol set: | |
1877 | ||
1878 | STANDARD ALTERNATIVE | |
1879 | | ==> / or ! | |
1880 | [ ==> (/ | |
1881 | ] ==> /) | |
1882 | { ==> (: | |
1883 | } ==> :) | |
1884 | ; ==> ." | |
1885 | :type 'boolean | |
b11b1870 | 1886 | :version "20" |
ab3256ed | 1887 | :group 'ebnf-syntactic) |
984ae001 GM |
1888 | |
1889 | ||
1890 | (defcustom ebnf-iso-normalize-p nil | |
fb7ada5f | 1891 | "Non-nil means normalize ISO EBNF syntax names. |
984ae001 GM |
1892 | |
1893 | Normalize a name means that several contiguous spaces inside name become a | |
1894 | single space, so \"A B C\" is normalized to \"A B C\". | |
1895 | ||
1896 | It's only used when `ebnf-syntax' is `iso-ebnf'." | |
1897 | :type 'boolean | |
b11b1870 | 1898 | :version "20" |
ab3256ed | 1899 | :group 'ebnf-syntactic) |
984ae001 GM |
1900 | |
1901 | ||
ac4780a1 | 1902 | (defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$" |
fb7ada5f | 1903 | "Specify file name suffix that contains EBNF. |
ac4780a1 VJL |
1904 | |
1905 | See `ebnf-eps-directory' command." | |
1906 | :type 'regexp | |
b11b1870 | 1907 | :version "20" |
ac4780a1 VJL |
1908 | :group 'ebnf2ps) |
1909 | ||
1910 | ||
984ae001 | 1911 | (defcustom ebnf-eps-prefix "ebnf--" |
fb7ada5f | 1912 | "Specify EPS prefix file name. |
984ae001 GM |
1913 | |
1914 | See `ebnf-eps-buffer' and `ebnf-eps-region' commands." | |
1915 | :type 'string | |
b11b1870 | 1916 | :version "20" |
984ae001 GM |
1917 | :group 'ebnf2ps) |
1918 | ||
1919 | ||
3ced5caa | 1920 | (defcustom ebnf-eps-header-font '(11 Helvetica "Black" "White" bold) |
fb7ada5f | 1921 | "Specify EPS header font. |
3ced5caa VJL |
1922 | |
1923 | See documentation for `ebnf-production-font'. | |
1924 | ||
1925 | See `ebnf-eps-buffer' and `ebnf-eps-region' commands." | |
1926 | :type '(list :tag "EPS Header Font" | |
1927 | (number :tag "Font Size") | |
1928 | (symbol :tag "Font Name") | |
1929 | (choice :tag "Foreground Color" | |
1930 | (string :tag "Name") | |
1931 | (other :tag "Default" nil)) | |
1932 | (choice :tag "Background Color" | |
1933 | (string :tag "Name") | |
1934 | (other :tag "Default" nil)) | |
1935 | (repeat :tag "Font Attributes" :inline t | |
1936 | (choice (const bold) (const italic) | |
1937 | (const underline) (const strikeout) | |
1938 | (const overline) (const shadow) | |
1939 | (const box) (const outline)))) | |
1940 | :version "22" | |
1941 | :group 'ebnf2ps) | |
1942 | ||
1943 | ||
1944 | (defcustom ebnf-eps-header nil | |
fb7ada5f | 1945 | "Specify EPS header. |
3ced5caa VJL |
1946 | |
1947 | The value should be a string, a symbol or nil. | |
1948 | ||
1949 | String is inserted unchanged. | |
1950 | ||
1951 | For symbol bounded to a function, the function is called and should return a | |
1952 | string. For symbol bounded to a value, the value should be a string. | |
1953 | ||
1954 | If symbol is unbounded, it is silently ignored. | |
1955 | ||
1956 | Empty string or nil mean that no header will be generated. | |
1957 | ||
1958 | Note that when the header action comment (;H in EBNF syntax) is specified, the | |
1959 | string in the header action comment is processed and, if it returns a non-empty | |
1960 | string, it's used to generate the header. The header action comment accepts | |
1961 | the following formats: | |
1962 | ||
1963 | %% prints a % character. | |
1964 | ||
1965 | %H prints the `ebnf-eps-header' value. | |
1966 | ||
1967 | %F prints the `ebnf-eps-footer' (which see) value. | |
1968 | ||
1969 | Any other format is ignored, that is, if, for example, it's used %s then %s | |
1970 | characters are stripped out from the header. If header action comment is an | |
1971 | empty string, no header is generated until a non-empty header is specified or | |
1972 | `ebnf-eps-header' has a non-empty string value." | |
1973 | :type '(repeat (choice :menu-tag "EPS Header" | |
1974 | :tag "EPS Header" | |
1975 | string symbol (const :tag "No Header" nil ))) | |
1976 | :version "22" | |
1977 | :group 'ebnf2ps) | |
1978 | ||
1979 | ||
1980 | (defcustom ebnf-eps-footer-font '(7 Helvetica "Black" "White" bold) | |
fb7ada5f | 1981 | "Specify EPS footer font. |
3ced5caa VJL |
1982 | |
1983 | See documentation for `ebnf-production-font'. | |
1984 | ||
1985 | See `ebnf-eps-buffer' and `ebnf-eps-region' commands." | |
1986 | :type '(list :tag "EPS Footer Font" | |
1987 | (number :tag "Font Size") | |
1988 | (symbol :tag "Font Name") | |
1989 | (choice :tag "Foreground Color" | |
1990 | (string :tag "Name") | |
1991 | (other :tag "Default" nil)) | |
1992 | (choice :tag "Background Color" | |
1993 | (string :tag "Name") | |
1994 | (other :tag "Default" nil)) | |
1995 | (repeat :tag "Font Attributes" :inline t | |
1996 | (choice (const bold) (const italic) | |
1997 | (const underline) (const strikeout) | |
1998 | (const overline) (const shadow) | |
1999 | (const box) (const outline)))) | |
2000 | :version "22" | |
2001 | :group 'ebnf2ps) | |
2002 | ||
2003 | ||
2004 | (defcustom ebnf-eps-footer nil | |
fb7ada5f | 2005 | "Specify EPS footer. |
3ced5caa VJL |
2006 | |
2007 | The value should be a string, a symbol or nil. | |
2008 | ||
2009 | String is inserted unchanged. | |
2010 | ||
2011 | For symbol bounded to a function, the function is called and should return a | |
2012 | string. For symbol bounded to a value, the value should be a string. | |
2013 | ||
2014 | If symbol is unbounded, it is silently ignored. | |
2015 | ||
2016 | Empty string or nil mean that no footer will be generated. | |
2017 | ||
2018 | Note that when the footer action comment (;F in EBNF syntax) is specified, the | |
2019 | string in the footer action comment is processed and, if it returns a non-empty | |
2020 | string, it's used to generate the footer. The footer action comment accepts | |
2021 | the following formats: | |
2022 | ||
2023 | %% prints a % character. | |
2024 | ||
2025 | %H prints the `ebnf-eps-header' (which see) value. | |
2026 | ||
2027 | %F prints the `ebnf-eps-footer' value. | |
2028 | ||
2029 | Any other format is ignored, that is, if, for example, it's used %s then %s | |
2030 | characters are stripped out from the footer. If footer action comment is an | |
2031 | empty string, no footer is generated until a non-empty footer is specified or | |
2032 | `ebnf-eps-footer' has a non-empty string value." | |
2033 | :type '(repeat (choice :menu-tag "EPS Footer" | |
2034 | :tag "EPS Footer" | |
2035 | string symbol (const :tag "No Footer" nil ))) | |
2036 | :version "22" | |
2037 | :group 'ebnf2ps) | |
2038 | ||
2039 | ||
984ae001 | 2040 | (defcustom ebnf-entry-percentage 0.5 ; middle |
fb7ada5f | 2041 | "Specify entry height on alternatives. |
984ae001 GM |
2042 | |
2043 | It must be a float between 0.0 (top) and 1.0 (bottom)." | |
2044 | :type 'number | |
b11b1870 | 2045 | :version "20" |
984ae001 GM |
2046 | :group 'ebnf2ps) |
2047 | ||
2048 | ||
2049 | (defcustom ebnf-default-width 0.6 | |
fb7ada5f | 2050 | "Specify additional border width over default terminal, non-terminal or |
984ae001 GM |
2051 | special." |
2052 | :type 'number | |
b11b1870 | 2053 | :version "20" |
984ae001 GM |
2054 | :group 'ebnf2ps) |
2055 | ||
2056 | ||
2057 | ;; Printing color requires x-color-values. | |
2058 | (defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs | |
2059 | (fboundp 'color-instance-rgb-components)) ; XEmacs | |
fb7ada5f | 2060 | "Non-nil means use color." |
984ae001 | 2061 | :type 'boolean |
b11b1870 | 2062 | :version "20" |
984ae001 GM |
2063 | :group 'ebnf2ps) |
2064 | ||
2065 | ||
2066 | (defcustom ebnf-line-width 1.0 | |
fb7ada5f | 2067 | "Specify flow line width." |
984ae001 | 2068 | :type 'number |
b11b1870 | 2069 | :version "20" |
984ae001 GM |
2070 | :group 'ebnf2ps) |
2071 | ||
2072 | ||
2073 | (defcustom ebnf-line-color "Black" | |
fb7ada5f | 2074 | "Specify flow line color." |
984ae001 | 2075 | :type 'string |
b11b1870 | 2076 | :version "20" |
984ae001 GM |
2077 | :group 'ebnf2ps) |
2078 | ||
2079 | ||
ed0aa46c VJL |
2080 | (defcustom ebnf-arrow-extra-width |
2081 | (if (eq ebnf-arrow-shape 'none) | |
2082 | 0.0 | |
2083 | (* (sqrt 5.0) 0.65 ebnf-line-width)) | |
fb7ada5f | 2084 | "Specify extra width for arrow shape drawing. |
ed0aa46c VJL |
2085 | |
2086 | The extra width is used to avoid that the arrowhead and the terminal border | |
4c36be58 | 2087 | overlap. It depends on `ebnf-arrow-shape' and `ebnf-line-width'." |
ed0aa46c VJL |
2088 | :type 'number |
2089 | :version "22" | |
2090 | :group 'ebnf-shape) | |
2091 | ||
2092 | ||
2093 | (defcustom ebnf-arrow-scale 1.0 | |
fb7ada5f | 2094 | "Specify the arrow scale. |
ed0aa46c VJL |
2095 | |
2096 | Values lower than 1.0, shrink the arrow. | |
2097 | Values greater than 1.0, expand the arrow." | |
2098 | :type 'number | |
2099 | :version "22" | |
2100 | :group 'ebnf-shape) | |
2101 | ||
2102 | ||
984ae001 | 2103 | (defcustom ebnf-debug-ps nil |
fb7ada5f | 2104 | "Non-nil means to generate PostScript debug procedures. |
984ae001 GM |
2105 | |
2106 | It is intended to help PostScript programmers in debugging." | |
2107 | :type 'boolean | |
b11b1870 | 2108 | :version "20" |
984ae001 GM |
2109 | :group 'ebnf2ps) |
2110 | ||
2111 | ||
2112 | (defcustom ebnf-use-float-format t | |
fb7ada5f | 2113 | "Non-nil means use `%f' float format. |
984ae001 GM |
2114 | |
2115 | The advantage of using float format is that ebnf2ps generates a little short | |
2116 | PostScript file. | |
2117 | ||
2118 | If it occurs the error message: | |
2119 | ||
2120 | Invalid format operation %f | |
2121 | ||
2122 | when executing ebnf2ps, set `ebnf-use-float-format' to nil." | |
2123 | :type 'boolean | |
b11b1870 | 2124 | :version "20" |
984ae001 GM |
2125 | :group 'ebnf2ps) |
2126 | ||
2127 | ||
ac4780a1 | 2128 | (defcustom ebnf-stop-on-error nil |
fb7ada5f | 2129 | "Non-nil means signal error and stop. Otherwise, signal error and continue." |
ac4780a1 | 2130 | :type 'boolean |
b11b1870 | 2131 | :version "20" |
ac4780a1 VJL |
2132 | :group 'ebnf2ps) |
2133 | ||
2134 | ||
984ae001 | 2135 | (defcustom ebnf-yac-ignore-error-recovery nil |
fb7ada5f | 2136 | "Non-nil means ignore error recovery. |
984ae001 GM |
2137 | |
2138 | It's only used when `ebnf-syntax' is `yacc'." | |
2139 | :type 'boolean | |
b11b1870 | 2140 | :version "20" |
ab3256ed | 2141 | :group 'ebnf-syntactic) |
984ae001 GM |
2142 | |
2143 | ||
2144 | (defcustom ebnf-ignore-empty-rule nil | |
fb7ada5f | 2145 | "Non-nil means ignore empty rules. |
984ae001 GM |
2146 | |
2147 | It's interesting to set this variable if your Yacc/Bison grammar has a lot of | |
2148 | middle action rule." | |
2149 | :type 'boolean | |
b11b1870 | 2150 | :version "20" |
984ae001 GM |
2151 | :group 'ebnf-optimization) |
2152 | ||
2153 | ||
2154 | (defcustom ebnf-optimize nil | |
fb7ada5f | 2155 | "Non-nil means optimize syntactic chart of rules. |
984ae001 GM |
2156 | |
2157 | The following optimizations are done: | |
2158 | ||
2159 | left recursion: | |
2160 | 1. A = B | A C. ==> A = B {C}*. | |
2161 | 2. A = B | A B. ==> A = {B}+. | |
2162 | 3. A = | A B. ==> A = {B}*. | |
2163 | 4. A = B | A C B. ==> A = {B || C}+. | |
2164 | 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*. | |
2165 | ||
2166 | optional: | |
2167 | 6. A = B | . ==> A = [B]. | |
2168 | 7. A = | B . ==> A = [B]. | |
2169 | ||
ad96a7ef | 2170 | factorization: |
984ae001 GM |
2171 | 8. A = B C | B D. ==> A = B (C | D). |
2172 | 9. A = C B | D B. ==> A = (C | D) B. | |
2173 | 10. A = B C E | B D E. ==> A = B (C | D) E. | |
2174 | ||
2175 | The above optimizations are specially useful when `ebnf-syntax' is `yacc'." | |
2176 | :type 'boolean | |
b11b1870 | 2177 | :version "20" |
984ae001 GM |
2178 | :group 'ebnf-optimization) |
2179 | ||
3ced5caa VJL |
2180 | |
2181 | (defcustom ebnf-log nil | |
fb7ada5f | 2182 | "Non-nil means generate log messages. |
3ced5caa VJL |
2183 | |
2184 | The log messages are generated into the buffer *Ebnf2ps Log*. | |
2185 | These messages are intended to help debugging ebnf2ps." | |
2186 | :type 'boolean | |
2187 | :version "22" | |
2188 | :group 'ebnf2ps) | |
2189 | ||
984ae001 | 2190 | \f |
6411a60a VJL |
2191 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2192 | ;; To make this file smaller, some commands go in a separate file. | |
2193 | ;; But autoload them here to make the separation invisible. | |
2194 | ;; Autoload is here to avoid compilation gripes. | |
2195 | ||
2196 | (autoload 'ebnf-eliminate-empty-rules "ebnf-otz" | |
2197 | "Eliminate empty rules.") | |
2198 | ||
2199 | (autoload 'ebnf-optimize "ebnf-otz" | |
2200 | "Syntactic chart optimizer.") | |
2201 | ||
2202 | (autoload 'ebnf-otz-initialize "ebnf-otz" | |
2203 | "Initialize optimizer.") | |
2204 | ||
2205 | \f | |
984ae001 GM |
2206 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2207 | ;; Customization | |
2208 | ||
2209 | ||
2210 | ;;;###autoload | |
2211 | (defun ebnf-customize () | |
2212 | "Customization for ebnf group." | |
2213 | (interactive) | |
2214 | (customize-group 'ebnf2ps)) | |
2215 | ||
2216 | \f | |
2217 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2218 | ;; User commands | |
2219 | ||
2220 | ||
ac4780a1 VJL |
2221 | ;;;###autoload |
2222 | (defun ebnf-print-directory (&optional directory) | |
2223 | "Generate and print a PostScript syntactic chart image of DIRECTORY. | |
2224 | ||
2225 | If DIRECTORY is nil, it's used `default-directory'. | |
2226 | ||
2227 | The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are | |
2228 | processed. | |
2229 | ||
2230 | See also `ebnf-print-buffer'." | |
2231 | (interactive | |
7e27ce9c AL |
2232 | (list (read-directory-name "Directory containing EBNF files (print): " |
2233 | nil default-directory))) | |
3ced5caa | 2234 | (ebnf-log-header "(ebnf-print-directory %S)" directory) |
ac4780a1 VJL |
2235 | (ebnf-directory 'ebnf-print-buffer directory)) |
2236 | ||
2237 | ||
2238 | ;;;###autoload | |
2239 | (defun ebnf-print-file (file &optional do-not-kill-buffer-when-done) | |
2240 | "Generate and print a PostScript syntactic chart image of the file FILE. | |
2241 | ||
2242 | If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't | |
2243 | killed after process termination. | |
2244 | ||
2245 | See also `ebnf-print-buffer'." | |
2246 | (interactive "fEBNF file to generate PostScript and print from: ") | |
3ced5caa | 2247 | (ebnf-log-header "(ebnf-print-file %S %S)" file do-not-kill-buffer-when-done) |
ac4780a1 VJL |
2248 | (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done)) |
2249 | ||
2250 | ||
984ae001 GM |
2251 | ;;;###autoload |
2252 | (defun ebnf-print-buffer (&optional filename) | |
ab3256ed | 2253 | "Generate and print a PostScript syntactic chart image of the buffer. |
984ae001 GM |
2254 | |
2255 | When called with a numeric prefix argument (C-u), prompts the user for | |
2256 | the name of a file to save the PostScript image in, instead of sending | |
2257 | it to the printer. | |
2258 | ||
2259 | More specifically, the FILENAME argument is treated as follows: if it | |
2260 | is nil, send the image to the printer. If FILENAME is a string, save | |
2261 | the PostScript image in a file with that name. If FILENAME is a | |
2262 | number, prompt the user for the name of the file to save in." | |
2263 | (interactive (list (ps-print-preprint current-prefix-arg))) | |
3ced5caa | 2264 | (ebnf-log-header "(ebnf-print-buffer %S)" filename) |
984ae001 GM |
2265 | (ebnf-print-region (point-min) (point-max) filename)) |
2266 | ||
2267 | ||
2268 | ;;;###autoload | |
2269 | (defun ebnf-print-region (from to &optional filename) | |
ab3256ed | 2270 | "Generate and print a PostScript syntactic chart image of the region. |
984ae001 GM |
2271 | Like `ebnf-print-buffer', but prints just the current region." |
2272 | (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) | |
3ced5caa | 2273 | (ebnf-log-header "(ebnf-print-region %S %S %S)" from to filename) |
984ae001 GM |
2274 | (run-hooks 'ebnf-hook) |
2275 | (or (ebnf-spool-region from to) | |
2276 | (ps-do-despool filename))) | |
2277 | ||
2278 | ||
ac4780a1 VJL |
2279 | ;;;###autoload |
2280 | (defun ebnf-spool-directory (&optional directory) | |
2281 | "Generate and spool a PostScript syntactic chart image of DIRECTORY. | |
2282 | ||
2283 | If DIRECTORY is nil, it's used `default-directory'. | |
2284 | ||
2285 | The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are | |
2286 | processed. | |
2287 | ||
2288 | See also `ebnf-spool-buffer'." | |
2289 | (interactive | |
7e27ce9c AL |
2290 | (list (read-directory-name "Directory containing EBNF files (spool): " |
2291 | nil default-directory))) | |
3ced5caa | 2292 | (ebnf-log-header "(ebnf-spool-directory %S)" directory) |
ac4780a1 VJL |
2293 | (ebnf-directory 'ebnf-spool-buffer directory)) |
2294 | ||
2295 | ||
2296 | ;;;###autoload | |
2297 | (defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done) | |
2298 | "Generate and spool a PostScript syntactic chart image of the file FILE. | |
2299 | ||
2300 | If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't | |
2301 | killed after process termination. | |
2302 | ||
2303 | See also `ebnf-spool-buffer'." | |
2304 | (interactive "fEBNF file to generate PostScript and spool from: ") | |
3ced5caa | 2305 | (ebnf-log-header "(ebnf-spool-file %S %S)" file do-not-kill-buffer-when-done) |
ac4780a1 VJL |
2306 | (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done)) |
2307 | ||
2308 | ||
984ae001 GM |
2309 | ;;;###autoload |
2310 | (defun ebnf-spool-buffer () | |
ab3256ed | 2311 | "Generate and spool a PostScript syntactic chart image of the buffer. |
984ae001 GM |
2312 | Like `ebnf-print-buffer' except that the PostScript image is saved in a |
2313 | local buffer to be sent to the printer later. | |
2314 | ||
2315 | Use the command `ebnf-despool' to send the spooled images to the printer." | |
2316 | (interactive) | |
3ced5caa | 2317 | (ebnf-log-header "(ebnf-spool-buffer)") |
984ae001 GM |
2318 | (ebnf-spool-region (point-min) (point-max))) |
2319 | ||
2320 | ||
2321 | ;;;###autoload | |
2322 | (defun ebnf-spool-region (from to) | |
ab3256ed | 2323 | "Generate a PostScript syntactic chart image of the region and spool locally. |
984ae001 GM |
2324 | Like `ebnf-spool-buffer', but spools just the current region. |
2325 | ||
2326 | Use the command `ebnf-despool' to send the spooled images to the printer." | |
2327 | (interactive "r") | |
3ced5caa | 2328 | (ebnf-log-header "(ebnf-spool-region %S)" from to) |
984ae001 GM |
2329 | (ebnf-generate-region from to 'ebnf-generate)) |
2330 | ||
2331 | ||
ac4780a1 VJL |
2332 | ;;;###autoload |
2333 | (defun ebnf-eps-directory (&optional directory) | |
2334 | "Generate EPS files from EBNF files in DIRECTORY. | |
2335 | ||
2336 | If DIRECTORY is nil, it's used `default-directory'. | |
2337 | ||
2338 | The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are | |
2339 | processed. | |
2340 | ||
2341 | See also `ebnf-eps-buffer'." | |
2342 | (interactive | |
7e27ce9c AL |
2343 | (list (read-directory-name "Directory containing EBNF files (EPS): " |
2344 | nil default-directory))) | |
3ced5caa | 2345 | (ebnf-log-header "(ebnf-eps-directory %S)" directory) |
ac4780a1 VJL |
2346 | (ebnf-directory 'ebnf-eps-buffer directory)) |
2347 | ||
2348 | ||
2349 | ;;;###autoload | |
2350 | (defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done) | |
2351 | "Generate an EPS file from EBNF file FILE. | |
2352 | ||
2353 | If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't | |
2354 | killed after EPS generation. | |
2355 | ||
2356 | See also `ebnf-eps-buffer'." | |
2357 | (interactive "fEBNF file to generate EPS file from: ") | |
3ced5caa | 2358 | (ebnf-log-header "(ebnf-eps-file %S %S)" file do-not-kill-buffer-when-done) |
ac4780a1 VJL |
2359 | (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done)) |
2360 | ||
2361 | ||
984ae001 GM |
2362 | ;;;###autoload |
2363 | (defun ebnf-eps-buffer () | |
4303661c | 2364 | "Generate a PostScript syntactic chart image of the buffer in an EPS file. |
984ae001 | 2365 | |
815cbda2 | 2366 | Generate an EPS file for each production in the buffer. |
984ae001 GM |
2367 | The EPS file name has the following form: |
2368 | ||
2369 | <PREFIX><PRODUCTION>.eps | |
2370 | ||
2371 | <PREFIX> is given by variable `ebnf-eps-prefix'. | |
2372 | The default value is \"ebnf--\". | |
2373 | ||
2374 | <PRODUCTION> is the production name. | |
815cbda2 EZ |
2375 | Some characters in the production file name are replaced to |
2376 | produce a valid file name. For example, the production name | |
2377 | \"A/B + C\" is modified to produce \"A_B_+_C\", and the EPS | |
2378 | file name used in this case will be \"ebnf--A_B_+_C.eps\". | |
984ae001 | 2379 | |
815cbda2 | 2380 | WARNING: This function does *NOT* ask any confirmation to override existing |
3ced5caa | 2381 | files." |
984ae001 | 2382 | (interactive) |
3ced5caa | 2383 | (ebnf-log-header "(ebnf-eps-buffer)") |
984ae001 GM |
2384 | (ebnf-eps-region (point-min) (point-max))) |
2385 | ||
2386 | ||
2387 | ;;;###autoload | |
2388 | (defun ebnf-eps-region (from to) | |
4303661c | 2389 | "Generate a PostScript syntactic chart image of the region in an EPS file. |
984ae001 | 2390 | |
815cbda2 | 2391 | Generate an EPS file for each production in the region. |
984ae001 GM |
2392 | The EPS file name has the following form: |
2393 | ||
2394 | <PREFIX><PRODUCTION>.eps | |
2395 | ||
2396 | <PREFIX> is given by variable `ebnf-eps-prefix'. | |
2397 | The default value is \"ebnf--\". | |
2398 | ||
2399 | <PRODUCTION> is the production name. | |
815cbda2 EZ |
2400 | Some characters in the production file name are replaced to |
2401 | produce a valid file name. For example, the production name | |
2402 | \"A/B + C\" is modified to produce \"A_B_+_C\", and the EPS | |
2403 | file name used in this case will be \"ebnf--A_B_+_C.eps\". | |
984ae001 | 2404 | |
815cbda2 | 2405 | WARNING: This function does *NOT* ask any confirmation to override existing |
3ced5caa | 2406 | files." |
984ae001 | 2407 | (interactive "r") |
3ced5caa | 2408 | (ebnf-log-header "(ebnf-eps-region %S %S)" from to) |
984ae001 GM |
2409 | (let ((ebnf-eps-executing t)) |
2410 | (ebnf-generate-region from to 'ebnf-generate-eps))) | |
2411 | ||
2412 | ||
2413 | ;;;###autoload | |
2414 | (defalias 'ebnf-despool 'ps-despool) | |
2415 | ||
2416 | ||
cd0f9f85 VJL |
2417 | ;;;###autoload |
2418 | (defun ebnf-syntax-directory (&optional directory) | |
815cbda2 | 2419 | "Do a syntactic analysis of the files in DIRECTORY. |
cd0f9f85 | 2420 | |
815cbda2 | 2421 | If DIRECTORY is nil, use `default-directory'. |
cd0f9f85 | 2422 | |
815cbda2 EZ |
2423 | Only the files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see) |
2424 | are processed. | |
cd0f9f85 VJL |
2425 | |
2426 | See also `ebnf-syntax-buffer'." | |
2427 | (interactive | |
7e27ce9c AL |
2428 | (list (read-directory-name "Directory containing EBNF files (syntax): " |
2429 | nil default-directory))) | |
3ced5caa | 2430 | (ebnf-log-header "(ebnf-syntax-directory %S)" directory) |
cd0f9f85 VJL |
2431 | (ebnf-directory 'ebnf-syntax-buffer directory)) |
2432 | ||
2433 | ||
2434 | ;;;###autoload | |
2435 | (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done) | |
815cbda2 | 2436 | "Do a syntactic analysis of the named FILE. |
cd0f9f85 VJL |
2437 | |
2438 | If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't | |
4e7d3274 | 2439 | killed after syntax checking. |
cd0f9f85 VJL |
2440 | |
2441 | See also `ebnf-syntax-buffer'." | |
2442 | (interactive "fEBNF file to check syntax: ") | |
3ced5caa | 2443 | (ebnf-log-header "(ebnf-syntax-file %S %S)" file do-not-kill-buffer-when-done) |
cd0f9f85 VJL |
2444 | (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done)) |
2445 | ||
2446 | ||
984ae001 GM |
2447 | ;;;###autoload |
2448 | (defun ebnf-syntax-buffer () | |
815cbda2 | 2449 | "Do a syntactic analysis of the current buffer." |
984ae001 | 2450 | (interactive) |
3ced5caa | 2451 | (ebnf-log-header "(ebnf-syntax-buffer)") |
984ae001 GM |
2452 | (ebnf-syntax-region (point-min) (point-max))) |
2453 | ||
2454 | ||
2455 | ;;;###autoload | |
2456 | (defun ebnf-syntax-region (from to) | |
3ced5caa | 2457 | "Do a syntactic analysis of a region." |
984ae001 | 2458 | (interactive "r") |
3ced5caa | 2459 | (ebnf-log-header "(ebnf-syntax-region %S %S)" from to) |
984ae001 GM |
2460 | (ebnf-generate-region from to nil)) |
2461 | ||
2462 | \f | |
2463 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2464 | ;; Utilities | |
2465 | ||
2466 | ||
2467 | ;;;###autoload | |
2468 | (defun ebnf-setup () | |
2469 | "Return the current ebnf2ps setup." | |
2470 | (format | |
2471 | " | |
6a5275dc GM |
2472 | ;;; ebnf2ps.el version %s |
2473 | ||
3ced5caa VJL |
2474 | ;;; Emacs version %S |
2475 | ||
ac4780a1 VJL |
2476 | \(setq ebnf-special-show-delimiter %S |
2477 | ebnf-special-font %s | |
984ae001 GM |
2478 | ebnf-special-shape %s |
2479 | ebnf-special-shadow %S | |
2480 | ebnf-special-border-width %S | |
2481 | ebnf-special-border-color %S | |
2482 | ebnf-except-font %s | |
2483 | ebnf-except-shape %s | |
2484 | ebnf-except-shadow %S | |
2485 | ebnf-except-border-width %S | |
2486 | ebnf-except-border-color %S | |
2487 | ebnf-repeat-font %s | |
2488 | ebnf-repeat-shape %s | |
2489 | ebnf-repeat-shadow %S | |
2490 | ebnf-repeat-border-width %S | |
2491 | ebnf-repeat-border-color %S | |
2492 | ebnf-terminal-regexp %S | |
2493 | ebnf-case-fold-search %S | |
2494 | ebnf-terminal-font %s | |
2495 | ebnf-terminal-shape %s | |
2496 | ebnf-terminal-shadow %S | |
2497 | ebnf-terminal-border-width %S | |
2498 | ebnf-terminal-border-color %S | |
2499 | ebnf-non-terminal-font %s | |
2500 | ebnf-non-terminal-shape %s | |
2501 | ebnf-non-terminal-shadow %S | |
2502 | ebnf-non-terminal-border-width %S | |
2503 | ebnf-non-terminal-border-color %S | |
ac4780a1 | 2504 | ebnf-production-name-p %S |
984ae001 GM |
2505 | ebnf-sort-production %s |
2506 | ebnf-production-font %s | |
2507 | ebnf-arrow-shape %s | |
2508 | ebnf-chart-shape %s | |
2509 | ebnf-user-arrow %s | |
2510 | ebnf-horizontal-orientation %S | |
2511 | ebnf-horizontal-max-height %S | |
2512 | ebnf-production-horizontal-space %S | |
2513 | ebnf-production-vertical-space %S | |
2514 | ebnf-justify-sequence %s | |
2515 | ebnf-lex-comment-char ?\\%03o | |
2516 | ebnf-lex-eop-char ?\\%03o | |
2517 | ebnf-syntax %s | |
2518 | ebnf-iso-alternative-p %S | |
2519 | ebnf-iso-normalize-p %S | |
ac4780a1 | 2520 | ebnf-file-suffix-regexp %S |
984ae001 | 2521 | ebnf-eps-prefix %S |
3ced5caa VJL |
2522 | ebnf-eps-header-font %s |
2523 | ebnf-eps-header %s | |
2524 | ebnf-eps-footer-font %s | |
2525 | ebnf-eps-footer %s | |
984ae001 GM |
2526 | ebnf-entry-percentage %S |
2527 | ebnf-color-p %S | |
2528 | ebnf-line-width %S | |
2529 | ebnf-line-color %S | |
3ced5caa VJL |
2530 | ebnf-arrow-extra-width %S |
2531 | ebnf-arrow-scale %S | |
984ae001 GM |
2532 | ebnf-debug-ps %S |
2533 | ebnf-use-float-format %S | |
ac4780a1 | 2534 | ebnf-stop-on-error %S |
984ae001 GM |
2535 | ebnf-yac-ignore-error-recovery %S |
2536 | ebnf-ignore-empty-rule %S | |
3ced5caa VJL |
2537 | ebnf-optimize %S |
2538 | ebnf-log %S) | |
6a5275dc GM |
2539 | |
2540 | ;;; ebnf2ps.el - end of settings | |
984ae001 | 2541 | " |
6a5275dc | 2542 | ebnf-version |
3ced5caa | 2543 | emacs-version |
ac4780a1 | 2544 | ebnf-special-show-delimiter |
984ae001 GM |
2545 | (ps-print-quote ebnf-special-font) |
2546 | (ps-print-quote ebnf-special-shape) | |
2547 | ebnf-special-shadow | |
2548 | ebnf-special-border-width | |
2549 | ebnf-special-border-color | |
2550 | (ps-print-quote ebnf-except-font) | |
2551 | (ps-print-quote ebnf-except-shape) | |
2552 | ebnf-except-shadow | |
2553 | ebnf-except-border-width | |
2554 | ebnf-except-border-color | |
2555 | (ps-print-quote ebnf-repeat-font) | |
2556 | (ps-print-quote ebnf-repeat-shape) | |
2557 | ebnf-repeat-shadow | |
2558 | ebnf-repeat-border-width | |
2559 | ebnf-repeat-border-color | |
2560 | ebnf-terminal-regexp | |
2561 | ebnf-case-fold-search | |
2562 | (ps-print-quote ebnf-terminal-font) | |
2563 | (ps-print-quote ebnf-terminal-shape) | |
2564 | ebnf-terminal-shadow | |
2565 | ebnf-terminal-border-width | |
2566 | ebnf-terminal-border-color | |
2567 | (ps-print-quote ebnf-non-terminal-font) | |
2568 | (ps-print-quote ebnf-non-terminal-shape) | |
2569 | ebnf-non-terminal-shadow | |
2570 | ebnf-non-terminal-border-width | |
2571 | ebnf-non-terminal-border-color | |
ac4780a1 | 2572 | ebnf-production-name-p |
984ae001 GM |
2573 | (ps-print-quote ebnf-sort-production) |
2574 | (ps-print-quote ebnf-production-font) | |
2575 | (ps-print-quote ebnf-arrow-shape) | |
2576 | (ps-print-quote ebnf-chart-shape) | |
2577 | (ps-print-quote ebnf-user-arrow) | |
2578 | ebnf-horizontal-orientation | |
2579 | ebnf-horizontal-max-height | |
2580 | ebnf-production-horizontal-space | |
2581 | ebnf-production-vertical-space | |
2582 | (ps-print-quote ebnf-justify-sequence) | |
2583 | ebnf-lex-comment-char | |
2584 | ebnf-lex-eop-char | |
2585 | (ps-print-quote ebnf-syntax) | |
2586 | ebnf-iso-alternative-p | |
2587 | ebnf-iso-normalize-p | |
ac4780a1 | 2588 | ebnf-file-suffix-regexp |
984ae001 | 2589 | ebnf-eps-prefix |
3ced5caa VJL |
2590 | (ps-print-quote ebnf-eps-header-font) |
2591 | (ps-print-quote ebnf-eps-header) | |
2592 | (ps-print-quote ebnf-eps-footer-font) | |
2593 | (ps-print-quote ebnf-eps-footer) | |
984ae001 GM |
2594 | ebnf-entry-percentage |
2595 | ebnf-color-p | |
2596 | ebnf-line-width | |
2597 | ebnf-line-color | |
3ced5caa VJL |
2598 | ebnf-arrow-extra-width |
2599 | ebnf-arrow-scale | |
984ae001 GM |
2600 | ebnf-debug-ps |
2601 | ebnf-use-float-format | |
ac4780a1 | 2602 | ebnf-stop-on-error |
984ae001 GM |
2603 | ebnf-yac-ignore-error-recovery |
2604 | ebnf-ignore-empty-rule | |
3ced5caa VJL |
2605 | ebnf-optimize |
2606 | ebnf-log)) | |
984ae001 GM |
2607 | |
2608 | \f | |
2609 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2610 | ;; Style variables | |
2611 | ||
2612 | ||
2613 | (defvar ebnf-stack-style nil | |
2614 | "Used in functions `ebnf-reset-style', `ebnf-push-style' and | |
2615 | `ebnf-pop-style'.") | |
2616 | ||
2617 | ||
2618 | (defvar ebnf-current-style 'default | |
2619 | "Used in functions `ebnf-apply-style' and `ebnf-push-style'.") | |
2620 | ||
2621 | ||
2622 | (defconst ebnf-style-custom-list | |
ac4780a1 VJL |
2623 | '(ebnf-special-show-delimiter |
2624 | ebnf-special-font | |
984ae001 GM |
2625 | ebnf-special-shape |
2626 | ebnf-special-shadow | |
2627 | ebnf-special-border-width | |
2628 | ebnf-special-border-color | |
2629 | ebnf-except-font | |
2630 | ebnf-except-shape | |
2631 | ebnf-except-shadow | |
2632 | ebnf-except-border-width | |
2633 | ebnf-except-border-color | |
2634 | ebnf-repeat-font | |
2635 | ebnf-repeat-shape | |
2636 | ebnf-repeat-shadow | |
2637 | ebnf-repeat-border-width | |
2638 | ebnf-repeat-border-color | |
2639 | ebnf-terminal-regexp | |
2640 | ebnf-case-fold-search | |
2641 | ebnf-terminal-font | |
2642 | ebnf-terminal-shape | |
2643 | ebnf-terminal-shadow | |
2644 | ebnf-terminal-border-width | |
2645 | ebnf-terminal-border-color | |
2646 | ebnf-non-terminal-font | |
2647 | ebnf-non-terminal-shape | |
2648 | ebnf-non-terminal-shadow | |
2649 | ebnf-non-terminal-border-width | |
2650 | ebnf-non-terminal-border-color | |
ac4780a1 | 2651 | ebnf-production-name-p |
984ae001 GM |
2652 | ebnf-sort-production |
2653 | ebnf-production-font | |
2654 | ebnf-arrow-shape | |
2655 | ebnf-chart-shape | |
2656 | ebnf-user-arrow | |
2657 | ebnf-horizontal-orientation | |
2658 | ebnf-horizontal-max-height | |
2659 | ebnf-production-horizontal-space | |
2660 | ebnf-production-vertical-space | |
2661 | ebnf-justify-sequence | |
2662 | ebnf-lex-comment-char | |
2663 | ebnf-lex-eop-char | |
2664 | ebnf-syntax | |
2665 | ebnf-iso-alternative-p | |
2666 | ebnf-iso-normalize-p | |
ac4780a1 | 2667 | ebnf-file-suffix-regexp |
984ae001 | 2668 | ebnf-eps-prefix |
3ced5caa VJL |
2669 | ebnf-eps-header-font |
2670 | ebnf-eps-header | |
2671 | ebnf-eps-footer-font | |
2672 | ebnf-eps-footer | |
984ae001 GM |
2673 | ebnf-entry-percentage |
2674 | ebnf-color-p | |
2675 | ebnf-line-width | |
2676 | ebnf-line-color | |
2677 | ebnf-debug-ps | |
2678 | ebnf-use-float-format | |
ac4780a1 | 2679 | ebnf-stop-on-error |
984ae001 GM |
2680 | ebnf-yac-ignore-error-recovery |
2681 | ebnf-ignore-empty-rule | |
2682 | ebnf-optimize) | |
2683 | "List of valid symbol custom variable.") | |
2684 | ||
2685 | ||
2686 | (defvar ebnf-style-database | |
2687 | '(;; EBNF default | |
2688 | (default | |
2689 | nil | |
ac4780a1 | 2690 | (ebnf-special-show-delimiter . t) |
984ae001 GM |
2691 | (ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic)) |
2692 | (ebnf-special-shape . 'bevel) | |
2693 | (ebnf-special-shadow . nil) | |
2694 | (ebnf-special-border-width . 0.5) | |
2695 | (ebnf-special-border-color . "Black") | |
2696 | (ebnf-except-font . '(7 Courier "Black" "Gray90" bold italic)) | |
2697 | (ebnf-except-shape . 'bevel) | |
2698 | (ebnf-except-shadow . nil) | |
2699 | (ebnf-except-border-width . 0.25) | |
2700 | (ebnf-except-border-color . "Black") | |
2701 | (ebnf-repeat-font . '(7 Courier "Black" "Gray85" bold italic)) | |
2702 | (ebnf-repeat-shape . 'bevel) | |
2703 | (ebnf-repeat-shadow . nil) | |
2704 | (ebnf-repeat-border-width . 0.0) | |
2705 | (ebnf-repeat-border-color . "Black") | |
2706 | (ebnf-terminal-regexp . nil) | |
2707 | (ebnf-case-fold-search . nil) | |
2708 | (ebnf-terminal-font . '(7 Courier "Black" "White")) | |
2709 | (ebnf-terminal-shape . 'miter) | |
2710 | (ebnf-terminal-shadow . nil) | |
2711 | (ebnf-terminal-border-width . 1.0) | |
2712 | (ebnf-terminal-border-color . "Black") | |
2713 | (ebnf-non-terminal-font . '(7 Helvetica "Black" "White")) | |
2714 | (ebnf-non-terminal-shape . 'round) | |
2715 | (ebnf-non-terminal-shadow . nil) | |
2716 | (ebnf-non-terminal-border-width . 1.0) | |
2717 | (ebnf-non-terminal-border-color . "Black") | |
ac4780a1 | 2718 | (ebnf-production-name-p . t) |
984ae001 GM |
2719 | (ebnf-sort-production . nil) |
2720 | (ebnf-production-font . '(10 Helvetica "Black" "White" bold)) | |
2721 | (ebnf-arrow-shape . 'hollow) | |
2722 | (ebnf-chart-shape . 'round) | |
2723 | (ebnf-user-arrow . nil) | |
2724 | (ebnf-horizontal-orientation . nil) | |
2725 | (ebnf-horizontal-max-height . nil) | |
2726 | (ebnf-production-horizontal-space . 0.0) | |
2727 | (ebnf-production-vertical-space . 0.0) | |
2728 | (ebnf-justify-sequence . 'center) | |
2729 | (ebnf-lex-comment-char . ?\;) | |
2730 | (ebnf-lex-eop-char . ?.) | |
2731 | (ebnf-syntax . 'ebnf) | |
2732 | (ebnf-iso-alternative-p . nil) | |
2733 | (ebnf-iso-normalize-p . nil) | |
ac4780a1 | 2734 | (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$") |
984ae001 | 2735 | (ebnf-eps-prefix . "ebnf--") |
3ced5caa VJL |
2736 | (ebnf-eps-header-font . '(11 Helvetica "Black" "White" bold)) |
2737 | (ebnf-eps-header . nil) | |
2738 | (ebnf-eps-footer-font . '(7 Helvetica "Black" "White" bold)) | |
2739 | (ebnf-eps-footer . nil) | |
984ae001 GM |
2740 | (ebnf-entry-percentage . 0.5) |
2741 | (ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs | |
2742 | (fboundp 'color-instance-rgb-components))) ; XEmacs | |
2743 | (ebnf-line-width . 1.0) | |
2744 | (ebnf-line-color . "Black") | |
2745 | (ebnf-debug-ps . nil) | |
2746 | (ebnf-use-float-format . t) | |
ac4780a1 | 2747 | (ebnf-stop-on-error . nil) |
984ae001 GM |
2748 | (ebnf-yac-ignore-error-recovery . nil) |
2749 | (ebnf-ignore-empty-rule . nil) | |
2750 | (ebnf-optimize . nil)) | |
2751 | ;; Happy EBNF default | |
2752 | (happy | |
2753 | default | |
2754 | (ebnf-justify-sequence . 'left) | |
2755 | (ebnf-lex-comment-char . ?\#) | |
2756 | (ebnf-lex-eop-char . ?\;)) | |
ac4780a1 VJL |
2757 | ;; ABNF default |
2758 | (abnf | |
2759 | default | |
2760 | (ebnf-syntax . 'abnf)) | |
984ae001 GM |
2761 | ;; ISO EBNF default |
2762 | (iso-ebnf | |
2763 | default | |
2764 | (ebnf-syntax . 'iso-ebnf)) | |
2765 | ;; Yacc/Bison default | |
2766 | (yacc | |
2767 | default | |
2768 | (ebnf-syntax . 'yacc)) | |
6ca94f87 VJL |
2769 | ;; ebnfx default |
2770 | (ebnfx | |
2771 | default | |
2772 | (ebnf-syntax . 'ebnfx)) | |
6411a60a VJL |
2773 | ;; dtd default |
2774 | (dtd | |
2775 | default | |
2776 | (ebnf-syntax . 'dtd)) | |
984ae001 GM |
2777 | ) |
2778 | "Style database. | |
2779 | ||
2780 | Each element has the following form: | |
2781 | ||
ac4780a1 | 2782 | (NAME INHERITS (VAR . VALUE)...) |
984ae001 | 2783 | |
ac4780a1 | 2784 | Where: |
984ae001 | 2785 | |
ac4780a1 VJL |
2786 | NAME is a symbol name style. |
2787 | ||
2788 | INHERITS is a symbol name style from which the current style inherits | |
815cbda2 | 2789 | the context. If INHERITS is nil, then there is no inheritance. |
ac4780a1 | 2790 | |
815cbda2 EZ |
2791 | This is a simple inheritance of style: if you declare that |
2792 | style A inherits from style B, all settings of B are applied | |
2793 | first, and then the settings of A are applied. This is useful | |
ac4780a1 | 2794 | when you wish to modify some aspects of an existing style, but |
815cbda2 | 2795 | at the same time wish to keep it unmodified. |
ac4780a1 VJL |
2796 | |
2797 | VAR is a valid ebnf2ps symbol custom variable. | |
815cbda2 | 2798 | See `ebnf-style-custom-list' for valid symbol variables. |
ac4780a1 | 2799 | |
815cbda2 EZ |
2800 | VALUE is a sexp which will be evaluated to set the value of VAR. |
2801 | Don't forget to quote symbols and constant lists. | |
ac4780a1 VJL |
2802 | See `default' style for an example. |
2803 | ||
815cbda2 | 2804 | Don't use this variable directly. Use functions `ebnf-insert-style', |
ac4780a1 | 2805 | `ebnf-delete-style' and `ebnf-merge-style'.") |
984ae001 GM |
2806 | |
2807 | \f | |
2808 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2809 | ;; Style commands | |
2810 | ||
2811 | ||
3ced5caa VJL |
2812 | ;;;###autoload |
2813 | (defun ebnf-find-style (name) | |
2814 | "Return style definition if NAME is already defined; otherwise, return nil. | |
2815 | ||
2816 | See `ebnf-style-database' documentation." | |
2817 | (interactive "SStyle name: ") | |
2818 | (assoc name ebnf-style-database)) | |
2819 | ||
2820 | ||
984ae001 GM |
2821 | ;;;###autoload |
2822 | (defun ebnf-insert-style (name inherits &rest values) | |
ac4780a1 VJL |
2823 | "Insert a new style NAME with inheritance INHERITS and values VALUES. |
2824 | ||
2825 | See `ebnf-style-database' documentation." | |
2826 | (interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ") | |
984ae001 GM |
2827 | (and (assoc name ebnf-style-database) |
2828 | (error "Style name already exists: %s" name)) | |
2829 | (or (assoc inherits ebnf-style-database) | |
0e816a43 | 2830 | (error "Style inheritance name doesn't exist: %s" inherits)) |
984ae001 GM |
2831 | (setq ebnf-style-database |
2832 | (cons (cons name (cons inherits (ebnf-check-style-values values))) | |
2833 | ebnf-style-database))) | |
2834 | ||
2835 | ||
ac4780a1 VJL |
2836 | ;;;###autoload |
2837 | (defun ebnf-delete-style (name) | |
2838 | "Delete style NAME. | |
2839 | ||
2840 | See `ebnf-style-database' documentation." | |
2841 | (interactive "SDelete style name: ") | |
2842 | (or (assoc name ebnf-style-database) | |
2843 | (error "Style name doesn't exist: %s" name)) | |
2844 | (let ((db ebnf-style-database)) | |
2845 | (while db | |
2846 | (and (eq (nth 1 (car db)) name) | |
2847 | (error "Style name `%s' is inherited by `%s' style" | |
2848 | name (nth 0 (car db)))) | |
2849 | (setq db (cdr db)))) | |
2850 | (setq ebnf-style-database (assq-delete-all name ebnf-style-database))) | |
2851 | ||
2852 | ||
984ae001 GM |
2853 | ;;;###autoload |
2854 | (defun ebnf-merge-style (name &rest values) | |
ac4780a1 VJL |
2855 | "Merge values of style NAME with style VALUES. |
2856 | ||
2857 | See `ebnf-style-database' documentation." | |
2858 | (interactive "SStyle name: \nXStyle values: ") | |
984ae001 | 2859 | (let ((style (or (assoc name ebnf-style-database) |
0e816a43 | 2860 | (error "Style name doesn't exist: %s" name))) |
984ae001 GM |
2861 | (merge (ebnf-check-style-values values)) |
2862 | val elt new check) | |
2863 | ;; modify value of existing variables | |
2864 | (setq val (nthcdr 2 style)) | |
2865 | (while merge | |
2866 | (setq check (car merge) | |
2867 | merge (cdr merge) | |
2868 | elt (assoc (car check) val)) | |
2869 | (if elt | |
2870 | (setcdr elt (cdr check)) | |
2871 | (setq new (cons check new)))) | |
2872 | ;; insert new variables | |
2873 | (nconc style (nreverse new)))) | |
2874 | ||
2875 | ||
2876 | ;;;###autoload | |
2877 | (defun ebnf-apply-style (style) | |
ac4780a1 | 2878 | "Set STYLE as the current style. |
984ae001 | 2879 | |
815cbda2 | 2880 | Returns the old style symbol. |
ac4780a1 VJL |
2881 | |
2882 | See `ebnf-style-database' documentation." | |
2883 | (interactive "SApply style: ") | |
984ae001 GM |
2884 | (prog1 |
2885 | ebnf-current-style | |
2886 | (and (ebnf-apply-style1 style) | |
2887 | (setq ebnf-current-style style)))) | |
2888 | ||
2889 | ||
2890 | ;;;###autoload | |
2891 | (defun ebnf-reset-style (&optional style) | |
2892 | "Reset current style. | |
2893 | ||
815cbda2 | 2894 | Returns the old style symbol. |
ac4780a1 VJL |
2895 | |
2896 | See `ebnf-style-database' documentation." | |
2897 | (interactive "SReset style: ") | |
984ae001 GM |
2898 | (setq ebnf-stack-style nil) |
2899 | (ebnf-apply-style (or style 'default))) | |
2900 | ||
2901 | ||
2902 | ;;;###autoload | |
2903 | (defun ebnf-push-style (&optional style) | |
815cbda2 EZ |
2904 | "Push the current style onto a stack and set STYLE as the current style. |
2905 | ||
2906 | Returns the old style symbol. | |
984ae001 | 2907 | |
815cbda2 | 2908 | See also `ebnf-pop-style'. |
ac4780a1 VJL |
2909 | |
2910 | See `ebnf-style-database' documentation." | |
2911 | (interactive "SPush style: ") | |
984ae001 GM |
2912 | (prog1 |
2913 | ebnf-current-style | |
2914 | (setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style)) | |
2915 | (and style | |
2916 | (ebnf-apply-style style)))) | |
2917 | ||
2918 | ||
2919 | ;;;###autoload | |
2920 | (defun ebnf-pop-style () | |
815cbda2 | 2921 | "Pop a style from the stack of pushed styles and set it as the current style. |
ac4780a1 | 2922 | |
815cbda2 EZ |
2923 | Returns the old style symbol. |
2924 | ||
2925 | See also `ebnf-push-style'. | |
984ae001 | 2926 | |
ac4780a1 | 2927 | See `ebnf-style-database' documentation." |
984ae001 GM |
2928 | (interactive) |
2929 | (prog1 | |
2930 | (ebnf-apply-style (car ebnf-stack-style)) | |
2931 | (setq ebnf-stack-style (cdr ebnf-stack-style)))) | |
2932 | ||
2933 | ||
2934 | (defun ebnf-apply-style1 (style) | |
2935 | (let ((value (cdr (assoc style ebnf-style-database)))) | |
2936 | (prog1 | |
2937 | value | |
2938 | (and (car value) (ebnf-apply-style1 (car value))) | |
2939 | (while (setq value (cdr value)) | |
2940 | (set (caar value) (eval (cdar value))))))) | |
2941 | ||
2942 | ||
2943 | (defun ebnf-check-style-values (values) | |
2944 | (let (style) | |
2945 | (while values | |
ac4780a1 | 2946 | (and (memq (caar values) ebnf-style-custom-list) |
984ae001 GM |
2947 | (setq style (cons (car values) style))) |
2948 | (setq values (cdr values))) | |
2949 | (nreverse style))) | |
2950 | ||
2951 | \f | |
2952 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
2953 | ;; Internal variables | |
2954 | ||
2955 | ||
3ced5caa VJL |
2956 | (defvar ebnf-eps-buffer-name " *EPS*") |
2957 | (defvar ebnf-parser-func nil) | |
2958 | (defvar ebnf-eps-executing nil) | |
2959 | (defvar ebnf-eps-header-comment nil) | |
2960 | (defvar ebnf-eps-footer-comment nil) | |
2961 | (defvar ebnf-eps-upper-x 0.0) | |
984ae001 | 2962 | (make-variable-buffer-local 'ebnf-eps-upper-x) |
3ced5caa | 2963 | (defvar ebnf-eps-upper-y 0.0) |
984ae001 | 2964 | (make-variable-buffer-local 'ebnf-eps-upper-y) |
3ced5caa | 2965 | (defvar ebnf-eps-prod-width 0.0) |
984ae001 | 2966 | (make-variable-buffer-local 'ebnf-eps-prod-width) |
3ced5caa | 2967 | (defvar ebnf-eps-max-height 0.0) |
984ae001 | 2968 | (make-variable-buffer-local 'ebnf-eps-max-height) |
3ced5caa | 2969 | (defvar ebnf-eps-max-width 0.0) |
984ae001 GM |
2970 | (make-variable-buffer-local 'ebnf-eps-max-width) |
2971 | ||
2972 | ||
2973 | (defvar ebnf-eps-context nil | |
2974 | "List of EPS file name during parsing. | |
2975 | ||
2976 | See section \"Actions in Comments\" in ebnf2ps documentation.") | |
2977 | ||
2978 | ||
3ced5caa VJL |
2979 | (defvar ebnf-eps-file-alist nil |
2980 | "Alist associating file name with EPS header and footer. | |
2981 | ||
2982 | Each element has the following form: | |
2983 | ||
2984 | (EPS-FILENAME HEADER FOOTER) | |
2985 | ||
2986 | EPS-FILENAME is the EPS file name. | |
2987 | HEADER is the header string or nil. | |
2988 | FOOTER is the footer string or nil. | |
2989 | ||
2990 | It's generated during parsing and used during EPS generation. | |
2991 | ||
2992 | See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps | |
2993 | documentation.") | |
2994 | ||
2995 | ||
984ae001 GM |
2996 | (defvar ebnf-eps-production-list nil |
2997 | "Alist associating production name with EPS file name list. | |
2998 | ||
2999 | Each element has the following form: | |
3000 | ||
3001 | (PRODUCTION EPS-FILENAME...) | |
3002 | ||
3003 | PRODUCTION is the production name. | |
3004 | EPS-FILENAME is the EPS file name. | |
3005 | ||
815cbda2 | 3006 | This is generated during parsing and used during EPS generation. |
984ae001 GM |
3007 | |
3008 | See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps | |
3009 | documentation.") | |
3010 | ||
3011 | ||
3012 | (defconst ebnf-arrow-shape-alist | |
ac4780a1 VJL |
3013 | '((none . 0) |
3014 | (semi-up . 1) | |
3015 | (semi-down . 2) | |
3016 | (simple . 3) | |
3017 | (transparent . 4) | |
3018 | (hollow . 5) | |
3019 | (full . 6) | |
3020 | (semi-up-hollow . 7) | |
3021 | (semi-up-full . 8) | |
3022 | (semi-down-hollow . 9) | |
3023 | (semi-down-full . 10) | |
3024 | (user . 11)) | |
984ae001 GM |
3025 | "Alist associating values for `ebnf-arrow-shape'. |
3026 | ||
3027 | See documentation for `ebnf-arrow-shape'.") | |
3028 | ||
3029 | ||
3030 | (defconst ebnf-terminal-shape-alist | |
3031 | '((miter . 0) | |
3032 | (round . 1) | |
3033 | (bevel . 2)) | |
3034 | "Alist associating values from `ebnf-terminal-shape' to a bit vector. | |
3035 | ||
3036 | See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and | |
3037 | `ebnf-chart-shape'.") | |
3038 | ||
3039 | ||
3ced5caa VJL |
3040 | (defvar ebnf-limit nil) |
3041 | (defvar ebnf-action nil) | |
3042 | (defvar ebnf-action-list nil) | |
984ae001 GM |
3043 | |
3044 | ||
3ced5caa | 3045 | (defvar ebnf-default-p nil) |
984ae001 GM |
3046 | |
3047 | ||
3ced5caa VJL |
3048 | (defvar ebnf-font-height-P 0) |
3049 | (defvar ebnf-font-height-T 0) | |
3050 | (defvar ebnf-font-height-NT 0) | |
3051 | (defvar ebnf-font-height-S 0) | |
3052 | (defvar ebnf-font-height-E 0) | |
3053 | (defvar ebnf-font-height-R 0) | |
3054 | (defvar ebnf-font-width-P 0) | |
3055 | (defvar ebnf-font-width-T 0) | |
3056 | (defvar ebnf-font-width-NT 0) | |
3057 | (defvar ebnf-font-width-S 0) | |
3058 | (defvar ebnf-font-width-E 0) | |
3059 | (defvar ebnf-font-width-R 0) | |
3060 | (defvar ebnf-space-T 0) | |
3061 | (defvar ebnf-space-NT 0) | |
3062 | (defvar ebnf-space-S 0) | |
3063 | (defvar ebnf-space-E 0) | |
3064 | (defvar ebnf-space-R 0) | |
984ae001 GM |
3065 | |
3066 | ||
3ced5caa VJL |
3067 | (defvar ebnf-basic-width-extra 0) |
3068 | (defvar ebnf-basic-width 0) | |
3069 | (defvar ebnf-basic-height 0) | |
3070 | (defvar ebnf-basic-empty-height 0) | |
3071 | (defvar ebnf-vertical-space 0) | |
3072 | (defvar ebnf-horizontal-space 0) | |
984ae001 GM |
3073 | |
3074 | ||
3ced5caa VJL |
3075 | (defvar ebnf-settings nil) |
3076 | (defvar ebnf-fonts-required nil) | |
984ae001 GM |
3077 | |
3078 | ||
3079 | (defconst ebnf-debug | |
3080 | " | |
3081 | % === begin EBNF procedures to help debugging | |
3082 | ||
3083 | % Mark visually current point: string debug | |
3084 | /debug | |
3085 | {/-s- exch def | |
3086 | currentpoint | |
3087 | gsave -s- show grestore | |
3088 | gsave | |
3089 | 20 20 rlineto | |
3090 | 0 -40 rlineto | |
3091 | -40 40 rlineto | |
3092 | 0 -40 rlineto | |
3093 | 20 20 rlineto | |
3094 | stroke | |
3095 | grestore | |
3096 | moveto | |
3097 | }def | |
3098 | ||
3099 | % Show number value: number string debug-number | |
3100 | /debug-number | |
3101 | {gsave | |
3102 | 20 0 rmoveto show ([) show 60 string cvs show (]) show | |
3103 | grestore | |
3104 | }def | |
3105 | ||
3106 | % === end EBNF procedures to help debugging | |
3107 | ||
3108 | " | |
3109 | "This is intended to help debugging PostScript programming.") | |
3110 | ||
3111 | ||
3112 | (defconst ebnf-prologue | |
3113 | " | |
3114 | % === begin EBNF engine | |
3115 | ||
3116 | % --- Basic Definitions | |
3117 | ||
3118 | /fS F | |
3119 | /SpaceS FontHeight 0.5 mul def | |
3120 | /HeightS FontHeight FontHeight add def | |
3121 | ||
3122 | /fE F | |
3123 | /SpaceE FontHeight 0.5 mul def | |
3124 | /HeightE FontHeight FontHeight add def | |
3125 | ||
3126 | /fR F | |
3127 | /SpaceR FontHeight 0.5 mul def | |
3128 | /HeightR FontHeight FontHeight add def | |
3129 | ||
3130 | /fT F | |
3131 | /SpaceT FontHeight 0.5 mul def | |
3132 | /HeightT FontHeight FontHeight add def | |
3133 | ||
3134 | /fNT F | |
3135 | /SpaceNT FontHeight 0.5 mul def | |
3136 | /HeightNT FontHeight FontHeight add def | |
3137 | ||
3138 | /T HeightT HeightNT add 0.5 mul def | |
ed0aa46c VJL |
3139 | /hT T 0.5 mul def |
3140 | /hT2 hT 0.5 mul ArrowScale mul def | |
3141 | /hT4 hT 0.25 mul ArrowScale mul def | |
984ae001 GM |
3142 | |
3143 | /Er 0.1 def % Error factor | |
3144 | ||
3145 | ||
3146 | /c{currentpoint}bind def | |
3147 | /xyi{/xi c /yi exch def def}bind def | |
3148 | /xyo{/xo c /yo exch def def}bind def | |
3149 | /xyp{/xp c /yp exch def def}bind def | |
3150 | /xyt{/xt c /yt exch def def}bind def | |
3151 | ||
3152 | % vertical movement: x y height vm | |
3153 | /vm{add moveto}bind def | |
3154 | ||
3155 | % horizontal movement: x y width hm | |
3156 | /hm{3 -1 roll exch add exch moveto}bind def | |
3157 | ||
3158 | % set color: [R G B] SetRGB | |
3159 | /SetRGB{aload pop setrgbcolor}bind def | |
3160 | ||
3161 | % filling gray area: gray-scale FillGray | |
3162 | /FillGray{gsave setgray fill grestore}bind def | |
3163 | ||
3164 | % filling color area: [R G B] FillRGB | |
3165 | /FillRGB{gsave SetRGB fill grestore}bind def | |
3166 | ||
3167 | /Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def | |
3168 | /StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def | |
3169 | /Gstroke{gsave Stroke grestore}bind def | |
3170 | ||
3171 | % Empty Line: width EL | |
3172 | /EL{0 rlineto Gstroke}bind def | |
3173 | ||
3174 | % --- Arrows | |
3175 | ||
3176 | /Down{hT2 neg hT4 neg rlineto}bind def | |
3177 | ||
3178 | /Arrow | |
3179 | {hT2 neg hT4 rmoveto | |
3180 | hT2 hT4 neg rlineto | |
3181 | Down | |
3182 | }bind def | |
3183 | ||
3184 | /ArrowPath{c newpath moveto Arrow closepath}bind def | |
3185 | ||
ac4780a1 VJL |
3186 | /UpPath |
3187 | {c newpath moveto | |
3188 | hT2 neg 0 rmoveto | |
3189 | 0 hT4 rlineto | |
3190 | hT2 hT4 neg rlineto | |
3191 | closepath | |
3192 | }bind def | |
3193 | ||
3194 | /DownPath | |
3195 | {c newpath moveto | |
3196 | hT2 neg 0 rmoveto | |
3197 | 0 hT4 neg rlineto | |
3198 | hT2 hT4 rlineto | |
3199 | closepath | |
3200 | }bind def | |
3201 | ||
984ae001 GM |
3202 | %>Right Arrow: RA |
3203 | % \\ | |
3204 | % *---+ | |
3205 | % / | |
3206 | /RA-vector | |
ac4780a1 VJL |
3207 | [{} % 0 - none |
3208 | {hT2 neg hT4 rlineto} % 1 - semi-up | |
3209 | {Down} % 2 - semi-down | |
3210 | {Arrow} % 3 - simple | |
3211 | {Gstroke ArrowPath} % 4 - transparent | |
3212 | {Gstroke ArrowPath 1 FillGray} % 5 - hollow | |
3213 | {Gstroke ArrowPath LineColor FillRGB} % 6 - full | |
3214 | {Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow | |
3215 | {Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full | |
3216 | {Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow | |
3217 | {Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full | |
3218 | {Gstroke gsave UserArrow grestore} % 11 - user | |
984ae001 GM |
3219 | ]def |
3220 | ||
3221 | /RA | |
3222 | {hT 0 rlineto | |
3223 | c | |
3224 | RA-vector ArrowShape get exec | |
3225 | Gstroke | |
3226 | moveto | |
ed0aa46c | 3227 | ExtraWidth 0 rmoveto |
984ae001 GM |
3228 | }def |
3229 | ||
3230 | % rotation DrawArrow | |
3231 | /DrawArrow | |
3232 | {gsave | |
3233 | 0 0 translate | |
3234 | rotate | |
3235 | RA | |
3236 | c | |
3237 | grestore | |
3238 | rmoveto | |
3239 | }def | |
3240 | ||
3241 | %>Left Arrow: LA | |
3242 | % / | |
3243 | % +---* | |
3244 | % \\ | |
3245 | /LA{180 DrawArrow}def | |
3246 | ||
3247 | %>Up Arrow: UA | |
3248 | % + | |
3249 | % /|\\ | |
3250 | % | | |
3251 | % * | |
3252 | /UA{90 DrawArrow}def | |
3253 | ||
3254 | %>Down Arrow: DA | |
3255 | % * | |
3256 | % | | |
3257 | % \\|/ | |
3258 | % + | |
3259 | /DA{270 DrawArrow}def | |
3260 | ||
3261 | % --- Corners | |
3262 | ||
a87ef899 | 3263 | %>corner Right Descendant: height arrow corner_RD |
984ae001 GM |
3264 | % _ | arrow |
3265 | % / height > 0 | 0 - none | |
3266 | % | | 1 - right | |
3267 | % * ---------- | 2 - left | |
3268 | % | | 3 - vertical | |
3269 | % \\ height < 0 | | |
3270 | % - | | |
3271 | /cRD0-vector | |
3272 | [% 0 - none | |
3273 | {0 h rlineto | |
3274 | hT 0 rlineto} | |
3275 | % 1 - right | |
3276 | {0 h rlineto | |
3277 | RA} | |
3278 | % 2 - left | |
3279 | {hT 0 rmoveto xyi | |
3280 | LA | |
3281 | 0 h neg rlineto | |
3282 | xi yi moveto} | |
3283 | % 3 - vertical | |
3284 | {hT h rmoveto xyi | |
3285 | hT neg 0 rlineto | |
3286 | h 0 gt{DA}{UA}ifelse | |
3287 | xi yi moveto} | |
3288 | ]def | |
3289 | ||
3290 | /cRD-vector | |
3291 | [{cRD0-vector arrow get exec} % 0 - miter | |
3292 | {0 0 0 h hT h rcurveto} % 1 - rounded | |
3293 | {hT h rlineto} % 2 - bevel | |
3294 | ]def | |
3295 | ||
3296 | /corner_RD | |
3297 | {/arrow exch def /h exch def | |
3298 | cRD-vector ChartShape get exec | |
3299 | Gstroke | |
3300 | }def | |
3301 | ||
a87ef899 | 3302 | %>corner Right Ascendant: height arrow corner_RA |
984ae001 GM |
3303 | % | arrow |
3304 | % | height > 0 | 0 - none | |
3305 | % / | 1 - right | |
3306 | % *- ---------- | 2 - left | |
3307 | % \\ | 3 - vertical | |
3308 | % | height < 0 | | |
3309 | % | | |
3310 | /cRA0-vector | |
3311 | [% 0 - none | |
3312 | {hT 0 rlineto | |
3313 | 0 h rlineto} | |
3314 | % 1 - right | |
3315 | {RA | |
3316 | 0 h rlineto} | |
3317 | % 2 - left | |
3318 | {hT h rmoveto xyi | |
3319 | 0 h neg rlineto | |
3320 | LA | |
3321 | xi yi moveto} | |
3322 | % 3 - vertical | |
3323 | {hT h rmoveto xyi | |
3324 | h 0 gt{DA}{UA}ifelse | |
3325 | hT neg 0 rlineto | |
3326 | xi yi moveto} | |
3327 | ]def | |
3328 | ||
3329 | /cRA-vector | |
3330 | [{cRA0-vector arrow get exec} % 0 - miter | |
3331 | {0 0 hT 0 hT h rcurveto} % 1 - rounded | |
3332 | {hT h rlineto} % 2 - bevel | |
3333 | ]def | |
3334 | ||
3335 | /corner_RA | |
3336 | {/arrow exch def /h exch def | |
3337 | cRA-vector ChartShape get exec | |
3338 | Gstroke | |
3339 | }def | |
3340 | ||
a87ef899 | 3341 | %>corner Left Descendant: height arrow corner_LD |
984ae001 GM |
3342 | % _ | arrow |
3343 | % \\ height > 0 | 0 - none | |
3344 | % | | 1 - right | |
3345 | % * ---------- | 2 - left | |
3346 | % | | 3 - vertical | |
3347 | % / height < 0 | | |
3348 | % - | | |
3349 | /cLD0-vector | |
3350 | [% 0 - none | |
3351 | {0 h rlineto | |
3352 | hT neg 0 rlineto} | |
3353 | % 1 - right | |
3354 | {hT neg h rmoveto xyi | |
3355 | RA | |
3356 | 0 h neg rlineto | |
3357 | xi yi moveto} | |
3358 | % 2 - left | |
3359 | {0 h rlineto | |
3360 | LA} | |
3361 | % 3 - vertical | |
3362 | {hT neg h rmoveto xyi | |
3363 | hT 0 rlineto | |
3364 | h 0 gt{DA}{UA}ifelse | |
3365 | xi yi moveto} | |
3366 | ]def | |
3367 | ||
3368 | /cLD-vector | |
3369 | [{cLD0-vector arrow get exec} % 0 - miter | |
3370 | {0 0 0 h hT neg h rcurveto} % 1 - rounded | |
3371 | {hT neg h rlineto} % 2 - bevel | |
3372 | ]def | |
3373 | ||
3374 | /corner_LD | |
3375 | {/arrow exch def /h exch def | |
3376 | cLD-vector ChartShape get exec | |
3377 | Gstroke | |
3378 | }def | |
3379 | ||
a87ef899 | 3380 | %>corner Left Ascendant: height arrow corner_LA |
984ae001 GM |
3381 | % | arrow |
3382 | % | height > 0 | 0 - none | |
3383 | % \\ | 1 - right | |
3384 | % -* ---------- | 2 - left | |
3385 | % / | 3 - vertical | |
3386 | % | height < 0 | | |
3387 | % | | |
3388 | /cLA0-vector | |
3389 | [% 0 - none | |
3390 | {hT neg 0 rlineto | |
3391 | 0 h rlineto} | |
3392 | % 1 - right | |
3393 | {hT neg h rmoveto xyi | |
3394 | 0 h neg rlineto | |
3395 | RA | |
3396 | xi yi moveto} | |
3397 | % 2 - left | |
3398 | {LA | |
3399 | 0 h rlineto} | |
3400 | % 3 - vertical | |
3401 | {hT neg h rmoveto xyi | |
3402 | h 0 gt{DA}{UA}ifelse | |
3403 | hT 0 rlineto | |
3404 | xi yi moveto} | |
3405 | ]def | |
3406 | ||
3407 | /cLA-vector | |
3408 | [{cLA0-vector arrow get exec} % 0 - miter | |
3409 | {0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded | |
3410 | {hT neg h rlineto} % 2 - bevel | |
3411 | ]def | |
3412 | ||
3413 | /corner_LA | |
3414 | {/arrow exch def /h exch def | |
3415 | cLA-vector ChartShape get exec | |
3416 | Gstroke | |
3417 | }def | |
3418 | ||
3419 | % --- Flow Stuff | |
3420 | ||
3ced5caa VJL |
3421 | % height prepare-height |- line_height corner_height corner_height |
3422 | /prepare-height | |
984ae001 GM |
3423 | {dup 0 gt |
3424 | {T sub hT} | |
3425 | {T add hT neg}ifelse | |
3426 | dup | |
3427 | }def | |
3428 | ||
3429 | %>Left Alternative: height LAlt | |
3430 | % _ | |
3431 | % / | |
3432 | % | height > 0 | |
3433 | % | | |
3434 | % / | |
3435 | % *- ---------- | |
3436 | % \\ | |
3437 | % | | |
3438 | % | height < 0 | |
3439 | % \\ | |
3440 | % - | |
3441 | /LAlt | |
3442 | {dup 0 eq | |
3443 | {T exch rlineto} | |
3444 | {dup abs T lt | |
3445 | {0.5 mul dup | |
3446 | 1 corner_RA | |
3447 | 0 corner_RD} | |
3ced5caa | 3448 | {prepare-height |
984ae001 GM |
3449 | 1 corner_RA |
3450 | exch 0 exch rlineto | |
3451 | 0 corner_RD | |
3452 | }ifelse | |
3453 | }ifelse | |
3454 | }def | |
3455 | ||
3456 | %>Left Loop: height LLoop | |
3457 | % _ | |
3458 | % / | |
3459 | % | height > 0 | |
3460 | % | | |
3461 | % \\ | |
3462 | % -* ---------- | |
3463 | % / | |
3464 | % | | |
3465 | % | height < 0 | |
3466 | % \\ | |
3467 | % - | |
3468 | /LLoop | |
3ced5caa | 3469 | {prepare-height |
984ae001 GM |
3470 | 3 corner_LA |
3471 | exch 0 exch rlineto | |
3472 | 0 corner_RD | |
3473 | }def | |
3474 | ||
3475 | %>Right Alternative: height RAlt | |
3476 | % _ | |
3477 | % \\ | |
3478 | % | height > 0 | |
3479 | % | | |
3480 | % \\ | |
3481 | % -* ---------- | |
3482 | % / | |
3483 | % | | |
3484 | % | height < 0 | |
3485 | % / | |
3486 | % - | |
3487 | /RAlt | |
3488 | {dup 0 eq | |
3489 | {T neg exch rlineto} | |
3490 | {dup abs T lt | |
3491 | {0.5 mul dup | |
3492 | 1 corner_LA | |
3493 | 0 corner_LD} | |
3ced5caa | 3494 | {prepare-height |
984ae001 GM |
3495 | 1 corner_LA |
3496 | exch 0 exch rlineto | |
3497 | 0 corner_LD | |
3498 | }ifelse | |
3499 | }ifelse | |
3500 | }def | |
3501 | ||
3502 | %>Right Loop: height RLoop | |
3503 | % _ | |
3504 | % \\ | |
3505 | % | height > 0 | |
3506 | % | | |
3507 | % / | |
3508 | % *- ---------- | |
3509 | % \\ | |
3510 | % | | |
3511 | % | height < 0 | |
3512 | % / | |
3513 | % - | |
3514 | /RLoop | |
3ced5caa | 3515 | {prepare-height |
984ae001 GM |
3516 | 1 corner_RA |
3517 | exch 0 exch rlineto | |
3518 | 0 corner_LD | |
3519 | }def | |
3520 | ||
3521 | % --- Terminal, Non-terminal and Special Basics | |
3522 | ||
3523 | % string width prepare-width |- string | |
3524 | /prepare-width | |
3525 | {/width exch def | |
ed0aa46c | 3526 | dup stringwidth pop space add space add width exch sub ExtraWidth sub 0.5 mul |
984ae001 GM |
3527 | /w exch def |
3528 | }def | |
3529 | ||
3530 | % string width begin-right | |
3531 | /begin-right | |
3532 | {xyo | |
3533 | prepare-width | |
3534 | w hT sub EL | |
3535 | RA | |
3536 | }def | |
3537 | ||
3538 | % end-right | |
3539 | /end-right | |
3540 | {xo width add Er add yo moveto | |
3541 | w Er add neg EL | |
3542 | xo yo moveto | |
3543 | }def | |
3544 | ||
3545 | % string width begin-left | |
3546 | /begin-left | |
3547 | {xyo | |
3548 | prepare-width | |
3549 | w EL | |
3550 | }def | |
3551 | ||
3552 | % end-left | |
3553 | /end-left | |
3554 | {xo width add Er add yo moveto | |
3555 | hT w sub Er add EL | |
3556 | LA | |
3557 | xo yo moveto | |
3558 | }def | |
3559 | ||
3560 | /ShapePath-vector | |
3561 | [% 0 - miter | |
3562 | {xx yy moveto | |
3563 | xx YY lineto | |
3564 | XX YY lineto | |
3565 | XX yy lineto} | |
3566 | % 1 - rounded | |
3567 | {/half YY yy sub 0.5 mul abs def | |
3568 | xx half add YY moveto | |
3569 | 0 0 half neg 0 half neg half neg rcurveto | |
3570 | 0 0 0 half neg half half neg rcurveto | |
3571 | XX xx sub abs half sub half sub 0 rlineto | |
3572 | 0 0 half 0 half half rcurveto | |
3573 | 0 0 0 half half neg half rcurveto} | |
3574 | % 2 - bevel | |
3575 | {/quarter YY yy sub 0.25 mul abs def | |
3576 | xx quarter add YY moveto | |
3577 | quarter neg quarter neg rlineto | |
3578 | 0 quarter quarter add neg rlineto | |
3579 | quarter quarter neg rlineto | |
3580 | XX xx sub abs quarter sub quarter sub 0 rlineto | |
3581 | quarter quarter rlineto | |
3582 | 0 quarter quarter add rlineto | |
3583 | quarter neg quarter rlineto} | |
3584 | ]def | |
3585 | ||
3586 | /doShapePath | |
3587 | {newpath | |
3588 | ShapePath-vector shape get exec | |
3589 | closepath | |
3590 | }def | |
3591 | ||
3592 | /doShapeShadow | |
3593 | {gsave | |
3594 | Xshadow Xshadow add Xshadow add | |
3595 | Yshadow Yshadow add Yshadow add translate | |
3596 | doShapePath | |
3597 | 0.9 FillGray | |
3598 | grestore | |
3599 | }def | |
3600 | ||
3601 | /doShape | |
3602 | {gsave | |
3603 | doShapePath | |
3604 | shapecolor FillRGB | |
3605 | StrokeShape | |
3606 | grestore | |
3607 | }def | |
3608 | ||
3609 | % string SBound |- string | |
3610 | /SBound | |
3611 | {/xx c dup /yy exch def | |
3612 | FontHeight add /YY exch def def | |
3613 | dup stringwidth pop xx add /XX exch def | |
3614 | Effect 8 and 0 ne | |
3615 | {/yy yy YShadow add def | |
3616 | /XX XX XShadow add def | |
3617 | }if | |
3618 | }def | |
3619 | ||
3620 | % string SBox | |
3621 | /SBox | |
3622 | {gsave | |
3623 | c space sub moveto | |
3624 | SBound | |
3625 | /XX XX space add space add def | |
3626 | /YY YY space add def | |
3627 | /yy yy space sub def | |
3628 | shadow{doShapeShadow}if | |
3629 | doShape | |
3630 | space Descent abs rmoveto | |
3631 | foreground SetRGB S | |
3632 | grestore | |
3633 | }def | |
3634 | ||
3635 | % --- Terminal | |
3636 | ||
3637 | % TeRminal: string TR | |
3638 | /TR | |
3639 | {/Effect EffectT def | |
3640 | /shape ShapeT def | |
3641 | /shapecolor BackgroundT def | |
3642 | /borderwidth BorderWidthT def | |
3643 | /bordercolor BorderColorT def | |
3644 | /foreground ForegroundT def | |
3645 | /shadow ShadowT def | |
3646 | SBox | |
3647 | }def | |
3648 | ||
3649 | %>Right Terminal: string width RT |- x y | |
3650 | /RT | |
3651 | {xyt | |
3652 | /fT F | |
3653 | /space SpaceT def | |
3654 | begin-right | |
3655 | TR | |
3656 | end-right | |
3657 | xt yt | |
3658 | }def | |
3659 | ||
3660 | %>Left Terminal: string width LT |- x y | |
3661 | /LT | |
3662 | {xyt | |
3663 | /fT F | |
3664 | /space SpaceT def | |
3665 | begin-left | |
3666 | TR | |
3667 | end-left | |
3668 | xt yt | |
3669 | }def | |
3670 | ||
3671 | %>Right Terminal Default: string width RTD |- x y | |
3672 | /RTD | |
3673 | {/-save- BorderWidthT def | |
3674 | /BorderWidthT BorderWidthT DefaultWidth add def | |
3675 | RT | |
3676 | /BorderWidthT -save- def | |
3677 | }def | |
3678 | ||
3679 | %>Left Terminal Default: string width LTD |- x y | |
3680 | /LTD | |
3681 | {/-save- BorderWidthT def | |
3682 | /BorderWidthT BorderWidthT DefaultWidth add def | |
3683 | LT | |
3684 | /BorderWidthT -save- def | |
3685 | }def | |
3686 | ||
3687 | % --- Non-Terminal | |
3688 | ||
3689 | % Non-Terminal: string NT | |
3690 | /NT | |
3691 | {/Effect EffectNT def | |
3692 | /shape ShapeNT def | |
3693 | /shapecolor BackgroundNT def | |
3694 | /borderwidth BorderWidthNT def | |
3695 | /bordercolor BorderColorNT def | |
3696 | /foreground ForegroundNT def | |
3697 | /shadow ShadowNT def | |
3698 | SBox | |
3699 | }def | |
3700 | ||
3701 | %>Right Non-Terminal: string width RNT |- x y | |
3702 | /RNT | |
3703 | {xyt | |
3704 | /fNT F | |
3705 | /space SpaceNT def | |
3706 | begin-right | |
3707 | NT | |
3708 | end-right | |
3709 | xt yt | |
3710 | }def | |
3711 | ||
3712 | %>Left Non-Terminal: string width LNT |- x y | |
3713 | /LNT | |
3714 | {xyt | |
3715 | /fNT F | |
3716 | /space SpaceNT def | |
3717 | begin-left | |
3718 | NT | |
3719 | end-left | |
3720 | xt yt | |
3721 | }def | |
3722 | ||
3723 | %>Right Non-Terminal Default: string width RNTD |- x y | |
3724 | /RNTD | |
3725 | {/-save- BorderWidthNT def | |
3726 | /BorderWidthNT BorderWidthNT DefaultWidth add def | |
3727 | RNT | |
3728 | /BorderWidthNT -save- def | |
3729 | }def | |
3730 | ||
3731 | %>Left Non-Terminal Default: string width LNTD |- x y | |
3732 | /LNTD | |
3733 | {/-save- BorderWidthNT def | |
3734 | /BorderWidthNT BorderWidthNT DefaultWidth add def | |
3735 | LNT | |
3736 | /BorderWidthNT -save- def | |
3737 | }def | |
3738 | ||
3739 | % --- Special | |
3740 | ||
3741 | % SPecial: string SP | |
3742 | /SP | |
3743 | {/Effect EffectS def | |
3744 | /shape ShapeS def | |
3745 | /shapecolor BackgroundS def | |
3746 | /borderwidth BorderWidthS def | |
3747 | /bordercolor BorderColorS def | |
3748 | /foreground ForegroundS def | |
3749 | /shadow ShadowS def | |
3750 | SBox | |
3751 | }def | |
3752 | ||
3753 | %>Right SPecial: string width RSP |- x y | |
3754 | /RSP | |
3755 | {xyt | |
3756 | /fS F | |
3757 | /space SpaceS def | |
3758 | begin-right | |
3759 | SP | |
3760 | end-right | |
3761 | xt yt | |
3762 | }def | |
3763 | ||
3764 | %>Left SPecial: string width LSP |- x y | |
3765 | /LSP | |
3766 | {xyt | |
3767 | /fS F | |
3768 | /space SpaceS def | |
3769 | begin-left | |
3770 | SP | |
3771 | end-left | |
3772 | xt yt | |
3773 | }def | |
3774 | ||
3775 | %>Right SPecial Default: string width RSPD |- x y | |
3776 | /RSPD | |
3777 | {/-save- BorderWidthS def | |
3778 | /BorderWidthS BorderWidthS DefaultWidth add def | |
3779 | RSP | |
3780 | /BorderWidthS -save- def | |
3781 | }def | |
3782 | ||
3783 | %>Left SPecial Default: string width LSPD |- x y | |
3784 | /LSPD | |
3785 | {/-save- BorderWidthS def | |
3786 | /BorderWidthS BorderWidthS DefaultWidth add def | |
3787 | LSP | |
3788 | /BorderWidthS -save- def | |
3789 | }def | |
3790 | ||
3791 | % --- Repeat and Except basics | |
3792 | ||
3793 | /begin-direction | |
3794 | {/w width rwidth sub 0.5 mul def | |
3795 | width 0 rmoveto}def | |
3796 | ||
3797 | /end-direction | |
3798 | {gsave | |
3799 | /xx c entry add /YY exch def def | |
3800 | /yy YY height sub def | |
3801 | /XX xx rwidth add def | |
3802 | shadow{doShapeShadow}if | |
3803 | doShape | |
3804 | grestore | |
3805 | }def | |
3806 | ||
3807 | /right-direction | |
3808 | {begin-direction | |
3809 | w neg EL | |
3810 | xt yt moveto | |
3811 | w hT sub EL RA | |
3812 | end-direction | |
3813 | }def | |
3814 | ||
3815 | /left-direction | |
3816 | {begin-direction | |
3817 | hT w sub EL LA | |
3818 | xt yt moveto | |
3819 | w EL | |
3820 | end-direction | |
3821 | }def | |
3822 | ||
3823 | % --- Repeat | |
3824 | ||
3825 | % entry height width rwidth begin-repeat | |
3826 | /begin-repeat | |
3827 | {/rwidth exch def | |
3828 | /width exch def | |
3829 | /height exch def | |
3830 | /entry exch def | |
3831 | /fR F | |
3832 | /space SpaceR def | |
3833 | /Effect EffectR def | |
3834 | /shape ShapeR def | |
3835 | /shapecolor BackgroundR def | |
3836 | /borderwidth BorderWidthR def | |
3837 | /bordercolor BorderColorR def | |
3838 | /foreground ForegroundR def | |
3839 | /shadow ShadowR def | |
3840 | xyt | |
3841 | }def | |
3842 | ||
3843 | % string end-repeat |- x y | |
3844 | /end-repeat | |
3845 | {gsave | |
3846 | space Descent rmoveto | |
3847 | foreground SetRGB S | |
3848 | c Descent sub | |
3849 | grestore | |
3850 | exch space add exch moveto | |
3851 | xt yt | |
3852 | }def | |
3853 | ||
3854 | %>Right RePeat: string entry height width rwidth RRP |- x y | |
3855 | /RRP{begin-repeat right-direction end-repeat}def | |
3856 | ||
3857 | %>Left RePeat: string entry height width rwidth LRP |- x y | |
3858 | /LRP{begin-repeat left-direction end-repeat}def | |
3859 | ||
3860 | % --- Except | |
3861 | ||
3862 | % entry height width rwidth begin-except | |
3863 | /begin-except | |
3864 | {/rwidth exch def | |
3865 | /width exch def | |
3866 | /height exch def | |
3867 | /entry exch def | |
3868 | /fE F | |
3869 | /space SpaceE def | |
3870 | /Effect EffectE def | |
3871 | /shape ShapeE def | |
3872 | /shapecolor BackgroundE def | |
3873 | /borderwidth BorderWidthE def | |
3874 | /bordercolor BorderColorE def | |
3875 | /foreground ForegroundE def | |
3876 | /shadow ShadowE def | |
3877 | xyt | |
3878 | }def | |
3879 | ||
3880 | % x-width end-except |- x y | |
3881 | /end-except | |
3882 | {gsave | |
3883 | space space add add Descent rmoveto | |
3884 | (-) foreground SetRGB S | |
3885 | grestore | |
3886 | space 0 rmoveto | |
3887 | xt yt | |
3888 | }def | |
3889 | ||
3890 | %>Right EXcept: x-width entry height width rwidth REX |- x y | |
3891 | /REX{begin-except right-direction end-except}def | |
3892 | ||
3893 | %>Left EXcept: x-width entry height width rwidth LEX |- x y | |
3894 | /LEX{begin-except left-direction end-except}def | |
3895 | ||
3896 | % --- Sequence | |
3897 | ||
3898 | %>Beginning Of Sequence: BOS |- x y | |
3899 | /BOS{currentpoint}bind def | |
3900 | ||
3901 | %>End Of Sequence: x y x1 y1 EOS |- x y | |
3902 | /EOS{pop pop}bind def | |
3903 | ||
3904 | % --- Production | |
3905 | ||
3906 | %>Beginning Of Production: string width height BOP |- y x | |
3907 | /BOP | |
3908 | {xyp | |
3909 | neg yp add /yw exch def | |
3910 | xp add T sub /xw exch def | |
ac4780a1 VJL |
3911 | dup length 0 gt % empty string ==> no production name |
3912 | {/Effect EffectP def | |
3913 | /fP F ForegroundP SetRGB BackgroundP aload pop true BG S | |
3914 | /Effect 0 def | |
3915 | ( :) S false BG}if | |
984ae001 GM |
3916 | xw yw moveto |
3917 | hT EL RA | |
3918 | xp yw moveto | |
3919 | T EL | |
3920 | yp xp | |
3921 | }def | |
3922 | ||
3923 | %>End Of Production: y x delta EOP | |
3924 | /EOPH{add exch moveto}bind def % horizontal | |
3925 | /EOPV{exch pop sub 0 exch moveto}bind def % vertical | |
3926 | ||
3927 | % --- Empty Alternative | |
3928 | ||
3929 | %>Empty Alternative: width EA |- x y | |
3930 | /EA | |
3931 | {gsave | |
3932 | Er add 0 rlineto | |
3933 | Stroke | |
3934 | grestore | |
3935 | c | |
3936 | }def | |
3937 | ||
3938 | % --- Alternative | |
3939 | ||
3940 | %>AlTernative: h1 h2 ... hn n width AT |- x y | |
3941 | /AT | |
3942 | {xyo xo add /xw exch def | |
3943 | xw yo moveto | |
3944 | Er EL | |
3945 | {xw yo moveto | |
3946 | dup RAlt | |
3947 | xo yo moveto | |
3948 | LAlt}repeat | |
3949 | xo yo | |
3950 | }def | |
3951 | ||
3952 | % --- Optional | |
3953 | ||
3954 | %>OPtional: height width OP |- x y | |
3955 | /OP | |
3956 | {xyo | |
3957 | T sub /ow exch def | |
3958 | ow Er sub 0 rmoveto | |
3959 | T Er add EL | |
3960 | neg dup RAlt | |
3961 | ow T sub neg EL | |
3962 | xo yo moveto | |
3963 | LAlt | |
3964 | xo yo moveto | |
3965 | T EL | |
3966 | xo yo | |
3967 | }def | |
3968 | ||
3969 | % --- List Flow | |
3970 | ||
3971 | %>One or More: height width OM |- x y | |
3972 | /OM | |
3973 | {xyo | |
3974 | /ow exch def | |
3975 | ow Er add 0 rmoveto | |
3976 | T Er add neg EL | |
3977 | dup RLoop | |
3978 | xo T add yo moveto | |
3979 | LLoop | |
3980 | xo yo moveto | |
3981 | T EL | |
3982 | xo yo | |
3983 | }def | |
3984 | ||
3985 | %>Zero or More: h2 h1 width ZM |- x y | |
3986 | /ZM | |
3987 | {xyo | |
3988 | Er add EL | |
3989 | Er neg 0 rmoveto | |
3990 | dup RAlt | |
3991 | exch dup RLoop | |
3992 | xo yo moveto | |
3993 | exch dup LAlt | |
3994 | exch LLoop | |
3995 | yo add xo T add exch moveto | |
3996 | xo yo | |
3997 | }def | |
3998 | ||
3999 | % === end EBNF engine | |
4000 | ||
4001 | " | |
4002 | "EBNF PostScript prologue") | |
4003 | ||
4004 | ||
4005 | (defconst ebnf-eps-prologue | |
4006 | " | |
4007 | /#ebnf2ps#dict 230 dict def | |
4008 | #ebnf2ps#dict begin | |
4009 | ||
f6b1b0a8 | 4010 | % Initialize variables to avoid name-conflicting with document variables. |
984ae001 GM |
4011 | % This is the case when using `bind' operator. |
4012 | /-fillp- 0 def /h 0 def | |
4013 | /-ox- 0 def /half 0 def | |
4014 | /-oy- 0 def /height 0 def | |
4015 | /-save- 0 def /ow 0 def | |
4016 | /Ascent 0 def /quarter 0 def | |
4017 | /Descent 0 def /rXX 0 def | |
4018 | /Effect 0 def /rYY 0 def | |
4019 | /FontHeight 0 def /rwidth 0 def | |
4020 | /LineThickness 0 def /rxx 0 def | |
4021 | /OverlinePosition 0 def /ryy 0 def | |
4022 | /SpaceBackground 0 def /shadow 0 def | |
4023 | /StrikeoutPosition 0 def /shape 0 def | |
4024 | /UnderlinePosition 0 def /shapecolor 0 def | |
4025 | /XBox 0 def /space 0 def | |
4026 | /XX 0 def /st 1 string def | |
4027 | /Xshadow 0 def /w 0 def | |
4028 | /YBox 0 def /width 0 def | |
4029 | /YY 0 def /xi 0 def | |
4030 | /Yshadow 0 def /xo 0 def | |
4031 | /arrow 0 def /xp 0 def | |
4032 | /bg false def /xt 0 def | |
4033 | /bgcolor 0 def /xw 0 def | |
4034 | /bordercolor 0 def /xx 0 def | |
4035 | /borderwidth 0 def /yi 0 def | |
4036 | /dd 0 def /yo 0 def | |
4037 | /entry 0 def /yp 0 def | |
4038 | /foreground 0 def /yt 0 def | |
4039 | /yy 0 def | |
4040 | ||
4041 | ||
4042 | % ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: | |
4043 | /ISOLatin1Encoding where | |
4044 | {pop} | |
4045 | {% -- The ISO Latin-1 encoding vector isn't known, so define it. | |
4046 | % -- The first half is the same as the standard encoding, | |
4047 | % -- except for minus instead of hyphen at code 055. | |
4048 | /ISOLatin1Encoding | |
4049 | StandardEncoding 0 45 getinterval aload pop | |
4050 | /minus | |
4051 | StandardEncoding 46 82 getinterval aload pop | |
4052 | %*** NOTE: the following are missing in the Adobe documentation, | |
4053 | %*** but appear in the displayed table: | |
4054 | %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240. | |
4055 | % 0200 (128) | |
4056 | /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef | |
4057 | /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef | |
4058 | /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent | |
4059 | /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron | |
4060 | % 0240 (160) | |
4061 | /space /exclamdown /cent /sterling | |
4062 | /currency /yen /brokenbar /section | |
4063 | /dieresis /copyright /ordfeminine /guillemotleft | |
4064 | /logicalnot /hyphen /registered /macron | |
4065 | /degree /plusminus /twosuperior /threesuperior | |
4066 | /acute /mu /paragraph /periodcentered | |
4067 | /cedilla /onesuperior /ordmasculine /guillemotright | |
4068 | /onequarter /onehalf /threequarters /questiondown | |
4069 | % 0300 (192) | |
4070 | /Agrave /Aacute /Acircumflex /Atilde | |
4071 | /Adieresis /Aring /AE /Ccedilla | |
4072 | /Egrave /Eacute /Ecircumflex /Edieresis | |
4073 | /Igrave /Iacute /Icircumflex /Idieresis | |
4074 | /Eth /Ntilde /Ograve /Oacute | |
4075 | /Ocircumflex /Otilde /Odieresis /multiply | |
4076 | /Oslash /Ugrave /Uacute /Ucircumflex | |
4077 | /Udieresis /Yacute /Thorn /germandbls | |
4078 | % 0340 (224) | |
4079 | /agrave /aacute /acircumflex /atilde | |
4080 | /adieresis /aring /ae /ccedilla | |
4081 | /egrave /eacute /ecircumflex /edieresis | |
4082 | /igrave /iacute /icircumflex /idieresis | |
4083 | /eth /ntilde /ograve /oacute | |
4084 | /ocircumflex /otilde /odieresis /divide | |
4085 | /oslash /ugrave /uacute /ucircumflex | |
4086 | /udieresis /yacute /thorn /ydieresis | |
4087 | 256 packedarray def | |
4088 | }ifelse | |
4089 | ||
4090 | /reencodeFontISO %def | |
4091 | {dup | |
4092 | length 12 add dict % Make a new font (a new dict the same size | |
4093 | % as the old one) with room for our new symbols. | |
4094 | ||
4095 | begin % Make the new font the current dictionary. | |
4096 | {1 index /FID ne | |
4097 | {def}{pop pop}ifelse | |
4098 | }forall % Copy each of the symbols from the old dictionary | |
4099 | % to the new one except for the font ID. | |
4100 | ||
4101 | currentdict /FontType get 0 ne | |
4102 | {/Encoding ISOLatin1Encoding def}if % Override the encoding with | |
4103 | % the ISOLatin1 encoding. | |
4104 | ||
4105 | % Use the font's bounding box to determine the ascent, descent, | |
4106 | % and overall height; don't forget that these values have to be | |
4107 | % transformed using the font's matrix. | |
4108 | ||
4109 | % ^ (x2 y2) | |
4110 | % | | | |
4111 | % | v | |
4112 | % | +----+ - - | |
4113 | % | | | ^ | |
4114 | % | | | | Ascent (usually > 0) | |
4115 | % | | | | | |
4116 | % (0 0) -> +--+----+--------> | |
4117 | % | | | | |
4118 | % | | v Descent (usually < 0) | |
4119 | % (x1 y1) --> +----+ - - | |
4120 | ||
4121 | currentdict /FontType get 0 ne | |
4122 | {/FontBBox load aload pop % -- x1 y1 x2 y2 | |
4123 | FontMatrix transform /Ascent exch def pop | |
4124 | FontMatrix transform /Descent exch def pop} | |
4125 | {/PrimaryFont FDepVector 0 get def | |
4126 | PrimaryFont /FontBBox get aload pop | |
4127 | PrimaryFont /FontMatrix get transform /Ascent exch def pop | |
4128 | PrimaryFont /FontMatrix get transform /Descent exch def pop | |
4129 | }ifelse | |
4130 | ||
4131 | /FontHeight Ascent Descent sub def % use `sub' because descent < 0 | |
4132 | ||
4133 | % Define these in case they're not in the FontInfo | |
4134 | % (also, here they're easier to get to). | |
4135 | /UnderlinePosition Descent 0.70 mul def | |
4136 | /OverlinePosition Descent UnderlinePosition sub Ascent add def | |
4137 | /StrikeoutPosition Ascent 0.30 mul def | |
4138 | /LineThickness FontHeight 0.05 mul def | |
4139 | /Xshadow FontHeight 0.08 mul def | |
4140 | /Yshadow FontHeight -0.09 mul def | |
4141 | /SpaceBackground Descent neg UnderlinePosition add def | |
4142 | /XBox Descent neg def | |
4143 | /YBox LineThickness 0.7 mul def | |
4144 | ||
4145 | currentdict % Leave the new font on the stack | |
4146 | end % Stop using the font as the current dictionary | |
4147 | definefont % Put the font into the font dictionary | |
4148 | pop % Discard the returned font | |
4149 | }bind def | |
4150 | ||
4151 | % Font definition | |
4152 | /DefFont{findfont exch scalefont reencodeFontISO}def | |
4153 | ||
4154 | % Font selection | |
4155 | /F | |
4156 | {findfont | |
4157 | dup /Ascent get /Ascent exch def | |
4158 | dup /Descent get /Descent exch def | |
4159 | dup /FontHeight get /FontHeight exch def | |
4160 | dup /UnderlinePosition get /UnderlinePosition exch def | |
4161 | dup /OverlinePosition get /OverlinePosition exch def | |
4162 | dup /StrikeoutPosition get /StrikeoutPosition exch def | |
4163 | dup /LineThickness get /LineThickness exch def | |
4164 | dup /Xshadow get /Xshadow exch def | |
4165 | dup /Yshadow get /Yshadow exch def | |
4166 | dup /SpaceBackground get /SpaceBackground exch def | |
4167 | dup /XBox get /XBox exch def | |
4168 | dup /YBox get /YBox exch def | |
4169 | setfont | |
4170 | }def | |
4171 | ||
4172 | /BG | |
4173 | {dup /bg exch def | |
4174 | {mark 4 1 roll ]} | |
4175 | {[ 1.0 1.0 1.0 ]} | |
4176 | ifelse | |
4177 | /bgcolor exch def | |
4178 | }def | |
4179 | ||
4180 | % stack: -- | |
4181 | /FillBgColor{bgcolor aload pop setrgbcolor fill}bind def | |
4182 | ||
4183 | % stack: fill-or-not lower-x lower-y upper-x upper-y |- -- | |
4184 | /doRect | |
4185 | {/rYY exch def | |
4186 | /rXX exch def | |
4187 | /ryy exch def | |
4188 | /rxx exch def | |
4189 | gsave | |
4190 | newpath | |
4191 | rXX rYY moveto | |
4192 | rxx rYY lineto | |
4193 | rxx ryy lineto | |
4194 | rXX ryy lineto | |
4195 | closepath | |
4196 | % top of stack: fill-or-not | |
4197 | {FillBgColor} | |
4198 | {LineThickness setlinewidth stroke} | |
4199 | ifelse | |
4200 | grestore | |
4201 | }bind def | |
4202 | ||
4203 | % stack: string fill-or-not |- -- | |
4204 | /doOutline | |
4205 | {/-fillp- exch def | |
4206 | /-ox- currentpoint /-oy- exch def def | |
4207 | gsave | |
4208 | LineThickness setlinewidth | |
4209 | {st 0 3 -1 roll put | |
4210 | st dup true charpath | |
4211 | -fillp- {gsave FillBgColor grestore}if | |
4212 | stroke stringwidth | |
4213 | -oy- add /-oy- exch def | |
4214 | -ox- add /-ox- exch def | |
4215 | -ox- -oy- moveto | |
4216 | }forall | |
4217 | grestore | |
4218 | -ox- -oy- moveto | |
4219 | }bind def | |
4220 | ||
4221 | % stack: fill-or-not delta |- -- | |
4222 | /doBox | |
4223 | {/dd exch def | |
4224 | xx XBox sub dd sub yy YBox sub dd sub | |
4225 | XX XBox add dd add YY YBox add dd add | |
4226 | doRect | |
4227 | }bind def | |
4228 | ||
4229 | % stack: string |- -- | |
4230 | /doShadow | |
4231 | {gsave | |
4232 | Xshadow Yshadow rmoveto | |
4233 | false doOutline | |
4234 | grestore | |
4235 | }bind def | |
4236 | ||
4237 | % stack: position |- -- | |
4238 | /Hline | |
4239 | {currentpoint exch pop add dup | |
4240 | gsave | |
4241 | newpath | |
4242 | xx exch moveto | |
4243 | XX exch lineto | |
4244 | closepath | |
4245 | LineThickness setlinewidth stroke | |
4246 | grestore | |
4247 | }bind def | |
4248 | ||
4249 | % stack: string |- -- | |
4250 | % effect: 1 - underline 2 - strikeout 4 - overline | |
4251 | % 8 - shadow 16 - box 32 - outline | |
4252 | /S | |
4253 | {/xx currentpoint dup Descent add /yy exch def | |
4254 | Ascent add /YY exch def def | |
4255 | dup stringwidth pop xx add /XX exch def | |
4256 | Effect 8 and 0 ne | |
4257 | {/yy yy Yshadow add def | |
4258 | /XX XX Xshadow add def | |
4259 | }if | |
4260 | bg | |
4261 | {true | |
4262 | Effect 16 and 0 ne | |
4263 | {SpaceBackground doBox} | |
4264 | {xx yy XX YY doRect} | |
4265 | ifelse | |
4266 | }if % background | |
4267 | Effect 16 and 0 ne{false 0 doBox}if % box | |
4268 | Effect 8 and 0 ne{dup doShadow}if % shadow | |
4269 | Effect 32 and 0 ne | |
4270 | {true doOutline} % outline | |
4271 | {show} % normal text | |
4272 | ifelse | |
4273 | Effect 1 and 0 ne{UnderlinePosition Hline}if % underline | |
4274 | Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout | |
4275 | Effect 4 and 0 ne{OverlinePosition Hline}if % overline | |
4276 | }bind def | |
4277 | ||
4278 | " | |
4279 | "EBNF EPS prologue") | |
4280 | ||
4281 | ||
4282 | (defconst ebnf-eps-begin | |
4283 | " | |
4284 | end | |
4285 | ||
4286 | % x y #ebnf2ps#begin | |
4287 | /#ebnf2ps#begin | |
4288 | {#ebnf2ps#dict begin /#ebnf2ps#save save def | |
4289 | moveto false BG 0.0 0.0 0.0 setrgbcolor}def | |
4290 | ||
4291 | /#ebnf2ps#end{showpage #ebnf2ps#save restore end}def | |
4292 | ||
0b5ecd6d | 4293 | %%EndProlog |
984ae001 GM |
4294 | " |
4295 | "EBNF EPS begin") | |
4296 | ||
4297 | ||
4298 | (defconst ebnf-eps-end | |
4299 | "#ebnf2ps#end | |
4300 | %%EOF | |
4301 | " | |
4302 | "EBNF EPS end") | |
4303 | ||
4304 | \f | |
3ced5caa VJL |
4305 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
4306 | ;; Header & Footer | |
4307 | ||
4308 | ||
4309 | (defun ebnf-eps-header-footer (value) | |
4310 | ;; evaluate header/footer value | |
4311 | ;; return a string or nil | |
4312 | (let ((tmp (if (symbolp value) | |
4313 | (cond ((fboundp value) (funcall value)) | |
4314 | ((boundp value) (symbol-value value)) | |
4315 | (t nil)) | |
4316 | value))) | |
4317 | (and (stringp tmp) tmp))) | |
4318 | ||
4319 | ||
4320 | (defun ebnf-eps-header () | |
4321 | ;; evaluate header value | |
4322 | (ebnf-eps-header-footer ebnf-eps-header)) | |
4323 | ||
4324 | ||
4325 | (defun ebnf-eps-footer () | |
4326 | ;; evaluate footer value | |
4327 | (ebnf-eps-header-footer ebnf-eps-footer)) | |
4328 | ||
4329 | ||
4330 | ;; hacked fom `ps-output-string-prim' (ps-print.el) | |
4331 | (defun ebnf-eps-string (string) | |
4332 | (let* ((str (string-as-unibyte string)) | |
4333 | (len (length str)) | |
4334 | (index 0) | |
4335 | (new "(") ; insert start-string delimiter | |
4336 | start special) | |
4337 | ;; Find and quote special characters as necessary for PS | |
4338 | ;; This skips everything except control chars, non-ASCII chars, (, ) and \. | |
4339 | (while (setq start (string-match "[^]-~ -'*-[]" str index)) | |
4340 | (setq special (aref str start) | |
4341 | new (concat new | |
4342 | (substring str index start) | |
4343 | (if (and (<= 0 special) (<= special 255)) | |
4344 | (aref ps-string-escape-codes special) | |
4345 | ;; insert hexadecimal representation if character | |
4346 | ;; code is out of range | |
4347 | (format "\\%04X" special))) | |
4348 | index (1+ start))) | |
4349 | (concat new | |
4350 | (and (< index len) | |
4351 | (substring str index len)) | |
4352 | ")"))) ; insert end-string delimiter | |
4353 | ||
4354 | ||
4355 | (defun ebnf-eps-header-footer-comment (str) | |
4356 | ;; parse header/footer comment string | |
4357 | (let ((len (1- (length str))) | |
4358 | (index 0) | |
4359 | new start fmt) | |
4360 | (while (setq start (string-match "%" str index)) | |
4361 | (setq fmt (if (< start len) (aref str (1+ start)) ?\?) | |
4362 | new (concat new | |
4363 | (substring str index start) | |
4364 | (cond ((= fmt ?%) "%") | |
4365 | ((= fmt ?H) (ebnf-eps-header)) | |
4366 | ((= fmt ?F) (ebnf-eps-footer)) | |
4367 | (t nil) | |
4368 | )) | |
4369 | index (+ start 2))) | |
4370 | (ebnf-eps-string (concat new | |
4371 | (and (<= index len) | |
4372 | (substring str index (1+ len))))))) | |
4373 | ||
4374 | ||
4375 | (defun ebnf-eps-header-footer-p (value) | |
4376 | ;; return t if value is non-nil and is not an empty string | |
4377 | (not (or (null value) | |
4378 | (and (stringp value) (string= value ""))))) | |
4379 | ||
4380 | ||
4381 | (defun ebnf-eps-header-comment (str) | |
4382 | ;; set header comment if header is on | |
4383 | (when (ebnf-eps-header-footer-p ebnf-eps-header) | |
4384 | (setq ebnf-eps-header-comment (ebnf-eps-header-footer-comment str)))) | |
4385 | ||
4386 | ||
4387 | (defun ebnf-eps-footer-comment (str) | |
4388 | ;; set footer comment if footer is on | |
4389 | (when (ebnf-eps-header-footer-p ebnf-eps-footer) | |
4390 | (setq ebnf-eps-footer-comment (ebnf-eps-header-footer-comment str)))) | |
4391 | ||
4392 | ||
4393 | (defun ebnf-eps-header-footer-file (filename) | |
4394 | ;; associate header and footer with a filename | |
4395 | (let ((filehf (assoc filename ebnf-eps-file-alist)) | |
4396 | (header (or ebnf-eps-header-comment (ebnf-eps-header))) | |
4397 | (footer (or ebnf-eps-footer-comment (ebnf-eps-footer)))) | |
4398 | (if (null filehf) | |
4399 | (setq ebnf-eps-file-alist (cons (list filename header footer) | |
4400 | ebnf-eps-file-alist)) | |
4401 | (setcar (nthcdr 1 filehf) header) | |
4402 | (setcar (nthcdr 2 filehf) footer)))) | |
4403 | ||
4404 | ||
4405 | (defun ebnf-eps-header-footer-set (filename) | |
4406 | ;; set header and footer from a filename | |
4407 | (let ((header-footer (assoc filename ebnf-eps-file-alist))) | |
4408 | (setq ebnf-eps-header-comment (nth 1 header-footer) | |
4409 | ebnf-eps-footer-comment (nth 2 header-footer)))) | |
4410 | ||
4411 | \f | |
984ae001 GM |
4412 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
4413 | ;; Formatting | |
4414 | ||
4415 | ||
4416 | (defvar ebnf-format-float "%1.3f") | |
4417 | ||
4418 | ||
4419 | (defun ebnf-format-float (&rest floats) | |
4420 | (mapconcat | |
4421 | #'(lambda (float) | |
4422 | (format ebnf-format-float float)) | |
4423 | floats | |
4424 | " ")) | |
4425 | ||
4426 | ||
4427 | (defun ebnf-format-color (format-str color default) | |
4428 | (let* ((the-color (or color default)) | |
b685181e | 4429 | (rgb (ps-color-scale the-color))) |
984ae001 GM |
4430 | (format format-str |
4431 | (concat "[" | |
4432 | (ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb)) | |
4433 | "]") | |
4434 | the-color))) | |
4435 | ||
4436 | ||
4437 | (defvar ebnf-message-float "%3.2f") | |
4438 | ||
4439 | ||
4440 | (defsubst ebnf-message-float (format-str value) | |
4441 | (message format-str | |
4442 | (format ebnf-message-float value))) | |
4443 | ||
4444 | ||
30fa28b4 VJL |
4445 | (defvar ebnf-total 0) |
4446 | (defvar ebnf-nprod 0) | |
4447 | ||
4448 | ||
984ae001 GM |
4449 | (defsubst ebnf-message-info (messag) |
4450 | (message "%s...%3d%%" | |
4451 | messag | |
4452 | (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total)))) | |
4453 | ||
4454 | \f | |
4455 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
4456 | ;; Macros | |
4457 | ||
4458 | ||
4459 | (defmacro ebnf-node-kind (vec &optional value) | |
4460 | (if value | |
4461 | `(aset ,vec 0 ,value) | |
4462 | `(aref ,vec 0))) | |
4463 | ||
4464 | ||
4465 | (defmacro ebnf-node-width-func (node width) | |
4466 | `(funcall (aref ,node 1) ,node ,width)) | |
4467 | ||
4468 | ||
4469 | (defmacro ebnf-node-dimension-func (node &optional value) | |
4470 | (if value | |
4471 | `(aset ,node 2 ,value) | |
4472 | `(funcall (aref ,node 2) ,node))) | |
4473 | ||
4474 | ||
4475 | (defmacro ebnf-node-entry (vec &optional value) | |
4476 | (if value | |
4477 | `(aset ,vec 3 ,value) | |
4478 | `(aref ,vec 3))) | |
4479 | ||
4480 | ||
4481 | (defmacro ebnf-node-height (vec &optional value) | |
4482 | (if value | |
4483 | `(aset ,vec 4 ,value) | |
4484 | `(aref ,vec 4))) | |
4485 | ||
4486 | ||
4487 | (defmacro ebnf-node-width (vec &optional value) | |
4488 | (if value | |
4489 | `(aset ,vec 5 ,value) | |
4490 | `(aref ,vec 5))) | |
4491 | ||
4492 | ||
4493 | (defmacro ebnf-node-name (vec) | |
4494 | `(aref ,vec 6)) | |
4495 | ||
4496 | ||
4497 | (defmacro ebnf-node-list (vec &optional value) | |
4498 | (if value | |
4499 | `(aset ,vec 6 ,value) | |
4500 | `(aref ,vec 6))) | |
4501 | ||
4502 | ||
4503 | (defmacro ebnf-node-default (vec) | |
4504 | `(aref ,vec 7)) | |
4505 | ||
4506 | ||
4507 | (defmacro ebnf-node-production (vec &optional value) | |
4508 | (if value | |
4509 | `(aset ,vec 7 ,value) | |
4510 | `(aref ,vec 7))) | |
4511 | ||
4512 | ||
4513 | (defmacro ebnf-node-separator (vec &optional value) | |
4514 | (if value | |
4515 | `(aset ,vec 7 ,value) | |
4516 | `(aref ,vec 7))) | |
4517 | ||
4518 | ||
4519 | (defmacro ebnf-node-action (vec &optional value) | |
4520 | (if value | |
4521 | `(aset ,vec 8 ,value) | |
4522 | `(aref ,vec 8))) | |
4523 | ||
4524 | ||
4525 | (defmacro ebnf-node-generation (node) | |
4526 | `(funcall (ebnf-node-kind ,node) ,node)) | |
4527 | ||
4528 | ||
4529 | (defmacro ebnf-max-width (prod) | |
4530 | `(max (ebnf-node-width ,prod) | |
4531 | (+ (* (length (ebnf-node-name ,prod)) | |
4532 | ebnf-font-width-P) | |
4533 | ebnf-production-horizontal-space))) | |
4534 | ||
4535 | \f | |
4536 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
4537 | ;; PostScript generation | |
4538 | ||
4539 | ||
4540 | (defun ebnf-generate-eps (ebnf-tree) | |
4541 | (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) | |
4542 | (ps-print-color-scale (if ps-color-p | |
4543 | (float (car (ps-color-values "white"))) | |
4544 | 1.0)) | |
4545 | (ebnf-total (length ebnf-tree)) | |
4546 | (ebnf-nprod 0) | |
4547 | (old-ps-output (symbol-function 'ps-output)) | |
4548 | (old-ps-output-string (symbol-function 'ps-output-string)) | |
4549 | (eps-buffer (get-buffer-create ebnf-eps-buffer-name)) | |
4550 | ebnf-debug-ps error-msg horizontal | |
4551 | prod prod-name prod-width prod-height prod-list file-list) | |
4552 | ;; redefines `ps-output' and `ps-output-string' | |
4553 | (defalias 'ps-output 'ebnf-eps-output) | |
4554 | (defalias 'ps-output-string 'ps-output-string-prim) | |
4555 | ;; generate EPS file | |
4556 | (save-excursion | |
4557 | (condition-case data | |
4558 | (progn | |
4559 | (while ebnf-tree | |
4560 | (setq prod (car ebnf-tree) | |
4561 | prod-name (ebnf-node-name prod) | |
4562 | prod-width (ebnf-max-width prod) | |
4563 | prod-height (ebnf-node-height prod) | |
b685181e GM |
4564 | horizontal (memq (ebnf-node-action prod) |
4565 | ebnf-action-list)) | |
984ae001 | 4566 | ;; generate production in EPS buffer |
9a529312 | 4567 | (with-current-buffer eps-buffer |
984ae001 GM |
4568 | (setq ebnf-eps-upper-x 0.0 |
4569 | ebnf-eps-upper-y 0.0 | |
4570 | ebnf-eps-max-width prod-width | |
4571 | ebnf-eps-max-height prod-height) | |
4572 | (ebnf-generate-production prod)) | |
4573 | (if (setq prod-list (cdr (assoc prod-name | |
4574 | ebnf-eps-production-list))) | |
4575 | ;; insert EPS buffer in all buffer associated with production | |
4576 | (ebnf-eps-production-list prod-list 'file-list horizontal | |
4577 | prod-width prod-height eps-buffer) | |
4578 | ;; write EPS file for production | |
4579 | (ebnf-eps-finish-and-write eps-buffer | |
4580 | (ebnf-eps-filename prod-name))) | |
4581 | ;; prepare for next loop | |
9a529312 | 4582 | (with-current-buffer eps-buffer |
984ae001 GM |
4583 | (erase-buffer)) |
4584 | (setq ebnf-tree (cdr ebnf-tree))) | |
4585 | ;; write and kill temporary buffers | |
4586 | (ebnf-eps-write-kill-temp file-list t) | |
4587 | (setq file-list nil)) | |
4588 | ;; handler | |
4589 | ((quit error) | |
4590 | (setq error-msg (error-message-string data))))) | |
4591 | ;; restore `ps-output' and `ps-output-string' | |
4592 | (defalias 'ps-output old-ps-output) | |
4593 | (defalias 'ps-output-string old-ps-output-string) | |
4594 | ;; kill temporary buffers | |
4595 | (kill-buffer eps-buffer) | |
4596 | (ebnf-eps-write-kill-temp file-list nil) | |
4597 | (and error-msg (error error-msg)) | |
4598 | (message " "))) | |
4599 | ||
4600 | ||
4601 | ;; write and kill temporary buffers | |
4602 | (defun ebnf-eps-write-kill-temp (file-list write-p) | |
4603 | (while file-list | |
4604 | (let ((buffer (get-buffer (concat " *" (car file-list) "*")))) | |
4605 | (when buffer | |
4606 | (and write-p | |
4607 | (ebnf-eps-finish-and-write buffer (car file-list))) | |
4608 | (kill-buffer buffer))) | |
4609 | (setq file-list (cdr file-list)))) | |
4610 | ||
4611 | ||
4612 | ;; insert EPS buffer in all buffer associated with production | |
4613 | (defun ebnf-eps-production-list (prod-list file-list-sym horizontal | |
4614 | prod-width prod-height eps-buffer) | |
4615 | (while prod-list | |
4616 | (add-to-list file-list-sym (car prod-list)) | |
9a529312 | 4617 | (with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*")) |
984ae001 GM |
4618 | (goto-char (point-max)) |
4619 | (cond | |
4620 | ;; first production | |
4621 | ((zerop (buffer-size)) | |
4622 | (setq ebnf-eps-upper-x 0.0 | |
4623 | ebnf-eps-upper-y 0.0 | |
4624 | ebnf-eps-max-width prod-width | |
4625 | ebnf-eps-max-height prod-height)) | |
4626 | ;; horizontal | |
4627 | (horizontal | |
4628 | (ebnf-eop-horizontal ebnf-eps-prod-width) | |
4629 | (setq ebnf-eps-max-width (+ ebnf-eps-max-width | |
4630 | ebnf-production-horizontal-space | |
4631 | prod-width) | |
4632 | ebnf-eps-max-height (max ebnf-eps-max-height prod-height))) | |
4633 | ;; vertical | |
4634 | (t | |
4635 | (ebnf-eop-vertical ebnf-eps-max-height) | |
4636 | (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width) | |
4637 | ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y) | |
4638 | ebnf-eps-max-height | |
4639 | (+ ebnf-eps-upper-y | |
4640 | ebnf-production-vertical-space | |
4641 | ebnf-eps-max-height)) | |
4642 | ebnf-eps-max-width prod-width | |
4643 | ebnf-eps-max-height prod-height)) | |
4644 | ) | |
4645 | (setq ebnf-eps-prod-width prod-width) | |
b0de446f | 4646 | (insert-buffer-substring eps-buffer)) |
984ae001 GM |
4647 | (setq prod-list (cdr prod-list)))) |
4648 | ||
4649 | ||
4650 | (defun ebnf-generate (ebnf-tree) | |
4651 | (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) | |
4652 | (ps-print-color-scale (if ps-color-p | |
4653 | (float (car (ps-color-values "white"))) | |
4654 | 1.0)) | |
4655 | ps-zebra-stripes ps-line-number ps-razzle-dazzle | |
4656 | ps-print-hook | |
4657 | ps-print-begin-sheet-hook | |
4658 | ps-print-begin-page-hook | |
4659 | ps-print-begin-column-hook) | |
4660 | (ps-generate (current-buffer) (point-min) (point-max) | |
4661 | 'ebnf-generate-postscript))) | |
4662 | ||
4663 | ||
4664 | (defvar ebnf-tree nil) | |
4665 | (defvar ebnf-direction "R") | |
984ae001 GM |
4666 | |
4667 | ||
4668 | (defun ebnf-generate-postscript (from to) | |
4669 | (ebnf-begin-file) | |
4670 | (if ebnf-horizontal-max-height | |
4671 | (ebnf-generate-with-max-height) | |
4672 | (ebnf-generate-without-max-height)) | |
4673 | (message " ")) | |
4674 | ||
4675 | ||
4676 | (defun ebnf-generate-with-max-height () | |
4677 | (let ((ebnf-total (length ebnf-tree)) | |
4678 | (ebnf-nprod 0) | |
4679 | next-line max-height prod the-width) | |
4680 | (while ebnf-tree | |
4681 | ;; find next line point | |
4682 | (setq next-line ebnf-tree | |
4683 | prod (car ebnf-tree) | |
4684 | max-height (ebnf-node-height prod)) | |
4685 | (ebnf-begin-line prod (ebnf-max-width prod)) | |
4686 | (while (and (setq next-line (cdr next-line)) | |
4687 | (setq prod (car next-line)) | |
4688 | (memq (ebnf-node-action prod) ebnf-action-list) | |
4689 | (setq the-width (ebnf-max-width prod)) | |
4690 | (<= the-width ps-width-remaining)) | |
4691 | (setq max-height (max max-height (ebnf-node-height prod)) | |
4692 | ps-width-remaining (- ps-width-remaining | |
4693 | (+ the-width | |
4694 | ebnf-production-horizontal-space)))) | |
4695 | ;; generate current line | |
4696 | (ebnf-newline max-height) | |
4697 | (setq prod (car ebnf-tree)) | |
4698 | (ebnf-generate-production prod) | |
4699 | (while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line)) | |
4700 | (ebnf-eop-horizontal (ebnf-max-width prod)) | |
4701 | (setq prod (car ebnf-tree)) | |
4702 | (ebnf-generate-production prod)) | |
4703 | (ebnf-eop-vertical max-height)))) | |
4704 | ||
4705 | ||
4706 | (defun ebnf-generate-without-max-height () | |
4707 | (let ((ebnf-total (length ebnf-tree)) | |
4708 | (ebnf-nprod 0) | |
4709 | max-height prod bef-width cur-width) | |
4710 | (while ebnf-tree | |
4711 | ;; generate current line | |
4712 | (setq prod (car ebnf-tree) | |
4713 | max-height (ebnf-node-height prod) | |
4714 | bef-width (ebnf-max-width prod)) | |
4715 | (ebnf-begin-line prod bef-width) | |
4716 | (ebnf-generate-production prod) | |
4717 | (while (and (setq ebnf-tree (cdr ebnf-tree)) | |
4718 | (setq prod (car ebnf-tree)) | |
4719 | (memq (ebnf-node-action prod) ebnf-action-list) | |
4720 | (setq cur-width (ebnf-max-width prod)) | |
4721 | (<= cur-width ps-width-remaining) | |
4722 | (<= (ebnf-node-height prod) ps-height-remaining)) | |
4723 | (ebnf-eop-horizontal bef-width) | |
4724 | (ebnf-generate-production prod) | |
4725 | (setq bef-width cur-width | |
4726 | max-height (max max-height (ebnf-node-height prod)) | |
4727 | ps-width-remaining (- ps-width-remaining | |
4728 | (+ cur-width | |
4729 | ebnf-production-horizontal-space)))) | |
4730 | (ebnf-eop-vertical max-height) | |
4731 | ;; prepare next line | |
4732 | (ebnf-newline max-height)))) | |
4733 | ||
4734 | ||
4735 | (defun ebnf-begin-line (prod width) | |
4736 | (and (or (eq (ebnf-node-action prod) 'form-feed) | |
4737 | (> (ebnf-node-height prod) ps-height-remaining)) | |
4738 | (ebnf-new-page)) | |
4739 | (setq ps-width-remaining (- ps-width-remaining | |
4740 | (+ width | |
4741 | ebnf-production-horizontal-space)))) | |
4742 | ||
4743 | ||
4744 | (defun ebnf-newline (height) | |
4745 | (and (> height ps-height-remaining) | |
4746 | (ebnf-new-page)) | |
4747 | (setq ps-width-remaining ps-print-width | |
4748 | ps-height-remaining (- ps-height-remaining | |
4749 | (+ height | |
4750 | ebnf-production-vertical-space)))) | |
4751 | ||
4752 | ||
4753 | ;; [production width-fun dim-fun entry height width name production action] | |
4754 | (defun ebnf-generate-production (production) | |
4755 | (ebnf-message-info "Generating") | |
4756 | (run-hooks 'ebnf-production-hook) | |
ac4780a1 VJL |
4757 | (ps-output-string (if ebnf-production-name-p |
4758 | (ebnf-node-name production) | |
4759 | "")) | |
984ae001 GM |
4760 | (ps-output " " |
4761 | (ebnf-format-float | |
4762 | (ebnf-node-width production) | |
ac4780a1 VJL |
4763 | (+ (if ebnf-production-name-p |
4764 | ebnf-basic-height | |
4765 | 0.0) | |
984ae001 GM |
4766 | (ebnf-node-entry (ebnf-node-production production)))) |
4767 | " BOP\n") | |
4768 | (ebnf-node-generation (ebnf-node-production production)) | |
4769 | (ps-output "EOS\n")) | |
4770 | ||
4771 | ||
4772 | ;; [alternative width-fun dim-fun entry height width list] | |
4773 | (defun ebnf-generate-alternative (alternative) | |
4774 | (let ((alt (ebnf-node-list alternative)) | |
4775 | (entry (ebnf-node-entry alternative)) | |
4776 | (nlist 0) | |
4777 | alt-height alt-entry) | |
4778 | (while alt | |
4779 | (ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt)))) | |
4780 | " ") | |
4781 | (setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space) | |
4782 | nlist (1+ nlist) | |
4783 | alt (cdr alt))) | |
4784 | (ps-output (format "%d " nlist) | |
4785 | (ebnf-format-float (ebnf-node-width alternative)) | |
4786 | " AT\n") | |
4787 | (setq alt (ebnf-node-list alternative)) | |
4788 | (when alt | |
4789 | (ebnf-node-generation (car alt)) | |
4790 | (setq alt-height (- (ebnf-node-height (car alt)) | |
4791 | (ebnf-node-entry (car alt))))) | |
4792 | (while (setq alt (cdr alt)) | |
4793 | (setq alt-entry (ebnf-node-entry (car alt))) | |
4794 | (ebnf-vertical-movement | |
4795 | (- (+ alt-height ebnf-vertical-space alt-entry))) | |
4796 | (ebnf-node-generation (car alt)) | |
4797 | (setq alt-height (- (ebnf-node-height (car alt)) alt-entry)))) | |
4798 | (ps-output "EOS\n")) | |
4799 | ||
4800 | ||
4801 | ;; [sequence width-fun dim-fun entry height width list] | |
4802 | (defun ebnf-generate-sequence (sequence) | |
4803 | (ps-output "BOS\n") | |
4804 | (let ((seq (ebnf-node-list sequence)) | |
4805 | seq-width) | |
4806 | (when seq | |
4807 | (ebnf-node-generation (car seq)) | |
4808 | (setq seq-width (ebnf-node-width (car seq)))) | |
4809 | (while (setq seq (cdr seq)) | |
4810 | (ebnf-horizontal-movement seq-width) | |
4811 | (ebnf-node-generation (car seq)) | |
4812 | (setq seq-width (ebnf-node-width (car seq))))) | |
4813 | (ps-output "EOS\n")) | |
4814 | ||
4815 | ||
4816 | ;; [terminal width-fun dim-fun entry height width name] | |
4817 | (defun ebnf-generate-terminal (terminal) | |
4818 | (ebnf-gen-terminal terminal "T")) | |
4819 | ||
4820 | ||
4821 | ;; [non-terminal width-fun dim-fun entry height width name] | |
4822 | (defun ebnf-generate-non-terminal (non-terminal) | |
4823 | (ebnf-gen-terminal non-terminal "NT")) | |
4824 | ||
4825 | ||
4826 | ;; [empty width-fun dim-fun entry height width] | |
4827 | (defun ebnf-generate-empty (empty) | |
4828 | (ebnf-empty-alternative (ebnf-node-width empty))) | |
4829 | ||
4830 | ||
4831 | ;; [optional width-fun dim-fun entry height width element] | |
4832 | (defun ebnf-generate-optional (optional) | |
4833 | (let ((the-optional (ebnf-node-list optional))) | |
4834 | (ps-output (ebnf-format-float | |
4835 | (+ (- (ebnf-node-height the-optional) | |
4836 | (ebnf-node-entry optional)) | |
4837 | ebnf-vertical-space) | |
4838 | (ebnf-node-width optional)) | |
4839 | " OP\n") | |
4840 | (ebnf-node-generation the-optional) | |
4841 | (ps-output "EOS\n"))) | |
4842 | ||
4843 | ||
4844 | ;; [one-or-more width-fun dim-fun entry height width element separator] | |
4845 | (defun ebnf-generate-one-or-more (one-or-more) | |
4846 | (let* ((width (ebnf-node-width one-or-more)) | |
4847 | (sep (ebnf-node-separator one-or-more)) | |
4848 | (entry (- (ebnf-node-entry one-or-more) | |
4849 | (if sep | |
4850 | (ebnf-node-entry sep) | |
4851 | 0)))) | |
4852 | (ps-output (ebnf-format-float entry width) | |
4853 | " OM\n") | |
4854 | (ebnf-node-generation (ebnf-node-list one-or-more)) | |
4855 | (ebnf-vertical-movement entry) | |
4856 | (if sep | |
4857 | (let ((ebnf-direction "L")) | |
4858 | (ebnf-node-generation sep)) | |
3ced5caa VJL |
4859 | (ebnf-empty-alternative (- width |
4860 | ebnf-horizontal-space | |
4861 | ebnf-basic-width-extra)))) | |
984ae001 GM |
4862 | (ps-output "EOS\n")) |
4863 | ||
4864 | ||
4865 | ;; [zero-or-more width-fun dim-fun entry height width element separator] | |
4866 | (defun ebnf-generate-zero-or-more (zero-or-more) | |
4867 | (let* ((width (ebnf-node-width zero-or-more)) | |
4868 | (node-list (ebnf-node-list zero-or-more)) | |
4869 | (list-entry (ebnf-node-entry node-list)) | |
4870 | (node-sep (ebnf-node-separator zero-or-more)) | |
4871 | (entry (+ list-entry | |
4872 | ebnf-vertical-space | |
4873 | (if node-sep | |
4874 | (- (ebnf-node-height node-sep) | |
4875 | (ebnf-node-entry node-sep)) | |
3ced5caa | 4876 | ebnf-basic-empty-height)))) |
984ae001 GM |
4877 | (ps-output (ebnf-format-float entry |
4878 | (+ (- (ebnf-node-height node-list) | |
4879 | list-entry) | |
4880 | ebnf-vertical-space) | |
4881 | width) | |
4882 | " ZM\n") | |
4883 | (ebnf-node-generation (ebnf-node-list zero-or-more)) | |
4884 | (ebnf-vertical-movement entry) | |
4885 | (if (ebnf-node-separator zero-or-more) | |
4886 | (let ((ebnf-direction "L")) | |
4887 | (ebnf-node-generation (ebnf-node-separator zero-or-more))) | |
3ced5caa VJL |
4888 | (ebnf-empty-alternative (- width |
4889 | ebnf-horizontal-space | |
4890 | ebnf-basic-width-extra)))) | |
984ae001 GM |
4891 | (ps-output "EOS\n")) |
4892 | ||
4893 | ||
4894 | ;; [special width-fun dim-fun entry height width name] | |
4895 | (defun ebnf-generate-special (special) | |
4896 | (ebnf-gen-terminal special "SP")) | |
4897 | ||
4898 | ||
4899 | ;; [repeat width-fun dim-fun entry height width times element] | |
4900 | (defun ebnf-generate-repeat (repeat) | |
4901 | (let ((times (ebnf-node-name repeat)) | |
4902 | (element (ebnf-node-separator repeat))) | |
4903 | (ps-output-string times) | |
4904 | (ps-output " " | |
4905 | (ebnf-format-float | |
4906 | (ebnf-node-entry repeat) | |
4907 | (ebnf-node-height repeat) | |
4908 | (ebnf-node-width repeat) | |
4909 | (if element | |
4910 | (+ (ebnf-node-width element) | |
4911 | ebnf-space-R ebnf-space-R ebnf-space-R | |
4912 | (* (length times) ebnf-font-width-R)) | |
4913 | 0.0)) | |
4914 | " " ebnf-direction "RP\n") | |
4915 | (and element | |
4916 | (ebnf-node-generation element))) | |
4917 | (ps-output "EOS\n")) | |
4918 | ||
4919 | ||
4920 | ;; [except width-fun dim-fun entry height width element element] | |
4921 | (defun ebnf-generate-except (except) | |
4922 | (let* ((element (ebnf-node-list except)) | |
4923 | (exception (ebnf-node-separator except)) | |
4924 | (width (ebnf-node-width element))) | |
4925 | (ps-output (ebnf-format-float | |
4926 | width | |
4927 | (ebnf-node-entry except) | |
4928 | (ebnf-node-height except) | |
4929 | (ebnf-node-width except) | |
4930 | (+ width | |
4931 | ebnf-space-E ebnf-space-E ebnf-space-E | |
4932 | ebnf-font-width-E | |
4933 | (if exception | |
4934 | (+ (ebnf-node-width exception) ebnf-space-E) | |
4935 | 0.0))) | |
4936 | " " ebnf-direction "EX\n") | |
4937 | (ebnf-node-generation (ebnf-node-list except)) | |
4938 | (when exception | |
4939 | (ebnf-horizontal-movement (+ width ebnf-space-E | |
4940 | ebnf-font-width-E ebnf-space-E)) | |
4941 | (ebnf-node-generation exception))) | |
4942 | (ps-output "EOS\n")) | |
4943 | ||
4944 | ||
4945 | (defun ebnf-gen-terminal (node code) | |
4946 | (ps-output-string (ebnf-node-name node)) | |
4947 | (ps-output " " (ebnf-format-float (ebnf-node-width node)) | |
4948 | " " ebnf-direction code | |
4949 | (if (ebnf-node-default node) | |
4950 | "D\n" | |
4951 | "\n"))) | |
4952 | ||
4953 | \f | |
4954 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
4955 | ;; Internal functions | |
4956 | ||
4957 | ||
ac4780a1 VJL |
4958 | (defun ebnf-directory (fun &optional directory) |
4959 | "Process files in DIRECTORY applying function FUN on each file. | |
4960 | ||
815cbda2 | 4961 | If DIRECTORY is nil, use `default-directory'. |
ac4780a1 | 4962 | |
815cbda2 | 4963 | Only files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see) are |
ac4780a1 VJL |
4964 | processed." |
4965 | (let ((files (directory-files (or directory default-directory) | |
4966 | t ebnf-file-suffix-regexp))) | |
4967 | (while files | |
4968 | (set-buffer (find-file-noselect (car files))) | |
4969 | (funcall fun) | |
4970 | (setq buffer-backed-up t) ; Do not back it up. | |
4971 | (save-buffer) ; Just save new version. | |
4972 | (kill-buffer (current-buffer)) | |
4973 | (setq files (cdr files))))) | |
4974 | ||
4975 | ||
4976 | (defun ebnf-file (fun file &optional do-not-kill-buffer-when-done) | |
815cbda2 | 4977 | "Process the named FILE applying function FUN. |
ac4780a1 VJL |
4978 | |
4979 | If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't | |
4980 | killed after process termination." | |
4981 | (set-buffer (find-file-noselect file)) | |
4982 | (funcall fun) | |
4983 | (or do-not-kill-buffer-when-done | |
4984 | (kill-buffer (current-buffer)))) | |
4985 | ||
4986 | ||
6a5275dc GM |
4987 | ;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward' |
4988 | ;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or | |
4989 | ;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or | |
4990 | ;; from \177 to \237). It seems that version 20.7 has the same problem. | |
4991 | (defun ebnf-range-regexp (prefix from to) | |
4992 | (let (str) | |
4993 | (while (<= from to) | |
4994 | (setq str (concat str (char-to-string from)) | |
4995 | from (1+ from))) | |
4996 | (concat prefix str))) | |
4997 | ||
4998 | ||
984ae001 GM |
4999 | (defvar ebnf-map-name |
5000 | (let ((map (make-vector 256 ?\_))) | |
a6d6a87a GM |
5001 | (mapc #'(lambda (char) |
5002 | (aset map char char)) | |
5003 | (concat "#$%&+-.0123456789=?@~" | |
5004 | "ABCDEFGHIJKLMNOPQRSTUVWXYZ" | |
5005 | "abcdefghijklmnopqrstuvwxyz")) | |
984ae001 GM |
5006 | map)) |
5007 | ||
5008 | ||
5009 | (defun ebnf-eps-filename (str) | |
5010 | (let* ((len (length str)) | |
5011 | (stri 0) | |
3ced5caa VJL |
5012 | ;; to keep compatibility with Emacs 20 & 21: |
5013 | ;; DO NOT REPLACE `?\ ' BY `?\s' | |
5014 | (new (make-string len ?\ ))) | |
984ae001 GM |
5015 | (while (< stri len) |
5016 | (aset new stri (aref ebnf-map-name (aref str stri))) | |
5017 | (setq stri (1+ stri))) | |
5018 | (concat ebnf-eps-prefix new ".eps"))) | |
5019 | ||
5020 | ||
5021 | (defun ebnf-eps-output (&rest args) | |
5022 | (while args | |
5023 | (insert (car args)) | |
5024 | (setq args (cdr args)))) | |
5025 | ||
5026 | ||
5027 | (defun ebnf-generate-region (from to gen-func) | |
5028 | (run-hooks 'ebnf-hook) | |
5029 | (let ((ebnf-limit (max from to)) | |
ac4780a1 | 5030 | (error-msg "SYNTAX") |
984ae001 GM |
5031 | the-point) |
5032 | (save-excursion | |
5033 | (save-restriction | |
5034 | (save-match-data | |
5035 | (condition-case data | |
5036 | (let ((tree (ebnf-parse-and-sort (min from to)))) | |
5037 | (when gen-func | |
ac4780a1 VJL |
5038 | (setq error-msg "EMPTY RULES" |
5039 | tree (ebnf-eliminate-empty-rules tree)) | |
09e80d9f | 5040 | (setq error-msg "OPTIMIZE" |
ac4780a1 VJL |
5041 | tree (ebnf-optimize tree)) |
5042 | (setq error-msg "DIMENSIONS" | |
5043 | tree (ebnf-dimensions tree)) | |
5044 | (setq error-msg "GENERATION") | |
5045 | (funcall gen-func tree)) | |
5046 | (setq error-msg nil)) ; here it's ok | |
984ae001 GM |
5047 | ;; handler |
5048 | ((quit error) | |
5049 | (ding) | |
ac4780a1 VJL |
5050 | (setq the-point (max (1- (point)) (point-min)) |
5051 | error-msg (concat error-msg ": " | |
5052 | (error-message-string data) | |
ea946fcc VJL |
5053 | ", " |
5054 | (and (string= error-msg "SYNTAX") | |
5055 | (format "at position %d " | |
5056 | the-point)) | |
5057 | (format "in buffer \"%s\"." | |
5058 | (buffer-name))))))))) | |
984ae001 | 5059 | (cond |
ac4780a1 VJL |
5060 | ;; error occurred |
5061 | (error-msg | |
5062 | (goto-char the-point) | |
5063 | (if ebnf-stop-on-error | |
5064 | (error error-msg) | |
29a4e67d | 5065 | (message "%s" error-msg))) |
ac4780a1 | 5066 | ;; generated output OK |
984ae001 GM |
5067 | (gen-func |
5068 | nil) | |
ac4780a1 | 5069 | ;; syntax checked OK |
984ae001 | 5070 | (t |
ab3256ed | 5071 | (message "EBNF syntactic analysis: NO ERRORS."))))) |
984ae001 GM |
5072 | |
5073 | ||
5074 | (defun ebnf-parse-and-sort (start) | |
3ced5caa | 5075 | (ebnf-log "(ebnf-parse-and-sort %S)" start) |
984ae001 GM |
5076 | (ebnf-begin-job) |
5077 | (let ((tree (funcall ebnf-parser-func start))) | |
5078 | (if ebnf-sort-production | |
5079 | (progn | |
5080 | (message "Sorting...") | |
5081 | (sort tree | |
5082 | (if (eq ebnf-sort-production 'ascending) | |
5083 | 'ebnf-sorter-ascending | |
5084 | 'ebnf-sorter-descending))) | |
5085 | (nreverse tree)))) | |
5086 | ||
5087 | ||
5088 | (defun ebnf-sorter-ascending (first second) | |
5089 | (string< (ebnf-node-name first) | |
5090 | (ebnf-node-name second))) | |
5091 | ||
5092 | ||
5093 | (defun ebnf-sorter-descending (first second) | |
5094 | (string< (ebnf-node-name second) | |
5095 | (ebnf-node-name first))) | |
5096 | ||
5097 | ||
5098 | (defun ebnf-empty-alternative (width) | |
5099 | (ps-output (ebnf-format-float width) " EA\n")) | |
5100 | ||
5101 | ||
5102 | (defun ebnf-vertical-movement (height) | |
5103 | (ps-output (ebnf-format-float height) " vm\n")) | |
5104 | ||
5105 | ||
5106 | (defun ebnf-horizontal-movement (width) | |
5107 | (ps-output (ebnf-format-float width) " hm\n")) | |
5108 | ||
5109 | ||
5110 | (defun ebnf-entry (height) | |
5111 | (* height ebnf-entry-percentage)) | |
5112 | ||
5113 | ||
5114 | (defun ebnf-eop-vertical (height) | |
5115 | (ps-output (ebnf-format-float (+ height ebnf-production-vertical-space)) | |
5116 | " EOPV\n\n")) | |
5117 | ||
5118 | ||
5119 | (defun ebnf-eop-horizontal (width) | |
5120 | (ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space)) | |
5121 | " EOPH\n\n")) | |
5122 | ||
5123 | ||
5124 | (defun ebnf-new-page () | |
5125 | (when (< ps-height-remaining ps-print-height) | |
5126 | (run-hooks 'ebnf-page-hook) | |
5127 | (ps-next-page) | |
5128 | (ps-output "\n"))) | |
5129 | ||
5130 | ||
5131 | (defsubst ebnf-font-size (font) (nth 0 font)) | |
5132 | (defsubst ebnf-font-name (font) (nth 1 font)) | |
5133 | (defsubst ebnf-font-foreground (font) (nth 2 font)) | |
5134 | (defsubst ebnf-font-background (font) (nth 3 font)) | |
5135 | (defsubst ebnf-font-list (font) (nthcdr 4 font)) | |
5136 | (defsubst ebnf-font-attributes (font) | |
5137 | (lsh (ps-extension-bit (cdr font)) -2)) | |
5138 | ||
5139 | ||
5140 | (defconst ebnf-font-name-select | |
5141 | (vector 'normal 'bold 'italic 'bold-italic)) | |
5142 | ||
5143 | ||
5144 | (defun ebnf-font-name-select (font) | |
5145 | (let* ((font-list (ebnf-font-list font)) | |
5146 | (font-index (+ (if (memq 'bold font-list) 1 0) | |
5147 | (if (memq 'italic font-list) 2 0))) | |
5148 | (name (ebnf-font-name font)) | |
5149 | (database (cdr (assoc name ps-font-info-database))) | |
5150 | (info-list (or (cdr (assoc 'fonts database)) | |
5151 | (error "Invalid font: %s" name)))) | |
5152 | (or (cdr (assoc (aref ebnf-font-name-select font-index) | |
5153 | info-list)) | |
5154 | (error "Invalid attributes for font %s" name)))) | |
5155 | ||
5156 | ||
5157 | (defun ebnf-font-select (font select) | |
5158 | (let* ((name (ebnf-font-name font)) | |
5159 | (database (cdr (assoc name ps-font-info-database))) | |
5160 | (size (cdr (assoc 'size database))) | |
5161 | (base (cdr (assoc select database)))) | |
5162 | (if (and size base) | |
5163 | (/ (* (ebnf-font-size font) base) | |
5164 | size) | |
5165 | (error "Invalid font: %s" name)))) | |
5166 | ||
5167 | ||
5168 | (defsubst ebnf-font-width (font) | |
5169 | (ebnf-font-select font 'avg-char-width)) | |
5170 | (defsubst ebnf-font-height (font) | |
5171 | (ebnf-font-select font 'line-height)) | |
5172 | ||
5173 | ||
ac4780a1 VJL |
5174 | (defconst ebnf-syntax-alist |
5175 | ;; 0.syntax 1.parser 2.initializer | |
5176 | '((iso-ebnf ebnf-iso-parser ebnf-iso-initialize) | |
5177 | (yacc ebnf-yac-parser ebnf-yac-initialize) | |
5178 | (abnf ebnf-abn-parser ebnf-abn-initialize) | |
6ca94f87 | 5179 | (ebnf ebnf-bnf-parser ebnf-bnf-initialize) |
6411a60a VJL |
5180 | (ebnfx ebnf-ebx-parser ebnf-ebx-initialize) |
5181 | (dtd ebnf-dtd-parser ebnf-dtd-initialize)) | |
4303661c | 5182 | "Alist associating EBNF syntax with a parser and an initializer.") |
ac4780a1 VJL |
5183 | |
5184 | ||
984ae001 | 5185 | (defun ebnf-begin-job () |
ae6f46f9 | 5186 | (ps-printing-region nil nil nil) |
984ae001 GM |
5187 | (if ebnf-use-float-format |
5188 | (setq ebnf-format-float "%1.3f" | |
5189 | ebnf-message-float "%3.2f") | |
5190 | (setq ebnf-format-float "%s" | |
5191 | ebnf-message-float "%s")) | |
5192 | (ebnf-otz-initialize) | |
5193 | ;; to avoid compilation gripes when calling autoloaded functions | |
ac4780a1 VJL |
5194 | (let ((init (or (assoc ebnf-syntax ebnf-syntax-alist) |
5195 | (assoc 'ebnf ebnf-syntax-alist)))) | |
5196 | (setq ebnf-parser-func (nth 1 init)) | |
5197 | (funcall (nth 2 init))) | |
984ae001 GM |
5198 | (and ebnf-terminal-regexp ; ensures that it's a string or nil |
5199 | (not (stringp ebnf-terminal-regexp)) | |
5200 | (setq ebnf-terminal-regexp nil)) | |
5201 | (or (and ebnf-eps-prefix ; ensures that it's a string | |
5202 | (stringp ebnf-eps-prefix)) | |
5203 | (setq ebnf-eps-prefix "ebnf--")) | |
5204 | (setq ebnf-entry-percentage ; ensures value between 0.0 and 1.0 | |
5205 | (min (max ebnf-entry-percentage 0.0) 1.0) | |
5206 | ebnf-action-list (if ebnf-horizontal-orientation | |
5207 | '(nil keep-line) | |
5208 | '(keep-line)) | |
5209 | ebnf-settings nil | |
5210 | ebnf-fonts-required nil | |
5211 | ebnf-action nil | |
5212 | ebnf-default-p nil | |
5213 | ebnf-eps-context nil | |
3ced5caa | 5214 | ebnf-eps-file-alist nil |
984ae001 | 5215 | ebnf-eps-production-list nil |
3ced5caa VJL |
5216 | ebnf-eps-header-comment nil |
5217 | ebnf-eps-footer-comment nil | |
984ae001 GM |
5218 | ebnf-eps-upper-x 0.0 |
5219 | ebnf-eps-upper-y 0.0 | |
5220 | ebnf-font-height-P (ebnf-font-height ebnf-production-font) | |
5221 | ebnf-font-height-T (ebnf-font-height ebnf-terminal-font) | |
5222 | ebnf-font-height-NT (ebnf-font-height ebnf-non-terminal-font) | |
5223 | ebnf-font-height-S (ebnf-font-height ebnf-special-font) | |
5224 | ebnf-font-height-E (ebnf-font-height ebnf-except-font) | |
5225 | ebnf-font-height-R (ebnf-font-height ebnf-repeat-font) | |
5226 | ebnf-font-width-P (ebnf-font-width ebnf-production-font) | |
5227 | ebnf-font-width-T (ebnf-font-width ebnf-terminal-font) | |
5228 | ebnf-font-width-NT (ebnf-font-width ebnf-non-terminal-font) | |
5229 | ebnf-font-width-S (ebnf-font-width ebnf-special-font) | |
5230 | ebnf-font-width-E (ebnf-font-width ebnf-except-font) | |
5231 | ebnf-font-width-R (ebnf-font-width ebnf-repeat-font) | |
5232 | ebnf-space-T (* ebnf-font-height-T 0.5) | |
5233 | ebnf-space-NT (* ebnf-font-height-NT 0.5) | |
5234 | ebnf-space-S (* ebnf-font-height-S 0.5) | |
5235 | ebnf-space-E (* ebnf-font-height-E 0.5) | |
5236 | ebnf-space-R (* ebnf-font-height-R 0.5)) | |
5237 | (let ((basic (+ ebnf-font-height-T ebnf-font-height-NT))) | |
3ced5caa VJL |
5238 | (setq ebnf-basic-width (* basic 0.5) |
5239 | ebnf-horizontal-space (+ basic basic) | |
5240 | ebnf-basic-empty-height (* ebnf-basic-width 0.5) | |
5241 | ebnf-basic-height ebnf-basic-width | |
5242 | ebnf-vertical-space ebnf-basic-width | |
5243 | ebnf-basic-width-extra (- ebnf-basic-width | |
5244 | ebnf-arrow-extra-width | |
5245 | 0.1)) ; error factor | |
984ae001 GM |
5246 | ;; ensures value is greater than zero |
5247 | (or (and (numberp ebnf-production-horizontal-space) | |
5248 | (> ebnf-production-horizontal-space 0.0)) | |
5249 | (setq ebnf-production-horizontal-space basic)) | |
5250 | ;; ensures value is greater than zero | |
5251 | (or (and (numberp ebnf-production-vertical-space) | |
5252 | (> ebnf-production-vertical-space 0.0)) | |
3ced5caa VJL |
5253 | (setq ebnf-production-vertical-space basic))) |
5254 | (ebnf-log "(ebnf-begin-job)") | |
5255 | (ebnf-log " ebnf-arrow-extra-width ............ : %7.3f" ebnf-arrow-extra-width) | |
5256 | (ebnf-log " ebnf-arrow-scale .................. : %7.3f" ebnf-arrow-scale) | |
5257 | (ebnf-log " ebnf-basic-width-extra ............ : %7.3f" ebnf-basic-width-extra) | |
5258 | (ebnf-log " ebnf-basic-width .................. : %7.3f (T)" ebnf-basic-width) | |
5259 | (ebnf-log " ebnf-horizontal-space ............. : %7.3f (4T)" ebnf-horizontal-space) | |
5260 | (ebnf-log " ebnf-basic-empty-height ........... : %7.3f (hT)" ebnf-basic-empty-height) | |
5261 | (ebnf-log " ebnf-basic-height ................. : %7.3f (T)" ebnf-basic-height) | |
5262 | (ebnf-log " ebnf-vertical-space ............... : %7.3f (T)" ebnf-vertical-space) | |
5263 | (ebnf-log " ebnf-production-horizontal-space .. : %7.3f (2T)" ebnf-production-horizontal-space) | |
5264 | (ebnf-log " ebnf-production-vertical-space .... : %7.3f (2T)" ebnf-production-vertical-space)) | |
984ae001 GM |
5265 | |
5266 | ||
5267 | (defsubst ebnf-shape-value (sym alist) | |
5268 | (or (cdr (assq sym alist)) 0)) | |
5269 | ||
5270 | ||
5271 | (defsubst ebnf-boolean (value) | |
5272 | (if value "true" "false")) | |
5273 | ||
5274 | ||
5275 | (defun ebnf-begin-file () | |
5276 | (ps-flush-output) | |
9a529312 | 5277 | (with-current-buffer ps-spool-buffer |
984ae001 GM |
5278 | (goto-char (point-min)) |
5279 | (and (search-forward "%%Creator: " nil t) | |
5280 | (not (search-forward "& ebnf2ps v" | |
5ed619e0 | 5281 | (line-end-position) |
984ae001 GM |
5282 | t)) |
5283 | (progn | |
5284 | ;; adjust creator comment | |
5285 | (end-of-line) | |
3ced5caa | 5286 | ;; (backward-char) |
984ae001 GM |
5287 | (insert " & ebnf2ps v" ebnf-version) |
5288 | ;; insert ebnf settings & engine | |
5289 | (goto-char (point-max)) | |
0b5ecd6d | 5290 | (search-backward "\n%%EndProlog\n") |
984ae001 GM |
5291 | (ebnf-insert-ebnf-prologue) |
5292 | (ps-output "\n"))))) | |
5293 | ||
5294 | ||
5295 | (defun ebnf-eps-finish-and-write (buffer filename) | |
1ede99a8 | 5296 | (when (buffer-modified-p buffer) |
9a529312 | 5297 | (with-current-buffer buffer |
3ced5caa | 5298 | (ebnf-eps-header-footer-set filename) |
1ede99a8 VJL |
5299 | (setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width) |
5300 | ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y) | |
5301 | ebnf-eps-max-height | |
5302 | (+ ebnf-eps-upper-y | |
5303 | ebnf-production-vertical-space | |
5304 | ebnf-eps-max-height))) | |
5305 | ;; prologue | |
5306 | (goto-char (point-min)) | |
5307 | (insert | |
5308 | "%!PS-Adobe-3.0 EPSF-3.0" | |
5309 | "\n%%BoundingBox: 0 0 " | |
5310 | (format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y)) | |
5311 | "\n%%Title: " filename | |
5312 | "\n%%CreationDate: " (format-time-string "%T %b %d %Y") | |
5313 | "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")" | |
5314 | "\n%%DocumentNeededResources: font " | |
5315 | (or ebnf-fonts-required | |
5316 | (setq ebnf-fonts-required | |
5317 | (mapconcat 'identity | |
5318 | (ps-remove-duplicates | |
5319 | (mapcar 'ebnf-font-name-select | |
5320 | (list ebnf-production-font | |
5321 | ebnf-terminal-font | |
5322 | ebnf-non-terminal-font | |
5323 | ebnf-special-font | |
5324 | ebnf-except-font | |
3ced5caa VJL |
5325 | ebnf-repeat-font |
5326 | ebnf-eps-header-font | |
5327 | ebnf-eps-footer-font))) | |
1ede99a8 VJL |
5328 | "\n%%+ font "))) |
5329 | "\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n" | |
5330 | ebnf-eps-prologue) | |
5331 | (ebnf-insert-ebnf-prologue) | |
5332 | (insert ebnf-eps-begin | |
5333 | "\n0 " (ebnf-format-float | |
5334 | (- ebnf-eps-upper-y (* ebnf-font-height-P 0.7))) | |
5335 | " #ebnf2ps#begin\n") | |
5336 | ;; epilogue | |
5337 | (goto-char (point-max)) | |
5338 | (insert ebnf-eps-end) | |
5339 | ;; write file | |
5340 | (message "Saving...") | |
5341 | (setq filename (expand-file-name filename)) | |
5342 | (let ((coding-system-for-write 'raw-text-unix)) | |
5343 | (write-region (point-min) (point-max) filename)) | |
5344 | (message "Wrote %s" filename)))) | |
984ae001 GM |
5345 | |
5346 | ||
5347 | (defun ebnf-insert-ebnf-prologue () | |
5348 | (insert | |
5349 | (or ebnf-settings | |
5350 | (setq ebnf-settings | |
5351 | (concat | |
5352 | "\n\n% === begin EBNF settings\n\n" | |
3ced5caa VJL |
5353 | (format "/Header %s def\n" |
5354 | (or ebnf-eps-header-comment "()")) | |
5355 | (format "/Footer %s def\n" | |
5356 | (or ebnf-eps-footer-comment "()")) | |
5357 | ;; header | |
5358 | (format "/ShowHeader %s def\n" | |
5359 | (ebnf-boolean | |
5360 | (ebnf-eps-header-footer-p ebnf-eps-header))) | |
5361 | (format "/fH %s /%s DefFont\n" | |
5362 | (ebnf-format-float | |
5363 | (ebnf-font-size ebnf-eps-header-font)) | |
5364 | (ebnf-font-name-select ebnf-eps-header-font)) | |
5365 | (ebnf-format-color "/ForegroundH %s def %% %s\n" | |
5366 | (ebnf-font-foreground ebnf-eps-header-font) | |
5367 | "Black") | |
5368 | (ebnf-format-color "/BackgroundH %s def %% %s\n" | |
5369 | (ebnf-font-background ebnf-eps-header-font) | |
5370 | "White") | |
5371 | (format "/EffectH %d def\n" | |
5372 | (ebnf-font-attributes ebnf-eps-header-font)) | |
5373 | ;; footer | |
5374 | (format "/ShowFooter %s def\n" | |
5375 | (ebnf-boolean | |
5376 | (ebnf-eps-header-footer-p ebnf-eps-footer))) | |
5377 | (format "/fF %s /%s DefFont\n" | |
5378 | (ebnf-format-float | |
5379 | (ebnf-font-size ebnf-eps-footer-font)) | |
5380 | (ebnf-font-name-select ebnf-eps-footer-font)) | |
5381 | (ebnf-format-color "/ForegroundF %s def %% %s\n" | |
5382 | (ebnf-font-foreground ebnf-eps-footer-font) | |
5383 | "Black") | |
5384 | (ebnf-format-color "/BackgroundF %s def %% %s\n" | |
5385 | (ebnf-font-background ebnf-eps-footer-font) | |
5386 | "White") | |
5387 | (format "/EffectF %d def\n" | |
5388 | (ebnf-font-attributes ebnf-eps-footer-font)) | |
984ae001 GM |
5389 | ;; production |
5390 | (format "/fP %s /%s DefFont\n" | |
5391 | (ebnf-format-float (ebnf-font-size ebnf-production-font)) | |
5392 | (ebnf-font-name-select ebnf-production-font)) | |
5393 | (ebnf-format-color "/ForegroundP %s def %% %s\n" | |
5394 | (ebnf-font-foreground ebnf-production-font) | |
5395 | "Black") | |
5396 | (ebnf-format-color "/BackgroundP %s def %% %s\n" | |
5397 | (ebnf-font-background ebnf-production-font) | |
5398 | "White") | |
5399 | (format "/EffectP %d def\n" | |
5400 | (ebnf-font-attributes ebnf-production-font)) | |
5401 | ;; terminal | |
5402 | (format "/fT %s /%s DefFont\n" | |
5403 | (ebnf-format-float (ebnf-font-size ebnf-terminal-font)) | |
5404 | (ebnf-font-name-select ebnf-terminal-font)) | |
5405 | (ebnf-format-color "/ForegroundT %s def %% %s\n" | |
5406 | (ebnf-font-foreground ebnf-terminal-font) | |
5407 | "Black") | |
5408 | (ebnf-format-color "/BackgroundT %s def %% %s\n" | |
5409 | (ebnf-font-background ebnf-terminal-font) | |
5410 | "White") | |
5411 | (format "/EffectT %d def\n" | |
5412 | (ebnf-font-attributes ebnf-terminal-font)) | |
5413 | (format "/BorderWidthT %s def\n" | |
5414 | (ebnf-format-float ebnf-terminal-border-width)) | |
5415 | (ebnf-format-color "/BorderColorT %s def %% %s\n" | |
5416 | ebnf-terminal-border-color | |
5417 | "Black") | |
5418 | (format "/ShapeT %d def\n" | |
5419 | (ebnf-shape-value ebnf-terminal-shape | |
5420 | ebnf-terminal-shape-alist)) | |
5421 | (format "/ShadowT %s def\n" | |
5422 | (ebnf-boolean ebnf-terminal-shadow)) | |
5423 | ;; non-terminal | |
5424 | (format "/fNT %s /%s DefFont\n" | |
5425 | (ebnf-format-float | |
5426 | (ebnf-font-size ebnf-non-terminal-font)) | |
5427 | (ebnf-font-name-select ebnf-non-terminal-font)) | |
5428 | (ebnf-format-color "/ForegroundNT %s def %% %s\n" | |
5429 | (ebnf-font-foreground ebnf-non-terminal-font) | |
5430 | "Black") | |
5431 | (ebnf-format-color "/BackgroundNT %s def %% %s\n" | |
5432 | (ebnf-font-background ebnf-non-terminal-font) | |
5433 | "White") | |
5434 | (format "/EffectNT %d def\n" | |
5435 | (ebnf-font-attributes ebnf-non-terminal-font)) | |
5436 | (format "/BorderWidthNT %s def\n" | |
5437 | (ebnf-format-float ebnf-non-terminal-border-width)) | |
5438 | (ebnf-format-color "/BorderColorNT %s def %% %s\n" | |
5439 | ebnf-non-terminal-border-color | |
5440 | "Black") | |
5441 | (format "/ShapeNT %d def\n" | |
5442 | (ebnf-shape-value ebnf-non-terminal-shape | |
5443 | ebnf-terminal-shape-alist)) | |
5444 | (format "/ShadowNT %s def\n" | |
5445 | (ebnf-boolean ebnf-non-terminal-shadow)) | |
5446 | ;; special | |
5447 | (format "/fS %s /%s DefFont\n" | |
5448 | (ebnf-format-float (ebnf-font-size ebnf-special-font)) | |
5449 | (ebnf-font-name-select ebnf-special-font)) | |
5450 | (ebnf-format-color "/ForegroundS %s def %% %s\n" | |
5451 | (ebnf-font-foreground ebnf-special-font) | |
5452 | "Black") | |
5453 | (ebnf-format-color "/BackgroundS %s def %% %s\n" | |
5454 | (ebnf-font-background ebnf-special-font) | |
5455 | "Gray95") | |
5456 | (format "/EffectS %d def\n" | |
5457 | (ebnf-font-attributes ebnf-special-font)) | |
5458 | (format "/BorderWidthS %s def\n" | |
5459 | (ebnf-format-float ebnf-special-border-width)) | |
5460 | (ebnf-format-color "/BorderColorS %s def %% %s\n" | |
5461 | ebnf-special-border-color | |
5462 | "Black") | |
5463 | (format "/ShapeS %d def\n" | |
5464 | (ebnf-shape-value ebnf-special-shape | |
5465 | ebnf-terminal-shape-alist)) | |
5466 | (format "/ShadowS %s def\n" | |
5467 | (ebnf-boolean ebnf-special-shadow)) | |
5468 | ;; except | |
5469 | (format "/fE %s /%s DefFont\n" | |
5470 | (ebnf-format-float (ebnf-font-size ebnf-except-font)) | |
5471 | (ebnf-font-name-select ebnf-except-font)) | |
5472 | (ebnf-format-color "/ForegroundE %s def %% %s\n" | |
5473 | (ebnf-font-foreground ebnf-except-font) | |
5474 | "Black") | |
5475 | (ebnf-format-color "/BackgroundE %s def %% %s\n" | |
5476 | (ebnf-font-background ebnf-except-font) | |
5477 | "Gray90") | |
5478 | (format "/EffectE %d def\n" | |
5479 | (ebnf-font-attributes ebnf-except-font)) | |
5480 | (format "/BorderWidthE %s def\n" | |
5481 | (ebnf-format-float ebnf-except-border-width)) | |
5482 | (ebnf-format-color "/BorderColorE %s def %% %s\n" | |
5483 | ebnf-except-border-color | |
5484 | "Black") | |
5485 | (format "/ShapeE %d def\n" | |
5486 | (ebnf-shape-value ebnf-except-shape | |
5487 | ebnf-terminal-shape-alist)) | |
5488 | (format "/ShadowE %s def\n" | |
5489 | (ebnf-boolean ebnf-except-shadow)) | |
5490 | ;; repeat | |
5491 | (format "/fR %s /%s DefFont\n" | |
5492 | (ebnf-format-float (ebnf-font-size ebnf-repeat-font)) | |
5493 | (ebnf-font-name-select ebnf-repeat-font)) | |
5494 | (ebnf-format-color "/ForegroundR %s def %% %s\n" | |
5495 | (ebnf-font-foreground ebnf-repeat-font) | |
5496 | "Black") | |
5497 | (ebnf-format-color "/BackgroundR %s def %% %s\n" | |
5498 | (ebnf-font-background ebnf-repeat-font) | |
5499 | "Gray85") | |
5500 | (format "/EffectR %d def\n" | |
5501 | (ebnf-font-attributes ebnf-repeat-font)) | |
5502 | (format "/BorderWidthR %s def\n" | |
5503 | (ebnf-format-float ebnf-repeat-border-width)) | |
5504 | (ebnf-format-color "/BorderColorR %s def %% %s\n" | |
5505 | ebnf-repeat-border-color | |
5506 | "Black") | |
5507 | (format "/ShapeR %d def\n" | |
5508 | (ebnf-shape-value ebnf-repeat-shape | |
5509 | ebnf-terminal-shape-alist)) | |
5510 | (format "/ShadowR %s def\n" | |
5511 | (ebnf-boolean ebnf-repeat-shadow)) | |
5512 | ;; miscellaneous | |
ed0aa46c VJL |
5513 | (format "/ExtraWidth %s def\n" |
5514 | (ebnf-format-float ebnf-arrow-extra-width)) | |
5515 | (format "/ArrowScale %s def\n" | |
5516 | (ebnf-format-float ebnf-arrow-scale)) | |
984ae001 GM |
5517 | (format "/DefaultWidth %s def\n" |
5518 | (ebnf-format-float ebnf-default-width)) | |
5519 | (format "/LineWidth %s def\n" | |
5520 | (ebnf-format-float ebnf-line-width)) | |
5521 | (ebnf-format-color "/LineColor %s def %% %s\n" | |
5522 | ebnf-line-color | |
5523 | "Black") | |
5524 | (format "/ArrowShape %d def\n" | |
5525 | (ebnf-shape-value ebnf-arrow-shape | |
5526 | ebnf-arrow-shape-alist)) | |
5527 | (format "/ChartShape %d def\n" | |
5528 | (ebnf-shape-value ebnf-chart-shape | |
5529 | ebnf-terminal-shape-alist)) | |
5530 | (format "/UserArrow{%s}def\n" | |
bf061ba6 GM |
5531 | (let ((arrow (eval ebnf-user-arrow))) |
5532 | (if (stringp arrow) | |
5533 | arrow | |
5534 | ""))) | |
984ae001 GM |
5535 | "\n% === end EBNF settings\n\n" |
5536 | (and ebnf-debug-ps ebnf-debug)))) | |
5537 | ebnf-prologue)) | |
5538 | ||
984ae001 GM |
5539 | \f |
5540 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
5541 | ;; Adjusting dimensions | |
5542 | ||
5543 | ||
5544 | (defun ebnf-dimensions (tree) | |
3ced5caa | 5545 | (ebnf-log "(ebnf-dimensions tree)") |
984ae001 GM |
5546 | (let ((ebnf-total (length tree)) |
5547 | (ebnf-nprod 0)) | |
a6d6a87a | 5548 | (mapc 'ebnf-production-dimension tree)) |
984ae001 GM |
5549 | tree) |
5550 | ||
5551 | ||
5552 | ;; [empty width-fun dim-fun entry height width] | |
5553 | ;;(defun ebnf-empty-dimension (empty) | |
5554 | ;; ) | |
5555 | ||
5556 | ||
5557 | ;; [production width-fun dim-fun entry height width name production action] | |
5558 | (defun ebnf-production-dimension (production) | |
3ced5caa | 5559 | (ebnf-log "(ebnf-production-dimension production)") |
984ae001 GM |
5560 | (ebnf-message-info "Calculating dimensions") |
5561 | (ebnf-node-dimension-func (ebnf-node-production production)) | |
5562 | (let* ((prod (ebnf-node-production production)) | |
ac4780a1 VJL |
5563 | (height (+ (if ebnf-production-name-p |
5564 | ebnf-font-height-P | |
5565 | 0.0) | |
5566 | ebnf-line-width ebnf-line-width | |
984ae001 GM |
5567 | ebnf-basic-height |
5568 | (ebnf-node-height prod)))) | |
5569 | (ebnf-node-entry production height) | |
5570 | (ebnf-node-height production height) | |
5571 | (ebnf-node-width production (+ (ebnf-node-width prod) | |
ac4780a1 | 5572 | ebnf-line-width |
3ced5caa VJL |
5573 | ebnf-horizontal-space |
5574 | ebnf-basic-width-extra))) | |
5575 | (ebnf-log " production name : %S" (ebnf-node-name production)) | |
5576 | (ebnf-log " production entry : %7.3f" (ebnf-node-entry production)) | |
5577 | (ebnf-log " production height : %7.3f" (ebnf-node-height production)) | |
5578 | (ebnf-log " production width : %7.3f" (ebnf-node-width production))) | |
984ae001 GM |
5579 | |
5580 | ||
5581 | ;; [terminal width-fun dim-fun entry height width name] | |
5582 | (defun ebnf-terminal-dimension (terminal) | |
3ced5caa | 5583 | (ebnf-log "(ebnf-terminal-dimension terminal)") |
984ae001 GM |
5584 | (ebnf-terminal-dimension1 terminal |
5585 | ebnf-font-height-T | |
5586 | ebnf-font-width-T | |
5587 | ebnf-space-T)) | |
5588 | ||
5589 | ||
5590 | ;; [non-terminal width-fun dim-fun entry height width name] | |
5591 | (defun ebnf-non-terminal-dimension (non-terminal) | |
3ced5caa | 5592 | (ebnf-log "(ebnf-non-terminal-dimension non-terminal)") |
984ae001 GM |
5593 | (ebnf-terminal-dimension1 non-terminal |
5594 | ebnf-font-height-NT | |
5595 | ebnf-font-width-NT | |
5596 | ebnf-space-NT)) | |
5597 | ||
5598 | ||
5599 | ;; [special width-fun dim-fun entry height width name] | |
5600 | (defun ebnf-special-dimension (special) | |
3ced5caa | 5601 | (ebnf-log "(ebnf-special-dimension special)") |
984ae001 GM |
5602 | (ebnf-terminal-dimension1 special |
5603 | ebnf-font-height-S | |
5604 | ebnf-font-width-S | |
5605 | ebnf-space-S)) | |
5606 | ||
5607 | ||
5608 | (defun ebnf-terminal-dimension1 (node font-height font-width space) | |
5609 | (let ((height (+ space font-height space)) | |
5610 | (len (length (ebnf-node-name node)))) | |
5611 | (ebnf-node-entry node (* height 0.5)) | |
5612 | (ebnf-node-height node height) | |
3ced5caa VJL |
5613 | (ebnf-node-width node (+ ebnf-basic-width |
5614 | ebnf-arrow-extra-width | |
5615 | space | |
984ae001 | 5616 | (* len font-width) |
3ced5caa VJL |
5617 | space |
5618 | ebnf-basic-width))) | |
5619 | (ebnf-log " name : %S" (ebnf-node-name node)) | |
5620 | (ebnf-log " entry : %7.3f" (ebnf-node-entry node)) | |
5621 | (ebnf-log " height : %7.3f" (ebnf-node-height node)) | |
5622 | (ebnf-log " width : %7.3f" (ebnf-node-width node))) | |
984ae001 GM |
5623 | |
5624 | ||
5625 | (defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0)) | |
5626 | ||
5627 | ||
5628 | ;; [repeat width-fun dim-fun entry height width times element] | |
5629 | (defun ebnf-repeat-dimension (repeat) | |
3ced5caa | 5630 | (ebnf-log "(ebnf-repeat-dimension repeat)") |
984ae001 GM |
5631 | (let ((times (ebnf-node-name repeat)) |
5632 | (element (ebnf-node-separator repeat))) | |
5633 | (if element | |
5634 | (ebnf-node-dimension-func element) | |
5635 | (setq element ebnf-null-vector)) | |
5636 | (ebnf-node-entry repeat (+ (ebnf-node-entry element) | |
5637 | ebnf-space-R)) | |
5638 | (ebnf-node-height repeat (+ (max (ebnf-node-height element) | |
5639 | ebnf-font-height-S) | |
5640 | ebnf-space-R ebnf-space-R)) | |
5641 | (ebnf-node-width repeat (+ (ebnf-node-width element) | |
ed0aa46c | 5642 | ebnf-arrow-extra-width |
984ae001 GM |
5643 | ebnf-space-R ebnf-space-R ebnf-space-R |
5644 | ebnf-horizontal-space | |
3ced5caa VJL |
5645 | (* (length times) ebnf-font-width-R)))) |
5646 | (ebnf-log " repeat entry : %7.3f" (ebnf-node-entry repeat)) | |
5647 | (ebnf-log " repeat height : %7.3f" (ebnf-node-height repeat)) | |
5648 | (ebnf-log " repeat width : %7.3f" (ebnf-node-width repeat))) | |
984ae001 GM |
5649 | |
5650 | ||
5651 | ;; [except width-fun dim-fun entry height width element element] | |
5652 | (defun ebnf-except-dimension (except) | |
3ced5caa | 5653 | (ebnf-log "(ebnf-except-dimension except)") |
984ae001 GM |
5654 | (let ((factor (ebnf-node-list except)) |
5655 | (element (ebnf-node-separator except))) | |
5656 | (ebnf-node-dimension-func factor) | |
5657 | (if element | |
5658 | (ebnf-node-dimension-func element) | |
5659 | (setq element ebnf-null-vector)) | |
5660 | (ebnf-node-entry except (+ (max (ebnf-node-entry factor) | |
5661 | (ebnf-node-entry element)) | |
5662 | ebnf-space-E)) | |
5663 | (ebnf-node-height except (+ (max (ebnf-node-height factor) | |
5664 | (ebnf-node-height element)) | |
5665 | ebnf-space-E ebnf-space-E)) | |
5666 | (ebnf-node-width except (+ (ebnf-node-width factor) | |
5667 | (ebnf-node-width element) | |
ed0aa46c | 5668 | ebnf-arrow-extra-width |
984ae001 GM |
5669 | ebnf-space-E ebnf-space-E |
5670 | ebnf-space-E ebnf-space-E | |
5671 | ebnf-font-width-E | |
3ced5caa VJL |
5672 | ebnf-horizontal-space))) |
5673 | (ebnf-log " except entry : %7.3f" (ebnf-node-entry except)) | |
5674 | (ebnf-log " except height : %7.3f" (ebnf-node-height except)) | |
5675 | (ebnf-log " except width : %7.3f" (ebnf-node-width except))) | |
984ae001 GM |
5676 | |
5677 | ||
5678 | ;; [alternative width-fun dim-fun entry height width list] | |
5679 | (defun ebnf-alternative-dimension (alternative) | |
3ced5caa | 5680 | (ebnf-log "(ebnf-alternative-dimension alternative)") |
984ae001 GM |
5681 | (let ((body (ebnf-node-list alternative)) |
5682 | (lis (ebnf-node-list alternative))) | |
5683 | (while lis | |
5684 | (ebnf-node-dimension-func (car lis)) | |
5685 | (setq lis (cdr lis))) | |
5686 | (let ((height 0.0) | |
5687 | (width 0.0) | |
5688 | (alt body) | |
5689 | (tail (car (last body))) | |
5690 | (entry (ebnf-node-entry (car body))) | |
5691 | node) | |
5692 | (while alt | |
5693 | (setq node (car alt) | |
5694 | alt (cdr alt) | |
5695 | height (+ (ebnf-node-height node) height) | |
5696 | width (max (ebnf-node-width node) width))) | |
5697 | (ebnf-adjust-width body width) | |
5698 | (setq height (+ height (* (1- (length body)) ebnf-vertical-space))) | |
5699 | (ebnf-node-entry alternative (+ entry | |
5700 | (ebnf-entry | |
5701 | (- height entry | |
5702 | (- (ebnf-node-height tail) | |
5703 | (ebnf-node-entry tail)))))) | |
5704 | (ebnf-node-height alternative height) | |
3ced5caa VJL |
5705 | (ebnf-node-width alternative (+ width |
5706 | ebnf-horizontal-space | |
5707 | ebnf-basic-width-extra)) | |
5708 | (ebnf-node-list alternative body))) | |
5709 | (ebnf-log " alternative entry : %7.3f" (ebnf-node-entry alternative)) | |
5710 | (ebnf-log " alternative height : %7.3f" (ebnf-node-height alternative)) | |
5711 | (ebnf-log " alternative width : %7.3f" (ebnf-node-width alternative))) | |
984ae001 GM |
5712 | |
5713 | ||
5714 | ;; [optional width-fun dim-fun entry height width element] | |
5715 | (defun ebnf-optional-dimension (optional) | |
3ced5caa | 5716 | (ebnf-log "(ebnf-optional-dimension optional)") |
984ae001 GM |
5717 | (let ((body (ebnf-node-list optional))) |
5718 | (ebnf-node-dimension-func body) | |
5719 | (ebnf-node-entry optional (ebnf-node-entry body)) | |
5720 | (ebnf-node-height optional (+ (ebnf-node-height body) | |
5721 | ebnf-vertical-space)) | |
5722 | (ebnf-node-width optional (+ (ebnf-node-width body) | |
3ced5caa VJL |
5723 | ebnf-horizontal-space))) |
5724 | (ebnf-log " optional entry : %7.3f" (ebnf-node-entry optional)) | |
5725 | (ebnf-log " optional height : %7.3f" (ebnf-node-height optional)) | |
5726 | (ebnf-log " optional width : %7.3f" (ebnf-node-width optional))) | |
984ae001 GM |
5727 | |
5728 | ||
5729 | ;; [one-or-more width-fun dim-fun entry height width element separator] | |
5730 | (defun ebnf-one-or-more-dimension (or-more) | |
3ced5caa | 5731 | (ebnf-log "(ebnf-one-or-more-dimension or-more)") |
984ae001 GM |
5732 | (let ((list-part (ebnf-node-list or-more)) |
5733 | (sep-part (ebnf-node-separator or-more))) | |
5734 | (ebnf-node-dimension-func list-part) | |
5735 | (and sep-part | |
5736 | (ebnf-node-dimension-func sep-part)) | |
5737 | (let ((height (+ (if sep-part | |
5738 | (ebnf-node-height sep-part) | |
3ced5caa | 5739 | ebnf-basic-empty-height) |
984ae001 GM |
5740 | ebnf-vertical-space |
5741 | (ebnf-node-height list-part))) | |
5742 | (width (max (if sep-part | |
5743 | (ebnf-node-width sep-part) | |
5744 | 0.0) | |
5745 | (ebnf-node-width list-part)))) | |
5746 | (when sep-part | |
5747 | (ebnf-adjust-width list-part width) | |
5748 | (ebnf-adjust-width sep-part width)) | |
3ced5caa VJL |
5749 | (ebnf-node-entry or-more (+ (- height |
5750 | (ebnf-node-height list-part)) | |
984ae001 GM |
5751 | (ebnf-node-entry list-part))) |
5752 | (ebnf-node-height or-more height) | |
3ced5caa VJL |
5753 | (ebnf-node-width or-more (+ width |
5754 | ebnf-horizontal-space | |
5755 | ebnf-basic-width-extra)))) | |
5756 | (ebnf-log " one-or-more entry : %7.3f" (ebnf-node-entry or-more)) | |
5757 | (ebnf-log " one-or-more height : %7.3f" (ebnf-node-height or-more)) | |
5758 | (ebnf-log " one-or-more width : %7.3f" (ebnf-node-width or-more))) | |
984ae001 GM |
5759 | |
5760 | ||
5761 | ;; [zero-or-more width-fun dim-fun entry height width element separator] | |
5762 | (defun ebnf-zero-or-more-dimension (or-more) | |
3ced5caa | 5763 | (ebnf-log "(ebnf-zero-or-more-dimension or-more)") |
984ae001 GM |
5764 | (let ((list-part (ebnf-node-list or-more)) |
5765 | (sep-part (ebnf-node-separator or-more))) | |
5766 | (ebnf-node-dimension-func list-part) | |
5767 | (and sep-part | |
5768 | (ebnf-node-dimension-func sep-part)) | |
5769 | (let ((height (+ (if sep-part | |
5770 | (ebnf-node-height sep-part) | |
3ced5caa | 5771 | ebnf-basic-empty-height) |
984ae001 GM |
5772 | ebnf-vertical-space |
5773 | (ebnf-node-height list-part) | |
5774 | ebnf-vertical-space)) | |
5775 | (width (max (if sep-part | |
5776 | (ebnf-node-width sep-part) | |
5777 | 0.0) | |
5778 | (ebnf-node-width list-part)))) | |
5779 | (when sep-part | |
5780 | (ebnf-adjust-width list-part width) | |
5781 | (ebnf-adjust-width sep-part width)) | |
5782 | (ebnf-node-entry or-more height) | |
5783 | (ebnf-node-height or-more height) | |
3ced5caa VJL |
5784 | (ebnf-node-width or-more (+ width |
5785 | ebnf-horizontal-space | |
5786 | ebnf-basic-width-extra)))) | |
5787 | (ebnf-log " zero-or-more entry : %7.3f" (ebnf-node-entry or-more)) | |
5788 | (ebnf-log " zero-or-more height : %7.3f" (ebnf-node-height or-more)) | |
5789 | (ebnf-log " zero-or-more width : %7.3f" (ebnf-node-width or-more))) | |
984ae001 GM |
5790 | |
5791 | ||
5792 | ;; [sequence width-fun dim-fun entry height width list] | |
5793 | (defun ebnf-sequence-dimension (sequence) | |
3ced5caa | 5794 | (ebnf-log "(ebnf-sequence-dimension sequence)") |
984ae001 GM |
5795 | (let ((above 0.0) |
5796 | (below 0.0) | |
5797 | (width 0.0) | |
5798 | (lis (ebnf-node-list sequence)) | |
5799 | entry node) | |
5800 | (while lis | |
5801 | (setq node (car lis) | |
5802 | lis (cdr lis)) | |
5803 | (ebnf-node-dimension-func node) | |
5804 | (setq entry (ebnf-node-entry node) | |
5805 | above (max above entry) | |
5806 | below (max below (- (ebnf-node-height node) entry)) | |
5807 | width (+ width (ebnf-node-width node)))) | |
5808 | (ebnf-node-entry sequence above) | |
5809 | (ebnf-node-height sequence (+ above below)) | |
3ced5caa VJL |
5810 | (ebnf-node-width sequence width)) |
5811 | (ebnf-log " sequence entry : %7.3f" (ebnf-node-entry sequence)) | |
5812 | (ebnf-log " sequence height : %7.3f" (ebnf-node-height sequence)) | |
5813 | (ebnf-log " sequence width : %7.3f" (ebnf-node-width sequence))) | |
984ae001 GM |
5814 | |
5815 | \f | |
5816 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
5817 | ;; Adjusting width | |
5818 | ||
5819 | ||
5820 | (defun ebnf-adjust-width (node width) | |
5821 | (cond | |
5822 | ((listp node) | |
5823 | (prog1 | |
5824 | node | |
5825 | (while node | |
5826 | (setcar node (ebnf-adjust-width (car node) width)) | |
5827 | (setq node (cdr node))))) | |
5828 | ((vectorp node) | |
5829 | (cond | |
5830 | ;; nothing to be done | |
5831 | ((= width (ebnf-node-width node)) | |
5832 | node) | |
5833 | ;; left justify term | |
5834 | ((eq ebnf-justify-sequence 'left) | |
5835 | (ebnf-adjust-empty node width nil)) | |
5836 | ;; right justify terms | |
5837 | ((eq ebnf-justify-sequence 'right) | |
5838 | (ebnf-adjust-empty node width t)) | |
5839 | ;; centralize terms | |
5840 | (t | |
5841 | (ebnf-node-width-func node width) | |
5842 | (ebnf-node-width node width) | |
5843 | node) | |
5844 | )) | |
5845 | (t | |
5846 | node) | |
5847 | )) | |
5848 | ||
5849 | ||
5850 | (defun ebnf-adjust-empty (node width last-p) | |
5851 | (if (eq (ebnf-node-kind node) 'ebnf-generate-empty) | |
5852 | (progn | |
5853 | (ebnf-node-width node width) | |
5854 | node) | |
5855 | (let ((empty (ebnf-make-empty (- width (ebnf-node-width node))))) | |
5856 | (ebnf-make-dup-sequence node | |
5857 | (if last-p | |
5858 | (list empty node) | |
5859 | (list node empty)))))) | |
5860 | ||
5861 | ||
5862 | ;; [terminal width-fun dim-fun entry height width name] | |
5863 | ;; [non-terminal width-fun dim-fun entry height width name] | |
5864 | ;; [empty width-fun dim-fun entry height width] | |
5865 | ;; [special width-fun dim-fun entry height width name] | |
5866 | ;; [repeat width-fun dim-fun entry height width times element] | |
5867 | ;; [except width-fun dim-fun entry height width element element] | |
5868 | ;;(defun ebnf-terminal-width (terminal width) | |
5869 | ;; ) | |
5870 | ||
5871 | ||
5872 | ;; [alternative width-fun dim-fun entry height width list] | |
5873 | ;; [optional width-fun dim-fun entry height width element] | |
5874 | (defun ebnf-alternative-width (alternative width) | |
5875 | (ebnf-adjust-width (ebnf-node-list alternative) | |
5876 | (- width ebnf-horizontal-space))) | |
5877 | ||
5878 | ||
5879 | ;; [one-or-more width-fun dim-fun entry height width element separator] | |
5880 | ;; [zero-or-more width-fun dim-fun entry height width element separator] | |
ac4780a1 | 5881 | (defun ebnf-element-width (or-more width) |
984ae001 GM |
5882 | (setq width (- width ebnf-horizontal-space)) |
5883 | (ebnf-node-list or-more | |
5884 | (ebnf-justify-list or-more | |
5885 | (ebnf-node-list or-more) | |
5886 | width)) | |
5887 | (ebnf-node-separator or-more | |
5888 | (ebnf-justify-list or-more | |
5889 | (ebnf-node-separator or-more) | |
5890 | width))) | |
5891 | ||
5892 | ||
5893 | ;; [sequence width-fun dim-fun entry height width list] | |
5894 | (defun ebnf-sequence-width (sequence width) | |
5895 | (ebnf-node-list sequence | |
b685181e GM |
5896 | (ebnf-justify-list sequence |
5897 | (ebnf-node-list sequence) | |
5898 | width))) | |
984ae001 GM |
5899 | |
5900 | ||
5901 | (defun ebnf-justify-list (node seq width) | |
5902 | (let ((seq-width (ebnf-node-width node))) | |
5903 | (if (= width seq-width) | |
5904 | seq | |
5905 | (cond | |
5906 | ;; left justify terms | |
5907 | ((eq ebnf-justify-sequence 'left) | |
5908 | (ebnf-justify node seq seq-width width t)) | |
5909 | ;; right justify terms | |
5910 | ((eq ebnf-justify-sequence 'right) | |
5911 | (ebnf-justify node seq seq-width width nil)) | |
ac4780a1 VJL |
5912 | ;; centralize terms -- element |
5913 | ((vectorp seq) | |
5914 | (ebnf-adjust-width seq width)) | |
5915 | ;; centralize terms -- list | |
984ae001 GM |
5916 | (t |
5917 | (let ((the-width (/ (- width seq-width) (length seq))) | |
5918 | (lis seq)) | |
5919 | (while lis | |
5920 | (ebnf-adjust-width (car lis) | |
5921 | (+ (ebnf-node-width (car lis)) | |
5922 | the-width)) | |
5923 | (setq lis (cdr lis))) | |
5924 | seq)) | |
5925 | )))) | |
5926 | ||
5927 | ||
5928 | (defun ebnf-justify (node seq seq-width width last-p) | |
5929 | (let ((term (car (if last-p (last seq) seq)))) | |
5930 | (cond | |
5931 | ;; adjust empty term | |
5932 | ((eq (ebnf-node-kind term) 'ebnf-generate-empty) | |
5933 | (ebnf-node-width term (+ (- width seq-width) | |
5934 | (ebnf-node-width term))) | |
5935 | seq) | |
5936 | ;; insert empty at end ==> left justify | |
5937 | (last-p | |
5938 | (nconc seq | |
5939 | (list (ebnf-make-empty (- width seq-width))))) | |
5940 | ;; insert empty at beginning ==> right justify | |
5941 | (t | |
5942 | (cons (ebnf-make-empty (- width seq-width)) | |
5943 | seq)) | |
5944 | ))) | |
5945 | ||
5946 | \f | |
5947 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
5948 | ;; Functions used by parsers | |
5949 | ||
5950 | ||
5951 | (defun ebnf-eps-add-context (name) | |
5952 | (let ((filename (ebnf-eps-filename name))) | |
5953 | (if (member filename ebnf-eps-context) | |
5954 | (error "Try to open an already opened EPS file: %s" filename) | |
3ced5caa VJL |
5955 | (setq ebnf-eps-context (cons filename ebnf-eps-context))) |
5956 | (ebnf-eps-header-footer-file filename))) | |
984ae001 GM |
5957 | |
5958 | ||
5959 | (defun ebnf-eps-remove-context (name) | |
5960 | (let ((filename (ebnf-eps-filename name))) | |
5961 | (if (member filename ebnf-eps-context) | |
5962 | (setq ebnf-eps-context (delete filename ebnf-eps-context)) | |
5963 | (error "Try to close a not opened EPS file: %s" filename)))) | |
5964 | ||
5965 | ||
5966 | (defun ebnf-eps-add-production (header) | |
3ced5caa VJL |
5967 | (when ebnf-eps-executing |
5968 | (if ebnf-eps-context | |
5969 | (let ((prod (assoc header ebnf-eps-production-list))) | |
5970 | (if prod | |
5971 | (setcdr prod (ebnf-dup-list | |
5972 | (append ebnf-eps-context (cdr prod)))) | |
5973 | (setq ebnf-eps-production-list | |
5974 | (cons (cons header (ebnf-dup-list ebnf-eps-context)) | |
5975 | ebnf-eps-production-list)))) | |
5976 | (ebnf-eps-header-footer-file (ebnf-eps-filename header))))) | |
984ae001 GM |
5977 | |
5978 | ||
5979 | (defun ebnf-dup-list (old) | |
5980 | (let (new) | |
5981 | (while old | |
5982 | (setq new (cons (car old) new) | |
5983 | old (cdr old))) | |
5984 | (nreverse new))) | |
5985 | ||
5986 | ||
5987 | (defun ebnf-buffer-substring (chars) | |
5988 | (buffer-substring-no-properties | |
5989 | (point) | |
5990 | (progn | |
5991 | (skip-chars-forward chars ebnf-limit) | |
5992 | (point)))) | |
5993 | ||
5994 | ||
6a5275dc GM |
5995 | ;; replace the range "\240-\377" (see `ebnf-range-regexp'). |
5996 | (defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377)) | |
5268b442 GM |
5997 | |
5998 | ||
984ae001 GM |
5999 | (defun ebnf-string (chars eos-char kind) |
6000 | (forward-char) | |
6001 | (buffer-substring-no-properties | |
6002 | (point) | |
6003 | (progn | |
5268b442 GM |
6004 | ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit) |
6005 | (skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit) | |
984ae001 | 6006 | (if (or (eobp) (/= (following-char) eos-char)) |
eac9c0ef | 6007 | (error "Invalid %s: missing `%c'" kind eos-char) |
984ae001 GM |
6008 | (forward-char) |
6009 | (1- (point)))))) | |
6010 | ||
6011 | ||
6012 | (defun ebnf-get-string () | |
6013 | (forward-char) | |
6014 | (buffer-substring-no-properties (point) (ebnf-end-of-string))) | |
6015 | ||
6016 | ||
6017 | (defun ebnf-end-of-string () | |
6018 | (let ((n 1)) | |
6019 | (while (> (logand n 1) 0) | |
6020 | (skip-chars-forward "^\"" ebnf-limit) | |
6021 | (setq n (- (skip-chars-backward "\\\\"))) | |
6022 | (goto-char (+ (point) n 1)))) | |
6023 | (if (= (preceding-char) ?\") | |
6024 | (1- (point)) | |
e8af40ee | 6025 | (error "Missing `\"'"))) |
984ae001 GM |
6026 | |
6027 | ||
6028 | (defun ebnf-trim-right (str) | |
6029 | (let* ((len (1- (length str))) | |
6030 | (index len)) | |
3ced5caa VJL |
6031 | ;; to keep compatibility with Emacs 20 & 21: |
6032 | ;; DO NOT REPLACE `?\ ' BY `?\s' | |
6033 | (while (and (> index 0) (= (aref str index) ?\ )) | |
984ae001 GM |
6034 | (setq index (1- index))) |
6035 | (if (= index len) | |
6036 | str | |
6037 | (substring str 0 (1+ index))))) | |
6038 | ||
6039 | \f | |
6040 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
6041 | ;; Vector creation | |
6042 | ||
6043 | ||
6044 | (defun ebnf-make-empty (&optional width) | |
3ced5caa VJL |
6045 | (vector 'ebnf-generate-empty ; 0 generator |
6046 | 'ignore ; 1 width fun | |
6047 | 'ignore ; 2 dimension fun | |
6048 | 0.0 ; 3 entry | |
6049 | 0.0 ; 4 height | |
6050 | (or width ebnf-horizontal-space))) ; 5 width | |
984ae001 GM |
6051 | |
6052 | ||
6053 | (defun ebnf-make-terminal (name) | |
6054 | (ebnf-make-terminal1 name | |
6055 | 'ebnf-generate-terminal | |
6056 | 'ebnf-terminal-dimension)) | |
6057 | ||
6058 | ||
6059 | (defun ebnf-make-non-terminal (name) | |
6060 | (ebnf-make-terminal1 name | |
6061 | 'ebnf-generate-non-terminal | |
6062 | 'ebnf-non-terminal-dimension)) | |
6063 | ||
6064 | ||
6065 | (defun ebnf-make-special (name) | |
6066 | (ebnf-make-terminal1 name | |
6067 | 'ebnf-generate-special | |
6068 | 'ebnf-special-dimension)) | |
6069 | ||
6070 | ||
6071 | (defun ebnf-make-terminal1 (name gen-func dim-func) | |
3ed8598c | 6072 | (vector gen-func ; 0 generator |
3ced5caa VJL |
6073 | 'ignore ; 1 width fun |
6074 | dim-func ; 2 dimension fun | |
6075 | 0.0 ; 3 entry | |
6076 | 0.0 ; 4 height | |
6077 | 0.0 ; 5 width | |
6078 | (let ((len (length name))) ; 6 name | |
ac4780a1 VJL |
6079 | (cond ((> len 3) name) |
6080 | ((= len 3) (concat name " ")) | |
6081 | ((= len 2) (concat " " name " ")) | |
6082 | ((= len 1) (concat " " name " ")) | |
6083 | (t " "))) | |
3ced5caa | 6084 | ebnf-default-p)) ; 7 is default? |
984ae001 GM |
6085 | |
6086 | ||
6087 | (defun ebnf-make-one-or-more (list-part &optional sep-part) | |
6088 | (ebnf-make-or-more1 'ebnf-generate-one-or-more | |
6089 | 'ebnf-one-or-more-dimension | |
6090 | list-part | |
6091 | sep-part)) | |
6092 | ||
6093 | ||
6094 | (defun ebnf-make-zero-or-more (list-part &optional sep-part) | |
6095 | (ebnf-make-or-more1 'ebnf-generate-zero-or-more | |
6096 | 'ebnf-zero-or-more-dimension | |
6097 | list-part | |
6098 | sep-part)) | |
6099 | ||
6100 | ||
6101 | (defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part) | |
3ced5caa VJL |
6102 | (vector gen-func ; 0 generator |
6103 | 'ebnf-element-width ; 1 width fun | |
6104 | dim-func ; 2 dimension fun | |
6105 | 0.0 ; 3 entry | |
6106 | 0.0 ; 4 height | |
6107 | 0.0 ; 5 width | |
6108 | (if (listp list-part) ; 6 element | |
984ae001 GM |
6109 | (ebnf-make-sequence list-part) |
6110 | list-part) | |
3ced5caa | 6111 | (if (and sep-part (listp sep-part)) ; 7 separator |
984ae001 GM |
6112 | (ebnf-make-sequence sep-part) |
6113 | sep-part))) | |
6114 | ||
6115 | ||
6116 | (defun ebnf-make-production (name prod action) | |
3ced5caa VJL |
6117 | (vector 'ebnf-generate-production ; 0 generator |
6118 | 'ignore ; 1 width fun | |
6119 | 'ebnf-production-dimension ; 2 dimension fun | |
6120 | 0.0 ; 3 entry | |
6121 | 0.0 ; 4 height | |
6122 | 0.0 ; 5 width | |
6123 | name ; 6 production name | |
6124 | prod ; 7 production body | |
6125 | action)) ; 8 production action | |
984ae001 GM |
6126 | |
6127 | ||
6128 | (defun ebnf-make-alternative (body) | |
3ced5caa VJL |
6129 | (vector 'ebnf-generate-alternative ; 0 generator |
6130 | 'ebnf-alternative-width ; 1 width fun | |
6131 | 'ebnf-alternative-dimension ; 2 dimension fun | |
6132 | 0.0 ; 3 entry | |
6133 | 0.0 ; 4 height | |
6134 | 0.0 ; 5 width | |
6135 | body)) ; 6 alternative list | |
984ae001 GM |
6136 | |
6137 | ||
6138 | (defun ebnf-make-optional (body) | |
3ced5caa VJL |
6139 | (vector 'ebnf-generate-optional ; 0 generator |
6140 | 'ebnf-alternative-width ; 1 width fun | |
6141 | 'ebnf-optional-dimension ; 2 dimension fun | |
6142 | 0.0 ; 3 entry | |
6143 | 0.0 ; 4 height | |
6144 | 0.0 ; 5 width | |
6145 | body)) ; 6 optional element | |
984ae001 GM |
6146 | |
6147 | ||
6148 | (defun ebnf-make-except (factor exception) | |
3ced5caa VJL |
6149 | (vector 'ebnf-generate-except ; 0 generator |
6150 | 'ignore ; 1 width fun | |
6151 | 'ebnf-except-dimension ; 2 dimension fun | |
6152 | 0.0 ; 3 entry | |
6153 | 0.0 ; 4 height | |
6154 | 0.0 ; 5 width | |
6155 | factor ; 6 base element | |
6156 | exception)) ; 7 exception element | |
984ae001 GM |
6157 | |
6158 | ||
ac4780a1 | 6159 | (defun ebnf-make-repeat (times primary &optional upper) |
3ced5caa VJL |
6160 | (vector 'ebnf-generate-repeat ; 0 generator |
6161 | 'ignore ; 1 width fun | |
6162 | 'ebnf-repeat-dimension ; 2 dimension fun | |
6163 | 0.0 ; 3 entry | |
6164 | 0.0 ; 4 height | |
6165 | 0.0 ; 5 width | |
6166 | ; 6 times | |
ac4780a1 VJL |
6167 | (cond ((and times upper) ; L * U, L * L |
6168 | (if (string= times upper) | |
6169 | (if (string= times "") | |
6170 | " * " | |
6171 | times) | |
6172 | (concat times " * " upper))) | |
6173 | (times ; L * | |
6174 | (concat times " *")) | |
6175 | (upper ; * U | |
6176 | (concat "* " upper)) | |
6177 | (t ; * | |
6178 | " * ")) | |
3ced5caa | 6179 | primary)) ; 7 element |
984ae001 GM |
6180 | |
6181 | ||
6182 | (defun ebnf-make-sequence (seq) | |
3ced5caa VJL |
6183 | (vector 'ebnf-generate-sequence ; 0 generator |
6184 | 'ebnf-sequence-width ; 1 width fun | |
6185 | 'ebnf-sequence-dimension ; 2 dimension fun | |
6186 | 0.0 ; 3 entry | |
6187 | 0.0 ; 4 height | |
6188 | 0.0 ; 5 width | |
6189 | seq)) ; 6 sequence | |
984ae001 GM |
6190 | |
6191 | ||
6192 | (defun ebnf-make-dup-sequence (node seq) | |
3ced5caa VJL |
6193 | (vector 'ebnf-generate-sequence ; 0 generator |
6194 | 'ebnf-sequence-width ; 1 width fun | |
6195 | 'ebnf-sequence-dimension ; 2 dimension fun | |
6196 | (ebnf-node-entry node) ; 3 entry | |
6197 | (ebnf-node-height node) ; 4 height | |
6198 | (ebnf-node-width node) ; 5 width | |
6199 | seq)) ; 6 sequence | |
984ae001 GM |
6200 | |
6201 | \f | |
6202 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
6203 | ;; Optimizers used by parsers | |
6204 | ||
6205 | ||
6206 | (defun ebnf-token-except (element exception) | |
6207 | (cons (prog1 | |
6208 | (car exception) | |
6209 | (setq exception (cdr exception))) | |
6210 | (and element ; EMPTY - A ==> EMPTY | |
6211 | (let ((kind (ebnf-node-kind element))) | |
6212 | (cond | |
6213 | ;; [ A ]- ==> A | |
6214 | ((and (null exception) | |
6215 | (eq kind 'ebnf-generate-optional)) | |
6216 | (ebnf-node-list element)) | |
6217 | ;; { A }- ==> { A }+ | |
6218 | ((and (null exception) | |
6219 | (eq kind 'ebnf-generate-zero-or-more)) | |
6220 | (ebnf-node-kind element 'ebnf-generate-one-or-more) | |
6221 | (ebnf-node-dimension-func element 'ebnf-one-or-more-dimension) | |
6222 | element) | |
6223 | ;; ( A | EMPTY )- ==> A | |
6224 | ;; ( A | B | EMPTY )- ==> A | B | |
6225 | ((and (null exception) | |
6226 | (eq kind 'ebnf-generate-alternative) | |
b685181e GM |
6227 | (eq (ebnf-node-kind |
6228 | (car (last (ebnf-node-list element)))) | |
984ae001 GM |
6229 | 'ebnf-generate-empty)) |
6230 | (let ((elt (ebnf-node-list element)) | |
6231 | bef) | |
6232 | (while (cdr elt) | |
6233 | (setq bef elt | |
6234 | elt (cdr elt))) | |
6235 | (if (null bef) | |
6236 | ;; this should not happen!!?! | |
6237 | (setq element (ebnf-make-empty | |
6238 | (ebnf-node-width element))) | |
6239 | (setcdr bef nil) | |
6240 | (setq elt (ebnf-node-list element)) | |
6241 | (and (= (length elt) 1) | |
6242 | (setq element (car elt)))) | |
6243 | element)) | |
6244 | ;; A - B | |
6245 | (t | |
6246 | (ebnf-make-except element exception)) | |
6247 | ))))) | |
6248 | ||
6249 | ||
ac4780a1 | 6250 | (defun ebnf-token-repeat (times repeat &optional upper) |
984ae001 GM |
6251 | (if (null (cdr repeat)) |
6252 | ;; n * EMPTY ==> EMPTY | |
6253 | repeat | |
6254 | ;; n * term | |
6255 | (cons (car repeat) | |
ac4780a1 | 6256 | (ebnf-make-repeat times (cdr repeat) upper)))) |
984ae001 GM |
6257 | |
6258 | ||
6259 | (defun ebnf-token-optional (body) | |
6260 | (let ((kind (ebnf-node-kind body))) | |
6261 | (cond | |
6262 | ;; [ EMPTY ] ==> EMPTY | |
6263 | ((eq kind 'ebnf-generate-empty) | |
6264 | nil) | |
6265 | ;; [ { A }* ] ==> { A }* | |
6266 | ((eq kind 'ebnf-generate-zero-or-more) | |
6267 | body) | |
6268 | ;; [ { A }+ ] ==> { A }* | |
6269 | ((eq kind 'ebnf-generate-one-or-more) | |
6270 | (ebnf-node-kind body 'ebnf-generate-zero-or-more) | |
6271 | body) | |
6272 | ;; [ A | B ] ==> A | B | EMPTY | |
6273 | ((eq kind 'ebnf-generate-alternative) | |
6274 | (ebnf-node-list body (nconc (ebnf-node-list body) | |
6275 | (list (ebnf-make-empty)))) | |
6276 | body) | |
6277 | ;; [ A ] | |
6278 | (t | |
6279 | (ebnf-make-optional body)) | |
6280 | ))) | |
6281 | ||
6282 | ||
6283 | (defun ebnf-token-alternative (body sequence) | |
6284 | (if (null body) | |
6285 | (if (cdr sequence) | |
3ced5caa | 6286 | ;; no alternative |
984ae001 | 6287 | sequence |
3ced5caa VJL |
6288 | ;; empty element |
6289 | (cons (car sequence) ; token | |
984ae001 | 6290 | (ebnf-make-empty))) |
3ced5caa | 6291 | (cons (car sequence) ; token |
984ae001 GM |
6292 | (let ((seq (cdr sequence))) |
6293 | (if (and (= (length body) 1) (null seq)) | |
3ced5caa | 6294 | ;; alternative with one element |
984ae001 | 6295 | (car body) |
3ced5caa | 6296 | ;; a real alternative |
984ae001 GM |
6297 | (ebnf-make-alternative (nreverse (if seq |
6298 | (cons seq body) | |
6299 | body)))))))) | |
6300 | ||
6411a60a VJL |
6301 | |
6302 | (defun ebnf-token-sequence (sequence) | |
6303 | (cond | |
6304 | ;; null sequence | |
6305 | ((null sequence) | |
6306 | (ebnf-make-empty)) | |
6307 | ;; sequence with only one element | |
6308 | ((= (length sequence) 1) | |
6309 | (car sequence)) | |
6310 | ;; a real sequence | |
6311 | (t | |
6312 | (ebnf-make-sequence (nreverse sequence))) | |
6313 | )) | |
6314 | ||
984ae001 GM |
6315 | \f |
6316 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
6317 | ;; Variables used by parsers | |
6318 | ||
6319 | ||
6320 | (defconst ebnf-comment-table | |
6321 | (let ((table (make-vector 256 nil))) | |
6322 | ;; Override special comment character: | |
6323 | (aset table ?< 'newline) | |
6324 | (aset table ?> 'keep-line) | |
6411a60a | 6325 | (aset table ?^ 'form-feed) |
984ae001 GM |
6326 | table) |
6327 | "Vector used to map characters to a special comment token.") | |
6328 | ||
6329 | \f | |
3ced5caa VJL |
6330 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
6331 | ;; Log message | |
6332 | ||
6333 | ||
6334 | (defun ebnf-log-header (format-str &rest args) | |
6335 | (when ebnf-log | |
6336 | (apply | |
6337 | 'ebnf-log | |
6338 | (concat | |
6339 | "\n\n===============================================================\n\n" | |
6340 | format-str) | |
6341 | args))) | |
6342 | ||
6343 | ||
6344 | (defun ebnf-log (format-str &rest args) | |
6345 | (when ebnf-log | |
9a529312 | 6346 | (with-current-buffer (get-buffer-create "*Ebnf2ps Log*") |
3ced5caa VJL |
6347 | (goto-char (point-max)) |
6348 | (insert (apply 'format format-str args) "\n")))) | |
6349 | ||
6350 | \f | |
984ae001 GM |
6351 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
6352 | ;; To make this file smaller, some commands go in a separate file. | |
6353 | ;; But autoload them here to make the separation invisible. | |
6354 | ||
ac4780a1 VJL |
6355 | (autoload 'ebnf-abn-parser "ebnf-abn" |
6356 | "ABNF parser.") | |
6357 | ||
6358 | (autoload 'ebnf-abn-initialize "ebnf-abn" | |
6359 | "Initialize ABNF token table.") | |
6360 | ||
984ae001 GM |
6361 | (autoload 'ebnf-bnf-parser "ebnf-bnf" |
6362 | "EBNF parser.") | |
6363 | ||
6364 | (autoload 'ebnf-bnf-initialize "ebnf-bnf" | |
6365 | "Initialize EBNF token table.") | |
6366 | ||
6367 | (autoload 'ebnf-iso-parser "ebnf-iso" | |
6368 | "ISO EBNF parser.") | |
6369 | ||
6370 | (autoload 'ebnf-iso-initialize "ebnf-iso" | |
6371 | "Initialize ISO EBNF token table.") | |
6372 | ||
6373 | (autoload 'ebnf-yac-parser "ebnf-yac" | |
6374 | "Yacc/Bison parser.") | |
6375 | ||
6376 | (autoload 'ebnf-yac-initialize "ebnf-yac" | |
6377 | "Initializations for Yacc/Bison parser.") | |
6378 | ||
6ca94f87 VJL |
6379 | (autoload 'ebnf-ebx-parser "ebnf-ebx" |
6380 | "EBNFX parser.") | |
6381 | ||
6382 | (autoload 'ebnf-ebx-initialize "ebnf-ebx" | |
6383 | "Initializations for EBNFX parser.") | |
6384 | ||
6411a60a VJL |
6385 | (autoload 'ebnf-dtd-parser "ebnf-dtd" |
6386 | "DTD parser.") | |
984ae001 | 6387 | |
6411a60a VJL |
6388 | (autoload 'ebnf-dtd-initialize "ebnf-dtd" |
6389 | "Initializations for DTD parser.") | |
984ae001 GM |
6390 | |
6391 | \f | |
6392 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
6393 | ||
6394 | ||
6395 | (provide 'ebnf2ps) | |
6396 | ||
984ae001 | 6397 | ;;; ebnf2ps.el ends here |