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