-;;; ebnf2ps --- Translate an EBNF to a syntatic chart on PostScript
+;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
-;; Copyright (C) 1999 Vinicius Jose Latorre
+;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+;; Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Keywords: wp, ebnf, PostScript
-;; Time-stamp: <99/12/11 21:41:24 vinicius>
-;; Version: 3.1
+;; 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/
-(defconst ebnf-version "3.1"
- "ebnf2ps.el, v 3.1 <99/12/11 vinicius>
+;; This file is part of GNU Emacs.
-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 <vinicius@cpqd.com.br>.
-")
-
-;; This file is *NOT* (yet?) part of GNU Emacs.
-
-;; This program is free software; you can redistribute it and/or modify
+;; 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.
-;; This program is distributed in the hope that it will be useful,
+;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; 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 syntatic chart on PostScript.
+;; 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 3.05.1 or later), so see ps-print to
-;; know how to set options like landscape printing, page headings, margins, etc.
+;; 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.
;; Using ebnf2ps
;; -------------
;;
-;; ebnf2ps provides six commands for generating PostScript syntatic chart images
-;; of Emacs buffers:
-;;
-;; ebnf-print-buffer
-;; ebnf-print-region
-;; ebnf-spool-buffer
-;; ebnf-spool-region
-;; ebnf-eps-buffer
-;; ebnf-eps-region
+;; 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 syntatic chart images suitable for printing on a PostScript
+;; 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;
+;; 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'.
+;; 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.
+;; 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
;; 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.
+;; you'll be asked to confirm the exit; this is modeled on the confirmation
+;; that Emacs uses for modified buffers.
;;
-;; The word "buffer" or "region" in the command name determines how much of the
-;; buffer is printed:
+;; The word "directory", "file", "buffer" or "region" in the command name
+;; determines how much of the buffer is printed:
;;
-;; buffer - Print the entire buffer.
+;; directory - Read files in the directory and print them.
;;
-;; region - Print just the current region.
+;; 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-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.
+;; 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-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.
+;; 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
;; (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)
;; 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 n (integer) times)
+;; 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
;;
;; exception = repeat [ "-" repeat]. ;; exception
;;
-;; repeat = [ integer "*" ] term. ;; repetition
+;; repeat = [ integer "*" [ integer ]] term. ;; repetition
;;
;; term = factor
;; | [factor] "+" ;; one-or-more
;; | "{" body [ "||" body ] "}" ;; zero-or-more
;; .
;;
-;; non_terminal = "[A-Za-z\\240-\\377][!#%&'*-,0-:<>@-Z\\^-z~\\240-\\377]*".
+;; 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 = "[^?\\n\\000-\\010\\016-\\037\\177-\\237]*".
+;; 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.
;;
;; Logical Expression non-terminal
;; "(" OR AND "XOR" ")" terminal
;;
-;; The line comment is controlled by `ebnf-lex-comment-char'. The default value
-;; is ?\; (character `;').
+;; 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 `.').
;; `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").
;; 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'.
;; 6. A = B | . ==> A = [B].
;; 7. A = | B . ==> A = [B].
;;
-;; factoration:
+;; 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.
;; Form Feed
;; ---------
;;
-;; You may use form feed (^L \014) to force a production to start on a new page,
-;; for example:
+;; You may use form feed (^L \014) to force a production to start on a new
+;; page, for example:
;;
;; a) A = B | C.
;; ^L
;;
;; 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.
;;
;;
;; ;[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
+;; 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.
;; 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:
+;; If consecutive actions occur, only the last one takes effect, so if you
+;; have:
;;
;; A = X.
;; ;<
;; 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:
+;; In ISO EBNF the above actions are specified as (*^*), (*>*), (*<*), (*[EPS*)
+;; and (*]EPS*). The first example above should be written:
;;
;; A = t;
;; C = x;
;;
;; `ebnf-setup' returns the current setup.
;;
-;; `ebnf-syntax-buffer' does a syntatic analysis of your EBNF in the current
+;; `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 syntatic analysis of your EBNF in the current
+;; `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-buffer', `ebnf-syntax-region' and `ebnf-customize' can be bound
-;; to keys in the same way as `ebnf-' commands.
+;; `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
;; `ebnf-production-horizontal-space' Specify horizontal space in points
;; between productions.
;;
-;; `ebnf-production-vertical-space' Specify vertical 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-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-shape' Specify non-terminal box shape.
;;
-;; `ebnf-non-terminal-shadow' Non-nil means non-terminal box will have
-;; a shadow.
+;; `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-line-color' Specify flow line color.
;;
-;; `ebnf-user-arrow' Specify a user arrow shape (a PostScript
-;; code).
+;; `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-lex-eop-char' Specify the end of production
+;; character.
;;
;; `ebnf-syntax' Specify syntax to be recognized.
;;
;; 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 syntatic chart of
-;; rules.
+;; `ebnf-optimize' Non-nil means optimize syntactic chart
+;; of rules.
;;
;; To set the above options you may:
;;
;; `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 to current style.
+;; `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 to 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 to current style.
+;; `ebnf-pop-style' Pop a style and set it as the current style.
;;
-;; These commands helps to put together a lot of variable settings in a group
+;; 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
+;; 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'.
;; 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.
+;; 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
;; Internal Structures
;; -------------------
;;
-;; ebnf2ps has two passes. The first pass does a lexical and syntatic analysis
+;; 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 syntatic
-;; chart.
+;; pass uses the intermediate representation to generate the PostScript
+;; syntactic chart.
;;
;; The intermediate representation is a list of vectors, the vector element
-;; represents a syntatic chart element. Below is a vector representation for
-;; each syntatic chart 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]
+;; [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]
;; Things To Change
;; ----------------
;;
-;; . Handle situations when syntatic chart is out of paper.
+;; . 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:
+;;; Code:
(require 'ps-print)
-(and (string< ps-print-version "3.05.1")
- (error "`ebnf2ps' requires `ps-print' package version 3.05.1 or later"))
-
-
-;; temporary fix for ps-print
-(or (fboundp 'set-buffer-multibyte)
- (defun set-buffer-multibyte (arg)
- (setq enable-multibyte-characters arg)))
-
-(or (fboundp 'string-as-unibyte)
- (defun string-as-unibyte (arg) arg))
+(and (string< ps-print-version "5.2.3")
+ (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
-(or (fboundp 'string-as-multibyte)
- (defun string-as-multibyte (arg) arg))
-(or (fboundp 'charset-after)
- (defun charset-after (&optional arg)
- (char-charset (char-after arg))))
+;; 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)))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Interface to the command system
(defgroup postscript nil
- "PostScript Group"
+ "PostScript Group."
:tag "PostScript"
+ :version "20"
:group 'emacs)
(defgroup ebnf2ps nil
- "Translate an EBNF to a syntatic chart on PostScript"
+ "Translate an EBNF to a syntactic chart on PostScript."
:prefix "ebnf-"
+ :version "20"
:group 'wp
:group 'postscript)
(defgroup ebnf-special nil
- "Special customization"
+ "Special customization."
:prefix "ebnf-"
:tag "Special"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-except nil
- "Except customization"
+ "Except customization."
:prefix "ebnf-"
:tag "Except"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-repeat nil
- "Repeat customization"
+ "Repeat customization."
:prefix "ebnf-"
:tag "Repeat"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-terminal nil
- "Terminal customization"
+ "Terminal customization."
:prefix "ebnf-"
:tag "Terminal"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-non-terminal nil
- "Non-Terminal customization"
+ "Non-Terminal customization."
:prefix "ebnf-"
:tag "Non-Terminal"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-production nil
- "Production customization"
+ "Production customization."
:prefix "ebnf-"
:tag "Production"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-shape nil
- "Shapes customization"
+ "Shapes customization."
:prefix "ebnf-"
:tag "Shape"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-displacement nil
- "Displacement customization"
+ "Displacement customization."
:prefix "ebnf-"
:tag "Displacement"
+ :version "20"
:group 'ebnf2ps)
-(defgroup ebnf-syntatic nil
- "Syntatic customization"
+(defgroup ebnf-syntactic nil
+ "Syntactic customization."
:prefix "ebnf-"
- :tag "Syntatic"
+ :tag "Syntactic"
+ :version "20"
:group 'ebnf2ps)
(defgroup ebnf-optimization nil
- "Optimization customization"
+ "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)
It is only used when `ebnf-horizontal-orientation' is non-nil."
:type 'boolean
+ :version "20"
:group 'ebnf-displacement)
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
+ :version "20"
:group 'ebnf-displacement)
Value less or equal to zero forces ebnf2ps to set a proper default value."
:type 'number
+ :version "20"
:group 'ebnf-displacement)
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.
(const underline) (const strikeout)
(const overline) (const shadow)
(const box) (const outline))))
+ :version "20"
:group 'ebnf-special)
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)
(const underline) (const strikeout)
(const overline) (const shadow)
(const box) (const outline))))
+ :version "20"
:group 'ebnf-except)
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)
(const underline) (const strikeout)
(const overline) (const shadow)
(const box) (const outline))))
+ :version "20"
:group 'ebnf-repeat)
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)
(const underline) (const strikeout)
(const overline) (const shadow)
(const box) (const outline))))
+ :version "20"
:group 'ebnf-terminal)
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.
(const :tag "Ascending" ascending)
(const :tag "Descending" descending)
(other :tag "No Sort" nil))
+ :version "20"
:group 'ebnf-production)
(const underline) (const strikeout)
(const overline) (const shadow)
(const box) (const outline))))
+ :version "20"
:group 'ebnf-production)
(const underline) (const strikeout)
(const overline) (const shadow)
(const box) (const outline))))
+ :version "20"
:group 'ebnf-non-terminal)
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)
|*
*
+ `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 user))
+ (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)
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 user arrow shape (a PostScript code).
+ "*Specify a sexp for user arrow shape (a PostScript code).
-PostScript code should draw a right arrow.
+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:
: } 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.
+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'.
-
-See function `ebnf-user-arrow' for valid values and how values are processed."
- :type '(radio :tag "User Arrow Shape"
- (const nil)
- string
- symbol
- (repeat :tag "List"
- (radio string
- symbol
- sexp)))
+symbol `user'."
+ :type '(sexp :tag "User Arrow Shape")
+ :version "20"
:group 'ebnf-shape)
`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\").
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 iso-ebnf) (const yacc))
- :group 'ebnf-syntatic)
+ (const ebnf) (const abnf) (const iso-ebnf)
+ (const yacc) (const ebnfx) (const dtd))
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-lex-comment-char ?\;
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
- :group 'ebnf-syntatic)
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-lex-eop-char ?.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
- :group 'ebnf-syntatic)
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-terminal-regexp nil
It's used only when `ebnf-syntax' is `ebnf'."
:type '(radio :tag "Terminal Name"
(const nil) regexp)
- :group 'ebnf-syntatic)
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-case-fold-search nil
It's only used when `ebnf-terminal-regexp' is non-nil and when `ebnf-syntax' is
`ebnf'."
:type 'boolean
- :group 'ebnf-syntatic)
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-iso-alternative-p nil
} ==> :)
; ==> ."
:type 'boolean
- :group 'ebnf-syntatic)
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-iso-normalize-p nil
It's only used when `ebnf-syntax' is `iso-ebnf'."
:type 'boolean
- :group 'ebnf-syntatic)
+ :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--"
See `ebnf-eps-buffer' and `ebnf-eps-region' commands."
:type 'string
+ :version "20"
:group 'ebnf2ps)
It must be a float between 0.0 (top) and 1.0 (bottom)."
:type 'number
+ :version "20"
:group 'ebnf2ps)
"*Specify additional border width over default terminal, non-terminal or
special."
:type 'number
+ :version "20"
:group 'ebnf2ps)
(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)
It is intended to help PostScript programmers in debugging."
:type 'boolean
+ :version "20"
:group 'ebnf2ps)
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)
It's only used when `ebnf-syntax' is `yacc'."
:type 'boolean
- :group 'ebnf-syntatic)
+ :version "20"
+ :group 'ebnf-syntactic)
(defcustom ebnf-ignore-empty-rule nil
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 syntatic chart of rules.
+ "*Non-nil means optimize syntactic chart of rules.
The following optimizations are done:
6. A = B | . ==> A = [B].
7. A = | B . ==> A = [B].
- factoration:
+ 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)
\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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.")
+
+\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Customization
;; 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 syntatic chart image of the buffer.
+ "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
;;;###autoload
(defun ebnf-print-region (from to &optional filename)
- "Generate and print a PostScript syntatic chart image of the region.
+ "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)
(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 syntatic chart image of the 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.
;;;###autoload
(defun ebnf-spool-region (from to)
- "Generate a PostScript syntatic chart image of the region and spool locally.
+ "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."
(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 syntatic chart image of the buffer in a EPS file.
+ "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:
;;;###autoload
(defun ebnf-eps-region (from to)
- "Generate a PostScript syntatic chart image of the region in a EPS file.
+ "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:
(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 syntatic analysis of the current 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 syntatic analysis of a region."
+ "Does a syntactic analysis of a region."
(interactive "r")
(ebnf-generate-region from to nil))
"Return the current ebnf2ps setup."
(format
"
-\(setq ebnf-special-font %s
+;;; 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-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-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-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-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-syntax)
ebnf-iso-alternative-p
ebnf-iso-normalize-p
+ ebnf-file-suffix-regexp
ebnf-eps-prefix
ebnf-entry-percentage
ebnf-color-p
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))
(defconst ebnf-style-custom-list
- '(ebnf-special-font
+ '(ebnf-special-show-delimiter
+ ebnf-special-font
ebnf-special-shape
ebnf-special-shadow
ebnf-special-border-width
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-syntax
ebnf-iso-alternative-p
ebnf-iso-normalize-p
+ ebnf-file-suffix-regexp
ebnf-eps-prefix
ebnf-entry-percentage
ebnf-color-p
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)
'(;; 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-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-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
(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))
(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
(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:
- (CUSTOM INHERITS (VAR . VALUE)...)
+ (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.
-CUSTOM 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.
-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.
+ 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.
-Don't handle this variable directly. Use functions `ebnf-insert-style' and
-`ebnf-merge-style'.")
+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'.")
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun ebnf-insert-style (name inherits &rest values)
- "Insert a new style NAME with inheritance INHERITS and values VALUES."
- (interactive)
+ "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)
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."
- (interactive)
+ "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))
;;;###autoload
(defun ebnf-apply-style (style)
- "Set STYLE to current style.
+ "Set STYLE as the current style.
-It returns the old style symbol."
- (interactive)
+It returns the old style symbol.
+
+See `ebnf-style-database' documentation."
+ (interactive "SApply style: ")
(prog1
ebnf-current-style
(and (ebnf-apply-style1 style)
(defun ebnf-reset-style (&optional style)
"Reset current style.
-It returns the old style symbol."
- (interactive)
+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 to current style.
+ "Push the current style and set STYLE as the current style.
-It returns the old style symbol."
- (interactive)
+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))
;;;###autoload
(defun ebnf-pop-style ()
- "Pop a style and set it to current style.
+ "Pop a style and set it as the current style.
-It returns the old style symbol."
+It returns the old style symbol.
+
+See `ebnf-style-database' documentation."
(interactive)
(prog1
(ebnf-apply-style (car ebnf-stack-style))
(defun ebnf-check-style-values (values)
(let (style)
(while values
- (and (memq (car values) ebnf-style-custom-list)
+ (and (memq (caar values) ebnf-style-custom-list)
(setq style (cons (car values) style)))
(setq values (cdr values)))
(nreverse style)))
;; Internal variables
-(make-local-hook 'ebnf-hook)
-(make-local-hook 'ebnf-production-hook)
-(make-local-hook 'ebnf-page-hook)
-
-
(defvar ebnf-eps-buffer-name " *EPS*")
(defvar ebnf-parser-func nil)
(defvar ebnf-eps-executing nil)
(defconst ebnf-arrow-shape-alist
- '((none . 0)
- (semi-up . 1)
- (semi-down . 2)
- (simple . 3)
- (transparent . 4)
- (hollow . 5)
- (full . 6)
- (user . 7))
+ '((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'.")
/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 gsave UserArrow grestore} % 7 - user
+[{} % 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
{xyp
neg yp add /yw exch def
xp add T sub /xw exch def
- /Effect EffectP def
- /fP F ForegroundP SetRGB BackgroundP aload pop true BG S
- /Effect 0 def
- ( :) S false BG
+ 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
/#ebnf2ps#end{showpage #ebnf2ps#save restore end}def
-%%EndPrologue
+%%EndProlog
"
"EBNF EPS begin")
(defun ebnf-format-color (format-str color default)
(let* ((the-color (or color default))
- (rgb (mapcar 'ps-color-value (ps-color-values the-color))))
+ (rgb (ps-color-scale the-color)))
(format format-str
(concat "["
(ebnf-format-float (nth 0 rgb) (nth 1 rgb) (nth 2 rgb))
(format ebnf-message-float value)))
+(defvar ebnf-total 0)
+(defvar ebnf-nprod 0)
+
+
(defsubst ebnf-message-info (messag)
(message "%s...%3d%%"
messag
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))
+ horizontal (memq (ebnf-node-action prod)
+ ebnf-action-list))
;; generate production in EPS buffer
(save-excursion
(set-buffer eps-buffer)
ebnf-eps-max-height prod-height))
)
(setq ebnf-eps-prod-width prod-width)
- (insert-buffer eps-buffer))
+ (insert-buffer-substring eps-buffer))
(setq prod-list (cdr prod-list))))
(defvar ebnf-tree nil)
(defvar ebnf-direction "R")
-(defvar ebnf-total 0)
-(defvar ebnf-nprod 0)
(defun ebnf-generate-postscript (from to)
(defun ebnf-generate-production (production)
(ebnf-message-info "Generating")
(run-hooks 'ebnf-production-hook)
- (ps-output-string (ebnf-node-name production))
+ (ps-output-string (if ebnf-production-name-p
+ (ebnf-node-name production)
+ ""))
(ps-output " "
(ebnf-format-float
(ebnf-node-width production)
- (+ ebnf-basic-height
+ (+ (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))
;; 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)
(defun ebnf-eps-filename (str)
(let* ((len (length str))
(stri 0)
- (new (make-string len ?\ )))
+ (new (make-string len ?\s)))
(while (< stri len)
(aset new stri (aref ebnf-map-name (aref str stri)))
(setq stri (1+ stri)))
(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
(condition-case data
(let ((tree (ebnf-parse-and-sort (min from to))))
(when gen-func
- (funcall gen-func
- (ebnf-dimensions
- (ebnf-optimize
- (ebnf-eliminate-empty-rules tree))))))
+ (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)))
- (message (error-message-string data)))))))
+ (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
- (the-point
- (goto-char the-point))
+ ;; 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 syntatic analysis: NO ERRORS.")))))
+ (message "EBNF syntactic analysis: NO ERRORS.")))))
(defun ebnf-parse-and-sort (start)
(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)
+ (ps-printing-region nil nil nil)
(if ebnf-use-float-format
(setq ebnf-format-float "%1.3f"
ebnf-message-float "%3.2f")
ebnf-message-float "%s"))
(ebnf-otz-initialize)
;; to avoid compilation gripes when calling autoloaded functions
- (funcall (cond ((eq ebnf-syntax 'iso-ebnf)
- (setq ebnf-parser-func 'ebnf-iso-parser)
- 'ebnf-iso-initialize)
- ((eq ebnf-syntax 'yacc)
- (setq ebnf-parser-func 'ebnf-yac-parser)
- 'ebnf-yac-initialize)
- (t
- (setq ebnf-parser-func 'ebnf-bnf-parser)
- 'ebnf-bnf-initialize)))
+ (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))
(insert " & ebnf2ps v" ebnf-version)
;; insert ebnf settings & engine
(goto-char (point-max))
- (search-backward "\n%%EndPrologue\n")
+ (search-backward "\n%%EndProlog\n")
(ebnf-insert-ebnf-prologue)
(ps-output "\n")))))
(defun ebnf-eps-finish-and-write (buffer filename)
- (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: " (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
- "\n%%Creator: " (user-full-name) " (using ebnf2ps v" ebnf-version ")"
- "\n%%DocumentNeededResources: font "
- (or ebnf-fonts-required
- (setq ebnf-fonts-required
- (let ((fonts (ps-remove-duplicates
+ (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)))))
- (concat (car fonts)
- (and (cdr fonts) "\n%%+ font ")
- (mapconcat 'identity (cdr fonts) "\n%%+ font ")))))
- "\n%%Pages: 0\n%%EndComments\n\n%%BeginPrologue\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)))
+ 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 ()
(ebnf-shape-value ebnf-chart-shape
ebnf-terminal-shape-alist))
(format "/UserArrow{%s}def\n"
- (ebnf-user-arrow ebnf-user-arrow))
+ (let ((arrow (eval ebnf-user-arrow)))
+ (if (stringp arrow)
+ arrow
+ "")))
"\n% === end EBNF settings\n\n"
(and ebnf-debug-ps ebnf-debug))))
ebnf-prologue))
-
-(defun ebnf-user-arrow (user-arrow)
- "Return a user arrow shape from USER-ARROW (a PostScript code).
-
-This function is only called when `ebnf-arrow-shape' is set to symbol `user'.
-
-If is a string, should be a PostScript procedure body.
-If is a variable symbol, should contain a string.
-If is a function symbol, it is called and the result is applied recursively.
-If is a cons and car is a function symbol, it is called as:
- (funcall (car cons) (cdr cons))
-and the result is applied recursively.
-If is a cons and car is not a function symbol, it is applied recursively on
-car and cdr, and the results are concatened as:
- (concat RESULT-FROM-CAR \" \" RESULT-FROM-CDR)
-If is a list and car is a function symbol, it is called as:
- (apply (car list) (cdr list))
-and the result is applied recursively.
-If is a list and car is not a function symbol, it is applied recursively on
-each element and the resulting list is concatened as:
- (mapconcat 'identity RESULTING-LIST \" \")
-Otherwise, it is treated as an empty string."
- (cond
- ((null user-arrow)
- "")
- ((stringp user-arrow)
- user-arrow)
- ((and (symbolp user-arrow) (fboundp user-arrow))
- (ebnf-user-arrow (funcall user-arrow)))
- ((and (symbolp user-arrow) (boundp user-arrow))
- (ebnf-user-arrow (symbol-value user-arrow)))
- ((consp user-arrow)
- (if (and (symbolp (car user-arrow)) (fboundp (car user-arrow)))
- (ebnf-user-arrow (funcall (car user-arrow) (cdr user-arrow)))
- (concat (ebnf-user-arrow (car user-arrow))
- " "
- (ebnf-user-arrow (cdr user-arrow)))))
- ((listp user-arrow)
- (if (and (symbolp (car user-arrow))
- (fboundp (car user-arrow)))
- (ebnf-user-arrow (apply (car user-arrow) (cdr user-arrow)))
- (mapconcat 'ebnf-user-arrow user-arrow " ")))
- (t
- "")
- ))
-
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adjusting dimensions
(ebnf-message-info "Calculating dimensions")
(ebnf-node-dimension-func (ebnf-node-production production))
(let* ((prod (ebnf-node-production production))
- (height (+ ebnf-font-height-P
+ (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))))
;; [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-list-width (or-more width)
+(defun ebnf-element-width (or-more width)
(setq width (- width ebnf-horizontal-space))
(ebnf-node-list or-more
(ebnf-justify-list or-more
;; [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)))
+ (ebnf-justify-list sequence
+ (ebnf-node-list sequence)
+ width)))
(defun ebnf-justify-list (node seq width)
;; right justify terms
((eq ebnf-justify-sequence 'right)
(ebnf-justify node seq seq-width width nil))
- ;; centralize terms
+ ;; centralize terms -- element
+ ((vectorp seq)
+ (ebnf-adjust-width seq width))
+ ;; centralize terms -- list
(t
(let ((the-width (/ (- width seq-width) (length seq)))
(lis seq))
(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 "\240-\377") ebnf-limit)
+ (skip-chars-forward (concat chars ebnf-8-bit-chars) ebnf-limit)
(if (or (eobp) (/= (following-char) eos-char))
- (error "Illegal %s: missing `%c'." kind eos-char)
+ (error "Invalid %s: missing `%c'" kind eos-char)
(forward-char)
(1- (point))))))
(goto-char (+ (point) n 1))))
(if (= (preceding-char) ?\")
(1- (point))
- (error "Missing `\"'.")))
+ (error "Missing `\"'")))
(defun ebnf-trim-right (str)
(let* ((len (1- (length str)))
(index len))
- (while (and (> index 0) (= (aref str index) ?\ ))
+ (while (and (> index 0) (= (aref str index) ?\s))
(setq index (1- index)))
(if (= index len)
str
0.0
0.0
(let ((len (length name)))
- (cond ((> len 2) name)
- ((= len 2) (concat " " name))
- ((= len 1) (concat " " name " "))
- (t " ")))
+ (cond ((> len 3) name)
+ ((= len 3) (concat name " "))
+ ((= len 2) (concat " " name " "))
+ ((= len 1) (concat " " name " "))
+ (t " ")))
ebnf-default-p))
(defun ebnf-make-or-more1 (gen-func dim-func list-part sep-part)
(vector gen-func
- 'ebnf-list-width
+ 'ebnf-element-width
dim-func
0.0
0.0
exception))
-(defun ebnf-make-repeat (times primary)
+(defun ebnf-make-repeat (times primary &optional upper)
(vector 'ebnf-generate-repeat
'ignore
'ebnf-repeat-dimension
0.0
0.0
0.0
- (concat times " *")
+ (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))
;; ( A | B | EMPTY )- ==> A | B
((and (null exception)
(eq kind 'ebnf-generate-alternative)
- (eq (ebnf-node-kind (car (last (ebnf-node-list element))))
+ (eq (ebnf-node-kind
+ (car (last (ebnf-node-list element))))
'ebnf-generate-empty))
(let ((elt (ebnf-node-list element))
bef)
)))))
-(defun ebnf-token-repeat (times repeat)
+(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)))))
+ (ebnf-make-repeat times (cdr repeat) upper))))
(defun ebnf-token-optional (body)
(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)))
+ ))
+
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Variables used by parsers
;; 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-yac-initialize "ebnf-yac"
"Initializations for Yacc/Bison parser.")
-(autoload 'ebnf-eliminate-empty-rules "ebnf-otz"
- "Eliminate empty rules.")
+(autoload 'ebnf-ebx-parser "ebnf-ebx"
+ "EBNFX parser.")
-(autoload 'ebnf-optimize "ebnf-otz"
- "Syntatic chart optimizer.")
+(autoload 'ebnf-ebx-initialize "ebnf-ebx"
+ "Initializations for EBNFX parser.")
-(autoload 'ebnf-otz-initialize "ebnf-otz"
- "Initialize optimizer.")
+(autoload 'ebnf-dtd-parser "ebnf-dtd"
+ "DTD parser.")
+
+(autoload 'ebnf-dtd-initialize "ebnf-dtd"
+ "Initializations for DTD parser.")
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'ebnf2ps)
-
+;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
;;; ebnf2ps.el ends here
HCoop / bpt / emacs.git / blobdiff