aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/progmodes/ebnf2ps.el96
1 files changed, 46 insertions, 50 deletions
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 313c36b6c5a..5c9a106d41a 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -1,4 +1,4 @@
1;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript 1;;; ebnf2ps.el --- translate an EBNF to a syntactic chart on PostScript -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1999-2017 Free Software Foundation, Inc. 3;; Copyright (C) 1999-2017 Free Software Foundation, Inc.
4 4
@@ -30,8 +30,7 @@ Vinicius's last change version. When reporting bugs, please also
30report the version of Emacs, if any, that ebnf2ps was running with. 30report the version of Emacs, if any, that ebnf2ps was running with.
31 31
32Please send all bug fixes and enhancements to 32Please send all bug fixes and enhancements to
33 Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>. 33 Vinicius Jose Latorre <viniciusjl.gnu@gmail.com>.")
34")
35 34
36 35
37;;; Commentary: 36;;; Commentary:
@@ -1154,6 +1153,7 @@ Please send all bug fixes and enhancements to
1154 1153
1155 1154
1156(require 'ps-print) 1155(require 'ps-print)
1156(eval-when-compile (require 'cl-lib))
1157 1157
1158(and (string< ps-print-version "5.2.3") 1158(and (string< ps-print-version "5.2.3")
1159 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later")) 1159 (error "`ebnf2ps' requires `ps-print' package version 5.2.3 or later"))
@@ -2047,8 +2047,7 @@ It must be a float between 0.0 (top) and 1.0 (bottom)."
2047 2047
2048 2048
2049(defcustom ebnf-default-width 0.6 2049(defcustom ebnf-default-width 0.6
2050 "Specify additional border width over default terminal, non-terminal or 2050 "Additional border width over default terminal, non-terminal or special."
2051special."
2052 :type 'number 2051 :type 'number
2053 :version "20" 2052 :version "20"
2054 :group 'ebnf2ps) 2053 :group 'ebnf2ps)
@@ -2252,7 +2251,7 @@ See also `ebnf-print-buffer'."
2252(defun ebnf-print-buffer (&optional filename) 2251(defun ebnf-print-buffer (&optional filename)
2253 "Generate and print a PostScript syntactic chart image of the buffer. 2252 "Generate and print a PostScript syntactic chart image of the buffer.
2254 2253
2255When called with a numeric prefix argument (C-u), prompts the user for 2254When called with a numeric prefix argument (\\[universal-argument]), prompts the user for
2256the name of a file to save the PostScript image in, instead of sending 2255the name of a file to save the PostScript image in, instead of sending
2257it to the printer. 2256it to the printer.
2258 2257
@@ -2383,6 +2382,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing
2383 (ebnf-log-header "(ebnf-eps-buffer)") 2382 (ebnf-log-header "(ebnf-eps-buffer)")
2384 (ebnf-eps-region (point-min) (point-max))) 2383 (ebnf-eps-region (point-min) (point-max)))
2385 2384
2385(defvar ebnf-eps-executing)
2386 2386
2387;;;###autoload 2387;;;###autoload
2388(defun ebnf-eps-region (from to) 2388(defun ebnf-eps-region (from to)
@@ -2411,7 +2411,7 @@ WARNING: This function does *NOT* ask any confirmation to override existing
2411 2411
2412 2412
2413;;;###autoload 2413;;;###autoload
2414(defalias 'ebnf-despool 'ps-despool) 2414(defalias 'ebnf-despool #'ps-despool)
2415 2415
2416 2416
2417;;;###autoload 2417;;;###autoload
@@ -2611,7 +2611,8 @@ See also `ebnf-syntax-buffer'."
2611 2611
2612 2612
2613(defvar ebnf-stack-style nil 2613(defvar ebnf-stack-style nil
2614 "Used in functions `ebnf-reset-style', `ebnf-push-style' and 2614 "Stack of styles.
2615Used in functions `ebnf-reset-style', `ebnf-push-style' and
2615`ebnf-pop-style'.") 2616`ebnf-pop-style'.")
2616 2617
2617 2618
@@ -3999,7 +4000,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
3999% === end EBNF engine 4000% === end EBNF engine
4000 4001
4001" 4002"
4002 "EBNF PostScript prologue") 4003 "EBNF PostScript prologue.")
4003 4004
4004 4005
4005(defconst ebnf-eps-prologue 4006(defconst ebnf-eps-prologue
@@ -4276,7 +4277,7 @@ See documentation for `ebnf-terminal-shape', `ebnf-non-terminal-shape' and
4276}bind def 4277}bind def
4277 4278
4278" 4279"
4279 "EBNF EPS prologue") 4280 "EBNF EPS prologue.")
4280 4281
4281 4282
4282(defconst ebnf-eps-begin 4283(defconst ebnf-eps-begin
@@ -4292,14 +4293,14 @@ end
4292 4293
4293%%EndProlog 4294%%EndProlog
4294" 4295"
4295 "EBNF EPS begin") 4296 "EBNF EPS begin.")
4296 4297
4297 4298
4298(defconst ebnf-eps-end 4299(defconst ebnf-eps-end
4299 "#ebnf2ps#end 4300 "#ebnf2ps#end
4300%%EOF 4301%%EOF
4301" 4302"
4302 "EBNF EPS end") 4303 "EBNF EPS end.")
4303 4304
4304 4305
4305;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4306;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4329,14 +4330,16 @@ end
4329 4330
4330;; hacked fom `ps-output-string-prim' (ps-print.el) 4331;; hacked fom `ps-output-string-prim' (ps-print.el)
4331(defun ebnf-eps-string (string) 4332(defun ebnf-eps-string (string)
4332 (let* ((str (string-as-unibyte string)) 4333 (let* ((str string)
4333 (len (length str)) 4334 (len (length str))
4334 (index 0) 4335 (index 0)
4335 (new "(") ; insert start-string delimiter 4336 (new "(") ; insert start-string delimiter
4336 start special) 4337 start special)
4337 ;; Find and quote special characters as necessary for PS 4338 ;; Find and quote special characters as necessary for PS
4338 ;; This skips everything except control chars, non-ASCII chars, (, ) and \. 4339 ;; This skips everything except control chars, non-ASCII chars,
4339 (while (setq start (string-match "[^]-~ -'*-[]" str index)) 4340 ;; (, ), \, and DEL.
4341 (while (setq start (string-match "[[:cntrl:][:nonascii:]\177()\\]"
4342 str index))
4340 (setq special (aref str start) 4343 (setq special (aref str start)
4341 new (concat new 4344 new (concat new
4342 (substring str index start) 4345 (substring str index start)
@@ -4536,26 +4539,25 @@ end
4536;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4539;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4537;; PostScript generation 4540;; PostScript generation
4538 4541
4542(defvar ebnf-tree)
4539 4543
4540(defun ebnf-generate-eps (ebnf-tree) 4544(defun ebnf-generate-eps (tree)
4541 (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) 4545 (let* ((ebnf-tree tree)
4546 (ps-color-p (and ebnf-color-p (ps-color-device)))
4542 (ps-print-color-scale (if ps-color-p 4547 (ps-print-color-scale (if ps-color-p
4543 (float (car (ps-color-values "white"))) 4548 (float (car (ps-color-values "white")))
4544 1.0)) 4549 1.0))
4545 (ebnf-total (length ebnf-tree)) 4550 (ebnf-total (length ebnf-tree))
4546 (ebnf-nprod 0) 4551 (ebnf-nprod 0)
4547 (old-ps-output (symbol-function 'ps-output))
4548 (old-ps-output-string (symbol-function 'ps-output-string))
4549 (eps-buffer (get-buffer-create ebnf-eps-buffer-name)) 4552 (eps-buffer (get-buffer-create ebnf-eps-buffer-name))
4550 ebnf-debug-ps error-msg horizontal 4553 ebnf-debug-ps horizontal
4551 prod prod-name prod-width prod-height prod-list file-list) 4554 prod prod-name prod-width prod-height prod-list file-list)
4552 ;; redefines `ps-output' and `ps-output-string'
4553 (defalias 'ps-output 'ebnf-eps-output)
4554 (defalias 'ps-output-string 'ps-output-string-prim)
4555 ;; generate EPS file 4555 ;; generate EPS file
4556 (save-excursion 4556 (unwind-protect
4557 (condition-case data 4557 ;; redefines `ps-output' and `ps-output-string'
4558 (progn 4558 (cl-letf (((symbol-function 'ps-output) #'ebnf-eps-output)
4559 ((symbol-function 'ps-output-string) #'ps-output-string-prim))
4560 (save-excursion
4559 (while ebnf-tree 4561 (while ebnf-tree
4560 (setq prod (car ebnf-tree) 4562 (setq prod (car ebnf-tree)
4561 prod-name (ebnf-node-name prod) 4563 prod-name (ebnf-node-name prod)
@@ -4573,8 +4575,9 @@ end
4573 (if (setq prod-list (cdr (assoc prod-name 4575 (if (setq prod-list (cdr (assoc prod-name
4574 ebnf-eps-production-list))) 4576 ebnf-eps-production-list)))
4575 ;; insert EPS buffer in all buffer associated with production 4577 ;; insert EPS buffer in all buffer associated with production
4576 (ebnf-eps-production-list prod-list 'file-list horizontal 4578 (ebnf-eps-production-list
4577 prod-width prod-height eps-buffer) 4579 prod-list (gv-ref file-list) horizontal
4580 prod-width prod-height eps-buffer)
4578 ;; write EPS file for production 4581 ;; write EPS file for production
4579 (ebnf-eps-finish-and-write eps-buffer 4582 (ebnf-eps-finish-and-write eps-buffer
4580 (ebnf-eps-filename prod-name))) 4583 (ebnf-eps-filename prod-name)))
@@ -4584,17 +4587,10 @@ end
4584 (setq ebnf-tree (cdr ebnf-tree))) 4587 (setq ebnf-tree (cdr ebnf-tree)))
4585 ;; write and kill temporary buffers 4588 ;; write and kill temporary buffers
4586 (ebnf-eps-write-kill-temp file-list t) 4589 (ebnf-eps-write-kill-temp file-list t)
4587 (setq file-list nil)) 4590 (setq file-list nil)))
4588 ;; handler 4591 ;; kill temporary buffers
4589 ((quit error) 4592 (kill-buffer eps-buffer)
4590 (setq error-msg (error-message-string data))))) 4593 (ebnf-eps-write-kill-temp file-list nil))
4591 ;; restore `ps-output' and `ps-output-string'
4592 (defalias 'ps-output old-ps-output)
4593 (defalias 'ps-output-string old-ps-output-string)
4594 ;; kill temporary buffers
4595 (kill-buffer eps-buffer)
4596 (ebnf-eps-write-kill-temp file-list nil)
4597 (and error-msg (error error-msg))
4598 (message " "))) 4594 (message " ")))
4599 4595
4600 4596
@@ -4610,10 +4606,10 @@ end
4610 4606
4611 4607
4612;; insert EPS buffer in all buffer associated with production 4608;; insert EPS buffer in all buffer associated with production
4613(defun ebnf-eps-production-list (prod-list file-list-sym horizontal 4609(defun ebnf-eps-production-list (prod-list file-list-ref horizontal
4614 prod-width prod-height eps-buffer) 4610 prod-width prod-height eps-buffer)
4615 (while prod-list 4611 (while prod-list
4616 (add-to-list file-list-sym (car prod-list)) 4612 (cl-pushnew (car prod-list) (gv-deref file-list-ref) :test #'equal)
4617 (with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*")) 4613 (with-current-buffer (get-buffer-create (concat " *" (car prod-list) "*"))
4618 (goto-char (point-max)) 4614 (goto-char (point-max))
4619 (cond 4615 (cond
@@ -4647,8 +4643,9 @@ end
4647 (setq prod-list (cdr prod-list)))) 4643 (setq prod-list (cdr prod-list))))
4648 4644
4649 4645
4650(defun ebnf-generate (ebnf-tree) 4646(defun ebnf-generate (tree)
4651 (let* ((ps-color-p (and ebnf-color-p (ps-color-device))) 4647 (let* ((ebnf-tree tree)
4648 (ps-color-p (and ebnf-color-p (ps-color-device)))
4652 (ps-print-color-scale (if ps-color-p 4649 (ps-print-color-scale (if ps-color-p
4653 (float (car (ps-color-values "white"))) 4650 (float (car (ps-color-values "white")))
4654 1.0)) 4651 1.0))
@@ -4658,14 +4655,13 @@ end
4658 ps-print-begin-page-hook 4655 ps-print-begin-page-hook
4659 ps-print-begin-column-hook) 4656 ps-print-begin-column-hook)
4660 (ps-generate (current-buffer) (point-min) (point-max) 4657 (ps-generate (current-buffer) (point-min) (point-max)
4661 'ebnf-generate-postscript))) 4658 #'ebnf-generate-postscript)))
4662 4659
4663 4660
4664(defvar ebnf-tree nil)
4665(defvar ebnf-direction "R") 4661(defvar ebnf-direction "R")
4666 4662
4667 4663
4668(defun ebnf-generate-postscript (from to) 4664(defun ebnf-generate-postscript (_from _to)
4669 (ebnf-begin-file) 4665 (ebnf-begin-file)
4670 (if ebnf-horizontal-max-height 4666 (if ebnf-horizontal-max-height
4671 (ebnf-generate-with-max-height) 4667 (ebnf-generate-with-max-height)
@@ -5314,9 +5310,9 @@ killed after process termination."
5314 "\n%%DocumentNeededResources: font " 5310 "\n%%DocumentNeededResources: font "
5315 (or ebnf-fonts-required 5311 (or ebnf-fonts-required
5316 (setq ebnf-fonts-required 5312 (setq ebnf-fonts-required
5317 (mapconcat 'identity 5313 (mapconcat #'identity
5318 (ps-remove-duplicates 5314 (ps-remove-duplicates
5319 (mapcar 'ebnf-font-name-select 5315 (mapcar #'ebnf-font-name-select
5320 (list ebnf-production-font 5316 (list ebnf-production-font
5321 ebnf-terminal-font 5317 ebnf-terminal-font
5322 ebnf-non-terminal-font 5318 ebnf-non-terminal-font
@@ -5545,7 +5541,7 @@ killed after process termination."
5545 (ebnf-log "(ebnf-dimensions tree)") 5541 (ebnf-log "(ebnf-dimensions tree)")
5546 (let ((ebnf-total (length tree)) 5542 (let ((ebnf-total (length tree))
5547 (ebnf-nprod 0)) 5543 (ebnf-nprod 0))
5548 (mapc 'ebnf-production-dimension tree)) 5544 (mapc #'ebnf-production-dimension tree))
5549 tree) 5545 tree)
5550 5546
5551 5547
@@ -5925,7 +5921,7 @@ killed after process termination."
5925 )))) 5921 ))))
5926 5922
5927 5923
5928(defun ebnf-justify (node seq seq-width width last-p) 5924(defun ebnf-justify (_node seq seq-width width last-p)
5929 (let ((term (car (if last-p (last seq) seq)))) 5925 (let ((term (car (if last-p (last seq) seq))))
5930 (cond 5926 (cond
5931 ;; adjust empty term 5927 ;; adjust empty term