-PostScript printer. Under MS Windows, the built-in printing support is used."
- (cond ((valid-specifier-tag-p 'msprinter)
- (or (stringp printer-name)
- (error "Please set `printer-name'"))
- (let (d f)
- (setq buf (decode-buffer buf))
- (unwind-protect
- (progn
- (setq d (make-device 'msprinter printer-name))
- (setq f (make-frame
- (list* 'name (concat (substitute ?_ ?.
- (buffer-name buf))
- " - XEmacs")
- '(menubar-visible-p nil
- has-modeline-p nil
- default-toolbar-visible-p nil
- default-gutter-visible-p nil
- minibuffer none
- modeline-shadow-thickness 0
- vertical-scrollbar-visible-p nil
- horizontal-scrollbar-visible-p nil))
- d))
- (let* ((w (frame-root-window f))
- (vertdpi (cdr (device-system-metric d 'device-dpi)))
- (pixel-vertical-clip-threshold (/ vertdpi 2))
- (last-end 0)
- done)
- (set-window-buffer w (or buf (current-buffer)))
- (set-window-start w b)
- (while (not done)
- (redisplay-frame f)
- (print-job-eject-page f)
- (let ((end (window-end w))
- (pixvis (window-last-line-visible-height w)))
- ;; in case we get stuck somewhere, bow out
- ;; rather than printing an infinite number of
- ;; pages. #### this will fail with an image
- ;; bigger than an entire page. but we really
- ;; need this check here. we should be more
- ;; clever in our check, to deal with this case.
- (if (or (= end last-end)
- ;; #### fuckme! window-end returns a value
- ;; outside of the valid range of buffer
- ;; positions!!!
- (>= end e))
- (setq done t)
- (setq last-end end)
- (set-window-start w end)
- (if pixvis
- (save-selected-window
- (select-window w)
- ;; #### scroll-down should take a window arg.
- (let ((window-pixel-scroll-increment pixvis))
- (scroll-down 1)))))))))
- (and f (delete-frame f))
- (and d (delete-device d))
- )))
+PostScript printer. Under MS Windows, the built-in printing support is used.
+
+Optional PRINT-DEVICE is a device, already created, to use to do the
+printing. This is typically used when this function was invoked from
+`generic-print-buffer' and it displayed a dialog box. That function created
+the device, and then the dialog box stuffed it with the user's selections
+of how the buffer should be printed.
+
+PROPS, if given, is typically the plist returned from the call to
+`make-dialog-box' that displayed the Print box. It contains properties
+relevant to us when we print.
+
+Recognized properties are the same as those in `make-dialog-box':
+
+ name Printer device name. If omitted, the current system-selected
+ printer will be used.
+ from-page First page to print, 1-based. If omitted, printing starts from
+ the beginning.
+ to-page Last page to print, inclusive, If omitted, printing ends at
+ the end.
+ copies Number of copies to print. If omitted, one copy is printed."
+ (cond ((valid-device-type-p 'msprinter)
+ ;; loop, printing one copy of document per loop. kill and
+ ;; re-create the frame each time so that we eject the piece
+ ;; of paper at the end even if we're printing more than one
+ ;; page per sheet of paper.
+ (let ((copies (plist-get props 'copies 1))
+ ;; This is not relevant to printing and can mess up
+ ;; msprinter frame sizing
+ default-frame-plist)
+ (while (> copies 0)
+ (let (d f header-buffer footer-buffer)
+ (setq buffer (decode-buffer buffer))
+ (unwind-protect
+ (with-current-buffer buffer
+ (save-restriction
+ (narrow-to-region start end)
+ (setq d (or print-device (Printer-get-device)))
+ (setq f (make-frame
+ (list* 'name
+ (concat
+ (substitute ?_ ?. (buffer-name buffer))
+ " - XEmacs")
+ '(menubar-visible-p
+ nil
+ has-modeline-p nil
+ default-toolbar-visible-p nil
+ default-gutter-visible-p nil
+ minibuffer none
+ modeline-shadow-thickness 0
+ vertical-scrollbar-visible-p nil
+ horizontal-scrollbar-visible-p nil
+ [default foreground] "black"
+ [default background] "white"))
+ d))
+ (let* ((w (frame-root-window f))
+ (vertdpi
+ (cdr (device-system-metric d 'device-dpi)))
+ (pixel-vertical-clip-threshold (/ vertdpi 2))
+ (from-page (plist-get props 'from-page 1))
+ (to-page (plist-get props 'to-page))
+ (context (make-Print-context
+ :start-time (current-time)
+ ;; #### bogus! we need accessors for
+ ;; print-settings objects.
+ :printer-name
+ (or (plist-get props 'name)
+ printer-name
+ (mswindows-get-default-printer))))
+ header-window
+ footer-window)
+
+ (when printer-page-header
+ (let ((window-min-height 2))
+ (setq header-window w)
+ (setq w (split-window w 2)))
+ (setq header-buffer
+ (generate-new-buffer " *header*"))
+ (set-window-buffer header-window header-buffer))
+
+ (when printer-page-footer
+ (let ((window-min-height 2))
+ (setq footer-window
+ (split-window w (- (window-height w) 2))))
+ (setq footer-buffer
+ (generate-new-buffer " *footer*"))
+ (set-window-buffer footer-window footer-buffer))
+
+ (setf (Print-context-window context) w)
+
+ (let ((last-end 0) ; bufpos at end of previous page
+ reached-end ; t if we've reached the end of the
+ ; text we're printing
+ (pageno 1))
+ (set-window-buffer w buffer)
+ (set-window-start w start)
+
+ ;; loop, printing one page per loop
+ (while (and (not reached-end)
+ ;; stop at end of region of text or
+ ;; outside of ranges of pages given
+ (or (not to-page) (<= pageno to-page)))
+
+ (setf (Print-context-pageno context) pageno)
+
+ ;; only actually print the page if it's in the
+ ;; range.
+ (when (>= pageno from-page)
+ (when printer-page-header
+ (with-current-buffer header-buffer
+ (erase-buffer)
+ (generate-header-line printer-page-header
+ context)
+ (goto-char (point-min))
+ (set-window-start header-window
+ (point-min))))
+
+ (when printer-page-footer
+ (with-current-buffer footer-buffer
+ (erase-buffer)
+ (insert "\n")
+ (generate-header-line printer-page-footer
+ context)
+ (goto-char (point-min))
+ (set-window-start footer-window
+ (point-min))))
+
+ (redisplay-frame f t)
+ (print-job-eject-page f)
+ )
+ ;; but use the GUARANTEE argument to `window-end'
+ ;; so that we get the right value even if we
+ ;; didn't do a redisplay.
+ (let ((this-end (window-end w t))
+ (pixvis
+ (window-last-line-visible-height w)))
+ ;; in case we get stuck somewhere, bow out
+ ;; rather than printing an infinite number of
+ ;; pages. #### this will fail with an image
+ ;; bigger than an entire page. but we really
+ ;; need this check here. we should be more
+ ;; clever in our check, to deal with this case.
+ (if (or (= this-end last-end)
+ ;; #### fuckme! window-end returns a
+ ;; value outside of the valid range of
+ ;; buffer positions!!!
+ (>= this-end end))
+ (setq reached-end t)
+ (setq last-end this-end)
+ (set-window-start w this-end)
+ (if pixvis
+ (with-selected-window w
+ ;; #### scroll-down should take a
+ ;; window arg.
+ (let ((window-pixel-scroll-increment
+ pixvis))
+ (scroll-down 1))))))
+ (setq pageno (1+ pageno))))))
+ (and f (delete-frame f))
+ (and header-buffer (kill-buffer header-buffer))
+ (and footer-buffer (kill-buffer footer-buffer)))))
+ (setq copies (1- copies)))))