annotate lisp/printer.el @ 5518:3cc7470ea71c

gnuclient: if TMPDIR was set and connect failed, try again with /tmp 2011-06-03 Aidan Kehoe <kehoea@parhasard.net> * gnuslib.c (connect_to_unix_server): Retry with /tmp as a directory in which to search for Unix sockets if an attempt to connect with some other directory failed (which may be because gnuclient and gnuserv don't share an environment value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR turned off).
author Aidan Kehoe <kehoea@parhasard.net>
date Fri, 03 Jun 2011 18:40:57 +0100
parents 308d34e9f07d
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
1 ;;; printer.el --- support for hard-copy printing in XEmacs
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
2
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
3 ;; Copyright (C) 2000, 2002 Ben Wing.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
4 ;; Copyright (C) 2000 Kirill Katsnelson.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
5
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
6 ;; Maintainer: XEmacs Development Team
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
7 ;; Keywords: printer, printing, internal, dumped
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
8
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
9 ;; This file is part of XEmacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
10
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
11 ;; XEmacs is free software: you can redistribute it and/or modify it
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
12 ;; under the terms of the GNU General Public License as published by the
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
13 ;; Free Software Foundation, either version 3 of the License, or (at your
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
14 ;; option) any later version.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
15
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
19 ;; for more details.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
20
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
21 ;; You should have received a copy of the GNU General Public License
5402
308d34e9f07d Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents: 4459
diff changeset
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
23
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
24 ;;; Synched up with: Not in FSF.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
25
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
26 ;;; Authorship:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
27
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
28 ;; Created 2000 by Ben Wing, to provide the high-level interface onto the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
29 ;; print support implemented by Kirill Katsnelson.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
30
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
31 ;;; Commentary:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
32
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
33 ;; This file is dumped with XEmacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
34
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
35
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
36 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
37 ;; generic printing code ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
39
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
40 ;; #### should be named print-buffer, but that's currently in
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
41 ;; lpr-buffer with some horrible definition: print-buffer == "print with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
42 ;; headings", lpr-buffer == "print without headings", and the headings are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
43 ;; generated by calling the external program "pr"! This is major stone-age
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
44 ;; here!
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
45 ;;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
46 ;; I propose junking that package entirely and creating a unified,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
47 ;; modern API here that will work well with modern GUI's on top of it,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
48 ;; and with various different actual implementations (e.g. lpr or the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
49 ;; pretty-print package on Unix, built-in msprinter support on
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
50 ;; Windows), where the workings of a particular implementation is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
51 ;; hidden from the user and there is a consistent set of options to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
52 ;; control how to print, which works across all implementations.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
53 ;;
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
54 ;; The code here currently only really supports Windows.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
55
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
56 (defgroup printing nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
57 "Generic printing support."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
58 :group 'wp)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
59
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
60 (defcustom printer-name nil
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
61 "*Name of printer to print to.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
62 If nil, use default.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
63 Under Windows, use `mswindows-printer-list' to get names of installed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
64 printers."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
65 :type 'string
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
66 :group 'printing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
67
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
68 (defstruct Print-context pageno window start-time printer-name)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
69
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
70 (defvar printer-current-device nil)
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
71
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
72 (defun Printer-get-device ()
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
73 (or printer-current-device (setq printer-current-device
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
74 (make-device 'msprinter printer-name))))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
75
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
76 (defun Printer-clear-device ()
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
77 ;; relying on GC to delete the device is too error-prone since there
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
78 ;; only can be one anyway.
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
79 (and printer-current-device (delete-device printer-current-device))
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
80 (setq printer-current-device nil))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
81
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
82 (defcustom printer-page-header '((face bold date) nil (face bold buffer-name))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
83 "*Controls printed page header.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
84
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
85 This can be:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
86 - nil. Header is not printed.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
87 - An fbound symbol or lambda expression. The function is called with
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
88 one parameter, a print-context object, every time the headers need
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
89 to be set up. It can use the function `print-context-property' to
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
90 query the properties of this object. The return value is treated as
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
91 if it was literally specified: i.e. it will be reprocessed.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
92 - A list of up to three elements, for left, center and right portions
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
93 of the header. Each of these can be
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
94 - nil, not to print the portion
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
95 - A string, which will be printed literally.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
96 - A predefined symbol, on of the following:
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
97 printer-name Name of printer being printed to
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
98 short-file-name File name only, no path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
99 long-file-name File name with its path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
100 buffer-name Buffer name
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
101 date Date current when printing started
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
102 time Time current when printing started
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
103 page Current printout page number, 1-based
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
104 user-id User logon id
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
105 user-name User full name
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
106 - A list of three elements: (face FACE-NAME EXPR). EXPR is any of the
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
107 items given here. The item will be displayed in the given face.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
108 - A cons of an extent and any of the items given here. The item will
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
109 be displayed using the extent's face, begin-glyph and end-glyph
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
110 properties.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
111 - A list, each element of which is any of the items given here.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
112 Each element of the list is rendered in sequence. For example,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
113 '(\"Page \" page) is rendered as \"Page 5\" on the fifth page.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
114 - An fbound symbol or lambda expression, called with one parameter,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
115 a print-context object, as above. The return value is treated as
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
116 if it was literally specified: i.e. it will be reprocessed."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
117 :type 'sexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
118 :group 'printing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
119
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
120 (defcustom printer-page-footer '(nil (face bold ("Page " page)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
121 "*Controls printed page footer.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
122
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
123 Format is the same as `printer-page-header'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
124 :type 'sexp
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
125 :group 'printing)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
126
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
127 (defun generate-header-element (element context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
128 (cond ((null element) nil)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
129 ((stringp element) (insert element))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
130 ((memq element '(printer-name
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
131 short-file-name long-file-name buffer-name
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
132 date time page user-id user-name))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
133 (insert (print-context-property context element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
134 ((and (consp element) (eq 'face (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
135 (let ((p (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
136 (generate-header-element (third element) context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
137 (let ((x (make-extent p (point))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
138 (set-extent-face x (second element)))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
139 ((and (consp element) (extentp (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
140 (let ((p (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
141 (generate-header-element (cdr element) context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
142 (let ((x (make-extent p (point))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
143 (set-extent-face x (extent-face (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
144 (set-extent-begin-glyph x (extent-begin-glyph (car element)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
145 (set-extent-end-glyph x (extent-end-glyph (car element))))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
146 ((listp element)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
147 (mapcar #'(lambda (el) (generate-header-element el context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
148 element))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
149 ((functionp element)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
150 (generate-header-element (funcall element context) context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
151 (t (error 'invalid-argument "Unknown header element" element))))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
152
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
153 (defun generate-header-line (spec context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
154 (let* ((left (first spec))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
155 (middle (second spec))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
156 (right (third spec))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
157 (left-start (point))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
158 (middle-start (progn (generate-header-element left context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
159 (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
160 (right-start (progn (generate-header-element middle context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
161 (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
162 (right-end (progn (generate-header-element right context)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
163 (point)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
164 (left-width (- middle-start left-start))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
165 (middle-width (- right-start middle-start))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
166 (right-width (- right-end right-start))
1346
01c57eb70ae9 [xemacs-hg @ 2003-03-09 02:27:27 by ben]
ben
parents: 903
diff changeset
167 (winwidth (- (window-width (Print-context-window context)) 2))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
168 (spaces1 (max (- (/ (- winwidth middle-width) 2) left-width) 0))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
169 (spaces2 (max (- (- winwidth right-width)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
170 (+ left-width spaces1 middle-width))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
171 0)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
172 (goto-char right-start)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
173 (insert-char ?\ spaces2)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
174 (goto-char middle-start)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
175 (insert-char ?\ spaces1)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
176
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
177 (defun print-context-property (print-context prop)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
178 "Return property PROP of PRINT-CONTEXT.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
179
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
180 Valid properties are
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
181
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
182 print-buffer Buffer being printed
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
183 print-window Window on printer device containing print buffer
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
184 print-frame Frame on printer device corresponding to current page
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
185 print-device Device referring to printer
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
186 print-start-time Time current when printing started (`current-time' format)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
187 print-page Current printout page number, 1-based
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
188 printer-name Name of printer being printed to
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
189 short-file-name File name only, no path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
190 long-file-name File name with its path
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
191 buffer-name Buffer name
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
192 date Date current when printing started (as a string)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
193 time Time current when printing started (as a string)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
194 page Current printout page number, 1-based (as a string)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
195 user-id User logon id (as a string)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
196 user-name User full name"
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
197 (let* ((window (Print-context-window print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
198 (pageno (Print-context-pageno print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
199 (start-time (Print-context-start-time print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
200 (printer-name (Print-context-printer-name print-context))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
201 (buffer (window-buffer window)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
202 (case prop
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
203 (print-buffer buffer)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
204 (print-window window)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
205 (print-frame (window-frame window))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
206 (print-device (frame-device (window-frame window)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
207 (print-start-time start-time)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
208 (print-page pageno)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
209 (printer-name printer-name)
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
210 (short-file-name (let ((name (buffer-file-name buffer)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
211 (if name (file-name-nondirectory name) "")))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
212 (long-file-name (let ((name (buffer-file-name buffer)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
213 (or name "")))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
214 (buffer-name (buffer-name buffer))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
215 (date (format-time-string "%x" start-time))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
216 (time (format-time-string "%X" start-time))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
217 (page (format "%d" pageno))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
218 (user-id (format "%d" (user-uid)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
219 (user-name (format "%d" (user-login-name)))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
220 (t (error 'invalid-argument "Unrecognized print-context property"
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
221 prop)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
222
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
223 (defun generic-page-setup ()
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
224 "Display the Page Setup dialog box.
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
225 Changes made are recorded internally."
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
226 (interactive)
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
227 (let* ((d (Printer-get-device))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
228 (props
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
229 (condition-case err
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
230 (make-dialog-box 'page-setup :device d
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
231 :properties (declare-boundp
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
232 default-msprinter-frame-plist))
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
233 (error
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
234 (Printer-clear-device)
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
235 (signal (car err) (cdr err))))))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
236 (while props
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
237 (with-boundp 'default-msprinter-frame-plist
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
238 (setq default-msprinter-frame-plist
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
239 (plist-put default-msprinter-frame-plist (car props)
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
240 (cadr props))))
506
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
241 (setq props (cddr props)))))
39ccc7dd8077 [xemacs-hg @ 2001-05-05 08:39:59 by ben]
ben
parents: 503
diff changeset
242
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
243 (defun generic-print-buffer (&optional buffer display-print-dialog)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
244 "Print buffer BUFFER using a printing method appropriate to the O.S. being run.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
245 Under Unix, `lpr' is normally used to spool out a no-frills version of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
246 buffer, or the `ps-print' package is used to pretty-print the buffer to a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
247 PostScript printer. Under MS Windows, the built-in printing support is used.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
248
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
249 If DISPLAY-PRINT-DIALOG is t, the print dialog will first be
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
250 displayed, allowing the user to select various printing settings
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
251 \(e.g. which printer to print to, the range of pages, number of copies,
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
252 modes such landscape/portrait/2-up/4-up [2 or 4 (small!) logical pages
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
253 per physical page], etc.). At this point the user can cancel the printing
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
254 operation using the dialog box, and `generic-print-buffer' will not print
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
255 anything. When called interactively, use a prefix arg to suppress the
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
256 display of the print dialog box.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
257
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
258 If BUFFER is nil or omitted, the current buffer is used."
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 491
diff changeset
259 (interactive (list nil (not current-prefix-arg)))
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
260 (condition-case err
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
261 (let* ((print-region (and (interactive-p) (region-active-p)))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
262 (start (if print-region (region-beginning) (point-min buffer)))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
263 (end (if print-region (region-end) (point-max buffer))))
4459
554b9d31e7a5 Handle printing correctly on non-mswindows.
Aidan Kehoe <kehoea@parhasard.net>
parents: 1346
diff changeset
264 (if (or (not (valid-device-type-p 'msprinter))
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
265 (not display-print-dialog))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
266 (generic-print-region start end buffer)
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
267 (let* ((d (Printer-get-device))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
268 (props (make-dialog-box 'print :device d
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
269 :allow-selection print-region
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
270 :selected-page-button
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
271 (if print-region 'selection 'all))))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
272 (and props
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
273 (let ((really-print-region
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
274 (eq (plist-get props 'selected-page-button) 'selection)))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
275 (generic-print-region (if really-print-region start
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
276 (point-min buffer))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
277 (if really-print-region end
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
278 (point-max buffer))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
279 buffer d props))))))
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
280 (error
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
281 ;; Make sure we catch all errors thrown from the native code.
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
282 (Printer-clear-device)
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
283 (signal (car err) (cdr err)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
284
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
285 (defun generic-print-region (start end &optional buffer print-device props)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
286 "Print region using a printing method appropriate to the O.S. being run.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
287 The region between START and END of BUFFER (defaults to the current
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
288 buffer) is printed.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
289
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
290 Under Unix, `lpr' is normally used to spool out a no-frills version of the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
291 buffer, or the `ps-print' package is used to pretty-print the buffer to a
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
292 PostScript printer. Under MS Windows, the built-in printing support is used.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
293
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
294 Optional PRINT-DEVICE is a device, already created, to use to do the
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
295 printing. This is typically used when this function was invoked from
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
296 `generic-print-buffer' and it displayed a dialog box. That function created
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
297 the device, and then the dialog box stuffed it with the user's selections
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
298 of how the buffer should be printed.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
299
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
300 PROPS, if given, is typically the plist returned from the call to
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
301 `make-dialog-box' that displayed the Print box. It contains properties
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
302 relevant to us when we print.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
303
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
304 Recognized properties are the same as those in `make-dialog-box':
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
305
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
306 name Printer device name. If omitted, the current system-selected
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
307 printer will be used.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
308 from-page First page to print, 1-based. If omitted, printing starts from
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
309 the beginning.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
310 to-page Last page to print, inclusive, If omitted, printing ends at
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
311 the end.
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
312 copies Number of copies to print. If omitted, one copy is printed."
4459
554b9d31e7a5 Handle printing correctly on non-mswindows.
Aidan Kehoe <kehoea@parhasard.net>
parents: 1346
diff changeset
313 (cond ((valid-device-type-p 'msprinter)
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
314 ;; loop, printing one copy of document per loop. kill and
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
315 ;; re-create the frame each time so that we eject the piece
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
316 ;; of paper at the end even if we're printing more than one
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
317 ;; page per sheet of paper.
707
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
318 (let ((copies (plist-get props 'copies 1))
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
319 ;; This is not relevant to printing and can mess up
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
320 ;; msprinter frame sizing
a307f9a2021d [xemacs-hg @ 2001-12-20 05:49:28 by andyp]
andyp
parents: 546
diff changeset
321 default-frame-plist)
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
322 (while (> copies 0)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
323 (let (d f header-buffer footer-buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
324 (setq buffer (decode-buffer buffer))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
325 (unwind-protect
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
326 (with-current-buffer buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
327 (save-restriction
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
328 (narrow-to-region start end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
329 (setq d (or print-device (Printer-get-device)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
330 (setq f (make-frame
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
331 (list* 'name
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
332 (concat
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
333 (substitute ?_ ?. (buffer-name buffer))
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
334 " - XEmacs")
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
335 '(menubar-visible-p
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
336 nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
337 has-modeline-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
338 default-toolbar-visible-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
339 default-gutter-visible-p nil
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
340 minibuffer none
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
341 modeline-shadow-thickness 0
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
342 vertical-scrollbar-visible-p nil
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
343 horizontal-scrollbar-visible-p nil
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
344 [default foreground] "black"
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
345 [default background] "white"))
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
346 d))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
347 (let* ((w (frame-root-window f))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
348 (vertdpi
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
349 (cdr (device-system-metric d 'device-dpi)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
350 (pixel-vertical-clip-threshold (/ vertdpi 2))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
351 (from-page (plist-get props 'from-page 1))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
352 (to-page (plist-get props 'to-page))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
353 (context (make-Print-context
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
354 :start-time (current-time)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
355 ;; #### bogus! we need accessors for
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
356 ;; print-settings objects.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
357 :printer-name
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
358 (or (plist-get props 'name)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
359 printer-name
778
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
360 (declare-fboundp
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
361 (mswindows-get-default-printer)
2923009caf47 [xemacs-hg @ 2002-03-16 10:38:59 by ben]
ben
parents: 776
diff changeset
362 ))))
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
363 header-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
364 footer-window)
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
365
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
366 (when printer-page-header
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
367 (let ((window-min-height 2))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
368 (setq header-window w)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
369 (setq w (split-window w 2)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
370 (setq header-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
371 (generate-new-buffer " *header*"))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
372 (set-window-buffer header-window header-buffer))
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
373
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
374 (when printer-page-footer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
375 (let ((window-min-height 2))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
376 (setq footer-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
377 (split-window w (- (window-height w) 2))))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
378 (setq footer-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
379 (generate-new-buffer " *footer*"))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
380 (set-window-buffer footer-window footer-buffer))
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
381
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
382 (setf (Print-context-window context) w)
903
4a27df428c73 [xemacs-hg @ 2002-07-06 05:48:14 by andyp]
andyp
parents: 872
diff changeset
383
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
384 (let ((last-end 0) ; bufpos at end of previous page
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
385 reached-end ; t if we've reached the end of the
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
386 ; text we're printing
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
387 (pageno 1))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
388 (set-window-buffer w buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
389 (set-window-start w start)
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
390
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
391 ;; loop, printing one page per loop
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
392 (while (and (not reached-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
393 ;; stop at end of region of text or
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
394 ;; outside of ranges of pages given
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
395 (or (not to-page) (<= pageno to-page)))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
396
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
397 (setf (Print-context-pageno context) pageno)
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
398
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
399 ;; only actually print the page if it's in the
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
400 ;; range.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
401 (when (>= pageno from-page)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
402 (when printer-page-header
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
403 (with-current-buffer header-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
404 (erase-buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
405 (generate-header-line printer-page-header
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
406 context)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
407 (goto-char (point-min))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
408 (set-window-start header-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
409 (point-min))))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
410
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
411 (when printer-page-footer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
412 (with-current-buffer footer-buffer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
413 (erase-buffer)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
414 (insert "\n")
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
415 (generate-header-line printer-page-footer
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
416 context)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
417 (goto-char (point-min))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
418 (set-window-start footer-window
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
419 (point-min))))
491
b3bbdc4058d7 [xemacs-hg @ 2001-04-30 09:26:20 by ben]
ben
parents: 444
diff changeset
420
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
421 (redisplay-frame f t)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
422 (print-job-eject-page f)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
423 )
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
424 ;; but use the GUARANTEE argument to `window-end'
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
425 ;; so that we get the right value even if we
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
426 ;; didn't do a redisplay.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
427 (let ((this-end (window-end w t))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
428 (pixvis
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
429 (window-last-line-visible-height w)))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
430 ;; in case we get stuck somewhere, bow out
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
431 ;; rather than printing an infinite number of
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
432 ;; pages. #### this will fail with an image
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
433 ;; bigger than an entire page. but we really
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
434 ;; need this check here. we should be more
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
435 ;; clever in our check, to deal with this case.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
436 (if (or (= this-end last-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
437 ;; #### fuckme! window-end returns a
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
438 ;; value outside of the valid range of
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
439 ;; buffer positions!!!
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
440 (>= this-end end))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
441 (setq reached-end t)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
442 (setq last-end this-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
443 (set-window-start w this-end)
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
444 (if pixvis
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
445 (with-selected-window w
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
446 ;; #### scroll-down should take a
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
447 ;; window arg.
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
448 (let ((window-pixel-scroll-increment
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
449 pixvis))
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
450 (scroll-down 1))))))
546
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
451 (setq pageno (1+ pageno)))))))
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
452 (and f (delete-frame f))
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
453 (and header-buffer (kill-buffer header-buffer))
666d73d6ac56 [xemacs-hg @ 2001-05-20 01:17:07 by ben]
ben
parents: 510
diff changeset
454 (and footer-buffer (kill-buffer footer-buffer))))
510
5bdbc721d46a [xemacs-hg @ 2001-05-06 08:33:35 by ben]
ben
parents: 506
diff changeset
455 (setq copies (1- copies)))))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
456 ((and (not (eq system-type 'windows-nt))
503
98fb34b6fbe9 [xemacs-hg @ 2001-05-04 23:31:31 by ben]
ben
parents: 491
diff changeset
457 (fboundp 'lpr-region))
872
79c6ff3eef26 [xemacs-hg @ 2002-06-20 21:18:01 by ben]
ben
parents: 863
diff changeset
458 (declare-fboundp (lpr-region start end)))
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents:
diff changeset
459 (t (error "No print support available"))))