1;;; lpr.el --- print Emacs buffer on line printer
2
3;; Copyright (C) 1985, 1988, 1992, 1994, 2001, 2002, 2003,
4;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
5
6;; Maintainer: FSF
7;; Keywords: unix
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; Commands to send the region or a buffer to your printer.  Entry points
29;; are `lpr-buffer', `print-buffer', `lpr-region', or `print-region'; option
30;; variables include `printer-name', `lpr-switches' and `lpr-command'.
31
32;;; Code:
33
34;;;###autoload
35(defvar lpr-windows-system
36  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
37
38;;;###autoload
39(defvar lpr-lp-system
40  (memq system-type '(usg-unix-v dgux hpux irix)))
41
42
43(defgroup lpr nil
44  "Print Emacs buffer on line printer."
45  :group 'wp)
46
47
48;;;###autoload
49(defcustom printer-name
50  (and lpr-windows-system "PRN")
51  "*The name of a local printer to which data is sent for printing.
52\(Note that PostScript files are sent to `ps-printer-name', which see.\)
53
54On Unix-like systems, a string value should be a name understood by
55lpr's -P option; otherwise the value should be nil.
56
57On MS-DOS and MS-Windows systems, a string value is taken as the name of
58a printer device or port, provided `lpr-command' is set to \"\".
59Typical non-default settings would be \"LPT1\" to \"LPT3\" for parallel
60printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
61\"//hostname/printer\" for a shared network printer.  You can also set
62it to the name of a file, in which case the output gets appended to that
63file.  If you want to discard the printed output, set this to \"NUL\"."
64  :type '(choice :menu-tag "Printer Name"
65		 :tag "Printer Name"
66		 (const :tag "Default" nil)
67		 ;; could use string but then we lose completion for files.
68		 (file :tag "Name"))
69  :group 'lpr)
70
71;;;###autoload
72(defcustom lpr-switches nil
73  "*List of strings to pass as extra options for the printer program.
74It is recommended to set `printer-name' instead of including an explicit
75switch on this list.
76See `lpr-command'."
77  :type '(repeat (string :tag "Argument"))
78  :group 'lpr)
79
80(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux))
81  "*Non-nil means construct `-T' and `-J' options for the printer program.
82These are made assuming that the program is `lpr';
83if you are using some other incompatible printer program,
84this variable should be nil."
85  :type 'boolean
86  :group 'lpr)
87
88(defcustom lpr-printer-switch
89  (if lpr-lp-system
90      "-d "
91    "-P")
92  "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc.
93This switch is used in conjunction with `printer-name'."
94  :type '(choice :menu-tag "Printer Name Switch"
95		 :tag "Printer Name Switch"
96		 (const :tag "None" nil)
97		 (string :tag "Printer Switch"))
98  :group 'lpr)
99
100;;;###autoload
101(defcustom lpr-command
102  (cond
103   (lpr-windows-system
104    "")
105   (lpr-lp-system
106    "lp")
107   (t
108    "lpr"))
109  "*Name of program for printing a file.
110
111On MS-DOS and MS-Windows systems, if the value is an empty string then
112Emacs will write directly to the printer port named by `printer-name'.
113The programs `print' and `nprint' (the standard print programs on
114Windows NT and Novell Netware respectively) are handled specially, using
115`printer-name' as the destination for output; any other program is
116treated like `lpr' except that an explicit filename is given as the last
117argument."
118  :type 'string
119  :group 'lpr)
120
121;; Default is nil, because that enables us to use pr -f
122;; which is more reliable than pr with no args, which is what lpr -p does.
123(defcustom lpr-headers-switches nil
124  "*List of strings of options to request page headings in the printer program.
125If nil, we run `lpr-page-header-program' to make page headings
126and print the result."
127  :type '(repeat (string :tag "Argument"))
128  :group 'lpr)
129
130(defcustom print-region-function nil
131  "Function to call to print the region on a printer.
132See definition of `print-region-1' for calling conventions."
133  :type '(choice (const nil) function)
134  :group 'lpr)
135
136(defcustom lpr-page-header-program "pr"
137  "*Name of program for adding page headers to a file."
138  :type 'string
139  :group 'lpr)
140
141;; Berkeley systems support -F, and GNU pr supports both -f and -F,
142;; So it looks like -F is a better default.
143(defcustom lpr-page-header-switches '("-h %s" "-F")
144  "*List of strings to use as options for the page-header-generating program.
145If `%s' appears in one of the strings, it is substituted by the page title.
146The variable `lpr-page-header-program' specifies the program to use."
147  :type '(repeat string)
148  :group 'lpr)
149
150;;;###autoload
151(defun lpr-buffer ()
152  "Print buffer contents without pagination or page headers.
153See the variables `lpr-switches' and `lpr-command'
154for customization of the printer command."
155  (interactive)
156  (print-region-1 (point-min) (point-max) lpr-switches nil))
157
158;;;###autoload
159(defun print-buffer ()
160  "Paginate and print buffer contents.
161
162The variable `lpr-headers-switches' controls how to paginate.
163If it is nil (the default), we run the `pr' program (or whatever program
164`lpr-page-header-program' specifies) to paginate.
165`lpr-page-header-switches' specifies the switches for that program.
166
167Otherwise, the switches in `lpr-headers-switches' are used
168in the print command itself; we expect them to request pagination.
169
170See the variables `lpr-switches' and `lpr-command'
171for further customization of the printer command."
172  (interactive)
173  (print-region-1 (point-min) (point-max) lpr-switches t))
174
175;;;###autoload
176(defun lpr-region (start end)
177  "Print region contents without pagination or page headers.
178See the variables `lpr-switches' and `lpr-command'
179for customization of the printer command."
180  (interactive "r")
181  (print-region-1 start end lpr-switches nil))
182
183;;;###autoload
184(defun print-region (start end)
185  "Paginate and print the region contents.
186
187The variable `lpr-headers-switches' controls how to paginate.
188If it is nil (the default), we run the `pr' program (or whatever program
189`lpr-page-header-program' specifies) to paginate.
190`lpr-page-header-switches' specifies the switches for that program.
191
192Otherwise, the switches in `lpr-headers-switches' are used
193in the print command itself; we expect them to request pagination.
194
195See the variables `lpr-switches' and `lpr-command'
196for further customization of the printer command."
197  (interactive "r")
198  (print-region-1 start end lpr-switches t))
199
200(defun print-region-1 (start end switches page-headers)
201  ;; On some MIPS system, having a space in the job name
202  ;; crashes the printer demon.  But using dashes looks ugly
203  ;; and it seems to annoying to do for that MIPS system.
204  (let ((name  (concat (buffer-name) " Emacs buffer"))
205	(title (concat (buffer-name) " Emacs buffer"))
206	;; Make pipes use the same coding system as
207	;; writing the buffer to a file would.
208	(coding-system-for-write (or coding-system-for-write
209				     buffer-file-coding-system))
210	(coding-system-for-read  (or coding-system-for-read
211				     buffer-file-coding-system))
212	(width tab-width)
213	nswitches
214	switch-string)
215    (save-excursion
216      (and page-headers lpr-headers-switches
217	   ;; It's possible to use an lpr option to get page headers.
218	   (setq switches (append (if (stringp lpr-headers-switches)
219				      (list lpr-headers-switches)
220				    lpr-headers-switches)
221				  switches)))
222      (setq nswitches     (lpr-flatten-list
223			   (mapcar 'lpr-eval-switch ; Dynamic evaluation
224				   switches))
225	    switch-string (if switches
226			      (concat " with options "
227				      (mapconcat 'identity switches " "))
228			    ""))
229      (message "Spooling%s..." switch-string)
230      (if (/= tab-width 8)
231	  (let ((new-coords (print-region-new-buffer start end)))
232	    (setq start     (car new-coords)
233		  end       (cdr new-coords)
234		  tab-width width)
235	    (save-excursion
236	      (goto-char end)
237	      (setq end (point-marker)))
238	    (untabify (point-min) (point-max))))
239      (if page-headers
240	  (if lpr-headers-switches
241	      ;; We handled this above by modifying SWITCHES.
242	      nil
243	    ;; Run a separate program to get page headers.
244	    (let ((new-coords (print-region-new-buffer start end)))
245	      (apply 'call-process-region (car new-coords) (cdr new-coords)
246		     lpr-page-header-program t t nil
247		     (mapcar (lambda (e) (format e title))
248			     lpr-page-header-switches)))
249	    (setq start (point-min)
250		  end   (point-max))))
251      (apply (or print-region-function 'call-process-region)
252	     (nconc (list start end lpr-command
253			  nil nil nil)
254		    (and lpr-add-switches
255			 (list "-J" name))
256		    ;; These belong in pr if we are using that.
257		    (and lpr-add-switches lpr-headers-switches
258			 (list "-T" title))
259		    (and (stringp printer-name)
260			 (list (concat lpr-printer-switch
261				       printer-name)))
262		    nswitches))
263      (if (markerp end)
264	  (set-marker end nil))
265      (message "Spooling%s...done" switch-string))))
266
267;; This function copies the text between start and end
268;; into a new buffer, makes that buffer current.
269;; It returns the new range to print from the new current buffer
270;; as (START . END).
271
272(defun print-region-new-buffer (ostart oend)
273  (if (string= (buffer-name) " *spool temp*")
274      (cons ostart oend)
275    (let ((oldbuf (current-buffer)))
276      (set-buffer (get-buffer-create " *spool temp*"))
277      (widen)
278      (erase-buffer)
279      (insert-buffer-substring oldbuf ostart oend)
280      (cons (point-min) (point-max)))))
281
282(defun printify-region (begin end)
283  "Replace nonprinting characters in region with printable representations.
284The printable representations use ^ (for ASCII control characters) or hex.
285The characters tab, linefeed, space, return and formfeed are not affected."
286  (interactive "r")
287  (save-excursion
288    (save-restriction
289      (narrow-to-region begin end)
290      (goto-char (point-min))
291      (let (c)
292	(while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" nil t)
293	  (setq c (preceding-char))
294	  (delete-backward-char 1)
295	  (insert (if (< c ?\s)
296		      (format "\\^%c" (+ c ?@))
297		    (format "\\%02x" c))))))))
298
299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
300;; Functions hacked from `ps-print' package.
301
302;; Dynamic evaluation
303(defun lpr-eval-switch (arg)
304  (cond ((stringp arg) arg)
305	((functionp arg) (apply arg nil))
306	((symbolp arg) (symbol-value arg))
307	((consp arg) (apply (car arg) (cdr arg)))
308	(t nil)))
309
310;; `lpr-flatten-list' is defined here (copied from "message.el" and
311;; enhanced to handle dotted pairs as well) until we can get some
312;; sensible autoloads, or `flatten-list' gets put somewhere decent.
313
314;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j))
315;; => (a b c d e f g h i j)
316
317(defun lpr-flatten-list (&rest list)
318  (lpr-flatten-list-1 list))
319
320(defun lpr-flatten-list-1 (list)
321  (cond
322   ((null list) (list))
323   ((consp list)
324    (append (lpr-flatten-list-1 (car list))
325	    (lpr-flatten-list-1 (cdr list))))
326   (t (list list))))
327
328(provide 'lpr)
329
330;;; arch-tag: 21c3f821-ebec-4ca9-ac67-a81e4b75c62a
331;;; lpr.el ends here
332