From 4ad25e4311961dd134b167fd51a3d968f58bd728 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 30 Jan 2001 12:04:05 +0000 Subject: [PATCH] XEmacs compatibility and doc fixes from Vinicius Jose Latorre : (lpr-windows-system, lpr-lp-system): New vars. (lpr-printer-switch): New defcustom. (printer-name, lpr-command): Customization fix. (print-region-1): Code fix. (print-region-new-buffer, printify-region): Indentation fix. (lpr-eval-switch, lpr-flatten-list, lpr-flatten-list-1): New funcsions. --- lisp/ChangeLog | 11 ++++ lisp/lpr.el | 159 ++++++++++++++++++++++++++++++++----------------- 2 files changed, 116 insertions(+), 54 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index a6b085cd5c..7317481ce8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,14 @@ +2001-01-30 Vinicius Jose Latorre + + * lpr.el: Compatibility with XEmacs and doc fixes. + (lpr-windows-system, lpr-lp-system): New vars. + (lpr-printer-switch): New defcustom. + (printer-name, lpr-command): Customization fix. + (print-region-1): Code fix. + (print-region-new-buffer, printify-region): Indentation fix. + (lpr-eval-switch, lpr-flatten-list, lpr-flatten-list-1): New + functions. + 2001-01-29 Gerd Moellmann * msb.el (toplevel): Fix the eval-after-load. diff --git a/lisp/lpr.el b/lisp/lpr.el index 21a1ed24f8..6f6f3d53b2 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -1,9 +1,9 @@ ;;; lpr.el --- print Emacs buffer on line printer. -;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1988, 1992, 1994, 2001 Free Software Foundation, Inc. -;; Maintainer: FSF -;; Keywords: unix +;; Maintainer: FSF +;; Keywords: unix ;; This file is part of GNU Emacs. @@ -30,13 +30,21 @@ ;;; Code: +(defvar lpr-windows-system + (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) + +(defvar lpr-lp-system + (memq system-type '(usg-unix-v dgux hpux irix))) + + (defgroup lpr nil "Print Emacs buffer on line printer" :group 'wp) + ;;;###autoload (defcustom printer-name - (if (memq system-type '(ms-dos windows-nt)) "PRN") + (and lpr-windows-system "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.\) @@ -50,13 +58,15 @@ printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"//hostname/printer\" for a shared network printer. You can also set it to the 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)) + :type '(choice :menu-tag "Printer Name" + :tag "Printer Name" + (const :tag "Default" nil) + ;; could use string but then we lose completion for files. + (file :tag "Name")) :group 'lpr) ;;;###autoload -(defcustom lpr-switches nil +(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. @@ -72,12 +82,24 @@ this variable should be nil." :type 'boolean :group 'lpr) +(defcustom lpr-printer-switch + (if lpr-lp-system + "-d " + "-P") + "*Printer switch, that is, something like \"-P\", \"-d \", \"/D:\", etc. +This switch is used in conjunction with `printer-name'." + :type '(choice :menu-tag "Printer Name Switch" + :tag "Printer Name Switch" + (const :tag "None" nil) + (string :tag "Printer Switch")) + :group 'lpr) + ;;;###autoload (defcustom lpr-command (cond - ((memq system-type '(ms-dos windows-nt)) + (lpr-windows-system "") - ((memq system-type '(usg-unix-v dgux hpux irix)) + (lpr-lp-system "lp") (t "lpr")) @@ -175,34 +197,37 @@ for further customization of the printer command." ;; 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")) + (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)) + (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) + nswitches 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 " ")) - "")) + (and page-headers lpr-headers-switches + ;; It's 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 nswitches (lpr-flatten-list + (mapcar 'lpr-eval-switch ; Dynamic evaluation + switches)) + 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) + (setq start (car new-coords) + end (cdr new-coords) + tab-width width) (save-excursion (goto-char end) (setq end (point-marker))) @@ -213,26 +238,23 @@ for further customization of the printer command." 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 - lpr-page-header-switches) - (setq start (point-min) end (point-max)))) - (let ((printer-name-switch (if (memq system-type - '(usg-unix-v dgux hpux irix)) - "-d" "-P"))) - (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 printer-name-switch - printer-name))) - switches)))) + (apply 'call-process-region (car new-coords) (cdr new-coords) + lpr-page-header-program t t nil + 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) + (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 lpr-printer-switch + printer-name))) + nswitches)) (if (markerp end) (set-marker end nil)) (message "Spooling%s...done" switch-string)))) @@ -247,7 +269,8 @@ for further customization of the printer command." (cons ostart oend) (let ((oldbuf (current-buffer))) (set-buffer (get-buffer-create " *spool temp*")) - (widen) (erase-buffer) + (widen) + (erase-buffer) (insert-buffer-substring oldbuf ostart oend) (cons (point-min) (point-max))))) @@ -262,10 +285,38 @@ The characters tab, linefeed, space, return and formfeed are not affected." (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))))))) + (insert (if (< c ?\ ) + (format "\\^%c" (+ c ?@)) + (format "\\%02x" c))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions hacked from `ps-print' package. + +;; Dynamic evaluation +(defun lpr-eval-switch (arg) + (cond ((stringp arg) arg) + ((functionp arg) (apply arg nil)) + ((symbolp arg) (symbol-value arg)) + ((consp arg) (apply (car arg) (cdr arg))) + (t nil))) + +;; `lpr-flatten-list' is defined here (copied from "message.el" and +;; enhanced to handle dotted pairs as well) until we can get some +;; sensible autoloads, or `flatten-list' gets put somewhere decent. + +;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j)) +;; => (a b c d e f g h i j) + +(defun lpr-flatten-list (&rest list) + (lpr-flatten-list-1 list)) + +(defun lpr-flatten-list-1 (list) + (cond + ((null list) (list)) + ((consp list) + (append (lpr-flatten-list-1 (car list)) + (lpr-flatten-list-1 (cdr list)))) + (t (list list)))) (provide 'lpr) -- 2.20.1