- (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))))
+ (lpr-print-region start end switches name))))
+
+(defun lpr-print-region (start end switches name)
+ (let ((buf (current-buffer))
+ (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)
+ (with-temp-buffer
+ (let ((retval
+ (let ((tempbuf (current-buffer)))
+ (with-current-buffer buf
+ (apply (or print-region-function 'call-process-region)
+ start end lpr-command
+ nil tempbuf nil
+ (nconc (and name lpr-add-switches
+ (list "-J" name))
+ ;; These belong in pr if we are using that.
+ (and name lpr-add-switches lpr-headers-switches
+ (list "-T" name))
+ (and (stringp printer-name)
+ (string< "" printer-name)
+ (list (concat lpr-printer-switch
+ printer-name)))
+ nswitches))))))
+ (if (markerp end)
+ (set-marker end nil))
+ (funcall (if (memq retval '(nil 0)) #'message #'user-error)
+ "Spooling%s...done%s%s" switch-string
+ (pcase (count-lines (point-min) (point-max))
+ (0 "")
+ (1 ": ")
+ (_ ":\n"))
+ (buffer-string))))))