[comp.emacs] format.el

ron@mlfarm.com (Ronald Florence) (02/18/91)

This is a revised version of code I posted some time ago, modified for
use with groff and a postscript printer.  The code allows asychronous
formatting of the contents of a buffer, with output to the print
spooler or to another buffer for proofing.  There are a wide variety
of possible commands, including:

M-x te-buffer     "Typeset buffer after formatting with pic, tbl, eqn,
                   and troff.  Optional prefix argument specifies 
		   number of copies."

M-x troff-region  "Typeset region contents after formatting with troff.
	           Optional prefix argument specifies number of copies."

M-x proof-buffer  "Proof buffer using nroff."

M-x tproof-buffer "Rough (ascii) proof buffer using troff."

M-x pr-buffer     "Print buffer contents in portrait mode.  Optional 
                   prefix argument specifies number of copies."

M-x pr2-region    "Print region contents in two columns, landscape mode.
		   Optional prefix argument specifies number of copies."

and other permutations.  A few commonly used commands are bound to
key-combinations.  Customize to suit your printer, print spooler,
formatter, macro sets, and formatting options by changing the
roff-macro, roff-options, and the formatting strings.  I use the
following code in my ~/.emacs to load format.el:

   (setq nroff-mode-hook '(lambda () 
		            (abbrev-mode 1) 
			    (auto-fill-mode 1)
			    (require 'format)
			    (setq mode-name "Troff")))

I'm very much an amateur at elisp, and would welcome suggestions or
comments on format.el.  I'd be delighted if someone finds it as useful
as it has been here.
--

Ronald Florence			ron@mlfarm.com



-------------------------[format.el]---------------------------
;; format.el
;; Copyright 1991 Ronald Florence (ron@mlfarm.com)
;;
;; modified for groff & postscript, 5 Feb 91

