home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / packages / format.shar / format.el
Encoding:
Text File  |  1990-07-22  |  7.0 KB  |  223 lines
  1. ;; format.el
  2. ;; Copyright 1989 Ronald Florence (ron@mlfarm)
  3.  
  4. (defvar roff-macro "-mm"
  5. "*Default macro package to use with troff and nroff.")
  6.  
  7. (defvar troff-options "-rN2"
  8. "*Default options to use with troff.")
  9.  
  10. (defvar nroff-options "-rN2 -rO9"
  11. "*Default options to use with nroff.")
  12.  
  13. (setq troff-format-string "\(troff -t %s %s %s 2>&1 \) | lp -ot -n%d")
  14. (setq nroff-format-string "nroff -Thp %s %s %s | lp -n%d")
  15. (setq pr-format-string "pr -h %s %s | lp -n%d")
  16.  
  17. (if (not nroff-mode-map)
  18.     (error "Nroff-mode is not loaded.")
  19.   (progn
  20.     (define-key nroff-mode-map "\C-c\C-n" 'proof-buffer)
  21.     (define-key nroff-mode-map "\C-c\C-t" 'tproof-buffer)
  22.     (define-key nroff-mode-map "\C-c\C-k" 'kill-proof)
  23.     (define-key nroff-mode-map "\C-c\C-i" 'kill-print)))
  24.  
  25. (setq proof-tmp-file nil 
  26.       print-tmp-file nil
  27.       proof-process nil 
  28.       print-process nil
  29.       proof-file nil)
  30.  
  31. (defun nroff-buffer (&optional copies)
  32.   "Print buffer contents after formatting with nroff.
  33. Optional prefix argument specifies number of copies."
  34.   (interactive "p")
  35.   (format-to-printer-region (point-min) (point-max) "nroff" copies))
  36.  
  37. (defun nroff-region (start end &optional copies)
  38.   "Print region contents after formatting with nroff.
  39. Optional prefix argument specifies number of copies."
  40.   (interactive "r\np")
  41.   (format-to-printer-region start end "nroff" copies))
  42.  
  43. (defun troff-buffer (&optional copies)
  44.   "Typeset buffer after formatting with troff.
  45. Optional prefix argument specifies number of copies."
  46.   (interactive "p")
  47.   (format-to-printer-region (point-min) (point-max) "troff" copies))
  48.  
  49. (defun troff-region (start end &optional copies)
  50.   "Typeset region contents after formatting with troff.
  51. Optional prefix argument specifies number of copies."
  52.   (interactive "r\np")
  53.   (format-to-printer-region start end "troff" copies))
  54.  
  55. (defun pr-buffer (&optional copies)
  56.   "Print buffer contents after formatting with pr.
  57. Optional prefix argument specifies number of copies."
  58.   (interactive "p")
  59.   (format-to-printer-region (point-min) (point-max) "pr" copies))
  60.  
  61. (defun pr-region (start end &optional copies)
  62.   "Print region contents after formatting with pr.
  63. Optional prefix argument specifies number of copies."
  64.   (interactive "r\np")
  65.   (format-to-printer-region start end "pr" copies))
  66.  
  67. (defun proof-region (start end)
  68.   "Proof region using nroff."
  69.   (interactive "r")
  70.   (proof-region-to-buffer start end "nroff"))
  71.  
  72. (defun proof-buffer ()
  73.   "Proof buffer using nroff."
  74.   (interactive)
  75.   (proof-region-to-buffer (point-min) (point-max) "nroff"))
  76.  
  77. (defun tproof-region (start end)
  78.   "Rough proof region using troff."
  79.   (interactive "r")
  80.   (proof-region-to-buffer start end "troff"))
  81.  
  82. (defun tproof-buffer ()
  83.   "Rough proof buffer using troff."
  84.   (interactive)
  85.   (proof-region-to-buffer (point-min) (point-max) "troff"))
  86.  
  87. (defun kill-print ()
  88.   "Kill format-to-printer process."
  89.   (interactive)
  90.   (if print-process
  91.       (interrupt-process print-process)))
  92.  
  93. (defun kill-proof ()
  94.   "Kill proof process."
  95.   (interactive)
  96.   (if proof-process
  97.       (interrupt-process proof-process)))
  98.  
  99. (defun format-to-printer-region (start end formatter &optional copies)
  100.   (if print-process
  101.       (if (or 
  102.        (not (eq (process-status print-process) 'run))
  103.        (yes-or-no-p "A format-to-printer process is running; kill it? "))
  104.       (condition-case ()
  105.           (let ((print-proc print-process))
  106.         (interrupt-process print-proc)
  107.         (sit-for 1)
  108.         (delete-process print-proc))
  109.         (error nil))
  110.     (error "One format-to-printer process at a time.")))
  111.   (save-excursion
  112.     (setq printer-output-buffer " *printer output*")
  113.     (get-buffer-create printer-output-buffer)
  114.     (set-buffer printer-output-buffer)
  115.     (erase-buffer))
  116.   (if (null copies) (setq copies 1))
  117.   (setq print-tmp-file (concat "/tmp/" (make-temp-name "#pr#")))
  118.   (write-region start end print-tmp-file nil 'nomsg)
  119.   (setq print-command 
  120.     (cond ((string= formatter "troff")
  121.            (format troff-format-string
  122.                troff-options roff-macro
  123.                print-tmp-file copies))
  124.           ((string= formatter "nroff") 
  125.            (format nroff-format-string
  126.                nroff-options roff-macro
  127.                print-tmp-file copies))
  128.           ((string= formatter "pr")
  129.            (format pr-format-string
  130.                (buffer-name) print-tmp-file copies))))
  131.   (setq print-process
  132.     (start-process formatter printer-output-buffer "sh" "-c"
  133.                print-command))
  134.   (set-process-sentinel print-process 'print-sentinel))
  135.  
  136. (defun print-sentinel (process msg)
  137.   (delete-file print-tmp-file)
  138.   (save-excursion
  139.     (set-buffer (process-buffer process))
  140.     (if (> (buffer-size) 0)
  141.     (progn
  142.       (goto-char (point-min))
  143.       (end-of-line)
  144.       (message "%s: %s" (process-name process) 
  145.            (buffer-substring 1 (point))))
  146.       (message "%s: killed" (process-name process))))
  147.   (setq print-process nil)
  148.   (kill-buffer (process-buffer process)))
  149.  
  150. (defun proof-region-to-buffer (start end formatter)
  151.   (if proof-process
  152.       (if (or (not (eq (process-status proof-process) 'run))
  153.           (yes-or-no-p "A proof process is running; kill it? "))
  154.       (condition-case ()
  155.           (let ((proof-proc proof-process))
  156.         (interrupt-process proof-proc)
  157.         (sit-for 1)
  158.         (delete-process proof-proc))
  159.         (error nil))
  160.     (error "One proof process at a time.")))
  161.   (setq proof-tmp-file (concat "/tmp/" (make-temp-name "#p#")))
  162.   (save-excursion
  163.     (setq proof-file (buffer-name))
  164.     (setq proof-buffer "*proof*")
  165.     (get-buffer-create proof-buffer)
  166.     (set-buffer proof-buffer)
  167.     (erase-buffer))
  168.   (write-region start end proof-tmp-file nil 'nomsg)
  169.   (setq proof-command 
  170.     (if (string= formatter "troff") 
  171.         (format "troff -a %s %s %s" troff-options
  172.             roff-macro proof-tmp-file)
  173.       (format "nroff %s %s %s" nroff-options roff-macro proof-tmp-file)))
  174.  (setq proof-process
  175.        (start-process formatter proof-buffer "sh" "-c" proof-command))
  176.  (set-process-sentinel proof-process 'proof-sentinel))
  177.  
  178. (defun proof-sentinel (process msg)
  179.   (delete-file proof-tmp-file)
  180.   (if (string-match "^exited" msg)
  181.       (message "%s: killed" (process-name process))
  182.     (progn
  183.       (set-buffer (process-buffer process))
  184.       (text-mode)
  185.       (setq mode-name (format "%s:%s"
  186.                   (process-name proof-process) proof-file))
  187.       (if (string= (process-name process) "nroff")
  188.       (zap-nroff-crap))
  189.       (goto-char (point-min))
  190.       (display-buffer (process-buffer process))))
  191.   (setq proof-process nil))
  192.     
  193. (defun zap-nroff-crap ()
  194.   (goto-char (point-min))
  195.   (while (search-forward "\b" nil t)
  196.     (let* ((preceding (char-after (- (point) 2)))
  197.        (following (following-char)))
  198.               ;; x\bx
  199.       (cond ((= preceding following)    
  200.          (delete-char -2))
  201.         ;; _\b
  202.         ((= preceding ?\_)        
  203.          (delete-char -2))
  204.         ;; \b_
  205.         ((= following ?\_)        
  206.          (delete-region (1- (point)) (1+ (point)))))))
  207.   ;; expand ^G lines
  208.   (goto-char (point-min))
  209.   (while (search-forward "\C-g" nil t)    
  210.     (delete-char -2)
  211.     (while (not (eolp))
  212.       (insert " ")
  213.       (forward-char 1)))
  214.   ;; zap Esc-8 & Esc-9 vertical motions
  215.   (goto-char (point-min))
  216.   (while (search-forward "\e" nil t)
  217.     (if (or (= (following-char) ?8) (= (following-char) ?9))
  218.         (delete-region (1+ (point)) (1- (point))))))
  219.  
  220.  
  221.  
  222.  
  223.