1 ;;; lpr.el --- print Emacs buffer on line printer.
3 ;; Copyright (C) 1985, 1988, 1992, 1994, 2000 Free Software Foundation, Inc.
8 ;; Modified by: Vinicius Jose Latorre <vinicius@cpqd.com.br>
9 ;; (Tentative to have a `lpr' package that runs on GNU Emacs and
11 ;; Time-stamp: <2000/11/17 11:48:35 vinicius>
13 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
15 ;; This file is part of GNU Emacs.
17 ;; GNU Emacs is free software; you can redistribute it and/or modify
18 ;; it under the terms of the GNU General Public License as published by
19 ;; the Free Software Foundation; either version 2, or (at your option)
22 ;; GNU Emacs is distributed in the hope that it will be useful,
23 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
24 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
25 ;; GNU General Public License for more details.
27 ;; You should have received a copy of the GNU General Public License
28 ;; along with GNU Emacs; see the file COPYING. If not, write to the
29 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
30 ;; Boston, MA 02111-1307, USA.
34 ;; Commands to send the region or a buffer to your printer. Entry points
35 ;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
36 ;; variables include `printer-name', `lpr-switches' and `lpr-command'.
41 (defvar lpr-windows-system
42 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
46 (memq system-type '(usg-unix-v dgux hpux irix)))
50 "Print Emacs buffer on line printer"
55 (defcustom printer-name
56 (and lpr-windows-system "PRN")
57 "*The name of a local printer to which data is sent for printing.
58 \(Note that PostScript files are sent to `ps-printer-name', which see.\)
60 On Unix-like systems, a string value should be a name understood by
61 lpr's -P option; otherwise the value should be nil.
63 On MS-DOS and MS-Windows systems, a string value is taken as the name of
64 a printer device or port, provided `lpr-command' is set to \"\".
65 Typical non-default settings would be \"LPT1\" to \"LPT3\" for parallel
66 printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
67 \"//hostname/printer\" for a shared network printer. You can also set
68 it to the name of a file, in which case the output gets appended to that
69 file. If you want to discard the printed output, set this to \"NUL\"."
70 :type '(choice :menu-tag "Printer Name"
72 (const :tag "Default" nil)
73 ;; could use string but then we lose completion for files.
78 (defcustom lpr-switches nil
79 "*List of strings to pass as extra options for the printer program.
80 It is recommended to set `printer-name' instead of including an explicit
83 :type '(repeat (string :tag "Argument"))
86 (defcustom lpr-add-switches (eq system-type 'berkeley-unix)
87 "*Non-nil means construct -T and -J options for the printer program.
88 These are made assuming that the program is `lpr';
89 if you are using some other incompatible printer program,
90 this variable should be nil."
94 (defcustom lpr-printer-switch
98 "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc.
99 This switch is used in conjunction with `printer-name'."
100 :type '(choice :menu-tag "Printer Name Switch"
101 :tag "Printer Name Switch"
102 (const :tag "None" nil)
103 (string :tag "Printer Switch"))
107 (defcustom lpr-command
115 "*Name of program for printing a file.
117 On MS-DOS and MS-Windows systems, if the value is an empty string then
118 Emacs will write directly to the printer port named by `printer-name'.
119 The programs `print' and `nprint' (the standard print programs on
120 Windows NT and Novell Netware respectively) are handled specially, using
121 `printer-name' as the destination for output; any other program is
122 treated like `lpr' except that an explicit filename is given as the last
127 ;; Default is nil, because that enables us to use pr -f
128 ;; which is more reliable than pr with no args, which is what lpr -p does.
129 (defcustom lpr-headers-switches nil
130 "*List of strings of options to request page headings in the printer program.
131 If nil, we run `lpr-page-header-program' to make page headings
132 and print the result."
133 :type '(repeat (string :tag "Argument"))
136 (defcustom print-region-function nil
137 "Function to call to print the region on a printer.
138 See definition of `print-region-1' for calling conventions."
142 (defcustom lpr-page-header-program "pr"
143 "*Name of program for adding page headers to a file."
147 ;; Berkeley systems support -F, and GNU pr supports both -f and -F,
148 ;; So it looks like -F is a better default.
149 (defcustom lpr-page-header-switches '("-h" "-F")
150 "*List of strings to use as options for the page-header-generating program.
151 The variable `lpr-page-header-program' specifies the program to use."
152 :type '(repeat string)
157 "Print buffer contents without pagination or page headers.
158 See the variables `lpr-switches' and `lpr-command'
159 for customization of the printer command."
161 (print-region-1 (point-min) (point-max) lpr-switches nil))
164 (defun print-buffer ()
165 "Paginate and print buffer contents.
167 The variable `lpr-headers-switches' controls how to paginate.
168 If it is nil (the default), we run the `pr' program (or whatever program
169 `lpr-page-header-program' specifies) to paginate.
170 `lpr-page-header-switches' specifies the switches for that program.
172 Otherwise, the switches in `lpr-headers-switches' are used
173 in the print command itself; we expect them to request pagination.
175 See the variables `lpr-switches' and `lpr-command'
176 for further customization of the printer command."
178 (print-region-1 (point-min) (point-max) lpr-switches t))
181 (defun lpr-region (start end)
182 "Print region contents without pagination or page headers.
183 See the variables `lpr-switches' and `lpr-command'
184 for customization of the printer command."
186 (print-region-1 start end lpr-switches nil))
189 (defun print-region (start end)
190 "Paginate and print the region contents.
192 The variable `lpr-headers-switches' controls how to paginate.
193 If it is nil (the default), we run the `pr' program (or whatever program
194 `lpr-page-header-program' specifies) to paginate.
195 `lpr-page-header-switches' specifies the switches for that program.
197 Otherwise, the switches in `lpr-headers-switches' are used
198 in the print command itself; we expect them to request pagination.
200 See the variables `lpr-switches' and `lpr-command'
201 for further customization of the printer command."
203 (print-region-1 start end lpr-switches t))
205 (defun print-region-1 (start end switches page-headers)
206 ;; On some MIPS system, having a space in the job name
207 ;; crashes the printer demon. But using dashes looks ugly
208 ;; and it seems to annoying to do for that MIPS system.
209 (let ((name (concat (buffer-name) " Emacs buffer"))
210 (title (concat (buffer-name) " Emacs buffer"))
211 ;; Make pipes use the same coding system as
212 ;; writing the buffer to a file would.
213 (coding-system-for-write (or coding-system-for-write
214 buffer-file-coding-system))
215 (coding-system-for-read (or coding-system-for-read
216 buffer-file-coding-system))
221 (and page-headers lpr-headers-switches
222 ;; It's possible to use an lpr option to get page headers.
223 (setq switches (append (if (stringp lpr-headers-switches)
224 (list lpr-headers-switches)
225 lpr-headers-switches)
227 (setq nswitches (lpr-flatten-list
228 (mapcar 'lpr-eval-switch ; Dynamic evaluation
230 switch-string (if switches
231 (concat " with options "
232 (mapconcat 'identity switches " "))
234 (message "Spooling%s..." switch-string)
236 (let ((new-coords (print-region-new-buffer start end)))
237 (setq start (car new-coords)
242 (setq end (point-marker)))
243 (untabify (point-min) (point-max))))
245 (if lpr-headers-switches
246 ;; We handled this above by modifying SWITCHES.
248 ;; Run a separate program to get page headers.
249 (let ((new-coords (print-region-new-buffer start end)))
250 (apply 'call-process-region (car new-coords) (cdr new-coords)
251 lpr-page-header-program t t nil
252 lpr-page-header-switches))
253 (setq start (point-min)
255 (apply (or print-region-function 'call-process-region)
256 (nconc (list start end lpr-command
258 (and lpr-add-switches
260 ;; These belong in pr if we are using that.
261 (and lpr-add-switches lpr-headers-switches
263 (and (stringp printer-name)
264 (list (concat lpr-printer-switch
268 (set-marker end nil))
269 (message "Spooling%s...done" switch-string))))
271 ;; This function copies the text between start and end
272 ;; into a new buffer, makes that buffer current.
273 ;; It returns the new range to print from the new current buffer
276 (defun print-region-new-buffer (ostart oend)
277 (if (string= (buffer-name) " *spool temp*")
279 (let ((oldbuf (current-buffer)))
280 (set-buffer (get-buffer-create " *spool temp*"))
283 (insert-buffer-substring oldbuf ostart oend)
284 (cons (point-min) (point-max)))))
286 (defun printify-region (begin end)
287 "Replace nonprinting characters in region with printable representations.
288 The printable representations use ^ (for ASCII control characters) or hex.
289 The characters tab, linefeed, space, return and formfeed are not affected."
294 (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
295 (setq c (preceding-char))
296 (delete-backward-char 1)
297 (insert (if (< c ?\ )
298 (format "\\^%c" (+ c ?@))
299 (format "\\%02x" c)))))))
301 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
302 ;; Functions hacked from `ps-print' package.
304 ;; Dynamic evaluation
305 (defun lpr-eval-switch (arg)
306 (cond ((stringp arg) arg)
307 ((functionp arg) (apply arg nil))
308 ((symbolp arg) (symbol-value arg))
309 ((consp arg) (apply (car arg) (cdr arg)))
312 ;; `lpr-flatten-list' is defined here (copied from "message.el" and
313 ;; enhanced to handle dotted pairs as well) until we can get some
314 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
316 ;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j))
317 ;; => (a b c d e f g h i j)
319 (defun lpr-flatten-list (&rest list)
320 (lpr-flatten-list-1 list))
322 (defun lpr-flatten-list-1 (list)
326 (append (lpr-flatten-list-1 (car list))
327 (lpr-flatten-list-1 (cdr list))))