;;; lpr.el --- print Emacs buffer on line printer
-;; Copyright (C) 1985, 1988, 1992, 1994, 2001, 2003
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2012
+;; 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
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;;###autoload
(defvar lpr-windows-system
- (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
+ (memq system-type '(ms-dos windows-nt))
+ "Non-nil if running on MS-DOS or MS Windows.")
;;;###autoload
(defvar lpr-lp-system
- (memq system-type '(usg-unix-v dgux hpux irix)))
+ (memq system-type '(usg-unix-v hpux irix))
+ "Non-nil if running on a system type that uses the \"lp\" command.")
(defgroup lpr nil
;;;###autoload
(defcustom printer-name
- (and lpr-windows-system "PRN")
- "*The name of a local printer to which data is sent for printing.
+ (and (eq system-type 'ms-dos) "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
;;;###autoload
(defcustom lpr-switches nil
- "*List of strings to pass as extra options for the printer program.
+ "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'."
: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.
+ "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."
(if lpr-lp-system
"-d "
"-P")
- "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc.
+ "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"
;;;###autoload
(defcustom lpr-command
+ (purecopy
(cond
(lpr-windows-system
"")
(lpr-lp-system
"lp")
(t
- "lpr"))
- "*Name of program for printing a file.
+ "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'.
;; 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.
+ "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 lpr-page-header-program "pr"
- "*Name of program for adding page headers to a file."
+ "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.
+(defcustom lpr-page-header-switches '("-h" "%s" "-F")
+ "List of strings to use as options for the page-header-generating program.
+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.
The variable `lpr-page-header-program' specifies the program to use."
:type '(repeat string)
:group 'lpr)
"Print buffer contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
- (interactive)
+ (interactive
+ (unless (y-or-n-p "Send current buffer to default printer? ")
+ (error "Cancelled")))
(print-region-1 (point-min) (point-max) lpr-switches nil))
;;;###autoload
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
- (interactive)
+ (interactive
+ (unless (y-or-n-p "Send current buffer to default printer? ")
+ (error "Cancelled")))
(print-region-1 (point-min) (point-max) lpr-switches t))
;;;###autoload
"Print region contents without pagination or page headers.
See the variables `lpr-switches' and `lpr-command'
for customization of the printer command."
- (interactive "r")
+ (interactive
+ (if (y-or-n-p "Send selected text to default printer? ")
+ (list (region-beginning) (region-end))
+ (error "Cancelled")))
(print-region-1 start end lpr-switches nil))
;;;###autoload
See the variables `lpr-switches' and `lpr-command'
for further customization of the printer command."
- (interactive "r")
+ (interactive
+ (if (y-or-n-p "Send selected text to default printer? ")
+ (list (region-beginning) (region-end))
+ (error "Cancelled")))
(print-region-1 start end lpr-switches t))
(defun print-region-1 (start end switches 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)))
+ (mapcar (lambda (e) (format e 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))))
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (let ((tempbuf (current-buffer)))
+ (with-current-buffer buf
+ (apply (or print-region-function 'call-process-region)
+ (nconc (list start end lpr-command
+ nil tempbuf 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%s%s" switch-string
+ (pcase (count-lines (point-min) (point-max))
+ (0 "")
+ (1 ": ")
+ (_ ":\n"))
+ (buffer-string)))))))
;; This function copies the text between start and end
;; into a new buffer, makes that buffer current.
(let (c)
(while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" nil t)
(setq c (preceding-char))
- (delete-backward-char 1)
+ (delete-char -1)
(insert (if (< c ?\s)
(format "\\^%c" (+ c ?@))
(format "\\%02x" c))))))))
(provide 'lpr)
-;;; arch-tag: 21c3f821-ebec-4ca9-ac67-a81e4b75c62a
;;; lpr.el ends here