X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/cbee283dd7dd655124e81a6bd555506476180b5d..32a9496d8d7f87bb7695b62340e2602eb9cab615:/lisp/lpr.el diff --git a/lisp/lpr.el b/lisp/lpr.el index 45914ce5a7..40c530a95f 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -1,17 +1,17 @@ ;;; 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-2014 Free Software +;; Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; 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 3, 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 @@ -19,9 +19,7 @@ ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -33,11 +31,13 @@ ;;;###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 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 @@ -47,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 @@ -70,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'." @@ -78,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." @@ -89,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" @@ -99,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'. @@ -121,27 +122,32 @@ 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")) + :type '(choice (const nil) + (string :tag "Single argument") + (repeat :tag "Multiple arguments" (string :tag "Argument"))) :group 'lpr) -(defcustom print-region-function nil +(defcustom print-region-function + (if (memq system-type '(ms-dos windows-nt)) + #'w32-direct-print-region-function + #'call-process-region) "Function to call to print the region on a printer. See definition of `print-region-1' for calling conventions." - :type '(choice (const nil) function) + :type 'function :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." @@ -153,7 +159,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 "Canceled"))) (print-region-1 (point-min) (point-max) lpr-switches nil)) ;;;###autoload @@ -170,7 +178,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 "Canceled"))) (print-region-1 (point-min) (point-max) lpr-switches t)) ;;;###autoload @@ -178,7 +188,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 "Canceled"))) (print-region-1 start end lpr-switches nil)) ;;;###autoload @@ -195,39 +208,31 @@ 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 "Canceled"))) (print-region-1 start end lpr-switches t)) (defun print-region-1 (start end switches page-headers) + (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))) ;; 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) + (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)) (if (/= tab-width 8) (let ((new-coords (print-region-new-buffer start end))) (setq start (car new-coords) @@ -245,25 +250,48 @@ for further customization of the printer command." (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 - (mapcar (lambda (e) (format e title)) + (mapcar (lambda (e) (format e name)) 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)))) + (lpr-print-region start end switches name)))) + +(defun lpr-print-region (start end switches name) + (let ((buf (current-buffer)) + (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) + (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)))))) ;; This function copies the text between start and end ;; into a new buffer, makes that buffer current. @@ -292,7 +320,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)))))))) @@ -303,7 +331,7 @@ The characters tab, linefeed, space, return and formfeed are not affected." ;; Dynamic evaluation (defun lpr-eval-switch (arg) (cond ((stringp arg) arg) - ((functionp arg) (apply arg nil)) + ((functionp arg) (funcall arg)) ((symbolp arg) (symbol-value arg)) ((consp arg) (apply (car arg) (cdr arg))) (t nil))) @@ -320,7 +348,7 @@ The characters tab, linefeed, space, return and formfeed are not affected." (defun lpr-flatten-list-1 (list) (cond - ((null list) (list)) + ((null list) nil) ((consp list) (append (lpr-flatten-list-1 (car list)) (lpr-flatten-list-1 (cdr list)))) @@ -328,5 +356,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