1;;; lpr.el --- print Emacs buffer on line printer 2 3;; Copyright (C) 1985, 1988, 1992, 1994, 2001, 2002, 2003, 4;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Maintainer: FSF 7;; Keywords: unix 8 9;; This file is part of GNU Emacs. 10 11;; GNU Emacs is free software; you can redistribute it and/or modify 12;; it under the terms of the GNU General Public License as published by 13;; the Free Software Foundation; either version 2, or (at your option) 14;; any later version. 15 16;; GNU Emacs is distributed in the hope that it will be useful, 17;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19;; GNU General Public License for more details. 20 21;; You should have received a copy of the GNU General Public License 22;; along with GNU Emacs; see the file COPYING. If not, write to the 23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 24;; Boston, MA 02110-1301, USA. 25 26;;; Commentary: 27 28;; Commands to send the region or a buffer to your printer. Entry points 29;; are `lpr-buffer', `print-buffer', `lpr-region', or `print-region'; option 30;; variables include `printer-name', `lpr-switches' and `lpr-command'. 31 32;;; Code: 33 34;;;###autoload 35(defvar lpr-windows-system 36 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) 37 38;;;###autoload 39(defvar lpr-lp-system 40 (memq system-type '(usg-unix-v dgux hpux irix))) 41 42 43(defgroup lpr nil 44 "Print Emacs buffer on line printer." 45 :group 'wp) 46 47 48;;;###autoload 49(defcustom printer-name 50 (and lpr-windows-system "PRN") 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 54On Unix-like systems, a string value should be a name understood by 55lpr's -P option; otherwise the value should be nil. 56 57On MS-DOS and MS-Windows systems, a string value is taken as the name of 58a printer device or port, provided `lpr-command' is set to \"\". 59Typical non-default settings would be \"LPT1\" to \"LPT3\" for parallel 60printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or 61\"//hostname/printer\" for a shared network printer. You can also set 62it to the name of a file, in which case the output gets appended to that 63file. If you want to discard the printed output, set this to \"NUL\"." 64 :type '(choice :menu-tag "Printer Name" 65 :tag "Printer Name" 66 (const :tag "Default" nil) 67 ;; could use string but then we lose completion for files. 68 (file :tag "Name")) 69 :group 'lpr) 70 71;;;###autoload 72(defcustom lpr-switches nil 73 "*List of strings to pass as extra options for the printer program. 74It is recommended to set `printer-name' instead of including an explicit 75switch on this list. 76See `lpr-command'." 77 :type '(repeat (string :tag "Argument")) 78 :group 'lpr) 79 80(defcustom lpr-add-switches (memq system-type '(berkeley-unix gnu/linux)) 81 "*Non-nil means construct `-T' and `-J' options for the printer program. 82These are made assuming that the program is `lpr'; 83if you are using some other incompatible printer program, 84this variable should be nil." 85 :type 'boolean 86 :group 'lpr) 87 88(defcustom lpr-printer-switch 89 (if lpr-lp-system 90 "-d " 91 "-P") 92 "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc. 93This switch is used in conjunction with `printer-name'." 94 :type '(choice :menu-tag "Printer Name Switch" 95 :tag "Printer Name Switch" 96 (const :tag "None" nil) 97 (string :tag "Printer Switch")) 98 :group 'lpr) 99 100;;;###autoload 101(defcustom lpr-command 102 (cond 103 (lpr-windows-system 104 "") 105 (lpr-lp-system 106 "lp") 107 (t 108 "lpr")) 109 "*Name of program for printing a file. 110 111On MS-DOS and MS-Windows systems, if the value is an empty string then 112Emacs will write directly to the printer port named by `printer-name'. 113The programs `print' and `nprint' (the standard print programs on 114Windows NT and Novell Netware respectively) are handled specially, using 115`printer-name' as the destination for output; any other program is 116treated like `lpr' except that an explicit filename is given as the last 117argument." 118 :type 'string 119 :group 'lpr) 120 121;; Default is nil, because that enables us to use pr -f 122;; which is more reliable than pr with no args, which is what lpr -p does. 123(defcustom lpr-headers-switches nil 124 "*List of strings of options to request page headings in the printer program. 125If nil, we run `lpr-page-header-program' to make page headings 126and print the result." 127 :type '(repeat (string :tag "Argument")) 128 :group 'lpr) 129 130(defcustom print-region-function nil 131 "Function to call to print the region on a printer. 132See definition of `print-region-1' for calling conventions." 133 :type '(choice (const nil) function) 134 :group 'lpr) 135 136(defcustom lpr-page-header-program "pr" 137 "*Name of program for adding page headers to a file." 138 :type 'string 139 :group 'lpr) 140 141;; Berkeley systems support -F, and GNU pr supports both -f and -F, 142;; So it looks like -F is a better default. 143(defcustom lpr-page-header-switches '("-h %s" "-F") 144 "*List of strings to use as options for the page-header-generating program. 145If `%s' appears in one of the strings, it is substituted by the page title. 146The variable `lpr-page-header-program' specifies the program to use." 147 :type '(repeat string) 148 :group 'lpr) 149 150;;;###autoload 151(defun lpr-buffer () 152 "Print buffer contents without pagination or page headers. 153See the variables `lpr-switches' and `lpr-command' 154for customization of the printer command." 155 (interactive) 156 (print-region-1 (point-min) (point-max) lpr-switches nil)) 157 158;;;###autoload 159(defun print-buffer () 160 "Paginate and print buffer contents. 161 162The variable `lpr-headers-switches' controls how to paginate. 163If it is nil (the default), we run the `pr' program (or whatever program 164`lpr-page-header-program' specifies) to paginate. 165`lpr-page-header-switches' specifies the switches for that program. 166 167Otherwise, the switches in `lpr-headers-switches' are used 168in the print command itself; we expect them to request pagination. 169 170See the variables `lpr-switches' and `lpr-command' 171for further customization of the printer command." 172 (interactive) 173 (print-region-1 (point-min) (point-max) lpr-switches t)) 174 175;;;###autoload 176(defun lpr-region (start end) 177 "Print region contents without pagination or page headers. 178See the variables `lpr-switches' and `lpr-command' 179for customization of the printer command." 180 (interactive "r") 181 (print-region-1 start end lpr-switches nil)) 182 183;;;###autoload 184(defun print-region (start end) 185 "Paginate and print the region contents. 186 187The variable `lpr-headers-switches' controls how to paginate. 188If it is nil (the default), we run the `pr' program (or whatever program 189`lpr-page-header-program' specifies) to paginate. 190`lpr-page-header-switches' specifies the switches for that program. 191 192Otherwise, the switches in `lpr-headers-switches' are used 193in the print command itself; we expect them to request pagination. 194 195See the variables `lpr-switches' and `lpr-command' 196for further customization of the printer command." 197 (interactive "r") 198 (print-region-1 start end lpr-switches t)) 199 200(defun print-region-1 (start end switches page-headers) 201 ;; On some MIPS system, having a space in the job name 202 ;; crashes the printer demon. But using dashes looks ugly 203 ;; and it seems to annoying to do for that MIPS system. 204 (let ((name (concat (buffer-name) " Emacs buffer")) 205 (title (concat (buffer-name) " Emacs buffer")) 206 ;; Make pipes use the same coding system as 207 ;; writing the buffer to a file would. 208 (coding-system-for-write (or coding-system-for-write 209 buffer-file-coding-system)) 210 (coding-system-for-read (or coding-system-for-read 211 buffer-file-coding-system)) 212 (width tab-width) 213 nswitches 214 switch-string) 215 (save-excursion 216 (and page-headers lpr-headers-switches 217 ;; It's possible to use an lpr option to get page headers. 218 (setq switches (append (if (stringp lpr-headers-switches) 219 (list lpr-headers-switches) 220 lpr-headers-switches) 221 switches))) 222 (setq nswitches (lpr-flatten-list 223 (mapcar 'lpr-eval-switch ; Dynamic evaluation 224 switches)) 225 switch-string (if switches 226 (concat " with options " 227 (mapconcat 'identity switches " ")) 228 "")) 229 (message "Spooling%s..." switch-string) 230 (if (/= tab-width 8) 231 (let ((new-coords (print-region-new-buffer start end))) 232 (setq start (car new-coords) 233 end (cdr new-coords) 234 tab-width width) 235 (save-excursion 236 (goto-char end) 237 (setq end (point-marker))) 238 (untabify (point-min) (point-max)))) 239 (if page-headers 240 (if lpr-headers-switches 241 ;; We handled this above by modifying SWITCHES. 242 nil 243 ;; Run a separate program to get page headers. 244 (let ((new-coords (print-region-new-buffer start end))) 245 (apply 'call-process-region (car new-coords) (cdr new-coords) 246 lpr-page-header-program t t nil 247 (mapcar (lambda (e) (format e title)) 248 lpr-page-header-switches))) 249 (setq start (point-min) 250 end (point-max)))) 251 (apply (or print-region-function 'call-process-region) 252 (nconc (list start end lpr-command 253 nil nil nil) 254 (and lpr-add-switches 255 (list "-J" name)) 256 ;; These belong in pr if we are using that. 257 (and lpr-add-switches lpr-headers-switches 258 (list "-T" title)) 259 (and (stringp printer-name) 260 (list (concat lpr-printer-switch 261 printer-name))) 262 nswitches)) 263 (if (markerp end) 264 (set-marker end nil)) 265 (message "Spooling%s...done" switch-string)))) 266 267;; This function copies the text between start and end 268;; into a new buffer, makes that buffer current. 269;; It returns the new range to print from the new current buffer 270;; as (START . END). 271 272(defun print-region-new-buffer (ostart oend) 273 (if (string= (buffer-name) " *spool temp*") 274 (cons ostart oend) 275 (let ((oldbuf (current-buffer))) 276 (set-buffer (get-buffer-create " *spool temp*")) 277 (widen) 278 (erase-buffer) 279 (insert-buffer-substring oldbuf ostart oend) 280 (cons (point-min) (point-max))))) 281 282(defun printify-region (begin end) 283 "Replace nonprinting characters in region with printable representations. 284The printable representations use ^ (for ASCII control characters) or hex. 285The characters tab, linefeed, space, return and formfeed are not affected." 286 (interactive "r") 287 (save-excursion 288 (save-restriction 289 (narrow-to-region begin end) 290 (goto-char (point-min)) 291 (let (c) 292 (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" nil t) 293 (setq c (preceding-char)) 294 (delete-backward-char 1) 295 (insert (if (< c ?\s) 296 (format "\\^%c" (+ c ?@)) 297 (format "\\%02x" c)))))))) 298 299;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 300;; Functions hacked from `ps-print' package. 301 302;; Dynamic evaluation 303(defun lpr-eval-switch (arg) 304 (cond ((stringp arg) arg) 305 ((functionp arg) (apply arg nil)) 306 ((symbolp arg) (symbol-value arg)) 307 ((consp arg) (apply (car arg) (cdr arg))) 308 (t nil))) 309 310;; `lpr-flatten-list' is defined here (copied from "message.el" and 311;; enhanced to handle dotted pairs as well) until we can get some 312;; sensible autoloads, or `flatten-list' gets put somewhere decent. 313 314;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j)) 315;; => (a b c d e f g h i j) 316 317(defun lpr-flatten-list (&rest list) 318 (lpr-flatten-list-1 list)) 319 320(defun lpr-flatten-list-1 (list) 321 (cond 322 ((null list) (list)) 323 ((consp list) 324 (append (lpr-flatten-list-1 (car list)) 325 (lpr-flatten-list-1 (cdr list)))) 326 (t (list list)))) 327 328(provide 'lpr) 329 330;;; arch-tag: 21c3f821-ebec-4ca9-ac67-a81e4b75c62a 331;;; lpr.el ends here 332