lpr.el 12.6 KB
Newer Older
1
;;; lpr.el --- print Emacs buffer on line printer
Eric S. Raymond's avatar
Eric S. Raymond committed
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2019 Free Software
4
;; Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5

6
;; Maintainer: emacs-devel@gnu.org
7
;; Keywords: unix
Eric S. Raymond's avatar
Eric S. Raymond committed
8

Richard M. Stallman's avatar
Richard M. Stallman committed
9 10
;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
15 16 17 18 19 20 21

;; 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
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Richard M. Stallman's avatar
Richard M. Stallman committed
23

24 25
;;; Commentary:

26
;; Commands to send the region or a buffer to your printer.  Entry points
Markus Rost's avatar
Markus Rost committed
27
;; are `lpr-buffer', `print-buffer', `lpr-region', or `print-region'; option
28
;; variables include `printer-name', `lpr-switches' and `lpr-command'.
29

Eric S. Raymond's avatar
Eric S. Raymond committed
30
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
31

32
;;;###autoload
33
(defvar lpr-windows-system
34 35
  (memq system-type '(ms-dos windows-nt))
  "Non-nil if running on MS-DOS or MS Windows.")
36

37
;;;###autoload
38
(defvar lpr-lp-system
Paul Eggert's avatar
Paul Eggert committed
39
  (memq system-type '(usg-unix-v hpux))
40
  "Non-nil if running on a system type that uses the \"lp\" command.")
41 42


43
(defgroup lpr nil
44
  "Print Emacs buffer on line printer."
45
  :group 'text)
46

47

48 49
;;;###autoload
(defcustom printer-name
50
  (and (eq system-type 'ms-dos) "PRN")
Lute Kamstra's avatar
Lute Kamstra committed
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 54

On Unix-like systems, a string value should be a name understood by
55 56 57 58 59 60 61 62 63
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\"."
64 65 66 67 68
  :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"))
69
  :group 'lpr)
70

Jim Blandy's avatar
Jim Blandy committed
71
;;;###autoload
72
(defcustom lpr-switches nil
Lute Kamstra's avatar
Lute Kamstra committed
73
  "List of strings to pass as extra options for the printer program.
74 75
It is recommended to set `printer-name' instead of including an explicit
switch on this list.
76 77 78
See `lpr-command'."
  :type '(repeat (string :tag "Argument"))
  :group 'lpr)
79

80
(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux))
Lute Kamstra's avatar
Lute Kamstra committed
81
  "Non-nil means construct `-T' and `-J' options for the printer program.
82 83
These are made assuming that the program is `lpr';
if you are using some other incompatible printer program,
84 85 86
this variable should be nil."
  :type 'boolean
  :group 'lpr)
Richard M. Stallman's avatar
Richard M. Stallman committed
87

88 89 90 91
(defcustom lpr-printer-switch
  (if lpr-lp-system
      "-d "
    "-P")
Lute Kamstra's avatar
Lute Kamstra committed
92
  "Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc.
93 94 95 96 97 98 99
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)

Richard M. Stallman's avatar
Richard M. Stallman committed
100
;;;###autoload
101
(defcustom lpr-command
102
 (purecopy
103
  (cond
104
   (lpr-windows-system
105
    "")
106
   (lpr-lp-system
107 108
    "lp")
   (t
109
    "lpr")))
Lute Kamstra's avatar
Lute Kamstra committed
110
  "Name of program for printing a file.
111 112 113 114 115 116 117 118

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."
119 120
  :type 'string
  :group 'lpr)
Richard M. Stallman's avatar
Richard M. Stallman committed
121

122 123
;; 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.
124
(defcustom lpr-headers-switches nil
Lute Kamstra's avatar
Lute Kamstra committed
125
  "List of strings of options to request page headings in the printer program.
126
If nil, we run `lpr-page-header-program' to make page headings
127
and print the result."
Glenn Morris's avatar
Glenn Morris committed
128 129 130
  :type '(choice (const nil)
		 (string :tag "Single argument")
		 (repeat :tag "Multiple arguments" (string :tag "Argument")))
