XEmacs 21.4.9 "Informed Management".

[chise/xemacs-chise.git.1] / lisp / printer.el

diff --git a/lisp/printer.el b/lisp/printer.el
index 5783af7..9f0b6d7 100644 (file)
--- a/lisp/printer.el
+++ b/lisp/printer.el
@@ -76,6 +76,9 @@ printers."
                                   (make-device 'msprinter printer-name))))
 
 (defun Printer-clear-device ()
+  ;; relying on GC to delete the device is too error-prone since there
+  ;; only can be one anyway.
+  (and printer-current-device (delete-device printer-current-device))
   (setq printer-current-device nil))
 
 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
@@ -253,29 +256,30 @@ display of the print dialog box.
 
 If BUFFER is nil or omitted, the current buffer is used."
   (interactive (list nil (not current-prefix-arg)))
-  (let* ((print-region (and (interactive-p) (region-active-p)))
-        (start (if print-region (region-beginning) (point-min buffer)))
-        (end (if print-region (region-end) (point-max buffer))))
-    (if (or (not (valid-specifier-tag-p 'msprinter))
-           (not display-print-dialog))
-       (generic-print-region start end buffer)
-      (let* ((d (Printer-get-device))
-            (props (condition-case err
-                       (make-dialog-box 'print :device d
+  (condition-case err
+      (let* ((print-region (and (interactive-p) (region-active-p)))
+            (start (if print-region (region-beginning) (point-min buffer)))
+            (end (if print-region (region-end) (point-max buffer))))
+       (if (or (not (valid-specifier-tag-p 'msprinter))
+               (not display-print-dialog))
+           (generic-print-region start end buffer)
+         (let* ((d (Printer-get-device))
+                (props (make-dialog-box 'print :device d
                                         :allow-selection print-region
                                         :selected-page-button
-                                        (if print-region 'selection 'all))
-                     (error
-                      (Printer-clear-device)
-                      (signal (car err) (cdr err))))))
-       (and props
-            (let ((really-print-region
-                   (eq (plist-get props 'selected-page-button) 'selection)))
-              (generic-print-region (if really-print-region start
-                                      (point-min buffer))
-                                    (if really-print-region end
-                                      (point-max buffer))
-                                    buffer d props)))))))
+                                        (if print-region 'selection 'all))))
+           (and props
+                (let ((really-print-region
+                       (eq (plist-get props 'selected-page-button) 'selection)))
+                  (generic-print-region (if really-print-region start
+                                          (point-min buffer))
+                                        (if really-print-region end
+                                          (point-max buffer))
+                                        buffer d props))))))
+    (error
+     ;; Make sure we catch all errors thrown from the native code.
+     (Printer-clear-device)
+     (signal (car err) (cdr err)))))
 
 (defun generic-print-region (start end &optional buffer print-device props)
   "Print region using a printing method appropriate to the O.S. being run.
@@ -310,7 +314,10 @@ Recognized properties are the same as those in `make-dialog-box':
         ;; 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)))
+        (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))
@@ -332,7 +339,9 @@ Recognized properties are the same as those in `make-dialog-box':
                                         minibuffer none
                                         modeline-shadow-thickness 0
                                         vertical-scrollbar-visible-p nil
-                                        horizontal-scrollbar-visible-p nil))
+                                        horizontal-scrollbar-visible-p nil
+                                        [default foreground] "black"
+                                        [default background] "white"))
                                d))
                       (let* ((w (frame-root-window f))
                              (vertdpi