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