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