site-lisp/a2ps-print.el

   1 ;;a2ps-print.el: Postscript printing hook for a2ps.
   2 ;;This file is available at ftp://ftp.cppsig.org/pub/tools/emacs/a2ps-print.el
   3 ;;This requires a2ps to be installed in your PATH
   4 ;;a2ps is available at ftp://ftp.enst.fr/pub/unix/a2ps/ and others
   5
   6 ;; Keywords: languages, faces, a2ps
   7 ;;Modified for enscript from lpr.el by Jim Robinson robinson@wdg.mot.com
   8 ;;Modified for a2ps by phanes@icon.com and docs by bingalls@panix.com
   9 ;;Tested on a2ps v4.10 on emacs & xemacs 20.2 on solaris
  10
  11 ;;; This file is part of a2ps.
  12 ;;;
  13 ;;; This program is free software; you can redistribute it and/or modify
  14 ;;; it under the terms of the GNU General Public License as published by
  15 ;;; the Free Software Foundation; either version 2, or (at your option)
  16 ;;; any later version.
  17 ;;;
  18 ;;; This program is distributed in the hope that it will be useful,
  19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;;; GNU General Public License for more details.
  22 ;;;
  23 ;;; You should have received a copy of the GNU General Public License
  24 ;;; along with this program; see the file COPYING.  If not, write to
  25 ;;; the Free Software Foundation, 59 Temple Place - Suite 330,
  26 ;;; Boston, MA 02111-1307, USA.
  27 ;;;
  28
  29 ;; This file is (not yet) part of GNU Emacs.
  30 ;; $Id: a2ps-print.el,v 1.01 1998/06/19 19:15:00 ingalls Exp $
  31
  32 ;;Put the following into your .emacs:
  33 ;(load "a2ps-print")
  34 ;(global-set-key 'f22 'a2ps-buffer)                     ;f22 is Print Screen
  35 ;(global-set-key '(shift f22) 'a2ps-region-1)           ;print selected text
  36 ;(add-menu-button '("File") ["a2ps-print" a2ps-buffer "--"]) ;on file menu
  37                 ;;Someday I'll get menu to show PrtScr instead of f22...
  38
  39 ;you can pass up to 4 command line switches to a2ps.
  40 ;Here's a recommended sample for your .emacs:
  41 ;(setq a2ps-switches `("-C" "--line-numbers=1"))
  42
  43 (defvar a2ps-switches nil
  44 ;You can replace nil above with up to 4 hard coded switches:
  45 ;`("-C" "--line-numbers=1")
  46   "*List of strings to pass as extra switch args to a2ps when it is invo\
  47 ked.")
  48
  49 (defvar a2ps-command "a2ps"
  50   "Shell command for printing a file")
  51
  52 (defun a2ps-buffer (argp)
  53   "Print buffer contents as with Unix command `a2ps'.
  54 `a2ps-switches' is a list of extra switches (strings) to pass to a2ps."
  55   (interactive "P")
  56   (a2ps-region (point-min) (point-max) argp))
  57
  58 (defun a2ps-region (start end argp)
  59   "Print region contents as with Unix command `a2ps'.
  60 `a2ps-switches' is a list of extra switches (strings) to pass to a2ps."
  61   (interactive "r\nP")
  62   (let ((switches a2ps-switches)
  63         (lpr-command a2ps-command))
  64     (if argp
  65         (setq switches (append switches (list (read-string "switches: ")))))
  66     (a2ps-region-1 start end switches)))
  67
  68 (defun a2ps-region-1 (start end switches)
  69   (let (
  70         (name (buffer-name))
  71         (filetype (substring (buffer-name)
  72                              (string-match "[^.]*$" (buffer-name))))
  73         (width tab-width))
  74 ; this line doesn't work if switches actually contains anything
  75 ;    (message (concat "Sending '" name "' to " lpr-command " switches: "
  76 ;    switches " filetype: " filetype))
  77     (save-excursion
  78       (message "Spooling...")
  79       (if (/= tab-width 8)
  80           (let ((oldbuf (current-buffer)))
  81             (set-buffer (get-buffer-create " *spool temp*"))
  82             (widen) (erase-buffer)
  83             (insert-buffer-substring oldbuf)
  84             (setq tab-width width)
  85             (untabify (point-min) (point-max))
  86             (setq start (point-min) end (point-max))))
  87       (apply 'call-process-region
  88              (nconc (list start end lpr-command
  89                           nil nil nil
  90 ;above can be replaced with this debug line:
  91 ;                        nil '(nil "/tmp/EEE") nil
  92 ;                         (concat "--header=" name)
  93                           (concat "--center-title=" name)
  94                           (concat "--footer=" (concat name " Emacs buffer"))
  95                           (concat "--pretty-print=" filetype)
  96 ;Uncommenting the following gives a print preview (only):
  97 ;                         (concat "--output=/tmp/foo.ps")
  98                           )
  99                     switches))
 100       (message "Spooling...done")
 101       )))
 102