Mercurial > hg > xemacs-beta

comparison lisp/packages/lpr.el @ 6:27bc7f280385 r19-15b4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b4
author cvs
date Mon, 13 Aug 2007 08:47:15 +0200
parents ac2d302a0011
children 131b0175ea99
comparison
equal deleted inserted replaced
5:49b78a777eb4 6:27bc7f280385
93 "Print region contents as with Unix command `lpr -p'. 93 "Print region contents as with Unix command `lpr -p'.
94 `lpr-switches' is a list of extra switches (strings) to pass to lpr." 94 `lpr-switches' is a list of extra switches (strings) to pass to lpr."
95 (interactive "r") 95 (interactive "r")
96 (print-region-1 start end lpr-switches t)) 96 (print-region-1 start end lpr-switches t))
97 97
98 ;; XEmacs change
99 (require 'message) ; Until We can get some sensible autoloads, or
100 ; message-flatten-list gets put somewhere decent.
98 (defun print-region-1 (start end switches page-headers) 101 (defun print-region-1 (start end switches page-headers)
99 ;; On some MIPS system, having a space in the job name 102 ;; On some MIPS system, having a space in the job name
100 ;; crashes the printer demon. But using dashes looks ugly 103 ;; crashes the printer demon. But using dashes looks ugly
101 ;; and it seems to annoying to do for that MIPS system. 104 ;; and it seems to annoying to do for that MIPS system.
102 (let ((name (concat (buffer-name) " Emacs buffer")) 105 (let ((name (concat (buffer-name) " Emacs buffer"))
104 ;; On MS-DOS systems, make pipes use binary mode if the 107 ;; On MS-DOS systems, make pipes use binary mode if the
105 ;; original file is binary. 108 ;; original file is binary.
106 (binary-process-input buffer-file-type) 109 (binary-process-input buffer-file-type)
107 (binary-process-output buffer-file-type) 110 (binary-process-output buffer-file-type)
108 (width tab-width) 111 (width tab-width)
112 nswitches
109 switch-string) 113 switch-string)
110 (save-excursion 114 (save-excursion
111 (if page-headers 115 (if page-headers
112 (if lpr-headers-switches 116 (if lpr-headers-switches
113 ;; It is possible to use an lpr option 117 ;; It is possible to use an lpr option
114 ;; to get page headers. 118 ;; to get page headers.
115 (setq switches (append (if (stringp lpr-headers-switches) 119 (setq switches (append (if (stringp lpr-headers-switches)
116 (list lpr-headers-switches) 120 (list lpr-headers-switches)
117 lpr-headers-switches) 121 lpr-headers-switches)
118 switches)))) 122 switches))))
123 (setq nswitches (message-flatten-list ; XEmacs
124 (mapcar '(lambda (arg) ; Dynamic evaluation
125 (cond ((stringp arg) arg)
126 ((functionp arg) (apply arg nil))
127 ((symbolp arg) (eval arg))
128 ((consp arg) (apply (car arg)
129 (cdr arg)))
130 (t nil)))
131 switches)))
119 (setq switch-string 132 (setq switch-string
120 (if switches (concat " with options " 133 (if nswitches (concat " with options "
121 (mapconcat 'identity switches " ")) 134 (mapconcat 'identity nswitches " "))
122 "")) 135 ""))
123 (message "Spooling%s..." switch-string) 136 (message "Spooling%s..." switch-string)
124 (if (/= tab-width 8) 137 (if (/= tab-width 8)
125 (let ((new-coords (print-region-new-buffer start end))) 138 (let ((new-coords (print-region-new-buffer start end)))
126 (setq start (car new-coords) end (cdr new-coords)) 139 (setq start (car new-coords) end (cdr new-coords))
148 (nconc (and lpr-add-switches 161 (nconc (and lpr-add-switches
149 (list "-J" name)) 162 (list "-J" name))
150 ;; These belong in pr if we are using that. 163 ;; These belong in pr if we are using that.
151 (and lpr-add-switches lpr-headers-switches 164 (and lpr-add-switches lpr-headers-switches
152 (list "-T" title)) 165 (list "-T" title))
153 switches))) 166 nswitches)))
154 (if (markerp end) 167 (if (markerp end)
155 (set-marker end nil)) 168 (set-marker end nil))
156 (message "Spooling%s...done" switch-string)))) 169 (message "Spooling%s...done" switch-string))))
157 170
158 ;; This function copies the text between start and end 171 ;; This function copies the text between start and end