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