| 1 | ;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript |
| 2 | |
| 3 | ;; Copyright (C) 1999-2012 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
| 6 | ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
| 7 | ;; Keywords: wp, ebnf, PostScript |
| 8 | ;; Version: 4.4 |
| 9 | ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre |
| 10 | |
| 11 | ;; This file is part of GNU Emacs. |
| 12 | |
| 13 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 14 | ;; it under the terms of the GNU General Public License as published by |
| 15 | ;; the Free Software Foundation, either version 3 of the License, or |
| 16 | ;; (at your option) any later version. |
| 17 | |
| 18 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 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 |
| 24 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 25 | |
| 26 | (defconst ebnf-version "4.4" |
| 27 | "ebnf2ps.el, v 4.4 <2007/02/12 vinicius> |
| 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 |
| 33 | Vinicius Jose Latorre <viniciusjl@ig.com.br>. |
| 34 | ") |
| 35 | |
| 36 | |
| 37 | ;;; Commentary: |
| 38 | |
| 39 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 40 | ;; |
| 41 | ;; Introduction |
| 42 | ;; ------------ |
| 43 | ;; |
| 44 | ;; This package translates an EBNF to a syntactic chart on PostScript. |
| 45 | ;; |
| 46 | ;; To use ebnf2ps, insert in your ~/.emacs: |
| 47 | ;; |
| 48 | ;; (require 'ebnf2ps) |
| 49 | ;; |
| 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. |
| 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 | ;; |
| 69 | ;; ebnf2ps provides the following commands for generating PostScript syntactic |
| 70 | ;; chart images of Emacs buffers: |
| 71 | ;; |
| 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 |
| 84 | ;; |
| 85 | ;; These commands all perform essentially the same function: they generate |
| 86 | ;; PostScript syntactic chart images suitable for printing on a PostScript |
| 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 | ;; |
| 93 | ;; print - The PostScript image is immediately sent to the printer; |
| 94 | ;; |
| 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'. |
| 99 | ;; |
| 100 | ;; eps - The PostScript image is immediately sent to an EPS file. |
| 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, |
| 113 | ;; you'll be asked to confirm the exit; this is modeled on the confirmation |
| 114 | ;; that Emacs uses for modified buffers. |
| 115 | ;; |
| 116 | ;; The word "directory", "file", "buffer" or "region" in the command name |
| 117 | ;; determines how much of the buffer is printed: |
| 118 | ;; |
| 119 | ;; directory - Read files in the directory and print them. |
| 120 | ;; |
| 121 | ;; file - Read file and print it. |
| 122 | ;; |
| 123 | ;; buffer - Print the entire buffer. |
| 124 | ;; |
| 125 | ;; region - Print just the current region. |
| 126 | ;; |
| 127 | ;; Two ebnf- command examples: |
| 128 | ;; |
| 129 | ;; ebnf-print-buffer - translate and print the entire buffer, and send it |
| 130 | ;; immediately to the printer. |
| 131 | ;; |
| 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. |
| 135 | ;; |
| 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. |
| 140 | ;; |
| 141 | ;; |
| 142 | ;; Invoking Ebnf2ps |
| 143 | ;; ---------------- |
| 144 | ;; |
| 145 | ;; To translate and print your buffer, type |
| 146 | ;; |
| 147 | ;; M-x ebnf-print-buffer |
| 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 | ;; |
| 153 | ;; C-u M-x ebnf-print-buffer |
| 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 | ;; |
| 161 | ;; C-u M-x ebnf-despool |
| 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 | ;; |
| 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) |
| 174 | ;; |
| 175 | ;; |
| 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 | ;; |
| 197 | ;; EBNF Syntax |
| 198 | ;; ----------- |
| 199 | ;; |
| 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 | ;; |
| 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) |
| 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) |
| 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 | ;; |
| 246 | ;; repeat = [ integer "*" [ integer ]] term. ;; repetition |
| 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 | ;; |
| 263 | ;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+". |
| 264 | ;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper |
| 265 | ;; ;; and lower), 8-bit accentuated characters, |
| 266 | ;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":", |
| 267 | ;; ;; "<", ">", "@", "\", "^", "_", "`" and "~". |
| 268 | ;; |
| 269 | ;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+". |
| 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 |
| 274 | ;; ;; example: \", \\. |
| 275 | ;; |
| 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. |
| 280 | ;; |
| 281 | ;; integer = "[0-9]+". |
| 282 | ;; ;; that is, an integer is a sequence of one or more decimal digits. |
| 283 | ;; |
| 284 | ;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n". |
| 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. |
| 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 | ;; |
| 316 | ;; The line comment is controlled by `ebnf-lex-comment-char'. The default |
| 317 | ;; value is ?\; (character `;'). |
| 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 | ;; |
| 330 | ;; `abnf' ebnf2ps recognizes the syntax described in the URL: |
| 331 | ;; `http://www.ietf.org/rfc/rfc2234.txt' |
| 332 | ;; ("Augmented BNF for Syntax Specifications: ABNF"). |
| 333 | ;; |
| 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 | ;; |
| 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 | ;; |
| 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 | ;; |
| 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 | ;; |
| 392 | ;; factorization: |
| 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 | ;; |
| 403 | ;; You may use form feed (^L \014) to force a production to start on a new |
| 404 | ;; page, for example: |
| 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 | ;; |
| 425 | ;; ;^ same as form feed. See section Form Feed above. |
| 426 | ;; |
| 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 |
| 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 |
| 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 | ;; |
| 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 | ;; |
| 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 | ;; |
| 497 | ;; If consecutive actions occur, only the last one takes effect, so if you |
| 498 | ;; have: |
| 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 | ;; |
| 509 | ;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*) |
| 510 | ;; and (*]EPS*). The first example above should be written: |
| 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 | ;; |
| 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 |
| 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 | ;; |
| 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 | ;; |
| 574 | ;; Utilities |
| 575 | ;; --------- |
| 576 | ;; |
| 577 | ;; Some tools are provided to help you. |
| 578 | ;; |
| 579 | ;; `ebnf-setup' returns the current setup. |
| 580 | ;; |
| 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 | ;; |
| 587 | ;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current |
| 588 | ;; buffer. |
| 589 | ;; |
| 590 | ;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current |
| 591 | ;; region. |
| 592 | ;; |
| 593 | ;; `ebnf-customize' activates a customization buffer for ebnf2ps options. |
| 594 | ;; |
| 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. |
| 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 | ;; |
| 630 | ;; `ebnf-production-vertical-space' Specify vertical space in points |
| 631 | ;; between productions. |
| 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 | ;; |
| 651 | ;; `ebnf-production-name-p' Non-nil means production name will be |
| 652 | ;; printed. |
| 653 | ;; |
| 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 | ;; |
| 662 | ;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will |
| 663 | ;; have a shadow. |
| 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 | ;; |
| 671 | ;; `ebnf-special-show-delimiter' Non-nil means special delimiter |
| 672 | ;; (character `?') is shown. |
| 673 | ;; |
| 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 | ;; |
| 719 | ;; `ebnf-arrow-extra-width' Specify extra width for arrow shape |
| 720 | ;; drawing. |
| 721 | ;; |
| 722 | ;; `ebnf-arrow-scale' Specify the arrow scale. |
| 723 | ;; |
| 724 | ;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a |
| 725 | ;; PostScript code). |
| 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 | ;; |
| 732 | ;; `ebnf-lex-eop-char' Specify the end of production |
| 733 | ;; character. |
| 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 | ;; |
| 746 | ;; `ebnf-file-suffix-regexp' Specify file name suffix that contains |
| 747 | ;; EBNF. |
| 748 | ;; |
| 749 | ;; `ebnf-eps-prefix' Specify EPS prefix file name. |
| 750 | ;; |
| 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 | ;; |
| 759 | ;; `ebnf-use-float-format' Non-nil means use `%f' float format. |
| 760 | ;; |
| 761 | ;; `ebnf-stop-on-error' Non-nil means signal error and stop. |
| 762 | ;; Nil means signal error and continue. |
| 763 | ;; |
| 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 | ;; |
| 768 | ;; `ebnf-optimize' Non-nil means optimize syntactic chart |
| 769 | ;; of rules. |
| 770 | ;; |
| 771 | ;; `ebnf-log' Non-nil means generate log messages. |
| 772 | ;; |
| 773 | ;; To set the above options you may: |
| 774 | ;; |
| 775 | ;; a) insert the code in your ~/.emacs, like: |
| 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 | ;; |
| 825 | ;; `ebnf-find-style' Return style definition if NAME is already defined; |
| 826 | ;; otherwise, return nil. |
| 827 | ;; |
| 828 | ;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and |
| 829 | ;; values VALUES. |
| 830 | ;; |
| 831 | ;; `ebnf-delete-style' Delete style NAME. |
| 832 | ;; |
| 833 | ;; `ebnf-merge-style' Merge values of style NAME with style VALUES. |
| 834 | ;; |
| 835 | ;; `ebnf-apply-style' Set STYLE as the current style. |
| 836 | ;; |
| 837 | ;; `ebnf-reset-style' Reset current style. |
| 838 | ;; |
| 839 | ;; `ebnf-push-style' Push the current style and set STYLE as the current |
| 840 | ;; style. |
| 841 | ;; |
| 842 | ;; `ebnf-pop-style' Pop a style and set it as the current style. |
| 843 | ;; |
| 844 | ;; These commands help to put together a lot of variable settings in a group |
| 845 | ;; and name this group. So when you wish to apply these settings it's only |
| 846 | ;; needed to give the name. |
| 847 | ;; |
| 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. |
| 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 | ;; |
| 865 | ;; entry is the vertical position used to know where it should |
| 866 | ;; be drawn the flow line in the current element. |
| 867 | ;; |
| 868 | ;; extra is given by `ebnf-arrow-extra-width'. |
| 869 | ;; |
| 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 | ;; : : : : : : |
| 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 | ;; :................................................. |
| 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 | ;; : : : : : : : : |
| 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 | ;; :................................................... |
| 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 | ;; : : : : : : : : |
| 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 | ;; :..................................................... |
| 1064 | ;; |
| 1065 | ;; NOTE: If Y element is empty, it's draw nothing at Y place. |
| 1066 | ;; |
| 1067 | ;; |
| 1068 | ;; Internal Structures |
| 1069 | ;; ------------------- |
| 1070 | ;; |
| 1071 | ;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis |
| 1072 | ;; of current buffer and generates an intermediate representation. The second |
| 1073 | ;; pass uses the intermediate representation to generate the PostScript |
| 1074 | ;; syntactic chart. |
| 1075 | ;; |
| 1076 | ;; The intermediate representation is a list of vectors, the vector element |
| 1077 | ;; represents a syntactic chart element. Below is a vector representation for |
| 1078 | ;; each syntactic chart element. |
| 1079 | ;; |
| 1080 | ;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION] |
| 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 | ;; |
| 1126 | ;; . Handle situations when syntactic chart is out of paper. |
| 1127 | ;; . Use other alphabet than ascii. |
| 1128 | ;; . Optimizations... |
| 1129 | ;; |
| 1130 | ;; |
| 1131 | ;; Acknowledgements |
| 1132 | ;; ---------------- |
| 1133 | ;; |
| 1134 | ;; Thanks to Eli Zaretskii <eliz@gnu.org> for some doc fixes. |
| 1135 | ;; |
| 1136 | ;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions: |
| 1137 | ;; - `ebnf-arrow-extra-width', `ebnf-arrow-scale', |
| 1138 | ;; `ebnf-production-name-p', `ebnf-stop-on-error', |
| 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 | ;; |
| 1148 | ;; Thanks to all who emailed comments. |
| 1149 | ;; |
| 1150 | ;; |
| 1151 | ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1152 | |
| 1153 | ;;; Code: |
| 1154 | |
| 1155 | |
| 1156 | (require 'ps-print) |
| 1157 | |
| 1158 | (and (string< ps-print-version "5.2.3") |
| 1159 | (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) |
| 1160 | |
| 1161 | |
| 1162 | ;; to avoid gripes with Emacs 20 |
| 1163 | (or (fboundp 'assq-delete-all) |
| 1164 | (defun assq-delete-all (key alist) |
| 1165 | "Delete from ALIST all elements whose car is KEY. |
| 1166 | Return the modified alist. |
| 1167 | Elements of ALIST that are not conses are ignored." |
| 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))) |
| 1175 | |
| 1176 | \f |
| 1177 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 1178 | ;; User Variables: |
| 1179 | |
| 1180 | |
| 1181 | ;;; Interface to the command system |
| 1182 | |
| 1183 | (defgroup postscript nil |
| 1184 | "PostScript Group." |
| 1185 | :tag "PostScript" |
| 1186 | :version "20" |
| 1187 | :group 'emacs) |
| 1188 | |
| 1189 | |
| 1190 | (defgroup ebnf2ps nil |
| 1191 | "Translate an EBNF to a syntactic chart on PostScript." |
| 1192 | :prefix "ebnf-" |
| 1193 | :version "20" |
| 1194 | :group 'wp |
| 1195 | :group 'postscript) |
| 1196 | |
| 1197 | |
| 1198 | (defgroup ebnf-special nil |
| 1199 | "Special customization." |
| 1200 | :prefix "ebnf-" |
| 1201 | :tag "Special" |
| 1202 | :version "20" |
| 1203 | :group 'ebnf2ps) |
| 1204 | |
| 1205 | |
| 1206 | (defgroup ebnf-except nil |
| 1207 | "Except customization." |
| 1208 | :prefix "ebnf-" |
| 1209 | :tag "Except" |
| 1210 | :version "20" |
| 1211 | :group 'ebnf2ps) |
| 1212 | |
| 1213 | |
| 1214 | (defgroup ebnf-repeat nil |
| 1215 | "Repeat customization." |
| 1216 | :prefix "ebnf-" |
| 1217 | :tag "Repeat" |
| 1218 | :version "20" |
| 1219 | :group 'ebnf2ps) |
| 1220 | |
| 1221 | |
| 1222 | (defgroup ebnf-terminal nil |
| 1223 | "Terminal customization." |
| 1224 | :prefix "ebnf-" |
| 1225 | :tag "Terminal" |
| 1226 | :version "20" |
| 1227 | :group 'ebnf2ps) |
| 1228 | |
| 1229 | |
| 1230 | (defgroup ebnf-non-terminal nil |
| 1231 | "Non-Terminal customization." |
| 1232 | :prefix "ebnf-" |
| 1233 | :tag "Non-Terminal" |
| 1234 | :version "20" |
| 1235 | :group 'ebnf2ps) |
| 1236 | |
| 1237 | |
| 1238 | (defgroup ebnf-production nil |
| 1239 | "Production customization." |
| 1240 | :prefix "ebnf-" |
| 1241 | :tag "Production" |
| 1242 | :version "20" |
| 1243 | :group 'ebnf2ps) |
| 1244 | |
| 1245 | |
| 1246 | (defgroup ebnf-shape nil |
| 1247 | "Shapes customization." |
| 1248 | :prefix "ebnf-" |
| 1249 | :tag "Shape" |
| 1250 | :version "20" |
| 1251 | :group 'ebnf2ps) |
| 1252 | |
| 1253 | |
| 1254 | (defgroup ebnf-displacement nil |
| 1255 | "Displacement customization." |
| 1256 | :prefix "ebnf-" |
| 1257 | :tag "Displacement" |
| 1258 | :version "20" |
| 1259 | :group 'ebnf2ps) |
| 1260 | |
| 1261 | |
| 1262 | (defgroup ebnf-syntactic nil |
| 1263 | "Syntactic customization." |
| 1264 | :prefix "ebnf-" |
| 1265 | :tag "Syntactic" |
| 1266 | :version "20" |
| 1267 | :group 'ebnf2ps) |
| 1268 | |
| 1269 | |
| 1270 | (defgroup ebnf-optimization nil |
| 1271 | "Optimization customization." |
| 1272 | :prefix "ebnf-" |
| 1273 | :tag "Optimization" |
| 1274 | :version "20" |
| 1275 | :group 'ebnf2ps) |
| 1276 | |
| 1277 | |
| 1278 | (defcustom ebnf-horizontal-orientation nil |
| 1279 | "*Non-nil means productions are drawn horizontally." |
| 1280 | :type 'boolean |
| 1281 | :version "20" |
| 1282 | :group 'ebnf-displacement) |
| 1283 | |
| 1284 | |
| 1285 | (defcustom ebnf-horizontal-max-height nil |
| 1286 | "*Non-nil means to use maximum production height in horizontal orientation. |
| 1287 | |
| 1288 | It is only used when `ebnf-horizontal-orientation' is non-nil." |
| 1289 | :type 'boolean |
| 1290 | :version "20" |
| 1291 | :group 'ebnf-displacement) |
| 1292 | |
| 1293 | |
| 1294 | (defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value |
| 1295 | "*Specify horizontal space in points between productions. |
| 1296 | |
| 1297 | Value less or equal to zero forces ebnf2ps to set a proper default value." |
| 1298 | :type 'number |
| 1299 | :version "20" |
| 1300 | :group 'ebnf-displacement) |
| 1301 | |
| 1302 | |
| 1303 | (defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value |
| 1304 | "*Specify vertical space in points between productions. |
| 1305 | |
| 1306 | Value less or equal to zero forces ebnf2ps to set a proper default value." |
| 1307 | :type 'number |
| 1308 | :version "20" |
| 1309 | :group 'ebnf-displacement) |
| 1310 | |
| 1311 | |
| 1312 | (defcustom ebnf-justify-sequence 'center |
| 1313 | "*Specify justification of terms in a sequence inside alternatives. |
| 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)) |
| 1322 | :version "20" |
| 1323 | :group 'ebnf-displacement) |
| 1324 | |
| 1325 | |
| 1326 | (defcustom ebnf-special-show-delimiter t |
| 1327 | "*Non-nil means special delimiter (character `?') is shown." |
| 1328 | :type 'boolean |
| 1329 | :version "20" |
| 1330 | :group 'ebnf-special) |
| 1331 | |
| 1332 | |
| 1333 | (defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic) |
| 1334 | "*Specify special font. |
| 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)))) |
| 1351 | :version "20" |
| 1352 | :group 'ebnf-special) |
| 1353 | |
| 1354 | |
| 1355 | (defcustom ebnf-special-shape 'bevel |
| 1356 | "*Specify special box shape. |
| 1357 | |
| 1358 | See documentation for `ebnf-non-terminal-shape'." |
| 1359 | :type '(radio :tag "Special Shape" |
| 1360 | (const miter) (const round) (const bevel)) |
| 1361 | :version "20" |
| 1362 | :group 'ebnf-special) |
| 1363 | |
| 1364 | |
| 1365 | (defcustom ebnf-special-shadow nil |
| 1366 | "*Non-nil means special box will have a shadow." |
| 1367 | :type 'boolean |
| 1368 | :version "20" |
| 1369 | :group 'ebnf-special) |
| 1370 | |
| 1371 | |
| 1372 | (defcustom ebnf-special-border-width 0.5 |
| 1373 | "*Specify border width for special box." |
| 1374 | :type 'number |
| 1375 | :version "20" |
| 1376 | :group 'ebnf-special) |
| 1377 | |
| 1378 | |
| 1379 | (defcustom ebnf-special-border-color "Black" |
| 1380 | "*Specify border color for special box." |
| 1381 | :type 'string |
| 1382 | :version "20" |
| 1383 | :group 'ebnf-special) |
| 1384 | |
| 1385 | |
| 1386 | (defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic) |
| 1387 | "*Specify except font. |
| 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)))) |
| 1404 | :version "20" |
| 1405 | :group 'ebnf-except) |
| 1406 | |
| 1407 | |
| 1408 | (defcustom ebnf-except-shape 'bevel |
| 1409 | "*Specify except box shape. |
| 1410 | |
| 1411 | See documentation for `ebnf-non-terminal-shape'." |
| 1412 | :type '(radio :tag "Except Shape" |
| 1413 | (const miter) (const round) (const bevel)) |
| 1414 | :version "20" |
| 1415 | :group 'ebnf-except) |
| 1416 | |
| 1417 | |
| 1418 | (defcustom ebnf-except-shadow nil |
| 1419 | "*Non-nil means except box will have a shadow." |
| 1420 | :type 'boolean |
| 1421 | :version "20" |
| 1422 | :group 'ebnf-except) |
| 1423 | |
| 1424 | |
| 1425 | (defcustom ebnf-except-border-width 0.25 |
| 1426 | "*Specify border width for except box." |
| 1427 | :type 'number |
| 1428 | :version "20" |
| 1429 | :group 'ebnf-except) |
| 1430 | |
| 1431 | |
| 1432 | (defcustom ebnf-except-border-color "Black" |
| 1433 | "*Specify border color for except box." |
| 1434 | :type 'string |
| 1435 | :version "20" |
| 1436 | :group 'ebnf-except) |
| 1437 | |
| 1438 | |
| 1439 | (defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic) |
| 1440 | "*Specify repeat font. |
| 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)))) |
| 1457 | :version "20" |
| 1458 | :group 'ebnf-repeat) |
| 1459 | |
| 1460 | |
| 1461 | (defcustom ebnf-repeat-shape 'bevel |
| 1462 | "*Specify repeat box shape. |
| 1463 | |
| 1464 | See documentation for `ebnf-non-terminal-shape'." |
| 1465 | :type '(radio :tag "Repeat Shape" |
| 1466 | (const miter) (const round) (const bevel)) |
| 1467 | :version "20" |
| 1468 | :group 'ebnf-repeat) |
| 1469 | |
| 1470 | |
| 1471 | (defcustom ebnf-repeat-shadow nil |
| 1472 | "*Non-nil means repeat box will have a shadow." |
| 1473 | :type 'boolean |
| 1474 | :version "20" |
| 1475 | :group 'ebnf-repeat) |
| 1476 | |
| 1477 | |
| 1478 | (defcustom ebnf-repeat-border-width 0.0 |
| 1479 | "*Specify border width for repeat box." |
| 1480 | :type 'number |
| 1481 | :version "20" |
| 1482 | :group 'ebnf-repeat) |
| 1483 | |
| 1484 | |
| 1485 | (defcustom ebnf-repeat-border-color "Black" |
| 1486 | "*Specify border color for repeat box." |
| 1487 | :type 'string |
| 1488 | :version "20" |
| 1489 | :group 'ebnf-repeat) |
| 1490 | |
| 1491 | |
| 1492 | (defcustom ebnf-terminal-font '(7 Courier "Black" "White") |
| 1493 | "*Specify terminal font. |
| 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)))) |
| 1510 | :version "20" |
| 1511 | :group 'ebnf-terminal) |
| 1512 | |
| 1513 | |
| 1514 | (defcustom ebnf-terminal-shape 'miter |
| 1515 | "*Specify terminal box shape. |
| 1516 | |
| 1517 | See documentation for `ebnf-non-terminal-shape'." |
| 1518 | :type '(radio :tag "Terminal Shape" |
| 1519 | (const miter) (const round) (const bevel)) |
| 1520 | :version "20" |
| 1521 | :group 'ebnf-terminal) |
| 1522 | |
| 1523 | |
| 1524 | (defcustom ebnf-terminal-shadow nil |
| 1525 | "*Non-nil means terminal box will have a shadow." |
| 1526 | :type 'boolean |
| 1527 | :version "20" |
| 1528 | :group 'ebnf-terminal) |
| 1529 | |
| 1530 | |
| 1531 | (defcustom ebnf-terminal-border-width 1.0 |
| 1532 | "*Specify border width for terminal box." |
| 1533 | :type 'number |
| 1534 | :version "20" |
| 1535 | :group 'ebnf-terminal) |
| 1536 | |
| 1537 | |
| 1538 | (defcustom ebnf-terminal-border-color "Black" |
| 1539 | "*Specify border color for terminal box." |
| 1540 | :type 'string |
| 1541 | :version "20" |
| 1542 | :group 'ebnf-terminal) |
| 1543 | |
| 1544 | |
| 1545 | (defcustom ebnf-production-name-p t |
| 1546 | "*Non-nil means production name will be printed." |
| 1547 | :type 'boolean |
| 1548 | :version "20" |
| 1549 | :group 'ebnf-production) |
| 1550 | |
| 1551 | |
| 1552 | (defcustom ebnf-sort-production nil |
| 1553 | "*Specify how productions are sorted. |
| 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)) |
| 1564 | :version "20" |
| 1565 | :group 'ebnf-production) |
| 1566 | |
| 1567 | |
| 1568 | (defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold) |
| 1569 | "*Specify production header font. |
| 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)))) |
| 1607 | :version "20" |
| 1608 | :group 'ebnf-production) |
| 1609 | |
| 1610 | |
| 1611 | (defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White") |
| 1612 | "*Specify non-terminal font. |
| 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)))) |
| 1629 | :version "20" |
| 1630 | :group 'ebnf-non-terminal) |
| 1631 | |
| 1632 | |
| 1633 | (defcustom ebnf-non-terminal-shape 'round |
| 1634 | "*Specify non-terminal box shape. |
| 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)) |
| 1653 | :version "20" |
| 1654 | :group 'ebnf-non-terminal) |
| 1655 | |
| 1656 | |
| 1657 | (defcustom ebnf-non-terminal-shadow nil |
| 1658 | "*Non-nil means non-terminal box will have a shadow." |
| 1659 | :type 'boolean |
| 1660 | :version "20" |
| 1661 | :group 'ebnf-non-terminal) |
| 1662 | |
| 1663 | |
| 1664 | (defcustom ebnf-non-terminal-border-width 1.0 |
| 1665 | "*Specify border width for non-terminal box." |
| 1666 | :type 'number |
| 1667 | :version "20" |
| 1668 | :group 'ebnf-non-terminal) |
| 1669 | |
| 1670 | |
| 1671 | (defcustom ebnf-non-terminal-border-color "Black" |
| 1672 | "*Specify border color for non-terminal box." |
| 1673 | :type 'string |
| 1674 | :version "20" |
| 1675 | :group 'ebnf-non-terminal) |
| 1676 | |
| 1677 | |
| 1678 | (defcustom ebnf-arrow-shape 'hollow |
| 1679 | "*Specify the arrow shape. |
| 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 | |
| 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 | |
| 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" |
| 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)) |
| 1731 | :version "20" |
| 1732 | :group 'ebnf-shape) |
| 1733 | |
| 1734 | |
| 1735 | (defcustom ebnf-chart-shape 'round |
| 1736 | "*Specify chart flow shape. |
| 1737 | |
| 1738 | See documentation for `ebnf-non-terminal-shape'." |
| 1739 | :type '(radio :tag "Chart Flow Shape" |
| 1740 | (const miter) (const round) (const bevel)) |
| 1741 | :version "20" |
| 1742 | :group 'ebnf-shape) |
| 1743 | |
| 1744 | |
| 1745 | (defcustom ebnf-user-arrow nil |
| 1746 | "*Specify a sexp for user arrow shape (a PostScript code). |
| 1747 | |
| 1748 | When evaluated, the sexp should return nil or a string containing PostScript |
| 1749 | code. PostScript code should draw a right arrow. |
| 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 | |
| 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. |
| 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 |
| 1779 | symbol `user'." |
| 1780 | :type '(sexp :tag "User Arrow Shape") |
| 1781 | :version "20" |
| 1782 | :group 'ebnf-shape) |
| 1783 | |
| 1784 | |
| 1785 | (defcustom ebnf-syntax 'ebnf |
| 1786 | "*Specify syntax to be recognized. |
| 1787 | |
| 1788 | Valid values are: |
| 1789 | |
| 1790 | `ebnf' ebnf2ps recognizes the syntax described in ebnf2ps |
| 1791 | documentation. |
| 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 | |
| 1797 | `abnf' ebnf2ps recognizes the syntax described in the URL: |
| 1798 | `http://www.ietf.org/rfc/rfc2234.txt' |
| 1799 | (\"Augmented BNF for Syntax Specifications: ABNF\"). |
| 1800 | |
| 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 | |
| 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 | |
| 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 | |
| 1821 | Any other value is treated as `ebnf'." |
| 1822 | :type '(radio :tag "Syntax" |
| 1823 | (const ebnf) (const abnf) (const iso-ebnf) |
| 1824 | (const yacc) (const ebnfx) (const dtd)) |
| 1825 | :version "20" |
| 1826 | :group 'ebnf-syntactic) |
| 1827 | |
| 1828 | |
| 1829 | (defcustom ebnf-lex-comment-char ?\; |
| 1830 | "*Specify the line comment character. |
| 1831 | |
| 1832 | It's used only when `ebnf-syntax' is `ebnf'." |
| 1833 | :type 'character |
| 1834 | :version "20" |
| 1835 | :group 'ebnf-syntactic) |
| 1836 | |
| 1837 | |
| 1838 | (defcustom ebnf-lex-eop-char ?. |
| 1839 | "*Specify the end of production character. |
| 1840 | |
| 1841 | It's used only when `ebnf-syntax' is `ebnf'." |
| 1842 | :type 'character |
| 1843 | :version "20" |
| 1844 | :group 'ebnf-syntactic) |
| 1845 | |
| 1846 | |
| 1847 | (defcustom ebnf-terminal-regexp nil |
| 1848 | "*Specify how it's a terminal name. |
| 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) |
| 1857 | :version "20" |
| 1858 | :group 'ebnf-syntactic) |
| 1859 | |
| 1860 | |
| 1861 | (defcustom ebnf-case-fold-search nil |
| 1862 | "*Non-nil means ignore case on matching. |
| 1863 | |
| 1864 | It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is |
| 1865 | `ebnf'." |
| 1866 | :type 'boolean |
| 1867 | :version "20" |
| 1868 | :group 'ebnf-syntactic) |
| 1869 | |
| 1870 | |
| 1871 | (defcustom ebnf-iso-alternative-p nil |
| 1872 | "*Non-nil means use alternative ISO EBNF. |
| 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 |
| 1886 | :version "20" |
| 1887 | :group 'ebnf-syntactic) |
| 1888 | |
| 1889 | |
| 1890 | (defcustom ebnf-iso-normalize-p nil |
| 1891 | "*Non-nil means normalize ISO EBNF syntax names. |
| 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 |
| 1898 | :version "20" |
| 1899 | :group 'ebnf-syntactic) |
| 1900 | |
| 1901 | |
| 1902 | (defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$" |
| 1903 | "*Specify file name suffix that contains EBNF. |
| 1904 | |
| 1905 | See `ebnf-eps-directory' command." |
| 1906 | :type 'regexp |
| 1907 | :version "20" |
| 1908 | :group 'ebnf2ps) |
| 1909 | |
| 1910 | |
| 1911 | (defcustom ebnf-eps-prefix "ebnf--" |
| 1912 | "*Specify EPS prefix file name. |
| 1913 | |
| 1914 | See `ebnf-eps-buffer' and `ebnf-eps-region' commands." |
| 1915 | :type 'string |
| 1916 | :version "20" |
| 1917 | :group 'ebnf2ps) |
| 1918 | |
| 1919 | |
| 1920 | (defcustom ebnf-eps-header-font '(11 Helvetica "Black" "White" bold) |
| 1921 | "*Specify EPS header font. |
| 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 |
| 1945 | "*Specify EPS header. |
| 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) |
| 1981 | "*Specify EPS footer font. |
| 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 |
| 2005 | "*Specify EPS footer. |
| 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 | |
| 2040 | (defcustom ebnf-entry-percentage 0.5 ; middle |
| 2041 | "*Specify entry height on alternatives. |
| 2042 | |
| 2043 | It must be a float between 0.0 (top) and 1.0 (bottom)." |
| 2044 | :type 'number |
| 2045 | :version "20" |
| 2046 | :group 'ebnf2ps) |
| 2047 | |
| 2048 | |
| 2049 | (defcustom ebnf-default-width 0.6 |
| 2050 | "*Specify additional border width over default terminal, non-terminal or |
| 2051 | special." |
| 2052 | :type 'number |
| 2053 | :version "20" |
| 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 |
| 2060 | "*Non-nil means use color." |
| 2061 | :type 'boolean |
| 2062 | :version "20" |
| 2063 | :group 'ebnf2ps) |
| 2064 | |
| 2065 | |
| 2066 | (defcustom ebnf-line-width 1.0 |
| 2067 | "*Specify flow line width." |
| 2068 | :type 'number |
| 2069 | :version "20" |
| 2070 | :group 'ebnf2ps) |
| 2071 | |
| 2072 | |
| 2073 | (defcustom ebnf-line-color "Black" |
| 2074 | "*Specify flow line color." |
| 2075 | :type 'string |
| 2076 | :version "20" |
| 2077 | :group 'ebnf2ps) |
| 2078 | |
| 2079 | |
| 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)) |
| 2084 | "*Specify extra width for arrow shape drawing. |
| 2085 | |
| 2086 | The extra width is used to avoid that the arrowhead and the terminal border |
| 2087 | overlap. It depends on `ebnf-arrow-shape' and `ebnf-line-width'." |
| 2088 | :type 'number |
| 2089 | :version "22" |
| 2090 | :group 'ebnf-shape) |
| 2091 | |
| 2092 | |
| 2093 | (defcustom ebnf-arrow-scale 1.0 |
| 2094 | "*Specify the arrow scale. |
| 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 | |
| 2103 | (defcustom ebnf-debug-ps nil |
| 2104 | "*Non-nil means to generate PostScript debug procedures. |
| 2105 | |
| 2106 | It is intended to help PostScript programmers in debugging." |
| 2107 | :type 'boolean |
| 2108 | :version "20" |
| 2109 | :group 'ebnf2ps) |
| 2110 | |
| 2111 | |
| 2112 | (defcustom ebnf-use-float-format t |
| 2113 | "*Non-nil means use `%f' float format. |
| 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 |
| 2124 | :version "20" |
| 2125 | :group 'ebnf2ps) |
| 2126 | |
| 2127 | |
| 2128 | (defcustom ebnf-stop-on-error nil |
| 2129 | "*Non-nil means signal error and stop. Otherwise, signal error and continue." |
| 2130 | :type 'boolean |
| 2131 | :version "20" |
| 2132 | :group 'ebnf2ps) |
| 2133 | |
| 2134 | |
| 2135 | (defcustom ebnf-yac-ignore-error-recovery nil |
| 2136 | "*Non-nil means ignore error recovery. |
| 2137 | |
| 2138 | It's only used when `ebnf-syntax' is `yacc'." |
| 2139 | :type 'boolean |
| 2140 | :version "20" |
| 2141 | :group 'ebnf-syntactic) |
| 2142 | |
| 2143 | |
| 2144 | (defcustom ebnf-ignore-empty-rule nil |
| 2145 | "*Non-nil means ignore empty rules. |
| 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 |
| 2150 | :version "20" |
| 2151 | :group 'ebnf-optimization) |
| 2152 | |
| 2153 | |
| 2154 | (defcustom ebnf-optimize nil |
| 2155 | "*Non-nil means optimize syntactic chart of rules. |
| 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 | |
| 2170 | factorization: |
| 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 |
| 2177 | :version "20" |
| 2178 | :group 'ebnf-optimization) |
| 2179 | |
| 2180 | |
| 2181 | (defcustom ebnf-log nil |
| 2182 | "*Non-nil means generate log messages. |
| 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 | |
| 2190 | \f |
| 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 |
| 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 | |
| 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 |
| 2232 | (list (read-directory-name "Directory containing EBNF files (print): " |
| 2233 | nil default-directory))) |
| 2234 | (ebnf-log-header "(ebnf-print-directory %S)" directory) |
| 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: ") |
| 2247 | (ebnf-log-header "(ebnf-print-file %S %S)" file do-not-kill-buffer-when-done) |
| 2248 | (ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done)) |
| 2249 | |
| 2250 | |
| 2251 | ;;;###autoload |
| 2252 | (defun ebnf-print-buffer (&optional filename) |
| 2253 | "Generate and print a PostScript syntactic chart image of the buffer. |
| 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))) |
| 2264 | (ebnf-log-header "(ebnf-print-buffer %S)" filename) |
| 2265 | (ebnf-print-region (point-min) (point-max) filename)) |
| 2266 | |
| 2267 | |
| 2268 | ;;;###autoload |
| 2269 | (defun ebnf-print-region (from to &optional filename) |
| 2270 | "Generate and print a PostScript syntactic chart image of the region. |
| 2271 | Like `ebnf-print-buffer', but prints just the current region." |
| 2272 | (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) |
| 2273 | (ebnf-log-header "(ebnf-print-region %S %S %S)" from to filename) |
| 2274 | (run-hooks 'ebnf-hook) |
| 2275 | (or (ebnf-spool-region from to) |
| 2276 | (ps-do-despool filename))) |
| 2277 | |
| 2278 | |
| 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 |
| 2290 | (list (read-directory-name "Directory containing EBNF files (spool): " |
| 2291 | nil default-directory))) |
| 2292 | (ebnf-log-header "(ebnf-spool-directory %S)" directory) |
| 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: ") |
| 2305 | (ebnf-log-header "(ebnf-spool-file %S %S)" file do-not-kill-buffer-when-done) |
| 2306 | (ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done)) |
| 2307 | |
| 2308 | |
| 2309 | ;;;###autoload |
| 2310 | (defun ebnf-spool-buffer () |
| 2311 | "Generate and spool a PostScript syntactic chart image of the buffer. |
| 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) |
| 2317 | (ebnf-log-header "(ebnf-spool-buffer)") |
| 2318 | (ebnf-spool-region (point-min) (point-max))) |
| 2319 | |
| 2320 | |
| 2321 | ;;;###autoload |
| 2322 | (defun ebnf-spool-region (from to) |
| 2323 | "Generate a PostScript syntactic chart image of the region and spool locally. |
| 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") |
| 2328 | (ebnf-log-header "(ebnf-spool-region %S)" from to) |
| 2329 | (ebnf-generate-region from to 'ebnf-generate)) |
| 2330 | |
| 2331 | |
| 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 |
| 2343 | (list (read-directory-name "Directory containing EBNF files (EPS): " |
| 2344 | nil default-directory))) |
| 2345 | (ebnf-log-header "(ebnf-eps-directory %S)" directory) |
| 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: ") |
| 2358 | (ebnf-log-header "(ebnf-eps-file %S %S)" file do-not-kill-buffer-when-done) |
| 2359 | (ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done)) |
| 2360 | |
| 2361 | |
| 2362 | ;;;###autoload |
| 2363 | (defun ebnf-eps-buffer () |
| 2364 | "Generate a PostScript syntactic chart image of the buffer in an EPS file. |
| 2365 | |
| 2366 | Generate an EPS file for each production in the buffer. |
| 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. |
| 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\". |
| 2379 | |
| 2380 | WARNING: This function does *NOT* ask any confirmation to override existing |
| 2381 | files." |
| 2382 | (interactive) |
| 2383 | (ebnf-log-header "(ebnf-eps-buffer)") |
| 2384 | (ebnf-eps-region (point-min) (point-max))) |
| 2385 | |
| 2386 | |
| 2387 | ;;;###autoload |
| 2388 | (defun ebnf-eps-region (from to) |
| 2389 | "Generate a PostScript syntactic chart image of the region in an EPS file. |
| 2390 | |
| 2391 | Generate an EPS file for each production in the region. |
| 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. |
| 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\". |
| 2404 | |
| 2405 | WARNING: This function does *NOT* ask any confirmation to override existing |
| 2406 | files." |
| 2407 | (interactive "r") |
| 2408 | (ebnf-log-header "(ebnf-eps-region %S %S)" from to) |
| 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 | |
| 2417 | ;;;###autoload |
| 2418 | (defun ebnf-syntax-directory (&optional directory) |
| 2419 | "Do a syntactic analysis of the files in DIRECTORY. |
| 2420 | |
| 2421 | If DIRECTORY is nil, use `default-directory'. |
| 2422 | |
| 2423 | Only the files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see) |
| 2424 | are processed. |
| 2425 | |
| 2426 | See also `ebnf-syntax-buffer'." |
| 2427 | (interactive |
| 2428 | (list (read-directory-name "Directory containing EBNF files (syntax): " |
| 2429 | nil default-directory))) |
| 2430 | (ebnf-log-header "(ebnf-syntax-directory %S)" directory) |
| 2431 | (ebnf-directory 'ebnf-syntax-buffer directory)) |
| 2432 | |
| 2433 | |
| 2434 | ;;;###autoload |
| 2435 | (defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done) |
| 2436 | "Do a syntactic analysis of the named FILE. |
| 2437 | |
| 2438 | If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't |
| 2439 | killed after syntax checking. |
| 2440 | |
| 2441 | See also `ebnf-syntax-buffer'." |
| 2442 | (interactive "fEBNF file to check syntax: ") |
| 2443 | (ebnf-log-header "(ebnf-syntax-file %S %S)" file do-not-kill-buffer-when-done) |
| 2444 | (ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done)) |
| 2445 | |
| 2446 | |
| 2447 | ;;;###autoload |
| 2448 | (defun ebnf-syntax-buffer () |
| 2449 | "Do a syntactic analysis of the current buffer." |
| 2450 | (interactive) |
| 2451 | (ebnf-log-header "(ebnf-syntax-buffer)") |
| 2452 | (ebnf-syntax-region (point-min) (point-max))) |
| 2453 | |
| 2454 | |
| 2455 | ;;;###autoload |
| 2456 | (defun ebnf-syntax-region (from to) |
| 2457 | "Do a syntactic analysis of a region." |
| 2458 | (interactive "r") |
| 2459 | (ebnf-log-header "(ebnf-syntax-region %S %S)" from to) |
| 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 | " |
| 2472 | ;;; ebnf2ps.el version %s |
| 2473 | |
| 2474 | ;;; Emacs version %S |
| 2475 | |
| 2476 | \(setq ebnf-special-show-delimiter %S |
| 2477 | ebnf-special-font %s |
| 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 |
| 2504 | ebnf-production-name-p %S |
| 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 |
| 2520 | ebnf-file-suffix-regexp %S |
| 2521 | ebnf-eps-prefix %S |
| 2522 | ebnf-eps-header-font %s |
| 2523 | ebnf-eps-header %s |
| 2524 | ebnf-eps-footer-font %s |
| 2525 | ebnf-eps-footer %s |
| 2526 | ebnf-entry-percentage %S |
| 2527 | ebnf-color-p %S |
| 2528 | ebnf-line-width %S |
| 2529 | ebnf-line-color %S |
| 2530 | ebnf-arrow-extra-width %S |
| 2531 | ebnf-arrow-scale %S |
| 2532 | ebnf-debug-ps %S |
| 2533 | ebnf-use-float-format %S |
| 2534 | ebnf-stop-on-error %S |
| 2535 | ebnf-yac-ignore-error-recovery %S |
| 2536 | ebnf-ignore-empty-rule %S |
| 2537 | ebnf-optimize %S |
| 2538 | ebnf-log %S) |
| 2539 | |
| 2540 | ;;; ebnf2ps.el - end of settings |
| 2541 | " |
| 2542 | ebnf-version |
| 2543 | emacs-version |
| 2544 | ebnf-special-show-delimiter |
| 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 |
| 2572 | ebnf-production-name-p |
| 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 |
| 2588 | ebnf-file-suffix-regexp |
| 2589 | ebnf-eps-prefix |
| 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) |
| 2594 | ebnf-entry-percentage |
| 2595 | ebnf-color-p |
| 2596 | ebnf-line-width |
| 2597 | ebnf-line-color |
| 2598 | ebnf-arrow-extra-width |
| 2599 | ebnf-arrow-scale |
| 2600 | ebnf-debug-ps |
| 2601 | ebnf-use-float-format |
| 2602 | ebnf-stop-on-error |
| 2603 | ebnf-yac-ignore-error-recovery |
| 2604 | ebnf-ignore-empty-rule |
| 2605 | ebnf-optimize |
| 2606 | ebnf-log)) |
| 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 |
| 2623 | '(ebnf-special-show-delimiter |
| 2624 | ebnf-special-font |
| 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 |
| 2651 | ebnf-production-name-p |
| 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 |
| 2667 | ebnf-file-suffix-regexp |
| 2668 | ebnf-eps-prefix |
| 2669 | ebnf-eps-header-font |
| 2670 | ebnf-eps-header |
| 2671 | ebnf-eps-footer-font |
| 2672 | ebnf-eps-footer |
| 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 |
| 2679 | ebnf-stop-on-error |
| 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 |
| 2690 | (ebnf-special-show-delimiter . t) |
| 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") |
| 2718 | (ebnf-production-name-p . t) |
| 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) |
| 2734 | (ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$") |
| 2735 | (ebnf-eps-prefix . "ebnf--") |
| 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) |
| 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) |
| 2747 | (ebnf-stop-on-error . nil) |
| 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 . ?\;)) |
| 2757 | ;; ABNF default |
| 2758 | (abnf |
| 2759 | default |
| 2760 | (ebnf-syntax . 'abnf)) |
| 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)) |
| 2769 | ;; ebnfx default |
| 2770 | (ebnfx |
| 2771 | default |
| 2772 | (ebnf-syntax . 'ebnfx)) |
| 2773 | ;; dtd default |
| 2774 | (dtd |
| 2775 | default |
| 2776 | (ebnf-syntax . 'dtd)) |
| 2777 | ) |
| 2778 | "Style database. |
| 2779 | |
| 2780 | Each element has the following form: |
| 2781 | |
| 2782 | (NAME INHERITS (VAR . VALUE)...) |
| 2783 | |
| 2784 | Where: |
| 2785 | |
| 2786 | NAME is a symbol name style. |
| 2787 | |
| 2788 | INHERITS is a symbol name style from which the current style inherits |
| 2789 | the context. If INHERITS is nil, then there is no inheritance. |
| 2790 | |
| 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 |
| 2794 | when you wish to modify some aspects of an existing style, but |
| 2795 | at the same time wish to keep it unmodified. |
| 2796 | |
| 2797 | VAR is a valid ebnf2ps symbol custom variable. |
| 2798 | See `ebnf-style-custom-list' for valid symbol variables. |
| 2799 | |
| 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. |
| 2802 | See `default' style for an example. |
| 2803 | |
| 2804 | Don't use this variable directly. Use functions `ebnf-insert-style', |
| 2805 | `ebnf-delete-style' and `ebnf-merge-style'.") |
| 2806 | |
| 2807 | \f |
| 2808 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2809 | ;; Style commands |
| 2810 | |
| 2811 | |
| 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 | |
| 2821 | ;;;###autoload |
| 2822 | (defun ebnf-insert-style (name inherits &rest values) |
| 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: ") |
| 2827 | (and (assoc name ebnf-style-database) |
| 2828 | (error "Style name already exists: %s" name)) |
| 2829 | (or (assoc inherits ebnf-style-database) |
| 2830 | (error "Style inheritance name doesn't exist: %s" inherits)) |
| 2831 | (setq ebnf-style-database |
| 2832 | (cons (cons name (cons inherits (ebnf-check-style-values values))) |
| 2833 | ebnf-style-database))) |
| 2834 | |
| 2835 | |
| 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 | |
| 2853 | ;;;###autoload |
| 2854 | (defun ebnf-merge-style (name &rest values) |
| 2855 | "Merge values of style NAME with style VALUES. |
| 2856 | |
| 2857 | See `ebnf-style-database' documentation." |
| 2858 | (interactive "SStyle name: \nXStyle values: ") |
| 2859 | (let ((style (or (assoc name ebnf-style-database) |
| 2860 | (error "Style name doesn't exist: %s" name))) |
| 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) |
| 2878 | "Set STYLE as the current style. |
| 2879 | |
| 2880 | Returns the old style symbol. |
| 2881 | |
| 2882 | See `ebnf-style-database' documentation." |
| 2883 | (interactive "SApply style: ") |
| 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 | |
| 2894 | Returns the old style symbol. |
| 2895 | |
| 2896 | See `ebnf-style-database' documentation." |
| 2897 | (interactive "SReset style: ") |
| 2898 | (setq ebnf-stack-style nil) |
| 2899 | (ebnf-apply-style (or style 'default))) |
| 2900 | |
| 2901 | |
| 2902 | ;;;###autoload |
| 2903 | (defun ebnf-push-style (&optional style) |
| 2904 | "Push the current style onto a stack and set STYLE as the current style. |
| 2905 | |
| 2906 | Returns the old style symbol. |
| 2907 | |
| 2908 | See also `ebnf-pop-style'. |
| 2909 | |
| 2910 | See `ebnf-style-database' documentation." |
| 2911 | (interactive "SPush style: ") |
| 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 () |
| 2921 | "Pop a style from the stack of pushed styles and set it as the current style. |
| 2922 | |
| 2923 | Returns the old style symbol. |
| 2924 | |
| 2925 | See also `ebnf-push-style'. |
| 2926 | |
| 2927 | See `ebnf-style-database' documentation." |
| 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 |
| 2946 | (and (memq (caar values) ebnf-style-custom-list) |
| 2947 | (setq style (cons (car values) style))) |
| 2948 | (setq values (cdr values))) |
| 2949 | (nreverse style))) |
| 2950 | |
| 2951 | \f |
| 2952 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 2953 | ;; Internal variables |
| 2954 | |
| 2955 | |
| 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) |
| 2962 | (make-variable-buffer-local 'ebnf-eps-upper-x) |
| 2963 | (defvar ebnf-eps-upper-y 0.0) |
| 2964 | (make-variable-buffer-local 'ebnf-eps-upper-y) |
| 2965 | (defvar ebnf-eps-prod-width 0.0) |
| 2966 | (make-variable-buffer-local 'ebnf-eps-prod-width) |
| 2967 | (defvar ebnf-eps-max-height 0.0) |
| 2968 | (make-variable-buffer-local 'ebnf-eps-max-height) |
| 2969 | (defvar ebnf-eps-max-width 0.0) |
| 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 | |
| 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 | |
| 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 | |
| 3006 | This is generated during parsing and used during EPS generation. |
| 3007 | |
| 3008 | See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps |
| 3009 | documentation.") |
| 3010 | |
| 3011 | |
| 3012 | (defconst ebnf-arrow-shape-alist |
| 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)) |
| 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 | |
| 3040 | (defvar ebnf-limit nil) |
| 3041 | (defvar ebnf-action nil) |
| 3042 | (defvar ebnf-action-list nil) |
| 3043 | |
| 3044 | |
| 3045 | (defvar ebnf-default-p nil) |
| 3046 | |
| 3047 | |
| 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) |
| 3065 | |
| 3066 | |
| 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) |
| 3073 | |
| 3074 | |
| 3075 | (defvar ebnf-settings nil) |
| 3076 | (defvar ebnf-fonts-required nil) |
| 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 |
| 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 |
| 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 | |
| 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 | |
| 3202 | %>Right Arrow: RA |
| 3203 | % \\ |
| 3204 | % *---+ |
| 3205 | % / |
| 3206 | /RA-vector |
| 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 |
| 3219 | ]def |
| 3220 | |
| 3221 | /RA |
| 3222 | {hT 0 rlineto |
| 3223 | c |
| 3224 | RA-vector ArrowShape get exec |
| 3225 | Gstroke |
| 3226 | moveto |
| 3227 | ExtraWidth 0 rmoveto |
| 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 | |
| 3263 | %>corner Right Descendant: height arrow corner_RD |
| 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 | |
| 3302 | %>corner Right Ascendant: height arrow corner_RA |
| 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 | |
| 3341 | %>corner Left Descendant: height arrow corner_LD |
| 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 | |
| 3380 | %>corner Left Ascendant: height arrow corner_LA |
| 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 | |
| 3421 | % height prepare-height |- line_height corner_height corner_height |
| 3422 | /prepare-height |
| 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} |
| 3448 | {prepare-height |
| 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 |
| 3469 | {prepare-height |
| 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} |
| 3494 | {prepare-height |
| 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 |
| 3515 | {prepare-height |
| 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 |
| 3526 | dup stringwidth pop space add space add width exch sub ExtraWidth sub 0.5 mul |
| 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 |
| 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 |
| 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 | |
| 4010 | % Initialize variables to avoid name-conflicting with document variables. |
| 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 | |
| 4293 | %%EndProlog |
| 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 |
| 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 |
| 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)) |
| 4429 | (rgb (ps-color-scale the-color))) |
| 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 | |
| 4445 | (defvar ebnf-total 0) |
| 4446 | (defvar ebnf-nprod 0) |
| 4447 | |
| 4448 | |
| 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) |
| 4564 | horizontal (memq (ebnf-node-action prod) |
| 4565 | ebnf-action-list)) |
| 4566 | ;; generate production in EPS buffer |
| 4567 | (with-current-buffer eps-buffer |
| 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 |
| 4582 | (with-current-buffer eps-buffer |
| 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)) |
| 4617 | (with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*")) |
| 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) |
| 4646 | (insert-buffer-substring eps-buffer)) |
| 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") |
| 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) |
| 4757 | (ps-output-string (if ebnf-production-name-p |
| 4758 | (ebnf-node-name production) |
| 4759 | "")) |
| 4760 | (ps-output " " |
| 4761 | (ebnf-format-float |
| 4762 | (ebnf-node-width production) |
| 4763 | (+ (if ebnf-production-name-p |
| 4764 | ebnf-basic-height |
| 4765 | 0.0) |
| 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)) |
| 4859 | (ebnf-empty-alternative (- width |
| 4860 | ebnf-horizontal-space |
| 4861 | ebnf-basic-width-extra)))) |
| 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)) |
| 4876 | ebnf-basic-empty-height)))) |
| 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))) |
| 4888 | (ebnf-empty-alternative (- width |
| 4889 | ebnf-horizontal-space |
| 4890 | ebnf-basic-width-extra)))) |
| 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 | |
| 4958 | (defun ebnf-directory (fun &optional directory) |
| 4959 | "Process files in DIRECTORY applying function FUN on each file. |
| 4960 | |
| 4961 | If DIRECTORY is nil, use `default-directory'. |
| 4962 | |
| 4963 | Only files in DIRECTORY that match `ebnf-file-suffix-regexp' (which see) are |
| 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) |
| 4977 | "Process the named FILE applying function FUN. |
| 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 | |
| 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 | |
| 4999 | (defvar ebnf-map-name |
| 5000 | (let ((map (make-vector 256 ?\_))) |
| 5001 | (mapc #'(lambda (char) |
| 5002 | (aset map char char)) |
| 5003 | (concat "#$%&+-.0123456789=?@~" |
| 5004 | "ABCDEFGHIJKLMNOPQRSTUVWXYZ" |
| 5005 | "abcdefghijklmnopqrstuvwxyz")) |
| 5006 | map)) |
| 5007 | |
| 5008 | |
| 5009 | (defun ebnf-eps-filename (str) |
| 5010 | (let* ((len (length str)) |
| 5011 | (stri 0) |
| 5012 | ;; to keep compatibility with Emacs 20 & 21: |
| 5013 | ;; DO NOT REPLACE `?\ ' BY `?\s' |
| 5014 | (new (make-string len ?\ ))) |
| 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)) |
| 5030 | (error-msg "SYNTAX") |
| 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 |
| 5038 | (setq error-msg "EMPTY RULES" |
| 5039 | tree (ebnf-eliminate-empty-rules tree)) |
| 5040 | (setq error-msg "OPTIMIZE" |
| 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 |
| 5047 | ;; handler |
| 5048 | ((quit error) |
| 5049 | (ding) |
| 5050 | (setq the-point (max (1- (point)) (point-min)) |
| 5051 | error-msg (concat error-msg ": " |
| 5052 | (error-message-string data) |
| 5053 | ", " |
| 5054 | (and (string= error-msg "SYNTAX") |
| 5055 | (format "at position %d " |
| 5056 | the-point)) |
| 5057 | (format "in buffer \"%s\"." |
| 5058 | (buffer-name))))))))) |
| 5059 | (cond |
| 5060 | ;; error occurred |
| 5061 | (error-msg |
| 5062 | (goto-char the-point) |
| 5063 | (if ebnf-stop-on-error |
| 5064 | (error error-msg) |
| 5065 | (message "%s" error-msg))) |
| 5066 | ;; generated output OK |
| 5067 | (gen-func |
| 5068 | nil) |
| 5069 | ;; syntax checked OK |
| 5070 | (t |
| 5071 | (message "EBNF syntactic analysis: NO ERRORS."))))) |
| 5072 | |
| 5073 | |
| 5074 | (defun ebnf-parse-and-sort (start) |
| 5075 | (ebnf-log "(ebnf-parse-and-sort %S)" start) |
| 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 | |
| 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) |
| 5179 | (ebnf ebnf-bnf-parser ebnf-bnf-initialize) |
| 5180 | (ebnfx ebnf-ebx-parser ebnf-ebx-initialize) |
| 5181 | (dtd ebnf-dtd-parser ebnf-dtd-initialize)) |
| 5182 | "Alist associating EBNF syntax with a parser and an initializer.") |
| 5183 | |
| 5184 | |
| 5185 | (defun ebnf-begin-job () |
| 5186 | (ps-printing-region nil nil nil) |
| 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 |
| 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))) |
| 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 |
| 5214 | ebnf-eps-file-alist nil |
| 5215 | ebnf-eps-production-list nil |
| 5216 | ebnf-eps-header-comment nil |
| 5217 | ebnf-eps-footer-comment nil |
| 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))) |
| 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 |
| 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)) |
| 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)) |
| 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) |
| 5277 | (with-current-buffer ps-spool-buffer |
| 5278 | (goto-char (point-min)) |
| 5279 | (and (search-forward "%%Creator: " nil t) |
| 5280 | (not (search-forward "& ebnf2ps v" |
| 5281 | (line-end-position) |
| 5282 | t)) |
| 5283 | (progn |
| 5284 | ;; adjust creator comment |
| 5285 | (end-of-line) |
| 5286 | ;; (backward-char) |
| 5287 | (insert " & ebnf2ps v" ebnf-version) |
| 5288 | ;; insert ebnf settings & engine |
| 5289 | (goto-char (point-max)) |
| 5290 | (search-backward "\n%%EndProlog\n") |
| 5291 | (ebnf-insert-ebnf-prologue) |
| 5292 | (ps-output "\n"))))) |
| 5293 | |
| 5294 | |
| 5295 | (defun ebnf-eps-finish-and-write (buffer filename) |
| 5296 | (when (buffer-modified-p buffer) |
| 5297 | (with-current-buffer buffer |
| 5298 | (ebnf-eps-header-footer-set filename) |
| 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 |
| 5325 | ebnf-repeat-font |
| 5326 | ebnf-eps-header-font |
| 5327 | ebnf-eps-footer-font))) |
| 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)))) |
| 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" |
| 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)) |
| 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 |
| 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)) |
| 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" |
| 5531 | (let ((arrow (eval ebnf-user-arrow))) |
| 5532 | (if (stringp arrow) |
| 5533 | arrow |
| 5534 | ""))) |
| 5535 | "\n% === end EBNF settings\n\n" |
| 5536 | (and ebnf-debug-ps ebnf-debug)))) |
| 5537 | ebnf-prologue)) |
| 5538 | |
| 5539 | \f |
| 5540 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 5541 | ;; Adjusting dimensions |
| 5542 | |
| 5543 | |
| 5544 | (defun ebnf-dimensions (tree) |
| 5545 | (ebnf-log "(ebnf-dimensions tree)") |
| 5546 | (let ((ebnf-total (length tree)) |
| 5547 | (ebnf-nprod 0)) |
| 5548 | (mapc 'ebnf-production-dimension tree)) |
| 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) |
| 5559 | (ebnf-log "(ebnf-production-dimension production)") |
| 5560 | (ebnf-message-info "Calculating dimensions") |
| 5561 | (ebnf-node-dimension-func (ebnf-node-production production)) |
| 5562 | (let* ((prod (ebnf-node-production production)) |
| 5563 | (height (+ (if ebnf-production-name-p |
| 5564 | ebnf-font-height-P |
| 5565 | 0.0) |
| 5566 | ebnf-line-width ebnf-line-width |
| 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) |
| 5572 | ebnf-line-width |
| 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))) |
| 5579 | |
| 5580 | |
| 5581 | ;; [terminal width-fun dim-fun entry height width name] |
| 5582 | (defun ebnf-terminal-dimension (terminal) |
| 5583 | (ebnf-log "(ebnf-terminal-dimension terminal)") |
| 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) |
| 5592 | (ebnf-log "(ebnf-non-terminal-dimension non-terminal)") |
| 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) |
| 5601 | (ebnf-log "(ebnf-special-dimension special)") |
| 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) |
| 5613 | (ebnf-node-width node (+ ebnf-basic-width |
| 5614 | ebnf-arrow-extra-width |
| 5615 | space |
| 5616 | (* len font-width) |
| 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))) |
| 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) |
| 5630 | (ebnf-log "(ebnf-repeat-dimension repeat)") |
| 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) |
| 5642 | ebnf-arrow-extra-width |
| 5643 | ebnf-space-R ebnf-space-R ebnf-space-R |
| 5644 | ebnf-horizontal-space |
| 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))) |
| 5649 | |
| 5650 | |
| 5651 | ;; [except width-fun dim-fun entry height width element element] |
| 5652 | (defun ebnf-except-dimension (except) |
| 5653 | (ebnf-log "(ebnf-except-dimension except)") |
| 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) |
| 5668 | ebnf-arrow-extra-width |
| 5669 | ebnf-space-E ebnf-space-E |
| 5670 | ebnf-space-E ebnf-space-E |
| 5671 | ebnf-font-width-E |
| 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))) |
| 5676 | |
| 5677 | |
| 5678 | ;; [alternative width-fun dim-fun entry height width list] |
| 5679 | (defun ebnf-alternative-dimension (alternative) |
| 5680 | (ebnf-log "(ebnf-alternative-dimension alternative)") |
| 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) |
| 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))) |
| 5712 | |
| 5713 | |
| 5714 | ;; [optional width-fun dim-fun entry height width element] |
| 5715 | (defun ebnf-optional-dimension (optional) |
| 5716 | (ebnf-log "(ebnf-optional-dimension optional)") |
| 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) |
| 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))) |
| 5727 | |
| 5728 | |
| 5729 | ;; [one-or-more width-fun dim-fun entry height width element separator] |
| 5730 | (defun ebnf-one-or-more-dimension (or-more) |
| 5731 | (ebnf-log "(ebnf-one-or-more-dimension or-more)") |
| 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) |
| 5739 | ebnf-basic-empty-height) |
| 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)) |
| 5749 | (ebnf-node-entry or-more (+ (- height |
| 5750 | (ebnf-node-height list-part)) |
| 5751 | (ebnf-node-entry list-part))) |
| 5752 | (ebnf-node-height or-more height) |
| 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))) |
| 5759 | |
| 5760 | |
| 5761 | ;; [zero-or-more width-fun dim-fun entry height width element separator] |
| 5762 | (defun ebnf-zero-or-more-dimension (or-more) |
| 5763 | (ebnf-log "(ebnf-zero-or-more-dimension or-more)") |
| 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) |
| 5771 | ebnf-basic-empty-height) |
| 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) |
| 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))) |
| 5790 | |
| 5791 | |
| 5792 | ;; [sequence width-fun dim-fun entry height width list] |
| 5793 | (defun ebnf-sequence-dimension (sequence) |
| 5794 | (ebnf-log "(ebnf-sequence-dimension sequence)") |
| 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)) |
| 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))) |
| 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] |
| 5881 | (defun ebnf-element-width (or-more width) |
| 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 |
| 5896 | (ebnf-justify-list sequence |
| 5897 | (ebnf-node-list sequence) |
| 5898 | width))) |
| 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)) |
| 5912 | ;; centralize terms -- element |
| 5913 | ((vectorp seq) |
| 5914 | (ebnf-adjust-width seq width)) |
| 5915 | ;; centralize terms -- list |
| 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) |
| 5955 | (setq ebnf-eps-context (cons filename ebnf-eps-context))) |
| 5956 | (ebnf-eps-header-footer-file filename))) |
| 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) |
| 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))))) |
| 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 | |
| 5995 | ;; replace the range "\240-\377" (see `ebnf-range-regexp'). |
| 5996 | (defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377)) |
| 5997 | |
| 5998 | |
| 5999 | (defun ebnf-string (chars eos-char kind) |
| 6000 | (forward-char) |
| 6001 | (buffer-substring-no-properties |
| 6002 | (point) |
| 6003 | (progn |
| 6004 | ;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit) |
| 6005 | (skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit) |
| 6006 | (if (or (eobp) (/= (following-char) eos-char)) |
| 6007 | (error "Invalid %s: missing `%c'" kind eos-char) |
| 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)) |
| 6025 | (error "Missing `\"'"))) |
| 6026 | |
| 6027 | |
| 6028 | (defun ebnf-trim-right (str) |
| 6029 | (let* ((len (1- (length str))) |
| 6030 | (index len)) |
| 6031 | ;; to keep compatibility with Emacs 20 & 21: |
| 6032 | ;; DO NOT REPLACE `?\ ' BY `?\s' |
| 6033 | (while (and (> index 0) (= (aref str index) ?\ )) |
| 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) |
| 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 |
| 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) |
| 6072 | (vector gen-func ; 0 generator |
| 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 |
| 6079 | (cond ((> len 3) name) |
| 6080 | ((= len 3) (concat name " ")) |
| 6081 | ((= len 2) (concat " " name " ")) |
| 6082 | ((= len 1) (concat " " name " ")) |
| 6083 | (t " "))) |
| 6084 | ebnf-default-p)) ; 7 is default? |
| 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) |
| 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 |
| 6109 | (ebnf-make-sequence list-part) |
| 6110 | list-part) |
| 6111 | (if (and sep-part (listp sep-part)) ; 7 separator |
| 6112 | (ebnf-make-sequence sep-part) |
| 6113 | sep-part))) |
| 6114 | |
| 6115 | |
| 6116 | (defun ebnf-make-production (name prod action) |
| 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 |
| 6126 | |
| 6127 | |
| 6128 | (defun ebnf-make-alternative (body) |
| 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 |
| 6136 | |
| 6137 | |
| 6138 | (defun ebnf-make-optional (body) |
| 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 |
| 6146 | |
| 6147 | |
| 6148 | (defun ebnf-make-except (factor exception) |
| 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 |
| 6157 | |
| 6158 | |
| 6159 | (defun ebnf-make-repeat (times primary &optional upper) |
| 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 |
| 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 | " * ")) |
| 6179 | primary)) ; 7 element |
| 6180 | |
| 6181 | |
| 6182 | (defun ebnf-make-sequence (seq) |
| 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 |
| 6190 | |
| 6191 | |
| 6192 | (defun ebnf-make-dup-sequence (node seq) |
| 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 |
| 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) |
| 6227 | (eq (ebnf-node-kind |
| 6228 | (car (last (ebnf-node-list element)))) |
| 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 | |
| 6250 | (defun ebnf-token-repeat (times repeat &optional upper) |
| 6251 | (if (null (cdr repeat)) |
| 6252 | ;; n * EMPTY ==> EMPTY |
| 6253 | repeat |
| 6254 | ;; n * term |
| 6255 | (cons (car repeat) |
| 6256 | (ebnf-make-repeat times (cdr repeat) upper)))) |
| 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) |
| 6286 | ;; no alternative |
| 6287 | sequence |
| 6288 | ;; empty element |
| 6289 | (cons (car sequence) ; token |
| 6290 | (ebnf-make-empty))) |
| 6291 | (cons (car sequence) ; token |
| 6292 | (let ((seq (cdr sequence))) |
| 6293 | (if (and (= (length body) 1) (null seq)) |
| 6294 | ;; alternative with one element |
| 6295 | (car body) |
| 6296 | ;; a real alternative |
| 6297 | (ebnf-make-alternative (nreverse (if seq |
| 6298 | (cons seq body) |
| 6299 | body)))))))) |
| 6300 | |
| 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 | |
| 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) |
| 6325 | (aset table ?^ 'form-feed) |
| 6326 | table) |
| 6327 | "Vector used to map characters to a special comment token.") |
| 6328 | |
| 6329 | \f |
| 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 |
| 6346 | (with-current-buffer (get-buffer-create "*Ebnf2ps Log*") |
| 6347 | (goto-char (point-max)) |
| 6348 | (insert (apply 'format format-str args) "\n")))) |
| 6349 | |
| 6350 | \f |
| 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 | |
| 6355 | (autoload 'ebnf-abn-parser "ebnf-abn" |
| 6356 | "ABNF parser.") |
| 6357 | |
| 6358 | (autoload 'ebnf-abn-initialize "ebnf-abn" |
| 6359 | "Initialize ABNF token table.") |
| 6360 | |
| 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 | |
| 6379 | (autoload 'ebnf-ebx-parser "ebnf-ebx" |
| 6380 | "EBNFX parser.") |
| 6381 | |
| 6382 | (autoload 'ebnf-ebx-initialize "ebnf-ebx" |
| 6383 | "Initializations for EBNFX parser.") |
| 6384 | |
| 6385 | (autoload 'ebnf-dtd-parser "ebnf-dtd" |
| 6386 | "DTD parser.") |
| 6387 | |
| 6388 | (autoload 'ebnf-dtd-initialize "ebnf-dtd" |
| 6389 | "Initializations for DTD parser.") |
| 6390 | |
| 6391 | \f |
| 6392 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
| 6393 | |
| 6394 | |
| 6395 | (provide 'ebnf2ps) |
| 6396 | |
| 6397 | ;;; ebnf2ps.el ends here |