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