gildea@BBN.COM (Stephen Gildea) (02/15/89)
I am posting this in response to a query on this list. This version
of lpr.el works correctly with several different types of Unix and
print spooler systems. It is also more modular so if it doesn't work
on yours you should be able to get it working easily. (If you have to
fix anything to get it to work, I'd like to see your improvements.)
There is also a new command M-x lpq that displays the print queue.
You may want to add the form
(autoload 'lpq "lpr"
"Show the print queue in a temporary window." t)
to your .emacs or site-init file.
< Stephen
gildea@bbn.com
;; Print Emacs buffer on line printer.
;; Copyright (C) 1985, 1988 Free Software Foundation, Inc.
;; Modified by gildea Dec 88 to be more general.
;; This file is NOT part of GNU Emacs.
;; It is a variation by gildea.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY. No author or distributor
;; accepts responsibility to anyone for the consequences of using it
;; or for whether it serves any particular purpose or works at all,
;; unless he says so in writing. Refer to the GNU Emacs General Public
;; License for full details.
;; Everyone is granted permission to copy, modify and redistribute
;; GNU Emacs, but only under the conditions described in the
;; GNU Emacs General Public License. A copy of this license is
;; supposed to have been given to you along with GNU Emacs so you
;; can know your rights and responsibilities. It should be in a
;; file named COPYING. Among other things, the copyright notice
;; and this notice must be preserved on all copies.
(provide 'lpr)
(defvar lpr-command
(cond ((file-exists-p "/usr/spool/mdqs")
"pprint")
((eq system-type 'usg-unix-v)
"lp")
(t
"lpr"))
"Program to call to print a file. See also lpr-pretty-print-command.")
(defvar lpr-pretty-print-command t
"Program to call to pretty print a file.
Either a string which is the name of the program, or the symbol t
which means to use the value of lpr-command.")
(defvar lpr-command-switches
(cond ((string-equal lpr-command "pprint")
'("-jobname" "%s"))
((string-equal lpr-command "lp")
'("-t%s"))
(t
'("-J" "%s" "-T" "%s")))
"List of basic switches that lpr-command always needs.
This variable is for switches specific to lpr-command.
The string %s gets replaced with the name of the print job.
For user options, set lpr-switches, not this variable.")
(defvar lpr-pretty-print-command-switches
(cond ((string-equal lpr-command "pprint")
'(t "-filter" "pr -f"))
((string-equal lpr-command "lp")
'(t)) ;lp doesn't have a pretty option
(t
'(t "-p")))
"List of switches that are passed to lpr-pretty-print-command.
The \"print-\" versions of the lpr commands use this. This is a list of
strings except that the symbol t, whereever it occurs, is replaced
by all the elements of lpr-command-switches.")
;(defconst lpr-switches nil
; "*List of strings to pass as extra switch args to lpr-command.")
; should go in loaddefs.el
(defvar lpr-pretty-print-switches '(t)
"*List of strings to pass as extra switch args to lpr-pretty-print-command.
If the symbol t appears in the list, it is replaced by all the elements
of lpr-switches.")
(defvar lpq-command
(cond ((file-exists-p "/usr/spool/mdqs")
"qstat")
((eq system-type 'usg-unix-v)
"lpstat")
(t
"lpq"))
"Program to call to show the print queue. The args are in lpq-switches.")
(defvar lpq-command-switches
(cond ((string-equal lpq-command "qstat")
'("-a"))
(t
nil))
"List of switches always passed to the program lpq-command by \\[lpq].")
(defvar lpq-switches nil
"*List of switches (strings) passed to the program lpq-command by \\[lpq].
These are passed as extra switch arguments after lpq-command-switches.")
(defun lpr-buffer ()
"Print buffer contents by calling the program lpr-command.
`lpr-switches' is a list of extra switches (strings) to pass to lpr-command."
(interactive)
(print-region-1 (point-min) (point-max) lpr-command (lpr-arg-list)))
(defun print-buffer ()
"Pretty print the buffer by calling the program lpr-pretty-print-command.
`lpr-pretty-print-switches' is a list of extra switches (strings)
to pass to lpr-pretty-print-command."
(interactive)
(pretty-print-region-1 (point-min) (point-max)))
(defun lpr-region (start end)
"Print region contents by calling the program lpr-command.
`lpr-switches' is a list of extra switches (strings) to pass to lpr-command."
(interactive "r")
(print-region-1 start end lpr-command (lpr-arg-list)))
(defun print-region (start end)
"Pretty print the region by calling the program lpr-pretty-print-command.
`lpr-pretty-print-switches' is a list of extra switches (strings)
to pass to lpr-pretty-print-command."
(interactive "r")
(pretty-print-region-1 start end))
(defun lpq ()
"Show the print queue in a temporary window."
(interactive)
(with-output-to-temp-buffer "*Print Queue*"
(apply 'call-process lpq-command nil standard-output nil
(append lpq-command-switches lpq-switches))))
(defun pretty-print-region-1 (start end)
(let ((command (if (eql lpr-pretty-print-command t)
lpr-command lpr-pretty-print-command)))
(print-region-1 start end command
(nconc (lpr-substitute-for-t
lpr-pretty-print-command-switches
lpr-command-switches)
(lpr-substitute-for-t
lpr-pretty-print-switches
lpr-switches)))))
(defun print-region-1 (start end program-name switches)
(let ((print-job-name (concat (buffer-name) " Emacs buffer"))
(width tab-width))
(save-excursion
(message "Spooling...")
(if (/= tab-width 8)
(let ((oldbuf (current-buffer)))
(set-buffer (get-buffer-create " *spool temp*"))
(widen)
(erase-buffer)
(insert-buffer-substring oldbuf start end)
(setq tab-width width)
(untabify (point-min) (point-max))
(setq start (point-min) end (point-max))))
(apply 'call-process-region
start end program-name
nil nil nil
(mapcar 'lpr-format-switch switches))
(message "Spooling...done"))))
;;; This function may prove useful to other packages
(defun lpr-arg-list ()
(append lpr-command-switches lpr-switches))
(defun lpr-substitute-for-t (basiclist pattern)
;; replaces occurances of t in BASICLIST with PATTERN.
;; Neither PATTERN nor BASICLIST is destroyed. The new list is returned.
(let ((newlist nil))
(while basiclist
(setq newlist (nconc newlist
(if (eql (car basiclist) t)
(copy-sequence pattern)
(list (car basiclist)))))
(setq basiclist (cdr basiclist)))
newlist))
(defun lpr-format-switch (switch)
;; %s gets replaced by the print job name
(format switch print-job-name print-job-name print-job-name))jcgs@harlqn.harlqn.uucp (John Sturdy) (02/21/89)
And here's some stuff for selecting printers:
;;; print-select.el
;;; Last edited: Tue Apr 5 17:13:40 1988 by jcgs (John Sturdy) on harlqn
;;; controlling the printer flags; switch on or off the banners, and change
;;; the current printer
(provide 'print-select)
(defvar current-printer "lp"
"The most recently used printer - at a guess. Set to \"lp\" when a
printer mode is selected, and to \"LaserWriter\" after an \"enscript\"
operation. Used by \"lpq\". Use \"select-printer\" to set interactively -
this provides completion over the printer names defined on this system.")
(defvar current-printer-lpr-arg (concat "-P" current-printer)
"The name of the current printer, with \"-P\" prepended to it, for passing
to Unix utilities such as \"lpr\" and \"lpq\".")
(defun print-banner-on ( )
"Enable printing banner for print-buffer, print-region etcetera"
(interactive)
(setq lpr-switches (delequal "-h" lpr-switches)))
(defun print-banner-off ( )
"Disable printing banner for print-buffer, print-region etcetera"
(interactive)
(print-banner-on) ; ensure only one copy of flag
(setq lpr-switches (cons "-h" lpr-switches)))
(print-banner-off) ; my personal preference
;;; examining the printer queues
(defun lpq (&optional all-users)
"Display the printer queue for the your own entries; with a prefix
argument, display entries for all users."
(interactive "P")
(let
(
(buffer-name (concat "*" current-printer " queue*"))
(old-buffer (current-buffer))
)
(with-output-to-temp-buffer
buffer-name
(set-buffer (get-buffer buffer-name))
(message (buffer-name))
(shell-command
(concat "lpq " current-printer-lpr-arg
(if all-users
""
(concat " " (user-login-name))))
t))
(set-buffer old-buffer)))
(defvar printer-name-alist nil
"alist containing in the car parts the name strings for all printers
on this system. Used for completion in selecting a printer.")
(defun select-printer ()
"Set the current printer to one chosen by the user. Completion on printer
names is done using \"/etc/printcap\" to provide the printer names."
(interactive)
(if (null printer-name-alist) (get-printer-names))
(setq lpr-switches (delequal current-printer-lpr-arg lpr-switches))
(setq current-printer
(completing-read "Choose printer: "
printer-name-alist
nil ; predicate
t)) ; requires match
(setq current-printer-lpr-arg (concat "-P" current-printer))
(setq lpr-switches (cons current-printer-lpr-arg lpr-switches))
(save-window-excursion
(message "Checking that printer %s is OK" current-printer)
(set-buffer (get-buffer-create " *printer selection check*"))
(erase-buffer)
(shell-command (concat "lpq " current-printer-lpr-arg) t)
(goto-char (point-min))
(end-of-line) (forward-char)
(if (re-search-backward "off\\|disabled" (point-min) t) ; BUG?!?!?
(message "Problem with %s: %s"
current-printer (first-line-of-buffer))
(message "Printer %s selected" current-printer))
(kill-buffer (current-buffer))))
(defun add-printer (printer)
"Add PRINTER to the list of printers used for completion in select-printer."
(setq printer-name-alist (cons
(cons printer nil)
printer-name-alist)))
(defun get-printer-names ()
"Find all the valid printer names from \"/etc/printcap\"."
(save-window-excursion
(message "Reading /etc/printcap...")
(set-buffer (get-buffer-create " *printcap file*"))
(setq printer-name-alist nil) ; empty the name list
(erase-buffer) ; clear the buffer
(insert-file-contents "/etc/printcap" t) ; t marks as unmodified
(goto-char (point-min))
(while (re-search-forward "^[^# \t]" (point-max) t)
; scan for lines with printer names
(beginning-of-line)
(while (not (eq (char-after (- (point) 1)) ?\:))
; next line after last name on this one
(let ((start (point)))
(re-search-forward "[:|]" (point-max) t) ; get next name on line
(add-printer (buffer-substring start (- (point) 1))))))
(message "Reading /etc/printcap... done")
(kill-buffer (current-buffer))))
;;; end of print-select.el
--
__John When asked to attend a court case, Father Moses took with him
a leaking jug of water. Asked about it, he said: "You ask me to judge
the faults of another, while mine run out like water behind me."
jcgs@uk.co.harlqn (UK notation) jcgs@harlqn.co.uk (most places)
...!mcvax!ukc!harlqn!jcgs (uucp - really has more stages, but ukc knows us)
John Sturdy Telephone +44-223-872522
Harlequin Ltd, Barrington Hall, Barrington, Cambridge, UK