131
  :group 'lpr)
132

133 134
(defcustom print-region-function
  (if (memq system-type '(ms-dos windows-nt))
135
      #'w32-direct-print-region-function
136
    #'call-process-region)
Richard M. Stallman's avatar
Richard M. Stallman committed
137
  "Function to call to print the region on a printer.
138
See definition of `print-region-1' for calling conventions."
139
  :type 'function
140
  :group 'lpr)
Richard M. Stallman's avatar
Richard M. Stallman committed
141

142
(defcustom lpr-page-header-program "pr"
Lute Kamstra's avatar
Lute Kamstra committed
143
  "Name of program for adding page headers to a file."
144 145
  :type 'string
  :group 'lpr)
146

147 148
;; Berkeley systems support -F, and GNU pr supports both -f and -F,
;; So it looks like -F is a better default.
149
(defcustom lpr-page-header-switches '("-h" "%s" "-F")
Lute Kamstra's avatar
Lute Kamstra committed
150
  "List of strings to use as options for the page-header-generating program.
151 152
If `%s' appears in any of the strings, it is substituted by the page title.
Note that for correct quoting, `%s' should normally be a separate element.
153 154 155
The variable `lpr-page-header-program' specifies the program to use."
  :type '(repeat string)
  :group 'lpr)
156

Roland McGrath's avatar
Roland McGrath committed
157
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
158
(defun lpr-buffer ()
159 160 161
  "Print buffer contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
162 163
  (interactive
   (unless (y-or-n-p "Send current buffer to default printer? ")
Paul Eggert's avatar
Paul Eggert committed
164
     (error "Canceled")))
Richard M. Stallman's avatar
Richard M. Stallman committed
165 166
  (print-region-1 (point-min) (point-max) lpr-switches nil))

Roland McGrath's avatar
Roland McGrath committed
167
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
168
(defun print-buffer ()
169 170
  "Paginate and print buffer contents.

171 172 173 174 175 176 177
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.
178

179 180
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
181 182
  (interactive
   (unless (y-or-n-p "Send current buffer to default printer? ")
Paul Eggert's avatar
Paul Eggert committed
183
     (error "Canceled")))
Richard M. Stallman's avatar
Richard M. Stallman committed
184 185
  (print-region-1 (point-min) (point-max) lpr-switches t))

Roland McGrath's avatar
Roland McGrath committed
186
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
187
(defun lpr-region (start end)
188 189 190
  "Print region contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
191 192 193
  (interactive
   (if (y-or-n-p "Send selected text to default printer? ")
       (list (region-beginning) (region-end))
Paul Eggert's avatar
Paul Eggert committed
194
     (error "Canceled")))
Richard M. Stallman's avatar
Richard M. Stallman committed
195 196
  (print-region-1 start end lpr-switches nil))

Roland McGrath's avatar
Roland McGrath committed
197
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
198
(defun print-region (start end)
199 200 201 202 203 204 205 206 207
  "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.
208

209 210
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
211 212 213
  (interactive
   (if (y-or-n-p "Send selected text to default printer? ")
       (list (region-beginning) (region-end))
Paul Eggert's avatar
Paul Eggert committed
214
     (error "Canceled")))
Richard M. Stallman's avatar
Richard M. Stallman committed
215 216 217
  (print-region-1 start end lpr-switches t))

(defun print-region-1 (start end switches page-headers)
218 219 220 221 222 223
  (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)))
224 225 226
  ;; 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.
227 228 229 230 231 232 233 234 235
  (save-excursion
    (let ((name  (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))
Richard M. Stallman's avatar
Richard M. Stallman committed
236
      (if (/= tab-width 8)
237
	  (let ((new-coords (print-region-new-buffer start end)))
238 239 240
	    (setq start     (car new-coords)
		  end       (cdr new-coords)
		  tab-width width)
241 242 243
	    (save-excursion
	      (goto-char end)
	      (setq end (point-marker)))
Richard M. Stallman's avatar
Richard M. Stallman committed
244 245
	    (untabify (point-min) (point-max))))
      (if page-headers
246
	  (if lpr-headers-switches
247 248
	      ;; We handled this above by modifying SWITCHES.
	      nil
249
	    ;; Run a separate program to get page headers.
250
	    (let ((new-coords (print-region-new-buffer start end)))
251 252
	      (apply 'call-process-region (car new-coords) (cdr new-coords)
		     lpr-page-header-program t t nil
253
		     (mapcar (lambda (e) (format e name))
254
			     lpr-page-header-switches)))
255 256
	    (setq start (point-min)
		  end   (point-max))))
257 258 259 260
      (lpr-print-region start end switches name))))

(defun lpr-print-region (start end switches name)
  (let ((buf (current-buffer))
Alex Branham's avatar
Alex Branham committed
261
        (nswitches (flatten-tree
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
                    (mapcar #'lpr-eval-switch ; Dynamic evaluation
                            switches)))
        (switch-string (if switches
                           (concat " with options "
                                   (mapconcat #'identity switches " "))
                         "")))
    (message "Spooling%s..." switch-string)
    (with-temp-buffer
      (let ((retval
             (let ((tempbuf (current-buffer)))
               (with-current-buffer buf
                 (apply (or print-region-function 'call-process-region)
                        start end lpr-command
                        nil tempbuf nil
                        (nconc (and name lpr-add-switches
                                    (list "-J" name))
                               ;; These belong in pr if we are using that.
                               (and name lpr-add-switches lpr-headers-switches
                                    (list "-T" name))
                               (and (stringp printer-name)
                                    (string< "" printer-name)
                                    (list (concat lpr-printer-switch
                                                  printer-name)))
                               nswitches))))))
        (if (markerp end)
            (set-marker end nil))
        (funcall (if (memq retval '(nil 0)) #'message #'user-error)
                 "Spooling%s...done%s%s" switch-string
                 (pcase (count-lines (point-min) (point-max))
                   (0 "")
                   (1 ": ")
                   (_ ":\n"))
                 (buffer-string))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
295 296

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

301
(defun print-region-new-buffer (ostart oend)
302 303 304 305
  (if (string= (buffer-name) " *spool temp*")
      (cons ostart oend)
    (let ((oldbuf (current-buffer)))
      (set-buffer (get-buffer-create " *spool temp*"))
306 307
      (widen)
      (erase-buffer)
308 309
      (insert-buffer-substring oldbuf ostart oend)
      (cons (point-min) (point-max)))))
Eric S. Raymond's avatar
Eric S. Raymond committed
310

311
(defun printify-region (begin end)
312 313 314
  "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."
315 316
  (interactive "r")
  (save-excursion
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
317 318 319 320 321 322
    (save-restriction
      (narrow-to-region begin end)
      (goto-char (point-min))
      (let (c)
	(while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" nil t)
	  (setq c (preceding-char))
323
	  (delete-char -1)
324
	  (insert (if (< c ?\s)
Vinicius Jose Latorre's avatar
Vinicius Jose Latorre committed
325 326
		      (format "\\^%c" (+ c ?@))
		    (format "\\%02x" c))))))))
327 328 329 330 331 332 333

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

;; Dynamic evaluation
(defun lpr-eval-switch (arg)
  (cond ((stringp arg) arg)
334
	((functionp arg) (funcall arg))
335 336 337 338
	((symbolp arg) (symbol-value arg))
	((consp arg) (apply (car arg) (cdr arg)))
	(t nil)))

Alex Branham's avatar
Alex Branham committed
339
(define-obsolete-function-alias 'lpr-flatten-list #'flatten-tree "27.1")
340

Karl Heuer's avatar
Karl Heuer committed
341 342
(provide 'lpr)

Eric S. Raymond's avatar
Eric S. Raymond committed
343
;;; lpr.el ends here