-;;; ebnf2ps --- Translate an EBNF to a syntatic chart on PostScript
+;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript
-;; Copyright (C) 1999, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
-;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; 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
+;; Keywords: wp, ebnf, PostScript
+;; Time-stamp: <2003/08/08 23:09:36 vinicius>
+;; Version: 3.6.1
+;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
;; This file is part of GNU Emacs.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
-(defconst ebnf-version "3.1"
- "ebnf2ps.el, v 3.1 <99/12/11 vinicius>
+(defconst ebnf-version "3.6.1"
+ "ebnf2ps.el, v 3.6.1 <2001/09/24 vinicius>
Vinicius's last change version. When reporting bugs, please also
report the version of Emacs, if any, that ebnf2ps was running with.
;; 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:
+;; ebnf2ps provides six commands for generating PostScript syntactic chart
+;; images of Emacs buffers:
;;
-;; ebnf-print-buffer
-;; ebnf-print-region
-;; ebnf-spool-buffer
-;; ebnf-spool-region
-;; ebnf-eps-buffer
-;; ebnf-eps-region
+;; ebnf-print-buffer
+;; ebnf-print-region
+;; ebnf-spool-buffer
+;; ebnf-spool-region
+;; 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:
;;
-;; buffer - Print the entire buffer.
+;; buffer - Print the entire buffer.
;;
-;; region - Print just the current region.
+;; 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
;; | "{" body [ "||" body ] "}" ;; zero-or-more
;; .
;;
-;; non_terminal = "[A-Za-z\\240-\\377][!#%&'*-,0-:<>@-Z\\^-z~\\240-\\377]*".
+;; non_terminal = "[!#%&'*-,0-:<>@-Z\\\\^-z~\\240-\\377]+".
;;
;; terminal = "\\([^\"\\]\\|\\\\[ -~\\240-\\377]\\)+".
;;
;; 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 `.').
;; 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
;;
;; ;[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.
;; ;<
;;
;; `ebnf-setup' returns the current setup.
;;
-;; `ebnf-syntax-buffer' does a syntatic analysis of your EBNF in the current
+;; `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-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-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-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.
;;
;;
;; `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:
;;
;; 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...
;;
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; 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))
-
-(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))))
+(and (string< ps-print-version "5.2.3")
+ (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defgroup ebnf2ps nil
- "Translate an EBNF to a syntatic chart on PostScript"
+ "Translate an EBNF to a syntactic chart on PostScript"
:prefix "ebnf-"
:group 'wp
:group 'postscript)
:group 'ebnf2ps)
-(defgroup ebnf-syntatic nil
- "Syntatic customization"
+(defgroup ebnf-syntactic nil
+ "Syntactic customization"
:prefix "ebnf-"
- :tag "Syntatic"
+ :tag "Syntactic"
:group 'ebnf2ps)
(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")
:group 'ebnf-shape)
Any other value is treated as `ebnf'."
:type '(radio :tag "Syntax"
(const ebnf) (const iso-ebnf) (const yacc))
- :group 'ebnf-syntatic)
+ :group 'ebnf-syntactic)
(defcustom ebnf-lex-comment-char ?\;
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
- :group 'ebnf-syntatic)
+ :group 'ebnf-syntactic)
(defcustom ebnf-lex-eop-char ?.
It's used only when `ebnf-syntax' is `ebnf'."
:type 'character
- :group 'ebnf-syntatic)
+ :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)
+ :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)
+ :group 'ebnf-syntactic)
(defcustom ebnf-iso-alternative-p nil
} ==> :)
; ==> ."
:type 'boolean
- :group 'ebnf-syntatic)
+ :group 'ebnf-syntactic)
(defcustom ebnf-iso-normalize-p nil
It's only used when `ebnf-syntax' is `iso-ebnf'."
:type 'boolean
- :group 'ebnf-syntatic)
+ :group 'ebnf-syntactic)
(defcustom ebnf-eps-prefix "ebnf--"
It's only used when `ebnf-syntax' is `yacc'."
:type 'boolean
- :group 'ebnf-syntatic)
+ :group 'ebnf-syntactic)
(defcustom ebnf-ignore-empty-rule nil
(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:
;;;###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)
;;;###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."
;;;###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:
;;;###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
"
+;;; ebnf2ps.el version %s
+
\(setq ebnf-special-font %s
ebnf-special-shape %s
ebnf-special-shadow %S
ebnf-yac-ignore-error-recovery %S
ebnf-ignore-empty-rule %S
ebnf-optimize %S)
+
+;;; ebnf2ps.el - end of settings
"
+ ebnf-version
(ps-print-quote ebnf-special-font)
(ps-print-quote ebnf-special-shape)
ebnf-special-shadow
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.
+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.
;; 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)
/#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)
(defvar ebnf-tree nil)
(defvar ebnf-direction "R")
-(defvar ebnf-total 0)
-(defvar ebnf-nprod 0)
(defun ebnf-generate-postscript (from to)
;; Internal functions
+;; 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)
(gen-func
nil)
(t
- (message "EBNF syntatic analysis: NO ERRORS.")))))
+ (message "EBNF syntactic analysis: NO ERRORS.")))))
(defun ebnf-parse-and-sort (start)
(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")
(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")))))
"\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%%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
- (let ((fonts (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"
+ (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
(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
;; [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)
(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 "Illegal %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)
;; ( 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)
"Eliminate empty rules.")
(autoload 'ebnf-optimize "ebnf-otz"
- "Syntatic chart optimizer.")
+ "Syntactic chart optimizer.")
(autoload 'ebnf-otz-initialize "ebnf-otz"
"Initialize optimizer.")
(provide 'ebnf2ps)
-
+;;; arch-tag: 148bc8af-5398-468b-b922-eeb7afef3e4f
;;; ebnf2ps.el ends here
HCoop / bpt / emacs.git / blobdiff