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