mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
5866 lines
162 KiB
EmacsLisp
5866 lines
162 KiB
EmacsLisp
;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
|
||
|
||
;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005
|
||
;; Free Software Foundation, Inc.
|
||
|
||
;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
|
||
;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br>
|
||
;; Time-stamp: <2005-09-18 07:27:20 deego>
|
||
;; Keywords: wp, ebnf, PostScript
|
||
;; Version: 4.2
|
||
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
|
||
|
||
;; This file is part of GNU Emacs.
|
||
|
||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation; either version 2, or (at your option)
|
||
;; any later version.
|
||
|
||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with GNU Emacs; see the file COPYING. If not, write to the
|
||
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||
;; Boston, MA 02110-1301, USA.
|
||
|
||
(defconst ebnf-version "4.2"
|
||
"ebnf2ps.el, v 4.2 <2004/04/04 vinicius>
|
||
|
||
Vinicius's last change version. When reporting bugs, please also
|
||
report the version of Emacs, if any, that ebnf2ps was running with.
|
||
|
||
Please send all bug fixes and enhancements to
|
||
Vinicius Jose Latorre <viniciusjl@ig.com.br>.
|
||
")
|
||
|
||
|
||
;;; Commentary:
|
||
|
||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;;
|
||
;; Introduction
|
||
;; ------------
|
||
;;
|
||
;; This package translates an EBNF to a syntactic chart on PostScript.
|
||
;;
|
||
;; To use ebnf2ps, insert in your ~/.emacs:
|
||
;;
|
||
;; (require 'ebnf2ps)
|
||
;;
|
||
;; ebnf2ps uses ps-print package (version 5.2.3 or later), so see ps-print to
|
||
;; know how to set options like landscape printing, page headings, margins,
|
||
;; etc.
|
||
;;
|
||
;; NOTE: ps-print zebra stripes and line number options doesn't have effect on
|
||
;; ebnf2ps, they behave as it's turned off.
|
||
;;
|
||
;; For good performance, be sure to byte-compile ebnf2ps.el, e.g.
|
||
;;
|
||
;; M-x byte-compile-file <give the path to ebnf2ps.el when prompted>
|
||
;;
|
||
;; This will generate ebnf2ps.elc, which will be loaded instead of ebnf2ps.el.
|
||
;;
|
||
;; ebnf2ps was tested with GNU Emacs 20.4.1.
|
||
;;
|
||
;;
|
||
;; Using ebnf2ps
|
||
;; -------------
|
||
;;
|
||
;; ebnf2ps provides the following commands for generating PostScript syntactic
|
||
;; chart images of Emacs buffers:
|
||
;;
|
||
;; ebnf-print-directory
|
||
;; ebnf-print-file
|
||
;; ebnf-print-buffer
|
||
;; ebnf-print-region
|
||
;; ebnf-spool-directory
|
||
;; ebnf-spool-file
|
||
;; ebnf-spool-buffer
|
||
;; ebnf-spool-region
|
||
;; ebnf-eps-directory
|
||
;; ebnf-eps-file
|
||
;; ebnf-eps-buffer
|
||
;; ebnf-eps-region
|
||
;;
|
||
;; These commands all perform essentially the same function: they generate
|
||
;; PostScript syntactic chart images suitable for printing on a PostScript
|
||
;; printer or displaying with GhostScript. These commands are collectively
|
||
;; referred to as "ebnf- commands".
|
||
;;
|
||
;; The word "print", "spool" and "eps" in the command name determines when the
|
||
;; PostScript image is sent to the printer (or file):
|
||
;;
|
||
;; print - The PostScript image is immediately sent to the printer;
|
||
;;
|
||
;; spool - The PostScript image is saved temporarily in an Emacs buffer.
|
||
;; Many images may be spooled locally before printing them. To
|
||
;; send the spooled images to the printer, use the command
|
||
;; `ebnf-despool'.
|
||
;;
|
||
;; eps - The PostScript image is immediately sent to a EPS file.
|
||
;;
|
||
;; The spooling mechanism is the same as used by ps-print and was designed for
|
||
;; printing lots of small files to save paper that would otherwise be wasted on
|
||
;; banner pages, and to make it easier to find your output at the printer (it's
|
||
;; easier to pick up one 50-page printout than to find 50 single-page
|
||
;; printouts). As ebnf2ps and ps-print use the same Emacs buffer to spool
|
||
;; images, you can intermix the spooling of ebnf2ps and ps-print images.
|
||
;;
|
||
;; ebnf2ps use the same hook of ps-print in the `kill-emacs-hook' so that you
|
||
;; won't accidentally quit from Emacs while you have unprinted PostScript
|
||
;; waiting in the spool buffer. If you do attempt to exit with spooled
|
||
;; PostScript, you'll be asked if you want to print it, and if you decline,
|
||
;; you'll be asked to confirm the exit; this is modeled on the confirmation
|
||
;; that Emacs uses for modified buffers.
|
||
;;
|
||
;; The word "directory", "file", "buffer" or "region" in the command name
|
||
;; determines how much of the buffer is printed:
|
||
;;
|
||
;; directory - Read files in the directory and print them.
|
||
;;
|
||
;; file - Read file and print it.
|
||
;;
|
||
;; buffer - Print the entire buffer.
|
||
;;
|
||
;; region - Print just the current region.
|
||
;;
|
||
;; Two ebnf- command examples:
|
||
;;
|
||
;; ebnf-print-buffer - translate and print the entire buffer, and send it
|
||
;; immediately to the printer.
|
||
;;
|
||
;; ebnf-spool-region - translate and print just the current region, and
|
||
;; spool the image in Emacs to send to the printer
|
||
;; later.
|
||
;;
|
||
;; Note that `ebnf-eps-directory', `ebnf-eps-file', `ebnf-eps-buffer' and
|
||
;; `ebnf-eps-region' never spool the EPS image, so they don't use the ps-print
|
||
;; spooling mechanism. See section "Actions in Comments" for an explanation
|
||
;; about EPS file generation.
|
||
;;
|
||
;;
|
||
;; Invoking Ebnf2ps
|
||
;; ----------------
|
||
;;
|
||
;; To translate and print your buffer, type
|
||
;;
|
||
;; M-x ebnf-print-buffer
|
||
;;
|
||
;; or substitute one of the other four ebnf- commands. The command will
|
||
;; generate the PostScript image and print or spool it as specified. By giving
|
||
;; the command a prefix argument
|
||
;;
|
||
;; C-u M-x ebnf-print-buffer
|
||
;;
|
||
;; it will save the PostScript image to a file instead of sending it to the
|
||
;; printer; you will be prompted for the name of the file to save the image to.
|
||
;; The prefix argument is ignored by the commands that spool their images, but
|
||
;; you may save the spooled images to a file by giving a prefix argument to
|
||
;; `ebnf-despool':
|
||
;;
|
||
;; C-u M-x ebnf-despool
|
||
;;
|
||
;; When invoked this way, `ebnf-despool' will prompt you for the name of the
|
||
;; file to save to.
|
||
;;
|
||
;; The prefix argument is also ignored by `ebnf-eps-buffer' and
|
||
;; `ebnf-eps-region'.
|
||
;;
|
||
;; Any of the `ebnf-' commands can be bound to keys. Here are some examples:
|
||
;;
|
||
;; (global-set-key 'f22 'ebnf-print-buffer) ;f22 is prsc
|
||
;; (global-set-key '(shift f22) 'ebnf-print-region)
|
||
;; (global-set-key '(control f22) 'ebnf-despool)
|
||
;;
|
||
;;
|
||
;; Invoking Ebnf2ps in Batch
|
||
;; -------------------------
|
||
;;
|
||
;; It's possible also to run ebnf2ps in batch, this is useful when, for
|
||
;; example, you have a directory with a lot of files containing the EBNF to be
|
||
;; translated to PostScript.
|
||
;;
|
||
;; To run ebnf2ps in batch type, for example:
|
||
;;
|
||
;; emacs -batch -l setup-ebnf2ps.el -f ebnf-eps-directory
|
||
;;
|
||
;; Where setup-ebnf2ps.el should be a file containing:
|
||
;;
|
||
;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
|
||
;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
|
||
;; (require 'ebnf2ps)
|
||
;; ;; insert here your ebnf2ps settings
|
||
;; (setq ebnf-terminal-shape 'bevel)
|
||
;; ;; etc.
|
||
;;
|
||
;;
|
||
;; EBNF Syntax
|
||
;; -----------
|
||
;;
|
||
;; BNF (Backus Naur Form) notation is defined like languages, and like
|
||
;; languages there are rules about name formation and syntax. In this section
|
||
;; it's defined a BNF syntax that it's called simply EBNF (Extended BNF).
|
||
;; ebnf2ps package also deal with other BNF notation. Please, see the variable
|
||
;; `ebnf-syntax' documentation below in this section.
|
||
;;
|
||
;; The current EBNF that ebnf2ps accepts has the following constructions:
|
||
;;
|
||
;; ; comment (until end of line)
|
||
;; A non-terminal
|
||
;; "C" terminal
|
||
;; ?C? special
|
||
;; $A default non-terminal (see text below)
|
||
;; $"C" default terminal (see text below)
|
||
;; $?C? default special (see text below)
|
||
;; A = B. production (A is the header and B the body)
|
||
;; C D sequence (C occurs before D)
|
||
;; C | D alternative (C or D occurs)
|
||
;; A - B exception (A excluding B, B without any non-terminal)
|
||
;; n * A repetition (A repeats at least n (integer) times)
|
||
;; n * n A repetition (A repeats exactly n (integer) times)
|
||
;; n * m A repetition (A repeats at least n (integer) and at most
|
||
;; m (integer) times)
|
||
;; (C) group (expression C is grouped together)
|
||
;; [C] optional (C may or not occurs)
|
||
;; C+ one or more occurrences of C
|
||
;; {C}+ one or more occurrences of C
|
||
;; {C}* zero or more occurrences of C
|
||
;; {C} zero or more occurrences of C
|
||
;; C / D equivalent to: C {D C}*
|
||
;; {C || D}+ equivalent to: C {D C}*
|
||
;; {C || D}* equivalent to: [C {D C}*]
|
||
;; {C || D} equivalent to: [C {D C}*]
|
||
;;
|
||
;; The EBNF syntax written using the notation above is:
|
||
;;
|
||
;; EBNF = {production}+.
|
||
;;
|
||
;; production = non_terminal "=" body ".". ;; production
|
||
;;
|
||
;; body = {sequence || "|"}*. ;; alternative
|
||
;;
|
||
;; sequence = {exception}*. ;; sequence
|
||
;;
|
||
;; exception = repeat [ "-" repeat]. ;; exception
|
||
;;
|
||
;; repeat = [ integer "*" [ integer ]] term. ;; repetition
|
||
;;
|
||
;; term = factor
|
||
;; | [factor] "+" ;; one-or-more
|
||
;; | [factor] "/" [factor] ;; one-or-more
|
||
;; .
|
||
;;
|
||
;; factor = [ "$" ] "\"" terminal "\"" ;; terminal
|
||
;; | [ "$" ] non_terminal ;; non-terminal
|
||
;; | [ "$" ] "?" special "?" ;; special
|
||
;; | "(" body ")" ;; group
|
||
;; | "[" body "]" ;; zero-or-one
|
||
;; | "{" body [ "||" body ] "}+" ;; one-or-more
|
||
;; | "{" body [ "||" body ] "}*" ;; zero-or-more
|
||
;; | "{" body [ "||" body ] "}" ;; zero-or-more
|
||
;; .
|
||
;;
|
||
;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
|
||
;; ;; that is, a valid non_terminal accepts decimal digits, letters (upper
|
||
;; ;; and lower), 8-bit accentuated characters,
|
||
;; ;; "!", "#", "%", "&", "'", "*", "+", ",", ":",
|
||
;; ;; "<", ">", "@", "\", "^", "_", "`" and "~".
|
||
;;
|
||
;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
|
||
;; ;; that is, a valid terminal accepts any printable character (including
|
||
;; ;; 8-bit accentuated characters) except `"', as `"' is used to delimit a
|
||
;; ;; terminal. Also, accepts escaped characters, that is, a character
|
||
;; ;; pair starting with `\' followed by a printable character, for
|
||
;; ;; example: \", \\.
|
||
;;
|
||
;; special = "[^?\\000-\\010\\012-\\037\\177-\\237]*".
|
||
;; ;; that is, a valid special accepts any printable character (including
|
||
;; ;; 8-bit accentuated characters) and tabs except `?', as `?' is used to
|
||
;; ;; delimit a special.
|
||
;;
|
||
;; integer = "[0-9]+".
|
||
;; ;; that is, an integer is a sequence of one or more decimal digits.
|
||
;;
|
||
;; comment = ";" "[^\\n\\000-\\010\\016-\\037\\177-\\237]*" "\\n".
|
||
;; ;; that is, a comment starts with the character `;' and terminates at end
|
||
;; ;; of line. Also, it only accepts printable characters (including 8-bit
|
||
;; ;; accentuated characters) and tabs.
|
||
;;
|
||
;; Try to use the above EBNF to test ebnf2ps.
|
||
;;
|
||
;; The `default' terminal, non-terminal and special is a way to indicate a
|
||
;; default path in a production. For example, the production:
|
||
;;
|
||
;; X = [ $A ( B | $C ) | D ].
|
||
;;
|
||
;; Indicates that the default meaning for "X" is "A C" if "X" is empty.
|
||
;;
|
||
;; The terminal name is controlled by `ebnf-terminal-regexp' and
|
||
;; `ebnf-case-fold-search', so it's possible to match other kind of terminal
|
||
;; name besides that enclosed by `"'.
|
||
;;
|
||
;; Let's see an example:
|
||
;;
|
||
;; (setq ebnf-terminal-regexp "[A-Z][_A-Z]*") ; upper case name
|
||
;; (setq ebnf-case-fold-search nil) ; exact matching
|
||
;;
|
||
;; If you have the production:
|
||
;;
|
||
;; Logical = "(" Expression ( OR | AND | "XOR" ) Expression ")".
|
||
;;
|
||
;; The names are classified as:
|
||
;;
|
||
;; Logical Expression non-terminal
|
||
;; "(" OR AND "XOR" ")" terminal
|
||
;;
|
||
;; The line comment is controlled by `ebnf-lex-comment-char'. The default
|
||
;; value is ?\; (character `;').
|
||
;;
|
||
;; The end of production is controlled by `ebnf-lex-eop-char'. The default
|
||
;; value is ?. (character `.').
|
||
;;
|
||
;; The variable `ebnf-syntax' specifies which syntax to recognize:
|
||
;;
|
||
;; `ebnf' ebnf2ps recognizes the syntax described above.
|
||
;; The following variables *ONLY* have effect with this
|
||
;; setting:
|
||
;; `ebnf-terminal-regexp', `ebnf-case-fold-search',
|
||
;; `ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
|
||
;;
|
||
;; `abnf' ebnf2ps recognizes the syntax described in the URL:
|
||
;; `http://www.ietf.org/rfc/rfc2234.txt'
|
||
;; ("Augmented BNF for Syntax Specifications: ABNF").
|
||
;;
|
||
;; `iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
|
||
;; `http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
|
||
;; ("International Standard of the ISO EBNF Notation").
|
||
;; The following variables *ONLY* have effect with this
|
||
;; setting:
|
||
;; `ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
|
||
;;
|
||
;; `yacc' ebnf2ps recognizes the Yacc/Bison syntax.
|
||
;; The following variable *ONLY* has effect with this
|
||
;; setting:
|
||
;; `ebnf-yac-ignore-error-recovery'.
|
||
;;
|
||
;; `ebnfx' ebnf2ps recognizes the syntax described in the URL:
|
||
;; `http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
|
||
;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
|
||
;;
|
||
;; `dtd' ebnf2ps recognizes the syntax described in the URL:
|
||
;; `http://www.w3.org/TR/2004/REC-xml-20040204/'
|
||
;; ("Extensible Markup Language (XML) 1.0 (Third Edition)")
|
||
;;
|
||
;; Any other value is treated as `ebnf'.
|
||
;;
|
||
;; The default value is `ebnf'.
|
||
;;
|
||
;;
|
||
;; Optimizations
|
||
;; -------------
|
||
;;
|
||
;; The following EBNF optimizations are done:
|
||
;;
|
||
;; [ { A }* ] ==> { A }*
|
||
;; [ { A }+ ] ==> { A }*
|
||
;; [ A ] + ==> { A }*
|
||
;; { A }* + ==> { A }*
|
||
;; { A }+ + ==> { A }+
|
||
;; { A }- ==> { A }+
|
||
;; [ A ]- ==> A
|
||
;; ( A | EMPTY )- ==> A
|
||
;; ( A | B | EMPTY )- ==> A | B
|
||
;; [ A | B ] ==> A | B | EMPTY
|
||
;; n * EMPTY ==> EMPTY
|
||
;; EMPTY + ==> EMPTY
|
||
;; EMPTY / EMPTY ==> EMPTY
|
||
;; EMPTY - A ==> EMPTY
|
||
;;
|
||
;; The following optimizations are done when `ebnf-optimize' is non-nil:
|
||
;;
|
||
;; left recursion:
|
||
;; 1. A = B | A C. ==> A = B {C}*.
|
||
;; 2. A = B | A B. ==> A = {B}+.
|
||
;; 3. A = | A B. ==> A = {B}*.
|
||
;; 4. A = B | A C B. ==> A = {B || C}+.
|
||
;; 5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
|
||
;;
|
||
;; optional:
|
||
;; 6. A = B | . ==> A = [B].
|
||
;; 7. A = | B . ==> A = [B].
|
||
;;
|
||
;; factorization:
|
||
;; 8. A = B C | B D. ==> A = B (C | D).
|
||
;; 9. A = C B | D B. ==> A = (C | D) B.
|
||
;; 10. A = B C E | B D E. ==> A = B (C | D) E.
|
||
;;
|
||
;; The above optimizations are specially useful when `ebnf-syntax' is `yacc'.
|
||
;;
|
||
;;
|
||
;; Form Feed
|
||
;; ---------
|
||
;;
|
||
;; You may use form feed (^L \014) to force a production to start on a new
|
||
;; page, for example:
|
||
;;
|
||
;; a) A = B | C.
|
||
;; ^L
|
||
;; X = Y | Z.
|
||
;;
|
||
;; b) A = B ^L | C.
|
||
;; X = Y | Z.
|
||
;;
|
||
;; c) A = B ^L^L^L | C.^L
|
||
;; ^L
|
||
;; X = Y | Z.
|
||
;;
|
||
;; In all examples above, only the production X will start on a new page.
|
||
;;
|
||
;;
|
||
;; Actions in Comments
|
||
;; -------------------
|
||
;;
|
||
;; ebnf2ps accepts the following actions in comments:
|
||
;;
|
||
;; ;^ same as form feed. See section Form Feed above.
|
||
;;
|
||
;; ;> the next production starts in the same line as the current one.
|
||
;; It is useful when `ebnf-horizontal-orientation' is nil.
|
||
;;
|
||
;; ;< the next production starts in the next line.
|
||
;; It is useful when `ebnf-horizontal-orientation' is non-nil.
|
||
;;
|
||
;; ;[EPS open a new EPS file. The EPS file name has the form:
|
||
;; <PREFIX><NAME>.eps
|
||
;; where <PREFIX> is given by variable `ebnf-eps-prefix' and
|
||
;; <NAME> is the string given by ;[ action comment, this string is
|
||
;; mapped to form a valid file name (see documentation for
|
||
;; `ebnf-eps-buffer' or `ebnf-eps-region').
|
||
;; It has effect only during `ebnf-eps-buffer' or
|
||
;; `ebnf-eps-region' execution.
|
||
;; It's an error to try to open an already opened EPS file.
|
||
;;
|
||
;; ;]EPS close an opened EPS file.
|
||
;; It has effect only during `ebnf-eps-buffer' or
|
||
;; `ebnf-eps-region' execution.
|
||
;; It's an error to try to close a not opened EPS file.
|
||
;;
|
||
;; So if you have:
|
||
;;
|
||
;; (setq ebnf-horizontal-orientation nil)
|
||
;;
|
||
;; A = t.
|
||
;; C = x.
|
||
;; ;> C and B are drawn in the same line
|
||
;; B = y.
|
||
;; W = v.
|
||
;;
|
||
;; The graphical result is:
|
||
;;
|
||
;; +---+
|
||
;; | A |
|
||
;; +---+
|
||
;;
|
||
;; +---------+ +-----+
|
||
;; | | | |
|
||
;; | C | | |
|
||
;; | | | B |
|
||
;; +---------+ | |
|
||
;; | |
|
||
;; +-----+
|
||
;;
|
||
;; +-----------+
|
||
;; | W |
|
||
;; +-----------+
|
||
;;
|
||
;; Note that if ascending production sort is used, the productions A and B will
|
||
;; be drawn in the same line instead of C and B.
|
||
;;
|
||
;; If consecutive actions occur, only the last one takes effect, so if you
|
||
;; have:
|
||
;;
|
||
;; A = X.
|
||
;; ;<
|
||
;; ^L
|
||
;; ;>
|
||
;; B = Y.
|
||
;;
|
||
;; Only the ;> will take effect, that is, A and B will be drawn in the same
|
||
;; line.
|
||
;;
|
||
;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*)
|
||
;; and (*]EPS*). The first example above should be written:
|
||
;;
|
||
;; A = t;
|
||
;; C = x;
|
||
;; (*> C and B are drawn in the same line *)
|
||
;; B = y;
|
||
;; W = v;
|
||
;;
|
||
;; For an example of EPS action when executing `ebnf-eps-buffer' or
|
||
;; `ebnf-eps-region':
|
||
;;
|
||
;; Z = B0.
|
||
;; ;[CC
|
||
;; ;[AA
|
||
;; A = B1.
|
||
;; ;[BB
|
||
;; C = B2.
|
||
;; ;]AA
|
||
;; B = B3.
|
||
;; ;]BB
|
||
;; ;]CC
|
||
;; D = B4.
|
||
;; E = B5.
|
||
;; ;[CC
|
||
;; F = B6.
|
||
;; ;]CC
|
||
;; G = B7.
|
||
;;
|
||
;; The following table summarizes the results:
|
||
;;
|
||
;; EPS FILE NAME NO SORT ASCENDING SORT DESCENDING SORT
|
||
;; ebnf--AA.eps A C A C C A
|
||
;; ebnf--BB.eps C B B C C B
|
||
;; ebnf--CC.eps A C B F A B C F F C B A
|
||
;; ebnf--D.eps D D D
|
||
;; ebnf--E.eps E E E
|
||
;; ebnf--G.eps G G G
|
||
;; ebnf--Z.eps Z Z Z
|
||
;;
|
||
;; As you can see if EPS actions is not used, each single production is
|
||
;; generated per EPS file. To avoid overriding EPS files, use names in ;[ that
|
||
;; it's not an existing production name.
|
||
;;
|
||
;; In the following case:
|
||
;;
|
||
;; A = B0.
|
||
;; ;[AA
|
||
;; A = B1.
|
||
;; ;[BB
|
||
;; A = B2.
|
||
;;
|
||
;; The production A is generated in both files ebnf--AA.eps and ebnf--BB.eps.
|
||
;;
|
||
;;
|
||
;; Utilities
|
||
;; ---------
|
||
;;
|
||
;; Some tools are provided to help you.
|
||
;;
|
||
;; `ebnf-setup' returns the current setup.
|
||
;;
|
||
;; `ebnf-syntax-directory' does a syntactic analysis of your EBNF files in the
|
||
;; given directory.
|
||
;;
|
||
;; `ebnf-syntax-file' does a syntactic analysis of your EBNF in the given
|
||
;; file.
|
||
;;
|
||
;; `ebnf-syntax-buffer' does a syntactic analysis of your EBNF in the current
|
||
;; buffer.
|
||
;;
|
||
;; `ebnf-syntax-region' does a syntactic analysis of your EBNF in the current
|
||
;; region.
|
||
;;
|
||
;; `ebnf-customize' activates a customization buffer for ebnf2ps options.
|
||
;;
|
||
;; `ebnf-syntax-directory', `ebnf-syntax-file', `ebnf-syntax-buffer',
|
||
;; `ebnf-syntax-region' and `ebnf-customize' can be bound to keys in the same
|
||
;; way as `ebnf-' commands.
|
||
;;
|
||
;;
|
||
;; Hooks
|
||
;; -----
|
||
;;
|
||
;; ebn2ps has the following hook variables:
|
||
;;
|
||
;; `ebnf-hook'
|
||
;; It is evaluated once before any ebnf2ps process.
|
||
;;
|
||
;; `ebnf-production-hook'
|
||
;; It is evaluated on each beginning of production.
|
||
;;
|
||
;; `ebnf-page-hook'
|
||
;; It is evaluated on each beginning of page.
|
||
;;
|
||
;;
|
||
;; Options
|
||
;; -------
|
||
;;
|
||
;; Below it's shown a brief description of ebnf2ps options, please, see the
|
||
;; options declaration in the code for a long documentation.
|
||
;;
|
||
;; `ebnf-horizontal-orientation' Non-nil means productions are drawn
|
||
;; horizontally.
|
||
;;
|
||
;; `ebnf-horizontal-max-height' Non-nil means to use maximum production
|
||
;; height in horizontal orientation.
|
||
;;
|
||
;; `ebnf-production-horizontal-space' Specify horizontal space in points
|
||
;; between productions.
|
||
;;
|
||
;; `ebnf-production-vertical-space' Specify vertical space in points
|
||
;; between productions.
|
||
;;
|
||
;; `ebnf-justify-sequence' Specify justification of terms in a
|
||
;; sequence inside alternatives.
|
||
;;
|
||
;; `ebnf-terminal-regexp' Specify how it's a terminal name.
|
||
;;
|
||
;; `ebnf-case-fold-search' Non-nil means ignore case on matching.
|
||
;;
|
||
;; `ebnf-terminal-font' Specify terminal font.
|
||
;;
|
||
;; `ebnf-terminal-shape' Specify terminal box shape.
|
||
;;
|
||
;; `ebnf-terminal-shadow' Non-nil means terminal box will have a
|
||
;; shadow.
|
||
;;
|
||
;; `ebnf-terminal-border-width' Specify border width for terminal box.
|
||
;;
|
||
;; `ebnf-terminal-border-color' Specify border color for terminal box.
|
||
;;
|
||
;; `ebnf-production-name-p' Non-nil means production name will be
|
||
;; printed.
|
||
;;
|
||
;; `ebnf-sort-production' Specify how productions are sorted.
|
||
;;
|
||
;; `ebnf-production-font' Specify production font.
|
||
;;
|
||
;; `ebnf-non-terminal-font' Specify non-terminal font.
|
||
;;
|
||
;; `ebnf-non-terminal-shape' Specify non-terminal box shape.
|
||
;;
|
||
;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will
|
||
;; have a shadow.
|
||
;;
|
||
;; `ebnf-non-terminal-border-width' Specify border width for non-terminal
|
||
;; box.
|
||
;;
|
||
;; `ebnf-non-terminal-border-color' Specify border color for non-terminal
|
||
;; box.
|
||
;;
|
||
;; `ebnf-special-show-delimiter' Non-nil means special delimiter
|
||
;; (character `?') is shown.
|
||
;;
|
||
;; `ebnf-special-font' Specify special font.
|
||
;;
|
||
;; `ebnf-special-shape' Specify special box shape.
|
||
;;
|
||
;; `ebnf-special-shadow' Non-nil means special box will have a
|
||
;; shadow.
|
||
;;
|
||
;; `ebnf-special-border-width' Specify border width for special box.
|
||
;;
|
||
;; `ebnf-special-border-color' Specify border color for special box.
|
||
;;
|
||
;; `ebnf-except-font' Specify except font.
|
||
;;
|
||
;; `ebnf-except-shape' Specify except box shape.
|
||
;;
|
||
;; `ebnf-except-shadow' Non-nil means except box will have a
|
||
;; shadow.
|
||
;;
|
||
;; `ebnf-except-border-width' Specify border width for except box.
|
||
;;
|
||
;; `ebnf-except-border-color' Specify border color for except box.
|
||
;;
|
||
;; `ebnf-repeat-font' Specify repeat font.
|
||
;;
|
||
;; `ebnf-repeat-shape' Specify repeat box shape.
|
||
;;
|
||
;; `ebnf-repeat-shadow' Non-nil means repeat box will have a
|
||
;; shadow.
|
||
;;
|
||
;; `ebnf-repeat-border-width' Specify border width for repeat box.
|
||
;;
|
||
;; `ebnf-repeat-border-color' Specify border color for repeat box.
|
||
;;
|
||
;; `ebnf-entry-percentage' Specify entry height on alternatives.
|
||
;;
|
||
;; `ebnf-arrow-shape' Specify the arrow shape.
|
||
;;
|
||
;; `ebnf-chart-shape' Specify chart flow shape.
|
||
;;
|
||
;; `ebnf-color-p' Non-nil means use color.
|
||
;;
|
||
;; `ebnf-line-width' Specify flow line width.
|
||
;;
|
||
;; `ebnf-line-color' Specify flow line color.
|
||
;;
|
||
;; `ebnf-user-arrow' Specify a sexp for user arrow shape (a
|
||
;; PostScript code).
|
||
;;
|
||
;; `ebnf-debug-ps' Non-nil means to generate PostScript
|
||
;; debug procedures.
|
||
;;
|
||
;; `ebnf-lex-comment-char' Specify the line comment character.
|
||
;;
|
||
;; `ebnf-lex-eop-char' Specify the end of production
|
||
;; character.
|
||
;;
|
||
;; `ebnf-syntax' Specify syntax to be recognized.
|
||
;;
|
||
;; `ebnf-iso-alternative-p' Non-nil means use alternative ISO EBNF.
|
||
;;
|
||
;; `ebnf-iso-normalize-p' Non-nil means normalize ISO EBNF syntax
|
||
;; names.
|
||
;;
|
||
;; `ebnf-default-width' Specify additional border width over
|
||
;; default terminal, non-terminal or
|
||
;; special.
|
||
;;
|
||
;; `ebnf-file-suffix-regexp' Specify file name suffix that contains
|
||
;; EBNF.
|
||
;;
|
||
;; `ebnf-eps-prefix' Specify EPS prefix file name.
|
||
;;
|
||
;; `ebnf-use-float-format' Non-nil means use `%f' float format.
|
||
;;
|
||
;; `ebnf-stop-on-error' Non-nil means signal error and stop.
|
||
;; Nil means signal error and continue.
|
||
;;
|
||
;; `ebnf-yac-ignore-error-recovery' Non-nil means ignore error recovery.
|
||
;;
|
||
;; `ebnf-ignore-empty-rule' Non-nil means ignore empty rules.
|
||
;;
|
||
;; `ebnf-optimize' Non-nil means optimize syntactic chart
|
||
;; of rules.
|
||
;;
|
||
;; To set the above options you may:
|
||
;;
|
||
;; a) insert the code in your ~/.emacs, like:
|
||
;;
|
||
;; (setq ebnf-terminal-shape 'bevel)
|
||
;;
|
||
;; This way always keep your default settings when you enter a new Emacs
|
||
;; session.
|
||
;;
|
||
;; b) or use `set-variable' in your Emacs session, like:
|
||
;;
|
||
;; M-x set-variable RET ebnf-terminal-shape RET bevel RET
|
||
;;
|
||
;; This way keep your settings only during the current Emacs session.
|
||
;;
|
||
;; c) or use customization, for example:
|
||
;; click on menu-bar *Help* option,
|
||
;; then click on *Customize*,
|
||
;; then click on *Browse Customization Groups*,
|
||
;; expand *PostScript* group,
|
||
;; expand *Ebnf2ps* group
|
||
;; and then customize ebnf2ps options.
|
||
;; Through this way, you may choose if the settings are kept or not when
|
||
;; you leave out the current Emacs session.
|
||
;;
|
||
;; d) or see the option value:
|
||
;;
|
||
;; C-h v ebnf-terminal-shape RET
|
||
;;
|
||
;; and click the *customize* hypertext button.
|
||
;; Through this way, you may choose if the settings are kept or not when
|
||
;; you leave out the current Emacs session.
|
||
;;
|
||
;; e) or invoke:
|
||
;;
|
||
;; M-x ebnf-customize RET
|
||
;;
|
||
;; and then customize ebnf2ps options.
|
||
;; Through this way, you may choose if the settings are kept or not when
|
||
;; you leave out the current Emacs session.
|
||
;;
|
||
;;
|
||
;; Styles
|
||
;; ------
|
||
;;
|
||
;; Sometimes you need to change the EBNF style you are using, for example,
|
||
;; change the shapes and colors. These changes may force you to set some
|
||
;; variables and after use, set back the variables to the old values.
|
||
;;
|
||
;; To help to handle this situation, ebnf2ps has the following commands to
|
||
;; handle styles:
|
||
;;
|
||
;; `ebnf-insert-style' Insert a new style NAME with inheritance INHERITS and
|
||
;; values VALUES.
|
||
;;
|
||
;; `ebnf-delete-style' Delete style NAME.
|
||
;;
|
||
;; `ebnf-merge-style' Merge values of style NAME with style VALUES.
|
||
;;
|
||
;; `ebnf-apply-style' Set STYLE as the current style.
|
||
;;
|
||
;; `ebnf-reset-style' Reset current style.
|
||
;;
|
||
;; `ebnf-push-style' Push the current style and set STYLE as the current
|
||
;; style.
|
||
;;
|
||
;; `ebnf-pop-style' Pop a style and set it as the current style.
|
||
;;
|
||
;; These commands help to put together a lot of variable settings in a group
|
||
;; and name this group. So when you wish to apply these settings it's only
|
||
;; needed to give the name.
|
||
;;
|
||
;; There is also a notion of simple inheritance of style; so, if you declare
|
||
;; that a style A inherits from a style B, all settings of B is applied first
|
||
;; and then the settings of A is applied. This is useful when you wish to
|
||
;; modify some aspects of an existing style, but at same time wish to keep it
|
||
;; unmodified.
|
||
;;
|
||
;; See documentation for `ebnf-style-database'.
|
||
;;
|
||
;;
|
||
;; Layout
|
||
;; ------
|
||
;;
|
||
;; Below it is the layout of minimum area to draw each element, and it's used
|
||
;; the following terms:
|
||
;;
|
||
;; font height is given by:
|
||
;; (terminal font height + non-terminal font height) / 2
|
||
;;
|
||
;; entry is the vertical position used to know where it should
|
||
;; be drawn the flow line in the current element.
|
||
;;
|
||
;;
|
||
;; * SPECIAL, TERMINAL and NON-TERMINAL
|
||
;;
|
||
;; +==============+...................................
|
||
;; | | } font height / 2 } entry }
|
||
;; | XXXXXXXX...|....... } }
|
||
;; ====+ XXXXXXXX +==== } text height ...... } height
|
||
;; : | XXXXXXXX...|...:... }
|
||
;; : | : : | : } font height / 2 }
|
||
;; : +==============+...:...............................
|
||
;; : : : : : :
|
||
;; : : : : : :......................
|
||
;; : : : : : } font height }
|
||
;; : : : : :....... }
|
||
;; : : : : } font height / 2 }
|
||
;; : : : :........... }
|
||
;; : : : } text width } width
|
||
;; : : :.................. }
|
||
;; : : } font height / 2 }
|
||
;; : :...................... }
|
||
;; : } font height }
|
||
;; :.............................................
|
||
;;
|
||
;;
|
||
;; * OPTIONAL
|
||
;;
|
||
;; +==========+.....................................
|
||
;; | | } } }
|
||
;; | | } entry } }
|
||
;; | | } } }
|
||
;; ===+===+ +===+===... } element height } height
|
||
;; : \ | | / : } }
|
||
;; : + | | + : } }
|
||
;; : | +==========+.|................. }
|
||
;; : | : : | : } font height }
|
||
;; : +==============+...................................
|
||
;; : : : :
|
||
;; : : : :......................
|
||
;; : : : } font height * 2 }
|
||
;; : : :.......... }
|
||
;; : : } element width } width
|
||
;; : :..................... }
|
||
;; : } font height * 2 }
|
||
;; :...............................................
|
||
;;
|
||
;;
|
||
;; * ALTERNATIVE
|
||
;;
|
||
;; +===+...................................
|
||
;; +==+ A +==+ } A height } }
|
||
;; | +===+..|........ } entry }
|
||
;; + + } font height } }
|
||
;; / +===+...\....... } }
|
||
;; ===+====+ B +====+=== } B height ..... } height
|
||
;; : \ +===+.../....... }
|
||
;; : + + : } font height }
|
||
;; : | +===+..|........ }
|
||
;; : +==+ C +==+ : } C height }
|
||
;; : : +===+...................................
|
||
;; : : : :
|
||
;; : : : :......................
|
||
;; : : : } font height * 2 }
|
||
;; : : :......... }
|
||
;; : : } max width } width
|
||
;; : :................. }
|
||
;; : } font height * 2 }
|
||
;; :..........................................
|
||
;;
|
||
;; NOTES:
|
||
;; 1. An empty alternative has zero of height.
|
||
;;
|
||
;; 2. The variable `ebnf-entry-percentage' is used to determine the
|
||
;; entry point.
|
||
;;
|
||
;;
|
||
;; * ZERO OR MORE
|
||
;;
|
||
;; +===========+...............................
|
||
;; +=+ separator +=+ } separator height }
|
||
;; / +===========+..\........ }
|
||
;; + + } }
|
||
;; | | } font height }
|
||
;; + + } }
|
||
;; \ +===========+../........ } height = entry
|
||
;; +=+ element +=+ } element height }
|
||
;; /: +===========+..\........ }
|
||
;; + : : + } }
|
||
;; + : : + } font height }
|
||
;; / : : \ } }
|
||
;; ==+=======================+==.......................
|
||
;; : : : :
|
||
;; : : : :.......................
|
||
;; : : : } font height * 2 }
|
||
;; : : :......... }
|
||
;; : : } max width } width
|
||
;; : :......................... }
|
||
;; : } font height * 2 }
|
||
;; :...................................................
|
||
;;
|
||
;;
|
||
;; * ONE OR MORE
|
||
;;
|
||
;; +===========+......................................
|
||
;; +=+ separator +=+ } separator height } }
|
||
;; / +===========+..\...... } }
|
||
;; + + } } entry }
|
||
;; | | } font height } } height
|
||
;; + + } } }
|
||
;; \ +===========+../...... } }
|
||
;; ===+=+ element +=+=== } element height .... }
|
||
;; : : +===========+......................................
|
||
;; : : : :
|
||
;; : : : :........................
|
||
;; : : : } font height * 2 }
|
||
;; : : :....... }
|
||
;; : : } max width } width
|
||
;; : :....................... }
|
||
;; : } font height * 2 }
|
||
;; :..............................................
|
||
;;
|
||
;;
|
||
;; * PRODUCTION
|
||
;;
|
||
;; XXXXXX:......................................
|
||
;; XXXXXX: } production font height }
|
||
;; XXXXXX:............ }
|
||
;; } font height }
|
||
;; +======+....... } height = entry
|
||
;; | | } }
|
||
;; ====+ +==== } element height }
|
||
;; : | | : } }
|
||
;; : +======+.................................
|
||
;; : : : :
|
||
;; : : : :......................
|
||
;; : : : } font height * 2 }
|
||
;; : : :....... }
|
||
;; : : } element width } width
|
||
;; : :.............. }
|
||
;; : } font height * 2 }
|
||
;; :.....................................
|
||
;;
|
||
;;
|
||
;; * REPEAT
|
||
;;
|
||
;; +================+...................................
|
||
;; | | } font height / 2 } entry }
|
||
;; | +===+...|....... } }
|
||
;; ====+ N * | X | +==== } X height ......... } height
|
||
;; : | : : +===+...|...:... }
|
||
;; : | : : : : | : } font height / 2 }
|
||
;; : +================+...:...............................
|
||
;; : : : : : : : :
|
||
;; : : : : : : : :......................
|
||
;; : : : : : : : } font height }
|
||
;; : : : : : : :....... }
|
||
;; : : : : : : } font height / 2 }
|
||
;; : : : : : :........... }
|
||
;; : : : : : } X width }
|
||
;; : : : : :............... }
|
||
;; : : : : } font height / 2 } width
|
||
;; : : : :.................. }
|
||
;; : : : } text width }
|
||
;; : : :..................... }
|
||
;; : : } font height / 2 }
|
||
;; : :........................ }
|
||
;; : } font height }
|
||
;; :...............................................
|
||
;;
|
||
;;
|
||
;; * EXCEPT
|
||
;;
|
||
;; +==================+...................................
|
||
;; | | } font height / 2 } entry }
|
||
;; | +===+ +===+...|....... } }
|
||
;; ====+ | X | - | y | +==== } max height ....... } height
|
||
;; : | +===+ +===+...|...:... }
|
||
;; : | : : : : | : } font height / 2 }
|
||
;; : +==================+...:...............................
|
||
;; : : : : : : : :
|
||
;; : : : : : : : :......................
|
||
;; : : : : : : : } font height }
|
||
;; : : : : : : :....... }
|
||
;; : : : : : : } font height / 2 }
|
||
;; : : : : : :........... }
|
||
;; : : : : : } Y width }
|
||
;; : : : : :............... }
|
||
;; : : : : } font height } width
|
||
;; : : : :................... }
|
||
;; : : : } X width }
|
||
;; : : :....................... }
|
||
;; : : } font height / 2 }
|
||
;; : :.......................... }
|
||
;; : } font height }
|
||
;; :.................................................
|
||
;;
|
||
;; NOTE: If Y element is empty, it's draw nothing at Y place.
|
||
;;
|
||
;;
|
||
;; Internal Structures
|
||
;; -------------------
|
||
;;
|
||
;; ebnf2ps has two passes. The first pass does a lexical and syntactic analysis
|
||
;; of current buffer and generates an intermediate representation. The second
|
||
;; pass uses the intermediate representation to generate the PostScript
|
||
;; syntactic chart.
|
||
;;
|
||
;; The intermediate representation is a list of vectors, the vector element
|
||
;; represents a syntactic chart element. Below is a vector representation for
|
||
;; each syntactic chart element.
|
||
;;
|
||
;; [production WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME PRODUCTION ACTION]
|
||
;; [alternative WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
|
||
;; [sequence WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH LIST]
|
||
;; [terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
|
||
;; [non-terminal WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
|
||
;; [special WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH NAME DEFAULT]
|
||
;; [empty WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH]
|
||
;; [optional WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT]
|
||
;; [one-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
|
||
;; [zero-or-more WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT SEPARATOR]
|
||
;; [repeat WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH TIMES ELEMENT]
|
||
;; [except WIDTH-FUN DIM-FUN ENTRY HEIGHT WIDTH ELEMENT ELEMENT]
|
||
;;
|
||
;; The first vector position is a function symbol used to generate PostScript
|
||
;; for this element.
|
||
;; WIDTH-FUN is a function symbol called to adjust the element width.
|
||
;; DIM-FUN is a function symbol called to set the element dimensions.
|
||
;; ENTRY is the element entry point.
|
||
;; HEIGHT and WIDTH are the element height and width, respectively.
|
||
;; NAME is a string that it's the element name.
|
||
;; DEFAULT is a boolean that indicates if it's a `default' element.
|
||
;; PRODUCTION and ELEMENT are vectors that represents sub-elements of current
|
||
;; one.
|
||
;; LIST is a list of vector that represents the list part for alternatives and
|
||
;; sequences.
|
||
;; SEPARATOR is a vector that represents the sub-element used to separate the
|
||
;; list elements.
|
||
;; TIMES is a string representing the number of times that ELEMENT is repeated
|
||
;; on a repeat construction.
|
||
;; ACTION indicates some action that should be done before production is
|
||
;; generated. The current actions are:
|
||
;;
|
||
;; nil no action.
|
||
;;
|
||
;; form-feed current production starts on a new page.
|
||
;;
|
||
;; newline current production starts on next line, this is useful
|
||
;; when `ebnf-horizontal-orientation' is non-nil.
|
||
;;
|
||
;; keep-line current production continues on the current line, this
|
||
;; is useful when `ebnf-horizontal-orientation' is nil.
|
||
;;
|
||
;;
|
||
;; Things To Change
|
||
;; ----------------
|
||
;;
|
||
;; . Handle situations when syntactic chart is out of paper.
|
||
;; . Use other alphabet than ascii.
|
||
;; . Optimizations...
|
||
;;
|
||
;;
|
||
;; Acknowledgements
|
||
;; ----------------
|
||
;;
|
||
;; Thanks to Drew Adams <drew.adams@oracle.com> for suggestions:
|
||
;; - `ebnf-production-name-p', `ebnf-stop-on-error',
|
||
;; `ebnf-file-suffix-regexp'and `ebnf-special-show-delimiter' variables.
|
||
;; - `ebnf-delete-style', `ebnf-eps-file' and `ebnf-eps-directory'
|
||
;; commands.
|
||
;; - some docs fix.
|
||
;;
|
||
;; Thanks to Matthew K. Junker <junker@alum.mit.edu> for the suggestion to deal
|
||
;; with some Bison features (%right, %left and %prec pragmas). His suggestion
|
||
;; was extended to deal with %nonassoc pragma too.
|
||
;;
|
||
;; Thanks to all who emailed comments.
|
||
;;
|
||
;;
|
||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
;;; Code:
|
||
|
||
|
||
(require 'ps-print)
|
||
|
||
(and (string< ps-print-version "5.2.3")
|
||
(error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
|
||
|
||
|
||
;; to avoid gripes with Emacs 20
|
||
(or (fboundp 'assq-delete-all)
|
||
(defun assq-delete-all (key alist)
|
||
"Delete from ALIST all elements whose car is KEY.
|
||
Return the modified alist.
|
||
Elements of ALIST that are not conses are ignored."
|
||
(let ((tail alist))
|
||
(while tail
|
||
(if (and (consp (car tail))
|
||
(eq (car (car tail)) key))
|
||
(setq alist (delq (car tail) alist)))
|
||
(setq tail (cdr tail)))
|
||
alist)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; User Variables:
|
||
|
||
|
||
;;; Interface to the command system
|
||
|
||
(defgroup postscript nil
|
||
"PostScript Group."
|
||
:tag "PostScript"
|
||
:version "20"
|
||
:group 'emacs)
|
||
|
||
|
||
(defgroup ebnf2ps nil
|
||
"Translate an EBNF to a syntactic chart on PostScript."
|
||
:prefix "ebnf-"
|
||
:version "20"
|
||
:group 'wp
|
||
:group 'postscript)
|
||
|
||
|
||
(defgroup ebnf-special nil
|
||
"Special customization."
|
||
:prefix "ebnf-"
|
||
:tag "Special"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-except nil
|
||
"Except customization."
|
||
:prefix "ebnf-"
|
||
:tag "Except"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-repeat nil
|
||
"Repeat customization."
|
||
:prefix "ebnf-"
|
||
:tag "Repeat"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-terminal nil
|
||
"Terminal customization."
|
||
:prefix "ebnf-"
|
||
:tag "Terminal"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-non-terminal nil
|
||
"Non-Terminal customization."
|
||
:prefix "ebnf-"
|
||
:tag "Non-Terminal"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-production nil
|
||
"Production customization."
|
||
:prefix "ebnf-"
|
||
:tag "Production"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-shape nil
|
||
"Shapes customization."
|
||
:prefix "ebnf-"
|
||
:tag "Shape"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-displacement nil
|
||
"Displacement customization."
|
||
:prefix "ebnf-"
|
||
:tag "Displacement"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-syntactic nil
|
||
"Syntactic customization."
|
||
:prefix "ebnf-"
|
||
:tag "Syntactic"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defgroup ebnf-optimization nil
|
||
"Optimization customization."
|
||
:prefix "ebnf-"
|
||
:tag "Optimization"
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-horizontal-orientation nil
|
||
"*Non-nil means productions are drawn horizontally."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-displacement)
|
||
|
||
|
||
(defcustom ebnf-horizontal-max-height nil
|
||
"*Non-nil means to use maximum production height in horizontal orientation.
|
||
|
||
It is only used when `ebnf-horizontal-orientation' is non-nil."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-displacement)
|
||
|
||
|
||
(defcustom ebnf-production-horizontal-space 0.0 ; use ebnf2ps default value
|
||
"*Specify horizontal space in points between productions.
|
||
|
||
Value less or equal to zero forces ebnf2ps to set a proper default value."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-displacement)
|
||
|
||
|
||
(defcustom ebnf-production-vertical-space 0.0 ; use ebnf2ps default value
|
||
"*Specify vertical space in points between productions.
|
||
|
||
Value less or equal to zero forces ebnf2ps to set a proper default value."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-displacement)
|
||
|
||
|
||
(defcustom ebnf-justify-sequence 'center
|
||
"*Specify justification of terms in a sequence inside alternatives.
|
||
|
||
Valid values are:
|
||
|
||
`left' left justification
|
||
`right' right justification
|
||
any other value centralize"
|
||
:type '(radio :tag "Sequence Justification"
|
||
(const left) (const right) (other :tag "center" center))
|
||
:version "20"
|
||
:group 'ebnf-displacement)
|
||
|
||
|
||
(defcustom ebnf-special-show-delimiter t
|
||
"*Non-nil means special delimiter (character `?') is shown."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-special)
|
||
|
||
|
||
(defcustom ebnf-special-font '(7 Courier "Black" "Gray95" bold italic)
|
||
"*Specify special font.
|
||
|
||
See documentation for `ebnf-production-font'."
|
||
:type '(list :tag "Special Font"
|
||
(number :tag "Font Size")
|
||
(symbol :tag "Font Name")
|
||
(choice :tag "Foreground Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(choice :tag "Background Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(repeat :tag "Font Attributes" :inline t
|
||
(choice (const bold) (const italic)
|
||
(const underline) (const strikeout)
|
||
(const overline) (const shadow)
|
||
(const box) (const outline))))
|
||
:version "20"
|
||
:group 'ebnf-special)
|
||
|
||
|
||
(defcustom ebnf-special-shape 'bevel
|
||
"*Specify special box shape.
|
||
|
||
See documentation for `ebnf-non-terminal-shape'."
|
||
:type '(radio :tag "Special Shape"
|
||
(const miter) (const round) (const bevel))
|
||
:version "20"
|
||
:group 'ebnf-special)
|
||
|
||
|
||
(defcustom ebnf-special-shadow nil
|
||
"*Non-nil means special box will have a shadow."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-special)
|
||
|
||
|
||
(defcustom ebnf-special-border-width 0.5
|
||
"*Specify border width for special box."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-special)
|
||
|
||
|
||
(defcustom ebnf-special-border-color "Black"
|
||
"*Specify border color for special box."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf-special)
|
||
|
||
|
||
(defcustom ebnf-except-font '(7 Courier "Black" "Gray90" bold italic)
|
||
"*Specify except font.
|
||
|
||
See documentation for `ebnf-production-font'."
|
||
:type '(list :tag "Except Font"
|
||
(number :tag "Font Size")
|
||
(symbol :tag "Font Name")
|
||
(choice :tag "Foreground Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(choice :tag "Background Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(repeat :tag "Font Attributes" :inline t
|
||
(choice (const bold) (const italic)
|
||
(const underline) (const strikeout)
|
||
(const overline) (const shadow)
|
||
(const box) (const outline))))
|
||
:version "20"
|
||
:group 'ebnf-except)
|
||
|
||
|
||
(defcustom ebnf-except-shape 'bevel
|
||
"*Specify except box shape.
|
||
|
||
See documentation for `ebnf-non-terminal-shape'."
|
||
:type '(radio :tag "Except Shape"
|
||
(const miter) (const round) (const bevel))
|
||
:version "20"
|
||
:group 'ebnf-except)
|
||
|
||
|
||
(defcustom ebnf-except-shadow nil
|
||
"*Non-nil means except box will have a shadow."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-except)
|
||
|
||
|
||
(defcustom ebnf-except-border-width 0.25
|
||
"*Specify border width for except box."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-except)
|
||
|
||
|
||
(defcustom ebnf-except-border-color "Black"
|
||
"*Specify border color for except box."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf-except)
|
||
|
||
|
||
(defcustom ebnf-repeat-font '(7 Courier "Black" "Gray85" bold italic)
|
||
"*Specify repeat font.
|
||
|
||
See documentation for `ebnf-production-font'."
|
||
:type '(list :tag "Repeat Font"
|
||
(number :tag "Font Size")
|
||
(symbol :tag "Font Name")
|
||
(choice :tag "Foreground Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(choice :tag "Background Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(repeat :tag "Font Attributes" :inline t
|
||
(choice (const bold) (const italic)
|
||
(const underline) (const strikeout)
|
||
(const overline) (const shadow)
|
||
(const box) (const outline))))
|
||
:version "20"
|
||
:group 'ebnf-repeat)
|
||
|
||
|
||
(defcustom ebnf-repeat-shape 'bevel
|
||
"*Specify repeat box shape.
|
||
|
||
See documentation for `ebnf-non-terminal-shape'."
|
||
:type '(radio :tag "Repeat Shape"
|
||
(const miter) (const round) (const bevel))
|
||
:version "20"
|
||
:group 'ebnf-repeat)
|
||
|
||
|
||
(defcustom ebnf-repeat-shadow nil
|
||
"*Non-nil means repeat box will have a shadow."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-repeat)
|
||
|
||
|
||
(defcustom ebnf-repeat-border-width 0.0
|
||
"*Specify border width for repeat box."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-repeat)
|
||
|
||
|
||
(defcustom ebnf-repeat-border-color "Black"
|
||
"*Specify border color for repeat box."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf-repeat)
|
||
|
||
|
||
(defcustom ebnf-terminal-font '(7 Courier "Black" "White")
|
||
"*Specify terminal font.
|
||
|
||
See documentation for `ebnf-production-font'."
|
||
:type '(list :tag "Terminal Font"
|
||
(number :tag "Font Size")
|
||
(symbol :tag "Font Name")
|
||
(choice :tag "Foreground Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(choice :tag "Background Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(repeat :tag "Font Attributes" :inline t
|
||
(choice (const bold) (const italic)
|
||
(const underline) (const strikeout)
|
||
(const overline) (const shadow)
|
||
(const box) (const outline))))
|
||
:version "20"
|
||
:group 'ebnf-terminal)
|
||
|
||
|
||
(defcustom ebnf-terminal-shape 'miter
|
||
"*Specify terminal box shape.
|
||
|
||
See documentation for `ebnf-non-terminal-shape'."
|
||
:type '(radio :tag "Terminal Shape"
|
||
(const miter) (const round) (const bevel))
|
||
:version "20"
|
||
:group 'ebnf-terminal)
|
||
|
||
|
||
(defcustom ebnf-terminal-shadow nil
|
||
"*Non-nil means terminal box will have a shadow."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-terminal)
|
||
|
||
|
||
(defcustom ebnf-terminal-border-width 1.0
|
||
"*Specify border width for terminal box."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-terminal)
|
||
|
||
|
||
(defcustom ebnf-terminal-border-color "Black"
|
||
"*Specify border color for terminal box."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf-terminal)
|
||
|
||
|
||
(defcustom ebnf-production-name-p t
|
||
"*Non-nil means production name will be printed."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-production)
|
||
|
||
|
||
(defcustom ebnf-sort-production nil
|
||
"*Specify how productions are sorted.
|
||
|
||
Valid values are:
|
||
|
||
nil don't sort productions.
|
||
`ascending' ascending sort.
|
||
any other value descending sort."
|
||
:type '(radio :tag "Production Sort"
|
||
(const :tag "Ascending" ascending)
|
||
(const :tag "Descending" descending)
|
||
(other :tag "No Sort" nil))
|
||
:version "20"
|
||
:group 'ebnf-production)
|
||
|
||
|
||
(defcustom ebnf-production-font '(10 Helvetica "Black" "White" bold)
|
||
"*Specify production header font.
|
||
|
||
It is a list with the following form:
|
||
|
||
(SIZE NAME FOREGROUND BACKGROUND ATTRIBUTE...)
|
||
|
||
Where:
|
||
SIZE is the font size.
|
||
NAME is the font name symbol.
|
||
ATTRIBUTE is one of the following symbols:
|
||
bold - use bold font.
|
||
italic - use italic font.
|
||
underline - put a line under text.
|
||
strikeout - like underline, but the line is in middle of text.
|
||
overline - like underline, but the line is over the text.
|
||
shadow - text will have a shadow.
|
||
box - text will be surrounded by a box.
|
||
outline - print characters as hollow outlines.
|
||
FOREGROUND is a foreground string color name; if it's nil, the default color is
|
||
\"Black\".
|
||
BACKGROUND is a background string color name; if it's nil, the default color is
|
||
\"White\".
|
||
|
||
See `ps-font-info-database' for valid font name."
|
||
:type '(list :tag "Production Font"
|
||
(number :tag "Font Size")
|
||
(symbol :tag "Font Name")
|
||
(choice :tag "Foreground Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(choice :tag "Background Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(repeat :tag "Font Attributes" :inline t
|
||
(choice (const bold) (const italic)
|
||
(const underline) (const strikeout)
|
||
(const overline) (const shadow)
|
||
(const box) (const outline))))
|
||
:version "20"
|
||
:group 'ebnf-production)
|
||
|
||
|
||
(defcustom ebnf-non-terminal-font '(7 Helvetica "Black" "White")
|
||
"*Specify non-terminal font.
|
||
|
||
See documentation for `ebnf-production-font'."
|
||
:type '(list :tag "Non-Terminal Font"
|
||
(number :tag "Font Size")
|
||
(symbol :tag "Font Name")
|
||
(choice :tag "Foreground Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(choice :tag "Background Color"
|
||
(string :tag "Name")
|
||
(other :tag "Default" nil))
|
||
(repeat :tag "Font Attributes" :inline t
|
||
(choice (const bold) (const italic)
|
||
(const underline) (const strikeout)
|
||
(const overline) (const shadow)
|
||
(const box) (const outline))))
|
||
:version "20"
|
||
:group 'ebnf-non-terminal)
|
||
|
||
|
||
(defcustom ebnf-non-terminal-shape 'round
|
||
"*Specify non-terminal box shape.
|
||
|
||
Valid values are:
|
||
|
||
`miter' +-------+
|
||
| |
|
||
+-------+
|
||
|
||
`round' -------
|
||
( )
|
||
-------
|
||
|
||
`bevel' /-------\\
|
||
| |
|
||
\\-------/
|
||
|
||
Any other value is treated as `miter'."
|
||
:type '(radio :tag "Non-Terminal Shape"
|
||
(const miter) (const round) (const bevel))
|
||
:version "20"
|
||
:group 'ebnf-non-terminal)
|
||
|
||
|
||
(defcustom ebnf-non-terminal-shadow nil
|
||
"*Non-nil means non-terminal box will have a shadow."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-non-terminal)
|
||
|
||
|
||
(defcustom ebnf-non-terminal-border-width 1.0
|
||
"*Specify border width for non-terminal box."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf-non-terminal)
|
||
|
||
|
||
(defcustom ebnf-non-terminal-border-color "Black"
|
||
"*Specify border color for non-terminal box."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf-non-terminal)
|
||
|
||
|
||
(defcustom ebnf-arrow-shape 'hollow
|
||
"*Specify the arrow shape.
|
||
|
||
Valid values are:
|
||
|
||
`none' ======
|
||
|
||
`semi-up' * `transparent' *
|
||
* |*
|
||
=====* | *
|
||
==+==*
|
||
| *
|
||
|*
|
||
*
|
||
|
||
`semi-down' =====* `hollow' *
|
||
* |*
|
||
* | *
|
||
==+ *
|
||
| *
|
||
|*
|
||
*
|
||
|
||
`simple' * `full' *
|
||
* |*
|
||
=====* |X*
|
||
* ==+XX*
|
||
* |X*
|
||
|*
|
||
*
|
||
|
||
`semi-up-hollow' `semi-up-full'
|
||
* *
|
||
|* |*
|
||
| * |X*
|
||
==+==* ==+==*
|
||
|
||
`semi-down-hollow' `semi-down-full'
|
||
==+==* ==+==*
|
||
| * |X*
|
||
|* |*
|
||
* *
|
||
|
||
`user' See also documentation for variable `ebnf-user-arrow'.
|
||
|
||
Any other value is treated as `none'."
|
||
:type '(radio :tag "Arrow Shape"
|
||
(const none) (const semi-up)
|
||
(const semi-down) (const simple)
|
||
(const transparent) (const hollow)
|
||
(const full) (const semi-up-hollow)
|
||
(const semi-down-hollow) (const semi-up-full)
|
||
(const semi-down-full) (const user))
|
||
:version "20"
|
||
:group 'ebnf-shape)
|
||
|
||
|
||
(defcustom ebnf-chart-shape 'round
|
||
"*Specify chart flow shape.
|
||
|
||
See documentation for `ebnf-non-terminal-shape'."
|
||
:type '(radio :tag "Chart Flow Shape"
|
||
(const miter) (const round) (const bevel))
|
||
:version "20"
|
||
:group 'ebnf-shape)
|
||
|
||
|
||
(defcustom ebnf-user-arrow nil
|
||
"*Specify a sexp for user arrow shape (a PostScript code).
|
||
|
||
When evaluated, the sexp should return nil or a string containing PostScript
|
||
code. PostScript code should draw a right arrow.
|
||
|
||
The anatomy of a right arrow is:
|
||
|
||
...... Initial position
|
||
:
|
||
: *.................
|
||
: | * } }
|
||
: | * } hT4 }
|
||
v | * } }
|
||
======+======*... } hT2
|
||
: | *: } }
|
||
: | * : } hT4 }
|
||
: | * : } }
|
||
: *.................
|
||
: : :
|
||
: : :..........
|
||
: : } hT2 }
|
||
: :.......... } hT
|
||
: } hT2 }
|
||
:.......................
|
||
|
||
Where `hT', `hT2' and `hT4' are predefined PostScript variable names that can
|
||
be used to generate your own arrow. As these variables are used along
|
||
PostScript execution, *DON'T* modify the values of them. Instead, copy the
|
||
values, if you need to modify them.
|
||
|
||
The relation between these variables is: hT = 2 * hT2 = 4 * hT4.
|
||
|
||
The variable `ebnf-user-arrow' is only used when `ebnf-arrow-shape' is set to
|
||
symbol `user'."
|
||
:type '(sexp :tag "User Arrow Shape")
|
||
:version "20"
|
||
:group 'ebnf-shape)
|
||
|
||
|
||
(defcustom ebnf-syntax 'ebnf
|
||
"*Specify syntax to be recognized.
|
||
|
||
Valid values are:
|
||
|
||
`ebnf' ebnf2ps recognizes the syntax described in ebnf2ps
|
||
documentation.
|
||
The following variables *ONLY* have effect with this
|
||
setting:
|
||
`ebnf-terminal-regexp', `ebnf-case-fold-search',
|
||
`ebnf-lex-comment-char' and `ebnf-lex-eop-char'.
|
||
|
||
`abnf' ebnf2ps recognizes the syntax described in the URL:
|
||
`http://www.ietf.org/rfc/rfc2234.txt'
|
||
(\"Augmented BNF for Syntax Specifications: ABNF\").
|
||
|
||
`iso-ebnf' ebnf2ps recognizes the syntax described in the URL:
|
||
`http://www.cl.cam.ac.uk/~mgk25/iso-ebnf.html'
|
||
(\"International Standard of the ISO EBNF Notation\").
|
||
The following variables *ONLY* have effect with this
|
||
setting:
|
||
`ebnf-iso-alternative-p' and `ebnf-iso-normalize-p'.
|
||
|
||
`yacc' ebnf2ps recognizes the Yacc/Bison syntax.
|
||
The following variable *ONLY* has effect with this
|
||
setting:
|
||
`ebnf-yac-ignore-error-recovery'.
|
||
|
||
`ebnfx' ebnf2ps recognizes the syntax described in the URL:
|
||
`http://www.w3.org/TR/2004/REC-xml-20040204/#sec-notation'
|
||
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
|
||
|
||
`dtd' ebnf2ps recognizes the syntax described in the URL:
|
||
`http://www.w3.org/TR/2004/REC-xml-20040204/'
|
||
(\"Extensible Markup Language (XML) 1.0 (Third Edition)\")
|
||
|
||
Any other value is treated as `ebnf'."
|
||
:type '(radio :tag "Syntax"
|
||
(const ebnf) (const abnf) (const iso-ebnf)
|
||
(const yacc) (const ebnfx) (const dtd))
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-lex-comment-char ?\;
|
||
"*Specify the line comment character.
|
||
|
||
It's used only when `ebnf-syntax' is `ebnf'."
|
||
:type 'character
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-lex-eop-char ?.
|
||
"*Specify the end of production character.
|
||
|
||
It's used only when `ebnf-syntax' is `ebnf'."
|
||
:type 'character
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-terminal-regexp nil
|
||
"*Specify how it's a terminal name.
|
||
|
||
If it's nil, the terminal name must be enclosed by `\"'.
|
||
If it's a string, it should be a regexp that it'll be used to determine a
|
||
terminal name; terminal name may also be enclosed by `\"'.
|
||
|
||
It's used only when `ebnf-syntax' is `ebnf'."
|
||
:type '(radio :tag "Terminal Name"
|
||
(const nil) regexp)
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-case-fold-search nil
|
||
"*Non-nil means ignore case on matching.
|
||
|
||
It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
|
||
`ebnf'."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-iso-alternative-p nil
|
||
"*Non-nil means use alternative ISO EBNF.
|
||
|
||
It's only used when `ebnf-syntax' is `iso-ebnf'.
|
||
|
||
This variable affects the following symbol set:
|
||
|
||
STANDARD ALTERNATIVE
|
||
| ==> / or !
|
||
[ ==> (/
|
||
] ==> /)
|
||
{ ==> (:
|
||
} ==> :)
|
||
; ==> ."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-iso-normalize-p nil
|
||
"*Non-nil means normalize ISO EBNF syntax names.
|
||
|
||
Normalize a name means that several contiguous spaces inside name become a
|
||
single space, so \"A B C\" is normalized to \"A B C\".
|
||
|
||
It's only used when `ebnf-syntax' is `iso-ebnf'."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-file-suffix-regexp "\.[Bb][Nn][Ff]$"
|
||
"*Specify file name suffix that contains EBNF.
|
||
|
||
See `ebnf-eps-directory' command."
|
||
:type 'regexp
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-eps-prefix "ebnf--"
|
||
"*Specify EPS prefix file name.
|
||
|
||
See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-entry-percentage 0.5 ; middle
|
||
"*Specify entry height on alternatives.
|
||
|
||
It must be a float between 0.0 (top) and 1.0 (bottom)."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-default-width 0.6
|
||
"*Specify additional border width over default terminal, non-terminal or
|
||
special."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
;; Printing color requires x-color-values.
|
||
(defcustom ebnf-color-p (or (fboundp 'x-color-values) ; Emacs
|
||
(fboundp 'color-instance-rgb-components)) ; XEmacs
|
||
"*Non-nil means use color."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-line-width 1.0
|
||
"*Specify flow line width."
|
||
:type 'number
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-line-color "Black"
|
||
"*Specify flow line color."
|
||
:type 'string
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-debug-ps nil
|
||
"*Non-nil means to generate PostScript debug procedures.
|
||
|
||
It is intended to help PostScript programmers in debugging."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-use-float-format t
|
||
"*Non-nil means use `%f' float format.
|
||
|
||
The advantage of using float format is that ebnf2ps generates a little short
|
||
PostScript file.
|
||
|
||
If it occurs the error message:
|
||
|
||
Invalid format operation %f
|
||
|
||
when executing ebnf2ps, set `ebnf-use-float-format' to nil."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-stop-on-error nil
|
||
"*Non-nil means signal error and stop. Nil means signal error and continue."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf2ps)
|
||
|
||
|
||
(defcustom ebnf-yac-ignore-error-recovery nil
|
||
"*Non-nil means ignore error recovery.
|
||
|
||
It's only used when `ebnf-syntax' is `yacc'."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-syntactic)
|
||
|
||
|
||
(defcustom ebnf-ignore-empty-rule nil
|
||
"*Non-nil means ignore empty rules.
|
||
|
||
It's interesting to set this variable if your Yacc/Bison grammar has a lot of
|
||
middle action rule."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-optimization)
|
||
|
||
|
||
(defcustom ebnf-optimize nil
|
||
"*Non-nil means optimize syntactic chart of rules.
|
||
|
||
The following optimizations are done:
|
||
|
||
left recursion:
|
||
1. A = B | A C. ==> A = B {C}*.
|
||
2. A = B | A B. ==> A = {B}+.
|
||
3. A = | A B. ==> A = {B}*.
|
||
4. A = B | A C B. ==> A = {B || C}+.
|
||
5. A = B | D | A C | A E. ==> A = ( B | D ) { C | E }*.
|
||
|
||
optional:
|
||
6. A = B | . ==> A = [B].
|
||
7. A = | B . ==> A = [B].
|
||
|
||
factorization:
|
||
8. A = B C | B D. ==> A = B (C | D).
|
||
9. A = C B | D B. ==> A = (C | D) B.
|
||
10. A = B C E | B D E. ==> A = B (C | D) E.
|
||
|
||
The above optimizations are specially useful when `ebnf-syntax' is `yacc'."
|
||
:type 'boolean
|
||
:version "20"
|
||
:group 'ebnf-optimization)
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; To make this file smaller, some commands go in a separate file.
|
||
;; But autoload them here to make the separation invisible.
|
||
;; Autoload is here to avoid compilation gripes.
|
||
|
||
(autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
|
||
"Eliminate empty rules.")
|
||
|
||
(autoload 'ebnf-optimize "ebnf-otz"
|
||
"Syntactic chart optimizer.")
|
||
|
||
(autoload 'ebnf-otz-initialize "ebnf-otz"
|
||
"Initialize optimizer.")
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Customization
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-customize ()
|
||
"Customization for ebnf group."
|
||
(interactive)
|
||
(customize-group 'ebnf2ps))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; User commands
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-print-directory (&optional directory)
|
||
"Generate and print a PostScript syntactic chart image of DIRECTORY.
|
||
|
||
If DIRECTORY is nil, it's used `default-directory'.
|
||
|
||
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
|
||
processed.
|
||
|
||
See also `ebnf-print-buffer'."
|
||
(interactive
|
||
(list (read-file-name "Directory containing EBNF files (print): "
|
||
nil default-directory)))
|
||
(ebnf-directory 'ebnf-print-buffer directory))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-print-file (file &optional do-not-kill-buffer-when-done)
|
||
"Generate and print a PostScript syntactic chart image of the file FILE.
|
||
|
||
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
|
||
killed after process termination.
|
||
|
||
See also `ebnf-print-buffer'."
|
||
(interactive "fEBNF file to generate PostScript and print from: ")
|
||
(ebnf-file 'ebnf-print-buffer file do-not-kill-buffer-when-done))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-print-buffer (&optional filename)
|
||
"Generate and print a PostScript syntactic chart image of the buffer.
|
||
|
||
When called with a numeric prefix argument (C-u), prompts the user for
|
||
the name of a file to save the PostScript image in, instead of sending
|
||
it to the printer.
|
||
|
||
More specifically, the FILENAME argument is treated as follows: if it
|
||
is nil, send the image to the printer. If FILENAME is a string, save
|
||
the PostScript image in a file with that name. If FILENAME is a
|
||
number, prompt the user for the name of the file to save in."
|
||
(interactive (list (ps-print-preprint current-prefix-arg)))
|
||
(ebnf-print-region (point-min) (point-max) filename))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-print-region (from to &optional filename)
|
||
"Generate and print a PostScript syntactic chart image of the region.
|
||
Like `ebnf-print-buffer', but prints just the current region."
|
||
(interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
|
||
(run-hooks 'ebnf-hook)
|
||
(or (ebnf-spool-region from to)
|
||
(ps-do-despool filename)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-spool-directory (&optional directory)
|
||
"Generate and spool a PostScript syntactic chart image of DIRECTORY.
|
||
|
||
If DIRECTORY is nil, it's used `default-directory'.
|
||
|
||
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
|
||
processed.
|
||
|
||
See also `ebnf-spool-buffer'."
|
||
(interactive
|
||
(list (read-file-name "Directory containing EBNF files (spool): "
|
||
nil default-directory)))
|
||
(ebnf-directory 'ebnf-spool-buffer directory))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-spool-file (file &optional do-not-kill-buffer-when-done)
|
||
"Generate and spool a PostScript syntactic chart image of the file FILE.
|
||
|
||
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
|
||
killed after process termination.
|
||
|
||
See also `ebnf-spool-buffer'."
|
||
(interactive "fEBNF file to generate PostScript and spool from: ")
|
||
(ebnf-file 'ebnf-spool-buffer file do-not-kill-buffer-when-done))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-spool-buffer ()
|
||
"Generate and spool a PostScript syntactic chart image of the buffer.
|
||
Like `ebnf-print-buffer' except that the PostScript image is saved in a
|
||
local buffer to be sent to the printer later.
|
||
|
||
Use the command `ebnf-despool' to send the spooled images to the printer."
|
||
(interactive)
|
||
(ebnf-spool-region (point-min) (point-max)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-spool-region (from to)
|
||
"Generate a PostScript syntactic chart image of the region and spool locally.
|
||
Like `ebnf-spool-buffer', but spools just the current region.
|
||
|
||
Use the command `ebnf-despool' to send the spooled images to the printer."
|
||
(interactive "r")
|
||
(ebnf-generate-region from to 'ebnf-generate))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-eps-directory (&optional directory)
|
||
"Generate EPS files from EBNF files in DIRECTORY.
|
||
|
||
If DIRECTORY is nil, it's used `default-directory'.
|
||
|
||
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
|
||
processed.
|
||
|
||
See also `ebnf-eps-buffer'."
|
||
(interactive
|
||
(list (read-file-name "Directory containing EBNF files (EPS): "
|
||
nil default-directory)))
|
||
(ebnf-directory 'ebnf-eps-buffer directory))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-eps-file (file &optional do-not-kill-buffer-when-done)
|
||
"Generate an EPS file from EBNF file FILE.
|
||
|
||
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
|
||
killed after EPS generation.
|
||
|
||
See also `ebnf-eps-buffer'."
|
||
(interactive "fEBNF file to generate EPS file from: ")
|
||
(ebnf-file 'ebnf-eps-buffer file do-not-kill-buffer-when-done))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-eps-buffer ()
|
||
"Generate a PostScript syntactic chart image of the buffer in a EPS file.
|
||
|
||
Indeed, for each production is generated a EPS file.
|
||
The EPS file name has the following form:
|
||
|
||
<PREFIX><PRODUCTION>.eps
|
||
|
||
<PREFIX> is given by variable `ebnf-eps-prefix'.
|
||
The default value is \"ebnf--\".
|
||
|
||
<PRODUCTION> is the production name.
|
||
The production name is mapped to form a valid file name.
|
||
For example, the production name \"A/B + C\" is mapped to
|
||
\"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
|
||
|
||
WARNING: It's *NOT* asked any confirmation to override an existing file."
|
||
(interactive)
|
||
(ebnf-eps-region (point-min) (point-max)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-eps-region (from to)
|
||
"Generate a PostScript syntactic chart image of the region in a EPS file.
|
||
|
||
Indeed, for each production is generated a EPS file.
|
||
The EPS file name has the following form:
|
||
|
||
<PREFIX><PRODUCTION>.eps
|
||
|
||
<PREFIX> is given by variable `ebnf-eps-prefix'.
|
||
The default value is \"ebnf--\".
|
||
|
||
<PRODUCTION> is the production name.
|
||
The production name is mapped to form a valid file name.
|
||
For example, the production name \"A/B + C\" is mapped to
|
||
\"A_B_+_C\" and the EPS file name used is \"ebnf--A_B_+_C.eps\".
|
||
|
||
WARNING: It's *NOT* asked any confirmation to override an existing file."
|
||
(interactive "r")
|
||
(let ((ebnf-eps-executing t))
|
||
(ebnf-generate-region from to 'ebnf-generate-eps)))
|
||
|
||
|
||
;;;###autoload
|
||
(defalias 'ebnf-despool 'ps-despool)
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-syntax-directory (&optional directory)
|
||
"Does a syntactic analysis of the files in DIRECTORY.
|
||
|
||
If DIRECTORY is nil, it's used `default-directory'.
|
||
|
||
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
|
||
processed.
|
||
|
||
See also `ebnf-syntax-buffer'."
|
||
(interactive
|
||
(list (read-file-name "Directory containing EBNF files (syntax): "
|
||
nil default-directory)))
|
||
(ebnf-directory 'ebnf-syntax-buffer directory))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-syntax-file (file &optional do-not-kill-buffer-when-done)
|
||
"Does a syntactic analysis of the FILE.
|
||
|
||
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
|
||
killed after syntax checking.
|
||
|
||
See also `ebnf-syntax-buffer'."
|
||
(interactive "fEBNF file to check syntax: ")
|
||
(ebnf-file 'ebnf-syntax-buffer file do-not-kill-buffer-when-done))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-syntax-buffer ()
|
||
"Does a syntactic analysis of the current buffer."
|
||
(interactive)
|
||
(ebnf-syntax-region (point-min) (point-max)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-syntax-region (from to)
|
||
"Does a syntactic analysis of a region."
|
||
(interactive "r")
|
||
(ebnf-generate-region from to nil))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Utilities
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-setup ()
|
||
"Return the current ebnf2ps setup."
|
||
(format
|
||
"
|
||
;;; ebnf2ps.el version %s
|
||
|
||
\(setq ebnf-special-show-delimiter %S
|
||
ebnf-special-font %s
|
||
ebnf-special-shape %s
|
||
ebnf-special-shadow %S
|
||
ebnf-special-border-width %S
|
||
ebnf-special-border-color %S
|
||
ebnf-except-font %s
|
||
ebnf-except-shape %s
|
||
ebnf-except-shadow %S
|
||
ebnf-except-border-width %S
|
||
ebnf-except-border-color %S
|
||
ebnf-repeat-font %s
|
||
ebnf-repeat-shape %s
|
||
ebnf-repeat-shadow %S
|
||
ebnf-repeat-border-width %S
|
||
ebnf-repeat-border-color %S
|
||
ebnf-terminal-regexp %S
|
||
ebnf-case-fold-search %S
|
||
ebnf-terminal-font %s
|
||
ebnf-terminal-shape %s
|
||
ebnf-terminal-shadow %S
|
||
ebnf-terminal-border-width %S
|
||
ebnf-terminal-border-color %S
|
||
ebnf-non-terminal-font %s
|
||
ebnf-non-terminal-shape %s
|
||
ebnf-non-terminal-shadow %S
|
||
ebnf-non-terminal-border-width %S
|
||
ebnf-non-terminal-border-color %S
|
||
ebnf-production-name-p %S
|
||
ebnf-sort-production %s
|
||
ebnf-production-font %s
|
||
ebnf-arrow-shape %s
|
||
ebnf-chart-shape %s
|
||
ebnf-user-arrow %s
|
||
ebnf-horizontal-orientation %S
|
||
ebnf-horizontal-max-height %S
|
||
ebnf-production-horizontal-space %S
|
||
ebnf-production-vertical-space %S
|
||
ebnf-justify-sequence %s
|
||
ebnf-lex-comment-char ?\\%03o
|
||
ebnf-lex-eop-char ?\\%03o
|
||
ebnf-syntax %s
|
||
ebnf-iso-alternative-p %S
|
||
ebnf-iso-normalize-p %S
|
||
ebnf-file-suffix-regexp %S
|
||
ebnf-eps-prefix %S
|
||
ebnf-entry-percentage %S
|
||
ebnf-color-p %S
|
||
ebnf-line-width %S
|
||
ebnf-line-color %S
|
||
ebnf-debug-ps %S
|
||
ebnf-use-float-format %S
|
||
ebnf-stop-on-error %S
|
||
ebnf-yac-ignore-error-recovery %S
|
||
ebnf-ignore-empty-rule %S
|
||
ebnf-optimize %S)
|
||
|
||
;;; ebnf2ps.el - end of settings
|
||
"
|
||
ebnf-version
|
||
ebnf-special-show-delimiter
|
||
(ps-print-quote ebnf-special-font)
|
||
(ps-print-quote ebnf-special-shape)
|
||
ebnf-special-shadow
|
||
ebnf-special-border-width
|
||
ebnf-special-border-color
|
||
(ps-print-quote ebnf-except-font)
|
||
(ps-print-quote ebnf-except-shape)
|
||
ebnf-except-shadow
|
||
ebnf-except-border-width
|
||
ebnf-except-border-color
|
||
(ps-print-quote ebnf-repeat-font)
|
||
(ps-print-quote ebnf-repeat-shape)
|
||
ebnf-repeat-shadow
|
||
ebnf-repeat-border-width
|
||
ebnf-repeat-border-color
|
||
ebnf-terminal-regexp
|
||
ebnf-case-fold-search
|
||
(ps-print-quote ebnf-terminal-font)
|
||
(ps-print-quote ebnf-terminal-shape)
|
||
ebnf-terminal-shadow
|
||
ebnf-terminal-border-width
|
||
ebnf-terminal-border-color
|
||
(ps-print-quote ebnf-non-terminal-font)
|
||
(ps-print-quote ebnf-non-terminal-shape)
|
||
ebnf-non-terminal-shadow
|
||
ebnf-non-terminal-border-width
|
||
ebnf-non-terminal-border-color
|
||
ebnf-production-name-p
|
||
(ps-print-quote ebnf-sort-production)
|
||
(ps-print-quote ebnf-production-font)
|
||
(ps-print-quote ebnf-arrow-shape)
|
||
(ps-print-quote ebnf-chart-shape)
|
||
(ps-print-quote ebnf-user-arrow)
|
||
ebnf-horizontal-orientation
|
||
ebnf-horizontal-max-height
|
||
ebnf-production-horizontal-space
|
||
ebnf-production-vertical-space
|
||
(ps-print-quote ebnf-justify-sequence)
|
||
ebnf-lex-comment-char
|
||
ebnf-lex-eop-char
|
||
(ps-print-quote ebnf-syntax)
|
||
ebnf-iso-alternative-p
|
||
ebnf-iso-normalize-p
|
||
ebnf-file-suffix-regexp
|
||
ebnf-eps-prefix
|
||
ebnf-entry-percentage
|
||
ebnf-color-p
|
||
ebnf-line-width
|
||
ebnf-line-color
|
||
ebnf-debug-ps
|
||
ebnf-use-float-format
|
||
ebnf-stop-on-error
|
||
ebnf-yac-ignore-error-recovery
|
||
ebnf-ignore-empty-rule
|
||
ebnf-optimize))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Style variables
|
||
|
||
|
||
(defvar ebnf-stack-style nil
|
||
"Used in functions `ebnf-reset-style', `ebnf-push-style' and
|
||
`ebnf-pop-style'.")
|
||
|
||
|
||
(defvar ebnf-current-style 'default
|
||
"Used in functions `ebnf-apply-style' and `ebnf-push-style'.")
|
||
|
||
|
||
(defconst ebnf-style-custom-list
|
||
'(ebnf-special-show-delimiter
|
||
ebnf-special-font
|
||
ebnf-special-shape
|
||
ebnf-special-shadow
|
||
ebnf-special-border-width
|
||
ebnf-special-border-color
|
||
ebnf-except-font
|
||
ebnf-except-shape
|
||
ebnf-except-shadow
|
||
ebnf-except-border-width
|
||
ebnf-except-border-color
|
||
ebnf-repeat-font
|
||
ebnf-repeat-shape
|
||
ebnf-repeat-shadow
|
||
ebnf-repeat-border-width
|
||
ebnf-repeat-border-color
|
||
ebnf-terminal-regexp
|
||
ebnf-case-fold-search
|
||
ebnf-terminal-font
|
||
ebnf-terminal-shape
|
||
ebnf-terminal-shadow
|
||
ebnf-terminal-border-width
|
||
ebnf-terminal-border-color
|
||
ebnf-non-terminal-font
|
||
ebnf-non-terminal-shape
|
||
ebnf-non-terminal-shadow
|
||
ebnf-non-terminal-border-width
|
||
ebnf-non-terminal-border-color
|
||
ebnf-production-name-p
|
||
ebnf-sort-production
|
||
ebnf-production-font
|
||
ebnf-arrow-shape
|
||
ebnf-chart-shape
|
||
ebnf-user-arrow
|
||
ebnf-horizontal-orientation
|
||
ebnf-horizontal-max-height
|
||
ebnf-production-horizontal-space
|
||
ebnf-production-vertical-space
|
||
ebnf-justify-sequence
|
||
ebnf-lex-comment-char
|
||
ebnf-lex-eop-char
|
||
ebnf-syntax
|
||
ebnf-iso-alternative-p
|
||
ebnf-iso-normalize-p
|
||
ebnf-file-suffix-regexp
|
||
ebnf-eps-prefix
|
||
ebnf-entry-percentage
|
||
ebnf-color-p
|
||
ebnf-line-width
|
||
ebnf-line-color
|
||
ebnf-debug-ps
|
||
ebnf-use-float-format
|
||
ebnf-stop-on-error
|
||
ebnf-yac-ignore-error-recovery
|
||
ebnf-ignore-empty-rule
|
||
ebnf-optimize)
|
||
"List of valid symbol custom variable.")
|
||
|
||
|
||
(defvar ebnf-style-database
|
||
'(;; EBNF default
|
||
(default
|
||
nil
|
||
(ebnf-special-show-delimiter . t)
|
||
(ebnf-special-font . '(7 Courier "Black" "Gray95" bold italic))
|
||
(ebnf-special-shape . 'bevel)
|
||
(ebnf-special-shadow . nil)
|
||
(ebnf-special-border-width . 0.5)
|
||
(ebnf-special-border-color . "Black")
|
||
(ebnf-except-font . '(7 Courier "Black" "Gray90" bold italic))
|
||
(ebnf-except-shape . 'bevel)
|
||
(ebnf-except-shadow . nil)
|
||
(ebnf-except-border-width . 0.25)
|
||
(ebnf-except-border-color . "Black")
|
||
(ebnf-repeat-font . '(7 Courier "Black" "Gray85" bold italic))
|
||
(ebnf-repeat-shape . 'bevel)
|
||
(ebnf-repeat-shadow . nil)
|
||
(ebnf-repeat-border-width . 0.0)
|
||
(ebnf-repeat-border-color . "Black")
|
||
(ebnf-terminal-regexp . nil)
|
||
(ebnf-case-fold-search . nil)
|
||
(ebnf-terminal-font . '(7 Courier "Black" "White"))
|
||
(ebnf-terminal-shape . 'miter)
|
||
(ebnf-terminal-shadow . nil)
|
||
(ebnf-terminal-border-width . 1.0)
|
||
(ebnf-terminal-border-color . "Black")
|
||
(ebnf-non-terminal-font . '(7 Helvetica "Black" "White"))
|
||
(ebnf-non-terminal-shape . 'round)
|
||
(ebnf-non-terminal-shadow . nil)
|
||
(ebnf-non-terminal-border-width . 1.0)
|
||
(ebnf-non-terminal-border-color . "Black")
|
||
(ebnf-production-name-p . t)
|
||
(ebnf-sort-production . nil)
|
||
(ebnf-production-font . '(10 Helvetica "Black" "White" bold))
|
||
(ebnf-arrow-shape . 'hollow)
|
||
(ebnf-chart-shape . 'round)
|
||
(ebnf-user-arrow . nil)
|
||
(ebnf-horizontal-orientation . nil)
|
||
(ebnf-horizontal-max-height . nil)
|
||
(ebnf-production-horizontal-space . 0.0)
|
||
(ebnf-production-vertical-space . 0.0)
|
||
(ebnf-justify-sequence . 'center)
|
||
(ebnf-lex-comment-char . ?\;)
|
||
(ebnf-lex-eop-char . ?.)
|
||
(ebnf-syntax . 'ebnf)
|
||
(ebnf-iso-alternative-p . nil)
|
||
(ebnf-iso-normalize-p . nil)
|
||
(ebnf-file-suffix-regexp . "\.[Bb][Nn][Ff]$")
|
||
(ebnf-eps-prefix . "ebnf--")
|
||
(ebnf-entry-percentage . 0.5)
|
||
(ebnf-color-p . (or (fboundp 'x-color-values) ; Emacs
|
||
(fboundp 'color-instance-rgb-components))) ; XEmacs
|
||
(ebnf-line-width . 1.0)
|
||
(ebnf-line-color . "Black")
|
||
(ebnf-debug-ps . nil)
|
||
(ebnf-use-float-format . t)
|
||
(ebnf-stop-on-error . nil)
|
||
(ebnf-yac-ignore-error-recovery . nil)
|
||
(ebnf-ignore-empty-rule . nil)
|
||
(ebnf-optimize . nil))
|
||
;; Happy EBNF default
|
||
(happy
|
||
default
|
||
(ebnf-justify-sequence . 'left)
|
||
(ebnf-lex-comment-char . ?\#)
|
||
(ebnf-lex-eop-char . ?\;))
|
||
;; ABNF default
|
||
(abnf
|
||
default
|
||
(ebnf-syntax . 'abnf))
|
||
;; ISO EBNF default
|
||
(iso-ebnf
|
||
default
|
||
(ebnf-syntax . 'iso-ebnf))
|
||
;; Yacc/Bison default
|
||
(yacc
|
||
default
|
||
(ebnf-syntax . 'yacc))
|
||
;; ebnfx default
|
||
(ebnfx
|
||
default
|
||
(ebnf-syntax . 'ebnfx))
|
||
;; dtd default
|
||
(dtd
|
||
default
|
||
(ebnf-syntax . 'dtd))
|
||
)
|
||
"Style database.
|
||
|
||
Each element has the following form:
|
||
|
||
(NAME INHERITS (VAR . VALUE)...)
|
||
|
||
Where:
|
||
|
||
NAME is a symbol name style.
|
||
|
||
INHERITS is a symbol name style from which the current style inherits
|
||
the context. If INHERITS is nil, means that there is no
|
||
inheritance.
|
||
|
||
This is a simple inheritance of style; so if you declare that a
|
||
style A inherits from a style B, all settings of B is applied
|
||
first and then the settings of A is applied. This is useful
|
||
when you wish to modify some aspects of an existing style, but
|
||
at same time wish to keep it unmodified.
|
||
|
||
VAR is a valid ebnf2ps symbol custom variable.
|
||
See `ebnf-style-custom-list' for valid symbol variable.
|
||
|
||
VALUE is a sexp which it'll be evaluated to set the value to VAR.
|
||
So, don't forget to quote symbols and constant lists.
|
||
See `default' style for an example.
|
||
|
||
Don't handle this variable directly. Use functions `ebnf-insert-style',
|
||
`ebnf-delete-style' and `ebnf-merge-style'.")
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Style commands
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-insert-style (name inherits &rest values)
|
||
"Insert a new style NAME with inheritance INHERITS and values VALUES.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive "SStyle name: \nSStyle inherits from: \nXStyle values: ")
|
||
(and (assoc name ebnf-style-database)
|
||
(error "Style name already exists: %s" name))
|
||
(or (assoc inherits ebnf-style-database)
|
||
(error "Style inheritance name does'nt exist: %s" inherits))
|
||
(setq ebnf-style-database
|
||
(cons (cons name (cons inherits (ebnf-check-style-values values)))
|
||
ebnf-style-database)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-delete-style (name)
|
||
"Delete style NAME.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive "SDelete style name: ")
|
||
(or (assoc name ebnf-style-database)
|
||
(error "Style name doesn't exist: %s" name))
|
||
(let ((db ebnf-style-database))
|
||
(while db
|
||
(and (eq (nth 1 (car db)) name)
|
||
(error "Style name `%s' is inherited by `%s' style"
|
||
name (nth 0 (car db))))
|
||
(setq db (cdr db))))
|
||
(setq ebnf-style-database (assq-delete-all name ebnf-style-database)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-merge-style (name &rest values)
|
||
"Merge values of style NAME with style VALUES.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive "SStyle name: \nXStyle values: ")
|
||
(let ((style (or (assoc name ebnf-style-database)
|
||
(error "Style name does'nt exist: %s" name)))
|
||
(merge (ebnf-check-style-values values))
|
||
val elt new check)
|
||
;; modify value of existing variables
|
||
(setq val (nthcdr 2 style))
|
||
(while merge
|
||
(setq check (car merge)
|
||
merge (cdr merge)
|
||
elt (assoc (car check) val))
|
||
(if elt
|
||
(setcdr elt (cdr check))
|
||
(setq new (cons check new))))
|
||
;; insert new variables
|
||
(nconc style (nreverse new))))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-apply-style (style)
|
||
"Set STYLE as the current style.
|
||
|
||
It returns the old style symbol.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive "SApply style: ")
|
||
(prog1
|
||
ebnf-current-style
|
||
(and (ebnf-apply-style1 style)
|
||
(setq ebnf-current-style style))))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-reset-style (&optional style)
|
||
"Reset current style.
|
||
|
||
It returns the old style symbol.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive "SReset style: ")
|
||
(setq ebnf-stack-style nil)
|
||
(ebnf-apply-style (or style 'default)))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-push-style (&optional style)
|
||
"Push the current style and set STYLE as the current style.
|
||
|
||
It returns the old style symbol.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive "SPush style: ")
|
||
(prog1
|
||
ebnf-current-style
|
||
(setq ebnf-stack-style (cons ebnf-current-style ebnf-stack-style))
|
||
(and style
|
||
(ebnf-apply-style style))))
|
||
|
||
|
||
;;;###autoload
|
||
(defun ebnf-pop-style ()
|
||
"Pop a style and set it as the current style.
|
||
|
||
It returns the old style symbol.
|
||
|
||
See `ebnf-style-database' documentation."
|
||
(interactive)
|
||
(prog1
|
||
(ebnf-apply-style (car ebnf-stack-style))
|
||
(setq ebnf-stack-style (cdr ebnf-stack-style))))
|
||
|
||
|
||
(defun ebnf-apply-style1 (style)
|
||
(let ((value (cdr (assoc style ebnf-style-database))))
|
||
(prog1
|
||
value
|
||
(and (car value) (ebnf-apply-style1 (car value)))
|
||
(while (setq value (cdr value))
|
||
(set (caar value) (eval (cdar value)))))))
|
||
|
||
|
||
(defun ebnf-check-style-values (values)
|
||
(let (style)
|
||
(while values
|
||
(and (memq (caar values) ebnf-style-custom-list)
|
||
(setq style (cons (car values) style)))
|
||
(setq values (cdr values)))
|
||
(nreverse style)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Internal variables
|
||
|
||
|
||
(defvar ebnf-eps-buffer-name " *EPS*")
|
||
(defvar ebnf-parser-func nil)
|
||
(defvar ebnf-eps-executing nil)
|
||
(defvar ebnf-eps-upper-x 0.0)
|
||
(make-variable-buffer-local 'ebnf-eps-upper-x)
|
||
(defvar ebnf-eps-upper-y 0.0)
|
||
(make-variable-buffer-local 'ebnf-eps-upper-y)
|
||
(defvar ebnf-eps-prod-width 0.0)
|
||
(make-variable-buffer-local 'ebnf-eps-prod-width)
|
||
(defvar ebnf-eps-max-height 0.0)
|
||
(make-variable-buffer-local 'ebnf-eps-max-height)
|
||
(defvar ebnf-eps-max-width 0.0)
|
||
(make-variable-buffer-local 'ebnf-eps-max-width)
|
||
|
||
|
||
(defvar ebnf-eps-context nil
|
||
"List of EPS file name during parsing.
|
||
|
||
See section \"Actions in Comments\" in ebnf2ps documentation.")
|
||
|
||
|
||
(defvar ebnf-eps-production-list nil
|
||
"Alist associating production name with EPS file name list.
|
||
|
||
Each element has the following form:
|
||
|
||
(PRODUCTION EPS-FILENAME...)
|
||
|
||
PRODUCTION is the production name.
|
||
EPS-FILENAME is the EPS file name.
|
||
|
||
It's generated during parsing and used during EPS generation.
|
||
|
||
See `ebnf-eps-context' and section \"Actions in Comments\" in ebnf2ps
|
||
documentation.")
|
||
|
||
|
||
(defconst ebnf-arrow-shape-alist
|
||
'((none . 0)
|
||
(semi-up . 1)
|
||
(semi-down . 2)
|
||
(simple . 3)
|
||
(transparent . 4)
|
||
(hollow . 5)
|
||
(full . 6)
|
||
(semi-up-hollow . 7)
|
||
(semi-up-full . 8)
|
||
(semi-down-hollow . 9)
|
||
(semi-down-full . 10)
|
||
(user . 11))
|
||
"Alist associating values for `ebnf-arrow-shape'.
|
||
|
||
See documentation for `ebnf-arrow-shape'.")
|
||
|
||
|
||
(defconst ebnf-terminal-shape-alist
|
||
'((miter . 0)
|
||
(round . 1)
|
||
(bevel . 2))
|
||
"Alist associating values from `ebnf-terminal-shape' to a bit vector.
|
||
|
||
See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
|
||
`ebnf-chart-shape'.")
|
||
|
||
|
||
(defvar ebnf-limit nil)
|
||
(defvar ebnf-action nil)
|
||
(defvar ebnf-action-list nil)
|
||
|
||
|
||
(defvar ebnf-default-p nil)
|
||
|
||
|
||
(defvar ebnf-font-height-P 0)
|
||
(defvar ebnf-font-height-T 0)
|
||
(defvar ebnf-font-height-NT 0)
|
||
(defvar ebnf-font-height-S 0)
|
||
(defvar ebnf-font-height-E 0)
|
||
(defvar ebnf-font-height-R 0)
|
||
(defvar ebnf-font-width-P 0)
|
||
(defvar ebnf-font-width-T 0)
|
||
(defvar ebnf-font-width-NT 0)
|
||
(defvar ebnf-font-width-S 0)
|
||
(defvar ebnf-font-width-E 0)
|
||
(defvar ebnf-font-width-R 0)
|
||
(defvar ebnf-space-T 0)
|
||
(defvar ebnf-space-NT 0)
|
||
(defvar ebnf-space-S 0)
|
||
(defvar ebnf-space-E 0)
|
||
(defvar ebnf-space-R 0)
|
||
|
||
|
||
(defvar ebnf-basic-width 0)
|
||
(defvar ebnf-basic-height 0)
|
||
(defvar ebnf-vertical-space 0)
|
||
(defvar ebnf-horizontal-space 0)
|
||
|
||
|
||
(defvar ebnf-settings nil)
|
||
(defvar ebnf-fonts-required nil)
|
||
|
||
|
||
(defconst ebnf-debug
|
||
"
|
||
% === begin EBNF procedures to help debugging
|
||
|
||
% Mark visually current point: string debug
|
||
/debug
|
||
{/-s- exch def
|
||
currentpoint
|
||
gsave -s- show grestore
|
||
gsave
|
||
20 20 rlineto
|
||
0 -40 rlineto
|
||
-40 40 rlineto
|
||
0 -40 rlineto
|
||
20 20 rlineto
|
||
stroke
|
||
grestore
|
||
moveto
|
||
}def
|
||
|
||
% Show number value: number string debug-number
|
||
/debug-number
|
||
{gsave
|
||
20 0 rmoveto show ([) show 60 string cvs show (]) show
|
||
grestore
|
||
}def
|
||
|
||
% === end EBNF procedures to help debugging
|
||
|
||
"
|
||
"This is intended to help debugging PostScript programming.")
|
||
|
||
|
||
(defconst ebnf-prologue
|
||
"
|
||
% === begin EBNF engine
|
||
|
||
% --- Basic Definitions
|
||
|
||
/fS F
|
||
/SpaceS FontHeight 0.5 mul def
|
||
/HeightS FontHeight FontHeight add def
|
||
|
||
/fE F
|
||
/SpaceE FontHeight 0.5 mul def
|
||
/HeightE FontHeight FontHeight add def
|
||
|
||
/fR F
|
||
/SpaceR FontHeight 0.5 mul def
|
||
/HeightR FontHeight FontHeight add def
|
||
|
||
/fT F
|
||
/SpaceT FontHeight 0.5 mul def
|
||
/HeightT FontHeight FontHeight add def
|
||
|
||
/fNT F
|
||
/SpaceNT FontHeight 0.5 mul def
|
||
/HeightNT FontHeight FontHeight add def
|
||
|
||
/T HeightT HeightNT add 0.5 mul def
|
||
/hT T 0.5 mul def
|
||
/hT2 hT 0.5 mul def
|
||
/hT4 hT 0.25 mul def
|
||
|
||
/Er 0.1 def % Error factor
|
||
|
||
|
||
/c{currentpoint}bind def
|
||
/xyi{/xi c /yi exch def def}bind def
|
||
/xyo{/xo c /yo exch def def}bind def
|
||
/xyp{/xp c /yp exch def def}bind def
|
||
/xyt{/xt c /yt exch def def}bind def
|
||
|
||
% vertical movement: x y height vm
|
||
/vm{add moveto}bind def
|
||
|
||
% horizontal movement: x y width hm
|
||
/hm{3 -1 roll exch add exch moveto}bind def
|
||
|
||
% set color: [R G B] SetRGB
|
||
/SetRGB{aload pop setrgbcolor}bind def
|
||
|
||
% filling gray area: gray-scale FillGray
|
||
/FillGray{gsave setgray fill grestore}bind def
|
||
|
||
% filling color area: [R G B] FillRGB
|
||
/FillRGB{gsave SetRGB fill grestore}bind def
|
||
|
||
/Stroke{LineWidth setlinewidth LineColor SetRGB stroke}bind def
|
||
/StrokeShape{borderwidth setlinewidth bordercolor SetRGB stroke}bind def
|
||
/Gstroke{gsave Stroke grestore}bind def
|
||
|
||
% Empty Line: width EL
|
||
/EL{0 rlineto Gstroke}bind def
|
||
|
||
% --- Arrows
|
||
|
||
/Down{hT2 neg hT4 neg rlineto}bind def
|
||
|
||
/Arrow
|
||
{hT2 neg hT4 rmoveto
|
||
hT2 hT4 neg rlineto
|
||
Down
|
||
}bind def
|
||
|
||
/ArrowPath{c newpath moveto Arrow closepath}bind def
|
||
|
||
/UpPath
|
||
{c newpath moveto
|
||
hT2 neg 0 rmoveto
|
||
0 hT4 rlineto
|
||
hT2 hT4 neg rlineto
|
||
closepath
|
||
}bind def
|
||
|
||
/DownPath
|
||
{c newpath moveto
|
||
hT2 neg 0 rmoveto
|
||
0 hT4 neg rlineto
|
||
hT2 hT4 rlineto
|
||
closepath
|
||
}bind def
|
||
|
||
%>Right Arrow: RA
|
||
% \\
|
||
% *---+
|
||
% /
|
||
/RA-vector
|
||
[{} % 0 - none
|
||
{hT2 neg hT4 rlineto} % 1 - semi-up
|
||
{Down} % 2 - semi-down
|
||
{Arrow} % 3 - simple
|
||
{Gstroke ArrowPath} % 4 - transparent
|
||
{Gstroke ArrowPath 1 FillGray} % 5 - hollow
|
||
{Gstroke ArrowPath LineColor FillRGB} % 6 - full
|
||
{Gstroke UpPath 1 FillGray} % 7 - semi-up-hollow
|
||
{Gstroke UpPath LineColor FillRGB} % 8 - semi-up-full
|
||
{Gstroke DownPath 1 FillGray} % 9 - semi-down-hollow
|
||
{Gstroke DownPath LineColor FillRGB} % 10 - semi-down-full
|
||
{Gstroke gsave UserArrow grestore} % 11 - user
|
||
]def
|
||
|
||
/RA
|
||
{hT 0 rlineto
|
||
c
|
||
RA-vector ArrowShape get exec
|
||
Gstroke
|
||
moveto
|
||
}def
|
||
|
||
% rotation DrawArrow
|
||
/DrawArrow
|
||
{gsave
|
||
0 0 translate
|
||
rotate
|
||
RA
|
||
c
|
||
grestore
|
||
rmoveto
|
||
}def
|
||
|
||
%>Left Arrow: LA
|
||
% /
|
||
% +---*
|
||
% \\
|
||
/LA{180 DrawArrow}def
|
||
|
||
%>Up Arrow: UA
|
||
% +
|
||
% /|\\
|
||
% |
|
||
% *
|
||
/UA{90 DrawArrow}def
|
||
|
||
%>Down Arrow: DA
|
||
% *
|
||
% |
|
||
% \\|/
|
||
% +
|
||
/DA{270 DrawArrow}def
|
||
|
||
% --- Corners
|
||
|
||
%>corner Right Descendent: height arrow corner_RD
|
||
% _ | arrow
|
||
% / height > 0 | 0 - none
|
||
% | | 1 - right
|
||
% * ---------- | 2 - left
|
||
% | | 3 - vertical
|
||
% \\ height < 0 |
|
||
% - |
|
||
/cRD0-vector
|
||
[% 0 - none
|
||
{0 h rlineto
|
||
hT 0 rlineto}
|
||
% 1 - right
|
||
{0 h rlineto
|
||
RA}
|
||
% 2 - left
|
||
{hT 0 rmoveto xyi
|
||
LA
|
||
0 h neg rlineto
|
||
xi yi moveto}
|
||
% 3 - vertical
|
||
{hT h rmoveto xyi
|
||
hT neg 0 rlineto
|
||
h 0 gt{DA}{UA}ifelse
|
||
xi yi moveto}
|
||
]def
|
||
|
||
/cRD-vector
|
||
[{cRD0-vector arrow get exec} % 0 - miter
|
||
{0 0 0 h hT h rcurveto} % 1 - rounded
|
||
{hT h rlineto} % 2 - bevel
|
||
]def
|
||
|
||
/corner_RD
|
||
{/arrow exch def /h exch def
|
||
cRD-vector ChartShape get exec
|
||
Gstroke
|
||
}def
|
||
|
||
%>corner Right Ascendent: height arrow corner_RA
|
||
% | arrow
|
||
% | height > 0 | 0 - none
|
||
% / | 1 - right
|
||
% *- ---------- | 2 - left
|
||
% \\ | 3 - vertical
|
||
% | height < 0 |
|
||
% |
|
||
/cRA0-vector
|
||
[% 0 - none
|
||
{hT 0 rlineto
|
||
0 h rlineto}
|
||
% 1 - right
|
||
{RA
|
||
0 h rlineto}
|
||
% 2 - left
|
||
{hT h rmoveto xyi
|
||
0 h neg rlineto
|
||
LA
|
||
xi yi moveto}
|
||
% 3 - vertical
|
||
{hT h rmoveto xyi
|
||
h 0 gt{DA}{UA}ifelse
|
||
hT neg 0 rlineto
|
||
xi yi moveto}
|
||
]def
|
||
|
||
/cRA-vector
|
||
[{cRA0-vector arrow get exec} % 0 - miter
|
||
{0 0 hT 0 hT h rcurveto} % 1 - rounded
|
||
{hT h rlineto} % 2 - bevel
|
||
]def
|
||
|
||
/corner_RA
|
||
{/arrow exch def /h exch def
|
||
cRA-vector ChartShape get exec
|
||
Gstroke
|
||
}def
|
||
|
||
%>corner Left Descendent: height arrow corner_LD
|
||
% _ | arrow
|
||
% \\ height > 0 | 0 - none
|
||
% | | 1 - right
|
||
% * ---------- | 2 - left
|
||
% | | 3 - vertical
|
||
% / height < 0 |
|
||
% - |
|
||
/cLD0-vector
|
||
[% 0 - none
|
||
{0 h rlineto
|
||
hT neg 0 rlineto}
|
||
% 1 - right
|
||
{hT neg h rmoveto xyi
|
||
RA
|
||
0 h neg rlineto
|
||
xi yi moveto}
|
||
% 2 - left
|
||
{0 h rlineto
|
||
LA}
|
||
% 3 - vertical
|
||
{hT neg h rmoveto xyi
|
||
hT 0 rlineto
|
||
h 0 gt{DA}{UA}ifelse
|
||
xi yi moveto}
|
||
]def
|
||
|
||
/cLD-vector
|
||
[{cLD0-vector arrow get exec} % 0 - miter
|
||
{0 0 0 h hT neg h rcurveto} % 1 - rounded
|
||
{hT neg h rlineto} % 2 - bevel
|
||
]def
|
||
|
||
/corner_LD
|
||
{/arrow exch def /h exch def
|
||
cLD-vector ChartShape get exec
|
||
Gstroke
|
||
}def
|
||
|
||
%>corner Left Ascendent: height arrow corner_LA
|
||
% | arrow
|
||
% | height > 0 | 0 - none
|
||
% \\ | 1 - right
|
||
% -* ---------- | 2 - left
|
||
% / | 3 - vertical
|
||
% | height < 0 |
|
||
% |
|
||
/cLA0-vector
|
||
[% 0 - none
|
||
{hT neg 0 rlineto
|
||
0 h rlineto}
|
||
% 1 - right
|
||
{hT neg h rmoveto xyi
|
||
0 h neg rlineto
|
||
RA
|
||
xi yi moveto}
|
||
% 2 - left
|
||
{LA
|
||
0 h rlineto}
|
||
% 3 - vertical
|
||
{hT neg h rmoveto xyi
|
||
h 0 gt{DA}{UA}ifelse
|
||
hT 0 rlineto
|
||
xi yi moveto}
|
||
]def
|
||
|
||
/cLA-vector
|
||
[{cLA0-vector arrow get exec} % 0 - miter
|
||
{0 0 hT neg 0 hT neg h rcurveto} % 1 - rounded
|
||
{hT neg h rlineto} % 2 - bevel
|
||
]def
|
||
|
||
/corner_LA
|
||
{/arrow exch def /h exch def
|
||
cLA-vector ChartShape get exec
|
||
Gstroke
|
||
}def
|
||
|
||
% --- Flow Stuff
|
||
|
||
% height prepare_height |- line_height corner_height corner_height
|
||
/prepare_height
|
||
{dup 0 gt
|
||
{T sub hT}
|
||
{T add hT neg}ifelse
|
||
dup
|
||
}def
|
||
|
||
%>Left Alternative: height LAlt
|
||
% _
|
||
% /
|
||
% | height > 0
|
||
% |
|
||
% /
|
||
% *- ----------
|
||
% \\
|
||
% |
|
||
% | height < 0
|
||
% \\
|
||
% -
|
||
/LAlt
|
||
{dup 0 eq
|
||
{T exch rlineto}
|
||
{dup abs T lt
|
||
{0.5 mul dup
|
||
1 corner_RA
|
||
0 corner_RD}
|
||
{prepare_height
|
||
1 corner_RA
|
||
exch 0 exch rlineto
|
||
0 corner_RD
|
||
}ifelse
|
||
}ifelse
|
||
}def
|
||
|
||
%>Left Loop: height LLoop
|
||
% _
|
||
% /
|
||
% | height > 0
|
||
% |
|
||
% \\
|
||
% -* ----------
|
||
% /
|
||
% |
|
||
% | height < 0
|
||
% \\
|
||
% -
|
||
/LLoop
|
||
{prepare_height
|
||
3 corner_LA
|
||
exch 0 exch rlineto
|
||
0 corner_RD
|
||
}def
|
||
|
||
%>Right Alternative: height RAlt
|
||
% _
|
||
% \\
|
||
% | height > 0
|
||
% |
|
||
% \\
|
||
% -* ----------
|
||
% /
|
||
% |
|
||
% | height < 0
|
||
% /
|
||
% -
|
||
/RAlt
|
||
{dup 0 eq
|
||
{T neg exch rlineto}
|
||
{dup abs T lt
|
||
{0.5 mul dup
|
||
1 corner_LA
|
||
0 corner_LD}
|
||
{prepare_height
|
||
1 corner_LA
|
||
exch 0 exch rlineto
|
||
0 corner_LD
|
||
}ifelse
|
||
}ifelse
|
||
}def
|
||
|
||
%>Right Loop: height RLoop
|
||
% _
|
||
% \\
|
||
% | height > 0
|
||
% |
|
||
% /
|
||
% *- ----------
|
||
% \\
|
||
% |
|
||
% | height < 0
|
||
% /
|
||
% -
|
||
/RLoop
|
||
{prepare_height
|
||
1 corner_RA
|
||
exch 0 exch rlineto
|
||
0 corner_LD
|
||
}def
|
||
|
||
% --- Terminal, Non-terminal and Special Basics
|
||
|
||
% string width prepare-width |- string
|
||
/prepare-width
|
||
{/width exch def
|
||
dup stringwidth pop space add space add width exch sub 0.5 mul
|
||
/w exch def
|
||
}def
|
||
|
||
% string width begin-right
|
||
/begin-right
|
||
{xyo
|
||
prepare-width
|
||
w hT sub EL
|
||
RA
|
||
}def
|
||
|
||
% end-right
|
||
/end-right
|
||
{xo width add Er add yo moveto
|
||
w Er add neg EL
|
||
xo yo moveto
|
||
}def
|
||
|
||
% string width begin-left
|
||
/begin-left
|
||
{xyo
|
||
prepare-width
|
||
w EL
|
||
}def
|
||
|
||
% end-left
|
||
/end-left
|
||
{xo width add Er add yo moveto
|
||
hT w sub Er add EL
|
||
LA
|
||
xo yo moveto
|
||
}def
|
||
|
||
/ShapePath-vector
|
||
[% 0 - miter
|
||
{xx yy moveto
|
||
xx YY lineto
|
||
XX YY lineto
|
||
XX yy lineto}
|
||
% 1 - rounded
|
||
{/half YY yy sub 0.5 mul abs def
|
||
xx half add YY moveto
|
||
0 0 half neg 0 half neg half neg rcurveto
|
||
0 0 0 half neg half half neg rcurveto
|
||
XX xx sub abs half sub half sub 0 rlineto
|
||
0 0 half 0 half half rcurveto
|
||
0 0 0 half half neg half rcurveto}
|
||
% 2 - bevel
|
||
{/quarter YY yy sub 0.25 mul abs def
|
||
xx quarter add YY moveto
|
||
quarter neg quarter neg rlineto
|
||
0 quarter quarter add neg rlineto
|
||
quarter quarter neg rlineto
|
||
XX xx sub abs quarter sub quarter sub 0 rlineto
|
||
quarter quarter rlineto
|
||
0 quarter quarter add rlineto
|
||
quarter neg quarter rlineto}
|
||
]def
|
||
|
||
/doShapePath
|
||
{newpath
|
||
ShapePath-vector shape get exec
|
||
closepath
|
||
}def
|
||
|
||
/doShapeShadow
|
||
{gsave
|
||
Xshadow Xshadow add Xshadow add
|
||
Yshadow Yshadow add Yshadow add translate
|
||
doShapePath
|
||
0.9 FillGray
|
||
grestore
|
||
}def
|
||
|
||
/doShape
|
||
{gsave
|
||
doShapePath
|
||
shapecolor FillRGB
|
||
StrokeShape
|
||
grestore
|
||
}def
|
||
|
||
% string SBound |- string
|
||
/SBound
|
||
{/xx c dup /yy exch def
|
||
FontHeight add /YY exch def def
|
||
dup stringwidth pop xx add /XX exch def
|
||
Effect 8 and 0 ne
|
||
{/yy yy YShadow add def
|
||
/XX XX XShadow add def
|
||
}if
|
||
}def
|
||
|
||
% string SBox
|
||
/SBox
|
||
{gsave
|
||
c space sub moveto
|
||
SBound
|
||
/XX XX space add space add def
|
||
/YY YY space add def
|
||
/yy yy space sub def
|
||
shadow{doShapeShadow}if
|
||
doShape
|
||
space Descent abs rmoveto
|
||
foreground SetRGB S
|
||
grestore
|
||
}def
|
||
|
||
% --- Terminal
|
||
|
||
% TeRminal: string TR
|
||
/TR
|
||
{/Effect EffectT def
|
||
/shape ShapeT def
|
||
/shapecolor BackgroundT def
|
||
/borderwidth BorderWidthT def
|
||
/bordercolor BorderColorT def
|
||
/foreground ForegroundT def
|
||
/shadow ShadowT def
|
||
SBox
|
||
}def
|
||
|
||
%>Right Terminal: string width RT |- x y
|
||
/RT
|
||
{xyt
|
||
/fT F
|
||
/space SpaceT def
|
||
begin-right
|
||
TR
|
||
end-right
|
||
xt yt
|
||
}def
|
||
|
||
%>Left Terminal: string width LT |- x y
|
||
/LT
|
||
{xyt
|
||
/fT F
|
||
/space SpaceT def
|
||
begin-left
|
||
TR
|
||
end-left
|
||
xt yt
|
||
}def
|
||
|
||
%>Right Terminal Default: string width RTD |- x y
|
||
/RTD
|
||
{/-save- BorderWidthT def
|
||
/BorderWidthT BorderWidthT DefaultWidth add def
|
||
RT
|
||
/BorderWidthT -save- def
|
||
}def
|
||
|
||
%>Left Terminal Default: string width LTD |- x y
|
||
/LTD
|
||
{/-save- BorderWidthT def
|
||
/BorderWidthT BorderWidthT DefaultWidth add def
|
||
LT
|
||
/BorderWidthT -save- def
|
||
}def
|
||
|
||
% --- Non-Terminal
|
||
|
||
% Non-Terminal: string NT
|
||
/NT
|
||
{/Effect EffectNT def
|
||
/shape ShapeNT def
|
||
/shapecolor BackgroundNT def
|
||
/borderwidth BorderWidthNT def
|
||
/bordercolor BorderColorNT def
|
||
/foreground ForegroundNT def
|
||
/shadow ShadowNT def
|
||
SBox
|
||
}def
|
||
|
||
%>Right Non-Terminal: string width RNT |- x y
|
||
/RNT
|
||
{xyt
|
||
/fNT F
|
||
/space SpaceNT def
|
||
begin-right
|
||
NT
|
||
end-right
|
||
xt yt
|
||
}def
|
||
|
||
%>Left Non-Terminal: string width LNT |- x y
|
||
/LNT
|
||
{xyt
|
||
/fNT F
|
||
/space SpaceNT def
|
||
begin-left
|
||
NT
|
||
end-left
|
||
xt yt
|
||
}def
|
||
|
||
%>Right Non-Terminal Default: string width RNTD |- x y
|
||
/RNTD
|
||
{/-save- BorderWidthNT def
|
||
/BorderWidthNT BorderWidthNT DefaultWidth add def
|
||
RNT
|
||
/BorderWidthNT -save- def
|
||
}def
|
||
|
||
%>Left Non-Terminal Default: string width LNTD |- x y
|
||
/LNTD
|
||
{/-save- BorderWidthNT def
|
||
/BorderWidthNT BorderWidthNT DefaultWidth add def
|
||
LNT
|
||
/BorderWidthNT -save- def
|
||
}def
|
||
|
||
% --- Special
|
||
|
||
% SPecial: string SP
|
||
/SP
|
||
{/Effect EffectS def
|
||
/shape ShapeS def
|
||
/shapecolor BackgroundS def
|
||
/borderwidth BorderWidthS def
|
||
/bordercolor BorderColorS def
|
||
/foreground ForegroundS def
|
||
/shadow ShadowS def
|
||
SBox
|
||
}def
|
||
|
||
%>Right SPecial: string width RSP |- x y
|
||
/RSP
|
||
{xyt
|
||
/fS F
|
||
/space SpaceS def
|
||
begin-right
|
||
SP
|
||
end-right
|
||
xt yt
|
||
}def
|
||
|
||
%>Left SPecial: string width LSP |- x y
|
||
/LSP
|
||
{xyt
|
||
/fS F
|
||
/space SpaceS def
|
||
begin-left
|
||
SP
|
||
end-left
|
||
xt yt
|
||
}def
|
||
|
||
%>Right SPecial Default: string width RSPD |- x y
|
||
/RSPD
|
||
{/-save- BorderWidthS def
|
||
/BorderWidthS BorderWidthS DefaultWidth add def
|
||
RSP
|
||
/BorderWidthS -save- def
|
||
}def
|
||
|
||
%>Left SPecial Default: string width LSPD |- x y
|
||
/LSPD
|
||
{/-save- BorderWidthS def
|
||
/BorderWidthS BorderWidthS DefaultWidth add def
|
||
LSP
|
||
/BorderWidthS -save- def
|
||
}def
|
||
|
||
% --- Repeat and Except basics
|
||
|
||
/begin-direction
|
||
{/w width rwidth sub 0.5 mul def
|
||
width 0 rmoveto}def
|
||
|
||
/end-direction
|
||
{gsave
|
||
/xx c entry add /YY exch def def
|
||
/yy YY height sub def
|
||
/XX xx rwidth add def
|
||
shadow{doShapeShadow}if
|
||
doShape
|
||
grestore
|
||
}def
|
||
|
||
/right-direction
|
||
{begin-direction
|
||
w neg EL
|
||
xt yt moveto
|
||
w hT sub EL RA
|
||
end-direction
|
||
}def
|
||
|
||
/left-direction
|
||
{begin-direction
|
||
hT w sub EL LA
|
||
xt yt moveto
|
||
w EL
|
||
end-direction
|
||
}def
|
||
|
||
% --- Repeat
|
||
|
||
% entry height width rwidth begin-repeat
|
||
/begin-repeat
|
||
{/rwidth exch def
|
||
/width exch def
|
||
/height exch def
|
||
/entry exch def
|
||
/fR F
|
||
/space SpaceR def
|
||
/Effect EffectR def
|
||
/shape ShapeR def
|
||
/shapecolor BackgroundR def
|
||
/borderwidth BorderWidthR def
|
||
/bordercolor BorderColorR def
|
||
/foreground ForegroundR def
|
||
/shadow ShadowR def
|
||
xyt
|
||
}def
|
||
|
||
% string end-repeat |- x y
|
||
/end-repeat
|
||
{gsave
|
||
space Descent rmoveto
|
||
foreground SetRGB S
|
||
c Descent sub
|
||
grestore
|
||
exch space add exch moveto
|
||
xt yt
|
||
}def
|
||
|
||
%>Right RePeat: string entry height width rwidth RRP |- x y
|
||
/RRP{begin-repeat right-direction end-repeat}def
|
||
|
||
%>Left RePeat: string entry height width rwidth LRP |- x y
|
||
/LRP{begin-repeat left-direction end-repeat}def
|
||
|
||
% --- Except
|
||
|
||
% entry height width rwidth begin-except
|
||
/begin-except
|
||
{/rwidth exch def
|
||
/width exch def
|
||
/height exch def
|
||
/entry exch def
|
||
/fE F
|
||
/space SpaceE def
|
||
/Effect EffectE def
|
||
/shape ShapeE def
|
||
/shapecolor BackgroundE def
|
||
/borderwidth BorderWidthE def
|
||
/bordercolor BorderColorE def
|
||
/foreground ForegroundE def
|
||
/shadow ShadowE def
|
||
xyt
|
||
}def
|
||
|
||
% x-width end-except |- x y
|
||
/end-except
|
||
{gsave
|
||
space space add add Descent rmoveto
|
||
(-) foreground SetRGB S
|
||
grestore
|
||
space 0 rmoveto
|
||
xt yt
|
||
}def
|
||
|
||
%>Right EXcept: x-width entry height width rwidth REX |- x y
|
||
/REX{begin-except right-direction end-except}def
|
||
|
||
%>Left EXcept: x-width entry height width rwidth LEX |- x y
|
||
/LEX{begin-except left-direction end-except}def
|
||
|
||
% --- Sequence
|
||
|
||
%>Beginning Of Sequence: BOS |- x y
|
||
/BOS{currentpoint}bind def
|
||
|
||
%>End Of Sequence: x y x1 y1 EOS |- x y
|
||
/EOS{pop pop}bind def
|
||
|
||
% --- Production
|
||
|
||
%>Beginning Of Production: string width height BOP |- y x
|
||
/BOP
|
||
{xyp
|
||
neg yp add /yw exch def
|
||
xp add T sub /xw exch def
|
||
dup length 0 gt % empty string ==> no production name
|
||
{/Effect EffectP def
|
||
/fP F ForegroundP SetRGB BackgroundP aload pop true BG S
|
||
/Effect 0 def
|
||
( :) S false BG}if
|
||
xw yw moveto
|
||
hT EL RA
|
||
xp yw moveto
|
||
T EL
|
||
yp xp
|
||
}def
|
||
|
||
%>End Of Production: y x delta EOP
|
||
/EOPH{add exch moveto}bind def % horizontal
|
||
/EOPV{exch pop sub 0 exch moveto}bind def % vertical
|
||
|
||
% --- Empty Alternative
|
||
|
||
%>Empty Alternative: width EA |- x y
|
||
/EA
|
||
{gsave
|
||
Er add 0 rlineto
|
||
Stroke
|
||
grestore
|
||
c
|
||
}def
|
||
|
||
% --- Alternative
|
||
|
||
%>AlTernative: h1 h2 ... hn n width AT |- x y
|
||
/AT
|
||
{xyo xo add /xw exch def
|
||
xw yo moveto
|
||
Er EL
|
||
{xw yo moveto
|
||
dup RAlt
|
||
xo yo moveto
|
||
LAlt}repeat
|
||
xo yo
|
||
}def
|
||
|
||
% --- Optional
|
||
|
||
%>OPtional: height width OP |- x y
|
||
/OP
|
||
{xyo
|
||
T sub /ow exch def
|
||
ow Er sub 0 rmoveto
|
||
T Er add EL
|
||
neg dup RAlt
|
||
ow T sub neg EL
|
||
xo yo moveto
|
||
LAlt
|
||
xo yo moveto
|
||
T EL
|
||
xo yo
|
||
}def
|
||
|
||
% --- List Flow
|
||
|
||
%>One or More: height width OM |- x y
|
||
/OM
|
||
{xyo
|
||
/ow exch def
|
||
ow Er add 0 rmoveto
|
||
T Er add neg EL
|
||
dup RLoop
|
||
xo T add yo moveto
|
||
LLoop
|
||
xo yo moveto
|
||
T EL
|
||
xo yo
|
||
}def
|
||
|
||
%>Zero or More: h2 h1 width ZM |- x y
|
||
/ZM
|
||
{xyo
|
||
Er add EL
|
||
Er neg 0 rmoveto
|
||
dup RAlt
|
||
exch dup RLoop
|
||
xo yo moveto
|
||
exch dup LAlt
|
||
exch LLoop
|
||
yo add xo T add exch moveto
|
||
xo yo
|
||
}def
|
||
|
||
% === end EBNF engine
|
||
|
||
"
|
||
"EBNF PostScript prologue")
|
||
|
||
|
||
(defconst ebnf-eps-prologue
|
||
"
|
||
/#ebnf2ps#dict 230 dict def
|
||
#ebnf2ps#dict begin
|
||
|
||
% Initiliaze variables to avoid name-conflicting with document variables.
|
||
% This is the case when using `bind' operator.
|
||
/-fillp- 0 def /h 0 def
|
||
/-ox- 0 def /half 0 def
|
||
/-oy- 0 def /height 0 def
|
||
/-save- 0 def /ow 0 def
|
||
/Ascent 0 def /quarter 0 def
|
||
/Descent 0 def /rXX 0 def
|
||
/Effect 0 def /rYY 0 def
|
||
/FontHeight 0 def /rwidth 0 def
|
||
/LineThickness 0 def /rxx 0 def
|
||
/OverlinePosition 0 def /ryy 0 def
|
||
/SpaceBackground 0 def /shadow 0 def
|
||
/StrikeoutPosition 0 def /shape 0 def
|
||
/UnderlinePosition 0 def /shapecolor 0 def
|
||
/XBox 0 def /space 0 def
|
||
/XX 0 def /st 1 string def
|
||
/Xshadow 0 def /w 0 def
|
||
/YBox 0 def /width 0 def
|
||
/YY 0 def /xi 0 def
|
||
/Yshadow 0 def /xo 0 def
|
||
/arrow 0 def /xp 0 def
|
||
/bg false def /xt 0 def
|
||
/bgcolor 0 def /xw 0 def
|
||
/bordercolor 0 def /xx 0 def
|
||
/borderwidth 0 def /yi 0 def
|
||
/dd 0 def /yo 0 def
|
||
/entry 0 def /yp 0 def
|
||
/foreground 0 def /yt 0 def
|
||
/yy 0 def
|
||
|
||
|
||
% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
|
||
/ISOLatin1Encoding where
|
||
{pop}
|
||
{% -- The ISO Latin-1 encoding vector isn't known, so define it.
|
||
% -- The first half is the same as the standard encoding,
|
||
% -- except for minus instead of hyphen at code 055.
|
||
/ISOLatin1Encoding
|
||
StandardEncoding 0 45 getinterval aload pop
|
||
/minus
|
||
StandardEncoding 46 82 getinterval aload pop
|
||
%*** NOTE: the following are missing in the Adobe documentation,
|
||
%*** but appear in the displayed table:
|
||
%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
|
||
% 0200 (128)
|
||
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
|
||
/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
|
||
/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
|
||
/dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
|
||
% 0240 (160)
|
||
/space /exclamdown /cent /sterling
|
||
/currency /yen /brokenbar /section
|
||
/dieresis /copyright /ordfeminine /guillemotleft
|
||
/logicalnot /hyphen /registered /macron
|
||
/degree /plusminus /twosuperior /threesuperior
|
||
/acute /mu /paragraph /periodcentered
|
||
/cedilla /onesuperior /ordmasculine /guillemotright
|
||
/onequarter /onehalf /threequarters /questiondown
|
||
% 0300 (192)
|
||
/Agrave /Aacute /Acircumflex /Atilde
|
||
/Adieresis /Aring /AE /Ccedilla
|
||
/Egrave /Eacute /Ecircumflex /Edieresis
|
||
/Igrave /Iacute /Icircumflex /Idieresis
|
||
/Eth /Ntilde /Ograve /Oacute
|
||
/Ocircumflex /Otilde /Odieresis /multiply
|
||
/Oslash /Ugrave /Uacute /Ucircumflex
|
||
/Udieresis /Yacute /Thorn /germandbls
|
||
% 0340 (224)
|
||
/agrave /aacute /acircumflex /atilde
|
||
/adieresis /aring /ae /ccedilla
|
||
/egrave /eacute /ecircumflex /edieresis
|
||
/igrave /iacute /icircumflex /idieresis
|
||
/eth /ntilde /ograve /oacute
|
||
/ocircumflex /otilde /odieresis /divide
|
||
/oslash /ugrave /uacute /ucircumflex
|
||
/udieresis /yacute /thorn /ydieresis
|
||
256 packedarray def
|
||
}ifelse
|
||
|
||
/reencodeFontISO %def
|
||
{dup
|
||
length 12 add dict % Make a new font (a new dict the same size
|
||
% as the old one) with room for our new symbols.
|
||
|
||
begin % Make the new font the current dictionary.
|
||
{1 index /FID ne
|
||
{def}{pop pop}ifelse
|
||
}forall % Copy each of the symbols from the old dictionary
|
||
% to the new one except for the font ID.
|
||
|
||
currentdict /FontType get 0 ne
|
||
{/Encoding ISOLatin1Encoding def}if % Override the encoding with
|
||
% the ISOLatin1 encoding.
|
||
|
||
% Use the font's bounding box to determine the ascent, descent,
|
||
% and overall height; don't forget that these values have to be
|
||
% transformed using the font's matrix.
|
||
|
||
% ^ (x2 y2)
|
||
% | |
|
||
% | v
|
||
% | +----+ - -
|
||
% | | | ^
|
||
% | | | | Ascent (usually > 0)
|
||
% | | | |
|
||
% (0 0) -> +--+----+-------->
|
||
% | | |
|
||
% | | v Descent (usually < 0)
|
||
% (x1 y1) --> +----+ - -
|
||
|
||
currentdict /FontType get 0 ne
|
||
{/FontBBox load aload pop % -- x1 y1 x2 y2
|
||
FontMatrix transform /Ascent exch def pop
|
||
FontMatrix transform /Descent exch def pop}
|
||
{/PrimaryFont FDepVector 0 get def
|
||
PrimaryFont /FontBBox get aload pop
|
||
PrimaryFont /FontMatrix get transform /Ascent exch def pop
|
||
PrimaryFont /FontMatrix get transform /Descent exch def pop
|
||
}ifelse
|
||
|
||
/FontHeight Ascent Descent sub def % use `sub' because descent < 0
|
||
|
||
% Define these in case they're not in the FontInfo
|
||
% (also, here they're easier to get to).
|
||
/UnderlinePosition Descent 0.70 mul def
|
||
/OverlinePosition Descent UnderlinePosition sub Ascent add def
|
||
/StrikeoutPosition Ascent 0.30 mul def
|
||
/LineThickness FontHeight 0.05 mul def
|
||
/Xshadow FontHeight 0.08 mul def
|
||
/Yshadow FontHeight -0.09 mul def
|
||
/SpaceBackground Descent neg UnderlinePosition add def
|
||
/XBox Descent neg def
|
||
/YBox LineThickness 0.7 mul def
|
||
|
||
currentdict % Leave the new font on the stack
|
||
end % Stop using the font as the current dictionary
|
||
definefont % Put the font into the font dictionary
|
||
pop % Discard the returned font
|
||
}bind def
|
||
|
||
% Font definition
|
||
/DefFont{findfont exch scalefont reencodeFontISO}def
|
||
|
||
% Font selection
|
||
/F
|
||
{findfont
|
||
dup /Ascent get /Ascent exch def
|
||
dup /Descent get /Descent exch def
|
||
dup /FontHeight get /FontHeight exch def
|
||
dup /UnderlinePosition get /UnderlinePosition exch def
|
||
dup /OverlinePosition get /OverlinePosition exch def
|
||
dup /StrikeoutPosition get /StrikeoutPosition exch def
|
||
dup /LineThickness get /LineThickness exch def
|
||
dup /Xshadow get /Xshadow exch def
|
||
dup /Yshadow get /Yshadow exch def
|
||
dup /SpaceBackground get /SpaceBackground exch def
|
||
dup /XBox get /XBox exch def
|
||
dup /YBox get /YBox exch def
|
||
setfont
|
||
}def
|
||
|
||
/BG
|
||
{dup /bg exch def
|
||
{mark 4 1 roll ]}
|
||
{[ 1.0 1.0 1.0 ]}
|
||
ifelse
|
||
/bgcolor exch def
|
||
}def
|
||
|
||
% stack: --
|
||
/FillBgColor{bgcolor aload pop setrgbcolor fill}bind def
|
||
|
||
% stack: fill-or-not lower-x lower-y upper-x upper-y |- --
|
||
/doRect
|
||
{/rYY exch def
|
||
/rXX exch def
|
||
/ryy exch def
|
||
/rxx exch def
|
||
gsave
|
||
newpath
|
||
rXX rYY moveto
|
||
rxx rYY lineto
|
||
rxx ryy lineto
|
||
rXX ryy lineto
|
||
closepath
|
||
% top of stack: fill-or-not
|
||
{FillBgColor}
|
||
{LineThickness setlinewidth stroke}
|
||
ifelse
|
||
grestore
|
||
}bind def
|
||
|
||
% stack: string fill-or-not |- --
|
||
/doOutline
|
||
{/-fillp- exch def
|
||
/-ox- currentpoint /-oy- exch def def
|
||
gsave
|
||
LineThickness setlinewidth
|
||
{st 0 3 -1 roll put
|
||
st dup true charpath
|
||
-fillp- {gsave FillBgColor grestore}if
|
||
stroke stringwidth
|
||
-oy- add /-oy- exch def
|
||
-ox- add /-ox- exch def
|
||
-ox- -oy- moveto
|
||
}forall
|
||
grestore
|
||
-ox- -oy- moveto
|
||
}bind def
|
||
|
||
% stack: fill-or-not delta |- --
|
||
/doBox
|
||
{/dd exch def
|
||
xx XBox sub dd sub yy YBox sub dd sub
|
||
XX XBox add dd add YY YBox add dd add
|
||
doRect
|
||
}bind def
|
||
|
||
% stack: string |- --
|
||
/doShadow
|
||
{gsave
|
||
Xshadow Yshadow rmoveto
|
||
false doOutline
|
||
grestore
|
||
}bind def
|
||
|
||
% stack: position |- --
|
||
/Hline
|
||
{currentpoint exch pop add dup
|
||
gsave
|
||
newpath
|
||
xx exch moveto
|
||
XX exch lineto
|
||
closepath
|
||
LineThickness setlinewidth stroke
|
||
grestore
|
||
}bind def
|
||
|
||
% stack: string |- --
|
||
% effect: 1 - underline 2 - strikeout 4 - overline
|
||
% 8 - shadow 16 - box 32 - outline
|
||
/S
|
||
{/xx currentpoint dup Descent add /yy exch def
|
||
Ascent add /YY exch def def
|
||
dup stringwidth pop xx add /XX exch def
|
||
Effect 8 and 0 ne
|
||
{/yy yy Yshadow add def
|
||
/XX XX Xshadow add def
|
||
}if
|
||
bg
|
||
{true
|
||
Effect 16 and 0 ne
|
||
{SpaceBackground doBox}
|
||
{xx yy XX YY doRect}
|
||
ifelse
|
||
}if % background
|
||
Effect 16 and 0 ne{false 0 doBox}if % box
|
||
Effect 8 and 0 ne{dup doShadow}if % shadow
|
||
Effect 32 and 0 ne
|
||
{true doOutline} % outline
|
||
{show} % normal text
|
||
ifelse
|
||
Effect 1 and 0 ne{UnderlinePosition Hline}if % underline
|
||
Effect 2 and 0 ne{StrikeoutPosition Hline}if % strikeout
|
||
Effect 4 and 0 ne{OverlinePosition Hline}if % overline
|
||
}bind def
|
||
|
||
"
|
||
"EBNF EPS prologue")
|
||
|
||
|
||
(defconst ebnf-eps-begin
|
||
"
|
||
end
|
||
|
||
% x y #ebnf2ps#begin
|
||
/#ebnf2ps#begin
|
||
{#ebnf2ps#dict begin /#ebnf2ps#save save def
|
||
moveto false BG 0.0 0.0 0.0 setrgbcolor}def
|
||
|
||
/#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
|
||
|
||
%%EndProlog
|
||
"
|
||
"EBNF EPS begin")
|
||
|
||
|
||
(defconst ebnf-eps-end
|
||
"#ebnf2ps#end
|
||
%%EOF
|
||
"
|
||
"EBNF EPS end")
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Formatting
|
||
|
||
|
||
(defvar ebnf-format-float "%1.3f")
|
||
|
||
|
||
(defun ebnf-format-float (&rest floats)
|
||
(mapconcat
|
||
#'(lambda (float)
|
||
(format ebnf-format-float float))
|
||
floats
|
||
" "))
|
||
|
||
|
||
(defun ebnf-format-color (format-str color default)
|
||
(let* ((the-color (or color default))
|
||
(rgb (ps-color-scale the-color)))
|
||
(format format-str
|
||
(concat "["
|
||
(ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
|
||
"]")
|
||
the-color)))
|
||
|
||
|
||
(defvar ebnf-message-float "%3.2f")
|
||
|
||
|
||
(defsubst ebnf-message-float (format-str value)
|
||
(message format-str
|
||
(format ebnf-message-float value)))
|
||
|
||
|
||
(defvar ebnf-total 0)
|
||
(defvar ebnf-nprod 0)
|
||
|
||
|
||
(defsubst ebnf-message-info (messag)
|
||
(message "%s...%3d%%"
|
||
messag
|
||
(round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Macros
|
||
|
||
|
||
(defmacro ebnf-node-kind (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 0 ,value)
|
||
`(aref ,vec 0)))
|
||
|
||
|
||
(defmacro ebnf-node-width-func (node width)
|
||
`(funcall (aref ,node 1) ,node ,width))
|
||
|
||
|
||
(defmacro ebnf-node-dimension-func (node &optional value)
|
||
(if value
|
||
`(aset ,node 2 ,value)
|
||
`(funcall (aref ,node 2) ,node)))
|
||
|
||
|
||
(defmacro ebnf-node-entry (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 3 ,value)
|
||
`(aref ,vec 3)))
|
||
|
||
|
||
(defmacro ebnf-node-height (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 4 ,value)
|
||
`(aref ,vec 4)))
|
||
|
||
|
||
(defmacro ebnf-node-width (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 5 ,value)
|
||
`(aref ,vec 5)))
|
||
|
||
|
||
(defmacro ebnf-node-name (vec)
|
||
`(aref ,vec 6))
|
||
|
||
|
||
(defmacro ebnf-node-list (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 6 ,value)
|
||
`(aref ,vec 6)))
|
||
|
||
|
||
(defmacro ebnf-node-default (vec)
|
||
`(aref ,vec 7))
|
||
|
||
|
||
(defmacro ebnf-node-production (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 7 ,value)
|
||
`(aref ,vec 7)))
|
||
|
||
|
||
(defmacro ebnf-node-separator (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 7 ,value)
|
||
`(aref ,vec 7)))
|
||
|
||
|
||
(defmacro ebnf-node-action (vec &optional value)
|
||
(if value
|
||
`(aset ,vec 8 ,value)
|
||
`(aref ,vec 8)))
|
||
|
||
|
||
(defmacro ebnf-node-generation (node)
|
||
`(funcall (ebnf-node-kind ,node) ,node))
|
||
|
||
|
||
(defmacro ebnf-max-width (prod)
|
||
`(max (ebnf-node-width ,prod)
|
||
(+ (* (length (ebnf-node-name ,prod))
|
||
ebnf-font-width-P)
|
||
ebnf-production-horizontal-space)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; PostScript generation
|
||
|
||
|
||
(defun ebnf-generate-eps (ebnf-tree)
|
||
(let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
|
||
(ps-print-color-scale (if ps-color-p
|
||
(float (car (ps-color-values "white")))
|
||
1.0))
|
||
(ebnf-total (length ebnf-tree))
|
||
(ebnf-nprod 0)
|
||
(old-ps-output (symbol-function 'ps-output))
|
||
(old-ps-output-string (symbol-function 'ps-output-string))
|
||
(eps-buffer (get-buffer-create ebnf-eps-buffer-name))
|
||
ebnf-debug-ps error-msg horizontal
|
||
prod prod-name prod-width prod-height prod-list file-list)
|
||
;; redefines `ps-output' and `ps-output-string'
|
||
(defalias 'ps-output 'ebnf-eps-output)
|
||
(defalias 'ps-output-string 'ps-output-string-prim)
|
||
;; generate EPS file
|
||
(save-excursion
|
||
(condition-case data
|
||
(progn
|
||
(while ebnf-tree
|
||
(setq prod (car ebnf-tree)
|
||
prod-name (ebnf-node-name prod)
|
||
prod-width (ebnf-max-width prod)
|
||
prod-height (ebnf-node-height prod)
|
||
horizontal (memq (ebnf-node-action prod)
|
||
ebnf-action-list))
|
||
;; generate production in EPS buffer
|
||
(save-excursion
|
||
(set-buffer eps-buffer)
|
||
(setq ebnf-eps-upper-x 0.0
|
||
ebnf-eps-upper-y 0.0
|
||
ebnf-eps-max-width prod-width
|
||
ebnf-eps-max-height prod-height)
|
||
(ebnf-generate-production prod))
|
||
(if (setq prod-list (cdr (assoc prod-name
|
||
ebnf-eps-production-list)))
|
||
;; insert EPS buffer in all buffer associated with production
|
||
(ebnf-eps-production-list prod-list 'file-list horizontal
|
||
prod-width prod-height eps-buffer)
|
||
;; write EPS file for production
|
||
(ebnf-eps-finish-and-write eps-buffer
|
||
(ebnf-eps-filename prod-name)))
|
||
;; prepare for next loop
|
||
(save-excursion
|
||
(set-buffer eps-buffer)
|
||
(erase-buffer))
|
||
(setq ebnf-tree (cdr ebnf-tree)))
|
||
;; write and kill temporary buffers
|
||
(ebnf-eps-write-kill-temp file-list t)
|
||
(setq file-list nil))
|
||
;; handler
|
||
((quit error)
|
||
(setq error-msg (error-message-string data)))))
|
||
;; restore `ps-output' and `ps-output-string'
|
||
(defalias 'ps-output old-ps-output)
|
||
(defalias 'ps-output-string old-ps-output-string)
|
||
;; kill temporary buffers
|
||
(kill-buffer eps-buffer)
|
||
(ebnf-eps-write-kill-temp file-list nil)
|
||
(and error-msg (error error-msg))
|
||
(message " ")))
|
||
|
||
|
||
;; write and kill temporary buffers
|
||
(defun ebnf-eps-write-kill-temp (file-list write-p)
|
||
(while file-list
|
||
(let ((buffer (get-buffer (concat " *" (car file-list) "*"))))
|
||
(when buffer
|
||
(and write-p
|
||
(ebnf-eps-finish-and-write buffer (car file-list)))
|
||
(kill-buffer buffer)))
|
||
(setq file-list (cdr file-list))))
|
||
|
||
|
||
;; insert EPS buffer in all buffer associated with production
|
||
(defun ebnf-eps-production-list (prod-list file-list-sym horizontal
|
||
prod-width prod-height eps-buffer)
|
||
(while prod-list
|
||
(add-to-list file-list-sym (car prod-list))
|
||
(save-excursion
|
||
(set-buffer (get-buffer-create (concat " *" (car prod-list) "*")))
|
||
(goto-char (point-max))
|
||
(cond
|
||
;; first production
|
||
((zerop (buffer-size))
|
||
(setq ebnf-eps-upper-x 0.0
|
||
ebnf-eps-upper-y 0.0
|
||
ebnf-eps-max-width prod-width
|
||
ebnf-eps-max-height prod-height))
|
||
;; horizontal
|
||
(horizontal
|
||
(ebnf-eop-horizontal ebnf-eps-prod-width)
|
||
(setq ebnf-eps-max-width (+ ebnf-eps-max-width
|
||
ebnf-production-horizontal-space
|
||
prod-width)
|
||
ebnf-eps-max-height (max ebnf-eps-max-height prod-height)))
|
||
;; vertical
|
||
(t
|
||
(ebnf-eop-vertical ebnf-eps-max-height)
|
||
(setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
|
||
ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
|
||
ebnf-eps-max-height
|
||
(+ ebnf-eps-upper-y
|
||
ebnf-production-vertical-space
|
||
ebnf-eps-max-height))
|
||
ebnf-eps-max-width prod-width
|
||
ebnf-eps-max-height prod-height))
|
||
)
|
||
(setq ebnf-eps-prod-width prod-width)
|
||
(insert-buffer-substring eps-buffer))
|
||
(setq prod-list (cdr prod-list))))
|
||
|
||
|
||
(defun ebnf-generate (ebnf-tree)
|
||
(let* ((ps-color-p (and ebnf-color-p (ps-color-device)))
|
||
(ps-print-color-scale (if ps-color-p
|
||
(float (car (ps-color-values "white")))
|
||
1.0))
|
||
ps-zebra-stripes ps-line-number ps-razzle-dazzle
|
||
ps-print-hook
|
||
ps-print-begin-sheet-hook
|
||
ps-print-begin-page-hook
|
||
ps-print-begin-column-hook)
|
||
(ps-generate (current-buffer) (point-min) (point-max)
|
||
'ebnf-generate-postscript)))
|
||
|
||
|
||
(defvar ebnf-tree nil)
|
||
(defvar ebnf-direction "R")
|
||
|
||
|
||
(defun ebnf-generate-postscript (from to)
|
||
(ebnf-begin-file)
|
||
(if ebnf-horizontal-max-height
|
||
(ebnf-generate-with-max-height)
|
||
(ebnf-generate-without-max-height))
|
||
(message " "))
|
||
|
||
|
||
(defun ebnf-generate-with-max-height ()
|
||
(let ((ebnf-total (length ebnf-tree))
|
||
(ebnf-nprod 0)
|
||
next-line max-height prod the-width)
|
||
(while ebnf-tree
|
||
;; find next line point
|
||
(setq next-line ebnf-tree
|
||
prod (car ebnf-tree)
|
||
max-height (ebnf-node-height prod))
|
||
(ebnf-begin-line prod (ebnf-max-width prod))
|
||
(while (and (setq next-line (cdr next-line))
|
||
(setq prod (car next-line))
|
||
(memq (ebnf-node-action prod) ebnf-action-list)
|
||
(setq the-width (ebnf-max-width prod))
|
||
(<= the-width ps-width-remaining))
|
||
(setq max-height (max max-height (ebnf-node-height prod))
|
||
ps-width-remaining (- ps-width-remaining
|
||
(+ the-width
|
||
ebnf-production-horizontal-space))))
|
||
;; generate current line
|
||
(ebnf-newline max-height)
|
||
(setq prod (car ebnf-tree))
|
||
(ebnf-generate-production prod)
|
||
(while (not (eq (setq ebnf-tree (cdr ebnf-tree)) next-line))
|
||
(ebnf-eop-horizontal (ebnf-max-width prod))
|
||
(setq prod (car ebnf-tree))
|
||
(ebnf-generate-production prod))
|
||
(ebnf-eop-vertical max-height))))
|
||
|
||
|
||
(defun ebnf-generate-without-max-height ()
|
||
(let ((ebnf-total (length ebnf-tree))
|
||
(ebnf-nprod 0)
|
||
max-height prod bef-width cur-width)
|
||
(while ebnf-tree
|
||
;; generate current line
|
||
(setq prod (car ebnf-tree)
|
||
max-height (ebnf-node-height prod)
|
||
bef-width (ebnf-max-width prod))
|
||
(ebnf-begin-line prod bef-width)
|
||
(ebnf-generate-production prod)
|
||
(while (and (setq ebnf-tree (cdr ebnf-tree))
|
||
(setq prod (car ebnf-tree))
|
||
(memq (ebnf-node-action prod) ebnf-action-list)
|
||
(setq cur-width (ebnf-max-width prod))
|
||
(<= cur-width ps-width-remaining)
|
||
(<= (ebnf-node-height prod) ps-height-remaining))
|
||
(ebnf-eop-horizontal bef-width)
|
||
(ebnf-generate-production prod)
|
||
(setq bef-width cur-width
|
||
max-height (max max-height (ebnf-node-height prod))
|
||
ps-width-remaining (- ps-width-remaining
|
||
(+ cur-width
|
||
ebnf-production-horizontal-space))))
|
||
(ebnf-eop-vertical max-height)
|
||
;; prepare next line
|
||
(ebnf-newline max-height))))
|
||
|
||
|
||
(defun ebnf-begin-line (prod width)
|
||
(and (or (eq (ebnf-node-action prod) 'form-feed)
|
||
(> (ebnf-node-height prod) ps-height-remaining))
|
||
(ebnf-new-page))
|
||
(setq ps-width-remaining (- ps-width-remaining
|
||
(+ width
|
||
ebnf-production-horizontal-space))))
|
||
|
||
|
||
(defun ebnf-newline (height)
|
||
(and (> height ps-height-remaining)
|
||
(ebnf-new-page))
|
||
(setq ps-width-remaining ps-print-width
|
||
ps-height-remaining (- ps-height-remaining
|
||
(+ height
|
||
ebnf-production-vertical-space))))
|
||
|
||
|
||
;; [production width-fun dim-fun entry height width name production action]
|
||
(defun ebnf-generate-production (production)
|
||
(ebnf-message-info "Generating")
|
||
(run-hooks 'ebnf-production-hook)
|
||
(ps-output-string (if ebnf-production-name-p
|
||
(ebnf-node-name production)
|
||
""))
|
||
(ps-output " "
|
||
(ebnf-format-float
|
||
(ebnf-node-width production)
|
||
(+ (if ebnf-production-name-p
|
||
ebnf-basic-height
|
||
0.0)
|
||
(ebnf-node-entry (ebnf-node-production production))))
|
||
" BOP\n")
|
||
(ebnf-node-generation (ebnf-node-production production))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
;; [alternative width-fun dim-fun entry height width list]
|
||
(defun ebnf-generate-alternative (alternative)
|
||
(let ((alt (ebnf-node-list alternative))
|
||
(entry (ebnf-node-entry alternative))
|
||
(nlist 0)
|
||
alt-height alt-entry)
|
||
(while alt
|
||
(ps-output (ebnf-format-float (- entry (ebnf-node-entry (car alt))))
|
||
" ")
|
||
(setq entry (- entry (ebnf-node-height (car alt)) ebnf-vertical-space)
|
||
nlist (1+ nlist)
|
||
alt (cdr alt)))
|
||
(ps-output (format "%d " nlist)
|
||
(ebnf-format-float (ebnf-node-width alternative))
|
||
" AT\n")
|
||
(setq alt (ebnf-node-list alternative))
|
||
(when alt
|
||
(ebnf-node-generation (car alt))
|
||
(setq alt-height (- (ebnf-node-height (car alt))
|
||
(ebnf-node-entry (car alt)))))
|
||
(while (setq alt (cdr alt))
|
||
(setq alt-entry (ebnf-node-entry (car alt)))
|
||
(ebnf-vertical-movement
|
||
(- (+ alt-height ebnf-vertical-space alt-entry)))
|
||
(ebnf-node-generation (car alt))
|
||
(setq alt-height (- (ebnf-node-height (car alt)) alt-entry))))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
;; [sequence width-fun dim-fun entry height width list]
|
||
(defun ebnf-generate-sequence (sequence)
|
||
(ps-output "BOS\n")
|
||
(let ((seq (ebnf-node-list sequence))
|
||
seq-width)
|
||
(when seq
|
||
(ebnf-node-generation (car seq))
|
||
(setq seq-width (ebnf-node-width (car seq))))
|
||
(while (setq seq (cdr seq))
|
||
(ebnf-horizontal-movement seq-width)
|
||
(ebnf-node-generation (car seq))
|
||
(setq seq-width (ebnf-node-width (car seq)))))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
;; [terminal width-fun dim-fun entry height width name]
|
||
(defun ebnf-generate-terminal (terminal)
|
||
(ebnf-gen-terminal terminal "T"))
|
||
|
||
|
||
;; [non-terminal width-fun dim-fun entry height width name]
|
||
(defun ebnf-generate-non-terminal (non-terminal)
|
||
(ebnf-gen-terminal non-terminal "NT"))
|
||
|
||
|
||
;; [empty width-fun dim-fun entry height width]
|
||
(defun ebnf-generate-empty (empty)
|
||
(ebnf-empty-alternative (ebnf-node-width empty)))
|
||
|
||
|
||
;; [optional width-fun dim-fun entry height width element]
|
||
(defun ebnf-generate-optional (optional)
|
||
(let ((the-optional (ebnf-node-list optional)))
|
||
(ps-output (ebnf-format-float
|
||
(+ (- (ebnf-node-height the-optional)
|
||
(ebnf-node-entry optional))
|
||
ebnf-vertical-space)
|
||
(ebnf-node-width optional))
|
||
" OP\n")
|
||
(ebnf-node-generation the-optional)
|
||
(ps-output "EOS\n")))
|
||
|
||
|
||
;; [one-or-more width-fun dim-fun entry height width element separator]
|
||
(defun ebnf-generate-one-or-more (one-or-more)
|
||
(let* ((width (ebnf-node-width one-or-more))
|
||
(sep (ebnf-node-separator one-or-more))
|
||
(entry (- (ebnf-node-entry one-or-more)
|
||
(if sep
|
||
(ebnf-node-entry sep)
|
||
0))))
|
||
(ps-output (ebnf-format-float entry width)
|
||
" OM\n")
|
||
(ebnf-node-generation (ebnf-node-list one-or-more))
|
||
(ebnf-vertical-movement entry)
|
||
(if sep
|
||
(let ((ebnf-direction "L"))
|
||
(ebnf-node-generation sep))
|
||
(ebnf-empty-alternative (- width ebnf-horizontal-space))))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
;; [zero-or-more width-fun dim-fun entry height width element separator]
|
||
(defun ebnf-generate-zero-or-more (zero-or-more)
|
||
(let* ((width (ebnf-node-width zero-or-more))
|
||
(node-list (ebnf-node-list zero-or-more))
|
||
(list-entry (ebnf-node-entry node-list))
|
||
(node-sep (ebnf-node-separator zero-or-more))
|
||
(entry (+ list-entry
|
||
ebnf-vertical-space
|
||
(if node-sep
|
||
(- (ebnf-node-height node-sep)
|
||
(ebnf-node-entry node-sep))
|
||
0))))
|
||
(ps-output (ebnf-format-float entry
|
||
(+ (- (ebnf-node-height node-list)
|
||
list-entry)
|
||
ebnf-vertical-space)
|
||
width)
|
||
" ZM\n")
|
||
(ebnf-node-generation (ebnf-node-list zero-or-more))
|
||
(ebnf-vertical-movement entry)
|
||
(if (ebnf-node-separator zero-or-more)
|
||
(let ((ebnf-direction "L"))
|
||
(ebnf-node-generation (ebnf-node-separator zero-or-more)))
|
||
(ebnf-empty-alternative (- width ebnf-horizontal-space))))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
;; [special width-fun dim-fun entry height width name]
|
||
(defun ebnf-generate-special (special)
|
||
(ebnf-gen-terminal special "SP"))
|
||
|
||
|
||
;; [repeat width-fun dim-fun entry height width times element]
|
||
(defun ebnf-generate-repeat (repeat)
|
||
(let ((times (ebnf-node-name repeat))
|
||
(element (ebnf-node-separator repeat)))
|
||
(ps-output-string times)
|
||
(ps-output " "
|
||
(ebnf-format-float
|
||
(ebnf-node-entry repeat)
|
||
(ebnf-node-height repeat)
|
||
(ebnf-node-width repeat)
|
||
(if element
|
||
(+ (ebnf-node-width element)
|
||
ebnf-space-R ebnf-space-R ebnf-space-R
|
||
(* (length times) ebnf-font-width-R))
|
||
0.0))
|
||
" " ebnf-direction "RP\n")
|
||
(and element
|
||
(ebnf-node-generation element)))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
;; [except width-fun dim-fun entry height width element element]
|
||
(defun ebnf-generate-except (except)
|
||
(let* ((element (ebnf-node-list except))
|
||
(exception (ebnf-node-separator except))
|
||
(width (ebnf-node-width element)))
|
||
(ps-output (ebnf-format-float
|
||
width
|
||
(ebnf-node-entry except)
|
||
(ebnf-node-height except)
|
||
(ebnf-node-width except)
|
||
(+ width
|
||
ebnf-space-E ebnf-space-E ebnf-space-E
|
||
ebnf-font-width-E
|
||
(if exception
|
||
(+ (ebnf-node-width exception) ebnf-space-E)
|
||
0.0)))
|
||
" " ebnf-direction "EX\n")
|
||
(ebnf-node-generation (ebnf-node-list except))
|
||
(when exception
|
||
(ebnf-horizontal-movement (+ width ebnf-space-E
|
||
ebnf-font-width-E ebnf-space-E))
|
||
(ebnf-node-generation exception)))
|
||
(ps-output "EOS\n"))
|
||
|
||
|
||
(defun ebnf-gen-terminal (node code)
|
||
(ps-output-string (ebnf-node-name node))
|
||
(ps-output " " (ebnf-format-float (ebnf-node-width node))
|
||
" " ebnf-direction code
|
||
(if (ebnf-node-default node)
|
||
"D\n"
|
||
"\n")))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Internal functions
|
||
|
||
|
||
(defun ebnf-directory (fun &optional directory)
|
||
"Process files in DIRECTORY applying function FUN on each file.
|
||
|
||
If DIRECTORY is nil, it's used `default-directory'.
|
||
|
||
The files in DIRECTORY that matches `ebnf-file-suffix-regexp' (which see) are
|
||
processed."
|
||
(let ((files (directory-files (or directory default-directory)
|
||
t ebnf-file-suffix-regexp)))
|
||
(while files
|
||
(set-buffer (find-file-noselect (car files)))
|
||
(funcall fun)
|
||
(setq buffer-backed-up t) ; Do not back it up.
|
||
(save-buffer) ; Just save new version.
|
||
(kill-buffer (current-buffer))
|
||
(setq files (cdr files)))))
|
||
|
||
|
||
(defun ebnf-file (fun file &optional do-not-kill-buffer-when-done)
|
||
"Process file FILE applying function FUN.
|
||
|
||
If optional arg DO-NOT-KILL-BUFFER-WHEN-DONE is non-nil, the buffer isn't
|
||
killed after process termination."
|
||
(set-buffer (find-file-noselect file))
|
||
(funcall fun)
|
||
(or do-not-kill-buffer-when-done
|
||
(kill-buffer (current-buffer))))
|
||
|
||
|
||
;; function `ebnf-range-regexp' is used to avoid a bug of `skip-chars-forward'
|
||
;; on version 20.4.1, that is, it doesn't accept ranges like "\240-\377" (or
|
||
;; "\177-\237"), but it accepts the character sequence from \240 to \377 (or
|
||
;; from \177 to \237). It seems that version 20.7 has the same problem.
|
||
(defun ebnf-range-regexp (prefix from to)
|
||
(let (str)
|
||
(while (<= from to)
|
||
(setq str (concat str (char-to-string from))
|
||
from (1+ from)))
|
||
(concat prefix str)))
|
||
|
||
|
||
(defvar ebnf-map-name
|
||
(let ((map (make-vector 256 ?\_)))
|
||
(mapcar #'(lambda (char)
|
||
(aset map char char))
|
||
(concat "#$%&+-.0123456789=?@~"
|
||
"ABCDEFGHIJKLMNOPQRSTUVWXYZ"
|
||
"abcdefghijklmnopqrstuvwxyz"))
|
||
map))
|
||
|
||
|
||
(defun ebnf-eps-filename (str)
|
||
(let* ((len (length str))
|
||
(stri 0)
|
||
(new (make-string len ?\s)))
|
||
(while (< stri len)
|
||
(aset new stri (aref ebnf-map-name (aref str stri)))
|
||
(setq stri (1+ stri)))
|
||
(concat ebnf-eps-prefix new ".eps")))
|
||
|
||
|
||
(defun ebnf-eps-output (&rest args)
|
||
(while args
|
||
(insert (car args))
|
||
(setq args (cdr args))))
|
||
|
||
|
||
(defun ebnf-generate-region (from to gen-func)
|
||
(run-hooks 'ebnf-hook)
|
||
(let ((ebnf-limit (max from to))
|
||
(error-msg "SYNTAX")
|
||
the-point)
|
||
(save-excursion
|
||
(save-restriction
|
||
(save-match-data
|
||
(condition-case data
|
||
(let ((tree (ebnf-parse-and-sort (min from to))))
|
||
(when gen-func
|
||
(setq error-msg "EMPTY RULES"
|
||
tree (ebnf-eliminate-empty-rules tree))
|
||
(setq error-msg "OPTMIZE"
|
||
tree (ebnf-optimize tree))
|
||
(setq error-msg "DIMENSIONS"
|
||
tree (ebnf-dimensions tree))
|
||
(setq error-msg "GENERATION")
|
||
(funcall gen-func tree))
|
||
(setq error-msg nil)) ; here it's ok
|
||
;; handler
|
||
((quit error)
|
||
(ding)
|
||
(setq the-point (max (1- (point)) (point-min))
|
||
error-msg (concat error-msg ": "
|
||
(error-message-string data)
|
||
", "
|
||
(and (string= error-msg "SYNTAX")
|
||
(format "at position %d "
|
||
the-point))
|
||
(format "in buffer \"%s\"."
|
||
(buffer-name)))))))))
|
||
(cond
|
||
;; error occurred
|
||
(error-msg
|
||
(goto-char the-point)
|
||
(if ebnf-stop-on-error
|
||
(error error-msg)
|
||
(message "%s" error-msg)))
|
||
;; generated output OK
|
||
(gen-func
|
||
nil)
|
||
;; syntax checked OK
|
||
(t
|
||
(message "EBNF syntactic analysis: NO ERRORS.")))))
|
||
|
||
|
||
(defun ebnf-parse-and-sort (start)
|
||
(ebnf-begin-job)
|
||
(let ((tree (funcall ebnf-parser-func start)))
|
||
(if ebnf-sort-production
|
||
(progn
|
||
(message "Sorting...")
|
||
(sort tree
|
||
(if (eq ebnf-sort-production 'ascending)
|
||
'ebnf-sorter-ascending
|
||
'ebnf-sorter-descending)))
|
||
(nreverse tree))))
|
||
|
||
|
||
(defun ebnf-sorter-ascending (first second)
|
||
(string< (ebnf-node-name first)
|
||
(ebnf-node-name second)))
|
||
|
||
|
||
(defun ebnf-sorter-descending (first second)
|
||
(string< (ebnf-node-name second)
|
||
(ebnf-node-name first)))
|
||
|
||
|
||
(defun ebnf-empty-alternative (width)
|
||
(ps-output (ebnf-format-float width) " EA\n"))
|
||
|
||
|
||
(defun ebnf-vertical-movement (height)
|
||
(ps-output (ebnf-format-float height) " vm\n"))
|
||
|
||
|
||
(defun ebnf-horizontal-movement (width)
|
||
(ps-output (ebnf-format-float width) " hm\n"))
|
||
|
||
|
||
(defun ebnf-entry (height)
|
||
(* height ebnf-entry-percentage))
|
||
|
||
|
||
(defun ebnf-eop-vertical (height)
|
||
(ps-output (ebnf-format-float (+ height ebnf-production-vertical-space))
|
||
" EOPV\n\n"))
|
||
|
||
|
||
(defun ebnf-eop-horizontal (width)
|
||
(ps-output (ebnf-format-float (+ width ebnf-production-horizontal-space))
|
||
" EOPH\n\n"))
|
||
|
||
|
||
(defun ebnf-new-page ()
|
||
(when (< ps-height-remaining ps-print-height)
|
||
(run-hooks 'ebnf-page-hook)
|
||
(ps-next-page)
|
||
(ps-output "\n")))
|
||
|
||
|
||
(defsubst ebnf-font-size (font) (nth 0 font))
|
||
(defsubst ebnf-font-name (font) (nth 1 font))
|
||
(defsubst ebnf-font-foreground (font) (nth 2 font))
|
||
(defsubst ebnf-font-background (font) (nth 3 font))
|
||
(defsubst ebnf-font-list (font) (nthcdr 4 font))
|
||
(defsubst ebnf-font-attributes (font)
|
||
(lsh (ps-extension-bit (cdr font)) -2))
|
||
|
||
|
||
(defconst ebnf-font-name-select
|
||
(vector 'normal 'bold 'italic 'bold-italic))
|
||
|
||
|
||
(defun ebnf-font-name-select (font)
|
||
(let* ((font-list (ebnf-font-list font))
|
||
(font-index (+ (if (memq 'bold font-list) 1 0)
|
||
(if (memq 'italic font-list) 2 0)))
|
||
(name (ebnf-font-name font))
|
||
(database (cdr (assoc name ps-font-info-database)))
|
||
(info-list (or (cdr (assoc 'fonts database))
|
||
(error "Invalid font: %s" name))))
|
||
(or (cdr (assoc (aref ebnf-font-name-select font-index)
|
||
info-list))
|
||
(error "Invalid attributes for font %s" name))))
|
||
|
||
|
||
(defun ebnf-font-select (font select)
|
||
(let* ((name (ebnf-font-name font))
|
||
(database (cdr (assoc name ps-font-info-database)))
|
||
(size (cdr (assoc 'size database)))
|
||
(base (cdr (assoc select database))))
|
||
(if (and size base)
|
||
(/ (* (ebnf-font-size font) base)
|
||
size)
|
||
(error "Invalid font: %s" name))))
|
||
|
||
|
||
(defsubst ebnf-font-width (font)
|
||
(ebnf-font-select font 'avg-char-width))
|
||
(defsubst ebnf-font-height (font)
|
||
(ebnf-font-select font 'line-height))
|
||
|
||
|
||
(defconst ebnf-syntax-alist
|
||
;; 0.syntax 1.parser 2.initializer
|
||
'((iso-ebnf ebnf-iso-parser ebnf-iso-initialize)
|
||
(yacc ebnf-yac-parser ebnf-yac-initialize)
|
||
(abnf ebnf-abn-parser ebnf-abn-initialize)
|
||
(ebnf ebnf-bnf-parser ebnf-bnf-initialize)
|
||
(ebnfx ebnf-ebx-parser ebnf-ebx-initialize)
|
||
(dtd ebnf-dtd-parser ebnf-dtd-initialize))
|
||
"Alist associating ebnf syntax with a parser and a initializer.")
|
||
|
||
|
||
(defun ebnf-begin-job ()
|
||
(ps-printing-region nil nil nil)
|
||
(if ebnf-use-float-format
|
||
(setq ebnf-format-float "%1.3f"
|
||
ebnf-message-float "%3.2f")
|
||
(setq ebnf-format-float "%s"
|
||
ebnf-message-float "%s"))
|
||
(ebnf-otz-initialize)
|
||
;; to avoid compilation gripes when calling autoloaded functions
|
||
(let ((init (or (assoc ebnf-syntax ebnf-syntax-alist)
|
||
(assoc 'ebnf ebnf-syntax-alist))))
|
||
(setq ebnf-parser-func (nth 1 init))
|
||
(funcall (nth 2 init)))
|
||
(and ebnf-terminal-regexp ; ensures that it's a string or nil
|
||
(not (stringp ebnf-terminal-regexp))
|
||
(setq ebnf-terminal-regexp nil))
|
||
(or (and ebnf-eps-prefix ; ensures that it's a string
|
||
(stringp ebnf-eps-prefix))
|
||
(setq ebnf-eps-prefix "ebnf--"))
|
||
(setq ebnf-entry-percentage ; ensures value between 0.0 and 1.0
|
||
(min (max ebnf-entry-percentage 0.0) 1.0)
|
||
ebnf-action-list (if ebnf-horizontal-orientation
|
||
'(nil keep-line)
|
||
'(keep-line))
|
||
ebnf-settings nil
|
||
ebnf-fonts-required nil
|
||
ebnf-action nil
|
||
ebnf-default-p nil
|
||
ebnf-eps-context nil
|
||
ebnf-eps-production-list nil
|
||
ebnf-eps-upper-x 0.0
|
||
ebnf-eps-upper-y 0.0
|
||
ebnf-font-height-P (ebnf-font-height ebnf-production-font)
|
||
ebnf-font-height-T (ebnf-font-height ebnf-terminal-font)
|
||
ebnf-font-height-NT (ebnf-font-height ebnf-non-terminal-font)
|
||
ebnf-font-height-S (ebnf-font-height ebnf-special-font)
|
||
ebnf-font-height-E (ebnf-font-height ebnf-except-font)
|
||
ebnf-font-height-R (ebnf-font-height ebnf-repeat-font)
|
||
ebnf-font-width-P (ebnf-font-width ebnf-production-font)
|
||
ebnf-font-width-T (ebnf-font-width ebnf-terminal-font)
|
||
ebnf-font-width-NT (ebnf-font-width ebnf-non-terminal-font)
|
||
ebnf-font-width-S (ebnf-font-width ebnf-special-font)
|
||
ebnf-font-width-E (ebnf-font-width ebnf-except-font)
|
||
ebnf-font-width-R (ebnf-font-width ebnf-repeat-font)
|
||
ebnf-space-T (* ebnf-font-height-T 0.5)
|
||
ebnf-space-NT (* ebnf-font-height-NT 0.5)
|
||
ebnf-space-S (* ebnf-font-height-S 0.5)
|
||
ebnf-space-E (* ebnf-font-height-E 0.5)
|
||
ebnf-space-R (* ebnf-font-height-R 0.5))
|
||
(let ((basic (+ ebnf-font-height-T ebnf-font-height-NT)))
|
||
(setq ebnf-basic-width (* basic 0.5)
|
||
ebnf-horizontal-space (+ basic basic)
|
||
ebnf-basic-height ebnf-basic-width
|
||
ebnf-vertical-space ebnf-basic-width)
|
||
;; ensures value is greater than zero
|
||
(or (and (numberp ebnf-production-horizontal-space)
|
||
(> ebnf-production-horizontal-space 0.0))
|
||
(setq ebnf-production-horizontal-space basic))
|
||
;; ensures value is greater than zero
|
||
(or (and (numberp ebnf-production-vertical-space)
|
||
(> ebnf-production-vertical-space 0.0))
|
||
(setq ebnf-production-vertical-space basic))))
|
||
|
||
|
||
(defsubst ebnf-shape-value (sym alist)
|
||
(or (cdr (assq sym alist)) 0))
|
||
|
||
|
||
(defsubst ebnf-boolean (value)
|
||
(if value "true" "false"))
|
||
|
||
|
||
(defun ebnf-begin-file ()
|
||
(ps-flush-output)
|
||
(save-excursion
|
||
(set-buffer ps-spool-buffer)
|
||
(goto-char (point-min))
|
||
(and (search-forward "%%Creator: " nil t)
|
||
(not (search-forward "& ebnf2ps v"
|
||
(save-excursion (end-of-line) (point))
|
||
t))
|
||
(progn
|
||
;; adjust creator comment
|
||
(end-of-line)
|
||
(backward-char)
|
||
(insert " & ebnf2ps v" ebnf-version)
|
||
;; insert ebnf settings & engine
|
||
(goto-char (point-max))
|
||
(search-backward "\n%%EndProlog\n")
|
||
(ebnf-insert-ebnf-prologue)
|
||
(ps-output "\n")))))
|
||
|
||
|
||
(defun ebnf-eps-finish-and-write (buffer filename)
|
||
(when (buffer-modified-p buffer)
|
||
(save-excursion
|
||
(set-buffer buffer)
|
||
(setq ebnf-eps-upper-x (max ebnf-eps-upper-x ebnf-eps-max-width)
|
||
ebnf-eps-upper-y (if (zerop ebnf-eps-upper-y)
|
||
ebnf-eps-max-height
|
||
(+ ebnf-eps-upper-y
|
||
ebnf-production-vertical-space
|
||
ebnf-eps-max-height)))
|
||
;; prologue
|
||
(goto-char (point-min))
|
||
(insert
|
||
"%!PS-Adobe-3.0 EPSF-3.0"
|
||
"\n%%BoundingBox: 0 0 "
|
||
(format "%d %d" (1+ ebnf-eps-upper-x) (1+ ebnf-eps-upper-y))
|
||
"\n%%Title: " filename
|
||
"\n%%CreationDate: " (format-time-string "%T %b %d %Y")
|
||
"\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
|
||
"\n%%DocumentNeededResources: font "
|
||
(or ebnf-fonts-required
|
||
(setq ebnf-fonts-required
|
||
(mapconcat 'identity
|
||
(ps-remove-duplicates
|
||
(mapcar 'ebnf-font-name-select
|
||
(list ebnf-production-font
|
||
ebnf-terminal-font
|
||
ebnf-non-terminal-font
|
||
ebnf-special-font
|
||
ebnf-except-font
|
||
ebnf-repeat-font)))
|
||
"\n%%+ font ")))
|
||
"\n%%Pages: 0\n%%EndComments\n\n%%BeginProlog\n"
|
||
ebnf-eps-prologue)
|
||
(ebnf-insert-ebnf-prologue)
|
||
(insert ebnf-eps-begin
|
||
"\n0 " (ebnf-format-float
|
||
(- ebnf-eps-upper-y (* ebnf-font-height-P 0.7)))
|
||
" #ebnf2ps#begin\n")
|
||
;; epilogue
|
||
(goto-char (point-max))
|
||
(insert ebnf-eps-end)
|
||
;; write file
|
||
(message "Saving...")
|
||
(setq filename (expand-file-name filename))
|
||
(let ((coding-system-for-write 'raw-text-unix))
|
||
(write-region (point-min) (point-max) filename))
|
||
(message "Wrote %s" filename))))
|
||
|
||
|
||
(defun ebnf-insert-ebnf-prologue ()
|
||
(insert
|
||
(or ebnf-settings
|
||
(setq ebnf-settings
|
||
(concat
|
||
"\n\n% === begin EBNF settings\n\n"
|
||
;; production
|
||
(format "/fP %s /%s DefFont\n"
|
||
(ebnf-format-float (ebnf-font-size ebnf-production-font))
|
||
(ebnf-font-name-select ebnf-production-font))
|
||
(ebnf-format-color "/ForegroundP %s def %% %s\n"
|
||
(ebnf-font-foreground ebnf-production-font)
|
||
"Black")
|
||
(ebnf-format-color "/BackgroundP %s def %% %s\n"
|
||
(ebnf-font-background ebnf-production-font)
|
||
"White")
|
||
(format "/EffectP %d def\n"
|
||
(ebnf-font-attributes ebnf-production-font))
|
||
;; terminal
|
||
(format "/fT %s /%s DefFont\n"
|
||
(ebnf-format-float (ebnf-font-size ebnf-terminal-font))
|
||
(ebnf-font-name-select ebnf-terminal-font))
|
||
(ebnf-format-color "/ForegroundT %s def %% %s\n"
|
||
(ebnf-font-foreground ebnf-terminal-font)
|
||
"Black")
|
||
(ebnf-format-color "/BackgroundT %s def %% %s\n"
|
||
(ebnf-font-background ebnf-terminal-font)
|
||
"White")
|
||
(format "/EffectT %d def\n"
|
||
(ebnf-font-attributes ebnf-terminal-font))
|
||
(format "/BorderWidthT %s def\n"
|
||
(ebnf-format-float ebnf-terminal-border-width))
|
||
(ebnf-format-color "/BorderColorT %s def %% %s\n"
|
||
ebnf-terminal-border-color
|
||
"Black")
|
||
(format "/ShapeT %d def\n"
|
||
(ebnf-shape-value ebnf-terminal-shape
|
||
ebnf-terminal-shape-alist))
|
||
(format "/ShadowT %s def\n"
|
||
(ebnf-boolean ebnf-terminal-shadow))
|
||
;; non-terminal
|
||
(format "/fNT %s /%s DefFont\n"
|
||
(ebnf-format-float
|
||
(ebnf-font-size ebnf-non-terminal-font))
|
||
(ebnf-font-name-select ebnf-non-terminal-font))
|
||
(ebnf-format-color "/ForegroundNT %s def %% %s\n"
|
||
(ebnf-font-foreground ebnf-non-terminal-font)
|
||
"Black")
|
||
(ebnf-format-color "/BackgroundNT %s def %% %s\n"
|
||
(ebnf-font-background ebnf-non-terminal-font)
|
||
"White")
|
||
(format "/EffectNT %d def\n"
|
||
(ebnf-font-attributes ebnf-non-terminal-font))
|
||
(format "/BorderWidthNT %s def\n"
|
||
(ebnf-format-float ebnf-non-terminal-border-width))
|
||
(ebnf-format-color "/BorderColorNT %s def %% %s\n"
|
||
ebnf-non-terminal-border-color
|
||
"Black")
|
||
(format "/ShapeNT %d def\n"
|
||
(ebnf-shape-value ebnf-non-terminal-shape
|
||
ebnf-terminal-shape-alist))
|
||
(format "/ShadowNT %s def\n"
|
||
(ebnf-boolean ebnf-non-terminal-shadow))
|
||
;; special
|
||
(format "/fS %s /%s DefFont\n"
|
||
(ebnf-format-float (ebnf-font-size ebnf-special-font))
|
||
(ebnf-font-name-select ebnf-special-font))
|
||
(ebnf-format-color "/ForegroundS %s def %% %s\n"
|
||
(ebnf-font-foreground ebnf-special-font)
|
||
"Black")
|
||
(ebnf-format-color "/BackgroundS %s def %% %s\n"
|
||
(ebnf-font-background ebnf-special-font)
|
||
"Gray95")
|
||
(format "/EffectS %d def\n"
|
||
(ebnf-font-attributes ebnf-special-font))
|
||
(format "/BorderWidthS %s def\n"
|
||
(ebnf-format-float ebnf-special-border-width))
|
||
(ebnf-format-color "/BorderColorS %s def %% %s\n"
|
||
ebnf-special-border-color
|
||
"Black")
|
||
(format "/ShapeS %d def\n"
|
||
(ebnf-shape-value ebnf-special-shape
|
||
ebnf-terminal-shape-alist))
|
||
(format "/ShadowS %s def\n"
|
||
(ebnf-boolean ebnf-special-shadow))
|
||
;; except
|
||
(format "/fE %s /%s DefFont\n"
|
||
(ebnf-format-float (ebnf-font-size ebnf-except-font))
|
||
(ebnf-font-name-select ebnf-except-font))
|
||
(ebnf-format-color "/ForegroundE %s def %% %s\n"
|
||
(ebnf-font-foreground ebnf-except-font)
|
||
"Black")
|
||
(ebnf-format-color "/BackgroundE %s def %% %s\n"
|
||
(ebnf-font-background ebnf-except-font)
|
||
"Gray90")
|
||
(format "/EffectE %d def\n"
|
||
(ebnf-font-attributes ebnf-except-font))
|
||
(format "/BorderWidthE %s def\n"
|
||
(ebnf-format-float ebnf-except-border-width))
|
||
(ebnf-format-color "/BorderColorE %s def %% %s\n"
|
||
ebnf-except-border-color
|
||
"Black")
|
||
(format "/ShapeE %d def\n"
|
||
(ebnf-shape-value ebnf-except-shape
|
||
ebnf-terminal-shape-alist))
|
||
(format "/ShadowE %s def\n"
|
||
(ebnf-boolean ebnf-except-shadow))
|
||
;; repeat
|
||
(format "/fR %s /%s DefFont\n"
|
||
(ebnf-format-float (ebnf-font-size ebnf-repeat-font))
|
||
(ebnf-font-name-select ebnf-repeat-font))
|
||
(ebnf-format-color "/ForegroundR %s def %% %s\n"
|
||
(ebnf-font-foreground ebnf-repeat-font)
|
||
"Black")
|
||
(ebnf-format-color "/BackgroundR %s def %% %s\n"
|
||
(ebnf-font-background ebnf-repeat-font)
|
||
"Gray85")
|
||
(format "/EffectR %d def\n"
|
||
(ebnf-font-attributes ebnf-repeat-font))
|
||
(format "/BorderWidthR %s def\n"
|
||
(ebnf-format-float ebnf-repeat-border-width))
|
||
(ebnf-format-color "/BorderColorR %s def %% %s\n"
|
||
ebnf-repeat-border-color
|
||
"Black")
|
||
(format "/ShapeR %d def\n"
|
||
(ebnf-shape-value ebnf-repeat-shape
|
||
ebnf-terminal-shape-alist))
|
||
(format "/ShadowR %s def\n"
|
||
(ebnf-boolean ebnf-repeat-shadow))
|
||
;; miscellaneous
|
||
(format "/DefaultWidth %s def\n"
|
||
(ebnf-format-float ebnf-default-width))
|
||
(format "/LineWidth %s def\n"
|
||
(ebnf-format-float ebnf-line-width))
|
||
(ebnf-format-color "/LineColor %s def %% %s\n"
|
||
ebnf-line-color
|
||
"Black")
|
||
(format "/ArrowShape %d def\n"
|
||
(ebnf-shape-value ebnf-arrow-shape
|
||
ebnf-arrow-shape-alist))
|
||
(format "/ChartShape %d def\n"
|
||
(ebnf-shape-value ebnf-chart-shape
|
||
ebnf-terminal-shape-alist))
|
||
(format "/UserArrow{%s}def\n"
|
||
(let ((arrow (eval ebnf-user-arrow)))
|
||
(if (stringp arrow)
|
||
arrow
|
||
"")))
|
||
"\n% === end EBNF settings\n\n"
|
||
(and ebnf-debug-ps ebnf-debug))))
|
||
ebnf-prologue))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Adjusting dimensions
|
||
|
||
|
||
(defun ebnf-dimensions (tree)
|
||
(let ((ebnf-total (length tree))
|
||
(ebnf-nprod 0))
|
||
(mapcar 'ebnf-production-dimension tree))
|
||
tree)
|
||
|
||
|
||
;; [empty width-fun dim-fun entry height width]
|
||
;;(defun ebnf-empty-dimension (empty)
|
||
;; )
|
||
|
||
|
||
;; [production width-fun dim-fun entry height width name production action]
|
||
(defun ebnf-production-dimension (production)
|
||
(ebnf-message-info "Calculating dimensions")
|
||
(ebnf-node-dimension-func (ebnf-node-production production))
|
||
(let* ((prod (ebnf-node-production production))
|
||
(height (+ (if ebnf-production-name-p
|
||
ebnf-font-height-P
|
||
0.0)
|
||
ebnf-line-width ebnf-line-width
|
||
ebnf-basic-height
|
||
(ebnf-node-height prod))))
|
||
(ebnf-node-entry production height)
|
||
(ebnf-node-height production height)
|
||
(ebnf-node-width production (+ (ebnf-node-width prod)
|
||
ebnf-line-width
|
||
ebnf-horizontal-space))))
|
||
|
||
|
||
;; [terminal width-fun dim-fun entry height width name]
|
||
(defun ebnf-terminal-dimension (terminal)
|
||
(ebnf-terminal-dimension1 terminal
|
||
ebnf-font-height-T
|
||
ebnf-font-width-T
|
||
ebnf-space-T))
|
||
|
||
|
||
;; [non-terminal width-fun dim-fun entry height width name]
|
||
(defun ebnf-non-terminal-dimension (non-terminal)
|
||
(ebnf-terminal-dimension1 non-terminal
|
||
ebnf-font-height-NT
|
||
ebnf-font-width-NT
|
||
ebnf-space-NT))
|
||
|
||
|
||
;; [special width-fun dim-fun entry height width name]
|
||
(defun ebnf-special-dimension (special)
|
||
(ebnf-terminal-dimension1 special
|
||
ebnf-font-height-S
|
||
ebnf-font-width-S
|
||
ebnf-space-S))
|
||
|
||
|
||
(defun ebnf-terminal-dimension1 (node font-height font-width space)
|
||
(let ((height (+ space font-height space))
|
||
(len (length (ebnf-node-name node))))
|
||
(ebnf-node-entry node (* height 0.5))
|
||
(ebnf-node-height node height)
|
||
(ebnf-node-width node (+ ebnf-basic-width space
|
||
(* len font-width)
|
||
space ebnf-basic-width))))
|
||
|
||
|
||
(defconst ebnf-null-vector (vector t t t 0.0 0.0 0.0))
|
||
|
||
|
||
;; [repeat width-fun dim-fun entry height width times element]
|
||
(defun ebnf-repeat-dimension (repeat)
|
||
(let ((times (ebnf-node-name repeat))
|
||
(element (ebnf-node-separator repeat)))
|
||
(if element
|
||
(ebnf-node-dimension-func element)
|
||
(setq element ebnf-null-vector))
|
||
(ebnf-node-entry repeat (+ (ebnf-node-entry element)
|
||
ebnf-space-R))
|
||
(ebnf-node-height repeat (+ (max (ebnf-node-height element)
|
||
ebnf-font-height-S)
|
||
ebnf-space-R ebnf-space-R))
|
||
(ebnf-node-width repeat (+ (ebnf-node-width element)
|
||
ebnf-space-R ebnf-space-R ebnf-space-R
|
||
ebnf-horizontal-space
|
||
(* (length times) ebnf-font-width-R)))))
|
||
|
||
|
||
;; [except width-fun dim-fun entry height width element element]
|
||
(defun ebnf-except-dimension (except)
|
||
(let ((factor (ebnf-node-list except))
|
||
(element (ebnf-node-separator except)))
|
||
(ebnf-node-dimension-func factor)
|
||
(if element
|
||
(ebnf-node-dimension-func element)
|
||
(setq element ebnf-null-vector))
|
||
(ebnf-node-entry except (+ (max (ebnf-node-entry factor)
|
||
(ebnf-node-entry element))
|
||
ebnf-space-E))
|
||
(ebnf-node-height except (+ (max (ebnf-node-height factor)
|
||
(ebnf-node-height element))
|
||
ebnf-space-E ebnf-space-E))
|
||
(ebnf-node-width except (+ (ebnf-node-width factor)
|
||
(ebnf-node-width element)
|
||
ebnf-space-E ebnf-space-E
|
||
ebnf-space-E ebnf-space-E
|
||
ebnf-font-width-E
|
||
ebnf-horizontal-space))))
|
||
|
||
|
||
;; [alternative width-fun dim-fun entry height width list]
|
||
(defun ebnf-alternative-dimension (alternative)
|
||
(let ((body (ebnf-node-list alternative))
|
||
(lis (ebnf-node-list alternative)))
|
||
(while lis
|
||
(ebnf-node-dimension-func (car lis))
|
||
(setq lis (cdr lis)))
|
||
(let ((height 0.0)
|
||
(width 0.0)
|
||
(alt body)
|
||
(tail (car (last body)))
|
||
(entry (ebnf-node-entry (car body)))
|
||
node)
|
||
(while alt
|
||
(setq node (car alt)
|
||
alt (cdr alt)
|
||
height (+ (ebnf-node-height node) height)
|
||
width (max (ebnf-node-width node) width)))
|
||
(ebnf-adjust-width body width)
|
||
(setq height (+ height (* (1- (length body)) ebnf-vertical-space)))
|
||
(ebnf-node-entry alternative (+ entry
|
||
(ebnf-entry
|
||
(- height entry
|
||
(- (ebnf-node-height tail)
|
||
(ebnf-node-entry tail))))))
|
||
(ebnf-node-height alternative height)
|
||
(ebnf-node-width alternative (+ width ebnf-horizontal-space))
|
||
(ebnf-node-list alternative body))))
|
||
|
||
|
||
;; [optional width-fun dim-fun entry height width element]
|
||
(defun ebnf-optional-dimension (optional)
|
||
(let ((body (ebnf-node-list optional)))
|
||
(ebnf-node-dimension-func body)
|
||
(ebnf-node-entry optional (ebnf-node-entry body))
|
||
(ebnf-node-height optional (+ (ebnf-node-height body)
|
||
ebnf-vertical-space))
|
||
(ebnf-node-width optional (+ (ebnf-node-width body)
|
||
ebnf-horizontal-space))))
|
||
|
||
|
||
;; [one-or-more width-fun dim-fun entry height width element separator]
|
||
(defun ebnf-one-or-more-dimension (or-more)
|
||
(let ((list-part (ebnf-node-list or-more))
|
||
(sep-part (ebnf-node-separator or-more)))
|
||
(ebnf-node-dimension-func list-part)
|
||
(and sep-part
|
||
(ebnf-node-dimension-func sep-part))
|
||
(let ((height (+ (if sep-part
|
||
(ebnf-node-height sep-part)
|
||
0.0)
|
||
ebnf-vertical-space
|
||
(ebnf-node-height list-part)))
|
||
(width (max (if sep-part
|
||
(ebnf-node-width sep-part)
|
||
0.0)
|
||
(ebnf-node-width list-part))))
|
||
(when sep-part
|
||
(ebnf-adjust-width list-part width)
|
||
(ebnf-adjust-width sep-part width))
|
||
(ebnf-node-entry or-more (+ (- height (ebnf-node-height list-part))
|
||
(ebnf-node-entry list-part)))
|
||
(ebnf-node-height or-more height)
|
||
(ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
|
||
|
||
|
||
;; [zero-or-more width-fun dim-fun entry height width element separator]
|
||
(defun ebnf-zero-or-more-dimension (or-more)
|
||
(let ((list-part (ebnf-node-list or-more))
|
||
(sep-part (ebnf-node-separator or-more)))
|
||
(ebnf-node-dimension-func list-part)
|
||
(and sep-part
|
||
(ebnf-node-dimension-func sep-part))
|
||
(let ((height (+ (if sep-part
|
||
(ebnf-node-height sep-part)
|
||
0.0)
|
||
ebnf-vertical-space
|
||
(ebnf-node-height list-part)
|
||
ebnf-vertical-space))
|
||
(width (max (if sep-part
|
||
(ebnf-node-width sep-part)
|
||
0.0)
|
||
(ebnf-node-width list-part))))
|
||
(when sep-part
|
||
(ebnf-adjust-width list-part width)
|
||
(ebnf-adjust-width sep-part width))
|
||
(ebnf-node-entry or-more height)
|
||
(ebnf-node-height or-more height)
|
||
(ebnf-node-width or-more (+ width ebnf-horizontal-space)))))
|
||
|
||
|
||
;; [sequence width-fun dim-fun entry height width list]
|
||
(defun ebnf-sequence-dimension (sequence)
|
||
(let ((above 0.0)
|
||
(below 0.0)
|
||
(width 0.0)
|
||
(lis (ebnf-node-list sequence))
|
||
entry node)
|
||
(while lis
|
||
(setq node (car lis)
|
||
lis (cdr lis))
|
||
(ebnf-node-dimension-func node)
|
||
(setq entry (ebnf-node-entry node)
|
||
above (max above entry)
|
||
below (max below (- (ebnf-node-height node) entry))
|
||
width (+ width (ebnf-node-width node))))
|
||
(ebnf-node-entry sequence above)
|
||
(ebnf-node-height sequence (+ above below))
|
||
(ebnf-node-width sequence width)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Adjusting width
|
||
|
||
|
||
(defun ebnf-adjust-width (node width)
|
||
(cond
|
||
((listp node)
|
||
(prog1
|
||
node
|
||
(while node
|
||
(setcar node (ebnf-adjust-width (car node) width))
|
||
(setq node (cdr node)))))
|
||
((vectorp node)
|
||
(cond
|
||
;; nothing to be done
|
||
((= width (ebnf-node-width node))
|
||
node)
|
||
;; left justify term
|
||
((eq ebnf-justify-sequence 'left)
|
||
(ebnf-adjust-empty node width nil))
|
||
;; right justify terms
|
||
((eq ebnf-justify-sequence 'right)
|
||
(ebnf-adjust-empty node width t))
|
||
;; centralize terms
|
||
(t
|
||
(ebnf-node-width-func node width)
|
||
(ebnf-node-width node width)
|
||
node)
|
||
))
|
||
(t
|
||
node)
|
||
))
|
||
|
||
|
||
(defun ebnf-adjust-empty (node width last-p)
|
||
(if (eq (ebnf-node-kind node) 'ebnf-generate-empty)
|
||
(progn
|
||
(ebnf-node-width node width)
|
||
node)
|
||
(let ((empty (ebnf-make-empty (- width (ebnf-node-width node)))))
|
||
(ebnf-make-dup-sequence node
|
||
(if last-p
|
||
(list empty node)
|
||
(list node empty))))))
|
||
|
||
|
||
;; [terminal width-fun dim-fun entry height width name]
|
||
;; [non-terminal width-fun dim-fun entry height width name]
|
||
;; [empty width-fun dim-fun entry height width]
|
||
;; [special width-fun dim-fun entry height width name]
|
||
;; [repeat width-fun dim-fun entry height width times element]
|
||
;; [except width-fun dim-fun entry height width element element]
|
||
;;(defun ebnf-terminal-width (terminal width)
|
||
;; )
|
||
|
||
|
||
;; [alternative width-fun dim-fun entry height width list]
|
||
;; [optional width-fun dim-fun entry height width element]
|
||
(defun ebnf-alternative-width (alternative width)
|
||
(ebnf-adjust-width (ebnf-node-list alternative)
|
||
(- width ebnf-horizontal-space)))
|
||
|
||
|
||
;; [one-or-more width-fun dim-fun entry height width element separator]
|
||
;; [zero-or-more width-fun dim-fun entry height width element separator]
|
||
(defun ebnf-element-width (or-more width)
|
||
(setq width (- width ebnf-horizontal-space))
|
||
(ebnf-node-list or-more
|
||
(ebnf-justify-list or-more
|
||
(ebnf-node-list or-more)
|
||
width))
|
||
(ebnf-node-separator or-more
|
||
(ebnf-justify-list or-more
|
||
(ebnf-node-separator or-more)
|
||
width)))
|
||
|
||
|
||
;; [sequence width-fun dim-fun entry height width list]
|
||
(defun ebnf-sequence-width (sequence width)
|
||
(ebnf-node-list sequence
|
||
(ebnf-justify-list sequence
|
||
(ebnf-node-list sequence)
|
||
width)))
|
||
|
||
|
||
(defun ebnf-justify-list (node seq width)
|
||
(let ((seq-width (ebnf-node-width node)))
|
||
(if (= width seq-width)
|
||
seq
|
||
(cond
|
||
;; left justify terms
|
||
((eq ebnf-justify-sequence 'left)
|
||
(ebnf-justify node seq seq-width width t))
|
||
;; right justify terms
|
||
((eq ebnf-justify-sequence 'right)
|
||
(ebnf-justify node seq seq-width width nil))
|
||
;; centralize terms -- element
|
||
((vectorp seq)
|
||
(ebnf-adjust-width seq width))
|
||
;; centralize terms -- list
|
||
(t
|
||
(let ((the-width (/ (- width seq-width) (length seq)))
|
||
(lis seq))
|
||
(while lis
|
||
(ebnf-adjust-width (car lis)
|
||
(+ (ebnf-node-width (car lis))
|
||
the-width))
|
||
(setq lis (cdr lis)))
|
||
seq))
|
||
))))
|
||
|
||
|
||
(defun ebnf-justify (node seq seq-width width last-p)
|
||
(let ((term (car (if last-p (last seq) seq))))
|
||
(cond
|
||
;; adjust empty term
|
||
((eq (ebnf-node-kind term) 'ebnf-generate-empty)
|
||
(ebnf-node-width term (+ (- width seq-width)
|
||
(ebnf-node-width term)))
|
||
seq)
|
||
;; insert empty at end ==> left justify
|
||
(last-p
|
||
(nconc seq
|
||
(list (ebnf-make-empty (- width seq-width)))))
|
||
;; insert empty at beginning ==> right justify
|
||
(t
|
||
(cons (ebnf-make-empty (- width seq-width))
|
||
seq))
|
||
)))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Functions used by parsers
|
||
|
||
|
||
(defun ebnf-eps-add-context (name)
|
||
(let ((filename (ebnf-eps-filename name)))
|
||
(if (member filename ebnf-eps-context)
|
||
(error "Try to open an already opened EPS file: %s" filename)
|
||
(setq ebnf-eps-context (cons filename ebnf-eps-context)))))
|
||
|
||
|
||
(defun ebnf-eps-remove-context (name)
|
||
(let ((filename (ebnf-eps-filename name)))
|
||
(if (member filename ebnf-eps-context)
|
||
(setq ebnf-eps-context (delete filename ebnf-eps-context))
|
||
(error "Try to close a not opened EPS file: %s" filename))))
|
||
|
||
|
||
(defun ebnf-eps-add-production (header)
|
||
(and ebnf-eps-executing
|
||
ebnf-eps-context
|
||
(let ((prod (assoc header ebnf-eps-production-list)))
|
||
(if prod
|
||
(setcdr prod (append ebnf-eps-context (cdr prod)))
|
||
(setq ebnf-eps-production-list
|
||
(cons (cons header (ebnf-dup-list ebnf-eps-context))
|
||
ebnf-eps-production-list))))))
|
||
|
||
|
||
(defun ebnf-dup-list (old)
|
||
(let (new)
|
||
(while old
|
||
(setq new (cons (car old) new)
|
||
old (cdr old)))
|
||
(nreverse new)))
|
||
|
||
|
||
(defun ebnf-buffer-substring (chars)
|
||
(buffer-substring-no-properties
|
||
(point)
|
||
(progn
|
||
(skip-chars-forward chars ebnf-limit)
|
||
(point))))
|
||
|
||
|
||
;; replace the range "\240-\377" (see `ebnf-range-regexp').
|
||
(defconst ebnf-8-bit-chars (ebnf-range-regexp "" ?\240 ?\377))
|
||
|
||
|
||
(defun ebnf-string (chars eos-char kind)
|
||
(forward-char)
|
||
(buffer-substring-no-properties
|
||
(point)
|
||
(progn
|
||
;;(skip-chars-forward (concat chars "\240-\377") ebnf-limit)
|
||
(skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit)
|
||
(if (or (eobp) (/= (following-char) eos-char))
|
||
(error "Invalid %s: missing `%c'" kind eos-char)
|
||
(forward-char)
|
||
(1- (point))))))
|
||
|
||
|
||
(defun ebnf-get-string ()
|
||
(forward-char)
|
||
(buffer-substring-no-properties (point) (ebnf-end-of-string)))
|
||
|
||
|
||
(defun ebnf-end-of-string ()
|
||
(let ((n 1))
|
||
(while (> (logand n 1) 0)
|
||
(skip-chars-forward "^\"" ebnf-limit)
|
||
(setq n (- (skip-chars-backward "\\\\")))
|
||
(goto-char (+ (point) n 1))))
|
||
(if (= (preceding-char) ?\")
|
||
(1- (point))
|
||
(error "Missing `\"'")))
|
||
|
||
|
||
(defun ebnf-trim-right (str)
|
||
(let* ((len (1- (length str)))
|
||
(index len))
|
||
(while (and (> index 0) (= (aref str index) ?\s))
|
||
(setq index (1- index)))
|
||
(if (= index len)
|
||
str
|
||
(substring str 0 (1+ index)))))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Vector creation
|
||
|
||
|
||
(defun ebnf-make-empty (&optional width)
|
||
(vector 'ebnf-generate-empty
|
||
'ignore
|
||
'ignore
|
||
0.0
|
||
0.0
|
||
(or width ebnf-horizontal-space)))
|
||
|
||
|
||
(defun ebnf-make-terminal (name)
|
||
(ebnf-make-terminal1 name
|
||
'ebnf-generate-terminal
|
||
'ebnf-terminal-dimension))
|
||
|
||
|
||
(defun ebnf-make-non-terminal (name)
|
||
(ebnf-make-terminal1 name
|
||
'ebnf-generate-non-terminal
|
||
'ebnf-non-terminal-dimension))
|
||
|
||
|
||
(defun ebnf-make-special (name)
|
||
(ebnf-make-terminal1 name
|
||
'ebnf-generate-special
|
||
'ebnf-special-dimension))
|
||
|
||
|
||
(defun ebnf-make-terminal1 (name gen-func dim-func)
|
||
(vector gen-func
|
||
'ignore
|
||
dim-func
|
||
0.0
|
||
0.0
|
||
0.0
|
||
(let ((len (length name)))
|
||
(cond ((> len 3) name)
|
||
((= len 3) (concat name " "))
|
||
((= len 2) (concat " " name " "))
|
||
((= len 1) (concat " " name " "))
|
||
(t " ")))
|
||
ebnf-default-p))
|
||
|
||
|
||
(defun ebnf-make-one-or-more (list-part &optional sep-part)
|
||
(ebnf-make-or-more1 'ebnf-generate-one-or-more
|
||
'ebnf-one-or-more-dimension
|
||
list-part
|
||
sep-part))
|
||
|
||
|
||
(defun ebnf-make-zero-or-more (list-part &optional sep-part)
|
||
(ebnf-make-or-more1 'ebnf-generate-zero-or-more
|
||
'ebnf-zero-or-more-dimension
|
||
list-part
|
||
sep-part))
|
||
|
||
|
||
(defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
|
||
(vector gen-func
|
||
'ebnf-element-width
|
||
dim-func
|
||
0.0
|
||
0.0
|
||
0.0
|
||
(if (listp list-part)
|
||
(ebnf-make-sequence list-part)
|
||
list-part)
|
||
(if (and sep-part (listp sep-part))
|
||
(ebnf-make-sequence sep-part)
|
||
sep-part)))
|
||
|
||
|
||
(defun ebnf-make-production (name prod action)
|
||
(vector 'ebnf-generate-production
|
||
'ignore
|
||
'ebnf-production-dimension
|
||
0.0
|
||
0.0
|
||
0.0
|
||
name
|
||
prod
|
||
action))
|
||
|
||
|
||
(defun ebnf-make-alternative (body)
|
||
(vector 'ebnf-generate-alternative
|
||
'ebnf-alternative-width
|
||
'ebnf-alternative-dimension
|
||
0.0
|
||
0.0
|
||
0.0
|
||
body))
|
||
|
||
|
||
(defun ebnf-make-optional (body)
|
||
(vector 'ebnf-generate-optional
|
||
'ebnf-alternative-width
|
||
'ebnf-optional-dimension
|
||
0.0
|
||
0.0
|
||
0.0
|
||
body))
|
||
|
||
|
||
(defun ebnf-make-except (factor exception)
|
||
(vector 'ebnf-generate-except
|
||
'ignore
|
||
'ebnf-except-dimension
|
||
0.0
|
||
0.0
|
||
0.0
|
||
factor
|
||
exception))
|
||
|
||
|
||
(defun ebnf-make-repeat (times primary &optional upper)
|
||
(vector 'ebnf-generate-repeat
|
||
'ignore
|
||
'ebnf-repeat-dimension
|
||
0.0
|
||
0.0
|
||
0.0
|
||
(cond ((and times upper) ; L * U, L * L
|
||
(if (string= times upper)
|
||
(if (string= times "")
|
||
" * "
|
||
times)
|
||
(concat times " * " upper)))
|
||
(times ; L *
|
||
(concat times " *"))
|
||
(upper ; * U
|
||
(concat "* " upper))
|
||
(t ; *
|
||
" * "))
|
||
primary))
|
||
|
||
|
||
(defun ebnf-make-sequence (seq)
|
||
(vector 'ebnf-generate-sequence
|
||
'ebnf-sequence-width
|
||
'ebnf-sequence-dimension
|
||
0.0
|
||
0.0
|
||
0.0
|
||
seq))
|
||
|
||
|
||
(defun ebnf-make-dup-sequence (node seq)
|
||
(vector 'ebnf-generate-sequence
|
||
'ebnf-sequence-width
|
||
'ebnf-sequence-dimension
|
||
(ebnf-node-entry node)
|
||
(ebnf-node-height node)
|
||
(ebnf-node-width node)
|
||
seq))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Optimizers used by parsers
|
||
|
||
|
||
(defun ebnf-token-except (element exception)
|
||
(cons (prog1
|
||
(car exception)
|
||
(setq exception (cdr exception)))
|
||
(and element ; EMPTY - A ==> EMPTY
|
||
(let ((kind (ebnf-node-kind element)))
|
||
(cond
|
||
;; [ A ]- ==> A
|
||
((and (null exception)
|
||
(eq kind 'ebnf-generate-optional))
|
||
(ebnf-node-list element))
|
||
;; { A }- ==> { A }+
|
||
((and (null exception)
|
||
(eq kind 'ebnf-generate-zero-or-more))
|
||
(ebnf-node-kind element 'ebnf-generate-one-or-more)
|
||
(ebnf-node-dimension-func element 'ebnf-one-or-more-dimension)
|
||
element)
|
||
;; ( A | EMPTY )- ==> A
|
||
;; ( A | B | EMPTY )- ==> A | B
|
||
((and (null exception)
|
||
(eq kind 'ebnf-generate-alternative)
|
||
(eq (ebnf-node-kind
|
||
(car (last (ebnf-node-list element))))
|
||
'ebnf-generate-empty))
|
||
(let ((elt (ebnf-node-list element))
|
||
bef)
|
||
(while (cdr elt)
|
||
(setq bef elt
|
||
elt (cdr elt)))
|
||
(if (null bef)
|
||
;; this should not happen!!?!
|
||
(setq element (ebnf-make-empty
|
||
(ebnf-node-width element)))
|
||
(setcdr bef nil)
|
||
(setq elt (ebnf-node-list element))
|
||
(and (= (length elt) 1)
|
||
(setq element (car elt))))
|
||
element))
|
||
;; A - B
|
||
(t
|
||
(ebnf-make-except element exception))
|
||
)))))
|
||
|
||
|
||
(defun ebnf-token-repeat (times repeat &optional upper)
|
||
(if (null (cdr repeat))
|
||
;; n * EMPTY ==> EMPTY
|
||
repeat
|
||
;; n * term
|
||
(cons (car repeat)
|
||
(ebnf-make-repeat times (cdr repeat) upper))))
|
||
|
||
|
||
(defun ebnf-token-optional (body)
|
||
(let ((kind (ebnf-node-kind body)))
|
||
(cond
|
||
;; [ EMPTY ] ==> EMPTY
|
||
((eq kind 'ebnf-generate-empty)
|
||
nil)
|
||
;; [ { A }* ] ==> { A }*
|
||
((eq kind 'ebnf-generate-zero-or-more)
|
||
body)
|
||
;; [ { A }+ ] ==> { A }*
|
||
((eq kind 'ebnf-generate-one-or-more)
|
||
(ebnf-node-kind body 'ebnf-generate-zero-or-more)
|
||
body)
|
||
;; [ A | B ] ==> A | B | EMPTY
|
||
((eq kind 'ebnf-generate-alternative)
|
||
(ebnf-node-list body (nconc (ebnf-node-list body)
|
||
(list (ebnf-make-empty))))
|
||
body)
|
||
;; [ A ]
|
||
(t
|
||
(ebnf-make-optional body))
|
||
)))
|
||
|
||
|
||
(defun ebnf-token-alternative (body sequence)
|
||
(if (null body)
|
||
(if (cdr sequence)
|
||
sequence
|
||
(cons (car sequence)
|
||
(ebnf-make-empty)))
|
||
(cons (car sequence)
|
||
(let ((seq (cdr sequence)))
|
||
(if (and (= (length body) 1) (null seq))
|
||
(car body)
|
||
(ebnf-make-alternative (nreverse (if seq
|
||
(cons seq body)
|
||
body))))))))
|
||
|
||
|
||
(defun ebnf-token-sequence (sequence)
|
||
(cond
|
||
;; null sequence
|
||
((null sequence)
|
||
(ebnf-make-empty))
|
||
;; sequence with only one element
|
||
((= (length sequence) 1)
|
||
(car sequence))
|
||
;; a real sequence
|
||
(t
|
||
(ebnf-make-sequence (nreverse sequence)))
|
||
))
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; Variables used by parsers
|
||
|
||
|
||
(defconst ebnf-comment-table
|
||
(let ((table (make-vector 256 nil)))
|
||
;; Override special comment character:
|
||
(aset table ?< 'newline)
|
||
(aset table ?> 'keep-line)
|
||
(aset table ?^ 'form-feed)
|
||
table)
|
||
"Vector used to map characters to a special comment token.")
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
;; To make this file smaller, some commands go in a separate file.
|
||
;; But autoload them here to make the separation invisible.
|
||
|
||
(autoload 'ebnf-abn-parser "ebnf-abn"
|
||
"ABNF parser.")
|
||
|
||
(autoload 'ebnf-abn-initialize "ebnf-abn"
|
||
"Initialize ABNF token table.")
|
||
|
||
(autoload 'ebnf-bnf-parser "ebnf-bnf"
|
||
"EBNF parser.")
|
||
|
||
(autoload 'ebnf-bnf-initialize "ebnf-bnf"
|
||
"Initialize EBNF token table.")
|
||
|
||
(autoload 'ebnf-iso-parser "ebnf-iso"
|
||
"ISO EBNF parser.")
|
||
|
||
(autoload 'ebnf-iso-initialize "ebnf-iso"
|
||
"Initialize ISO EBNF token table.")
|
||
|
||
(autoload 'ebnf-yac-parser "ebnf-yac"
|
||
"Yacc/Bison parser.")
|
||
|
||
(autoload 'ebnf-yac-initialize "ebnf-yac"
|
||
"Initializations for Yacc/Bison parser.")
|
||
|
||
(autoload 'ebnf-ebx-parser "ebnf-ebx"
|
||
"EBNFX parser.")
|
||
|
||
(autoload 'ebnf-ebx-initialize "ebnf-ebx"
|
||
"Initializations for EBNFX parser.")
|
||
|
||
(autoload 'ebnf-dtd-parser "ebnf-dtd"
|
||
"DTD parser.")
|
||
|
||
(autoload 'ebnf-dtd-initialize "ebnf-dtd"
|
||
"Initializations for DTD parser.")
|
||
|
||
|
||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||
|
||
|
||
(provide 'ebnf2ps)
|
||
|
||
;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
|
||
;;; ebnf2ps.el ends here
|