--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/printer.el	Mon Aug 13 11:35:02 2007 +0200
@@ -0,0 +1,211 @@
+;;; printer.el --- support for hard-copy printing in XEmacs
+
+;; Copyright (C) 2000 Ben Wing.
+;; Copyright (C) 2000 Kirill Katsnelson.
+
+;; Maintainer: XEmacs Development Team
+;; Keywords: printer, printing, internal, dumped
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Authorship:
+
+;; Created 2000 by Ben Wing, to provide the high-level interface onto the
+;; print support implemented by Kirill Katsnelson.
+
+;;; Commentary:
+
+;; This file is dumped with XEmacs.
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;                          generic printing code                        ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; #### should be named print-buffer, but that's currently in
+;; lpr-buffer with some horrible definition: print-buffer == "print with
+;; headings", lpr-buffer == "print without headings", and the headings are
+;; generated by calling the external program "pr"!  This is major stone-age
+;; here!
+;;
+;; I propose junking that package entirely and creating a unified,
+;; modern API here that will work well with modern GUI's on top of it,
+;; and with various different actual implementations (e.g. lpr or the
+;; pretty-print package on Unix, built-in msprinter support on
+;; Windows), where the workings of a particular implementation is
+;; 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.
+
+(defgroup printing nil
+  "Generic printing support."
+  :group 'wp)
+
+(defcustom printer-name nil
+  "*Name of printer to print to.
+If nil, use default.
+Under Windows, use `mswindows-printer-list' to get names of installed
+printers."
+  :type 'string
+  :group 'printing)
+
+(defcustom printer-page-header '(date 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.
+- 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:
+     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
+     user-name        User full name
+   - 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.
+   - A list, each element of which is any of the items given here.
+     Each element of the list is rendered in sequence.  For example,
+     '(\"Page \" page) is rendered as \"Page 5\" on the fifth page.
+   - An fbound symbol or lambda expression, called with one parameter,
+     a print-context object, as above.  The return value is treated as
+     if it was literally specified: i.e. it will be reprocessed."
+  :type 'sexp
+  :group 'printing)
+
+(defcustom printer-page-footer '(nil page)
+"*Controls printed page footer.
+
+#### not yet implemented.
+
+Format is the same as `printer-page-header'."
+  :type 'sexp
+  :group 'printing)
+
+(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.
+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
+user-name        User full name"
+  (error "not yet implemented"))
+
+(defun generic-print-buffer (&optional buf)
+  "Print buffer BUF 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 BUF is nil or omitted, the current buffer is used."
+  (interactive)
+  (generic-print-region (point-min buf) (point-max buf) buf))
+
+(defun generic-print-region (b e &optional buf)
+  "Print region using a printing method appropriate to the O.S. being run.
+The region between B and E of BUF (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."
+  (cond ((valid-specifier-tag-p 'msprinter)
+	 (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))
+	     )))
+	((and (not (eq system-type 'windows-nt))
+	      (fboundp 'lpr-buffer))
+	 (lpr-region buf))
+	(t (error "No print support available"))))