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