diff options
| -rw-r--r-- | lisp/progmodes/ebnf2ps.el | 96 |
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 | |||
| 30 | report the version of Emacs, if any, that ebnf2ps was running with. | 30 | report the version of Emacs, if any, that ebnf2ps was running with. |
| 31 | 31 | ||
| 32 | Please send all bug fixes and enhancements to | 32 | Please 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." |
| 2051 | special." | ||
| 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 | ||
| 2255 | When called with a numeric prefix argument (C-u), prompts the user for | 2254 | When called with a numeric prefix argument (\\[universal-argument]), prompts the user for |
| 2256 | the name of a file to save the PostScript image in, instead of sending | 2255 | the name of a file to save the PostScript image in, instead of sending |
| 2257 | it to the printer. | 2256 | it 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. |
| 2615 | Used 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 |