(xmenu_show): Don't look in menubar for core.height if no menu bar.

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

diff --git a/lisp/lpr.el b/lisp/lpr.el
index d6b3723..cd68c41 100644 (file)
--- a/lisp/lpr.el
+++ b/lisp/lpr.el
@@ -1,9 +1,9 @@
 ;;; lpr.el --- print Emacs buffer on line printer.
 
-;; Maintainer: FSF
-;; Last-Modified: 19 Apr 1992
+;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
 
-;; Copyright (C) 1985, 1988, 1992 Free Software Foundation, Inc.
+;; Maintainer: FSF
+;; Keywords: unix
 
 ;; This file is part of GNU Emacs.
 
@@ -21,16 +21,31 @@
 ;; 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
-(defconst lpr-switches nil "\
-*List of strings to pass as extra switch args to lpr when it is invoked.")
+(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'.")
 
-(defvar lpr-command (if (eq system-type 'usg-unix-v)
-                       "lp" "lpr")
+;;;###autoload
+(defvar lpr-command
+  (if (memq system-type '(usg-unix-v dgux hpux irix))
+      "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.
 See definition of `print-region-1' for calling conventions.")
@@ -72,32 +87,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)
+                   (nconc (and lpr-add-options
                                (list "-J" name "-T" name))
                           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