annotate lisp/lpr.el @ 13814:f683f93b94e9

Initial revision

�     1 ;;; lpr.el --- print Emacs buffer on line printer.
�     2 
�     3 ;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
�     4 
�     5 ;; Maintainer: FSF
�     6 ;; Keywords: unix
�     7 
�     8 ;; This file is part of GNU Emacs.
�     9 
�    10 ;; GNU Emacs is free software; you can redistribute it and/or modify
�    11 ;; it under the terms of the GNU General Public License as published by
�    12 ;; the Free Software Foundation; either version 2, or (at your option)
�    13 ;; any later version.
�    14 
�    15 ;; GNU Emacs is distributed in the hope that it will be useful,
�    16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
�    17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
�    18 ;; GNU General Public License for more details.
�    19 
�    20 ;; You should have received a copy of the GNU General Public License
�    21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
�    22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
�    23 
�    24 ;;; Commentary:
�    25 
�    26 ;; Commands to send the region or a buffer your printer.  Entry points
�    27 ;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
�    28 ;; variables include `lpr-switches' and `lpr-command'.
�    29 
�    30 ;;; Code:
�    31 
�    32 ;;;###autoload
�    33 (defvar lpr-switches nil 
�    34   "*List of strings to pass as extra options for the printer program.
�    35 See `lpr-command'.")
�    36 
�    37 (defvar lpr-add-switches (eq system-type 'berkeley-unix)
�    38   "*Non-nil means construct -T and -J options for the printer program.
�    39 These are made assuming that the program is `lpr';
�    40 if you are using some other incompatible printer program,
�    41 this variable should be nil.")
�    42 
�    43 ;;;###autoload
�    44 (defvar lpr-command
�    45   (if (memq system-type '(usg-unix-v dgux hpux irix))
�    46       "lp" "lpr")
�    47   "*Name of program for printing a file.")
�    48 
�    49 ;; Default is nil, because that enables us to use pr -f
�    50 ;; which is more reliable than pr with no args, which is what lpr -p does.
�    51 (defvar lpr-headers-switches nil
�    52   "*List of strings to use as options for `lpr' to request page headings.
�    53 If nil, we run `lpr-page-header-program' to make page headings
�    54 and print the result.")
�    55 
�    56 (defvar print-region-function nil
�    57   "Function to call to print the region on a printer.
�    58 See definition of `print-region-1' for calling conventions.")
�    59 
�    60 (defvar lpr-page-header-program "pr"
�    61   "*Name of program for adding page headers to a file.")
�    62 
�    63 (defvar lpr-page-header-switches '("-f")
�    64   "*List of strings to use as options for `lpr-page-header-program'.")
�    65 
�    66 ;;;###autoload
�    67 (defun lpr-buffer ()
�    68   "Print buffer contents as with Unix command `lpr'.
�    69 `lpr-switches' is a list of extra switches (strings) to pass to lpr."
�    70   (interactive)
�    71   (print-region-1 (point-min) (point-max) lpr-switches nil))
�    72 
�    73 ;;;###autoload
�    74 (defun print-buffer ()
�    75   "Print buffer contents as with Unix command `lpr -p'.
�    76 `lpr-switches' is a list of extra switches (strings) to pass to lpr."
�    77   (interactive)
�    78   (print-region-1 (point-min) (point-max) lpr-switches t))
�    79 
�    80 ;;;###autoload
�    81 (defun lpr-region (start end)
�    82   "Print region contents as with Unix command `lpr'.
�    83 `lpr-switches' is a list of extra switches (strings) to pass to lpr."
�    84   (interactive "r")
�    85   (print-region-1 start end lpr-switches nil))
�    86 
�    87 ;;;###autoload
�    88 (defun print-region (start end)
�    89   "Print region contents as with Unix command `lpr -p'.
�    90 `lpr-switches' is a list of extra switches (strings) to pass to lpr."
�    91   (interactive "r")
�    92   (print-region-1 start end lpr-switches t))
�    93 
�    94 (defun print-region-1 (start end switches page-headers)
�    95   ;; On some MIPS system, having a space in the job name
�    96   ;; crashes the printer demon.  But using dashes looks ugly
�    97   ;; and it seems to annoying to do for that MIPS system.
�    98   (let ((name (concat (buffer-name) " Emacs buffer"))
�    99 	(title (concat (buffer-name) " Emacs buffer"))
�   100 	(width tab-width)
�   101 	switch-string)
�   102     (save-excursion
�   103       (if page-headers
�   104 	  (if lpr-headers-switches
�   105 	      ;; It is possible to use an lpr option
�   106 	      ;; to get page headers.
�   107 	      (setq switches (append (if (stringp lpr-headers-switches)
�   108 					 (list lpr-headers-switches)
�   109 				        lpr-headers-switches)
�   110 				     switches))))
�   111       (setq switch-string
�   112 	    (if switches (concat " with options "
�   113 				 (mapconcat 'identity switches " "))
�   114 	      ""))
�   115       (message "Spooling%s..." switch-string)
�   116       (if (/= tab-width 8)
�   117 	  (let ((new-coords (print-region-new-buffer start end)))
�   118 	    (setq start (car new-coords) end (cdr new-coords))
�   119 	    (setq tab-width width)
�   120 	    (save-excursion
�   121 	      (goto-char end)
�   122 	      (setq end (point-marker)))
�   123 	    (untabify (point-min) (point-max))))
�   124       (if page-headers
�   125 	  (if lpr-headers-switches
�   126 	      ;; We handled this above by modifying SWITCHES.
�   127 	      nil
�   128 	    ;; Run a separate program to get page headers.
�   129 	    (let ((new-coords (print-region-new-buffer start end)))
�   130 	      (setq start (car new-coords) end (cdr new-coords)))
�   131 	    (apply 'call-process-region start end lpr-page-header-program
�   132 				 t t nil
�   133 				 (nconc (and lpr-add-switches
�   134 					     (list "-h" title))
�   135 					lpr-page-header-switches))
�   136 	    (setq start (point-min) end (point-max))))
�   137       (apply (or print-region-function 'call-process-region)
�   138 	     (nconc (list start end lpr-command
�   139 			  nil nil nil)
�   140 		    (nconc (and lpr-add-switches
�   141 				(list "-J" name))
�   142 			   ;; These belong in pr if we are using that.
�   143 			   (and lpr-add-switches lpr-headers-switches
�   144 				(list "-T" title))
�   145 			   switches)))
�   146       (if (markerp end)
�   147 	  (set-marker end nil))
�   148       (message "Spooling%s...done" switch-string))))
�   149 
�   150 ;; This function copies the text between start and end
�   151 ;; into a new buffer, makes that buffer current.
�   152 ;; It returns the new range to print from the new current buffer
�   153 ;; as (START . END).
�   154 
�   155 (defun print-region-new-buffer (ostart oend)
�   156   (if (string= (buffer-name) " *spool temp*")
�   157       (cons ostart oend)
�   158     (let ((oldbuf (current-buffer)))
�   159       (set-buffer (get-buffer-create " *spool temp*"))
�   160       (widen) (erase-buffer)
�   161       (insert-buffer-substring oldbuf ostart oend)
�   162       (cons (point-min) (point-max)))))
�   163 
�   164 (defun printify-region (begin end)
�   165   "Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF)
�   166 in the current buffer into printable representations as control or
�   167 hexadecimal escapes."
�   168   (interactive "r")
�   169   (save-excursion
�   170     (goto-char begin)
�   171     (let (c)
�   172       (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
�   173 	(setq c (preceding-char))
�   174 	(delete-backward-char 1)
�   175 	(insert 
�   176 	 (if (< c ?\ )
�   177 	     (format "\\^%c" (+ c ?@))
�   178 	   (format "\\%02x" c)))))))
�   179 
�   180 (provide 'lpr)
�   181 
�   182 ;;; lpr.el ends here