X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fprinter.el;h=9b996f964c051aada0710a67ab550d3dc1af1980;hb=126b1c706cde7fda7e1cf5f1851371a25400d5a4;hp=5783af7f381092c291ccab59281db4b30636196e;hpb=d8654f7c5ad0c04060008c6fbbd90add1f4537e3;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/printer.el b/lisp/printer.el
index 5783af7..9b996f9 100644
--- 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-device-type-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.
@@ -305,12 +309,15 @@ Recognized properties are the same as those in `make-dialog-box':
   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-specifier-tag-p 'msprinter)
+  (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)))
+	 (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