(provide 'format)

(defvar roff-macro "-mm"
"*Default macro package to use with troff and nroff.")

(defvar roff-options "-rN2"
"*Default options to use with troff and nroff.")

(setq troff-format-string "gtroff -mps %s %s %s | grops -c%d | lp -op"
      te-format-string "gpic -x -p %s | gtbl - | geqn -D -- /usr/local/lib/font/devps/eqnchar - | gtroff -mps %s %s - | grops -c%d | lp -op"
      tproof-string "gtroff -a -Tps %s %s -mps %s"
      te-proof-string "gpic -x -p %s | gtbl - | geqn -D -- /usr/local/lib/font/devps/eqnchar - | gtroff -a -Tps %s %s -mps"
      proof-string "gtroff -Tascii %s %s -mtty %s | grotty -bu"
      pr-format-string "lp -n%d %s"
      pr2-format-string "lp -n%d -ot %s")

(if (not nroff-mode-map)
    (error "Nroff-mode is not loaded.")
  (progn
    (define-key nroff-mode-map "\C-c\C-n" 'proof-buffer)
    (define-key nroff-mode-map "\C-c\C-t" 'tproof-buffer)
    (define-key nroff-mode-map "\C-c\C-k" 'kill-proof)
    (define-key nroff-mode-map "\C-c\C-i" 'kill-print)))

(setq proof-tmp-file nil 
      print-tmp-file nil
      proof-process nil 
      print-process nil
      proof-file nil)

(defun te-buffer (&optional copies)
  "Typeset buffer after formatting with pic, tbl, eqn, and troff.
Optional prefix argument specifies number of copies."
  (interactive "p")
  (format-to-printer-region (point-min) (point-max) "te" copies))

(defun te-region (start end &optional copies)
  "Typeset region after formatting with pic, tbl, eqn, and troff.
Optional prefix argument specifies number of copies."
  (interactive "r\np")
  (format-to-printer-region start end "te" copies))

(defun troff-buffer (&optional copies)
  "Typeset buffer after formatting with troff.
Optional prefix argument specifies number of copies."
  (interactive "p")
  (format-to-printer-region (point-min) (point-max) "troff" copies))

(defun troff-region (start end &optional copies)
  "Typeset region contents after formatting with troff.
Optional prefix argument specifies number of copies."
  (interactive "r\np")
  (format-to-printer-region start end "troff" copies))

(defun pr-buffer (&optional copies)
  "Print buffer contents in portrait mode.
Optional prefix argument specifies number of copies."
  (interactive "p")
  (format-to-printer-region (point-min) (point-max) "pr" copies))

(defun pr-region (start end &optional copies)
  "Print region contents in portrait mode.
Optional prefix argument specifies number of copies."
  (interactive "r\np")
  (format-to-printer-region start end "pr" copies))

(defun pr2-buffer (&optional copies)
  "Print buffer contents in two columns, landscape mode. 
Optional prefix argument specifies number of copies."
  (interactive "p")
  (format-to-printer-region (point-min) (point-max) "pr2" copies))

(defun pr2-region (start end &optional copies)
  "Print region contents in two columns, landscape mode.
Optional prefix argument specifies number of copies."
  (interactive "r\np")
  (format-to-printer-region start end "pr2" copies))

(defun proof-region (start end)
  "Proof region using nroff."
  (interactive "r")
  (proof-region-to-buffer start end "nroff"))

(defun proof-buffer ()
  "Proof buffer using nroff."
  (interactive)
  (proof-region-to-buffer (point-min) (point-max) "nroff"))

(defun tproof-region (start end)
  "Rough (ascii) proof region using troff."
  (interactive "r")
  (proof-region-to-buffer start end "troff"))

(defun tproof-buffer ()
  "Rough (ascii) proof buffer using troff."
  (interactive)
  (proof-region-to-buffer (point-min) (point-max) "troff"))

(defun te-proof-region (start end)
  "Rough (ascii) proof region using troff, pic, eqn, tbl."
  (interactive "r")
  (proof-region-to-buffer start end "te-proof"))

(defun te-proof-buffer ()
  "Rough (ascii) proof buffer using troff, pic, eqn, tbl."
  (interactive)
  (proof-region-to-buffer (point-min) (point-max) "te-proof"))

(defun kill-print ()
  "Kill format-to-printer process."
  (interactive)
  (if print-process
      (interrupt-process print-process)))

(defun kill-proof ()
  "Kill proof process."
  (interactive)
  (if proof-process
      (interrupt-process proof-process)))

(defun format-to-printer-region (start end formatter &optional copies)
  (if print-process
      (if (or 
	   (not (eq (process-status print-process) 'run))
	   (yes-or-no-p "A format-to-printer process is running; kill it? "))
	  (condition-case ()
	      (let ((print-proc print-process))
		(interrupt-process print-proc)
		(sit-for 1)
		(delete-process print-proc))
	    (error nil))
	(error "One format-to-printer process at a time.")))
  (save-excursion
    (setq printer-output-buffer " *printer output*")
    (get-buffer-create printer-output-buffer)
    (set-buffer printer-output-buffer)
    (erase-buffer))
  (if (null copies) (setq copies 1))
  (setq print-tmp-file (concat "/tmp/" (make-temp-name "#pr#")))
  (write-region start end print-tmp-file nil 'nomsg)
  (setq print-command 
	(cond ((string= formatter "troff")
	       (format troff-format-string
		       roff-options roff-macro
		       print-tmp-file copies))
	      ((string= formatter "te")
	       (format te-format-string
		       print-tmp-file roff-options roff-macro copies))
	      ((string= formatter "pr")
	       (format pr-format-string
		       copies print-tmp-file))
	      ((string= formatter "pr2")
	       (format pr2-format-string
		       copies print-tmp-file))))
  (setq print-process
	(start-process formatter printer-output-buffer "sh" "-c"
		       print-command))
  (set-process-sentinel print-process 'print-sentinel))

(defun print-sentinel (process msg)
  (delete-file print-tmp-file)
  (save-excursion
    (set-buffer (process-buffer process))
    (if (> (buffer-size) 0)
	(progn
	  (goto-char (point-min))
	  (end-of-line)
	  (message "%s: %s" (process-name process) 
		   (buffer-substring 1 (point))))
      (message "%s: killed" (process-name process))))
  (setq print-process nil)
  (kill-buffer (process-buffer process)))

(defun proof-region-to-buffer (start end formatter)
  (if proof-process
      (if (or (not (eq (process-status proof-process) 'run))
	      (yes-or-no-p "A proof process is running; kill it? "))
	  (condition-case ()
	      (let ((proof-proc proof-process))
		(interrupt-process proof-proc)
		(sit-for 1)
		(delete-process proof-proc))
	    (error nil))
	(error "One proof process at a time.")))
  (setq proof-tmp-file (concat "/tmp/" (make-temp-name "#p#")))
  (save-excursion
    (setq proof-file (buffer-name))
    (setq proof-buffer "*proof*")
    (get-buffer-create proof-buffer)
    (set-buffer proof-buffer)
    (erase-buffer))
  (write-region start end proof-tmp-file nil 'nomsg)
  (setq proof-command 
	(cond ((string= formatter "troff") 
	       (format tproof-string roff-options roff-macro
		       proof-tmp-file ))
	      ((string= formatter "te-proof")
	       (format te-proof-string proof-tmp-file roff-options
		       roff-macro ))
	      ((string= formatter "nroff")
	       (format proof-string roff-options roff-macro 
		       proof-tmp-file ))))
  (setq proof-process
	(start-process formatter proof-buffer "sh" "-c" proof-command))
  (set-process-sentinel proof-process 'proof-sentinel))


(defun proof-sentinel (process msg)
  (delete-file proof-tmp-file)
  (if (string-match "^exited" msg)
      (message "%s: killed" (process-name process))
    (progn
      (set-buffer (process-buffer process))
      (text-mode)
      (setq mode-name (format "%s:%s"
			      (process-name proof-process) proof-file))
;      (if (string= (process-name process) "nroff")
;	  (zap-nroff-crap))
      (goto-char (point-min))
      (display-buffer (process-buffer process))))
  (setq proof-process nil))
	
(defun zap-nroff-crap ()
  (goto-char (point-min))
  (while (search-forward "\b" nil t)
    (let* ((preceding (char-after (- (point) 2)))
	   (following (following-char)))
      	    ;; x\bx
      (cond ((= preceding following)	
	     (delete-char -2))
	    ;; _\b
	    ((= preceding ?\_)		
	     (delete-char -2))
	    ;; \b_
	    ((= following ?\_)		
	     (delete-region (1- (point)) (1+ (point)))))))
  ;; expand ^G lines
  (goto-char (point-min))
  (while (search-forward "\C-g" nil t)	
    (delete-char -2)
    (while (not (eolp))
      (insert " ")
      (forward-char 1)))
  ;; zap Esc-8 & Esc-9 vertical motions
  (goto-char (point-min))
  (while (search-forward "\e" nil t)
    (if (or (= (following-char) ?8) (= (following-char) ?9))
	    (delete-region (1+ (point)) (1- (point))))))
----------------------------[eof]-----------------------------
--

Ronald Florence			ron@mlfarm.com