diff lisp/printer.el @ 506:39ccc7dd8077

[xemacs-hg @ 2001-05-05 08:39:59 by ben] Add Page Setup for Windows, take out Pretty Print. Implement Page Setup. Handle errors properly. Change top/bottom margin defaults to 0.5 inches.
author ben
date Sat, 05 May 2001 08:40:06 +0000
parents 98fb34b6fbe9
children 5bdbc721d46a
line wrap: on
line diff
--- a/lisp/printer.el	Sat May 05 08:26:04 2001 +0000
+++ b/lisp/printer.el	Sat May 05 08:40:06 2001 +0000
@@ -53,8 +53,7 @@
 ;; hidden from the user and there is a consistent set of options to
 ;; control how to print, which works across all implementations.
 ;;
-;; The code here is just a start and needs a huge amount of work.  Probably
-;; the interfaces below will change and the functions renamed.
+;; The code here currently only really supports Windows.
 
 (defgroup printing nil
   "Generic printing support."
@@ -70,6 +69,15 @@
 
 (defstruct Print-context pageno window start-time printer-name)
 
+(defvar printer-current-device nil)
+
+(defun Printer-get-device ()
+  (or printer-current-device (setq printer-current-device
+				   (make-device 'msprinter printer-name))))
+
+(defun Printer-clear-device ()
+  (setq printer-current-device nil))
+
 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
 "*Controls printed page header.
 
@@ -211,6 +219,23 @@
       (t (error 'invalid-argument "Unrecognized print-context property"
 		prop)))))
 
+(defun generic-page-setup ()
+  "Display the Page Setup dialog box.
+Changes made are recorded internally."
+  (interactive)
+  (let* ((d (Printer-get-device))
+	 (props
+	  (condition-case err
+	      (make-dialog-box 'page-setup :device d
+			       :properties default-msprinter-frame-plist)
+	    (error
+	     (Printer-clear-device)
+	     (signal (car err) (cdr err))))))
+    (while props
+      (setq default-msprinter-frame-plist
+	    (plist-put default-msprinter-frame-plist (car props) (cadr props)))
+      (setq props (cddr props)))))
+
 (defun generic-print-buffer (&optional buffer display-print-dialog)
   "Print buffer BUFFER using a printing method appropriate to the O.S. being run.
 Under Unix, `lpr' is normally used to spool out a no-frills version of the
@@ -231,8 +256,12 @@
   (if (or (not (valid-specifier-tag-p 'msprinter))
 	  (not display-print-dialog))
       (generic-print-region (point-min buffer) (point-max buffer) buffer)
-    (let* ((d (make-device 'msprinter printer-name))
-	   (props (make-dialog-box 'print :device d)))
+    (let* ((d (Printer-get-device))
+	   (props (condition-case err
+		      (make-dialog-box 'print :device d)
+		    (error
+		     (Printer-clear-device)
+		     (signal (car err) (cdr err))))))
       (and props (generic-print-region (point-min buffer)
 				       (point-max buffer) buffer
 				       d props)))))
@@ -270,8 +299,7 @@
 	   (setq buffer (decode-buffer buffer))
 	   (unwind-protect
 	       (progn
-		 (setq d (or print-device
-			     (make-device 'msprinter printer-name)))
+		 (setq d (or print-device (Printer-get-device)))
 		 (setq f (make-frame
 			  (list* 'name (concat
 					(substitute ?_ ?. (buffer-name buffer))
@@ -389,7 +417,6 @@
 			 (setq pageno (1+ pageno))))
 		     (setq copies (1- copies)))))
 	     (and f (delete-frame f))
-	     (and d (delete-device d))
 	     (and header-buffer (kill-buffer header-buffer))
 	     (and footer-buffer (kill-buffer footer-buffer))
 	     )))