Cleanup namespace of dos-w32.el.
[bpt/emacs.git] / lisp / ps-print.el
1
2 ;;; ps-print.el --- print text from the buffer as PostScript
3
4 ;; Copyright (C) 1993-2013 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 ;; init 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 ;; Load XEmacs/Emacs definitions
1477 (require 'ps-def)
1478
1479
1480 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1481 ;; User Variables:
1482
1483
1484 ;;; Interface to the command system
1485
1486 (defgroup postscript nil
1487 "Support for printing and PostScript."
1488 :tag "PostScript"
1489 :version "20"
1490 :group 'external)
1491
1492 (defgroup ps-print nil
1493 "PostScript generator for Emacs."
1494 :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
1495 :prefix "ps-"
1496 :version "20"
1497 :group 'wp
1498 :group 'postscript)
1499
1500 (defgroup ps-print-horizontal nil
1501 "Horizontal page layout."
1502 :prefix "ps-"
1503 :tag "Horizontal"
1504 :version "20"
1505 :group 'ps-print)
1506
1507 (defgroup ps-print-vertical nil
1508 "Vertical page layout."
1509 :prefix "ps-"
1510 :tag "Vertical"
1511 :version "20"
1512 :group 'ps-print)
1513
1514 (defgroup ps-print-headers nil
1515 "Headers & footers layout."
1516 :prefix "ps-"
1517 :tag "Header & Footer"
1518 :version "20"
1519 :group 'ps-print)
1520
1521 (defgroup ps-print-font nil
1522 "Fonts customization."
1523 :prefix "ps-"
1524 :tag "Font"
1525 :version "20"
1526 :group 'ps-print)
1527
1528 (defgroup ps-print-color nil
1529 "Color customization."
1530 :prefix "ps-"
1531 :tag "Color"
1532 :version "20"
1533 :group 'ps-print)
1534
1535 (defgroup ps-print-face nil
1536 "Faces customization."
1537 :prefix "ps-"
1538 :tag "PS Faces"
1539 :version "20"
1540 :group 'ps-print
1541 :group 'faces)
1542
1543 (defgroup ps-print-n-up nil
1544 "N-up customization."
1545 :prefix "ps-"
1546 :tag "N-Up"
1547 :version "20"
1548 :group 'ps-print)
1549
1550 (defgroup ps-print-zebra nil
1551 "Zebra customization."
1552 :prefix "ps-"
1553 :tag "Zebra"
1554 :version "20"
1555 :group 'ps-print)
1556
1557 (defgroup ps-print-background nil
1558 "Background customization."
1559 :prefix "ps-"
1560 :tag "Background"
1561 :version "20"
1562 :group 'ps-print)
1563
1564 (defgroup ps-print-printer '((lpr custom-group))
1565 "Printer customization."
1566 :prefix "ps-"
1567 :tag "Printer"
1568 :version "20"
1569 :group 'ps-print)
1570
1571 (defgroup ps-print-page nil
1572 "Page customization."
1573 :prefix "ps-"
1574 :tag "Page"
1575 :version "20"
1576 :group 'ps-print)
1577
1578 (defgroup ps-print-miscellany nil
1579 "Miscellany customization."
1580 :prefix "ps-"
1581 :tag "Miscellany"
1582 :version "20"
1583 :group 'ps-print)
1584
1585
1586 (defcustom ps-error-handler-message 'paper
1587 "Specify where the error handler message should be sent.
1588
1589 Valid values are:
1590
1591 `none' catch the error and *DON'T* send any message.
1592
1593 `paper' catch the error and print on paper the error message.
1594
1595 `system' catch the error and send back the error message to
1596 printing system. This is useful only if printing system
1597 send back an email reporting the error, or if there is
1598 some other alternative way to report back the error from
1599 the system to you.
1600
1601 `paper-and-system' catch the error, print on paper the error message and
1602 send back the error message to printing system.
1603
1604 Any other value is treated as `paper'."
1605 :type '(choice :menu-tag "Error Handler Message"
1606 :tag "Error Handler Message"
1607 (const none) (const paper)
1608 (const system) (const paper-and-system))
1609 :version "20"
1610 :group 'ps-print-miscellany)
1611
1612 (defcustom ps-user-defined-prologue nil
1613 "User defined PostScript prologue code inserted before all prologue code.
1614
1615 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1616 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1617 prologue comments, and before ps-print PostScript prologue code section. That
1618 is, this string is inserted after error handler initialization and before
1619 ps-print settings.
1620
1621 It's strongly recommended only insert PostScript code and/or comments specific
1622 for your printing system particularities. For example, some special
1623 initialization that only your printing system needs.
1624
1625 Do not insert code for duplex printing, n-up printing or error handler,
1626 ps-print handles this in a suitable way.
1627
1628 For more information about PostScript, see:
1629 PostScript Language Reference Manual (2nd edition)
1630 Adobe Systems Incorporated
1631
1632 As an example for `ps-user-defined-prologue' setting:
1633
1634 ;; Setting for HP PostScript printer
1635 (setq ps-user-defined-prologue
1636 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1637 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
1638 :type '(choice :menu-tag "User Defined Prologue"
1639 :tag "User Defined Prologue"
1640 (const :tag "none" nil) string symbol)
1641 :version "20"
1642 :group 'ps-print-miscellany)
1643
1644 (defcustom ps-print-prologue-header nil
1645 "PostScript prologue header comments besides that ps-print generates.
1646
1647 `ps-print-prologue-header' may be a string or a symbol function which returns a
1648 string. Note that this string is inserted on PostScript prologue header
1649 section which is used to define some document characteristic through PostScript
1650 special comments, like \"%%Requirements: jog\\n\".
1651
1652 ps-print always inserts the %%Requirements: comment, so if you need to insert
1653 more requirements put them first in `ps-print-prologue-header' using the
1654 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1655 requirements and set %%LanguageLevel: to 2, do:
1656
1657 (setq ps-print-prologue-header
1658 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1659
1660 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1661
1662 Do not forget to terminate the string with \"\\n\".
1663
1664 For more information about PostScript document comments, see:
1665 PostScript Language Reference Manual (2nd edition)
1666 Adobe Systems Incorporated
1667 Appendix G: Document Structuring Conventions -- Version 3.0"
1668 :type '(choice :menu-tag "Prologue Header"
1669 :tag "Prologue Header"
1670 (const :tag "none" nil) string symbol)
1671 :version "20"
1672 :group 'ps-print-miscellany)
1673
1674 (defcustom ps-printer-name nil
1675 "The name of a local printer for printing PostScript files.
1676
1677 On Unix-like systems, a string value should be a name understood by lpr's -P
1678 option; a value of nil means use the value of `printer-name' instead.
1679
1680 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1681 printer device or port to which PostScript files are written, provided
1682 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1683 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1684 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
1685 for a shared network printer. You can also set it to a name of a file, in
1686 which case the output gets appended to that file. \(Note that `ps-print'
1687 package already has facilities for printing to a file, so you might as well use
1688 them instead of changing the setting of this variable.\) If you want to
1689 silently discard the printed output, set this to \"NUL\".
1690
1691 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1692
1693 Any other value is treated as t, that is, an empty printer name.
1694
1695 See also `ps-printer-name-option' for documentation."
1696 :type '(choice :menu-tag "Printer Name"
1697 :tag "Printer Name"
1698 (const :tag "Same as printer-name" nil)
1699 (const :tag "No Printer Name" t)
1700 (file :tag "Print to file")
1701 (string :tag "Pipe to ps-lpr-command"))
1702 :version "20"
1703 :group 'ps-print-printer)
1704
1705 (defcustom ps-printer-name-option
1706 (cond (lpr-windows-system "/D:")
1707 (t lpr-printer-switch))
1708 "Option for `ps-printer-name' variable (see it).
1709
1710 On Unix-like systems, if `lpr' is in use, this should be the string
1711 \"-P\"; if `lp' is in use, this should be the string \"-d\".
1712
1713 On MS-DOS and MS-Windows systems, if `print' is in use, this should be
1714 the string \"/D:\".
1715
1716 For any other printing utility, see its documentation.
1717
1718 Set this to \"\" or nil, if the utility given by `ps-lpr-command'
1719 needs an empty printer name option--that is, pass the printer name
1720 with no special option preceding it.
1721
1722 This variable is used only when `ps-printer-name' is a non-empty string."
1723 :type '(choice :menu-tag "Printer Name Option"
1724 :tag "Printer Name Option"
1725 (const :tag "None" nil)
1726 (string :tag "Option"))
1727 :version "21.1"
1728 :group 'ps-print-printer)
1729
1730 (defcustom ps-lpr-command lpr-command
1731 "Name of program for printing a PostScript file.
1732
1733 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1734 will write directly to the printer port named by `ps-printer-name'. The
1735 programs `print' and `nprint' (the standard print programs on Windows NT and
1736 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1737 the destination for output; any other program is treated like `lpr' except that
1738 an explicit filename is given as the last argument."
1739 :type 'string
1740 :version "20"
1741 :group 'ps-print-printer)
1742
1743 (defcustom ps-lpr-switches lpr-switches
1744 "List of extra switches to pass to `ps-lpr-command'.
1745
1746 The list element can be:
1747
1748 string it should be an option for `ps-lpr-command' (which see).
1749 For example: \"-o Duplex=DuplexNoTumble\"
1750
1751 symbol it can be a function or variable symbol. If it's a function
1752 symbol, it should be a function with no argument. The result
1753 of the function or the variable value should be a string or a
1754 list of strings.
1755
1756 list the header should be a symbol function and the tail is the
1757 arguments for this function. This function should return a
1758 string or a list of strings.
1759
1760 Any other value is silently ignored.
1761
1762 It is recommended to set `ps-printer-name' (which see) instead of including an
1763 explicit switch on this list.
1764
1765 See `ps-lpr-command'."
1766 :type '(repeat :tag "PostScript lpr Switches"
1767 (choice :menu-tag "PostScript lpr Switch"
1768 :tag "PostScript lpr Switch"
1769 string symbol (repeat sexp)))
1770 :version "20"
1771 :group 'ps-print-printer)
1772
1773 (defcustom ps-print-region-function
1774 (if (memq system-type '(ms-dos windows-nt))
1775 #'w32-direct-ps-print-region-function
1776 #'call-process-region)
1777 "Specify a function to print the region on a PostScript printer.
1778 See definition of `call-process-region' for calling conventions. The fourth
1779 and the sixth arguments are both nil."
1780 :type 'function
1781 :version "20"
1782 :group 'ps-print-printer)
1783
1784 (defcustom ps-manual-feed nil
1785 "Non-nil means the printer will manually feed paper.
1786
1787 If it's nil, automatic feeding takes place."
1788 :type 'boolean
1789 :version "20"
1790 :group 'ps-print-printer)
1791
1792 (defcustom ps-end-with-control-d (and lpr-windows-system t)
1793 "Non-nil means insert C-d at end of PostScript file generated."
1794 :version "21.1"
1795 :type 'boolean
1796 :version "20"
1797 :group 'ps-print-printer)
1798
1799 ;;; Page layout
1800
1801 ;; All page dimensions are in PostScript points.
1802 ;; 1 inch == 2.54 cm == 72 points
1803 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1804
1805 ;; Letter 8.5 inch x 11.0 inch
1806 ;; Legal 8.5 inch x 14.0 inch
1807 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1808
1809 ;; LetterSmall 7.68 inch x 10.16 inch
1810 ;; Tabloid 11.0 inch x 17.0 inch
1811 ;; Ledger 17.0 inch x 11.0 inch
1812 ;; Statement 5.5 inch x 8.5 inch
1813 ;; Executive 7.5 inch x 10.0 inch
1814 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1815 ;; A4Small 7.47 inch x 10.85 inch
1816 ;; B4 10.125 inch x 14.33 inch
1817 ;; B5 7.16 inch x 10.125 inch
1818
1819 ;;;###autoload
1820 (defcustom ps-page-dimensions-database
1821 (purecopy
1822 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1823 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1824 (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
1825 (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
1826 (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
1827 (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
1828 (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
1829 (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
1830 (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
1831 (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
1832 (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
1833 (list 'b5 (* 72 7.16) (* 72 10.125) "B5")
1834 ;; page sizes for label printer
1835 ;; NOTE: the page sizes below don't have n-up > 1.
1836 '(addresslarge 236.0 99.0 "AddressLarge")
1837 '(addresssmall 236.0 68.0 "AddressSmall")
1838 '(cuthanging13 90.0 222.0 "CutHanging13")
1839 '(cuthanging15 90.0 114.0 "CutHanging15")
1840 '(diskette 181.0 136.0 "Diskette")
1841 '(eurofilefolder 139.0 112.0 "EuropeanFilefolder")
1842 '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow")
1843 '(eurofolderwide 526.0 136.0 "EuroFolderWide")
1844 '(euronamebadge 189.0 108.0 "EuroNameBadge")
1845 '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge")
1846 '(filefolder 230.0 37.0 "FileFolder")
1847 '(jewelry 76.0 136.0 "Jewelry")
1848 '(mediabadge 180.0 136.0 "MediaBadge")
1849 '(multipurpose 126.0 68.0 "MultiPurpose")
1850 '(retaillabel 90.0 104.0 "RetailLabel")
1851 '(shipping 271.0 136.0 "Shipping")
1852 '(slide35mm 26.0 104.0 "Slide35mm")
1853 '(spine8mm 187.0 26.0 "Spine8mm")
1854 '(topcoated 425.19685 136.0 "TopCoatedPaper")
1855 '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150")
1856 '(vhsface 205.0 127.0 "VHSFace")
1857 '(vhsspine 400.0 50.0 "VHSSpine")
1858 '(zipdisk 156.0 136.0 "ZipDisk")))
1859 "List associating a symbolic paper type to its width, height and doc media.
1860 See `ps-paper-type'."
1861 :type '(repeat (list :tag "Paper Type"
1862 (symbol :tag "Symbol Name")
1863 (number :tag "Width in points")
1864 (number :tag "Height in points")
1865 (string :tag "Media")))
1866 :version "20"
1867 :group 'ps-print-page)
1868
1869 ;;;###autoload
1870 (defcustom ps-paper-type 'letter
1871 "Specify the size of paper to format for.
1872 Should be one of the paper types defined in `ps-page-dimensions-database', for
1873 example `letter', `legal' or `a4'."
1874 :type '(symbol :validate (lambda (wid)
1875 (if (assq (widget-value wid)
1876 ps-page-dimensions-database)
1877 nil
1878 (widget-put wid :error "Unknown paper size")
1879 wid)))
1880 :version "20"
1881 :group 'ps-print-page)
1882
1883 (defcustom ps-warn-paper-type t
1884 "Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1885
1886 It's used when `ps-spool-config' is set to `setpagedevice'."
1887 :type 'boolean
1888 :version "20"
1889 :group 'ps-print-page)
1890
1891 (defcustom ps-landscape-mode nil
1892 "Non-nil means print in landscape mode."
1893 :type 'boolean
1894 :version "20"
1895 :group 'ps-print-page)
1896
1897 (defcustom ps-print-upside-down nil
1898 "Non-nil means print upside-down (that is, rotated by 180 degrees)."
1899 :type 'boolean
1900 :version "21.1"
1901 :group 'ps-print-page)
1902
1903 (defcustom ps-selected-pages nil
1904 "Specify which pages to print.
1905
1906 If nil, print all pages.
1907
1908 If a list, the lists element may be an integer or a cons cell (FROM . TO)
1909 designating FROM page to TO page; any invalid element is ignored, that is, an
1910 integer lesser than one or if FROM is greater than TO.
1911
1912 Otherwise, it's treated as nil.
1913
1914 After ps-print processing `ps-selected-pages' is set to nil. But the
1915 latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
1916 see). So you can restore the latest selected pages by using
1917 `ps-last-selected-pages' or with the `ps-restore-selected-pages'
1918 command (which see).
1919
1920 See also `ps-even-or-odd-pages'."
1921 :type '(repeat :tag "Selected Pages"
1922 (radio :tag "Page"
1923 (integer :tag "Number")
1924 (cons :tag "Range"
1925 (integer :tag "From")
1926 (integer :tag "To"))))
1927 :version "20"
1928 :group 'ps-print-page)
1929
1930 (defcustom ps-even-or-odd-pages nil
1931 "Specify if it prints even/odd pages.
1932
1933 Valid values are:
1934
1935 nil print all pages.
1936
1937 `even-page' print only even pages.
1938
1939 `odd-page' print only odd pages.
1940
1941 `even-sheet' print only even sheets.
1942 That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
1943 but for values greater than 1, it'll print only the even sheet
1944 of paper.
1945
1946 `odd-sheet' print only odd sheets.
1947 That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
1948 but for values greater than 1, it'll print only the odd sheet
1949 of paper.
1950
1951 Any other value is treated as nil.
1952
1953 If you set option `ps-selected-pages', first the pages are
1954 filtered by option `ps-selected-pages' and then by `ps-even-or-odd-pages'.
1955 For example, if we have:
1956
1957 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
1958
1959 Combining with `ps-even-or-odd-pages' and option `ps-n-up-printing', we have:
1960
1961 `ps-n-up-printing' = 1:
1962 `ps-even-or-odd-pages' PAGES PRINTED
1963 nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
1964 even-page 4, 6, 8, 10, 12, 14, 16, 20
1965 odd-page 1, 7, 9, 13, 15
1966 even-sheet 4, 6, 8, 10, 12, 14, 16, 20
1967 odd-sheet 1, 7, 9, 13, 15
1968
1969 `ps-n-up-printing' = 2:
1970 `ps-even-or-odd-pages' PAGES PRINTED
1971 nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
1972 even-page 4/6, 8/10, 12/14, 16/20
1973 odd-page 1/7, 9/13, 15
1974 even-sheet 6/7, 10/12, 15/16
1975 odd-sheet 1/4, 8/9, 13/14, 20
1976
1977 So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1978 sheet parity."
1979 :type '(choice :menu-tag "Print Even/Odd Pages"
1980 :tag "Print Even/Odd Pages"
1981 (const :tag "All Pages" nil)
1982 (const :tag "Only Even Pages" even-page)
1983 (const :tag "Only Odd Pages" odd-page)
1984 (const :tag "Only Even Sheets" even-sheet)
1985 (const :tag "Only Odd Sheets" odd-sheet))
1986 :version "20"
1987 :group 'ps-print-page)
1988
1989 (defcustom ps-print-control-characters 'control-8-bit
1990 "Specify the printable form for control and 8-bit characters.
1991 That is, instead of sending, for example, a ^D (\\004) to printer,
1992 it is sent the string \"^D\".
1993
1994 Valid values are:
1995
1996 `8-bit' This is the value to use when you want an ASCII encoding of
1997 any control or non-ASCII character. Control characters are
1998 encoded as \"^D\", and non-ASCII characters have an
1999 octal encoding.
2000
2001 `control-8-bit' This is the value to use when you want an ASCII encoding of
2002 any control character, whether it is 7 or 8-bit.
2003 European 8-bits accented characters are printed according
2004 the current font.
2005
2006 `control' Only ASCII control characters have an ASCII encoding.
2007 European 8-bits accented characters are printed according
2008 the current font.
2009
2010 nil No ASCII encoding. Any character is printed according the
2011 current font.
2012
2013 Any other value is treated as nil."
2014 :type '(choice :menu-tag "Control Char"
2015 :tag "Control Char"
2016 (const 8-bit) (const control-8-bit)
2017 (const control) (const :tag "nil" nil))
2018 :version "20"
2019 :group 'ps-print-miscellany)
2020
2021 (defcustom ps-n-up-printing 1
2022 "Specify the number of pages per sheet paper."
2023 :type '(integer
2024 :tag "N Up Printing"
2025 :validate
2026 (lambda (wid)
2027 (if (and (< 0 (widget-value wid))
2028 (<= (widget-value wid) 100))
2029 nil
2030 (widget-put
2031 wid :error
2032 "Number of pages per sheet paper must be between 1 and 100.")
2033 wid)))
2034 :version "20"
2035 :group 'ps-print-n-up)
2036
2037 (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
2038 "Specify the margin in points between the sheet border and n-up printing."
2039 :type 'number
2040 :version "20"
2041 :group 'ps-print-n-up)
2042
2043 (defcustom ps-n-up-border-p t
2044 "Non-nil means a border is drawn around each page."
2045 :type 'boolean
2046 :version "20"
2047 :group 'ps-print-n-up)
2048
2049 (defcustom ps-n-up-filling 'left-top
2050 "Specify how page matrix is filled on each sheet of paper.
2051
2052 Following are the valid values for `ps-n-up-filling' with a filling example
2053 using a 3x4 page matrix:
2054
2055 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
2056 5 6 7 8 5 6 7 8
2057 9 10 11 12 1 2 3 4
2058
2059 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
2060 8 7 6 5 8 7 6 5
2061 12 11 10 9 4 3 2 1
2062
2063 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
2064 2 5 8 11 2 5 8 11
2065 3 6 9 12 1 4 7 10
2066
2067 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
2068 11 8 5 2 11 8 5 2
2069 12 9 6 3 10 7 4 1
2070
2071 Any other value is treated as `left-top'."
2072 :type '(choice :menu-tag "N-Up Filling"
2073 :tag "N-Up Filling"
2074 (const left-top) (const left-bottom)
2075 (const right-top) (const right-bottom)
2076 (const top-left) (const bottom-left)
2077 (const top-right) (const bottom-right))
2078 :version "20"
2079 :group 'ps-print-n-up)
2080
2081 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
2082 "Specify the number of columns."
2083 :type 'number
2084 :version "20"
2085 :group 'ps-print-miscellany)
2086
2087 (defcustom ps-zebra-stripes nil
2088 "Non-nil means print zebra stripes.
2089 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
2090 :type 'boolean
2091 :version "20"
2092 :group 'ps-print-zebra)
2093
2094 (defcustom ps-zebra-stripe-height 3
2095 "Number of zebra stripe lines.
2096 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
2097 :type 'number
2098 :version "20"
2099 :group 'ps-print-zebra)
2100
2101 (defcustom ps-zebra-color 0.95
2102 "Zebra stripe gray scale or RGB color.
2103 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
2104 :type '(choice :menu-tag "Zebra Gray/Color"
2105 :tag "Zebra Gray/Color"
2106 (number :tag "Gray Scale" :value 0.95)
2107 (string :tag "Color Name" :value "gray95")
2108 (list :tag "RGB Color" :value (0.95 0.95 0.95)
2109 (number :tag "Red")
2110 (number :tag "Green")
2111 (number :tag "Blue")))
2112 :version "20"
2113 :group 'ps-print-zebra)
2114
2115 (defcustom ps-zebra-stripe-follow nil
2116 "Specify how zebra stripes continue on next page.
2117
2118 Visually, valid values are (the character `+' at right of each column indicates
2119 that a line is printed):
2120
2121 `nil' `follow' `full' `full-follow'
2122 Current Page -------- ----------- --------- ----------------
2123 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
2124 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
2125 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
2126 4 + 4 + 4 + 4 +
2127 5 + 5 + 5 + 5 +
2128 6 + 6 + 6 + 6 +
2129 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
2130 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
2131 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
2132 10 + 10 +
2133 11 + 11 +
2134 -------- ----------- --------- ----------------
2135 Next Page -------- ----------- --------- ----------------
2136 12 XXXXX + 12 + 10 XXXXXX + 10 +
2137 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
2138 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
2139 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
2140 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
2141 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
2142 18 XXXXX + 18 + 16 XXXXXX + 16 +
2143 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
2144 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
2145 21 + 21 XXXXXXXX +
2146 22 + 22 +
2147 -------- ----------- --------- ----------------
2148
2149 Any other value is treated as nil."
2150 :type '(choice :menu-tag "Zebra Stripe Follow"
2151 :tag "Zebra Stripe Follow"
2152 (const :tag "Always Restart" nil)
2153 (const :tag "Continue on Next Page" follow)
2154 (const :tag "Print Only Full Stripe" full)
2155 (const :tag "Continue on Full Stripe" full-follow))
2156 :version "20"
2157 :group 'ps-print-zebra)
2158
2159 (defcustom ps-line-number nil
2160 "Non-nil means print line number."
2161 :type 'boolean
2162 :version "20"
2163 :group 'ps-print-miscellany)
2164
2165 (defcustom ps-line-number-step 1
2166 "Specify the interval that line number is printed.
2167
2168 For example, `ps-line-number-step' is set to 2, the printing will look like:
2169
2170 1 one line
2171 one line
2172 3 one line
2173 one line
2174 5 one line
2175 one line
2176 ...
2177
2178 Valid values are:
2179
2180 integer an integer that specifies the interval that line number is
2181 printed. If it's lesser than or equal to zero, it's used the
2182 value 1.
2183
2184 `zebra' specifies that only the line number of the first line in a
2185 zebra stripe is to be printed.
2186
2187 Any other value is treated as `zebra'."
2188 :type '(choice :menu-tag "Line Number Step"
2189 :tag "Line Number Step"
2190 (integer :tag "Step Interval")
2191 (const :tag "Synchronize Zebra" zebra))
2192 :version "20"
2193 :group 'ps-print-miscellany)
2194
2195 (defcustom ps-line-number-start 1
2196 "Specify the starting point in the interval given by `ps-line-number-step'.
2197
2198 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2199 set to 3, the printing will look like:
2200
2201 one line
2202 one line
2203 3 one line
2204 one line
2205 one line
2206 6 one line
2207 one line
2208 one line
2209 9 one line
2210 one line
2211 ...
2212
2213 The values for `ps-line-number-start':
2214
2215 * If `ps-line-number-step' is an integer, must be between 1 and the value of
2216 `ps-line-number-step' inclusive.
2217
2218 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
2219 value of `ps-zebra-strip-height' inclusive. Use this combination if you
2220 wish that line number be relative to zebra stripes."
2221 :type '(integer :tag "Start Step Interval")
2222 :version "20"
2223 :group 'ps-print-miscellany)
2224
2225 (defcustom ps-print-background-image nil
2226 "EPS image list to be printed on background.
2227
2228 The elements are:
2229
2230 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2231
2232 FILENAME is a file name which contains an EPS image or some PostScript
2233 programming like EPS.
2234 FILENAME is ignored, if it doesn't exist or is read protected.
2235
2236 X and Y are relative positions on paper to put the image.
2237 If X and Y are nil, the image is centered on paper.
2238
2239 XSCALE and YSCALE are scale factor to be applied to image before printing.
2240 If XSCALE and YSCALE are nil, the original size is used.
2241
2242 ROTATION is the image rotation angle; if nil, the default is 0.
2243
2244 PAGES designates the page to print background image.
2245 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2246 page.
2247 If PAGES is nil, print background image on all pages.
2248
2249 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2250 number or a string. If it is a string, the string should contain PostScript
2251 programming that returns a float or integer value.
2252
2253 For example, if you wish to print an EPS image on all pages do:
2254
2255 '((\"~/images/EPS-image.ps\"))"
2256 :type '(repeat
2257 (list
2258 (file :tag "EPS File")
2259 (choice :tag "X" (const :tag "default" nil) number string)
2260 (choice :tag "Y" (const :tag "default" nil) number string)
2261 (choice :tag "X Scale" (const :tag "default" nil) number string)
2262 (choice :tag "Y Scale" (const :tag "default" nil) number string)
2263 (choice :tag "Rotation" (const :tag "default" nil) number string)
2264 (repeat :tag "Pages" :inline t
2265 (radio (integer :tag "Page")
2266 (cons :tag "Range"
2267 (integer :tag "From")
2268 (integer :tag "To"))))))
2269 :version "20"
2270 :group 'ps-print-background)
2271
2272 (defcustom ps-print-background-text nil
2273 "Text list to be printed on background.
2274
2275 The elements are:
2276
2277 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2278
2279 STRING is the text to be printed on background.
2280
2281 X and Y are positions on paper to put the text.
2282 If X and Y are nil, the text is positioned at lower left corner.
2283
2284 FONT is a font name to be used on printing the text.
2285 If nil, \"Times-Roman\" is used.
2286
2287 FONTSIZE is font size to be used, if nil, 200 is used.
2288
2289 GRAY is the text gray factor (should be very light like 0.8).
2290 If nil, the default is 0.85.
2291
2292 ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
2293 from lower left corner to upper right corner.
2294
2295 PAGES designates the page to print background text.
2296 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2297 page.
2298 If PAGES is nil, print background text on all pages.
2299
2300 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2301 number or a string. If it is a string, the string should contain PostScript
2302 programming that returns a float or integer value.
2303
2304 For example, if you wish to print text \"Preliminary\" on all pages do:
2305
2306 '((\"Preliminary\"))"
2307 :type '(repeat
2308 (list
2309 (string :tag "Text")
2310 (choice :tag "X" (const :tag "default" nil) number string)
2311 (choice :tag "Y" (const :tag "default" nil) number string)
2312 (choice :tag "Font" (const :tag "default" nil) string)
2313 (choice :tag "Fontsize" (const :tag "default" nil) number string)
2314 (choice :tag "Gray" (const :tag "default" nil) number string)
2315 (choice :tag "Rotation" (const :tag "default" nil) number string)
2316 (repeat :tag "Pages" :inline t
2317 (radio (integer :tag "Page")
2318 (cons :tag "Range"
2319 (integer :tag "From")
2320 (integer :tag "To"))))))
2321 :version "20"
2322 :group 'ps-print-background)
2323
2324 ;;; Horizontal layout
2325
2326 ;; ------------------------------------------
2327 ;; | | | | | | | |
2328 ;; | lm | text | ic | text | ic | text | rm |
2329 ;; | | | | | | | |
2330 ;; ------------------------------------------
2331
2332 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
2333 "Left margin in points (1/72 inch)."
2334 :type 'number
2335 :version "20"
2336 :group 'ps-print-horizontal)
2337
2338 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
2339 "Right margin in points (1/72 inch)."
2340 :type 'number
2341 :version "20"
2342 :group 'ps-print-horizontal)
2343
2344 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
2345 "Horizontal space between columns in points (1/72 inch)."
2346 :type 'number
2347 :version "20"
2348 :group 'ps-print-horizontal)
2349
2350 ;;; Vertical layout
2351
2352 ;; |--------|
2353 ;; | tm |
2354 ;; |--------|
2355 ;; | header |
2356 ;; |--------|
2357 ;; | ho |
2358 ;; |--------|
2359 ;; | text |
2360 ;; |--------|
2361 ;; | bm |
2362 ;; |--------|
2363
2364 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2365 "Bottom margin in points (1/72 inch)."
2366 :type 'number
2367 :version "20"
2368 :group 'ps-print-vertical)
2369
2370 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2371 "Top margin in points (1/72 inch)."
2372 :type 'number
2373 :version "20"
2374 :group 'ps-print-vertical)
2375
2376 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2377 "Vertical space in points (1/72 inch) between the main text and the header."
2378 :type 'number
2379 :version "20"
2380 :group 'ps-print-vertical)
2381
2382 (defcustom ps-header-line-pad 0.15
2383 "Portion of a header title line height to insert.
2384 The insertion is done between the header frame and the text it contains,
2385 both in the vertical and horizontal directions."
2386 :type 'number
2387 :version "20"
2388 :group 'ps-print-vertical)
2389
2390 (defcustom ps-footer-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2391 "Vertical space in points (1/72 inch) between the main text and the footer."
2392 :type 'number
2393 :version "20"
2394 :group 'ps-print-vertical)
2395
2396 (defcustom ps-footer-line-pad 0.15
2397 "Portion of a footer title line height to insert.
2398 The insertion is done between the footer frame and the text it contains,
2399 both in the vertical and horizontal directions."
2400 :type 'number
2401 :version "20"
2402 :group 'ps-print-vertical)
2403
2404 ;;; Header/Footer setup
2405
2406 (defcustom ps-print-header t
2407 "Non-nil means print a header at the top of each page.
2408 By default, the header displays the buffer name, page number, and, if the
2409 buffer is visiting a file, the file's directory. Headers are customizable by
2410 changing variables `ps-left-header' and `ps-right-header'."
2411 :type 'boolean
2412 :version "20"
2413 :group 'ps-print-headers)
2414
2415 (defcustom ps-print-header-frame t
2416 "Non-nil means draw a gaudy frame around the header."
2417 :type 'boolean
2418 :version "20"
2419 :group 'ps-print-headers)
2420
2421 (defcustom ps-header-frame-alist
2422 '((fore-color . 0.0)
2423 (back-color . 0.9)
2424 (border-width . 0.4)
2425 (border-color . 0.0)
2426 (shadow-color . 0.0))
2427 "Specify header frame properties alist.
2428
2429 Valid frame properties are:
2430
2431 `fore-color' Specify the foreground frame color.
2432 It should be a float number between 0.0 (black color)
2433 and 1.0 (white color), a string which is a color name,
2434 or a list of 3 float numbers which corresponds to the
2435 Red Green Blue color scale, each float number between
2436 0.0 (dark color) and 1.0 (bright color).
2437
2438 `back-color' Specify the background frame color (similar to
2439 `fore-color').
2440
2441 `shadow-color' Specify the shadow color (similar to `fore-color').
2442
2443 `border-color' Specify the border color (similar to `fore-color').
2444
2445 `border-width' Specify the border width.
2446
2447 Any other property is ignored.
2448
2449 Don't change this alist directly, instead use customization, or `ps-value',
2450 `ps-get', `ps-put' and `ps-del' functions (see them for documentation)."
2451 :version "21.1"
2452 :type '(repeat
2453 (choice :menu-tag "Header Frame Element"
2454 :tag ""
2455 (cons :tag "Foreground Color" :format "%v"
2456 (const :format "" fore-color)
2457 (choice :menu-tag "Foreground Color"
2458 :tag "Foreground Color"
2459 (number :tag "Gray Scale" :value 0.0)
2460 (string :tag "Color Name" :value "black")
2461 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2462 (number :tag "Red")
2463 (number :tag "Green")
2464 (number :tag "Blue"))))
2465 (cons :tag "Background Color" :format "%v"
2466 (const :format "" back-color)
2467 (choice :menu-tag "Background Color"
2468 :tag "Background Color"
2469 (number :tag "Gray Scale" :value 0.9)
2470 (string :tag "Color Name" :value "gray90")
2471 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2472 (number :tag "Red")
2473 (number :tag "Green")
2474 (number :tag "Blue"))))
2475 (cons :tag "Border Width" :format "%v"
2476 (const :format "" border-width)
2477 (number :tag "Border Width" :value 0.4))
2478 (cons :tag "Border Color" :format "%v"
2479 (const :format "" border-color)
2480 (choice :menu-tag "Border Color"
2481 :tag "Border Color"
2482 (number :tag "Gray Scale" :value 0.0)
2483 (string :tag "Color Name" :value "black")
2484 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2485 (number :tag "Red")
2486 (number :tag "Green")
2487 (number :tag "Blue"))))
2488 (cons :tag "Shadow Color" :format "%v"
2489 (const :format "" shadow-color)
2490 (choice :menu-tag "Shadow Color"
2491 :tag "Shadow 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 :version "20"
2499 :group 'ps-print-headers)
2500
2501 (defcustom ps-header-lines 2
2502 "Number of lines to display in page header, when generating PostScript."
2503 :type 'integer
2504 :version "20"
2505 :group 'ps-print-headers)
2506
2507 (defcustom ps-print-footer nil
2508 "Non-nil means print a footer at the bottom of each page.
2509 By default, the footer displays page number.
2510 Footers are customizable by changing variables `ps-left-footer' and
2511 `ps-right-footer'."
2512 :type 'boolean
2513 :version "21.1"
2514 :group 'ps-print-headers)
2515
2516 (defcustom ps-print-footer-frame t
2517 "Non-nil means draw a gaudy frame around the footer."
2518 :type 'boolean
2519 :version "21.1"
2520 :group 'ps-print-headers)
2521
2522 (defcustom ps-footer-frame-alist
2523 '((fore-color . 0.0)
2524 (back-color . 0.9)
2525 (border-width . 0.4)
2526 (border-color . 0.0)
2527 (shadow-color . 0.0))
2528 "Specify footer frame properties alist.
2529
2530 Don't change this alist directly, instead use customization, or `ps-value',
2531 `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
2532
2533 See also `ps-header-frame-alist' for documentation."
2534 :type '(repeat
2535 (choice :menu-tag "Header Frame Element"
2536 :tag ""
2537 (cons :tag "Foreground Color" :format "%v"
2538 (const :format "" fore-color)
2539 (choice :menu-tag "Foreground Color"
2540 :tag "Foreground Color"
2541 (number :tag "Gray Scale" :value 0.0)
2542 (string :tag "Color Name" :value "black")
2543 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2544 (number :tag "Red")
2545 (number :tag "Green")
2546 (number :tag "Blue"))))
2547 (cons :tag "Background Color" :format "%v"
2548 (const :format "" back-color)
2549 (choice :menu-tag "Background Color"
2550 :tag "Background Color"
2551 (number :tag "Gray Scale" :value 0.9)
2552 (string :tag "Color Name" :value "gray90")
2553 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2554 (number :tag "Red")
2555 (number :tag "Green")
2556 (number :tag "Blue"))))
2557 (cons :tag "Border Width" :format "%v"
2558 (const :format "" border-width)
2559 (number :tag "Border Width" :value 0.4))
2560 (cons :tag "Border Color" :format "%v"
2561 (const :format "" border-color)
2562 (choice :menu-tag "Border Color"
2563 :tag "Border Color"
2564 (number :tag "Gray Scale" :value 0.0)
2565 (string :tag "Color Name" :value "black")
2566 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2567 (number :tag "Red")
2568 (number :tag "Green")
2569 (number :tag "Blue"))))
2570 (cons :tag "Shadow Color" :format "%v"
2571 (const :format "" shadow-color)
2572 (choice :menu-tag "Shadow Color"
2573 :tag "Shadow 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 :version "21.1"
2581 :group 'ps-print-headers)
2582
2583 (defcustom ps-footer-lines 2
2584 "Number of lines to display in page footer, when generating PostScript."
2585 :type 'integer
2586 :version "21.1"
2587 :group 'ps-print-headers)
2588
2589 (defcustom ps-print-only-one-header nil
2590 "Non-nil means print only one header/footer at the top/bottom of each page.
2591 This is useful when printing more than one column, so it is possible to have
2592 only one header/footer over all columns or one header/footer per column.
2593 See also `ps-print-header' and `ps-print-footer'."
2594 :type 'boolean
2595 :version "20"
2596 :group 'ps-print-headers)
2597
2598 (defcustom ps-switch-header 'duplex
2599 "Specify if headers/footers are switched or not.
2600
2601 Valid values are:
2602
2603 nil Never switch headers/footers.
2604
2605 t Always switch headers/footers.
2606
2607 duplex Switch headers/footers only when duplexing is on, that is, when
2608 `ps-spool-duplex' is non-nil.
2609
2610 Any other value is treated as t.
2611
2612 See also `ps-print-header' and `ps-print-footer'."
2613 :type '(choice :menu-tag "Switch Header/Footer"
2614 :tag "Switch Header/Footer"
2615 (const :tag "Never Switch" nil)
2616 (const :tag "Always Switch" t)
2617 (const :tag "Switch When Duplexing" duplex))
2618 :version "20"
2619 :group 'ps-print-headers)
2620
2621 (defcustom ps-show-n-of-n t
2622 "Non-nil means show page numbers as N/M, meaning page N of M.
2623 NOTE: page numbers are displayed as part of headers,
2624 see variable `ps-print-header'."
2625 :type 'boolean
2626 :version "20"
2627 :group 'ps-print-headers)
2628
2629 (defcustom ps-spool-config
2630 (if lpr-windows-system
2631 nil
2632 'lpr-switches)
2633 "Specify who is responsible for setting duplex and page size.
2634
2635 Valid values are:
2636
2637 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2638 Don't forget to set `ps-lpr-switches' to select duplex
2639 printing for your printer.
2640
2641 `setpagedevice' duplex and page size are configured by ps-print using the
2642 setpagedevice PostScript operator.
2643
2644 nil duplex and page size are configured by ps-print *not* using
2645 the setpagedevice PostScript operator.
2646
2647 Any other value is treated as nil.
2648
2649 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2650 viewing file generated using landscape. Also on some printers,
2651 setpagedevice affects zebra stripes; on other printers, setpagedevice
2652 affects the left margin.
2653 Besides all that, if your printer does not have the paper size
2654 specified by setpagedevice, your printing will be aborted.
2655 So, if you need to use setpagedevice, set `ps-spool-config' to
2656 `setpagedevice', generate a test file and send it to your printer; if
2657 the printed file isn't OK, set `ps-spool-config' to nil."
2658 :type '(choice :menu-tag "Spool Config"
2659 :tag "Spool Config"
2660 (const lpr-switches) (const setpagedevice)
2661 (const :tag "nil" nil))
2662 :version "20"
2663 :group 'ps-print-headers)
2664
2665 (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
2666 ; so default to nil.
2667 "Non-nil generates PostScript for a two-sided printer.
2668 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2669 blank pages as needed between print jobs so that the next buffer printed will
2670 start on the right page. Also, if headers are turned on, the headers will be
2671 reversed on duplex printers so that the page numbers fall to the left on
2672 even-numbered pages.
2673
2674 See also `ps-spool-tumble'."
2675 :type 'boolean
2676 :version "20"
2677 :group 'ps-print-headers)
2678
2679 (defcustom ps-spool-tumble nil
2680 "Specify how the page images on opposite sides of a sheet are oriented.
2681 If `ps-spool-tumble' is nil, produces output suitable for binding on the left
2682 or right. If `ps-spool-tumble' is non-nil, produces output suitable for
2683 binding at the top or bottom.
2684
2685 It has effect only when `ps-spool-duplex' is non-nil."
2686 :type 'boolean
2687 :version "20"
2688 :group 'ps-print-headers)
2689
2690 ;;; Fonts
2691
2692 (defcustom ps-font-info-database
2693 '((Courier ; the family key
2694 (fonts (normal . "Courier")
2695 (bold . "Courier-Bold")
2696 (italic . "Courier-Oblique")
2697 (bold-italic . "Courier-BoldOblique"))
2698 (size . 10.0)
2699 (line-height . 10.55)
2700 (space-width . 6.0)
2701 (avg-char-width . 6.0))
2702 (Helvetica ; the family key
2703 (fonts (normal . "Helvetica")
2704 (bold . "Helvetica-Bold")
2705 (italic . "Helvetica-Oblique")
2706 (bold-italic . "Helvetica-BoldOblique"))
2707 (size . 10.0)
2708 (line-height . 11.56)
2709 (space-width . 2.78)
2710 (avg-char-width . 5.09243))
2711 (Times
2712 (fonts (normal . "Times-Roman")
2713 (bold . "Times-Bold")
2714 (italic . "Times-Italic")
2715 (bold-italic . "Times-BoldItalic"))
2716 (size . 10.0)
2717 (line-height . 11.0)
2718 (space-width . 2.5)
2719 (avg-char-width . 4.71432))
2720 (Palatino
2721 (fonts (normal . "Palatino-Roman")
2722 (bold . "Palatino-Bold")
2723 (italic . "Palatino-Italic")
2724 (bold-italic . "Palatino-BoldItalic"))
2725 (size . 10.0)
2726 (line-height . 12.1)
2727 (space-width . 2.5)
2728 (avg-char-width . 5.08676))
2729 (Helvetica-Narrow
2730 (fonts (normal . "Helvetica-Narrow")
2731 (bold . "Helvetica-Narrow-Bold")
2732 (italic . "Helvetica-Narrow-Oblique")
2733 (bold-italic . "Helvetica-Narrow-BoldOblique"))
2734 (size . 10.0)
2735 (line-height . 11.56)
2736 (space-width . 2.2796)
2737 (avg-char-width . 4.17579))
2738 (NewCenturySchlbk
2739 (fonts (normal . "NewCenturySchlbk-Roman")
2740 (bold . "NewCenturySchlbk-Bold")
2741 (italic . "NewCenturySchlbk-Italic")
2742 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2743 (size . 10.0)
2744 (line-height . 12.15)
2745 (space-width . 2.78)
2746 (avg-char-width . 5.31162))
2747 ;; got no bold for the next ones
2748 (AvantGarde-Book
2749 (fonts (normal . "AvantGarde-Book")
2750 (italic . "AvantGarde-BookOblique"))
2751 (size . 10.0)
2752 (line-height . 11.77)
2753 (space-width . 2.77)
2754 (avg-char-width . 5.45189))
2755 (AvantGarde-Demi
2756 (fonts (normal . "AvantGarde-Demi")
2757 (italic . "AvantGarde-DemiOblique"))
2758 (size . 10.0)
2759 (line-height . 12.72)
2760 (space-width . 2.8)
2761 (avg-char-width . 5.51351))
2762 (Bookman-Demi
2763 (fonts (normal . "Bookman-Demi")
2764 (italic . "Bookman-DemiItalic"))
2765 (size . 10.0)
2766 (line-height . 11.77)
2767 (space-width . 3.4)
2768 (avg-char-width . 6.05946))
2769 (Bookman-Light
2770 (fonts (normal . "Bookman-Light")
2771 (italic . "Bookman-LightItalic"))
2772 (size . 10.0)
2773 (line-height . 11.79)
2774 (space-width . 3.2)
2775 (avg-char-width . 5.67027))
2776 ;; got no bold and no italic for the next ones
2777 (Symbol
2778 (fonts (normal . "Symbol"))
2779 (size . 10.0)
2780 (line-height . 13.03)
2781 (space-width . 2.5)
2782 (avg-char-width . 3.24324))
2783 (Zapf-Dingbats
2784 (fonts (normal . "Zapf-Dingbats"))
2785 (size . 10.0)
2786 (line-height . 9.63)
2787 (space-width . 2.78)
2788 (avg-char-width . 2.78))
2789 (ZapfChancery-MediumItalic
2790 (fonts (normal . "ZapfChancery-MediumItalic"))
2791 (size . 10.0)
2792 (line-height . 11.45)
2793 (space-width . 2.2)
2794 (avg-char-width . 4.10811))
2795 ;; We keep this wrong entry name (but with correct font name) for
2796 ;; backward compatibility.
2797 (Zapf-Chancery-MediumItalic
2798 (fonts (normal . "ZapfChancery-MediumItalic"))
2799 (size . 10.0)
2800 (line-height . 11.45)
2801 (space-width . 2.2)
2802 (avg-char-width . 4.10811))
2803 )
2804 "Font info database.
2805 Each element comprises: font family (the key), name, bold, italic, bold-italic,
2806 reference size, line height, space width, average character width.
2807 To get the info for another specific font (say Helvetica), do the following:
2808 - create a new buffer
2809 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2810 - open this file and delete the leading `%' (which is the PostScript comment
2811 character) from the line
2812 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2813 to get the line
2814 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2815 - add the values to `ps-font-info-database'.
2816 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2817
2818 Note also that ps-print DOESN'T download any font to your printer, instead it
2819 uses the fonts resident in your printer."
2820 :type '(repeat
2821 (list :tag "Font Definition"
2822 (symbol :tag "Font Family")
2823 (cons :format "%v"
2824 (const :format "" fonts)
2825 (repeat :tag "Faces"
2826 (cons (choice :menu-tag "Font Weight/Slant"
2827 :tag "Font Weight/Slant"
2828 (const normal)
2829 (const bold)
2830 (const italic)
2831 (const bold-italic)
2832 (symbol :tag "Face"))
2833 (string :tag "Font Name"))))
2834 (cons :format "%v"
2835 (const :format "" size)
2836 (number :tag "Reference Size"))
2837 (cons :format "%v"
2838 (const :format "" line-height)
2839 (number :tag "Line Height"))
2840 (cons :format "%v"
2841 (const :format "" space-width)
2842 (number :tag "Space Width"))
2843 (cons :format "%v"
2844 (const :format "" avg-char-width)
2845 (number :tag "Average Character Width"))))
2846 :version "20"
2847 :group 'ps-print-font)
2848
2849 (defcustom ps-font-family 'Courier
2850 "Font family name for ordinary text, when generating PostScript."
2851 :type 'symbol
2852 :version "20"
2853 :group 'ps-print-font)
2854
2855 (defcustom ps-font-size '(7 . 8.5)
2856 "Font size, in points, for ordinary text, when generating PostScript.
2857 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2858 :type '(choice :menu-tag "Ordinary Text Font Size"
2859 :tag "Ordinary Text Font Size"
2860 (number :tag "Text Size")
2861 (cons :tag "Landscape/Portrait"
2862 (number :tag "Landscape Text Size")
2863 (number :tag "Portrait Text Size")))
2864 :version "20"
2865 :group 'ps-print-font)
2866
2867 (defcustom ps-header-font-family 'Helvetica
2868 "Font family name for text in the header, when generating PostScript."
2869 :type 'symbol
2870 :version "20"
2871 :group 'ps-print-font)
2872
2873 (defcustom ps-header-font-size '(10 . 12)
2874 "Font size, in points, for text in the header, when generating PostScript.
2875 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2876 :type '(choice :menu-tag "Header Font Size"
2877 :tag "Header Font Size"
2878 (number :tag "Header Size")
2879 (cons :tag "Landscape/Portrait"
2880 (number :tag "Landscape Header Size")
2881 (number :tag "Portrait Header Size")))
2882 :version "20"
2883 :group 'ps-print-font)
2884
2885 (defcustom ps-header-title-font-size '(12 . 14)
2886 "Font size, in points, for the top line of text in header, in PostScript.
2887 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2888 :type '(choice :menu-tag "Header Title Font Size"
2889 :tag "Header Title Font Size"
2890 (number :tag "Header Title Size")
2891 (cons :tag "Landscape/Portrait"
2892 (number :tag "Landscape Header Title Size")
2893 (number :tag "Portrait Header Title Size")))
2894 :version "20"
2895 :group 'ps-print-font)
2896
2897 (defcustom ps-footer-font-family 'Helvetica
2898 "Font family name for text in the footer, when generating PostScript."
2899 :type 'symbol
2900 :version "21.1"
2901 :group 'ps-print-font)
2902
2903 (defcustom ps-footer-font-size '(10 . 12)
2904 "Font size, in points, for text in the footer, when generating PostScript.
2905 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2906 :type '(choice :menu-tag "Footer Font Size"
2907 :tag "Footer Font Size"
2908 (number :tag "Footer Size")
2909 (cons :tag "Landscape/Portrait"
2910 (number :tag "Landscape Footer Size")
2911 (number :tag "Portrait Footer Size")))
2912 :version "21.1"
2913 :group 'ps-print-font)
2914
2915 (defcustom ps-line-number-color "black"
2916 "Specify color for line-number, when generating PostScript."
2917 :type '(choice :menu-tag "Line Number Color"
2918 :tag "Line Number Color"
2919 (number :tag "Gray Scale" :value 0)
2920 (string :tag "Color Name" :value "black")
2921 (list :tag "RGB Color" :value (0 0 0)
2922 (number :tag "Red")
2923 (number :tag "Green")
2924 (number :tag "Blue")))
2925 :version "21.1"
2926 :group 'ps-print-font
2927 :group 'ps-print-miscellany)
2928
2929 (defcustom ps-line-number-font "Times-Italic"
2930 "Font for line-number, when generating PostScript."
2931 :type 'string
2932 :version "20"
2933 :group 'ps-print-font
2934 :group 'ps-print-miscellany)
2935
2936 (defcustom ps-line-number-font-size 6
2937 "Font size, in points, for line number, when generating PostScript.
2938 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2939 :type '(choice :menu-tag "Line Number Font Size"
2940 :tag "Line Number Font Size"
2941 (number :tag "Font Size")
2942 (cons :tag "Landscape/Portrait"
2943 (number :tag "Landscape Font Size")
2944 (number :tag "Portrait Font Size")))
2945 :version "20"
2946 :group 'ps-print-font
2947 :group 'ps-print-miscellany)
2948
2949 ;;; Colors
2950
2951 ;; Printing color requires x-color-values.
2952 ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
2953 ;; widget to work.
2954 ;;;###autoload
2955 (defcustom ps-print-color-p
2956 (or (fboundp 'x-color-values) ; Emacs
2957 (fboundp 'color-instance-rgb-components))
2958 ; XEmacs
2959 "Specify how buffer's text color is printed.
2960
2961 Valid values are:
2962
2963 nil Do not print colors.
2964
2965 t Print colors.
2966
2967 black-white Print colors on black/white printer.
2968 See also `ps-black-white-faces'.
2969
2970 Any other value is treated as t."
2971 :type '(choice :menu-tag "Print Color"
2972 :tag "Print Color"
2973 (const :tag "Do NOT Print Color" nil)
2974 (const :tag "Print Always Color" t)
2975 (const :tag "Print Black/White Color" black-white))
2976 :version "20"
2977 :group 'ps-print-color)
2978
2979 (defcustom ps-default-fg nil
2980 "RGB values of the default foreground color.
2981
2982 The `ps-default-fg' variable contains the default foreground color used by
2983 ps-print, that is, if there is a face in a text that doesn't have a foreground
2984 color, the `ps-default-fg' color should be used.
2985
2986 Valid values are:
2987
2988 t The foreground color of Emacs session will be used.
2989
2990 frame-parameter The foreground-color frame parameter will be used.
2991
2992 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
2993 indicate the gray color.
2994
2995 COLOR-NAME It's a string which contains the color name. For example:
2996 \"yellow\".
2997
2998 LIST It's a list of RGB values, that is a list of three real values
2999 of the form:
3000
3001 (RED GREEN BLUE)
3002
3003 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3004 1.0 (full color).
3005
3006 Any other value is ignored and black color will be used.
3007
3008 This variable is used only when `ps-print-color-p' (which see) is neither nil
3009 nor black-white."
3010 :type '(choice :menu-tag "Default Foreground Gray/Color"
3011 (const :tag "Session Foreground" t)
3012 (const :tag "Frame Foreground" frame-parameter)
3013 (number :tag "Gray Scale" :value 0.0)
3014 (string :tag "Color Name" :value "black")
3015 (list :tag "RGB Color" :value (0.0 0.0 0.0)
3016 (number :tag "Red")
3017 (number :tag "Green")
3018 (number :tag "Blue"))
3019 (other :tag "Default Foreground Gray/Color" nil))
3020 :version "20"
3021 :group 'ps-print-color)
3022
3023 (defcustom ps-default-bg nil
3024 "RGB values of the default background color.
3025
3026 The `ps-default-bg' variable contains the default background color used by
3027 ps-print, that is, if there is a face in a text that doesn't have a background
3028 color, the `ps-default-bg' color should be used.
3029
3030 Valid values are:
3031
3032 t The background color of Emacs session will be used.
3033
3034 frame-parameter The background-color frame parameter will be used.
3035
3036 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3037 indicate the gray color.
3038
3039 COLOR-NAME It's a string which contains the color name. For example:
3040 \"yellow\".
3041
3042 LIST It's a list of RGB values, that is a list of three real values
3043 of the form:
3044
3045 (RED GREEN BLUE)
3046
3047 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3048 1.0 (full color).
3049
3050 Any other value is ignored and white color will be used.
3051
3052 This variable is used only when `ps-print-color-p' (which see) is neither nil
3053 nor black-white.
3054
3055 See also `ps-use-face-background'."
3056 :type '(choice :menu-tag "Default Background Gray/Color"
3057 (const :tag "Session Background" t)
3058 (const :tag "Frame Background" frame-parameter)
3059 (number :tag "Gray Scale" :value 1.0)
3060 (string :tag "Color Name" :value "white")
3061 (list :tag "RGB Color" :value (1.0 1.0 1.0)
3062 (number :tag "Red")
3063 (number :tag "Green")
3064 (number :tag "Blue"))
3065 (other :tag "Default Background Gray/Color" nil))
3066 :version "20"
3067 :group 'ps-print-color)
3068
3069 (defcustom ps-fg-list nil
3070 "Specify foreground color list.
3071
3072 This list is used to chose a text foreground color which is different than the
3073 background color. It'll be used the first foreground color in `ps-fg-list'
3074 which is different from the background color.
3075
3076 If this list is nil, the default foreground color is used. See
3077 `ps-default-fg'.
3078
3079 The list element valid values are:
3080
3081 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3082 indicate the gray color.
3083
3084 COLOR-NAME It's a string which contains the color name. For example:
3085 \"yellow\".
3086
3087 LIST It's a list of RGB values, that is a list of three real values
3088 of the form:
3089
3090 (RED GREEN BLUE)
3091
3092 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3093 1.0 (full color).
3094
3095 Any other value is ignored and black color will be used.
3096
3097 This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
3098 when `ps-print-color-p' (which see) is neither nil nor black-white."
3099 :type '(repeat
3100 (choice :menu-tag "Foreground Gray/Color"
3101 :tag "Foreground Gray/Color"
3102 (number :tag "Gray Scale" :value 0.0)
3103 (string :tag "Color Name" :value "black")
3104 (list :tag "RGB Color" :value (0.0 0.0 0.0)
3105 (number :tag "Red")
3106 (number :tag "Green")
3107 (number :tag "Blue"))))
3108 :version "22"
3109 :group 'ps-print-color)
3110
3111 (defcustom ps-fg-validate-p t
3112 "Non-nil means validate if foreground color is different than background.
3113
3114 If text foreground and background colors are equals, no text will appear.
3115
3116 See also `ps-fg-list'."
3117 :type 'boolean
3118 :version "22"
3119 :group 'ps-print-color)
3120
3121 (defcustom ps-auto-font-detect t
3122 "Non-nil means automatically detect bold/italic/underline face attributes.
3123 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
3124 `ps-underlined-faces'."
3125 :type 'boolean
3126 :version "20"
3127 :group 'ps-print-font)
3128
3129 (defcustom ps-black-white-faces
3130 '((font-lock-builtin-face "black" nil bold )
3131 (font-lock-comment-face "gray20" nil italic)
3132 (font-lock-constant-face "black" nil bold )
3133 (font-lock-function-name-face "black" nil bold )
3134 (font-lock-keyword-face "black" nil bold )
3135 (font-lock-string-face "black" nil italic)
3136 (font-lock-type-face "black" nil italic)
3137 (font-lock-variable-name-face "black" nil bold italic)
3138 (font-lock-warning-face "black" nil bold italic))
3139 "Specify list of face attributes to print colors on black/white printers.
3140
3141 The list elements are the same as defined on `ps-extend-face' (which see).
3142
3143 This variable is used only when `ps-print-color-p' is set to `black-white'."
3144 :version "21.1"
3145 :type '(repeat
3146 (list :tag "Face Specification"
3147 (face :tag "Face Symbol")
3148 (choice :menu-tag "Foreground Color"
3149 :tag "Foreground Color"
3150 (const :tag "Black" nil)
3151 (string :tag "Color Name"))
3152 (choice :menu-tag "Background Color"
3153 :tag "Background Color"
3154 (const :tag "None" nil)
3155 (string :tag "Color Name"))
3156 (repeat :inline t
3157 (choice :menu-tag "Attribute"
3158 (const bold)
3159 (const italic)
3160 (const underline)
3161 (const strikeout)
3162 (const overline)
3163 (const shadow)
3164 (const box)
3165 (const outline)))))
3166 :version "20"
3167 :group 'ps-print-face)
3168
3169 (defcustom ps-bold-faces
3170 (unless ps-print-color-p
3171 '(font-lock-function-name-face
3172 font-lock-builtin-face
3173 font-lock-variable-name-face
3174 font-lock-keyword-face
3175 font-lock-warning-face))
3176 "A list of the \(non-bold\) faces that should be printed in bold font.
3177 This applies to generating PostScript."
3178 :type '(repeat face)
3179 :version "20"
3180 :group 'ps-print-face)
3181
3182 (defcustom ps-italic-faces
3183 (unless ps-print-color-p
3184 '(font-lock-variable-name-face
3185 font-lock-type-face
3186 font-lock-string-face
3187 font-lock-comment-face
3188 font-lock-warning-face))
3189 "A list of the \(non-italic\) faces that should be printed in italic font.
3190 This applies to generating PostScript."
3191 :type '(repeat face)
3192 :version "20"
3193 :group 'ps-print-face)
3194
3195 (defcustom ps-underlined-faces
3196 (unless ps-print-color-p
3197 '(font-lock-function-name-face
3198 font-lock-constant-face
3199 font-lock-warning-face))
3200 "A list of the \(non-underlined\) faces that should be printed underlined.
3201 This applies to generating PostScript."
3202 :type '(repeat face)
3203 :version "20"
3204 :group 'ps-print-face)
3205
3206 (defcustom ps-use-face-background nil
3207 "Specify if face background should be used.
3208
3209 Valid values are:
3210
3211 t always use face background color.
3212 nil never use face background color.
3213 (face...) list of faces whose background color will be used.
3214
3215 Any other value will be treated as t."
3216 :type '(choice :menu-tag "Use Face Background"
3217 :tag "Use Face Background"
3218 (const :tag "Always Use Face Background" t)
3219 (const :tag "Never Use Face Background" nil)
3220 (repeat :menu-tag "Face Background List"
3221 :tag "Face Background List"
3222 face))
3223 :version "20"
3224 :group 'ps-print-face)
3225
3226 (defcustom ps-left-header
3227 (list 'ps-get-buffer-name 'ps-header-dirpart)
3228 "The items to display (each on a line) on the left part of the page header.
3229 This applies to generating PostScript.
3230
3231 The value should be a list of strings and symbols, each representing an entry
3232 in the PostScript array HeaderLinesLeft.
3233
3234 Strings are inserted unchanged into the array; those representing
3235 PostScript string literals should be delimited with PostScript string
3236 delimiters '(' and ')'.
3237
3238 For symbols with bound functions, the function is called and should return a
3239 string to be inserted into the array. For symbols with bound values, the value
3240 should be a string to be inserted into the array. In either case, function or
3241 variable, the string value has PostScript string delimiters added to it.
3242
3243 If symbols are unbounded, they are silently ignored."
3244 :type '(repeat (choice :menu-tag "Left Header"
3245 :tag "Left Header"
3246 string symbol))
3247 :version "20"
3248 :group 'ps-print-headers)
3249
3250 (defcustom ps-right-header
3251 (list "/pagenumberstring load"
3252 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3253 "The items to display (each on a line) on the right part of the page header.
3254 This applies to generating PostScript.
3255
3256 See the variable `ps-left-header' for a description of the format of this
3257 variable.
3258
3259 There are the following basic functions implemented:
3260
3261 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3262 as, for example, \"06/18/01\".
3263
3264 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3265
3266 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3267
3268 `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
3269 date).
3270
3271 `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
3272
3273 You can also create your own time stamp function by using `format-time-string'
3274 \(which see)."
3275 :type '(repeat (choice :menu-tag "Right Header"
3276 :tag "Right Header"
3277 string symbol))
3278 :version "20"
3279 :group 'ps-print-headers)
3280
3281 (defcustom ps-left-footer
3282 (list 'ps-get-buffer-name 'ps-header-dirpart)
3283 "The items to display (each on a line) on the left part of the page footer.
3284 This applies to generating PostScript.
3285
3286 The value should be a list of strings and symbols, each representing an entry
3287 in the PostScript array FooterLinesLeft.
3288
3289 Strings are inserted unchanged into the array; those representing PostScript
3290 string literals should be delimited with PostScript string delimiters '(' and
3291 ')'.
3292
3293 For symbols with bound functions, the function is called and should return a
3294 string to be inserted into the array. For symbols with bound values, the value
3295 should be a string to be inserted into the array. In either case, function or
3296 variable, the string value has PostScript string delimiters added to it.
3297
3298 If symbols are unbounded, they are silently ignored."
3299 :type '(repeat (choice :menu-tag "Left Footer"
3300 :tag "Left Footer"
3301 string symbol))
3302 :version "21.1"
3303 :group 'ps-print-headers)
3304
3305 (defcustom ps-right-footer
3306 (list "/pagenumberstring load"
3307 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3308 "The items to display (each on a line) on the right part of the page footer.
3309 This applies to generating PostScript.
3310
3311 See the variable `ps-left-footer' for a description of the format of this
3312 variable.
3313
3314 There are the following basic functions implemented:
3315
3316 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3317 as, for example, \"06/18/01\".
3318
3319 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3320
3321 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3322
3323 `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
3324 date).
3325
3326 `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
3327
3328 You can also create your own time stamp function by using `format-time-string'
3329 \(which see)."
3330 :type '(repeat (choice :menu-tag "Right Footer"
3331 :tag "Right Footer"
3332 string symbol))
3333 :version "21.1"
3334 :group 'ps-print-headers)
3335
3336 (defcustom ps-razzle-dazzle t
3337 "Non-nil means report progress while formatting buffer."
3338 :type 'boolean
3339 :version "20"
3340 :group 'ps-print-miscellany)
3341
3342 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
3343 "Contains the header line identifying the output as PostScript.
3344 By default, `ps-adobe-tag' contains the standard identifier. Some printers
3345 require slightly different versions of this line."
3346 :type 'string
3347 :version "20"
3348 :group 'ps-print-miscellany)
3349
3350 (defcustom ps-build-face-reference t
3351 "Non-nil means build the reference face lists.
3352
3353 ps-print sets this value to nil after it builds its internal reference lists of
3354 bold and italic faces. By setting its value back to t, you can force ps-print
3355 to rebuild the lists the next time you invoke one of the ...-with-faces
3356 commands.
3357
3358 You should set this value back to t after you change the attributes of any
3359 face, or create new faces. Most users shouldn't have to worry about its
3360 setting, though."
3361 :type 'boolean
3362 :version "20"
3363 :group 'ps-print-face)
3364
3365 (defcustom ps-always-build-face-reference nil
3366 "Non-nil means always rebuild the reference face lists.
3367
3368 If this variable is non-nil, ps-print will rebuild its internal reference lists
3369 of bold and italic faces *every* time one of the ...-with-faces commands is
3370 called. Most users shouldn't need to set this variable."
3371 :type 'boolean
3372 :version "20"
3373 :group 'ps-print-face)
3374
3375 (defcustom ps-banner-page-when-duplexing nil
3376 "Non-nil means the very first page is skipped.
3377 It's like the very first character of buffer (or region) is ^L (\\014)."
3378 :type 'boolean
3379 :version "20"
3380 :group 'ps-print-headers)
3381
3382 (defcustom ps-postscript-code-directory
3383 (cond ((fboundp 'locate-data-directory) ; XEmacs
3384 (locate-data-directory "ps-print"))
3385 ((boundp 'data-directory) ; XEmacs and Emacs.
3386 data-directory)
3387 (t ; don't know what to do
3388 (error "`ps-postscript-code-directory' isn't set properly")))
3389 "Directory where it's located the PostScript prologue file used by ps-print.
3390 By default, this directory is the same as in the variable `data-directory'."
3391 :type 'directory
3392 :version "20"
3393 :group 'ps-print-miscellany)
3394
3395 (defcustom ps-line-spacing 0
3396 "Specify line spacing, in points, for ordinary text.
3397
3398 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3399
3400 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3401
3402 To get all lines with some spacing set both `ps-line-spacing' and
3403 `ps-paragraph-spacing' variables."
3404 :type '(choice :menu-tag "Line Spacing For Ordinary Text"
3405 :tag "Line Spacing For Ordinary Text"
3406 (number :tag "Line Spacing")
3407 (cons :tag "Landscape/Portrait"
3408 (number :tag "Landscape Line Spacing")
3409 (number :tag "Portrait Line Spacing")))
3410 :version "21.1"
3411 :group 'ps-print-miscellany)
3412
3413 (defcustom ps-paragraph-spacing 0
3414 "Specify paragraph spacing, in points, for ordinary text.
3415
3416 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3417
3418 See also `ps-line-spacing' and `ps-paragraph-regexp'.
3419
3420 To get all lines with some spacing set both `ps-line-spacing' and
3421 `ps-paragraph-spacing' variables."
3422 :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text"
3423 :tag "Paragraph Spacing For Ordinary Text"
3424 (number :tag "Paragraph Spacing")
3425 (cons :tag "Landscape/Portrait"
3426 (number :tag "Landscape Paragraph Spacing")
3427 (number :tag "Portrait Paragraph Spacing")))
3428 :version "21.1"
3429 :group 'ps-print-miscellany)
3430
3431 (defcustom ps-paragraph-regexp "[ \t]*$"
3432 "Specify paragraph delimiter.
3433
3434 It should be a regexp or nil.
3435
3436 See also `ps-paragraph-spacing'."
3437 :type '(choice :menu-tag "Paragraph Delimiter"
3438 (const :tag "No Delimiter" nil)
3439 (regexp :tag "Delimiter Regexp"))
3440 :version "21.1"
3441 :group 'ps-print-miscellany)
3442
3443 (defcustom ps-begin-cut-regexp nil
3444 "Specify regexp which is start of a region to cut out when printing.
3445
3446 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
3447 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
3448 some special printing instructions from the actual print. Special printing
3449 instructions may be appended to the end of the file just like any other
3450 buffer-local variables. See section \"Local Variables in Files\" on Emacs
3451 manual for more information.
3452
3453 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3454 actually gets printed. Both variables may be set to nil in which case no
3455 cutting occurs."
3456 :type '(choice (const :tag "No Delimiter" nil)
3457 (regexp :tag "Delimiter Regexp"))
3458 :version "21.1"
3459 :group 'ps-print-miscellany)
3460
3461 (defcustom ps-end-cut-regexp nil
3462 "Specify regexp which is end of the region to cut out when printing.
3463
3464 See `ps-begin-cut-regexp' for more information."
3465 :type '(choice (const :tag "No Delimiter" nil)
3466 (regexp :tag "Delimiter Regexp"))
3467 :version "21.1"
3468 :group 'ps-print-miscellany)
3469
3470
3471 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3472 ;; Selected Pages
3473
3474
3475 (defvar ps-last-selected-pages nil
3476 "Latest `ps-selected-pages' value.")
3477
3478
3479 (defun ps-restore-selected-pages ()
3480 "Restore latest `ps-selected-pages' value."
3481 (interactive)
3482 (setq ps-selected-pages ps-last-selected-pages))
3483
3484
3485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3486 ;; Customization
3487
3488
3489 ;;;###autoload
3490 (defun ps-print-customize ()
3491 "Customization of ps-print group."
3492 (interactive)
3493 (customize-group 'ps-print))
3494
3495
3496 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3497 ;; User commands
3498
3499
3500 ;;;###autoload
3501 (defun ps-print-buffer (&optional filename)
3502 "Generate and print a PostScript image of the buffer.
3503
3504 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3505 user for a file name, and saves the PostScript image in that file instead of
3506 sending it to the printer.
3507
3508 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3509 send the image to the printer. If FILENAME is a string, save the PostScript
3510 image in a file with that name."
3511 (interactive (list (ps-print-preprint current-prefix-arg)))
3512 (ps-print-without-faces (point-min) (point-max) filename))
3513
3514
3515 ;;;###autoload
3516 (defun ps-print-buffer-with-faces (&optional filename)
3517 "Generate and print a PostScript image of the buffer.
3518 Like `ps-print-buffer', but includes font, color, and underline information in
3519 the generated image. This command works only if you are using a window system,
3520 so it has a way to determine color values."
3521 (interactive (list (ps-print-preprint current-prefix-arg)))
3522 (ps-print-with-faces (point-min) (point-max) filename))
3523
3524
3525 ;;;###autoload
3526 (defun ps-print-region (from to &optional filename)
3527 "Generate and print a PostScript image of the region.
3528 Like `ps-print-buffer', but prints just the current region."
3529 (interactive (ps-print-preprint-region current-prefix-arg))
3530 (ps-print-without-faces from to filename t))
3531
3532
3533 ;;;###autoload
3534 (defun ps-print-region-with-faces (from to &optional filename)
3535 "Generate and print a PostScript image of the region.
3536 Like `ps-print-region', but includes font, color, and underline information in
3537 the generated image. This command works only if you are using a window system,
3538 so it has a way to determine color values."
3539 (interactive (ps-print-preprint-region current-prefix-arg))
3540 (ps-print-with-faces from to filename t))
3541
3542
3543 ;;;###autoload
3544 (defun ps-spool-buffer ()
3545 "Generate and spool a PostScript image of the buffer.
3546 Like `ps-print-buffer' except that the PostScript image is saved in a local
3547 buffer to be sent to the printer later.
3548
3549 Use the command `ps-despool' to send the spooled images to the printer."
3550 (interactive)
3551 (ps-spool-without-faces (point-min) (point-max)))
3552
3553
3554 ;;;###autoload
3555 (defun ps-spool-buffer-with-faces ()
3556 "Generate and spool a PostScript image of the buffer.
3557 Like the command `ps-spool-buffer', but includes font, color, and underline
3558 information in the generated image. This command works only if you are using
3559 a window system, so it has a way to determine color values.
3560
3561 Use the command `ps-despool' to send the spooled images to the printer."
3562 (interactive)
3563 (ps-spool-with-faces (point-min) (point-max)))
3564
3565
3566 ;;;###autoload
3567 (defun ps-spool-region (from to)
3568 "Generate a PostScript image of the region and spool locally.
3569 Like `ps-spool-buffer', but spools just the current region.
3570
3571 Use the command `ps-despool' to send the spooled images to the printer."
3572 (interactive "r")
3573 (ps-spool-without-faces from to t))
3574
3575
3576 ;;;###autoload
3577 (defun ps-spool-region-with-faces (from to)
3578 "Generate a PostScript image of the region and spool locally.
3579 Like `ps-spool-region', but includes font, color, and underline information in
3580 the generated image. This command works only if you are using a window system,
3581 so it has a way to determine color values.
3582
3583 Use the command `ps-despool' to send the spooled images to the printer."
3584 (interactive "r")
3585 (ps-spool-with-faces from to t))
3586
3587 ;;;###autoload
3588 (defun ps-despool (&optional filename)
3589 "Send the spooled PostScript to the printer.
3590
3591 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3592 user for a file name, and saves the spooled PostScript image in that file
3593 instead of sending it to the printer.
3594
3595 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3596 send the image to the printer. If FILENAME is a string, save the PostScript
3597 image in a file with that name."
3598 (interactive (list (ps-print-preprint current-prefix-arg)))
3599 (ps-do-despool filename))
3600
3601 ;;;###autoload
3602 (defun ps-line-lengths ()
3603 "Display the correspondence between a line length and a font size.
3604 Done using the current ps-print setup.
3605 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3606 (interactive)
3607 (ps-line-lengths-internal))
3608
3609 ;;;###autoload
3610 (defun ps-nb-pages-buffer (nb-lines)
3611 "Display number of pages to print this buffer, for various font heights.
3612 The table depends on the current ps-print setup."
3613 (interactive (ps-count-lines-preprint (point-min) (point-max)))
3614 (ps-nb-pages nb-lines))
3615
3616 ;;;###autoload
3617 (defun ps-nb-pages-region (nb-lines)
3618 "Display number of pages to print the region, for various font heights.
3619 The table depends on the current ps-print setup."
3620 (interactive (ps-count-lines-preprint (mark) (point)))
3621 (ps-nb-pages nb-lines))
3622
3623 (defvar ps-prefix-quote nil
3624 "Used for `ps-print-quote' (which see).")
3625
3626 ;;;###autoload
3627 (defun ps-setup ()
3628 "Return the current PostScript-generation setup."
3629 (let (ps-prefix-quote)
3630 (mapconcat
3631 #'ps-print-quote
3632 (list
3633 (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs")
3634 ") ps-print version " ps-print-version "\n")
3635 ";; internal vars"
3636 (ps-comment-string "emacs-version " emacs-version)
3637 (ps-comment-string "lpr-windows-system" lpr-windows-system)
3638 nil
3639 '(25 . ps-print-color-p)
3640 '(25 . ps-lpr-command)
3641 '(25 . ps-lpr-switches)
3642 '(25 . ps-printer-name)
3643 '(25 . ps-printer-name-option)
3644 '(25 . ps-print-region-function)
3645 '(25 . ps-manual-feed)
3646 '(25 . ps-end-with-control-d)
3647 nil
3648 '(23 . ps-paper-type)
3649 '(23 . ps-warn-paper-type)
3650 '(23 . ps-landscape-mode)
3651 '(23 . ps-print-upside-down)
3652 '(23 . ps-number-of-columns)
3653 nil
3654 '(23 . ps-zebra-stripes)
3655 '(23 . ps-zebra-stripe-height)
3656 '(23 . ps-zebra-stripe-follow)
3657 '(23 . ps-zebra-color)
3658 '(23 . ps-line-number)
3659 '(23 . ps-line-number-step)
3660 '(23 . ps-line-number-start)
3661 nil
3662 '(17 . ps-razzle-dazzle)
3663 '(17 . ps-default-bg)
3664 '(17 . ps-default-fg)
3665 '(17 . ps-fg-validate-p)
3666 '(17 . ps-fg-list)
3667 nil
3668 '(23 . ps-use-face-background)
3669 nil
3670 '(28 . ps-print-control-characters)
3671 nil
3672 '(26 . ps-print-background-image)
3673 nil
3674 '(25 . ps-print-background-text)
3675 nil
3676 '(29 . ps-error-handler-message)
3677 '(29 . ps-user-defined-prologue)
3678 '(29 . ps-print-prologue-header)
3679 '(29 . ps-postscript-code-directory)
3680 '(29 . ps-adobe-tag)
3681 nil
3682 '(30 . ps-left-margin)
3683 '(30 . ps-right-margin)
3684 '(30 . ps-inter-column)
3685 '(30 . ps-bottom-margin)
3686 '(30 . ps-top-margin)
3687 '(30 . ps-print-only-one-header)
3688 '(30 . ps-switch-header)
3689 '(30 . ps-print-header)
3690 '(30 . ps-header-lines)
3691 '(30 . ps-header-offset)
3692 '(30 . ps-header-line-pad)
3693 '(30 . ps-print-header-frame)
3694 '(30 . ps-header-frame-alist)
3695 '(30 . ps-print-footer)
3696 '(30 . ps-footer-lines)
3697 '(30 . ps-footer-offset)
3698 '(30 . ps-footer-line-pad)
3699 '(30 . ps-print-footer-frame)
3700 '(30 . ps-footer-frame-alist)
3701 '(30 . ps-show-n-of-n)
3702 '(30 . ps-spool-config)
3703 '(30 . ps-spool-duplex)
3704 '(30 . ps-spool-tumble)
3705 '(30 . ps-banner-page-when-duplexing)
3706 '(30 . ps-left-header)
3707 '(30 . ps-right-header)
3708 '(30 . ps-left-footer)
3709 '(30 . ps-right-footer)
3710 nil
3711 '(23 . ps-n-up-printing)
3712 '(23 . ps-n-up-margin)
3713 '(23 . ps-n-up-border-p)
3714 '(23 . ps-n-up-filling)
3715 nil
3716 '(26 . ps-multibyte-buffer)
3717 '(26 . ps-font-family)
3718 '(26 . ps-font-size)
3719 '(26 . ps-header-font-family)
3720 '(26 . ps-header-font-size)
3721 '(26 . ps-header-title-font-size)
3722 '(26 . ps-footer-font-family)
3723 '(26 . ps-footer-font-size)
3724 '(26 . ps-line-number-color)
3725 '(26 . ps-line-number-font)
3726 '(26 . ps-line-number-font-size)
3727 '(26 . ps-line-spacing)
3728 '(26 . ps-paragraph-spacing)
3729 '(26 . ps-paragraph-regexp)
3730 '(26 . ps-begin-cut-regexp)
3731 '(26 . ps-end-cut-regexp)
3732 nil
3733 '(23 . ps-even-or-odd-pages)
3734 '(23 . ps-selected-pages)
3735 '(23 . ps-last-selected-pages)
3736 nil
3737 '(31 . ps-build-face-reference)
3738 '(31 . ps-always-build-face-reference)
3739 nil
3740 '(20 . ps-auto-font-detect)
3741 '(20 . ps-bold-faces)
3742 '(20 . ps-italic-faces)
3743 '(20 . ps-underlined-faces)
3744 '(20 . ps-black-white-faces)
3745 " )\n
3746 \;; The following customized variables have long lists and are seldom modified:
3747 \;; ps-page-dimensions-database
3748 \;; ps-font-info-database
3749
3750 \;;; ps-print - end of settings\n")
3751 "\n")))
3752
3753
3754 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3755 ;; Utility functions and variables:
3756
3757
3758 (defun ps-print-quote (elt)
3759 "Quote ELT for printing (used for showing settings).
3760
3761 If ELT is nil, return an empty string.
3762 If ELT is string, return it.
3763 Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3764 LEN is the field length where SYM name will be inserted. The variable
3765 `ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
3766 used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3767 generated is:
3768
3769 * If `ps-prefix-quote' is nil:
3770 \"(setq SYM-NAME SYM-VALUE\"
3771 |<------->|
3772 LEN
3773
3774 * If `ps-prefix-quote' is non-nil:
3775 \" SYM-NAME SYM-VALUE\"
3776 |<------->|
3777 LEN
3778
3779 If `ps-prefix-quote' is nil, it's set to t after generating string."
3780 (cond
3781 ((stringp elt) elt)
3782 ((and (consp elt) (integerp (car elt))
3783 (symbolp (cdr elt)) (boundp (cdr elt)))
3784 (let* ((col (car elt))
3785 (sym (cdr elt))
3786 (key (symbol-name sym))
3787 (len (length key))
3788 (val (symbol-value sym)))
3789 (concat (if ps-prefix-quote
3790 " "
3791 (setq ps-prefix-quote t)
3792 "(setq ")
3793 key
3794 (if (> col len)
3795 (make-string (- col len) ?\s)
3796 " ")
3797 (ps-value-string val))))
3798 (t "")
3799 ))
3800
3801
3802 (defun ps-value-string (val)
3803 "Return a string representation of VAL. Used by `ps-print-quote'."
3804 (cond ((null val)
3805 "nil")
3806 ((eq val t)
3807 "t")
3808 ((or (symbolp val) (listp val))
3809 (format "'%S" val))
3810 (t
3811 (format "%S" val))))
3812
3813
3814 (defun ps-comment-string (str value)
3815 "Return a comment string like \";; STR = VALUE\"."
3816 (format ";; %s = %s" str (ps-value-string value)))
3817
3818
3819 (defun ps-value (alist-sym key)
3820 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3821 (cdr (assq key (symbol-value alist-sym))))
3822
3823
3824 (defun ps-get (alist-sym key)
3825 "Return element from association list ALIST-SYM which car is `eq' to KEY."
3826 (assq key (symbol-value alist-sym)))
3827
3828
3829 (defun ps-put (alist-sym key value)
3830 "Store element (KEY . VALUE) into association list ALIST-SYM.
3831 If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3832 It can be retrieved with `(ps-get ALIST-SYM KEY)'."
3833 (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
3834 (if elt:
3835 (setcdr elt: value)
3836 (setq elt: (cons key value))
3837 (set alist-sym (cons elt: (symbol-value alist-sym))))
3838 elt:))
3839
3840
3841 (defun ps-del (alist-sym key)
3842 "Delete by side effect element KEY from association list ALIST-SYM."
3843 (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
3844 old)
3845 (while a:list:
3846 (if (eq key (car (car a:list:)))
3847 (progn
3848 (if old
3849 (setcdr old (cdr a:list:))
3850 (set alist-sym (cdr a:list:)))
3851 (setq a:list: nil))
3852 (setq old a:list:
3853 a:list: (cdr a:list:)))))
3854 (symbol-value alist-sym))
3855
3856
3857 (defun ps-time-stamp-locale-default ()
3858 "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
3859 (format-time-string "%x"))
3860
3861
3862 (defun ps-time-stamp-mon-dd-yyyy ()
3863 "Return date as \"Jun 18 2001\"."
3864 (format-time-string "%b %d %Y"))
3865
3866
3867 (defun ps-time-stamp-yyyy-mm-dd ()
3868 "Return date as \"2001-06-18\" (ISO date)."
3869 (format-time-string "%Y-%m-%d"))
3870
3871
3872 ;; Alias for `ps-time-stamp-yyyy-mm-dd' (which see).
3873 (defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd)
3874
3875
3876 (defun ps-time-stamp-hh:mm:ss ()
3877 "Return time as \"17:28:31\"."
3878 (format-time-string "%T"))
3879
3880
3881 (defvar ps-print-color-scale 1.0)
3882
3883 (defun ps-color-scale (color)
3884 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3885 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
3886 (ps-color-values color)))
3887
3888
3889 (defun ps-face-underlined-p (face)
3890 (or (face-underline-p face)
3891 (memq face ps-underlined-faces)))
3892
3893
3894 (defun ps-prologue-file (filenumber)
3895 "If prologue FILENUMBER exists and is readable, return contents as string.
3896
3897 Note: No major/minor-mode is activated and no local variables are evaluated for
3898 FILENUMBER, but proper EOL-conversion and character interpretation is
3899 done!"
3900 (let ((filename (convert-standard-filename
3901 (expand-file-name (format "ps-prin%d.ps" filenumber)
3902 ps-postscript-code-directory))))
3903 (if (and (file-exists-p filename)
3904 (file-readable-p filename))
3905 (with-temp-buffer
3906 (insert-file-contents filename)
3907 (buffer-string))
3908 (error "ps-print PostScript prologue `%s' file was not found"
3909 filename))))
3910
3911
3912 (defvar ps-mark-code-directory nil)
3913
3914 (defvar ps-print-prologue-0 ""
3915 "ps-print PostScript error handler.")
3916
3917 (defvar ps-print-prologue-1 ""
3918 "ps-print PostScript prologue.")
3919
3920 ;; Start Editing Here:
3921
3922 (defvar ps-source-buffer nil)
3923 (defvar ps-spool-buffer-name "*PostScript*")
3924 (defvar ps-spool-buffer nil)
3925
3926 (defvar ps-output-head nil)
3927 (defvar ps-output-tail nil)
3928
3929 (defvar ps-page-postscript 0) ; page number
3930 (defvar ps-page-order 0) ; PostScript page counter
3931 (defvar ps-page-sheet 0) ; sheet counter
3932 (defvar ps-page-column 0) ; column counter
3933 (defvar ps-page-printed 0) ; total pages printed
3934 (defvar ps-page-n-up 0) ; n-up counter
3935 (defvar ps-lines-printed 0) ; total lines printed
3936 (defvar ps-showline-count 1) ; line number counter
3937 (defvar ps-first-page nil)
3938 (defvar ps-last-page nil)
3939 (defvar ps-print-page-p t)
3940
3941 (defvar ps-control-or-escape-regexp nil)
3942 (defvar ps-n-up-on nil)
3943
3944 (defvar ps-background-pages nil)
3945 (defvar ps-background-all-pages nil)
3946 (defvar ps-background-text-count 0)
3947 (defvar ps-background-image-count 0)
3948
3949 (defvar ps-current-font 0)
3950 (defvar ps-default-foreground nil)
3951 (defvar ps-default-background nil)
3952 (defvar ps-default-color nil)
3953 (defvar ps-current-color nil)
3954 (defvar ps-current-bg nil)
3955 (defvar ps-foreground-list nil)
3956
3957 (defvar ps-zebra-stripe-full-p nil)
3958 (defvar ps-razchunk 0)
3959
3960 (defvar ps-color-p nil)
3961
3962 ;; These values determine how much print-height to deduct when headers/footers
3963 ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
3964 ;; now.
3965
3966 (defvar ps-header-pad 0
3967 "Vertical and horizontal space between the header frame and the text.
3968 This is in units of points (1/72 inch).")
3969
3970 (defvar ps-footer-pad 0
3971 "Vertical and horizontal space between the footer frame and the text.
3972 This is in units of points (1/72 inch).")
3973
3974 ;; Define accessors to the dimensions list.
3975
3976 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3977 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
3978 (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
3979
3980 (defvar ps-landscape-page-height nil)
3981
3982 (defvar ps-print-width nil)
3983 (defvar ps-print-height nil)
3984
3985 (defvar ps-height-remaining nil)
3986 (defvar ps-width-remaining nil)
3987
3988 (defvar ps-font-size-internal nil)
3989 (defvar ps-header-font-size-internal nil)
3990 (defvar ps-header-title-font-size-internal nil)
3991 (defvar ps-footer-font-size-internal nil)
3992 (defvar ps-line-spacing-internal nil)
3993 (defvar ps-paragraph-spacing-internal nil)
3994
3995 \f
3996 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3997 ;; Internal Variables
3998
3999
4000 (defvar ps-black-white-faces-alist nil
4001 "Alist of symbolic faces used for black/white PostScript printers.
4002 An element of this list has the same form as `ps-print-face-extension-alist'
4003 \(which see).
4004
4005 Don't change this list directly; instead,
4006 use `ps-extend-face' and `ps-extend-face-list'.
4007 See documentation for `ps-extend-face' for valid extension symbol.
4008 See also documentation for `ps-print-color-p'.")
4009
4010
4011 (defvar ps-print-face-extension-alist nil
4012 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
4013 An element of this list has the following form:
4014
4015 (FACE . [BITS FG BG])
4016
4017 FACE is a symbol denoting a face name
4018 BITS is a bit vector, where each bit correspond
4019 to a feature (bold, underline, etc)
4020 (see documentation for `ps-print-face-map-alist')
4021 FG foreground color (string or nil)
4022 BG background color (string or nil)
4023
4024 Don't change this list directly; instead,
4025 use `ps-extend-face' and `ps-extend-face-list'.
4026 See documentation for `ps-extend-face' for valid extension symbol.")
4027
4028
4029 (defvar ps-print-face-alist nil
4030 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
4031
4032 An element of this list has the same form as an element of
4033 `ps-print-face-extension-alist'.
4034
4035 Don't change this list directly; this list is used by `ps-face-attributes',
4036 `ps-map-face' and `ps-build-reference-face-lists'.")
4037
4038
4039 (defconst ps-print-face-map-alist
4040 '((bold . 1)
4041 (italic . 2)
4042 (underline . 4)
4043 (strikeout . 8)
4044 (overline . 16)
4045 (shadow . 32)
4046 (box . 64)
4047 (outline . 128))
4048 "Alist of all features and the corresponding bit mask.
4049 Each symbol correspond to one bit in a bit vector.")
4050
4051 \f
4052 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4053 ;; Remapping Faces
4054
4055
4056 ;;;###autoload
4057 (defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym)
4058 "Extend face in ALIST-SYM.
4059
4060 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
4061 with face extension in ALIST-SYM; otherwise, overrides.
4062
4063 If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
4064 otherwise, it should be an alist symbol.
4065
4066 The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.
4067
4068 See `ps-extend-face' for documentation."
4069 (while face-extension-list
4070 (ps-extend-face (car face-extension-list) merge-p alist-sym)
4071 (setq face-extension-list (cdr face-extension-list))))
4072
4073
4074 ;;;###autoload
4075 (defun ps-extend-face (face-extension &optional merge-p alist-sym)
4076 "Extend face in ALIST-SYM.
4077
4078 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
4079 with face extensions in ALIST-SYM; otherwise, overrides.
4080
4081 If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
4082 otherwise, it should be an alist symbol.
4083
4084 The elements of FACE-EXTENSION list have the form:
4085
4086 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
4087
4088 FACE-NAME is a face name symbol.
4089
4090 FOREGROUND and BACKGROUND may be nil or a string that denotes the
4091 foreground and background colors respectively.
4092
4093 EXTENSION is one of the following symbols:
4094 bold - use bold font.
4095 italic - use italic font.
4096 underline - put a line under text.
4097 strikeout - like underline, but the line is in middle of text.
4098 overline - like underline, but the line is over the text.
4099 shadow - text will have a shadow.
4100 box - text will be surrounded by a box.
4101 outline - print characters as hollow outlines.
4102
4103 If EXTENSION is any other symbol, it is ignored."
4104 (or alist-sym
4105 (setq alist-sym 'ps-print-face-extension-alist))
4106 (let* ((background (nth 2 face-extension))
4107 (foreground (nth 1 face-extension))
4108 (face-name (nth 0 face-extension))
4109 (ps-face (cdr (assq face-name (symbol-value alist-sym))))
4110 (face-vector (or ps-face (vector 0 nil nil)))
4111 (face-bit (ps-extension-bit face-extension)))
4112 ;; extend face
4113 (aset face-vector 0 (if merge-p
4114 (logior (aref face-vector 0) face-bit)
4115 face-bit))
4116 (and (or (not merge-p) (and foreground (stringp foreground)))
4117 (aset face-vector 1 foreground))
4118 (and (or (not merge-p) (and background (stringp background)))
4119 (aset face-vector 2 background))
4120 ;; if face does not exist, insert it
4121 (or ps-face
4122 (set alist-sym (cons (cons face-name face-vector)
4123 (symbol-value alist-sym))))))
4124
4125
4126 (defun ps-extension-bit (face-extension)
4127 (let ((face-bit 0))
4128 ;; map valid symbol extension to bit vector
4129 (setq face-extension (cdr (cdr face-extension)))
4130 (while (setq face-extension (cdr face-extension))
4131 (setq face-bit (logior face-bit
4132 (or (cdr (assq (car face-extension)
4133 ps-print-face-map-alist))
4134 0))))
4135 face-bit))
4136
4137 \f
4138 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4139 ;; Adapted from font-lock: (obsolete stuff)
4140 ;; Originally face attributes were specified via `font-lock-face-attributes'.
4141 ;; Users then changed the default face attributes by setting that variable.
4142 ;; However, we try and be back-compatible and respect its value if set except
4143 ;; for faces where M-x customize has been used to save changes for the face.
4144
4145
4146 (defun ps-font-lock-face-attributes ()
4147 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
4148 (boundp 'font-lock-face-attributes)
4149 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
4150 (while face-attributes
4151 (let* ((face-attribute
4152 (car (prog1 face-attributes
4153 (setq face-attributes (cdr face-attributes)))))
4154 (face (car face-attribute)))
4155 ;; Rustle up a `defface' SPEC from a
4156 ;; `font-lock-face-attributes' entry.
4157 (unless (get face 'saved-face)
4158 (let ((foreground (nth 1 face-attribute))
4159 (background (nth 2 face-attribute))
4160 (bold-p (nth 3 face-attribute))
4161 (italic-p (nth 4 face-attribute))
4162 (underline-p (nth 5 face-attribute))
4163 face-spec)
4164 (when foreground
4165 (setq face-spec (cons ':foreground
4166 (cons foreground face-spec))))
4167 (when background
4168 (setq face-spec (cons ':background
4169 (cons background face-spec))))
4170 (when bold-p
4171 (setq face-spec (append '(:weight bold) face-spec)))
4172 (when italic-p
4173 (setq face-spec (append '(:slant italic) face-spec)))
4174 (when underline-p
4175 (setq face-spec (append '(:underline t) face-spec)))
4176 (custom-declare-face face (list (list t face-spec)) nil)
4177 )))))))
4178
4179 \f
4180 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4181 ;; Internal functions and variables
4182
4183
4184 (defun ps-message-log-max ()
4185 (and (not (string= (buffer-name) "*Messages*"))
4186 (boundp 'message-log-max)
4187 message-log-max))
4188
4189
4190 (defvar ps-print-hook nil)
4191 (defvar ps-print-begin-sheet-hook nil)
4192 (defvar ps-print-begin-page-hook nil)
4193 (defvar ps-print-begin-column-hook nil)
4194
4195
4196 (defun ps-print-without-faces (from to &optional filename region-p)
4197 (ps-spool-without-faces from to region-p)
4198 (ps-do-despool filename))
4199
4200
4201 (defun ps-spool-without-faces (from to &optional region-p)
4202 (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
4203 (run-hooks 'ps-print-hook)
4204 (ps-printing-region region-p from to)
4205 (ps-generate (current-buffer) from to 'ps-generate-postscript)))
4206
4207
4208 (defun ps-print-with-faces (from to &optional filename region-p)
4209 (ps-spool-with-faces from to region-p)
4210 (ps-do-despool filename))
4211
4212
4213 (defun ps-spool-with-faces (from to &optional region-p)
4214 (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
4215 (run-hooks 'ps-print-hook)
4216 (ps-printing-region region-p from to)
4217 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)))
4218
4219
4220 (defun ps-count-lines-preprint (from to)
4221 (or (and from to)
4222 (error "The mark is not set now"))
4223 (let ((message-log-max (ps-message-log-max))) ; to count lines of *Messages*
4224 (list (count-lines from to))))
4225
4226
4227 (defun ps-count-lines (from to)
4228 (+ (count-lines from to)
4229 (save-excursion
4230 (goto-char to)
4231 (if (= (current-column) 0) 1 0))))
4232
4233
4234 (defvar ps-printing-region nil
4235 "Variable used to indicate the region that ps-print is printing.
4236 It is a cons, the car of which is the line number where the region begins, and
4237 its cdr is the total number of lines in the buffer. Formatting functions can
4238 use this information to print the original line number (and not the number of
4239 lines printed), and to indicate in the header that the printout is of a partial
4240 file.")
4241
4242
4243 (defvar ps-printing-region-p nil
4244 "Non-nil means ps-print is printing a region.")
4245
4246
4247 (defun ps-printing-region (region-p from to)
4248 (setq ps-printing-region-p region-p
4249 ps-printing-region
4250 (cons (if region-p
4251 (ps-count-lines (point-min) (min from to))
4252 1)
4253 (ps-count-lines (point-min) (point-max)))))
4254
4255 \f
4256 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4257 ;; Internal functions
4258
4259
4260 (defsubst ps-font-alist (font-sym)
4261 (get font-sym 'fonts))
4262
4263 (defun ps-font (font-sym font-type)
4264 "Font family name for text of `font-type', when generating PostScript."
4265 (let* ((font-list (ps-font-alist font-sym))
4266 (normal-font (cdr (assq 'normal font-list))))
4267 (while (and font-list (not (eq font-type (car (car font-list)))))
4268 (setq font-list (cdr font-list)))
4269 (or (cdr (car font-list)) normal-font)))
4270
4271 (defsubst ps-fonts (font-sym)
4272 (mapcar 'cdr (ps-font-alist font-sym)))
4273
4274 (defsubst ps-font-number (font-sym font-type)
4275 (or (ps-alist-position font-type (ps-font-alist font-sym))
4276 0))
4277
4278 (defsubst ps-line-height (font-sym)
4279 "The height of a line, for generating PostScript.
4280 This is the value that ps-print uses to determine the height,
4281 y-dimension, of the lines of text it has printed, and thus affects the
4282 point at which page-breaks are placed.
4283 The line-height is *not* the same as the point size of the font."
4284 (get font-sym 'line-height))
4285
4286 (defsubst ps-title-line-height (font-sym)
4287 "The height of a `title' line, for generating PostScript.
4288 This is the value that ps-print uses to determine the height,
4289 y-dimension, of the lines of text it has printed, and thus affects the
4290 point at which page-breaks are placed.
4291 The title-line-height is *not* the same as the point size of the font."
4292 (get font-sym 'title-line-height))
4293
4294 (defsubst ps-space-width (font-sym)
4295 "The width of a space character, for generating PostScript.
4296 This value is used in expanding tab characters."
4297 (get font-sym 'space-width))
4298
4299 (defsubst ps-avg-char-width (font-sym)
4300 "The average width, in points, of a character, for generating PostScript.
4301 This is the value that ps-print uses to determine the length,
4302 x-dimension, of the text it has printed, and thus affects the point at
4303 which long lines wrap around."
4304 (get font-sym 'avg-char-width))
4305
4306 (defun ps-line-lengths-internal ()
4307 "Display the correspondence between a line length and a font size.
4308 Done using the current ps-print setup.
4309 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4310 (let* ((ps-font-size-internal
4311 (or ps-font-size-internal
4312 (ps-get-font-size 'ps-font-size)))
4313 (ps-header-font-size-internal
4314 (or ps-header-font-size-internal
4315 (ps-get-font-size 'ps-header-font-size)))
4316 (ps-footer-font-size-internal
4317 (or ps-footer-font-size-internal
4318 (ps-get-font-size 'ps-footer-font-size)))
4319 (ps-header-title-font-size-internal
4320 (or ps-header-title-font-size-internal
4321 (ps-get-font-size 'ps-header-title-font-size)))
4322 (buf (get-buffer-create "*Line-lengths*"))
4323 (ifs ps-font-size-internal) ; initial font size
4324 (print-width (progn (ps-get-page-dimensions)
4325 ps-print-width))
4326 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
4327 (ps-setup (ps-setup)) ; setup for the current buffer
4328 (fs-min 5) ; minimum font size
4329 cw-min ; minimum character width
4330 nb-cpl-max ; maximum nb of characters per line
4331 (fs-max 14) ; maximum font size
4332 cw-max ; maximum character width
4333 nb-cpl-min ; minimum nb of characters per line
4334 fs ; current font size
4335 cw ; current character width
4336 nb-cpl ; current nb of characters per line
4337 )
4338 (setq cw-min (/ (* icw fs-min) ifs)
4339 nb-cpl-max (floor (/ print-width cw-min))
4340 cw-max (/ (* icw fs-max) ifs)
4341 nb-cpl-min (floor (/ print-width cw-max))
4342 nb-cpl nb-cpl-min)
4343 (set-buffer buf)
4344 (goto-char (point-max))
4345 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4346 (insert ps-setup
4347 "\nnb char per line / font size\n")
4348 (while (<= nb-cpl nb-cpl-max)
4349 (setq cw (/ print-width (float nb-cpl))
4350 fs (/ (* ifs cw) icw))
4351 (insert (format "%16d %s\n" nb-cpl fs))
4352 (setq nb-cpl (1+ nb-cpl)))
4353 (insert "\n")
4354 (display-buffer buf 'not-this-window)))
4355
4356 (defun ps-nb-pages (nb-lines)
4357 "Display correspondence between font size and the number of pages.
4358 The correspondence is based on having NB-LINES lines of text,
4359 and on the current ps-print setup."
4360 (let* ((ps-font-size-internal
4361 (or ps-font-size-internal
4362 (ps-get-font-size 'ps-font-size)))
4363 (ps-header-font-size-internal
4364 (or ps-header-font-size-internal
4365 (ps-get-font-size 'ps-header-font-size)))
4366 (ps-footer-font-size-internal
4367 (or ps-footer-font-size-internal
4368 (ps-get-font-size 'ps-footer-font-size)))
4369 (ps-header-title-font-size-internal
4370 (or ps-header-title-font-size-internal
4371 (ps-get-font-size 'ps-header-title-font-size)))
4372 (ps-line-spacing-internal
4373 (or ps-line-spacing-internal
4374 (ps-get-size ps-line-spacing "line spacing")))
4375 (buf (get-buffer-create "*Nb-Pages*"))
4376 (ils ps-line-spacing-internal) ; initial line spacing
4377 (ifs ps-font-size-internal) ; initial font size
4378 (page-height (progn (ps-get-page-dimensions)
4379 ps-print-height))
4380 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
4381 (ps-setup (ps-setup)) ; setup for the current buffer
4382 (fs-min 4) ; minimum font size
4383 lh-min ; minimum line height
4384 nb-lpp-max ; maximum nb of lines per page
4385 nb-page-min ; minimum nb of pages
4386 (fs-max 14) ; maximum font size
4387 lh-max ; maximum line height
4388 nb-lpp-min ; minimum nb of lines per page
4389 nb-page-max ; maximum nb of pages
4390 fs ; current font size
4391 lh ; current line height
4392 nb-lpp ; current nb of lines per page
4393 nb-page ; current nb of pages
4394 )
4395 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
4396 nb-lpp-max (floor (/ page-height lh-min))
4397 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
4398 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
4399 nb-lpp-min (floor (/ page-height lh-max))
4400 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
4401 nb-page nb-page-min)
4402 (set-buffer buf)
4403 (goto-char (point-max))
4404 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4405 (insert ps-setup
4406 (format "\nThere are %d lines.\n\n" nb-lines)
4407 "nb page / font size\n")
4408 (while (<= nb-page nb-page-max)
4409 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
4410 lh (/ page-height nb-lpp)
4411 fs (/ (* ifs lh) ilh))
4412 (insert (format "%7d %s\n" nb-page fs))
4413 (setq nb-page (1+ nb-page)))
4414 (insert "\n")
4415 (display-buffer buf 'not-this-window)))
4416
4417 ;; macros used in `ps-select-font'
4418 (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
4419 (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
4420
4421 (defun ps-select-font (font-family sym font-size title-font-size)
4422 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
4423 (or font-entry
4424 (error "Don't have data to scale font %s. Known fonts families are %s"
4425 font-family
4426 (mapcar 'car ps-font-info-database)))
4427 (let ((size (ps-lookup 'size)))
4428 (put sym 'fonts (ps-lookup 'fonts))
4429 (put sym 'space-width (ps-size-scale 'space-width))
4430 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
4431 (put sym 'line-height (ps-size-scale 'line-height))
4432 (put sym 'title-line-height
4433 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
4434
4435 (defun ps-get-page-dimensions ()
4436 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
4437 page-width page-height)
4438 (cond
4439 ((null page-dimensions)
4440 (error "`ps-paper-type' must be one of:\n%s"
4441 (mapcar 'car ps-page-dimensions-database)))
4442 ((< ps-number-of-columns 1)
4443 (error "The number of columns %d should be positive"
4444 ps-number-of-columns)))
4445
4446 (ps-select-font ps-font-family 'ps-font-for-text
4447 ps-font-size-internal ps-font-size-internal)
4448 (ps-select-font ps-header-font-family 'ps-font-for-header
4449 ps-header-font-size-internal
4450 ps-header-title-font-size-internal)
4451 (ps-select-font ps-footer-font-family 'ps-font-for-footer
4452 ps-footer-font-size-internal ps-footer-font-size-internal)
4453
4454 (setq page-width (ps-page-dimensions-get-width page-dimensions)
4455 page-height (ps-page-dimensions-get-height page-dimensions))
4456
4457 ;; Landscape mode
4458 (if ps-landscape-mode
4459 ;; exchange width and height
4460 (setq page-width (prog1 page-height (setq page-height page-width))))
4461
4462 ;; It is used to get the lower right corner (only in landscape mode)
4463 (setq ps-landscape-page-height page-height)
4464
4465 ;; | lm | text | ic | text | ic | text | rm |
4466 ;; page-width == lm + n * pw + (n - 1) * ic + rm
4467 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
4468 (setq ps-print-width (/ (- page-width
4469 ps-left-margin ps-right-margin
4470 (* (1- ps-number-of-columns) ps-inter-column))
4471 ps-number-of-columns))
4472 (if (<= ps-print-width 0)
4473 (error "Bad horizontal layout:
4474 page-width == %s
4475 ps-left-margin == %s
4476 ps-right-margin == %s
4477 ps-inter-column == %s
4478 ps-number-of-columns == %s
4479 | lm | text | ic | text | ic | text | rm |
4480 page-width == lm + n * print-width + (n - 1) * ic + rm
4481 => print-width == %d !"
4482 page-width
4483 ps-left-margin
4484 ps-right-margin
4485 ps-inter-column
4486 ps-number-of-columns
4487 ps-print-width))
4488
4489 (setq ps-print-height
4490 (- page-height ps-bottom-margin ps-top-margin))
4491 (if (<= ps-print-height 0)
4492 (error "Bad vertical layout:
4493 ps-top-margin == %s
4494 ps-bottom-margin == %s
4495 page-height == bm + print-height + tm
4496 => print-height == %d !"
4497 ps-top-margin
4498 ps-bottom-margin
4499 ps-print-height))
4500 ;; If headers are turned on, deduct the height of the header from the print
4501 ;; height.
4502 (if ps-print-header
4503 (setq ps-header-pad (* ps-header-line-pad
4504 (ps-title-line-height 'ps-font-for-header))
4505 ps-print-height (- ps-print-height
4506 ps-header-offset
4507 ps-header-pad
4508 (ps-title-line-height 'ps-font-for-header)
4509 (* (ps-line-height 'ps-font-for-header)
4510 (1- ps-header-lines))
4511 ps-header-pad)))
4512 (if (<= ps-print-height 0)
4513 (error "Bad vertical layout (header):
4514 ps-top-margin == %s
4515 ps-bottom-margin == %s
4516 ps-header-offset == %s
4517 ps-header-pad == %s
4518 header-height == %s
4519 page-height == bm + print-height + tm - ho - hh
4520 => print-height == %d !"
4521 ps-top-margin
4522 ps-bottom-margin
4523 ps-header-offset
4524 ps-header-pad
4525 (+ ps-header-pad
4526 (ps-title-line-height 'ps-font-for-header)
4527 (* (ps-line-height 'ps-font-for-header)
4528 (1- ps-header-lines))
4529 ps-header-pad)
4530 ps-print-height))
4531 ;; If footers are turned on, deduct the height of the footer from the print
4532 ;; height.
4533 (if ps-print-footer
4534 (setq ps-footer-pad (* ps-footer-line-pad
4535 (ps-title-line-height 'ps-font-for-footer))
4536 ps-print-height (- ps-print-height
4537 ps-footer-offset
4538 ps-footer-pad
4539 (* (ps-line-height 'ps-font-for-footer)
4540 (1- ps-footer-lines))
4541 ps-footer-pad)))
4542 (if (<= ps-print-height 0)
4543 (error "Bad vertical layout (footer):
4544 ps-top-margin == %s
4545 ps-bottom-margin == %s
4546 ps-footer-offset == %s
4547 ps-footer-pad == %s
4548 footer-height == %s
4549 page-height == bm + print-height + tm - fo - fh
4550 => print-height == %d !"
4551 ps-top-margin
4552 ps-bottom-margin
4553 ps-footer-offset
4554 ps-footer-pad
4555 (+ ps-footer-pad
4556 (* (ps-line-height 'ps-font-for-footer)
4557 (1- ps-footer-lines))
4558 ps-footer-pad)
4559 ps-print-height))
4560 ;; ps-zebra-stripe-follow is `full' or `full-follow'
4561 (if ps-zebra-stripe-full-p
4562 (let* ((line-height (ps-line-height 'ps-font-for-text))
4563 (zebra (* (+ line-height ps-line-spacing-internal)
4564 ps-zebra-stripe-height)))
4565 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
4566 line-height))
4567 (if (<= ps-print-height 0)
4568 (error "Bad vertical layout (full zebra stripe follow):
4569 ps-zebra-stripe-follow == %s
4570 ps-zebra-stripe-height == %s
4571 font-text-height == %s
4572 line-spacing == %s
4573 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
4574 => print-height == %d !"
4575 ps-zebra-stripe-follow
4576 ps-zebra-stripe-height
4577 (ps-line-height 'ps-font-for-text)
4578 ps-line-spacing-internal
4579 ps-print-height))))))
4580
4581
4582 (defun ps-print-preprint-region (prefix)
4583 (or (ps-mark-active-p)
4584 (error "The mark is not set now"))
4585 (list (point) (mark) (ps-print-preprint prefix)))
4586
4587
4588 (defun ps-print-preprint (prefix)
4589 (and prefix
4590 (or (numberp prefix)
4591 (listp prefix))
4592 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4593 (buffer-name)))
4594 ".ps"))
4595 (prompt (format "Save PostScript to file (default %s): " name))
4596 (res (read-file-name prompt default-directory name nil)))
4597 (while (cond ((file-directory-p res)
4598 (ding)
4599 (setq prompt "It's a directory"))
4600 ((not (file-writable-p res))
4601 (ding)
4602 (setq prompt "File is unwritable"))
4603 ((file-exists-p res)
4604 (setq prompt "File exists")
4605 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4606 res))))
4607 (t nil))
4608 (setq res (read-file-name
4609 (format "%s; save PostScript to file: " prompt)
4610 (file-name-directory res) nil nil
4611 (file-name-nondirectory res))))
4612 (if (file-directory-p res)
4613 (expand-file-name name (file-name-as-directory res))
4614 res))))
4615
4616 ;; The following functions implement a simple list-buffering scheme so
4617 ;; that ps-print doesn't have to repeatedly switch between buffers
4618 ;; while spooling. The functions `ps-output' and `ps-output-string' build
4619 ;; up the lists; the function `ps-flush-output' takes the lists and
4620 ;; insert its contents into the spool buffer (*PostScript*).
4621
4622 (defvar ps-string-escape-codes
4623 (let ((table (make-vector 256 nil))
4624 (char ?\000))
4625 ;; control characters
4626 (while (<= char ?\037)
4627 (aset table char (format "\\%03o" char))
4628 (setq char (1+ char)))
4629 ;; printable characters
4630 (while (< char ?\177)
4631 (aset table char (format "%c" char))
4632 (setq char (1+ char)))
4633 ;; DEL and 8-bit characters
4634 (while (<= char ?\377)
4635 (aset table char (format "\\%o" char))
4636 (setq char (1+ char)))
4637 ;; Override ASCII formatting characters with named escape code:
4638 (aset table ?\n "\\n") ; [NL] linefeed
4639 (aset table ?\r "\\r") ; [CR] carriage return
4640 (aset table ?\t "\\t") ; [HT] horizontal tab
4641 (aset table ?\b "\\b") ; [BS] backspace
4642 (aset table ?\f "\\f") ; [NP] form feed
4643 ;; Escape PostScript escape and string delimiter characters:
4644 (aset table ?\\ "\\\\")
4645 (aset table ?\( "\\(")
4646 (aset table ?\) "\\)")
4647 table)
4648 "Vector used to map characters to PostScript string escape codes.")
4649
4650 (defsubst ps-output-string-prim (string)
4651 (insert "(") ;insert start-string delimiter
4652 (save-excursion ;insert string
4653 (insert (string-as-unibyte string)))
4654 ;; Find and quote special characters as necessary for PS
4655 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4656 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4657 (let ((special (following-char)))
4658 (delete-char 1)
4659 (insert
4660 (if (and (<= 0 special) (<= special 255))
4661 (aref ps-string-escape-codes special)
4662 ;; insert hexadecimal representation if character code is out of range
4663 (format "\\%04X" special)
4664 ))))
4665 (goto-char (point-max))
4666 (insert ")")) ;insert end-string delimiter
4667
4668 (defsubst ps-init-output-queue ()
4669 (setq ps-output-head (list "")
4670 ps-output-tail ps-output-head))
4671
4672
4673 (defun ps-selected-pages ()
4674 (while (progn
4675 (setq ps-first-page (car (car ps-selected-pages))
4676 ps-last-page (cdr (car ps-selected-pages))
4677 ps-selected-pages (cdr ps-selected-pages))
4678 (and ps-selected-pages
4679 (< ps-last-page ps-page-postscript)))))
4680
4681
4682 (defsubst ps-print-page-p ()
4683 (setq ps-print-page-p
4684 (and (cond ((null ps-first-page))
4685 ((<= ps-page-postscript ps-last-page)
4686 (<= ps-first-page ps-page-postscript))
4687 (ps-selected-pages
4688 (ps-selected-pages)
4689 (and (<= ps-first-page ps-page-postscript)
4690 (<= ps-page-postscript ps-last-page)))
4691 (t
4692 nil))
4693 (cond ((eq ps-even-or-odd-pages 'even-page)
4694 (= (logand ps-page-postscript 1) 0))
4695 ((eq ps-even-or-odd-pages 'odd-page)
4696 (= (logand ps-page-postscript 1) 1))
4697 (t)
4698 ))))
4699
4700
4701 (defsubst ps-print-sheet-p ()
4702 (setq ps-print-page-p
4703 (cond ((eq ps-even-or-odd-pages 'even-sheet)
4704 (= (logand ps-page-sheet 1) 0))
4705 ((eq ps-even-or-odd-pages 'odd-sheet)
4706 (= (logand ps-page-sheet 1) 1))
4707 (t)
4708 )))
4709
4710
4711 (defun ps-output (&rest args)
4712 (when ps-print-page-p
4713 (setcdr ps-output-tail args)
4714 (while (cdr ps-output-tail)
4715 (setq ps-output-tail (cdr ps-output-tail)))))
4716
4717 (defun ps-output-string (string)
4718 (ps-output t string))
4719
4720 ;; Output strings in the list ARGS in the PostScript prologue part.
4721 (defun ps-output-prologue (args)
4722 (ps-output 'prologue (if (stringp args) (list args) args)))
4723
4724 (defun ps-flush-output ()
4725 (with-current-buffer ps-spool-buffer
4726 (goto-char (point-max))
4727 (while ps-output-head
4728 (let ((it (car ps-output-head)))
4729 (cond
4730 ((eq t it)
4731 (setq ps-output-head (cdr ps-output-head))
4732 (ps-output-string-prim (car ps-output-head)))
4733 ((eq 'prologue it)
4734 (setq ps-output-head (cdr ps-output-head))
4735 (save-excursion
4736 (search-backward "\nBeginDoc")
4737 (forward-char 1)
4738 (apply 'insert (car ps-output-head))))
4739 (t
4740 (insert it))))
4741 (setq ps-output-head (cdr ps-output-head))))
4742 (ps-init-output-queue))
4743
4744 (defun ps-insert-file (fname)
4745 (ps-flush-output)
4746 (with-current-buffer ps-spool-buffer
4747 (goto-char (point-max))
4748 (insert-file-contents fname)))
4749
4750 ;; These functions insert the arrays that define the contents of the headers.
4751
4752 (defvar ps-encode-header-string-function nil)
4753
4754 (defun ps-generate-header-line (fonttag &optional content)
4755 (ps-output " [" fonttag " ")
4756 (cond
4757 ;; Literal strings should be output as is -- the string must contain its own
4758 ;; PS string delimiters, '(' and ')', if necessary.
4759 ((stringp content)
4760 (ps-output content))
4761
4762 ;; Functions are called -- they should return strings; they will be inserted
4763 ;; as strings and the PS string delimiters added.
4764 ((functionp content)
4765 (if (functionp ps-encode-header-string-function)
4766 (dolist (l (funcall ps-encode-header-string-function
4767 (funcall content) fonttag))
4768 (ps-output-string l))
4769 (ps-output-string (funcall content))))
4770
4771 ;; Variables will have their contents inserted. They should contain
4772 ;; strings, and will be inserted as strings.
4773 ((and (symbolp content) (boundp content))
4774 (if (fboundp ps-encode-header-string-function)
4775 (dolist (l (funcall ps-encode-header-string-function
4776 (symbol-value content) fonttag))
4777 (ps-output-string l))
4778 (ps-output-string (symbol-value content))))
4779
4780 ;; Anything else will get turned into an empty string.
4781 (t
4782 (ps-output-string "")))
4783 (ps-output "]\n"))
4784
4785 (defun ps-generate-header (name fonttag0 fonttag1 contents)
4786 (ps-output "/" name "[\n")
4787 (and contents (> ps-header-lines 0)
4788 (let ((count 1))
4789 (ps-generate-header-line fonttag0 (car contents))
4790 (while (and (< count ps-header-lines)
4791 (setq contents (cdr contents)))
4792 (ps-generate-header-line fonttag1 (car contents))
4793 (setq count (1+ count)))))
4794 (ps-output "]def\n"))
4795
4796
4797 (defun ps-output-boolean (name bool)
4798 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
4799
4800
4801 (defun ps-output-frame-properties (name alist)
4802 (ps-output "/" name " ["
4803 (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
4804 (ps-format-color (cdr (assq 'back-color alist)) 0.9)
4805 (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
4806 (ps-format-color (cdr (assq 'border-color alist)) 0.0)
4807 (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
4808 "]def\n"))
4809
4810
4811 (defun ps-background-pages (page-list func)
4812 (if page-list
4813 (mapcar
4814 #'(lambda (pages)
4815 (let ((start (if (consp pages) (car pages) pages))
4816 (end (if (consp pages) (cdr pages) pages)))
4817 (and (integerp start) (integerp end) (<= start end)
4818 (add-to-list 'ps-background-pages (vector start end func)))))
4819 page-list)
4820 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4821
4822
4823 (defconst ps-boundingbox-re
4824 "^%%BoundingBox:\
4825 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4826
4827
4828 (defun ps-get-boundingbox ()
4829 (with-current-buffer ps-spool-buffer
4830 (save-excursion
4831 (if (re-search-forward ps-boundingbox-re nil t)
4832 (vector (string-to-number ; lower x
4833 (buffer-substring (match-beginning 1) (match-end 1)))
4834 (string-to-number ; lower y
4835 (buffer-substring (match-beginning 2) (match-end 2)))
4836 (string-to-number ; upper x
4837 (buffer-substring (match-beginning 3) (match-end 3)))
4838 (string-to-number ; upper y
4839 (buffer-substring (match-beginning 4) (match-end 4))))
4840 (vector 0 0 0 0)))))
4841
4842
4843 (defun ps-float-format (value &optional default)
4844 (let ((literal (or value default)))
4845 (cond ((null literal)
4846 " ")
4847 ((numberp literal)
4848 (format ps-float-format (* literal 1.0))) ; force float number
4849 (t
4850 (format "%s " literal))
4851 )))
4852
4853
4854 (defun ps-background-text ()
4855 (mapcar
4856 #'(lambda (text)
4857 (setq ps-background-text-count (1+ ps-background-text-count))
4858 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
4859 (ps-output-string (nth 0 text)) ; text
4860 (ps-output
4861 "\n"
4862 (ps-float-format (nth 4 text) 200.0) ; font size
4863 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
4864 (ps-float-format (nth 6 text)
4865 "PrintHeight PrintPageWidth atan") ; rotation
4866 (ps-float-format (nth 5 text) 0.85) ; gray
4867 (ps-float-format (nth 1 text) "0") ; x position
4868 (ps-float-format (nth 2 text) "0") ; y position
4869 "\nShowBackText}def\n")
4870 (ps-background-pages (nthcdr 7 text) ; page list
4871 (format "ShowBackText-%d\n"
4872 ps-background-text-count)))
4873 ps-print-background-text))
4874
4875
4876 (defun ps-background-image ()
4877 (mapcar
4878 #'(lambda (image)
4879 (let ((image-file (expand-file-name (nth 0 image))))
4880 (when (file-readable-p image-file)
4881 (setq ps-background-image-count (1+ ps-background-image-count))
4882 (ps-output
4883 (format "/ShowBackImage-%d{\n--back-- "
4884 ps-background-image-count)
4885 (ps-float-format (nth 5 image) 0.0) ; rotation
4886 (ps-float-format (nth 3 image) 1.0) ; x scale
4887 (ps-float-format (nth 4 image) 1.0) ; y scale
4888 (ps-float-format (nth 1 image) ; x position
4889 "PrintPageWidth 2 div")
4890 (ps-float-format (nth 2 image) ; y position
4891 "PrintHeight 2 div BottomMargin add")
4892 "\nBeginBackImage\n")
4893 (ps-insert-file image-file)
4894 ;; coordinate adjustment to center image
4895 ;; around x and y position
4896 (let ((box (ps-get-boundingbox)))
4897 (with-current-buffer ps-spool-buffer
4898 (save-excursion
4899 (if (re-search-backward "^--back--" nil t)
4900 (replace-match
4901 (format "%s %s"
4902 (ps-float-format
4903 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
4904 (aref box 0))))
4905 (ps-float-format
4906 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
4907 (aref box 1)))))
4908 t)))))
4909 (ps-output "\nEndBackImage}def\n")
4910 (ps-background-pages (nthcdr 6 image) ; page list
4911 (format "ShowBackImage-%d\n"
4912 ps-background-image-count)))))
4913 ps-print-background-image))
4914
4915
4916 (defun ps-background (page-number)
4917 (let (has-local-background)
4918 (mapc #'(lambda (range)
4919 (and (<= (aref range 0) page-number)
4920 (<= page-number (aref range 1))
4921 (if has-local-background
4922 (ps-output (aref range 2))
4923 (setq has-local-background t)
4924 (ps-output "/printLocalBackground{\n"
4925 (aref range 2)))))
4926 ps-background-pages)
4927 (and has-local-background (ps-output "}def\n"))))
4928
4929
4930 ;; Return a list of the distinct elements of LIST.
4931 ;; Elements are compared with `equal'.
4932 (defun ps-remove-duplicates (list)
4933 (let (new (tail list))
4934 (while tail
4935 (or (member (car tail) new)
4936 (setq new (cons (car tail) new)))
4937 (setq tail (cdr tail)))
4938 (nreverse new)))
4939
4940
4941 ;; Find the first occurrence of ITEM in LIST.
4942 ;; Return the index of the matching item, or nil if not found.
4943 ;; Elements are compared with `eq'.
4944 (defun ps-alist-position (item list)
4945 (let ((tail list) (index 0) found)
4946 (while tail
4947 (if (setq found (eq (car (car tail)) item))
4948 (setq tail nil)
4949 (setq index (1+ index)
4950 tail (cdr tail))))
4951 (and found index)))
4952
4953
4954 (defconst ps-n-up-database
4955 '((a4
4956 (1 nil 1 1 0)
4957 (2 t 1 2 0)
4958 (4 nil 2 2 0)
4959 (6 t 2 3 1)
4960 (8 t 2 4 0)
4961 (9 nil 3 3 0)
4962 (12 t 3 4 2)
4963 (16 nil 4 4 0)
4964 (18 t 3 6 0)
4965 (20 nil 5 4 1)
4966 (25 nil 5 5 0)
4967 (30 nil 6 5 1)
4968 (32 t 4 8 0)
4969 (36 nil 6 6 0)
4970 (42 nil 7 6 1)
4971 (49 nil 7 7 0)
4972 (50 t 5 10 0)
4973 (56 nil 8 7 1)
4974 (64 nil 8 8 0)
4975 (72 nil 9 8 1)
4976 (81 nil 9 9 0)
4977 (90 nil 10 9 1)
4978 (100 nil 10 10 0))
4979 (a3
4980 (1 nil 1 1 0)
4981 (2 t 1 2 0)
4982 (4 nil 2 2 0)
4983 (6 t 2 3 1)
4984 (8 t 2 4 0)
4985 (9 nil 3 3 0)
4986 (12 nil 4 3 1)
4987 (16 nil 4 4 0)
4988 (18 t 3 6 0)
4989 (20 nil 5 4 1)
4990 (25 nil 5 5 0)
4991 (30 nil 6 5 1)
4992 (32 t 4 8 0)
4993 (36 nil 6 6 0)
4994 (42 nil 7 6 1)
4995 (49 nil 7 7 0)
4996 (50 t 5 10 0)
4997 (56 nil 8 7 1)
4998 (64 nil 8 8 0)
4999 (72 nil 9 8 1)
5000 (81 nil 9 9 0)
5001 (90 nil 10 9 1)
5002 (100 nil 10 10 0))
5003 (letter
5004 (1 nil 1 1 0)
5005 (2 t 1 2 0) ; adjusted by PostScript code
5006 (4 nil 2 2 0)
5007 (6 t 2 3 0)
5008 (9 nil 3 3 0)
5009 (12 nil 4 3 1)
5010 (16 nil 4 4 0)
5011 (20 nil 5 4 1)
5012 (25 nil 5 5 0)
5013 (30 nil 6 5 1)
5014 (36 nil 6 6 0)
5015 (40 t 5 8 0)
5016 (42 nil 7 6 1)
5017 (49 nil 7 7 0)
5018 (56 nil 8 7 1)
5019 (64 nil 8 8 0)
5020 (72 nil 9 8 1)
5021 (81 nil 9 9 0)
5022 (90 nil 10 9 1)
5023 (100 nil 10 10 0))
5024 (legal
5025 (1 nil 1 1 0)
5026 (2 t 1 2 0)
5027 (4 nil 2 2 0)
5028 (6 nil 3 2 1)
5029 (9 nil 3 3 0)
5030 (10 t 2 5 0)
5031 (12 nil 4 3 1)
5032 (16 nil 4 4 0)
5033 (20 nil 5 4 1)
5034 (25 nil 5 5 0)
5035 (30 nil 6 5 1)
5036 (36 nil 6 6 0)
5037 (42 nil 7 6 1)
5038 (49 nil 7 7 0)
5039 (56 nil 8 7 1)
5040 (64 nil 8 8 0)
5041 (70 t 5 14 0)
5042 (72 nil 9 8 1)
5043 (81 nil 9 9 0)
5044 (90 nil 10 9 1)
5045 (100 nil 10 10 0))
5046 (letter-small
5047 (1 nil 1 1 0)
5048 (2 t 1 2 0) ; adjusted by PostScript code
5049 (4 nil 2 2 0)
5050 (6 t 2 3 0)
5051 (9 nil 3 3 0)
5052 (12 t 3 4 1)
5053 (15 t 3 5 0)
5054 (16 nil 4 4 0)
5055 (20 nil 5 4 1)
5056 (25 nil 5 5 0)
5057 (28 t 4 7 0)
5058 (30 nil 6 5 1)
5059 (36 nil 6 6 0)
5060 (40 t 5 8 0)
5061 (42 nil 7 6 1)
5062 (49 nil 7 7 0)
5063 (56 nil 8 7 1)
5064 (60 t 6 10 0)
5065 (64 nil 8 8 0)
5066 (72 ni 9 8 1)
5067 (81 nil 9 9 0)
5068 (84 t 7 12 0)
5069 (90 nil 10 9 1)
5070 (100 nil 10 10 0))
5071 (tabloid
5072 (1 nil 1 1 0)
5073 (2 t 1 2 0)
5074 (4 nil 2 2 0)
5075 (6 t 2 3 1)
5076 (8 t 2 4 0)
5077 (9 nil 3 3 0)
5078 (12 nil 4 3 1)
5079 (16 nil 4 4 0)
5080 (20 nil 5 4 1)
5081 (25 nil 5 5 0)
5082 (30 nil 6 5 1)
5083 (36 nil 6 6 0)
5084 (42 nil 7 6 1)
5085 (49 nil 7 7 0)
5086 (56 nil 8 7 1)
5087 (64 nil 8 8 0)
5088 (72 nil 9 8 1)
5089 (81 nil 9 9 0)
5090 (84 t 6 14 0)
5091 (90 nil 10 9 1)
5092 (100 nil 10 10 0))
5093 ;; Ledger paper size is a special case, it is the only paper size where the
5094 ;; normal size is landscaped, that is, the height is smaller than width.
5095 ;; So, we use the special value `pag' in the `landscape' field.
5096 (ledger
5097 (1 nil 1 1 0)
5098 (2 pag 1 2 0)
5099 (4 nil 2 2 0)
5100 (6 pag 2 3 1)
5101 (8 pag 2 4 0)
5102 (9 nil 3 3 0)
5103 (12 nil 4 3 1)
5104 (16 nil 4 4 0)
5105 (20 nil 5 4 1)
5106 (25 nil 5 5 0)
5107 (30 nil 6 5 1)
5108 (36 nil 6 6 0)
5109 (42 nil 7 6 1)
5110 (49 nil 7 7 0)
5111 (56 nil 8 7 1)
5112 (64 nil 8 8 0)
5113 (72 nil 9 8 1)
5114 (81 nil 9 9 0)
5115 (84 pag 6 14 0)
5116 (90 nil 10 9 1)
5117 (100 nil 10 10 0))
5118 (statement
5119 (1 nil 1 1 0)
5120 (2 t 1 2 0)
5121 (4 nil 2 2 0)
5122 (6 nil 3 2 1)
5123 (9 nil 3 3 0)
5124 (10 t 2 5 0)
5125 (12 nil 4 3 1)
5126 (16 nil 4 4 0)
5127 (20 nil 5 4 1)
5128 (21 t 3 7 0)
5129 (25 nil 5 5 0)
5130 (30 nil 6 5 1)
5131 (36 nil 6 6 0)
5132 (40 t 4 10 0)
5133 (42 nil 7 6 1)
5134 (49 nil 7 7 0)
5135 (56 nil 8 7 1)
5136 (60 t 5 12 0)
5137 (64 nil 8 8 0)
5138 (72 nil 9 8 1)
5139 (81 nil 9 9 0)
5140 (90 nil 10 9 1)
5141 (100 nil 10 10 0))
5142 (executive
5143 (1 nil 1 1 0)
5144 (2 t 1 2 0) ; adjusted by PostScript code
5145 (4 nil 2 2 0)
5146 (6 t 2 3 0)
5147 (9 nil 3 3 0)
5148 (12 nil 4 3 1)
5149 (16 nil 4 4 0)
5150 (20 nil 5 4 1)
5151 (25 nil 5 5 0)
5152 (28 t 4 7 0)
5153 (30 nil 6 5 1)
5154 (36 nil 6 6 0)
5155 (42 nil 7 6 1)
5156 (45 t 5 9 0)
5157 (49 nil 7 7 0)
5158 (56 nil 8 7 1)
5159 (60 t 6 10 0)
5160 (64 nil 8 8 0)
5161 (72 nil 9 8 1)
5162 (81 nil 9 9 0)
5163 (84 t 7 12 0)
5164 (90 nil 10 9 1)
5165 (100 nil 10 10 0))
5166 (a4small
5167 (1 nil 1 1 0)
5168 (2 t 1 2 0)
5169 (4 nil 2 2 0)
5170 (6 t 2 3 1)
5171 (8 t 2 4 0)
5172 (9 nil 3 3 0)
5173 (12 nil 4 3 1)
5174 (16 nil 4 4 0)
5175 (18 t 3 6 0)
5176 (20 nil 5 4 1)
5177 (25 nil 5 5 0)
5178 (30 nil 6 5 1)
5179 (32 t 4 8 0)
5180 (36 nil 6 6 0)
5181 (42 nil 7 6 1)
5182 (49 nil 7 7 0)
5183 (50 t 5 10 0)
5184 (56 nil 8 7 1)
5185 (64 nil 8 8 0)
5186 (72 nil 9 8 1)
5187 (78 t 6 13 0)
5188 (81 nil 9 9 0)
5189 (90 nil 10 9 1)
5190 (100 nil 10 10 0))
5191 (b4
5192 (1 nil 1 1 0)
5193 (2 t 1 2 0)
5194 (4 nil 2 2 0)
5195 (6 t 2 3 1)
5196 (8 t 2 4 0)
5197 (9 nil 3 3 0)
5198 (12 nil 4 3 1)
5199 (16 nil 4 4 0)
5200 (18 t 3 6 0)
5201 (20 nil 5 4 1)
5202 (25 nil 5 5 0)
5203 (30 nil 6 5 1)
5204 (32 t 4 8 0)
5205 (36 nil 6 6 0)
5206 (42 nil 7 6 1)
5207 (49 nil 7 7 0)
5208 (50 t 5 10 0)
5209 (56 nil 8 7 1)
5210 (64 nil 8 8 0)
5211 (72 nil 9 8 1)
5212 (81 nil 9 9 0)
5213 (90 nil 10 9 1)
5214 (100 nil 10 10 0))
5215 (b5
5216 (1 nil 1 1 0)
5217 (2 t 1 2 0)
5218 (4 nil 2 2 0)
5219 (6 t 2 3 1)
5220 (8 t 2 4 0)
5221 (9 nil 3 3 0)
5222 (12 nil 4 3 1)
5223 (16 nil 4 4 0)
5224 (18 t 3 6 0)
5225 (20 nil 5 4 1)
5226 (25 nil 5 5 0)
5227 (30 nil 6 5 1)
5228 (32 t 4 8 0)
5229 (36 nil 6 6 0)
5230 (42 nil 7 6 1)
5231 (49 nil 7 7 0)
5232 (50 t 5 10 0)
5233 (56 nil 8 7 1)
5234 (64 nil 8 8 0)
5235 (72 nil 9 8 0)
5236 (81 nil 9 9 0)
5237 (90 nil 10 9 1)
5238 (98 t 7 14 0)
5239 (100 nil 10 10 0)))
5240 "Alist which is the page matrix database used for N-up printing.
5241
5242 Each element has the following form:
5243
5244 (PAGE
5245 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
5246 ...)
5247
5248 Where:
5249 PAGE is the page size used (see `ps-paper-type').
5250 MAX is the maximum elements of this page matrix.
5251 LANDSCAPE specifies if page matrix is landscaped, has the following valid
5252 values:
5253 nil the sheet is in portrait mode.
5254 t the sheet is in landscape mode.
5255 pag the sheet is in portrait mode and page is in landscape mode.
5256 LINES is the number of lines of page matrix.
5257 COLUMNS is the number of columns of page matrix.
5258 COL-MISSING is the number of columns missing to fill the sheet.")
5259
5260
5261 (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
5262 (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
5263 (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
5264 (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
5265
5266
5267 (defun ps-n-up-printing ()
5268 ;; force `ps-n-up-printing' be in range 1 to 100.
5269 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
5270 ;; find suitable page matrix for a given `ps-paper-type'.
5271 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
5272 (and the-list
5273 (while (> ps-n-up-printing (caar the-list))
5274 (setq the-list (cdr the-list))))
5275 (or (car the-list)
5276 '(1 nil 1 1 0))))
5277
5278
5279 (defconst ps-n-up-filling-database
5280 '((left-top
5281 "PageWidth" ; N-Up-XColumn
5282 "0" ; N-Up-YColumn
5283 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5284 "LandscapePageHeight neg" ; N-Up-YLine
5285 "N-Up-Lines" ; N-Up-Repeat
5286 "N-Up-Columns" ; N-Up-End
5287 "0" ; N-Up-XStart
5288 "0") ; N-Up-YStart
5289 (left-bottom
5290 "PageWidth" ; N-Up-XColumn
5291 "0" ; N-Up-YColumn
5292 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5293 "LandscapePageHeight" ; N-Up-YLine
5294 "N-Up-Lines" ; N-Up-Repeat
5295 "N-Up-Columns" ; N-Up-End
5296 "0" ; N-Up-XStart
5297 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5298 (right-top
5299 "PageWidth neg" ; N-Up-XColumn
5300 "0" ; N-Up-YColumn
5301 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5302 "LandscapePageHeight neg" ; N-Up-YLine
5303 "N-Up-Lines" ; N-Up-Repeat
5304 "N-Up-Columns" ; N-Up-End
5305 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5306 "0") ; N-Up-YStart
5307 (right-bottom
5308 "PageWidth neg" ; N-Up-XColumn
5309 "0" ; N-Up-YColumn
5310 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5311 "LandscapePageHeight" ; N-Up-YLine
5312 "N-Up-Lines" ; N-Up-Repeat
5313 "N-Up-Columns" ; N-Up-End
5314 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5315 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5316 (top-left
5317 "0" ; N-Up-XColumn
5318 "LandscapePageHeight neg" ; N-Up-YColumn
5319 "PageWidth" ; N-Up-XLine
5320 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5321 "N-Up-Columns" ; N-Up-Repeat
5322 "N-Up-Lines" ; N-Up-End
5323 "0" ; N-Up-XStart
5324 "0") ; N-Up-YStart
5325 (bottom-left
5326 "0" ; N-Up-XColumn
5327 "LandscapePageHeight" ; N-Up-YColumn
5328 "PageWidth" ; N-Up-XLine
5329 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5330 "N-Up-Columns" ; N-Up-Repeat
5331 "N-Up-Lines" ; N-Up-End
5332 "0" ; N-Up-XStart
5333 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5334 (top-right
5335 "0" ; N-Up-XColumn
5336 "LandscapePageHeight neg" ; N-Up-YColumn
5337 "PageWidth neg" ; N-Up-XLine
5338 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5339 "N-Up-Columns" ; N-Up-Repeat
5340 "N-Up-Lines" ; N-Up-End
5341 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5342 "0") ; N-Up-YStart
5343 (bottom-right
5344 "0" ; N-Up-XColumn
5345 "LandscapePageHeight" ; N-Up-YColumn
5346 "PageWidth neg" ; N-Up-XLine
5347 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5348 "N-Up-Columns" ; N-Up-Repeat
5349 "N-Up-Lines" ; N-Up-End
5350 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5351 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
5352 "Alist for n-up printing initializations.
5353
5354 Each element has the following form:
5355
5356 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5357
5358 Where:
5359 KIND is a valid value of the variable `ps-n-up-filling'.
5360 XCOL YCOL are the relative position for the next column.
5361 XLIN YLIN are the relative position for the beginning of next line.
5362 REPEAT is the number of repetitions for external loop.
5363 END is the number of repetitions for internal loop and also the number
5364 of pages in a row.
5365 XSTART YSTART are the relative position for the first page in a sheet.")
5366
5367
5368 (defun ps-n-up-filling ()
5369 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
5370 (assq 'left-top ps-n-up-filling-database))))
5371
5372
5373 (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
5374 (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
5375 (defmacro ps-n-up-xline (init) `(nth 2 ,init))
5376 (defmacro ps-n-up-yline (init) `(nth 3 ,init))
5377 (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
5378 (defmacro ps-n-up-end (init) `(nth 5 ,init))
5379 (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
5380 (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
5381
5382
5383 (defconst ps-error-handler-alist
5384 '((none . 0)
5385 (paper . 1)
5386 (system . 2)
5387 (paper-and-system . 3))
5388 "Alist for error handler message.")
5389
5390
5391 (defconst ps-zebra-stripe-alist
5392 '((follow . 1)
5393 (full . 2)
5394 (full-follow . 3))
5395 "Alist for zebra stripe continuation.")
5396
5397
5398 (defun ps-begin-file ()
5399 (setq ps-page-order 0
5400 ps-page-printed 0
5401 ps-background-text-count 0
5402 ps-background-image-count 0
5403 ps-background-pages nil
5404 ps-background-all-pages nil)
5405
5406 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
5407 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
5408 (n-up (ps-n-up-printing))
5409 (n-up-filling (ps-n-up-filling)))
5410 (and ps-n-up-on (setq tumble (not tumble)))
5411 (ps-output
5412 ps-adobe-tag
5413 "%%Title: " (buffer-name) ; Take job name from name of
5414 ; first buffer printed
5415 "\n%%Creator: ps-print v" ps-print-version
5416 "\n%%For: " (user-full-name) ;FIXME: may need encoding!
5417 "\n%%CreationDate: " (format-time-string "%T %b %d %Y") ;FIXME: encoding!
5418 "\n%%Orientation: "
5419 (if ps-landscape-mode "Landscape" "Portrait")
5420 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
5421 (mapconcat 'identity
5422 (ps-remove-duplicates
5423 (append (ps-fonts 'ps-font-for-text)
5424 (list (ps-font 'ps-font-for-header 'normal)
5425 (ps-font 'ps-font-for-header 'bold)
5426 (ps-font 'ps-font-for-footer 'normal)
5427 (ps-font 'ps-font-for-footer 'bold))))
5428 "\n%%+ font ")
5429 "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
5430 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
5431 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
5432 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
5433 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
5434 (if ps-spool-duplex
5435 (if tumble " duplex(tumble)\n" " duplex\n")
5436 "\n"))
5437
5438 (ps-insert-string ps-print-prologue-header)
5439
5440 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5441 (ps-page-dimensions-get-media dimensions)
5442 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
5443 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5444 (format "/ErrorMessage %s def\n\n"
5445 (or (cdr (assoc ps-error-handler-message
5446 ps-error-handler-alist))
5447 1)) ; send to paper
5448 ps-print-prologue-0
5449 "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
5450
5451 (ps-insert-string ps-user-defined-prologue)
5452
5453 (ps-output "\n%%EndResource\n\n")
5454
5455 (ps-output-boolean "LandscapeMode "
5456 (or ps-landscape-mode
5457 (eq (ps-n-up-landscape n-up) 'pag)))
5458 (ps-output-boolean "UpsideDown " ps-print-upside-down)
5459 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
5460
5461 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
5462 (format "/PrintPageWidth %s def\n"
5463 (- (* (+ ps-print-width ps-inter-column)
5464 ps-number-of-columns)
5465 ps-inter-column))
5466 (format "/PrintWidth %s def\n" ps-print-width)
5467 (format "/PrintHeight %s def\n" ps-print-height)
5468
5469 (format "/LeftMargin %s def\n" ps-left-margin)
5470 (format "/RightMargin %s def\n" ps-right-margin)
5471 (format "/InterColumn %s def\n" ps-inter-column)
5472
5473 (format "/BottomMargin %s def\n" ps-bottom-margin)
5474 (format "/TopMargin %s def\n" ps-top-margin) ; not used
5475 (format "/HeaderOffset %s def\n" ps-header-offset)
5476 (format "/HeaderPad %s def\n" ps-header-pad)
5477 (format "/FooterOffset %s def\n" ps-footer-offset)
5478 (format "/FooterPad %s def\n" ps-footer-pad)
5479 (format "/FooterLines %s def\n" ps-footer-lines))
5480
5481 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
5482 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
5483 ps-spool-duplex
5484 ps-switch-header))
5485 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
5486 (ps-output-boolean "PrintHeader " ps-print-header)
5487 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
5488 (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist)
5489 (ps-output-boolean "PrintFooter " ps-print-footer)
5490 (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame)
5491 (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist)
5492
5493 (let ((line-height (ps-line-height 'ps-font-for-text)))
5494 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
5495 (format "/ParagraphSpacing %s def\n"
5496 ps-paragraph-spacing-internal)
5497 (format "/LineHeight %s def\n" line-height)
5498 (format "/LinesPerColumn %d def\n"
5499 (let ((height (+ line-height
5500 ps-line-spacing-internal)))
5501 (round (/ (+ ps-print-height
5502 (* height 0.45))
5503 height))))))
5504
5505 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
5506 (ps-output-boolean "Zebra " ps-zebra-stripes)
5507 (ps-output-boolean "PrintLineNumber " ps-line-number)
5508 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
5509 (ps-output (format "/ZebraFollow %d def\n"
5510 (or (cdr (assq ps-zebra-stripe-follow
5511 ps-zebra-stripe-alist))
5512 0))
5513 (format "/PrintLineStep %d def\n"
5514 (if (integerp ps-line-number-step)
5515 ps-line-number-step
5516 ps-zebra-stripe-height))
5517 (format "/PrintLineStart %d def\n" ps-line-number-start)
5518 "/LineNumberColor "
5519 (ps-format-color ps-line-number-color 0.0)
5520 (format "def\n/ZebraHeight %d def\n"
5521 ps-zebra-stripe-height)
5522 "/ZebraColor "
5523 (ps-format-color ps-zebra-color 0.95)
5524 "def\n")
5525 (ps-output "/BackgroundColor "
5526 (ps-format-color ps-default-background 1.0)
5527 "def\n")
5528 (ps-output "/UseSetpagedevice "
5529 (if (eq ps-spool-config 'setpagedevice)
5530 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5531 "false")
5532 " def\n\n/PageWidth "
5533 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
5534 (format "/N-Up %d def\n" ps-n-up-printing))
5535 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
5536 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
5537 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
5538 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
5539 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
5540 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
5541 "/N-Up-Repeat "
5542 (if ps-landscape-mode
5543 (ps-n-up-end n-up-filling)
5544 (ps-n-up-repeat n-up-filling))
5545 " def\n/N-Up-End "
5546 (if ps-landscape-mode
5547 (ps-n-up-repeat n-up-filling)
5548 (ps-n-up-end n-up-filling))
5549 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
5550 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
5551 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
5552 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
5553 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
5554 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
5555
5556 (ps-background-text)
5557 (ps-background-image)
5558 (setq ps-background-all-pages (nreverse ps-background-all-pages)
5559 ps-background-pages (nreverse ps-background-pages))
5560
5561 (ps-output "\n" ps-print-prologue-1
5562 "\n/printGlobalBackground{\n")
5563 (mapc 'ps-output ps-background-all-pages)
5564 (ps-output
5565 "}def\n/printLocalBackground{\n}def\n"
5566 "\n%%EndProlog\n\n%%BeginSetup\n"
5567 "\n%%IncludeResource: font Times-Roman"
5568 "\n%%IncludeResource: font Times-Italic"
5569 "\n%%IncludeResource: font "
5570 (mapconcat 'identity
5571 (ps-remove-duplicates
5572 (append (ps-fonts 'ps-font-for-text)
5573 (list (ps-font 'ps-font-for-header 'normal)
5574 (ps-font 'ps-font-for-header 'bold)
5575 (ps-font 'ps-font-for-footer 'normal)
5576 (ps-font 'ps-font-for-footer 'bold))))
5577 "\n%%IncludeResource: font ")
5578 ;; Header/line number fonts
5579 (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
5580 ps-header-title-font-size-internal
5581 (ps-font 'ps-font-for-header 'bold))
5582 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
5583 ps-header-font-size-internal
5584 (ps-font 'ps-font-for-header 'normal))
5585 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
5586 (ps-get-font-size 'ps-line-number-font-size)
5587 ps-line-number-font)
5588 (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
5589 ps-footer-font-size-internal
5590 (ps-font 'ps-font-for-footer 'normal))
5591 "\n\n% ---- These lines must be kept together because...
5592
5593 /h0 F
5594 /HeaderTitleLineHeight FontHeight def
5595
5596 /h1 F
5597 /HeaderLineHeight FontHeight def
5598 /HeaderDescent Descent def
5599
5600 /H0 F
5601 /FooterLineHeight FontHeight def
5602 /FooterDescent Descent def
5603
5604 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
5605
5606 ;; Text fonts
5607 (let ((font (ps-font-alist 'ps-font-for-text))
5608 (i 0))
5609 (while font
5610 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
5611 i
5612 ps-font-size-internal
5613 (ps-font 'ps-font-for-text (car (car font)))))
5614 (setq font (cdr font)
5615 i (1+ i))))
5616
5617 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
5618 (ps-output (format "/SpaceWidthRatio %f def\n"
5619 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
5620
5621 (unless (eq ps-spool-config 'lpr-switches)
5622 (ps-output "\n%%BeginFeature: *Duplex "
5623 (ps-boolean-capitalized ps-spool-duplex)
5624 " *Tumble "
5625 (ps-boolean-capitalized tumble)
5626 "\nUseSetpagedevice\n{BMark/Duplex "
5627 (ps-boolean-constant ps-spool-duplex)
5628 "/Tumble "
5629 (ps-boolean-constant tumble)
5630 " EMark setpagedevice}\n{statusdict begin "
5631 (ps-boolean-constant ps-spool-duplex)
5632 " setduplexmode "
5633 (ps-boolean-constant tumble)
5634 " settumble end}ifelse\n%%EndFeature\n")))
5635 (ps-output "\n%%BeginFeature: *ManualFeed "
5636 (ps-boolean-capitalized ps-manual-feed)
5637 "\nBMark /ManualFeed "
5638 (ps-boolean-constant ps-manual-feed)
5639 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
5640 (and ps-banner-page-when-duplexing
5641 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
5642
5643
5644 (defun ps-format-color (color &optional default)
5645 (let ((the-color (if (stringp color)
5646 (ps-color-scale color)
5647 color)))
5648 (if (and the-color (listp the-color))
5649 (concat "["
5650 (format ps-color-format
5651 (* (nth 0 the-color) 1.0) ; force float number
5652 (* (nth 1 the-color) 1.0) ; force float number
5653 (* (nth 2 the-color) 1.0)) ; force float number
5654 "] ")
5655 (ps-float-format (if (numberp the-color) the-color default)))))
5656
5657
5658 (defun ps-insert-string (prologue)
5659 (let ((str (if (functionp prologue)
5660 (funcall prologue)
5661 prologue)))
5662 (and (stringp str)
5663 (ps-output str))))
5664
5665
5666 (defun ps-boolean-capitalized (bool)
5667 (if bool "True" "False"))
5668
5669
5670 (defun ps-boolean-constant (bool)
5671 (if bool "true" "false"))
5672
5673
5674 (defun ps-header-dirpart ()
5675 (let ((fname (buffer-file-name)))
5676 (if fname
5677 (if (string-equal (buffer-name) (file-name-nondirectory fname))
5678 (abbreviate-file-name (file-name-directory fname))
5679 fname)
5680 "")))
5681
5682
5683 (defun ps-get-buffer-name ()
5684 (cond
5685 ;; Indulge Jim this little easter egg:
5686 ((string= (buffer-name) "ps-print.el")
5687 "Hey, Cool! It's ps-print.el!!!")
5688 ;; Indulge Jack this other little easter egg:
5689 ((string= (buffer-name) "sokoban.el")
5690 "Super! C'est sokoban.el!")
5691 (t (concat
5692 (and ps-printing-region-p "Subset of: ")
5693 (buffer-name)
5694 (and (buffer-modified-p) " (unsaved)")))))
5695
5696
5697 (defun ps-get-size (size mess &optional arg)
5698 (let ((siz (cond ((numberp size)
5699 size)
5700 ((and (consp size)
5701 (numberp (car size))
5702 (numberp (cdr size)))
5703 (if ps-landscape-mode
5704 (car size)
5705 (cdr size)))
5706 (t
5707 -1))))
5708 (and (< siz 0)
5709 (error "Invalid %s `%S'%s"
5710 mess size
5711 (if arg
5712 (format " for `%S'" arg)
5713 "")))
5714 siz))
5715
5716
5717 (defun ps-get-font-size (font-sym)
5718 (ps-get-size (symbol-value font-sym) "font size" font-sym))
5719
5720
5721 (defun ps-rgb-color (color unspecified default)
5722 (cond
5723 ;; (float float float) ==> (R G B)
5724 ((and color (listp color) (= (length color) 3)
5725 (let ((cl color)
5726 (ok t) e)
5727 (while (and ok cl)
5728 (setq e (car cl)
5729 cl (cdr cl)
5730 ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
5731 ok))
5732 color)
5733 ;; float ==> 0.0 = black .. 1.0 = white
5734 ((and (floatp color) (<= 0.0 color) (<= color 1.0))
5735 (list color color color))
5736 ;; "colorName" but different from "unspecified-[bf]g"
5737 ((and (stringp color) (not (string= color unspecified)))
5738 (ps-color-scale color))
5739 ;; ok, use the default
5740 (t
5741 (list default default default))))
5742
5743 (defvar ps-basic-plot-string-function 'ps-basic-plot-string)
5744
5745 (defun ps-begin-job (genfunc)
5746 ;; prologue files
5747 (or (equal ps-mark-code-directory ps-postscript-code-directory)
5748 (setq ps-print-prologue-0 (ps-prologue-file 0)
5749 ps-print-prologue-1 (ps-prologue-file 1)
5750 ps-mark-code-directory ps-postscript-code-directory))
5751 ;; selected pages
5752 (let (new page)
5753 (while ps-selected-pages
5754 (setq page (car ps-selected-pages)
5755 ps-selected-pages (cdr ps-selected-pages))
5756 (cond ((integerp page)
5757 (and (> page 0)
5758 (setq new (cons (cons page page) new))))
5759 ((consp page)
5760 (and (integerp (car page)) (integerp (cdr page))
5761 (> (car page) 0)
5762 (<= (car page) (cdr page))
5763 (setq new (cons page new))))))
5764 (setq ps-selected-pages (sort new #'(lambda (one other)
5765 (< (car one) (car other))))
5766 ps-last-selected-pages ps-selected-pages
5767 ps-first-page nil
5768 ps-last-page nil))
5769 ;; face background
5770 (or (listp ps-use-face-background)
5771 (setq ps-use-face-background t))
5772 ;; line number
5773 (and (integerp ps-line-number-step)
5774 (<= ps-line-number-step 0)
5775 (setq ps-line-number-step 1))
5776 (setq ps-n-up-on (> ps-n-up-printing 1)
5777 ps-line-number-start (max 1 (min ps-line-number-start
5778 (if (integerp ps-line-number-step)
5779 ps-line-number-step
5780 ps-zebra-stripe-height))))
5781 ;; spooling buffer
5782 (with-current-buffer ps-spool-buffer
5783 (goto-char (point-max))
5784 (and (re-search-backward "^%%Trailer$" nil t)
5785 (delete-region (match-beginning 0) (point-max))))
5786 ;; miscellaneous
5787 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5788 '(full full-follow))
5789 ps-page-postscript 0
5790 ps-page-sheet 0
5791 ps-page-n-up 0
5792 ps-page-column 0
5793 ps-lines-printed 0
5794 ps-print-page-p t
5795 ps-showline-count (car ps-printing-region)
5796 ps-line-spacing-internal (ps-get-size ps-line-spacing
5797 "line spacing")
5798 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
5799 "paragraph spacing")
5800 ps-font-size-internal (ps-get-font-size 'ps-font-size)
5801 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
5802 ps-header-title-font-size-internal
5803 (ps-get-font-size 'ps-header-title-font-size)
5804 ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
5805 ps-control-or-escape-regexp
5806 (cond ((eq ps-print-control-characters '8-bit)
5807 (string-as-unibyte "[\000-\037\177-\377]"))
5808 ((eq ps-print-control-characters 'control-8-bit)
5809 (string-as-unibyte "[\000-\037\177-\237]"))
5810 ((eq ps-print-control-characters 'control)
5811 "[\000-\037\177]")
5812 (t "[\t\n\f]"))
5813 ;; Set the color scale. We do it here instead of in the defvar so
5814 ;; that ps-print can be dumped into emacs. This expression can't be
5815 ;; evaluated at dump-time because X isn't initialized.
5816 ps-color-p (and ps-print-color-p (ps-color-device))
5817 ps-print-color-scale (if ps-color-p
5818 (float (car (ps-color-values "white")))
5819 1.0)
5820 ps-default-background (ps-rgb-color
5821 (cond
5822 ((or (member ps-print-color-p
5823 '(nil back-white))
5824 (eq genfunc 'ps-generate-postscript))
5825 nil)
5826 ((eq ps-default-bg 'frame-parameter)
5827 (ps-frame-parameter nil 'background-color))
5828 ((eq ps-default-bg t)
5829 (ps-face-background-name 'default))
5830 (t
5831 ps-default-bg))
5832 "unspecified-bg"
5833 1.0)
5834 ps-default-foreground (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-fg 'frame-parameter)
5841 (ps-frame-parameter nil 'foreground-color))
5842 ((eq ps-default-fg t)
5843 (ps-face-foreground-name 'default))
5844 (t
5845 ps-default-fg))
5846 "unspecified-fg"
5847 0.0)
5848 ps-foreground-list (mapcar
5849 #'(lambda (arg)
5850 (ps-rgb-color arg "unspecified-fg" 0.0))
5851 (append (and (not (member ps-print-color-p
5852 '(nil back-white)))
5853 ps-fg-list)
5854 (list ps-default-foreground
5855 "black")))
5856 ps-default-color (and (not (member ps-print-color-p
5857 '(nil back-white)))
5858 ps-default-foreground)
5859 ps-current-color ps-default-color
5860 ;; Set up default functions.
5861 ;; They may be overridden by ps-mule-begin-job.
5862 ps-basic-plot-string-function 'ps-basic-plot-string
5863 ps-encode-header-string-function nil)
5864 ;; initialize page dimensions
5865 (ps-get-page-dimensions)
5866 ;; final check
5867 (unless (listp ps-lpr-switches)
5868 (error "`ps-lpr-switches' value should be a list"))
5869 (and ps-color-p
5870 (equal ps-default-background ps-default-foreground)
5871 (error
5872 (concat
5873 "`ps-default-fg' and `ps-default-bg' have the same color.\n"
5874 "Text won't appear on page. Please, check these variables."))))
5875
5876
5877 (defun ps-page-number ()
5878 (if ps-print-only-one-header
5879 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5880 ps-page-column))
5881
5882
5883 (defsubst ps-end-page ()
5884 (ps-output "EndPage\nEndDSCPage\n"))
5885
5886
5887 (defsubst ps-next-page ()
5888 (ps-end-page)
5889 (ps-flush-output)
5890 (ps-begin-page))
5891
5892
5893 (defun ps-end-sheet ()
5894 (and ps-print-page-p (> ps-page-sheet 0)
5895 (ps-output "EndSheet\n")))
5896
5897
5898 (defun ps-header-sheet ()
5899 ;; Print only when a new sheet begins.
5900 (ps-end-sheet)
5901 (setq ps-page-sheet (1+ ps-page-sheet))
5902 (when (ps-print-sheet-p)
5903 (setq ps-page-order (1+ ps-page-order))
5904 (ps-output (if ps-n-up-on
5905 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5906 ps-page-order ps-page-postscript ps-page-order)
5907 (format "\n%%%%Page: %d %d\n"
5908 ps-page-postscript ps-page-order))
5909 ;; spooling needs to redefine Lines and PageCount on each page
5910 "/Lines 0 def\n/PageCount 0 def\n"
5911 (format "%d BeginSheet\nBeginDSCPage\n"
5912 ps-n-up-printing))))
5913
5914
5915 (defun ps-header-page ()
5916 ;; set total line and page number when printing has finished
5917 ;; (see `ps-generate')
5918 (if (zerop (mod ps-page-column ps-number-of-columns))
5919 (progn
5920 (setq ps-page-postscript (1+ ps-page-postscript))
5921 (when (ps-print-page-p)
5922 (ps-print-sheet-p)
5923 (if (zerop (mod ps-page-n-up ps-n-up-printing))
5924 ;; Print only when a new sheet begins.
5925 (progn
5926 (ps-header-sheet)
5927 (run-hooks 'ps-print-begin-sheet-hook))
5928 ;; Print only when a new page begins.
5929 (ps-output "BeginDSCPage\n")
5930 (run-hooks 'ps-print-begin-page-hook))
5931 (ps-background ps-page-postscript)
5932 (setq ps-page-n-up (1+ ps-page-n-up))
5933 (and ps-print-page-p
5934 (setq ps-page-printed (1+ ps-page-printed)))))
5935 ;; Print only when a new column begins.
5936 (ps-output "BeginDSCPage\n")
5937 (run-hooks 'ps-print-begin-column-hook))
5938 (setq ps-page-column (1+ ps-page-column)))
5939
5940 (defun ps-begin-page ()
5941 (setq ps-width-remaining ps-print-width
5942 ps-height-remaining ps-print-height)
5943
5944 (ps-header-page)
5945
5946 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
5947 (format "/PageNumber %d def\n" (ps-page-number)))
5948
5949 (when ps-print-header
5950 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
5951 (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
5952 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
5953
5954 (when ps-print-footer
5955 (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
5956 (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
5957 (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
5958
5959 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
5960 (ps-set-font ps-current-font)
5961 (ps-set-bg ps-current-bg)
5962 (ps-set-color ps-current-color))
5963
5964 (defsubst ps-skip-newline (limit)
5965 (setq ps-showline-count (1+ ps-showline-count)
5966 ps-lines-printed (1+ ps-lines-printed))
5967 (and (< (point) limit)
5968 (forward-char 1)))
5969
5970 (defsubst ps-next-line ()
5971 (setq ps-showline-count (1+ ps-showline-count)
5972 ps-lines-printed (1+ ps-lines-printed))
5973 (let* ((paragraph-p (and ps-paragraph-regexp
5974 (looking-at ps-paragraph-regexp)))
5975 (lh (+ (ps-line-height 'ps-font-for-text)
5976 (if paragraph-p
5977 ps-paragraph-spacing-internal
5978 ps-line-spacing-internal))))
5979 (if (< ps-height-remaining lh)
5980 (ps-next-page)
5981 (setq ps-width-remaining ps-print-width
5982 ps-height-remaining (- ps-height-remaining lh))
5983 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
5984
5985 (defun ps-continue-line ()
5986 (setq ps-lines-printed (1+ ps-lines-printed))
5987 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
5988 (if (< ps-height-remaining lh)
5989 (ps-next-page)
5990 (setq ps-width-remaining ps-print-width
5991 ps-height-remaining (- ps-height-remaining lh))
5992 (ps-output "SL\n"))))
5993
5994 (defun ps-find-wrappoint (from to char-width)
5995 (let ((avail (truncate (/ ps-width-remaining char-width)))
5996 (todo (- to from)))
5997 (if (< todo avail)
5998 (cons to (* todo char-width))
5999 (cons (+ from avail) ps-width-remaining))))
6000
6001 (defun ps-basic-plot-str (from to string)
6002 (let* ((wrappoint (ps-find-wrappoint from to
6003 (ps-avg-char-width 'ps-font-for-text)))
6004 (to (car wrappoint))
6005 (str (substring string from to)))
6006 (ps-output-string str)
6007 (ps-output " S\n")
6008 wrappoint))
6009
6010 (defun ps-basic-plot-string (from to &optional _bg-color)
6011 (let* ((wrappoint (ps-find-wrappoint from to
6012 (ps-avg-char-width 'ps-font-for-text)))
6013 (to (car wrappoint))
6014 (string (buffer-substring-no-properties from to)))
6015 (ps-output-string string)
6016 (ps-output " S\n")
6017 wrappoint))
6018
6019 (defun ps-basic-plot-whitespace (from to &optional _bg-color)
6020 (let* ((wrappoint (ps-find-wrappoint from to
6021 (ps-space-width 'ps-font-for-text)))
6022 (to (car wrappoint)))
6023 (ps-output (format "%d W\n" (- to from)))
6024 wrappoint))
6025
6026 (defun ps-plot (plotfunc from to &optional bg-color)
6027 (while (< from to)
6028 (let* ((wrappoint (funcall plotfunc from to bg-color))
6029 (plotted-to (car wrappoint))
6030 (plotted-width (cdr wrappoint)))
6031 (setq from plotted-to
6032 ps-width-remaining (- ps-width-remaining plotted-width))
6033 (if (< from to)
6034 (ps-continue-line))))
6035 (if ps-razzle-dazzle
6036 (let* ((q-todo (- (point-max) (point-min)))
6037 (q-done (- (point) (point-min)))
6038 (chunkfrac (/ q-todo 8))
6039 (chunksize (min chunkfrac 1000)))
6040 (if (> (- q-done ps-razchunk) chunksize)
6041 (progn
6042 (setq ps-razchunk q-done)
6043 (message "Formatting...%3d%%"
6044 (if (< q-todo 100)
6045 (/ (* 100 q-done) q-todo)
6046 (/ q-done (/ q-todo 100)))
6047 ))))))
6048
6049 (defvar ps-last-font nil)
6050
6051 (defun ps-set-font (font)
6052 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
6053 (ps-output (format "/%s F\n" ps-last-font)))
6054
6055 (defun ps-set-bg (color)
6056 (if (setq ps-current-bg color)
6057 (ps-output (format ps-color-format
6058 (nth 0 color) (nth 1 color) (nth 2 color))
6059 " true BG\n")
6060 (ps-output "false BG\n")))
6061
6062 (defun ps-set-color (color)
6063 (setq ps-current-color (or color ps-default-foreground))
6064 (ps-output (format ps-color-format
6065 (nth 0 ps-current-color)
6066 (nth 1 ps-current-color) (nth 2 ps-current-color))
6067 " FG\n"))
6068
6069
6070 (defsubst ps-plot-string (string)
6071 (ps-plot 'ps-basic-plot-str 0 (length string) string))
6072
6073
6074 (defvar ps-current-effect 0)
6075
6076 (defvar ps-print-translation-table
6077 (let ((tbl (make-char-table 'translation-table nil)))
6078 (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
6079 (char-table-p ucs-mule-8859-to-mule-unicode))
6080 (map-char-table
6081 #'(lambda (k v)
6082 (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
6083 (aset tbl k v)))
6084 ucs-mule-8859-to-mule-unicode))
6085 tbl)
6086 "Translation table for PostScript printing.
6087 The default value is a table that translates non-Latin-1 Latin characters
6088 to the equivalent Latin-1 characters.")
6089
6090 (defun ps-plot-region (from to font &optional fg-color bg-color effects)
6091 (or (equal font ps-current-font)
6092 (ps-set-font font))
6093
6094 ;; Specify a foreground color only if:
6095 ;; one's specified,
6096 ;; it's different than the background (if `ps-fg-validate-p' is non-nil)
6097 ;; and it's different than the current.
6098 (let ((fg (or fg-color ps-default-foreground)))
6099 (if ps-fg-validate-p
6100 (let ((bg (or bg-color ps-default-background))
6101 (el ps-foreground-list))
6102 (while (and el (equal fg bg))
6103 (setq fg (car el)
6104 el (cdr el)))))
6105 (or (equal fg ps-current-color)
6106 (ps-set-color fg)))
6107
6108 (or (equal bg-color ps-current-bg)
6109 (ps-set-bg bg-color))
6110
6111 ;; Specify effects (underline, overline, box, etc.)
6112 (cond
6113 ((not (integerp effects))
6114 (ps-output "0 EF\n")
6115 (setq ps-current-effect 0))
6116 ((/= effects ps-current-effect)
6117 (ps-output (number-to-string effects) " EF\n")
6118 (setq ps-current-effect effects)))
6119
6120 ;; Starting at the beginning of the specified region...
6121 (save-excursion
6122 (goto-char from)
6123
6124 ;; ...break the region up into chunks separated by tabs, linefeeds,
6125 ;; pagefeeds, control characters, and plot each chunk.
6126 (while (< from to)
6127 ;; skip lines between cut markers
6128 (and ps-begin-cut-regexp ps-end-cut-regexp
6129 (looking-at ps-begin-cut-regexp)
6130 (progn
6131 (goto-char (match-end 0))
6132 (and (re-search-forward ps-end-cut-regexp to 'noerror)
6133 (= (following-char) ?\n)
6134 (forward-char 1))
6135 (setq from (point))))
6136 (if (re-search-forward ps-control-or-escape-regexp to t)
6137 ;; region with some control characters or some multi-byte characters
6138 (let* ((match-point (match-beginning 0))
6139 (match (char-after match-point)))
6140 (when (< from match-point)
6141 (ps-plot ps-basic-plot-string-function
6142 from match-point bg-color))
6143 (cond
6144 ((= match ?\t) ; tab
6145 (let ((linestart (line-beginning-position)))
6146 (forward-char -1)
6147 (setq from (+ linestart (current-column)))
6148 (when (re-search-forward "[ \t]+" to t)
6149 (ps-plot 'ps-basic-plot-whitespace
6150 from (+ linestart (current-column))
6151 bg-color))))
6152
6153 ((= match ?\n) ; newline
6154 (if (looking-at "\f[^\n]")
6155 ;; \n\ftext\n ==>> next page, but keep line counting!!
6156 (progn
6157 (ps-skip-newline to)
6158 (ps-next-page))
6159 ;; \n\f\n ==>> it'll be handled by form feed
6160 ;; \ntext\n ==>> next line
6161 (ps-next-line)))
6162
6163 ((= match ?\f) ; form feed
6164 ;; do not skip page if previous character is NEWLINE and
6165 ;; it is a beginning of page.
6166 (unless (and (equal (char-after (1- match-point)) ?\n)
6167 (= ps-height-remaining ps-print-height))
6168 ;; \f\n ==>> skip \n, but keep line counting!!
6169 (and (equal (following-char) ?\n)
6170 (ps-skip-newline to))
6171 (ps-next-page)))
6172
6173 (t ; characters from 127 to 255
6174 (ps-control-character match)))
6175 (setq from (point)))
6176 ;; region without control characters
6177 (ps-plot ps-basic-plot-string-function from to bg-color)
6178 (setq from to)))))
6179
6180 (defvar ps-string-control-codes
6181 (let ((table (make-vector 256 nil))
6182 (char ?\000))
6183 ;; control character
6184 (while (<= char ?\037)
6185 (aset table char (format "^%c" (+ char ?@)))
6186 (setq char (1+ char)))
6187 ;; printable character
6188 (while (< char ?\177)
6189 (aset table char (format "%c" char))
6190 (setq char (1+ char)))
6191 ;; DEL
6192 (aset table char "^?")
6193 ;; 8-bit character
6194 (while (<= (setq char (1+ char)) ?\377)
6195 (aset table char (format "\\%o" char)))
6196 table)
6197 "Vector used to map characters to a printable string.")
6198
6199 (defun ps-control-character (char)
6200 (let* ((str (aref ps-string-control-codes char))
6201 (from (1- (point)))
6202 (len (length str))
6203 (to (+ from len))
6204 (char-width (ps-avg-char-width 'ps-font-for-text))
6205 (wrappoint (ps-find-wrappoint from to char-width)))
6206 (if (< (car wrappoint) to)
6207 (ps-continue-line))
6208 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
6209 (ps-output-string str)
6210 (ps-output " S\n")))
6211
6212
6213 (defsubst ps-face-foreground-color-p (attr)
6214 (memq attr '(foreground-color :foreground)))
6215
6216
6217 (defsubst ps-face-background-color-p (attr)
6218 (memq attr '(background-color :background)))
6219
6220
6221 (defsubst ps-face-color-p (attr)
6222 (memq attr '(foreground-color :foreground background-color :background)))
6223
6224
6225 (defun ps-face-extract-color (face-attrs)
6226 (let ((color (cdr face-attrs)))
6227 (if (listp color)
6228 (car color)
6229 color)))
6230
6231
6232 (defun ps-face-attributes (face)
6233 "Return face attribute vector.
6234
6235 If FACE is not in `ps-print-face-extension-alist' or in
6236 `ps-print-face-alist', insert it on `ps-print-face-alist' and
6237 return the attribute vector.
6238
6239 If FACE is not a valid face name, use default face."
6240 (and (stringp face) (facep face) (setq face (intern face)))
6241 (cond
6242 (ps-black-white-faces-alist
6243 (or (and (symbolp face)
6244 (cdr (assq face ps-black-white-faces-alist)))
6245 (vector 0 nil nil)))
6246 ((symbolp face)
6247 (cdr (or (assq face ps-print-face-extension-alist)
6248 (assq face ps-print-face-alist)
6249 (let* ((the-face (if (facep face) face 'default))
6250 (new-face (ps-screen-to-bit-face the-face)))
6251 (or (and (eq the-face 'default)
6252 (assq the-face ps-print-face-alist))
6253 (setq ps-print-face-alist
6254 (cons new-face ps-print-face-alist)))
6255 new-face))))
6256 ((ps-face-foreground-color-p (car face))
6257 (vector 0 (ps-face-extract-color face) nil))
6258 ((ps-face-background-color-p (car face))
6259 (vector 0 nil (ps-face-extract-color face)))
6260 (t
6261 (vector 0 nil nil))))
6262
6263
6264 (defun ps-face-background (face background)
6265 (and (cond ((eq ps-use-face-background t)) ; always
6266 ((null ps-use-face-background) nil) ; never
6267 ;; ps-user-face-background is a symbol face list
6268 ((symbolp face)
6269 (memq face ps-use-face-background))
6270 ((listp face)
6271 (or (ps-face-color-p (car face))
6272 (let (ok)
6273 (while face
6274 (if (or (memq (car face) ps-use-face-background)
6275 (ps-face-color-p (car face)))
6276 (setq face nil
6277 ok t)
6278 (setq face (cdr face))))
6279 ok)))
6280 (t
6281 nil)
6282 )
6283 background))
6284
6285
6286 (defun ps-face-attribute-list (face-or-list)
6287 (cond
6288 ;; simple face
6289 ((not (listp face-or-list))
6290 (ps-face-attributes face-or-list))
6291 ;; only foreground color, not a `real' face
6292 ((ps-face-foreground-color-p (car face-or-list))
6293 (vector 0 (ps-face-extract-color face-or-list) nil))
6294 ;; only background color, not a `real' face
6295 ((ps-face-background-color-p (car face-or-list))
6296 (vector 0 nil (ps-face-extract-color face-or-list)))
6297 ;; list of faces
6298 (t
6299 (let ((effects 0)
6300 foreground background face-attr face)
6301 (while face-or-list
6302 (setq face (car face-or-list)
6303 face-or-list (cdr face-or-list)
6304 face-attr (ps-face-attributes face)
6305 effects (logior effects (aref face-attr 0)))
6306 (or foreground (setq foreground (aref face-attr 1)))
6307 (or background
6308 (setq background (ps-face-background face (aref face-attr 2)))))
6309 (vector effects foreground background)))))
6310
6311
6312 (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
6313
6314
6315 (defun ps-plot-with-face (from to face)
6316 (cond
6317 ((null face) ; print text with null face
6318 (ps-plot-region from to 0))
6319 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
6320 (t ; otherwise, text has a valid face
6321 (let* ((face-bit (ps-face-attribute-list face))
6322 (effect (aref face-bit 0))
6323 (foreground (aref face-bit 1))
6324 (background (ps-face-background face (aref face-bit 2)))
6325 (fg-color (if (and ps-color-p foreground)
6326 (ps-color-scale foreground)
6327 ps-default-color))
6328 (bg-color (and ps-color-p background
6329 (ps-color-scale background))))
6330 (ps-plot-region
6331 from to
6332 (ps-font-number 'ps-font-for-text
6333 (or (aref ps-font-type (logand effect 3))
6334 face))
6335 fg-color bg-color (lsh effect -2)))))
6336 (goto-char to))
6337
6338
6339 ;; Ensure that face-list is fbound.
6340 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
6341
6342
6343 (defun ps-build-reference-face-lists ()
6344 ;; Ensure that face database is updated with faces on
6345 ;; `font-lock-face-attributes' (obsolete stuff)
6346 (ps-font-lock-face-attributes)
6347 ;; Now, rebuild reference face lists
6348 (setq ps-print-face-alist nil)
6349 (if ps-auto-font-detect
6350 (mapc 'ps-map-face (face-list))
6351 (mapc 'ps-set-face-bold ps-bold-faces)
6352 (mapc 'ps-set-face-italic ps-italic-faces)
6353 (mapc 'ps-set-face-underline ps-underlined-faces))
6354 (setq ps-build-face-reference nil))
6355
6356
6357 (defun ps-set-face-bold (face)
6358 (ps-set-face-attribute face 1))
6359
6360 (defun ps-set-face-italic (face)
6361 (ps-set-face-attribute face 2))
6362
6363 (defun ps-set-face-underline (face)
6364 (ps-set-face-attribute face 4))
6365
6366
6367 (defun ps-set-face-attribute (face effect)
6368 (let ((face-bit (cdr (ps-map-face face))))
6369 (aset face-bit 0 (logior (aref face-bit 0) effect))))
6370
6371
6372 (defun ps-map-face (face)
6373 (let* ((face-map (ps-screen-to-bit-face face))
6374 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
6375 (if ps-face-bit
6376 ;; if face exists, merge both
6377 (let ((face-bit (cdr face-map)))
6378 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
6379 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
6380 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
6381 ;; if face does not exist, insert it
6382 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
6383 face-map))
6384
6385
6386 (defun ps-screen-to-bit-face (face)
6387 (cons face
6388 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
6389 (if (ps-face-italic-p face) 2 0) ; italic
6390 (if (ps-face-underlined-p face) 4 0) ; underline
6391 (if (ps-face-strikeout-p face) 8 0) ; strikeout
6392 (if (ps-face-overline-p face) 16 0) ; overline
6393 (if (ps-face-box-p face) 64 0)) ; box
6394 (ps-face-foreground-name face)
6395 (ps-face-background-name face))))
6396
6397
6398 (declare-function jit-lock-fontify-now "jit-lock" (&optional start end))
6399 (declare-function lazy-lock-fontify-region "lazy-lock" (beg end))
6400
6401 ;; to avoid compilation gripes
6402 (defun ps-print-ensure-fontified (start end)
6403 (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
6404 (jit-lock-fontify-now start end))
6405 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
6406 (lazy-lock-fontify-region start end))))
6407
6408
6409 (defun ps-generate-postscript-with-faces (from to)
6410 ;; Some initialization...
6411 (setq ps-current-effect 0)
6412
6413 ;; Build the reference lists of faces if necessary.
6414 (when (or ps-always-build-face-reference
6415 ps-build-face-reference)
6416 (message "Collecting face information...")
6417 (ps-build-reference-face-lists))
6418
6419 ;; Black/white printer.
6420 (setq ps-black-white-faces-alist nil)
6421 (and (eq ps-print-color-p 'black-white)
6422 (ps-extend-face-list ps-black-white-faces nil
6423 'ps-black-white-faces-alist))
6424
6425 ;; Generate some PostScript.
6426 (save-restriction
6427 (narrow-to-region from to)
6428 (ps-print-ensure-fontified from to)
6429 (ps-generate-postscript-with-faces1 from to)))
6430
6431 (defun ps-generate-postscript (from to)
6432 (ps-plot-region from to 0))
6433
6434 ;; These are autoloaded, but ps-mule generates autoloads at the end of
6435 ;; this file, so they are unknown at this point when compiling.
6436 (declare-function ps-mule-initialize "ps-mule" ())
6437 (declare-function ps-mule-begin-job "ps-mule" (from to))
6438 (declare-function ps-mule-end-job "ps-mule" ())
6439
6440 (defun ps-generate (buffer from to genfunc)
6441 (save-excursion
6442 (let ((from (min to from))
6443 (to (max to from))
6444 ;; This avoids trouble if chars with read-only properties
6445 ;; are copied into ps-spool-buffer.
6446 (inhibit-read-only t))
6447 (save-restriction
6448 (narrow-to-region from to)
6449 (and ps-razzle-dazzle
6450 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
6451 (setq ps-source-buffer buffer
6452 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
6453 (ps-init-output-queue)
6454 (let (safe-marker completed-safely needs-begin-file)
6455 (unwind-protect
6456 (progn
6457 (set-buffer ps-spool-buffer)
6458 (set-buffer-multibyte nil)
6459
6460 ;; Get a marker and make it point to the current end of the
6461 ;; buffer, If an error occurs, we'll delete everything from
6462 ;; the end of this marker onwards.
6463 (setq safe-marker (make-marker))
6464 (set-marker safe-marker (point-max))
6465
6466 (goto-char (point-min))
6467 (or (looking-at (regexp-quote ps-adobe-tag))
6468 (setq needs-begin-file t))
6469
6470 (set-buffer ps-source-buffer)
6471 (save-excursion
6472 (let ((ps-print-page-p t)
6473 ps-even-or-odd-pages)
6474 (ps-begin-job genfunc)
6475 (when needs-begin-file
6476 (ps-begin-file)
6477 (ps-mule-initialize))
6478 (ps-mule-begin-job from to)
6479 (ps-selected-pages)))
6480 (ps-begin-page)
6481 (funcall genfunc from to)
6482 (ps-end-page)
6483 (ps-mule-end-job)
6484 (ps-end-job needs-begin-file)
6485
6486 ;; Setting this variable tells the unwind form that the
6487 ;; the PostScript was generated without error.
6488 (setq completed-safely t))
6489
6490 ;; Unwind form: If some bad mojo occurred while generating
6491 ;; PostScript, delete all the PostScript that was generated.
6492 ;; This protects the previously spooled files from getting
6493 ;; corrupted.
6494 (and (markerp safe-marker) (not completed-safely)
6495 (progn
6496 (set-buffer ps-spool-buffer)
6497 (delete-region (marker-position safe-marker) (point-max))))))
6498
6499 (and ps-razzle-dazzle (message "Formatting...done"))))))
6500
6501
6502 (defun ps-end-job (needs-begin-file)
6503 (let ((ps-print-page-p t))
6504 (ps-flush-output)
6505 (save-excursion
6506 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
6507 (total-lines (cdr ps-printing-region))
6508 (total-pages (ps-page-number)))
6509 (set-buffer ps-spool-buffer)
6510 (let (case-fold-search)
6511 ;; Back to the PS output buffer to set the last page n-up printing
6512 (goto-char (point-max))
6513 (and (> pages-per-sheet 0)
6514 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
6515 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
6516 ;; Back to the PS output buffer to set the page count
6517 (goto-char (point-min))
6518 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
6519 (replace-match (format "/Lines %d def\n/PageCount %d def"
6520 total-lines total-pages) t)))))
6521 ;; Set dummy page
6522 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
6523 (let ((ps-n-up-printing 0))
6524 (ps-header-sheet)
6525 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
6526 "/PrintLineNumber false def\n"
6527 (number-to-string ps-lines-printed) " BeginPage\n")
6528 (ps-end-page)))
6529 ;; Set end of PostScript file
6530 (ps-end-sheet)
6531 (ps-output "\n%%Trailer\n%%Pages: "
6532 (number-to-string
6533 (if (and needs-begin-file
6534 ps-banner-page-when-duplexing)
6535 (1+ ps-page-order)
6536 ps-page-order))
6537 "\n\nEndDoc\n\n%%EOF\n")
6538 (and ps-end-with-control-d
6539 (ps-output "\C-d"))
6540 (ps-flush-output))
6541 ;; disable selected pages
6542 (setq ps-selected-pages nil))
6543
6544
6545 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
6546 (defun ps-do-despool (filename)
6547 (if (or (not (boundp 'ps-spool-buffer))
6548 (not (symbol-value 'ps-spool-buffer)))
6549 (message "No spooled PostScript to print")
6550 (if filename
6551 (save-excursion
6552 (and ps-razzle-dazzle (message "Saving..."))
6553 (set-buffer ps-spool-buffer)
6554 (setq filename (expand-file-name filename))
6555 (let ((coding-system-for-write 'raw-text-unix))
6556 (write-region (point-min) (point-max) filename))
6557 (and ps-razzle-dazzle (message "Wrote %s" filename)))
6558 ;; Else, spool to the printer
6559 (with-current-buffer ps-spool-buffer
6560 (let* ((coding-system-for-write 'raw-text-unix)
6561 (printer-name (or ps-printer-name printer-name))
6562 (lpr-printer-switch ps-printer-name-option)
6563 (print-region-function ps-print-region-function)
6564 (lpr-command ps-lpr-command))
6565 (lpr-print-region (point-min) (point-max) ps-lpr-switches nil))))
6566 (kill-buffer ps-spool-buffer)))
6567
6568 (defun ps-kill-emacs-check ()
6569 (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
6570 (and (buffer-live-p ps-buffer)
6571 (buffer-modified-p ps-buffer)
6572 (y-or-n-p "Unprinted PostScript waiting; print now? ")
6573 (ps-despool)))
6574 (let ((ps-buffer (get-buffer ps-spool-buffer-name)))
6575 (and (buffer-live-p ps-buffer)
6576 (buffer-modified-p ps-buffer)
6577 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
6578 (error "Unprinted PostScript"))))
6579
6580 (unless noninteractive
6581 (add-hook 'kill-emacs-hook #'ps-kill-emacs-check))
6582
6583 \f
6584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6585 ;; To make this file smaller, some commands go in a separate file.
6586 ;; But autoload them here to make the separation invisible.
6587 \f
6588 ;;;### (autoloads nil "../../../../../../srv/data/home/r/rgm/emacs/bzr/trunk/lisp/ps-mule"
6589 ;;;;;; "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761")
6590 ;;; Generated autoloads from ps-mule.el
6591
6592 (defvar ps-multibyte-buffer nil "\
6593 Specifies the multi-byte buffer handling.
6594
6595 Valid values are:
6596
6597 nil This is the value to use the default settings;
6598 by default, this only works to print buffers with
6599 only ASCII and Latin characters. But this default
6600 setting can be changed by setting the variable
6601 `ps-mule-font-info-database-default' differently.
6602 The initial value of this variable is
6603 `ps-mule-font-info-database-latin' (see
6604 documentation).
6605
6606 `non-latin-printer' This is the value to use when you have a Japanese
6607 or Korean PostScript printer and want to print
6608 buffer with ASCII, Latin-1, Japanese (JISX0208 and
6609 JISX0201-Kana) and Korean characters. At present,
6610 it was not tested with the Korean characters
6611 printing. If you have a korean PostScript printer,
6612 please, test it.
6613
6614 `bdf-font' This is the value to use when you want to print
6615 buffer with BDF fonts. BDF fonts include both latin
6616 and non-latin fonts. BDF (Bitmap Distribution
6617 Format) is a format used for distributing X's font
6618 source file. BDF fonts are included in
6619 `intlfonts-1.2' which is a collection of X11 fonts
6620 for all characters supported by Emacs. In order to
6621 use this value, be sure to have installed
6622 `intlfonts-1.2' and set the variable
6623 `bdf-directory-list' appropriately (see ps-bdf.el for
6624 documentation of this variable).
6625
6626 `bdf-font-except-latin' This is like `bdf-font' except that it uses
6627 PostScript default fonts to print ASCII and Latin-1
6628 characters. This is convenient when you want or
6629 need to use both latin and non-latin characters on
6630 the same buffer. See `ps-font-family',
6631 `ps-header-font-family' and `ps-font-info-database'.
6632
6633 Any other value is treated as nil.")
6634
6635 (custom-autoload 'ps-multibyte-buffer "../../../../../../srv/data/home/r/rgm/emacs/bzr/trunk/lisp/ps-mule" t)
6636
6637 (autoload 'ps-mule-initialize "../../../../../../srv/data/home/r/rgm/emacs/bzr/trunk/lisp/ps-mule" "\
6638 Initialize global data for printing multi-byte characters.
6639
6640 \(fn)" nil nil)
6641
6642 (autoload 'ps-mule-begin-job "../../../../../../srv/data/home/r/rgm/emacs/bzr/trunk/lisp/ps-mule" "\
6643 Start printing job for multi-byte chars between FROM and TO.
6644 It checks if all multi-byte characters in the region are printable or not.
6645
6646 \(fn FROM TO)" nil nil)
6647
6648 (autoload 'ps-mule-end-job "../../../../../../srv/data/home/r/rgm/emacs/bzr/trunk/lisp/ps-mule" "\
6649 Finish printing job for multi-byte chars.
6650
6651 \(fn)" nil nil)
6652
6653 ;;;***
6654 \f
6655 ;;;### (autoloads nil "ps-mule" "ps-mule.el" "a90e8414a27ac8fdf093251ac648d761")
6656 ;;; Generated autoloads from ps-mule.el
6657
6658 (defvar ps-multibyte-buffer nil "\
6659 Specifies the multi-byte buffer handling.
6660
6661 Valid values are:
6662
6663 nil This is the value to use the default settings;
6664 by default, this only works to print buffers with
6665 only ASCII and Latin characters. But this default
6666 setting can be changed by setting the variable
6667 `ps-mule-font-info-database-default' differently.
6668 The initial value of this variable is
6669 `ps-mule-font-info-database-latin' (see
6670 documentation).
6671
6672 `non-latin-printer' This is the value to use when you have a Japanese
6673 or Korean PostScript printer and want to print
6674 buffer with ASCII, Latin-1, Japanese (JISX0208 and
6675 JISX0201-Kana) and Korean characters. At present,
6676 it was not tested with the Korean characters
6677 printing. If you have a korean PostScript printer,
6678 please, test it.
6679
6680 `bdf-font' This is the value to use when you want to print
6681 buffer with BDF fonts. BDF fonts include both latin
6682 and non-latin fonts. BDF (Bitmap Distribution
6683 Format) is a format used for distributing X's font
6684 source file. BDF fonts are included in
6685 `intlfonts-1.2' which is a collection of X11 fonts
6686 for all characters supported by Emacs. In order to
6687 use this value, be sure to have installed
6688 `intlfonts-1.2' and set the variable
6689 `bdf-directory-list' appropriately (see ps-bdf.el for
6690 documentation of this variable).
6691
6692 `bdf-font-except-latin' This is like `bdf-font' except that it uses
6693 PostScript default fonts to print ASCII and Latin-1
6694 characters. This is convenient when you want or
6695 need to use both latin and non-latin characters on
6696 the same buffer. See `ps-font-family',
6697 `ps-header-font-family' and `ps-font-info-database'.
6698
6699 Any other value is treated as nil.")
6700
6701 (custom-autoload 'ps-multibyte-buffer "ps-mule" t)
6702
6703 (autoload 'ps-mule-initialize "ps-mule" "\
6704 Initialize global data for printing multi-byte characters.
6705
6706 \(fn)" nil nil)
6707
6708 (autoload 'ps-mule-begin-job "ps-mule" "\
6709 Start printing job for multi-byte chars between FROM and TO.
6710 It checks if all multi-byte characters in the region are printable or not.
6711
6712 \(fn FROM TO)" nil nil)
6713
6714 (autoload 'ps-mule-end-job "ps-mule" "\
6715 Finish printing job for multi-byte chars.
6716
6717 \(fn)" nil nil)
6718
6719 ;;;***
6720 \f
6721 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6722
6723 (provide 'ps-print)
6724
6725 ;;; ps-print.el ends here