--- /dev/null
+;;; 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.
+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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 ; "Okidata OL610e/PS PostScript"
+ "*Name of printer to print to.
+If nil, use default.
+Under MS Windows, this can have the form `\\\\STOLI\\HP-345-PS'."
+ :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)
+ (or (stringp printer-name)
+ (error "Please set `printer-name'"))
+ (let (d f)
+ (setq buf (decode-buffer buf))
+ (unwind-protect
+ (progn
+ (setq d (make-device 'msprinter printer-name))
+ (setq f (make-frame
+ '(name "Test!"
+ 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"))))
projects / chise / xemacs-chise.git / blobdiff