[bpt/emacs.git] / lisp / lpr.el

;;; lpr.el --- print Emacs buffer on line printer.

;; Copyright (C) 1985, 1988, 1992, 1994 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
;; 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.

;; 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
;; 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.

;;; Commentary:

;; Commands to send the region or a buffer your printer.  Entry points
;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
;; variables include `printer-name', `lpr-switches' and `lpr-command'.

;;; Code:

(defgroup lpr nil
  "Print Emacs buffer on line printer"
  :group 'wp)

;;;###autoload
(defcustom printer-name
  (if (memq system-type '(ms-dos windows-nt)) "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
lpr's -P option.

On MS-DOS and MS-Windows systems, it is the name of a printer device or
port.  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 a 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\"."
  :type '(choice ; could use string but then we lose completion for files.
		 (file :tag "Name")
		 (const :tag "Default" nil))
  :group 'lpr)

;;;###autoload
(defcustom lpr-switches nil 
  "*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'."
  :type '(repeat (string :tag "Argument"))
  :group 'lpr)

(defcustom lpr-add-switches (eq system-type 'berkeley-unix)
  "*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."
  :type 'boolean
  :group 'lpr)

;;;###autoload
(defcustom lpr-command
  (if (memq system-type '(usg-unix-v dgux hpux irix))
      "lp" "lpr")
  "*Name of program for printing a file."
  :type 'string
  :group 'lpr)

;; 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.
If nil, we run `lpr-page-header-program' to make page headings
and print the result."
  :type '(repeat (string :tag "Argument"))
  :group 'lpr)

(defcustom print-region-function nil
  "Function to call to print the region on a printer.
See definition of `print-region-1' for calling conventions."
  :type 'function
  :group 'lpr)

(defcustom lpr-page-header-program "pr"
  "*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.
The variable `lpr-page-header-program' specifies the program to use."
  :type '(repeat string)
  :group 'lpr)

;;;###autoload
(defun lpr-buffer ()
  "Print buffer contents as with Unix command `lpr'.
`lpr-switches' is a list of extra switches (strings) to pass to lpr."
  (interactive)
  (print-region-1 (point-min) (point-max) lpr-switches nil))

;;;###autoload
(defun print-buffer ()
  "Print buffer contents as with Unix command `lpr -p'.
`lpr-switches' is a list of extra switches (strings) to pass to lpr."
  (interactive)
  (print-region-1 (point-min) (point-max) lpr-switches t))

;;;###autoload
(defun lpr-region (start end)
  "Print region contents as with Unix command `lpr'.
`lpr-switches' is a list of extra switches (strings) to pass to lpr."
  (interactive "r")
  (print-region-1 start end lpr-switches nil))

;;;###autoload
(defun print-region (start end)
  "Print region contents as with Unix command `lpr -p'.
`lpr-switches' is a list of extra switches (strings) to pass to lpr."
  (interactive "r")
  (print-region-1 start end lpr-switches t))

(defun print-region-1 (start end switches page-headers)
  ;; 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)
	switch-string)
    (save-excursion
      (if page-headers
	  (if lpr-headers-switches
	      ;; It is 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 switch-string
	    (if switches (concat " with options "
				 (mapconcat 'identity switches " "))
	      ""))
      (message "Spooling%s..." switch-string)
      (if (/= tab-width 8)
	  (let ((new-coords (print-region-new-buffer start end)))
	    (setq start (car new-coords) end (cdr new-coords))
	    (setq tab-width width)
	    (save-excursion
	      (goto-char end)
	      (setq end (point-marker)))
	    (untabify (point-min) (point-max))))
      (if page-headers
	  (if lpr-headers-switches
	      ;; We handled this above by modifying SWITCHES.
	      nil
	    ;; Run a separate program to get page headers.
	    (let ((new-coords (print-region-new-buffer start end)))
	      (setq start (car new-coords) end (cdr new-coords)))
	    (apply 'call-process-region start end lpr-page-header-program
				 t t nil
				 (nconc (list "-h" 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)
		    (nconc (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 "-P" printer-name)))
			   switches)))
      (if (markerp end)
	  (set-marker end nil))
      (message "Spooling%s...done" switch-string))))

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

(defun print-region-new-buffer (ostart oend)
  (if (string= (buffer-name) " *spool temp*")
      (cons ostart oend)
    (let ((oldbuf (current-buffer)))
      (set-buffer (get-buffer-create " *spool temp*"))
      (widen) (erase-buffer)
      (insert-buffer-substring oldbuf ostart oend)
      (cons (point-min) (point-max)))))

(defun printify-region (begin end)
  "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."
  (interactive "r")
  (save-excursion
    (goto-char begin)
    (let (c)
      (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
	(setq c (preceding-char))
	(delete-backward-char 1)
	(insert 
	 (if (< c ?\ )
	     (format "\\^%c" (+ c ?@))
	   (format "\\%02x" c)))))))

(provide 'lpr)

;;; lpr.el ends here
Commit	Line	Data
6594deb0 ER	1	;;; lpr.el --- print Emacs buffer on line printer.
6594deb0 ER	2
8f1204db	3	;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
3a801d0c	4
e5167999	5	;; Maintainer: FSF
fd7fa35a	6	;; Keywords: unix
e5167999	7
d6c7e99a RS	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
e5167999	12	;; the Free Software Foundation; either version 2, or (at your option)
d6c7e99a RS	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
b578f267 EN	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
	22	;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
	23	;; Boston, MA 02111-1307, USA.
d6c7e99a	24
e41b2db1 ER	25	;;; Commentary:
	26
	27	;; Commands to send the region or a buffer your printer. Entry points
	28	;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
8748e3eb	29	;; variables include `printer-name', `lpr-switches' and `lpr-command'.
e41b2db1	30
e5167999	31	;;; Code:
d6c7e99a	32
c5292bc8 RS	33	(defgroup lpr nil
	34	"Print Emacs buffer on line printer"
	35	:group 'wp)
	36
8748e3eb RS	37	;;;###autoload
	38	(defcustom printer-name
	39	(if (memq system-type '(ms-dos windows-nt)) "PRN")
	40	"*The name of a local printer to which data is sent for printing.
	41	\(Note that PostScript files are sent to `ps-printer-name', which see.\)
	42
	43	On Unix-like systems, a string value should be a name understood by
	44	lpr's -P option.
	45
	46	On MS-DOS and MS-Windows systems, it is the name of a printer device or
	47	port. Typical non-default settings would be \"LPT1\" to \"LPT3\" for
	48	parallel printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial
	49	printers, or \"//hostname/printer\" for a shared network printer. You
	50	can also set it to a name of a file, in which case the output gets
	51	appended to that file. If you want to discard the printed output, set
	52	this to \"NUL\"."
3917863b AS	53	:type '(choice ; could use string but then we lose completion for files.
	54	(file :tag "Name")
	55	(const :tag "Default" nil))
8748e3eb	56	:group 'lpr)
c5292bc8	57
6503cec3	58	;;;###autoload
c5292bc8	59	(defcustom lpr-switches nil
22466c09	60	"*List of strings to pass as extra options for the printer program.
8748e3eb RS	61	It is recommended to set `printer-name' instead of including an explicit
8748e3eb RS	62	switch on this list.
c5292bc8 RS	63	See `lpr-command'."
	64	:type '(repeat (string :tag "Argument"))
	65	:group 'lpr)
3a621cfe	66
c5292bc8	67	(defcustom lpr-add-switches (eq system-type 'berkeley-unix)
22466c09 KH	68	"*Non-nil means construct -T and -J options for the printer program.
	69	These are made assuming that the program is `lpr';
	70	if you are using some other incompatible printer program,
c5292bc8 RS	71	this variable should be nil."
	72	:type 'boolean
	73	:group 'lpr)
d6c7e99a	74
910476ef	75	;;;###autoload
c5292bc8	76	(defcustom lpr-command
ffc74f20	77	(if (memq system-type '(usg-unix-v dgux hpux irix))
9f0a6471	78	"lp" "lpr")
c5292bc8 RS	79	"*Name of program for printing a file."
	80	:type 'string
	81	:group 'lpr)
d6c7e99a	82
7173ec77 RS	83	;; Default is nil, because that enables us to use pr -f
7173ec77 RS	84	;; which is more reliable than pr with no args, which is what lpr -p does.
c5292bc8	85	(defcustom lpr-headers-switches nil
5526cfde	86	"*List of strings of options to request page headings in the printer program.
7173ec77	87	If nil, we run `lpr-page-header-program' to make page headings
c5292bc8 RS	88	and print the result."
	89	:type '(repeat (string :tag "Argument"))
	90	:group 'lpr)
3a621cfe	91
c5292bc8	92	(defcustom print-region-function nil
d6c7e99a	93	"Function to call to print the region on a printer.
c5292bc8 RS	94	See definition of `print-region-1' for calling conventions."
	95	:type 'function
	96	:group 'lpr)
d6c7e99a	97
c5292bc8 RS	98	(defcustom lpr-page-header-program "pr"
	99	"*Name of program for adding page headers to a file."
	100	:type 'string
	101	:group 'lpr)
c820123b	102
bafa1a69 RS	103	;; Berkeley systems support -F, and GNU pr supports both -f and -F,
bafa1a69 RS	104	;; So it looks like -F is a better default.
63c7b220	105	(defcustom lpr-page-header-switches '("-F")
5526cfde	106	"*List of strings to use as options for the page-header-generating program.
c5292bc8 RS	107	The variable `lpr-page-header-program' specifies the program to use."
	108	:type '(repeat string)
	109	:group 'lpr)
c820123b	110
7229064d	111	;;;###autoload
d6c7e99a RS	112	(defun lpr-buffer ()
	113	"Print buffer contents as with Unix command `lpr'.
	114	`lpr-switches' is a list of extra switches (strings) to pass to lpr."
	115	(interactive)
	116	(print-region-1 (point-min) (point-max) lpr-switches nil))
	117
7229064d	118	;;;###autoload
d6c7e99a RS	119	(defun print-buffer ()
	120	"Print buffer contents as with Unix command `lpr -p'.
	121	`lpr-switches' is a list of extra switches (strings) to pass to lpr."
	122	(interactive)
	123	(print-region-1 (point-min) (point-max) lpr-switches t))
	124
7229064d	125	;;;###autoload
d6c7e99a RS	126	(defun lpr-region (start end)
	127	"Print region contents as with Unix command `lpr'.
	128	`lpr-switches' is a list of extra switches (strings) to pass to lpr."
	129	(interactive "r")
	130	(print-region-1 start end lpr-switches nil))
	131
7229064d	132	;;;###autoload
d6c7e99a RS	133	(defun print-region (start end)
	134	"Print region contents as with Unix command `lpr -p'.
	135	`lpr-switches' is a list of extra switches (strings) to pass to lpr."
	136	(interactive "r")
	137	(print-region-1 start end lpr-switches t))
	138
	139	(defun print-region-1 (start end switches page-headers)
904d7624 RS	140	;; On some MIPS system, having a space in the job name
	141	;; crashes the printer demon. But using dashes looks ugly
	142	;; and it seems to annoying to do for that MIPS system.
	143	(let ((name (concat (buffer-name) " Emacs buffer"))
a8037455	144	(title (concat (buffer-name) " Emacs buffer"))
0b45d07b EZ	145	;; Make pipes use the same coding system as
	146	;; writing the buffer to a file would.
	147	(coding-system-for-write
	148	(or coding-system-for-write buffer-file-coding-system))
	149	(coding-system-for-read
	150	(or coding-system-for-read buffer-file-coding-system))
5bbf28a8 RS	151	(width tab-width)
5bbf28a8 RS	152	switch-string)
d6c7e99a	153	(save-excursion
5bbf28a8 RS	154	(if page-headers
	155	(if lpr-headers-switches
	156	;; It is possible to use an lpr option
	157	;; to get page headers.
	158	(setq switches (append (if (stringp lpr-headers-switches)
	159	(list lpr-headers-switches)
	160	lpr-headers-switches)
	161	switches))))
	162	(setq switch-string
	163	(if switches (concat " with options "
	164	(mapconcat 'identity switches " "))
	165	""))
	166	(message "Spooling%s..." switch-string)
d6c7e99a	167	(if (/= tab-width 8)
8fa64b34 RS	168	(let ((new-coords (print-region-new-buffer start end)))
8fa64b34 RS	169	(setq start (car new-coords) end (cdr new-coords))
d6c7e99a	170	(setq tab-width width)
2adf4f61 RS	171	(save-excursion
	172	(goto-char end)
	173	(setq end (point-marker)))
d6c7e99a RS	174	(untabify (point-min) (point-max))))
d6c7e99a RS	175	(if page-headers
3a621cfe	176	(if lpr-headers-switches
5bbf28a8 RS	177	;; We handled this above by modifying SWITCHES.
5bbf28a8 RS	178	nil
7173ec77	179	;; Run a separate program to get page headers.
8fa64b34 RS	180	(let ((new-coords (print-region-new-buffer start end)))
8fa64b34 RS	181	(setq start (car new-coords) end (cdr new-coords)))
a3324470 RS	182	(apply 'call-process-region start end lpr-page-header-program
a3324470 RS	183	t t nil
887bbf18	184	(nconc (list "-h" title)
a3324470	185	lpr-page-header-switches))
3a621cfe	186	(setq start (point-min) end (point-max))))
d6c7e99a RS	187	(apply (or print-region-function 'call-process-region)
	188	(nconc (list start end lpr-command
	189	nil nil nil)
a3324470 RS	190	(nconc (and lpr-add-switches
	191	(list "-J" name))
	192	;; These belong in pr if we are using that.
	193	(and lpr-add-switches lpr-headers-switches
	194	(list "-T" title))
8748e3eb RS	195	(and (stringp printer-name)
8748e3eb RS	196	(list (concat "-P" printer-name)))
d6c7e99a	197	switches)))
2adf4f61 RS	198	(if (markerp end)
2adf4f61 RS	199	(set-marker end nil))
5bbf28a8	200	(message "Spooling%s...done" switch-string))))
d6c7e99a RS	201
d6c7e99a RS	202	;; This function copies the text between start and end
8fa64b34 RS	203	;; into a new buffer, makes that buffer current.
	204	;; It returns the new range to print from the new current buffer
	205	;; as (START . END).
	206
3a621cfe	207	(defun print-region-new-buffer (ostart oend)
8fa64b34 RS	208	(if (string= (buffer-name) " spool temp")
	209	(cons ostart oend)
	210	(let ((oldbuf (current-buffer)))
	211	(set-buffer (get-buffer-create " spool temp"))
	212	(widen) (erase-buffer)
	213	(insert-buffer-substring oldbuf ostart oend)
	214	(cons (point-min) (point-max)))))
6594deb0	215
1c2df063	216	(defun printify-region (begin end)
8c44b2ad RS	217	"Replace nonprinting characters in region with printable representations.
	218	The printable representations use ^ (for ASCII control characters) or hex.
	219	The characters tab, linefeed, space, return and formfeed are not affected."
1c2df063 ER	220	(interactive "r")
	221	(save-excursion
	222	(goto-char begin)
	223	(let (c)
	224	(while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
	225	(setq c (preceding-char))
	226	(delete-backward-char 1)
	227	(insert
	228	(if (< c ?\ )
	229	(format "\\^%c" (+ c ?@))
	230	(format "\\%02x" c)))))))
	231
977b1278 KH	232	(provide 'lpr)
977b1278 KH	233
6594deb0	234	;;; lpr.el ends here