*** empty log message ***
[emacs.git] / lisp / ps-print.el
blobdeb7b7b88c4d3baef8f25385018b98da692a5c67
1 ;;; ps-print.el --- Print text from the buffer as PostScript
3 ;; Copyright (C) 1993,94,95,96,97,98,99,00,2001
4 ;; Free Software Foundation, Inc.
6 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
7 ;; Author: Jacques Duthen (was <duthen@cegelec-red.fr>)
8 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
9 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
11 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
12 ;; Keywords: wp, print, PostScript
13 ;; Time-stamp: <2001/03/23 21:27:46 Vinicius>
14 ;; Version: 6.5
15 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
17 (defconst ps-print-version "6.5"
18 "ps-print.el, v 6.5 <2001/03/23 vinicius>
20 Vinicius's last change version -- this file may have been edited as part of
21 Emacs without changes to the version number. When reporting bugs, please also
22 report the version of Emacs, if any, that ps-print was distributed with.
24 Please send all bug fixes and enhancements to
25 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
28 ;; This file is part of GNU Emacs.
30 ;; GNU Emacs is free software; you can redistribute it and/or modify
31 ;; it under the terms of the GNU General Public License as published by
32 ;; the Free Software Foundation; either version 2, or (at your option)
33 ;; any later version.
35 ;; GNU Emacs is distributed in the hope that it will be useful,
36 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
37 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
38 ;; GNU General Public License for more details.
40 ;; You should have received a copy of the GNU General Public License
41 ;; along with GNU Emacs; see the file COPYING. If not, write to the
42 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
43 ;; Boston, MA 02111-1307, USA.
45 ;;; Commentary:
47 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49 ;; About ps-print
50 ;; --------------
52 ;; This package provides printing of Emacs buffers on PostScript printers;
53 ;; the buffer's bold and italic text attributes are preserved in the printer
54 ;; output. ps-print is intended for use with Emacs or Lucid Emacs, together
55 ;; with a fontifying package such as font-lock or hilit.
57 ;; ps-print uses the same face attributes defined through font-lock or hilit
58 ;; to print a PostScript file, but some faces are better seeing on the screen
59 ;; than on paper, specially when you have a black/white PostScript printer.
61 ;; ps-print allows a remap of face to another one that it is better to print,
62 ;; for example, the face font-lock-comment-face (if you are using font-lock)
63 ;; could have bold or italic attribute when printing, besides foreground color.
64 ;; This remap improves printing look (see How Ps-Print Maps Faces).
67 ;; Using ps-print
68 ;; --------------
70 ;; ps-print provides eight commands for generating PostScript images
71 ;; of Emacs buffers:
73 ;; ps-print-buffer
74 ;; ps-print-buffer-with-faces
75 ;; ps-print-region
76 ;; ps-print-region-with-faces
77 ;; ps-spool-buffer
78 ;; ps-spool-buffer-with-faces
79 ;; ps-spool-region
80 ;; ps-spool-region-with-faces
82 ;; These commands all perform essentially the same function: they
83 ;; generate PostScript images suitable for printing on a PostScript
84 ;; printer or displaying with GhostScript. These commands are
85 ;; collectively referred to as "ps-print- commands".
87 ;; The word "print" or "spool" in the command name determines when the
88 ;; PostScript image is sent to the printer:
90 ;; print - The PostScript image is immediately sent to the
91 ;; printer;
93 ;; spool - The PostScript image is saved temporarily in an
94 ;; Emacs buffer. Many images may be spooled locally
95 ;; before printing them. To send the spooled images
96 ;; to the printer, use the command `ps-despool'.
98 ;; The spooling mechanism was designed for printing lots of small
99 ;; files (mail messages or netnews articles) to save paper that would
100 ;; otherwise be wasted on banner pages, and to make it easier to find
101 ;; your output at the printer (it's easier to pick up one 50-page
102 ;; printout than to find 50 single-page printouts).
104 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't
105 ;; accidentally quit from Emacs while you have unprinted PostScript
106 ;; waiting in the spool buffer. If you do attempt to exit with
107 ;; spooled PostScript, you'll be asked if you want to print it, and if
108 ;; you decline, you'll be asked to confirm the exit; this is modeled
109 ;; on the confirmation that Emacs uses for modified buffers.
111 ;; The word "buffer" or "region" in the command name determines how
112 ;; much of the buffer is printed:
114 ;; buffer - Print the entire buffer.
116 ;; region - Print just the current region.
118 ;; The -with-faces suffix on the command name means that the command
119 ;; will include font, color, and underline information in the
120 ;; PostScript image, so the printed image can look as pretty as the
121 ;; buffer. The ps-print- commands without the -with-faces suffix
122 ;; don't include font, color, or underline information; images printed
123 ;; with these commands aren't as pretty, but are faster to generate.
125 ;; Two ps-print- command examples:
127 ;; ps-print-buffer - print the entire buffer,
128 ;; without font, color, or
129 ;; underline information, and
130 ;; send it immediately to the
131 ;; printer.
133 ;; ps-spool-region-with-faces - print just the current region;
134 ;; include font, color, and
135 ;; underline information, and
136 ;; spool the image in Emacs to
137 ;; send to the printer later.
140 ;; Invoking Ps-Print
141 ;; -----------------
143 ;; To print your buffer, type
145 ;; M-x ps-print-buffer
147 ;; or substitute one of the other seven ps-print- commands. The
148 ;; command will generate the PostScript image and print or spool it as
149 ;; specified. By giving the command a prefix argument
151 ;; C-u M-x ps-print-buffer
153 ;; it will save the PostScript image to a file instead of sending it
154 ;; to the printer; you will be prompted for the name of the file to
155 ;; save the image to. The prefix argument is ignored by the commands
156 ;; that spool their images, but you may save the spooled images to a
157 ;; file by giving a prefix argument to `ps-despool':
159 ;; C-u M-x ps-despool
161 ;; When invoked this way, `ps-despool' will prompt you for the name of
162 ;; the file to save to.
164 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
165 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
166 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
168 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
169 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
170 ;; (global-set-key '(control f22) 'ps-despool)
173 ;; The Printer Interface
174 ;; ---------------------
176 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
177 ;; command is used to send the PostScript images to the printer, and
178 ;; what arguments to give the command. These are analogous to
179 ;; `lpr-command' and `lpr-switches'.
181 ;; Make sure that they contain appropriate values for your system;
182 ;; see the usage notes below and the documentation of these variables.
184 ;; The variable `ps-printer-name' determines the name of a local printer for
185 ;; printing PostScript files.
187 ;; The variable `ps-printer-name-option' determines the option used by some
188 ;; utilities to indicate the printer name, it's used only when
189 ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
190 ;; print, for example, `ps-printer-name-option' should be set to "-P".
192 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
193 ;; from the variables `lpr-command' and `lpr-switches'. If you have
194 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
195 ;; then ps-print won't work properly. `ps-lpr-command' must name
196 ;; a program that does not format the files it prints.
197 ;; `ps-printer-name' takes its initial value from the variable
198 ;; `printer-name'. `ps-printer-name-option' tries to guess which system
199 ;; Emacs is running and takes its initial value in accordance with this
200 ;; guess.
202 ;; The variable `ps-print-region-function' specifies a function to print the
203 ;; region on a PostScript printer.
204 ;; See definition of `call-process-region' for calling conventions. The fourth
205 ;; and the sixth arguments are both nil.
207 ;; The variable `ps-manual-feed' indicates if the printer will manually feed
208 ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
209 ;; feeding takes place. The default is nil (automatic feeding).
211 ;; The variable `ps-end-with-control-d' specifies whether C-d (\x04) should be
212 ;; inserted at end of PostScript generated. Non-nil means do so. The default
213 ;; is nil (don't insert).
215 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
216 ;; customize the following variables: `ps-printer-name',
217 ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
218 ;; `ps-spool-config'. See these variables documentation in the code or by
219 ;; typing, for example, C-h v ps-printer-name RET.
222 ;; The Page Layout
223 ;; ---------------
225 ;; All dimensions are floats in PostScript points.
226 ;; 1 inch == 2.54 cm == 72 points
227 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
229 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
230 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
231 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
232 ;; `b5'.
234 ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
235 ;; PostScript printer doesn't have a paper with the size indicated by
236 ;; `ps-paper-type', instead it uses the default paper size. If variable
237 ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
238 ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
239 ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
240 ;; Printers). The default value is non-nil (it gives an error).
242 ;; The variable `ps-landscape-mode' determines the orientation of the printing
243 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
244 ;; There is no oblique mode yet, though this is easy to do in ps.
246 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in portrait
247 ;; mode and only 50 lines in landscape mode. The margins represent margins in
248 ;; the printed paper: the top margin is the margin between the top of the page
249 ;; and the printed header, whatever the orientation is.
251 ;; The variable `ps-number-of-columns' determines the number of columns both in
252 ;; landscape and portrait mode.
253 ;; You can use:
254 ;; - (the standard) one column portrait mode.
255 ;; - (my favorite) two columns landscape mode (which spares trees).
256 ;; but also:
257 ;; - one column landscape mode for files with very long lines.
258 ;; - multi-column portrait or landscape mode.
260 ;; The variable `ps-print-upside-down' determines other orientation for printing
261 ;; page: nil means `normal' printing, non-nil means `upside-down' printing. The
262 ;; default value is nil (`normal' printing).
264 ;; The `upside-down' orientation can be used in portrait or landscape mode.
266 ;; The variable `ps-selected-pages' specifies which pages to print. If it's
267 ;; nil, all pages are printed. If it's a list, the list element may be an
268 ;; integer or a cons cell (FROM . TO) designating FROM page to TO page; any
269 ;; invalid element is ignored, that is, an integer lesser than one or if FROM
270 ;; is greater than TO. Otherwise, it's treated as nil. The default value is
271 ;; nil (print all pages). After ps-print processing `ps-selected-pages' is set
272 ;; to nil. But the latest `ps-selected-pages' is saved in
273 ;; `ps-last-selected-pages' (see it for documentation). So you can restore the
274 ;; latest selected pages by using `ps-last-selected-pages' or by calling
275 ;; `ps-restore-selected-pages' command (see it for documentation).
277 ;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
279 ;; Valid values are:
281 ;; nil print all pages.
283 ;; even-page print only even pages.
285 ;; odd-page print only odd pages.
287 ;; even-sheet print only even sheets.
289 ;; odd-sheet print only odd sheets.
291 ;; Any other value is treated as nil. The default value is nil.
293 ;; See `ps-even-or-odd-pages' for more detailed documentation.
296 ;; Horizontal layout
297 ;; -----------------
299 ;; The horizontal layout is determined by the variables
300 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
301 ;; as follows:
303 ;; ------------------------------------------
304 ;; | | | | | | | |
305 ;; | lm | text | ic | text | ic | text | rm |
306 ;; | | | | | | | |
307 ;; ------------------------------------------
309 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
310 ;; Usually, lm = rm > 0 and ic = lm
311 ;; If (ic < 0), the text of adjacent columns can overlap.
314 ;; Vertical layout
315 ;; ---------------
317 ;; The vertical layout is determined by the variables
318 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
319 ;; as follows:
321 ;; |--------| |--------|
322 ;; | tm | | tm |
323 ;; |--------| |--------|
324 ;; | header | | |
325 ;; |--------| | |
326 ;; | ho | | |
327 ;; |--------| or | text |
328 ;; | | | |
329 ;; | text | | |
330 ;; | | | |
331 ;; |--------| |--------|
332 ;; | bm | | bm |
333 ;; |--------| |--------|
335 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
336 ;; The margins represent margins in the printed paper:
337 ;; the top margin is the margin between the top of the page
338 ;; and the printed header, whatever the orientation is.
341 ;; Headers
342 ;; -------
344 ;; ps-print can print headers at the top of each column or at the top
345 ;; of each page; the default headers contain the following four items:
346 ;; on the left, the name of the buffer and, if the buffer is visiting
347 ;; a file, the file's directory; on the right, the page number and
348 ;; date of printing. The default 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
354 ;; that the 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 ;; To print only one header at the top of each page,
362 ;; set `ps-print-only-one-header' to t.
364 ;; To switch headers, set `ps-switch-header' to:
366 ;; nil Never switch headers.
368 ;; t Always switch headers.
370 ;; duplex Switch headers only when duplexing is on, that is, when
371 ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
373 ;; Any other value is treated as t. The default value is `duplex'.
375 ;; The font family and size of text in the header are determined
376 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
377 ;; `ps-header-title-font-size' (see below).
379 ;; The variable `ps-header-line-pad' determines the portion of a header
380 ;; title line height to insert between the header frame and the text
381 ;; it contains, both in the vertical and horizontal directions:
382 ;; .5 means half a line.
384 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
385 ;; to omit the total page count and just print the page number,
386 ;; set `ps-show-n-of-n' to nil.
388 ;; The amount of information in the header can be changed by changing
389 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
390 ;; the header will show only the buffer name and page number. To show
391 ;; more, set `ps-header-lines' to 3, and the header will show the time of
392 ;; printing below the date.
394 ;; To change the content of the headers, change the variables
395 ;; `ps-left-header' and `ps-right-header'.
396 ;; These variables are lists, specifying top-to-bottom the text
397 ;; to display on the left or right side of the header.
398 ;; Each element of the list should be a string or a symbol.
399 ;; Strings are inserted directly into the PostScript arrays,
400 ;; and should contain the PostScript string delimiters '(' and ')'.
402 ;; Symbols in the header format lists can either represent functions
403 ;; or variables. Functions are called, and should return a string to
404 ;; show in the header. Variables should contain strings to display in
405 ;; the header. In either case, function or variable, the PostScript
406 ;; string delimiters are added by ps-print, and should not be part of
407 ;; the returned value.
409 ;; Here's an example: say we want the left header to display the text
411 ;; Moe
412 ;; Larry
413 ;; Curly
415 ;; where we have a function to return "Moe"
417 ;; (defun moe-func ()
418 ;; "Moe")
420 ;; a variable specifying "Larry"
422 ;; (setq larry-var "Larry")
424 ;; and a literal for "Curly". Here's how `ps-left-header' should be
425 ;; set:
427 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
429 ;; Note that Curly has the PostScript string delimiters inside his
430 ;; quotes -- those aren't misplaced lisp delimiters!
432 ;; Without them, PostScript would attempt to call the undefined
433 ;; function Curly, which would result in a PostScript error.
435 ;; Since most printers don't report PostScript errors except by
436 ;; aborting the print job, this kind of error can be hard to track down.
438 ;; Consider yourself warned!
441 ;; PostScript Prologue Header
442 ;; --------------------------
444 ;; It is possible to add PostScript prologue header comments besides that
445 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
447 ;; `ps-print-prologue-header' may be a string or a symbol function which returns
448 ;; a string. Note that this string is inserted on PostScript prologue header
449 ;; section which is used to define some document characteristic through
450 ;; PostScript special comments, like "%%Requirements: jog\n".
452 ;; By default `ps-print-prologue-header' is nil.
454 ;; ps-print always inserts the %%Requirements: comment, so if you need to insert
455 ;; more requirements put them first in `ps-print-prologue-header' using the
456 ;; "%%+" comment. For example, if you need to set numcopies to 3 and jog on
457 ;; requirements and set %%LanguageLevel: to 2, do:
459 ;; (setq ps-print-prologue-header
460 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
462 ;; The duplex requirement is inserted by ps-print (see section Duplex Printers).
464 ;; Do not forget to terminate the string with "\n".
466 ;; For more information about PostScript document comments, see:
467 ;; PostScript Language Reference Manual (2nd edition)
468 ;; Adobe Systems Incorporated
469 ;; Appendix G: Document Structuring Conventions -- Version 3.0
471 ;; It is also possible to add an user defined PostScript prologue code before
472 ;; all generated prologue code by setting the variable
473 ;; `ps-user-defined-prologue'.
475 ;; `ps-user-defined-prologue' may be a string or a symbol function which returns
476 ;; a string. Note that this string is inserted after `ps-adobe-tag' and
477 ;; PostScript prologue comments, and before ps-print PostScript prologue code
478 ;; section. That is, this string is inserted after error handler initialization
479 ;; and before ps-print settings.
481 ;; By default `ps-user-defined-prologue' is nil.
483 ;; It's strongly recommended only insert PostScript code and/or comments
484 ;; specific for your printing system particularities. For example, some special
485 ;; initialization that only your printing system needs.
487 ;; Do not insert code for duplex printing, n-up printing or error handler,
488 ;; ps-print handles this in a suitable way.
490 ;; For more information about PostScript, see:
491 ;; PostScript Language Reference Manual (2nd edition)
492 ;; Adobe Systems Incorporated
494 ;; As an example for `ps-user-defined-prologue' setting:
496 ;; ;; Setting for HP PostScript printer
497 ;; (setq ps-user-defined-prologue
498 ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
499 ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
502 ;; PostScript Error Handler
503 ;; ------------------------
505 ;; ps-print instruments generated PostScript code with an error handler.
507 ;; The variable `ps-error-handler-message' specifies where the error handler
508 ;; message should be sent.
510 ;; Valid values are:
512 ;; none catch the error and *DON'T* send any message.
514 ;; paper catch the error and print on paper the error message.
515 ;; This is the default value.
517 ;; system catch the error and send back the error message to
518 ;; printing system. This is useful only if printing system
519 ;; send back an email reporting the error, or if there is
520 ;; some other alternative way to report back the error from
521 ;; the system to you.
523 ;; paper-and-system catch the error, print on paper the error message and
524 ;; send back the error message to printing system.
526 ;; Any other value is treated as `paper'.
529 ;; Duplex Printers
530 ;; ---------------
532 ;; If you have a duplex-capable printer (one that prints both sides of the
533 ;; paper), set `ps-spool-duplex' to t.
534 ;; ps-print will insert blank pages to make sure each buffer starts on the
535 ;; correct side of the paper.
537 ;; The variable `ps-spool-config' specifies who is the responsable for setting
538 ;; duplex and page size switches. Valid values are:
540 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
541 ;; Don't forget to set `ps-lpr-switches' to select duplex
542 ;; printing for your printer.
544 ;; setpagedevice duplex and page size are configured by ps-print using the
545 ;; setpagedevice PostScript operator.
547 ;; nil duplex and page size are configured by ps-print *not* using
548 ;; the setpagedevice PostScript operator.
550 ;; Any other value is treated as nil.
552 ;; The default value is `lpr-switches'.
554 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility when
555 ;; viewing file generated using landscape. Also on some printers,
556 ;; setpagedevice affects zebra stripes; on other printers,
557 ;; setpagedevice affects the left margin.
558 ;; Besides all that, if your printer does not have the paper size
559 ;; specified by setpagedevice, your printing will be aborted.
560 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
561 ;; `setpagedevice', generate a test file and send it to your printer;
562 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
564 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
565 ;; sides of a sheet are oriented with respect to each other. If
566 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left or
567 ;; right. If `ps-spool-tumble' is non-nil, produces output suitable for binding
568 ;; at the top or bottom. It has effect only when `ps-spool-duplex' is non-nil.
569 ;; The default value is nil.
571 ;; Some printer system prints a header page and forces the first page be printed
572 ;; on header page back, when using duplex. If your printer system has this
573 ;; behavior, set variable `ps-banner-page-when-duplexing' to t.
575 ;; When `ps-banner-page-when-duplexing' is non-nil means the very first page is
576 ;; skipped. It's like the very first character of buffer (or region) is ^L
577 ;; (\014).
579 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the very
580 ;; first page).
583 ;; N-up Printing
584 ;; -------------
586 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
587 ;; paper. The value specified must be between 1 and 100. The default is 1.
589 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is set
590 ;; to a high value (for example, 23). If this happens, set a lower value.
592 ;; The variable `ps-n-up-margin' specifies the margin in points between the
593 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
594 ;; or 28.35 points).
596 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each page.
597 ;; The default is t.
599 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
600 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
601 ;; filling example using a 3x4 page matrix:
603 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
604 ;; 5 6 7 8 5 6 7 8
605 ;; 9 10 11 12 1 2 3 4
607 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
608 ;; 8 7 6 5 8 7 6 5
609 ;; 12 11 10 9 4 3 2 1
611 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
612 ;; 2 5 8 11 2 5 8 11
613 ;; 3 6 9 12 1 4 7 10
615 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
616 ;; 11 8 5 2 11 8 5 2
617 ;; 12 9 6 3 10 7 4 1
619 ;; Any other value is treated as left-top.
621 ;; The default value is left-top.
624 ;; Control And 8-bit Characters
625 ;; ----------------------------
627 ;; The variable `ps-print-control-characters' specifies whether you want to see
628 ;; a printable form for control and 8-bit characters, that is, instead of
629 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
631 ;; Valid values for `ps-print-control-characters' are:
633 ;; 8-bit This is the value to use when you want an ASCII encoding of
634 ;; any control or non-ASCII character. Control characters are
635 ;; encoded as "^D", and non-ASCII characters have an
636 ;; octal encoding.
638 ;; control-8-bit This is the value to use when you want an ASCII encoding of
639 ;; any control character, whether it is 7 or 8-bit.
640 ;; European 8-bits accented characters are printed according
641 ;; the current font.
643 ;; control Only ASCII control characters have an ASCII encoding.
644 ;; European 8-bits accented characters are printed according
645 ;; the current font.
647 ;; nil No ASCII encoding. Any character is printed according the
648 ;; current font.
650 ;; Any other value is treated as nil.
652 ;; The default is `control-8-bit'.
654 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
657 ;; Printing Multi-byte Buffer
658 ;; --------------------------
660 ;; See ps-mule.el for documentation.
663 ;; Line Number
664 ;; -----------
666 ;; The variable `ps-line-number' specifies whether to number each line;
667 ;; non-nil means do so. The default is nil (don't number each line).
669 ;; The variable `ps-line-number-font' specifies the font for line number.
670 ;; The default is "Times-Italic".
672 ;; The variable `ps-line-number-font-size' specifies the font size in points
673 ;; for line number. See `ps-font-size' for documentation. The default is 6.
675 ;; The variable `ps-line-number-step' specifies the interval that line number is
676 ;; printed. For example, if `ps-line-number-step' is set to 2, the printing
677 ;; will look like:
679 ;; 1 one line
680 ;; one line
681 ;; 3 one line
682 ;; one line
683 ;; 5 one line
684 ;; one line
685 ;; ...
687 ;; Valid values are:
689 ;; integer an integer that specifies the interval that line number is
690 ;; printed. If it's lesser than or equal to zero, it's used the
691 ;; value 1.
693 ;; `zebra' specifies that only the line number of the first line in a zebra
694 ;; stripe is to be printed.
696 ;; Any other value is treated as `zebra'.
697 ;; The default value is 1, so each line number is printed.
699 ;; The variable `ps-line-number-start' specifies the starting point in the
700 ;; interval given by `ps-line-number-step'. For example, if
701 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3, the
702 ;; printing will look like:
704 ;; one line
705 ;; one line
706 ;; 3 one line
707 ;; one line
708 ;; one line
709 ;; 6 one line
710 ;; one line
711 ;; one line
712 ;; 9 one line
713 ;; one line
714 ;; ...
716 ;; The values for `ps-line-number-start':
718 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
719 ;; of `ps-line-number-step' inclusive.
721 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
722 ;; value of `ps-zebra-stripe-height' inclusive.
724 ;; The default value is 1, so the line number of the first line of each interval
725 ;; is printed.
728 ;; Zebra Stripes
729 ;; -------------
731 ;; Zebra stripes are a kind of background that appear "underneath" the text
732 ;; and can make the text easier to read. They look like this:
734 ;; XXXXXXXXXXXXXXXXXXXXXXXX
735 ;; XXXXXXXXXXXXXXXXXXXXXXXX
736 ;; XXXXXXXXXXXXXXXXXXXXXXXX
740 ;; XXXXXXXXXXXXXXXXXXXXXXXX
741 ;; XXXXXXXXXXXXXXXXXXXXXXXX
742 ;; XXXXXXXXXXXXXXXXXXXXXXXX
744 ;; The blocks of X's represent rectangles filled with a light gray color.
745 ;; Each rectangle extends all the way across the page.
747 ;; The height, in lines, of each rectangle is controlled by
748 ;; the variable `ps-zebra-stripe-height', which is 3 by default.
749 ;; The distance between stripes equals the height of a stripe.
751 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
752 ;; Non-nil means yes, nil means no. The default is nil.
754 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
755 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
756 ;; color), a string which is a color name, or a list of 3 numbers which
757 ;; corresponds to the Red Green Blue color scale.
758 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
760 ;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
761 ;; on next page. Visually, valid values are (the character `+' at right of
762 ;; each column indicates that a line is printed):
764 ;; `nil' `follow' `full' `full-follow'
765 ;; Current Page -------- ----------- --------- ----------------
766 ;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
767 ;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
768 ;; 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
769 ;; 4 + 4 + 4 + 4 +
770 ;; 5 + 5 + 5 + 5 +
771 ;; 6 + 6 + 6 + 6 +
772 ;; 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
773 ;; 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
774 ;; 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
775 ;; 10 + 10 +
776 ;; 11 + 11 +
777 ;; -------- ----------- --------- ----------------
778 ;; Next Page -------- ----------- --------- ----------------
779 ;; 12 XXXXX + 12 + 10 XXXXXX + 10 +
780 ;; 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
781 ;; 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
782 ;; 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
783 ;; 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
784 ;; 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
785 ;; 18 XXXXX + 18 + 16 XXXXXX + 16 +
786 ;; 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
787 ;; 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
788 ;; 21 + 21 XXXXXXXX +
789 ;; 22 + 22 +
790 ;; -------- ----------- --------- ----------------
792 ;; Any other value is treated as `nil'.
794 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
797 ;; Hooks
798 ;; -----
800 ;; ps-print has the following hook variables:
802 ;; `ps-print-hook'
803 ;; It is evaluated once before any printing process. This is the right
804 ;; place to initialize ps-print global data.
805 ;; For an example, see section Adding a New Font Family.
807 ;; `ps-print-begin-sheet-hook'
808 ;; It is evaluated on each beginning of sheet of paper.
809 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
810 ;; evaluated.
812 ;; `ps-print-begin-page-hook'
813 ;; It is evaluated on each beginning of page, except in the beginning
814 ;; of page that `ps-print-begin-sheet-hook' is evaluated.
816 ;; `ps-print-begin-column-hook'
817 ;; It is evaluated on each beginning of column, except in the beginning
818 ;; of column that `ps-print-begin-page-hook' is evaluated or that
819 ;; `ps-print-begin-sheet-hook' is evaluated.
822 ;; Font Managing
823 ;; -------------
825 ;; ps-print now knows rather precisely some fonts: the variable
826 ;; `ps-font-info-database' contains information for a list of font families
827 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino' `Helvetica-Narrow'
828 ;; `NewCenturySchlbk'). Each font family contains the font names for standard,
829 ;; bold, italic and bold-italic characters, a reference size (usually 10) and
830 ;; the corresponding line height, width of a space and average character width.
832 ;; The variable `ps-font-family' determines which font family is to be used for
833 ;; ordinary text. If its value does not correspond to a known font family, an
834 ;; error message is printed into the `*Messages*' buffer, which lists the
835 ;; currently available font families.
837 ;; The variable `ps-font-size' determines the size (in points) of the font for
838 ;; ordinary text, when generating PostScript. Its value is a float or a cons of
839 ;; floats which has the following form:
841 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
843 ;; Similarly, the variable `ps-header-font-family' determines which font family
844 ;; is to be used for text in the header.
846 ;; The variable `ps-header-font-size' determines the font size, in points, for
847 ;; text in the header (similar to `ps-font-size').
849 ;; The variable `ps-header-title-font-size' determines the font size, in points,
850 ;; for the top line of text in the header (similar to `ps-font-size').
852 ;; The variable `ps-line-spacing' determines the line spacing, in points, for
853 ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The
854 ;; default value is 0 (zero = no line spacing).
856 ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in
857 ;; points, for ordinary text, when generating PostScript (similar to
858 ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing).
860 ;; To get all lines with some spacing set both `ps-line-spacing' and
861 ;; `ps-paragraph-spacing' variables.
863 ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It
864 ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an
865 ;; empty line or a line containing only spaces and tabs.
867 ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start
868 ;; and end of a region to cut out when printing.
870 ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may
871 ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave
872 ;; out some special printing instructions from the actual print. Special
873 ;; printing instructions may be appended to the end of the file just like any
874 ;; other buffer-local variables. See section "Local Variables in Files" on
875 ;; Emacs manual for more information.
877 ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
878 ;; actually gets printed. Both variables may be set to nil in which case no
879 ;; cutting occurs. By default, both variables are set to nil.
882 ;; Adding a New Font Family
883 ;; ------------------------
885 ;; To use a new font family, you MUST first teach ps-print
886 ;; this font, i.e., add its information to `ps-font-info-database',
887 ;; otherwise ps-print cannot correctly place line and page breaks.
889 ;; For example, assuming `Helvetica' is unknown,
890 ;; you first need to do the following ONLY ONCE:
892 ;; - create a new buffer
893 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
894 ;; - open this file and find the line:
895 ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
896 ;; - delete the leading `%' (which is the PostScript comment character)
897 ;; - replace in this line `Courier' by the new font (say `Helvetica')
898 ;; to get the line:
899 ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
900 ;; - send this file to the printer (or to ghostscript).
901 ;; You should read the following on the output page:
903 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
904 ;; and a crude estimate of average character width is 5.09243
906 ;; - Add these values to the `ps-font-info-database':
907 ;; (setq ps-font-info-database
908 ;; (append
909 ;; '((Helvetica ; the family key
910 ;; (fonts (normal . "Helvetica")
911 ;; (bold . "Helvetica-Bold")
912 ;; (italic . "Helvetica-Oblique")
913 ;; (bold-italic . "Helvetica-BoldOblique"))
914 ;; (size . 10.0)
915 ;; (line-height . 11.56)
916 ;; (space-width . 2.78)
917 ;; (avg-char-width . 5.09243)))
918 ;; ps-font-info-database))
919 ;; - Now you can use this font family with any size:
920 ;; (setq ps-font-family 'Helvetica)
921 ;; - if you want to use this family in another emacs session, you must
922 ;; put into your `~/.emacs':
923 ;; (require 'ps-print)
924 ;; (setq ps-font-info-database (append ...)))
925 ;; if you don't want to load ps-print, you have to copy the whole value:
926 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
927 ;; or, use `ps-print-hook' (see section Hooks):
928 ;; (add-hook 'ps-print-hook
929 ;; '(lambda ()
930 ;; (or (assq 'Helvetica ps-font-info-database)
931 ;; (setq ps-font-info-database (append ...)))))
933 ;; You can create new `mixed' font families like:
934 ;; (my-mixed-family
935 ;; (fonts (normal . "Courier-Bold")
936 ;; (bold . "Helvetica")
937 ;; (italic . "Zapf-Chancery-MediumItalic")
938 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
939 ;; (w3-table-hack-x-face . "LineDrawNormal"))
940 ;; (size . 10.0)
941 ;; (line-height . 10.55)
942 ;; (space-width . 6.0)
943 ;; (avg-char-width . 6.0))
945 ;; Now you can use your new font family with any size:
946 ;; (setq ps-font-family 'my-mixed-family)
948 ;; Note that on above example the `w3-table-hack-x-face' entry refers to
949 ;; a face symbol, so when printing this face it'll be used the font
950 ;; `LineDrawNormal'. If the face `w3-table-hack-x-face' is remapped to
951 ;; use bold and/or italic attribute, the corresponding entry (bold, italic
952 ;; or bold-italic) will be used instead of `w3-table-hack-x-face' entry.
954 ;; Note also that the font family entry order is irrelevant, so the above
955 ;; example could also be written:
956 ;; (my-mixed-family
957 ;; (size . 10.0)
958 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
959 ;; (bold . "Helvetica")
960 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
961 ;; (italic . "Zapf-Chancery-MediumItalic")
962 ;; (normal . "Courier-Bold"))
963 ;; (avg-char-width . 6.0)
964 ;; (space-width . 6.0)
965 ;; (line-height . 10.55))
967 ;; Despite the note above, it is recommended that some convention about
968 ;; entry order be used.
970 ;; You can get information on all the fonts resident in YOUR printer
971 ;; by uncommenting the line:
972 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
974 ;; The PostScript file should be sent to YOUR PostScript printer.
975 ;; If you send it to ghostscript or to another PostScript printer,
976 ;; you may get slightly different results.
977 ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
979 ;; Note also that ps-print DOESN'T download any font to your printer, instead
980 ;; it uses the fonts resident in your printer.
983 ;; How Ps-Print Deals With Faces
984 ;; -----------------------------
986 ;; The ps-print-*-with-faces commands attempt to determine which faces
987 ;; should be printed in bold or italic, but their guesses aren't
988 ;; always right. For example, you might want to map colors into faces
989 ;; so that blue faces print in bold, and red faces in italic.
991 ;; It is possible to force ps-print to consider specific faces bold,
992 ;; italic or underline, no matter what font they are displayed in, by setting
993 ;; the variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
994 ;; These variables contain lists of faces that ps-print should consider bold,
995 ;; italic or underline; to set them, put code like the following into your
996 ;; .emacs file:
998 ;; (setq ps-bold-faces '(my-blue-face))
999 ;; (setq ps-italic-faces '(my-red-face))
1000 ;; (setq ps-underlined-faces '(my-green-face))
1002 ;; Faces like bold-italic that are both bold and italic should go in
1003 ;; *both* lists.
1005 ;; ps-print keeps internal lists of which fonts are bold and which are
1006 ;; italic; these lists are built the first time you invoke ps-print.
1007 ;; For the sake of efficiency, the lists are built only once; the same
1008 ;; lists are referred in later invocations of ps-print.
1010 ;; Because these lists are built only once, it's possible for them to
1011 ;; get out of sync, if a face changes, or if new faces are added. To
1012 ;; get the lists back in sync, you can set the variable
1013 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
1014 ;; next time ps-print is invoked. If you need that the lists always be
1015 ;; rebuilt when ps-print is invoked, set the variable
1016 ;; `ps-always-build-face-reference' to t.
1018 ;; If you need to print without worrying about face background color, set the
1019 ;; variable `ps-use-face-background' which specifies if face background should
1020 ;; be used. Valid values are:
1022 ;; t always use face background color.
1023 ;; nil never use face background color.
1024 ;; (face...) list of faces whose background color will be used.
1026 ;; Any other value will be treated as t.
1027 ;; The default value is t.
1030 ;; How Ps-Print Deals With Color
1031 ;; -----------------------------
1033 ;; ps-print detects faces with foreground and background colors
1034 ;; defined and embeds color information in the PostScript image.
1035 ;; The default foreground and background colors are defined by the
1036 ;; variables `ps-default-fg' and `ps-default-bg'.
1037 ;; On black-and-white printers, colors are displayed in gray scale.
1038 ;; To turn off color output, set `ps-print-color-p' to nil.
1041 ;; How Ps-Print Maps Faces
1042 ;; -----------------------
1044 ;; As ps-print uses PostScript to print buffers, it is possible to have
1045 ;; other attributes associated with faces. So the new attributes used
1046 ;; by ps-print are:
1048 ;; strikeout - like underline, but the line is in middle of text.
1049 ;; overline - like underline, but the line is over the text.
1050 ;; shadow - text will have a shadow.
1051 ;; box - text will be surrounded by a box.
1052 ;; outline - print characters as hollow outlines.
1054 ;; See the documentation for `ps-extend-face'.
1056 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1057 ;; color and bold attribute:
1059 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
1061 ;; If you want to use a new face, define it first with `defface',
1062 ;; and then call `ps-extend-face' to specify how to print it.
1065 ;; How Ps-Print Has A Text And/Or Image On Background
1066 ;; --------------------------------------------------
1068 ;; ps-print can print texts and/or EPS PostScript images on background; it is
1069 ;; possible to define the following text attributes: font name, font size,
1070 ;; initial position, angle, gray scale and pages to print.
1072 ;; It has the following EPS PostScript images attributes: file name containing
1073 ;; the image, initial position, X and Y scales, angle and pages to print.
1075 ;; See documentation for `ps-print-background-text' and
1076 ;; `ps-print-background-image'.
1078 ;; For example, if we wish to print text "preliminary" on all pages and text
1079 ;; "special" on page 5 and from page 11 to page 17, we could specify:
1081 ;; (setq ps-print-background-text
1082 ;; '(("preliminary")
1083 ;; ("special"
1084 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
1085 ;; ; (upper left corner)
1086 ;; nil nil nil
1087 ;; "PrintHeight neg PrintPageWidth atan" ; angle
1088 ;; 5 (11 . 17)) ; page list
1089 ;; ))
1091 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
1092 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
1093 ;; specify:
1095 ;; (setq ps-print-background-image
1096 ;; '(("~/images/EPS-image1.ps"
1097 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
1098 ;; ("~/images/EPS-image2.ps"
1099 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y position
1100 ;; ; (upper left corner)
1101 ;; nil nil nil
1102 ;; 5 (11 . 17)) ; page list
1103 ;; ))
1105 ;; If it is not possible to read (or does not exist) an image file, that file
1106 ;; is ignored.
1108 ;; The printing order is:
1110 ;; 1. Print background color
1111 ;; 2. Print zebra stripes
1112 ;; 3. Print background texts that it should be on all pages
1113 ;; 4. Print background images that it should be on all pages
1114 ;; 5. Print background texts only for current page (if any)
1115 ;; 6. Print background images only for current page (if any)
1116 ;; 7. Print header
1117 ;; 8. Print buffer text (with faces, if specified) and line number
1120 ;; Utilities
1121 ;; ---------
1123 ;; Some tools are provided to help you customize your font setup.
1125 ;; `ps-setup' returns (some part of) the current setup.
1127 ;; To avoid wrapping too many lines, you may want to adjust the
1128 ;; left and right margins and the font size. On UN*X systems, do:
1129 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1130 ;; to determine the longest lines of your file.
1131 ;; Then, the command `ps-line-lengths' will give you the correspondence
1132 ;; between a line length (number of characters) and the maximum font
1133 ;; size which doesn't wrap such a line with the current ps-print setup.
1135 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
1136 ;; the correspondence between a number of pages and the maximum font
1137 ;; size which allow the number of lines of the current buffer or of
1138 ;; its current region to fit in this number of pages.
1140 ;; NOTE: line folding is not taken into account in this process and could
1141 ;; change the results.
1143 ;; The command `ps-print-customize' activates a customization buffer for
1144 ;; ps-print options.
1147 ;; New since version 1.5
1148 ;; ---------------------
1150 ;; Color output capability.
1151 ;; Automatic detection of font attributes (bold, italic).
1152 ;; Configurable headers with page numbers.
1153 ;; Slightly faster.
1154 ;; Support for different paper sizes.
1155 ;; Better conformance to PostScript Document Structure Conventions.
1158 ;; New since version 2.8
1159 ;; ---------------------
1161 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1163 ;; 20001122
1164 ;; `ps-line-number-font', `ps-line-number-font-size' and
1165 ;; `ps-end-with-control-d'.
1167 ;; 20000821
1168 ;; `ps-even-or-odd-pages'
1170 ;; 20000617
1171 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
1172 ;; `ps-selected-pages', `ps-last-selected-pages',
1173 ;; `ps-restore-selected-pages', `ps-switch-header',
1174 ;; `ps-line-number-step', `ps-line-number-start',
1175 ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
1177 ;; 20000310
1178 ;; PostScript error handler.
1179 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1181 ;; 19991211
1182 ;; `ps-print-customize'.
1184 ;; 19990703
1185 ;; Better customization.
1186 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1188 ;; 19990513
1189 ;; N-up printing.
1190 ;; Hook: `ps-print-begin-sheet-hook'.
1192 ;; [keinichi] 19990509 Kein'ichi Handa <handa@etl.go.jp>
1194 ;; `ps-print-region-function'
1196 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1198 ;; 19990301
1199 ;; PostScript tumble and setpagedevice.
1201 ;; 19980922
1202 ;; PostScript prologue header comment insertion.
1203 ;; Skip invisible text better.
1205 ;; [keinichi] 19980819 Kein'ichi Handa <handa@etl.go.jp>
1207 ;; Multi-byte buffer handling.
1209 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1211 ;; 19980306
1212 ;; Skip invisible text.
1214 ;; 19971130
1215 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1216 ;; `ps-print-begin-column-hook'.
1217 ;; Put one header per page over the columns.
1218 ;; Better database font management.
1219 ;; Better control characters handling.
1221 ;; 19971121
1222 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1223 ;; Handle control characters.
1224 ;; Face remapping.
1225 ;; New face attributes.
1226 ;; Line number.
1227 ;; Zebra stripes.
1228 ;; Text and/or image on background.
1230 ;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
1232 ;; Font family and float size for text and header.
1233 ;; Landscape mode.
1234 ;; Multiple columns.
1235 ;; Tools for page setup.
1238 ;; Known bugs and limitations of ps-print
1239 ;; --------------------------------------
1241 ;; Although color printing will work in XEmacs 19.12, it doesn't work
1242 ;; well; in particular, bold or italic fonts don't print in the right
1243 ;; background color.
1245 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1247 ;; Automatic font-attribute detection doesn't work well, especially
1248 ;; with hilit19 and older versions of get-create-face. Users having
1249 ;; problems with auto-font detection should use the lists
1250 ;; `ps-italic-faces', `ps-bold-faces' and `ps-underlined-faces' and/or
1251 ;; turn off automatic detection by setting `ps-auto-font-detect' to nil.
1253 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
1254 ;; in tty mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1255 ;; `ps-underlined-faces' instead.
1257 ;; Still too slow; could use some hand-optimization.
1259 ;; Default background color isn't working.
1261 ;; Faces are always treated as opaque.
1263 ;; Epoch and Emacs 19 not supported. At all.
1265 ;; Fixed-pitch fonts work better for line folding, but are not required.
1267 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
1268 ;; of folding lines.
1271 ;; Things to change
1272 ;; ----------------
1274 ;; Avoid page break inside a paragraph.
1275 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1276 ;; Improve the memory management for big files (hard?).
1277 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
1278 ;; of folding lines.
1281 ;; Acknowledgments
1282 ;; ---------------
1284 ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
1286 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
1287 ;; suggestion.
1289 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1290 ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1292 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1293 ;; suggestion for `ps-postscript-code-directory' variable.
1295 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1296 ;; level 1 compatibility.
1298 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for upside-down,
1299 ;; line number step, line number start and zebra stripe follow suggestions, and
1300 ;; for XEmacs beta-tests.
1302 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1303 ;; prologue code suggestion, for odd/even printing suggestion and for
1304 ;; `ps-prologue-file' enhancement.
1306 ;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
1308 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1309 ;; empty columns.
1311 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1312 ;; last page.
1314 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1315 ;; `ps-print-control-characters' variable documentation.
1317 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1318 ;; database font management.
1320 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1321 ;; header per page over the columns and correct line numbers when printing a
1322 ;; region.
1324 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1325 ;; print time of `ps-lpr-switches'.
1327 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1328 ;; (his code was severely modified, but the main idea was kept).
1330 ;; Thanks to some suggestions on:
1331 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1332 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1333 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1335 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
1336 ;; I started from. [vinicius]
1338 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
1339 ;; [jack]
1341 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
1342 ;; color and the invisible property.
1344 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
1345 ;; the initial port to Emacs 19. His code is no longer part of
1346 ;; ps-print, but his work is still appreciated.
1348 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
1349 ;; for adding underline support. Their code also is no longer part of
1350 ;; ps-print, but their efforts are not forgotten.
1352 ;; Thanks also to all of you who mailed code to add features to
1353 ;; ps-print; although I didn't use your code, I still appreciate your
1354 ;; sharing it with me.
1356 ;; Thanks to all who mailed comments, encouragement, and criticism.
1357 ;; Thanks also to all who responded to my survey; I had too many
1358 ;; responses to reply to them all, but I greatly appreciate your
1359 ;; interest.
1361 ;; Jim
1362 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1364 ;;; Code:
1366 (eval-and-compile
1367 (unless (featurep 'lisp-float-type)
1368 (error "`ps-print' requires floating point support"))
1371 ;; For Emacs 20.2 and the earlier version.
1373 (or (fboundp 'set-buffer-multibyte)
1374 (defun set-buffer-multibyte (arg)
1375 (setq enable-multibyte-characters arg)))
1377 (or (fboundp 'string-as-unibyte)
1378 (defun string-as-unibyte (arg) arg))
1380 (or (fboundp 'string-as-multibyte)
1381 (defun string-as-multibyte (arg) arg))
1383 (or (fboundp 'char-charset)
1384 (defun char-charset (arg) 'ascii))
1386 (or (fboundp 'charset-after)
1387 (defun charset-after (&optional arg)
1388 (char-charset (char-after arg))))
1391 ;; GNU Emacs
1392 (or (fboundp 'line-beginning-position)
1393 (defun line-beginning-position (&optional n)
1394 (save-excursion
1395 (and n (/= n 1) (forward-line (1- n)))
1396 (beginning-of-line)
1397 (point))))
1400 ;; to avoid compilation gripes
1402 ;; XEmacs
1403 (defalias 'ps-x-color-instance-p 'color-instance-p)
1404 (defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
1405 (defalias 'ps-x-color-name 'color-name)
1406 (defalias 'ps-x-color-specifier-p 'color-specifier-p)
1407 (defalias 'ps-x-copy-coding-system 'copy-coding-system)
1408 (defalias 'ps-x-device-class 'device-class)
1409 (defalias 'ps-x-extent-end-position 'extent-end-position)
1410 (defalias 'ps-x-extent-face 'extent-face)
1411 (defalias 'ps-x-extent-priority 'extent-priority)
1412 (defalias 'ps-x-extent-start-position 'extent-start-position)
1413 (defalias 'ps-x-face-font-instance 'face-font-instance)
1414 (defalias 'ps-x-find-coding-system 'find-coding-system)
1415 (defalias 'ps-x-font-instance-properties 'font-instance-properties)
1416 (defalias 'ps-x-make-color-instance 'make-color-instance)
1417 (defalias 'ps-x-map-extents 'map-extents)
1419 ;; GNU Emacs
1420 (defalias 'ps-e-face-bold-p 'face-bold-p)
1421 (defalias 'ps-e-face-italic-p 'face-italic-p)
1422 (defalias 'ps-e-next-overlay-change 'next-overlay-change)
1423 (defalias 'ps-e-overlays-at 'overlays-at)
1424 (defalias 'ps-e-overlay-get 'overlay-get)
1425 (defalias 'ps-e-x-color-values 'x-color-values)
1426 (defalias 'ps-e-color-values 'color-values)
1427 (if (fboundp 'find-composition)
1428 (defalias 'ps-e-find-composition 'find-composition)
1429 (defalias 'ps-e-find-composition 'ignore))
1432 (defconst ps-windows-system
1433 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
1434 (defconst ps-lp-system
1435 (memq system-type '(usq-unix-v dgux hpux irix))))
1438 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1439 ;; User Variables:
1442 ;;; Interface to the command system
1444 (defgroup postscript nil
1445 "PostScript Group"
1446 :tag "PostScript"
1447 :group 'emacs)
1449 (defgroup ps-print nil
1450 "PostScript generator for Emacs"
1451 :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
1452 :prefix "ps-"
1453 :group 'wp
1454 :group 'postscript)
1456 (defgroup ps-print-horizontal nil
1457 "Horizontal page layout"
1458 :prefix "ps-"
1459 :tag "Horizontal"
1460 :group 'ps-print)
1462 (defgroup ps-print-vertical nil
1463 "Vertical page layout"
1464 :prefix "ps-"
1465 :tag "Vertical"
1466 :group 'ps-print)
1468 (defgroup ps-print-headers nil
1469 "Headers layout"
1470 :prefix "ps-"
1471 :tag "Header"
1472 :group 'ps-print)
1474 (defgroup ps-print-font nil
1475 "Fonts customization"
1476 :prefix "ps-"
1477 :tag "Font"
1478 :group 'ps-print)
1480 (defgroup ps-print-color nil
1481 "Color customization"
1482 :prefix "ps-"
1483 :tag "Color"
1484 :group 'ps-print)
1486 (defgroup ps-print-face nil
1487 "Faces customization"
1488 :prefix "ps-"
1489 :tag "PS Faces"
1490 :group 'ps-print
1491 :group 'faces)
1493 (defgroup ps-print-n-up nil
1494 "N-up customization"
1495 :prefix "ps-"
1496 :tag "N-Up"
1497 :group 'ps-print)
1499 (defgroup ps-print-zebra nil
1500 "Zebra customization"
1501 :prefix "ps-"
1502 :tag "Zebra"
1503 :group 'ps-print)
1505 (defgroup ps-print-background nil
1506 "Background customization"
1507 :prefix "ps-"
1508 :tag "Background"
1509 :group 'ps-print)
1511 (defgroup ps-print-printer nil
1512 "Printer customization"
1513 :prefix "ps-"
1514 :tag "Printer"
1515 :group 'ps-print)
1517 (defgroup ps-print-page nil
1518 "Page customization"
1519 :prefix "ps-"
1520 :tag "Page"
1521 :group 'ps-print)
1523 (defgroup ps-print-miscellany nil
1524 "Miscellany customization"
1525 :prefix "ps-"
1526 :tag "Miscellany"
1527 :group 'ps-print)
1530 (defcustom ps-error-handler-message 'paper
1531 "*Specify where the error handler message should be sent.
1533 Valid values are:
1535 `none' catch the error and *DON'T* send any message.
1537 `paper' catch the error and print on paper the error message.
1539 `system' catch the error and send back the error message to
1540 printing system. This is useful only if printing system
1541 send back an email reporting the error, or if there is
1542 some other alternative way to report back the error from
1543 the system to you.
1545 `paper-and-system' catch the error, print on paper the error message and
1546 send back the error message to printing system.
1548 Any other value is treated as `paper'."
1549 :type '(choice :menu-tag "Error Handler Message"
1550 :tag "Error Handler Message"
1551 (const none) (const paper)
1552 (const system) (const paper-and-system))
1553 :group 'ps-print-miscellany)
1555 (defcustom ps-user-defined-prologue nil
1556 "*User defined PostScript prologue code inserted before all prologue code.
1558 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1559 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1560 prologue comments, and before ps-print PostScript prologue code section. That
1561 is, this string is inserted after error handler initialization and before
1562 ps-print settings.
1564 It's strongly recommended only insert PostScript code and/or comments specific
1565 for your printing system particularities. For example, some special
1566 initialization that only your printing system needs.
1568 Do not insert code for duplex printing, n-up printing or error handler, ps-print
1569 handles this in a suitable way.
1571 For more information about PostScript, see:
1572 PostScript Language Reference Manual (2nd edition)
1573 Adobe Systems Incorporated
1575 As an example for `ps-user-defined-prologue' setting:
1577 ;; Setting for HP PostScript printer
1578 (setq ps-user-defined-prologue
1579 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1580 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))
1582 :type '(choice :menu-tag "User Defined Prologue"
1583 :tag "User Defined Prologue"
1584 (const :tag "none" nil) string symbol)
1585 :group 'ps-print-miscellany)
1587 (defcustom ps-print-prologue-header nil
1588 "*PostScript prologue header comments besides that ps-print generates.
1590 `ps-print-prologue-header' may be a string or a symbol function which
1591 returns a string. Note that this string is inserted on PostScript prologue
1592 header section which is used to define some document characteristic through
1593 PostScript special comments, like \"%%Requirements: jog\\n\".
1595 ps-print always inserts the %%Requirements: comment, so if you need to insert
1596 more requirements put them first in `ps-print-prologue-header' using the
1597 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1598 requirements and set %%LanguageLevel: to 2, do:
1600 (setq ps-print-prologue-header
1601 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1603 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1605 Do not forget to terminate the string with \"\\n\".
1607 For more information about PostScript document comments, see:
1608 PostScript Language Reference Manual (2nd edition)
1609 Adobe Systems Incorporated
1610 Appendix G: Document Structuring Conventions -- Version 3.0"
1611 :type '(choice :menu-tag "Prologue Header"
1612 :tag "Prologue Header"
1613 (const :tag "none" nil) string symbol)
1614 :group 'ps-print-miscellany)
1616 (defcustom ps-printer-name (and (boundp 'printer-name)
1617 (symbol-value 'printer-name))
1618 "*The name of a local printer for printing PostScript files.
1620 On Unix-like systems, a string value should be a name understood by lpr's -P
1621 option; a value of nil means use the value of `printer-name' instead.
1623 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1624 printer device or port to which PostScript files are written, provided
1625 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1626 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1627 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
1628 for a shared network printer. You can also set it to a name of a file, in
1629 which case the output gets appended to that file. \(Note that `ps-print'
1630 package already has facilities for printing to a file, so you might as well use
1631 them instead of changing the setting of this variable.\) If you want to
1632 silently discard the printed output, set this to \"NUL\".
1634 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1636 Any other value is treated as t, that is, an empty printer name.
1638 See also `ps-printer-name-option' for documentation."
1639 :type '(choice :menu-tag "Printer Name"
1640 :tag "Printer Name"
1641 (const :tag "Same as printer-name" nil)
1642 (const :tag "No Printer Name" t)
1643 (file :tag "Print to file")
1644 (string :tag "Pipe to ps-lpr-command"))
1645 :group 'ps-print-printer)
1647 (defcustom ps-printer-name-option
1648 (cond (ps-windows-system
1649 "/D:")
1650 (ps-lp-system
1651 "-d")
1653 "-P" ))
1654 "*Option for `ps-printer-name' variable (see it).
1656 On Unix-like systems, if it's been used lpr utility, it should be the string
1657 \"-P\"; if it's been used lp utility, it should be the string \"-d\".
1659 On MS-DOS and MS-Windows systems, if it's been used print utility, it should be
1660 the string \"/D:\".
1662 For any other printing utility, see the proper manual or documentation.
1664 Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
1665 option printer name option.
1667 Any other value is treated as nil, that is, an empty printer name option.
1669 This variable is used only when `ps-printer-name' is a non-empty string."
1670 :type '(choice :menu-tag "Printer Name Option"
1671 :tag "Printer Name Option"
1672 (const :tag "None" nil)
1673 (string :tag "Option"))
1674 :version "21.1"
1675 :group 'ps-print-printer)
1677 (defcustom ps-lpr-command lpr-command
1678 "*Name of program for printing a PostScript file.
1680 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1681 will write directly to the printer port named by `ps-printer-name'. The
1682 programs `print' and `nprint' (the standard print programs on Windows NT and
1683 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1684 the destination for output; any other program is treated like `lpr' except that
1685 an explicit filename is given as the last argument."
1686 :type 'string
1687 :group 'ps-print-printer)
1689 (defcustom ps-lpr-switches lpr-switches
1690 "*A list of extra switches to pass to `ps-lpr-command'."
1691 :type '(repeat :tag "PostScript lpr Switches"
1692 (choice :menu-tag "PostScript lpr Switch"
1693 :tag "PostScript lpr Switch"
1694 string symbol (repeat sexp)))
1695 :group 'ps-print-printer)
1697 (defcustom ps-print-region-function nil
1698 "*Specify a function to print the region on a PostScript printer.
1699 See definition of `call-process-region' for calling conventions. The fourth and
1700 the sixth arguments are both nil."
1701 :type '(choice (const nil) function)
1702 :group 'ps-print-printer)
1704 (defcustom ps-manual-feed nil
1705 "*Non-nil means the printer will manually feed paper.
1707 If it's nil, automatic feeding takes place."
1708 :type 'boolean
1709 :group 'ps-print-printer)
1711 (defcustom ps-end-with-control-d (and ps-windows-system t)
1712 "*Non-nil means insert C-d at end of PostScript file generated."
1713 :version "21.1"
1714 :type 'boolean
1715 :group 'ps-print-printer)
1717 ;;; Page layout
1719 ;; All page dimensions are in PostScript points.
1720 ;; 1 inch == 2.54 cm == 72 points
1721 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1723 ;; Letter 8.5 inch x 11.0 inch
1724 ;; Legal 8.5 inch x 14.0 inch
1725 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1727 ;; LetterSmall 7.68 inch x 10.16 inch
1728 ;; Tabloid 11.0 inch x 17.0 inch
1729 ;; Ledger 17.0 inch x 11.0 inch
1730 ;; Statement 5.5 inch x 8.5 inch
1731 ;; Executive 7.5 inch x 10.0 inch
1732 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1733 ;; A4Small 7.47 inch x 10.85 inch
1734 ;; B4 10.125 inch x 14.33 inch
1735 ;; B5 7.16 inch x 10.125 inch
1737 (defcustom ps-page-dimensions-database
1738 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1739 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1740 (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
1741 (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
1742 (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
1743 (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
1744 (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
1745 (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
1746 (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
1747 (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
1748 (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
1749 (list 'b5 (* 72 7.16) (* 72 10.125) "B5"))
1750 "*List associating a symbolic paper type to its width, height and doc media.
1751 See `ps-paper-type'."
1752 :type '(repeat (list :tag "Paper Type"
1753 (symbol :tag "Name")
1754 (number :tag "Width")
1755 (number :tag "Height")
1756 (string :tag "Media")))
1757 :group 'ps-print-page)
1759 ;;;###autoload
1760 (defcustom ps-paper-type 'letter
1761 "*Specify the size of paper to format for.
1762 Should be one of the paper types defined in `ps-page-dimensions-database', for
1763 example `letter', `legal' or `a4'."
1764 :type '(symbol :validate (lambda (wid)
1765 (if (assq (widget-value wid)
1766 ps-page-dimensions-database)
1768 (widget-put wid :error "Unknown paper size")
1769 wid)))
1770 :group 'ps-print-page)
1772 (defcustom ps-warn-paper-type t
1773 "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1775 It's used when `ps-spool-config' is set to `setpagedevice'."
1776 :type 'boolean
1777 :group 'ps-print-page)
1779 (defcustom ps-landscape-mode nil
1780 "*Non-nil means print in landscape mode."
1781 :type 'boolean
1782 :group 'ps-print-page)
1784 (defcustom ps-print-upside-down nil
1785 "*Non-nil means print upside-down."
1786 :type 'boolean
1787 :group 'ps-print-page)
1789 (defcustom ps-selected-pages nil
1790 "*Specify which pages to print.
1792 If it's nil, all pages are printed.
1794 If it's a list, the list element may be an integer or a cons cell (FROM . TO)
1795 designating FROM page to TO page; any invalid element is ignored, that is, an
1796 integer lesser than one or if FROM is greater than TO.
1798 Otherwise, it's treated as nil.
1800 After ps-print processing `ps-selected-pages' is set to nil. But the latest
1801 `ps-selected-pages' is saved in `ps-last-selected-pages' (see it for
1802 documentation). So you can restore the latest selected pages by using
1803 `ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
1804 it for documentation).
1806 See also `ps-even-or-odd-pages'."
1807 :type '(repeat :tag "Selected Pages"
1808 (radio :tag "Page"
1809 (integer :tag "Number")
1810 (cons :tag "Range"
1811 (integer :tag "From")
1812 (integer :tag "To"))))
1813 :group 'ps-print-page)
1815 (defcustom ps-even-or-odd-pages nil
1816 "*Specify if it prints even/odd pages.
1818 Valid values are:
1820 nil print all pages.
1822 `even-page' print only even pages.
1824 `odd-page' print only odd pages.
1826 `even-sheet' print only even sheets.
1827 That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
1828 but for values greater than 1, it'll print only the even sheet
1829 of paper.
1831 `odd-sheet' print only odd sheets.
1832 That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
1833 but for values greater than 1, it'll print only the odd sheet
1834 of paper.
1836 Any other value is treated as nil.
1838 If you set `ps-selected-pages' (see it for documentation), first the pages are
1839 filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1840 example, if we have:
1842 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
1844 Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
1846 `ps-n-up-printing' = 1:
1847 `ps-even-or-odd-pages' PAGES PRINTED
1848 nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
1849 even-page 4, 6, 8, 10, 12, 14, 16, 20
1850 odd-page 1, 7, 9, 13, 15
1851 even-sheet 4, 6, 8, 10, 12, 14, 16, 20
1852 odd-sheet 1, 7, 9, 13, 15
1854 `ps-n-up-printing' = 2:
1855 `ps-even-or-odd-pages' PAGES PRINTED
1856 nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
1857 even-page 4/6, 8/10, 12/14, 16/20
1858 odd-page 1/7, 9/13, 15
1859 even-sheet 6/7, 10/12, 15/16
1860 odd-sheet 1/4, 8/9, 13/14, 20
1862 So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1863 sheet parity."
1864 :type '(choice :menu-tag "Print Even/Odd Pages"
1865 :tag "Print Even/Odd Pages"
1866 (const :tag "All Pages" nil)
1867 (const :tag "Only Even Pages" even-page)
1868 (const :tag "Only Odd Pages" odd-page)
1869 (const :tag "Only Even Sheets" even-sheet)
1870 (const :tag "Only Odd Sheets" odd-sheet))
1871 :group 'ps-print-page)
1873 (defcustom ps-print-control-characters 'control-8-bit
1874 "*Specify the printable form for control and 8-bit characters.
1875 That is, instead of sending, for example, a ^D (\\004) to printer,
1876 it is sent the string \"^D\".
1878 Valid values are:
1880 `8-bit' This is the value to use when you want an ASCII encoding of
1881 any control or non-ASCII character. Control characters are
1882 encoded as \"^D\", and non-ASCII characters have an
1883 octal encoding.
1885 `control-8-bit' This is the value to use when you want an ASCII encoding of
1886 any control character, whether it is 7 or 8-bit.
1887 European 8-bits accented characters are printed according
1888 the current font.
1890 `control' Only ASCII control characters have an ASCII encoding.
1891 European 8-bits accented characters are printed according
1892 the current font.
1894 nil No ASCII encoding. Any character is printed according the
1895 current font.
1897 Any other value is treated as nil."
1898 :type '(choice :menu-tag "Control Char"
1899 :tag "Control Char"
1900 (const 8-bit) (const control-8-bit)
1901 (const control) (const :tag "nil" nil))
1902 :group 'ps-print-miscellany)
1904 (defcustom ps-n-up-printing 1
1905 "*Specify the number of pages per sheet paper."
1906 :type '(integer
1907 :tag "N Up Printing"
1908 :validate
1909 (lambda (wid)
1910 (if (and (< 0 (widget-value wid))
1911 (<= (widget-value wid) 100))
1913 (widget-put
1914 wid :error
1915 "Number of pages per sheet paper must be between 1 and 100.")
1916 wid)))
1917 :group 'ps-print-n-up)
1919 (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
1920 "*Specify the margin in points between the sheet border and n-up printing."
1921 :type 'number
1922 :group 'ps-print-n-up)
1924 (defcustom ps-n-up-border-p t
1925 "*Non-nil means a border is drawn around each page."
1926 :type 'boolean
1927 :group 'ps-print-n-up)
1929 (defcustom ps-n-up-filling 'left-top
1930 "*Specify how page matrix is filled on each sheet of paper.
1932 Following are the valid values for `ps-n-up-filling' with a filling example
1933 using a 3x4 page matrix:
1935 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
1936 5 6 7 8 5 6 7 8
1937 9 10 11 12 1 2 3 4
1939 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
1940 8 7 6 5 8 7 6 5
1941 12 11 10 9 4 3 2 1
1943 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
1944 2 5 8 11 2 5 8 11
1945 3 6 9 12 1 4 7 10
1947 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
1948 11 8 5 2 11 8 5 2
1949 12 9 6 3 10 7 4 1
1951 Any other value is treated as `left-top'."
1952 :type '(choice :menu-tag "N-Up Filling"
1953 :tag "N-Up Filling"
1954 (const left-top) (const left-bottom)
1955 (const right-top) (const right-bottom)
1956 (const top-left) (const bottom-left)
1957 (const top-right) (const bottom-right))
1958 :group 'ps-print-n-up)
1960 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
1961 "*Specify the number of columns"
1962 :type 'number
1963 :group 'ps-print-miscellany)
1965 (defcustom ps-zebra-stripes nil
1966 "*Non-nil means print zebra stripes.
1967 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
1968 :type 'boolean
1969 :group 'ps-print-zebra)
1971 (defcustom ps-zebra-stripe-height 3
1972 "*Number of zebra stripe lines.
1973 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
1974 :type 'number
1975 :group 'ps-print-zebra)
1977 (defcustom ps-zebra-color 0.95
1978 "*Zebra stripe gray scale or RGB color.
1979 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
1980 :type '(choice :menu-tag "Zebra Gray/Color"
1981 :tag "Zebra Gray/Color"
1982 (number :tag "Gray Scale" :value 0.95)
1983 (string :tag "Color Name" :value "gray95")
1984 (list :tag "RGB Color" :value (0.95 0.95 0.95)
1985 (number :tag "Red")
1986 (number :tag "Green")
1987 (number :tag "Blue")))
1988 :group 'ps-print-zebra)
1990 (defcustom ps-zebra-stripe-follow nil
1991 "*Specify how zebra stripes continue on next page.
1993 Visually, valid values are (the character `+' at right of each column indicates
1994 that a line is printed):
1996 `nil' `follow' `full' `full-follow'
1997 Current Page -------- ----------- --------- ----------------
1998 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
1999 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
2000 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
2001 4 + 4 + 4 + 4 +
2002 5 + 5 + 5 + 5 +
2003 6 + 6 + 6 + 6 +
2004 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
2005 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
2006 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
2007 10 + 10 +
2008 11 + 11 +
2009 -------- ----------- --------- ----------------
2010 Next Page -------- ----------- --------- ----------------
2011 12 XXXXX + 12 + 10 XXXXXX + 10 +
2012 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
2013 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
2014 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
2015 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
2016 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
2017 18 XXXXX + 18 + 16 XXXXXX + 16 +
2018 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
2019 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
2020 21 + 21 XXXXXXXX +
2021 22 + 22 +
2022 -------- ----------- --------- ----------------
2024 Any other value is treated as `nil'."
2025 :type '(choice :menu-tag "Zebra Stripe Follow"
2026 :tag "Zebra Stripe Follow"
2027 (const :tag "Always Restart" nil)
2028 (const :tag "Continue on Next Page" follow)
2029 (const :tag "Print Only Full Stripe" full)
2030 (const :tag "Continue on Full Stripe" full-follow))
2031 :group 'ps-print-zebra)
2033 (defcustom ps-line-number nil
2034 "*Non-nil means print line number."
2035 :type 'boolean
2036 :group 'ps-print-miscellany)
2038 (defcustom ps-line-number-step 1
2039 "*Specify the interval that line number is printed.
2041 For example, `ps-line-number-step' is set to 2, the printing will look like:
2043 1 one line
2044 one line
2045 3 one line
2046 one line
2047 5 one line
2048 one line
2051 Valid values are:
2053 integer an integer that specifies the interval that line number is
2054 printed. If it's lesser than or equal to zero, it's used the
2055 value 1.
2057 `zebra' specifies that only the line number of the first line in a zebra
2058 stripe is to be printed.
2060 Any other value is treated as `zebra'."
2061 :type '(choice :menu-tag "Line Number Step"
2062 :tag "Line Number Step"
2063 (integer :tag "Step Interval")
2064 (const :tag "Synchronize Zebra" zebra))
2065 :group 'ps-print-miscellany)
2067 (defcustom ps-line-number-start 1
2068 "*Specify the starting point in the interval given by `ps-line-number-step'.
2070 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2071 set to 3, the printing will look like:
2073 one line
2074 one line
2075 3 one line
2076 one line
2077 one line
2078 6 one line
2079 one line
2080 one line
2081 9 one line
2082 one line
2085 The values for `ps-line-number-start':
2087 * If `ps-line-number-step' is an integer, must be between 1 and the value
2088 of `ps-line-number-step' inclusive.
2090 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
2091 value of `ps-zebra-strip-height' inclusive. Use this combination if you
2092 wish that line number be relative to zebra stripes."
2093 :type '(integer :tag "Start Step Interval")
2094 :group 'ps-print-miscellany)
2096 (defcustom ps-print-background-image nil
2097 "*EPS image list to be printed on background.
2099 The elements are:
2101 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2103 FILENAME is a file name which contains an EPS image or some PostScript
2104 programming like EPS.
2105 FILENAME is ignored, if it doesn't exist or is read protected.
2107 X and Y are relative positions on paper to put the image.
2108 If X and Y are nil, the image is centralized on paper.
2110 XSCALE and YSCALE are scale factor to be applied to image before printing.
2111 If XSCALE and YSCALE are nil, the original size is used.
2113 ROTATION is the image rotation angle; if nil, the default is 0.
2115 PAGES designates the page to print background image.
2116 PAGES may be a number or a cons cell (FROM . TO) designating FROM page
2117 to TO page.
2118 If PAGES is nil, print background image on all pages.
2120 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number,
2121 an integer number or a string. If it is a string, the string should contain
2122 PostScript programming that returns a float or integer value.
2124 For example, if you wish to print an EPS image on all pages do:
2126 '((\"~/images/EPS-image.ps\"))"
2127 :type '(repeat
2128 (list
2129 (file :tag "EPS File")
2130 (choice :tag "X" (const :tag "default" nil) number string)
2131 (choice :tag "Y" (const :tag "default" nil) number string)
2132 (choice :tag "X Scale" (const :tag "default" nil) number string)
2133 (choice :tag "Y Scale" (const :tag "default" nil) number string)
2134 (choice :tag "Rotation" (const :tag "default" nil) number string)
2135 (repeat :tag "Pages" :inline t
2136 (radio (integer :tag "Page")
2137 (cons :tag "Range"
2138 (integer :tag "From")
2139 (integer :tag "To"))))))
2140 :group 'ps-print-background)
2142 (defcustom ps-print-background-text nil
2143 "*Text list to be printed on background.
2145 The elements are:
2147 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2149 STRING is the text to be printed on background.
2151 X and Y are positions on paper to put the text.
2152 If X and Y are nil, the text is positioned at lower left corner.
2154 FONT is a font name to be used on printing the text.
2155 If nil, \"Times-Roman\" is used.
2157 FONTSIZE is font size to be used, if nil, 200 is used.
2159 GRAY is the text gray factor (should be very light like 0.8).
2160 If nil, the default is 0.85.
2162 ROTATION is the text rotation angle; if nil, the angle is given by
2163 the diagonal from lower left corner to upper right corner.
2165 PAGES designates the page to print background text.
2166 PAGES may be a number or a cons cell (FROM . TO) designating FROM page
2167 to TO page.
2168 If PAGES is nil, print background text on all pages.
2170 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number,
2171 an integer number or a string. If it is a string, the string should contain
2172 PostScript programming that returns a float or integer value.
2174 For example, if you wish to print text \"Preliminary\" on all pages do:
2176 '((\"Preliminary\"))"
2177 :type '(repeat
2178 (list
2179 (string :tag "Text")
2180 (choice :tag "X" (const :tag "default" nil) number string)
2181 (choice :tag "Y" (const :tag "default" nil) number string)
2182 (choice :tag "Font" (const :tag "default" nil) string)
2183 (choice :tag "Fontsize" (const :tag "default" nil) number string)
2184 (choice :tag "Gray" (const :tag "default" nil) number string)
2185 (choice :tag "Rotation" (const :tag "default" nil) number string)
2186 (repeat :tag "Pages" :inline t
2187 (radio (integer :tag "Page")
2188 (cons :tag "Range"
2189 (integer :tag "From")
2190 (integer :tag "To"))))))
2191 :group 'ps-print-background)
2193 ;;; Horizontal layout
2195 ;; ------------------------------------------
2196 ;; | | | | | | | |
2197 ;; | lm | text | ic | text | ic | text | rm |
2198 ;; | | | | | | | |
2199 ;; ------------------------------------------
2201 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
2202 "*Left margin in points (1/72 inch)."
2203 :type 'number
2204 :group 'ps-print-horizontal)
2206 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
2207 "*Right margin in points (1/72 inch)."
2208 :type 'number
2209 :group 'ps-print-horizontal)
2211 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
2212 "*Horizontal space between columns in points (1/72 inch)."
2213 :type 'number
2214 :group 'ps-print-horizontal)
2216 ;;; Vertical layout
2218 ;; |--------|
2219 ;; | tm |
2220 ;; |--------|
2221 ;; | header |
2222 ;; |--------|
2223 ;; | ho |
2224 ;; |--------|
2225 ;; | text |
2226 ;; |--------|
2227 ;; | bm |
2228 ;; |--------|
2230 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2231 "*Bottom margin in points (1/72 inch)."
2232 :type 'number
2233 :group 'ps-print-vertical)
2235 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2236 "*Top margin in points (1/72 inch)."
2237 :type 'number
2238 :group 'ps-print-vertical)
2240 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2241 "*Vertical space in points (1/72 inch) between the main text and the header."
2242 :type 'number
2243 :group 'ps-print-vertical)
2245 (defcustom ps-header-line-pad 0.15
2246 "*Portion of a header title line height to insert between the header frame
2247 and the text it contains, both in the vertical and horizontal directions."
2248 :type 'number
2249 :group 'ps-print-vertical)
2251 ;;; Header setup
2253 (defcustom ps-print-header t
2254 "*Non-nil means print a header at the top of each page.
2255 By default, the header displays the buffer name, page number, and, if
2256 the buffer is visiting a file, the file's directory. Headers are
2257 customizable by changing variables `ps-left-header' and
2258 `ps-right-header'."
2259 :type 'boolean
2260 :group 'ps-print-headers)
2262 (defcustom ps-print-only-one-header nil
2263 "*Non-nil means print only one header at the top of each page.
2264 This is useful when printing more than one column, so it is possible
2265 to have only one header over all columns or one header per column.
2266 See also `ps-print-header'."
2267 :type 'boolean
2268 :group 'ps-print-headers)
2270 (defcustom ps-print-header-frame t
2271 "*Non-nil means draw a gaudy frame around the header."
2272 :type 'boolean
2273 :group 'ps-print-headers)
2275 (defcustom ps-header-lines 2
2276 "*Number of lines to display in page header, when generating PostScript."
2277 :type 'integer
2278 :group 'ps-print-headers)
2280 (defcustom ps-switch-header 'duplex
2281 "*Specify if headers are switched or not.
2283 Valid values are:
2285 nil Never switch headers.
2287 t Always switch headers.
2289 duplex Switch headers only when duplexing is on, that is, when
2290 `ps-spool-duplex' is non-nil.
2292 Any other value is treated as t."
2293 :type '(choice :menu-tag "Switch Header"
2294 :tag "Switch Header"
2295 (const :tag "Never Switch" nil)
2296 (const :tag "Always Switch" t)
2297 (const :tag "Switch When Duplexing" duplex))
2298 :group 'ps-print-headers)
2300 (defcustom ps-show-n-of-n t
2301 "*Non-nil means show page numbers as N/M, meaning page N of M.
2302 NOTE: page numbers are displayed as part of headers,
2303 see variable `ps-print-header'."
2304 :type 'boolean
2305 :group 'ps-print-headers)
2307 (defcustom ps-spool-config
2308 (if ps-windows-system
2310 'lpr-switches)
2311 "*Specify who is responsable for setting duplex and page size switches.
2313 Valid values are:
2315 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2316 Don't forget to set `ps-lpr-switches' to select duplex
2317 printing for your printer.
2319 `setpagedevice' duplex and page size are configured by ps-print using the
2320 setpagedevice PostScript operator.
2322 nil duplex and page size are configured by ps-print *not* using
2323 the setpagedevice PostScript operator.
2325 Any other value is treated as nil.
2327 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2328 viewing file generated using landscape. Also on some printers,
2329 setpagedevice affects zebra stripes; on other printers, setpagedevice
2330 affects the left margin.
2331 Besides all that, if your printer does not have the paper size
2332 specified by setpagedevice, your printing will be aborted.
2333 So, if you need to use setpagedevice, set `ps-spool-config' to
2334 `setpagedevice', generate a test file and send it to your printer; if
2335 the printed file isn't ok, set `ps-spool-config' to nil."
2336 :type '(choice :menu-tag "Spool Config"
2337 :tag "Spool Config"
2338 (const lpr-switches) (const setpagedevice)
2339 (const :tag "nil" nil))
2340 :group 'ps-print-headers)
2342 (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
2343 ; so default to nil.
2344 "*Non-nil generates PostScript for a two-sided printer.
2345 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2346 blank pages as needed between print jobs so that the next buffer printed will
2347 start on the right page. Also, if headers are turned on, the headers will be
2348 reversed on duplex printers so that the page numbers fall to the left on
2349 even-numbered pages.
2351 See also `ps-spool-tumble'."
2352 :type 'boolean
2353 :group 'ps-print-headers)
2355 (defcustom ps-spool-tumble nil
2356 "*Specify how the page images on opposite sides of a sheet are oriented.
2357 If `ps-spool-tumble' is nil, produces output suitable for binding on the left or
2358 right. If `ps-spool-tumble' is non-nil, produces output suitable for binding at
2359 the top or bottom.
2361 It has effect only when `ps-spool-duplex' is non-nil."
2362 :type 'boolean
2363 :group 'ps-print-headers)
2365 ;;; Fonts
2367 (defcustom ps-font-info-database
2368 '((Courier ; the family key
2369 (fonts (normal . "Courier")
2370 (bold . "Courier-Bold")
2371 (italic . "Courier-Oblique")
2372 (bold-italic . "Courier-BoldOblique"))
2373 (size . 10.0)
2374 (line-height . 10.55)
2375 (space-width . 6.0)
2376 (avg-char-width . 6.0))
2377 (Helvetica ; the family key
2378 (fonts (normal . "Helvetica")
2379 (bold . "Helvetica-Bold")
2380 (italic . "Helvetica-Oblique")
2381 (bold-italic . "Helvetica-BoldOblique"))
2382 (size . 10.0)
2383 (line-height . 11.56)
2384 (space-width . 2.78)
2385 (avg-char-width . 5.09243))
2386 (Times
2387 (fonts (normal . "Times-Roman")
2388 (bold . "Times-Bold")
2389 (italic . "Times-Italic")
2390 (bold-italic . "Times-BoldItalic"))
2391 (size . 10.0)
2392 (line-height . 11.0)
2393 (space-width . 2.5)
2394 (avg-char-width . 4.71432))
2395 (Palatino
2396 (fonts (normal . "Palatino-Roman")
2397 (bold . "Palatino-Bold")
2398 (italic . "Palatino-Italic")
2399 (bold-italic . "Palatino-BoldItalic"))
2400 (size . 10.0)
2401 (line-height . 12.1)
2402 (space-width . 2.5)
2403 (avg-char-width . 5.08676))
2404 (Helvetica-Narrow
2405 (fonts (normal . "Helvetica-Narrow")
2406 (bold . "Helvetica-Narrow-Bold")
2407 (italic . "Helvetica-Narrow-Oblique")
2408 (bold-italic . "Helvetica-Narrow-BoldOblique"))
2409 (size . 10.0)
2410 (line-height . 11.56)
2411 (space-width . 2.2796)
2412 (avg-char-width . 4.17579))
2413 (NewCenturySchlbk
2414 (fonts (normal . "NewCenturySchlbk-Roman")
2415 (bold . "NewCenturySchlbk-Bold")
2416 (italic . "NewCenturySchlbk-Italic")
2417 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2418 (size . 10.0)
2419 (line-height . 12.15)
2420 (space-width . 2.78)
2421 (avg-char-width . 5.31162))
2422 ;; got no bold for the next ones
2423 (AvantGarde-Book
2424 (fonts (normal . "AvantGarde-Book")
2425 (italic . "AvantGarde-BookOblique"))
2426 (size . 10.0)
2427 (line-height . 11.77)
2428 (space-width . 2.77)
2429 (avg-char-width . 5.45189))
2430 (AvantGarde-Demi
2431 (fonts (normal . "AvantGarde-Demi")
2432 (italic . "AvantGarde-DemiOblique"))
2433 (size . 10.0)
2434 (line-height . 12.72)
2435 (space-width . 2.8)
2436 (avg-char-width . 5.51351))
2437 (Bookman-Demi
2438 (fonts (normal . "Bookman-Demi")
2439 (italic . "Bookman-DemiItalic"))
2440 (size . 10.0)
2441 (line-height . 11.77)
2442 (space-width . 3.4)
2443 (avg-char-width . 6.05946))
2444 (Bookman-Light
2445 (fonts (normal . "Bookman-Light")
2446 (italic . "Bookman-LightItalic"))
2447 (size . 10.0)
2448 (line-height . 11.79)
2449 (space-width . 3.2)
2450 (avg-char-width . 5.67027))
2451 ;; got no bold and no italic for the next ones
2452 (Symbol
2453 (fonts (normal . "Symbol"))
2454 (size . 10.0)
2455 (line-height . 13.03)
2456 (space-width . 2.5)
2457 (avg-char-width . 3.24324))
2458 (Zapf-Dingbats
2459 (fonts (normal . "Zapf-Dingbats"))
2460 (size . 10.0)
2461 (line-height . 9.63)
2462 (space-width . 2.78)
2463 (avg-char-width . 2.78))
2464 (Zapf-Chancery-MediumItalic
2465 (fonts (normal . "Zapf-Chancery-MediumItalic"))
2466 (size . 10.0)
2467 (line-height . 11.45)
2468 (space-width . 2.2)
2469 (avg-char-width . 4.10811))
2471 "*Font info database: font family (the key), name, bold, italic, bold-italic,
2472 reference size, line height, space width, average character width.
2473 To get the info for another specific font (say Helvetica), do the following:
2474 - create a new buffer
2475 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2476 - open this file and delete the leading `%' (which is the PostScript
2477 comment character) from the line
2478 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2479 to get the line
2480 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2481 - add the values to `ps-font-info-database'.
2482 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2484 Note also that ps-print DOESN'T download any font to your printer, instead
2485 it uses the fonts resident in your printer."
2486 :type '(repeat
2487 (list :tag "Font Definition"
2488 (symbol :tag "Font Family")
2489 (cons :format "%v"
2490 (const :format "" fonts)
2491 (repeat :tag "Faces"
2492 (cons (choice :menu-tag "Font Weight/Slant"
2493 :tag "Font Weight/Slant"
2494 (const normal)
2495 (const bold)
2496 (const italic)
2497 (const bold-italic)
2498 (symbol :tag "Face"))
2499 (string :tag "Font Name"))))
2500 (cons :format "%v"
2501 (const :format "" size)
2502 (number :tag "Reference Size"))
2503 (cons :format "%v"
2504 (const :format "" line-height)
2505 (number :tag "Line Height"))
2506 (cons :format "%v"
2507 (const :format "" space-width)
2508 (number :tag "Space Width"))
2509 (cons :format "%v"
2510 (const :format "" avg-char-width)
2511 (number :tag "Average Character Width"))))
2512 :group 'ps-print-font)
2514 (defcustom ps-font-family 'Courier
2515 "*Font family name for ordinary text, when generating PostScript."
2516 :type 'symbol
2517 :group 'ps-print-font)
2519 (defcustom ps-font-size '(7 . 8.5)
2520 "*Font size, in points, for ordinary text, when generating PostScript."
2521 :type '(choice :menu-tag "Ordinary Text Font Size"
2522 :tag "Ordinary Text Font Size"
2523 (number :tag "Text Size")
2524 (cons :tag "Landscape/Portrait"
2525 (number :tag "Landscape Text Size")
2526 (number :tag "Portrait Text Size")))
2527 :group 'ps-print-font)
2529 (defcustom ps-header-font-family 'Helvetica
2530 "*Font family name for text in the header, when generating PostScript."
2531 :type 'symbol
2532 :group 'ps-print-font)
2534 (defcustom ps-header-font-size '(10 . 12)
2535 "*Font size, in points, for text in the header, when generating PostScript."
2536 :type '(choice :menu-tag "Header Font Size"
2537 :tag "Header Font Size"
2538 (number :tag "Header Size")
2539 (cons :tag "Landscape/Portrait"
2540 (number :tag "Landscape Header Size")
2541 (number :tag "Portrait Header Size")))
2542 :group 'ps-print-font)
2544 (defcustom ps-header-title-font-size '(12 . 14)
2545 "*Font size, in points, for the top line of text in header, in PostScript."
2546 :type '(choice :menu-tag "Header Title Font Size"
2547 :tag "Header Title Font Size"
2548 (number :tag "Header Title Size")
2549 (cons :tag "Landscape/Portrait"
2550 (number :tag "Landscape Header Title Size")
2551 (number :tag "Portrait Header Title Size")))
2552 :group 'ps-print-font)
2554 (defcustom ps-line-number-font "Times-Italic"
2555 "*Font for line-number, when generating PostScript."
2556 :type 'string
2557 :group 'ps-print-font
2558 :group 'ps-print-miscellany)
2560 (defcustom ps-line-number-font-size 6
2561 "*Font size, in points, for line number, when generating PostScript."
2562 :type '(choice :menu-tag "Line Number Font Size"
2563 :tag "Line Number Font Size"
2564 (number :tag "Font Size")
2565 (cons :tag "Landscape/Portrait"
2566 (number :tag "Landscape Font Size")
2567 (number :tag "Portrait Font Size")))
2568 :group 'ps-print-font
2569 :group 'ps-print-miscellany)
2571 ;;; Colors
2573 ;; Printing color requires x-color-values.
2574 (defcustom ps-print-color-p
2575 (or (and (fboundp 'color-values) ; Emacs
2576 (ps-e-color-values "Green"))
2577 (fboundp 'x-color-values) ; Emacs
2578 (fboundp 'color-instance-rgb-components))
2579 ; XEmacs
2580 "*Non-nil means print the buffer's text in color."
2581 :type 'boolean
2582 :group 'ps-print-color)
2584 (defcustom ps-default-fg '(0.0 0.0 0.0)
2585 "*RGB values of the default foreground color. Defaults to black."
2586 :type '(choice :menu-tag "Default Foreground Gray/Color"
2587 :tag "Default Foreground Gray/Color"
2588 (number :tag "Gray Scale" :value 0.0)
2589 (string :tag "Color Name" :value "black")
2590 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2591 (number :tag "Red")
2592 (number :tag "Green")
2593 (number :tag "Blue")))
2594 :group 'ps-print-color)
2596 (defcustom ps-default-bg '(1.0 1.0 1.0)
2597 "*RGB values of the default background color. Defaults to white."
2598 :type '(choice :menu-tag "Default Background Gray/Color"
2599 :tag "Default Background Gray/Color"
2600 (number :tag "Gray Scale" :value 1.0)
2601 (string :tag "Color Name" :value "white")
2602 (list :tag "RGB Color" :value (1.0 1.0 1.0)
2603 (number :tag "Red")
2604 (number :tag "Green")
2605 (number :tag "Blue")))
2606 :group 'ps-print-color)
2608 (defcustom ps-auto-font-detect t
2609 "*Non-nil means automatically detect bold/italic/underline face attributes.
2610 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces',
2611 and `ps-underlined-faces'."
2612 :type 'boolean
2613 :group 'ps-print-font)
2615 (defcustom ps-bold-faces
2616 (unless ps-print-color-p
2617 '(font-lock-function-name-face
2618 font-lock-builtin-face
2619 font-lock-variable-name-face
2620 font-lock-keyword-face
2621 font-lock-warning-face))
2622 "*A list of the \(non-bold\) faces that should be printed in bold font.
2623 This applies to generating PostScript."
2624 :type '(repeat face)
2625 :group 'ps-print-face)
2627 (defcustom ps-italic-faces
2628 (unless ps-print-color-p
2629 '(font-lock-variable-name-face
2630 font-lock-type-face
2631 font-lock-string-face
2632 font-lock-comment-face
2633 font-lock-warning-face))
2634 "*A list of the \(non-italic\) faces that should be printed in italic font.
2635 This applies to generating PostScript."
2636 :type '(repeat face)
2637 :group 'ps-print-face)
2639 (defcustom ps-underlined-faces
2640 (unless ps-print-color-p
2641 '(font-lock-function-name-face
2642 font-lock-constant-face
2643 font-lock-warning-face))
2644 "*A list of the \(non-underlined\) faces that should be printed underlined.
2645 This applies to generating PostScript."
2646 :type '(repeat face)
2647 :group 'ps-print-face)
2649 (defcustom ps-use-face-background nil
2650 "*Specify if face background should be used.
2652 Valid values are:
2654 t always use face background color.
2655 nil never use face background color.
2656 (face...) list of faces whose background color will be used.
2658 Any other value will be treated as t."
2659 :type '(choice :menu-tag "Use Face Background"
2660 :tag "Use Face Background"
2661 (const :tag "Always Use Face Background" t)
2662 (const :tag "Never Use Face Background" nil)
2663 (repeat :menu-tag "Face Background List"
2664 :tag "Face Background List"
2665 face))
2666 :group 'ps-print-face)
2668 (defcustom ps-left-header
2669 (list 'ps-get-buffer-name 'ps-header-dirpart)
2670 "*The items to display (each on a line) on the left part of the page header.
2671 This applies to generating PostScript.
2673 The value should be a list of strings and symbols, each representing an
2674 entry in the PostScript array HeaderLinesLeft.
2676 Strings are inserted unchanged into the array; those representing
2677 PostScript string literals should be delimited with PostScript string
2678 delimiters '(' and ')'.
2680 For symbols with bound functions, the function is called and should
2681 return a string to be inserted into the array. For symbols with bound
2682 values, the value should be a string to be inserted into the array.
2683 In either case, function or variable, the string value has PostScript
2684 string delimiters added to it."
2685 :type '(repeat (choice :menu-tag "Left Header"
2686 :tag "Left Header"
2687 string symbol))
2688 :group 'ps-print-headers)
2690 (defcustom ps-right-header
2691 (list "/pagenumberstring load"
2692 'ps-time-stamp-mon-dd-yyyy 'ps-time-stamp-hh:mm:ss)
2693 "*The items to display (each on a line) on the right part of the page header.
2694 This applies to generating PostScript.
2696 See the variable `ps-left-header' for a description of the format of
2697 this variable."
2698 :type '(repeat (choice :menu-tag "Right Header"
2699 :tag "Right Header"
2700 string symbol))
2701 :group 'ps-print-headers)
2703 (defcustom ps-razzle-dazzle t
2704 "*Non-nil means report progress while formatting buffer."
2705 :type 'boolean
2706 :group 'ps-print-miscellany)
2708 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
2709 "*Contains the header line identifying the output as PostScript.
2710 By default, `ps-adobe-tag' contains the standard identifier. Some
2711 printers require slightly different versions of this line."
2712 :type 'string
2713 :group 'ps-print-miscellany)
2715 (defcustom ps-build-face-reference t
2716 "*Non-nil means build the reference face lists.
2718 ps-print sets this value to nil after it builds its internal reference
2719 lists of bold and italic faces. By settings its value back to t, you
2720 can force ps-print to rebuild the lists the next time you invoke one
2721 of the ...-with-faces commands.
2723 You should set this value back to t after you change the attributes of
2724 any face, or create new faces. Most users shouldn't have to worry
2725 about its setting, though."
2726 :type 'boolean
2727 :group 'ps-print-face)
2729 (defcustom ps-always-build-face-reference nil
2730 "*Non-nil means always rebuild the reference face lists.
2732 If this variable is non-nil, ps-print will rebuild its internal
2733 reference lists of bold and italic faces *every* time one of the
2734 ...-with-faces commands is called. Most users shouldn't need to set this
2735 variable."
2736 :type 'boolean
2737 :group 'ps-print-face)
2739 (defcustom ps-banner-page-when-duplexing nil
2740 "*Non-nil means the very first page is skipped.
2741 It's like the very first character of buffer (or region) is ^L (\\014)."
2742 :type 'boolean
2743 :group 'ps-print-headers)
2745 (defcustom ps-postscript-code-directory
2746 (or (and (fboundp 'locate-data-directory) ; xemacs
2747 (locate-data-directory "ps-print"))
2748 data-directory) ; emacs
2749 "*Directory where it's located the PostScript prologue file used by ps-print.
2750 By default, this directory is the same as in the variable `data-directory'."
2751 :type 'directory
2752 :group 'ps-print-miscellany)
2754 (defcustom ps-line-spacing 0
2755 "*Specify line spacing, in points, for ordinary text.
2757 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
2759 To get all lines with some spacing set both `ps-line-spacing' and
2760 `ps-paragraph-spacing' variables."
2761 :type '(choice :menu-tag "Line Spacing For Ordinary Text"
2762 :tag "Line Spacing For Ordinary Text"
2763 (number :tag "Line Spacing")
2764 (cons :tag "Landscape/Portrait"
2765 (number :tag "Landscape Line Spacing")
2766 (number :tag "Portrait Line Spacing")))
2767 :version "21.1"
2768 :group 'ps-print-miscellany)
2770 (defcustom ps-paragraph-spacing 0
2771 "*Specify paragraph spacing, in points, for ordinary text.
2773 See also `ps-line-spacing' and `ps-paragraph-regexp'.
2775 To get all lines with some spacing set both `ps-line-spacing' and
2776 `ps-paragraph-spacing' variables."
2777 :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text"
2778 :tag "Paragraph Spacing For Ordinary Text"
2779 (number :tag "Paragraph Spacing")
2780 (cons :tag "Landscape/Portrait"
2781 (number :tag "Landscape Paragraph Spacing")
2782 (number :tag "Portrait Paragraph Spacing")))
2783 :version "21.1"
2784 :group 'ps-print-miscellany)
2786 (defcustom ps-paragraph-regexp "[ \t]*$"
2787 "*Specify paragraph delimiter.
2789 It should be a regexp or nil.
2791 See also `ps-paragraph-spacing'."
2792 :type '(choice :menu-tag "Paragraph Delimiter"
2793 (const :tag "No Delimiter" nil)
2794 (regexp :tag "Delimiter Regexp"))
2795 :version "21.1"
2796 :group 'ps-print-miscellany)
2798 (defcustom ps-begin-cut-regexp nil
2799 "*Specify regexp which is start of a region to cut out when printing.
2801 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
2802 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
2803 some special printing instructions from the actual print. Special printing
2804 instructions may be appended to the end of the file just like any other
2805 buffer-local variables. See section \"Local Variables in Files\" on Emacs
2806 manual for more information.
2808 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
2809 actually gets printed. Both variables may be set to nil in which case no
2810 cutting occurs."
2811 :type 'regexp
2812 :version "21.1"
2813 :group 'ps-print-miscellany)
2815 (defcustom ps-end-cut-regexp nil
2816 "*Specify regexp which is end of the region to cut out when printing.
2818 See `ps-begin-cut-regexp' for more information."
2819 :type 'regexp
2820 :version "21.1"
2821 :group 'ps-print-miscellany)
2824 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2825 ;; Selected Pages
2828 (defvar ps-last-selected-pages nil
2829 "Latest `ps-selected-pages' value.")
2832 (defun ps-restore-selected-pages ()
2833 "Restore latest `ps-selected-pages' value."
2834 (interactive)
2835 (setq ps-selected-pages ps-last-selected-pages))
2838 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2839 ;; Customization
2842 ;;;###autoload
2843 (defun ps-print-customize ()
2844 "Customization of ps-print group."
2845 (interactive)
2846 (customize-group 'ps-print))
2849 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2850 ;; User commands
2853 ;;;###autoload
2854 (defun ps-print-buffer (&optional filename)
2855 "Generate and print a PostScript image of the buffer.
2857 Interactively, when you use a prefix argument (C-u), the command
2858 prompts the user for a file name, and saves the PostScript image
2859 in that file instead of sending it to the printer.
2861 Noninteractively, the argument FILENAME is treated as follows: if it
2862 is nil, send the image to the printer. If FILENAME is a string, save
2863 the PostScript image in a file with that name."
2864 (interactive (list (ps-print-preprint current-prefix-arg)))
2865 (ps-print-without-faces (point-min) (point-max) filename))
2868 ;;;###autoload
2869 (defun ps-print-buffer-with-faces (&optional filename)
2870 "Generate and print a PostScript image of the buffer.
2871 Like `ps-print-buffer', but includes font, color, and underline
2872 information in the generated image. This command works only if you
2873 are using a window system, so it has a way to determine color values."
2874 (interactive (list (ps-print-preprint current-prefix-arg)))
2875 (ps-print-with-faces (point-min) (point-max) filename))
2878 ;;;###autoload
2879 (defun ps-print-region (from to &optional filename)
2880 "Generate and print a PostScript image of the region.
2881 Like `ps-print-buffer', but prints just the current region."
2882 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
2883 (ps-print-without-faces from to filename t))
2886 ;;;###autoload
2887 (defun ps-print-region-with-faces (from to &optional filename)
2888 "Generate and print a PostScript image of the region.
2889 Like `ps-print-region', but includes font, color, and underline
2890 information in the generated image. This command works only if you
2891 are using a window system, so it has a way to determine color values."
2892 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
2893 (ps-print-with-faces from to filename t))
2896 ;;;###autoload
2897 (defun ps-spool-buffer ()
2898 "Generate and spool a PostScript image of the buffer.
2899 Like `ps-print-buffer' except that the PostScript image is saved in a
2900 local buffer to be sent to the printer later.
2902 Use the command `ps-despool' to send the spooled images to the printer."
2903 (interactive)
2904 (ps-spool-without-faces (point-min) (point-max)))
2907 ;;;###autoload
2908 (defun ps-spool-buffer-with-faces ()
2909 "Generate and spool a PostScript image of the buffer.
2910 Like `ps-spool-buffer', but includes font, color, and underline
2911 information in the generated image. This command works only if you
2912 are using a window system, so it has a way to determine color values.
2914 Use the command `ps-despool' to send the spooled images to the printer."
2915 (interactive)
2916 (ps-spool-with-faces (point-min) (point-max)))
2919 ;;;###autoload
2920 (defun ps-spool-region (from to)
2921 "Generate a PostScript image of the region and spool locally.
2922 Like `ps-spool-buffer', but spools just the current region.
2924 Use the command `ps-despool' to send the spooled images to the printer."
2925 (interactive "r")
2926 (ps-spool-without-faces from to t))
2929 ;;;###autoload
2930 (defun ps-spool-region-with-faces (from to)
2931 "Generate a PostScript image of the region and spool locally.
2932 Like `ps-spool-region', but includes font, color, and underline
2933 information in the generated image. This command works only if you
2934 are using a window system, so it has a way to determine color values.
2936 Use the command `ps-despool' to send the spooled images to the printer."
2937 (interactive "r")
2938 (ps-spool-with-faces from to t))
2940 ;;;###autoload
2941 (defun ps-despool (&optional filename)
2942 "Send the spooled PostScript to the printer.
2944 Interactively, when you use a prefix argument (C-u), the command
2945 prompts the user for a file name, and saves the spooled PostScript
2946 image in that file instead of sending it to the printer.
2948 Noninteractively, the argument FILENAME is treated as follows: if it
2949 is nil, send the image to the printer. If FILENAME is a string, save
2950 the PostScript image in a file with that name."
2951 (interactive (list (ps-print-preprint current-prefix-arg)))
2952 (ps-do-despool filename))
2954 ;;;###autoload
2955 (defun ps-line-lengths ()
2956 "Display the correspondence between a line length and a font size,
2957 using the current ps-print setup.
2958 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
2959 (interactive)
2960 (ps-line-lengths-internal))
2962 ;;;###autoload
2963 (defun ps-nb-pages-buffer (nb-lines)
2964 "Display number of pages to print this buffer, for various font heights.
2965 The table depends on the current ps-print setup."
2966 (interactive (list (count-lines (point-min) (point-max))))
2967 (ps-nb-pages nb-lines))
2969 ;;;###autoload
2970 (defun ps-nb-pages-region (nb-lines)
2971 "Display number of pages to print the region, for various font heights.
2972 The table depends on the current ps-print setup."
2973 (interactive (list (count-lines (mark) (point))))
2974 (ps-nb-pages nb-lines))
2976 ;;;###autoload
2977 (defun ps-setup ()
2978 "Return the current PostScript-generation setup."
2979 (format
2981 ;;; ps-print version %s
2983 \(setq ps-print-color-p %s
2984 ps-lpr-command %S
2985 ps-lpr-switches %s
2986 ps-printer-name %s
2987 ps-printer-name-option %s
2988 ps-print-region-function %s
2989 ps-manual-feed %S
2990 ps-end-with-control-d %S
2992 ps-paper-type %s
2993 ps-warn-paper-type %s
2994 ps-landscape-mode %s
2995 ps-print-upside-down %s
2996 ps-number-of-columns %s
2998 ps-zebra-stripes %s
2999 ps-zebra-stripe-height %s
3000 ps-zebra-stripe-follow %S
3001 ps-zebra-color %s
3002 ps-line-number %s
3003 ps-line-number-step %s
3004 ps-line-number-start %S
3006 ps-default-fg %s
3007 ps-default-bg %s
3008 ps-razzle-dazzle %S
3010 ps-use-face-background %s
3012 ps-print-control-characters %s
3014 ps-print-background-image %s
3016 ps-print-background-text %s
3018 ps-error-handler-message %s
3019 ps-user-defined-prologue %s
3020 ps-print-prologue-header %s
3021 ps-postscript-code-directory %S
3022 ps-adobe-tag %S
3024 ps-left-margin %s
3025 ps-right-margin %s
3026 ps-inter-column %s
3027 ps-bottom-margin %s
3028 ps-top-margin %s
3029 ps-header-offset %s
3030 ps-header-line-pad %s
3031 ps-print-header %s
3032 ps-print-only-one-header %s
3033 ps-print-header-frame %s
3034 ps-switch-header %s
3035 ps-header-lines %s
3036 ps-show-n-of-n %s
3037 ps-spool-config %s
3038 ps-spool-duplex %s
3039 ps-spool-tumble %s
3040 ps-banner-page-when-duplexing %s
3041 ps-left-header %s
3042 ps-right-header %s
3044 ps-n-up-printing %s
3045 ps-n-up-margin %s
3046 ps-n-up-border-p %s
3047 ps-n-up-filling %s
3049 ps-multibyte-buffer %s
3050 ps-font-family %s
3051 ps-font-size %s
3052 ps-header-font-family %s
3053 ps-header-font-size %s
3054 ps-header-title-font-size %s
3055 ps-line-number-font %s
3056 ps-line-number-font-size %s
3057 ps-line-spacing %s
3058 ps-paragraph-spacing %s
3059 ps-paragraph-regexp %s
3060 ps-begin-cut-regexp %s
3061 ps-end-cut-regexp %s
3063 ps-even-or-odd-pages %s
3064 ps-selected-pages %s
3065 ps-last-selected-pages %s
3067 ps-build-face-reference %S
3068 ps-always-build-face-reference %S
3070 ps-auto-font-detect %S
3071 ps-bold-faces %s
3072 ps-italic-faces %s
3073 ps-underlined-faces %s)
3075 ;; The following customized variables have long lists and are seldom modified:
3076 ;; ps-page-dimensions-database
3077 ;; ps-font-info-database
3079 ;;; ps-print - end of settings
3081 ps-print-version
3082 ps-print-color-p
3083 ps-lpr-command
3084 (ps-print-quote ps-lpr-switches)
3085 (ps-print-quote ps-printer-name)
3086 (ps-print-quote ps-printer-name-option)
3087 (ps-print-quote ps-print-region-function)
3088 ps-manual-feed
3089 ps-end-with-control-d
3090 (ps-print-quote ps-paper-type)
3091 ps-warn-paper-type
3092 ps-landscape-mode
3093 ps-print-upside-down
3094 ps-number-of-columns
3095 ps-zebra-stripes
3096 ps-zebra-stripe-height
3097 (ps-print-quote ps-zebra-stripe-follow)
3098 (ps-print-quote ps-zebra-color)
3099 ps-line-number
3100 (ps-print-quote ps-line-number-step)
3101 ps-line-number-start
3102 (ps-print-quote ps-default-fg)
3103 (ps-print-quote ps-default-bg)
3104 ps-razzle-dazzle
3105 (ps-print-quote ps-use-face-background)
3106 (ps-print-quote ps-print-control-characters)
3107 (ps-print-quote ps-print-background-image)
3108 (ps-print-quote ps-print-background-text)
3109 (ps-print-quote ps-error-handler-message)
3110 (ps-print-quote ps-user-defined-prologue)
3111 (ps-print-quote ps-print-prologue-header)
3112 ps-postscript-code-directory
3113 ps-adobe-tag
3114 ps-left-margin
3115 ps-right-margin
3116 ps-inter-column
3117 ps-bottom-margin
3118 ps-top-margin
3119 ps-header-offset
3120 ps-header-line-pad
3121 ps-print-header
3122 ps-print-only-one-header
3123 ps-print-header-frame
3124 (ps-print-quote ps-switch-header)
3125 ps-header-lines
3126 ps-show-n-of-n
3127 (ps-print-quote ps-spool-config)
3128 ps-spool-duplex
3129 ps-spool-tumble
3130 ps-banner-page-when-duplexing
3131 (ps-print-quote ps-left-header)
3132 (ps-print-quote ps-right-header)
3133 ps-n-up-printing
3134 ps-n-up-margin
3135 ps-n-up-border-p
3136 (ps-print-quote ps-n-up-filling)
3137 (ps-print-quote (symbol-value 'ps-multibyte-buffer)) ; see `ps-mule.el'
3138 (ps-print-quote ps-font-family)
3139 (ps-print-quote ps-font-size)
3140 (ps-print-quote ps-header-font-family)
3141 (ps-print-quote ps-header-font-size)
3142 (ps-print-quote ps-header-title-font-size)
3143 ps-line-number-font
3144 (ps-print-quote ps-line-number-font-size)
3145 (ps-print-quote ps-line-spacing)
3146 (ps-print-quote ps-paragraph-spacing)
3147 (ps-print-quote ps-paragraph-regexp)
3148 (ps-print-quote ps-begin-cut-regexp)
3149 (ps-print-quote ps-end-cut-regexp)
3150 (ps-print-quote ps-even-or-odd-pages)
3151 (ps-print-quote ps-selected-pages)
3152 (ps-print-quote ps-last-selected-pages)
3153 ps-build-face-reference
3154 ps-always-build-face-reference
3155 ps-auto-font-detect
3156 (ps-print-quote ps-bold-faces)
3157 (ps-print-quote ps-italic-faces)
3158 (ps-print-quote ps-underlined-faces)))
3161 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3162 ;; Utility functions and variables:
3165 (defun ps-time-stamp-mon-dd-yyyy ()
3166 (format-time-string "%b %d %Y"))
3169 (defun ps-time-stamp-hh:mm:ss ()
3170 (format-time-string "%T"))
3173 (defun ps-print-quote (sym)
3174 (cond ((null sym)
3175 nil)
3176 ((or (symbolp sym) (listp sym))
3177 (format "'%S" sym))
3178 ((stringp sym)
3179 (format "%S" sym))
3181 sym)))
3184 (eval-and-compile
3185 (defvar ps-print-emacs-type
3186 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
3187 ((string-match "Lucid" emacs-version) 'lucid)
3188 ((string-match "Epoch" emacs-version) 'epoch)
3189 (t 'emacs)))
3191 (if (memq ps-print-emacs-type '(lucid xemacs))
3192 (if (< emacs-minor-version 12)
3193 (setq ps-print-color-p nil))
3194 (require 'faces)) ; face-font, face-underline-p,
3195 ; x-font-regexp
3198 ;; Return t if the device (which can be changed during an emacs session)
3199 ;; can handle colors.
3200 ;; This function is not yet implemented for GNU emacs.
3201 (cond ((and (eq ps-print-emacs-type 'xemacs)
3202 (>= emacs-minor-version 12)) ; xemacs
3203 (defun ps-color-device ()
3204 (eq (ps-x-device-class) 'color)))
3206 (t ; emacs
3207 (defun ps-color-device ()
3208 (if (fboundp 'color-values)
3209 (ps-e-color-values "Green")
3210 t))))
3213 (defun ps-mapper (extent list)
3214 (nconc list
3215 (list (list (ps-x-extent-start-position extent) 'push extent)
3216 (list (ps-x-extent-end-position extent) 'pull extent)))
3217 nil)
3219 (defun ps-extent-sorter (a b)
3220 (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
3222 (defun ps-xemacs-face-kind-p (face kind kind-regex)
3223 (let* ((frame-font (or (ps-x-face-font-instance face)
3224 (ps-x-face-font-instance 'default)))
3225 (kind-cons
3226 (and frame-font
3227 (assq kind
3228 (ps-x-font-instance-properties frame-font))))
3229 (kind-spec (cdr-safe kind-cons))
3230 (case-fold-search t))
3231 (and kind-spec (string-match kind-regex kind-spec))))
3233 (defun ps-xemacs-color-name (color)
3234 (if (ps-x-color-specifier-p color)
3235 (ps-x-color-name color)
3236 color))
3238 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
3240 ;; to avoid XEmacs compilation gripes
3241 (defvar coding-system-for-write nil)
3243 (defun ps-color-values (x-color)
3244 (cond
3245 ((fboundp 'color-values)
3246 (ps-e-color-values x-color))
3247 ((fboundp 'x-color-values)
3248 (ps-e-x-color-values x-color))
3250 (error "No available function to determine X color values."))))
3252 (defalias 'ps-face-foreground-name 'face-foreground)
3253 (defalias 'ps-face-background-name 'face-background)
3255 (defun ps-face-bold-p (face)
3256 (or (ps-e-face-bold-p face)
3257 (memq face ps-bold-faces)))
3259 (defun ps-face-italic-p (face)
3260 (or (ps-e-face-italic-p face)
3261 (memq face ps-italic-faces)))
3263 ; xemacs
3264 ; lucid
3265 (t ; epoch
3267 (and (fboundp 'find-coding-system)
3268 (or (ps-x-find-coding-system 'raw-text-unix)
3269 (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))
3271 (defun ps-color-values (x-color)
3272 (let ((color (ps-xemacs-color-name x-color)))
3273 (cond
3274 ((fboundp 'x-color-values)
3275 (ps-e-x-color-values color))
3276 ((and (fboundp 'color-instance-rgb-components)
3277 (ps-color-device))
3278 (ps-x-color-instance-rgb-components
3279 (if (ps-x-color-instance-p x-color)
3280 x-color
3281 (ps-x-make-color-instance color))))
3283 (error "No available function to determine X color values.")))))
3285 (defun ps-face-foreground-name (face)
3286 (ps-xemacs-color-name (face-foreground face)))
3288 (defun ps-face-background-name (face)
3289 (ps-xemacs-color-name (face-background face)))
3291 (defun ps-face-bold-p (face)
3292 (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
3293 (memq face ps-bold-faces))) ; Kludge-compatible
3295 (defun ps-face-italic-p (face)
3296 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
3297 (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
3298 (memq face ps-italic-faces))) ; Kludge-compatible
3302 (defvar ps-print-color-scale 1.0)
3304 (defun ps-color-scale (color)
3305 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3306 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
3307 (ps-color-values color)))
3310 (defun ps-face-underlined-p (face)
3311 (or (face-underline-p face)
3312 (memq face ps-underlined-faces)))
3315 (defun ps-prologue-file (filenumber)
3316 "If prologue FILENUMBER exists and is readable, returns contents as string.
3318 Note: No major/minor-mode is activated and no local variables are evaluated for
3319 FILENUMBER, but proper EOL-conversion and character interpretation is
3320 done!"
3321 (let ((filename (convert-standard-filename
3322 (expand-file-name (format "ps-prin%d.ps" filenumber)
3323 ps-postscript-code-directory))))
3324 (if (and (file-exists-p filename)
3325 (file-readable-p filename))
3326 (with-temp-buffer
3327 (insert-file-contents filename)
3328 (buffer-string))
3329 (error "ps-print PostScript prologue `%s' file was not found."
3330 filename))))
3333 (defvar ps-mark-code-directory nil)
3335 (defvar ps-print-prologue-0 ""
3336 "ps-print PostScript error handler.")
3338 (defvar ps-print-prologue-1 ""
3339 "ps-print PostScript prologue.")
3341 ;; Start Editing Here:
3343 (defvar ps-source-buffer nil)
3344 (defvar ps-spool-buffer-name "*PostScript*")
3345 (defvar ps-spool-buffer nil)
3347 (defvar ps-output-head nil)
3348 (defvar ps-output-tail nil)
3350 (defvar ps-page-postscript 0) ; page number
3351 (defvar ps-page-order 0) ; PostScript page counter
3352 (defvar ps-page-sheet 0) ; sheet counter
3353 (defvar ps-page-column 0) ; column counter
3354 (defvar ps-page-printed 0) ; total pages printed
3355 (defvar ps-page-n-up 0) ; n-up counter
3356 (defvar ps-lines-printed 0) ; total lines printed
3357 (defvar ps-showline-count 1) ; line number counter
3358 (defvar ps-first-page nil)
3359 (defvar ps-last-page nil)
3360 (defvar ps-print-page-p t)
3362 (defvar ps-control-or-escape-regexp nil)
3363 (defvar ps-n-up-on nil)
3365 (defvar ps-background-pages nil)
3366 (defvar ps-background-all-pages nil)
3367 (defvar ps-background-text-count 0)
3368 (defvar ps-background-image-count 0)
3370 (defvar ps-current-font 0)
3371 (defvar ps-default-foreground nil)
3372 (defvar ps-default-color nil)
3373 (defvar ps-current-color nil)
3374 (defvar ps-current-bg nil)
3376 (defvar ps-zebra-stripe-full-p nil)
3377 (defvar ps-razchunk 0)
3379 (defvar ps-color-p nil)
3380 (defvar ps-color-format
3381 (if (eq ps-print-emacs-type 'emacs)
3383 ;; Emacs understands the %f format; we'll use it to limit color RGB
3384 ;; values to three decimals to cut down some on the size of the
3385 ;; PostScript output.
3386 "%0.3f %0.3f %0.3f"
3388 ;; Lucid emacsen will have to make do with %s (princ) for floats.
3389 "%s %s %s"))
3391 ;; These values determine how much print-height to deduct when headers
3392 ;; are turned on. This is a pretty clumsy way of handling it, but
3393 ;; it'll do for now.
3395 (defvar ps-header-pad 0
3396 "Vertical and horizontal space between the header frame and the text.
3397 This is in units of points (1/72 inch).")
3399 ;; Define accessors to the dimensions list.
3401 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3402 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
3403 (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
3405 (defvar ps-landscape-page-height nil)
3407 (defvar ps-print-width nil)
3408 (defvar ps-print-height nil)
3410 (defvar ps-height-remaining nil)
3411 (defvar ps-width-remaining nil)
3413 (defvar ps-font-size-internal nil)
3414 (defvar ps-header-font-size-internal nil)
3415 (defvar ps-header-title-font-size-internal nil)
3416 (defvar ps-line-spacing-internal nil)
3417 (defvar ps-paragraph-spacing-internal nil)
3420 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3421 ;; Internal Variables
3424 (defvar ps-print-face-extension-alist nil
3425 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
3426 An element of this list has the following form:
3428 (FACE . [BITS FG BG])
3430 FACE is a symbol denoting a face name
3431 BITS is a bit vector, where each bit correspond
3432 to a feature (bold, underline, etc)
3433 (see documentation for `ps-print-face-map-alist')
3434 FG foreground color (string or nil)
3435 BG background color (string or nil)
3437 Don't change this list directly; instead,
3438 use `ps-extend-face' and `ps-extend-face-list'.
3439 See documentation for `ps-extend-face' for valid extension symbol.")
3442 (defvar ps-print-face-alist nil
3443 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
3445 An element of this list has the same form as an element of
3446 `ps-print-face-extension-alist'.
3448 Don't change this list directly; this list is used by `ps-face-attributes',
3449 `ps-map-face' and `ps-build-reference-face-lists'.")
3452 (defconst ps-print-face-map-alist
3453 '((bold . 1)
3454 (italic . 2)
3455 (underline . 4)
3456 (strikeout . 8)
3457 (overline . 16)
3458 (shadow . 32)
3459 (box . 64)
3460 (outline . 128))
3461 "Alist of all features and the corresponding bit mask.
3462 Each symbol correspond to one bit in a bit vector.")
3465 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3466 ;; Remapping Faces
3469 ;;;###autoload
3470 (defun ps-extend-face-list (face-extension-list &optional merge-p)
3471 "Extend face in `ps-print-face-extension-alist'.
3473 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
3474 with face extension in `ps-print-face-extension-alist'; otherwise, overrides.
3476 The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
3478 See `ps-extend-face' for documentation."
3479 (while face-extension-list
3480 (ps-extend-face (car face-extension-list) merge-p)
3481 (setq face-extension-list (cdr face-extension-list))))
3484 ;;;###autoload
3485 (defun ps-extend-face (face-extension &optional merge-p)
3486 "Extend face in `ps-print-face-extension-alist'.
3488 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
3489 with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
3491 The elements of FACE-EXTENSION list have the form:
3493 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
3495 FACE-NAME is a face name symbol.
3497 FOREGROUND and BACKGROUND may be nil or a string that denotes the
3498 foreground and background colors respectively.
3500 EXTENSION is one of the following symbols:
3501 bold - use bold font.
3502 italic - use italic font.
3503 underline - put a line under text.
3504 strikeout - like underline, but the line is in middle of text.
3505 overline - like underline, but the line is over the text.
3506 shadow - text will have a shadow.
3507 box - text will be surrounded by a box.
3508 outline - print characters as hollow outlines.
3510 If EXTENSION is any other symbol, it is ignored."
3511 (let* ((face-name (nth 0 face-extension))
3512 (foreground (nth 1 face-extension))
3513 (background (nth 2 face-extension))
3514 (ps-face (cdr (assq face-name ps-print-face-extension-alist)))
3515 (face-vector (or ps-face (vector 0 nil nil)))
3516 (face-bit (ps-extension-bit face-extension)))
3517 ;; extend face
3518 (aset face-vector 0 (if merge-p
3519 (logior (aref face-vector 0) face-bit)
3520 face-bit))
3521 (and foreground (stringp foreground) (aset face-vector 1 foreground))
3522 (and background (stringp background) (aset face-vector 2 background))
3523 ;; if face does not exist, insert it
3524 (or ps-face
3525 (setq ps-print-face-extension-alist
3526 (cons (cons face-name face-vector)
3527 ps-print-face-extension-alist)))))
3530 (defun ps-extension-bit (face-extension)
3531 (let ((face-bit 0))
3532 ;; map valid symbol extension to bit vector
3533 (setq face-extension (cdr (cdr face-extension)))
3534 (while (setq face-extension (cdr face-extension))
3535 (setq face-bit (logior face-bit
3536 (or (cdr (assq (car face-extension)
3537 ps-print-face-map-alist))
3538 0))))
3539 face-bit))
3542 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3543 ;; Adapted from font-lock: (obsolete stuff)
3544 ;; Originally face attributes were specified via `font-lock-face-attributes'.
3545 ;; Users then changed the default face attributes by setting that variable.
3546 ;; However, we try and be back-compatible and respect its value if set except
3547 ;; for faces where M-x customize has been used to save changes for the face.
3550 (defun ps-font-lock-face-attributes ()
3551 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
3552 (boundp 'font-lock-face-attributes)
3553 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
3554 (while face-attributes
3555 (let* ((face-attribute
3556 (car (prog1 face-attributes
3557 (setq face-attributes (cdr face-attributes)))))
3558 (face (car face-attribute)))
3559 ;; Rustle up a `defface' SPEC from a
3560 ;; `font-lock-face-attributes' entry.
3561 (unless (get face 'saved-face)
3562 (let ((foreground (nth 1 face-attribute))
3563 (background (nth 2 face-attribute))
3564 (bold-p (nth 3 face-attribute))
3565 (italic-p (nth 4 face-attribute))
3566 (underline-p (nth 5 face-attribute))
3567 face-spec)
3568 (when foreground
3569 (setq face-spec (cons ':foreground
3570 (cons foreground face-spec))))
3571 (when background
3572 (setq face-spec (cons ':background
3573 (cons background face-spec))))
3574 (when bold-p
3575 (setq face-spec (append '(:bold t) face-spec)))
3576 (when italic-p
3577 (setq face-spec (append '(:italic t) face-spec)))
3578 (when underline-p
3579 (setq face-spec (append '(:underline t) face-spec)))
3580 (custom-declare-face face (list (list t face-spec)) nil)
3581 )))))))
3584 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3585 ;; Internal functions and variables
3588 (defvar ps-print-hook nil)
3589 (defvar ps-print-begin-sheet-hook nil)
3590 (defvar ps-print-begin-page-hook nil)
3591 (defvar ps-print-begin-column-hook nil)
3594 (defun ps-print-without-faces (from to &optional filename region-p)
3595 (ps-spool-without-faces from to region-p)
3596 (ps-do-despool filename))
3599 (defun ps-spool-without-faces (from to &optional region-p)
3600 (run-hooks 'ps-print-hook)
3601 (ps-printing-region region-p from)
3602 (ps-generate (current-buffer) from to 'ps-generate-postscript))
3605 (defun ps-print-with-faces (from to &optional filename region-p)
3606 (ps-spool-with-faces from to region-p)
3607 (ps-do-despool filename))
3610 (defun ps-spool-with-faces (from to &optional region-p)
3611 (run-hooks 'ps-print-hook)
3612 (ps-printing-region region-p from)
3613 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
3616 (defun ps-count-lines (from to)
3617 (+ (count-lines from to)
3618 (save-excursion
3619 (goto-char to)
3620 (if (= (current-column) 0) 1 0))))
3623 (defvar ps-printing-region nil
3624 "Variable used to indicate if the region that ps-print is printing.
3625 It is a cons, the car of which is the line number where the region begins, and
3626 its cdr is the total number of lines in the buffer. Formatting functions can
3627 use this information to print the original line number (and not the number of
3628 lines printed), and to indicate in the header that the printout is of a partial
3629 file.")
3632 (defvar ps-printing-region-p nil
3633 "Non-nil means ps-print is printing a region.")
3636 (defun ps-printing-region (region-p from)
3637 (setq ps-printing-region-p region-p
3638 ps-printing-region
3639 (cons (if region-p
3640 (ps-count-lines (point-min) from)
3642 (ps-count-lines (point-min) (point-max)))))
3645 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3646 ;; Internal functions
3649 (defsubst ps-font-alist (font-sym)
3650 (get font-sym 'fonts))
3652 (defun ps-font (font-sym font-type)
3653 "Font family name for text of `font-type', when generating PostScript."
3654 (let* ((font-list (ps-font-alist font-sym))
3655 (normal-font (cdr (assq 'normal font-list))))
3656 (while (and font-list (not (eq font-type (car (car font-list)))))
3657 (setq font-list (cdr font-list)))
3658 (or (cdr (car font-list)) normal-font)))
3660 (defun ps-fonts (font-sym)
3661 (mapcar 'cdr (ps-font-alist font-sym)))
3663 (defun ps-font-number (font-sym font-type)
3664 (or (ps-alist-position font-type (ps-font-alist font-sym))
3667 (defsubst ps-line-height (font-sym)
3668 "The height of a line, for generating PostScript.
3669 This is the value that ps-print uses to determine the height,
3670 y-dimension, of the lines of text it has printed, and thus affects the
3671 point at which page-breaks are placed.
3672 The line-height is *not* the same as the point size of the font."
3673 (get font-sym 'line-height))
3675 (defsubst ps-title-line-height (font-sym)
3676 "The height of a `title' line, for generating PostScript.
3677 This is the value that ps-print uses to determine the height,
3678 y-dimension, of the lines of text it has printed, and thus affects the
3679 point at which page-breaks are placed.
3680 The title-line-height is *not* the same as the point size of the font."
3681 (get font-sym 'title-line-height))
3683 (defsubst ps-space-width (font-sym)
3684 "The width of a space character, for generating PostScript.
3685 This value is used in expanding tab characters."
3686 (get font-sym 'space-width))
3688 (defsubst ps-avg-char-width (font-sym)
3689 "The average width, in points, of a character, for generating PostScript.
3690 This is the value that ps-print uses to determine the length,
3691 x-dimension, of the text it has printed, and thus affects the point at
3692 which long lines wrap around."
3693 (get font-sym 'avg-char-width))
3695 (defun ps-line-lengths-internal ()
3696 "Display the correspondence between a line length and a font size,
3697 using the current ps-print setup.
3698 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3699 (let* ((ps-font-size-internal
3700 (or ps-font-size-internal
3701 (ps-get-font-size 'ps-font-size)))
3702 (ps-header-font-size-internal
3703 (or ps-header-font-size-internal
3704 (ps-get-font-size 'ps-header-font-size)))
3705 (ps-header-title-font-size-internal
3706 (or ps-header-title-font-size-internal
3707 (ps-get-font-size 'ps-header-title-font-size)))
3708 (buf (get-buffer-create "*Line-lengths*"))
3709 (ifs ps-font-size-internal) ; initial font size
3710 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
3711 (print-width (progn (ps-get-page-dimensions)
3712 ps-print-width))
3713 (ps-setup (ps-setup)) ; setup for the current buffer
3714 (fs-min 5) ; minimum font size
3715 cw-min ; minimum character width
3716 nb-cpl-max ; maximum nb of characters per line
3717 (fs-max 14) ; maximum font size
3718 cw-max ; maximum character width
3719 nb-cpl-min ; minimum nb of characters per line
3720 fs ; current font size
3721 cw ; current character width
3722 nb-cpl ; current nb of characters per line
3724 (setq cw-min (/ (* icw fs-min) ifs)
3725 nb-cpl-max (floor (/ print-width cw-min))
3726 cw-max (/ (* icw fs-max) ifs)
3727 nb-cpl-min (floor (/ print-width cw-max))
3728 nb-cpl nb-cpl-min)
3729 (set-buffer buf)
3730 (goto-char (point-max))
3731 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
3732 (insert ps-setup
3733 "\nnb char per line / font size\n")
3734 (while (<= nb-cpl nb-cpl-max)
3735 (setq cw (/ print-width (float nb-cpl))
3736 fs (/ (* ifs cw) icw))
3737 (insert (format "%16d %s\n" nb-cpl fs))
3738 (setq nb-cpl (1+ nb-cpl)))
3739 (insert "\n")
3740 (display-buffer buf 'not-this-window)))
3742 (defun ps-nb-pages (nb-lines)
3743 "Display correspondence between font size and the number of pages.
3744 The correspondence is based on having NB-LINES lines of text,
3745 and on the current ps-print setup."
3746 (let* ((ps-font-size-internal
3747 (or ps-font-size-internal
3748 (ps-get-font-size 'ps-font-size)))
3749 (ps-header-font-size-internal
3750 (or ps-header-font-size-internal
3751 (ps-get-font-size 'ps-header-font-size)))
3752 (ps-header-title-font-size-internal
3753 (or ps-header-title-font-size-internal
3754 (ps-get-font-size 'ps-header-title-font-size)))
3755 (ps-line-spacing-internal
3756 (or ps-line-spacing-internal
3757 (ps-get-size ps-line-spacing "line spacing")))
3758 (buf (get-buffer-create "*Nb-Pages*"))
3759 (ils ps-line-spacing-internal) ; initial line spacing
3760 (ifs ps-font-size-internal) ; initial font size
3761 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
3762 (page-height (progn (ps-get-page-dimensions)
3763 ps-print-height))
3764 (ps-setup (ps-setup)) ; setup for the current buffer
3765 (fs-min 4) ; minimum font size
3766 lh-min ; minimum line height
3767 nb-lpp-max ; maximum nb of lines per page
3768 nb-page-min ; minimum nb of pages
3769 (fs-max 14) ; maximum font size
3770 lh-max ; maximum line height
3771 nb-lpp-min ; minimum nb of lines per page
3772 nb-page-max ; maximum nb of pages
3773 fs ; current font size
3774 lh ; current line height
3775 nb-lpp ; current nb of lines per page
3776 nb-page ; current nb of pages
3778 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
3779 nb-lpp-max (floor (/ page-height lh-min))
3780 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
3781 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
3782 nb-lpp-min (floor (/ page-height lh-max))
3783 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
3784 nb-page nb-page-min)
3785 (set-buffer buf)
3786 (goto-char (point-max))
3787 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
3788 (insert ps-setup
3789 (format "\nThere are %d lines.\n\n" nb-lines)
3790 "nb page / font size\n")
3791 (while (<= nb-page nb-page-max)
3792 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
3793 lh (/ page-height nb-lpp)
3794 fs (/ (* ifs lh) ilh))
3795 (insert (format "%7d %s\n" nb-page fs))
3796 (setq nb-page (1+ nb-page)))
3797 (insert "\n")
3798 (display-buffer buf 'not-this-window)))
3800 ;; macros used in `ps-select-font'
3801 (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
3802 (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
3804 (defun ps-select-font (font-family sym font-size title-font-size)
3805 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
3806 (or font-entry
3807 (error "Don't have data to scale font %s. Known fonts families are %s"
3808 font-family
3809 (mapcar 'car ps-font-info-database)))
3810 (let ((size (ps-lookup 'size)))
3811 (put sym 'fonts (ps-lookup 'fonts))
3812 (put sym 'space-width (ps-size-scale 'space-width))
3813 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
3814 (put sym 'line-height (ps-size-scale 'line-height))
3815 (put sym 'title-line-height
3816 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
3818 (defun ps-get-page-dimensions ()
3819 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
3820 page-width page-height)
3821 (cond
3822 ((null page-dimensions)
3823 (error "`ps-paper-type' must be one of:\n%s"
3824 (mapcar 'car ps-page-dimensions-database)))
3825 ((< ps-number-of-columns 1)
3826 (error "The number of columns %d should be positive"
3827 ps-number-of-columns)))
3829 (ps-select-font ps-font-family 'ps-font-for-text
3830 ps-font-size-internal ps-font-size-internal)
3831 (ps-select-font ps-header-font-family 'ps-font-for-header
3832 ps-header-font-size-internal
3833 ps-header-title-font-size-internal)
3835 (setq page-width (ps-page-dimensions-get-width page-dimensions)
3836 page-height (ps-page-dimensions-get-height page-dimensions))
3838 ;; Landscape mode
3839 (if ps-landscape-mode
3840 ;; exchange width and height
3841 (setq page-width (prog1 page-height (setq page-height page-width))))
3843 ;; It is used to get the lower right corner (only in landscape mode)
3844 (setq ps-landscape-page-height page-height)
3846 ;; | lm | text | ic | text | ic | text | rm |
3847 ;; page-width == lm + n * pw + (n - 1) * ic + rm
3848 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
3849 (setq ps-print-width (/ (- page-width
3850 ps-left-margin ps-right-margin
3851 (* (1- ps-number-of-columns) ps-inter-column))
3852 ps-number-of-columns))
3853 (if (<= ps-print-width 0)
3854 (error "Bad horizontal layout:
3855 page-width == %s
3856 ps-left-margin == %s
3857 ps-right-margin == %s
3858 ps-inter-column == %s
3859 ps-number-of-columns == %s
3860 | lm | text | ic | text | ic | text | rm |
3861 page-width == lm + n * print-width + (n - 1) * ic + rm
3862 => print-width == %d !"
3863 page-width
3864 ps-left-margin
3865 ps-right-margin
3866 ps-inter-column
3867 ps-number-of-columns
3868 ps-print-width))
3870 (setq ps-print-height
3871 (- page-height ps-bottom-margin ps-top-margin))
3872 (if (<= ps-print-height 0)
3873 (error "Bad vertical layout:
3874 ps-top-margin == %s
3875 ps-bottom-margin == %s
3876 page-height == bm + print-height + tm
3877 => print-height == %d !"
3878 ps-top-margin
3879 ps-bottom-margin
3880 ps-print-height))
3881 ;; If headers are turned on, deduct the height of the header from
3882 ;; the print height.
3883 (if ps-print-header
3884 (setq ps-header-pad (* ps-header-line-pad
3885 (ps-title-line-height 'ps-font-for-header))
3886 ps-print-height (- ps-print-height
3887 ps-header-offset
3888 ps-header-pad
3889 (ps-title-line-height 'ps-font-for-header)
3890 (* (ps-line-height 'ps-font-for-header)
3891 (1- ps-header-lines))
3892 ps-header-pad)))
3893 (if (<= ps-print-height 0)
3894 (error "Bad vertical layout:
3895 ps-top-margin == %s
3896 ps-bottom-margin == %s
3897 ps-header-offset == %s
3898 ps-header-pad == %s
3899 header-height == %s
3900 page-height == bm + print-height + tm - ho - hh
3901 => print-height == %d !"
3902 ps-top-margin
3903 ps-bottom-margin
3904 ps-header-offset
3905 ps-header-pad
3906 (+ ps-header-pad
3907 (ps-title-line-height 'ps-font-for-header)
3908 (* (ps-line-height 'ps-font-for-header)
3909 (1- ps-header-lines))
3910 ps-header-pad)
3911 ps-print-height))
3912 ;; ps-zebra-stripe-follow is `full' or `full-follow'
3913 (if ps-zebra-stripe-full-p
3914 (let* ((line-height (ps-line-height 'ps-font-for-text))
3915 (zebra (* (+ line-height ps-line-spacing-internal)
3916 ps-zebra-stripe-height)))
3917 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
3918 line-height))
3919 (if (<= ps-print-height 0)
3920 (error "Bad vertical layout:
3921 ps-zebra-stripe-follow == %s
3922 ps-zebra-stripe-height == %s
3923 font-text-height == %s
3924 line-spacing == %s
3925 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
3926 => print-height == %d !"
3927 ps-zebra-stripe-follow
3928 ps-zebra-stripe-height
3929 (ps-line-height 'ps-font-for-text)
3930 ps-line-spacing-internal
3931 ps-print-height))))))
3933 (defun ps-print-preprint (prefix-arg)
3934 (and prefix-arg
3935 (or (numberp prefix-arg)
3936 (listp prefix-arg))
3937 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
3938 (buffer-name)))
3939 ".ps"))
3940 (prompt (format "Save PostScript to file: (default %s) " name))
3941 (res (read-file-name prompt default-directory name nil)))
3942 (while (cond ((file-directory-p res)
3943 (ding)
3944 (setq prompt "It's a directory"))
3945 ((not (file-writable-p res))
3946 (ding)
3947 (setq prompt "File is unwritable"))
3948 ((file-exists-p res)
3949 (setq prompt "File exists")
3950 (not (y-or-n-p (format "File `%s' exists; overwrite? "
3951 res))))
3952 (t nil))
3953 (setq res (read-file-name
3954 (format "%s; save PostScript to file: " prompt)
3955 (file-name-directory res) nil nil
3956 (file-name-nondirectory res))))
3957 (if (file-directory-p res)
3958 (expand-file-name name (file-name-as-directory res))
3959 res))))
3961 ;; The following functions implement a simple list-buffering scheme so
3962 ;; that ps-print doesn't have to repeatedly switch between buffers
3963 ;; while spooling. The functions `ps-output' and `ps-output-string' build
3964 ;; up the lists; the function `ps-flush-output' takes the lists and
3965 ;; insert its contents into the spool buffer (*PostScript*).
3967 (defvar ps-string-escape-codes
3968 (let ((table (make-vector 256 nil))
3969 (char ?\000))
3970 ;; control characters
3971 (while (<= char ?\037)
3972 (aset table char (format "\\%03o" char))
3973 (setq char (1+ char)))
3974 ;; printable characters
3975 (while (< char ?\177)
3976 (aset table char (format "%c" char))
3977 (setq char (1+ char)))
3978 ;; DEL and 8-bit characters
3979 (while (<= char ?\377)
3980 (aset table char (format "\\%o" char))
3981 (setq char (1+ char)))
3982 ;; Override ASCII formatting characters with named escape code:
3983 (aset table ?\n "\\n") ; [NL] linefeed
3984 (aset table ?\r "\\r") ; [CR] carriage return
3985 (aset table ?\t "\\t") ; [HT] horizontal tab
3986 (aset table ?\b "\\b") ; [BS] backspace
3987 (aset table ?\f "\\f") ; [NP] form feed
3988 ;; Escape PostScript escape and string delimiter characters:
3989 (aset table ?\\ "\\\\")
3990 (aset table ?\( "\\(")
3991 (aset table ?\) "\\)")
3992 table)
3993 "Vector used to map characters to PostScript string escape codes.")
3995 (defsubst ps-output-string-prim (string)
3996 (insert "(") ;insert start-string delimiter
3997 (save-excursion ;insert string
3998 (insert (string-as-unibyte string)))
3999 ;; Find and quote special characters as necessary for PS
4000 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4001 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4002 (let ((special (following-char)))
4003 (delete-char 1)
4004 (insert (aref ps-string-escape-codes special))))
4005 (goto-char (point-max))
4006 (insert ")")) ;insert end-string delimiter
4008 (defsubst ps-init-output-queue ()
4009 (setq ps-output-head (list "")
4010 ps-output-tail ps-output-head))
4013 (defun ps-selected-pages ()
4014 (while (progn
4015 (setq ps-first-page (car (car ps-selected-pages))
4016 ps-last-page (cdr (car ps-selected-pages))
4017 ps-selected-pages (cdr ps-selected-pages))
4018 (and ps-selected-pages
4019 (< ps-last-page ps-page-postscript)))))
4022 (defsubst ps-print-page-p ()
4023 (setq ps-print-page-p
4024 (and (cond ((null ps-first-page))
4025 ((<= ps-page-postscript ps-last-page)
4026 (<= ps-first-page ps-page-postscript))
4027 (ps-selected-pages
4028 (ps-selected-pages)
4029 (and (<= ps-first-page ps-page-postscript)
4030 (<= ps-page-postscript ps-last-page)))
4032 nil))
4033 (cond ((eq ps-even-or-odd-pages 'even-page)
4034 (= (logand ps-page-postscript 1) 0))
4035 ((eq ps-even-or-odd-pages 'odd-page)
4036 (= (logand ps-page-postscript 1) 1))
4038 ))))
4041 (defsubst ps-print-sheet-p ()
4042 (setq ps-print-page-p
4043 (cond ((eq ps-even-or-odd-pages 'even-sheet)
4044 (= (logand ps-page-sheet 1) 0))
4045 ((eq ps-even-or-odd-pages 'odd-sheet)
4046 (= (logand ps-page-sheet 1) 1))
4051 (defun ps-output (&rest args)
4052 (when ps-print-page-p
4053 (setcdr ps-output-tail args)
4054 (while (cdr ps-output-tail)
4055 (setq ps-output-tail (cdr ps-output-tail)))))
4057 (defun ps-output-string (string)
4058 (ps-output t string))
4060 ;; Output strings in the list ARGS in the PostScript prologue part.
4061 (defun ps-output-prologue (args)
4062 (ps-output 'prologue (if (stringp args) (list args) args)))
4064 (defun ps-flush-output ()
4065 (save-excursion
4066 (set-buffer ps-spool-buffer)
4067 (goto-char (point-max))
4068 (while ps-output-head
4069 (let ((it (car ps-output-head)))
4070 (cond
4071 ((eq t it)
4072 (setq ps-output-head (cdr ps-output-head))
4073 (ps-output-string-prim (car ps-output-head)))
4074 ((eq 'prologue it)
4075 (setq ps-output-head (cdr ps-output-head))
4076 (save-excursion
4077 (search-backward "\nBeginDoc")
4078 (forward-char 1)
4079 (apply 'insert (car ps-output-head))))
4081 (insert it))))
4082 (setq ps-output-head (cdr ps-output-head))))
4083 (ps-init-output-queue))
4085 (defun ps-insert-file (fname)
4086 (ps-flush-output)
4087 (save-excursion
4088 (set-buffer ps-spool-buffer)
4089 (goto-char (point-max))
4090 (insert-file fname)))
4092 ;; These functions insert the arrays that define the contents of the
4093 ;; headers.
4095 (defun ps-generate-header-line (fonttag &optional content)
4096 (ps-output " [ " fonttag " ")
4097 (cond
4098 ;; Literal strings should be output as is -- the string must
4099 ;; contain its own PS string delimiters, '(' and ')', if necessary.
4100 ((stringp content)
4101 (ps-output (ps-mule-encode-header-string content fonttag)))
4103 ;; Functions are called -- they should return strings; they will be
4104 ;; inserted as strings and the PS string delimiters added.
4105 ((and (symbolp content) (fboundp content))
4106 (ps-output-string (ps-mule-encode-header-string (funcall content)
4107 fonttag)))
4109 ;; Variables will have their contents inserted. They should
4110 ;; contain strings, and will be inserted as strings.
4111 ((and (symbolp content) (boundp content))
4112 (ps-output-string (ps-mule-encode-header-string (symbol-value content)
4113 fonttag)))
4115 ;; Anything else will get turned into an empty string.
4117 (ps-output-string "")))
4118 (ps-output " ]\n"))
4120 (defun ps-generate-header (name contents)
4121 (ps-output "/" name " [\n")
4122 (if (> ps-header-lines 0)
4123 (let ((count 1))
4124 (ps-generate-header-line "/h0" (car contents))
4125 (while (and (< count ps-header-lines)
4126 (setq contents (cdr contents)))
4127 (ps-generate-header-line "/h1" (car contents))
4128 (setq count (1+ count)))))
4129 (ps-output "] def\n"))
4132 (defun ps-output-boolean (name bool)
4133 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
4136 (defun ps-background-pages (page-list func)
4137 (if page-list
4138 (mapcar
4139 #'(lambda (pages)
4140 (let ((start (if (consp pages) (car pages) pages))
4141 (end (if (consp pages) (cdr pages) pages)))
4142 (and (integerp start) (integerp end) (<= start end)
4143 (add-to-list 'ps-background-pages (vector start end func)))))
4144 page-list)
4145 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4148 (defconst ps-boundingbox-re
4149 "^%%BoundingBox:\
4150 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4153 (defun ps-get-boundingbox ()
4154 (save-excursion
4155 (set-buffer ps-spool-buffer)
4156 (save-excursion
4157 (if (re-search-forward ps-boundingbox-re nil t)
4158 (vector (string-to-number ; lower x
4159 (buffer-substring (match-beginning 1) (match-end 1)))
4160 (string-to-number ; lower y
4161 (buffer-substring (match-beginning 2) (match-end 2)))
4162 (string-to-number ; upper x
4163 (buffer-substring (match-beginning 3) (match-end 3)))
4164 (string-to-number ; upper y
4165 (buffer-substring (match-beginning 4) (match-end 4))))
4166 (vector 0 0 0 0)))))
4169 ;; Emacs understands the %f format; we'll use it to limit color RGB values
4170 ;; to three decimals to cut down some on the size of the PostScript output.
4171 ;; Lucid emacsen will have to make do with %s (princ) for floats.
4173 (defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
4174 "%0.3f " ; emacs
4175 "%s ")) ; Lucid emacsen
4178 (defun ps-float-format (value &optional default)
4179 (let ((literal (or value default)))
4180 (if literal
4181 (format (if (numberp literal)
4182 ps-float-format
4183 "%s ")
4184 literal)
4185 " ")))
4188 (defun ps-background-text ()
4189 (mapcar
4190 #'(lambda (text)
4191 (setq ps-background-text-count (1+ ps-background-text-count))
4192 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
4193 (ps-output-string (nth 0 text)) ; text
4194 (ps-output
4195 "\n"
4196 (ps-float-format (nth 4 text) 200.0) ; font size
4197 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
4198 (ps-float-format (nth 6 text)
4199 "PrintHeight PrintPageWidth atan") ; rotation
4200 (ps-float-format (nth 5 text) 0.85) ; gray
4201 (ps-float-format (nth 1 text) "0") ; x position
4202 (ps-float-format (nth 2 text) "0") ; y position
4203 "\nShowBackText}def\n")
4204 (ps-background-pages (nthcdr 7 text) ; page list
4205 (format "ShowBackText-%d\n"
4206 ps-background-text-count)))
4207 ps-print-background-text))
4210 (defun ps-background-image ()
4211 (mapcar
4212 #'(lambda (image)
4213 (let ((image-file (expand-file-name (nth 0 image))))
4214 (when (file-readable-p image-file)
4215 (setq ps-background-image-count (1+ ps-background-image-count))
4216 (ps-output
4217 (format "/ShowBackImage-%d{\n--back-- "
4218 ps-background-image-count)
4219 (ps-float-format (nth 5 image) 0.0) ; rotation
4220 (ps-float-format (nth 3 image) 1.0) ; x scale
4221 (ps-float-format (nth 4 image) 1.0) ; y scale
4222 (ps-float-format (nth 1 image) ; x position
4223 "PrintPageWidth 2 div")
4224 (ps-float-format (nth 2 image) ; y position
4225 "PrintHeight 2 div BottomMargin add")
4226 "\nBeginBackImage\n")
4227 (ps-insert-file image-file)
4228 ;; coordinate adjustment to centralize image
4229 ;; around x and y position
4230 (let ((box (ps-get-boundingbox)))
4231 (save-excursion
4232 (set-buffer ps-spool-buffer)
4233 (save-excursion
4234 (if (re-search-backward "^--back--" nil t)
4235 (replace-match
4236 (format "%s %s"
4237 (ps-float-format
4238 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
4239 (aref box 0))))
4240 (ps-float-format
4241 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
4242 (aref box 1)))))
4243 t)))))
4244 (ps-output "\nEndBackImage}def\n")
4245 (ps-background-pages (nthcdr 6 image) ; page list
4246 (format "ShowBackImage-%d\n"
4247 ps-background-image-count)))))
4248 ps-print-background-image))
4251 (defun ps-background (page-number)
4252 (let (has-local-background)
4253 (mapcar #'(lambda (range)
4254 (and (<= (aref range 0) page-number)
4255 (<= page-number (aref range 1))
4256 (if has-local-background
4257 (ps-output (aref range 2))
4258 (setq has-local-background t)
4259 (ps-output "/printLocalBackground{\n"
4260 (aref range 2)))))
4261 ps-background-pages)
4262 (and has-local-background (ps-output "}def\n"))))
4265 ;; Return a list of the distinct elements of LIST.
4266 ;; Elements are compared with `equal'.
4267 (defun ps-remove-duplicates (list)
4268 (let (new (tail list))
4269 (while tail
4270 (or (member (car tail) new)
4271 (setq new (cons (car tail) new)))
4272 (setq tail (cdr tail)))
4273 (nreverse new)))
4276 ;; Find the first occurrence of ITEM in LIST.
4277 ;; Return the index of the matching item, or nil if not found.
4278 ;; Elements are compared with `eq'.
4279 (defun ps-alist-position (item list)
4280 (let ((tail list) (index 0) found)
4281 (while tail
4282 (if (setq found (eq (car (car tail)) item))
4283 (setq tail nil)
4284 (setq index (1+ index)
4285 tail (cdr tail))))
4286 (and found index)))
4289 (defconst ps-n-up-database
4290 '((a4
4291 (1 nil 1 1 0)
4292 (2 t 1 2 0)
4293 (4 nil 2 2 0)
4294 (6 t 2 3 1)
4295 (8 t 2 4 0)
4296 (9 nil 3 3 0)
4297 (12 t 3 4 2)
4298 (16 nil 4 4 0)
4299 (18 t 3 6 0)
4300 (20 nil 5 4 1)
4301 (25 nil 5 5 0)
4302 (30 nil 6 5 1)
4303 (32 t 4 8 0)
4304 (36 nil 6 6 0)
4305 (42 nil 7 6 1)
4306 (49 nil 7 7 0)
4307 (50 t 5 10 0)
4308 (56 nil 8 7 1)
4309 (64 nil 8 8 0)
4310 (72 nil 9 8 1)
4311 (81 nil 9 9 0)
4312 (90 nil 10 9 1)
4313 (100 nil 10 10 0))
4315 (1 nil 1 1 0)
4316 (2 t 1 2 0)
4317 (4 nil 2 2 0)
4318 (6 t 2 3 1)
4319 (8 t 2 4 0)
4320 (9 nil 3 3 0)
4321 (12 nil 4 3 1)
4322 (16 nil 4 4 0)
4323 (18 t 3 6 0)
4324 (20 nil 5 4 1)
4325 (25 nil 5 5 0)
4326 (30 nil 6 5 1)
4327 (32 t 4 8 0)
4328 (36 nil 6 6 0)
4329 (42 nil 7 6 1)
4330 (49 nil 7 7 0)
4331 (50 t 5 10 0)
4332 (56 nil 8 7 1)
4333 (64 nil 8 8 0)
4334 (72 nil 9 8 1)
4335 (81 nil 9 9 0)
4336 (90 nil 10 9 1)
4337 (100 nil 10 10 0))
4338 (letter
4339 (1 nil 1 1 0)
4340 (2 t 1 2 0) ; adjusted by PostScript code
4341 (4 nil 2 2 0)
4342 (6 t 2 3 0)
4343 (9 nil 3 3 0)
4344 (12 nil 4 3 1)
4345 (16 nil 4 4 0)
4346 (20 nil 5 4 1)
4347 (25 nil 5 5 0)
4348 (30 nil 6 5 1)
4349 (36 nil 6 6 0)
4350 (40 t 5 8 0)
4351 (42 nil 7 6 1)
4352 (49 nil 7 7 0)
4353 (56 nil 8 7 1)
4354 (64 nil 8 8 0)
4355 (72 nil 9 8 1)
4356 (81 nil 9 9 0)
4357 (90 nil 10 9 1)
4358 (100 nil 10 10 0))
4359 (legal
4360 (1 nil 1 1 0)
4361 (2 t 1 2 0)
4362 (4 nil 2 2 0)
4363 (6 nil 3 2 1)
4364 (9 nil 3 3 0)
4365 (10 t 2 5 0)
4366 (12 nil 4 3 1)
4367 (16 nil 4 4 0)
4368 (20 nil 5 4 1)
4369 (25 nil 5 5 0)
4370 (30 nil 6 5 1)
4371 (36 nil 6 6 0)
4372 (42 nil 7 6 1)
4373 (49 nil 7 7 0)
4374 (56 nil 8 7 1)
4375 (64 nil 8 8 0)
4376 (70 t 5 14 0)
4377 (72 nil 9 8 1)
4378 (81 nil 9 9 0)
4379 (90 nil 10 9 1)
4380 (100 nil 10 10 0))
4381 (letter-small
4382 (1 nil 1 1 0)
4383 (2 t 1 2 0) ; adjusted by PostScript code
4384 (4 nil 2 2 0)
4385 (6 t 2 3 0)
4386 (9 nil 3 3 0)
4387 (12 t 3 4 1)
4388 (15 t 3 5 0)
4389 (16 nil 4 4 0)
4390 (20 nil 5 4 1)
4391 (25 nil 5 5 0)
4392 (28 t 4 7 0)
4393 (30 nil 6 5 1)
4394 (36 nil 6 6 0)
4395 (40 t 5 8 0)
4396 (42 nil 7 6 1)
4397 (49 nil 7 7 0)
4398 (56 nil 8 7 1)
4399 (60 t 6 10 0)
4400 (64 nil 8 8 0)
4401 (72 ni 9 8 1)
4402 (81 nil 9 9 0)
4403 (84 t 7 12 0)
4404 (90 nil 10 9 1)
4405 (100 nil 10 10 0))
4406 (tabloid
4407 (1 nil 1 1 0)
4408 (2 t 1 2 0)
4409 (4 nil 2 2 0)
4410 (6 t 2 3 1)
4411 (8 t 2 4 0)
4412 (9 nil 3 3 0)
4413 (12 nil 4 3 1)
4414 (16 nil 4 4 0)
4415 (20 nil 5 4 1)
4416 (25 nil 5 5 0)
4417 (30 nil 6 5 1)
4418 (36 nil 6 6 0)
4419 (42 nil 7 6 1)
4420 (49 nil 7 7 0)
4421 (56 nil 8 7 1)
4422 (64 nil 8 8 0)
4423 (72 nil 9 8 1)
4424 (81 nil 9 9 0)
4425 (84 t 6 14 0)
4426 (90 nil 10 9 1)
4427 (100 nil 10 10 0))
4428 ;; Ledger paper size is a special case, it is the only paper size where the
4429 ;; normal size is landscaped, that is, the height is smaller than width.
4430 ;; So, we use the special value `pag' in the `landscape' field.
4431 (ledger
4432 (1 nil 1 1 0)
4433 (2 pag 1 2 0)
4434 (4 nil 2 2 0)
4435 (6 pag 2 3 1)
4436 (8 pag 2 4 0)
4437 (9 nil 3 3 0)
4438 (12 nil 4 3 1)
4439 (16 nil 4 4 0)
4440 (20 nil 5 4 1)
4441 (25 nil 5 5 0)
4442 (30 nil 6 5 1)
4443 (36 nil 6 6 0)
4444 (42 nil 7 6 1)
4445 (49 nil 7 7 0)
4446 (56 nil 8 7 1)
4447 (64 nil 8 8 0)
4448 (72 nil 9 8 1)
4449 (81 nil 9 9 0)
4450 (84 pag 6 14 0)
4451 (90 nil 10 9 1)
4452 (100 nil 10 10 0))
4453 (statement
4454 (1 nil 1 1 0)
4455 (2 t 1 2 0)
4456 (4 nil 2 2 0)
4457 (6 nil 3 2 1)
4458 (9 nil 3 3 0)
4459 (10 t 2 5 0)
4460 (12 nil 4 3 1)
4461 (16 nil 4 4 0)
4462 (20 nil 5 4 1)
4463 (21 t 3 7 0)
4464 (25 nil 5 5 0)
4465 (30 nil 6 5 1)
4466 (36 nil 6 6 0)
4467 (40 t 4 10 0)
4468 (42 nil 7 6 1)
4469 (49 nil 7 7 0)
4470 (56 nil 8 7 1)
4471 (60 t 5 12 0)
4472 (64 nil 8 8 0)
4473 (72 nil 9 8 1)
4474 (81 nil 9 9 0)
4475 (90 nil 10 9 1)
4476 (100 nil 10 10 0))
4477 (executive
4478 (1 nil 1 1 0)
4479 (2 t 1 2 0) ; adjusted by PostScript code
4480 (4 nil 2 2 0)
4481 (6 t 2 3 0)
4482 (9 nil 3 3 0)
4483 (12 nil 4 3 1)
4484 (16 nil 4 4 0)
4485 (20 nil 5 4 1)
4486 (25 nil 5 5 0)
4487 (28 t 4 7 0)
4488 (30 nil 6 5 1)
4489 (36 nil 6 6 0)
4490 (42 nil 7 6 1)
4491 (45 t 5 9 0)
4492 (49 nil 7 7 0)
4493 (56 nil 8 7 1)
4494 (60 t 6 10 0)
4495 (64 nil 8 8 0)
4496 (72 nil 9 8 1)
4497 (81 nil 9 9 0)
4498 (84 t 7 12 0)
4499 (90 nil 10 9 1)
4500 (100 nil 10 10 0))
4501 (a4small
4502 (1 nil 1 1 0)
4503 (2 t 1 2 0)
4504 (4 nil 2 2 0)
4505 (6 t 2 3 1)
4506 (8 t 2 4 0)
4507 (9 nil 3 3 0)
4508 (12 nil 4 3 1)
4509 (16 nil 4 4 0)
4510 (18 t 3 6 0)
4511 (20 nil 5 4 1)
4512 (25 nil 5 5 0)
4513 (30 nil 6 5 1)
4514 (32 t 4 8 0)
4515 (36 nil 6 6 0)
4516 (42 nil 7 6 1)
4517 (49 nil 7 7 0)
4518 (50 t 5 10 0)
4519 (56 nil 8 7 1)
4520 (64 nil 8 8 0)
4521 (72 nil 9 8 1)
4522 (78 t 6 13 0)
4523 (81 nil 9 9 0)
4524 (90 nil 10 9 1)
4525 (100 nil 10 10 0))
4527 (1 nil 1 1 0)
4528 (2 t 1 2 0)
4529 (4 nil 2 2 0)
4530 (6 t 2 3 1)
4531 (8 t 2 4 0)
4532 (9 nil 3 3 0)
4533 (12 nil 4 3 1)
4534 (16 nil 4 4 0)
4535 (18 t 3 6 0)
4536 (20 nil 5 4 1)
4537 (25 nil 5 5 0)
4538 (30 nil 6 5 1)
4539 (32 t 4 8 0)
4540 (36 nil 6 6 0)
4541 (42 nil 7 6 1)
4542 (49 nil 7 7 0)
4543 (50 t 5 10 0)
4544 (56 nil 8 7 1)
4545 (64 nil 8 8 0)
4546 (72 nil 9 8 1)
4547 (81 nil 9 9 0)
4548 (90 nil 10 9 1)
4549 (100 nil 10 10 0))
4551 (1 nil 1 1 0)
4552 (2 t 1 2 0)
4553 (4 nil 2 2 0)
4554 (6 t 2 3 1)
4555 (8 t 2 4 0)
4556 (9 nil 3 3 0)
4557 (12 nil 4 3 1)
4558 (16 nil 4 4 0)
4559 (18 t 3 6 0)
4560 (20 nil 5 4 1)
4561 (25 nil 5 5 0)
4562 (30 nil 6 5 1)
4563 (32 t 4 8 0)
4564 (36 nil 6 6 0)
4565 (42 nil 7 6 1)
4566 (49 nil 7 7 0)
4567 (50 t 5 10 0)
4568 (56 nil 8 7 1)
4569 (64 nil 8 8 0)
4570 (72 nil 9 8 0)
4571 (81 nil 9 9 0)
4572 (90 nil 10 9 1)
4573 (98 t 7 14 0)
4574 (100 nil 10 10 0)))
4575 "Alist which is the page matrix database used for N-up printing.
4577 Each element has the following form:
4579 (PAGE
4580 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
4581 ...)
4583 Where:
4584 PAGE is the page size used (see `ps-paper-type').
4585 MAX is the maximum elements of this page matrix.
4586 LANDSCAPE specifies if page matrix is landscaped, has the following valid
4587 values:
4588 nil the sheet is in portrait mode.
4589 t the sheet is in landscape mode.
4590 pag the sheet is in portrait mode and page is in landscape mode.
4591 LINES is the number of lines of page matrix.
4592 COLUMNS is the number of columns of page matrix.
4593 COL-MISSING is the number of columns missing to fill the sheet.")
4596 (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
4597 (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
4598 (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
4599 (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
4602 (defun ps-n-up-printing ()
4603 ;; force `ps-n-up-printing' be in range 1 to 100.
4604 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
4605 ;; find suitable page matrix for a given `ps-paper-type'.
4606 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
4607 (and the-list
4608 (while (> ps-n-up-printing (caar the-list))
4609 (setq the-list (cdr the-list))))
4610 (car the-list)))
4613 (defconst ps-n-up-filling-database
4614 '((left-top
4615 "PageWidth" ; N-Up-XColumn
4616 "0" ; N-Up-YColumn
4617 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
4618 "LandscapePageHeight neg" ; N-Up-YLine
4619 "N-Up-Lines" ; N-Up-Repeat
4620 "N-Up-Columns" ; N-Up-End
4621 "0" ; N-Up-XStart
4622 "0") ; N-Up-YStart
4623 (left-bottom
4624 "PageWidth" ; N-Up-XColumn
4625 "0" ; N-Up-YColumn
4626 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
4627 "LandscapePageHeight" ; N-Up-YLine
4628 "N-Up-Lines" ; N-Up-Repeat
4629 "N-Up-Columns" ; N-Up-End
4630 "0" ; N-Up-XStart
4631 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
4632 (right-top
4633 "PageWidth neg" ; N-Up-XColumn
4634 "0" ; N-Up-YColumn
4635 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
4636 "LandscapePageHeight neg" ; N-Up-YLine
4637 "N-Up-Lines" ; N-Up-Repeat
4638 "N-Up-Columns" ; N-Up-End
4639 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
4640 "0") ; N-Up-YStart
4641 (right-bottom
4642 "PageWidth neg" ; N-Up-XColumn
4643 "0" ; N-Up-YColumn
4644 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
4645 "LandscapePageHeight" ; N-Up-YLine
4646 "N-Up-Lines" ; N-Up-Repeat
4647 "N-Up-Columns" ; N-Up-End
4648 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
4649 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
4650 (top-left
4651 "0" ; N-Up-XColumn
4652 "LandscapePageHeight neg" ; N-Up-YColumn
4653 "PageWidth" ; N-Up-XLine
4654 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
4655 "N-Up-Columns" ; N-Up-Repeat
4656 "N-Up-Lines" ; N-Up-End
4657 "0" ; N-Up-XStart
4658 "0") ; N-Up-YStart
4659 (bottom-left
4660 "0" ; N-Up-XColumn
4661 "LandscapePageHeight" ; N-Up-YColumn
4662 "PageWidth" ; N-Up-XLine
4663 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
4664 "N-Up-Columns" ; N-Up-Repeat
4665 "N-Up-Lines" ; N-Up-End
4666 "0" ; N-Up-XStart
4667 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
4668 (top-right
4669 "0" ; N-Up-XColumn
4670 "LandscapePageHeight neg" ; N-Up-YColumn
4671 "PageWidth neg" ; N-Up-XLine
4672 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
4673 "N-Up-Columns" ; N-Up-Repeat
4674 "N-Up-Lines" ; N-Up-End
4675 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
4676 "0") ; N-Up-YStart
4677 (bottom-right
4678 "0" ; N-Up-XColumn
4679 "LandscapePageHeight" ; N-Up-YColumn
4680 "PageWidth neg" ; N-Up-XLine
4681 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
4682 "N-Up-Columns" ; N-Up-Repeat
4683 "N-Up-Lines" ; N-Up-End
4684 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
4685 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
4686 "Alist for n-up printing initializations.
4688 Each element has the following form:
4690 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
4692 Where:
4693 KIND is a valid value of `ps-n-up-filling'.
4694 XCOL YCOL are the relative position for the next column.
4695 XLIN YLIN are the relative position for the beginning of next line.
4696 REPEAT is the number of repetions for external loop.
4697 END is the number of repetions for internal loop and also the number of pages in
4698 a row.
4699 XSTART YSTART are the relative position for the first page in a sheet.")
4702 (defun ps-n-up-filling ()
4703 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
4704 (assq 'left-top ps-n-up-filling-database))))
4707 (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
4708 (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
4709 (defmacro ps-n-up-xline (init) `(nth 2 ,init))
4710 (defmacro ps-n-up-yline (init) `(nth 3 ,init))
4711 (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
4712 (defmacro ps-n-up-end (init) `(nth 5 ,init))
4713 (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
4714 (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
4717 (defconst ps-error-handler-alist
4718 '((none . 0)
4719 (paper . 1)
4720 (system . 2)
4721 (paper-and-system . 3))
4722 "Alist for error handler message.")
4725 (defconst ps-zebra-stripe-alist
4726 '((follow . 1)
4727 (full . 2)
4728 (full-follow . 3))
4729 "Alist for zebra stripe continuation.")
4732 (defun ps-begin-file ()
4733 (ps-get-page-dimensions)
4734 (setq ps-page-order 0
4735 ps-page-printed 0
4736 ps-background-text-count 0
4737 ps-background-image-count 0
4738 ps-background-pages nil
4739 ps-background-all-pages nil)
4741 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
4742 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
4743 (n-up (ps-n-up-printing))
4744 (n-up-filling (ps-n-up-filling)))
4745 (and ps-n-up-on (setq tumble (not tumble)))
4746 (ps-output
4747 ps-adobe-tag
4748 "%%Title: " (buffer-name) ; Take job name from name of
4749 ; first buffer printed
4750 "\n%%Creator: " (user-full-name)
4751 " (using ps-print v" ps-print-version
4752 ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
4753 "\n%%Orientation: "
4754 (if ps-landscape-mode "Landscape" "Portrait")
4755 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
4756 (mapconcat 'identity
4757 (ps-remove-duplicates
4758 (append (ps-fonts 'ps-font-for-text)
4759 (list (ps-font 'ps-font-for-header 'normal)
4760 (ps-font 'ps-font-for-header 'bold))))
4761 "\n%%+ font ")
4762 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
4763 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
4764 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
4765 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
4766 (if ps-spool-duplex
4767 (if tumble " duplex(tumble)\n" " duplex\n")
4768 "\n"))
4770 (ps-insert-string ps-print-prologue-header)
4772 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
4773 (ps-page-dimensions-get-media dimensions)
4774 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
4775 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
4776 (format "/ErrorMessage %s def\n\n"
4777 (or (cdr (assoc ps-error-handler-message
4778 ps-error-handler-alist))
4779 1)) ; send to paper
4780 ps-print-prologue-0
4781 "\n%%BeginProcSet: UserDefinedPrologue\n\n")
4783 (ps-insert-string ps-user-defined-prologue)
4785 (ps-output "\n%%EndProcSet\n\n")
4787 (ps-output-boolean "LandscapeMode "
4788 (or ps-landscape-mode
4789 (eq (ps-n-up-landscape n-up) 'pag)))
4790 (ps-output-boolean "UpsideDown " ps-print-upside-down)
4791 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
4793 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
4794 (format "/PrintPageWidth %s def\n"
4795 (- (* (+ ps-print-width ps-inter-column)
4796 ps-number-of-columns)
4797 ps-inter-column))
4798 (format "/PrintWidth %s def\n" ps-print-width)
4799 (format "/PrintHeight %s def\n" ps-print-height)
4801 (format "/LeftMargin %s def\n" ps-left-margin)
4802 (format "/RightMargin %s def\n" ps-right-margin)
4803 (format "/InterColumn %s def\n" ps-inter-column)
4805 (format "/BottomMargin %s def\n" ps-bottom-margin)
4806 (format "/TopMargin %s def\n" ps-top-margin) ; not used
4807 (format "/HeaderOffset %s def\n" ps-header-offset)
4808 (format "/HeaderPad %s def\n" ps-header-pad))
4810 (ps-output-boolean "PrintHeader " ps-print-header)
4811 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
4812 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
4813 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
4814 ps-spool-duplex
4815 ps-switch-header))
4816 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
4818 (let ((line-height (ps-line-height 'ps-font-for-text)))
4819 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
4820 (format "/ParagraphSpacing %s def\n"
4821 ps-paragraph-spacing-internal)
4822 (format "/LineHeight %s def\n" line-height)
4823 (format "/LinesPerColumn %d def\n"
4824 (let ((height (+ line-height
4825 ps-line-spacing-internal)))
4826 (round (/ (+ ps-print-height
4827 (* height 0.45))
4828 height))))))
4830 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
4831 (ps-output-boolean "Zebra " ps-zebra-stripes)
4832 (ps-output-boolean "PrintLineNumber " ps-line-number)
4833 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
4834 (ps-output (format "/ZebraFollow %d def\n"
4835 (or (cdr (assq ps-zebra-stripe-follow
4836 ps-zebra-stripe-alist))
4838 (format "/PrintLineStep %d def\n"
4839 (if (integerp ps-line-number-step)
4840 ps-line-number-step
4841 ps-zebra-stripe-height))
4842 (format "/PrintLineStart %d def\n" ps-line-number-start)
4843 (format "/ZebraHeight %d def\n" ps-zebra-stripe-height)
4844 "/ZebraColor "
4845 (ps-format-color ps-zebra-color 0.95)
4846 "def\n/BackgroundColor "
4847 (ps-format-color ps-default-bg 1.0)
4848 "def\n/UseSetpagedevice "
4849 (if (eq ps-spool-config 'setpagedevice)
4850 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
4851 "false")
4852 " def\n\n/PageWidth "
4853 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
4854 (format "/N-Up %d def\n" ps-n-up-printing))
4855 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
4856 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
4857 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
4858 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
4859 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
4860 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
4861 "/N-Up-Repeat "
4862 (if ps-landscape-mode
4863 (ps-n-up-end n-up-filling)
4864 (ps-n-up-repeat n-up-filling))
4865 " def\n/N-Up-End "
4866 (if ps-landscape-mode
4867 (ps-n-up-repeat n-up-filling)
4868 (ps-n-up-end n-up-filling))
4869 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
4870 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
4871 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
4872 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
4873 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
4874 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
4876 (ps-background-text)
4877 (ps-background-image)
4878 (setq ps-background-all-pages (nreverse ps-background-all-pages)
4879 ps-background-pages (nreverse ps-background-pages))
4881 (ps-output "\n" ps-print-prologue-1)
4883 (ps-output "\n/printGlobalBackground{\n")
4884 (mapcar 'ps-output ps-background-all-pages)
4885 (ps-output "}def\n/printLocalBackground{\n}def\n")
4887 ;; Header/line number fonts
4888 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
4889 ps-header-title-font-size-internal
4890 (ps-font 'ps-font-for-header 'bold))
4891 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
4892 ps-header-font-size-internal
4893 (ps-font 'ps-font-for-header 'normal))
4894 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
4895 (ps-get-font-size 'ps-line-number-font-size)
4896 ps-line-number-font))
4898 (ps-output "\n\n% ---- These lines must be kept together because...
4900 /h0 F
4901 /HeaderTitleLineHeight FontHeight def
4903 /h1 F
4904 /HeaderLineHeight FontHeight def
4905 /HeaderDescent Descent def
4907 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
4909 ;; Text fonts
4910 (let ((font (ps-font-alist 'ps-font-for-text))
4911 (i 0))
4912 (while font
4913 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
4915 ps-font-size-internal
4916 (ps-font 'ps-font-for-text (car (car font)))))
4917 (setq font (cdr font)
4918 i (1+ i))))
4920 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
4921 (ps-output (format "/SpaceWidthRatio %f def\n"
4922 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
4924 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
4925 (unless (eq ps-spool-config 'lpr-switches)
4926 (ps-output "\n%%BeginFeature: *Duplex "
4927 (ps-boolean-capitalized ps-spool-duplex)
4928 " *Tumble "
4929 (ps-boolean-capitalized tumble)
4930 "\nUseSetpagedevice\n{BMark/Duplex "
4931 (ps-boolean-constant ps-spool-duplex)
4932 "/Tumble "
4933 (ps-boolean-constant tumble)
4934 " EMark setpagedevice}\n{statusdict begin "
4935 (ps-boolean-constant ps-spool-duplex)
4936 " setduplexmode "
4937 (ps-boolean-constant tumble)
4938 " settumble end}ifelse\n%%EndFeature\n")))
4939 (ps-output "\n%%BeginFeature: *ManualFeed "
4940 (ps-boolean-capitalized ps-manual-feed)
4941 "\nBMark /ManualFeed "
4942 (ps-boolean-constant ps-manual-feed)
4943 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
4944 (and ps-banner-page-when-duplexing
4945 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
4948 (defun ps-format-color (color &optional default)
4949 (let ((the-color (if (stringp color)
4950 (ps-color-scale color)
4951 color)))
4952 (if (and the-color (listp the-color))
4953 (concat "["
4954 (format ps-color-format
4955 (nth 0 the-color)
4956 (nth 1 the-color)
4957 (nth 2 the-color))
4958 "] ")
4959 (ps-float-format (if (numberp the-color) the-color default)))))
4962 (defun ps-insert-string (prologue)
4963 (let ((str (if (functionp prologue)
4964 (funcall prologue)
4965 prologue)))
4966 (and (stringp str)
4967 (ps-output str))))
4970 (defun ps-boolean-capitalized (bool)
4971 (if bool "True" "False"))
4974 (defun ps-boolean-constant (bool)
4975 (if bool "true" "false"))
4978 (defun ps-header-dirpart ()
4979 (let ((fname (buffer-file-name)))
4980 (if fname
4981 (if (string-equal (buffer-name) (file-name-nondirectory fname))
4982 (abbreviate-file-name (file-name-directory fname))
4983 fname)
4984 "")))
4987 (defun ps-get-buffer-name ()
4988 (cond
4989 ;; Indulge Jim this little easter egg:
4990 ((string= (buffer-name) "ps-print.el")
4991 "Hey, Cool! It's ps-print.el!!!")
4992 ;; Indulge Jack this other little easter egg:
4993 ((string= (buffer-name) "sokoban.el")
4994 "Super! C'est sokoban.el!")
4995 (t (concat
4996 (and ps-printing-region-p "Subset of: ")
4997 (buffer-name)
4998 (and (buffer-modified-p) " (unsaved)")))))
5001 (defun ps-get-size (size mess &optional arg)
5002 (let ((siz (cond ((numberp size)
5003 size)
5004 ((and (consp size)
5005 (numberp (car size))
5006 (numberp (cdr size)))
5007 (if ps-landscape-mode
5008 (car size)
5009 (cdr size)))
5011 -1))))
5012 (and (< siz 0)
5013 (error "Invalid %s `%S'%s"
5014 mess size
5015 (if arg
5016 (format " for `%S'" arg)
5017 "")))
5018 siz))
5021 (defun ps-get-font-size (font-sym)
5022 (ps-get-size (symbol-value font-sym) "font size" font-sym))
5025 (defun ps-begin-job ()
5026 ;; prologue files
5027 (or (equal ps-mark-code-directory ps-postscript-code-directory)
5028 (setq ps-print-prologue-0 (ps-prologue-file 0)
5029 ps-print-prologue-1 (ps-prologue-file 1)
5030 ps-mark-code-directory ps-postscript-code-directory))
5031 ;; selected pages
5032 (let (new page)
5033 (while ps-selected-pages
5034 (setq page (car ps-selected-pages)
5035 ps-selected-pages (cdr ps-selected-pages))
5036 (cond ((integerp page)
5037 (and (> page 0)
5038 (setq new (cons (cons page page) new))))
5039 ((consp page)
5040 (and (integerp (car page)) (integerp (cdr page))
5041 (> (car page) 0)
5042 (<= (car page) (cdr page))
5043 (setq new (cons page new))))))
5044 (setq ps-selected-pages (sort new #'(lambda (one other)
5045 (< (car one) (car other))))
5046 ps-last-selected-pages ps-selected-pages
5047 ps-first-page nil
5048 ps-last-page nil))
5049 ;; face background
5050 (or (listp ps-use-face-background)
5051 (setq ps-use-face-background t))
5052 ;; line number
5053 (and (integerp ps-line-number-step)
5054 (<= ps-line-number-step 0)
5055 (setq ps-line-number-step 1))
5056 (setq ps-n-up-on (> ps-n-up-printing 1)
5057 ps-line-number-start (max 1 (min ps-line-number-start
5058 (if (integerp ps-line-number-step)
5059 ps-line-number-step
5060 ps-zebra-stripe-height))))
5061 ;; spooling buffer
5062 (save-excursion
5063 (set-buffer ps-spool-buffer)
5064 (goto-char (point-max))
5065 (and (re-search-backward "^%%Trailer$" nil t)
5066 (delete-region (match-beginning 0) (point-max))))
5067 ;; miscellaneous
5068 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5069 '(full full-follow))
5070 ps-page-postscript 0
5071 ps-page-sheet 0
5072 ps-page-n-up 0
5073 ps-page-column 0
5074 ps-lines-printed 0
5075 ps-print-page-p t
5076 ps-showline-count (car ps-printing-region)
5077 ps-line-spacing-internal (ps-get-size ps-line-spacing
5078 "line spacing")
5079 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
5080 "paragraph spacing")
5081 ps-font-size-internal (ps-get-font-size 'ps-font-size)
5082 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
5083 ps-header-title-font-size-internal
5084 (ps-get-font-size 'ps-header-title-font-size)
5085 ps-control-or-escape-regexp
5086 (cond ((eq ps-print-control-characters '8-bit)
5087 (string-as-unibyte "[\000-\037\177-\377]"))
5088 ((eq ps-print-control-characters 'control-8-bit)
5089 (string-as-unibyte "[\000-\037\177-\237]"))
5090 ((eq ps-print-control-characters 'control)
5091 "[\000-\037\177]")
5092 (t "[\t\n\f]"))
5093 ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
5094 ps-default-color (and ps-print-color-p ps-default-foreground)
5095 ps-current-color ps-default-color
5096 ;; Set the color scale. We do it here instead of in the defvar so
5097 ;; that ps-print can be dumped into emacs. This expression can't be
5098 ;; evaluated at dump-time because X isn't initialized.
5099 ps-color-p (and ps-print-color-p (ps-color-device))
5100 ps-print-color-scale (if ps-color-p
5101 (float (car (ps-color-values "white")))
5102 1.0)))
5105 (defun ps-rgb-color (color default)
5106 (cond ((and color (listp color)) color)
5107 ((stringp color) (ps-color-scale color))
5108 ((numberp color) (list color color color))
5109 (t (list default default default))
5113 (defun ps-page-number ()
5114 (if ps-print-only-one-header
5115 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5116 ps-page-column))
5119 (defun ps-next-page ()
5120 (ps-end-page)
5121 (ps-flush-output)
5122 (ps-begin-page))
5125 (defun ps-header-sheet ()
5126 ;; Print only when a new sheet begins.
5127 (and ps-print-page-p (> ps-page-sheet 0)
5128 (ps-output "EndSheet\n"))
5129 (setq ps-page-sheet (1+ ps-page-sheet))
5130 (when (ps-print-sheet-p)
5131 (setq ps-page-order (1+ ps-page-order))
5132 (ps-output (if ps-n-up-on
5133 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5134 ps-page-order ps-page-postscript ps-page-order)
5135 (format "\n%%%%Page: %d %d\n"
5136 ps-page-postscript ps-page-order))
5137 ;; spooling needs to redefine Lines and PageCount on each page
5138 "/Lines 0 def\n/PageCount 0 def\n"
5139 (format "%d BeginSheet\nBeginDSCPage\n"
5140 ps-n-up-printing))))
5143 (defun ps-header-page ()
5144 ;; set total line and page number when printing has finished
5145 ;; (see `ps-generate')
5146 (if (zerop (mod ps-page-column ps-number-of-columns))
5147 (progn
5148 (setq ps-page-postscript (1+ ps-page-postscript))
5149 (when (ps-print-page-p)
5150 (ps-print-sheet-p)
5151 (if (zerop (mod ps-page-n-up ps-n-up-printing))
5152 ;; Print only when a new sheet begins.
5153 (progn
5154 (ps-header-sheet)
5155 (run-hooks 'ps-print-begin-sheet-hook))
5156 ;; Print only when a new page begins.
5157 (ps-output "BeginDSCPage\n")
5158 (run-hooks 'ps-print-begin-page-hook))
5159 (ps-background ps-page-postscript)
5160 (setq ps-page-n-up (1+ ps-page-n-up))
5161 (and ps-print-page-p
5162 (setq ps-page-printed (1+ ps-page-printed)))))
5163 ;; Print only when a new column begins.
5164 (ps-output "BeginDSCPage\n")
5165 (run-hooks 'ps-print-begin-column-hook))
5166 (setq ps-page-column (1+ ps-page-column)))
5168 (defun ps-begin-page ()
5169 (ps-get-page-dimensions)
5170 (setq ps-width-remaining ps-print-width
5171 ps-height-remaining ps-print-height)
5173 (ps-header-page)
5175 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
5176 (format "/PageNumber %d def\n" (ps-page-number)))
5178 (when ps-print-header
5179 (ps-generate-header "HeaderLinesLeft" ps-left-header)
5180 (ps-generate-header "HeaderLinesRight" ps-right-header)
5181 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
5183 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
5184 (ps-set-font ps-current-font)
5185 (ps-set-bg ps-current-bg)
5186 (ps-set-color ps-current-color)
5187 (ps-mule-begin-page))
5189 (defun ps-end-page ()
5190 (ps-output "EndPage\nEndDSCPage\n"))
5192 (defun ps-skip-newline (limit)
5193 (setq ps-showline-count (1+ ps-showline-count)
5194 ps-lines-printed (1+ ps-lines-printed))
5195 (and (< (point) limit)
5196 (forward-char 1)))
5198 (defsubst ps-next-line ()
5199 (setq ps-showline-count (1+ ps-showline-count)
5200 ps-lines-printed (1+ ps-lines-printed))
5201 (let* ((paragraph-p (and ps-paragraph-regexp
5202 (looking-at ps-paragraph-regexp)))
5203 (lh (+ (ps-line-height 'ps-font-for-text)
5204 (if paragraph-p
5205 ps-paragraph-spacing-internal
5206 ps-line-spacing-internal))))
5207 (if (< ps-height-remaining lh)
5208 (ps-next-page)
5209 (setq ps-width-remaining ps-print-width
5210 ps-height-remaining (- ps-height-remaining lh))
5211 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
5213 (defun ps-continue-line ()
5214 (setq ps-lines-printed (1+ ps-lines-printed))
5215 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
5216 (if (< ps-height-remaining lh)
5217 (ps-next-page)
5218 (setq ps-width-remaining ps-print-width
5219 ps-height-remaining (- ps-height-remaining lh))
5220 (ps-output "SL\n"))))
5222 (defun ps-find-wrappoint (from to char-width)
5223 (let ((avail (truncate (/ ps-width-remaining char-width)))
5224 (todo (- to from)))
5225 (if (< todo avail)
5226 (cons to (* todo char-width))
5227 (cons (+ from avail) ps-width-remaining))))
5229 (defun ps-basic-plot-string (from to &optional bg-color)
5230 (let* ((wrappoint (ps-find-wrappoint from to
5231 (ps-avg-char-width 'ps-font-for-text)))
5232 (to (car wrappoint))
5233 (string (buffer-substring-no-properties from to)))
5234 (ps-mule-prepare-ascii-font string)
5235 (ps-output-string string)
5236 (ps-output " S\n")
5237 wrappoint))
5239 (defun ps-basic-plot-whitespace (from to &optional bg-color)
5240 (let* ((wrappoint (ps-find-wrappoint from to
5241 (ps-space-width 'ps-font-for-text)))
5242 (to (car wrappoint)))
5243 (ps-output (format "%d W\n" (- to from)))
5244 wrappoint))
5246 (defun ps-plot (plotfunc from to &optional bg-color)
5247 (while (< from to)
5248 (let* ((wrappoint (funcall plotfunc from to bg-color))
5249 (plotted-to (car wrappoint))
5250 (plotted-width (cdr wrappoint)))
5251 (setq from plotted-to
5252 ps-width-remaining (- ps-width-remaining plotted-width))
5253 (if (< from to)
5254 (ps-continue-line))))
5255 (if ps-razzle-dazzle
5256 (let* ((q-todo (- (point-max) (point-min)))
5257 (q-done (- (point) (point-min)))
5258 (chunkfrac (/ q-todo 8))
5259 (chunksize (min chunkfrac 1000)))
5260 (if (> (- q-done ps-razchunk) chunksize)
5261 (progn
5262 (setq ps-razchunk q-done)
5263 (message "Formatting...%3d%%"
5264 (if (< q-todo 100)
5265 (/ (* 100 q-done) q-todo)
5266 (/ q-done (/ q-todo 100)))
5267 ))))))
5269 (defvar ps-last-font nil)
5271 (defun ps-set-font (font)
5272 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
5273 (ps-output (format "/%s F\n" ps-last-font)))
5275 (defun ps-set-bg (color)
5276 (if (setq ps-current-bg color)
5277 (ps-output (format ps-color-format
5278 (nth 0 color) (nth 1 color) (nth 2 color))
5279 " true BG\n")
5280 (ps-output "false BG\n")))
5282 (defun ps-set-color (color)
5283 (setq ps-current-color (or color ps-default-foreground))
5284 (ps-output (format ps-color-format
5285 (nth 0 ps-current-color)
5286 (nth 1 ps-current-color) (nth 2 ps-current-color))
5287 " FG\n"))
5290 (defvar ps-current-effect 0)
5293 (defun ps-plot-region (from to font &optional fg-color bg-color effects)
5294 (if (not (equal font ps-current-font))
5295 (ps-set-font font))
5297 ;; Specify a foreground color only if one's specified and it's
5298 ;; different than the current.
5299 (if (not (equal fg-color ps-current-color))
5300 (ps-set-color fg-color))
5302 (if (not (equal bg-color ps-current-bg))
5303 (ps-set-bg bg-color))
5305 ;; Specify effects (underline, overline, box, etc)
5306 (cond
5307 ((not (integerp effects))
5308 (ps-output "0 EF\n")
5309 (setq ps-current-effect 0))
5310 ((/= effects ps-current-effect)
5311 (ps-output (number-to-string effects) " EF\n")
5312 (setq ps-current-effect effects)))
5314 ;; Starting at the beginning of the specified region...
5315 (save-excursion
5316 (goto-char from)
5318 ;; ...break the region up into chunks separated by tabs, linefeeds,
5319 ;; pagefeeds, control characters, and plot each chunk.
5320 (while (< from to)
5321 ;; skip lines between cut markers
5322 (and ps-begin-cut-regexp ps-end-cut-regexp
5323 (looking-at ps-begin-cut-regexp)
5324 (progn
5325 (goto-char (match-end 0))
5326 (and (re-search-forward ps-end-cut-regexp to 'noerror)
5327 (= (following-char) ?\n)
5328 (forward-char 1))
5329 (setq from (point))))
5330 (if (re-search-forward ps-control-or-escape-regexp to t)
5331 ;; region with some control characters or some multi-byte characters
5332 (let* ((match-point (match-beginning 0))
5333 (match (char-after match-point))
5334 (composition (ps-e-find-composition from (1+ match-point))))
5335 (if composition
5336 (if (and (nth 2 composition)
5337 (<= (car composition) match-point))
5338 (progn
5339 (setq match-point (car composition)
5340 match 0)
5341 (goto-char (nth 1 composition)))
5342 (setq composition nil)))
5343 (when (< from match-point)
5344 (ps-mule-set-ascii-font)
5345 (ps-plot 'ps-basic-plot-string from match-point bg-color))
5346 (cond
5347 ((= match ?\t) ; tab
5348 (let ((linestart (line-beginning-position)))
5349 (forward-char -1)
5350 (setq from (+ linestart (current-column)))
5351 (when (re-search-forward "[ \t]+" to t)
5352 (ps-mule-set-ascii-font)
5353 (ps-plot 'ps-basic-plot-whitespace
5354 from (+ linestart (current-column))
5355 bg-color))))
5357 ((= match ?\n) ; newline
5358 (if (looking-at "\f[^\n]")
5359 ;; \n\ftext\n ==>> next page, but keep line counting!!
5360 (progn
5361 (ps-skip-newline to)
5362 (ps-next-page))
5363 ;; \n\f\n ==>> it'll be handled by form feed
5364 ;; \ntext\n ==>> next line
5365 (ps-next-line)))
5367 ((= match ?\f) ; form feed
5368 ;; do not skip page if previous character is NEWLINE and
5369 ;; it is a beginning of page.
5370 (unless (and (equal (char-after (1- match-point)) ?\n)
5371 (= ps-height-remaining ps-print-height))
5372 ;; \f\n ==>> skip \n, but keep line counting!!
5373 (and (equal (following-char) ?\n)
5374 (ps-skip-newline to))
5375 (ps-next-page)))
5377 (composition ; a composite sequence
5378 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
5380 ((> match 255) ; a multi-byte character
5381 (let* ((charset (char-charset match))
5382 (composition (ps-e-find-composition match-point to))
5383 (stop (if (nth 2 composition) (car composition) to)))
5384 (or (eq charset 'composition)
5385 (while (and (< (point) stop) (eq (charset-after) charset))
5386 (forward-char 1)))
5387 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
5388 ; characters from ^@ to ^_ and
5389 (t ; characters from 127 to 255
5390 (ps-control-character match)))
5391 (setq from (point)))
5392 ;; region without control characters nor multi-byte characters
5393 (ps-mule-set-ascii-font)
5394 (ps-plot 'ps-basic-plot-string from to bg-color)
5395 (setq from to)))))
5397 (defvar ps-string-control-codes
5398 (let ((table (make-vector 256 nil))
5399 (char ?\000))
5400 ;; control character
5401 (while (<= char ?\037)
5402 (aset table char (format "^%c" (+ char ?@)))
5403 (setq char (1+ char)))
5404 ;; printable character
5405 (while (< char ?\177)
5406 (aset table char (format "%c" char))
5407 (setq char (1+ char)))
5408 ;; DEL
5409 (aset table char "^?")
5410 ;; 8-bit character
5411 (while (<= (setq char (1+ char)) ?\377)
5412 (aset table char (format "\\%o" char)))
5413 table)
5414 "Vector used to map characters to a printable string.")
5416 (defun ps-control-character (char)
5417 (let* ((str (aref ps-string-control-codes char))
5418 (from (1- (point)))
5419 (len (length str))
5420 (to (+ from len))
5421 (char-width (ps-avg-char-width 'ps-font-for-text))
5422 (wrappoint (ps-find-wrappoint from to char-width)))
5423 (if (< (car wrappoint) to)
5424 (ps-continue-line))
5425 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
5426 (ps-mule-prepare-ascii-font str)
5427 (ps-output-string str)
5428 (ps-output " S\n")))
5431 (defun ps-face-attributes (face)
5432 "Return face attribute vector.
5434 If FACE is not in `ps-print-face-extension-alist' or in
5435 `ps-print-face-alist', insert it on `ps-print-face-alist' and
5436 return the attribute vector.
5438 If FACE is not a valid face name, it is used default face."
5439 (cond
5440 ((symbolp face)
5441 (cdr (or (assq face ps-print-face-extension-alist)
5442 (assq face ps-print-face-alist)
5443 (let* ((the-face (if (facep face) face 'default))
5444 (new-face (ps-screen-to-bit-face the-face)))
5445 (or (and (eq the-face 'default)
5446 (assq the-face ps-print-face-alist))
5447 (setq ps-print-face-alist
5448 (cons new-face ps-print-face-alist)))
5449 new-face))))
5450 ((eq (car face) 'foreground-color)
5451 (vector 0 (cdr face) nil))
5452 ((eq (car face) 'background-color)
5453 (vector 0 nil (cdr face)))
5455 (vector 0 nil nil))))
5458 (defun ps-face-background (face background)
5459 (and (or (eq ps-use-face-background t)
5460 (cond ((symbolp face)
5461 (memq face ps-use-face-background))
5462 ((listp face)
5463 (or (memq (car face) '(foreground-color background-color))
5464 (let (ok)
5465 (while face
5466 (if (or (memq (car face) ps-use-face-background)
5467 (memq (car face)
5468 '(foreground-color background-color)))
5469 (setq face nil
5470 ok t)
5471 (setq face (cdr face))))
5472 ok)))
5474 nil)
5476 background))
5479 (defun ps-face-attribute-list (face-or-list)
5480 (cond
5481 ;; simple face
5482 ((not (listp face-or-list))
5483 (ps-face-attributes face-or-list))
5484 ;; only foreground color, not a `real' face
5485 ((eq (car face-or-list) 'foreground-color)
5486 (vector 0 (cdr face-or-list) nil))
5487 ;; only background color, not a `real' face
5488 ((eq (car face-or-list) 'background-color)
5489 (vector 0 nil (cdr face-or-list)))
5490 ;; list of faces
5492 (let ((effects 0)
5493 foreground background face-attr face)
5494 (while face-or-list
5495 (setq face (car face-or-list)
5496 face-or-list (cdr face-or-list)
5497 face-attr (ps-face-attributes face)
5498 effects (logior effects (aref face-attr 0)))
5499 (or foreground (setq foreground (aref face-attr 1)))
5500 (or background
5501 (setq background (ps-face-background face (aref face-attr 2)))))
5502 (vector effects foreground background)))))
5505 (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
5508 (defun ps-plot-with-face (from to face)
5509 (cond
5510 ((null face) ; print text with null face
5511 (ps-plot-region from to 0))
5512 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
5513 (t ; otherwise, text has a valid face
5514 (let* ((face-bit (ps-face-attribute-list face))
5515 (effect (aref face-bit 0))
5516 (foreground (aref face-bit 1))
5517 (background (ps-face-background face (aref face-bit 2)))
5518 (fg-color (if (and ps-color-p foreground)
5519 (ps-color-scale foreground)
5520 ps-default-color))
5521 (bg-color (and ps-color-p background
5522 (ps-color-scale background))))
5523 (ps-plot-region
5524 from to
5525 (ps-font-number 'ps-font-for-text
5526 (or (aref ps-font-type (logand effect 3))
5527 face))
5528 fg-color bg-color (lsh effect -2)))))
5529 (goto-char to))
5532 ;; Ensure that face-list is fbound.
5533 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
5536 (defun ps-build-reference-face-lists ()
5537 ;; Ensure that face database is updated with faces on
5538 ;; `font-lock-face-attributes' (obsolete stuff)
5539 (ps-font-lock-face-attributes)
5540 ;; Now, rebuild reference face lists
5541 (setq ps-print-face-alist nil)
5542 (if ps-auto-font-detect
5543 (mapcar 'ps-map-face (face-list))
5544 (mapcar 'ps-set-face-bold ps-bold-faces)
5545 (mapcar 'ps-set-face-italic ps-italic-faces)
5546 (mapcar 'ps-set-face-underline ps-underlined-faces))
5547 (setq ps-build-face-reference nil))
5550 (defun ps-set-face-bold (face)
5551 (ps-set-face-attribute face 1))
5553 (defun ps-set-face-italic (face)
5554 (ps-set-face-attribute face 2))
5556 (defun ps-set-face-underline (face)
5557 (ps-set-face-attribute face 4))
5560 (defun ps-set-face-attribute (face effect)
5561 (let ((face-bit (cdr (ps-map-face face))))
5562 (aset face-bit 0 (logior (aref face-bit 0) effect))))
5565 (defun ps-map-face (face)
5566 (let* ((face-map (ps-screen-to-bit-face face))
5567 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
5568 (if ps-face-bit
5569 ;; if face exists, merge both
5570 (let ((face-bit (cdr face-map)))
5571 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
5572 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
5573 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
5574 ;; if face does not exist, insert it
5575 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
5576 face-map))
5579 (defun ps-screen-to-bit-face (face)
5580 (cons face
5581 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
5582 (if (ps-face-italic-p face) 2 0) ; italic
5583 (if (ps-face-underlined-p face) 4 0)) ; underline
5584 (ps-face-foreground-name face)
5585 (ps-face-background-name face))))
5588 ;; to avoid compilation gripes
5589 (defun ps-print-ensure-fontified (start end)
5590 (cond
5591 ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
5592 (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
5593 (ps-jitify start end))
5594 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
5595 (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
5596 (ps-lazify start end))))
5599 (defun ps-generate-postscript-with-faces (from to)
5600 ;; Some initialization...
5601 (setq ps-current-effect 0)
5603 ;; Build the reference lists of faces if necessary.
5604 (when (or ps-always-build-face-reference
5605 ps-build-face-reference)
5606 (message "Collecting face information...")
5607 (ps-build-reference-face-lists))
5608 ;; Generate some PostScript.
5609 (save-restriction
5610 (narrow-to-region from to)
5611 (ps-print-ensure-fontified from to)
5612 (let ((face 'default)
5613 (position to))
5614 (cond
5615 ((memq ps-print-emacs-type '(xemacs lucid))
5616 ;; Build the list of extents...
5617 (let ((a (cons 'dummy nil))
5618 record type extent extent-list)
5619 (ps-x-map-extents 'ps-mapper nil from to a)
5620 (setq a (sort (cdr a) 'car-less-than-car)
5621 extent-list nil)
5623 ;; Loop through the extents...
5624 (while a
5625 (setq record (car a)
5626 position (car record)
5628 record (cdr record)
5629 type (car record)
5631 record (cdr record)
5632 extent (car record))
5634 ;; Plot up to this record.
5635 ;; XEmacs 19.12: for some reason, we're getting into a
5636 ;; situation in which some of the records have
5637 ;; positions less than 'from'. Since we've narrowed
5638 ;; the buffer, this'll generate errors. This is a hack,
5639 ;; but don't call ps-plot-with-face unless from > point-min.
5640 (and (>= from (point-min))
5641 (ps-plot-with-face from (min position (point-max)) face))
5643 (cond
5644 ((eq type 'push)
5645 (and (ps-x-extent-face extent)
5646 (setq extent-list (sort (cons extent extent-list)
5647 'ps-extent-sorter))))
5649 ((eq type 'pull)
5650 (setq extent-list (sort (delq extent extent-list)
5651 'ps-extent-sorter))))
5653 (setq face (if extent-list
5654 (ps-x-extent-face (car extent-list))
5655 'default)
5656 from position
5657 a (cdr a)))))
5659 ((eq ps-print-emacs-type 'emacs)
5660 (let ((property-change from)
5661 (overlay-change from)
5662 (save-buffer-invisibility-spec buffer-invisibility-spec)
5663 (buffer-invisibility-spec nil))
5664 (while (< from to)
5665 (and (< property-change to) ; Don't search for property change
5666 ; unless previous search succeeded.
5667 (setq property-change (next-property-change from nil to)))
5668 (and (< overlay-change to) ; Don't search for overlay change
5669 ; unless previous search succeeded.
5670 (setq overlay-change (min (ps-e-next-overlay-change from)
5671 to)))
5672 (setq position (min property-change overlay-change))
5673 ;; The code below is not quite correct,
5674 ;; because a non-nil overlay invisible property
5675 ;; which is inactive according to the current value
5676 ;; of buffer-invisibility-spec nonetheless overrides
5677 ;; a face text property.
5678 (setq face
5679 (cond ((let ((prop (get-text-property from 'invisible)))
5680 ;; Decide whether this invisible property
5681 ;; really makes the text invisible.
5682 (if (eq save-buffer-invisibility-spec t)
5683 (not (null prop))
5684 (or (memq prop save-buffer-invisibility-spec)
5685 (assq prop save-buffer-invisibility-spec))))
5686 'emacs--invisible--face)
5687 ((get-text-property from 'face))
5688 (t 'default)))
5689 (let ((overlays (ps-e-overlays-at from))
5690 (face-priority -1)) ; text-property
5691 (while (and overlays
5692 (not (eq face 'emacs--invisible--face)))
5693 (let* ((overlay (car overlays))
5694 (overlay-invisible (ps-e-overlay-get overlay 'invisible))
5695 (overlay-priority (or (ps-e-overlay-get overlay 'priority)
5696 0)))
5697 (and (> overlay-priority face-priority)
5698 (setq face
5699 (cond ((if (eq save-buffer-invisibility-spec t)
5700 (not (null overlay-invisible))
5701 (or (memq overlay-invisible
5702 save-buffer-invisibility-spec)
5703 (assq overlay-invisible
5704 save-buffer-invisibility-spec)))
5705 'emacs--invisible--face)
5706 ((ps-e-overlay-get overlay 'face))
5707 (t face))
5708 face-priority overlay-priority)))
5709 (setq overlays (cdr overlays))))
5710 ;; Plot up to this record.
5711 (ps-plot-with-face from position face)
5712 (setq from position)))))
5713 (ps-plot-with-face from to face))))
5715 (defun ps-generate-postscript (from to)
5716 (ps-plot-region from to 0 nil))
5718 (defun ps-generate (buffer from to genfunc)
5719 (save-excursion
5720 (let ((from (min to from))
5721 (to (max to from))
5722 ;; This avoids trouble if chars with read-only properties
5723 ;; are copied into ps-spool-buffer.
5724 (inhibit-read-only t))
5725 (save-restriction
5726 (narrow-to-region from to)
5727 (and ps-razzle-dazzle
5728 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
5729 (setq ps-source-buffer buffer
5730 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
5731 (ps-init-output-queue)
5732 (let (safe-marker completed-safely needs-begin-file)
5733 (unwind-protect
5734 (progn
5735 (set-buffer ps-spool-buffer)
5736 (set-buffer-multibyte nil)
5738 ;; Get a marker and make it point to the current end of the
5739 ;; buffer, If an error occurs, we'll delete everything from
5740 ;; the end of this marker onwards.
5741 (setq safe-marker (make-marker))
5742 (set-marker safe-marker (point-max))
5744 (goto-char (point-min))
5745 (or (looking-at (regexp-quote ps-adobe-tag))
5746 (setq needs-begin-file t))
5748 (set-buffer ps-source-buffer)
5749 (save-excursion
5750 (let ((ps-print-page-p t)
5751 ps-even-or-odd-pages)
5752 (ps-begin-job)
5753 (when needs-begin-file
5754 (ps-begin-file)
5755 (ps-mule-initialize))
5756 (ps-mule-begin-job from to)
5757 (ps-selected-pages)))
5758 (ps-begin-page)
5759 (funcall genfunc from to)
5760 (ps-end-page)
5761 (ps-end-job needs-begin-file)
5763 ;; Setting this variable tells the unwind form that the
5764 ;; the PostScript was generated without error.
5765 (setq completed-safely t))
5767 ;; Unwind form: If some bad mojo occurred while generating
5768 ;; PostScript, delete all the PostScript that was generated.
5769 ;; This protects the previously spooled files from getting
5770 ;; corrupted.
5771 (and (markerp safe-marker) (not completed-safely)
5772 (progn
5773 (set-buffer ps-spool-buffer)
5774 (delete-region (marker-position safe-marker) (point-max))))))
5776 (and ps-razzle-dazzle (message "Formatting...done"))))))
5779 (defun ps-end-job (needs-begin-file)
5780 (let ((previous-print ps-print-page-p)
5781 (ps-print-page-p t))
5782 (ps-flush-output)
5783 (save-excursion
5784 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
5785 (total-lines (cdr ps-printing-region))
5786 (total-pages (ps-page-number)))
5787 (set-buffer ps-spool-buffer)
5788 (let (case-fold-search)
5789 ;; Back to the PS output buffer to set the last page n-up printing
5790 (goto-char (point-max))
5791 (and (> pages-per-sheet 0)
5792 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
5793 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
5794 ;; Back to the PS output buffer to set the page count
5795 (goto-char (point-min))
5796 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
5797 (replace-match (format "/Lines %d def\n/PageCount %d def"
5798 total-lines total-pages) t)))))
5799 ;; Set dummy page
5800 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
5801 (let ((ps-n-up-printing 0))
5802 (ps-header-sheet)
5803 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
5804 "/PrintLineNumber false def\n"
5805 (number-to-string ps-lines-printed) " BeginPage\n")
5806 (ps-end-page)))
5807 ;; Set end of PostScript file
5808 (and previous-print
5809 (ps-output "EndSheet\n"))
5810 (ps-output "\n%%Trailer\n%%Pages: "
5811 (number-to-string
5812 (if (and needs-begin-file
5813 ps-banner-page-when-duplexing)
5814 (1+ ps-page-order)
5815 ps-page-order))
5816 "\n\nEndDoc\n\n%%EOF\n")
5817 (and ps-end-with-control-d
5818 (ps-output "\C-d"))
5819 (ps-flush-output))
5820 ;; disable selected pages
5821 (setq ps-selected-pages nil))
5824 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
5825 (defun ps-do-despool (filename)
5826 (if (or (not (boundp 'ps-spool-buffer))
5827 (not (symbol-value 'ps-spool-buffer)))
5828 (message "No spooled PostScript to print")
5829 (if filename
5830 (save-excursion
5831 (and ps-razzle-dazzle (message "Saving..."))
5832 (set-buffer ps-spool-buffer)
5833 (setq filename (expand-file-name filename))
5834 (let ((coding-system-for-write 'raw-text-unix))
5835 (write-region (point-min) (point-max) filename))
5836 (and ps-razzle-dazzle (message "Wrote %s" filename)))
5837 ;; Else, spool to the printer
5838 (and ps-razzle-dazzle (message "Printing..."))
5839 (save-excursion
5840 (set-buffer ps-spool-buffer)
5841 (let* ((coding-system-for-write 'raw-text-unix)
5842 (ps-printer-name (or ps-printer-name
5843 (and (boundp 'printer-name)
5844 (symbol-value 'printer-name))))
5845 (ps-lpr-switches
5846 (append ps-lpr-switches
5847 (and (stringp ps-printer-name)
5848 (string< "" ps-printer-name)
5849 (list (concat
5850 (and (stringp ps-printer-name-option)
5851 ps-printer-name-option)
5852 ps-printer-name))))))
5853 (apply (or ps-print-region-function 'call-process-region)
5854 (point-min) (point-max) ps-lpr-command nil
5855 (and (fboundp 'start-process) 0)
5857 (ps-flatten-list ; dynamic evaluation
5858 (mapcar 'ps-eval-switch ps-lpr-switches)))))
5859 (and ps-razzle-dazzle (message "Printing...done")))
5860 (kill-buffer ps-spool-buffer)))
5862 ;; Dynamic evaluation
5863 (defun ps-eval-switch (arg)
5864 (cond ((stringp arg) arg)
5865 ((functionp arg) (apply arg nil))
5866 ((symbolp arg) (symbol-value arg))
5867 ((consp arg) (apply (car arg) (cdr arg)))
5868 (t nil)))
5870 ;; `ps-flatten-list' is defined here (copied from "message.el" and
5871 ;; enhanced to handle dotted pairs as well) until we can get some
5872 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
5874 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
5875 ;; => (a b c d e f g h i j)
5877 (defun ps-flatten-list (&rest list)
5878 (ps-flatten-list-1 list))
5880 (defun ps-flatten-list-1 (list)
5881 (cond ((null list) nil)
5882 ((consp list) (append (ps-flatten-list-1 (car list))
5883 (ps-flatten-list-1 (cdr list))))
5884 (t (list list))))
5886 (defun ps-kill-emacs-check ()
5887 (let (ps-buffer)
5888 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
5889 (buffer-modified-p ps-buffer)
5890 (y-or-n-p "Unprinted PostScript waiting; print now? ")
5891 (ps-despool))
5892 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
5893 (buffer-modified-p ps-buffer)
5894 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
5895 (error "Unprinted PostScript"))))
5897 (cond ((fboundp 'add-hook)
5898 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
5899 (kill-emacs-hook
5900 (message "Won't override existing `kill-emacs-hook'"))
5902 (setq kill-emacs-hook 'ps-kill-emacs-check)))
5905 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5906 ;;; Sample Setup Code:
5909 ;; This stuff is for anybody that's brave enough to look this far,
5910 ;; and able to figure out how to use it. It isn't really part of
5911 ;; ps-print, but I'll leave it here in hopes it might be useful:
5913 ;; WARNING!!! The following code is *sample* code only.
5914 ;; Don't use it unless you understand what it does!
5916 (defmacro ps-prsc ()
5917 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
5918 (defmacro ps-c-prsc ()
5919 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
5920 (defmacro ps-s-prsc ()
5921 `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
5923 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
5924 ;; `ps-left-headers' specially for mail messages.
5925 (defun ps-rmail-mode-hook ()
5926 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
5927 (setq ps-header-lines 3
5928 ps-left-header
5929 ;; The left headers will display the message's subject, its
5930 ;; author, and the name of the folder it was in.
5931 '(ps-article-subject ps-article-author buffer-name)))
5933 ;; See `ps-gnus-print-article-from-summary'. This function does the
5934 ;; same thing for rmail.
5935 (defun ps-rmail-print-message-from-summary ()
5936 (interactive)
5937 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
5939 ;; Used in `ps-rmail-print-article-from-summary',
5940 ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
5941 (defun ps-print-message-from-summary (summary-buffer summary-default)
5942 (let ((ps-buf (or (and (boundp summary-buffer)
5943 (symbol-value summary-buffer))
5944 summary-default)))
5945 (and (get-buffer ps-buf)
5946 (save-excursion
5947 (set-buffer ps-buf)
5948 (ps-spool-buffer-with-faces)))))
5950 ;; Look in an article or mail message for the Subject: line. To be
5951 ;; placed in `ps-left-headers'.
5952 (defun ps-article-subject ()
5953 (save-excursion
5954 (goto-char (point-min))
5955 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
5956 (buffer-substring (match-beginning 1) (match-end 1))
5957 "Subject ???")))
5959 ;; Look in an article or mail message for the From: line. Sorta-kinda
5960 ;; understands RFC-822 addresses and can pull the real name out where
5961 ;; it's provided. To be placed in `ps-left-headers'.
5962 (defun ps-article-author ()
5963 (save-excursion
5964 (goto-char (point-min))
5965 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
5966 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
5967 (cond
5969 ;; Try first to match addresses that look like
5970 ;; thompson@wg2.waii.com (Jim Thompson)
5971 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
5972 (substring fromstring (match-beginning 1) (match-end 1)))
5974 ;; Next try to match addresses that look like
5975 ;; Jim Thompson <thompson@wg2.waii.com> or
5976 ;; "Jim Thompson" <thompson@wg2.waii.com>
5977 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
5978 (substring fromstring (match-beginning 2) (match-end 2)))
5980 ;; Couldn't find a real name -- show the address instead.
5981 (t fromstring)))
5982 "From ???")))
5984 ;; A hook to bind to `gnus-article-prepare-hook'. This will set the
5985 ;; `ps-left-headers' specially for gnus articles. Unfortunately,
5986 ;; `gnus-article-mode-hook' is called only once, the first time the *Article*
5987 ;; buffer enters that mode, so it would only work for the first time
5988 ;; we ran gnus. The second time, this hook wouldn't get set up. The
5989 ;; only alternative is `gnus-article-prepare-hook'.
5990 (defun ps-gnus-article-prepare-hook ()
5991 (setq ps-header-lines 3
5992 ps-left-header
5993 ;; The left headers will display the article's subject, its
5994 ;; author, and the newsgroup it was in.
5995 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
5997 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
5998 ;; `ps-left-headers' specially for mail messages.
5999 (defun ps-vm-mode-hook ()
6000 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
6001 (setq ps-header-lines 3
6002 ps-left-header
6003 ;; The left headers will display the message's subject, its
6004 ;; author, and the name of the folder it was in.
6005 '(ps-article-subject ps-article-author buffer-name)))
6007 ;; Every now and then I forget to switch from the *Summary* buffer to
6008 ;; the *Article* before hitting prsc, and a nicely formatted list of
6009 ;; article subjects shows up at the printer. This function, bound to
6010 ;; prsc for the gnus *Summary* buffer means I don't have to switch
6011 ;; buffers first.
6012 ;; sb: Updated for Gnus 5.
6013 (defun ps-gnus-print-article-from-summary ()
6014 (interactive)
6015 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
6017 ;; See `ps-gnus-print-article-from-summary'. This function does the
6018 ;; same thing for vm.
6019 (defun ps-vm-print-message-from-summary ()
6020 (interactive)
6021 (ps-print-message-from-summary 'vm-mail-buffer ""))
6023 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
6024 ;; prsc.
6025 (defun ps-gnus-summary-setup ()
6026 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
6028 ;; Look in an article or mail message for the Subject: line. To be
6029 ;; placed in `ps-left-headers'.
6030 (defun ps-info-file ()
6031 (save-excursion
6032 (goto-char (point-min))
6033 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
6034 (buffer-substring (match-beginning 1) (match-end 1))
6035 "File ???")))
6037 ;; Look in an article or mail message for the Subject: line. To be
6038 ;; placed in `ps-left-headers'.
6039 (defun ps-info-node ()
6040 (save-excursion
6041 (goto-char (point-min))
6042 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
6043 (buffer-substring (match-beginning 1) (match-end 1))
6044 "Node ???")))
6046 (defun ps-info-mode-hook ()
6047 (setq ps-left-header
6048 ;; The left headers will display the node name and file name.
6049 '(ps-info-node ps-info-file)))
6051 ;; WARNING! The following function is a *sample* only, and is *not*
6052 ;; meant to be used as a whole unless you understand what the effects
6053 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
6054 ;; I'd be very surprised if it was useful to *anybody*, without
6055 ;; modification.)
6057 (defun ps-jts-ps-setup ()
6058 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
6059 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
6060 (global-set-key (ps-c-prsc) 'ps-despool)
6061 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
6062 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
6063 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
6064 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
6065 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
6066 (setq ps-spool-duplex t
6067 ps-print-color-p nil
6068 ps-lpr-command "lpr"
6069 ps-lpr-switches '("-Jjct,duplex_long"))
6070 'ps-jts-ps-setup)
6072 ;; WARNING! The following function is a *sample* only, and is *not*
6073 ;; meant to be used as a whole unless it corresponds to your needs.
6074 ;; (In fact, this is a copy of Jack's setup for ps-print --
6075 ;; I would not be that surprised if it was useful to *anybody*,
6076 ;; without modification.)
6078 (defun ps-jack-setup ()
6079 (setq ps-print-color-p nil
6080 ps-lpr-command "lpr"
6081 ps-lpr-switches nil
6083 ps-paper-type 'a4
6084 ps-landscape-mode t
6085 ps-number-of-columns 2
6087 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6088 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6089 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
6090 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6091 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6092 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
6093 ps-header-line-pad .15
6094 ps-print-header t
6095 ps-print-header-frame t
6096 ps-header-lines 2
6097 ps-show-n-of-n t
6098 ps-spool-duplex nil
6100 ps-font-family 'Courier
6101 ps-font-size 5.5
6102 ps-header-font-family 'Helvetica
6103 ps-header-font-size 6
6104 ps-header-title-font-size 8)
6105 'ps-jack-setup)
6108 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6109 ;; To make this file smaller, some commands go in a separate file.
6110 ;; But autoload them here to make the separation invisible.
6112 (autoload 'ps-mule-prepare-ascii-font "ps-mule"
6113 "Setup special ASCII font for STRING.
6114 STRING should contain only ASCII characters.")
6116 (autoload 'ps-mule-set-ascii-font "ps-mule"
6117 "Adjust current font if current charset is not ASCII.")
6119 (autoload 'ps-mule-plot-string "ps-mule"
6120 "Generate PostScript code for plotting characters in the region FROM and TO.
6122 It is assumed that all characters in this region belong to the same charset.
6124 Optional argument BG-COLOR specifies background color.
6126 Returns the value:
6128 (ENDPOS . RUN-WIDTH)
6130 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
6131 the sequence.")
6133 (autoload 'ps-mule-initialize "ps-mule"
6134 "Initialize global data for printing multi-byte characters.")
6136 (autoload 'ps-mule-begin-job "ps-mule"
6137 "Start printing job for multi-byte chars between FROM and TO.
6138 This checks if all multi-byte characters in the region are printable or not.")
6140 (autoload 'ps-mule-begin-page "ps-mule"
6141 "Initialize multi-byte charset for printing current page.")
6143 (autoload 'ps-mule-encode-header-string "ps-mule"
6144 "Generate PostScript code for plotting characters in header STRING.
6146 It is assumed that the length of STRING is not zero.")
6149 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6151 (provide 'ps-print)
6153 ;;; ps-print.el ends here