--- a/lisp/ChangeLog	Mon Apr 30 09:12:04 2001 +0000
+++ b/lisp/ChangeLog	Mon Apr 30 09:26:20 2001 +0000
@@ -1,3 +1,17 @@
+2001-04-30  Ben Wing  <ben@xemacs.org>
+
+	* printer.el:
+	* printer.el (printer-page-header):
+	* printer.el (Print-context): New.
+	* printer.el (printer-page-footer):
+	* printer.el (generate-header-element): New.
+	* printer.el (generate-header-line): New.
+	* printer.el (print-context-property):
+	* printer.el (generic-print-buffer):
+	* printer.el (generic-print-region):
+	Implement headers and footers.  Implement calling Print dialog box
+	(#### but it doesn't quite work yet).
+
 2001-04-28  Ben Wing  <ben@xemacs.org>
 
 	* about.el (xemacs-hackers):

--- a/lisp/printer.el	Mon Apr 30 09:12:04 2001 +0000
+++ b/lisp/printer.el	Mon Apr 30 09:26:20 2001 +0000
@@ -68,23 +68,24 @@
   :type 'string
   :group 'printing)
 
-(defcustom printer-page-header '(date buffer-name)
+(defstruct Print-context pageno window start-time printer-name)
+
+(defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
 "*Controls printed page header.
 
-#### not yet implemented.
-
 This can be:
 - nil.  Header is not printed.
 - An fbound symbol or lambda expression.  The function is called with
    one parameter, a print-context object, every time the headers need
    to be set up.  It can use the function `print-context-property' to
    query the properties of this object.  The return value is treated as
-     if it was literally specified: i.e. it will be reprocessed.
+   if it was literally specified: i.e. it will be reprocessed.
 - A list of up to three elements, for left, center and right portions
    of the header.  Each of these can be
    - nil, not to print the portion
    - A string, which will be printed literally.
    - A predefined symbol, on of the following:
+     printer-name     Name of printer being printed to
      short-file-name  File name only, no path
      long-file-name   File name with its path
      buffer-name      Buffer name
@@ -93,6 +94,8 @@
      page             Current printout page number, 1-based
      user-id          User logon id
      user-name        User full name
+   - A list of three elements: (face FACE-NAME EXPR).  EXPR is any of the
+     items given here.  The item will be displayed in the given face.
    - A cons of an extent and any of the items given here.  The item will
      be displayed using the extent's face, begin-glyph and end-glyph
      properties.
@@ -105,64 +108,179 @@
   :type 'sexp
   :group 'printing)
 
-(defcustom printer-page-footer '(nil page)
+(defcustom printer-page-footer '(nil (face bold ("Page " page)))
 "*Controls printed page footer.
 
-#### not yet implemented.
-
 Format is the same as `printer-page-header'."
   :type 'sexp
   :group 'printing)
 
+(defun generate-header-element (element context)
+    (cond ((null element) nil)
+	  ((stringp element) (insert element))
+	  ((memq element '(printer-name
+			   short-file-name long-file-name buffer-name
+			   date time page user-id user-name))
+	   (insert (print-context-property context element)))
+	  ((and (consp element) (eq 'face (car element)))
+	   (let ((p (point)))
+	     (generate-header-element (third element) context)
+	     (let ((x (make-extent p (point))))
+	       (set-extent-face x (second element)))))
+	  ((and (consp element) (extentp (car element)))
+	   (let ((p (point)))
+	     (generate-header-element (cdr element) context)
+	     (let ((x (make-extent p (point))))
+	       (set-extent-face x (extent-face (car element)))
+	       (set-extent-begin-glyph x (extent-begin-glyph (car element)))
+	       (set-extent-end-glyph x (extent-end-glyph (car element))))))
+	  ((listp element)
+	   (mapcar #'(lambda (el) (generate-header-element el context))
+		   element))
+	  ((functionp element)
+	   (generate-header-element (funcall element context) context))
+	  (t (error 'invalid-argument "Unknown header element" element))))
+
+(defun generate-header-line (spec context)
+  (let* ((left (first spec))
+	 (middle (second spec))
+	 (right (third spec))
+	 (left-start (point))
+	 (middle-start (progn (generate-header-element left context)
+			      (point)))
+	 (right-start (progn (generate-header-element middle context)
+			     (point)))
+	 (right-end (progn (generate-header-element right context)
+			   (point)))
+	 (left-width (- middle-start left-start))
+	 (middle-width (- right-start middle-start))
+	 (right-width (- right-end right-start))
+	 (winwidth (- (window-width (Print-context-window context)) 1))
+	 (spaces1 (max (- (/ (- winwidth middle-width) 2) left-width) 0))
+	 (spaces2 (max (- (- winwidth right-width)
+			  (+ left-width spaces1 middle-width))
+		       0)))
+    (goto-char right-start)
+    (insert-char ?\  spaces2)
+    (goto-char middle-start)
+    (insert-char ?\  spaces1)))
+
 (defun print-context-property (print-context prop)
   "Return property PROP of PRINT-CONTEXT.
 
 Valid properties are
 
-print-buffer     Buffer being printed.
-print-window     Window on printer device containing print buffer.
-print-frame      Frame on printer device corresponding to current page.
-print-device     Device referring to printer.
-printer-name     Name of printer being printed to.
+print-buffer     Buffer being printed
+print-window     Window on printer device containing print buffer
+print-frame      Frame on printer device corresponding to current page
+print-device     Device referring to printer
+print-start-time Time current when printing started (`current-time' format)
+print-page       Current printout page number, 1-based
+printer-name     Name of printer being printed to
 short-file-name  File name only, no path
 long-file-name   File name with its path
 buffer-name      Buffer name
-date             Date current when printing started
-time             Time current when printing started
-page             Current printout page number, 1-based
-user-id          User logon id
+date             Date current when printing started (as a string)
+time             Time current when printing started (as a string)
+page             Current printout page number, 1-based (as a string)
+user-id          User logon id (as a string)
 user-name        User full name"
-  (error "not yet implemented"))
+  (let* ((window (Print-context-window print-context))
+	 (pageno (Print-context-pageno print-context))
+	 (start-time (Print-context-start-time print-context))
+	 (printer-name (Print-context-printer-name print-context))
+	 (buffer (window-buffer window)))
+    (case prop
+      (print-buffer buffer)
+      (print-window window)
+      (print-frame (window-frame window))
+      (print-device (frame-device (window-frame window)))
+      (print-start-time start-time)
+      (print-page pageno)
+      (printer-name printer-name)
+      (short-file-name (let ((name (buffer-file-name buffer)))
+			 (if name (file-name-nondirectory name) "")))
+      (long-file-name (let ((name (buffer-file-name buffer)))
+			(or name "")))
+      (buffer-name (buffer-name buffer))
+      (date (format-time-string "%x" start-time))
+      (time (format-time-string "%X" start-time))
+      (page (format "%d" pageno))
+      (user-id (format "%d" (user-uid)))
+      (user-name (format "%d" (user-login-name)))
+      (t (error 'invalid-argument "Unrecognized print-context property"
+		prop)))))
 
-(defun generic-print-buffer (&optional buffer)
+(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
 buffer, or the `ps-print' package is used to pretty-print the buffer to a
 PostScript printer.  Under MS Windows, the built-in printing support is used.
 
+If DISPLAY-PRINT-DIALOG is t, the print dialog will first be
+displayed, allowing the user to select various printing settings
+\(e.g. which printer to print to, the range of pages, number of copies,
+modes such landscape/portrait/2-up/4-up [2 or 4 (small!) logical pages
+per physical page], etc.).  At this point the user can cancel the printing
+operation using the dialog box, and `generic-print-buffer' will not print
+anything.  When called interactively, use a prefix arg to suppress the
+display of the print dialog box.
+
 If BUFFER is nil or omitted, the current buffer is used."
-  (interactive)
-  (generic-print-region (point-min buffer) (point-max buffer) buffer))
+  ;; #### for some reason, displaying a dialog box makes the printing
+  ;; fail unless y-or-n-p is called (see below).  when this is fixed,
+  ;; remove one of the calls to `not' in the following line.
+  (interactive (list nil (not (not current-prefix-arg))))
+  (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)))
+      (and props (generic-print-region (point-min buffer)
+				       (point-max buffer) buffer
+				       d props)))))
 
-(defun generic-print-region (start end &optional buffer)
+(defun generic-print-region (start end &optional buffer print-device props)
   "Print region using a printing method appropriate to the O.S. being run.
 The region between START and END of BUFFER (defaults to the current
 buffer) is printed.
 
 Under Unix, `lpr' is normally used to spool out a no-frills version of the
 buffer, or the `ps-print' package is used to pretty-print the buffer to a
-PostScript printer.  Under MS Windows, the built-in printing support is used."
+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-specifier-tag-p 'msprinter)
-	 (let (d f)
+	 (let (d f header-buffer footer-buffer)
 	   (setq buffer (decode-buffer buffer))
 	   (unwind-protect
 	       (progn
-		 (setq d (make-device 'msprinter printer-name))
+		 (setq d (or print-device
+			     (make-device 'msprinter printer-name)))
 		 (setq f (make-frame
-			  (list* 'name (concat (substitute ?_ ?.
-							   (buffer-name buffer))
-					       " - XEmacs")
-				 '(menubar-visible-p nil
+			  (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
@@ -174,37 +292,125 @@
 		 (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 buffer (current-buffer)))
-		   (set-window-start w start)
-		   (while (not done)
-		     (redisplay-frame f)
-		     (print-job-eject-page f)
-		     (let ((this-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 (= this-end last-end)
-			       ;; #### fuckme!  window-end returns a value
-			       ;; outside of the valid range of buffer
-			       ;; positions!!!
-			       (>= this-end end))
-			   (setq done t)
-			 (setq last-end this-end)
-			 (set-window-start w this-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)))))))))
+			(from-page (plist-get props 'from-page 1))
+			(to-page (plist-get props 'to-page))
+			(copies (plist-get props 'copies 1))
+			(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)
+
+		   ;; loop, printing one copy of document per loop
+		   (while (> copies 0)
+		     (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)
+			   ;; none of these work.
+; 			   (mapcar #'(lambda (foo)
+; 				       (redisplay-device foo t))
+; 				   (delete-if #'(lambda (foo)
+; 						  (eq (device-type foo)
+; 						      'msprinter))
+; 					      (device-list)))
+; 			   (mapcar #'(lambda (foo)
+; 				       (redraw-device foo t))
+; 				   (delete-if #'(lambda (foo)
+; 						  (eq (device-type foo)
+; 						      'msprinter))
+; 					      (device-list)))
+; 			   (sit-for 0.01)
+			   ;; but this one sure as hell does.
+; 			   (y-or-n-p "continue")
+			   (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)
+			   (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
+				 (save-selected-window
+				   (select-window w)
+				   ;; #### scroll-down should take a
+				   ;; window arg.
+				   (let ((window-pixel-scroll-increment
+					  pixvis))
+				     (scroll-down 1))))))
+			 (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))
 	     )))
 	((and (not (eq system-type 'windows-nt))
 	      (fboundp 'lpr-buffer))