summaryrefslogtreecommitdiff
path: root/lisp/lpr.el
blob: 213a6d05af24b243802005cf9bdeb363a793b356 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
;;; lpr.el --- print Emacs buffer on line printer

;; Copyright (C) 1985, 1988, 1992, 1994, 2001 Free Software Foundation, Inc.

;; Maintainer: FSF
;; Keywords: unix

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; Commands to send the region or a buffer to your printer.  Entry points
;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
;; variables include `printer-name', `lpr-switches' and `lpr-command'.

;;; Code:

;;;###autoload
(defvar lpr-windows-system
  (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))

;;;###autoload
(defvar lpr-lp-system
  (memq system-type '(usg-unix-v dgux hpux irix)))


(defgroup lpr nil
  "Print Emacs buffer on line printer"
  :group 'wp)


;;;###autoload
(defcustom printer-name
  (and lpr-windows-system "PRN")
  "*The name of a local printer to which data is sent for printing.
\(Note that PostScript files are sent to `ps-printer-name', which see.\)

On Unix-like systems, a string value should be a name understood by
lpr's -P option; otherwise the value should be nil.

On MS-DOS and MS-Windows systems, a string value is taken as the name of
a printer device or port, provided `lpr-command' is set to \"\".
Typical non-default settings would be \"LPT1\" to \"LPT3\" for parallel
printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or
\"//hostname/printer\" for a shared network printer.  You can also set
it to the name of a file, in which case the output gets appended to that
file.  If you want to discard the printed output, set this to \"NUL\"."
  :type '(choice :menu-tag "Printer Name"
		 :tag "Printer Name"
		 (const :tag "Default" nil)
		 ;; could use string but then we lose completion for files.
		 (file :tag "Name"))
  :group 'lpr)

;;;###autoload
(defcustom lpr-switches nil
  "*List of strings to pass as extra options for the printer program.
It is recommended to set `printer-name' instead of including an explicit
switch on this list.
See `lpr-command'."
  :type '(repeat (string :tag "Argument"))
  :group 'lpr)

(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux))
  "*Non-nil means construct `-T' and `-J' options for the printer program.
These are made assuming that the program is `lpr';
if you are using some other incompatible printer program,
this variable should be nil."
  :type 'boolean
  :group 'lpr)

(defcustom lpr-printer-switch
  (if lpr-lp-system
      "-d "
    "-P")
  "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc.
This switch is used in conjunction with `printer-name'."
  :type '(choice :menu-tag "Printer Name Switch"
		 :tag "Printer Name Switch"
		 (const :tag "None" nil)
		 (string :tag "Printer Switch"))
  :group 'lpr)

;;;###autoload
(defcustom lpr-command
  (cond
   (lpr-windows-system
    "")
   (lpr-lp-system
    "lp")
   (t
    "lpr"))
  "*Name of program for printing a file.

On MS-DOS and MS-Windows systems, if the value is an empty string then
Emacs will write directly to the printer port named by `printer-name'.
The programs `print' and `nprint' (the standard print programs on
Windows NT and Novell Netware respectively) are handled specially, using
`printer-name' as the destination for output; any other program is
treated like `lpr' except that an explicit filename is given as the last
argument."
  :type 'string
  :group 'lpr)

;; Default is nil, because that enables us to use pr -f
;; which is more reliable than pr with no args, which is what lpr -p does.
(defcustom lpr-headers-switches nil
  "*List of strings of options to request page headings in the printer program.
If nil, we run `lpr-page-header-program' to make page headings
and print the result."
  :type '(repeat (string :tag "Argument"))
  :group 'lpr)

(defcustom print-region-function nil
  "Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
  :type '(choice (const nil) function)
  :group 'lpr)

(defcustom lpr-page-header-program "pr"
  "*Name of program for adding page headers to a file."
  :type 'string
  :group 'lpr)

;; Berkeley systems support -F, and GNU pr supports both -f and -F,
;; So it looks like -F is a better default.
(defcustom lpr-page-header-switches '("-F")
  "*List of strings to use as options for the page-header-generating program.
The variable `lpr-page-header-program' specifies the program to use."
  :type '(repeat string)
  :group 'lpr)

;;;###autoload
(defun lpr-buffer ()
  "Print buffer contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
  (interactive)
  (print-region-1 (point-min) (point-max) lpr-switches nil))

;;;###autoload
(defun print-buffer ()
  "Paginate and print buffer contents.

The variable `lpr-headers-switches' controls how to paginate.
If it is nil (the default), we run the `pr' program (or whatever program
`lpr-page-header-program' specifies) to paginate.
`lpr-page-header-switches' specifies the switches for that program.

Otherwise, the switches in `lpr-headers-switches' are used
in the print command itself; we expect them to request pagination.
 
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
  (interactive)
  (print-region-1 (point-min) (point-max) lpr-switches t))

;;;###autoload
(defun lpr-region (start end)
  "Print region contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
  (interactive "r")
  (print-region-1 start end lpr-switches nil))

;;;###autoload
(defun print-region (start end)
  "Paginate and print the region contents.

The variable `lpr-headers-switches' controls how to paginate.
If it is nil (the default), we run the `pr' program (or whatever program
`lpr-page-header-program' specifies) to paginate.
`lpr-page-header-switches' specifies the switches for that program.

Otherwise, the switches in `lpr-headers-switches' are used
in the print command itself; we expect them to request pagination.
 
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
  (interactive "r")
  (print-region-1 start end lpr-switches t))

(defun print-region-1 (start end switches page-headers)
  ;; On some MIPS system, having a space in the job name
  ;; crashes the printer demon.  But using dashes looks ugly
  ;; and it seems to annoying to do for that MIPS system.
  (let ((name  (concat (buffer-name) " Emacs buffer"))
	(title (concat (buffer-name) " Emacs buffer"))
	;; Make pipes use the same coding system as
	;; writing the buffer to a file would.
	(coding-system-for-write (or coding-system-for-write
				     buffer-file-coding-system))
	(coding-system-for-read  (or coding-system-for-read
				     buffer-file-coding-system))
	(width tab-width)
	nswitches
	switch-string)
    (save-excursion
      (and page-headers lpr-headers-switches
	   ;; It's possible to use an lpr option to get page headers.
	   (setq switches (append (if (stringp lpr-headers-switches)
				      (list lpr-headers-switches)
				    lpr-headers-switches)
				  switches)))
      (setq nswitches     (lpr-flatten-list
			   (mapcar 'lpr-eval-switch ; Dynamic evaluation
				   switches))
	    switch-string (if switches
			      (concat " with options "
				      (mapconcat 'identity switches " "))
			    ""))
      (message "Spooling%s..." switch-string)
      (if (/= tab-width 8)
	  (let ((new-coords (print-region-new-buffer start end)))
	    (setq start     (car new-coords)
		  end       (cdr new-coords)
		  tab-width width)
	    (save-excursion
	      (goto-char end)
	      (setq end (point-marker)))
	    (untabify (point-min) (point-max))))
      (if page-headers
	  (if lpr-headers-switches
	      ;; We handled this above by modifying SWITCHES.
	      nil
	    ;; Run a separate program to get page headers.
	    (let ((new-coords (print-region-new-buffer start end)))
	      (apply 'call-process-region (car new-coords) (cdr new-coords)
		     lpr-page-header-program t t nil
		     (nconc (list "-h" title)
			    lpr-page-header-switches)))
	    (setq start (point-min)
		  end   (point-max))))
      (apply (or print-region-function 'call-process-region)
	     (nconc (list start end lpr-command
			  nil nil nil)
		    (and lpr-add-switches
			 (list "-J" name))
		    ;; These belong in pr if we are using that.
		    (and lpr-add-switches lpr-headers-switches
			 (list "-T" title))
		    (and (stringp printer-name)
			 (list (concat lpr-printer-switch
				       printer-name)))
		    nswitches))
      (if (markerp end)
	  (set-marker end nil))
      (message "Spooling%s...done" switch-string))))

;; This function copies the text between start and end
;; into a new buffer, makes that buffer current.
;; It returns the new range to print from the new current buffer
;; as (START . END).

(defun print-region-new-buffer (ostart oend)
  (if (string= (buffer-name) " *spool temp*")
      (cons ostart oend)
    (let ((oldbuf (current-buffer)))
      (set-buffer (get-buffer-create " *spool temp*"))
      (widen)
      (erase-buffer)
      (insert-buffer-substring oldbuf ostart oend)
      (cons (point-min) (point-max)))))

(defun printify-region (begin end)
  "Replace nonprinting characters in region with printable representations.
The printable representations use ^ (for ASCII control characters) or hex.
The characters tab, linefeed, space, return and formfeed are not affected."
  (interactive "r")
  (save-excursion
    (goto-char begin)
    (let (c)
      (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
	(setq c (preceding-char))
	(delete-backward-char 1)
	(insert (if (< c ?\ )
		    (format "\\^%c" (+ c ?@))
		  (format "\\%02x" c)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Functions hacked from `ps-print' package.

;; Dynamic evaluation
(defun lpr-eval-switch (arg)
  (cond ((stringp arg) arg)
	((functionp arg) (apply arg nil))
	((symbolp arg) (symbol-value arg))
	((consp arg) (apply (car arg) (cdr arg)))
	(t nil)))

;; `lpr-flatten-list' is defined here (copied from "message.el" and
;; enhanced to handle dotted pairs as well) until we can get some
;; sensible autoloads, or `flatten-list' gets put somewhere decent.

;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j))
;; => (a b c d e f g h i j)

(defun lpr-flatten-list (&rest list)
  (lpr-flatten-list-1 list))

(defun lpr-flatten-list-1 (list)
  (cond
   ((null list) (list))
   ((consp list)
    (append (lpr-flatten-list-1 (car list))
	    (lpr-flatten-list-1 (cdr list))))
   (t (list list))))

(provide 'lpr)

;;; lpr.el ends here