(read_char): After read_char_minibuf_menu_prompt,

[gnu-emacs] / lisp / lpr.el

diff --git a/lisp/lpr.el b/lisp/lpr.el
index 5c363301747af691806d2ddc5002fcffb54258d3..7f5ff8d15426bca78ed15680ce4fe7aadbef17db 100644 (file)
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,11 +1,15 @@
-;; Print Emacs buffer on line printer.
-;; Copyright (C) 1985, 1988 Free Software Foundation, Inc.
+;;; 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 1, or (at your option)
+;; 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,
@@ -17,13 +21,30 @@
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, 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 `lpr-switches' and `lpr-command'.
+
+;;; Code:
+
+;;;###autoload
+(defvar lpr-switches nil 
+  "*List of strings to pass as extra switch args to `lpr' when it is invoked.")
+
+(defvar lpr-add-options (eq system-type 'berkeley-unix)
+  "*Non-nil means construct -T and -J options for the `lpr'.")
 
-;;;###autoload (defconst lpr-switches nil
-;;;###autoload   "*List of strings to pass as extra switch args to lpr when it is invoked.")
+;;;###autoload
+(defvar lpr-command
+  (if (memq system-type '(usg-unix-v dgux hpux irix))
+      "lp" "lpr")
+  "*Shell command for printing a file")
 
-(defvar lpr-command (if (eq system-type 'usg-unix-v)
-                       "lp" "lpr")
-  "Shell command for printing a file")
+(defvar lpr-headers-switches
+  (if (memq system-type '(usg-unix-v hpux)) nil "-p")
+  "*List of strings to use as options for `lpr' to request page headings.")
 
 (defvar print-region-function nil
   "Function to call to print the region on a printer.
@@ -58,7 +79,11 @@ See definition of `print-region-1' for calling conventions.")
   (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"))
        (width tab-width))
     (save-excursion
       (message "Spooling...")
@@ -66,30 +91,56 @@ See definition of `print-region-1' for calling conventions.")
          (progn
            (print-region-new-buffer start end)
            (setq tab-width width)
+           (save-excursion
+             (goto-char end)
+             (setq end (point-marker)))
            (untabify (point-min) (point-max))))
       (if page-headers
-         (if (eq system-type 'usg-unix-v)
-             (progn
-               (print-region-new-buffer)
-               (call-process-region start end "pr" t t nil))
-           ;; On BSD, use an option to get page headers.
-           (setq switches (cons "-p" switches))))
+         (if lpr-headers-switches
+             ;; On BSD, use an option to get page headers.
+             (setq switches (append (if (stringp lpr-headers-switches)
+                                        (list lpr-headers-switches)
+                                       lpr-headers-switches)
+                                    switches))
+           (print-region-new-buffer start end)
+           (call-process-region start end "pr" t t nil)
+           (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 (eq system-type 'berkeley-unix)
-                               (list "-J" name "-T" name))
+                   (nconc (and lpr-add-options
+                               (list "-J" name "-T" title))
                           switches)))
+      (if (markerp end)
+         (set-marker end nil))
       (message "Spooling...done"))))
 
 ;; This function copies the text between start and end
 ;; into a new buffer, makes that buffer current,
 ;; and sets start and end to the buffer bounds.
 ;; start and end are used free.
-(defun print-region-new-buffer ()
+(defun print-region-new-buffer (ostart oend)
   (or (string= (buffer-name) " *spool temp*")
       (let ((oldbuf (current-buffer)))
        (set-buffer (get-buffer-create " *spool temp*"))
        (widen) (erase-buffer)
-       (insert-buffer-substring oldbuf start end)
+       (insert-buffer-substring oldbuf ostart oend)
        (setq start (point-min) end (point-max)))))
+
+(defun printify-region (begin end)
+  "Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF)
+in the current buffer into printable representations as control or
+hexadecimal escapes."
+  (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)))))))
+
+;;; lpr.el ends here