Mercurial > hg > xemacs-beta

comparison lisp/packages/lpr.el @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 27bc7f280385
children 54cc21c15cbb
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
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.
101 (defun print-region-1 (start end switches page-headers) 98 (defun print-region-1 (start end switches page-headers)
102 ;; On some MIPS system, having a space in the job name 99 ;; On some MIPS system, having a space in the job name
103 ;; crashes the printer demon. But using dashes looks ugly 100 ;; crashes the printer demon. But using dashes looks ugly
104 ;; and it seems to annoying to do for that MIPS system. 101 ;; and it seems to annoying to do for that MIPS system.
105 (let ((name (concat (buffer-name) " Emacs buffer")) 102 (let ((name (concat (buffer-name) " Emacs buffer"))
107 ;; On MS-DOS systems, make pipes use binary mode if the 104 ;; On MS-DOS systems, make pipes use binary mode if the
108 ;; original file is binary. 105 ;; original file is binary.
109 (binary-process-input buffer-file-type) 106 (binary-process-input buffer-file-type)
110 (binary-process-output buffer-file-type) 107 (binary-process-output buffer-file-type)
111 (width tab-width) 108 (width tab-width)
112 nswitches
113 switch-string) 109 switch-string)
114 (save-excursion 110 (save-excursion
115 (if page-headers 111 (if page-headers
116 (if lpr-headers-switches 112 (if lpr-headers-switches
117 ;; It is possible to use an lpr option 113 ;; It is possible to use an lpr option
118 ;; to get page headers. 114 ;; to get page headers.
119 (setq switches (append (if (stringp lpr-headers-switches) 115 (setq switches (append (if (stringp lpr-headers-switches)
120 (list lpr-headers-switches) 116 (list lpr-headers-switches)
121 lpr-headers-switches) 117 lpr-headers-switches)
122 switches)))) 118 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)))
132 (setq switch-string 119 (setq switch-string
133 (if nswitches (concat " with options " 120 (if switches (concat " with options "
134 (mapconcat 'identity nswitches " ")) 121 (mapconcat 'identity switches " "))
135 "")) 122 ""))
136 (message "Spooling%s..." switch-string) 123 (message "Spooling%s..." switch-string)
137 (if (/= tab-width 8) 124 (if (/= tab-width 8)
138 (let ((new-coords (print-region-new-buffer start end))) 125 (let ((new-coords (print-region-new-buffer start end)))
139 (setq start (car new-coords) end (cdr new-coords)) 126 (setq start (car new-coords) end (cdr new-coords))
161 (nconc (and lpr-add-switches 148 (nconc (and lpr-add-switches
162 (list "-J" name)) 149 (list "-J" name))
163 ;; These belong in pr if we are using that. 150 ;; These belong in pr if we are using that.
164 (and lpr-add-switches lpr-headers-switches 151 (and lpr-add-switches lpr-headers-switches
165 (list "-T" title)) 152 (list "-T" title))
166 nswitches))) 153 switches)))
167 (if (markerp end) 154 (if (markerp end)
168 (set-marker end nil)) 155 (set-marker end nil))
169 (message "Spooling%s...done" switch-string)))) 156 (message "Spooling%s...done" switch-string))))
170 157
171 ;; This function copies the text between start and end 158 ;; This function copies the text between start and end