X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/a971635315e259c076de020b3676c04d1dcc415e..2b75be6704c3adf2f6ec9428dbcca90bf28043ef:/lisp/lpr.el diff --git a/lisp/lpr.el b/lisp/lpr.el index 04b77a30a0..76c69f3308 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -1,7 +1,7 @@ ;;; lpr.el --- print Emacs buffer on line printer -;; Copyright (C) 1985, 1988, 1992, 1994, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1988, 1992, 1994, 2001-2011 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: unix @@ -29,9 +29,11 @@ ;;; Code: +(eval-when-compile (require 'cl)) + ;;;###autoload (defvar lpr-windows-system - (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) + (memq system-type '(ms-dos windows-nt))) ;;;###autoload (defvar lpr-lp-system @@ -45,8 +47,8 @@ ;;;###autoload (defcustom printer-name - (and (memq system-type '(emx ms-dos)) "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 @@ -68,7 +70,7 @@ file. If you want to discard the printed output, set this to \"NUL\"." ;;;###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'." @@ -76,7 +78,7 @@ 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." @@ -87,7 +89,7 @@ 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" @@ -97,14 +99,15 @@ This switch is used in conjunction with `printer-name'." ;;;###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'. @@ -119,7 +122,7 @@ argument." ;; 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")) @@ -132,14 +135,14 @@ See definition of `print-region-1' for calling conventions." :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 '("-h" "%s" "-F") - "*List of strings to use as options for the page-header-generating program. + "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." @@ -151,7 +154,9 @@ The variable `lpr-page-header-program' specifies the program to use." "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 @@ -168,7 +173,9 @@ 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) + (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 @@ -176,7 +183,10 @@ for further customization of the printer command." "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 @@ -193,7 +203,10 @@ 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") + (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) @@ -247,21 +260,30 @@ for further customization of the printer command." 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 + (case (count-lines (point-min) (point-max)) + (0 "") + (1 ": ") + (t ":\n")) + (buffer-string))))))) ;; This function copies the text between start and end ;; into a new buffer, makes that buffer current. @@ -290,7 +312,7 @@ The characters tab, linefeed, space, return and formfeed are not affected." (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)))))))) @@ -326,5 +348,4 @@ The characters tab, linefeed, space, return and formfeed are not affected." (provide 'lpr) -;; arch-tag: 21c3f821-ebec-4ca9-ac67-a81e4b75c62a ;;; lpr.el ends here