* configure.in: Add i386 to cpp_undefs (Bug#8497).
[bpt/emacs.git] / lisp / ps-print.el
1 ;;; ps-print.el --- print text from the buffer as PostScript
2
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001,
4 ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
5 ;; Free Software Foundation, Inc.
6
7 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
8 ;; Jacques Duthen (was <duthen@cegelec-red.fr>)
9 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
10 ;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
11 ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
12 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
13 ;; Keywords: wp, print, PostScript
14 ;; Version: 7.3.5
15 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
16
17 (defconst ps-print-version "7.3.5"
18 "ps-print.el, v 7.3.5 <2009/12/23 vinicius>
19
20 Vinicius's last change version -- this file may have been edited as part of
21 Emacs without changes to the version number. When reporting bugs, please also
22 report the version of Emacs, if any, that ps-print was distributed with.
23
24 Please send all bug fixes and enhancements to
25 Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
26
27 ;; This file is part of GNU Emacs.
28
29 ;; GNU Emacs is free software: you can redistribute it and/or modify
30 ;; it under the terms of the GNU General Public License as published by
31 ;; the Free Software Foundation, either version 3 of the License, or
32 ;; (at your option) any later version.
33
34 ;; GNU Emacs is distributed in the hope that it will be useful,
35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
37 ;; GNU General Public License for more details.
38
39 ;; You should have received a copy of the GNU General Public License
40 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
41
42 ;;; Commentary:
43
44 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45 ;;
46 ;; About ps-print
47 ;; --------------
48 ;;
49 ;; This package provides printing of Emacs buffers on PostScript printers; the
50 ;; buffer's bold and italic text attributes are preserved in the printer
51 ;; output. ps-print is intended for use with Emacs or XEmacs, together with a
52 ;; fontifying package such as font-lock or hilit.
53 ;;
54 ;; ps-print uses the same face attributes defined through font-lock or hilit to
55 ;; print a PostScript file, but some faces are better seeing on the screen than
56 ;; on paper, specially when you have a black/white PostScript printer.
57 ;;
58 ;; ps-print allows a remap of face to another one that it is better to print,
59 ;; for example, the face font-lock-comment-face (if you are using font-lock)
60 ;; could have bold or italic attribute when printing, besides foreground color.
61 ;; This remap improves printing look (see How Ps-Print Maps Faces).
62 ;;
63 ;;
64 ;; Using ps-print
65 ;; --------------
66 ;;
67 ;; ps-print provides eight commands for generating PostScript images of Emacs
68 ;; buffers:
69 ;;
70 ;; ps-print-buffer
71 ;; ps-print-buffer-with-faces
72 ;; ps-print-region
73 ;; ps-print-region-with-faces
74 ;; ps-spool-buffer
75 ;; ps-spool-buffer-with-faces
76 ;; ps-spool-region
77 ;; ps-spool-region-with-faces
78 ;;
79 ;; These commands all perform essentially the same function: they generate
80 ;; PostScript images suitable for printing on a PostScript printer or
81 ;; displaying with GhostScript. These commands are collectively referred to as
82 ;; "ps-print- commands".
83 ;;
84 ;; The word "print" or "spool" in the command name determines when the
85 ;; PostScript image is sent to the printer:
86 ;;
87 ;; print - The PostScript image is immediately sent to the printer;
88 ;;
89 ;; spool - The PostScript image is saved temporarily in an Emacs
90 ;; buffer. Many images may be spooled locally before
91 ;; printing them. To send the spooled images to the
92 ;; printer, use the command `ps-despool'.
93 ;;
94 ;; The spooling mechanism was designed for printing lots of small files (mail
95 ;; messages or netnews articles) to save paper that would otherwise be wasted
96 ;; on banner pages, and to make it easier to find your output at the printer
97 ;; (it's easier to pick up one 50-page printout than to find 50 single-page
98 ;; printouts).
99 ;;
100 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't accidentally
101 ;; quit from Emacs while you have unprinted PostScript waiting in the spool
102 ;; buffer. If you do attempt to exit with spooled PostScript, you'll be asked
103 ;; if you want to print it, and if you decline, you'll be asked to confirm the
104 ;; exit; this is modeled on the confirmation that Emacs uses for modified
105 ;; buffers.
106 ;;
107 ;; The word "buffer" or "region" in the command name determines how much of the
108 ;; buffer is printed:
109 ;;
110 ;; buffer - Print the entire buffer.
111 ;;
112 ;; region - Print just the current region.
113 ;;
114 ;; The -with-faces suffix on the command name means that the command will
115 ;; include font, color, and underline information in the PostScript image, so
116 ;; the printed image can look as pretty as the buffer. The ps-print- commands
117 ;; without the -with-faces suffix don't include font, color, or underline
118 ;; information; images printed with these commands aren't as pretty, but are
119 ;; faster to generate.
120 ;;
121 ;; Two ps-print- command examples:
122 ;;
123 ;; ps-print-buffer - print the entire buffer, without font,
124 ;; color, or underline information, and
125 ;; send it immediately to the printer.
126 ;;
127 ;; ps-spool-region-with-faces - print just the current region; include
128 ;; font, color, and underline information,
129 ;; and spool the image in Emacs to send to
130 ;; the printer later.
131 ;;
132 ;;
133 ;; Invoking Ps-Print
134 ;; -----------------
135 ;;
136 ;; To print your buffer, type
137 ;;
138 ;; M-x ps-print-buffer
139 ;;
140 ;; or substitute one of the other seven ps-print- commands. The command will
141 ;; generate the PostScript image and print or spool it as specified. By giving
142 ;; the command a prefix argument
143 ;;
144 ;; C-u M-x ps-print-buffer
145 ;;
146 ;; it will save the PostScript image to a file instead of sending it to the
147 ;; printer; you will be prompted for the name of the file to save the image to.
148 ;; The prefix argument is ignored by the commands that spool their images, but
149 ;; you may save the spooled images to a file by giving a prefix argument to
150 ;; `ps-despool':
151 ;;
152 ;; C-u M-x ps-despool
153 ;;
154 ;; When invoked this way, `ps-despool' will prompt you for the name of the file
155 ;; to save to.
156 ;;
157 ;; Any of the `ps-print-' commands can be bound to keys; I recommend binding
158 ;; `ps-spool-buffer-with-faces', `ps-spool-region-with-faces', and
159 ;; `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
160 ;;
161 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
162 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
163 ;; (global-set-key '(control f22) 'ps-despool)
164 ;;
165 ;;
166 ;; The Printer Interface
167 ;; ---------------------
168 ;;
169 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what command
170 ;; is used to send the PostScript images to the printer, and what arguments to
171 ;; give the command. These are analogous to `lpr-command' and `lpr-switches'.
172 ;;
173 ;; Make sure that they contain appropriate values for your system;
174 ;; see the usage notes below and the documentation of these variables.
175 ;;
176 ;; The variable `ps-printer-name' determines the name of a local printer for
177 ;; printing PostScript files.
178 ;;
179 ;; The variable `ps-printer-name-option' determines the option used by some
180 ;; utilities to indicate the printer name, it's used only when
181 ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
182 ;; print, for example, `ps-printer-name-option' should be set to "-P".
183 ;;
184 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values from
185 ;; the variables `lpr-command' and `lpr-switches'. If you have
186 ;; `lpr-command' set to invoke a pretty-printer such as `enscript', then
187 ;; ps-print won't work properly. `ps-lpr-command' must name a program
188 ;; that does not format the files it prints.
189 ;; `ps-printer-name' takes its initial value from the variable
190 ;; `printer-name'. `ps-printer-name-option' tries to guess which system
191 ;; Emacs is running and takes its initial value in accordance with this
192 ;; guess.
193 ;;
194 ;; The variable `ps-print-region-function' specifies a function to print the
195 ;; region on a PostScript printer.
196 ;; See definition of `call-process-region' for calling conventions. The fourth
197 ;; and the sixth arguments are both nil.
198 ;;
199 ;; The variable `ps-manual-feed' indicates if the printer will manually feed
200 ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
201 ;; feeding takes place. The default is nil (automatic feeding).
202 ;;
203 ;; The variable `ps-end-with-control-d' specifies whether C-d (\x04) should be
204 ;; inserted at end of PostScript generated. Non-nil means do so. The default
205 ;; is nil (don't insert).
206 ;;
207 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
208 ;; customize the following variables: `ps-printer-name',
209 ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
210 ;; `ps-spool-config'. See these variables documentation in the code or by
211 ;; typing, for example, C-h v ps-printer-name RET.
212 ;;
213 ;;
214 ;; The Page Layout
215 ;; ---------------
216 ;;
217 ;; All dimensions are floats in PostScript points.
218 ;; 1 inch == 2.54 cm == 72 points
219 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
220 ;;
221 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
222 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
223 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
224 ;; `b5'.
225 ;;
226 ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
227 ;; PostScript printer doesn't have a paper with the size indicated by
228 ;; `ps-paper-type', instead it uses the default paper size. If variable
229 ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
230 ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
231 ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
232 ;; Printers). The default value is non-nil (it gives an error).
233 ;;
234 ;; The variable `ps-landscape-mode' determines the orientation of the printing
235 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
236 ;; There is no oblique mode yet, though this is easy to do in ps.
237 ;;
238 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in
239 ;; portrait mode and only 50 lines in landscape mode. The margins represent
240 ;; margins in the printed paper: the top margin is the margin between the top
241 ;; of the page and the printed header, whatever the orientation is.
242 ;;
243 ;; The variable `ps-number-of-columns' determines the number of columns both in
244 ;; landscape and portrait mode.
245 ;; You can use:
246 ;; - (the standard) one column portrait mode.
247 ;; - (my favorite) two columns landscape mode (which spares trees).
248 ;; but also:
249 ;; - one column landscape mode for files with very long lines.
250 ;; - multi-column portrait or landscape mode.
251 ;;
252 ;; The variable `ps-print-upside-down' determines other orientation for
253 ;; printing page: nil means `normal' printing, non-nil means `upside-down'
254 ;; printing (that is, the page is rotated by 180 grades). The default value is
255 ;; nil (`normal' printing).
256 ;;
257 ;; The `upside-down' orientation can be used in portrait or landscape mode.
258 ;;
259 ;; The variable `ps-selected-pages' specifies which pages to print. If it's
260 ;; nil, all pages are printed. If it's a list, the list element may be an
261 ;; integer or a cons cell (FROM . TO) designating FROM page to TO page; any
262 ;; invalid element is ignored, that is, an integer lesser than one or if FROM
263 ;; is greater than TO. Otherwise, it's treated as nil. The default value is
264 ;; nil (print all pages). After ps-print processing `ps-selected-pages' is set
265 ;; to nil. But the latest `ps-selected-pages' is saved in
266 ;; `ps-last-selected-pages' (see it for documentation). So you can restore the
267 ;; latest selected pages by using `ps-last-selected-pages' or by calling
268 ;; `ps-restore-selected-pages' command (see it for documentation).
269 ;;
270 ;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
271 ;;
272 ;; Valid values are:
273 ;;
274 ;; nil print all pages.
275 ;;
276 ;; even-page print only even pages.
277 ;;
278 ;; odd-page print only odd pages.
279 ;;
280 ;; even-sheet print only even sheets.
281 ;;
282 ;; odd-sheet print only odd sheets.
283 ;;
284 ;; Any other value is treated as nil. The default value is nil.
285 ;;
286 ;; See `ps-even-or-odd-pages' for more detailed documentation.
287 ;;
288 ;;
289 ;; Horizontal layout
290 ;; -----------------
291 ;;
292 ;; The horizontal layout is determined by the variables
293 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
294 ;; as follows:
295 ;;
296 ;; ------------------------------------------
297 ;; | | | | | | | |
298 ;; | lm | text | ic | text | ic | text | rm |
299 ;; | | | | | | | |
300 ;; ------------------------------------------
301 ;;
302 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
303 ;; Usually, lm = rm > 0 and ic = lm
304 ;; If (ic < 0), the text of adjacent columns can overlap.
305 ;;
306 ;;
307 ;; Vertical layout
308 ;; ---------------
309 ;;
310 ;; The vertical layout is determined by the variables
311 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' `ps-footer-offset'
312 ;; as follows:
313 ;;
314 ;; |--------| |--------| |--------| |--------|
315 ;; | tm | | tm | | tm | | tm |
316 ;; |--------| |--------| |--------| |--------|
317 ;; | header | | | | header | | |
318 ;; |--------| | | |--------| | |
319 ;; | ho | | | | ho | | |
320 ;; |--------| | | |--------| | |
321 ;; | | | | | | | |
322 ;; | text | or | text | or | text | or | text |
323 ;; | | | | | | | |
324 ;; | | |--------| |--------| | |
325 ;; | | | fo | | fo | | |
326 ;; | | |--------| |--------| | |
327 ;; | | | footer | | footer | | |
328 ;; |--------| |--------| |--------| |--------|
329 ;; | bm | | bm | | bm | | bm |
330 ;; |--------| |--------| |--------| |--------|
331 ;;
332 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
333 ;; If `ps-print-footer' is nil, `ps-footer-offset' is not relevant.
334 ;; The margins represent margins in the printed paper:
335 ;; the top margin is the margin between the top of the page and the printed
336 ;; header, whatever the orientation is;
337 ;; the bottom margin is the margin between the bottom of the page and the
338 ;; printed footer, whatever the orientation is.
339 ;;
340 ;;
341 ;; Headers & Footers
342 ;; -----------------
343 ;;
344 ;; ps-print can print headers at the top of each column or at the top of each
345 ;; page; the default headers contain the following four items: on the left, the
346 ;; name of the buffer and, if the buffer is visiting a file, the file's
347 ;; directory; on the right, the page number and date of printing. The default
348 ;; headers look something like this:
349 ;;
350 ;; ps-print.el 1/21
351 ;; /home/jct/emacs-lisp/ps/new 94/12/31
352 ;;
353 ;; When printing on duplex printers, left and right are reversed so that the
354 ;; page numbers are toward the outside (cf. `ps-spool-duplex').
355 ;;
356 ;; Headers are configurable:
357 ;; To turn them off completely, set `ps-print-header' to nil.
358 ;; To turn off the header's gaudy framing box,
359 ;; set `ps-print-header-frame' to nil.
360 ;;
361 ;; The variable `ps-header-frame-alist' specifies header frame properties
362 ;; alist. Valid frame properties are:
363 ;;
364 ;; fore-color Specify the foreground frame color.
365 ;; It should be a float number between 0.0 (black color)
366 ;; and 1.0 (white color), a string which is a color name,
367 ;; or a list of 3 float numbers which corresponds to the
368 ;; Red Green Blue color scale, each float number between
369 ;; 0.0 (dark color) and 1.0 (bright color).
370 ;; The default is 0 ("black").
371 ;;
372 ;; back-color Specify the background frame color (similar to
373 ;; fore-color). The default is 0.9 ("gray90").
374 ;;
375 ;; shadow-color Specify the shadow color (similar to fore-color).
376 ;; The default is 0 ("black").
377 ;;
378 ;; border-color Specify the border color (similar to fore-color).
379 ;; The default is 0 ("black").
380 ;;
381 ;; border-width Specify the border width.
382 ;; The default is 0.4.
383 ;;
384 ;; Any other property is ignored.
385 ;;
386 ;; Don't change this alist directly, instead use customization, or `ps-value',
387 ;; `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
388 ;;
389 ;; To print only one header at the top of each page, set
390 ;; `ps-print-only-one-header' to t.
391 ;;
392 ;; To switch headers, set `ps-switch-header' to:
393 ;;
394 ;; nil Never switch headers.
395 ;;
396 ;; t Always switch headers.
397 ;;
398 ;; duplex Switch headers only when duplexing is on, that is, when
399 ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
400 ;;
401 ;; Any other value is treated as t. The default value is `duplex'.
402 ;;
403 ;; The font family and size of text in the header are determined by the
404 ;; variables `ps-header-font-family', `ps-header-font-size' and
405 ;; `ps-header-title-font-size' (see below).
406 ;;
407 ;; The variable `ps-header-line-pad' determines the portion of a header title
408 ;; line height to insert between the header frame and the text it contains,
409 ;; both in the vertical and horizontal directions: .5 means half a line.
410 ;;
411 ;; Page numbers are printed in `n/m' format, indicating page n of m pages; to
412 ;; omit the total page count and just print the page number, set
413 ;; `ps-show-n-of-n' to nil.
414 ;;
415 ;; The amount of information in the header can be changed by changing the
416 ;; number of lines. To show less, set `ps-header-lines' to 1, and the header
417 ;; will show only the buffer name and page number. To show more, set
418 ;; `ps-header-lines' to 3, and the header will show the time of printing below
419 ;; the date.
420 ;;
421 ;; To change the content of the headers, change the variables `ps-left-header'
422 ;; and `ps-right-header'.
423 ;; These variables are lists, specifying top-to-bottom the text to display on
424 ;; the left or right side of the header. Each element of the list should be a
425 ;; string or a symbol. Strings are inserted directly into the PostScript
426 ;; arrays, and should contain the PostScript string delimiters '(' and ')'.
427 ;;
428 ;; Symbols in the header format lists can either represent functions or
429 ;; variables. Functions are called, and should return a string to show in the
430 ;; header. Variables should contain strings to display in the header. In
431 ;; either case, function or variable, the PostScript string delimiters are
432 ;; added by ps-print, and should not be part of the returned value.
433 ;;
434 ;; Here's an example: say we want the left header to display the text
435 ;;
436 ;; Moe
437 ;; Larry
438 ;; Curly
439 ;;
440 ;; where we have a function to return "Moe"
441 ;;
442 ;; (defun moe-func ()
443 ;; "Moe")
444 ;;
445 ;; a variable specifying "Larry"
446 ;;
447 ;; (setq larry-var "Larry")
448 ;;
449 ;; and a literal for "Curly". Here's how `ps-left-header' should be set:
450 ;;
451 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
452 ;;
453 ;; Note that Curly has the PostScript string delimiters inside his quotes --
454 ;; those aren't misplaced lisp delimiters!
455 ;;
456 ;; Without them, PostScript would attempt to call the undefined function Curly,
457 ;; which would result in a PostScript error.
458 ;;
459 ;; Since most printers don't report PostScript errors except by aborting the
460 ;; print job, this kind of error can be hard to track down.
461 ;;
462 ;; Consider yourself warned!
463 ;;
464 ;; ps-print also print footers. The footer variables are: `ps-print-footer',
465 ;; `ps-footer-offset', `ps-print-footer-frame', `ps-footer-font-family',
466 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
467 ;; `ps-left-footer', `ps-right-footer' and `ps-footer-frame-alist'. These
468 ;; variables are similar to those one that control headers.
469 ;;
470 ;; The variables `ps-print-only-one-header' and `ps-switch-header' also control
471 ;; the footer (The same way that control header).
472 ;;
473 ;; As a footer example, if you want to have a centered page number in the
474 ;; footer but without headers, set:
475 ;;
476 ;; (setq ps-print-header nil
477 ;; ps-print-footer t
478 ;; ps-print-footer-frame nil
479 ;; ps-footer-lines 1
480 ;; ps-right-footer nil
481 ;; ps-left-footer
482 ;; (list (concat "{pagenumberstring dup stringwidth pop"
483 ;; " 2 div PrintWidth 2 div exch sub 0 rmoveto}")))
484 ;;
485 ;;
486 ;; PostScript Prologue Header
487 ;; --------------------------
488 ;;
489 ;; It is possible to add PostScript prologue header comments besides that
490 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
491 ;;
492 ;; `ps-print-prologue-header' may be a string or a symbol function which
493 ;; returns a string. Note that this string is inserted on PostScript prologue
494 ;; header section which is used to define some document characteristic through
495 ;; PostScript special comments, like "%%Requirements: jog\n".
496 ;;
497 ;; By default `ps-print-prologue-header' is nil.
498 ;;
499 ;; ps-print always inserts the %%Requirements: comment, so if you need to
500 ;; insert more requirements put them first in `ps-print-prologue-header' using
501 ;; the "%%+" comment. For example, if you need to set numcopies to 3 and jog
502 ;; on requirements and set %%LanguageLevel: to 2, do:
503 ;;
504 ;; (setq ps-print-prologue-header
505 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
506 ;;
507 ;; The duplex requirement is inserted by ps-print (see section Duplex
508 ;; Printers).
509 ;;
510 ;; Do not forget to terminate the string with "\n".
511 ;;
512 ;; For more information about PostScript document comments, see:
513 ;; PostScript Language Reference Manual (2nd edition)
514 ;; Adobe Systems Incorporated
515 ;; Appendix G: Document Structuring Conventions -- Version 3.0
516 ;;
517 ;; It is also possible to add an user defined PostScript prologue code before
518 ;; all generated prologue code by setting the variable
519 ;; `ps-user-defined-prologue'.
520 ;;
521 ;; `ps-user-defined-prologue' may be a string or a symbol function which
522 ;; returns a string. Note that this string is inserted after `ps-adobe-tag'
523 ;; and PostScript prologue comments, and before ps-print PostScript prologue
524 ;; code section. That is, this string is inserted after error handler
525 ;; initialization and before ps-print settings.
526 ;;
527 ;; By default `ps-user-defined-prologue' is nil.
528 ;;
529 ;; It's strongly recommended only insert PostScript code and/or comments
530 ;; specific for your printing system particularities. For example, some
531 ;; special initialization that only your printing system needs.
532 ;;
533 ;; Do not insert code for duplex printing, n-up printing or error handler,
534 ;; ps-print handles this in a suitable way.
535 ;;
536 ;; For more information about PostScript, see:
537 ;; PostScript Language Reference Manual (2nd edition)
538 ;; Adobe Systems Incorporated
539 ;;
540 ;; As an example for `ps-user-defined-prologue' setting:
541 ;;
542 ;; ;; Setting for HP PostScript printer
543 ;; (setq ps-user-defined-prologue
544 ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
545 ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
546 ;;
547 ;;
548 ;; PostScript Error Handler
549 ;; ------------------------
550 ;;
551 ;; ps-print instruments generated PostScript code with an error handler.
552 ;;
553 ;; The variable `ps-error-handler-message' specifies where the error handler
554 ;; message should be sent.
555 ;;
556 ;; Valid values are:
557 ;;
558 ;; none catch the error and *DON'T* send any message.
559 ;;
560 ;; paper catch the error and print on paper the error message.
561 ;; This is the default value.
562 ;;
563 ;; system catch the error and send back the error message to
564 ;; printing system. This is useful only if printing
565 ;; system send back an email reporting the error, or if
566 ;; there is some other alternative way to report back the
567 ;; error from the system to you.
568 ;;
569 ;; paper-and-system catch the error, print on paper the error message and
570 ;; send back the error message to printing system.
571 ;;
572 ;; Any other value is treated as `paper'.
573 ;;
574 ;;
575 ;; Duplex Printers
576 ;; ---------------
577 ;;
578 ;; If you have a duplex-capable printer (one that prints both sides of the
579 ;; paper), set `ps-spool-duplex' to t.
580 ;; ps-print will insert blank pages to make sure each buffer starts on the
581 ;; correct side of the paper.
582 ;;
583 ;; The variable `ps-spool-config' specifies who is the responsible for setting
584 ;; duplex and page size. Valid values are:
585 ;;
586 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
587 ;; Don't forget to set `ps-lpr-switches' to select duplex
588 ;; printing for your printer.
589 ;;
590 ;; setpagedevice duplex and page size are configured by ps-print using the
591 ;; setpagedevice PostScript operator.
592 ;;
593 ;; nil duplex and page size are configured by ps-print *not* using
594 ;; the setpagedevice PostScript operator.
595 ;;
596 ;; Any other value is treated as nil.
597 ;;
598 ;; The default value is `lpr-switches'.
599 ;;
600 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility
601 ;; when viewing file generated using landscape. Also on some
602 ;; printers, setpagedevice affects zebra stripes; on other printers,
603 ;; setpagedevice affects the left margin.
604 ;; Besides all that, if your printer does not have the paper size
605 ;; specified by setpagedevice, your printing will be aborted.
606 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
607 ;; `setpagedevice', generate a test file and send it to your printer;
608 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
609 ;;
610 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
611 ;; sides of a sheet are oriented with respect to each other. If
612 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left
613 ;; or right. If `ps-spool-tumble' is non-nil, produces output suitable for
614 ;; binding at the top or bottom. It has effect only when `ps-spool-duplex' is
615 ;; non-nil. The default value is nil.
616 ;;
617 ;; Some printer system prints a header page and forces the first page be
618 ;; printed on header page back, when using duplex. If your printer system has
619 ;; this behavior, set variable `ps-banner-page-when-duplexing' to t.
620 ;;
621 ;; When `ps-banner-page-when-duplexing' is non-nil, it prints a blank page as
622 ;; the very first printed page. So, it behaves as the very first character of
623 ;; buffer (or region) is ^L (\014).
624 ;;
625 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the
626 ;; very first page).
627 ;;
628 ;;
629 ;; N-up Printing
630 ;; -------------
631 ;;
632 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
633 ;; paper. The value specified must be between 1 and 100. The default is 1.
634 ;;
635 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is
636 ;; set to a high value (for example, 23). If this happens, set a lower value.
637 ;;
638 ;; The variable `ps-n-up-margin' specifies the margin in points between the
639 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
640 ;; or 28.35 points).
641 ;;
642 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each
643 ;; page. The default is t.
644 ;;
645 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
646 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
647 ;; filling example using a 3x4 page matrix:
648 ;;
649 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
650 ;; 5 6 7 8 5 6 7 8
651 ;; 9 10 11 12 1 2 3 4
652 ;;
653 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
654 ;; 8 7 6 5 8 7 6 5
655 ;; 12 11 10 9 4 3 2 1
656 ;;
657 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
658 ;; 2 5 8 11 2 5 8 11
659 ;; 3 6 9 12 1 4 7 10
660 ;;
661 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
662 ;; 11 8 5 2 11 8 5 2
663 ;; 12 9 6 3 10 7 4 1
664 ;;
665 ;; Any other value is treated as `left-top'.
666 ;;
667 ;; The default value is left-top.
668 ;;
669 ;;
670 ;; Control And 8-bit Characters
671 ;; ----------------------------
672 ;;
673 ;; The variable `ps-print-control-characters' specifies whether you want to see
674 ;; a printable form for control and 8-bit characters, that is, instead of
675 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
676 ;;
677 ;; Valid values for `ps-print-control-characters' are:
678 ;;
679 ;; 8-bit This is the value to use when you want an ASCII encoding of
680 ;; any control or non-ASCII character. Control characters are
681 ;; encoded as "^D", and non-ASCII characters have an
682 ;; octal encoding.
683 ;;
684 ;; control-8-bit This is the value to use when you want an ASCII encoding of
685 ;; any control character, whether it is 7 or 8-bit.
686 ;; European 8-bits accented characters are printed according
687 ;; the current font.
688 ;;
689 ;; control Only ASCII control characters have an ASCII encoding.
690 ;; European 8-bits accented characters are printed according
691 ;; the current font.
692 ;;
693 ;; nil No ASCII encoding. Any character is printed according the
694 ;; current font.
695 ;;
696 ;; Any other value is treated as nil.
697 ;;
698 ;; The default is `control-8-bit'.
699 ;;
700 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
701 ;;
702 ;;
703 ;; Printing Multi-byte Buffer
704 ;; --------------------------
705 ;;
706 ;; See ps-mule.el for documentation.
707 ;;
708 ;;
709 ;; Line Number
710 ;; -----------
711 ;;
712 ;; The variable `ps-line-number' specifies whether to number each line;
713 ;; non-nil means do so. The default is nil (don't number each line).
714 ;;
715 ;; The variable `ps-line-number-color' specifies the color for line number.
716 ;; See `ps-zebra-color' for documentation. The default is "black" (or 0.0, or
717 ;; '(0.0 0.0 0.0)).
718 ;;
719 ;; The variable `ps-line-number-font' specifies the font for line number.
720 ;; The default is "Times-Italic".
721 ;;
722 ;; The variable `ps-line-number-font-size' specifies the font size in points
723 ;; for line number. See `ps-font-size' for documentation. The default is 6.
724 ;;
725 ;; The variable `ps-line-number-step' specifies the interval that line number
726 ;; is printed. For example, if `ps-line-number-step' is set to 2, the printing
727 ;; will look like:
728 ;;
729 ;; 1 one line
730 ;; one line
731 ;; 3 one line
732 ;; one line
733 ;; 5 one line
734 ;; one line
735 ;; ...
736 ;;
737 ;; Valid values are:
738 ;;
739 ;; integer an integer that specifies the interval that line number is
740 ;; printed. If it's lesser than or equal to zero, it's used the
741 ;; value 1.
742 ;;
743 ;; `zebra' specifies that only the line number of the first line in a
744 ;; zebra stripe is to be printed.
745 ;;
746 ;; Any other value is treated as `zebra'.
747 ;; The default value is 1, so each line number is printed.
748 ;;
749 ;; The variable `ps-line-number-start' specifies the starting point in the
750 ;; interval given by `ps-line-number-step'. For example, if
751 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3,
752 ;; the printing will look like:
753 ;;
754 ;; one line
755 ;; one line
756 ;; 3 one line
757 ;; one line
758 ;; one line
759 ;; 6 one line
760 ;; one line
761 ;; one line
762 ;; 9 one line
763 ;; one line
764 ;; ...
765 ;;
766 ;; The values for `ps-line-number-start':
767 ;;
768 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
769 ;; of `ps-line-number-step' inclusive.
770 ;;
771 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
772 ;; value of `ps-zebra-stripe-height' inclusive.
773 ;;
774 ;; The default value is 1, so the line number of the first line of each
775 ;; interval is printed.
776 ;;
777 ;;
778 ;; Zebra Stripes
779 ;; -------------
780 ;;
781 ;; Zebra stripes are a kind of background that appear "underneath" the text and
782 ;; can make the text easier to read. They look like this:
783 ;;
784 ;; XXXXXXXXXXXXXXXXXXXXXXXX
785 ;; XXXXXXXXXXXXXXXXXXXXXXXX
786 ;; XXXXXXXXXXXXXXXXXXXXXXXX
787 ;;
788 ;;
789 ;;
790 ;; XXXXXXXXXXXXXXXXXXXXXXXX
791 ;; XXXXXXXXXXXXXXXXXXXXXXXX
792 ;; XXXXXXXXXXXXXXXXXXXXXXXX
793 ;;
794 ;; The blocks of X's represent rectangles filled with a light gray color.
795 ;; Each rectangle extends all the way across the page.
796 ;;
797 ;; The height, in lines, of each rectangle is controlled by the variable
798 ;; `ps-zebra-stripe-height', which is 3 by default. The distance between
799 ;; stripes equals the height of a stripe.
800 ;;
801 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
802 ;; Non-nil means yes, nil means no. The default is nil.
803 ;;
804 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
805 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
806 ;; color), a string which is a color name, or a list of 3 numbers which
807 ;; corresponds to the Red Green Blue color scale.
808 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
809 ;;
810 ;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
811 ;; on next page. Visually, valid values are (the character `+' at right of
812 ;; each column indicates that a line is printed):
813 ;;
814 ;; `nil' `follow' `full' `full-follow'
815 ;; Current Page -------- ----------- --------- ----------------
816 ;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
817 ;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
818 ;; 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
819 ;; 4 + 4 + 4 + 4 +
820 ;; 5 + 5 + 5 + 5 +
821 ;; 6 + 6 + 6 + 6 +
822 ;; 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
823 ;; 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
824 ;; 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
825 ;; 10 + 10 +
826 ;; 11 + 11 +
827 ;; -------- ----------- --------- ----------------
828 ;; Next Page -------- ----------- --------- ----------------
829 ;; 12 XXXXX + 12 + 10 XXXXXX + 10 +
830 ;; 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
831 ;; 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
832 ;; 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
833 ;; 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
834 ;; 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
835 ;; 18 XXXXX + 18 + 16 XXXXXX + 16 +
836 ;; 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
837 ;; 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
838 ;; 21 + 21 XXXXXXXX +
839 ;; 22 + 22 +
840 ;; -------- ----------- --------- ----------------
841 ;;
842 ;; Any other value is treated as nil.
843 ;;
844 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
845 ;;
846 ;;
847 ;; Hooks
848 ;; -----
849 ;;
850 ;; ps-print has the following hook variables:
851 ;;
852 ;; `ps-print-hook'
853 ;; It is evaluated once before any printing process. This is the right
854 ;; place to initialize ps-print global data.
855 ;; For an example, see section Adding a New Font Family.
856 ;;
857 ;; `ps-print-begin-sheet-hook'
858 ;; It is evaluated on each beginning of sheet of paper.
859 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
860 ;; evaluated.
861 ;;
862 ;; `ps-print-begin-page-hook'
863 ;; It is evaluated on each beginning of page, except in the beginning of
864 ;; page that `ps-print-begin-sheet-hook' is evaluated.
865 ;;
866 ;; `ps-print-begin-column-hook'
867 ;; It is evaluated on each beginning of column, except in the beginning of
868 ;; column that `ps-print-begin-page-hook' is evaluated or that
869 ;; `ps-print-begin-sheet-hook' is evaluated.
870 ;;
871 ;;
872 ;; Font Managing
873 ;; -------------
874 ;;
875 ;; ps-print now knows rather precisely some fonts: the variable
876 ;; `ps-font-info-database' contains information for a list of font families
877 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino'
878 ;; `Helvetica-Narrow' `NewCenturySchlbk'). Each font family contains the font
879 ;; names for standard, bold, italic and bold-italic characters, a reference
880 ;; size (usually 10) and the corresponding line height, width of a space and
881 ;; average character width.
882 ;;
883 ;; The variable `ps-font-family' determines which font family is to be used for
884 ;; ordinary text. If its value does not correspond to a known font family, an
885 ;; error message is printed into the `*Messages*' buffer, which lists the
886 ;; currently available font families.
887 ;;
888 ;; The variable `ps-font-size' determines the size (in points) of the font for
889 ;; ordinary text, when generating PostScript. Its value is a float or a cons
890 ;; of floats which has the following form:
891 ;;
892 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
893 ;;
894 ;; Similarly, the variable `ps-header-font-family' determines which font family
895 ;; is to be used for text in the header.
896 ;;
897 ;; The variable `ps-header-font-size' determines the font size, in points, for
898 ;; text in the header (similar to `ps-font-size').
899 ;;
900 ;; The variable `ps-header-title-font-size' determines the font size, in
901 ;; points, for the top line of text in the header (similar to `ps-font-size').
902 ;;
903 ;; The variable `ps-line-spacing' determines the line spacing, in points, for
904 ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The
905 ;; default value is 0 (zero = no line spacing).
906 ;;
907 ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in
908 ;; points, for ordinary text, when generating PostScript (similar to
909 ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing).
910 ;;
911 ;; To get all lines with some spacing set both `ps-line-spacing' and
912 ;; `ps-paragraph-spacing' variables.
913 ;;
914 ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It
915 ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an
916 ;; empty line or a line containing only spaces and tabs.
917 ;;
918 ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start
919 ;; and end of a region to cut out when printing.
920 ;;
921 ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may
922 ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave
923 ;; out some special printing instructions from the actual print. Special
924 ;; printing instructions may be appended to the end of the file just like any
925 ;; other buffer-local variables. See section "Local Variables in Files" on
926 ;; Emacs manual for more information.
927 ;;
928 ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together
929 ;; what actually gets printed. Both variables may be set to nil in which case
930 ;; no cutting occurs. By default, both variables are set to nil.
931 ;;
932 ;;
933 ;; Adding a New Font Family
934 ;; ------------------------
935 ;;
936 ;; To use a new font family, you MUST first teach ps-print this font, i.e., add
937 ;; its information to `ps-font-info-database', otherwise ps-print cannot
938 ;; correctly place line and page breaks.
939 ;;
940 ;; For example, assuming `Helvetica' is unknown, you first need to do the
941 ;; following ONLY ONCE:
942 ;;
943 ;; - create a new buffer
944 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
945 ;; - open this file and find the line:
946 ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
947 ;; - delete the leading `%' (which is the PostScript comment character)
948 ;; - replace in this line `Courier' by the new font (say `Helvetica') to get
949 ;; the line:
950 ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
951 ;; - send this file to the printer (or to ghostscript).
952 ;; You should read the following on the output page:
953 ;;
954 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
955 ;; and a crude estimate of average character width is 5.09243
956 ;;
957 ;; - Add these values to the `ps-font-info-database':
958 ;; (setq ps-font-info-database
959 ;; (append
960 ;; '((Helvetica ; the family key
961 ;; (fonts (normal . "Helvetica")
962 ;; (bold . "Helvetica-Bold")
963 ;; (italic . "Helvetica-Oblique")
964 ;; (bold-italic . "Helvetica-BoldOblique"))
965 ;; (size . 10.0)
966 ;; (line-height . 11.56)
967 ;; (space-width . 2.78)
968 ;; (avg-char-width . 5.09243)))
969 ;; ps-font-info-database))
970 ;; - Now you can use this font family with any size:
971 ;; (setq ps-font-family 'Helvetica)
972 ;; - if you want to use this family in another emacs session, you must put into
973 ;; your `~/.emacs':
974 ;; (require 'ps-print)
975 ;; (setq ps-font-info-database (append ...)))
976 ;; if you don't want to load ps-print, you have to copy the whole value:
977 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
978 ;; or, use `ps-print-hook' (see section Hooks):
979 ;; (add-hook 'ps-print-hook
980 ;; '(lambda ()
981 ;; (or (assq 'Helvetica ps-font-info-database)
982 ;; (setq ps-font-info-database (append ...)))))
983 ;;
984 ;; You can create new `mixed' font families like:
985 ;; (my-mixed-family
986 ;; (fonts (normal . "Courier-Bold")
987 ;; (bold . "Helvetica")
988 ;; (italic . "ZapfChancery-MediumItalic")
989 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
990 ;; (w3-table-hack-x-face . "LineDrawNormal"))
991 ;; (size . 10.0)
992 ;; (line-height . 10.55)
993 ;; (space-width . 6.0)
994 ;; (avg-char-width . 6.0))
995 ;;
996 ;; Now you can use your new font family with any size:
997 ;; (setq ps-font-family 'my-mixed-family)
998 ;;
999 ;; Note that on above example the `w3-table-hack-x-face' entry refers to a face
1000 ;; symbol, so when printing this face it'll be used the font `LineDrawNormal'.
1001 ;; If the face `w3-table-hack-x-face' is remapped to use bold and/or italic
1002 ;; attribute, the corresponding entry (bold, italic or bold-italic) will be
1003 ;; used instead of `w3-table-hack-x-face' entry.
1004 ;;
1005 ;; Note also that the font family entry order is irrelevant, so the above
1006 ;; example could also be written:
1007 ;; (my-mixed-family
1008 ;; (size . 10.0)
1009 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
1010 ;; (bold . "Helvetica")
1011 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
1012 ;; (italic . "ZapfChancery-MediumItalic")
1013 ;; (normal . "Courier-Bold"))
1014 ;; (avg-char-width . 6.0)
1015 ;; (space-width . 6.0)
1016 ;; (line-height . 10.55))
1017 ;;
1018 ;; Despite the note above, it is recommended that some convention about
1019 ;; entry order be used.
1020 ;;
1021 ;; You can get information on all the fonts resident in YOUR printer
1022 ;; by uncommenting the line:
1023 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
1024 ;;
1025 ;; The PostScript file should be sent to YOUR PostScript printer.
1026 ;; If you send it to ghostscript or to another PostScript printer, you may get
1027 ;; slightly different results.
1028 ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
1029 ;;
1030 ;; Note also that ps-print DOESN'T download any font to your printer, instead
1031 ;; it uses the fonts resident in your printer.
1032 ;;
1033 ;;
1034 ;; How Ps-Print Deals With Faces
1035 ;; -----------------------------
1036 ;;
1037 ;; The ps-print-*-with-faces commands attempt to determine which faces should
1038 ;; be printed in bold or italic, but their guesses aren't always right. For
1039 ;; example, you might want to map colors into faces so that blue faces print in
1040 ;; bold, and red faces in italic.
1041 ;;
1042 ;; It is possible to force ps-print to consider specific faces bold, italic or
1043 ;; underline, no matter what font they are displayed in, by setting the
1044 ;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
1045 ;; These variables contain lists of faces that ps-print should consider bold,
1046 ;; italic or underline; to set them, put code like the following into your
1047 ;; .emacs file:
1048 ;;
1049 ;; (setq ps-bold-faces '(my-blue-face))
1050 ;; (setq ps-italic-faces '(my-red-face))
1051 ;; (setq ps-underlined-faces '(my-green-face))
1052 ;;
1053 ;; Faces like bold-italic that are both bold and italic should go in *both*
1054 ;; lists.
1055 ;;
1056 ;; ps-print keeps internal lists of which fonts are bold and which are italic;
1057 ;; these lists are built the first time you invoke ps-print.
1058 ;; For the sake of efficiency, the lists are built only once; the same lists
1059 ;; are referred in later invocations of ps-print.
1060 ;;
1061 ;; Because these lists are built only once, it's possible for them to get out
1062 ;; of sync, if a face changes, or if new faces are added. To get the lists
1063 ;; back in sync, you can set the variable `ps-build-face-reference' to t, and
1064 ;; the lists will be rebuilt the next time ps-print is invoked. If you need
1065 ;; that the lists always be rebuilt when ps-print is invoked, set the variable
1066 ;; `ps-always-build-face-reference' to t.
1067 ;;
1068 ;; If you need to print without worrying about face background color, set the
1069 ;; variable `ps-use-face-background' which specifies if face background should
1070 ;; be used. Valid values are:
1071 ;;
1072 ;; t always use face background color.
1073 ;; nil never use face background color.
1074 ;; (face...) list of faces whose background color will be used.
1075 ;;
1076 ;; Any other value will be treated as t.
1077 ;; The default value is nil.
1078 ;;
1079 ;;
1080 ;; How Ps-Print Deals With Color
1081 ;; -----------------------------
1082 ;;
1083 ;; ps-print detects faces with foreground and background colors defined and
1084 ;; embeds color information in the PostScript image.
1085 ;; The default foreground and background colors are defined by the variables
1086 ;; `ps-default-fg' and `ps-default-bg'.
1087 ;; On black/white printers, colors are displayed in gray scale.
1088 ;; To turn off color output, set `ps-print-color-p' to nil.
1089 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
1090 ;; on black/white printers. See also `ps-black-white-faces' for documentation.
1091 ;;
1092 ;; ps-print also detects if the text foreground and background colors are
1093 ;; equals when `ps-fg-validate-p' is non-nil. In this case, if these colors
1094 ;; are used, no text will appear. You can use `ps-fg-list' to give a list of
1095 ;; foreground colors to be used when text foreground and background colors are
1096 ;; equals. It'll be used the first foreground color in `ps-fg-list' which is
1097 ;; different from the background color. If `ps-fg-list' is nil, the default
1098 ;; foreground color is used.
1099 ;;
1100 ;;
1101 ;; How Ps-Print Maps Faces
1102 ;; -----------------------
1103 ;;
1104 ;; As ps-print uses PostScript to print buffers, it is possible to have other
1105 ;; attributes associated with faces. So the new attributes used by ps-print
1106 ;; are:
1107 ;;
1108 ;; strikeout - like underline, but the line is in middle of text.
1109 ;; overline - like underline, but the line is over the text.
1110 ;; shadow - text will have a shadow.
1111 ;; box - text will be surrounded by a box.
1112 ;; outline - print characters as hollow outlines.
1113 ;;
1114 ;; See the documentation for `ps-extend-face'.
1115 ;;
1116 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1117 ;; color and bold attribute:
1118 ;;
1119 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
1120 ;;
1121 ;; If you want to use a new face, define it first with `defface', and then call
1122 ;; `ps-extend-face' to specify how to print it.
1123 ;;
1124 ;;
1125 ;; How Ps-Print Has A Text And/Or Image On Background
1126 ;; --------------------------------------------------
1127 ;;
1128 ;; ps-print can print texts and/or EPS PostScript images on background; it is
1129 ;; possible to define the following text attributes: font name, font size,
1130 ;; initial position, angle, gray scale and pages to print.
1131 ;;
1132 ;; It has the following EPS PostScript images attributes: file name containing
1133 ;; the image, initial position, X and Y scales, angle and pages to print.
1134 ;;
1135 ;; See documentation for `ps-print-background-text' and
1136 ;; `ps-print-background-image'.
1137 ;;
1138 ;; For example, if we wish to print text "preliminary" on all pages and text
1139 ;; "special" on page 5 and from page 11 to page 17, we could specify:
1140 ;;
1141 ;; (setq ps-print-background-text
1142 ;; '(("preliminary")
1143 ;; ("special"
1144 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
1145 ;; ; (upper left corner)
1146 ;; nil nil nil
1147 ;; "PrintHeight neg PrintPageWidth atan" ; angle
1148 ;; 5 (11 . 17)) ; page list
1149 ;; ))
1150 ;;
1151 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
1152 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
1153 ;; specify:
1154 ;;
1155 ;; (setq ps-print-background-image
1156 ;; '(("~/images/EPS-image1.ps"
1157 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
1158 ;; ("~/images/EPS-image2.ps"
1159 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y pos.
1160 ;; ; (upper left corner)
1161 ;; nil nil nil
1162 ;; 5 (11 . 17)) ; page list
1163 ;; ))
1164 ;;
1165 ;; If it is not possible to read (or does not exist) an image file, that file
1166 ;; is ignored.
1167 ;;
1168 ;; The printing order is:
1169 ;;
1170 ;; 1. Print background color
1171 ;; 2. Print zebra stripes
1172 ;; 3. Print background texts that it should be on all pages
1173 ;; 4. Print background images that it should be on all pages
1174 ;; 5. Print background texts only for current page (if any)
1175 ;; 6. Print background images only for current page (if any)
1176 ;; 7. Print header
1177 ;; 8. Print buffer text (with faces, if specified) and line number
1178 ;;
1179 ;;
1180 ;; Utilities
1181 ;; ---------
1182 ;;
1183 ;; Some tools are provided to help you customize your font setup.
1184 ;;
1185 ;; `ps-setup' returns (some part of) the current setup.
1186 ;;
1187 ;; To avoid wrapping too many lines, you may want to adjust the left and right
1188 ;; margins and the font size. On UN*X systems, do:
1189 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1190 ;; to determine the longest lines of your file.
1191 ;; Then, the command `ps-line-lengths' will give you the correspondence between
1192 ;; a line length (number of characters) and the maximum font size which doesn't
1193 ;; wrap such a line with the current ps-print setup.
1194 ;;
1195 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display the
1196 ;; correspondence between a number of pages and the maximum font size which
1197 ;; allow the number of lines of the current buffer or of its current region to
1198 ;; fit in this number of pages.
1199 ;;
1200 ;; NOTE: line folding is not taken into account in this process and could
1201 ;; change the results.
1202 ;;
1203 ;; The command `ps-print-customize' activates a customization buffer for
1204 ;; ps-print options.
1205 ;;
1206 ;;
1207 ;; New since version 1.5
1208 ;; ---------------------
1209 ;;
1210 ;; Color output capability.
1211 ;; Automatic detection of font attributes (bold, italic).
1212 ;; Configurable headers with page numbers.
1213 ;; Slightly faster.
1214 ;; Support for different paper sizes.
1215 ;; Better conformance to PostScript Document Structure Conventions.
1216 ;;
1217 ;;
1218 ;; New since version 2.8
1219 ;; ---------------------
1220 ;;
1221 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1222 ;;
1223 ;; 2007-10-27
1224 ;; `ps-fg-validate-p', `ps-fg-list'
1225 ;;
1226 ;; 2004-02-29
1227 ;; `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
1228 ;;
1229 ;; 2001-06-19
1230 ;; `ps-time-stamp-locale-default'
1231 ;;
1232 ;; 2001-05-30
1233 ;; Handle before-string and after-string overlay properties.
1234 ;;
1235 ;; 2001-04-07
1236 ;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
1237 ;; `ps-print-footer-frame', `ps-footer-font-family',
1238 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
1239 ;; `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
1240 ;; `ps-header-frame-alist'.
1241 ;;
1242 ;; 2001-03-28
1243 ;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
1244 ;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
1245 ;;
1246 ;; 2000-11-22
1247 ;; `ps-line-number-font', `ps-line-number-font-size' and
1248 ;; `ps-end-with-control-d'.
1249 ;;
1250 ;; 2000-08-21
1251 ;; `ps-even-or-odd-pages'
1252 ;;
1253 ;; 2000-06-17
1254 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
1255 ;; `ps-selected-pages', `ps-last-selected-pages',
1256 ;; `ps-restore-selected-pages', `ps-switch-header',
1257 ;; `ps-line-number-step', `ps-line-number-start',
1258 ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
1259 ;;
1260 ;; 2000-03-10
1261 ;; PostScript error handler.
1262 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1263 ;;
1264 ;; 1999-12-11
1265 ;; `ps-print-customize'.
1266 ;;
1267 ;; 1999-07-03
1268 ;; Better customization.
1269 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1270 ;;
1271 ;; 1999-05-13
1272 ;; N-up printing.
1273 ;; Hook: `ps-print-begin-sheet-hook'.
1274 ;;
1275 ;; [kenichi] 1999-05-09 Ken'ichi Handa <handa@m17n.org>
1276 ;;
1277 ;; `ps-print-region-function'
1278 ;;
1279 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1280 ;;
1281 ;; 1999-03-01
1282 ;; PostScript tumble and setpagedevice.
1283 ;;
1284 ;; 1998-09-22
1285 ;; PostScript prologue header comment insertion.
1286 ;; Skip invisible text better.
1287 ;;
1288 ;; [kenichi] 1998-08-19 Ken'ichi Handa <handa@m17n.org>
1289 ;;
1290 ;; Multi-byte buffer handling.
1291 ;;
1292 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1293 ;;
1294 ;; 1998-03-06
1295 ;; Skip invisible text.
1296 ;;
1297 ;; 1997-11-30
1298 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1299 ;; `ps-print-begin-column-hook'.
1300 ;; Put one header per page over the columns.
1301 ;; Better database font management.
1302 ;; Better control characters handling.
1303 ;;
1304 ;; 1997-11-21
1305 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1306 ;; Handle control characters.
1307 ;; Face remapping.
1308 ;; New face attributes.
1309 ;; Line number.
1310 ;; Zebra stripes.
1311 ;; Text and/or image on background.
1312 ;;
1313 ;; [jack] 1996-05-17 Jacques Duthen <duthen@cegelec-red.fr>
1314 ;;
1315 ;; Font family and float size for text and header.
1316 ;; Landscape mode.
1317 ;; Multiple columns.
1318 ;; Tools for page setup.
1319 ;;
1320 ;;
1321 ;; Known bugs and limitations of ps-print
1322 ;; --------------------------------------
1323 ;;
1324 ;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
1325 ;; particular, bold or italic fonts don't print in the right background color.
1326 ;;
1327 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1328 ;;
1329 ;; Automatic font-attribute detection doesn't work well, especially with
1330 ;; hilit19 and older versions of get-create-face. Users having problems with
1331 ;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
1332 ;; and `ps-underlined-faces' and/or turn off automatic detection by setting
1333 ;; `ps-auto-font-detect' to nil.
1334 ;;
1335 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
1336 ;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1337 ;; `ps-underlined-faces' instead.
1338 ;;
1339 ;; Still too slow; could use some hand-optimization.
1340 ;;
1341 ;; Default background color isn't working.
1342 ;;
1343 ;; Faces are always treated as opaque.
1344 ;;
1345 ;; Epoch, Lucid and Emacs 22 not supported. At all.
1346 ;;
1347 ;; Fixed-pitch fonts work better for line folding, but are not required.
1348 ;;
1349 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
1350 ;; lines.
1351 ;;
1352 ;;
1353 ;; Things to change
1354 ;; ----------------
1355 ;;
1356 ;; Avoid page break inside a paragraph.
1357 ;;
1358 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1359 ;;
1360 ;; Improve the memory management for big files (hard?).
1361 ;;
1362 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
1363 ;; lines.
1364 ;;
1365 ;;
1366 ;; Acknowledgments
1367 ;; ---------------
1368 ;;
1369 ;; Thanks to Eduard Wiebe <usenet@pusto.de> for fixing face
1370 ;; background/foreground extraction.
1371 ;;
1372 ;; Thanks to Friedrich Delgado Friedrichs <friedel@nomaden.org> for new label
1373 ;; printer page sizes.
1374 ;;
1375 ;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
1376 ;; compliance of the generated PostScript.
1377 ;;
1378 ;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
1379 ;; for black/white PostScript printers.
1380 ;;
1381 ;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
1382 ;; region to cut out when printing and footer suggestions.
1383 ;;
1384 ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
1385 ;;
1386 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
1387 ;; suggestion.
1388 ;;
1389 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1390 ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1391 ;;
1392 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1393 ;; suggestion for `ps-postscript-code-directory' variable.
1394 ;;
1395 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1396 ;; level 1 compatibility.
1397 ;;
1398 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for:
1399 ;; - upside-down, line number step, line number start and zebra stripe
1400 ;; follow suggestions.
1401 ;; - `ps-time-stamp-yyyy-mm-dd' and `ps-time-stamp-iso8601' suggestion.
1402 ;; - and for XEmacs beta-tests.
1403 ;;
1404 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1405 ;; prologue code suggestion, for odd/even printing suggestion and for
1406 ;; `ps-prologue-file' enhancement.
1407 ;;
1408 ;; Thanks to Ken'ichi Handa <handa@m17n.org> for multi-byte buffer handling.
1409 ;;
1410 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1411 ;; empty columns.
1412 ;;
1413 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1414 ;; last page.
1415 ;;
1416 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1417 ;; `ps-print-control-characters' variable documentation.
1418 ;;
1419 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1420 ;; database font management.
1421 ;;
1422 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1423 ;; header per page over the columns and correct line numbers when printing a
1424 ;; region.
1425 ;;
1426 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1427 ;; print time of `ps-lpr-switches'.
1428 ;;
1429 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1430 ;; (his code was severely modified, but the main idea was kept).
1431 ;;
1432 ;; Thanks to some suggestions on:
1433 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1434 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1435 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1436 ;;
1437 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for version 3.4 I
1438 ;; started from. [vinicius]
1439 ;;
1440 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from. [jack]
1441 ;;
1442 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
1443 ;; the invisible property.
1444 ;;
1445 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the
1446 ;; initial port to Emacs 19. His code is no longer part of ps-print, but his
1447 ;; work is still appreciated.
1448 ;;
1449 ;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
1450 ;; adding underline support. Their code also is no longer part of ps-print,
1451 ;; but their efforts are not forgotten.
1452 ;;
1453 ;; Thanks also to all of you who mailed code to add features to ps-print;
1454 ;; although I didn't use your code, I still appreciate your sharing it with me.
1455 ;;
1456 ;; Thanks to all who mailed comments, encouragement, and criticism.
1457 ;; Thanks also to all who responded to my survey; I had too many responses to
1458 ;; reply to them all, but I greatly appreciate your interest.
1459 ;;
1460 ;; Jim
1461 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1462
1463 ;;; Code:
1464
1465
1466 (require 'lpr)
1467
1468
1469 (or (featurep 'lisp-float-type)
1470 (error "`ps-print' requires floating point support"))
1471
1472
1473 (if (featurep 'xemacs)
1474 ()
1475 (unless (and (boundp 'emacs-major-version)
1476 (>= emacs-major-version 23))
1477 (error "`ps-print' only supports Emacs 23 and higher")))
1478
1479
1480 (defconst ps-windows-system
1481 (memq system-type '(ms-dos windows-nt)))
1482 (defconst ps-lp-system
1483 (memq system-type '(usg-unix-v hpux irix)))
1484
1485
1486 ;; Load XEmacs/Emacs definitions
1487 (eval-and-compile (require 'ps-def))
1488
1489
1490 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1491 ;; User Variables:
1492
1493
1494 ;;; Interface to the command system
1495
1496 (defgroup postscript nil
1497 "Support for printing and PostScript."
1498 :tag "PostScript"
1499 :version "20"
1500 :group 'emacs)
1501
1502 (defgroup ps-print nil
1503 "PostScript generator for Emacs."
1504 :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
1505 :prefix "ps-"
1506 :version "20"
1507 :group 'wp
1508 :group 'postscript)
1509
1510 (defgroup ps-print-horizontal nil
1511 "Horizontal page layout."
1512 :prefix "ps-"
1513 :tag "Horizontal"
1514 :version "20"
1515 :group 'ps-print)
1516
1517 (defgroup ps-print-vertical nil
1518 "Vertical page layout."
1519 :prefix "ps-"
1520 :tag "Vertical"
1521 :version "20"
1522 :group 'ps-print)
1523
1524 (defgroup ps-print-headers nil
1525 "Headers & footers layout."
1526 :prefix "ps-"
1527 :tag "Header & Footer"
1528 :version "20"
1529 :group 'ps-print)
1530
1531 (defgroup ps-print-font nil
1532 "Fonts customization."
1533 :prefix "ps-"
1534 :tag "Font"
1535 :version "20"
1536 :group 'ps-print)
1537
1538 (defgroup ps-print-color nil
1539 "Color customization."
1540 :prefix "ps-"
1541 :tag "Color"
1542 :version "20"
1543 :group 'ps-print)
1544
1545 (defgroup ps-print-face nil
1546 "Faces customization."
1547 :prefix "ps-"
1548 :tag "PS Faces"
1549 :version "20"
1550 :group 'ps-print
1551 :group 'faces)
1552
1553 (defgroup ps-print-n-up nil
1554 "N-up customization."
1555 :prefix "ps-"
1556 :tag "N-Up"
1557 :version "20"
1558 :group 'ps-print)
1559
1560 (defgroup ps-print-zebra nil
1561 "Zebra customization."
1562 :prefix "ps-"
1563 :tag "Zebra"
1564 :version "20"
1565 :group 'ps-print)
1566
1567 (defgroup ps-print-background nil
1568 "Background customization."
1569 :prefix "ps-"
1570 :tag "Background"
1571 :version "20"
1572 :group 'ps-print)
1573
1574 (defgroup ps-print-printer '((lpr custom-group))
1575 "Printer customization."
1576 :prefix "ps-"
1577 :tag "Printer"
1578 :version "20"
1579 :group 'ps-print)
1580
1581 (defgroup ps-print-page nil
1582 "Page customization."
1583 :prefix "ps-"
1584 :tag "Page"
1585 :version "20"
1586 :group 'ps-print)
1587
1588 (defgroup ps-print-miscellany nil
1589 "Miscellany customization."
1590 :prefix "ps-"
1591 :tag "Miscellany"
1592 :version "20"
1593 :group 'ps-print)
1594
1595
1596 (defcustom ps-error-handler-message 'paper
1597 "Specify where the error handler message should be sent.
1598
1599 Valid values are:
1600
1601 `none' catch the error and *DON'T* send any message.
1602
1603 `paper' catch the error and print on paper the error message.
1604
1605 `system' catch the error and send back the error message to
1606 printing system. This is useful only if printing system
1607 send back an email reporting the error, or if there is
1608 some other alternative way to report back the error from
1609 the system to you.
1610
1611 `paper-and-system' catch the error, print on paper the error message and
1612 send back the error message to printing system.
1613
1614 Any other value is treated as `paper'."
1615 :type '(choice :menu-tag "Error Handler Message"
1616 :tag "Error Handler Message"
1617 (const none) (const paper)
1618 (const system) (const paper-and-system))
1619 :version "20"
1620 :group 'ps-print-miscellany)
1621
1622 (defcustom ps-user-defined-prologue nil
1623 "User defined PostScript prologue code inserted before all prologue code.
1624
1625 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1626 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1627 prologue comments, and before ps-print PostScript prologue code section. That
1628 is, this string is inserted after error handler initialization and before
1629 ps-print settings.
1630
1631 It's strongly recommended only insert PostScript code and/or comments specific
1632 for your printing system particularities. For example, some special
1633 initialization that only your printing system needs.
1634
1635 Do not insert code for duplex printing, n-up printing or error handler,
1636 ps-print handles this in a suitable way.
1637
1638 For more information about PostScript, see:
1639 PostScript Language Reference Manual (2nd edition)
1640 Adobe Systems Incorporated
1641
1642 As an example for `ps-user-defined-prologue' setting:
1643
1644 ;; Setting for HP PostScript printer
1645 (setq ps-user-defined-prologue
1646 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1647 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
1648 :type '(choice :menu-tag "User Defined Prologue"
1649 :tag "User Defined Prologue"
1650 (const :tag "none" nil) string symbol)
1651 :version "20"
1652 :group 'ps-print-miscellany)
1653
1654 (defcustom ps-print-prologue-header nil
1655 "PostScript prologue header comments besides that ps-print generates.
1656
1657 `ps-print-prologue-header' may be a string or a symbol function which returns a
1658 string. Note that this string is inserted on PostScript prologue header
1659 section which is used to define some document characteristic through PostScript
1660 special comments, like \"%%Requirements: jog\\n\".
1661
1662 ps-print always inserts the %%Requirements: comment, so if you need to insert
1663 more requirements put them first in `ps-print-prologue-header' using the
1664 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1665 requirements and set %%LanguageLevel: to 2, do:
1666
1667 (setq ps-print-prologue-header
1668 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1669
1670 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1671
1672 Do not forget to terminate the string with \"\\n\".
1673
1674 For more information about PostScript document comments, see:
1675 PostScript Language Reference Manual (2nd edition)
1676 Adobe Systems Incorporated
1677 Appendix G: Document Structuring Conventions -- Version 3.0"
1678 :type '(choice :menu-tag "Prologue Header"
1679 :tag "Prologue Header"
1680 (const :tag "none" nil) string symbol)
1681 :version "20"
1682 :group 'ps-print-miscellany)
1683
1684 (defcustom ps-printer-name (and (boundp 'printer-name)
1685 (symbol-value 'printer-name))
1686 "The name of a local printer for printing PostScript files.
1687
1688 On Unix-like systems, a string value should be a name understood by lpr's -P
1689 option; a value of nil means use the value of `printer-name' instead.
1690
1691 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1692 printer device or port to which PostScript files are written, provided
1693 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1694 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1695 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
1696 for a shared network printer. You can also set it to a name of a file, in
1697 which case the output gets appended to that file. \(Note that `ps-print'
1698 package already has facilities for printing to a file, so you might as well use
1699 them instead of changing the setting of this variable.\) If you want to
1700 silently discard the printed output, set this to \"NUL\".
1701
1702 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1703
1704 Any other value is treated as t, that is, an empty printer name.
1705
1706 See also `ps-printer-name-option' for documentation."
1707 :type '(choice :menu-tag "Printer Name"
1708 :tag "Printer Name"
1709 (const :tag "Same as printer-name" nil)
1710 (const :tag "No Printer Name" t)
1711 (file :tag "Print to file")
1712 (string :tag "Pipe to ps-lpr-command"))
1713 :version "20"
1714 :group 'ps-print-printer)
1715
1716 (defcustom ps-printer-name-option
1717 (cond (ps-windows-system
1718 "/D:")
1719 (ps-lp-system
1720 "-d")
1721 (t
1722 "-P" ))
1723 "Option for `ps-printer-name' variable (see it).
1724
1725 On Unix-like systems, if `lpr' is in use, this should be the string
1726 \"-P\"; if `lp' is in use, this should be the string \"-d\".
1727
1728 On MS-DOS and MS-Windows systems, if `print' is in use, this should be
1729 the string \"/D:\".
1730
1731 For any other printing utility, see its documentation.
1732
1733 Set this to \"\" or nil, if the utility given by `ps-lpr-command'
1734 needs an empty printer name option--that is, pass the printer name
1735 with no special option preceding it.
1736
1737 Any value that is not a string is treated as nil.
1738
1739 This variable is used only when `ps-printer-name' is a non-empty string."
1740 :type '(choice :menu-tag "Printer Name Option"
1741 :tag "Printer Name Option"
1742 (const :tag "None" nil)
1743 (string :tag "Option"))
1744 :version "21.1"
1745 :group 'ps-print-printer)
1746
1747 (defcustom ps-lpr-command lpr-command
1748 "Name of program for printing a PostScript file.
1749
1750 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1751 will write directly to the printer port named by `ps-printer-name'. The
1752 programs `print' and `nprint' (the standard print programs on Windows NT and
1753 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1754 the destination for output; any other program is treated like `lpr' except that
1755 an explicit filename is given as the last argument."
1756 :type 'string
1757 :version "20"
1758 :group 'ps-print-printer)
1759
1760 (defcustom ps-lpr-switches lpr-switches
1761 "List of extra switches to pass to `ps-lpr-command'.
1762
1763 The list element can be:
1764
1765 string it should be an option for `ps-lpr-command' (which see).
1766 For example: \"-o Duplex=DuplexNoTumble\"
1767
1768 symbol it can be a function or variable symbol. If it's a function
1769 symbol, it should be a function with no argument. The result
1770 of the function or the variable value should be a string or a
1771 list of strings.
1772
1773 list the header should be a symbol function and the tail is the
1774 arguments for this function. This function should return a
1775 string or a list of strings.
1776
1777 Any other value is silently ignored.
1778
1779 It is recommended to set `ps-printer-name' (which see) instead of including an
1780 explicit switch on this list.
1781
1782 See `ps-lpr-command'."
1783 :type '(repeat :tag "PostScript lpr Switches"
1784 (choice :menu-tag "PostScript lpr Switch"
1785 :tag "PostScript lpr Switch"
1786 string symbol (repeat sexp)))
1787 :version "20"
1788 :group 'ps-print-printer)
1789
1790 (defcustom ps-print-region-function nil
1791 "Specify a function to print the region on a PostScript printer.
1792 See definition of `call-process-region' for calling conventions. The fourth
1793 and the sixth arguments are both nil."
1794 :type '(choice (const nil) function)
1795 :version "20"
1796 :group 'ps-print-printer)
1797
1798 (defcustom ps-manual-feed nil
1799 "Non-nil means the printer will manually feed paper.
1800
1801 If it's nil, automatic feeding takes place."
1802 :type 'boolean
1803 :version "20"
1804 :group 'ps-print-printer)
1805
1806 (defcustom ps-end-with-control-d (and ps-windows-system t)
1807 "Non-nil means insert C-d at end of PostScript file generated."
1808 :version "21.1"
1809 :type 'boolean
1810 :version "20"
1811 :group 'ps-print-printer)
1812
1813 ;;; Page layout
1814
1815 ;; All page dimensions are in PostScript points.
1816 ;; 1 inch == 2.54 cm == 72 points
1817 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1818
1819 ;; Letter 8.5 inch x 11.0 inch
1820 ;; Legal 8.5 inch x 14.0 inch
1821 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1822
1823 ;; LetterSmall 7.68 inch x 10.16 inch
1824 ;; Tabloid 11.0 inch x 17.0 inch
1825 ;; Ledger 17.0 inch x 11.0 inch
1826 ;; Statement 5.5 inch x 8.5 inch
1827 ;; Executive 7.5 inch x 10.0 inch
1828 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1829 ;; A4Small 7.47 inch x 10.85 inch
1830 ;; B4 10.125 inch x 14.33 inch
1831 ;; B5 7.16 inch x 10.125 inch
1832
1833 ;;;###autoload
1834 (defcustom ps-page-dimensions-database
1835 (purecopy
1836 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1837 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1838 (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
1839 (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
1840 (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
1841 (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
1842 (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
1843 (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
1844 (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
1845 (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
1846 (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
1847 (list 'b5 (* 72 7.16) (* 72 10.125) "B5")
1848 ;; page sizes for label printer
1849 ;; NOTE: the page sizes below don't have n-up > 1.
1850 '(addresslarge 236.0 99.0 "AddressLarge")
1851 '(addresssmall 236.0 68.0 "AddressSmall")
1852 '(cuthanging13 90.0 222.0 "CutHanging13")
1853 '(cuthanging15 90.0 114.0 "CutHanging15")
1854 '(diskette 181.0 136.0 "Diskette")
1855 '(eurofilefolder 139.0 112.0 "EuropeanFilefolder")
1856 '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow")
1857 '(eurofolderwide 526.0 136.0 "EuroFolderWide")
1858 '(euronamebadge 189.0 108.0 "EuroNameBadge")
1859 '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge")
1860 '(filefolder 230.0 37.0 "FileFolder")
1861 '(jewelry 76.0 136.0 "Jewelry")
1862 '(mediabadge 180.0 136.0 "MediaBadge")
1863 '(multipurpose 126.0 68.0 "MultiPurpose")
1864 '(retaillabel 90.0 104.0 "RetailLabel")
1865 '(shipping 271.0 136.0 "Shipping")
1866 '(slide35mm 26.0 104.0 "Slide35mm")
1867 '(spine8mm 187.0 26.0 "Spine8mm")
1868 '(topcoated 425.19685 136.0 "TopCoatedPaper")
1869 '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150")
1870 '(vhsface 205.0 127.0 "VHSFace")
1871 '(vhsspine 400.0 50.0 "VHSSpine")
1872 '(zipdisk 156.0 136.0 "ZipDisk")))
1873 "List associating a symbolic paper type to its width, height and doc media.
1874 See `ps-paper-type'."
1875 :type '(repeat (list :tag "Paper Type"
1876 (symbol :tag "Symbol Name")
1877 (number :tag "Width in points")
1878 (number :tag "Height in points")
1879 (string :tag "Media")))
1880 :version "20"
1881 :group 'ps-print-page)
1882
1883 ;;;###autoload
1884 (defcustom ps-paper-type 'letter
1885 "Specify the size of paper to format for.
1886 Should be one of the paper types defined in `ps-page-dimensions-database', for
1887 example `letter', `legal' or `a4'."
1888 :type '(symbol :validate (lambda (wid)
1889 (if (assq (widget-value wid)
1890 ps-page-dimensions-database)
1891 nil
1892 (widget-put wid :error "Unknown paper size")
1893 wid)))
1894 :version "20"
1895 :group 'ps-print-page)
1896
1897 (defcustom ps-warn-paper-type t
1898 "Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1899
1900 It's used when `ps-spool-config' is set to `setpagedevice'."
1901 :type 'boolean
1902 :version "20"
1903 :group 'ps-print-page)
1904
1905 (defcustom ps-landscape-mode nil
1906 "Non-nil means print in landscape mode."
1907 :type 'boolean
1908 :version "20"
1909 :group 'ps-print-page)
1910
1911 (defcustom ps-print-upside-down nil
1912 "Non-nil means print upside-down (that is, rotated by 180 degrees)."
1913 :type 'boolean
1914 :version "21.1"
1915 :group 'ps-print-page)
1916
1917 (defcustom ps-selected-pages nil
1918 "Specify which pages to print.
1919
1920 If nil, print all pages.
1921
1922 If a list, the lists element may be an integer or a cons cell (FROM . TO)
1923 designating FROM page to TO page; any invalid element is ignored, that is, an
1924 integer lesser than one or if FROM is greater than TO.
1925
1926 Otherwise, it's treated as nil.
1927
1928 After ps-print processing `ps-selected-pages' is set to nil. But the
1929 latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
1930 see). So you can restore the latest selected pages by using
1931 `ps-last-selected-pages' or with the `ps-restore-selected-pages'
1932 command (which see).
1933
1934 See also `ps-even-or-odd-pages'."
1935 :type '(repeat :tag "Selected Pages"
1936 (radio :tag "Page"
1937 (integer :tag "Number")
1938 (cons :tag "Range"
1939 (integer :tag "From")
1940 (integer :tag "To"))))
1941 :version "20"
1942 :group 'ps-print-page)
1943
1944 (defcustom ps-even-or-odd-pages nil
1945 "Specify if it prints even/odd pages.
1946
1947 Valid values are:
1948
1949 nil print all pages.
1950
1951 `even-page' print only even pages.
1952
1953 `odd-page' print only odd pages.
1954
1955 `even-sheet' print only even sheets.
1956 That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
1957 but for values greater than 1, it'll print only the even sheet
1958 of paper.
1959
1960 `odd-sheet' print only odd sheets.
1961 That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
1962 but for values greater than 1, it'll print only the odd sheet
1963 of paper.
1964
1965 Any other value is treated as nil.
1966
1967 If you set `ps-selected-pages' (see it for documentation), first the pages are
1968 filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1969 example, if we have:
1970
1971 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
1972
1973 Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
1974
1975 `ps-n-up-printing' = 1:
1976 `ps-even-or-odd-pages' PAGES PRINTED
1977 nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
1978 even-page 4, 6, 8, 10, 12, 14, 16, 20
1979 odd-page 1, 7, 9, 13, 15
1980 even-sheet 4, 6, 8, 10, 12, 14, 16, 20
1981 odd-sheet 1, 7, 9, 13, 15
1982
1983 `ps-n-up-printing' = 2:
1984 `ps-even-or-odd-pages' PAGES PRINTED
1985 nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
1986 even-page 4/6, 8/10, 12/14, 16/20
1987 odd-page 1/7, 9/13, 15
1988 even-sheet 6/7, 10/12, 15/16
1989 odd-sheet 1/4, 8/9, 13/14, 20
1990
1991 So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1992 sheet parity."
1993 :type '(choice :menu-tag "Print Even/Odd Pages"
1994 :tag "Print Even/Odd Pages"
1995 (const :tag "All Pages" nil)
1996 (const :tag "Only Even Pages" even-page)
1997 (const :tag "Only Odd Pages" odd-page)
1998 (const :tag "Only Even Sheets" even-sheet)
1999 (const :tag "Only Odd Sheets" odd-sheet))
2000 :version "20"
2001 :group 'ps-print-page)
2002
2003 (defcustom ps-print-control-characters 'control-8-bit
2004 "Specify the printable form for control and 8-bit characters.
2005 That is, instead of sending, for example, a ^D (\\004) to printer,
2006 it is sent the string \"^D\".
2007
2008 Valid values are:
2009
2010 `8-bit' This is the value to use when you want an ASCII encoding of
2011 any control or non-ASCII character. Control characters are
2012 encoded as \"^D\", and non-ASCII characters have an
2013 octal encoding.
2014
2015 `control-8-bit' This is the value to use when you want an ASCII encoding of
2016 any control character, whether it is 7 or 8-bit.
2017 European 8-bits accented characters are printed according
2018 the current font.
2019
2020 `control' Only ASCII control characters have an ASCII encoding.
2021 European 8-bits accented characters are printed according
2022 the current font.
2023
2024 nil No ASCII encoding. Any character is printed according the
2025 current font.
2026
2027 Any other value is treated as nil."
2028 :type '(choice :menu-tag "Control Char"
2029 :tag "Control Char"
2030 (const 8-bit) (const control-8-bit)
2031 (const control) (const :tag "nil" nil))
2032 :version "20"
2033 :group 'ps-print-miscellany)
2034
2035 (defcustom ps-n-up-printing 1
2036 "Specify the number of pages per sheet paper."
2037 :type '(integer
2038 :tag "N Up Printing"
2039 :validate
2040 (lambda (wid)
2041 (if (and (< 0 (widget-value wid))
2042 (<= (widget-value wid) 100))
2043 nil
2044 (widget-put
2045 wid :error
2046 "Number of pages per sheet paper must be between 1 and 100.")
2047 wid)))
2048 :version "20"
2049 :group 'ps-print-n-up)
2050
2051 (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
2052 "Specify the margin in points between the sheet border and n-up printing."
2053 :type 'number
2054 :version "20"
2055 :group 'ps-print-n-up)
2056
2057 (defcustom ps-n-up-border-p t
2058 "Non-nil means a border is drawn around each page."
2059 :type 'boolean
2060 :version "20"
2061 :group 'ps-print-n-up)
2062
2063 (defcustom ps-n-up-filling 'left-top
2064 "Specify how page matrix is filled on each sheet of paper.
2065
2066 Following are the valid values for `ps-n-up-filling' with a filling example
2067 using a 3x4 page matrix:
2068
2069 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
2070 5 6 7 8 5 6 7 8
2071 9 10 11 12 1 2 3 4
2072
2073 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
2074 8 7 6 5 8 7 6 5
2075 12 11 10 9 4 3 2 1
2076
2077 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
2078 2 5 8 11 2 5 8 11
2079 3 6 9 12 1 4 7 10
2080
2081 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
2082 11 8 5 2 11 8 5 2
2083 12 9 6 3 10 7 4 1
2084
2085 Any other value is treated as `left-top'."
2086 :type '(choice :menu-tag "N-Up Filling"
2087 :tag "N-Up Filling"
2088 (const left-top) (const left-bottom)
2089 (const right-top) (const right-bottom)
2090 (const top-left) (const bottom-left)
2091 (const top-right) (const bottom-right))
2092 :version "20"
2093 :group 'ps-print-n-up)
2094
2095 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
2096 "Specify the number of columns."
2097 :type 'number
2098 :version "20"
2099 :group 'ps-print-miscellany)
2100
2101 (defcustom ps-zebra-stripes nil
2102 "Non-nil means print zebra stripes.
2103 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
2104 :type 'boolean
2105 :version "20"
2106 :group 'ps-print-zebra)
2107
2108 (defcustom ps-zebra-stripe-height 3
2109 "Number of zebra stripe lines.
2110 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
2111 :type 'number
2112 :version "20"
2113 :group 'ps-print-zebra)
2114
2115 (defcustom ps-zebra-color 0.95
2116 "Zebra stripe gray scale or RGB color.
2117 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
2118 :type '(choice :menu-tag "Zebra Gray/Color"
2119 :tag "Zebra Gray/Color"
2120 (number :tag "Gray Scale" :value 0.95)
2121 (string :tag "Color Name" :value "gray95")
2122 (list :tag "RGB Color" :value (0.95 0.95 0.95)
2123 (number :tag "Red")
2124 (number :tag "Green")
2125 (number :tag "Blue")))
2126 :version "20"
2127 :group 'ps-print-zebra)
2128
2129 (defcustom ps-zebra-stripe-follow nil
2130 "Specify how zebra stripes continue on next page.
2131
2132 Visually, valid values are (the character `+' at right of each column indicates
2133 that a line is printed):
2134
2135 `nil' `follow' `full' `full-follow'
2136 Current Page -------- ----------- --------- ----------------
2137 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
2138 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
2139 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
2140 4 + 4 + 4 + 4 +
2141 5 + 5 + 5 + 5 +
2142 6 + 6 + 6 + 6 +
2143 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
2144 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
2145 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
2146 10 + 10 +
2147 11 + 11 +
2148 -------- ----------- --------- ----------------
2149 Next Page -------- ----------- --------- ----------------
2150 12 XXXXX + 12 + 10 XXXXXX + 10 +
2151 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
2152 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
2153 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
2154 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
2155 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
2156 18 XXXXX + 18 + 16 XXXXXX + 16 +
2157 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
2158 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
2159 21 + 21 XXXXXXXX +
2160 22 + 22 +
2161 -------- ----------- --------- ----------------
2162
2163 Any other value is treated as nil."
2164 :type '(choice :menu-tag "Zebra Stripe Follow"
2165 :tag "Zebra Stripe Follow"
2166 (const :tag "Always Restart" nil)
2167 (const :tag "Continue on Next Page" follow)
2168 (const :tag "Print Only Full Stripe" full)
2169 (const :tag "Continue on Full Stripe" full-follow))
2170 :version "20"
2171 :group 'ps-print-zebra)
2172
2173 (defcustom ps-line-number nil
2174 "Non-nil means print line number."
2175 :type 'boolean
2176 :version "20"
2177 :group 'ps-print-miscellany)
2178
2179 (defcustom ps-line-number-step 1
2180 "Specify the interval that line number is printed.
2181
2182 For example, `ps-line-number-step' is set to 2, the printing will look like:
2183
2184 1 one line
2185 one line
2186 3 one line
2187 one line
2188 5 one line
2189 one line
2190 ...
2191
2192 Valid values are:
2193
2194 integer an integer that specifies the interval that line number is
2195 printed. If it's lesser than or equal to zero, it's used the
2196 value 1.
2197
2198 `zebra' specifies that only the line number of the first line in a
2199 zebra stripe is to be printed.
2200
2201 Any other value is treated as `zebra'."
2202 :type '(choice :menu-tag "Line Number Step"
2203 :tag "Line Number Step"
2204 (integer :tag "Step Interval")
2205 (const :tag "Synchronize Zebra" zebra))
2206 :version "20"
2207 :group 'ps-print-miscellany)
2208
2209 (defcustom ps-line-number-start 1
2210 "Specify the starting point in the interval given by `ps-line-number-step'.
2211
2212 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2213 set to 3, the printing will look like:
2214
2215 one line
2216 one line
2217 3 one line
2218 one line
2219 one line
2220 6 one line
2221 one line
2222 one line
2223 9 one line
2224 one line
2225 ...
2226
2227 The values for `ps-line-number-start':
2228
2229 * If `ps-line-number-step' is an integer, must be between 1 and the value of
2230 `ps-line-number-step' inclusive.
2231
2232 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
2233 value of `ps-zebra-strip-height' inclusive. Use this combination if you
2234 wish that line number be relative to zebra stripes."
2235 :type '(integer :tag "Start Step Interval")
2236 :version "20"
2237 :group 'ps-print-miscellany)
2238
2239 (defcustom ps-print-background-image nil
2240 "EPS image list to be printed on background.
2241
2242 The elements are:
2243
2244 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2245
2246 FILENAME is a file name which contains an EPS image or some PostScript
2247 programming like EPS.
2248 FILENAME is ignored, if it doesn't exist or is read protected.
2249
2250 X and Y are relative positions on paper to put the image.
2251 If X and Y are nil, the image is centered on paper.
2252
2253 XSCALE and YSCALE are scale factor to be applied to image before printing.
2254 If XSCALE and YSCALE are nil, the original size is used.
2255
2256 ROTATION is the image rotation angle; if nil, the default is 0.
2257
2258 PAGES designates the page to print background image.
2259 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2260 page.
2261 If PAGES is nil, print background image on all pages.
2262
2263 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2264 number or a string. If it is a string, the string should contain PostScript
2265 programming that returns a float or integer value.
2266
2267 For example, if you wish to print an EPS image on all pages do:
2268
2269 '((\"~/images/EPS-image.ps\"))"
2270 :type '(repeat
2271 (list
2272 (file :tag "EPS File")
2273 (choice :tag "X" (const :tag "default" nil) number string)
2274 (choice :tag "Y" (const :tag "default" nil) number string)
2275 (choice :tag "X Scale" (const :tag "default" nil) number string)
2276 (choice :tag "Y Scale" (const :tag "default" nil) number string)
2277 (choice :tag "Rotation" (const :tag "default" nil) number string)
2278 (repeat :tag "Pages" :inline t
2279 (radio (integer :tag "Page")
2280 (cons :tag "Range"
2281 (integer :tag "From")
2282 (integer :tag "To"))))))
2283 :version "20"
2284 :group 'ps-print-background)
2285
2286 (defcustom ps-print-background-text nil
2287 "Text list to be printed on background.
2288
2289 The elements are:
2290
2291 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2292
2293 STRING is the text to be printed on background.
2294
2295 X and Y are positions on paper to put the text.
2296 If X and Y are nil, the text is positioned at lower left corner.
2297
2298 FONT is a font name to be used on printing the text.
2299 If nil, \"Times-Roman\" is used.
2300
2301 FONTSIZE is font size to be used, if nil, 200 is used.
2302
2303 GRAY is the text gray factor (should be very light like 0.8).
2304 If nil, the default is 0.85.
2305
2306 ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
2307 from lower left corner to upper right corner.
2308
2309 PAGES designates the page to print background text.
2310 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2311 page.
2312 If PAGES is nil, print background text on all pages.
2313
2314 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2315 number or a string. If it is a string, the string should contain PostScript
2316 programming that returns a float or integer value.
2317
2318 For example, if you wish to print text \"Preliminary\" on all pages do:
2319
2320 '((\"Preliminary\"))"
2321 :type '(repeat
2322 (list
2323 (string :tag "Text")
2324 (choice :tag "X" (const :tag "default" nil) number string)
2325 (choice :tag "Y" (const :tag "default" nil) number string)
2326 (choice :tag "Font" (const :tag "default" nil) string)
2327 (choice :tag "Fontsize" (const :tag "default" nil) number string)
2328 (choice :tag "Gray" (const :tag "default" nil) number string)
2329 (choice :tag "Rotation" (const :tag "default" nil) number string)
2330 (repeat :tag "Pages" :inline t
2331 (radio (integer :tag "Page")
2332 (cons :tag "Range"
2333 (integer :tag "From")
2334 (integer :tag "To"))))))
2335 :version "20"
2336 :group 'ps-print-background)
2337
2338 ;;; Horizontal layout
2339
2340 ;; ------------------------------------------
2341 ;; | | | | | | | |
2342 ;; | lm | text | ic | text | ic | text | rm |
2343 ;; | | | | | | | |
2344 ;; ------------------------------------------
2345
2346 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
2347 "Left margin in points (1/72 inch)."
2348 :type 'number
2349 :version "20"
2350 :group 'ps-print-horizontal)
2351
2352 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
2353 "Right margin in points (1/72 inch)."
2354 :type 'number
2355 :version "20"
2356 :group 'ps-print-horizontal)
2357
2358 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
2359 "Horizontal space between columns in points (1/72 inch)."
2360 :type 'number
2361 :version "20"
2362 :group 'ps-print-horizontal)
2363
2364 ;;; Vertical layout
2365
2366 ;; |--------|
2367 ;; | tm |
2368 ;; |--------|
2369 ;; | header |
2370 ;; |--------|
2371 ;; | ho |
2372 ;; |--------|
2373 ;; | text |
2374 ;; |--------|
2375 ;; | bm |
2376 ;; |--------|
2377
2378 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2379 "Bottom margin in points (1/72 inch)."
2380 :type 'number
2381 :version "20"
2382 :group 'ps-print-vertical)
2383
2384 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2385 "Top margin in points (1/72 inch)."
2386 :type 'number
2387 :version "20"
2388 :group 'ps-print-vertical)
2389
2390 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2391 "Vertical space in points (1/72 inch) between the main text and the header."
2392 :type 'number
2393 :version "20"
2394 :group 'ps-print-vertical)
2395
2396 (defcustom ps-header-line-pad 0.15
2397 "Portion of a header title line height to insert.
2398 The insertion is done between the header frame and the text it contains,
2399 both in the vertical and horizontal directions."
2400 :type 'number
2401 :version "20"
2402 :group 'ps-print-vertical)
2403
2404 (defcustom ps-footer-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2405 "Vertical space in points (1/72 inch) between the main text and the footer."
2406 :type 'number
2407 :version "20"
2408 :group 'ps-print-vertical)
2409
2410 (defcustom ps-footer-line-pad 0.15
2411 "Portion of a footer title line height to insert.
2412 The insertion is done between the footer frame and the text it contains,
2413 both in the vertical and horizontal directions."
2414 :type 'number
2415 :version "20"
2416 :group 'ps-print-vertical)
2417
2418 ;;; Header/Footer setup
2419
2420 (defcustom ps-print-header t
2421 "Non-nil means print a header at the top of each page.
2422 By default, the header displays the buffer name, page number, and, if the
2423 buffer is visiting a file, the file's directory. Headers are customizable by
2424 changing variables `ps-left-header' and `ps-right-header'."
2425 :type 'boolean
2426 :version "20"
2427 :group 'ps-print-headers)
2428
2429 (defcustom ps-print-header-frame t
2430 "Non-nil means draw a gaudy frame around the header."
2431 :type 'boolean
2432 :version "20"
2433 :group 'ps-print-headers)
2434
2435 (defcustom ps-header-frame-alist
2436 '((fore-color . 0.0)
2437 (back-color . 0.9)
2438 (border-width . 0.4)
2439 (border-color . 0.0)
2440 (shadow-color . 0.0))
2441 "Specify header frame properties alist.
2442
2443 Valid frame properties are:
2444
2445 `fore-color' Specify the foreground frame color.
2446 It should be a float number between 0.0 (black color)
2447 and 1.0 (white color), a string which is a color name,
2448 or a list of 3 float numbers which corresponds to the
2449 Red Green Blue color scale, each float number between
2450 0.0 (dark color) and 1.0 (bright color).
2451
2452 `back-color' Specify the background frame color (similar to
2453 `fore-color').
2454
2455 `shadow-color' Specify the shadow color (similar to `fore-color').
2456
2457 `border-color' Specify the border color (similar to `fore-color').
2458
2459 `border-width' Specify the border width.
2460
2461 Any other property is ignored.
2462
2463 Don't change this alist directly, instead use customization, or `ps-value',
2464 `ps-get', `ps-put' and `ps-del' functions (see them for documentation)."
2465 :version "21.1"
2466 :type '(repeat
2467 (choice :menu-tag "Header Frame Element"
2468 :tag ""
2469 (cons :tag "Foreground Color" :format "%v"
2470 (const :format "" fore-color)
2471 (choice :menu-tag "Foreground Color"
2472 :tag "Foreground Color"
2473 (number :tag "Gray Scale" :value 0.0)
2474 (string :tag "Color Name" :value "black")
2475 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2476 (number :tag "Red")
2477 (number :tag "Green")
2478 (number :tag "Blue"))))
2479 (cons :tag "Background Color" :format "%v"
2480 (const :format "" back-color)
2481 (choice :menu-tag "Background Color"
2482 :tag "Background Color"
2483 (number :tag "Gray Scale" :value 0.9)
2484 (string :tag "Color Name" :value "gray90")
2485 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2486 (number :tag "Red")
2487 (number :tag "Green")
2488 (number :tag "Blue"))))
2489 (cons :tag "Border Width" :format "%v"
2490 (const :format "" border-width)
2491 (number :tag "Border Width" :value 0.4))
2492 (cons :tag "Border Color" :format "%v"
2493 (const :format "" border-color)
2494 (choice :menu-tag "Border Color"
2495 :tag "Border Color"
2496 (number :tag "Gray Scale" :value 0.0)
2497 (string :tag "Color Name" :value "black")
2498 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2499 (number :tag "Red")
2500 (number :tag "Green")
2501 (number :tag "Blue"))))
2502 (cons :tag "Shadow Color" :format "%v"
2503 (const :format "" shadow-color)
2504 (choice :menu-tag "Shadow Color"
2505 :tag "Shadow Color"
2506 (number :tag "Gray Scale" :value 0.0)
2507 (string :tag "Color Name" :value "black")
2508 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2509 (number :tag "Red")
2510 (number :tag "Green")
2511 (number :tag "Blue"))))))
2512 :version "20"
2513 :group 'ps-print-headers)
2514
2515 (defcustom ps-header-lines 2
2516 "Number of lines to display in page header, when generating PostScript."
2517 :type 'integer
2518 :version "20"
2519 :group 'ps-print-headers)
2520
2521 (defcustom ps-print-footer nil
2522 "Non-nil means print a footer at the bottom of each page.
2523 By default, the footer displays page number.
2524 Footers are customizable by changing variables `ps-left-footer' and
2525 `ps-right-footer'."
2526 :type 'boolean
2527 :version "21.1"
2528 :group 'ps-print-headers)
2529
2530 (defcustom ps-print-footer-frame t
2531 "Non-nil means draw a gaudy frame around the footer."
2532 :type 'boolean
2533 :version "21.1"
2534 :group 'ps-print-headers)
2535
2536 (defcustom ps-footer-frame-alist
2537 '((fore-color . 0.0)
2538 (back-color . 0.9)
2539 (border-width . 0.4)
2540 (border-color . 0.0)
2541 (shadow-color . 0.0))
2542 "Specify footer frame properties alist.
2543
2544 Don't change this alist directly, instead use customization, or `ps-value',
2545 `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
2546
2547 See also `ps-header-frame-alist' for documentation."
2548 :type '(repeat
2549 (choice :menu-tag "Header Frame Element"
2550 :tag ""
2551 (cons :tag "Foreground Color" :format "%v"
2552 (const :format "" fore-color)
2553 (choice :menu-tag "Foreground Color"
2554 :tag "Foreground Color"
2555 (number :tag "Gray Scale" :value 0.0)
2556 (string :tag "Color Name" :value "black")
2557 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2558 (number :tag "Red")
2559 (number :tag "Green")
2560 (number :tag "Blue"))))
2561 (cons :tag "Background Color" :format "%v"
2562 (const :format "" back-color)
2563 (choice :menu-tag "Background Color"
2564 :tag "Background Color"
2565 (number :tag "Gray Scale" :value 0.9)
2566 (string :tag "Color Name" :value "gray90")
2567 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2568 (number :tag "Red")
2569 (number :tag "Green")
2570 (number :tag "Blue"))))
2571 (cons :tag "Border Width" :format "%v"
2572 (const :format "" border-width)
2573 (number :tag "Border Width" :value 0.4))
2574 (cons :tag "Border Color" :format "%v"
2575 (const :format "" border-color)
2576 (choice :menu-tag "Border Color"
2577 :tag "Border Color"
2578 (number :tag "Gray Scale" :value 0.0)
2579 (string :tag "Color Name" :value "black")
2580 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2581 (number :tag "Red")
2582 (number :tag "Green")
2583 (number :tag "Blue"))))
2584 (cons :tag "Shadow Color" :format "%v"
2585 (const :format "" shadow-color)
2586 (choice :menu-tag "Shadow Color"
2587 :tag "Shadow Color"
2588 (number :tag "Gray Scale" :value 0.0)
2589 (string :tag "Color Name" :value "black")
2590 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2591 (number :tag "Red")
2592 (number :tag "Green")
2593 (number :tag "Blue"))))))
2594 :version "21.1"
2595 :group 'ps-print-headers)
2596
2597 (defcustom ps-footer-lines 2
2598 "Number of lines to display in page footer, when generating PostScript."
2599 :type 'integer
2600 :version "21.1"
2601 :group 'ps-print-headers)
2602
2603 (defcustom ps-print-only-one-header nil
2604 "Non-nil means print only one header/footer at the top/bottom of each page.
2605 This is useful when printing more than one column, so it is possible to have
2606 only one header/footer over all columns or one header/footer per column.
2607 See also `ps-print-header' and `ps-print-footer'."
2608 :type 'boolean
2609 :version "20"
2610 :group 'ps-print-headers)
2611
2612 (defcustom ps-switch-header 'duplex
2613 "Specify if headers/footers are switched or not.
2614
2615 Valid values are:
2616
2617 nil Never switch headers/footers.
2618
2619 t Always switch headers/footers.
2620
2621 duplex Switch headers/footers only when duplexing is on, that is, when
2622 `ps-spool-duplex' is non-nil.
2623
2624 Any other value is treated as t.
2625
2626 See also `ps-print-header' and `ps-print-footer'."
2627 :type '(choice :menu-tag "Switch Header/Footer"
2628 :tag "Switch Header/Footer"
2629 (const :tag "Never Switch" nil)
2630 (const :tag "Always Switch" t)
2631 (const :tag "Switch When Duplexing" duplex))
2632 :version "20"
2633 :group 'ps-print-headers)
2634
2635 (defcustom ps-show-n-of-n t
2636 "Non-nil means show page numbers as N/M, meaning page N of M.
2637 NOTE: page numbers are displayed as part of headers,
2638 see variable `ps-print-header'."
2639 :type 'boolean
2640 :version "20"
2641 :group 'ps-print-headers)
2642
2643 (defcustom ps-spool-config
2644 (if ps-windows-system
2645 nil
2646 'lpr-switches)
2647 "Specify who is responsible for setting duplex and page size.
2648
2649 Valid values are:
2650
2651 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2652 Don't forget to set `ps-lpr-switches' to select duplex
2653 printing for your printer.
2654
2655 `setpagedevice' duplex and page size are configured by ps-print using the
2656 setpagedevice PostScript operator.
2657
2658 nil duplex and page size are configured by ps-print *not* using
2659 the setpagedevice PostScript operator.
2660
2661 Any other value is treated as nil.
2662
2663 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2664 viewing file generated using landscape. Also on some printers,
2665 setpagedevice affects zebra stripes; on other printers, setpagedevice
2666 affects the left margin.
2667 Besides all that, if your printer does not have the paper size
2668 specified by setpagedevice, your printing will be aborted.
2669 So, if you need to use setpagedevice, set `ps-spool-config' to
2670 `setpagedevice', generate a test file and send it to your printer; if
2671 the printed file isn't OK, set `ps-spool-config' to nil."
2672 :type '(choice :menu-tag "Spool Config"
2673 :tag "Spool Config"
2674 (const lpr-switches) (const setpagedevice)
2675 (const :tag "nil" nil))
2676 :version "20"
2677 :group 'ps-print-headers)
2678
2679 (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
2680 ; so default to nil.
2681 "Non-nil generates PostScript for a two-sided printer.
2682 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2683 blank pages as needed between print jobs so that the next buffer printed will
2684 start on the right page. Also, if headers are turned on, the headers will be
2685 reversed on duplex printers so that the page numbers fall to the left on
2686 even-numbered pages.
2687
2688 See also `ps-spool-tumble'."
2689 :type 'boolean
2690 :version "20"
2691 :group 'ps-print-headers)
2692
2693 (defcustom ps-spool-tumble nil
2694 "Specify how the page images on opposite sides of a sheet are oriented.
2695 If `ps-spool-tumble' is nil, produces output suitable for binding on the left
2696 or right. If `ps-spool-tumble' is non-nil, produces output suitable for
2697 binding at the top or bottom.
2698
2699 It has effect only when `ps-spool-duplex' is non-nil."
2700 :type 'boolean
2701 :version "20"
2702 :group 'ps-print-headers)
2703
2704 ;;; Fonts
2705
2706 (defcustom ps-font-info-database
2707 '((Courier ; the family key
2708 (fonts (normal . "Courier")
2709 (bold . "Courier-Bold")
2710 (italic . "Courier-Oblique")
2711 (bold-italic . "Courier-BoldOblique"))
2712 (size . 10.0)
2713 (line-height . 10.55)
2714 (space-width . 6.0)
2715 (avg-char-width . 6.0))
2716 (Helvetica ; the family key
2717 (fonts (normal . "Helvetica")
2718 (bold . "Helvetica-Bold")
2719 (italic . "Helvetica-Oblique")
2720 (bold-italic . "Helvetica-BoldOblique"))
2721 (size . 10.0)
2722 (line-height . 11.56)
2723 (space-width . 2.78)
2724 (avg-char-width . 5.09243))
2725 (Times
2726 (fonts (normal . "Times-Roman")
2727 (bold . "Times-Bold")
2728 (italic . "Times-Italic")
2729 (bold-italic . "Times-BoldItalic"))
2730 (size . 10.0)
2731 (line-height . 11.0)
2732 (space-width . 2.5)
2733 (avg-char-width . 4.71432))
2734 (Palatino
2735 (fonts (normal . "Palatino-Roman")
2736 (bold . "Palatino-Bold")
2737 (italic . "Palatino-Italic")
2738 (bold-italic . "Palatino-BoldItalic"))
2739 (size . 10.0)
2740 (line-height . 12.1)
2741 (space-width . 2.5)
2742 (avg-char-width . 5.08676))
2743 (Helvetica-Narrow
2744 (fonts (normal . "Helvetica-Narrow")
2745 (bold . "Helvetica-Narrow-Bold")
2746 (italic . "Helvetica-Narrow-Oblique")
2747 (bold-italic . "Helvetica-Narrow-BoldOblique"))
2748 (size . 10.0)
2749 (line-height . 11.56)
2750 (space-width . 2.2796)
2751 (avg-char-width . 4.17579))
2752 (NewCenturySchlbk
2753 (fonts (normal . "NewCenturySchlbk-Roman")
2754 (bold . "NewCenturySchlbk-Bold")
2755 (italic . "NewCenturySchlbk-Italic")
2756 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2757 (size . 10.0)
2758 (line-height . 12.15)
2759 (space-width . 2.78)
2760 (avg-char-width . 5.31162))
2761 ;; got no bold for the next ones
2762 (AvantGarde-Book
2763 (fonts (normal . "AvantGarde-Book")
2764 (italic . "AvantGarde-BookOblique"))
2765 (size . 10.0)
2766 (line-height . 11.77)
2767 (space-width . 2.77)
2768 (avg-char-width . 5.45189))
2769 (AvantGarde-Demi
2770 (fonts (normal . "AvantGarde-Demi")
2771 (italic . "AvantGarde-DemiOblique"))
2772 (size . 10.0)
2773 (line-height . 12.72)
2774 (space-width . 2.8)
2775 (avg-char-width . 5.51351))
2776 (Bookman-Demi
2777 (fonts (normal . "Bookman-Demi")
2778 (italic . "Bookman-DemiItalic"))
2779 (size . 10.0)
2780 (line-height . 11.77)
2781 (space-width . 3.4)
2782 (avg-char-width . 6.05946))
2783 (Bookman-Light
2784 (fonts (normal . "Bookman-Light")
2785 (italic . "Bookman-LightItalic"))
2786 (size . 10.0)
2787 (line-height . 11.79)
2788 (space-width . 3.2)
2789 (avg-char-width . 5.67027))
2790 ;; got no bold and no italic for the next ones
2791 (Symbol
2792 (fonts (normal . "Symbol"))
2793 (size . 10.0)
2794 (line-height . 13.03)
2795 (space-width . 2.5)
2796 (avg-char-width . 3.24324))
2797 (Zapf-Dingbats
2798 (fonts (normal . "Zapf-Dingbats"))
2799 (size . 10.0)
2800 (line-height . 9.63)
2801 (space-width . 2.78)
2802 (avg-char-width . 2.78))
2803 (ZapfChancery-MediumItalic
2804 (fonts (normal . "ZapfChancery-MediumItalic"))
2805 (size . 10.0)
2806 (line-height . 11.45)
2807 (space-width . 2.2)
2808 (avg-char-width . 4.10811))
2809 ;; We keep this wrong entry name (but with correct font name) for
2810 ;; backward compatibility.
2811 (Zapf-Chancery-MediumItalic
2812 (fonts (normal . "ZapfChancery-MediumItalic"))
2813 (size . 10.0)
2814 (line-height . 11.45)
2815 (space-width . 2.2)
2816 (avg-char-width . 4.10811))
2817 )
2818 "Font info database.
2819 Each element comprises: font family (the key), name, bold, italic, bold-italic,
2820 reference size, line height, space width, average character width.
2821 To get the info for another specific font (say Helvetica), do the following:
2822 - create a new buffer
2823 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2824 - open this file and delete the leading `%' (which is the PostScript comment
2825 character) from the line
2826 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2827 to get the line
2828 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2829 - add the values to `ps-font-info-database'.
2830 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2831
2832 Note also that ps-print DOESN'T download any font to your printer, instead it
2833 uses the fonts resident in your printer."
2834 :type '(repeat
2835 (list :tag "Font Definition"
2836 (symbol :tag "Font Family")
2837 (cons :format "%v"
2838 (const :format "" fonts)
2839 (repeat :tag "Faces"
2840 (cons (choice :menu-tag "Font Weight/Slant"
2841 :tag "Font Weight/Slant"
2842 (const normal)
2843 (const bold)
2844 (const italic)
2845 (const bold-italic)
2846 (symbol :tag "Face"))
2847 (string :tag "Font Name"))))
2848 (cons :format "%v"
2849 (const :format "" size)
2850 (number :tag "Reference Size"))
2851 (cons :format "%v"
2852 (const :format "" line-height)
2853 (number :tag "Line Height"))
2854 (cons :format "%v"
2855 (const :format "" space-width)
2856 (number :tag "Space Width"))
2857 (cons :format "%v"
2858 (const :format "" avg-char-width)
2859 (number :tag "Average Character Width"))))
2860 :version "20"
2861 :group 'ps-print-font)
2862
2863 (defcustom ps-font-family 'Courier
2864 "Font family name for ordinary text, when generating PostScript."
2865 :type 'symbol
2866 :version "20"
2867 :group 'ps-print-font)
2868
2869 (defcustom ps-font-size '(7 . 8.5)
2870 "Font size, in points, for ordinary text, when generating PostScript.
2871 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2872 :type '(choice :menu-tag "Ordinary Text Font Size"
2873 :tag "Ordinary Text Font Size"
2874 (number :tag "Text Size")
2875 (cons :tag "Landscape/Portrait"
2876 (number :tag "Landscape Text Size")
2877 (number :tag "Portrait Text Size")))
2878 :version "20"
2879 :group 'ps-print-font)
2880
2881 (defcustom ps-header-font-family 'Helvetica
2882 "Font family name for text in the header, when generating PostScript."
2883 :type 'symbol
2884 :version "20"
2885 :group 'ps-print-font)
2886
2887 (defcustom ps-header-font-size '(10 . 12)
2888 "Font size, in points, for text in the header, when generating PostScript.
2889 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2890 :type '(choice :menu-tag "Header Font Size"
2891 :tag "Header Font Size"
2892 (number :tag "Header Size")
2893 (cons :tag "Landscape/Portrait"
2894 (number :tag "Landscape Header Size")
2895 (number :tag "Portrait Header Size")))
2896 :version "20"
2897 :group 'ps-print-font)
2898
2899 (defcustom ps-header-title-font-size '(12 . 14)
2900 "Font size, in points, for the top line of text in header, in PostScript.
2901 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2902 :type '(choice :menu-tag "Header Title Font Size"
2903 :tag "Header Title Font Size"
2904 (number :tag "Header Title Size")
2905 (cons :tag "Landscape/Portrait"
2906 (number :tag "Landscape Header Title Size")
2907 (number :tag "Portrait Header Title Size")))
2908 :version "20"
2909 :group 'ps-print-font)
2910
2911 (defcustom ps-footer-font-family 'Helvetica
2912 "Font family name for text in the footer, when generating PostScript."
2913 :type 'symbol
2914 :version "21.1"
2915 :group 'ps-print-font)
2916
2917 (defcustom ps-footer-font-size '(10 . 12)
2918 "Font size, in points, for text in the footer, when generating PostScript.
2919 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2920 :type '(choice :menu-tag "Footer Font Size"
2921 :tag "Footer Font Size"
2922 (number :tag "Footer Size")
2923 (cons :tag "Landscape/Portrait"
2924 (number :tag "Landscape Footer Size")
2925 (number :tag "Portrait Footer Size")))
2926 :version "21.1"
2927 :group 'ps-print-font)
2928
2929 (defcustom ps-line-number-color "black"
2930 "Specify color for line-number, when generating PostScript."
2931 :type '(choice :menu-tag "Line Number Color"
2932 :tag "Line Number Color"
2933 (number :tag "Gray Scale" :value 0)
2934 (string :tag "Color Name" :value "black")
2935 (list :tag "RGB Color" :value (0 0 0)
2936 (number :tag "Red")
2937 (number :tag "Green")
2938 (number :tag "Blue")))
2939 :version "21.1"
2940 :group 'ps-print-font
2941 :group 'ps-print-miscellany)
2942
2943 (defcustom ps-line-number-font "Times-Italic"
2944 "Font for line-number, when generating PostScript."
2945 :type 'string
2946 :version "20"
2947 :group 'ps-print-font
2948 :group 'ps-print-miscellany)
2949
2950 (defcustom ps-line-number-font-size 6
2951 "Font size, in points, for line number, when generating PostScript.
2952 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2953 :type '(choice :menu-tag "Line Number Font Size"
2954 :tag "Line Number Font Size"
2955 (number :tag "Font Size")
2956 (cons :tag "Landscape/Portrait"
2957 (number :tag "Landscape Font Size")
2958 (number :tag "Portrait Font Size")))
2959 :version "20"
2960 :group 'ps-print-font
2961 :group 'ps-print-miscellany)
2962
2963 ;;; Colors
2964
2965 ;; Printing color requires x-color-values.
2966 ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
2967 ;; widget to work.
2968 ;;;###autoload
2969 (defcustom ps-print-color-p
2970 (or (fboundp 'x-color-values) ; Emacs
2971 (fboundp 'color-instance-rgb-components))
2972 ; XEmacs
2973 "Specify how buffer's text color is printed.
2974
2975 Valid values are:
2976
2977 nil Do not print colors.
2978
2979 t Print colors.
2980
2981 black-white Print colors on black/white printer.
2982 See also `ps-black-white-faces'.
2983
2984 Any other value is treated as t."
2985 :type '(choice :menu-tag "Print Color"
2986 :tag "Print Color"
2987 (const :tag "Do NOT Print Color" nil)
2988 (const :tag "Print Always Color" t)
2989 (const :tag "Print Black/White Color" black-white))
2990 :version "20"
2991 :group 'ps-print-color)
2992
2993 (defcustom ps-default-fg nil
2994 "RGB values of the default foreground color.
2995
2996 The `ps-default-fg' variable contains the default foreground color used by
2997 ps-print, that is, if there is a face in a text that doesn't have a foreground
2998 color, the `ps-default-fg' color should be used.
2999
3000 Valid values are:
3001
3002 t The foreground color of Emacs session will be used.
3003
3004 frame-parameter The foreground-color frame parameter will be used.
3005
3006 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3007 indicate the gray color.
3008
3009 COLOR-NAME It's a string which contains the color name. For example:
3010 \"yellow\".
3011
3012 LIST It's a list of RGB values, that is a list of three real values
3013 of the form:
3014
3015 (RED GREEN BLUE)
3016
3017 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3018 1.0 (full color).
3019
3020 Any other value is ignored and black color will be used.
3021
3022 This variable is used only when `ps-print-color-p' (which see) is neither nil
3023 nor black-white."
3024 :type '(choice :menu-tag "Default Foreground Gray/Color"
3025 :tag "Default Foreground Gray/Color"
3026 (const :tag "Session Foreground" t)
3027 (const :tag "Frame Foreground" frame-parameter)
3028 (number :tag "Gray Scale" :value 0.0)
3029 (string :tag "Color Name" :value "black")
3030 (list :tag "RGB Color" :value (0.0 0.0 0.0)
3031 (number :tag "Red")
3032 (number :tag "Green")
3033 (number :tag "Blue")))
3034 :version "20"
3035 :group 'ps-print-color)
3036
3037 (defcustom ps-default-bg nil
3038 "RGB values of the default background color.
3039
3040 The `ps-default-bg' variable contains the default background color used by
3041 ps-print, that is, if there is a face in a text that doesn't have a background
3042 color, the `ps-default-bg' color should be used.
3043
3044 Valid values are:
3045
3046 t The background color of Emacs session will be used.
3047
3048 frame-parameter The background-color frame parameter will be used.
3049
3050 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3051 indicate the gray color.
3052
3053 COLOR-NAME It's a string which contains the color name. For example:
3054 \"yellow\".
3055
3056 LIST It's a list of RGB values, that is a list of three real values
3057 of the form:
3058
3059 (RED GREEN BLUE)
3060
3061 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3062 1.0 (full color).
3063
3064 Any other value is ignored and white color will be used.
3065
3066 This variable is used only when `ps-print-color-p' (which see) is neither nil
3067 nor black-white.
3068
3069 See also `ps-use-face-background'."
3070 :type '(choice :menu-tag "Default Background Gray/Color"
3071 :tag "Default Background Gray/Color"
3072 (const :tag "Session Background" t)
3073 (const :tag "Frame Background" frame-parameter)
3074 (number :tag "Gray Scale" :value 1.0)
3075 (string :tag "Color Name" :value "white")
3076 (list :tag "RGB Color" :value (1.0 1.0 1.0)
3077 (number :tag "Red")
3078 (number :tag "Green")
3079 (number :tag "Blue")))
3080 :version "20"
3081 :group 'ps-print-color)
3082
3083 (defcustom ps-fg-list nil
3084 "Specify foreground color list.
3085
3086 This list is used to chose a text foreground color which is different than the
3087 background color. It'll be used the first foreground color in `ps-fg-list'
3088 which is different from the background color.
3089
3090 If this list is nil, the default foreground color is used. See
3091 `ps-default-fg'.
3092
3093 The list element valid values are:
3094
3095 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3096 indicate the gray color.
3097
3098 COLOR-NAME It's a string which contains the color name. For example:
3099 \"yellow\".
3100
3101 LIST It's a list of RGB values, that is a list of three real values
3102 of the form:
3103
3104 (RED GREEN BLUE)
3105
3106 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3107 1.0 (full color).
3108
3109 Any other value is ignored and black color will be used.
3110
3111 This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
3112 when `ps-print-color-p' (which see) is neither nil nor black-white."
3113 :type '(repeat
3114 (choice :menu-tag "Foreground Gray/Color"
3115 :tag "Foreground Gray/Color"
3116 (number :tag "Gray Scale" :value 0.0)
3117 (string :tag "Color Name" :value "black")
3118 (list :tag "RGB Color" :value (0.0 0.0 0.0)
3119 (number :tag "Red")
3120 (number :tag "Green")
3121 (number :tag "Blue"))))
3122 :version "22"
3123 :group 'ps-print-color)
3124
3125 (defcustom ps-fg-validate-p t
3126 "Non-nil means validate if foreground color is different than background.
3127
3128 If text foreground and background colors are equals, no text will appear.
3129
3130 See also `ps-fg-list'."
3131 :type 'boolean
3132 :version "22"
3133 :group 'ps-print-color)
3134
3135 (defcustom ps-auto-font-detect t
3136 "Non-nil means automatically detect bold/italic/underline face attributes.
3137 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
3138 `ps-underlined-faces'."
3139 :type 'boolean
3140 :version "20"
3141 :group 'ps-print-font)
3142
3143 (defcustom ps-black-white-faces
3144 '((font-lock-builtin-face "black" nil bold )
3145 (font-lock-comment-face "gray20" nil italic)
3146 (font-lock-constant-face "black" nil bold )
3147 (font-lock-function-name-face "black" nil bold )
3148 (font-lock-keyword-face "black" nil bold )
3149 (font-lock-string-face "black" nil italic)
3150 (font-lock-type-face "black" nil italic)
3151 (font-lock-variable-name-face "black" nil bold italic)
3152 (font-lock-warning-face "black" nil bold italic))
3153 "Specify list of face attributes to print colors on black/white printers.
3154
3155 The list elements are the same as defined on `ps-extend-face' (which see).
3156
3157 This variable is used only when `ps-print-color-p' is set to `black-white'."
3158 :version "21.1"
3159 :type '(repeat
3160 (list :tag "Face Specification"
3161 (face :tag "Face Symbol")
3162 (choice :menu-tag "Foreground Color"
3163 :tag "Foreground Color"
3164 (const :tag "Black" nil)
3165 (string :tag "Color Name"))
3166 (choice :menu-tag "Background Color"
3167 :tag "Background Color"
3168 (const :tag "None" nil)
3169 (string :tag "Color Name"))
3170 (repeat :inline t
3171 (choice :menu-tag "Attribute"
3172 (const bold)
3173 (const italic)
3174 (const underline)
3175 (const strikeout)
3176 (const overline)
3177 (const shadow)
3178 (const box)
3179 (const outline)))))
3180 :version "20"
3181 :group 'ps-print-face)
3182
3183 (defcustom ps-bold-faces
3184 (unless ps-print-color-p
3185 '(font-lock-function-name-face
3186 font-lock-builtin-face
3187 font-lock-variable-name-face
3188 font-lock-keyword-face
3189 font-lock-warning-face))
3190 "A list of the \(non-bold\) faces that should be printed in bold font.
3191 This applies to generating PostScript."
3192 :type '(repeat face)
3193 :version "20"
3194 :group 'ps-print-face)
3195
3196 (defcustom ps-italic-faces
3197 (unless ps-print-color-p
3198 '(font-lock-variable-name-face
3199 font-lock-type-face
3200 font-lock-string-face
3201 font-lock-comment-face
3202 font-lock-warning-face))
3203 "A list of the \(non-italic\) faces that should be printed in italic font.
3204 This applies to generating PostScript."
3205 :type '(repeat face)
3206 :version "20"
3207 :group 'ps-print-face)
3208
3209 (defcustom ps-underlined-faces
3210 (unless ps-print-color-p
3211 '(font-lock-function-name-face
3212 font-lock-constant-face
3213 font-lock-warning-face))
3214 "A list of the \(non-underlined\) faces that should be printed underlined.
3215 This applies to generating PostScript."
3216 :type '(repeat face)
3217 :version "20"
3218 :group 'ps-print-face)
3219
3220 (defcustom ps-use-face-background nil
3221 "Specify if face background should be used.
3222
3223 Valid values are:
3224
3225 t always use face background color.
3226 nil never use face background color.
3227 (face...) list of faces whose background color will be used.
3228
3229 Any other value will be treated as t."
3230 :type '(choice :menu-tag "Use Face Background"
3231 :tag "Use Face Background"
3232 (const :tag "Always Use Face Background" t)
3233 (const :tag "Never Use Face Background" nil)
3234 (repeat :menu-tag "Face Background List"
3235 :tag "Face Background List"
3236 face))
3237 :version "20"
3238 :group 'ps-print-face)
3239
3240 (defcustom ps-left-header
3241 (list 'ps-get-buffer-name 'ps-header-dirpart)
3242 "The items to display (each on a line) on the left part of the page header.
3243 This applies to generating PostScript.
3244
3245 The value should be a list of strings and symbols, each representing an entry
3246 in the PostScript array HeaderLinesLeft.
3247
3248 Strings are inserted unchanged into the array; those representing
3249 PostScript string literals should be delimited with PostScript string
3250 delimiters '(' and ')'.
3251
3252 For symbols with bound functions, the function is called and should return a
3253 string to be inserted into the array. For symbols with bound values, the value
3254 should be a string to be inserted into the array. In either case, function or
3255 variable, the string value has PostScript string delimiters added to it.
3256
3257 If symbols are unbounded, they are silently ignored."
3258 :type '(repeat (choice :menu-tag "Left Header"
3259 :tag "Left Header"
3260 string symbol))
3261 :version "20"
3262 :group 'ps-print-headers)
3263
3264 (defcustom ps-right-header
3265 (list "/pagenumberstring load"
3266 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3267 "The items to display (each on a line) on the right part of the page header.
3268 This applies to generating PostScript.
3269
3270 See the variable `ps-left-header' for a description of the format of this
3271 variable.
3272
3273 There are the following basic functions implemented:
3274
3275 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3276 as, for example, \"06/18/01\".
3277
3278 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3279
3280 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3281
3282 `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
3283 date).
3284
3285 `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
3286
3287 You can also create your own time stamp function by using `format-time-string'
3288 \(which see)."
3289 :type '(repeat (choice :menu-tag "Right Header"
3290 :tag "Right Header"
3291 string symbol))
3292 :version "20"
3293 :group 'ps-print-headers)
3294
3295 (defcustom ps-left-footer
3296 (list 'ps-get-buffer-name 'ps-header-dirpart)
3297 "The items to display (each on a line) on the left part of the page footer.
3298 This applies to generating PostScript.
3299
3300 The value should be a list of strings and symbols, each representing an entry
3301 in the PostScript array FooterLinesLeft.
3302
3303 Strings are inserted unchanged into the array; those representing PostScript
3304 string literals should be delimited with PostScript string delimiters '(' and
3305 ')'.
3306
3307 For symbols with bound functions, the function is called and should return a
3308 string to be inserted into the array. For symbols with bound values, the value
3309 should be a string to be inserted into the array. In either case, function or
3310 variable, the string value has PostScript string delimiters added to it.
3311
3312 If symbols are unbounded, they are silently ignored."
3313 :type '(repeat (choice :menu-tag "Left Footer"
3314 :tag "Left Footer"
3315 string symbol))
3316 :version "21.1"
3317 :group 'ps-print-headers)
3318
3319 (defcustom ps-right-footer
3320 (list "/pagenumberstring load"
3321 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3322 "The items to display (each on a line) on the right part of the page footer.
3323 This applies to generating PostScript.
3324
3325 See the variable `ps-left-footer' for a description of the format of this
3326 variable.
3327
3328 There are the following basic functions implemented:
3329
3330 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3331 as, for example, \"06/18/01\".
3332
3333 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3334
3335 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3336
3337 `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
3338 date).
3339
3340 `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
3341
3342 You can also create your own time stamp function by using `format-time-string'
3343 \(which see)."
3344 :type '(repeat (choice :menu-tag "Right Footer"
3345 :tag "Right Footer"
3346 string symbol))
3347 :version "21.1"
3348 :group 'ps-print-headers)
3349
3350 (defcustom ps-razzle-dazzle t
3351 "Non-nil means report progress while formatting buffer."
3352 :type 'boolean
3353 :version "20"
3354 :group 'ps-print-miscellany)
3355
3356 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
3357 "Contains the header line identifying the output as PostScript.
3358 By default, `ps-adobe-tag' contains the standard identifier. Some printers
3359 require slightly different versions of this line."
3360 :type 'string
3361 :version "20"
3362 :group 'ps-print-miscellany)
3363
3364 (defcustom ps-build-face-reference t
3365 "Non-nil means build the reference face lists.
3366
3367 ps-print sets this value to nil after it builds its internal reference lists of
3368 bold and italic faces. By setting its value back to t, you can force ps-print
3369 to rebuild the lists the next time you invoke one of the ...-with-faces
3370 commands.
3371
3372 You should set this value back to t after you change the attributes of any
3373 face, or create new faces. Most users shouldn't have to worry about its
3374 setting, though."
3375 :type 'boolean
3376 :version "20"
3377 :group 'ps-print-face)
3378
3379 (defcustom ps-always-build-face-reference nil
3380 "Non-nil means always rebuild the reference face lists.
3381
3382 If this variable is non-nil, ps-print will rebuild its internal reference lists
3383 of bold and italic faces *every* time one of the ...-with-faces commands is
3384 called. Most users shouldn't need to set this variable."
3385 :type 'boolean
3386 :version "20"
3387 :group 'ps-print-face)
3388
3389 (defcustom ps-banner-page-when-duplexing nil
3390 "Non-nil means the very first page is skipped.
3391 It's like the very first character of buffer (or region) is ^L (\\014)."
3392 :type 'boolean
3393 :version "20"
3394 :group 'ps-print-headers)
3395
3396 (defcustom ps-postscript-code-directory
3397 (or (if (featurep 'xemacs)
3398 (cond ((fboundp 'locate-data-directory) ; XEmacs
3399 (funcall 'locate-data-directory "ps-print"))
3400 ((boundp 'data-directory) ; XEmacs
3401 (symbol-value 'data-directory))
3402 (t ; don't know what to do
3403 nil))
3404 data-directory) ; Emacs
3405 (error "`ps-postscript-code-directory' isn't set properly"))
3406 "Directory where it's located the PostScript prologue file used by ps-print.
3407 By default, this directory is the same as in the variable `data-directory'."
3408 :type 'directory
3409 :version "20"
3410 :group 'ps-print-miscellany)
3411
3412 (defcustom ps-line-spacing 0
3413 "Specify line spacing, in points, for ordinary text.
3414
3415 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3416
3417 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3418
3419 To get all lines with some spacing set both `ps-line-spacing' and
3420 `ps-paragraph-spacing' variables."
3421 :type '(choice :menu-tag "Line Spacing For Ordinary Text"
3422 :tag "Line Spacing For Ordinary Text"
3423 (number :tag "Line Spacing")
3424 (cons :tag "Landscape/Portrait"
3425 (number :tag "Landscape Line Spacing")
3426 (number :tag "Portrait Line Spacing")))
3427 :version "21.1"
3428 :group 'ps-print-miscellany)
3429
3430 (defcustom ps-paragraph-spacing 0
3431 "Specify paragraph spacing, in points, for ordinary text.
3432
3433 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3434
3435 See also `ps-line-spacing' and `ps-paragraph-regexp'.
3436
3437 To get all lines with some spacing set both `ps-line-spacing' and
3438 `ps-paragraph-spacing' variables."
3439 :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text"
3440 :tag "Paragraph Spacing For Ordinary Text"
3441 (number :tag "Paragraph Spacing")
3442 (cons :tag "Landscape/Portrait"
3443 (number :tag "Landscape Paragraph Spacing")
3444 (number :tag "Portrait Paragraph Spacing")))
3445 :version "21.1"
3446 :group 'ps-print-miscellany)
3447
3448 (defcustom ps-paragraph-regexp "[ \t]*$"
3449 "Specify paragraph delimiter.
3450
3451 It should be a regexp or nil.
3452
3453 See also `ps-paragraph-spacing'."
3454 :type '(choice :menu-tag "Paragraph Delimiter"
3455 (const :tag "No Delimiter" nil)
3456 (regexp :tag "Delimiter Regexp"))
3457 :version "21.1"
3458 :group 'ps-print-miscellany)
3459
3460 (defcustom ps-begin-cut-regexp nil
3461 "Specify regexp which is start of a region to cut out when printing.
3462
3463 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
3464 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
3465 some special printing instructions from the actual print. Special printing
3466 instructions may be appended to the end of the file just like any other
3467 buffer-local variables. See section \"Local Variables in Files\" on Emacs
3468 manual for more information.
3469
3470 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3471 actually gets printed. Both variables may be set to nil in which case no
3472 cutting occurs."
3473 :type '(choice (const :tag "No Delimiter" nil)
3474 (regexp :tag "Delimiter Regexp"))
3475 :version "21.1"
3476 :group 'ps-print-miscellany)
3477
3478 (defcustom ps-end-cut-regexp nil
3479 "Specify regexp which is end of the region to cut out when printing.
3480
3481 See `ps-begin-cut-regexp' for more information."
3482 :type '(choice (const :tag "No Delimiter" nil)
3483 (regexp :tag "Delimiter Regexp"))
3484 :version "21.1"
3485 :group 'ps-print-miscellany)
3486
3487
3488 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3489 ;; Selected Pages
3490
3491
3492 (defvar ps-last-selected-pages nil
3493 "Latest `ps-selected-pages' value.")
3494
3495
3496 (defun ps-restore-selected-pages ()
3497 "Restore latest `ps-selected-pages' value."
3498 (interactive)
3499 (setq ps-selected-pages ps-last-selected-pages))
3500
3501
3502 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3503 ;; Customization
3504
3505
3506 ;;;###autoload
3507 (defun ps-print-customize ()
3508 "Customization of ps-print group."
3509 (interactive)
3510 (customize-group 'ps-print))
3511
3512
3513 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3514 ;; User commands
3515
3516
3517 ;;;###autoload
3518 (defun ps-print-buffer (&optional filename)
3519 "Generate and print a PostScript image of the buffer.
3520
3521 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3522 user for a file name, and saves the PostScript image in that file instead of
3523 sending it to the printer.
3524
3525 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3526 send the image to the printer. If FILENAME is a string, save the PostScript
3527 image in a file with that name."
3528 (interactive (list (ps-print-preprint current-prefix-arg)))
3529 (ps-print-without-faces (point-min) (point-max) filename))
3530
3531
3532 ;;;###autoload
3533 (defun ps-print-buffer-with-faces (&optional filename)
3534 "Generate and print a PostScript image of the buffer.
3535 Like `ps-print-buffer', but includes font, color, and underline information in
3536 the generated image. This command works only if you are using a window system,
3537 so it has a way to determine color values."
3538 (interactive (list (ps-print-preprint current-prefix-arg)))
3539 (ps-print-with-faces (point-min) (point-max) filename))
3540
3541
3542 ;;;###autoload
3543 (defun ps-print-region (from to &optional filename)
3544 "Generate and print a PostScript image of the region.
3545 Like `ps-print-buffer', but prints just the current region."
3546 (interactive (ps-print-preprint-region current-prefix-arg))
3547 (ps-print-without-faces from to filename t))
3548
3549
3550 ;;;###autoload
3551 (defun ps-print-region-with-faces (from to &optional filename)
3552 "Generate and print a PostScript image of the region.
3553 Like `ps-print-region', but includes font, color, and underline information in
3554 the generated image. This command works only if you are using a window system,
3555 so it has a way to determine color values."
3556 (interactive (ps-print-preprint-region current-prefix-arg))
3557 (ps-print-with-faces from to filename t))
3558
3559
3560 ;;;###autoload
3561 (defun ps-spool-buffer ()
3562 "Generate and spool a PostScript image of the buffer.
3563 Like `ps-print-buffer' except that the PostScript image is saved in a local
3564 buffer to be sent to the printer later.
3565
3566 Use the command `ps-despool' to send the spooled images to the printer."
3567 (interactive)
3568 (ps-spool-without-faces (point-min) (point-max)))
3569
3570
3571 ;;;###autoload
3572 (defun ps-spool-buffer-with-faces ()
3573 "Generate and spool a PostScript image of the buffer.
3574 Like `ps-spool-buffer', but includes font, color, and underline information in
3575 the generated image. This command works only if you are using a window system,
3576 so it has a way to determine color values.
3577
3578 Use the command `ps-despool' to send the spooled images to the printer."
3579 (interactive)
3580 (ps-spool-with-faces (point-min) (point-max)))
3581
3582
3583 ;;;###autoload
3584 (defun ps-spool-region (from to)
3585 "Generate a PostScript image of the region and spool locally.
3586 Like `ps-spool-buffer', but spools just the current region.
3587
3588 Use the command `ps-despool' to send the spooled images to the printer."
3589 (interactive "r")
3590 (ps-spool-without-faces from to t))
3591
3592
3593 ;;;###autoload
3594 (defun ps-spool-region-with-faces (from to)
3595 "Generate a PostScript image of the region and spool locally.
3596 Like `ps-spool-region', but includes font, color, and underline information in
3597 the generated image. This command works only if you are using a window system,
3598 so it has a way to determine color values.
3599
3600 Use the command `ps-despool' to send the spooled images to the printer."
3601 (interactive "r")
3602 (ps-spool-with-faces from to t))
3603
3604 ;;;###autoload
3605 (defun ps-despool (&optional filename)
3606 "Send the spooled PostScript to the printer.
3607
3608 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3609 user for a file name, and saves the spooled PostScript image in that file
3610 instead of sending it to the printer.
3611
3612 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3613 send the image to the printer. If FILENAME is a string, save the PostScript
3614 image in a file with that name."
3615 (interactive (list (ps-print-preprint current-prefix-arg)))
3616 (ps-do-despool filename))
3617
3618 ;;;###autoload
3619 (defun ps-line-lengths ()
3620 "Display the correspondence between a line length and a font size.
3621 Done using the current ps-print setup.
3622 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3623 (interactive)
3624 (ps-line-lengths-internal))
3625
3626 ;;;###autoload
3627 (defun ps-nb-pages-buffer (nb-lines)
3628 "Display number of pages to print this buffer, for various font heights.
3629 The table depends on the current ps-print setup."
3630 (interactive (ps-count-lines-preprint (point-min) (point-max)))
3631 (ps-nb-pages nb-lines))
3632
3633 ;;;###autoload
3634 (defun ps-nb-pages-region (nb-lines)
3635 "Display number of pages to print the region, for various font heights.
3636 The table depends on the current ps-print setup."
3637 (interactive (ps-count-lines-preprint (mark) (point)))
3638 (ps-nb-pages nb-lines))
3639
3640 (defvar ps-prefix-quote nil
3641 "Used for `ps-print-quote' (which see).")
3642
3643 ;;;###autoload
3644 (defun ps-setup ()
3645 "Return the current PostScript-generation setup."
3646 (let (ps-prefix-quote)
3647 (mapconcat
3648 #'ps-print-quote
3649 (list
3650 (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs")
3651 ") ps-print version " ps-print-version "\n")
3652 ";; internal vars"
3653 (ps-comment-string "emacs-version " emacs-version)
3654 (ps-comment-string "ps-windows-system " ps-windows-system)
3655 (ps-comment-string "ps-lp-system " ps-lp-system)
3656 nil
3657 '(25 . ps-print-color-p)
3658 '(25 . ps-lpr-command)
3659 '(25 . ps-lpr-switches)
3660 '(25 . ps-printer-name)
3661 '(25 . ps-printer-name-option)
3662 '(25 . ps-print-region-function)
3663 '(25 . ps-manual-feed)
3664 '(25 . ps-end-with-control-d)
3665 nil
3666 '(23 . ps-paper-type)
3667 '(23 . ps-warn-paper-type)
3668 '(23 . ps-landscape-mode)
3669 '(23 . ps-print-upside-down)
3670 '(23 . ps-number-of-columns)
3671 nil
3672 '(23 . ps-zebra-stripes)
3673 '(23 . ps-zebra-stripe-height)
3674 '(23 . ps-zebra-stripe-follow)
3675 '(23 . ps-zebra-color)
3676 '(23 . ps-line-number)
3677 '(23 . ps-line-number-step)
3678 '(23 . ps-line-number-start)
3679 nil
3680 '(17 . ps-razzle-dazzle)
3681 '(17 . ps-default-bg)
3682 '(17 . ps-default-fg)
3683 '(17 . ps-fg-validate-p)
3684 '(17 . ps-fg-list)
3685 nil
3686 '(23 . ps-use-face-background)
3687 nil
3688 '(28 . ps-print-control-characters)
3689 nil
3690 '(26 . ps-print-background-image)
3691 nil
3692 '(25 . ps-print-background-text)
3693 nil
3694 '(29 . ps-error-handler-message)
3695 '(29 . ps-user-defined-prologue)
3696 '(29 . ps-print-prologue-header)
3697 '(29 . ps-postscript-code-directory)
3698 '(29 . ps-adobe-tag)
3699 nil
3700 '(30 . ps-left-margin)
3701 '(30 . ps-right-margin)
3702 '(30 . ps-inter-column)
3703 '(30 . ps-bottom-margin)
3704 '(30 . ps-top-margin)
3705 '(30 . ps-print-only-one-header)
3706 '(30 . ps-switch-header)
3707 '(30 . ps-print-header)
3708 '(30 . ps-header-lines)
3709 '(30 . ps-header-offset)
3710 '(30 . ps-header-line-pad)
3711 '(30 . ps-print-header-frame)
3712 '(30 . ps-header-frame-alist)
3713 '(30 . ps-print-footer)
3714 '(30 . ps-footer-lines)
3715 '(30 . ps-footer-offset)
3716 '(30 . ps-footer-line-pad)
3717 '(30 . ps-print-footer-frame)
3718 '(30 . ps-footer-frame-alist)
3719 '(30 . ps-show-n-of-n)
3720 '(30 . ps-spool-config)
3721 '(30 . ps-spool-duplex)
3722 '(30 . ps-spool-tumble)
3723 '(30 . ps-banner-page-when-duplexing)
3724 '(30 . ps-left-header)
3725 '(30 . ps-right-header)
3726 '(30 . ps-left-footer)
3727 '(30 . ps-right-footer)
3728 nil
3729 '(23 . ps-n-up-printing)
3730 '(23 . ps-n-up-margin)
3731 '(23 . ps-n-up-border-p)
3732 '(23 . ps-n-up-filling)
3733 nil
3734 '(26 . ps-multibyte-buffer)
3735 '(26 . ps-font-family)
3736 '(26 . ps-font-size)
3737 '(26 . ps-header-font-family)
3738 '(26 . ps-header-font-size)
3739 '(26 . ps-header-title-font-size)
3740 '(26 . ps-footer-font-family)
3741 '(26 . ps-footer-font-size)
3742 '(26 . ps-line-number-color)
3743 '(26 . ps-line-number-font)
3744 '(26 . ps-line-number-font-size)
3745 '(26 . ps-line-spacing)
3746 '(26 . ps-paragraph-spacing)
3747 '(26 . ps-paragraph-regexp)
3748 '(26 . ps-begin-cut-regexp)
3749 '(26 . ps-end-cut-regexp)
3750 nil
3751 '(23 . ps-even-or-odd-pages)
3752 '(23 . ps-selected-pages)
3753 '(23 . ps-last-selected-pages)
3754 nil
3755 '(31 . ps-build-face-reference)
3756 '(31 . ps-always-build-face-reference)
3757 nil
3758 '(20 . ps-auto-font-detect)
3759 '(20 . ps-bold-faces)
3760 '(20 . ps-italic-faces)
3761 '(20 . ps-underlined-faces)
3762 '(20 . ps-black-white-faces)
3763 " )\n
3764 \;; The following customized variables have long lists and are seldom modified:
3765 \;; ps-page-dimensions-database
3766 \;; ps-font-info-database
3767
3768 \;;; ps-print - end of settings\n")
3769 "\n")))
3770
3771
3772 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3773 ;; Utility functions and variables:
3774
3775
3776 (defun ps-print-quote (elt)
3777 "Quote ELT for printing (used for showing settings).
3778
3779 If ELT is nil, return an empty string.
3780 If ELT is string, return it.
3781 Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3782 LEN is the field length where SYM name will be inserted. The variable
3783 `ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
3784 used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3785 generated is:
3786
3787 * If `ps-prefix-quote' is nil:
3788 \"(setq SYM-NAME SYM-VALUE\"
3789 |<------->|
3790 LEN
3791
3792 * If `ps-prefix-quote' is non-nil:
3793 \" SYM-NAME SYM-VALUE\"
3794 |<------->|
3795 LEN
3796
3797 If `ps-prefix-quote' is nil, it's set to t after generating string."
3798 (cond
3799 ((stringp elt) elt)
3800 ((and (consp elt) (integerp (car elt))
3801 (symbolp (cdr elt)) (boundp (cdr elt)))
3802 (let* ((col (car elt))
3803 (sym (cdr elt))
3804 (key (symbol-name sym))
3805 (len (length key))
3806 (val (symbol-value sym)))
3807 (concat (if ps-prefix-quote
3808 " "
3809 (setq ps-prefix-quote t)
3810 "(setq ")
3811 key
3812 (if (> col len)
3813 (make-string (- col len) ?\s)
3814 " ")
3815 (ps-value-string val))))
3816 (t "")
3817 ))
3818
3819
3820 (defun ps-value-string (val)
3821 "Return a string representation of VAL. Used by `ps-print-quote'."
3822 (cond ((null val)
3823 "nil")
3824 ((eq val t)
3825 "t")
3826 ((or (symbolp val) (listp val))
3827 (format "'%S" val))
3828 (t
3829 (format "%S" val))))
3830
3831
3832 (defun ps-comment-string (str value)
3833 "Return a comment string like \";; STR = VALUE\"."
3834 (format ";; %s = %s" str (ps-value-string value)))
3835
3836
3837 (defun ps-value (alist-sym key)
3838 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3839 (cdr (assq key (symbol-value alist-sym))))
3840
3841
3842 (defun ps-get (alist-sym key)
3843 "Return element from association list ALIST-SYM which car is `eq' to KEY."
3844 (assq key (symbol-value alist-sym)))
3845
3846
3847 (defun ps-put (alist-sym key value)
3848 "Store element (KEY . VALUE) into association list ALIST-SYM.
3849 If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3850 It can be retrieved with `(ps-get ALIST-SYM KEY)'."
3851 (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
3852 (if elt:
3853 (setcdr elt: value)
3854 (setq elt: (cons key value))
3855 (set alist-sym (cons elt: (symbol-value alist-sym))))
3856 elt:))
3857
3858
3859 (defun ps-del (alist-sym key)
3860 "Delete by side effect element KEY from association list ALIST-SYM."
3861 (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
3862 old)
3863 (while a:list:
3864 (if (eq key (car (car a:list:)))
3865 (progn
3866 (if old
3867 (setcdr old (cdr a:list:))
3868 (set alist-sym (cdr a:list:)))
3869 (setq a:list: nil))
3870 (setq old a:list:
3871 a:list: (cdr a:list:)))))
3872 (symbol-value alist-sym))
3873
3874
3875 (defun ps-time-stamp-locale-default ()
3876 "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
3877 (format-time-string "%x"))
3878
3879
3880 (defun ps-time-stamp-mon-dd-yyyy ()
3881 "Return date as \"Jun 18 2001\"."
3882 (format-time-string "%b %d %Y"))
3883
3884
3885 (defun ps-time-stamp-yyyy-mm-dd ()
3886 "Return date as \"2001-06-18\" (ISO date)."
3887 (format-time-string "%Y-%m-%d"))
3888
3889
3890 ;; Alias for `ps-time-stamp-yyyy-mm-dd' (which see).
3891 (defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd)
3892
3893
3894 (defun ps-time-stamp-hh:mm:ss ()
3895 "Return time as \"17:28:31\"."
3896 (format-time-string "%T"))
3897
3898
3899 (defvar ps-print-color-scale 1.0)
3900
3901 (defun ps-color-scale (color)
3902 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3903 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
3904 (ps-color-values color)))
3905
3906
3907 (defun ps-face-underlined-p (face)
3908 (or (face-underline-p face)
3909 (memq face ps-underlined-faces)))
3910
3911
3912 (defun ps-prologue-file (filenumber)
3913 "If prologue FILENUMBER exists and is readable, return contents as string.
3914
3915 Note: No major/minor-mode is activated and no local variables are evaluated for
3916 FILENUMBER, but proper EOL-conversion and character interpretation is
3917 done!"
3918 (let ((filename (convert-standard-filename
3919 (expand-file-name (format "ps-prin%d.ps" filenumber)
3920 ps-postscript-code-directory))))
3921 (if (and (file-exists-p filename)
3922 (file-readable-p filename))
3923 (with-temp-buffer
3924 (insert-file-contents filename)
3925 (buffer-string))
3926 (error "ps-print PostScript prologue `%s' file was not found"
3927 filename))))
3928
3929
3930 (defvar ps-mark-code-directory nil)
3931
3932 (defvar ps-print-prologue-0 ""
3933 "ps-print PostScript error handler.")
3934
3935 (defvar ps-print-prologue-1 ""
3936 "ps-print PostScript prologue.")
3937
3938 ;; Start Editing Here:
3939
3940 (defvar ps-source-buffer nil)
3941 (defvar ps-spool-buffer-name "*PostScript*")
3942 (defvar ps-spool-buffer nil)
3943
3944 (defvar ps-output-head nil)
3945 (defvar ps-output-tail nil)
3946
3947 (defvar ps-page-postscript 0) ; page number
3948 (defvar ps-page-order 0) ; PostScript page counter
3949 (defvar ps-page-sheet 0) ; sheet counter
3950 (defvar ps-page-column 0) ; column counter
3951 (defvar ps-page-printed 0) ; total pages printed
3952 (defvar ps-page-n-up 0) ; n-up counter
3953 (defvar ps-lines-printed 0) ; total lines printed
3954 (defvar ps-showline-count 1) ; line number counter
3955 (defvar ps-first-page nil)
3956 (defvar ps-last-page nil)
3957 (defvar ps-print-page-p t)
3958
3959 (defvar ps-control-or-escape-regexp nil)
3960 (defvar ps-n-up-on nil)
3961
3962 (defvar ps-background-pages nil)
3963 (defvar ps-background-all-pages nil)
3964 (defvar ps-background-text-count 0)
3965 (defvar ps-background-image-count 0)
3966
3967 (defvar ps-current-font 0)
3968 (defvar ps-default-foreground nil)
3969 (defvar ps-default-background nil)
3970 (defvar ps-default-color nil)
3971 (defvar ps-current-color nil)
3972 (defvar ps-current-bg nil)
3973 (defvar ps-foreground-list nil)
3974
3975 (defvar ps-zebra-stripe-full-p nil)
3976 (defvar ps-razchunk 0)
3977
3978 (defvar ps-color-p nil)
3979
3980 ;; These values determine how much print-height to deduct when headers/footers
3981 ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
3982 ;; now.
3983
3984 (defvar ps-header-pad 0
3985 "Vertical and horizontal space between the header frame and the text.
3986 This is in units of points (1/72 inch).")
3987
3988 (defvar ps-footer-pad 0
3989 "Vertical and horizontal space between the footer frame and the text.
3990 This is in units of points (1/72 inch).")
3991
3992 ;; Define accessors to the dimensions list.
3993
3994 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3995 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
3996 (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
3997
3998 (defvar ps-landscape-page-height nil)
3999
4000 (defvar ps-print-width nil)
4001 (defvar ps-print-height nil)
4002
4003 (defvar ps-height-remaining nil)
4004 (defvar ps-width-remaining nil)
4005
4006 (defvar ps-font-size-internal nil)
4007 (defvar ps-header-font-size-internal nil)
4008 (defvar ps-header-title-font-size-internal nil)
4009 (defvar ps-footer-font-size-internal nil)
4010 (defvar ps-line-spacing-internal nil)
4011 (defvar ps-paragraph-spacing-internal nil)
4012
4013 \f
4014 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4015 ;; Internal Variables
4016
4017
4018 (defvar ps-black-white-faces-alist nil
4019 "Alist of symbolic faces used for black/white PostScript printers.
4020 An element of this list has the same form as `ps-print-face-extension-alist'
4021 \(which see).
4022
4023 Don't change this list directly; instead,
4024 use `ps-extend-face' and `ps-extend-face-list'.
4025 See documentation for `ps-extend-face' for valid extension symbol.
4026 See also documentation for `ps-print-color-p'.")
4027
4028
4029 (defvar ps-print-face-extension-alist nil
4030 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
4031 An element of this list has the following form:
4032
4033 (FACE . [BITS FG BG])
4034
4035 FACE is a symbol denoting a face name
4036 BITS is a bit vector, where each bit correspond
4037 to a feature (bold, underline, etc)
4038 (see documentation for `ps-print-face-map-alist')
4039 FG foreground color (string or nil)
4040 BG background color (string or nil)
4041
4042 Don't change this list directly; instead,
4043 use `ps-extend-face' and `ps-extend-face-list'.
4044 See documentation for `ps-extend-face' for valid extension symbol.")
4045
4046
4047 (defvar ps-print-face-alist nil
4048 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
4049
4050 An element of this list has the same form as an element of
4051 `ps-print-face-extension-alist'.
4052
4053 Don't change this list directly; this list is used by `ps-face-attributes',
4054 `ps-map-face' and `ps-build-reference-face-lists'.")
4055
4056
4057 (defconst ps-print-face-map-alist
4058 '((bold . 1)
4059 (italic . 2)
4060 (underline . 4)
4061 (strikeout . 8)
4062 (overline . 16)
4063 (shadow . 32)
4064 (box . 64)
4065 (outline . 128))
4066 "Alist of all features and the corresponding bit mask.
4067 Each symbol correspond to one bit in a bit vector.")
4068
4069 \f
4070 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4071 ;; Remapping Faces
4072
4073
4074 ;;;###autoload
4075 (defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym)
4076 "Extend face in ALIST-SYM.
4077
4078 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
4079 with face extension in ALIST-SYM; otherwise, overrides.
4080
4081 If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
4082 otherwise, it should be an alist symbol.
4083
4084 The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.
4085
4086 See `ps-extend-face' for documentation."
4087 (while face-extension-list
4088 (ps-extend-face (car face-extension-list) merge-p alist-sym)
4089 (setq face-extension-list (cdr face-extension-list))))
4090
4091
4092 ;;;###autoload
4093 (defun ps-extend-face (face-extension &optional merge-p alist-sym)
4094 "Extend face in ALIST-SYM.
4095
4096 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
4097 with face extensions in ALIST-SYM; otherwise, overrides.
4098
4099 If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
4100 otherwise, it should be an alist symbol.
4101
4102 The elements of FACE-EXTENSION list have the form:
4103
4104 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
4105
4106 FACE-NAME is a face name symbol.
4107
4108 FOREGROUND and BACKGROUND may be nil or a string that denotes the
4109 foreground and background colors respectively.
4110
4111 EXTENSION is one of the following symbols:
4112 bold - use bold font.
4113 italic - use italic font.
4114 underline - put a line under text.
4115 strikeout - like underline, but the line is in middle of text.
4116 overline - like underline, but the line is over the text.
4117 shadow - text will have a shadow.
4118 box - text will be surrounded by a box.
4119 outline - print characters as hollow outlines.
4120
4121 If EXTENSION is any other symbol, it is ignored."
4122 (or alist-sym
4123 (setq alist-sym 'ps-print-face-extension-alist))
4124 (let* ((background (nth 2 face-extension))
4125 (foreground (nth 1 face-extension))
4126 (face-name (nth 0 face-extension))
4127 (ps-face (cdr (assq face-name (symbol-value alist-sym))))
4128 (face-vector (or ps-face (vector 0 nil nil)))
4129 (face-bit (ps-extension-bit face-extension)))
4130 ;; extend face
4131 (aset face-vector 0 (if merge-p
4132 (logior (aref face-vector 0) face-bit)
4133 face-bit))
4134 (and (or (not merge-p) (and foreground (stringp foreground)))
4135 (aset face-vector 1 foreground))
4136 (and (or (not merge-p) (and background (stringp background)))
4137 (aset face-vector 2 background))
4138 ;; if face does not exist, insert it
4139 (or ps-face
4140 (set alist-sym (cons (cons face-name face-vector)
4141 (symbol-value alist-sym))))))
4142
4143
4144 (defun ps-extension-bit (face-extension)
4145 (let ((face-bit 0))
4146 ;; map valid symbol extension to bit vector
4147 (setq face-extension (cdr (cdr face-extension)))
4148 (while (setq face-extension (cdr face-extension))
4149 (setq face-bit (logior face-bit
4150 (or (cdr (assq (car face-extension)
4151 ps-print-face-map-alist))
4152 0))))
4153 face-bit))
4154
4155 \f
4156 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4157 ;; Adapted from font-lock: (obsolete stuff)
4158 ;; Originally face attributes were specified via `font-lock-face-attributes'.
4159 ;; Users then changed the default face attributes by setting that variable.
4160 ;; However, we try and be back-compatible and respect its value if set except
4161 ;; for faces where M-x customize has been used to save changes for the face.
4162
4163
4164 (defun ps-font-lock-face-attributes ()
4165 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
4166 (boundp 'font-lock-face-attributes)
4167 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
4168 (while face-attributes
4169 (let* ((face-attribute
4170 (car (prog1 face-attributes
4171 (setq face-attributes (cdr face-attributes)))))
4172 (face (car face-attribute)))
4173 ;; Rustle up a `defface' SPEC from a
4174 ;; `font-lock-face-attributes' entry.
4175 (unless (get face 'saved-face)
4176 (let ((foreground (nth 1 face-attribute))
4177 (background (nth 2 face-attribute))
4178 (bold-p (nth 3 face-attribute))
4179 (italic-p (nth 4 face-attribute))
4180 (underline-p (nth 5 face-attribute))
4181 face-spec)
4182 (when foreground
4183 (setq face-spec (cons ':foreground
4184 (cons foreground face-spec))))
4185 (when background
4186 (setq face-spec (cons ':background
4187 (cons background face-spec))))
4188 (when bold-p
4189 (setq face-spec (append '(:weight bold) face-spec)))
4190 (when italic-p
4191 (setq face-spec (append '(:slant italic) face-spec)))
4192 (when underline-p
4193 (setq face-spec (append '(:underline t) face-spec)))
4194 (custom-declare-face face (list (list t face-spec)) nil)
4195 )))))))
4196
4197 \f
4198 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4199 ;; Internal functions and variables
4200
4201
4202 (defun ps-message-log-max ()
4203 (and (not (string= (buffer-name) "*Messages*"))
4204 (boundp 'message-log-max)
4205 message-log-max))
4206
4207
4208 (defvar ps-print-hook nil)
4209 (defvar ps-print-begin-sheet-hook nil)
4210 (defvar ps-print-begin-page-hook nil)
4211 (defvar ps-print-begin-column-hook nil)
4212
4213
4214 (defun ps-print-without-faces (from to &optional filename region-p)
4215 (ps-spool-without-faces from to region-p)
4216 (ps-do-despool filename))
4217
4218
4219 (defun ps-spool-without-faces (from to &optional region-p)
4220 (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
4221 (run-hooks 'ps-print-hook)
4222 (ps-printing-region region-p from to)
4223 (ps-generate (current-buffer) from to 'ps-generate-postscript)))
4224
4225
4226 (defun ps-print-with-faces (from to &optional filename region-p)
4227 (ps-spool-with-faces from to region-p)
4228 (ps-do-despool filename))
4229
4230
4231 (defun ps-spool-with-faces (from to &optional region-p)
4232 (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
4233 (run-hooks 'ps-print-hook)
4234 (ps-printing-region region-p from to)
4235 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)))
4236
4237
4238 (defun ps-count-lines-preprint (from to)
4239 (or (and from to)
4240 (error "The mark is not set now"))
4241 (let ((message-log-max (ps-message-log-max))) ; to count lines of *Messages*
4242 (list (count-lines from to))))
4243
4244
4245 (defun ps-count-lines (from to)
4246 (+ (count-lines from to)
4247 (save-excursion
4248 (goto-char to)
4249 (if (= (current-column) 0) 1 0))))
4250
4251
4252 (defvar ps-printing-region nil
4253 "Variable used to indicate the region that ps-print is printing.
4254 It is a cons, the car of which is the line number where the region begins, and
4255 its cdr is the total number of lines in the buffer. Formatting functions can
4256 use this information to print the original line number (and not the number of
4257 lines printed), and to indicate in the header that the printout is of a partial
4258 file.")
4259
4260
4261 (defvar ps-printing-region-p nil
4262 "Non-nil means ps-print is printing a region.")
4263
4264
4265 (defun ps-printing-region (region-p from to)
4266 (setq ps-printing-region-p region-p
4267 ps-printing-region
4268 (cons (if region-p
4269 (ps-count-lines (point-min) (min from to))
4270 1)
4271 (ps-count-lines (point-min) (point-max)))))
4272
4273 \f
4274 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4275 ;; Internal functions
4276
4277
4278 (defsubst ps-font-alist (font-sym)
4279 (get font-sym 'fonts))
4280
4281 (defun ps-font (font-sym font-type)
4282 "Font family name for text of `font-type', when generating PostScript."
4283 (let* ((font-list (ps-font-alist font-sym))
4284 (normal-font (cdr (assq 'normal font-list))))
4285 (while (and font-list (not (eq font-type (car (car font-list)))))
4286 (setq font-list (cdr font-list)))
4287 (or (cdr (car font-list)) normal-font)))
4288
4289 (defsubst ps-fonts (font-sym)
4290 (mapcar 'cdr (ps-font-alist font-sym)))
4291
4292 (defsubst ps-font-number (font-sym font-type)
4293 (or (ps-alist-position font-type (ps-font-alist font-sym))
4294 0))
4295
4296 (defsubst ps-line-height (font-sym)
4297 "The height of a line, for generating PostScript.
4298 This is the value that ps-print uses to determine the height,
4299 y-dimension, of the lines of text it has printed, and thus affects the
4300 point at which page-breaks are placed.
4301 The line-height is *not* the same as the point size of the font."
4302 (get font-sym 'line-height))
4303
4304 (defsubst ps-title-line-height (font-sym)
4305 "The height of a `title' line, for generating PostScript.
4306 This is the value that ps-print uses to determine the height,
4307 y-dimension, of the lines of text it has printed, and thus affects the
4308 point at which page-breaks are placed.
4309 The title-line-height is *not* the same as the point size of the font."
4310 (get font-sym 'title-line-height))
4311
4312 (defsubst ps-space-width (font-sym)
4313 "The width of a space character, for generating PostScript.
4314 This value is used in expanding tab characters."
4315 (get font-sym 'space-width))
4316
4317 (defsubst ps-avg-char-width (font-sym)
4318 "The average width, in points, of a character, for generating PostScript.
4319 This is the value that ps-print uses to determine the length,
4320 x-dimension, of the text it has printed, and thus affects the point at
4321 which long lines wrap around."
4322 (get font-sym 'avg-char-width))
4323
4324 (defun ps-line-lengths-internal ()
4325 "Display the correspondence between a line length and a font size.
4326 Done using the current ps-print setup.
4327 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4328 (let* ((ps-font-size-internal
4329 (or ps-font-size-internal
4330 (ps-get-font-size 'ps-font-size)))
4331 (ps-header-font-size-internal
4332 (or ps-header-font-size-internal
4333 (ps-get-font-size 'ps-header-font-size)))
4334 (ps-footer-font-size-internal
4335 (or ps-footer-font-size-internal
4336 (ps-get-font-size 'ps-footer-font-size)))
4337 (ps-header-title-font-size-internal
4338 (or ps-header-title-font-size-internal
4339 (ps-get-font-size 'ps-header-title-font-size)))
4340 (buf (get-buffer-create "*Line-lengths*"))
4341 (ifs ps-font-size-internal) ; initial font size
4342 (print-width (progn (ps-get-page-dimensions)
4343 ps-print-width))
4344 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
4345 (ps-setup (ps-setup)) ; setup for the current buffer
4346 (fs-min 5) ; minimum font size
4347 cw-min ; minimum character width
4348 nb-cpl-max ; maximum nb of characters per line
4349 (fs-max 14) ; maximum font size
4350 cw-max ; maximum character width
4351 nb-cpl-min ; minimum nb of characters per line
4352 fs ; current font size
4353 cw ; current character width
4354 nb-cpl ; current nb of characters per line
4355 )
4356 (setq cw-min (/ (* icw fs-min) ifs)
4357 nb-cpl-max (floor (/ print-width cw-min))
4358 cw-max (/ (* icw fs-max) ifs)
4359 nb-cpl-min (floor (/ print-width cw-max))
4360 nb-cpl nb-cpl-min)
4361 (set-buffer buf)
4362 (goto-char (point-max))
4363 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4364 (insert ps-setup
4365 "\nnb char per line / font size\n")
4366 (while (<= nb-cpl nb-cpl-max)
4367 (setq cw (/ print-width (float nb-cpl))
4368 fs (/ (* ifs cw) icw))
4369 (insert (format "%16d %s\n" nb-cpl fs))
4370 (setq nb-cpl (1+ nb-cpl)))
4371 (insert "\n")
4372 (display-buffer buf 'not-this-window)))
4373
4374 (defun ps-nb-pages (nb-lines)
4375 "Display correspondence between font size and the number of pages.
4376 The correspondence is based on having NB-LINES lines of text,
4377 and on the current ps-print setup."
4378 (let* ((ps-font-size-internal
4379 (or ps-font-size-internal
4380 (ps-get-font-size 'ps-font-size)))
4381 (ps-header-font-size-internal
4382 (or ps-header-font-size-internal
4383 (ps-get-font-size 'ps-header-font-size)))
4384 (ps-footer-font-size-internal
4385 (or ps-footer-font-size-internal
4386 (ps-get-font-size 'ps-footer-font-size)))
4387 (ps-header-title-font-size-internal
4388 (or ps-header-title-font-size-internal
4389 (ps-get-font-size 'ps-header-title-font-size)))
4390 (ps-line-spacing-internal
4391 (or ps-line-spacing-internal
4392 (ps-get-size ps-line-spacing "line spacing")))
4393 (buf (get-buffer-create "*Nb-Pages*"))
4394 (ils ps-line-spacing-internal) ; initial line spacing
4395 (ifs ps-font-size-internal) ; initial font size
4396 (page-height (progn (ps-get-page-dimensions)
4397 ps-print-height))
4398 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
4399 (ps-setup (ps-setup)) ; setup for the current buffer
4400 (fs-min 4) ; minimum font size
4401 lh-min ; minimum line height
4402 nb-lpp-max ; maximum nb of lines per page
4403 nb-page-min ; minimum nb of pages
4404 (fs-max 14) ; maximum font size
4405 lh-max ; maximum line height
4406 nb-lpp-min ; minimum nb of lines per page
4407 nb-page-max ; maximum nb of pages
4408 fs ; current font size
4409 lh ; current line height
4410 nb-lpp ; current nb of lines per page
4411 nb-page ; current nb of pages
4412 )
4413 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
4414 nb-lpp-max (floor (/ page-height lh-min))
4415 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
4416 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
4417 nb-lpp-min (floor (/ page-height lh-max))
4418 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
4419 nb-page nb-page-min)
4420 (set-buffer buf)
4421 (goto-char (point-max))
4422 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4423 (insert ps-setup
4424 (format "\nThere are %d lines.\n\n" nb-lines)
4425 "nb page / font size\n")
4426 (while (<= nb-page nb-page-max)
4427 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
4428 lh (/ page-height nb-lpp)
4429 fs (/ (* ifs lh) ilh))
4430 (insert (format "%7d %s\n" nb-page fs))
4431 (setq nb-page (1+ nb-page)))
4432 (insert "\n")
4433 (display-buffer buf 'not-this-window)))
4434
4435 ;; macros used in `ps-select-font'
4436 (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
4437 (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
4438
4439 (defun ps-select-font (font-family sym font-size title-font-size)
4440 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
4441 (or font-entry
4442 (error "Don't have data to scale font %s. Known fonts families are %s"
4443 font-family
4444 (mapcar 'car ps-font-info-database)))
4445 (let ((size (ps-lookup 'size)))
4446 (put sym 'fonts (ps-lookup 'fonts))
4447 (put sym 'space-width (ps-size-scale 'space-width))
4448 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
4449 (put sym 'line-height (ps-size-scale 'line-height))
4450 (put sym 'title-line-height
4451 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
4452
4453 (defun ps-get-page-dimensions ()
4454 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
4455 page-width page-height)
4456 (cond
4457 ((null page-dimensions)
4458 (error "`ps-paper-type' must be one of:\n%s"
4459 (mapcar 'car ps-page-dimensions-database)))
4460 ((< ps-number-of-columns 1)
4461 (error "The number of columns %d should be positive"
4462 ps-number-of-columns)))
4463
4464 (ps-select-font ps-font-family 'ps-font-for-text
4465 ps-font-size-internal ps-font-size-internal)
4466 (ps-select-font ps-header-font-family 'ps-font-for-header
4467 ps-header-font-size-internal
4468 ps-header-title-font-size-internal)
4469 (ps-select-font ps-footer-font-family 'ps-font-for-footer
4470 ps-footer-font-size-internal ps-footer-font-size-internal)
4471
4472 (setq page-width (ps-page-dimensions-get-width page-dimensions)
4473 page-height (ps-page-dimensions-get-height page-dimensions))
4474
4475 ;; Landscape mode
4476 (if ps-landscape-mode
4477 ;; exchange width and height
4478 (setq page-width (prog1 page-height (setq page-height page-width))))
4479
4480 ;; It is used to get the lower right corner (only in landscape mode)
4481 (setq ps-landscape-page-height page-height)
4482
4483 ;; | lm | text | ic | text | ic | text | rm |
4484 ;; page-width == lm + n * pw + (n - 1) * ic + rm
4485 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
4486 (setq ps-print-width (/ (- page-width
4487 ps-left-margin ps-right-margin
4488 (* (1- ps-number-of-columns) ps-inter-column))
4489 ps-number-of-columns))
4490 (if (<= ps-print-width 0)
4491 (error "Bad horizontal layout:
4492 page-width == %s
4493 ps-left-margin == %s
4494 ps-right-margin == %s
4495 ps-inter-column == %s
4496 ps-number-of-columns == %s
4497 | lm | text | ic | text | ic | text | rm |
4498 page-width == lm + n * print-width + (n - 1) * ic + rm
4499 => print-width == %d !"
4500 page-width
4501 ps-left-margin
4502 ps-right-margin
4503 ps-inter-column
4504 ps-number-of-columns
4505 ps-print-width))
4506
4507 (setq ps-print-height
4508 (- page-height ps-bottom-margin ps-top-margin))
4509 (if (<= ps-print-height 0)
4510 (error "Bad vertical layout:
4511 ps-top-margin == %s
4512 ps-bottom-margin == %s
4513 page-height == bm + print-height + tm
4514 => print-height == %d !"
4515 ps-top-margin
4516 ps-bottom-margin
4517 ps-print-height))
4518 ;; If headers are turned on, deduct the height of the header from the print
4519 ;; height.
4520 (if ps-print-header
4521 (setq ps-header-pad (* ps-header-line-pad
4522 (ps-title-line-height 'ps-font-for-header))
4523 ps-print-height (- ps-print-height
4524 ps-header-offset
4525 ps-header-pad
4526 (ps-title-line-height 'ps-font-for-header)
4527 (* (ps-line-height 'ps-font-for-header)
4528 (1- ps-header-lines))
4529 ps-header-pad)))
4530 (if (<= ps-print-height 0)
4531 (error "Bad vertical layout (header):
4532 ps-top-margin == %s
4533 ps-bottom-margin == %s
4534 ps-header-offset == %s
4535 ps-header-pad == %s
4536 header-height == %s
4537 page-height == bm + print-height + tm - ho - hh
4538 => print-height == %d !"
4539 ps-top-margin
4540 ps-bottom-margin
4541 ps-header-offset
4542 ps-header-pad
4543 (+ ps-header-pad
4544 (ps-title-line-height 'ps-font-for-header)
4545 (* (ps-line-height 'ps-font-for-header)
4546 (1- ps-header-lines))
4547 ps-header-pad)
4548 ps-print-height))
4549 ;; If footers are turned on, deduct the height of the footer from the print
4550 ;; height.
4551 (if ps-print-footer
4552 (setq ps-footer-pad (* ps-footer-line-pad
4553 (ps-title-line-height 'ps-font-for-footer))
4554 ps-print-height (- ps-print-height
4555 ps-footer-offset
4556 ps-footer-pad
4557 (* (ps-line-height 'ps-font-for-footer)
4558 (1- ps-footer-lines))
4559 ps-footer-pad)))
4560 (if (<= ps-print-height 0)
4561 (error "Bad vertical layout (footer):
4562 ps-top-margin == %s
4563 ps-bottom-margin == %s
4564 ps-footer-offset == %s
4565 ps-footer-pad == %s
4566 footer-height == %s
4567 page-height == bm + print-height + tm - fo - fh
4568 => print-height == %d !"
4569 ps-top-margin
4570 ps-bottom-margin
4571 ps-footer-offset
4572 ps-footer-pad
4573 (+ ps-footer-pad
4574 (* (ps-line-height 'ps-font-for-footer)
4575 (1- ps-footer-lines))
4576 ps-footer-pad)
4577 ps-print-height))
4578 ;; ps-zebra-stripe-follow is `full' or `full-follow'
4579 (if ps-zebra-stripe-full-p
4580 (let* ((line-height (ps-line-height 'ps-font-for-text))
4581 (zebra (* (+ line-height ps-line-spacing-internal)
4582 ps-zebra-stripe-height)))
4583 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
4584 line-height))
4585 (if (<= ps-print-height 0)
4586 (error "Bad vertical layout (full zebra stripe follow):
4587 ps-zebra-stripe-follow == %s
4588 ps-zebra-stripe-height == %s
4589 font-text-height == %s
4590 line-spacing == %s
4591 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
4592 => print-height == %d !"
4593 ps-zebra-stripe-follow
4594 ps-zebra-stripe-height
4595 (ps-line-height 'ps-font-for-text)
4596 ps-line-spacing-internal
4597 ps-print-height))))))
4598
4599
4600 (defun ps-print-preprint-region (prefix-arg)
4601 (or (ps-mark-active-p)
4602 (error "The mark is not set now"))
4603 (list (point) (mark) (ps-print-preprint prefix-arg)))
4604
4605
4606 (defun ps-print-preprint (prefix-arg)
4607 (and prefix-arg
4608 (or (numberp prefix-arg)
4609 (listp prefix-arg))
4610 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4611 (buffer-name)))
4612 ".ps"))
4613 (prompt (format "Save PostScript to file (default %s): " name))
4614 (res (read-file-name prompt default-directory name nil)))
4615 (while (cond ((file-directory-p res)
4616 (ding)
4617 (setq prompt "It's a directory"))
4618 ((not (file-writable-p res))
4619 (ding)
4620 (setq prompt "File is unwritable"))
4621 ((file-exists-p res)
4622 (setq prompt "File exists")
4623 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4624 res))))
4625 (t nil))
4626 (setq res (read-file-name
4627 (format "%s; save PostScript to file: " prompt)
4628 (file-name-directory res) nil nil
4629 (file-name-nondirectory res))))
4630 (if (file-directory-p res)
4631 (expand-file-name name (file-name-as-directory res))
4632 res))))
4633
4634 ;; The following functions implement a simple list-buffering scheme so
4635 ;; that ps-print doesn't have to repeatedly switch between buffers
4636 ;; while spooling. The functions `ps-output' and `ps-output-string' build
4637 ;; up the lists; the function `ps-flush-output' takes the lists and
4638 ;; insert its contents into the spool buffer (*PostScript*).
4639
4640 (defvar ps-string-escape-codes
4641 (let ((table (make-vector 256 nil))
4642 (char ?\000))
4643 ;; control characters
4644 (while (<= char ?\037)
4645 (aset table char (format "\\%03o" char))
4646 (setq char (1+ char)))
4647 ;; printable characters
4648 (while (< char ?\177)
4649 (aset table char (format "%c" char))
4650 (setq char (1+ char)))
4651 ;; DEL and 8-bit characters
4652 (while (<= char ?\377)
4653 (aset table char (format "\\%o" char))
4654 (setq char (1+ char)))
4655 ;; Override ASCII formatting characters with named escape code:
4656 (aset table ?\n "\\n") ; [NL] linefeed
4657 (aset table ?\r "\\r") ; [CR] carriage return
4658 (aset table ?\t "\\t") ; [HT] horizontal tab
4659 (aset table ?\b "\\b") ; [BS] backspace
4660 (aset table ?\f "\\f") ; [NP] form feed
4661 ;; Escape PostScript escape and string delimiter characters:
4662 (aset table ?\\ "\\\\")
4663 (aset table ?\( "\\(")
4664 (aset table ?\) "\\)")
4665 table)
4666 "Vector used to map characters to PostScript string escape codes.")
4667
4668 (defsubst ps-output-string-prim (string)
4669 (insert "(") ;insert start-string delimiter
4670 (save-excursion ;insert string
4671 (insert (string-as-unibyte string)))
4672 ;; Find and quote special characters as necessary for PS
4673 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4674 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4675 (let ((special (following-char)))
4676 (delete-char 1)
4677 (insert
4678 (if (and (<= 0 special) (<= special 255))
4679 (aref ps-string-escape-codes special)
4680 ;; insert hexadecimal representation if character code is out of range
4681 (format "\\%04X" special)
4682 ))))
4683 (goto-char (point-max))
4684 (insert ")")) ;insert end-string delimiter
4685
4686 (defsubst ps-init-output-queue ()
4687 (setq ps-output-head (list "")
4688 ps-output-tail ps-output-head))
4689
4690
4691 (defun ps-selected-pages ()
4692 (while (progn
4693 (setq ps-first-page (car (car ps-selected-pages))
4694 ps-last-page (cdr (car ps-selected-pages))
4695 ps-selected-pages (cdr ps-selected-pages))
4696 (and ps-selected-pages
4697 (< ps-last-page ps-page-postscript)))))
4698
4699
4700 (defsubst ps-print-page-p ()
4701 (setq ps-print-page-p
4702 (and (cond ((null ps-first-page))
4703 ((<= ps-page-postscript ps-last-page)
4704 (<= ps-first-page ps-page-postscript))
4705 (ps-selected-pages
4706 (ps-selected-pages)
4707 (and (<= ps-first-page ps-page-postscript)
4708 (<= ps-page-postscript ps-last-page)))
4709 (t
4710 nil))
4711 (cond ((eq ps-even-or-odd-pages 'even-page)
4712 (= (logand ps-page-postscript 1) 0))
4713 ((eq ps-even-or-odd-pages 'odd-page)
4714 (= (logand ps-page-postscript 1) 1))
4715 (t)
4716 ))))
4717
4718
4719 (defsubst ps-print-sheet-p ()
4720 (setq ps-print-page-p
4721 (cond ((eq ps-even-or-odd-pages 'even-sheet)
4722 (= (logand ps-page-sheet 1) 0))
4723 ((eq ps-even-or-odd-pages 'odd-sheet)
4724 (= (logand ps-page-sheet 1) 1))
4725 (t)
4726 )))
4727
4728
4729 (defun ps-output (&rest args)
4730 (when ps-print-page-p
4731 (setcdr ps-output-tail args)
4732 (while (cdr ps-output-tail)
4733 (setq ps-output-tail (cdr ps-output-tail)))))
4734
4735 (defun ps-output-string (string)
4736 (ps-output t string))
4737
4738 ;; Output strings in the list ARGS in the PostScript prologue part.
4739 (defun ps-output-prologue (args)
4740 (ps-output 'prologue (if (stringp args) (list args) args)))
4741
4742 (defun ps-flush-output ()
4743 (with-current-buffer ps-spool-buffer
4744 (goto-char (point-max))
4745 (while ps-output-head
4746 (let ((it (car ps-output-head)))
4747 (cond
4748 ((eq t it)
4749 (setq ps-output-head (cdr ps-output-head))
4750 (ps-output-string-prim (car ps-output-head)))
4751 ((eq 'prologue it)
4752 (setq ps-output-head (cdr ps-output-head))
4753 (save-excursion
4754 (search-backward "\nBeginDoc")
4755 (forward-char 1)
4756 (apply 'insert (car ps-output-head))))
4757 (t
4758 (insert it))))
4759 (setq ps-output-head (cdr ps-output-head))))
4760 (ps-init-output-queue))
4761
4762 (defun ps-insert-file (fname)
4763 (ps-flush-output)
4764 (with-current-buffer ps-spool-buffer
4765 (goto-char (point-max))
4766 (insert-file-contents fname)))
4767
4768 ;; These functions insert the arrays that define the contents of the headers.
4769
4770 (defvar ps-encode-header-string-function nil)
4771
4772 (defun ps-generate-header-line (fonttag &optional content)
4773 (ps-output " [" fonttag " ")
4774 (cond
4775 ;; Literal strings should be output as is -- the string must contain its own
4776 ;; PS string delimiters, '(' and ')', if necessary.
4777 ((stringp content)
4778 (ps-output content))
4779
4780 ;; Functions are called -- they should return strings; they will be inserted
4781 ;; as strings and the PS string delimiters added.
4782 ((functionp content)
4783 (if (functionp ps-encode-header-string-function)
4784 (dolist (l (funcall ps-encode-header-string-function
4785 (funcall content) fonttag))
4786 (ps-output-string l))
4787 (ps-output-string (funcall content))))
4788
4789 ;; Variables will have their contents inserted. They should contain
4790 ;; strings, and will be inserted as strings.
4791 ((and (symbolp content) (boundp content))
4792 (if (fboundp ps-encode-header-string-function)
4793 (dolist (l (funcall ps-encode-header-string-function
4794 (symbol-value content) fonttag))
4795 (ps-output-string l))
4796 (ps-output-string (symbol-value content))))
4797
4798 ;; Anything else will get turned into an empty string.
4799 (t
4800 (ps-output-string "")))
4801 (ps-output "]\n"))
4802
4803 (defun ps-generate-header (name fonttag0 fonttag1 contents)
4804 (ps-output "/" name "[\n")
4805 (and contents (> ps-header-lines 0)
4806 (let ((count 1))
4807 (ps-generate-header-line fonttag0 (car contents))
4808 (while (and (< count ps-header-lines)
4809 (setq contents (cdr contents)))
4810 (ps-generate-header-line fonttag1 (car contents))
4811 (setq count (1+ count)))))
4812 (ps-output "]def\n"))
4813
4814
4815 (defun ps-output-boolean (name bool)
4816 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
4817
4818
4819 (defun ps-output-frame-properties (name alist)
4820 (ps-output "/" name " ["
4821 (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
4822 (ps-format-color (cdr (assq 'back-color alist)) 0.9)
4823 (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
4824 (ps-format-color (cdr (assq 'border-color alist)) 0.0)
4825 (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
4826 "]def\n"))
4827
4828
4829 (defun ps-background-pages (page-list func)
4830 (if page-list
4831 (mapcar
4832 #'(lambda (pages)
4833 (let ((start (if (consp pages) (car pages) pages))
4834 (end (if (consp pages) (cdr pages) pages)))
4835 (and (integerp start) (integerp end) (<= start end)
4836 (add-to-list 'ps-background-pages (vector start end func)))))
4837 page-list)
4838 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4839
4840
4841 (defconst ps-boundingbox-re
4842 "^%%BoundingBox:\
4843 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4844
4845
4846 (defun ps-get-boundingbox ()
4847 (with-current-buffer ps-spool-buffer
4848 (save-excursion
4849 (if (re-search-forward ps-boundingbox-re nil t)
4850 (vector (string-to-number ; lower x
4851 (buffer-substring (match-beginning 1) (match-end 1)))
4852 (string-to-number ; lower y
4853 (buffer-substring (match-beginning 2) (match-end 2)))
4854 (string-to-number ; upper x
4855 (buffer-substring (match-beginning 3) (match-end 3)))
4856 (string-to-number ; upper y
4857 (buffer-substring (match-beginning 4) (match-end 4))))
4858 (vector 0 0 0 0)))))
4859
4860
4861 (defun ps-float-format (value &optional default)
4862 (let ((literal (or value default)))
4863 (cond ((null literal)
4864 " ")
4865 ((numberp literal)
4866 (format ps-float-format (* literal 1.0))) ; force float number
4867 (t
4868 (format "%s " literal))
4869 )))
4870
4871
4872 (defun ps-background-text ()
4873 (mapcar
4874 #'(lambda (text)
4875 (setq ps-background-text-count (1+ ps-background-text-count))
4876 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
4877 (ps-output-string (nth 0 text)) ; text
4878 (ps-output
4879 "\n"
4880 (ps-float-format (nth 4 text) 200.0) ; font size
4881 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
4882 (ps-float-format (nth 6 text)
4883 "PrintHeight PrintPageWidth atan") ; rotation
4884 (ps-float-format (nth 5 text) 0.85) ; gray
4885 (ps-float-format (nth 1 text) "0") ; x position
4886 (ps-float-format (nth 2 text) "0") ; y position
4887 "\nShowBackText}def\n")
4888 (ps-background-pages (nthcdr 7 text) ; page list
4889 (format "ShowBackText-%d\n"
4890 ps-background-text-count)))
4891 ps-print-background-text))
4892
4893
4894 (defun ps-background-image ()
4895 (mapcar
4896 #'(lambda (image)
4897 (let ((image-file (expand-file-name (nth 0 image))))
4898 (when (file-readable-p image-file)
4899 (setq ps-background-image-count (1+ ps-background-image-count))
4900 (ps-output
4901 (format "/ShowBackImage-%d{\n--back-- "
4902 ps-background-image-count)
4903 (ps-float-format (nth 5 image) 0.0) ; rotation
4904 (ps-float-format (nth 3 image) 1.0) ; x scale
4905 (ps-float-format (nth 4 image) 1.0) ; y scale
4906 (ps-float-format (nth 1 image) ; x position
4907 "PrintPageWidth 2 div")
4908 (ps-float-format (nth 2 image) ; y position
4909 "PrintHeight 2 div BottomMargin add")
4910 "\nBeginBackImage\n")
4911 (ps-insert-file image-file)
4912 ;; coordinate adjustment to center image
4913 ;; around x and y position
4914 (let ((box (ps-get-boundingbox)))
4915 (with-current-buffer ps-spool-buffer
4916 (save-excursion
4917 (if (re-search-backward "^--back--" nil t)
4918 (replace-match
4919 (format "%s %s"
4920 (ps-float-format
4921 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
4922 (aref box 0))))
4923 (ps-float-format
4924 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
4925 (aref box 1)))))
4926 t)))))
4927 (ps-output "\nEndBackImage}def\n")
4928 (ps-background-pages (nthcdr 6 image) ; page list
4929 (format "ShowBackImage-%d\n"
4930 ps-background-image-count)))))
4931 ps-print-background-image))
4932
4933
4934 (defun ps-background (page-number)
4935 (let (has-local-background)
4936 (mapc #'(lambda (range)
4937 (and (<= (aref range 0) page-number)
4938 (<= page-number (aref range 1))
4939 (if has-local-background
4940 (ps-output (aref range 2))
4941 (setq has-local-background t)
4942 (ps-output "/printLocalBackground{\n"
4943 (aref range 2)))))
4944 ps-background-pages)
4945 (and has-local-background (ps-output "}def\n"))))
4946
4947
4948 ;; Return a list of the distinct elements of LIST.
4949 ;; Elements are compared with `equal'.
4950 (defun ps-remove-duplicates (list)
4951 (let (new (tail list))
4952 (while tail
4953 (or (member (car tail) new)
4954 (setq new (cons (car tail) new)))
4955 (setq tail (cdr tail)))
4956 (nreverse new)))
4957
4958
4959 ;; Find the first occurrence of ITEM in LIST.
4960 ;; Return the index of the matching item, or nil if not found.
4961 ;; Elements are compared with `eq'.
4962 (defun ps-alist-position (item list)
4963 (let ((tail list) (index 0) found)
4964 (while tail
4965 (if (setq found (eq (car (car tail)) item))
4966 (setq tail nil)
4967 (setq index (1+ index)
4968 tail (cdr tail))))
4969 (and found index)))
4970
4971
4972 (defconst ps-n-up-database
4973 '((a4
4974 (1 nil 1 1 0)
4975 (2 t 1 2 0)
4976 (4 nil 2 2 0)
4977 (6 t 2 3 1)
4978 (8 t 2 4 0)
4979 (9 nil 3 3 0)
4980 (12 t 3 4 2)
4981 (16 nil 4 4 0)
4982 (18 t 3 6 0)
4983 (20 nil 5 4 1)
4984 (25 nil 5 5 0)
4985 (30 nil 6 5 1)
4986 (32 t 4 8 0)
4987 (36 nil 6 6 0)
4988 (42 nil 7 6 1)
4989 (49 nil 7 7 0)
4990 (50 t 5 10 0)
4991 (56 nil 8 7 1)
4992 (64 nil 8 8 0)
4993 (72 nil 9 8 1)
4994 (81 nil 9 9 0)
4995 (90 nil 10 9 1)
4996 (100 nil 10 10 0))
4997 (a3
4998 (1 nil 1 1 0)
4999 (2 t 1 2 0)
5000 (4 nil 2 2 0)
5001 (6 t 2 3 1)
5002 (8 t 2 4 0)
5003 (9 nil 3 3 0)
5004 (12 nil 4 3 1)
5005 (16 nil 4 4 0)
5006 (18 t 3 6 0)
5007 (20 nil 5 4 1)
5008 (25 nil 5 5 0)
5009 (30 nil 6 5 1)
5010 (32 t 4 8 0)
5011 (36 nil 6 6 0)
5012 (42 nil 7 6 1)
5013 (49 nil 7 7 0)
5014 (50 t 5 10 0)
5015 (56 nil 8 7 1)
5016 (64 nil 8 8 0)
5017 (72 nil 9 8 1)
5018 (81 nil 9 9 0)
5019 (90 nil 10 9 1)
5020 (100 nil 10 10 0))
5021 (letter
5022 (1 nil 1 1 0)
5023 (2 t 1 2 0) ; adjusted by PostScript code
5024 (4 nil 2 2 0)
5025 (6 t 2 3 0)
5026 (9 nil 3 3 0)
5027 (12 nil 4 3 1)
5028 (16 nil 4 4 0)
5029 (20 nil 5 4 1)
5030 (25 nil 5 5 0)
5031 (30 nil 6 5 1)
5032 (36 nil 6 6 0)
5033 (40 t 5 8 0)
5034 (42 nil 7 6 1)
5035 (49 nil 7 7 0)
5036 (56 nil 8 7 1)
5037 (64 nil 8 8 0)
5038 (72 nil 9 8 1)
5039 (81 nil 9 9 0)
5040 (90 nil 10 9 1)
5041 (100 nil 10 10 0))
5042 (legal
5043 (1 nil 1 1 0)
5044 (2 t 1 2 0)
5045 (4 nil 2 2 0)
5046 (6 nil 3 2 1)
5047 (9 nil 3 3 0)
5048 (10 t 2 5 0)
5049 (12 nil 4 3 1)
5050 (16 nil 4 4 0)
5051 (20 nil 5 4 1)
5052 (25 nil 5 5 0)
5053 (30 nil 6 5 1)
5054 (36 nil 6 6 0)
5055 (42 nil 7 6 1)
5056 (49 nil 7 7 0)
5057 (56 nil 8 7 1)
5058 (64 nil 8 8 0)
5059 (70 t 5 14 0)
5060 (72 nil 9 8 1)
5061 (81 nil 9 9 0)
5062 (90 nil 10 9 1)
5063 (100 nil 10 10 0))
5064 (letter-small
5065 (1 nil 1 1 0)
5066 (2 t 1 2 0) ; adjusted by PostScript code
5067 (4 nil 2 2 0)
5068 (6 t 2 3 0)
5069 (9 nil 3 3 0)
5070 (12 t 3 4 1)
5071 (15 t 3 5 0)
5072 (16 nil 4 4 0)
5073 (20 nil 5 4 1)
5074 (25 nil 5 5 0)
5075 (28 t 4 7 0)
5076 (30 nil 6 5 1)
5077 (36 nil 6 6 0)
5078 (40 t 5 8 0)
5079 (42 nil 7 6 1)
5080 (49 nil 7 7 0)
5081 (56 nil 8 7 1)
5082 (60 t 6 10 0)
5083 (64 nil 8 8 0)
5084 (72 ni 9 8 1)
5085 (81 nil 9 9 0)
5086 (84 t 7 12 0)
5087 (90 nil 10 9 1)
5088 (100 nil 10 10 0))
5089 (tabloid
5090 (1 nil 1 1 0)
5091 (2 t 1 2 0)
5092 (4 nil 2 2 0)
5093 (6 t 2 3 1)
5094 (8 t 2 4 0)
5095 (9 nil 3 3 0)
5096 (12 nil 4 3 1)
5097 (16 nil 4 4 0)
5098 (20 nil 5 4 1)
5099 (25 nil 5 5 0)
5100 (30 nil 6 5 1)
5101 (36 nil 6 6 0)
5102 (42 nil 7 6 1)
5103 (49 nil 7 7 0)
5104 (56 nil 8 7 1)
5105 (64 nil 8 8 0)
5106 (72 nil 9 8 1)
5107 (81 nil 9 9 0)
5108 (84 t 6 14 0)
5109 (90 nil 10 9 1)
5110 (100 nil 10 10 0))
5111 ;; Ledger paper size is a special case, it is the only paper size where the
5112 ;; normal size is landscaped, that is, the height is smaller than width.
5113 ;; So, we use the special value `pag' in the `landscape' field.
5114 (ledger
5115 (1 nil 1 1 0)
5116 (2 pag 1 2 0)
5117 (4 nil 2 2 0)
5118 (6 pag 2 3 1)
5119 (8 pag 2 4 0)
5120 (9 nil 3 3 0)
5121 (12 nil 4 3 1)
5122 (16 nil 4 4 0)
5123 (20 nil 5 4 1)
5124 (25 nil 5 5 0)
5125 (30 nil 6 5 1)
5126 (36 nil 6 6 0)
5127 (42 nil 7 6 1)
5128 (49 nil 7 7 0)
5129 (56 nil 8 7 1)
5130 (64 nil 8 8 0)
5131 (72 nil 9 8 1)
5132 (81 nil 9 9 0)
5133 (84 pag 6 14 0)
5134 (90 nil 10 9 1)
5135 (100 nil 10 10 0))
5136 (statement
5137 (1 nil 1 1 0)
5138 (2 t 1 2 0)
5139 (4 nil 2 2 0)
5140 (6 nil 3 2 1)
5141 (9 nil 3 3 0)
5142 (10 t 2 5 0)
5143 (12 nil 4 3 1)
5144 (16 nil 4 4 0)
5145 (20 nil 5 4 1)
5146 (21 t 3 7 0)
5147 (25 nil 5 5 0)
5148 (30 nil 6 5 1)
5149 (36 nil 6 6 0)
5150 (40 t 4 10 0)
5151 (42 nil 7 6 1)
5152 (49 nil 7 7 0)
5153 (56 nil 8 7 1)
5154 (60 t 5 12 0)
5155 (64 nil 8 8 0)
5156 (72 nil 9 8 1)
5157 (81 nil 9 9 0)
5158 (90 nil 10 9 1)
5159 (100 nil 10 10 0))
5160 (executive
5161 (1 nil 1 1 0)
5162 (2 t 1 2 0) ; adjusted by PostScript code
5163 (4 nil 2 2 0)
5164 (6 t 2 3 0)
5165 (9 nil 3 3 0)
5166 (12 nil 4 3 1)
5167 (16 nil 4 4 0)
5168 (20 nil 5 4 1)
5169 (25 nil 5 5 0)
5170 (28 t 4 7 0)
5171 (30 nil 6 5 1)
5172 (36 nil 6 6 0)
5173 (42 nil 7 6 1)
5174 (45 t 5 9 0)
5175 (49 nil 7 7 0)
5176 (56 nil 8 7 1)
5177 (60 t 6 10 0)
5178 (64 nil 8 8 0)
5179 (72 nil 9 8 1)
5180 (81 nil 9 9 0)
5181 (84 t 7 12 0)
5182 (90 nil 10 9 1)
5183 (100 nil 10 10 0))
5184 (a4small
5185 (1 nil 1 1 0)
5186 (2 t 1 2 0)
5187 (4 nil 2 2 0)
5188 (6 t 2 3 1)
5189 (8 t 2 4 0)
5190 (9 nil 3 3 0)
5191 (12 nil 4 3 1)
5192 (16 nil 4 4 0)
5193 (18 t 3 6 0)
5194 (20 nil 5 4 1)
5195 (25 nil 5 5 0)
5196 (30 nil 6 5 1)
5197 (32 t 4 8 0)
5198 (36 nil 6 6 0)
5199 (42 nil 7 6 1)
5200 (49 nil 7 7 0)
5201 (50 t 5 10 0)
5202 (56 nil 8 7 1)
5203 (64 nil 8 8 0)
5204 (72 nil 9 8 1)
5205 (78 t 6 13 0)
5206 (81 nil 9 9 0)
5207 (90 nil 10 9 1)
5208 (100 nil 10 10 0))
5209 (b4
5210 (1 nil 1 1 0)
5211 (2 t 1 2 0)
5212 (4 nil 2 2 0)
5213 (6 t 2 3 1)
5214 (8 t 2 4 0)
5215 (9 nil 3 3 0)
5216 (12 nil 4 3 1)
5217 (16 nil 4 4 0)
5218 (18 t 3 6 0)
5219 (20 nil 5 4 1)
5220 (25 nil 5 5 0)
5221 (30 nil 6 5 1)
5222 (32 t 4 8 0)
5223 (36 nil 6 6 0)
5224 (42 nil 7 6 1)
5225 (49 nil 7 7 0)
5226 (50 t 5 10 0)
5227 (56 nil 8 7 1)
5228 (64 nil 8 8 0)
5229 (72 nil 9 8 1)
5230 (81 nil 9 9 0)
5231 (90 nil 10 9 1)
5232 (100 nil 10 10 0))
5233 (b5
5234 (1 nil 1 1 0)
5235 (2 t 1 2 0)
5236 (4 nil 2 2 0)
5237 (6 t 2 3 1)
5238 (8 t 2 4 0)
5239 (9 nil 3 3 0)
5240 (12 nil 4 3 1)
5241 (16 nil 4 4 0)
5242 (18 t 3 6 0)
5243 (20 nil 5 4 1)
5244 (25 nil 5 5 0)
5245 (30 nil 6 5 1)
5246 (32 t 4 8 0)
5247 (36 nil 6 6 0)
5248 (42 nil 7 6 1)
5249 (49 nil 7 7 0)
5250 (50 t 5 10 0)
5251 (56 nil 8 7 1)
5252 (64 nil 8 8 0)
5253 (72 nil 9 8 0)
5254 (81 nil 9 9 0)
5255 (90 nil 10 9 1)
5256 (98 t 7 14 0)
5257 (100 nil 10 10 0)))
5258 "Alist which is the page matrix database used for N-up printing.
5259
5260 Each element has the following form:
5261
5262 (PAGE
5263 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
5264 ...)
5265
5266 Where:
5267 PAGE is the page size used (see `ps-paper-type').
5268 MAX is the maximum elements of this page matrix.
5269 LANDSCAPE specifies if page matrix is landscaped, has the following valid
5270 values:
5271 nil the sheet is in portrait mode.
5272 t the sheet is in landscape mode.
5273 pag the sheet is in portrait mode and page is in landscape mode.
5274 LINES is the number of lines of page matrix.
5275 COLUMNS is the number of columns of page matrix.
5276 COL-MISSING is the number of columns missing to fill the sheet.")
5277
5278
5279 (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
5280 (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
5281 (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
5282 (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
5283
5284
5285 (defun ps-n-up-printing ()
5286 ;; force `ps-n-up-printing' be in range 1 to 100.
5287 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
5288 ;; find suitable page matrix for a given `ps-paper-type'.
5289 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
5290 (and the-list
5291 (while (> ps-n-up-printing (caar the-list))
5292 (setq the-list (cdr the-list))))
5293 (or (car the-list)
5294 '(1 nil 1 1 0))))
5295
5296
5297 (defconst ps-n-up-filling-database
5298 '((left-top
5299 "PageWidth" ; N-Up-XColumn
5300 "0" ; N-Up-YColumn
5301 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5302 "LandscapePageHeight neg" ; N-Up-YLine
5303 "N-Up-Lines" ; N-Up-Repeat
5304 "N-Up-Columns" ; N-Up-End
5305 "0" ; N-Up-XStart
5306 "0") ; N-Up-YStart
5307 (left-bottom
5308 "PageWidth" ; N-Up-XColumn
5309 "0" ; N-Up-YColumn
5310 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5311 "LandscapePageHeight" ; N-Up-YLine
5312 "N-Up-Lines" ; N-Up-Repeat
5313 "N-Up-Columns" ; N-Up-End
5314 "0" ; N-Up-XStart
5315 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5316 (right-top
5317 "PageWidth neg" ; N-Up-XColumn
5318 "0" ; N-Up-YColumn
5319 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5320 "LandscapePageHeight neg" ; N-Up-YLine
5321 "N-Up-Lines" ; N-Up-Repeat
5322 "N-Up-Columns" ; N-Up-End
5323 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5324 "0") ; N-Up-YStart
5325 (right-bottom
5326 "PageWidth neg" ; N-Up-XColumn
5327 "0" ; N-Up-YColumn
5328 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5329 "LandscapePageHeight" ; N-Up-YLine
5330 "N-Up-Lines" ; N-Up-Repeat
5331 "N-Up-Columns" ; N-Up-End
5332 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5333 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5334 (top-left
5335 "0" ; N-Up-XColumn
5336 "LandscapePageHeight neg" ; N-Up-YColumn
5337 "PageWidth" ; N-Up-XLine
5338 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5339 "N-Up-Columns" ; N-Up-Repeat
5340 "N-Up-Lines" ; N-Up-End
5341 "0" ; N-Up-XStart
5342 "0") ; N-Up-YStart
5343 (bottom-left
5344 "0" ; N-Up-XColumn
5345 "LandscapePageHeight" ; N-Up-YColumn
5346 "PageWidth" ; N-Up-XLine
5347 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5348 "N-Up-Columns" ; N-Up-Repeat
5349 "N-Up-Lines" ; N-Up-End
5350 "0" ; N-Up-XStart
5351 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5352 (top-right
5353 "0" ; N-Up-XColumn
5354 "LandscapePageHeight neg" ; N-Up-YColumn
5355 "PageWidth neg" ; N-Up-XLine
5356 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5357 "N-Up-Columns" ; N-Up-Repeat
5358 "N-Up-Lines" ; N-Up-End
5359 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5360 "0") ; N-Up-YStart
5361 (bottom-right
5362 "0" ; N-Up-XColumn
5363 "LandscapePageHeight" ; N-Up-YColumn
5364 "PageWidth neg" ; N-Up-XLine
5365 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5366 "N-Up-Columns" ; N-Up-Repeat
5367 "N-Up-Lines" ; N-Up-End
5368 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5369 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
5370 "Alist for n-up printing initializations.
5371
5372 Each element has the following form:
5373
5374 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5375
5376 Where:
5377 KIND is a valid value of `ps-n-up-filling'.
5378 XCOL YCOL are the relative position for the next column.
5379 XLIN YLIN are the relative position for the beginning of next line.
5380 REPEAT is the number of repetions for external loop.
5381 END is the number of repetions for internal loop and also the number of pages in
5382 a row.
5383 XSTART YSTART are the relative position for the first page in a sheet.")
5384
5385
5386 (defun ps-n-up-filling ()
5387 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
5388 (assq 'left-top ps-n-up-filling-database))))
5389
5390
5391 (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
5392 (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
5393 (defmacro ps-n-up-xline (init) `(nth 2 ,init))
5394 (defmacro ps-n-up-yline (init) `(nth 3 ,init))
5395 (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
5396 (defmacro ps-n-up-end (init) `(nth 5 ,init))
5397 (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
5398 (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
5399
5400
5401 (defconst ps-error-handler-alist
5402 '((none . 0)
5403 (paper . 1)
5404 (system . 2)
5405 (paper-and-system . 3))
5406 "Alist for error handler message.")
5407
5408
5409 (defconst ps-zebra-stripe-alist
5410 '((follow . 1)
5411 (full . 2)
5412 (full-follow . 3))
5413 "Alist for zebra stripe continuation.")
5414
5415
5416 (defun ps-begin-file ()
5417 (setq ps-page-order 0
5418 ps-page-printed 0
5419 ps-background-text-count 0
5420 ps-background-image-count 0
5421 ps-background-pages nil
5422 ps-background-all-pages nil)
5423
5424 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
5425 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
5426 (n-up (ps-n-up-printing))
5427 (n-up-filling (ps-n-up-filling)))
5428 (and ps-n-up-on (setq tumble (not tumble)))
5429 (ps-output
5430 ps-adobe-tag
5431 "%%Title: " (buffer-name) ; Take job name from name of
5432 ; first buffer printed
5433 "\n%%Creator: ps-print v" ps-print-version
5434 "\n%%For: " (user-full-name)
5435 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
5436 "\n%%Orientation: "
5437 (if ps-landscape-mode "Landscape" "Portrait")
5438 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
5439 (mapconcat 'identity
5440 (ps-remove-duplicates
5441 (append (ps-fonts 'ps-font-for-text)
5442 (list (ps-font 'ps-font-for-header 'normal)
5443 (ps-font 'ps-font-for-header 'bold)
5444 (ps-font 'ps-font-for-footer 'normal)
5445 (ps-font 'ps-font-for-footer 'bold))))
5446 "\n%%+ font ")
5447 "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
5448 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
5449 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
5450 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
5451 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
5452 (if ps-spool-duplex
5453 (if tumble " duplex(tumble)\n" " duplex\n")
5454 "\n"))
5455
5456 (ps-insert-string ps-print-prologue-header)
5457
5458 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5459 (ps-page-dimensions-get-media dimensions)
5460 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
5461 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5462 (format "/ErrorMessage %s def\n\n"
5463 (or (cdr (assoc ps-error-handler-message
5464 ps-error-handler-alist))
5465 1)) ; send to paper
5466 ps-print-prologue-0
5467 "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
5468
5469 (ps-insert-string ps-user-defined-prologue)
5470
5471 (ps-output "\n%%EndResource\n\n")
5472
5473 (ps-output-boolean "LandscapeMode "
5474 (or ps-landscape-mode
5475 (eq (ps-n-up-landscape n-up) 'pag)))
5476 (ps-output-boolean "UpsideDown " ps-print-upside-down)
5477 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
5478
5479 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
5480 (format "/PrintPageWidth %s def\n"
5481 (- (* (+ ps-print-width ps-inter-column)
5482 ps-number-of-columns)
5483 ps-inter-column))
5484 (format "/PrintWidth %s def\n" ps-print-width)
5485 (format "/PrintHeight %s def\n" ps-print-height)
5486
5487 (format "/LeftMargin %s def\n" ps-left-margin)
5488 (format "/RightMargin %s def\n" ps-right-margin)
5489 (format "/InterColumn %s def\n" ps-inter-column)
5490
5491 (format "/BottomMargin %s def\n" ps-bottom-margin)
5492 (format "/TopMargin %s def\n" ps-top-margin) ; not used
5493 (format "/HeaderOffset %s def\n" ps-header-offset)
5494 (format "/HeaderPad %s def\n" ps-header-pad)
5495 (format "/FooterOffset %s def\n" ps-footer-offset)
5496 (format "/FooterPad %s def\n" ps-footer-pad)
5497 (format "/FooterLines %s def\n" ps-footer-lines))
5498
5499 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
5500 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
5501 ps-spool-duplex
5502 ps-switch-header))
5503 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
5504 (ps-output-boolean "PrintHeader " ps-print-header)
5505 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
5506 (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist)
5507 (ps-output-boolean "PrintFooter " ps-print-footer)
5508 (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame)
5509 (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist)
5510
5511 (let ((line-height (ps-line-height 'ps-font-for-text)))
5512 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
5513 (format "/ParagraphSpacing %s def\n"
5514 ps-paragraph-spacing-internal)
5515 (format "/LineHeight %s def\n" line-height)
5516 (format "/LinesPerColumn %d def\n"
5517 (let ((height (+ line-height
5518 ps-line-spacing-internal)))
5519 (round (/ (+ ps-print-height
5520 (* height 0.45))
5521 height))))))
5522
5523 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
5524 (ps-output-boolean "Zebra " ps-zebra-stripes)
5525 (ps-output-boolean "PrintLineNumber " ps-line-number)
5526 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
5527 (ps-output (format "/ZebraFollow %d def\n"
5528 (or (cdr (assq ps-zebra-stripe-follow
5529 ps-zebra-stripe-alist))
5530 0))
5531 (format "/PrintLineStep %d def\n"
5532 (if (integerp ps-line-number-step)
5533 ps-line-number-step
5534 ps-zebra-stripe-height))
5535 (format "/PrintLineStart %d def\n" ps-line-number-start)
5536 "/LineNumberColor "
5537 (ps-format-color ps-line-number-color 0.0)
5538 (format "def\n/ZebraHeight %d def\n"
5539 ps-zebra-stripe-height)
5540 "/ZebraColor "
5541 (ps-format-color ps-zebra-color 0.95)
5542 "def\n")
5543 (ps-output "/BackgroundColor "
5544 (ps-format-color ps-default-background 1.0)
5545 "def\n")
5546 (ps-output "/UseSetpagedevice "
5547 (if (eq ps-spool-config 'setpagedevice)
5548 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5549 "false")
5550 " def\n\n/PageWidth "
5551 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
5552 (format "/N-Up %d def\n" ps-n-up-printing))
5553 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
5554 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
5555 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
5556 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
5557 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
5558 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
5559 "/N-Up-Repeat "
5560 (if ps-landscape-mode
5561 (ps-n-up-end n-up-filling)
5562 (ps-n-up-repeat n-up-filling))
5563 " def\n/N-Up-End "
5564 (if ps-landscape-mode
5565 (ps-n-up-repeat n-up-filling)
5566 (ps-n-up-end n-up-filling))
5567 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
5568 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
5569 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
5570 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
5571 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
5572 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
5573
5574 (ps-background-text)
5575 (ps-background-image)
5576 (setq ps-background-all-pages (nreverse ps-background-all-pages)
5577 ps-background-pages (nreverse ps-background-pages))
5578
5579 (ps-output "\n" ps-print-prologue-1
5580 "\n/printGlobalBackground{\n")
5581 (mapc 'ps-output ps-background-all-pages)
5582 (ps-output
5583 "}def\n/printLocalBackground{\n}def\n"
5584 "\n%%EndProlog\n\n%%BeginSetup\n"
5585 "\n%%IncludeResource: font Times-Roman"
5586 "\n%%IncludeResource: font Times-Italic"
5587 "\n%%IncludeResource: font "
5588 (mapconcat 'identity
5589 (ps-remove-duplicates
5590 (append (ps-fonts 'ps-font-for-text)
5591 (list (ps-font 'ps-font-for-header 'normal)
5592 (ps-font 'ps-font-for-header 'bold)
5593 (ps-font 'ps-font-for-footer 'normal)
5594 (ps-font 'ps-font-for-footer 'bold))))
5595 "\n%%IncludeResource: font ")
5596 ;; Header/line number fonts
5597 (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
5598 ps-header-title-font-size-internal
5599 (ps-font 'ps-font-for-header 'bold))
5600 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
5601 ps-header-font-size-internal
5602 (ps-font 'ps-font-for-header 'normal))
5603 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
5604 (ps-get-font-size 'ps-line-number-font-size)
5605 ps-line-number-font)
5606 (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
5607 ps-footer-font-size-internal
5608 (ps-font 'ps-font-for-footer 'normal))
5609 "\n\n% ---- These lines must be kept together because...
5610
5611 /h0 F
5612 /HeaderTitleLineHeight FontHeight def
5613
5614 /h1 F
5615 /HeaderLineHeight FontHeight def
5616 /HeaderDescent Descent def
5617
5618 /H0 F
5619 /FooterLineHeight FontHeight def
5620 /FooterDescent Descent def
5621
5622 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
5623
5624 ;; Text fonts
5625 (let ((font (ps-font-alist 'ps-font-for-text))
5626 (i 0))
5627 (while font
5628 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
5629 i
5630 ps-font-size-internal
5631 (ps-font 'ps-font-for-text (car (car font)))))
5632 (setq font (cdr font)
5633 i (1+ i))))
5634
5635 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
5636 (ps-output (format "/SpaceWidthRatio %f def\n"
5637 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
5638
5639 (unless (eq ps-spool-config 'lpr-switches)
5640 (ps-output "\n%%BeginFeature: *Duplex "
5641 (ps-boolean-capitalized ps-spool-duplex)
5642 " *Tumble "
5643 (ps-boolean-capitalized tumble)
5644 "\nUseSetpagedevice\n{BMark/Duplex "
5645 (ps-boolean-constant ps-spool-duplex)
5646 "/Tumble "
5647 (ps-boolean-constant tumble)
5648 " EMark setpagedevice}\n{statusdict begin "
5649 (ps-boolean-constant ps-spool-duplex)
5650 " setduplexmode "
5651 (ps-boolean-constant tumble)
5652 " settumble end}ifelse\n%%EndFeature\n")))
5653 (ps-output "\n%%BeginFeature: *ManualFeed "
5654 (ps-boolean-capitalized ps-manual-feed)
5655 "\nBMark /ManualFeed "
5656 (ps-boolean-constant ps-manual-feed)
5657 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
5658 (and ps-banner-page-when-duplexing
5659 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
5660
5661
5662 (defun ps-format-color (color &optional default)
5663 (let ((the-color (if (stringp color)
5664 (ps-color-scale color)
5665 color)))
5666 (if (and the-color (listp the-color))
5667 (concat "["
5668 (format ps-color-format
5669 (* (nth 0 the-color) 1.0) ; force float number
5670 (* (nth 1 the-color) 1.0) ; force float number
5671 (* (nth 2 the-color) 1.0)) ; force float number
5672 "] ")
5673 (ps-float-format (if (numberp the-color) the-color default)))))
5674
5675
5676 (defun ps-insert-string (prologue)
5677 (let ((str (if (functionp prologue)
5678 (funcall prologue)
5679 prologue)))
5680 (and (stringp str)
5681 (ps-output str))))
5682
5683
5684 (defun ps-boolean-capitalized (bool)
5685 (if bool "True" "False"))
5686
5687
5688 (defun ps-boolean-constant (bool)
5689 (if bool "true" "false"))
5690
5691
5692 (defun ps-header-dirpart ()
5693 (let ((fname (buffer-file-name)))
5694 (if fname
5695 (if (string-equal (buffer-name) (file-name-nondirectory fname))
5696 (abbreviate-file-name (file-name-directory fname))
5697 fname)
5698 "")))
5699
5700
5701 (defun ps-get-buffer-name ()
5702 (cond
5703 ;; Indulge Jim this little easter egg:
5704 ((string= (buffer-name) "ps-print.el")
5705 "Hey, Cool! It's ps-print.el!!!")
5706 ;; Indulge Jack this other little easter egg:
5707 ((string= (buffer-name) "sokoban.el")
5708 "Super! C'est sokoban.el!")
5709 (t (concat
5710 (and ps-printing-region-p "Subset of: ")
5711 (buffer-name)
5712 (and (buffer-modified-p) " (unsaved)")))))
5713
5714
5715 (defun ps-get-size (size mess &optional arg)
5716 (let ((siz (cond ((numberp size)
5717 size)
5718 ((and (consp size)
5719 (numberp (car size))
5720 (numberp (cdr size)))
5721 (if ps-landscape-mode
5722 (car size)
5723 (cdr size)))
5724 (t
5725 -1))))
5726 (and (< siz 0)
5727 (error "Invalid %s `%S'%s"
5728 mess size
5729 (if arg
5730 (format " for `%S'" arg)
5731 "")))
5732 siz))
5733
5734
5735 (defun ps-get-font-size (font-sym)
5736 (ps-get-size (symbol-value font-sym) "font size" font-sym))
5737
5738
5739 (defun ps-rgb-color (color unspecified default)
5740 (cond
5741 ;; (float float float) ==> (R G B)
5742 ((and color (listp color) (= (length color) 3)
5743 (let ((cl color)
5744 (ok t) e)
5745 (while (and ok cl)
5746 (setq e (car cl)
5747 cl (cdr cl)
5748 ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
5749 ok))
5750 color)
5751 ;; float ==> 0.0 = black .. 1.0 = white
5752 ((and (floatp color) (<= 0.0 color) (<= color 1.0))
5753 (list color color color))
5754 ;; "colorName" but different from "unspecified-[bf]g"
5755 ((and (stringp color) (not (string= color unspecified)))
5756 (ps-color-scale color))
5757 ;; ok, use the default
5758 (t
5759 (list default default default))))
5760
5761 (defvar ps-basic-plot-string-function 'ps-basic-plot-string)
5762
5763 (defun ps-begin-job (genfunc)
5764 ;; prologue files
5765 (or (equal ps-mark-code-directory ps-postscript-code-directory)
5766 (setq ps-print-prologue-0 (ps-prologue-file 0)
5767 ps-print-prologue-1 (ps-prologue-file 1)
5768 ps-mark-code-directory ps-postscript-code-directory))
5769 ;; selected pages
5770 (let (new page)
5771 (while ps-selected-pages
5772 (setq page (car ps-selected-pages)
5773 ps-selected-pages (cdr ps-selected-pages))
5774 (cond ((integerp page)
5775 (and (> page 0)
5776 (setq new (cons (cons page page) new))))
5777 ((consp page)
5778 (and (integerp (car page)) (integerp (cdr page))
5779 (> (car page) 0)
5780 (<= (car page) (cdr page))
5781 (setq new (cons page new))))))
5782 (setq ps-selected-pages (sort new #'(lambda (one other)
5783 (< (car one) (car other))))
5784 ps-last-selected-pages ps-selected-pages
5785 ps-first-page nil
5786 ps-last-page nil))
5787 ;; face background
5788 (or (listp ps-use-face-background)
5789 (setq ps-use-face-background t))
5790 ;; line number
5791 (and (integerp ps-line-number-step)
5792 (<= ps-line-number-step 0)
5793 (setq ps-line-number-step 1))
5794 (setq ps-n-up-on (> ps-n-up-printing 1)
5795 ps-line-number-start (max 1 (min ps-line-number-start
5796 (if (integerp ps-line-number-step)
5797 ps-line-number-step
5798 ps-zebra-stripe-height))))
5799 ;; spooling buffer
5800 (with-current-buffer ps-spool-buffer
5801 (goto-char (point-max))
5802 (and (re-search-backward "^%%Trailer$" nil t)
5803 (delete-region (match-beginning 0) (point-max))))
5804 ;; miscellaneous
5805 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5806 '(full full-follow))
5807 ps-page-postscript 0
5808 ps-page-sheet 0
5809 ps-page-n-up 0
5810 ps-page-column 0
5811 ps-lines-printed 0
5812 ps-print-page-p t
5813 ps-showline-count (car ps-printing-region)
5814 ps-line-spacing-internal (ps-get-size ps-line-spacing
5815 "line spacing")
5816 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
5817 "paragraph spacing")
5818 ps-font-size-internal (ps-get-font-size 'ps-font-size)
5819 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
5820 ps-header-title-font-size-internal
5821 (ps-get-font-size 'ps-header-title-font-size)
5822 ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
5823 ps-control-or-escape-regexp
5824 (cond ((eq ps-print-control-characters '8-bit)
5825 (string-as-unibyte "[\000-\037\177-\377]"))
5826 ((eq ps-print-control-characters 'control-8-bit)
5827 (string-as-unibyte "[\000-\037\177-\237]"))
5828 ((eq ps-print-control-characters 'control)
5829 "[\000-\037\177]")
5830 (t "[\t\n\f]"))
5831 ;; Set the color scale. We do it here instead of in the defvar so
5832 ;; that ps-print can be dumped into emacs. This expression can't be
5833 ;; evaluated at dump-time because X isn't initialized.
5834 ps-color-p (and ps-print-color-p (ps-color-device))
5835 ps-print-color-scale (if ps-color-p
5836 (float (car (ps-color-values "white")))
5837 1.0)
5838 ps-default-background (ps-rgb-color
5839 (cond
5840 ((or (member ps-print-color-p
5841 '(nil back-white))
5842 (eq genfunc 'ps-generate-postscript))
5843 nil)
5844 ((eq ps-default-bg 'frame-parameter)
5845 (ps-frame-parameter nil 'background-color))
5846 ((eq ps-default-bg t)
5847 (ps-face-background-name 'default))
5848 (t
5849 ps-default-bg))
5850 "unspecified-bg"
5851 1.0)
5852 ps-default-foreground (ps-rgb-color
5853 (cond
5854 ((or (member ps-print-color-p
5855 '(nil back-white))
5856 (eq genfunc 'ps-generate-postscript))
5857 nil)
5858 ((eq ps-default-fg 'frame-parameter)
5859 (ps-frame-parameter nil 'foreground-color))
5860 ((eq ps-default-fg t)
5861 (ps-face-foreground-name 'default))
5862 (t
5863 ps-default-fg))
5864 "unspecified-fg"
5865 0.0)
5866 ps-foreground-list (mapcar
5867 #'(lambda (arg)
5868 (ps-rgb-color arg "unspecified-fg" 0.0))
5869 (append (and (not (member ps-print-color-p
5870 '(nil back-white)))
5871 ps-fg-list)
5872 (list ps-default-foreground
5873 "black")))
5874 ps-default-color (and (not (member ps-print-color-p
5875 '(nil back-white)))
5876 ps-default-foreground)
5877 ps-current-color ps-default-color
5878 ;; Set up default functions.
5879 ;; They may be overridden by ps-mule-begin-job.
5880 ps-basic-plot-string-function 'ps-basic-plot-string
5881 ps-encode-header-string-function nil)
5882 ;; initialize page dimensions
5883 (ps-get-page-dimensions)
5884 ;; final check
5885 (unless (listp ps-lpr-switches)
5886 (error "`ps-lpr-switches' value should be a list"))
5887 (and ps-color-p
5888 (equal ps-default-background ps-default-foreground)
5889 (error
5890 (concat
5891 "`ps-default-fg' and `ps-default-bg' have the same color.\n"
5892 "Text won't appear on page. Please, check these variables."))))
5893
5894
5895 (defun ps-page-number ()
5896 (if ps-print-only-one-header
5897 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5898 ps-page-column))
5899
5900
5901 (defsubst ps-end-page ()
5902 (ps-output "EndPage\nEndDSCPage\n"))
5903
5904
5905 (defsubst ps-next-page ()
5906 (ps-end-page)
5907 (ps-flush-output)
5908 (ps-begin-page))
5909
5910
5911 (defun ps-end-sheet ()
5912 (and ps-print-page-p (> ps-page-sheet 0)
5913 (ps-output "EndSheet\n")))
5914
5915
5916 (defun ps-header-sheet ()
5917 ;; Print only when a new sheet begins.
5918 (ps-end-sheet)
5919 (setq ps-page-sheet (1+ ps-page-sheet))
5920 (when (ps-print-sheet-p)
5921 (setq ps-page-order (1+ ps-page-order))
5922 (ps-output (if ps-n-up-on
5923 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5924 ps-page-order ps-page-postscript ps-page-order)
5925 (format "\n%%%%Page: %d %d\n"
5926 ps-page-postscript ps-page-order))
5927 ;; spooling needs to redefine Lines and PageCount on each page
5928 "/Lines 0 def\n/PageCount 0 def\n"
5929 (format "%d BeginSheet\nBeginDSCPage\n"
5930 ps-n-up-printing))))
5931
5932
5933 (defun ps-header-page ()
5934 ;; set total line and page number when printing has finished
5935 ;; (see `ps-generate')
5936 (if (zerop (mod ps-page-column ps-number-of-columns))
5937 (progn
5938 (setq ps-page-postscript (1+ ps-page-postscript))
5939 (when (ps-print-page-p)
5940 (ps-print-sheet-p)
5941 (if (zerop (mod ps-page-n-up ps-n-up-printing))
5942 ;; Print only when a new sheet begins.
5943 (progn
5944 (ps-header-sheet)
5945 (run-hooks 'ps-print-begin-sheet-hook))
5946 ;; Print only when a new page begins.
5947 (ps-output "BeginDSCPage\n")
5948 (run-hooks 'ps-print-begin-page-hook))
5949 (ps-background ps-page-postscript)
5950 (setq ps-page-n-up (1+ ps-page-n-up))
5951 (and ps-print-page-p
5952 (setq ps-page-printed (1+ ps-page-printed)))))
5953 ;; Print only when a new column begins.
5954 (ps-output "BeginDSCPage\n")
5955 (run-hooks 'ps-print-begin-column-hook))
5956 (setq ps-page-column (1+ ps-page-column)))
5957
5958 (defun ps-begin-page ()
5959 (setq ps-width-remaining ps-print-width
5960 ps-height-remaining ps-print-height)
5961
5962 (ps-header-page)
5963
5964 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
5965 (format "/PageNumber %d def\n" (ps-page-number)))
5966
5967 (when ps-print-header
5968 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
5969 (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
5970 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
5971
5972 (when ps-print-footer
5973 (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
5974 (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
5975 (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
5976
5977 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
5978 (ps-set-font ps-current-font)
5979 (ps-set-bg ps-current-bg)
5980 (ps-set-color ps-current-color))
5981
5982 (defsubst ps-skip-newline (limit)
5983 (setq ps-showline-count (1+ ps-showline-count)
5984 ps-lines-printed (1+ ps-lines-printed))
5985 (and (< (point) limit)
5986 (forward-char 1)))
5987
5988 (defsubst ps-next-line ()
5989 (setq ps-showline-count (1+ ps-showline-count)
5990 ps-lines-printed (1+ ps-lines-printed))
5991 (let* ((paragraph-p (and ps-paragraph-regexp
5992 (looking-at ps-paragraph-regexp)))
5993 (lh (+ (ps-line-height 'ps-font-for-text)
5994 (if paragraph-p
5995 ps-paragraph-spacing-internal
5996 ps-line-spacing-internal))))
5997 (if (< ps-height-remaining lh)
5998 (ps-next-page)
5999 (setq ps-width-remaining ps-print-width
6000 ps-height-remaining (- ps-height-remaining lh))
6001 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
6002
6003 (defun ps-continue-line ()
6004 (setq ps-lines-printed (1+ ps-lines-printed))
6005 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
6006 (if (< ps-height-remaining lh)
6007 (ps-next-page)
6008 (setq ps-width-remaining ps-print-width
6009 ps-height-remaining (- ps-height-remaining lh))
6010 (ps-output "SL\n"))))
6011
6012 (defun ps-find-wrappoint (from to char-width)
6013 (let ((avail (truncate (/ ps-width-remaining char-width)))
6014 (todo (- to from)))
6015 (if (< todo avail)
6016 (cons to (* todo char-width))
6017 (cons (+ from avail) ps-width-remaining))))
6018
6019 (defun ps-basic-plot-str (from to string)
6020 (let* ((wrappoint (ps-find-wrappoint from to
6021 (ps-avg-char-width 'ps-font-for-text)))
6022 (to (car wrappoint))
6023 (str (substring string from to)))
6024 (ps-output-string str)
6025 (ps-output " S\n")
6026 wrappoint))
6027
6028 (defun ps-basic-plot-string (from to &optional bg-color)
6029 (let* ((wrappoint (ps-find-wrappoint from to
6030 (ps-avg-char-width 'ps-font-for-text)))
6031 (to (car wrappoint))
6032 (string (buffer-substring-no-properties from to)))
6033 (ps-output-string string)
6034 (ps-output " S\n")
6035 wrappoint))
6036
6037 (defun ps-basic-plot-whitespace (from to &optional bg-color)
6038 (let* ((wrappoint (ps-find-wrappoint from to
6039 (ps-space-width 'ps-font-for-text)))
6040 (to (car wrappoint)))
6041 (ps-output (format "%d W\n" (- to from)))
6042 wrappoint))
6043
6044 (defun ps-plot (plotfunc from to &optional bg-color)
6045 (while (< from to)
6046 (let* ((wrappoint (funcall plotfunc from to bg-color))
6047 (plotted-to (car wrappoint))
6048 (plotted-width (cdr wrappoint)))
6049 (setq from plotted-to
6050 ps-width-remaining (- ps-width-remaining plotted-width))
6051 (if (< from to)
6052 (ps-continue-line))))
6053 (if ps-razzle-dazzle
6054 (let* ((q-todo (- (point-max) (point-min)))
6055 (q-done (- (point) (point-min)))
6056 (chunkfrac (/ q-todo 8))
6057 (chunksize (min chunkfrac 1000)))
6058 (if (> (- q-done ps-razchunk) chunksize)
6059 (progn
6060 (setq ps-razchunk q-done)
6061 (message "Formatting...%3d%%"
6062 (if (< q-todo 100)
6063 (/ (* 100 q-done) q-todo)
6064 (/ q-done (/ q-todo 100)))
6065 ))))))
6066
6067 (defvar ps-last-font nil)
6068
6069 (defun ps-set-font (font)
6070 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
6071 (ps-output (format "/%s F\n" ps-last-font)))
6072
6073 (defun ps-set-bg (color)
6074 (if (setq ps-current-bg color)
6075 (ps-output (format ps-color-format
6076 (nth 0 color) (nth 1 color) (nth 2 color))
6077 " true BG\n")
6078 (ps-output "false BG\n")))
6079
6080 (defun ps-set-color (color)
6081 (setq ps-current-color (or color ps-default-foreground))
6082 (ps-output (format ps-color-format
6083 (nth 0 ps-current-color)
6084 (nth 1 ps-current-color) (nth 2 ps-current-color))
6085 " FG\n"))
6086
6087
6088 (defsubst ps-plot-string (string)
6089 (ps-plot 'ps-basic-plot-str 0 (length string) string))
6090
6091
6092 (defvar ps-current-effect 0)
6093
6094 (defvar ps-print-translation-table
6095 (let ((tbl (make-char-table 'translation-table nil)))
6096 (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
6097 (char-table-p ucs-mule-8859-to-mule-unicode))
6098 (map-char-table
6099 #'(lambda (k v)
6100 (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
6101 (aset tbl k v)))
6102 ucs-mule-8859-to-mule-unicode))
6103 tbl)
6104 "Translation table for PostScript printing.
6105 The default value is a table that translates non-Latin-1 Latin characters
6106 to the equivalent Latin-1 characters.")
6107
6108 (defun ps-plot-region (from to font &optional fg-color bg-color effects)
6109 (or (equal font ps-current-font)
6110 (ps-set-font font))
6111
6112 ;; Specify a foreground color only if:
6113 ;; one's specified,
6114 ;; it's different than the background (if `ps-fg-validate-p' is non-nil)
6115 ;; and it's different than the current.
6116 (let ((fg (or fg-color ps-default-foreground)))
6117 (if ps-fg-validate-p
6118 (let ((bg (or bg-color ps-default-background))
6119 (el ps-foreground-list))
6120 (while (and el (equal fg bg))
6121 (setq fg (car el)
6122 el (cdr el)))))
6123 (or (equal fg ps-current-color)
6124 (ps-set-color fg)))
6125
6126 (or (equal bg-color ps-current-bg)
6127 (ps-set-bg bg-color))
6128
6129 ;; Specify effects (underline, overline, box, etc.)
6130 (cond
6131 ((not (integerp effects))
6132 (ps-output "0 EF\n")
6133 (setq ps-current-effect 0))
6134 ((/= effects ps-current-effect)
6135 (ps-output (number-to-string effects) " EF\n")
6136 (setq ps-current-effect effects)))
6137
6138 ;; Starting at the beginning of the specified region...
6139 (save-excursion
6140 (goto-char from)
6141
6142 ;; ...break the region up into chunks separated by tabs, linefeeds,
6143 ;; pagefeeds, control characters, and plot each chunk.
6144 (while (< from to)
6145 ;; skip lines between cut markers
6146 (and ps-begin-cut-regexp ps-end-cut-regexp
6147 (looking-at ps-begin-cut-regexp)
6148 (progn
6149 (goto-char (match-end 0))
6150 (and (re-search-forward ps-end-cut-regexp to 'noerror)
6151 (= (following-char) ?\n)
6152 (forward-char 1))
6153 (setq from (point))))
6154 (if (re-search-forward ps-control-or-escape-regexp to t)
6155 ;; region with some control characters or some multi-byte characters
6156 (let* ((match-point (match-beginning 0))
6157 (match (char-after match-point)))
6158 (when (< from match-point)
6159 (ps-plot ps-basic-plot-string-function
6160 from match-point bg-color))
6161 (cond
6162 ((= match ?\t) ; tab
6163 (let ((linestart (line-beginning-position)))
6164 (forward-char -1)
6165 (setq from (+ linestart (current-column)))
6166 (when (re-search-forward "[ \t]+" to t)
6167 (ps-plot 'ps-basic-plot-whitespace
6168 from (+ linestart (current-column))
6169 bg-color))))
6170
6171 ((= match ?\n) ; newline
6172 (if (looking-at "\f[^\n]")
6173 ;; \n\ftext\n ==>> next page, but keep line counting!!
6174 (progn
6175 (ps-skip-newline to)
6176 (ps-next-page))
6177 ;; \n\f\n ==>> it'll be handled by form feed
6178 ;; \ntext\n ==>> next line
6179 (ps-next-line)))
6180
6181 ((= match ?\f) ; form feed
6182 ;; do not skip page if previous character is NEWLINE and
6183 ;; it is a beginning of page.
6184 (unless (and (equal (char-after (1- match-point)) ?\n)
6185 (= ps-height-remaining ps-print-height))
6186 ;; \f\n ==>> skip \n, but keep line counting!!
6187 (and (equal (following-char) ?\n)
6188 (ps-skip-newline to))
6189 (ps-next-page)))
6190
6191 (t ; characters from 127 to 255
6192 (ps-control-character match)))
6193 (setq from (point)))
6194 ;; region without control characters
6195 (ps-plot ps-basic-plot-string-function from to bg-color)
6196 (setq from to)))))
6197
6198 (defvar ps-string-control-codes
6199 (let ((table (make-vector 256 nil))
6200 (char ?\000))
6201 ;; control character
6202 (while (<= char ?\037)
6203 (aset table char (format "^%c" (+ char ?@)))
6204 (setq char (1+ char)))
6205 ;; printable character
6206 (while (< char ?\177)
6207 (aset table char (format "%c" char))
6208 (setq char (1+ char)))
6209 ;; DEL
6210 (aset table char "^?")
6211 ;; 8-bit character
6212 (while (<= (setq char (1+ char)) ?\377)
6213 (aset table char (format "\\%o" char)))
6214 table)
6215 "Vector used to map characters to a printable string.")
6216
6217 (defun ps-control-character (char)
6218 (let* ((str (aref ps-string-control-codes char))
6219 (from (1- (point)))
6220 (len (length str))
6221 (to (+ from len))
6222 (char-width (ps-avg-char-width 'ps-font-for-text))
6223 (wrappoint (ps-find-wrappoint from to char-width)))
6224 (if (< (car wrappoint) to)
6225 (ps-continue-line))
6226 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
6227 (ps-output-string str)
6228 (ps-output " S\n")))
6229
6230
6231 (defsubst ps-face-foreground-color-p (attr)
6232 (memq attr '(foreground-color :foreground)))
6233
6234
6235 (defsubst ps-face-background-color-p (attr)
6236 (memq attr '(background-color :background)))
6237
6238
6239 (defsubst ps-face-color-p (attr)
6240 (memq attr '(foreground-color :foreground background-color :background)))
6241
6242
6243 (defun ps-face-extract-color (face-attrs)
6244 (let ((color (cdr face-attrs)))
6245 (if (listp color)
6246 (car color)
6247 color)))
6248
6249
6250 (defun ps-face-attributes (face)
6251 "Return face attribute vector.
6252
6253 If FACE is not in `ps-print-face-extension-alist' or in
6254 `ps-print-face-alist', insert it on `ps-print-face-alist' and
6255 return the attribute vector.
6256
6257 If FACE is not a valid face name, use default face."
6258 (and (stringp face) (facep face) (setq face (intern face)))
6259 (cond
6260 (ps-black-white-faces-alist
6261 (or (and (symbolp face)
6262 (cdr (assq face ps-black-white-faces-alist)))
6263 (vector 0 nil nil)))
6264 ((symbolp face)
6265 (cdr (or (assq face ps-print-face-extension-alist)
6266 (assq face ps-print-face-alist)
6267 (let* ((the-face (if (facep face) face 'default))
6268 (new-face (ps-screen-to-bit-face the-face)))
6269 (or (and (eq the-face 'default)
6270 (assq the-face ps-print-face-alist))
6271 (setq ps-print-face-alist
6272 (cons new-face ps-print-face-alist)))
6273 new-face))))
6274 ((ps-face-foreground-color-p (car face))
6275 (vector 0 (ps-face-extract-color face) nil))
6276 ((ps-face-background-color-p (car face))
6277 (vector 0 nil (ps-face-extract-color face)))
6278 (t
6279 (vector 0 nil nil))))
6280
6281
6282 (defun ps-face-background (face background)
6283 (and (cond ((eq ps-use-face-background t)) ; always
6284 ((null ps-use-face-background) nil) ; never
6285 ;; ps-user-face-background is a symbol face list
6286 ((symbolp face)
6287 (memq face ps-use-face-background))
6288 ((listp face)
6289 (or (ps-face-color-p (car face))
6290 (let (ok)
6291 (while face
6292 (if (or (memq (car face) ps-use-face-background)
6293 (ps-face-color-p (car face)))
6294 (setq face nil
6295 ok t)
6296 (setq face (cdr face))))
6297 ok)))
6298 (t
6299 nil)
6300 )
6301 background))
6302
6303
6304 (defun ps-face-attribute-list (face-or-list)
6305 (cond
6306 ;; simple face
6307 ((not (listp face-or-list))
6308 (ps-face-attributes face-or-list))
6309 ;; only foreground color, not a `real' face
6310 ((ps-face-foreground-color-p (car face-or-list))
6311 (vector 0 (ps-face-extract-color face-or-list) nil))
6312 ;; only background color, not a `real' face
6313 ((ps-face-background-color-p (car face-or-list))
6314 (vector 0 nil (ps-face-extract-color face-or-list)))
6315 ;; list of faces
6316 (t
6317 (let ((effects 0)
6318 foreground background face-attr face)
6319 (while face-or-list
6320 (setq face (car face-or-list)
6321 face-or-list (cdr face-or-list)
6322 face-attr (ps-face-attributes face)
6323 effects (logior effects (aref face-attr 0)))
6324 (or foreground (setq foreground (aref face-attr 1)))
6325 (or background
6326 (setq background (ps-face-background face (aref face-attr 2)))))
6327 (vector effects foreground background)))))
6328
6329
6330 (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
6331
6332
6333 (defun ps-plot-with-face (from to face)
6334 (cond
6335 ((null face) ; print text with null face
6336 (ps-plot-region from to 0))
6337 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
6338 (t ; otherwise, text has a valid face
6339 (let* ((face-bit (ps-face-attribute-list face))
6340 (effect (aref face-bit 0))
6341 (foreground (aref face-bit 1))
6342 (background (ps-face-background face (aref face-bit 2)))
6343 (fg-color (if (and ps-color-p foreground)
6344 (ps-color-scale foreground)
6345 ps-default-color))
6346 (bg-color (and ps-color-p background
6347 (ps-color-scale background))))
6348 (ps-plot-region
6349 from to
6350 (ps-font-number 'ps-font-for-text
6351 (or (aref ps-font-type (logand effect 3))
6352 face))
6353 fg-color bg-color (lsh effect -2)))))
6354 (goto-char to))
6355
6356
6357 ;; Ensure that face-list is fbound.
6358 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
6359
6360
6361 (defun ps-build-reference-face-lists ()
6362 ;; Ensure that face database is updated with faces on
6363 ;; `font-lock-face-attributes' (obsolete stuff)
6364 (ps-font-lock-face-attributes)
6365 ;; Now, rebuild reference face lists
6366 (setq ps-print-face-alist nil)
6367 (if ps-auto-font-detect
6368 (mapc 'ps-map-face (face-list))
6369 (mapc 'ps-set-face-bold ps-bold-faces)
6370 (mapc 'ps-set-face-italic ps-italic-faces)
6371 (mapc 'ps-set-face-underline ps-underlined-faces))
6372 (setq ps-build-face-reference nil))
6373
6374
6375 (defun ps-set-face-bold (face)
6376 (ps-set-face-attribute face 1))
6377
6378 (defun ps-set-face-italic (face)
6379 (ps-set-face-attribute face 2))
6380
6381 (defun ps-set-face-underline (face)
6382 (ps-set-face-attribute face 4))
6383
6384
6385 (defun ps-set-face-attribute (face effect)
6386 (let ((face-bit (cdr (ps-map-face face))))
6387 (aset face-bit 0 (logior (aref face-bit 0) effect))))
6388
6389
6390 (defun ps-map-face (face)
6391 (let* ((face-map (ps-screen-to-bit-face face))
6392 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
6393 (if ps-face-bit
6394 ;; if face exists, merge both
6395 (let ((face-bit (cdr face-map)))
6396 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
6397 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
6398 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
6399 ;; if face does not exist, insert it
6400 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
6401 face-map))
6402
6403
6404 (defun ps-screen-to-bit-face (face)
6405 (cons face
6406 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
6407 (if (ps-face-italic-p face) 2 0) ; italic
6408 (if (ps-face-underlined-p face) 4 0) ; underline
6409 (if (ps-face-strikeout-p face) 8 0) ; strikeout
6410 (if (ps-face-overline-p face) 16 0) ; overline
6411 (if (ps-face-box-p face) 64 0)) ; box
6412 (ps-face-foreground-name face)
6413 (ps-face-background-name face))))
6414
6415
6416 (declare-function jit-lock-fontify-now "jit-lock" (&optional start end))
6417 (declare-function lazy-lock-fontify-region "lazy-lock" (beg end))
6418
6419 ;; to avoid compilation gripes
6420 (defun ps-print-ensure-fontified (start end)
6421 (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
6422 (jit-lock-fontify-now start end))
6423 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
6424 (lazy-lock-fontify-region start end))))
6425
6426
6427 (defun ps-generate-postscript-with-faces (from to)
6428 ;; Some initialization...
6429 (setq ps-current-effect 0)
6430
6431 ;; Build the reference lists of faces if necessary.
6432 (when (or ps-always-build-face-reference
6433 ps-build-face-reference)
6434 (message "Collecting face information...")
6435 (ps-build-reference-face-lists))
6436
6437 ;; Black/white printer.
6438 (setq ps-black-white-faces-alist nil)
6439 (and (eq ps-print-color-p 'black-white)
6440 (ps-extend-face-list ps-black-white-faces nil
6441 'ps-black-white-faces-alist))
6442
6443 ;; Generate some PostScript.
6444 (save-restriction
6445 (narrow-to-region from to)
6446 (ps-print-ensure-fontified from to)
6447 (ps-generate-postscript-with-faces1 from to)))
6448
6449 (defun ps-generate-postscript (from to)
6450 (ps-plot-region from to 0))
6451
6452 ;; These are autoloaded, but ps-mule generates autoloads at the end of
6453 ;; this file, so they are unknown at this point when compiling.
6454 (declare-function ps-mule-initialize "ps-mule" ())
6455 (declare-function ps-mule-begin-job "ps-mule" (from to))
6456 (declare-function ps-mule-end-job "ps-mule" ())
6457
6458 (defun ps-generate (buffer from to genfunc)
6459 (save-excursion
6460 (let ((from (min to from))
6461 (to (max to from))
6462 ;; This avoids trouble if chars with read-only properties
6463 ;; are copied into ps-spool-buffer.
6464 (inhibit-read-only t))
6465 (save-restriction
6466 (narrow-to-region from to)
6467 (and ps-razzle-dazzle
6468 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
6469 (setq ps-source-buffer buffer
6470 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
6471 (ps-init-output-queue)
6472 (let (safe-marker completed-safely needs-begin-file)
6473 (unwind-protect
6474 (progn
6475 (set-buffer ps-spool-buffer)
6476 (set-buffer-multibyte nil)
6477
6478 ;; Get a marker and make it point to the current end of the
6479 ;; buffer, If an error occurs, we'll delete everything from
6480 ;; the end of this marker onwards.
6481 (setq safe-marker (make-marker))
6482 (set-marker safe-marker (point-max))
6483
6484 (goto-char (point-min))
6485 (or (looking-at (regexp-quote ps-adobe-tag))
6486 (setq needs-begin-file t))
6487
6488 (set-buffer ps-source-buffer)
6489 (save-excursion
6490 (let ((ps-print-page-p t)
6491 ps-even-or-odd-pages)
6492 (ps-begin-job genfunc)
6493 (when needs-begin-file
6494 (ps-begin-file)
6495 (ps-mule-initialize))
6496 (ps-mule-begin-job from to)
6497 (ps-selected-pages)))
6498 (ps-begin-page)
6499 (funcall genfunc from to)
6500 (ps-end-page)
6501 (ps-mule-end-job)
6502 (ps-end-job needs-begin-file)
6503
6504 ;; Setting this variable tells the unwind form that the
6505 ;; the PostScript was generated without error.
6506 (setq completed-safely t))
6507
6508 ;; Unwind form: If some bad mojo occurred while generating
6509 ;; PostScript, delete all the PostScript that was generated.
6510 ;; This protects the previously spooled files from getting
6511 ;; corrupted.
6512 (and (markerp safe-marker) (not completed-safely)
6513 (progn
6514 (set-buffer ps-spool-buffer)
6515 (delete-region (marker-position safe-marker) (point-max))))))
6516
6517 (and ps-razzle-dazzle (message "Formatting...done"))))))
6518
6519
6520 (defun ps-end-job (needs-begin-file)
6521 (let ((ps-print-page-p t))
6522 (ps-flush-output)
6523 (save-excursion
6524 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
6525 (total-lines (cdr ps-printing-region))
6526 (total-pages (ps-page-number)))
6527 (set-buffer ps-spool-buffer)
6528 (let (case-fold-search)
6529 ;; Back to the PS output buffer to set the last page n-up printing
6530 (goto-char (point-max))
6531 (and (> pages-per-sheet 0)
6532 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
6533 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
6534 ;; Back to the PS output buffer to set the page count
6535 (goto-char (point-min))
6536 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
6537 (replace-match (format "/Lines %d def\n/PageCount %d def"
6538 total-lines total-pages) t)))))
6539 ;; Set dummy page
6540 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
6541 (let ((ps-n-up-printing 0))
6542 (ps-header-sheet)
6543 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
6544 "/PrintLineNumber false def\n"
6545 (number-to-string ps-lines-printed) " BeginPage\n")
6546 (ps-end-page)))
6547 ;; Set end of PostScript file
6548 (ps-end-sheet)
6549 (ps-output "\n%%Trailer\n%%Pages: "
6550 (number-to-string
6551 (if (and needs-begin-file
6552 ps-banner-page-when-duplexing)
6553 (1+ ps-page-order)
6554 ps-page-order))
6555 "\n\nEndDoc\n\n%%EOF\n")
6556 (and ps-end-with-control-d
6557 (ps-output "\C-d"))
6558 (ps-flush-output))
6559 ;; disable selected pages
6560 (setq ps-selected-pages nil))
6561
6562
6563 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
6564 (defun ps-do-despool (filename)
6565 (if (or (not (boundp 'ps-spool-buffer))
6566 (not (symbol-value 'ps-spool-buffer)))
6567 (message "No spooled PostScript to print")
6568 (if filename
6569 (save-excursion
6570 (and ps-razzle-dazzle (message "Saving..."))
6571 (set-buffer ps-spool-buffer)
6572 (setq filename (expand-file-name filename))
6573 (let ((coding-system-for-write 'raw-text-unix))
6574 (write-region (point-min) (point-max) filename))
6575 (and ps-razzle-dazzle (message "Wrote %s" filename)))
6576 ;; Else, spool to the printer
6577 (and ps-razzle-dazzle (message "Printing..."))
6578 (with-current-buffer ps-spool-buffer
6579 (let* ((coding-system-for-write 'raw-text-unix)
6580 (ps-printer-name (or ps-printer-name
6581 (and (boundp 'printer-name)
6582 (symbol-value 'printer-name))))
6583 (ps-lpr-switches
6584 (append ps-lpr-switches
6585 (and (stringp ps-printer-name)
6586 (string< "" ps-printer-name)
6587 (list (concat
6588 (and (stringp ps-printer-name-option)
6589 ps-printer-name-option)
6590 ps-printer-name))))))
6591 (or (stringp ps-printer-name)
6592 (setq ps-printer-name nil))
6593 (apply (or ps-print-region-function 'call-process-region)
6594 (point-min) (point-max) ps-lpr-command nil
6595 (and (fboundp 'start-process) 0)
6596 nil
6597 (ps-flatten-list ; dynamic evaluation
6598 (ps-string-list
6599 (mapcar 'ps-eval-switch ps-lpr-switches))))))
6600 (and ps-razzle-dazzle (message "Printing...done")))
6601 (kill-buffer ps-spool-buffer)))
6602
6603 (defun ps-string-list (arg)
6604 (let (lstr)
6605 (dolist (elm arg)
6606 (cond ((stringp elm)
6607 (setq lstr (cons elm lstr)))
6608 ((listp elm)
6609 (let ((s (ps-string-list elm)))
6610 (when s
6611 (setq lstr (cons s lstr)))))
6612 (t ))) ; ignore any other value
6613 (nreverse lstr)))
6614
6615 ;; Dynamic evaluation
6616 (defun ps-eval-switch (arg)
6617 (cond ((stringp arg) arg)
6618 ((functionp arg) (apply arg nil))
6619 ((symbolp arg) (symbol-value arg))
6620 ((consp arg) (apply (car arg) (cdr arg)))
6621 (t nil)))
6622
6623 ;; `ps-flatten-list' is defined here (copied from "message.el" and
6624 ;; enhanced to handle dotted pairs as well) until we can get some
6625 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
6626
6627 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
6628 ;; => (a b c d e f g h i j)
6629
6630 (defun ps-flatten-list (&rest list)
6631 (ps-flatten-list-1 list))
6632
6633 (defun ps-flatten-list-1 (list)
6634 (cond ((null list) nil)
6635 ((consp list) (append (ps-flatten-list-1 (car list))
6636 (ps-flatten-list-1 (cdr list))))
6637 (t (list list))))
6638
6639 (defun ps-kill-emacs-check ()
6640 (let (ps-buffer)
6641 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6642 (buffer-name ps-buffer) ; check if it's not killed
6643 (buffer-modified-p ps-buffer)
6644 (y-or-n-p "Unprinted PostScript waiting; print now? ")
6645 (ps-despool))
6646 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6647 (buffer-name ps-buffer) ; check if it's not killed
6648 (buffer-modified-p ps-buffer)
6649 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
6650 (error "Unprinted PostScript"))))
6651
6652 (cond ((fboundp 'add-hook)
6653 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
6654 (kill-emacs-hook
6655 (message "Won't override existing `kill-emacs-hook'"))
6656 (t
6657 (setq kill-emacs-hook 'ps-kill-emacs-check)))
6658
6659 \f
6660 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6661 ;; To make this file smaller, some commands go in a separate file.
6662 ;; But autoload them here to make the separation invisible.
6663 \f
6664 ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
6665 ;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "371cbfd7a980b9fb80a68013dc44ef1f")
6666 ;;; Generated autoloads from ps-mule.el
6667
6668 (defvar ps-multibyte-buffer nil "\
6669 Specifies the multi-byte buffer handling.
6670
6671 Valid values are:
6672
6673 nil This is the value to use the default settings;
6674 by default, this only works to print buffers with
6675 only ASCII and Latin characters. But this default
6676 setting can be changed by setting the variable
6677 `ps-mule-font-info-database-default' differently.
6678 The initial value of this variable is
6679 `ps-mule-font-info-database-latin' (see
6680 documentation).
6681
6682 `non-latin-printer' This is the value to use when you have a Japanese
6683 or Korean PostScript printer and want to print
6684 buffer with ASCII, Latin-1, Japanese (JISX0208 and
6685 JISX0201-Kana) and Korean characters. At present,
6686 it was not tested with the Korean characters
6687 printing. If you have a korean PostScript printer,
6688 please, test it.
6689
6690 `bdf-font' This is the value to use when you want to print
6691 buffer with BDF fonts. BDF fonts include both latin
6692 and non-latin fonts. BDF (Bitmap Distribution
6693 Format) is a format used for distributing X's font
6694 source file. BDF fonts are included in
6695 `intlfonts-1.2' which is a collection of X11 fonts
6696 for all characters supported by Emacs. In order to
6697 use this value, be sure to have installed
6698 `intlfonts-1.2' and set the variable
6699 `bdf-directory-list' appropriately (see ps-bdf.el for
6700 documentation of this variable).
6701
6702 `bdf-font-except-latin' This is like `bdf-font' except that it uses
6703 PostScript default fonts to print ASCII and Latin-1
6704 characters. This is convenient when you want or
6705 need to use both latin and non-latin characters on
6706 the same buffer. See `ps-font-family',
6707 `ps-header-font-family' and `ps-font-info-database'.
6708
6709 Any other value is treated as nil.")
6710
6711 (custom-autoload 'ps-multibyte-buffer "ps-mule" t)
6712
6713 (autoload 'ps-mule-initialize "ps-mule" "\
6714 Initialize global data for printing multi-byte characters.
6715
6716 \(fn)" nil nil)
6717
6718 (autoload 'ps-mule-begin-job "ps-mule" "\
6719 Start printing job for multi-byte chars between FROM and TO.
6720 It checks if all multi-byte characters in the region are printable or not.
6721
6722 \(fn FROM TO)" nil nil)
6723
6724 (autoload 'ps-mule-end-job "ps-mule" "\
6725 Finish printing job for multi-byte chars.
6726
6727 \(fn)" nil nil)
6728
6729 ;;;***
6730 \f
6731 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6732
6733 (provide 'ps-print)
6734
6735 ;;; ps-print.el ends here