home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / lpr.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  4.6 KB  |  140 lines
  1. ;;; lpr.el --- print Emacs buffer on line printer.
  2.  
  3. ;; Copyright (C) 1985, 1988, 1992, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Maintainer: FSF
  6. ;; Keywords: unix
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; Synched up with: Not synched with FSF.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;; Commands to send the region or a buffer your printer.  Entry points
  29. ;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
  30. ;; variables include `lpr-switches' and `lpr-command'.
  31.  
  32. ;;; Code:
  33.  
  34. ;;;###autoload
  35. (defvar lpr-switches nil
  36.   "*List of strings to pass as extra switch args to lpr when it is invoked.")
  37.  
  38. ;;;###autoload
  39. (defvar lpr-command
  40.   (if (memq system-type
  41.             '(usg-unix-v dgux-unix hpux silicon-graphics-unix))
  42.       "lp" "lpr")
  43.   "*Shell command for printing a file")
  44.  
  45. (defvar print-region-function nil
  46.   "Function to call to print the region on a printer.
  47. See definition of `print-region-1' for calling conventions.")
  48.  
  49. ;;;###autoload
  50. (defun lpr-buffer ()
  51.   "Print buffer contents as with Unix command `lpr'.
  52. `lpr-switches' is a list of extra switches (strings) to pass to lpr."
  53.   (interactive)
  54.   (print-region-1 (point-min) (point-max) lpr-switches nil))
  55.  
  56. ;;;###autoload
  57. (defun print-buffer ()
  58.   "Print buffer contents as with Unix command `lpr -p'.
  59. `lpr-switches' is a list of extra switches (strings) to pass to lpr."
  60.   (interactive)
  61.   (print-region-1 (point-min) (point-max) lpr-switches t))
  62.  
  63. ;;;###autoload
  64. (defun lpr-region (start end)
  65.   "Print region contents as with Unix command `lpr'.
  66. `lpr-switches' is a list of extra switches (strings) to pass to lpr."
  67.   (interactive "r")
  68.   (print-region-1 start end lpr-switches nil))
  69.  
  70. ;;;###autoload
  71. (defun print-region (start end)
  72.   "Print region contents as with Unix command `lpr -p'.
  73. `lpr-switches' is a list of extra switches (strings) to pass to lpr."
  74.   (interactive "r")
  75.   (print-region-1 start end lpr-switches t))
  76.  
  77. (defun print-region-1 (start end switches page-headers)
  78.   (let ((name (concat (buffer-name) " Emacs buffer"))
  79.     (width tab-width))
  80.     (save-excursion
  81.       (message "Spooling...")
  82.       (if (/= tab-width 8)
  83.       (progn
  84.         (print-region-new-buffer) ; see below (start end)
  85.         (setq tab-width width)
  86.         (save-excursion
  87.           (goto-char end)
  88.           (setq end (point-marker)))
  89.         (untabify (point-min) (point-max))))
  90.       (if page-headers
  91.       (if (eq system-type 'usg-unix-v)
  92.           (progn
  93.         (print-region-new-buffer) ; see below (start end)
  94.         (call-process-region start end "pr" t t nil)
  95.         (setq start (point-min) end (point-max)))
  96.         ;; On BSD, use an option to get page headers.
  97.         (setq switches (and (equal lpr-command "lpr")
  98.                 (cons "-p" switches)))))
  99.       (apply (or print-region-function 'call-process-region)
  100.          (nconc (list start end lpr-command
  101.               nil nil nil)
  102.             (nconc (and (eq system-type 'berkeley-unix)
  103.                 (equal lpr-command "lpr")
  104.                 (list "-J" name "-T" name))
  105.                switches)))
  106.       (if (markerp end)
  107.       (set-marker end nil))
  108.       (message "Spooling...done"))))
  109.  
  110. ;; This function copies the text between start and end
  111. ;; into a new buffer, makes that buffer current,
  112. ;; and sets start and end to the buffer bounds.
  113. ;; start and end are used free.
  114. ;; (hey you loser if you want them to be used free, they can't be args.)
  115. (defun print-region-new-buffer () ;(start end)
  116.   (or (string= (buffer-name) " *spool temp*")
  117.       (let ((oldbuf (current-buffer)))
  118.     (set-buffer (get-buffer-create " *spool temp*"))
  119.     (widen) (erase-buffer)
  120.     (insert-buffer-substring oldbuf start end)
  121.     (setq start (point-min) end (point-max)))))
  122.  
  123. (defun printify-region (begin end)
  124.   "Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF)
  125. in the current buffer into printable representations as control or
  126. hexadecimal escapes."
  127.   (interactive "r")
  128.   (save-excursion
  129.     (goto-char begin)
  130.     (let (c)
  131.       (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
  132.     (setq c (preceding-char))
  133.     (delete-backward-char 1)
  134.     (insert 
  135.      (if (< c ?\ )
  136.          (format "\\^%c" (+ c ?@))
  137.        (format "\\%02x" c)))))))
  138.  
  139. ;;; lpr.el ends here
  140.