|
0
|
1 ;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19.
|
|
|
2
|
|
2
|
3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
|
|
0
|
4
|
|
82
|
5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
|
|
96
|
6 ;; Maintainer: Jacques Duthen <duthen@club-internet.fr>
|
|
82
|
7 ;; Keywords: print, PostScript
|
|
88
|
8 ;; Time-stamp: <97/01/29 23:21:25 tjchol01>
|
|
82
|
9 ;; Version: 3.05
|
|
|
10
|
|
|
11 (defconst ps-print-version "3.05"
|
|
|
12 "ps-print.el, v 3.05 <97/01/17 duthen>
|
|
|
13
|
|
|
14 Jack's last change version -- this file may have been edited as part of
|
|
|
15 Emacs without changes to the version number. When reporting bugs,
|
|
|
16 please also report the version of Emacs, if any, that ps-print was
|
|
|
17 distributed with.
|
|
|
18
|
|
|
19 Please send all bug fixes and enhancements to
|
|
|
20 Jacques Duthen <duthen@cegelec-red.fr>.
|
|
|
21 ")
|
|
|
22
|
|
|
23 ;; This file is part of GNU Emacs.
|
|
|
24
|
|
|
25 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
26 ;; it under the terms of the GNU General Public License as published by
|
|
0
|
27 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
28 ;; any later version.
|
|
|
29
|
|
82
|
30 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
31 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
32 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
33 ;; GNU General Public License for more details.
|
|
0
|
34
|
|
|
35 ;; You should have received a copy of the GNU General Public License
|
|
82
|
36 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
37 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
38 ;; Boston, MA 02111-1307, USA.
|
|
0
|
39
|
|
|
40 ;; LCD Archive Entry:
|
|
|
41 ;; ps-print|James C. Thompson|thompson@wg2.waii.com|
|
|
|
42 ;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)|
|
|
|
43 ;; 26-Feb-1994|2.8|~/packages/ps-print.el|
|
|
|
44
|
|
82
|
45 ;; 3.05 [jack] <97/01/16 duthen>
|
|
|
46 ;; Ben Wing <ben@666.com> took ps-print.el from the official 19.34
|
|
|
47 ;; GNU distribution:
|
|
|
48 ;; -rw-rw-r-- 1 duthen 69315 Jul 22 1996 ps-print.el
|
|
|
49 ;; He patched it for XEmacs.
|
|
|
50 ;; Steven L Baur <steve@miranova.com> sent me this version which has
|
|
|
51 ;; 26 diffs with 19.34.
|
|
|
52 ;; I merge these 26 diffs into my 3.04 version.
|
|
|
53
|
|
|
54 ;; `ps-paper-type': ###autoload.
|
|
|
55 ;; `ps-print-color-p' `ps-color-values': Replace pixel-components by
|
|
|
56 ;; color-instance-rgb-components for XEmacs.
|
|
|
57 ;; `ps-color-device': New function to dynamically test the device
|
|
|
58 ;; color capability, added where ps-print-color-p is tested.
|
|
|
59 ;; `ps-xemacs-face-kind-p': Fixed.
|
|
|
60 ;; `ps-do-despool': Permit dynamic evaluation at print time of
|
|
|
61 ;; ps-lpr-switches.
|
|
|
62 ;; `ps-eval-switch' `ps-flatten-list' `ps-flatten-list-1': New for
|
|
|
63 ;; the previous feature.
|
|
|
64 ;; `ps-gnus-print-article-from-summary': Updated for Gnus 5.
|
|
|
65
|
|
|
66
|
|
|
67 ;; 3.04 [jack] after [simon] Oct 8, 1996 Simon Marshall <simon@gnu.ai.mit.edu>
|
|
|
68 ;; `ps-print-version':
|
|
|
69 ;; Fix value.
|
|
|
70 ;; `cl' `lisp-float-type':
|
|
|
71 ;; Require them.
|
|
|
72 ;; `ps-number-of-columns' `ps-*-font-size':
|
|
|
73 ;; Try to select defaults better suited when `ps-landscape-mode' is non-nil.
|
|
|
74 ;; `ps-*-faces':
|
|
|
75 ;; Change default for Font Lock mode faces when `ps-print-color-p' is nil.
|
|
|
76 ;; `ps-right-header':
|
|
|
77 ;; Replace `time-stamp-yy/mm/dd' by `time-stamp-mon-dd-yyyy'.
|
|
|
78 ;; `ps-end-file' `ps-begin-page':
|
|
|
79 ;; Fix bug in page count for Ghostview.
|
|
|
80 ;; `ps-generate-postscript-with-faces':
|
|
|
81 ;; Replace `ps-sorter' by `car-less-than-car'.
|
|
|
82 ;; `ps-plot' `ps-generate':
|
|
|
83 ;; Replace `%d' by `%3d'.
|
|
|
84
|
|
|
85 ;; 3.03 [jack] Sept 27, 1996 Jacques Duthen <duthen@cegelec-red.fr>
|
|
|
86 ;; Merge 31 diffs between 19.29 and 19.34
|
|
|
87
|
|
|
88 ;; 3.02 [jack] June 26, 1996 Jacques Duthen <duthen@cegelec-red.fr>
|
|
|
89 ;; Add new page dimensions to `ps-page-dimensions-database' for `paper-type'
|
|
|
90 ;; Improve landscape mode `ps-landscape-mode' and multiple columns
|
|
|
91 ;; printing `ps-number-of-columns':
|
|
|
92 ;; The text and the margins are no more scaled.
|
|
|
93 ;; Simplify the semantics of `ps-inter-column' (space between columns).
|
|
|
94 ;; Add error checking for negative `ps-print-width' and `ps-print-height'.
|
|
|
95 ;; Change the semantics of `ps-top-margin' which is now the TOP MARGIN,
|
|
|
96 ;; and add `ps-header-offset' instead of having `ps-top-margin' split in 2.
|
|
|
97 ;; Add `ps-header-font-family', `ps-header-font-size' and
|
|
|
98 ;; `ps-header-title-font-size' to control the header.
|
|
|
99 ;; Add `ps-header-line-pad'.
|
|
|
100 ;; Change the semantics of `ps-font-info-database' to have symbolic
|
|
|
101 ;; font families.
|
|
|
102 ;; Add new fonts to `ps-font-info-database': `Courier' `Helvetica'
|
|
|
103 ;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk'
|
|
|
104 ;; Make public `ps-font-family' and `ps-font-size' so that the user
|
|
|
105 ;; can directly control the text font and size without loading ps-print.
|
|
|
106 ;; Add error checking for unknown font families and a message giving
|
|
|
107 ;; the exhaustive list of available font families.
|
|
|
108 ;; Document how to install a new font family.
|
|
|
109 ;; Add `/ReportAllFontInfo' to get all the font families of the printer.
|
|
|
110 ;; Add the possibility to make `mixed' font families.
|
|
|
111 ;; Add `ps-setup' to get the current setup.
|
|
|
112 ;; Add tools `ps-line-lengths' `ps-nb-pages-buffer' `ps-nb-pages-region'
|
|
|
113 ;; to help choose the font size.
|
|
|
114 ;; Split `ps-print-prologue' in two to insert info from header fonts
|
|
|
115 ;; Replace indexes by macro `ps-page-dimensions-get-width'
|
|
|
116 ;; to get access to the dimensions list.
|
|
|
117 ;; Add `ps-select-font' inside `ps-get-page-dimensions'.
|
|
|
118 ;; Fix the "clumsy" `ps-page-height' management.
|
|
|
119 ;; Move `ps-get-page-dimensions' to the beginning of `ps-begin-file'
|
|
|
120 ;; to get early error checking.
|
|
|
121 ;; Add sample setup `ps-jack-setup'.
|
|
|
122 ;;
|
|
|
123 ;; Rewrite a lot of postscript code and add comments inside it
|
|
|
124 ;; (maybe they should not (or optionally) be included in the generated
|
|
|
125 ;; Postscript).
|
|
|
126 ;; Translate the origin to (lm, bm) to simplify the other moves.
|
|
|
127 ;; Fix bug in `/HeaderOffset' with `/PrintStartY'.
|
|
|
128 ;; Fix bug in `/SetHeaderLines'.
|
|
|
129 ;; Change `/ReportFontInfo' for use by `/ReportAllFontInfo'.
|
|
|
130
|
|
|
131 ;; 3.01 [jack] June 4, 1996 Jacques Duthen <duthen@cegelec-red.fr>
|
|
|
132 ;; Manage float value for every variable representing a size.
|
|
|
133 ;; Add `ps-font-info-database' `ps-inter-column'
|
|
|
134
|
|
|
135 ;; 3.00 [jack] May 17, 1996 Jacques Duthen <duthen@cegelec-red.fr>
|
|
|
136 ;; based on 2.8 Jim's Pretty-Good version:
|
|
|
137 ;; Add `ps-landscape-mode' and `ps-number-of-columns'
|
|
|
138 ;; for dumb multi-column landscape mode.
|
|
|
139
|
|
0
|
140 ;; Baseline-version: 2.8. (Jim's last change version -- this
|
|
|
141 ;; file may have been edited as part of Emacs without changes to the
|
|
|
142 ;; version number. When reporting bugs, please also report the
|
|
|
143 ;; version of Emacs, if any, that ps-print was distributed with.)
|
|
|
144
|
|
|
145 ;;; Commentary:
|
|
|
146
|
|
|
147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
148 ;;
|
|
|
149 ;; About ps-print
|
|
|
150 ;; --------------
|
|
82
|
151 ;;
|
|
0
|
152 ;; This package provides printing of Emacs buffers on PostScript
|
|
|
153 ;; printers; the buffer's bold and italic text attributes are
|
|
|
154 ;; preserved in the printer output. Ps-print is intended for use with
|
|
|
155 ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
|
|
|
156 ;; font-lock or hilit.
|
|
|
157 ;;
|
|
82
|
158 ;;
|
|
0
|
159 ;; Using ps-print
|
|
|
160 ;; --------------
|
|
|
161 ;;
|
|
|
162 ;; The Commands
|
|
|
163 ;;
|
|
|
164 ;; Ps-print provides eight commands for generating PostScript images
|
|
|
165 ;; of Emacs buffers:
|
|
|
166 ;;
|
|
|
167 ;; ps-print-buffer
|
|
|
168 ;; ps-print-buffer-with-faces
|
|
|
169 ;; ps-print-region
|
|
|
170 ;; ps-print-region-with-faces
|
|
|
171 ;; ps-spool-buffer
|
|
|
172 ;; ps-spool-buffer-with-faces
|
|
|
173 ;; ps-spool-region
|
|
|
174 ;; ps-spool-region-with-faces
|
|
|
175 ;;
|
|
|
176 ;; These commands all perform essentially the same function: they
|
|
|
177 ;; generate PostScript images suitable for printing on a PostScript
|
|
|
178 ;; printer or displaying with GhostScript. These commands are
|
|
|
179 ;; collectively referred to as "ps-print- commands".
|
|
|
180 ;;
|
|
|
181 ;; The word "print" or "spool" in the command name determines when the
|
|
|
182 ;; PostScript image is sent to the printer:
|
|
|
183 ;;
|
|
|
184 ;; print - The PostScript image is immediately sent to the
|
|
|
185 ;; printer;
|
|
|
186 ;;
|
|
|
187 ;; spool - The PostScript image is saved temporarily in an
|
|
|
188 ;; Emacs buffer. Many images may be spooled locally
|
|
|
189 ;; before printing them. To send the spooled images
|
|
82
|
190 ;; to the printer, use the command `ps-despool'.
|
|
0
|
191 ;;
|
|
|
192 ;; The spooling mechanism was designed for printing lots of small
|
|
|
193 ;; files (mail messages or netnews articles) to save paper that would
|
|
|
194 ;; otherwise be wasted on banner pages, and to make it easier to find
|
|
|
195 ;; your output at the printer (it's easier to pick up one 50-page
|
|
|
196 ;; printout than to find 50 single-page printouts).
|
|
|
197 ;;
|
|
82
|
198 ;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't
|
|
2
|
199 ;; accidentally quit from Emacs while you have unprinted PostScript
|
|
0
|
200 ;; waiting in the spool buffer. If you do attempt to exit with
|
|
|
201 ;; spooled PostScript, you'll be asked if you want to print it, and if
|
|
|
202 ;; you decline, you'll be asked to confirm the exit; this is modeled
|
|
|
203 ;; on the confirmation that Emacs uses for modified buffers.
|
|
|
204 ;;
|
|
|
205 ;; The word "buffer" or "region" in the command name determines how
|
|
|
206 ;; much of the buffer is printed:
|
|
|
207 ;;
|
|
|
208 ;; buffer - Print the entire buffer.
|
|
|
209 ;;
|
|
|
210 ;; region - Print just the current region.
|
|
|
211 ;;
|
|
|
212 ;; The -with-faces suffix on the command name means that the command
|
|
|
213 ;; will include font, color, and underline information in the
|
|
|
214 ;; PostScript image, so the printed image can look as pretty as the
|
|
|
215 ;; buffer. The ps-print- commands without the -with-faces suffix
|
|
|
216 ;; don't include font, color, or underline information; images printed
|
|
|
217 ;; with these commands aren't as pretty, but are faster to generate.
|
|
|
218 ;;
|
|
|
219 ;; Two ps-print- command examples:
|
|
|
220 ;;
|
|
|
221 ;; ps-print-buffer - print the entire buffer,
|
|
|
222 ;; without font, color, or
|
|
|
223 ;; underline information, and
|
|
|
224 ;; send it immediately to the
|
|
|
225 ;; printer.
|
|
|
226 ;;
|
|
|
227 ;; ps-spool-region-with-faces - print just the current region;
|
|
|
228 ;; include font, color, and
|
|
|
229 ;; underline information, and
|
|
|
230 ;; spool the image in Emacs to
|
|
|
231 ;; send to the printer later.
|
|
|
232 ;;
|
|
|
233 ;;
|
|
|
234 ;; Invoking Ps-Print
|
|
82
|
235 ;; -----------------
|
|
0
|
236 ;;
|
|
|
237 ;; To print your buffer, type
|
|
|
238 ;;
|
|
|
239 ;; M-x ps-print-buffer
|
|
|
240 ;;
|
|
|
241 ;; or substitute one of the other seven ps-print- commands. The
|
|
|
242 ;; command will generate the PostScript image and print or spool it as
|
|
|
243 ;; specified. By giving the command a prefix argument
|
|
|
244 ;;
|
|
|
245 ;; C-u M-x ps-print-buffer
|
|
|
246 ;;
|
|
|
247 ;; it will save the PostScript image to a file instead of sending it
|
|
|
248 ;; to the printer; you will be prompted for the name of the file to
|
|
|
249 ;; save the image to. The prefix argument is ignored by the commands
|
|
|
250 ;; that spool their images, but you may save the spooled images to a
|
|
82
|
251 ;; file by giving a prefix argument to `ps-despool':
|
|
0
|
252 ;;
|
|
|
253 ;; C-u M-x ps-despool
|
|
|
254 ;;
|
|
82
|
255 ;; When invoked this way, `ps-despool' will prompt you for the name of
|
|
0
|
256 ;; the file to save to.
|
|
|
257 ;;
|
|
82
|
258 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
|
|
|
259 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
|
|
|
260 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
|
|
0
|
261 ;;
|
|
|
262 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
|
|
|
263 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
|
|
|
264 ;; (global-set-key '(control f22) 'ps-despool)
|
|
|
265 ;;
|
|
|
266 ;;
|
|
|
267 ;; The Printer Interface
|
|
82
|
268 ;; ---------------------
|
|
0
|
269 ;;
|
|
82
|
270 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
|
|
70
|
271 ;; command is used to send the PostScript images to the printer, and
|
|
82
|
272 ;; what arguments to give the command. These are analogous to
|
|
|
273 ;; `lpr-command' and `lpr-switches'.
|
|
16
|
274 ;;
|
|
82
|
275 ;; Make sure that they contain appropriate values for your system;
|
|
|
276 ;; see the usage notes below and the documentation of these variables.
|
|
|
277 ;;
|
|
|
278 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
|
|
|
279 ;; from the variables `lpr-command' and `lpr-switches'. If you have
|
|
|
280 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
|
|
|
281 ;; then ps-print won't work properly. `ps-lpr-command' must name
|
|
0
|
282 ;; a program that does not format the files it prints.
|
|
|
283 ;;
|
|
|
284 ;;
|
|
82
|
285 ;; The Page Layout
|
|
|
286 ;; ---------------
|
|
0
|
287 ;;
|
|
82
|
288 ;; All dimensions are floats in PostScript points.
|
|
|
289 ;; 1 inch == 2.54 cm == 72 points
|
|
|
290 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
|
|
0
|
291 ;;
|
|
82
|
292 ;; The variable `ps-paper-type' determines the size of paper ps-print
|
|
|
293 ;; formats for; it should contain one of the symbols:
|
|
|
294 ;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
|
|
|
295 ;; `ledger' `statement' `executive' `a4small' `b4' `b5'
|
|
0
|
296 ;;
|
|
82
|
297 ;; The variable `ps-landscape-mode' determines the orientation
|
|
|
298 ;; of the printing on the page:
|
|
|
299 ;; nil means `portrait' mode, non-nil means `landscape' mode.
|
|
|
300 ;; There is no oblique mode yet, though this is easy to do in ps.
|
|
|
301
|
|
|
302 ;; In landscape mode, the text is NOT scaled: you may print 70 lines
|
|
|
303 ;; in portrait mode and only 50 lignes in landscape mode.
|
|
|
304 ;; The margins represent margins in the printed paper:
|
|
|
305 ;; the top margin is the margin between the top of the page
|
|
|
306 ;; and the printed header, whatever the orientation is.
|
|
0
|
307 ;;
|
|
82
|
308 ;; The variable `ps-number-of-columns' determines the number of columns
|
|
|
309 ;; both in landscape and portrait mode.
|
|
|
310 ;; You can use:
|
|
|
311 ;; - (the standard) one column portrait mode
|
|
|
312 ;; - (my favorite) two columns landscape mode (which spares trees)
|
|
|
313 ;; but also
|
|
|
314 ;; - one column landscape mode for files with very long lines.
|
|
|
315 ;; - multi-column portrait or landscape mode
|
|
0
|
316 ;;
|
|
|
317 ;;
|
|
82
|
318 ;; Horizontal layout
|
|
|
319 ;; -----------------
|
|
|
320 ;;
|
|
|
321 ;; The horizontal layout is determined by the variables
|
|
|
322 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
|
|
|
323 ;; as follows:
|
|
|
324 ;;
|
|
|
325 ;; ------------------------------------------
|
|
|
326 ;; | | | | | | | |
|
|
|
327 ;; | lm | text | ic | text | ic | text | rm |
|
|
|
328 ;; | | | | | | | |
|
|
|
329 ;; ------------------------------------------
|
|
|
330 ;;
|
|
|
331 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
|
|
|
332 ;; Usually, lm = rm > 0 and ic = lm
|
|
|
333 ;; If (ic < 0), the text of adjacent columns can overlap.
|
|
|
334 ;;
|
|
|
335 ;;
|
|
|
336 ;; Vertical layout
|
|
|
337 ;; ---------------
|
|
0
|
338 ;;
|
|
82
|
339 ;; The vertical layout is determined by the variables
|
|
|
340 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
|
|
|
341 ;; as follows:
|
|
|
342 ;;
|
|
|
343 ;; |--------| |--------|
|
|
|
344 ;; | tm | | tm |
|
|
|
345 ;; |--------| |--------|
|
|
|
346 ;; | header | | |
|
|
|
347 ;; |--------| | |
|
|
|
348 ;; | ho | | |
|
|
|
349 ;; |--------| or | text |
|
|
|
350 ;; | | | |
|
|
|
351 ;; | text | | |
|
|
|
352 ;; | | | |
|
|
|
353 ;; |--------| |--------|
|
|
|
354 ;; | bm | | bm |
|
|
|
355 ;; |--------| |--------|
|
|
|
356 ;;
|
|
|
357 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
|
|
|
358 ;; The margins represent margins in the printed paper:
|
|
|
359 ;; the top margin is the margin between the top of the page
|
|
|
360 ;; and the printed header, whatever the orientation is.
|
|
0
|
361 ;;
|
|
|
362 ;;
|
|
|
363 ;; Headers
|
|
82
|
364 ;; -------
|
|
0
|
365 ;;
|
|
82
|
366 ;; Ps-print can print headers at the top of each column; the default
|
|
0
|
367 ;; headers contain the following four items: on the left, the name of
|
|
|
368 ;; the buffer and, if the buffer is visiting a file, the file's
|
|
82
|
369 ;; directory; on the right, the page number and date of printing.
|
|
|
370 ;; The default headers look something like this:
|
|
0
|
371 ;;
|
|
|
372 ;; ps-print.el 1/21
|
|
|
373 ;; /home/jct/emacs-lisp/ps/new 94/12/31
|
|
|
374 ;;
|
|
|
375 ;; When printing on duplex printers, left and right are reversed so
|
|
82
|
376 ;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
|
|
|
377 ;;
|
|
|
378 ;; Headers are configurable:
|
|
|
379 ;; To turn them off completely, set `ps-print-header' to nil.
|
|
|
380 ;; To turn off the header's gaudy framing box,
|
|
|
381 ;; set `ps-print-header-frame' to nil.
|
|
0
|
382 ;;
|
|
82
|
383 ;; The font family and size of text in the header are determined
|
|
|
384 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
|
|
|
385 ;; `ps-header-title-font-size' (see below).
|
|
|
386 ;;
|
|
|
387 ;; The variable `ps-header-line-pad' determines the portion of a header
|
|
|
388 ;; title line height to insert between the header frame and the text
|
|
|
389 ;; it contains, both in the vertical and horizontal directions:
|
|
|
390 ;; .5 means half a line.
|
|
|
391
|
|
|
392 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
|
|
|
393 ;; to omit the total page count and just print the page number,
|
|
|
394 ;; set `ps-show-n-of-n' to nil.
|
|
0
|
395 ;;
|
|
|
396 ;; The amount of information in the header can be changed by changing
|
|
82
|
397 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
|
|
0
|
398 ;; the header will show only the buffer name and page number. To show
|
|
82
|
399 ;; more, set `ps-header-lines' to 3, and the header will show the time of
|
|
0
|
400 ;; printing below the date.
|
|
|
401 ;;
|
|
|
402 ;; To change the content of the headers, change the variables
|
|
82
|
403 ;; `ps-left-header' and `ps-right-header'.
|
|
|
404 ;; These variables are lists, specifying top-to-bottom the text
|
|
|
405 ;; to display on the left or right side of the header.
|
|
|
406 ;; Each element of the list should be a string or a symbol.
|
|
|
407 ;; Strings are inserted directly into the PostScript arrays,
|
|
|
408 ;; and should contain the PostScript string delimiters '(' and ')'.
|
|
0
|
409 ;;
|
|
|
410 ;; Symbols in the header format lists can either represent functions
|
|
|
411 ;; or variables. Functions are called, and should return a string to
|
|
|
412 ;; show in the header. Variables should contain strings to display in
|
|
|
413 ;; the header. In either case, function or variable, the PostScript
|
|
82
|
414 ;; string delimiters are added by ps-print, and should not be part of
|
|
0
|
415 ;; the returned value.
|
|
|
416 ;;
|
|
|
417 ;; Here's an example: say we want the left header to display the text
|
|
|
418 ;;
|
|
|
419 ;; Moe
|
|
|
420 ;; Larry
|
|
|
421 ;; Curly
|
|
|
422 ;;
|
|
|
423 ;; where we have a function to return "Moe"
|
|
|
424 ;;
|
|
|
425 ;; (defun moe-func ()
|
|
|
426 ;; "Moe")
|
|
|
427 ;;
|
|
|
428 ;; a variable specifying "Larry"
|
|
|
429 ;;
|
|
|
430 ;; (setq larry-var "Larry")
|
|
|
431 ;;
|
|
82
|
432 ;; and a literal for "Curly". Here's how `ps-left-header' should be
|
|
0
|
433 ;; set:
|
|
|
434 ;;
|
|
|
435 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
|
|
|
436 ;;
|
|
|
437 ;; Note that Curly has the PostScript string delimiters inside his
|
|
82
|
438 ;; quotes -- those aren't misplaced lisp delimiters!
|
|
|
439 ;;
|
|
|
440 ;; Without them, PostScript would attempt to call the undefined
|
|
|
441 ;; function Curly, which would result in a PostScript error.
|
|
|
442 ;;
|
|
|
443 ;; Since most printers don't report PostScript errors except by
|
|
|
444 ;; aborting the print job, this kind of error can be hard to track down.
|
|
|
445 ;;
|
|
|
446 ;; Consider yourself warned!
|
|
0
|
447 ;;
|
|
|
448 ;;
|
|
|
449 ;; Duplex Printers
|
|
82
|
450 ;; ---------------
|
|
0
|
451 ;;
|
|
|
452 ;; If you have a duplex-capable printer (one that prints both sides of
|
|
82
|
453 ;; the paper), set `ps-spool-duplex' to t.
|
|
|
454 ;; Ps-print will insert blank pages to make sure each buffer starts
|
|
|
455 ;; on the correct side of the paper.
|
|
|
456 ;; Don't forget to set `ps-lpr-switches' to select duplex printing
|
|
|
457 ;; for your printer.
|
|
|
458 ;;
|
|
|
459 ;;
|
|
|
460 ;; Font managing
|
|
|
461 ;; -------------
|
|
|
462 ;;
|
|
|
463 ;; Ps-print now knows rather precisely some fonts:
|
|
|
464 ;; the variable `ps-font-info-database' contains information
|
|
|
465 ;; for a list of font families (currently mainly `Courier' `Helvetica'
|
|
|
466 ;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
|
|
|
467 ;; Each font family contains the font names for standard, bold, italic
|
|
|
468 ;; and bold-italic characters, a reference size (usually 10) and the
|
|
|
469 ;; corresponding line height, width of a space and average character width.
|
|
0
|
470 ;;
|
|
82
|
471 ;; The variable `ps-font-family' determines which font family
|
|
|
472 ;; is to be used for ordinary text.
|
|
|
473 ;; If its value does not correspond to a known font family,
|
|
|
474 ;; an error message is printed into the `*Messages*' buffer,
|
|
|
475 ;; which lists the currently available font families.
|
|
16
|
476 ;;
|
|
82
|
477 ;; The variable `ps-font-size' determines the size (in points)
|
|
|
478 ;; of the font for ordinary text, when generating Postscript.
|
|
|
479 ;; Its value is a float.
|
|
|
480 ;;
|
|
|
481 ;; Similarly, the variable `ps-header-font-family' determines
|
|
|
482 ;; which font family is to be used for text in the header.
|
|
|
483 ;; The variable `ps-header-font-size' determines the font size,
|
|
|
484 ;; in points, for text in the header.
|
|
|
485 ;; The variable `ps-header-title-font-size' determines the font size,
|
|
|
486 ;; in points, for the top line of text in the header.
|
|
|
487 ;;
|
|
|
488 ;;
|
|
|
489 ;; Adding a new font family
|
|
|
490 ;; ------------------------
|
|
|
491 ;;
|
|
|
492 ;; To use a new font family, you MUST first teach ps-print
|
|
88
|
493 ;; this font, i.e., add its information to `ps-font-info-database',
|
|
82
|
494 ;; otherwise ps-print cannot correctly place line and page breaks.
|
|
|
495 ;;
|
|
88
|
496 ;; For example, assuming `Helvetica' is unknown,
|
|
82
|
497 ;; you first need to do the following ONLY ONCE:
|
|
|
498 ;;
|
|
|
499 ;; - create a new buffer
|
|
|
500 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
|
|
|
501 ;; - open this file and find the line:
|
|
|
502 ;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
|
|
|
503 ;; - delete the leading `%' (which is the Postscript comment character)
|
|
|
504 ;; - replace in this line `Courier' by the new font (say `Helvetica')
|
|
|
505 ;; to get the line:
|
|
|
506 ;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
|
|
|
507 ;; - send this file to the printer (or to ghostscript).
|
|
|
508 ;; You should read the following on the output page:
|
|
|
509 ;;
|
|
|
510 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
|
|
|
511 ;; and a crude estimate of average character width is 5.09243
|
|
|
512 ;;
|
|
|
513 ;; - Add these values to the `ps-font-info-database':
|
|
|
514 ;; (setq ps-font-info-database
|
|
|
515 ;; (append
|
|
|
516 ;; '((Helvetica ; the family name
|
|
|
517 ;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
|
|
|
518 ;; 10.0 11.56 2.78 5.09243))
|
|
|
519 ;; ps-font-info-database))
|
|
|
520 ;; - Now you can use this font family with any size:
|
|
|
521 ;; (setq ps-font-family 'Helvetica)
|
|
|
522 ;; - if you want to use this family in another emacs session, you must
|
|
|
523 ;; put into your `~/.emacs':
|
|
|
524 ;; (require 'ps-print)
|
|
|
525 ;; (setq ps-font-info-database (append ...)))
|
|
|
526 ;; if you don't want to load ps-print, you have to copy the whole value:
|
|
|
527 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
|
|
|
528 ;; or, if you can wait until the `ps-print-hook' is implemented, do:
|
|
|
529 ;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...)))
|
|
|
530 ;; This does not work yet, since there is no `ps-print-hook' yet.
|
|
0
|
531 ;;
|
|
82
|
532 ;; You can create new `mixed' font families like:
|
|
|
533 ;; (my-mixed-family
|
|
|
534 ;; "Courier-Bold" "Helvetica"
|
|
|
535 ;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic"
|
|
|
536 ;; 10.0 10.55 6.0 6.0)
|
|
|
537 ;; Now you can use your new font family with any size:
|
|
|
538 ;; (setq ps-font-family 'my-mixed-family)
|
|
|
539 ;;
|
|
|
540 ;; You can get information on all the fonts resident in YOUR printer
|
|
|
541 ;; by uncommenting the line:
|
|
|
542 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
|
|
|
543 ;;
|
|
|
544 ;; The postscript file should be sent to YOUR postscript printer.
|
|
|
545 ;; If you send it to ghostscript or to another postscript printer,
|
|
|
546 ;; you may get slightly different results.
|
|
|
547 ;; Anyway, as ghostscript fonts are autoload, you won't get
|
|
|
548 ;; much font info.
|
|
|
549 ;;
|
|
|
550 ;;
|
|
|
551 ;; How Ps-Print Deals With Faces
|
|
|
552 ;; -----------------------------
|
|
|
553 ;;
|
|
|
554 ;; The ps-print-*-with-faces commands attempt to determine which faces
|
|
|
555 ;; should be printed in bold or italic, but their guesses aren't
|
|
|
556 ;; always right. For example, you might want to map colors into faces
|
|
|
557 ;; so that blue faces print in bold, and red faces in italic.
|
|
|
558 ;;
|
|
|
559 ;; It is possible to force ps-print to consider specific faces bold or
|
|
|
560 ;; italic, no matter what font they are displayed in, by setting the
|
|
|
561 ;; variables `ps-bold-faces' and `ps-italic-faces'. These variables
|
|
|
562 ;; contain lists of faces that ps-print should consider bold or
|
|
|
563 ;; italic; to set them, put code like the following into your .emacs
|
|
|
564 ;; file:
|
|
|
565 ;;
|
|
|
566 ;; (setq ps-bold-faces '(my-blue-face))
|
|
|
567 ;; (setq ps-italic-faces '(my-red-face))
|
|
|
568 ;;
|
|
|
569 ;; Faces like bold-italic that are both bold and italic should go in
|
|
|
570 ;; *both* lists.
|
|
0
|
571 ;;
|
|
82
|
572 ;; Ps-print keeps internal lists of which fonts are bold and which are
|
|
|
573 ;; italic; these lists are built the first time you invoke ps-print.
|
|
|
574 ;; For the sake of efficiency, the lists are built only once; the same
|
|
|
575 ;; lists are referred in later invocations of ps-print.
|
|
|
576 ;;
|
|
|
577 ;; Because these lists are built only once, it's possible for them to
|
|
|
578 ;; get out of sync, if a face changes, or if new faces are added. To
|
|
|
579 ;; get the lists back in sync, you can set the variable
|
|
|
580 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
|
|
|
581 ;; next time ps-print is invoked.
|
|
|
582 ;;
|
|
|
583 ;;
|
|
|
584 ;; How Ps-Print Deals With Color
|
|
|
585 ;; -----------------------------
|
|
|
586 ;;
|
|
|
587 ;; Ps-print detects faces with foreground and background colors
|
|
|
588 ;; defined and embeds color information in the PostScript image.
|
|
|
589 ;; The default foreground and background colors are defined by the
|
|
|
590 ;; variables `ps-default-fg' and `ps-default-bg'.
|
|
|
591 ;; On black-and-white printers, colors are displayed in grayscale.
|
|
|
592 ;; To turn off color output, set `ps-print-color-p' to nil.
|
|
|
593 ;;
|
|
|
594 ;;
|
|
|
595 ;; Utilities
|
|
|
596 ;; ---------
|
|
|
597 ;;
|
|
|
598 ;; Some tools are provided to help you customize your font setup.
|
|
|
599 ;;
|
|
|
600 ;; `ps-setup' returns (some part of) the current setup.
|
|
|
601 ;;
|
|
|
602 ;; To avoid wrapping too many lines, you may want to adjust the
|
|
|
603 ;; left and right margins and the font size. On UN*X systems, do:
|
|
|
604 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
|
|
|
605 ;; to determine the longest lines of your file.
|
|
88
|
606 ;; Then, the command `ps-line-lengths' will give you the correspondence
|
|
82
|
607 ;; between a line length (number of characters) and the maximum font
|
|
|
608 ;; size which doesn't wrap such a line with the current ps-print setup.
|
|
|
609 ;;
|
|
|
610 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
|
|
88
|
611 ;; the correspondence between a number of pages and the maximum font
|
|
82
|
612 ;; size which allow the number of lines of the current buffer or of
|
|
|
613 ;; its current region to fit in this number of pages.
|
|
|
614 ;; Note: line folding is not taken into account in this process
|
|
|
615 ;; and could change the results.
|
|
|
616 ;;
|
|
|
617 ;;
|
|
0
|
618 ;; New since version 1.5
|
|
|
619 ;; ---------------------
|
|
82
|
620 ;;
|
|
70
|
621 ;; Color output capability.
|
|
0
|
622 ;; Automatic detection of font attributes (bold, italic).
|
|
82
|
623 ;; Configurable headers with page numbers.
|
|
|
624 ;; Slightly faster.
|
|
|
625 ;; Support for different paper sizes.
|
|
|
626 ;; Better conformance to PostScript Document Structure Conventions.
|
|
70
|
627 ;;
|
|
0
|
628 ;;
|
|
82
|
629 ;; New since version 2.8
|
|
|
630 ;; ---------------------
|
|
|
631 ;;
|
|
|
632 ;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
|
|
0
|
633 ;;
|
|
82
|
634 ;; Font familiy and float size for text and header.
|
|
|
635 ;; Landscape mode.
|
|
|
636 ;; Multiple columns.
|
|
|
637 ;; Tools for page setup.
|
|
0
|
638 ;;
|
|
|
639 ;;
|
|
|
640 ;; Known bugs and limitations of ps-print:
|
|
|
641 ;; --------------------------------------
|
|
82
|
642 ;;
|
|
0
|
643 ;; Although color printing will work in XEmacs 19.12, it doesn't work
|
|
|
644 ;; well; in particular, bold or italic fonts don't print in the right
|
|
|
645 ;; background color.
|
|
|
646 ;;
|
|
|
647 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
|
|
|
648 ;;
|
|
|
649 ;; Automatic font-attribute detection doesn't work well, especially
|
|
|
650 ;; with hilit19 and older versions of get-create-face. Users having
|
|
82
|
651 ;; problems with auto-font detection should use the lists
|
|
|
652 ;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic
|
|
|
653 ;; detection by setting `ps-auto-font-detect' to nil.
|
|
0
|
654 ;;
|
|
|
655 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
|
|
82
|
656 ;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces'
|
|
0
|
657 ;; instead.
|
|
|
658 ;;
|
|
|
659 ;; Still too slow; could use some hand-optimization.
|
|
|
660 ;;
|
|
|
661 ;; ASCII Control characters other than tab, linefeed and pagefeed are
|
|
|
662 ;; not handled.
|
|
|
663 ;;
|
|
|
664 ;; Default background color isn't working.
|
|
|
665 ;;
|
|
|
666 ;; Faces are always treated as opaque.
|
|
|
667 ;;
|
|
|
668 ;; Epoch and Emacs 18 not supported. At all.
|
|
|
669 ;;
|
|
82
|
670 ;; Fixed-pitch fonts work better for line folding, but are not required.
|
|
0
|
671 ;;
|
|
82
|
672 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
|
|
|
673 ;; of folding lines.
|
|
|
674 ;;
|
|
|
675 ;;
|
|
|
676 ;; Things to change:
|
|
|
677 ;; ----------------
|
|
70
|
678 ;;
|
|
82
|
679 ;; Add `ps-print-hook' (I don't know how to do that (yet!)).
|
|
|
680 ;; Add 4-up capability (really needed?).
|
|
|
681 ;; Add line numbers (should not be too hard).
|
|
|
682 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
|
|
|
683 ;; Put one header per page over the columns (easy but needed?).
|
|
|
684 ;; Improve the memory management for big files (hard?).
|
|
|
685 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
|
|
|
686 ;; of folding lines.
|
|
0
|
687 ;;
|
|
|
688 ;;
|
|
|
689 ;; Acknowledgements
|
|
|
690 ;; ----------------
|
|
82
|
691 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
|
|
|
692 ;; [jack]
|
|
|
693 ;;
|
|
0
|
694 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
|
|
|
695 ;; color and the invisible property.
|
|
|
696 ;;
|
|
|
697 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
|
|
|
698 ;; the initial port to Emacs 19. His code is no longer part of
|
|
|
699 ;; ps-print, but his work is still appreciated.
|
|
|
700 ;;
|
|
|
701 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
|
|
|
702 ;; for adding underline support. Their code also is no longer part of
|
|
|
703 ;; ps-print, but their efforts are not forgotten.
|
|
|
704 ;;
|
|
|
705 ;; Thanks also to all of you who mailed code to add features to
|
|
|
706 ;; ps-print; although I didn't use your code, I still appreciate your
|
|
|
707 ;; sharing it with me.
|
|
|
708 ;;
|
|
|
709 ;; Thanks to all who mailed comments, encouragement, and criticism.
|
|
|
710 ;; Thanks also to all who responded to my survey; I had too many
|
|
|
711 ;; responses to reply to them all, but I greatly appreciate your
|
|
|
712 ;; interest.
|
|
|
713 ;;
|
|
|
714 ;; Jim
|
|
|
715 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
716
|
|
|
717 ;;; Code:
|
|
|
718
|
|
82
|
719 (eval-when-compile
|
|
|
720 (require 'cl))
|
|
|
721
|
|
|
722 (unless (featurep 'lisp-float-type)
|
|
|
723 (error "`ps-print' requires floating point support"))
|
|
0
|
724
|
|
|
725 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
726 ;; User Variables:
|
|
|
727
|
|
82
|
728 ;;; Interface to the command system
|
|
|
729
|
|
124
|
730 (defgroup ps-print nil
|
|
|
731 "Postscript generator for Emacs 19"
|
|
|
732 :prefix "ps-"
|
|
|
733 :group 'wp)
|
|
|
734
|
|
|
735 (defgroup ps-print-horizontal nil
|
|
|
736 "Horizontal page layout"
|
|
|
737 :prefix "ps-"
|
|
|
738 :tag "Horizontal"
|
|
|
739 :group 'ps-print)
|
|
|
740
|
|
|
741 (defgroup ps-print-vertical nil
|
|
|
742 "Vertical page layout"
|
|
|
743 :prefix "ps-"
|
|
|
744 :tag "Vertical"
|
|
|
745 :group 'ps-print)
|
|
|
746
|
|
|
747 (defgroup ps-print-header nil
|
|
|
748 "Headers layout"
|
|
|
749 :prefix "ps-"
|
|
|
750 :tag "Header"
|
|
|
751 :group 'ps-print)
|
|
|
752
|
|
|
753 (defgroup ps-print-font nil
|
|
|
754 "Fonts customization"
|
|
|
755 :prefix "ps-"
|
|
|
756 :tag "Font"
|
|
|
757 :group 'ps-print)
|
|
|
758
|
|
|
759 (defgroup ps-print-color nil
|
|
|
760 "Color customization"
|
|
|
761 :prefix "ps-"
|
|
|
762 :tag "Color"
|
|
|
763 :group 'ps-print)
|
|
|
764
|
|
|
765 (defgroup ps-print-face nil
|
|
|
766 "Faces customization"
|
|
|
767 :prefix "ps-"
|
|
|
768 :tag "PS Faces"
|
|
|
769 :group 'ps-print
|
|
|
770 :group 'faces)
|
|
|
771
|
|
|
772
|
|
|
773 (defcustom ps-lpr-command lpr-command
|
|
|
774 "*The shell command for printing a PostScript file."
|
|
|
775 :type 'string
|
|
|
776 :group 'ps-print)
|
|
|
777
|
|
|
778 (defcustom ps-lpr-switches lpr-switches
|
|
|
779 "*A list of extra switches to pass to `ps-lpr-command'."
|
|
|
780 :type '(repeat string)
|
|
|
781 :group 'ps-print)
|
|
0
|
782
|
|
82
|
783 ;;; Page layout
|
|
|
784
|
|
|
785 ;; All page dimensions are in PostScript points.
|
|
|
786 ;; 1 inch == 2.54 cm == 72 points
|
|
|
787 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
|
|
|
788
|
|
|
789 ;; Letter 8.5 inch x 11.0 inch
|
|
|
790 ;; Legal 8.5 inch x 14.0 inch
|
|
|
791 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
|
|
|
792
|
|
|
793 ;; LetterSmall 7.68 inch x 10.16 inch
|
|
|
794 ;; Tabloid 11.0 inch x 17.0 inch
|
|
|
795 ;; Ledger 17.0 inch x 11.0 inch
|
|
|
796 ;; Statement 5.5 inch x 8.5 inch
|
|
|
797 ;; Executive 7.5 inch x 10.0 inch
|
|
|
798 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
|
|
|
799 ;; A4Small 7.47 inch x 10.85 inch
|
|
|
800 ;; B4 10.125 inch x 14.33 inch
|
|
|
801 ;; B5 7.16 inch x 10.125 inch
|
|
|
802
|
|
124
|
803 (defcustom ps-page-dimensions-database
|
|
82
|
804 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54))
|
|
|
805 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54))
|
|
|
806 (list 'letter (* 72 8.5) (* 72 11.0))
|
|
|
807 (list 'legal (* 72 8.5) (* 72 14.0))
|
|
|
808 (list 'letter-small (* 72 7.68) (* 72 10.16))
|
|
|
809 (list 'tabloid (* 72 11.0) (* 72 17.0))
|
|
|
810 (list 'ledger (* 72 17.0) (* 72 11.0))
|
|
|
811 (list 'statement (* 72 5.5) (* 72 8.5))
|
|
|
812 (list 'executive (* 72 7.5) (* 72 10.0))
|
|
|
813 (list 'a4small (* 72 7.47) (* 72 10.85))
|
|
|
814 (list 'b4 (* 72 10.125) (* 72 14.33))
|
|
|
815 (list 'b5 (* 72 7.16) (* 72 10.125)))
|
|
|
816 "*List associating a symbolic paper type to its width and height.
|
|
124
|
817 see `ps-paper-type'."
|
|
|
818 :type '(repeat (list :tag "Paper Type"
|
|
|
819 (symbol :tag "Name")
|
|
|
820 (number :tag "Width")
|
|
|
821 (number :tag "Height")))
|
|
|
822 :group 'ps-print)
|
|
0
|
823
|
|
|
824 ;;;###autoload
|
|
124
|
825 (defcustom ps-paper-type 'letter
|
|
82
|
826 "*Specifies the size of paper to format for.
|
|
|
827 Should be one of the paper types defined in `ps-page-dimensions-database', for
|
|
124
|
828 example `letter', `legal' or `a4'."
|
|
|
829 :type '(symbol :validate (lambda (wid)
|
|
|
830 (if (assq (widget-value wid) ps-page-dimensions-database)
|
|
|
831 nil
|
|
|
832 (widget-put wid :error "Unknown paper size")
|
|
|
833 wid)))
|
|
|
834 :group 'ps-print)
|
|
|
835
|
|
|
836 (defcustom ps-landscape-mode 'nil
|
|
|
837 "*Non-nil means print in landscape mode."
|
|
|
838 :type 'boolean
|
|
|
839 :group 'ps-print)
|
|
|
840
|
|
|
841 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
|
|
|
842 "*Specifies the number of columns"
|
|
|
843 :type 'integer
|
|
|
844 :group 'ps-print)
|
|
82
|
845
|
|
|
846 ;;; Horizontal layout
|
|
|
847
|
|
|
848 ;; ------------------------------------------
|
|
|
849 ;; | | | | | | | |
|
|
|
850 ;; | lm | text | ic | text | ic | text | rm |
|
|
|
851 ;; | | | | | | | |
|
|
|
852 ;; ------------------------------------------
|
|
|
853
|
|
124
|
854 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
|
|
|
855 "*Left margin in points (1/72 inch)."
|
|
|
856 :type 'number
|
|
|
857 :group 'ps-print-horizontal)
|
|
|
858
|
|
|
859 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
|
|
|
860 "*Right margin in points (1/72 inch)."
|
|
|
861 :type 'number
|
|
|
862 :group 'ps-print-horizontal)
|
|
|
863
|
|
|
864 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
|
|
|
865 "*Horizontal space between columns in points (1/72 inch)."
|
|
|
866 :type 'number
|
|
|
867 :group 'ps-print-horizontal)
|
|
82
|
868
|
|
|
869 ;;; Vertical layout
|
|
|
870
|
|
|
871 ;; |--------|
|
|
|
872 ;; | tm |
|
|
|
873 ;; |--------|
|
|
|
874 ;; | header |
|
|
|
875 ;; |--------|
|
|
|
876 ;; | ho |
|
|
|
877 ;; |--------|
|
|
|
878 ;; | text |
|
|
|
879 ;; |--------|
|
|
|
880 ;; | bm |
|
|
|
881 ;; |--------|
|
|
|
882
|
|
124
|
883 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
|
|
|
884 "*Bottom margin in points (1/72 inch)."
|
|
|
885 :type 'number
|
|
|
886 :group 'ps-print-vertical)
|
|
|
887
|
|
|
888 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
|
|
|
889 "*Top margin in points (1/72 inch)."
|
|
|
890 :type 'number
|
|
|
891 :group 'ps-print-vertical)
|
|
|
892
|
|
|
893 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
|
|
|
894 "*Vertical space in points (1/72 inch) between the main text and the header."
|
|
|
895 :type 'number
|
|
|
896 :group 'ps-print-vertical)
|
|
|
897
|
|
|
898 (defcustom ps-header-line-pad 0.15
|
|
82
|
899 "*Portion of a header title line height to insert between the header frame
|
|
124
|
900 and the text it contains, both in the vertical and horizontal directions."
|
|
|
901 :type 'number
|
|
|
902 :group 'ps-print-vertical)
|
|
82
|
903
|
|
|
904 ;;; Header setup
|
|
0
|
905
|
|
124
|
906 (defcustom ps-print-header t
|
|
0
|
907 "*Non-nil means print a header at the top of each page.
|
|
|
908 By default, the header displays the buffer name, page number, and, if
|
|
|
909 the buffer is visiting a file, the file's directory. Headers are
|
|
|
910 customizable by changing variables `ps-header-left' and
|
|
124
|
911 `ps-header-right'."
|
|
|
912 :type 'boolean
|
|
|
913 :group 'ps-print-header)
|
|
|
914
|
|
|
915 (defcustom ps-print-header-frame t
|
|
|
916 "*Non-nil means draw a gaudy frame around the header."
|
|
|
917 :type 'boolean
|
|
|
918 :group 'ps-print-header)
|
|
|
919
|
|
|
920 (defcustom ps-header-lines 2
|
|
|
921 "*Number of lines to display in page header, when generating Postscript."
|
|
|
922 :type 'integer
|
|
|
923 :group 'ps-print-header)
|
|
82
|
924 (make-variable-buffer-local 'ps-header-lines)
|
|
|
925
|
|
124
|
926 (defcustom ps-show-n-of-n t
|
|
0
|
927 "*Non-nil means show page numbers as N/M, meaning page N of M.
|
|
|
928 Note: page numbers are displayed as part of headers, see variable
|
|
124
|
929 `ps-print-headers'."
|
|
|
930 :type 'boolean
|
|
|
931 :group 'ps-print-header)
|
|
|
932
|
|
|
933 (defcustom ps-spool-duplex nil ; Not many people have duplex
|
|
82
|
934 ; printers, so default to nil.
|
|
|
935 "*Non-nil indicates spooling is for a two-sided printer.
|
|
|
936 For a duplex printer, the `ps-spool-*' commands will insert blank pages
|
|
|
937 as needed between print jobs so that the next buffer printed will
|
|
|
938 start on the right page. Also, if headers are turned on, the headers
|
|
|
939 will be reversed on duplex printers so that the page numbers fall to
|
|
124
|
940 the left on even-numbered pages."
|
|
|
941 :type 'boolean
|
|
|
942 :group 'ps-print-header)
|
|
82
|
943
|
|
|
944 ;;; Fonts
|
|
|
945
|
|
124
|
946 (defcustom ps-font-info-database
|
|
82
|
947 '((Courier ; the family key
|
|
|
948 "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique"
|
|
|
949 10.0 10.55 6.0 6.0)
|
|
|
950 (Helvetica ; the family key
|
|
|
951 "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
|
|
|
952 10.0 11.56 2.78 5.09243)
|
|
|
953 (Times
|
|
|
954 "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic"
|
|
|
955 10.0 11.0 2.5 4.71432)
|
|
|
956 (Palatino
|
|
|
957 "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic"
|
|
|
958 10.0 12.1 2.5 5.08676)
|
|
|
959 (Helvetica-Narrow
|
|
|
960 "Helvetica-Narrow" "Helvetica-Narrow-Bold"
|
|
|
961 "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique"
|
|
|
962 10.0 11.56 2.2796 4.17579)
|
|
|
963 (NewCenturySchlbk
|
|
|
964 "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold"
|
|
|
965 "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic"
|
|
|
966 10.0 12.15 2.78 5.31162)
|
|
|
967 ;; got no bold for the next ones
|
|
|
968 (AvantGarde-Book
|
|
|
969 "AvantGarde-Book" "AvantGarde-Book"
|
|
|
970 "AvantGarde-BookOblique" "AvantGarde-BookOblique"
|
|
|
971 10.0 11.77 2.77 5.45189)
|
|
|
972 (AvantGarde-Demi
|
|
|
973 "AvantGarde-Demi" "AvantGarde-Demi"
|
|
|
974 "AvantGarde-DemiOblique" "AvantGarde-DemiOblique"
|
|
|
975 10.0 12.72 2.8 5.51351)
|
|
|
976 (Bookman-Demi
|
|
|
977 "Bookman-Demi" "Bookman-Demi"
|
|
|
978 "Bookman-DemiItalic" "Bookman-DemiItalic"
|
|
|
979 10.0 11.77 3.4 6.05946)
|
|
|
980 (Bookman-Light
|
|
|
981 "Bookman-Light" "Bookman-Light"
|
|
|
982 "Bookman-LightItalic" "Bookman-LightItalic"
|
|
|
983 10.0 11.79 3.2 5.67027)
|
|
|
984 ;; got no bold and no italic for the next ones
|
|
|
985 (Symbol
|
|
|
986 "Symbol" "Symbol" "Symbol" "Symbol"
|
|
|
987 10.0 13.03 2.5 3.24324)
|
|
|
988 (Zapf-Dingbats
|
|
|
989 "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats"
|
|
|
990 10.0 9.63 2.78 2.78)
|
|
|
991 (Zapf-Chancery-MediumItalic
|
|
|
992 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
|
|
|
993 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
|
|
|
994 10.0 11.45 2.2 4.10811)
|
|
|
995 )
|
|
|
996 "*Font info database: font family (the key), name, bold, italic, bold-italic,
|
|
|
997 reference size, line height, space width, average character width.
|
|
|
998 To get the info for another specific font (say Helvetica), do the following:
|
|
|
999 - create a new buffer
|
|
|
1000 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
|
|
|
1001 - open this file and delete the leading `%' (which is the Postscript
|
|
|
1002 comment character) from the line
|
|
|
1003 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
|
|
|
1004 to get the line
|
|
|
1005 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
|
|
|
1006 - add the values to `ps-font-info-database'.
|
|
124
|
1007 You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
|
|
|
1008 :type '(repeat (list :tag "Font Definition"
|
|
|
1009 (symbol :tag "Font")
|
|
|
1010 (string :tag "Name")
|
|
|
1011 (string :tag "Bold")
|
|
|
1012 (string :tag "Italic")
|
|
|
1013 (string :tag "Bold-Italic")
|
|
|
1014 (number :tag "Reference Size")
|
|
|
1015 (number :tag "Line Height")
|
|
|
1016 (number :tag "Space Width")
|
|
|
1017 (number :tag "Average Character Width")))
|
|
|
1018 :group 'ps-print-font)
|
|
|
1019
|
|
|
1020 (defcustom ps-font-family 'Courier
|
|
|
1021 "Font family name for ordinary text, when generating Postscript."
|
|
|
1022 :type 'symbol
|
|
|
1023 :group 'ps-print-font)
|
|
|
1024
|
|
|
1025 (defcustom ps-font-size (if ps-landscape-mode 7 8.5)
|
|
|
1026 "Font size, in points, for ordinary text, when generating Postscript."
|
|
|
1027 :type 'number
|
|
|
1028 :group 'ps-print-font)
|
|
|
1029
|
|
|
1030 (defcustom ps-header-font-family 'Helvetica
|
|
|
1031 "Font family name for text in the header, when generating Postscript."
|
|
|
1032 :type 'symbol
|
|
|
1033 :group 'ps-print-font)
|
|
|
1034
|
|
|
1035 (defcustom ps-header-font-size (if ps-landscape-mode 10 12)
|
|
|
1036 "Font size, in points, for text in the header, when generating Postscript."
|
|
|
1037 :type 'number
|
|
|
1038 :group 'ps-print-font)
|
|
|
1039
|
|
|
1040 (defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)
|
|
82
|
1041 "Font size, in points, for the top line of text in the header,
|
|
124
|
1042 when generating Postscript."
|
|
|
1043 :type 'number
|
|
|
1044 :group 'ps-print-font)
|
|
82
|
1045
|
|
|
1046 ;;; Colors
|
|
|
1047
|
|
0
|
1048 ;;;###autoload
|
|
2
|
1049 ;;; The 19.33 fsf version includes a test on pixel components instead
|
|
|
1050 ;;; of color-instance-rgb-components
|
|
124
|
1051 (defcustom ps-print-color-p (or (fboundp 'x-color-values) ; fsf
|
|
82
|
1052 (fboundp 'color-instance-rgb-components))
|
|
0
|
1053 ; xemacs
|
|
82
|
1054 ; Printing color requires x-color-values.
|
|
124
|
1055 "*If non-nil, print the buffer's text in color."
|
|
|
1056 :type 'boolean
|
|
|
1057 :group 'ps-print-color)
|
|
|
1058
|
|
|
1059 (defcustom ps-default-fg '(0.0 0.0 0.0)
|
|
|
1060 "*RGB values of the default foreground color. Defaults to black."
|
|
|
1061 :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
|
|
|
1062 :group 'ps-print-color)
|
|
|
1063
|
|
|
1064 (defcustom ps-default-bg '(1.0 1.0 1.0)
|
|
|
1065 "*RGB values of the default background color. Defaults to white."
|
|
|
1066 :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
|
|
|
1067 :group 'ps-print-color)
|
|
|
1068
|
|
|
1069 (defcustom ps-auto-font-detect t
|
|
0
|
1070 "*Non-nil means automatically detect bold/italic face attributes.
|
|
|
1071 nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces',
|
|
124
|
1072 and `ps-underlined-faces'."
|
|
|
1073 :type 'boolean
|
|
|
1074 :group 'ps-print-font)
|
|
|
1075
|
|
|
1076 (defcustom ps-bold-faces
|
|
82
|
1077 (unless ps-print-color-p
|
|
|
1078 '(font-lock-function-name-face
|
|
|
1079 font-lock-builtin-face
|
|
|
1080 font-lock-variable-name-face
|
|
|
1081 font-lock-keyword-face
|
|
|
1082 font-lock-warning-face))
|
|
0
|
1083 "*A list of the \(non-bold\) faces that should be printed in bold font.
|
|
124
|
1084 This applies to generating Postscript."
|
|
|
1085 :type '(repeat face)
|
|
|
1086 :group 'ps-print-face)
|
|
|
1087
|
|
|
1088 (defcustom ps-italic-faces
|
|
82
|
1089 (unless ps-print-color-p
|
|
|
1090 '(font-lock-variable-name-face
|
|
|
1091 font-lock-string-face
|
|
|
1092 font-lock-comment-face
|
|
|
1093 font-lock-warning-face))
|
|
0
|
1094 "*A list of the \(non-italic\) faces that should be printed in italic font.
|
|
124
|
1095 This applies to generating Postscript."
|
|
|
1096 :type '(repeat face)
|
|
|
1097 :group 'ps-print-face)
|
|
|
1098
|
|
|
1099 (defcustom ps-underlined-faces
|
|
82
|
1100 (unless ps-print-color-p
|
|
|
1101 '(font-lock-function-name-face
|
|
|
1102 font-lock-type-face
|
|
|
1103 font-lock-reference-face
|
|
|
1104 font-lock-warning-face))
|
|
0
|
1105 "*A list of the \(non-underlined\) faces that should be printed underlined.
|
|
124
|
1106 This applies to generating Postscript."
|
|
|
1107 :type '(repeat face)
|
|
|
1108 :group 'ps-print-face)
|
|
|
1109
|
|
|
1110 (defcustom ps-left-header
|
|
0
|
1111 (list 'ps-get-buffer-name 'ps-header-dirpart)
|
|
82
|
1112 "*The items to display (each on a line) on the left part of the page header.
|
|
0
|
1113 This applies to generating Postscript.
|
|
|
1114
|
|
|
1115 The value should be a list of strings and symbols, each representing an
|
|
|
1116 entry in the PostScript array HeaderLinesLeft.
|
|
|
1117
|
|
|
1118 Strings are inserted unchanged into the array; those representing
|
|
|
1119 PostScript string literals should be delimited with PostScript string
|
|
|
1120 delimiters '(' and ')'.
|
|
|
1121
|
|
|
1122 For symbols with bound functions, the function is called and should
|
|
|
1123 return a string to be inserted into the array. For symbols with bound
|
|
|
1124 values, the value should be a string to be inserted into the array.
|
|
|
1125 In either case, function or variable, the string value has PostScript
|
|
124
|
1126 string delimiters added to it."
|
|
|
1127 :type '(repeat (choice string symbol))
|
|
144
|
1128 :group 'ps-print-header)
|
|
0
|
1129 (make-variable-buffer-local 'ps-left-header)
|
|
|
1130
|
|
124
|
1131 (defcustom ps-right-header
|
|
82
|
1132 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
|
|
|
1133 "*The items to display (each on a line) on the right part of the page header.
|
|
0
|
1134 This applies to generating Postscript.
|
|
|
1135
|
|
|
1136 See the variable `ps-left-header' for a description of the format of
|
|
124
|
1137 this variable."
|
|
|
1138 :type '(repeat (choice string symbol))
|
|
144
|
1139 :group 'ps-print-header)
|
|
0
|
1140 (make-variable-buffer-local 'ps-right-header)
|
|
|
1141
|
|
124
|
1142 (defcustom ps-razzle-dazzle t
|
|
|
1143 "*Non-nil means report progress while formatting buffer."
|
|
|
1144 :type 'boolean
|
|
|
1145 :group 'ps-print)
|
|
0
|
1146
|
|
88
|
1147 (defvar ps-adobe-tag "%!PS-Adobe-3.0\n"
|
|
0
|
1148 "*Contains the header line identifying the output as PostScript.
|
|
|
1149 By default, `ps-adobe-tag' contains the standard identifier. Some
|
|
|
1150 printers require slightly different versions of this line.")
|
|
|
1151
|
|
124
|
1152 (defcustom ps-build-face-reference t
|
|
0
|
1153 "*Non-nil means build the reference face lists.
|
|
|
1154
|
|
|
1155 Ps-print sets this value to nil after it builds its internal reference
|
|
|
1156 lists of bold and italic faces. By settings its value back to t, you
|
|
|
1157 can force ps-print to rebuild the lists the next time you invoke one
|
|
|
1158 of the ...-with-faces commands.
|
|
|
1159
|
|
|
1160 You should set this value back to t after you change the attributes of
|
|
|
1161 any face, or create new faces. Most users shouldn't have to worry
|
|
124
|
1162 about its setting, though."
|
|
|
1163 :type 'boolean
|
|
|
1164 :group 'ps-print-face)
|
|
|
1165
|
|
|
1166 (defcustom ps-always-build-face-reference nil
|
|
0
|
1167 "*Non-nil means always rebuild the reference face lists.
|
|
|
1168
|
|
|
1169 If this variable is non-nil, ps-print will rebuild its internal
|
|
|
1170 reference lists of bold and italic faces *every* time one of the
|
|
|
1171 -with-faces commands is called. Most users shouldn't need to set this
|
|
124
|
1172 variable."
|
|
|
1173 :type 'boolean
|
|
|
1174 :group 'ps-print-face)
|
|
0
|
1175
|
|
|
1176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1177 ;; User commands
|
|
|
1178
|
|
|
1179 ;;;###autoload
|
|
|
1180 (defun ps-print-buffer (&optional filename)
|
|
|
1181 "Generate and print a PostScript image of the buffer.
|
|
|
1182
|
|
|
1183 When called with a numeric prefix argument (C-u), prompts the user for
|
|
|
1184 the name of a file to save the PostScript image in, instead of sending
|
|
|
1185 it to the printer.
|
|
|
1186
|
|
|
1187 More specifically, the FILENAME argument is treated as follows: if it
|
|
|
1188 is nil, send the image to the printer. If FILENAME is a string, save
|
|
|
1189 the PostScript image in a file with that name. If FILENAME is a
|
|
|
1190 number, prompt the user for the name of the file to save in."
|
|
|
1191
|
|
|
1192 (interactive (list (ps-print-preprint current-prefix-arg)))
|
|
|
1193 (ps-generate (current-buffer) (point-min) (point-max)
|
|
|
1194 'ps-generate-postscript)
|
|
|
1195 (ps-do-despool filename))
|
|
|
1196
|
|
|
1197
|
|
|
1198 ;;;###autoload
|
|
|
1199 (defun ps-print-buffer-with-faces (&optional filename)
|
|
|
1200 "Generate and print a PostScript image of the buffer.
|
|
|
1201 Like `ps-print-buffer', but includes font, color, and underline
|
|
2
|
1202 information in the generated image. This command works only if you
|
|
|
1203 are using a window system, so it has a way to determine color values."
|
|
0
|
1204 (interactive (list (ps-print-preprint current-prefix-arg)))
|
|
|
1205 (ps-generate (current-buffer) (point-min) (point-max)
|
|
|
1206 'ps-generate-postscript-with-faces)
|
|
|
1207 (ps-do-despool filename))
|
|
|
1208
|
|
|
1209
|
|
|
1210 ;;;###autoload
|
|
|
1211 (defun ps-print-region (from to &optional filename)
|
|
|
1212 "Generate and print a PostScript image of the region.
|
|
|
1213 Like `ps-print-buffer', but prints just the current region."
|
|
|
1214
|
|
|
1215 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
|
|
|
1216 (ps-generate (current-buffer) from to
|
|
|
1217 'ps-generate-postscript)
|
|
|
1218 (ps-do-despool filename))
|
|
|
1219
|
|
|
1220
|
|
|
1221 ;;;###autoload
|
|
|
1222 (defun ps-print-region-with-faces (from to &optional filename)
|
|
|
1223 "Generate and print a PostScript image of the region.
|
|
|
1224 Like `ps-print-region', but includes font, color, and underline
|
|
2
|
1225 information in the generated image. This command works only if you
|
|
|
1226 are using a window system, so it has a way to determine color values."
|
|
0
|
1227
|
|
|
1228 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
|
|
|
1229 (ps-generate (current-buffer) from to
|
|
|
1230 'ps-generate-postscript-with-faces)
|
|
|
1231 (ps-do-despool filename))
|
|
|
1232
|
|
|
1233
|
|
|
1234 ;;;###autoload
|
|
|
1235 (defun ps-spool-buffer ()
|
|
|
1236 "Generate and spool a PostScript image of the buffer.
|
|
|
1237 Like `ps-print-buffer' except that the PostScript image is saved in a
|
|
|
1238 local buffer to be sent to the printer later.
|
|
|
1239
|
|
|
1240 Use the command `ps-despool' to send the spooled images to the printer."
|
|
|
1241 (interactive)
|
|
|
1242 (ps-generate (current-buffer) (point-min) (point-max)
|
|
|
1243 'ps-generate-postscript))
|
|
|
1244
|
|
|
1245
|
|
|
1246 ;;;###autoload
|
|
|
1247 (defun ps-spool-buffer-with-faces ()
|
|
|
1248 "Generate and spool a PostScript image of the buffer.
|
|
|
1249 Like `ps-spool-buffer', but includes font, color, and underline
|
|
2
|
1250 information in the generated image. This command works only if you
|
|
|
1251 are using a window system, so it has a way to determine color values.
|
|
0
|
1252
|
|
|
1253 Use the command `ps-despool' to send the spooled images to the printer."
|
|
|
1254
|
|
|
1255 (interactive)
|
|
|
1256 (ps-generate (current-buffer) (point-min) (point-max)
|
|
|
1257 'ps-generate-postscript-with-faces))
|
|
|
1258
|
|
|
1259
|
|
|
1260 ;;;###autoload
|
|
|
1261 (defun ps-spool-region (from to)
|
|
|
1262 "Generate a PostScript image of the region and spool locally.
|
|
|
1263 Like `ps-spool-buffer', but spools just the current region.
|
|
|
1264
|
|
|
1265 Use the command `ps-despool' to send the spooled images to the printer."
|
|
|
1266 (interactive "r")
|
|
|
1267 (ps-generate (current-buffer) from to
|
|
|
1268 'ps-generate-postscript))
|
|
|
1269
|
|
|
1270
|
|
|
1271 ;;;###autoload
|
|
|
1272 (defun ps-spool-region-with-faces (from to)
|
|
|
1273 "Generate a PostScript image of the region and spool locally.
|
|
|
1274 Like `ps-spool-region', but includes font, color, and underline
|
|
2
|
1275 information in the generated image. This command works only if you
|
|
|
1276 are using a window system, so it has a way to determine color values.
|
|
0
|
1277
|
|
|
1278 Use the command `ps-despool' to send the spooled images to the printer."
|
|
|
1279 (interactive "r")
|
|
|
1280 (ps-generate (current-buffer) from to
|
|
|
1281 'ps-generate-postscript-with-faces))
|
|
|
1282
|
|
|
1283 ;;;###autoload
|
|
|
1284 (defun ps-despool (&optional filename)
|
|
|
1285 "Send the spooled PostScript to the printer.
|
|
|
1286
|
|
|
1287 When called with a numeric prefix argument (C-u), prompt the user for
|
|
|
1288 the name of a file to save the spooled PostScript in, instead of sending
|
|
|
1289 it to the printer.
|
|
|
1290
|
|
|
1291 More specifically, the FILENAME argument is treated as follows: if it
|
|
|
1292 is nil, send the image to the printer. If FILENAME is a string, save
|
|
|
1293 the PostScript image in a file with that name. If FILENAME is a
|
|
|
1294 number, prompt the user for the name of the file to save in."
|
|
|
1295 (interactive (list (ps-print-preprint current-prefix-arg)))
|
|
|
1296 (ps-do-despool filename))
|
|
|
1297
|
|
82
|
1298 ;;;###autoload
|
|
|
1299 (defun ps-line-lengths ()
|
|
88
|
1300 "*Display the correspondence between a line length and a font size,
|
|
82
|
1301 using the current ps-print setup.
|
|
|
1302 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
|
|
|
1303 (interactive)
|
|
|
1304 (ps-line-lengths-internal))
|
|
|
1305
|
|
|
1306 ;;;###autoload
|
|
|
1307 (defun ps-nb-pages-buffer (nb-lines)
|
|
88
|
1308 "*Display an approximate correspondence between a font size and the number
|
|
82
|
1309 of pages the current buffer would require to print
|
|
|
1310 using the current ps-print setup."
|
|
|
1311 (interactive (list (count-lines (point-min) (point-max))))
|
|
|
1312 (ps-nb-pages nb-lines))
|
|
|
1313
|
|
|
1314 ;;;###autoload
|
|
|
1315 (defun ps-nb-pages-region (nb-lines)
|
|
88
|
1316 "*Display an approximate correspondence between a font size and the number
|
|
82
|
1317 of pages the current region would require to print
|
|
|
1318 using the current ps-print setup."
|
|
|
1319 (interactive (list (count-lines (mark) (point))))
|
|
|
1320 (ps-nb-pages nb-lines))
|
|
|
1321
|
|
|
1322 ;;;###autoload
|
|
|
1323 (defun ps-setup ()
|
|
|
1324 "*Return the current setup"
|
|
|
1325 (format "
|
|
|
1326 (setq ps-print-color-p %s
|
|
|
1327 ps-lpr-command \"%s\"
|
|
|
1328 ps-lpr-switches %s
|
|
|
1329
|
|
|
1330 ps-paper-type '%s
|
|
|
1331 ps-landscape-mode %s
|
|
|
1332 ps-number-of-columns %s
|
|
|
1333
|
|
|
1334 ps-left-margin %s
|
|
|
1335 ps-right-margin %s
|
|
|
1336 ps-inter-column %s
|
|
|
1337 ps-bottom-margin %s
|
|
|
1338 ps-top-margin %s
|
|
|
1339 ps-header-offset %s
|
|
|
1340 ps-header-line-pad %s
|
|
|
1341 ps-print-header %s
|
|
|
1342 ps-print-header-frame %s
|
|
|
1343 ps-header-lines %s
|
|
|
1344 ps-show-n-of-n %s
|
|
|
1345 ps-spool-duplex %s
|
|
|
1346
|
|
|
1347 ps-font-family '%s
|
|
|
1348 ps-font-size %s
|
|
|
1349 ps-header-font-family '%s
|
|
|
1350 ps-header-font-size %s
|
|
|
1351 ps-header-title-font-size %s)
|
|
|
1352 "
|
|
|
1353 ps-print-color-p
|
|
|
1354 ps-lpr-command
|
|
|
1355 ps-lpr-switches
|
|
|
1356 ps-paper-type
|
|
|
1357 ps-landscape-mode
|
|
|
1358 ps-number-of-columns
|
|
|
1359 ps-left-margin
|
|
|
1360 ps-right-margin
|
|
|
1361 ps-inter-column
|
|
|
1362 ps-bottom-margin
|
|
|
1363 ps-top-margin
|
|
|
1364 ps-header-offset
|
|
|
1365 ps-header-line-pad
|
|
|
1366 ps-print-header
|
|
|
1367 ps-print-header-frame
|
|
|
1368 ps-header-lines
|
|
|
1369 ps-show-n-of-n
|
|
|
1370 ps-spool-duplex
|
|
|
1371 ps-font-family
|
|
|
1372 ps-font-size
|
|
|
1373 ps-header-font-family
|
|
|
1374 ps-header-font-size
|
|
|
1375 ps-header-title-font-size))
|
|
|
1376
|
|
0
|
1377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1378 ;; Utility functions and variables:
|
|
|
1379
|
|
|
1380 (defvar ps-print-emacs-type
|
|
|
1381 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
|
|
|
1382 ((string-match "Lucid" emacs-version) 'lucid)
|
|
|
1383 ((string-match "Epoch" emacs-version) 'epoch)
|
|
|
1384 (t 'emacs)))
|
|
|
1385
|
|
|
1386 (if (or (eq ps-print-emacs-type 'lucid)
|
|
|
1387 (eq ps-print-emacs-type 'xemacs))
|
|
|
1388 (if (< emacs-minor-version 12)
|
|
|
1389 (setq ps-print-color-p nil))
|
|
|
1390 (require 'faces)) ; face-font, face-underline-p,
|
|
|
1391 ; x-font-regexp
|
|
|
1392
|
|
82
|
1393 ;; Return t if the device (which can be changed during an emacs
|
|
|
1394 ;; session) can handle colors.
|
|
|
1395 ;; This is function is not yet implemented for GNU emacs.
|
|
|
1396 (defun ps-color-device ()
|
|
0
|
1397 (if (and (eq ps-print-emacs-type 'xemacs)
|
|
|
1398 (>= emacs-minor-version 12))
|
|
|
1399 (eq (device-class) 'color)
|
|
|
1400 t))
|
|
|
1401
|
|
|
1402 (require 'time-stamp)
|
|
|
1403
|
|
82
|
1404 (defvar ps-font nil
|
|
|
1405 "Font family name for ordinary text, when generating Postscript.")
|
|
|
1406
|
|
|
1407 (defvar ps-font-bold nil
|
|
|
1408 "Font family name for bold text, when generating Postscript.")
|
|
|
1409
|
|
|
1410 (defvar ps-font-italic nil
|
|
|
1411 "Font family name for italic text, when generating Postscript.")
|
|
|
1412
|
|
|
1413 (defvar ps-font-bold-italic nil
|
|
|
1414 "Font family name for bold italic text, when generating Postscript.")
|
|
|
1415
|
|
|
1416 (defvar ps-avg-char-width nil
|
|
|
1417 "The average width, in points, of a character, for generating Postscript.
|
|
|
1418 This is the value that ps-print uses to determine the length,
|
|
|
1419 x-dimension, of the text it has printed, and thus affects the point at
|
|
|
1420 which long lines wrap around.")
|
|
|
1421
|
|
|
1422 (defvar ps-space-width nil
|
|
|
1423 "The width of a space character, for generating Postscript.
|
|
|
1424 This value is used in expanding tab characters.")
|
|
|
1425
|
|
|
1426 (defvar ps-line-height nil
|
|
|
1427 "The height of a line, for generating Postscript.
|
|
|
1428 This is the value that ps-print uses to determine the height,
|
|
|
1429 y-dimension, of the lines of text it has printed, and thus affects the
|
|
|
1430 point at which page-breaks are placed.
|
|
|
1431 The line-height is *not* the same as the point size of the font.")
|
|
|
1432
|
|
|
1433 (defvar ps-print-prologue-1
|
|
|
1434 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
|
|
0
|
1435 /ISOLatin1Encoding where { pop } {
|
|
82
|
1436 % -- The ISO Latin-1 encoding vector isn't known, so define it.
|
|
|
1437 % -- The first half is the same as the standard encoding,
|
|
|
1438 % -- except for minus instead of hyphen at code 055.
|
|
0
|
1439 /ISOLatin1Encoding
|
|
|
1440 StandardEncoding 0 45 getinterval aload pop
|
|
|
1441 /minus
|
|
|
1442 StandardEncoding 46 82 getinterval aload pop
|
|
|
1443 %*** NOTE: the following are missing in the Adobe documentation,
|
|
|
1444 %*** but appear in the displayed table:
|
|
|
1445 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
|
|
82
|
1446 % 0200 (128)
|
|
0
|
1447 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
|
|
|
1448 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
|
|
|
1449 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
|
|
|
1450 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
|
|
82
|
1451 % 0240 (160)
|
|
0
|
1452 /space /exclamdown /cent /sterling
|
|
|
1453 /currency /yen /brokenbar /section
|
|
|
1454 /dieresis /copyright /ordfeminine /guillemotleft
|
|
|
1455 /logicalnot /hyphen /registered /macron
|
|
|
1456 /degree /plusminus /twosuperior /threesuperior
|
|
|
1457 /acute /mu /paragraph /periodcentered
|
|
|
1458 /cedilla /onesuperior /ordmasculine /guillemotright
|
|
|
1459 /onequarter /onehalf /threequarters /questiondown
|
|
82
|
1460 % 0300 (192)
|
|
0
|
1461 /Agrave /Aacute /Acircumflex /Atilde
|
|
|
1462 /Adieresis /Aring /AE /Ccedilla
|
|
|
1463 /Egrave /Eacute /Ecircumflex /Edieresis
|
|
|
1464 /Igrave /Iacute /Icircumflex /Idieresis
|
|
|
1465 /Eth /Ntilde /Ograve /Oacute
|
|
|
1466 /Ocircumflex /Otilde /Odieresis /multiply
|
|
|
1467 /Oslash /Ugrave /Uacute /Ucircumflex
|
|
|
1468 /Udieresis /Yacute /Thorn /germandbls
|
|
82
|
1469 % 0340 (224)
|
|
0
|
1470 /agrave /aacute /acircumflex /atilde
|
|
|
1471 /adieresis /aring /ae /ccedilla
|
|
|
1472 /egrave /eacute /ecircumflex /edieresis
|
|
|
1473 /igrave /iacute /icircumflex /idieresis
|
|
|
1474 /eth /ntilde /ograve /oacute
|
|
|
1475 /ocircumflex /otilde /odieresis /divide
|
|
|
1476 /oslash /ugrave /uacute /ucircumflex
|
|
|
1477 /udieresis /yacute /thorn /ydieresis
|
|
|
1478 256 packedarray def
|
|
|
1479 } ifelse
|
|
|
1480
|
|
|
1481 /reencodeFontISO { %def
|
|
|
1482 dup
|
|
82
|
1483 length 5 add dict % Make a new font (a new dict the same size
|
|
|
1484 % as the old one) with room for our new symbols.
|
|
|
1485
|
|
|
1486 begin % Make the new font the current dictionary.
|
|
0
|
1487
|
|
|
1488
|
|
|
1489 { 1 index /FID ne
|
|
|
1490 { def } { pop pop } ifelse
|
|
82
|
1491 } forall % Copy each of the symbols from the old dictionary
|
|
|
1492 % to the new one except for the font ID.
|
|
0
|
1493
|
|
|
1494 /Encoding ISOLatin1Encoding def % Override the encoding with
|
|
|
1495 % the ISOLatin1 encoding.
|
|
|
1496
|
|
|
1497 % Use the font's bounding box to determine the ascent, descent,
|
|
|
1498 % and overall height; don't forget that these values have to be
|
|
|
1499 % transformed using the font's matrix.
|
|
82
|
1500
|
|
|
1501 % ^ (x2 y2)
|
|
|
1502 % | |
|
|
|
1503 % | v
|
|
|
1504 % | +----+ - -
|
|
|
1505 % | | | ^
|
|
|
1506 % | | | | Ascent (usually > 0)
|
|
|
1507 % | | | |
|
|
|
1508 % (0 0) -> +--+----+-------->
|
|
|
1509 % | | |
|
|
|
1510 % | | v Descent (usually < 0)
|
|
|
1511 % (x1 y1) --> +----+ - -
|
|
|
1512
|
|
|
1513 FontBBox % -- x1 y1 x2 y2
|
|
|
1514 FontMatrix transform /Ascent exch def pop
|
|
70
|
1515 FontMatrix transform /Descent exch def pop
|
|
82
|
1516 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
|
|
|
1517
|
|
|
1518 % Define these in case they're not in the FontInfo
|
|
|
1519 % (also, here they're easier to get to.
|
|
|
1520 /UnderlinePosition 1 def
|
|
0
|
1521 /UnderlineThickness 1 def
|
|
|
1522
|
|
|
1523 % Get the underline position and thickness if they're defined.
|
|
|
1524 currentdict /FontInfo known {
|
|
|
1525 FontInfo
|
|
|
1526
|
|
|
1527 dup /UnderlinePosition known {
|
|
|
1528 dup /UnderlinePosition get
|
|
|
1529 0 exch FontMatrix transform exch pop
|
|
|
1530 /UnderlinePosition exch def
|
|
|
1531 } if
|
|
|
1532
|
|
|
1533 dup /UnderlineThickness known {
|
|
|
1534 /UnderlineThickness get
|
|
|
1535 0 exch FontMatrix transform exch pop
|
|
|
1536 /UnderlineThickness exch def
|
|
|
1537 } if
|
|
|
1538
|
|
|
1539 } if
|
|
|
1540
|
|
82
|
1541 currentdict % Leave the new font on the stack
|
|
|
1542 end % Stop using the font as the current dictionary.
|
|
|
1543 definefont % Put the font into the font dictionary
|
|
|
1544 pop % Discard the returned font.
|
|
0
|
1545 } bind def
|
|
|
1546
|
|
82
|
1547 /DefFont { % Font definition
|
|
0
|
1548 findfont exch scalefont reencodeFontISO
|
|
|
1549 } def
|
|
|
1550
|
|
82
|
1551 /F { % Font selection
|
|
0
|
1552 findfont
|
|
82
|
1553 dup /Ascent get /Ascent exch def
|
|
|
1554 dup /Descent get /Descent exch def
|
|
|
1555 dup /FontHeight get /FontHeight exch def
|
|
|
1556 dup /UnderlinePosition get /UnderlinePosition exch def
|
|
0
|
1557 dup /UnderlineThickness get /UnderlineThickness exch def
|
|
|
1558 setfont
|
|
|
1559 } def
|
|
|
1560
|
|
|
1561 /FG /setrgbcolor load def
|
|
|
1562
|
|
|
1563 /bg false def
|
|
|
1564 /BG {
|
|
|
1565 dup /bg exch def
|
|
|
1566 { mark 4 1 roll ] /bgcolor exch def } if
|
|
|
1567 } def
|
|
|
1568
|
|
82
|
1569 % B width C
|
|
|
1570 % +-----------+
|
|
|
1571 % | Ascent (usually > 0)
|
|
|
1572 % A + +
|
|
|
1573 % | Descent (usually < 0)
|
|
|
1574 % +-----------+
|
|
|
1575 % E width D
|
|
|
1576
|
|
0
|
1577 /dobackground { % width --
|
|
82
|
1578 currentpoint % -- width x y
|
|
0
|
1579 gsave
|
|
|
1580 newpath
|
|
82
|
1581 moveto % A (x y)
|
|
|
1582 0 Ascent rmoveto % B
|
|
|
1583 dup 0 rlineto % C
|
|
|
1584 0 Descent Ascent sub rlineto % D
|
|
|
1585 neg 0 rlineto % E
|
|
0
|
1586 closepath
|
|
|
1587 bgcolor aload pop setrgbcolor
|
|
|
1588 fill
|
|
|
1589 grestore
|
|
|
1590 } def
|
|
|
1591
|
|
|
1592 /dobackgroundstring { % string --
|
|
|
1593 stringwidth pop
|
|
|
1594 dobackground
|
|
|
1595 } def
|
|
|
1596
|
|
|
1597 /dounderline { % fromx fromy --
|
|
|
1598 currentpoint
|
|
|
1599 gsave
|
|
|
1600 UnderlineThickness setlinewidth
|
|
|
1601 4 2 roll
|
|
|
1602 UnderlinePosition add moveto
|
|
|
1603 UnderlinePosition add lineto
|
|
|
1604 stroke
|
|
|
1605 grestore
|
|
|
1606 } def
|
|
|
1607
|
|
82
|
1608 /eolbg { % dobackground until right margin
|
|
|
1609 PrintWidth % -- x-eol
|
|
|
1610 currentpoint pop % -- cur-x
|
|
|
1611 sub % -- width until eol
|
|
|
1612 dobackground
|
|
0
|
1613 } def
|
|
|
1614
|
|
82
|
1615 /eolul { % idem for underline
|
|
|
1616 PrintWidth % -- x-eol
|
|
|
1617 currentpoint exch pop % -- x-eol cur-y
|
|
|
1618 dounderline
|
|
0
|
1619 } def
|
|
|
1620
|
|
|
1621 /SL { % Soft Linefeed
|
|
|
1622 bg { eolbg } if
|
|
|
1623 ul { eolul } if
|
|
82
|
1624 0 currentpoint exch pop LineHeight sub moveto
|
|
0
|
1625 } def
|
|
|
1626
|
|
|
1627 /HL /SL load def % Hard Linefeed
|
|
|
1628
|
|
|
1629 /sp1 { currentpoint 3 -1 roll } def
|
|
|
1630
|
|
|
1631 % Some debug
|
|
|
1632 /dcp { currentpoint exch 40 string cvs print (, ) print = } def
|
|
|
1633 /dp { print 2 copy
|
|
|
1634 exch 40 string cvs print (, ) print = } def
|
|
|
1635
|
|
|
1636 /S {
|
|
|
1637 bg { dup dobackgroundstring } if
|
|
|
1638 ul { sp1 } if
|
|
|
1639 show
|
|
|
1640 ul { dounderline } if
|
|
|
1641 } def
|
|
|
1642
|
|
|
1643 /W {
|
|
|
1644 ul { sp1 } if
|
|
82
|
1645 ( ) stringwidth % Get the width of a space in the current font.
|
|
|
1646 pop % Discard the Y component.
|
|
|
1647 mul % Multiply the width of a space
|
|
|
1648 % by the number of spaces to plot
|
|
0
|
1649 bg { dup dobackground } if
|
|
|
1650 0 rmoveto
|
|
|
1651 ul { dounderline } if
|
|
|
1652 } def
|
|
|
1653
|
|
82
|
1654 /BeginDoc {
|
|
|
1655 % ---- save the state of the document (useful for ghostscript!)
|
|
|
1656 /docState save def
|
|
|
1657 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
|
|
|
1658 /JackGhostscript where {
|
|
|
1659 pop 1 27.7 29.7 div scale
|
|
|
1660 } if
|
|
|
1661 LandscapeMode {
|
|
|
1662 % ---- translate to bottom-right corner of Portrait page
|
|
|
1663 LandscapePageHeight 0 translate
|
|
|
1664 90 rotate
|
|
|
1665 } if
|
|
|
1666 /ColumnWidth PrintWidth InterColumn add def
|
|
|
1667 % ---- translate to lower left corner of TEXT
|
|
|
1668 LeftMargin BottomMargin translate
|
|
|
1669 % ---- define where printing will start
|
|
|
1670 /f0 F % this installs Ascent
|
|
|
1671 /PrintStartY PrintHeight Ascent sub def
|
|
|
1672 /ColumnIndex 1 def
|
|
|
1673 } def
|
|
|
1674
|
|
|
1675 /EndDoc {
|
|
|
1676 % ---- on last page but not last column, spit out the page
|
|
|
1677 ColumnIndex 1 eq not { showpage } if
|
|
|
1678 % ---- restore the state of the document (useful for ghostscript!)
|
|
|
1679 docState restore
|
|
|
1680 } def
|
|
|
1681
|
|
0
|
1682 /BeginDSCPage {
|
|
82
|
1683 % ---- when 1st column, save the state of the page
|
|
|
1684 ColumnIndex 1 eq { /pageState save def } if
|
|
|
1685 % ---- save the state of the column
|
|
|
1686 /columnState save def
|
|
0
|
1687 } def
|
|
|
1688
|
|
|
1689 /BeginPage {
|
|
|
1690 PrintHeader {
|
|
|
1691 PrintHeaderFrame { HeaderFrame } if
|
|
|
1692 HeaderText
|
|
|
1693 } if
|
|
82
|
1694 0 PrintStartY moveto % move to where printing will start
|
|
0
|
1695 } def
|
|
|
1696
|
|
|
1697 /EndPage {
|
|
|
1698 bg { eolbg } if
|
|
|
1699 ul { eolul } if
|
|
|
1700 } def
|
|
|
1701
|
|
|
1702 /EndDSCPage {
|
|
82
|
1703 ColumnIndex NumberOfColumns eq {
|
|
|
1704 % ---- on last column, spit out the page
|
|
|
1705 showpage
|
|
|
1706 % ---- restore the state of the page
|
|
|
1707 pageState restore
|
|
|
1708 /ColumnIndex 1 def
|
|
|
1709 } { % else
|
|
|
1710 % ---- restore the state of the current column
|
|
|
1711 columnState restore
|
|
|
1712 % ---- and translate to the next column
|
|
|
1713 ColumnWidth 0 translate
|
|
|
1714 /ColumnIndex ColumnIndex 1 add def
|
|
|
1715 } ifelse
|
|
0
|
1716 } def
|
|
|
1717
|
|
|
1718 /ul false def
|
|
|
1719
|
|
|
1720 /UL { /ul exch def } def
|
|
|
1721
|
|
82
|
1722 /SetHeaderLines { % nb-lines --
|
|
0
|
1723 /HeaderLines exch def
|
|
82
|
1724 % ---- bottom up
|
|
|
1725 HeaderPad
|
|
|
1726 HeaderLines 1 sub HeaderLineHeight mul add
|
|
|
1727 HeaderTitleLineHeight add
|
|
|
1728 HeaderPad add
|
|
|
1729 /HeaderHeight exch def
|
|
0
|
1730 } def
|
|
|
1731
|
|
82
|
1732 % |---------|
|
|
|
1733 % | tm |
|
|
|
1734 % |---------|
|
|
|
1735 % | header |
|
|
|
1736 % |-+-------| <-- (x y)
|
|
|
1737 % | ho |
|
|
|
1738 % |---------|
|
|
|
1739 % | text |
|
|
|
1740 % |-+-------| <-- (0 0)
|
|
|
1741 % | bm |
|
|
|
1742 % |---------|
|
|
|
1743
|
|
|
1744 /HeaderFrameStart { % -- x y
|
|
|
1745 0 PrintHeight HeaderOffset add
|
|
0
|
1746 } def
|
|
|
1747
|
|
|
1748 /HeaderFramePath {
|
|
82
|
1749 PrintWidth 0 rlineto
|
|
|
1750 0 HeaderHeight rlineto
|
|
|
1751 PrintWidth neg 0 rlineto
|
|
|
1752 0 HeaderHeight neg rlineto
|
|
0
|
1753 } def
|
|
|
1754
|
|
|
1755 /HeaderFrame {
|
|
|
1756 gsave
|
|
|
1757 0.4 setlinewidth
|
|
82
|
1758 % ---- fill a black rectangle (the shadow of the next one)
|
|
0
|
1759 HeaderFrameStart moveto
|
|
|
1760 1 -1 rmoveto
|
|
|
1761 HeaderFramePath
|
|
|
1762 0 setgray fill
|
|
82
|
1763 % ---- do the next rectangle ...
|
|
0
|
1764 HeaderFrameStart moveto
|
|
|
1765 HeaderFramePath
|
|
82
|
1766 gsave 0.9 setgray fill grestore % filled with grey
|
|
|
1767 gsave 0 setgray stroke grestore % drawn with black
|
|
0
|
1768 grestore
|
|
|
1769 } def
|
|
|
1770
|
|
|
1771 /HeaderStart {
|
|
|
1772 HeaderFrameStart
|
|
82
|
1773 exch HeaderPad add exch % horizontal pad
|
|
|
1774 % ---- bottom up
|
|
|
1775 HeaderPad add % vertical pad
|
|
|
1776 HeaderDescent sub
|
|
|
1777 HeaderLineHeight HeaderLines 1 sub mul add
|
|
0
|
1778 } def
|
|
|
1779
|
|
|
1780 /strcat {
|
|
|
1781 dup length 3 -1 roll dup length dup 4 -1 roll add string dup
|
|
|
1782 0 5 -1 roll putinterval
|
|
|
1783 dup 4 2 roll exch putinterval
|
|
|
1784 } def
|
|
|
1785
|
|
|
1786 /pagenumberstring {
|
|
|
1787 PageNumber 32 string cvs
|
|
|
1788 ShowNofN {
|
|
|
1789 (/) strcat
|
|
|
1790 PageCount 32 string cvs strcat
|
|
|
1791 } if
|
|
|
1792 } def
|
|
|
1793
|
|
|
1794 /HeaderText {
|
|
|
1795 HeaderStart moveto
|
|
|
1796
|
|
82
|
1797 HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
|
|
|
1798
|
|
|
1799 % ---- hack: `PN 1 and' == `PN 2 modulo'
|
|
|
1800
|
|
|
1801 % ---- if duplex and even page number, then exchange left and right
|
|
0
|
1802 Duplex PageNumber 1 and 0 eq and { exch } if
|
|
|
1803
|
|
82
|
1804 { % ---- process the left lines
|
|
0
|
1805 aload pop
|
|
|
1806 exch F
|
|
|
1807 gsave
|
|
|
1808 dup xcheck { exec } if
|
|
|
1809 show
|
|
|
1810 grestore
|
|
|
1811 0 HeaderLineHeight neg rmoveto
|
|
|
1812 } forall
|
|
|
1813
|
|
|
1814 HeaderStart moveto
|
|
|
1815
|
|
82
|
1816 { % ---- process the right lines
|
|
0
|
1817 aload pop
|
|
|
1818 exch F
|
|
|
1819 gsave
|
|
|
1820 dup xcheck { exec } if
|
|
|
1821 dup stringwidth pop
|
|
|
1822 PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto
|
|
|
1823 show
|
|
|
1824 grestore
|
|
|
1825 0 HeaderLineHeight neg rmoveto
|
|
|
1826 } forall
|
|
|
1827 } def
|
|
|
1828
|
|
|
1829 /ReportFontInfo {
|
|
|
1830 2 copy
|
|
82
|
1831 /t0 3 1 roll DefFont
|
|
0
|
1832 /t0 F
|
|
|
1833 /lh FontHeight def
|
|
|
1834 /sw ( ) stringwidth pop def
|
|
|
1835 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
|
|
|
1836 stringwidth pop exch div def
|
|
82
|
1837 /t1 12 /Helvetica-Oblique DefFont
|
|
0
|
1838 /t1 F
|
|
|
1839 gsave
|
|
|
1840 (For ) show
|
|
|
1841 128 string cvs show
|
|
|
1842 ( ) show
|
|
|
1843 32 string cvs show
|
|
|
1844 ( point, the line height is ) show
|
|
|
1845 lh 32 string cvs show
|
|
|
1846 (, the space width is ) show
|
|
|
1847 sw 32 string cvs show
|
|
|
1848 (,) show
|
|
|
1849 grestore
|
|
|
1850 0 FontHeight neg rmoveto
|
|
82
|
1851 gsave
|
|
|
1852 (and a crude estimate of average character width is ) show
|
|
|
1853 aw 32 string cvs show
|
|
|
1854 (.) show
|
|
|
1855 grestore
|
|
|
1856 0 FontHeight neg rmoveto
|
|
|
1857 } def
|
|
|
1858
|
|
|
1859 /cm { % cm to point
|
|
|
1860 72 mul 2.54 div
|
|
|
1861 } def
|
|
|
1862
|
|
|
1863 /ReportAllFontInfo {
|
|
|
1864 FontDirectory
|
|
|
1865 { % key = font name value = font dictionary
|
|
|
1866 pop 10 exch ReportFontInfo
|
|
|
1867 } forall
|
|
0
|
1868 } def
|
|
|
1869
|
|
82
|
1870 % 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
|
|
|
1871 % 3 cm 20 cm moveto ReportAllFontInfo showpage
|
|
|
1872
|
|
|
1873 ")
|
|
|
1874
|
|
|
1875 (defvar ps-print-prologue-2
|
|
|
1876 "
|
|
|
1877 % ---- These lines must be kept together because...
|
|
|
1878
|
|
|
1879 /h0 F
|
|
|
1880 /HeaderTitleLineHeight FontHeight def
|
|
|
1881
|
|
|
1882 /h1 F
|
|
|
1883 /HeaderLineHeight FontHeight def
|
|
|
1884 /HeaderDescent Descent def
|
|
|
1885
|
|
|
1886 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
|
|
|
1887
|
|
0
|
1888 ")
|
|
|
1889
|
|
|
1890 ;; Start Editing Here:
|
|
|
1891
|
|
|
1892 (defvar ps-source-buffer nil)
|
|
|
1893 (defvar ps-spool-buffer-name "*PostScript*")
|
|
|
1894 (defvar ps-spool-buffer nil)
|
|
|
1895
|
|
|
1896 (defvar ps-output-head nil)
|
|
|
1897 (defvar ps-output-tail nil)
|
|
|
1898
|
|
|
1899 (defvar ps-page-count 0)
|
|
|
1900 (defvar ps-showpage-count 0)
|
|
|
1901
|
|
|
1902 (defvar ps-current-font 0)
|
|
|
1903 (defvar ps-current-underline-p nil)
|
|
|
1904 (defvar ps-default-color (if ps-print-color-p ps-default-fg)) ; black
|
|
|
1905 (defvar ps-current-color ps-default-color)
|
|
|
1906 (defvar ps-current-bg nil)
|
|
|
1907
|
|
|
1908 (defvar ps-razchunk 0)
|
|
|
1909
|
|
82
|
1910 (defvar ps-color-format
|
|
|
1911 (if (eq ps-print-emacs-type 'emacs)
|
|
|
1912
|
|
|
1913 ;;Emacs understands the %f format; we'll
|
|
|
1914 ;;use it to limit color RGB values to
|
|
|
1915 ;;three decimals to cut down some on the
|
|
|
1916 ;;size of the PostScript output.
|
|
|
1917 "%0.3f %0.3f %0.3f"
|
|
|
1918
|
|
|
1919 ;; Lucid emacsen will have to make do with
|
|
|
1920 ;; %s (princ) for floats.
|
|
|
1921 "%s %s %s"))
|
|
0
|
1922
|
|
|
1923 ;; These values determine how much print-height to deduct when headers
|
|
|
1924 ;; are turned on. This is a pretty clumsy way of handling it, but
|
|
|
1925 ;; it'll do for now.
|
|
82
|
1926
|
|
|
1927 (defvar ps-header-font)
|
|
|
1928 (defvar ps-header-title-font)
|
|
|
1929
|
|
|
1930 (defvar ps-header-line-height)
|
|
|
1931 (defvar ps-header-title-line-height)
|
|
|
1932 (defvar ps-header-pad 0
|
|
|
1933 "Vertical and horizontal space in points (1/72 inch) between the header frame
|
|
|
1934 and the text it contains.")
|
|
|
1935
|
|
|
1936 ;; Define accessors to the dimensions list.
|
|
|
1937
|
|
|
1938 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
|
|
|
1939 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
|
|
|
1940
|
|
|
1941 (defvar ps-landscape-page-height)
|
|
|
1942
|
|
0
|
1943 (defvar ps-print-width nil)
|
|
|
1944 (defvar ps-print-height nil)
|
|
|
1945
|
|
|
1946 (defvar ps-height-remaining)
|
|
|
1947 (defvar ps-width-remaining)
|
|
|
1948
|
|
|
1949 (defvar ps-ref-bold-faces nil)
|
|
|
1950 (defvar ps-ref-italic-faces nil)
|
|
|
1951 (defvar ps-ref-underlined-faces nil)
|
|
|
1952
|
|
82
|
1953 (defvar ps-print-color-scale nil)
|
|
|
1954
|
|
0
|
1955 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
1956 ;; Internal functions
|
|
|
1957
|
|
82
|
1958 (defun ps-line-lengths-internal ()
|
|
88
|
1959 "Display the correspondence between a line length and a font size,
|
|
82
|
1960 using the current ps-print setup.
|
|
|
1961 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
|
|
|
1962 (let ((buf (get-buffer-create "*Line-lengths*"))
|
|
|
1963 (ifs ps-font-size) ; initial font size
|
|
|
1964 (icw ps-avg-char-width) ; initial character width
|
|
|
1965 (print-width (progn (ps-get-page-dimensions)
|
|
|
1966 ps-print-width))
|
|
|
1967 (ps-setup (ps-setup)) ; setup for the current buffer
|
|
|
1968 (fs-min 5) ; minimum font size
|
|
|
1969 cw-min ; minimum character width
|
|
|
1970 nb-cpl-max ; maximum nb of characters per line
|
|
|
1971 (fs-max 14) ; maximum font size
|
|
|
1972 cw-max ; maximum character width
|
|
|
1973 nb-cpl-min ; minimum nb of characters per line
|
|
|
1974 fs ; current font size
|
|
|
1975 cw ; current character width
|
|
|
1976 nb-cpl ; current nb of characters per line
|
|
|
1977 )
|
|
|
1978 (setq cw-min (/ (* icw fs-min) ifs)
|
|
|
1979 nb-cpl-max (floor (/ print-width cw-min))
|
|
|
1980 cw-max (/ (* icw fs-max) ifs)
|
|
|
1981 nb-cpl-min (floor (/ print-width cw-max)))
|
|
|
1982 (setq nb-cpl nb-cpl-min)
|
|
|
1983 (set-buffer buf)
|
|
|
1984 (goto-char (point-max))
|
|
|
1985 (if (not (bolp)) (insert "\n"))
|
|
|
1986 (insert ps-setup)
|
|
|
1987 (insert "nb char per line / font size\n")
|
|
|
1988 (while (<= nb-cpl nb-cpl-max)
|
|
|
1989 (setq cw (/ print-width (float nb-cpl))
|
|
|
1990 fs (/ (* ifs cw) icw))
|
|
|
1991 (insert (format "%3s %s\n" nb-cpl fs))
|
|
|
1992 (setq nb-cpl (1+ nb-cpl)))
|
|
|
1993 (insert "\n")
|
|
|
1994 (display-buffer buf 'not-this-window)))
|
|
|
1995
|
|
|
1996 (defun ps-nb-pages (nb-lines)
|
|
88
|
1997 "Display an approximate correspondence between a font size and the number
|
|
82
|
1998 of pages the number of lines would require to print
|
|
|
1999 using the current ps-print setup."
|
|
|
2000 (let ((buf (get-buffer-create "*Nb-Pages*"))
|
|
|
2001 (ifs ps-font-size) ; initial font size
|
|
|
2002 (ilh ps-line-height) ; initial line height
|
|
|
2003 (page-height (progn (ps-get-page-dimensions)
|
|
|
2004 ps-print-height))
|
|
|
2005 (ps-setup (ps-setup)) ; setup for the current buffer
|
|
|
2006 (fs-min 4) ; minimum font size
|
|
|
2007 lh-min ; minimum line height
|
|
|
2008 nb-lpp-max ; maximum nb of lines per page
|
|
|
2009 nb-page-min ; minimum nb of pages
|
|
|
2010 (fs-max 14) ; maximum font size
|
|
|
2011 lh-max ; maximum line height
|
|
|
2012 nb-lpp-min ; minimum nb of lines per page
|
|
|
2013 nb-page-max ; maximum nb of pages
|
|
|
2014 fs ; current font size
|
|
|
2015 lh ; current line height
|
|
|
2016 nb-lpp ; current nb of lines per page
|
|
|
2017 nb-page ; current nb of pages
|
|
|
2018 )
|
|
|
2019 (setq lh-min (/ (* ilh fs-min) ifs)
|
|
|
2020 nb-lpp-max (floor (/ page-height lh-min))
|
|
|
2021 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
|
|
|
2022 lh-max (/ (* ilh fs-max) ifs)
|
|
|
2023 nb-lpp-min (floor (/ page-height lh-max))
|
|
|
2024 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)))
|
|
|
2025 (setq nb-page nb-page-min)
|
|
|
2026 (set-buffer buf)
|
|
|
2027 (goto-char (point-max))
|
|
|
2028 (if (not (bolp)) (insert "\n"))
|
|
|
2029 (insert ps-setup)
|
|
|
2030 (insert (format "%d lines\n" nb-lines))
|
|
|
2031 (insert "nb page / font size\n")
|
|
|
2032 (while (<= nb-page nb-page-max)
|
|
|
2033 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
|
|
|
2034 lh (/ page-height nb-lpp)
|
|
|
2035 fs (/ (* ifs lh) ilh))
|
|
|
2036 (insert (format "%s %s\n" nb-page fs))
|
|
|
2037 (setq nb-page (1+ nb-page)))
|
|
|
2038 (insert "\n")
|
|
|
2039 (display-buffer buf 'not-this-window)))
|
|
|
2040
|
|
|
2041 (defun ps-select-font ()
|
|
|
2042 "Choose the font name and size (scaling data)."
|
|
|
2043 (let ((assoc (assq ps-font-family ps-font-info-database))
|
|
|
2044 l fn fb fi bi sz lh sw aw)
|
|
|
2045 (if (null assoc)
|
|
|
2046 (error "Don't have data to scale font %s. Known fonts families are %s"
|
|
|
2047 ps-font-family
|
|
|
2048 (mapcar 'car ps-font-info-database)))
|
|
|
2049 (setq l (cdr assoc)
|
|
|
2050 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
|
|
|
2051 fb (prog1 (car l) (setq l (cdr l)))
|
|
|
2052 fi (prog1 (car l) (setq l (cdr l)))
|
|
|
2053 bi (prog1 (car l) (setq l (cdr l)))
|
|
|
2054 sz (prog1 (car l) (setq l (cdr l)))
|
|
|
2055 lh (prog1 (car l) (setq l (cdr l)))
|
|
|
2056 sw (prog1 (car l) (setq l (cdr l)))
|
|
|
2057 aw (prog1 (car l) (setq l (cdr l))))
|
|
|
2058
|
|
|
2059 (setq ps-font fn)
|
|
|
2060 (setq ps-font-bold fb)
|
|
|
2061 (setq ps-font-italic fi)
|
|
|
2062 (setq ps-font-bold-italic bi)
|
|
|
2063 ;; These data just need to be rescaled:
|
|
|
2064 (setq ps-line-height (/ (* lh ps-font-size) sz))
|
|
|
2065 (setq ps-space-width (/ (* sw ps-font-size) sz))
|
|
|
2066 (setq ps-avg-char-width (/ (* aw ps-font-size) sz))
|
|
|
2067 ps-font-family))
|
|
|
2068
|
|
|
2069 (defun ps-select-header-font ()
|
|
|
2070 "Choose the font name and size (scaling data) for the header."
|
|
|
2071 (let ((assoc (assq ps-header-font-family ps-font-info-database))
|
|
|
2072 l fn fb fi bi sz lh sw aw)
|
|
|
2073 (if (null assoc)
|
|
|
2074 (error "Don't have data to scale font %s. Known fonts families are %s"
|
|
|
2075 ps-font-family
|
|
|
2076 (mapcar 'car ps-font-info-database)))
|
|
|
2077 (setq l (cdr assoc)
|
|
|
2078 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
|
|
|
2079 fb (prog1 (car l) (setq l (cdr l)))
|
|
|
2080 fi (prog1 (car l) (setq l (cdr l)))
|
|
|
2081 bi (prog1 (car l) (setq l (cdr l)))
|
|
|
2082 sz (prog1 (car l) (setq l (cdr l)))
|
|
|
2083 lh (prog1 (car l) (setq l (cdr l)))
|
|
|
2084 sw (prog1 (car l) (setq l (cdr l)))
|
|
|
2085 aw (prog1 (car l) (setq l (cdr l))))
|
|
|
2086
|
|
|
2087 ;; Font name
|
|
|
2088 (setq ps-header-font fn)
|
|
|
2089 (setq ps-header-title-font fb)
|
|
|
2090 ;; Line height: These data just need to be rescaled:
|
|
|
2091 (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz))
|
|
|
2092 (setq ps-header-line-height (/ (* lh ps-header-font-size) sz))
|
|
|
2093 ps-header-font-family))
|
|
|
2094
|
|
0
|
2095 (defun ps-get-page-dimensions ()
|
|
82
|
2096 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
|
|
|
2097 page-width page-height)
|
|
|
2098 (cond
|
|
|
2099 ((null page-dimensions)
|
|
|
2100 (error "`ps-paper-type' must be one of:\n%s"
|
|
|
2101 (mapcar 'car ps-page-dimensions-database)))
|
|
|
2102 ((< ps-number-of-columns 1)
|
|
|
2103 (error "The number of columns %d should not be negative")))
|
|
|
2104
|
|
|
2105 (ps-select-font)
|
|
|
2106 (ps-select-header-font)
|
|
|
2107
|
|
|
2108 (setq page-width (ps-page-dimensions-get-width page-dimensions)
|
|
|
2109 page-height (ps-page-dimensions-get-height page-dimensions))
|
|
|
2110
|
|
|
2111 ;; Landscape mode
|
|
|
2112 (if ps-landscape-mode
|
|
|
2113 ;; exchange width and height
|
|
|
2114 (setq page-width (prog1 page-height (setq page-height page-width))))
|
|
|
2115
|
|
|
2116 ;; It is used to get the lower right corner (only in landscape mode)
|
|
|
2117 (setq ps-landscape-page-height page-height)
|
|
|
2118
|
|
|
2119 ;; | lm | text | ic | text | ic | text | rm |
|
|
|
2120 ;; page-width == lm + n * pw + (n - 1) * ic + rm
|
|
|
2121 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
|
|
|
2122 (setq ps-print-width
|
|
|
2123 (/ (- page-width
|
|
|
2124 ps-left-margin ps-right-margin
|
|
|
2125 (* (1- ps-number-of-columns) ps-inter-column))
|
|
|
2126 ps-number-of-columns))
|
|
|
2127 (if (<= ps-print-width 0)
|
|
|
2128 (error "Bad horizontal layout:
|
|
|
2129 page-width == %s
|
|
|
2130 ps-left-margin == %s
|
|
|
2131 ps-right-margin == %s
|
|
|
2132 ps-inter-column == %s
|
|
|
2133 ps-number-of-columns == %s
|
|
|
2134 | lm | text | ic | text | ic | text | rm |
|
|
|
2135 page-width == lm + n * print-width + (n - 1) * ic + rm
|
|
|
2136 => print-width == %d !"
|
|
|
2137 page-width
|
|
|
2138 ps-left-margin
|
|
|
2139 ps-right-margin
|
|
|
2140 ps-inter-column
|
|
|
2141 ps-number-of-columns
|
|
|
2142 ps-print-width))
|
|
|
2143
|
|
|
2144 (setq ps-print-height
|
|
|
2145 (- page-height ps-bottom-margin ps-top-margin))
|
|
|
2146 (if (<= ps-print-height 0)
|
|
|
2147 (error "Bad vertical layout:
|
|
|
2148 ps-top-margin == %s
|
|
|
2149 ps-bottom-margin == %s
|
|
|
2150 page-height == bm + print-height + tm
|
|
|
2151 => print-height == %d !"
|
|
|
2152 ps-top-margin
|
|
|
2153 ps-bottom-margin
|
|
|
2154 ps-print-height))
|
|
|
2155 ;; If headers are turned on, deduct the height of the header from
|
|
|
2156 ;; the print height.
|
|
|
2157 (cond
|
|
|
2158 (ps-print-header
|
|
|
2159 (setq ps-header-pad
|
|
|
2160 (* ps-header-line-pad ps-header-title-line-height))
|
|
|
2161 (setq ps-print-height
|
|
|
2162 (- ps-print-height
|
|
|
2163 ps-header-offset
|
|
|
2164 ps-header-pad
|
|
|
2165 ps-header-title-line-height
|
|
|
2166 (* ps-header-line-height (- ps-header-lines 1))
|
|
|
2167 ps-header-pad))))
|
|
|
2168 (if (<= ps-print-height 0)
|
|
|
2169 (error "Bad vertical layout:
|
|
|
2170 ps-top-margin == %s
|
|
|
2171 ps-bottom-margin == %s
|
|
|
2172 ps-header-offset == %s
|
|
|
2173 ps-header-pad == %s
|
|
|
2174 header-height == %s
|
|
|
2175 page-height == bm + print-height + tm - ho - hh
|
|
|
2176 => print-height == %d !"
|
|
|
2177 ps-top-margin
|
|
|
2178 ps-bottom-margin
|
|
|
2179 ps-header-offset
|
|
|
2180 ps-header-pad
|
|
|
2181 (+ ps-header-pad
|
|
|
2182 ps-header-title-line-height
|
|
|
2183 (* ps-header-line-height (- ps-header-lines 1))
|
|
|
2184 ps-header-pad)
|
|
|
2185 ps-print-height))))
|
|
0
|
2186
|
|
|
2187 (defun ps-print-preprint (&optional filename)
|
|
|
2188 (if (and filename
|
|
|
2189 (or (numberp filename)
|
|
|
2190 (listp filename)))
|
|
|
2191 (let* ((name (concat (buffer-name) ".ps"))
|
|
|
2192 (prompt (format "Save PostScript to file: (default %s) "
|
|
2
|
2193 name))
|
|
|
2194 (res (read-file-name prompt default-directory name nil)))
|
|
|
2195 (if (file-directory-p res)
|
|
|
2196 (expand-file-name name (file-name-as-directory res))
|
|
|
2197 res))))
|
|
0
|
2198
|
|
|
2199 ;; The following functions implement a simple list-buffering scheme so
|
|
|
2200 ;; that ps-print doesn't have to repeatedly switch between buffers
|
|
|
2201 ;; while spooling. The functions ps-output and ps-output-string build
|
|
|
2202 ;; up the lists; the function ps-flush-output takes the lists and
|
|
|
2203 ;; insert its contents into the spool buffer (*PostScript*).
|
|
|
2204
|
|
|
2205 (defun ps-output-string-prim (string)
|
|
|
2206 (insert "(") ;insert start-string delimiter
|
|
|
2207 (save-excursion ;insert string
|
|
|
2208 (insert string))
|
|
|
2209
|
|
|
2210 ;; Find and quote special characters as necessary for PS
|
|
|
2211 (while (re-search-forward "[()\\]" nil t)
|
|
|
2212 (save-excursion
|
|
|
2213 (forward-char -1)
|
|
|
2214 (insert "\\")))
|
|
|
2215
|
|
|
2216 (goto-char (point-max))
|
|
|
2217 (insert ")")) ;insert end-string delimiter
|
|
|
2218
|
|
|
2219 (defun ps-init-output-queue ()
|
|
|
2220 (setq ps-output-head (list ""))
|
|
|
2221 (setq ps-output-tail ps-output-head))
|
|
|
2222
|
|
|
2223 (defun ps-output (&rest args)
|
|
|
2224 (setcdr ps-output-tail args)
|
|
|
2225 (while (cdr ps-output-tail)
|
|
|
2226 (setq ps-output-tail (cdr ps-output-tail))))
|
|
|
2227
|
|
|
2228 (defun ps-output-string (string)
|
|
|
2229 (ps-output t string))
|
|
|
2230
|
|
|
2231 (defun ps-flush-output ()
|
|
|
2232 (save-excursion
|
|
|
2233 (set-buffer ps-spool-buffer)
|
|
|
2234 (goto-char (point-max))
|
|
|
2235 (while ps-output-head
|
|
|
2236 (let ((it (car ps-output-head)))
|
|
|
2237 (if (not (eq t it))
|
|
|
2238 (insert it)
|
|
|
2239 (setq ps-output-head (cdr ps-output-head))
|
|
|
2240 (ps-output-string-prim (car ps-output-head))))
|
|
|
2241 (setq ps-output-head (cdr ps-output-head))))
|
|
|
2242 (ps-init-output-queue))
|
|
|
2243
|
|
|
2244 (defun ps-insert-file (fname)
|
|
|
2245 (ps-flush-output)
|
|
|
2246
|
|
|
2247 ;; Check to see that the file exists and is readable; if not, throw
|
|
88
|
2248 ;; an error.
|
|
0
|
2249 (if (not (file-readable-p fname))
|
|
|
2250 (error "Could not read file `%s'" fname))
|
|
|
2251
|
|
|
2252 (save-excursion
|
|
|
2253 (set-buffer ps-spool-buffer)
|
|
|
2254 (goto-char (point-max))
|
|
|
2255 (insert-file fname)))
|
|
|
2256
|
|
|
2257 ;; These functions insert the arrays that define the contents of the
|
|
|
2258 ;; headers.
|
|
|
2259
|
|
|
2260 (defun ps-generate-header-line (fonttag &optional content)
|
|
|
2261 (ps-output " [ " fonttag " ")
|
|
|
2262 (cond
|
|
|
2263 ;; Literal strings should be output as is -- the string must
|
|
|
2264 ;; contain its own PS string delimiters, '(' and ')', if necessary.
|
|
|
2265 ((stringp content)
|
|
|
2266 (ps-output content))
|
|
|
2267
|
|
|
2268 ;; Functions are called -- they should return strings; they will be
|
|
|
2269 ;; inserted as strings and the PS string delimiters added.
|
|
|
2270 ((and (symbolp content) (fboundp content))
|
|
|
2271 (ps-output-string (funcall content)))
|
|
|
2272
|
|
|
2273 ;; Variables will have their contents inserted. They should
|
|
|
2274 ;; contain strings, and will be inserted as strings.
|
|
|
2275 ((and (symbolp content) (boundp content))
|
|
|
2276 (ps-output-string (symbol-value content)))
|
|
|
2277
|
|
|
2278 ;; Anything else will get turned into an empty string.
|
|
|
2279 (t
|
|
|
2280 (ps-output-string "")))
|
|
|
2281 (ps-output " ]\n"))
|
|
|
2282
|
|
|
2283 (defun ps-generate-header (name contents)
|
|
|
2284 (ps-output "/" name " [\n")
|
|
|
2285 (if (> ps-header-lines 0)
|
|
|
2286 (let ((count 1))
|
|
|
2287 (ps-generate-header-line "/h0" (car contents))
|
|
|
2288 (while (and (< count ps-header-lines)
|
|
|
2289 (setq contents (cdr contents)))
|
|
|
2290 (ps-generate-header-line "/h1" (car contents))
|
|
|
2291 (setq count (+ count 1)))
|
|
|
2292 (ps-output "] def\n"))))
|
|
|
2293
|
|
|
2294 (defun ps-output-boolean (name bool)
|
|
|
2295 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
|
|
|
2296
|
|
|
2297 (defun ps-begin-file ()
|
|
82
|
2298 (ps-get-page-dimensions)
|
|
0
|
2299 (setq ps-showpage-count 0)
|
|
|
2300
|
|
|
2301 (ps-output ps-adobe-tag)
|
|
|
2302 (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of
|
|
|
2303 ;first buffer printed
|
|
|
2304 (ps-output "%%Creator: " (user-full-name) "\n")
|
|
|
2305 (ps-output "%%CreationDate: "
|
|
|
2306 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n")
|
|
|
2307 (ps-output "%%Pages: (atend)\n")
|
|
|
2308 (ps-output "%%EndComments\n\n")
|
|
|
2309
|
|
88
|
2310 (ps-output "%%BeginProlog\n")
|
|
82
|
2311 (ps-output-boolean "LandscapeMode" ps-landscape-mode)
|
|
|
2312 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns))
|
|
|
2313
|
|
|
2314 (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height))
|
|
|
2315 (ps-output (format "/PrintWidth %s def\n" ps-print-width))
|
|
|
2316 (ps-output (format "/PrintHeight %s def\n" ps-print-height))
|
|
|
2317
|
|
|
2318 (ps-output (format "/LeftMargin %s def\n" ps-left-margin))
|
|
|
2319 (ps-output (format "/RightMargin %s def\n" ps-right-margin)) ; not used
|
|
|
2320 (ps-output (format "/InterColumn %s def\n" ps-inter-column))
|
|
|
2321
|
|
|
2322 (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin))
|
|
|
2323 (ps-output (format "/TopMargin %s def\n" ps-top-margin)) ; not used
|
|
|
2324 (ps-output (format "/HeaderOffset %s def\n" ps-header-offset))
|
|
|
2325 (ps-output (format "/HeaderPad %s def\n" ps-header-pad))
|
|
|
2326
|
|
|
2327 (ps-output-boolean "PrintHeader" ps-print-header)
|
|
70
|
2328 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
|
|
82
|
2329 (ps-output-boolean "ShowNofN" ps-show-n-of-n)
|
|
|
2330 (ps-output-boolean "Duplex" ps-spool-duplex)
|
|
|
2331
|
|
|
2332 (ps-output (format "/LineHeight %s def\n" ps-line-height))
|
|
|
2333
|
|
|
2334 (ps-output ps-print-prologue-1)
|
|
88
|
2335 (ps-output "%%EndProlog\n\n")
|
|
|
2336
|
|
|
2337
|
|
|
2338 (ps-output "%%BeginSetup\n")
|
|
82
|
2339
|
|
|
2340 ;; Header fonts
|
|
|
2341 (ps-output ; /h0 14 /Helvetica-Bold Font
|
|
|
2342 (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font))
|
|
|
2343 (ps-output ; /h1 12 /Helvetica Font
|
|
|
2344 (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font))
|
|
|
2345
|
|
|
2346 (ps-output ps-print-prologue-2)
|
|
|
2347
|
|
|
2348 ;; Text fonts
|
|
|
2349 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font))
|
|
|
2350 (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold))
|
|
|
2351 (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic))
|
|
|
2352 (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic))
|
|
|
2353
|
|
|
2354 (ps-output "\nBeginDoc\n\n")
|
|
88
|
2355 (ps-output "%%EndSetup\n")
|
|
|
2356 )
|
|
0
|
2357
|
|
|
2358 (defun ps-header-dirpart ()
|
|
|
2359 (let ((fname (buffer-file-name)))
|
|
|
2360 (if fname
|
|
|
2361 (if (string-equal (buffer-name) (file-name-nondirectory fname))
|
|
|
2362 (file-name-directory fname)
|
|
|
2363 fname)
|
|
|
2364 "")))
|
|
|
2365
|
|
|
2366 (defun ps-get-buffer-name ()
|
|
82
|
2367 (cond
|
|
|
2368 ;; Indulge Jim this little easter egg:
|
|
|
2369 ((string= (buffer-name) "ps-print.el")
|
|
|
2370 "Hey, Cool! It's ps-print.el!!!")
|
|
|
2371 ;; Indulge Jack this other little easter egg:
|
|
|
2372 ((string= (buffer-name) "sokoban.el")
|
|
|
2373 "Super! C'est sokoban.el!")
|
|
|
2374 (t (buffer-name))))
|
|
0
|
2375
|
|
|
2376 (defun ps-begin-job ()
|
|
|
2377 (setq ps-page-count 0))
|
|
|
2378
|
|
|
2379 (defun ps-end-file ()
|
|
88
|
2380 (ps-output "\n\n%%Trailer\n")
|
|
82
|
2381 (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count)
|
|
88
|
2382 ps-number-of-columns))))
|
|
|
2383 (ps-output "EndDoc\n")
|
|
|
2384 (ps-output "%%EOF\n"))
|
|
0
|
2385
|
|
|
2386 (defun ps-next-page ()
|
|
|
2387 (ps-end-page)
|
|
|
2388 (ps-flush-output)
|
|
|
2389 (ps-begin-page))
|
|
|
2390
|
|
|
2391 (defun ps-begin-page (&optional dummypage)
|
|
|
2392 (ps-get-page-dimensions)
|
|
82
|
2393 (setq ps-width-remaining ps-print-width)
|
|
0
|
2394 (setq ps-height-remaining ps-print-height)
|
|
|
2395
|
|
82
|
2396 ;; Print only when a new real page begins.
|
|
|
2397 (when (zerop (mod ps-page-count ps-number-of-columns))
|
|
|
2398 (ps-output (format "\n%%%%Page: %d %d\n"
|
|
|
2399 (1+ (/ ps-page-count ps-number-of-columns))
|
|
|
2400 (1+ (/ ps-page-count ps-number-of-columns)))))
|
|
|
2401
|
|
0
|
2402 (ps-output "BeginDSCPage\n")
|
|
82
|
2403 (ps-output (format "/PageNumber %d def\n" (incf ps-page-count)))
|
|
0
|
2404 (ps-output "/PageCount 0 def\n")
|
|
|
2405
|
|
82
|
2406 (when ps-print-header
|
|
|
2407 (ps-generate-header "HeaderLinesLeft" ps-left-header)
|
|
|
2408 (ps-generate-header "HeaderLinesRight" ps-right-header)
|
|
|
2409 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
|
|
0
|
2410
|
|
|
2411 (ps-output "BeginPage\n")
|
|
82
|
2412 (ps-set-font ps-current-font)
|
|
|
2413 (ps-set-bg ps-current-bg)
|
|
|
2414 (ps-set-color ps-current-color)
|
|
0
|
2415 (ps-set-underline ps-current-underline-p))
|
|
|
2416
|
|
|
2417 (defun ps-end-page ()
|
|
|
2418 (setq ps-showpage-count (+ 1 ps-showpage-count))
|
|
|
2419 (ps-output "EndPage\n")
|
|
|
2420 (ps-output "EndDSCPage\n"))
|
|
|
2421
|
|
|
2422 (defun ps-dummy-page ()
|
|
|
2423 (setq ps-showpage-count (+ 1 ps-showpage-count))
|
|
|
2424 (ps-output "%%Page: " (format "- %d\n" ps-showpage-count)
|
|
|
2425 "BeginDSCPage
|
|
|
2426 /PrintHeader false def
|
|
|
2427 BeginPage
|
|
|
2428 EndPage
|
|
|
2429 EndDSCPage\n"))
|
|
|
2430
|
|
|
2431 (defun ps-next-line ()
|
|
|
2432 (if (< ps-height-remaining ps-line-height)
|
|
|
2433 (ps-next-page)
|
|
82
|
2434 (setq ps-width-remaining ps-print-width)
|
|
0
|
2435 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
|
|
|
2436 (ps-hard-lf)))
|
|
|
2437
|
|
|
2438 (defun ps-continue-line ()
|
|
|
2439 (if (< ps-height-remaining ps-line-height)
|
|
|
2440 (ps-next-page)
|
|
82
|
2441 (setq ps-width-remaining ps-print-width)
|
|
0
|
2442 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
|
|
|
2443 (ps-soft-lf)))
|
|
|
2444
|
|
82
|
2445 ;; [jack] Why hard and soft ?
|
|
|
2446
|
|
0
|
2447 (defun ps-hard-lf ()
|
|
|
2448 (ps-output "HL\n"))
|
|
|
2449
|
|
|
2450 (defun ps-soft-lf ()
|
|
|
2451 (ps-output "SL\n"))
|
|
|
2452
|
|
|
2453 (defun ps-find-wrappoint (from to char-width)
|
|
|
2454 (let ((avail (truncate (/ ps-width-remaining char-width)))
|
|
|
2455 (todo (- to from)))
|
|
|
2456 (if (< todo avail)
|
|
|
2457 (cons to (* todo char-width))
|
|
|
2458 (cons (+ from avail) ps-width-remaining))))
|
|
|
2459
|
|
|
2460 (defun ps-basic-plot-string (from to &optional bg-color)
|
|
|
2461 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width))
|
|
|
2462 (to (car wrappoint))
|
|
|
2463 (string (buffer-substring from to)))
|
|
|
2464 (ps-output-string string)
|
|
82
|
2465 (ps-output " S\n")
|
|
0
|
2466 wrappoint))
|
|
|
2467
|
|
|
2468 (defun ps-basic-plot-whitespace (from to &optional bg-color)
|
|
|
2469 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width))
|
|
|
2470 (to (car wrappoint)))
|
|
|
2471
|
|
|
2472 (ps-output (format "%d W\n" (- to from)))
|
|
|
2473 wrappoint))
|
|
|
2474
|
|
|
2475 (defun ps-plot (plotfunc from to &optional bg-color)
|
|
|
2476 (while (< from to)
|
|
|
2477 (let* ((wrappoint (funcall plotfunc from to bg-color))
|
|
|
2478 (plotted-to (car wrappoint))
|
|
|
2479 (plotted-width (cdr wrappoint)))
|
|
|
2480 (setq from plotted-to)
|
|
|
2481 (setq ps-width-remaining (- ps-width-remaining plotted-width))
|
|
|
2482 (if (< from to)
|
|
|
2483 (ps-continue-line))))
|
|
|
2484 (if ps-razzle-dazzle
|
|
|
2485 (let* ((q-todo (- (point-max) (point-min)))
|
|
|
2486 (q-done (- (point) (point-min)))
|
|
|
2487 (chunkfrac (/ q-todo 8))
|
|
|
2488 (chunksize (if (> chunkfrac 1000) 1000 chunkfrac)))
|
|
|
2489 (if (> (- q-done ps-razchunk) chunksize)
|
|
|
2490 (let (foo)
|
|
|
2491 (setq ps-razchunk q-done)
|
|
|
2492 (setq foo
|
|
|
2493 (if (< q-todo 100)
|
|
|
2494 (/ (* 100 q-done) q-todo)
|
|
|
2495 (/ q-done (/ q-todo 100))))
|
|
82
|
2496 (message "Formatting...%3d%%" foo))))))
|
|
0
|
2497
|
|
|
2498 (defun ps-set-font (font)
|
|
|
2499 (setq ps-current-font font)
|
|
|
2500 (ps-output (format "/f%d F\n" ps-current-font)))
|
|
|
2501
|
|
|
2502 (defun ps-set-bg (color)
|
|
|
2503 (if (setq ps-current-bg color)
|
|
|
2504 (ps-output (format ps-color-format (nth 0 color) (nth 1 color)
|
|
|
2505 (nth 2 color))
|
|
|
2506 " true BG\n")
|
|
|
2507 (ps-output "false BG\n")))
|
|
|
2508
|
|
|
2509 (defun ps-set-color (color)
|
|
|
2510 (if (setq ps-current-color color)
|
|
|
2511 nil
|
|
|
2512 (setq ps-current-color ps-default-fg))
|
|
|
2513 (ps-output (format ps-color-format (nth 0 ps-current-color)
|
|
|
2514 (nth 1 ps-current-color) (nth 2 ps-current-color))
|
|
|
2515 " FG\n"))
|
|
|
2516
|
|
|
2517 (defun ps-set-underline (underline-p)
|
|
|
2518 (ps-output (if underline-p "true" "false") " UL\n")
|
|
|
2519 (setq ps-current-underline-p underline-p))
|
|
|
2520
|
|
|
2521 (defun ps-plot-region (from to font fg-color &optional bg-color underline-p)
|
|
|
2522
|
|
|
2523 (if (not (equal font ps-current-font))
|
|
|
2524 (ps-set-font font))
|
|
|
2525
|
|
|
2526 ;; Specify a foreground color only if one's specified and it's
|
|
|
2527 ;; different than the current.
|
|
|
2528 (if (not (equal fg-color ps-current-color))
|
|
|
2529 (ps-set-color fg-color))
|
|
|
2530
|
|
|
2531 (if (not (equal bg-color ps-current-bg))
|
|
|
2532 (ps-set-bg bg-color))
|
|
|
2533
|
|
|
2534 ;; Toggle underlining if different.
|
|
|
2535 (if (not (equal underline-p ps-current-underline-p))
|
|
|
2536 (ps-set-underline underline-p))
|
|
|
2537
|
|
|
2538 ;; Starting at the beginning of the specified region...
|
|
|
2539 (save-excursion
|
|
|
2540 (goto-char from)
|
|
|
2541
|
|
|
2542 ;; ...break the region up into chunks separated by tabs, linefeeds,
|
|
|
2543 ;; and pagefeeds, and plot each chunk.
|
|
|
2544 (while (< from to)
|
|
|
2545 (if (re-search-forward "[\t\n\f]" to t)
|
|
|
2546 (let ((match (char-after (match-beginning 0))))
|
|
|
2547 (cond
|
|
|
2548 ((= match ?\t)
|
|
|
2549 (let ((linestart
|
|
|
2550 (save-excursion (beginning-of-line) (point))))
|
|
|
2551 (ps-plot 'ps-basic-plot-string from (- (point) 1)
|
|
|
2552 bg-color)
|
|
|
2553 (forward-char -1)
|
|
|
2554 (setq from (+ linestart (current-column)))
|
|
|
2555 (if (re-search-forward "[ \t]+" to t)
|
|
|
2556 (ps-plot 'ps-basic-plot-whitespace
|
|
|
2557 from (+ linestart (current-column))
|
|
|
2558 bg-color))))
|
|
|
2559
|
|
|
2560 ((= match ?\n)
|
|
|
2561 (ps-plot 'ps-basic-plot-string from (- (point) 1)
|
|
|
2562 bg-color)
|
|
|
2563 (ps-next-line)
|
|
|
2564 )
|
|
|
2565
|
|
|
2566 ((= match ?\f)
|
|
|
2567 (ps-plot 'ps-basic-plot-string from (- (point) 1)
|
|
|
2568 bg-color)
|
|
|
2569 (ps-next-page)))
|
|
|
2570 (setq from (point)))
|
|
|
2571 (ps-plot 'ps-basic-plot-string from to bg-color)
|
|
|
2572 (setq from to)))))
|
|
|
2573
|
|
|
2574 (defun ps-color-value (x-color-value)
|
|
|
2575 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
|
|
|
2576 (/ x-color-value ps-print-color-scale))
|
|
|
2577
|
|
|
2578 (defun ps-color-values (x-color)
|
|
96
|
2579 (cond ((fboundp 'color-instance-rgb-components)
|
|
|
2580 (if (ps-color-device)
|
|
|
2581 (color-instance-rgb-components
|
|
|
2582 (if (color-instance-p x-color) x-color
|
|
|
2583 (if (color-specifier-p x-color)
|
|
|
2584 (make-color-instance (color-name x-color))
|
|
|
2585 (make-color-instance x-color))))
|
|
|
2586 (error "No available function to determine X color values.")))
|
|
|
2587 ((fboundp 'x-color-values)
|
|
0
|
2588 (x-color-values x-color))
|
|
|
2589 (t (error "No available function to determine X color values."))))
|
|
|
2590
|
|
|
2591 (defun ps-face-attributes (face)
|
|
|
2592 (let ((differs (face-differs-from-default-p face)))
|
|
|
2593 (list (memq face ps-ref-bold-faces)
|
|
|
2594 (memq face ps-ref-italic-faces)
|
|
|
2595 (memq face ps-ref-underlined-faces)
|
|
|
2596 (and differs (face-foreground face))
|
|
|
2597 (and differs (face-background face)))))
|
|
|
2598
|
|
|
2599 (defun ps-face-attribute-list (face-or-list)
|
|
|
2600 (if (listp face-or-list)
|
|
|
2601 (let (bold-p italic-p underline-p foreground background face-attr face)
|
|
|
2602 (while face-or-list
|
|
|
2603 (setq face (car face-or-list))
|
|
|
2604 (setq face-attr (ps-face-attributes face))
|
|
|
2605 (setq bold-p (or bold-p (nth 0 face-attr)))
|
|
|
2606 (setq italic-p (or italic-p (nth 1 face-attr)))
|
|
|
2607 (setq underline-p (or underline-p (nth 2 face-attr)))
|
|
|
2608 (if foreground
|
|
|
2609 nil
|
|
|
2610 (setq foreground (nth 3 face-attr)))
|
|
|
2611 (if background
|
|
|
2612 nil
|
|
|
2613 (setq background (nth 4 face-attr)))
|
|
|
2614 (setq face-or-list (cdr face-or-list)))
|
|
|
2615 (list bold-p italic-p underline-p foreground background))
|
|
|
2616
|
|
|
2617 (ps-face-attributes face-or-list)))
|
|
|
2618
|
|
|
2619 (defun ps-plot-with-face (from to face)
|
|
|
2620 (if face
|
|
|
2621 (let* ((face-attr (ps-face-attribute-list face))
|
|
|
2622 (bold-p (nth 0 face-attr))
|
|
|
2623 (italic-p (nth 1 face-attr))
|
|
|
2624 (underline-p (nth 2 face-attr))
|
|
|
2625 (foreground (nth 3 face-attr))
|
|
|
2626 (background (nth 4 face-attr))
|
|
|
2627 (fg-color (if (and ps-print-color-p
|
|
82
|
2628 (ps-color-device)
|
|
0
|
2629 foreground)
|
|
|
2630 (mapcar 'ps-color-value
|
|
|
2631 (ps-color-values foreground))
|
|
|
2632 ps-default-color))
|
|
|
2633 (bg-color (if (and ps-print-color-p
|
|
82
|
2634 (ps-color-device)
|
|
0
|
2635 background)
|
|
|
2636 (mapcar 'ps-color-value
|
|
|
2637 (ps-color-values background)))))
|
|
|
2638 (ps-plot-region from to
|
|
|
2639 (cond ((and bold-p italic-p) 3)
|
|
|
2640 (italic-p 2)
|
|
|
2641 (bold-p 1)
|
|
|
2642 (t 0))
|
|
|
2643 ; (or fg-color '(0.0 0.0 0.0))
|
|
|
2644 fg-color
|
|
|
2645 bg-color underline-p))
|
|
|
2646 (goto-char to)))
|
|
|
2647
|
|
|
2648
|
|
|
2649 (defun ps-emacs-face-kind-p (face kind kind-regex kind-list)
|
|
|
2650 (let ((frame-font (face-font face))
|
|
|
2651 (face-defaults (face-font face t)))
|
|
|
2652 (or
|
|
|
2653 ;; Check FACE defaults:
|
|
|
2654 (and (listp face-defaults)
|
|
|
2655 (memq kind face-defaults))
|
|
|
2656
|
|
|
2657 ;; Check the user's preferences
|
|
|
2658 (memq face kind-list))))
|
|
|
2659
|
|
|
2660 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
|
|
|
2661 (let* ((frame-font
|
|
|
2662 (or (face-font-instance face) (face-font-instance 'default)))
|
|
|
2663 (kind-cons (and frame-font
|
|
|
2664 (assq kind (font-instance-properties frame-font))))
|
|
|
2665 (kind-spec (cdr-safe kind-cons))
|
|
|
2666 (case-fold-search t))
|
|
|
2667
|
|
|
2668 (or (and kind-spec (string-match kind-regex kind-spec))
|
|
|
2669 ;; Kludge-compatible:
|
|
|
2670 (memq face kind-list))))
|
|
|
2671
|
|
|
2672 (defun ps-face-bold-p (face)
|
|
|
2673 (if (eq ps-print-emacs-type 'emacs)
|
|
|
2674 (ps-emacs-face-kind-p face 'bold "-\\(bold\\|demibold\\)-"
|
|
|
2675 ps-bold-faces)
|
|
|
2676 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
|
|
|
2677 ps-bold-faces)))
|
|
|
2678
|
|
|
2679 (defun ps-face-italic-p (face)
|
|
|
2680 (if (eq ps-print-emacs-type 'emacs)
|
|
|
2681 (ps-emacs-face-kind-p face 'italic "-[io]-" ps-italic-faces)
|
|
|
2682 (or
|
|
|
2683 (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces)
|
|
|
2684 (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces))))
|
|
|
2685
|
|
|
2686 (defun ps-face-underlined-p (face)
|
|
|
2687 (or (face-underline-p face)
|
|
|
2688 (memq face ps-underlined-faces)))
|
|
|
2689
|
|
|
2690 ;; Ensure that face-list is fbound.
|
|
|
2691 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
|
|
|
2692
|
|
|
2693 (defun ps-build-reference-face-lists ()
|
|
|
2694 (if ps-auto-font-detect
|
|
100
|
2695 (let ((faces (if (eq ps-print-emacs-type 'xemacs)
|
|
|
2696 (face-list 5)
|
|
|
2697 (face-list)))
|
|
0
|
2698 the-face)
|
|
|
2699 (setq ps-ref-bold-faces nil
|
|
|
2700 ps-ref-italic-faces nil
|
|
|
2701 ps-ref-underlined-faces nil)
|
|
|
2702 (while faces
|
|
|
2703 (setq the-face (car faces))
|
|
|
2704 (if (ps-face-italic-p the-face)
|
|
|
2705 (setq ps-ref-italic-faces
|
|
|
2706 (cons the-face ps-ref-italic-faces)))
|
|
|
2707 (if (ps-face-bold-p the-face)
|
|
|
2708 (setq ps-ref-bold-faces
|
|
|
2709 (cons the-face ps-ref-bold-faces)))
|
|
|
2710 (if (ps-face-underlined-p the-face)
|
|
|
2711 (setq ps-ref-underlined-faces
|
|
|
2712 (cons the-face ps-ref-underlined-faces)))
|
|
|
2713 (setq faces (cdr faces))))
|
|
|
2714 (setq ps-ref-bold-faces ps-bold-faces)
|
|
|
2715 (setq ps-ref-italic-faces ps-italic-faces)
|
|
|
2716 (setq ps-ref-underlined-faces ps-underlined-faces))
|
|
|
2717 (setq ps-build-face-reference nil))
|
|
|
2718
|
|
|
2719 (defun ps-mapper (extent list)
|
|
|
2720 (nconc list (list (list (extent-start-position extent) 'push extent)
|
|
|
2721 (list (extent-end-position extent) 'pull extent)))
|
|
|
2722 nil)
|
|
|
2723
|
|
|
2724 (defun ps-extent-sorter (a b)
|
|
|
2725 (< (extent-priority a) (extent-priority b)))
|
|
|
2726
|
|
|
2727 (defun ps-print-ensure-fontified (start end)
|
|
|
2728 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode)
|
|
|
2729 (if (fboundp 'lazy-lock-fontify-region)
|
|
82
|
2730 (lazy-lock-fontify-region start end) ; the new
|
|
209
|
2731 (lazy-lock-fontify-buffer))) ; the old
|
|
|
2732 (if (and (boundp 'lazy-shot-mode) lazy-shot-mode) ;; temporary untill
|
|
|
2733 (lazy-shot-fontify-region start end))) ;; lazy-shot is renamed
|
|
|
2734
|
|
0
|
2735
|
|
|
2736 (defun ps-generate-postscript-with-faces (from to)
|
|
|
2737 ;; Build the reference lists of faces if necessary.
|
|
|
2738 (if (or ps-always-build-face-reference
|
|
|
2739 ps-build-face-reference)
|
|
|
2740 (progn
|
|
|
2741 (message "Collecting face information...")
|
|
|
2742 (ps-build-reference-face-lists)))
|
|
|
2743 ;; Set the color scale. We do it here instead of in the defvar so
|
|
|
2744 ;; that ps-print can be dumped into emacs. This expression can't be
|
|
|
2745 ;; evaluated at dump-time because X isn't initialized.
|
|
|
2746 (setq ps-print-color-scale
|
|
82
|
2747 (if (and ps-print-color-p (ps-color-device))
|
|
0
|
2748 (float (car (ps-color-values "white")))
|
|
|
2749 1.0))
|
|
|
2750 ;; Generate some PostScript.
|
|
|
2751 (save-restriction
|
|
|
2752 (narrow-to-region from to)
|
|
|
2753 (let ((face 'default)
|
|
|
2754 (position to))
|
|
|
2755 (ps-print-ensure-fontified from to)
|
|
82
|
2756 (cond ((or (eq ps-print-emacs-type 'lucid)
|
|
|
2757 (eq ps-print-emacs-type 'xemacs))
|
|
0
|
2758 ;; Build the list of extents...
|
|
|
2759 (let ((a (cons 'dummy nil))
|
|
|
2760 record type extent extent-list)
|
|
|
2761 (map-extents 'ps-mapper nil from to a)
|
|
82
|
2762 (setq a (sort (cdr a) 'car-less-than-car))
|
|
0
|
2763
|
|
|
2764 (setq extent-list nil)
|
|
|
2765
|
|
|
2766 ;; Loop through the extents...
|
|
|
2767 (while a
|
|
|
2768 (setq record (car a))
|
|
|
2769
|
|
|
2770 (setq position (car record))
|
|
|
2771 (setq record (cdr record))
|
|
|
2772
|
|
|
2773 (setq type (car record))
|
|
|
2774 (setq record (cdr record))
|
|
|
2775
|
|
|
2776 (setq extent (car record))
|
|
|
2777
|
|
|
2778 ;; Plot up to this record.
|
|
|
2779 ;; XEmacs 19.12: for some reason, we're getting into a
|
|
|
2780 ;; situation in which some of the records have
|
|
|
2781 ;; positions less than 'from'. Since we've narrowed
|
|
|
2782 ;; the buffer, this'll generate errors. This is a
|
|
|
2783 ;; hack, but don't call ps-plot-with-face unless from >
|
|
|
2784 ;; point-min.
|
|
|
2785 (if (and (>= from (point-min))
|
|
|
2786 (<= position (point-max)))
|
|
|
2787 (ps-plot-with-face from position face))
|
|
|
2788
|
|
|
2789 (cond
|
|
|
2790 ((eq type 'push)
|
|
|
2791 (if (extent-face extent)
|
|
|
2792 (setq extent-list (sort (cons extent extent-list)
|
|
|
2793 'ps-extent-sorter))))
|
|
|
2794
|
|
|
2795 ((eq type 'pull)
|
|
|
2796 (setq extent-list (sort (delq extent extent-list)
|
|
|
2797 'ps-extent-sorter))))
|
|
|
2798
|
|
|
2799 (setq face
|
|
|
2800 (if extent-list
|
|
|
2801 (extent-face (car extent-list))
|
|
|
2802 'default))
|
|
|
2803
|
|
|
2804 (setq from position)
|
|
|
2805 (setq a (cdr a)))))
|
|
|
2806
|
|
|
2807 ((eq ps-print-emacs-type 'emacs)
|
|
|
2808 (let ((property-change from)
|
|
|
2809 (overlay-change from))
|
|
|
2810 (while (< from to)
|
|
|
2811 (if (< property-change to) ; Don't search for property change
|
|
|
2812 ; unless previous search succeeded.
|
|
|
2813 (setq property-change
|
|
|
2814 (next-property-change from nil to)))
|
|
|
2815 (if (< overlay-change to) ; Don't search for overlay change
|
|
|
2816 ; unless previous search succeeded.
|
|
|
2817 (setq overlay-change
|
|
|
2818 (min (next-overlay-change from) to)))
|
|
|
2819 (setq position
|
|
|
2820 (min property-change overlay-change))
|
|
2
|
2821 ;; The code below is not quite correct,
|
|
|
2822 ;; because a non-nil overlay invisible property
|
|
|
2823 ;; which is inactive according to the current value
|
|
|
2824 ;; of buffer-invisibility-spec nonetheless overrides
|
|
|
2825 ;; a face text property.
|
|
0
|
2826 (setq face
|
|
2
|
2827 (cond ((let ((prop (get-text-property from 'invisible)))
|
|
|
2828 ;; Decide whether this invisible property
|
|
|
2829 ;; really makes the text invisible.
|
|
|
2830 (if (eq buffer-invisibility-spec t)
|
|
|
2831 (not (null prop))
|
|
|
2832 (or (memq prop buffer-invisibility-spec)
|
|
|
2833 (assq prop buffer-invisibility-spec))))
|
|
|
2834 nil)
|
|
0
|
2835 ((get-text-property from 'face))
|
|
|
2836 (t 'default)))
|
|
|
2837 (let ((overlays (overlays-at from))
|
|
|
2838 (face-priority -1)) ; text-property
|
|
|
2839 (while overlays
|
|
|
2840 (let* ((overlay (car overlays))
|
|
|
2841 (overlay-face (overlay-get overlay 'face))
|
|
|
2842 (overlay-invisible (overlay-get overlay 'invisible))
|
|
|
2843 (overlay-priority (or (overlay-get overlay
|
|
|
2844 'priority)
|
|
|
2845 0)))
|
|
|
2846 (if (and (or overlay-invisible overlay-face)
|
|
|
2847 (> overlay-priority face-priority))
|
|
2
|
2848 (setq face (cond ((if (eq buffer-invisibility-spec t)
|
|
|
2849 (not (null overlay-invisible))
|
|
|
2850 (or (memq overlay-invisible buffer-invisibility-spec)
|
|
|
2851 (assq overlay-invisible buffer-invisibility-spec)))
|
|
|
2852 nil)
|
|
0
|
2853 ((and face overlay-face)))
|
|
|
2854 face-priority overlay-priority)))
|
|
|
2855 (setq overlays (cdr overlays))))
|
|
|
2856 ;; Plot up to this record.
|
|
|
2857 (ps-plot-with-face from position face)
|
|
|
2858 (setq from position)))))
|
|
|
2859 (ps-plot-with-face from to face))))
|
|
|
2860
|
|
|
2861 (defun ps-generate-postscript (from to)
|
|
|
2862 (ps-plot-region from to 0 nil))
|
|
|
2863
|
|
|
2864 (defun ps-generate (buffer from to genfunc)
|
|
|
2865 (let ((from (min to from))
|
|
2
|
2866 (to (max to from))
|
|
|
2867 ;; This avoids trouble if chars with read-only properties
|
|
|
2868 ;; are copied into ps-spool-buffer.
|
|
|
2869 (inhibit-read-only t))
|
|
0
|
2870 (save-restriction
|
|
|
2871 (narrow-to-region from to)
|
|
|
2872 (if ps-razzle-dazzle
|
|
82
|
2873 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
|
|
0
|
2874 (set-buffer buffer)
|
|
|
2875 (setq ps-source-buffer buffer)
|
|
|
2876 (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
|
|
|
2877 (ps-init-output-queue)
|
|
|
2878 (let (safe-marker completed-safely needs-begin-file)
|
|
|
2879 (unwind-protect
|
|
|
2880 (progn
|
|
|
2881 (set-buffer ps-spool-buffer)
|
|
|
2882
|
|
|
2883 ;; Get a marker and make it point to the current end of the
|
|
|
2884 ;; buffer, If an error occurs, we'll delete everything from
|
|
|
2885 ;; the end of this marker onwards.
|
|
|
2886 (setq safe-marker (make-marker))
|
|
|
2887 (set-marker safe-marker (point-max))
|
|
|
2888
|
|
|
2889 (goto-char (point-min))
|
|
88
|
2890 (if (looking-at (regexp-quote ps-adobe-tag))
|
|
0
|
2891 nil
|
|
|
2892 (setq needs-begin-file t))
|
|
|
2893 (save-excursion
|
|
|
2894 (set-buffer ps-source-buffer)
|
|
|
2895 (if needs-begin-file (ps-begin-file))
|
|
|
2896 (ps-begin-job)
|
|
|
2897 (ps-begin-page))
|
|
|
2898 (set-buffer ps-source-buffer)
|
|
|
2899 (funcall genfunc from to)
|
|
|
2900 (ps-end-page)
|
|
|
2901
|
|
|
2902 (if (and ps-spool-duplex
|
|
|
2903 (= (mod ps-page-count 2) 1))
|
|
|
2904 (ps-dummy-page))
|
|
|
2905 (ps-flush-output)
|
|
|
2906
|
|
|
2907 ;; Back to the PS output buffer to set the page count
|
|
|
2908 (set-buffer ps-spool-buffer)
|
|
|
2909 (goto-char (point-max))
|
|
|
2910 (while (re-search-backward "^/PageCount 0 def$" nil t)
|
|
|
2911 (replace-match (format "/PageCount %d def" ps-page-count) t))
|
|
|
2912
|
|
2
|
2913 ;; Setting this variable tells the unwind form that
|
|
0
|
2914 ;; the postscript was generated without error.
|
|
|
2915 (setq completed-safely t))
|
|
|
2916
|
|
2
|
2917 ;; Unwind form: If some bad mojo occurred while generating
|
|
0
|
2918 ;; postscript, delete all the postscript that was generated.
|
|
|
2919 ;; This protects the previously spooled files from getting
|
|
|
2920 ;; corrupted.
|
|
|
2921 (if (and (markerp safe-marker) (not completed-safely))
|
|
|
2922 (progn
|
|
|
2923 (set-buffer ps-spool-buffer)
|
|
|
2924 (delete-region (marker-position safe-marker) (point-max))))))
|
|
|
2925
|
|
|
2926 (if ps-razzle-dazzle
|
|
|
2927 (message "Formatting...done")))))
|
|
|
2928
|
|
74
|
2929 ;; Permit dynamic evaluation at print time of ps-lpr-switches
|
|
0
|
2930 (defun ps-do-despool (filename)
|
|
|
2931 (if (or (not (boundp 'ps-spool-buffer))
|
|
82
|
2932 (not (symbol-value 'ps-spool-buffer)))
|
|
0
|
2933 (message "No spooled PostScript to print")
|
|
|
2934 (ps-end-file)
|
|
|
2935 (ps-flush-output)
|
|
|
2936 (if filename
|
|
|
2937 (save-excursion
|
|
|
2938 (if ps-razzle-dazzle
|
|
|
2939 (message "Saving..."))
|
|
|
2940 (set-buffer ps-spool-buffer)
|
|
|
2941 (setq filename (expand-file-name filename))
|
|
|
2942 (write-region (point-min) (point-max) filename)
|
|
|
2943 (if ps-razzle-dazzle
|
|
|
2944 (message "Wrote %s" filename)))
|
|
|
2945 ;; Else, spool to the printer
|
|
|
2946 (if ps-razzle-dazzle
|
|
|
2947 (message "Printing..."))
|
|
|
2948 (save-excursion
|
|
|
2949 (set-buffer ps-spool-buffer)
|
|
2
|
2950 (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer))
|
|
|
2951 (write-region (point-min) (point-max) dos-ps-printer t 0)
|
|
74
|
2952 (let ((binary-process-input t) ; for MS-DOS
|
|
82
|
2953 (ps-lpr-sw ; Dynamic evaluation
|
|
|
2954 (ps-flatten-list (mapcar 'ps-eval-switch ps-lpr-switches))))
|
|
2
|
2955 (apply 'call-process-region
|
|
|
2956 (point-min) (point-max) ps-lpr-command nil
|
|
|
2957 (if (fboundp 'start-process) 0 nil)
|
|
|
2958 nil
|
|
74
|
2959 ps-lpr-sw))))
|
|
0
|
2960 (if ps-razzle-dazzle
|
|
|
2961 (message "Printing...done")))
|
|
|
2962 (kill-buffer ps-spool-buffer)))
|
|
|
2963
|
|
82
|
2964 ;; Dynamic evaluation
|
|
|
2965 (defun ps-eval-switch (arg)
|
|
|
2966 (cond ((stringp arg) arg)
|
|
|
2967 ((functionp arg) (apply arg nil))
|
|
|
2968 ((symbolp arg) (symbol-value arg))
|
|
|
2969 ((consp arg) (apply (car arg) (cdr arg)))
|
|
|
2970 (t nil)))
|
|
|
2971
|
|
|
2972 ;; `ps-flatten-list' is defined here (copied from "message.el" and
|
|
|
2973 ;; enhanced to handle dotted pairs as well) until we can get some
|
|
|
2974 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
|
|
|
2975
|
|
|
2976 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
|
|
|
2977 ;; => (a b c d e f g h i j)
|
|
|
2978
|
|
|
2979 (defun ps-flatten-list (&rest list)
|
|
|
2980 (ps-flatten-list-1 list))
|
|
|
2981
|
|
|
2982 (defun ps-flatten-list-1 (list)
|
|
|
2983 (cond
|
|
|
2984 ((null list) (list))
|
|
|
2985 ((consp list)
|
|
|
2986 (append (ps-flatten-list-1 (car list))
|
|
|
2987 (ps-flatten-list-1 (cdr list))))
|
|
|
2988 (t (list list))))
|
|
|
2989
|
|
0
|
2990 (defun ps-kill-emacs-check ()
|
|
|
2991 (let (ps-buffer)
|
|
|
2992 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
|
|
|
2993 (buffer-modified-p ps-buffer))
|
|
|
2994 (if (y-or-n-p "Unprinted PostScript waiting; print now? ")
|
|
|
2995 (ps-despool)))
|
|
|
2996 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
|
|
|
2997 (buffer-modified-p ps-buffer))
|
|
|
2998 (if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")
|
|
|
2999 nil
|
|
|
3000 (error "Unprinted PostScript")))))
|
|
|
3001
|
|
|
3002 (if (fboundp 'add-hook)
|
|
|
3003 (add-hook 'kill-emacs-hook 'ps-kill-emacs-check)
|
|
|
3004 (if kill-emacs-hook
|
|
|
3005 (message "Won't override existing kill-emacs-hook")
|
|
|
3006 (setq kill-emacs-hook 'ps-kill-emacs-check)))
|
|
|
3007
|
|
|
3008 ;;; Sample Setup Code:
|
|
|
3009
|
|
|
3010 ;; This stuff is for anybody that's brave enough to look this far,
|
|
|
3011 ;; and able to figure out how to use it. It isn't really part of ps-
|
|
|
3012 ;; print, but I'll leave it here in hopes it might be useful:
|
|
|
3013
|
|
|
3014 ;; WARNING!!! The following code is *sample* code only. Don't use it
|
|
|
3015 ;; unless you understand what it does!
|
|
|
3016
|
|
|
3017 (defmacro ps-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
|
|
|
3018 [f22] ''f22))
|
|
|
3019 (defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
|
|
|
3020 [C-f22]
|
|
|
3021 ''(control f22)))
|
|
|
3022 (defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
|
|
|
3023 [S-f22]
|
|
|
3024 ''(shift f22)))
|
|
|
3025
|
|
|
3026 ;; Look in an article or mail message for the Subject: line. To be
|
|
|
3027 ;; placed in ps-left-headers.
|
|
|
3028 (defun ps-article-subject ()
|
|
|
3029 (save-excursion
|
|
|
3030 (goto-char (point-min))
|
|
2
|
3031 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
|
|
0
|
3032 (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
3033 "Subject ???")))
|
|
|
3034
|
|
|
3035 ;; Look in an article or mail message for the From: line. Sorta-kinda
|
|
|
3036 ;; understands RFC-822 addresses and can pull the real name out where
|
|
|
3037 ;; it's provided. To be placed in ps-left-headers.
|
|
|
3038 (defun ps-article-author ()
|
|
|
3039 (save-excursion
|
|
|
3040 (goto-char (point-min))
|
|
2
|
3041 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
|
|
0
|
3042 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
|
|
|
3043 (cond
|
|
|
3044
|
|
|
3045 ;; Try first to match addresses that look like
|
|
|
3046 ;; thompson@wg2.waii.com (Jim Thompson)
|
|
|
3047 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
|
|
|
3048 (substring fromstring (match-beginning 1) (match-end 1)))
|
|
|
3049
|
|
|
3050 ;; Next try to match addresses that look like
|
|
|
3051 ;; Jim Thompson <thompson@wg2.waii.com>
|
|
|
3052 ((string-match "\\(.*\\)[ \t]+<.*>" fromstring)
|
|
|
3053 (substring fromstring (match-beginning 1) (match-end 1)))
|
|
|
3054
|
|
|
3055 ;; Couldn't find a real name -- show the address instead.
|
|
|
3056 (t fromstring)))
|
|
|
3057 "From ???")))
|
|
|
3058
|
|
|
3059 ;; A hook to bind to gnus-Article-prepare-hook. This will set the ps-
|
|
|
3060 ;; left-headers specially for gnus articles. Unfortunately, gnus-
|
|
|
3061 ;; article-mode-hook is called only once, the first time the *Article*
|
|
|
3062 ;; buffer enters that mode, so it would only work for the first time
|
|
|
3063 ;; we ran gnus. The second time, this hook wouldn't get set up. The
|
|
|
3064 ;; only alternative is gnus-article-prepare-hook.
|
|
|
3065 (defun ps-gnus-article-prepare-hook ()
|
|
|
3066 (setq ps-header-lines 3)
|
|
|
3067 (setq ps-left-header
|
|
|
3068 ;; The left headers will display the article's subject, its
|
|
|
3069 ;; author, and the newsgroup it was in.
|
|
|
3070 (list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name)))
|
|
|
3071
|
|
|
3072 ;; A hook to bind to vm-mode-hook to locally bind prsc and set the ps-
|
|
|
3073 ;; left-headers specially for mail messages. This header setup would
|
|
|
3074 ;; also work, I think, for RMAIL.
|
|
|
3075 (defun ps-vm-mode-hook ()
|
|
|
3076 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
|
|
|
3077 (setq ps-header-lines 3)
|
|
|
3078 (setq ps-left-header
|
|
|
3079 ;; The left headers will display the message's subject, its
|
|
|
3080 ;; author, and the name of the folder it was in.
|
|
|
3081 (list 'ps-article-subject 'ps-article-author 'buffer-name)))
|
|
|
3082
|
|
|
3083 ;; Every now and then I forget to switch from the *Summary* buffer to
|
|
|
3084 ;; the *Article* before hitting prsc, and a nicely formatted list of
|
|
|
3085 ;; article subjects shows up at the printer. This function, bound to
|
|
|
3086 ;; prsc for the gnus *Summary* buffer means I don't have to switch
|
|
|
3087 ;; buffers first.
|
|
74
|
3088 ;; sb: Updated for Gnus 5.
|
|
0
|
3089 (defun ps-gnus-print-article-from-summary ()
|
|
|
3090 (interactive)
|
|
74
|
3091 (let ((ps-buf (if (boundp 'gnus-article-buffer)
|
|
|
3092 gnus-article-buffer
|
|
|
3093 "*Article*")))
|
|
|
3094 (if (get-buffer ps-buf)
|
|
|
3095 (save-excursion
|
|
|
3096 (set-buffer ps-buf)
|
|
|
3097 (ps-spool-buffer-with-faces)))))
|
|
0
|
3098
|
|
|
3099 ;; See ps-gnus-print-article-from-summary. This function does the
|
|
|
3100 ;; same thing for vm.
|
|
|
3101 (defun ps-vm-print-message-from-summary ()
|
|
|
3102 (interactive)
|
|
82
|
3103 (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
|
|
0
|
3104 (save-excursion
|
|
82
|
3105 (set-buffer (symbol-value 'vm-mail-buffer))
|
|
0
|
3106 (ps-spool-buffer-with-faces))))
|
|
|
3107
|
|
|
3108 ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind
|
|
|
3109 ;; prsc.
|
|
|
3110 (defun ps-gnus-summary-setup ()
|
|
|
3111 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
|
|
|
3112
|
|
|
3113 ;; Look in an article or mail message for the Subject: line. To be
|
|
|
3114 ;; placed in ps-left-headers.
|
|
|
3115 (defun ps-info-file ()
|
|
|
3116 (save-excursion
|
|
|
3117 (goto-char (point-min))
|
|
2
|
3118 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
|
|
0
|
3119 (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
3120 "File ???")))
|
|
|
3121
|
|
|
3122 ;; Look in an article or mail message for the Subject: line. To be
|
|
|
3123 ;; placed in ps-left-headers.
|
|
|
3124 (defun ps-info-node ()
|
|
|
3125 (save-excursion
|
|
|
3126 (goto-char (point-min))
|
|
2
|
3127 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
|
|
0
|
3128 (buffer-substring (match-beginning 1) (match-end 1))
|
|
|
3129 "Node ???")))
|
|
|
3130
|
|
|
3131 (defun ps-info-mode-hook ()
|
|
|
3132 (setq ps-left-header
|
|
|
3133 ;; The left headers will display the node name and file name.
|
|
|
3134 (list 'ps-info-node 'ps-info-file)))
|
|
|
3135
|
|
|
3136 ;; WARNING! The following function is a *sample* only, and is *not*
|
|
|
3137 ;; meant to be used as a whole unless you understand what the effects
|
|
82
|
3138 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
|
|
|
3139 ;; I'd be very surprised if it was useful to *anybody*, without
|
|
0
|
3140 ;; modification.)
|
|
|
3141
|
|
|
3142 (defun ps-jts-ps-setup ()
|
|
|
3143 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
|
|
|
3144 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
|
|
|
3145 (global-set-key (ps-c-prsc) 'ps-despool)
|
|
|
3146 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
|
|
|
3147 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
|
|
|
3148 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
|
|
|
3149 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
|
|
|
3150 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
|
|
|
3151 (setq ps-spool-duplex t)
|
|
|
3152 (setq ps-print-color-p nil)
|
|
|
3153 (setq ps-lpr-command "lpr")
|
|
82
|
3154 (setq ps-lpr-switches '("-Jjct,duplex_long"))
|
|
|
3155 'ps-jts-ps-setup)
|
|
|
3156
|
|
|
3157 ;; WARNING! The following function is a *sample* only, and is *not*
|
|
|
3158 ;; meant to be used as a whole unless it corresponds to your needs.
|
|
|
3159 ;; (In fact, this is a copy of Jack's setup for ps-print --
|
|
|
3160 ;; I would not be that surprised if it was useful to *anybody*,
|
|
|
3161 ;; without modification.)
|
|
|
3162
|
|
|
3163 (defun ps-jack-setup ()
|
|
|
3164 (setq ps-print-color-p 'nil
|
|
|
3165 ps-lpr-command "lpr"
|
|
|
3166 ps-lpr-switches (list)
|
|
|
3167
|
|
|
3168 ps-paper-type 'a4
|
|
|
3169 ps-landscape-mode 't
|
|
|
3170 ps-number-of-columns 2
|
|
|
3171
|
|
|
3172 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
|
|
|
3173 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
|
|
|
3174 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
|
|
|
3175 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
|
|
|
3176 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
|
|
|
3177 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
|
|
|
3178 ps-header-line-pad .15
|
|
|
3179 ps-print-header t
|
|
|
3180 ps-print-header-frame t
|
|
|
3181 ps-header-lines 2
|
|
|
3182 ps-show-n-of-n t
|
|
|
3183 ps-spool-duplex nil
|
|
|
3184
|
|
|
3185 ps-font-family 'Courier
|
|
|
3186 ps-font-size 5.5
|
|
|
3187 ps-header-font-family 'Helvetica
|
|
|
3188 ps-header-font-size 6
|
|
|
3189 ps-header-title-font-size 8)
|
|
|
3190 'ps-jack-setup)
|
|
0
|
3191
|
|
|
3192 (provide 'ps-print)
|
|
|
3193
|
|
|
3194 ;;; ps-print.el ends here
|
