Mercurial > hg > xemacs-beta

comparison lisp/packages/lpr.el @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents 34a5b81f86ba
children
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
113 `lpr-switches' is a list of extra switches (strings) to pass to lpr." 113 `lpr-switches' is a list of extra switches (strings) to pass to lpr."
114 (interactive "r") 114 (interactive "r")
115 (print-region-1 start end lpr-switches t)) 115 (print-region-1 start end lpr-switches t))
116 116
117 ;; XEmacs change 117 ;; XEmacs change
118 (require 'message) ; Until We can get some sensible autoloads, or 118 ;; (require 'message) ; Until We can get some sensible autoloads, or
119 ; message-flatten-list gets put somewhere decent. 119 ; message-flatten-list gets put somewhere decent.
120 ;; Sigh ...
121 ;; `ps-flatten-list' is defined here (copied from "message.el" and
122 ;; enhanced to handle dotted pairs as well) until we can get some
123 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
124
125 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
126 ;; => (a b c d e f g h i j)
127
128 (defun lpr-flatten-list (&rest list)
129 (lpr-flatten-list-1 list))
130
131 (defun lpr-flatten-list-1 (list)
132 (cond
133 ((null list) (list))
134 ((consp list)
135 (append (lpr-flatten-list-1 (car list))
136 (lpr-flatten-list-1 (cdr list))))
137 (t (list list))))
138
120 (defun print-region-1 (start end switches page-headers) 139 (defun print-region-1 (start end switches page-headers)
121 ;; On some MIPS system, having a space in the job name 140 ;; On some MIPS system, having a space in the job name
122 ;; crashes the printer demon. But using dashes looks ugly 141 ;; crashes the printer demon. But using dashes looks ugly
123 ;; and it seems to annoying to do for that MIPS system. 142 ;; and it seems to annoying to do for that MIPS system.
124 (let ((name (concat (buffer-name) " Emacs buffer")) 143 (let ((name (concat (buffer-name) " Emacs buffer"))
137 ;; to get page headers. 156 ;; to get page headers.
138 (setq switches (append (if (stringp lpr-headers-switches) 157 (setq switches (append (if (stringp lpr-headers-switches)
139 (list lpr-headers-switches) 158 (list lpr-headers-switches)
140 lpr-headers-switches) 159 lpr-headers-switches)
141 switches)))) 160 switches))))
142 (setq nswitches (message-flatten-list ; XEmacs 161 (setq nswitches (lpr-flatten-list ; XEmacs
143 (mapcar '(lambda (arg) ; Dynamic evaluation 162 (mapcar '(lambda (arg) ; Dynamic evaluation
144 (cond ((stringp arg) arg) 163 (cond ((stringp arg) arg)
145 ((functionp arg) (apply arg nil)) 164 ((functionp arg) (apply arg nil))
146 ((symbolp arg) (eval arg)) 165 ((symbolp arg) (eval arg))
147 ((consp arg) (apply (car arg) 166 ((consp arg) (apply (car arg)