(Trailing Whitespace): Document that the option is buffer-local.
[bpt/emacs.git] / lisp / ps-print.el
CommitLineData
652a9be9 1;;; ps-print.el --- print text from the buffer as PostScript
12d89a2e 2
2bd80d73 3;; Copyright (C) 1993,94,95,96,97,98,99,00,2001
967b06fd 4;; Free Software Foundation, Inc.
ef2cbb24 5
652a9be9
PJ
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/
e65df0a1 16
4b81a999
GM
17(defconst ps-print-version "6.5.3"
18 "ps-print.el, v 6.5.3 <2001/06/19 vinicius>
090be653 19
535efc38 20Vinicius's last change version -- this file may have been edited as part of
906d41a7
GM
21Emacs without changes to the version number. When reporting bugs, please also
22report the version of Emacs, if any, that ps-print was distributed with.
090be653
RS
23
24Please send all bug fixes and enhancements to
8bd22fcf 25 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
090be653 26")
ef2cbb24 27
86c10ecb 28;; This file is part of GNU Emacs.
ef2cbb24 29
319acba0
GM
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.
ef2cbb24 34
319acba0
GM
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.
ef2cbb24 39
319acba0
GM
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.
ef2cbb24 43
12d89a2e 44;;; Commentary:
ef2cbb24 45
bc0d41bd 46;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ef2cbb24 47;;
12d89a2e 48;; About ps-print
ef2cbb24 49;; --------------
bcc0d457 50;;
319acba0
GM
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
0a5daee5
KH
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.
12d89a2e 55;;
319acba0
GM
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.
87a16a06
RS
59;;
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).
64;;
bcc0d457 65;;
12d89a2e 66;; Using ps-print
ef2cbb24 67;; --------------
ef2cbb24 68;;
319acba0
GM
69;; ps-print provides eight commands for generating PostScript images of Emacs
70;; buffers:
12d89a2e
RS
71;;
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
80;;
319acba0
GM
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".
12d89a2e
RS
85;;
86;; The word "print" or "spool" in the command name determines when the
87;; PostScript image is sent to the printer:
ef2cbb24 88;;
319acba0 89;; print - The PostScript image is immediately sent to the printer;
ef2cbb24 90;;
319acba0
GM
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'.
ef2cbb24 95;;
319acba0
GM
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).
06fb6aab 101;;
319acba0
GM
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.
12d89a2e 108;;
319acba0
GM
109;; The word "buffer" or "region" in the command name determines how much of the
110;; buffer is printed:
12d89a2e
RS
111;;
112;; buffer - Print the entire buffer.
113;;
114;; region - Print just the current region.
115;;
319acba0
GM
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.
12d89a2e
RS
122;;
123;; Two ps-print- command examples:
124;;
319acba0
GM
125;; ps-print-buffer - print the entire buffer, without font,
126;; color, or underline information, and
127;; send it immediately to the printer.
12d89a2e 128;;
319acba0
GM
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.
12d89a2e
RS
133;;
134;;
135;; Invoking Ps-Print
bcc0d457 136;; -----------------
ef2cbb24 137;;
12d89a2e 138;; To print your buffer, type
ef2cbb24 139;;
12d89a2e 140;; M-x ps-print-buffer
ef2cbb24 141;;
319acba0
GM
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
12d89a2e
RS
145;;
146;; C-u M-x ps-print-buffer
147;;
319acba0
GM
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':
12d89a2e
RS
153;;
154;; C-u M-x ps-despool
155;;
319acba0
GM
156;; When invoked this way, `ps-despool' will prompt you for the name of the file
157;; to save to.
12d89a2e 158;;
319acba0
GM
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:
12d89a2e
RS
162;;
163;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
ef2cbb24
RS
164;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
165;; (global-set-key '(control f22) 'ps-despool)
166;;
12d89a2e
RS
167;;
168;; The Printer Interface
bcc0d457 169;; ---------------------
12d89a2e 170;;
319acba0
GM
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'.
87a16a06 174;;
bcc0d457
RS
175;; Make sure that they contain appropriate values for your system;
176;; see the usage notes below and the documentation of these variables.
177;;
bc0d41bd 178;; The variable `ps-printer-name' determines the name of a local printer for
d3ab8dac
KH
179;; printing PostScript files.
180;;
3556c6dd
GM
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".
185;;
319acba0
GM
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.
d3ab8dac 191;; `ps-printer-name' takes its initial value from the variable
3556c6dd
GM
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.
12d89a2e 195;;
bc0d41bd
KH
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.
200;;
8e234846
GM
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).
204;;
ef1159c2
EZ
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).
208;;
98f2fbe7 209;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
3556c6dd
GM
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.
edc9cd35 214;;
12d89a2e 215;;
bcc0d457
RS
216;; The Page Layout
217;; ---------------
12d89a2e 218;;
bcc0d457
RS
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
12d89a2e 222;;
906d41a7
GM
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'.
12d89a2e 227;;
8e234846
GM
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).
235;;
906d41a7
GM
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.
bcc0d457 238;; There is no oblique mode yet, though this is easy to do in ps.
87a16a06 239;;
319acba0
GM
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.
043620f4 244;;
906d41a7
GM
245;; The variable `ps-number-of-columns' determines the number of columns both in
246;; landscape and portrait mode.
bcc0d457 247;; You can use:
906d41a7
GM
248;; - (the standard) one column portrait mode.
249;; - (my favorite) two columns landscape mode (which spares trees).
250;; but also:
bcc0d457 251;; - one column landscape mode for files with very long lines.
906d41a7
GM
252;; - multi-column portrait or landscape mode.
253;;
319acba0
GM
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).
906d41a7
GM
258;;
259;; The `upside-down' orientation can be used in portrait or landscape mode.
12d89a2e 260;;
1fd9b7fe
GM
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).
271;;
c3d6d211
GM
272;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
273;;
274;; Valid values are:
275;;
276;; nil print all pages.
277;;
4b3eb10f 278;; even-page print only even pages.
c3d6d211 279;;
4b3eb10f
GM
280;; odd-page print only odd pages.
281;;
282;; even-sheet print only even sheets.
283;;
284;; odd-sheet print only odd sheets.
c3d6d211
GM
285;;
286;; Any other value is treated as nil. The default value is nil.
287;;
4b3eb10f
GM
288;; See `ps-even-or-odd-pages' for more detailed documentation.
289;;
12d89a2e 290;;
bcc0d457
RS
291;; Horizontal layout
292;; -----------------
12d89a2e 293;;
bcc0d457
RS
294;; The horizontal layout is determined by the variables
295;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
296;; as follows:
12d89a2e 297;;
bcc0d457
RS
298;; ------------------------------------------
299;; | | | | | | | |
300;; | lm | text | ic | text | ic | text | rm |
301;; | | | | | | | |
302;; ------------------------------------------
12d89a2e 303;;
bcc0d457
RS
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.
12d89a2e 307;;
12d89a2e 308;;
bcc0d457
RS
309;; Vertical layout
310;; ---------------
311;;
312;; The vertical layout is determined by the variables
319acba0 313;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' `ps-footer-offset'
bcc0d457
RS
314;; as follows:
315;;
319acba0
GM
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;; |--------| |--------| |--------| |--------|
bcc0d457
RS
333;;
334;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
319acba0 335;; If `ps-print-footer' is nil, `ps-footer-offset' is not relevant.
bcc0d457 336;; The margins represent margins in the printed paper:
319acba0
GM
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.
12d89a2e
RS
341;;
342;;
319acba0
GM
343;; Headers & Footers
344;; -----------------
12d89a2e 345;;
319acba0
GM
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:
12d89a2e
RS
351;;
352;; ps-print.el 1/21
353;; /home/jct/emacs-lisp/ps/new 94/12/31
06fb6aab 354;;
319acba0
GM
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').
12d89a2e 357;;
bcc0d457
RS
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.
362;;
319acba0
GM
363;; The variable `ps-header-frame-alist' specifies header frame properties
364;; alist. Valid frame properties are:
365;;
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").
373;;
374;; back-color Specify the background frame color (similar to
375;; fore-color). The default is 0.9 ("gray90").
376;;
377;; shadow-color Specify the shadow color (similar to fore-color).
378;; The default is 0 ("black").
379;;
380;; border-color Specify the border color (similar to fore-color).
381;; The default is 0 ("black").
382;;
383;; border-width Specify the border width.
384;; The default is 0.4.
385;;
386;; Any other property is ignored.
387;;
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).
390;;
391;; To print only one header at the top of each page, set
392;; `ps-print-only-one-header' to t.
12b88fff 393;;
8e234846
GM
394;; To switch headers, set `ps-switch-header' to:
395;;
396;; nil Never switch headers.
397;;
398;; t Always switch headers.
399;;
400;; duplex Switch headers only when duplexing is on, that is, when
401;; `ps-spool-duplex' is non-nil (see Duplex Printers).
402;;
403;; Any other value is treated as t. The default value is `duplex'.
404;;
319acba0
GM
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
bcc0d457
RS
407;; `ps-header-title-font-size' (see below).
408;;
319acba0
GM
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.
412;;
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.
416;;
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.
422;;
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 ')'.
429;;
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.
12d89a2e
RS
435;;
436;; Here's an example: say we want the left header to display the text
437;;
438;; Moe
439;; Larry
440;; Curly
441;;
442;; where we have a function to return "Moe"
443;;
444;; (defun moe-func ()
445;; "Moe")
446;;
447;; a variable specifying "Larry"
448;;
449;; (setq larry-var "Larry")
450;;
319acba0 451;; and a literal for "Curly". Here's how `ps-left-header' should be set:
12d89a2e
RS
452;;
453;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
454;;
319acba0
GM
455;; Note that Curly has the PostScript string delimiters inside his quotes --
456;; those aren't misplaced lisp delimiters!
87a16a06 457;;
319acba0
GM
458;; Without them, PostScript would attempt to call the undefined function Curly,
459;; which would result in a PostScript error.
87a16a06 460;;
319acba0
GM
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.
87a16a06 463;;
bcc0d457 464;; Consider yourself warned!
12d89a2e 465;;
319acba0
GM
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.
471;;
472;; The variables `ps-print-only-one-header' and `ps-switch-header' also control
473;; the footer (The same way that control header).
474;;
475;; As a footer example, if you want to have a centered page number in the
476;; footer but without headers, set:
477;;
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}")))
486;;
12d89a2e 487;;
d3ab8dac
KH
488;; PostScript Prologue Header
489;; --------------------------
490;;
491;; It is possible to add PostScript prologue header comments besides that
492;; ps-print generates by setting the variable `ps-print-prologue-header'.
493;;
319acba0
GM
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
d3ab8dac
KH
497;; PostScript special comments, like "%%Requirements: jog\n".
498;;
499;; By default `ps-print-prologue-header' is nil.
500;;
319acba0
GM
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:
d3ab8dac
KH
505;;
506;; (setq ps-print-prologue-header
507;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
508;;
319acba0
GM
509;; The duplex requirement is inserted by ps-print (see section Duplex
510;; Printers).
d3ab8dac
KH
511;;
512;; Do not forget to terminate the string with "\n".
513;;
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
518;;
66e63857
GM
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'.
522;;
319acba0
GM
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.
66e63857
GM
528;;
529;; By default `ps-user-defined-prologue' is nil.
530;;
66e63857 531;; It's strongly recommended only insert PostScript code and/or comments
319acba0
GM
532;; specific for your printing system particularities. For example, some
533;; special initialization that only your printing system needs.
66e63857
GM
534;;
535;; Do not insert code for duplex printing, n-up printing or error handler,
536;; ps-print handles this in a suitable way.
537;;
538;; For more information about PostScript, see:
539;; PostScript Language Reference Manual (2nd edition)
540;; Adobe Systems Incorporated
541;;
c3d6d211
GM
542;; As an example for `ps-user-defined-prologue' setting:
543;;
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"))
548;;
66e63857
GM
549;;
550;; PostScript Error Handler
551;; ------------------------
552;;
553;; ps-print instruments generated PostScript code with an error handler.
554;;
555;; The variable `ps-error-handler-message' specifies where the error handler
556;; message should be sent.
557;;
558;; Valid values are:
559;;
560;; none catch the error and *DON'T* send any message.
561;;
562;; paper catch the error and print on paper the error message.
563;; This is the default value.
564;;
565;; system catch the error and send back the error message to
319acba0
GM
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.
66e63857
GM
570;;
571;; paper-and-system catch the error, print on paper the error message and
572;; send back the error message to printing system.
573;;
574;; Any other value is treated as `paper'.
575;;
d3ab8dac 576;;
12d89a2e 577;; Duplex Printers
bcc0d457 578;; ---------------
12d89a2e 579;;
bc0d41bd
KH
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.
584;;
319acba0
GM
585;; The variable `ps-spool-config' specifies who is the responsible for setting
586;; duplex and page size. Valid values are:
bc0d41bd
KH
587;;
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.
591;;
592;; setpagedevice duplex and page size are configured by ps-print using the
593;; setpagedevice PostScript operator.
594;;
595;; nil duplex and page size are configured by ps-print *not* using
596;; the setpagedevice PostScript operator.
597;;
598;; Any other value is treated as nil.
599;;
600;; The default value is `lpr-switches'.
601;;
319acba0
GM
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,
bc0d41bd
KH
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.
611;;
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
319acba0
GM
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.
bc0d41bd 618;;
319acba0
GM
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.
bc0d41bd 622;;
319acba0
GM
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).
bc0d41bd 626;;
319acba0
GM
627;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the
628;; very first page).
bc0d41bd
KH
629;;
630;;
631;; N-up Printing
632;; -------------
633;;
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.
636;;
319acba0
GM
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.
bc0d41bd
KH
639;;
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).
643;;
319acba0
GM
644;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each
645;; page. The default is t.
bc0d41bd
KH
646;;
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:
650;;
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
654;;
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
658;;
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
662;;
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
666;;
667;; Any other value is treated as left-top.
668;;
669;; The default value is left-top.
bcc0d457 670;;
06fb6aab 671;;
857686a6
RS
672;; Control And 8-bit Characters
673;; ----------------------------
674;;
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
6bdb808e 677;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
857686a6
RS
678;;
679;; Valid values for `ps-print-control-characters' are:
680;;
c82b4a75
KH
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
6bdb808e
RS
684;; octal encoding.
685;;
c82b4a75 686;; control-8-bit This is the value to use when you want an ASCII encoding of
6bdb808e
RS
687;; any control character, whether it is 7 or 8-bit.
688;; European 8-bits accented characters are printed according
689;; the current font.
690;;
c82b4a75 691;; control Only ASCII control characters have an ASCII encoding.
6bdb808e
RS
692;; European 8-bits accented characters are printed according
693;; the current font.
694;;
c82b4a75 695;; nil No ASCII encoding. Any character is printed according the
6bdb808e 696;; current font.
857686a6
RS
697;;
698;; Any other value is treated as nil.
699;;
496725ad 700;; The default is `control-8-bit'.
857686a6
RS
701;;
702;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
703;;
704;;
024ced4d
KH
705;; Printing Multi-byte Buffer
706;; --------------------------
d3ab8dac 707;;
298bfad9 708;; See ps-mule.el for documentation.
e65df0a1
KH
709;;
710;;
87a16a06
RS
711;; Line Number
712;; -----------
713;;
a18ed129
RS
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).
87a16a06 716;;
319acba0
GM
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)).
720;;
ef1159c2
EZ
721;; The variable `ps-line-number-font' specifies the font for line number.
722;; The default is "Times-Italic".
723;;
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.
726;;
319acba0
GM
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
906d41a7
GM
729;; will look like:
730;;
731;; 1 one line
732;; one line
733;; 3 one line
734;; one line
98f2fbe7 735;; 5 one line
906d41a7
GM
736;; one line
737;; ...
738;;
739;; Valid values are:
740;;
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.
744;;
319acba0
GM
745;; `zebra' specifies that only the line number of the first line in a
746;; zebra stripe is to be printed.
906d41a7
GM
747;;
748;; Any other value is treated as `zebra'.
749;; The default value is 1, so each line number is printed.
750;;
98f2fbe7
GM
751;; The variable `ps-line-number-start' specifies the starting point in the
752;; interval given by `ps-line-number-step'. For example, if
319acba0
GM
753;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3,
754;; the printing will look like:
98f2fbe7
GM
755;;
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;; ...
767;;
768;; The values for `ps-line-number-start':
769;;
770;; * If `ps-line-number-step' is an integer, must be between 1 and the value
771;; of `ps-line-number-step' inclusive.
772;;
773;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
c3d6d211 774;; value of `ps-zebra-stripe-height' inclusive.
98f2fbe7 775;;
319acba0
GM
776;; The default value is 1, so the line number of the first line of each
777;; interval is printed.
98f2fbe7 778;;
87a16a06
RS
779;;
780;; Zebra Stripes
781;; -------------
782;;
319acba0
GM
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:
87a16a06
RS
785;;
786;; XXXXXXXXXXXXXXXXXXXXXXXX
787;; XXXXXXXXXXXXXXXXXXXXXXXX
535efc38
RS
788;; XXXXXXXXXXXXXXXXXXXXXXXX
789;;
87a16a06
RS
790;;
791;;
792;; XXXXXXXXXXXXXXXXXXXXXXXX
793;; XXXXXXXXXXXXXXXXXXXXXXXX
535efc38 794;; XXXXXXXXXXXXXXXXXXXXXXXX
87a16a06 795;;
06fb6aab 796;; The blocks of X's represent rectangles filled with a light gray color.
a18ed129
RS
797;; Each rectangle extends all the way across the page.
798;;
319acba0
GM
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.
8bd22fcf 802;;
01961237 803;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
a18ed129
RS
804;; Non-nil means yes, nil means no. The default is nil.
805;;
6e1b1da6
GM
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)).
bc0d41bd 811;;
2bd80d73
GM
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):
815;;
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;; -------- ----------- --------- ----------------
843;;
844;; Any other value is treated as `nil'.
8e234846 845;;
a18ed129 846;; See also section How Ps-Print Has A Text And/Or Image On Background.
87a16a06 847;;
87a16a06 848;;
12b88fff
RS
849;; Hooks
850;; -----
851;;
d3ab8dac 852;; ps-print has the following hook variables:
12b88fff
RS
853;;
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.
858;;
bc0d41bd
KH
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.
863;;
12b88fff 864;; `ps-print-begin-page-hook'
319acba0
GM
865;; It is evaluated on each beginning of page, except in the beginning of
866;; page that `ps-print-begin-sheet-hook' is evaluated.
12b88fff
RS
867;;
868;; `ps-print-begin-column-hook'
319acba0
GM
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
bc0d41bd 871;; `ps-print-begin-sheet-hook' is evaluated.
12b88fff
RS
872;;
873;;
874;; Font Managing
bcc0d457
RS
875;; -------------
876;;
7d8b7e8e
KH
877;; ps-print now knows rather precisely some fonts: the variable
878;; `ps-font-info-database' contains information for a list of font families
319acba0
GM
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.
06fb6aab 884;;
7d8b7e8e
KH
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.
bcc0d457 889;;
7d8b7e8e 890;; The variable `ps-font-size' determines the size (in points) of the font for
319acba0
GM
891;; ordinary text, when generating PostScript. Its value is a float or a cons
892;; of floats which has the following form:
bcc0d457 893;;
7d8b7e8e
KH
894;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
895;;
896;; Similarly, the variable `ps-header-font-family' determines which font family
897;; is to be used for text in the header.
898;;
899;; The variable `ps-header-font-size' determines the font size, in points, for
900;; text in the header (similar to `ps-font-size').
901;;
319acba0
GM
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').
bcc0d457 904;;
6bf5fb46
GM
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).
908;;
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).
912;;
913;; To get all lines with some spacing set both `ps-line-spacing' and
914;; `ps-paragraph-spacing' variables.
915;;
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.
919;;
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.
922;;
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.
319acba0
GM
929;;
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.
6bf5fb46 933;;
bcc0d457 934;;
12b88fff 935;; Adding a New Font Family
bcc0d457
RS
936;; ------------------------
937;;
319acba0
GM
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.
bcc0d457 941;;
319acba0
GM
942;; For example, assuming `Helvetica' is unknown, you first need to do the
943;; following ONLY ONCE:
bcc0d457
RS
944;;
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:
1fd9b7fe 948;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
a18ed129 949;; - delete the leading `%' (which is the PostScript comment character)
319acba0
GM
950;; - replace in this line `Courier' by the new font (say `Helvetica') to get
951;; the line:
1fd9b7fe 952;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
bcc0d457
RS
953;; - send this file to the printer (or to ghostscript).
954;; You should read the following on the output page:
955;;
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
958;;
959;; - Add these values to the `ps-font-info-database':
960;; (setq ps-font-info-database
12b88fff
RS
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))
bcc0d457
RS
972;; - Now you can use this font family with any size:
973;; (setq ps-font-family 'Helvetica)
319acba0
GM
974;; - if you want to use this family in another emacs session, you must put into
975;; your `~/.emacs':
bcc0d457
RS
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>))
12b88fff
RS
980;; or, use `ps-print-hook' (see section Hooks):
981;; (add-hook 'ps-print-hook
bc0d41bd
KH
982;; '(lambda ()
983;; (or (assq 'Helvetica ps-font-info-database)
984;; (setq ps-font-info-database (append ...)))))
bcc0d457
RS
985;;
986;; You can create new `mixed' font families like:
12b88fff
RS
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))
d3ab8dac 997;;
bcc0d457
RS
998;; Now you can use your new font family with any size:
999;; (setq ps-font-family 'my-mixed-family)
1000;;
319acba0
GM
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.
12b88fff
RS
1006;;
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))
1019;;
1020;; Despite the note above, it is recommended that some convention about
1021;; entry order be used.
1022;;
bcc0d457
RS
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
1026;;
a18ed129 1027;; The PostScript file should be sent to YOUR PostScript printer.
319acba0
GM
1028;; If you send it to ghostscript or to another PostScript printer, you may get
1029;; slightly different results.
c3d6d211
GM
1030;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
1031;;
1032;; Note also that ps-print DOESN'T download any font to your printer, instead
1033;; it uses the fonts resident in your printer.
bcc0d457
RS
1034;;
1035;;
1036;; How Ps-Print Deals With Faces
1037;; -----------------------------
12d89a2e 1038;;
319acba0
GM
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.
12d89a2e 1043;;
319acba0
GM
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'.
857686a6
RS
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:
12d89a2e 1050;;
12b88fff 1051;; (setq ps-bold-faces '(my-blue-face))
bcc0d457 1052;; (setq ps-italic-faces '(my-red-face))
857686a6 1053;; (setq ps-underlined-faces '(my-green-face))
bcc0d457 1054;;
319acba0
GM
1055;; Faces like bold-italic that are both bold and italic should go in *both*
1056;; lists.
bcc0d457 1057;;
319acba0
GM
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.
bcc0d457 1062;;
319acba0
GM
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
857686a6 1068;; `ps-always-build-face-reference' to t.
bcc0d457 1069;;
906d41a7
GM
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:
1073;;
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.
1077;;
1078;; Any other value will be treated as t.
1079;; The default value is t.
1080;;
bcc0d457
RS
1081;;
1082;; How Ps-Print Deals With Color
1083;; -----------------------------
1084;;
319acba0
GM
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'.
6e1b1da6 1089;; On black-and-white printers, colors are displayed in gray scale.
bcc0d457
RS
1090;; To turn off color output, set `ps-print-color-p' to nil.
1091;;
1092;;
87a16a06
RS
1093;; How Ps-Print Maps Faces
1094;; -----------------------
1095;;
319acba0
GM
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:
87a16a06
RS
1099;;
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.
a18ed129 1104;; outline - print characters as hollow outlines.
87a16a06 1105;;
06fb6aab 1106;; See the documentation for `ps-extend-face'.
87a16a06 1107;;
bc0d41bd
KH
1108;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1109;; color and bold attribute:
87a16a06 1110;;
a18ed129 1111;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
87a16a06 1112;;
319acba0
GM
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.
6c8f2753 1115;;
87a16a06
RS
1116;;
1117;; How Ps-Print Has A Text And/Or Image On Background
1118;; --------------------------------------------------
1119;;
d3ab8dac 1120;; ps-print can print texts and/or EPS PostScript images on background; it is
87a16a06
RS
1121;; possible to define the following text attributes: font name, font size,
1122;; initial position, angle, gray scale and pages to print.
1123;;
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.
1126;;
1127;; See documentation for `ps-print-background-text' and
1128;; `ps-print-background-image'.
1129;;
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:
1132;;
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
12b88fff 1139;; "PrintHeight neg PrintPageWidth atan" ; angle
87a16a06
RS
1140;; 5 (11 . 17)) ; page list
1141;; ))
1142;;
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:
1146;;
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"
319acba0 1151;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y pos.
87a16a06
RS
1152;; ; (upper left corner)
1153;; nil nil nil
1154;; 5 (11 . 17)) ; page list
1155;; ))
1156;;
1157;; If it is not possible to read (or does not exist) an image file, that file
1158;; is ignored.
1159;;
1160;; The printing order is:
1161;;
6e1b1da6
GM
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
87a16a06
RS
1170;;
1171;;
bcc0d457
RS
1172;; Utilities
1173;; ---------
1174;;
1175;; Some tools are provided to help you customize your font setup.
1176;;
1177;; `ps-setup' returns (some part of) the current setup.
1178;;
319acba0
GM
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:
bcc0d457
RS
1181;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1182;; to determine the longest lines of your file.
319acba0
GM
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.
bcc0d457 1186;;
319acba0
GM
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.
a18ed129
RS
1191;;
1192;; NOTE: line folding is not taken into account in this process and could
1193;; change the results.
b87c5d3d 1194;;
0a5daee5
KH
1195;; The command `ps-print-customize' activates a customization buffer for
1196;; ps-print options.
1197;;
b87c5d3d 1198;;
b87c5d3d
RS
1199;; New since version 1.5
1200;; ---------------------
b87c5d3d 1201;;
bcc0d457 1202;; Color output capability.
b87c5d3d 1203;; Automatic detection of font attributes (bold, italic).
b87c5d3d 1204;; Configurable headers with page numbers.
b87c5d3d 1205;; Slightly faster.
b87c5d3d 1206;; Support for different paper sizes.
b87c5d3d
RS
1207;; Better conformance to PostScript Document Structure Conventions.
1208;;
ef2cbb24 1209;;
bcc0d457
RS
1210;; New since version 2.8
1211;; ---------------------
1212;;
1fd9b7fe 1213;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
0a5daee5 1214;;
4b81a999
GM
1215;; 20010619
1216;; `ps-time-stamp-locale-default'
1217;;
1218;; 20010530
1219;; Handle before-string and after-string overlay properties.
1220;;
319acba0
GM
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'.
1227;;
1228;; 20010328
1229;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
1230;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
1231;;
ef1159c2
EZ
1232;; 20001122
1233;; `ps-line-number-font', `ps-line-number-font-size' and
1234;; `ps-end-with-control-d'.
1235;;
c3d6d211
GM
1236;; 20000821
1237;; `ps-even-or-odd-pages'
1238;;
1fd9b7fe
GM
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'.
0a5daee5 1245;;
1fd9b7fe
GM
1246;; 20000310
1247;; PostScript error handler.
1248;; `ps-user-defined-prologue' and `ps-error-handler-message'.
bc0d41bd 1249;;
df5e6194 1250;; 19991211
1fd9b7fe 1251;; `ps-print-customize'.
bc0d41bd 1252;;
df5e6194 1253;; 19990703
1fd9b7fe
GM
1254;; Better customization.
1255;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
bc0d41bd 1256;;
df5e6194 1257;; 19990513
1fd9b7fe
GM
1258;; N-up printing.
1259;; Hook: `ps-print-begin-sheet-hook'.
bc0d41bd 1260;;
df5e6194 1261;; [keinichi] 19990509 Kein'ichi Handa <handa@etl.go.jp>
bc0d41bd
KH
1262;;
1263;; `ps-print-region-function'
1264;;
1fd9b7fe 1265;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
bc0d41bd 1266;;
df5e6194 1267;; 19990301
1fd9b7fe 1268;; PostScript tumble and setpagedevice.
bc0d41bd 1269;;
df5e6194 1270;; 19980922
1fd9b7fe
GM
1271;; PostScript prologue header comment insertion.
1272;; Skip invisible text better.
d3ab8dac 1273;;
df5e6194 1274;; [keinichi] 19980819 Kein'ichi Handa <handa@etl.go.jp>
e65df0a1 1275;;
024ced4d 1276;; Multi-byte buffer handling.
e65df0a1 1277;;
1fd9b7fe 1278;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
12b88fff 1279;;
df5e6194 1280;; 19980306
1fd9b7fe 1281;; Skip invisible text.
12b88fff 1282;;
df5e6194 1283;; 19971130
1fd9b7fe
GM
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.
12b88fff 1289;;
df5e6194 1290;; 19971121
1fd9b7fe
GM
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.
87a16a06 1298;;
df5e6194 1299;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
bcc0d457 1300;;
a18ed129 1301;; Font family and float size for text and header.
bcc0d457
RS
1302;; Landscape mode.
1303;; Multiple columns.
1304;; Tools for page setup.
1305;;
1306;;
d3ab8dac 1307;; Known bugs and limitations of ps-print
ef2cbb24 1308;; --------------------------------------
bcc0d457 1309;;
319acba0
GM
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.
043620f4
KH
1312;;
1313;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1314;;
319acba0
GM
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.
00aa16af 1320;;
319acba0
GM
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
857686a6 1323;; `ps-underlined-faces' instead.
12d89a2e 1324;;
00aa16af 1325;; Still too slow; could use some hand-optimization.
ef2cbb24 1326;;
12d89a2e 1327;; Default background color isn't working.
ef2cbb24
RS
1328;;
1329;; Faces are always treated as opaque.
1330;;
41481e4b 1331;; Epoch and Emacs 19 not supported. At all.
ef2cbb24 1332;;
06fb6aab 1333;; Fixed-pitch fonts work better for line folding, but are not required.
bcc0d457 1334;;
319acba0
GM
1335;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
1336;; lines.
ef2cbb24 1337;;
12d89a2e 1338;;
d3ab8dac 1339;; Things to change
bcc0d457 1340;; ----------------
ef2cbb24 1341;;
12b88fff 1342;; Avoid page break inside a paragraph.
bcc0d457 1343;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
bcc0d457 1344;; Improve the memory management for big files (hard?).
319acba0
GM
1345;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
1346;; lines.
ef2cbb24 1347;;
ef2cbb24 1348;;
6bf5fb46
GM
1349;; Acknowledgments
1350;; ---------------
1351;;
319acba0
GM
1352;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
1353;; region to cut out when printing and footer suggestions.
1354;;
6bf5fb46 1355;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
12b88fff 1356;;
ef1159c2
EZ
1357;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
1358;; suggestion.
1359;;
c3d6d211
GM
1360;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1361;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1362;;
98f2fbe7
GM
1363;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1364;; suggestion for `ps-postscript-code-directory' variable.
1365;;
906d41a7
GM
1366;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1367;; level 1 compatibility.
1368;;
8e234846
GM
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.
906d41a7 1372;;
66e63857 1373;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
2bd80d73
GM
1374;; prologue code suggestion, for odd/even printing suggestion and for
1375;; `ps-prologue-file' enhancement.
66e63857 1376;;
024ced4d 1377;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
915293a2
KH
1378;;
1379;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1380;; empty columns.
1381;;
1382;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1383;; last page.
1384;;
6bdb808e
RS
1385;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1386;; `ps-print-control-characters' variable documentation.
1387;;
12b88fff
RS
1388;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1389;; database font management.
1390;;
1391;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
6bdb808e
RS
1392;; header per page over the columns and correct line numbers when printing a
1393;; region.
12b88fff
RS
1394;;
1395;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1396;; print time of `ps-lpr-switches'.
1397;;
6bdb808e
RS
1398;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1399;; (his code was severely modified, but the main idea was kept).
1400;;
12b88fff
RS
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>
984e7bd9 1404;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
12b88fff 1405;;
319acba0
GM
1406;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for version 3.4 I
1407;; started from. [vinicius]
857686a6 1408;;
319acba0 1409;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from. [jack]
bcc0d457 1410;;
319acba0
GM
1411;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
1412;; the invisible property.
ef2cbb24 1413;;
319acba0
GM
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.
ef2cbb24 1417;;
319acba0
GM
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.
12d89a2e 1421;;
319acba0
GM
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.
12d89a2e
RS
1424;;
1425;; Thanks to all who mailed comments, encouragement, and criticism.
319acba0
GM
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.
12d89a2e
RS
1428;;
1429;; Jim
bc0d41bd 1430;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
ef2cbb24
RS
1431
1432;;; Code:
1433
ea0c615d
GM
1434(eval-and-compile
1435 (unless (featurep 'lisp-float-type)
1436 (error "`ps-print' requires floating point support"))
68e684a0 1437
68e684a0 1438
ea0c615d 1439 ;; For Emacs 20.2 and the earlier version.
68e684a0 1440
ea0c615d
GM
1441 (or (fboundp 'set-buffer-multibyte)
1442 (defun set-buffer-multibyte (arg)
1443 (setq enable-multibyte-characters arg)))
68e684a0 1444
ea0c615d
GM
1445 (or (fboundp 'string-as-unibyte)
1446 (defun string-as-unibyte (arg) arg))
df5e6194 1447
ea0c615d
GM
1448 (or (fboundp 'string-as-multibyte)
1449 (defun string-as-multibyte (arg) arg))
298bfad9 1450
ea0c615d
GM
1451 (or (fboundp 'char-charset)
1452 (defun char-charset (arg) 'ascii))
0a5daee5 1453
ea0c615d
GM
1454 (or (fboundp 'charset-after)
1455 (defun charset-after (&optional arg)
1456 (char-charset (char-after arg))))
712dc9e0
GM
1457
1458
ea0c615d
GM
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))))
1466
1467
1468 ;; to avoid compilation gripes
1469
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)
1486
1487 ;; GNU Emacs
2bd80d73
GM
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)
c86f4619 1493 (defalias 'ps-e-overlay-end 'overlay-end)
2bd80d73
GM
1494 (defalias 'ps-e-x-color-values 'x-color-values)
1495 (defalias 'ps-e-color-values 'color-values)
ea0c615d
GM
1496 (if (fboundp 'find-composition)
1497 (defalias 'ps-e-find-composition 'find-composition)
1498 (defalias 'ps-e-find-composition 'ignore))
1499
1500
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))))
906d41a7
GM
1505
1506
ef2cbb24 1507;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12d89a2e
RS
1508;; User Variables:
1509
0a5daee5 1510
bcc0d457
RS
1511;;; Interface to the command system
1512
bc0d41bd
KH
1513(defgroup postscript nil
1514 "PostScript Group"
1515 :tag "PostScript"
1516 :group 'emacs)
1517
e0af0d3e 1518(defgroup ps-print nil
3556c6dd
GM
1519 "PostScript generator for Emacs"
1520 :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
e0af0d3e 1521 :prefix "ps-"
bc0d41bd
KH
1522 :group 'wp
1523 :group 'postscript)
e0af0d3e
RS
1524
1525(defgroup ps-print-horizontal nil
1526 "Horizontal page layout"
1527 :prefix "ps-"
1528 :tag "Horizontal"
1529 :group 'ps-print)
1530
1531(defgroup ps-print-vertical nil
1532 "Vertical page layout"
1533 :prefix "ps-"
1534 :tag "Vertical"
1535 :group 'ps-print)
1536
6e1b1da6 1537(defgroup ps-print-headers nil
319acba0 1538 "Headers & footers layout"
e0af0d3e 1539 :prefix "ps-"
319acba0 1540 :tag "Header & Footer"
e0af0d3e
RS
1541 :group 'ps-print)
1542
1543(defgroup ps-print-font nil
1544 "Fonts customization"
1545 :prefix "ps-"
1546 :tag "Font"
1547 :group 'ps-print)
1548
1549(defgroup ps-print-color nil
1550 "Color customization"
1551 :prefix "ps-"
1552 :tag "Color"
1553 :group 'ps-print)
1554
1555(defgroup ps-print-face nil
1556 "Faces customization"
1557 :prefix "ps-"
1558 :tag "PS Faces"
1559 :group 'ps-print
1560 :group 'faces)
1561
bc0d41bd
KH
1562(defgroup ps-print-n-up nil
1563 "N-up customization"
1564 :prefix "ps-"
1565 :tag "N-Up"
1566 :group 'ps-print)
1567
1568(defgroup ps-print-zebra nil
1569 "Zebra customization"
1570 :prefix "ps-"
1571 :tag "Zebra"
1572 :group 'ps-print)
1573
1574(defgroup ps-print-background nil
1575 "Background customization"
1576 :prefix "ps-"
1577 :tag "Background"
1578 :group 'ps-print)
1579
1580(defgroup ps-print-printer nil
1581 "Printer customization"
1582 :prefix "ps-"
1583 :tag "Printer"
1584 :group 'ps-print)
1585
1586(defgroup ps-print-page nil
1587 "Page customization"
1588 :prefix "ps-"
1589 :tag "Page"
1590 :group 'ps-print)
1591
6e1b1da6
GM
1592(defgroup ps-print-miscellany nil
1593 "Miscellany customization"
1594 :prefix "ps-"
1595 :tag "Miscellany"
1596 :group 'ps-print)
1597
bc0d41bd 1598
66e63857
GM
1599(defcustom ps-error-handler-message 'paper
1600 "*Specify where the error handler message should be sent.
1601
1602Valid values are:
1603
1604 `none' catch the error and *DON'T* send any message.
1605
1606 `paper' catch the error and print on paper the error message.
1607
1608 `system' catch the error and send back the error message to
6e1b1da6
GM
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.
66e63857
GM
1613
1614 `paper-and-system' catch the error, print on paper the error message and
1615 send back the error message to printing system.
1616
1617Any other value is treated as `paper'."
8e234846
GM
1618 :type '(choice :menu-tag "Error Handler Message"
1619 :tag "Error Handler Message"
66e63857
GM
1620 (const none) (const paper)
1621 (const system) (const paper-and-system))
6e1b1da6 1622 :group 'ps-print-miscellany)
66e63857
GM
1623
1624(defcustom ps-user-defined-prologue nil
1625 "*User defined PostScript prologue code inserted before all prologue code.
1626
1627`ps-user-defined-prologue' may be a string or a symbol function which returns a
1628string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1629prologue comments, and before ps-print PostScript prologue code section. That
1630is, this string is inserted after error handler initialization and before
1631ps-print settings.
1632
66e63857
GM
1633It's strongly recommended only insert PostScript code and/or comments specific
1634for your printing system particularities. For example, some special
1635initialization that only your printing system needs.
1636
319acba0
GM
1637Do not insert code for duplex printing, n-up printing or error handler,
1638ps-print handles this in a suitable way.
66e63857
GM
1639
1640For more information about PostScript, see:
1641 PostScript Language Reference Manual (2nd edition)
c3d6d211
GM
1642 Adobe Systems Incorporated
1643
1644As an example for `ps-user-defined-prologue' setting:
1645
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\"))
1650"
8e234846
GM
1651 :type '(choice :menu-tag "User Defined Prologue"
1652 :tag "User Defined Prologue"
98f2fbe7 1653 (const :tag "none" nil) string symbol)
6e1b1da6 1654 :group 'ps-print-miscellany)
66e63857 1655
d3ab8dac
KH
1656(defcustom ps-print-prologue-header nil
1657 "*PostScript prologue header comments besides that ps-print generates.
1658
319acba0
GM
1659`ps-print-prologue-header' may be a string or a symbol function which returns a
1660string. Note that this string is inserted on PostScript prologue header
1661section which is used to define some document characteristic through PostScript
1662special comments, like \"%%Requirements: jog\\n\".
d3ab8dac
KH
1663
1664ps-print always inserts the %%Requirements: comment, so if you need to insert
1665more 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
1667requirements and set %%LanguageLevel: to 2, do:
1668
1669(setq ps-print-prologue-header
1670 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1671
1672The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1673
1674Do not forget to terminate the string with \"\\n\".
1675
1676For 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"
8e234846
GM
1680 :type '(choice :menu-tag "Prologue Header"
1681 :tag "Prologue Header"
98f2fbe7 1682 (const :tag "none" nil) string symbol)
6e1b1da6 1683 :group 'ps-print-miscellany)
d3ab8dac 1684
298bfad9 1685(defcustom ps-printer-name (and (boundp 'printer-name)
2bd80d73 1686 (symbol-value 'printer-name))
03820514
RS
1687 "*The name of a local printer for printing PostScript files.
1688
3556c6dd
GM
1689On Unix-like systems, a string value should be a name understood by lpr's -P
1690option; a value of nil means use the value of `printer-name' instead.
1691
1692On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1693printer 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
1695non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
7bb054a5 1696\"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
3556c6dd
GM
1697for a shared network printer. You can also set it to a name of a file, in
1698which case the output gets appended to that file. \(Note that `ps-print'
1699package already has facilities for printing to a file, so you might as well use
1700them instead of changing the setting of this variable.\) If you want to
1701silently discard the printed output, set this to \"NUL\".
1702
1703Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1704
1705Any other value is treated as t, that is, an empty printer name.
1706
1707See also `ps-printer-name-option' for documentation."
8e234846
GM
1708 :type '(choice :menu-tag "Printer Name"
1709 :tag "Printer Name"
1710 (const :tag "Same as printer-name" nil)
3556c6dd 1711 (const :tag "No Printer Name" t)
6e1b1da6 1712 (file :tag "Print to file")
8e234846 1713 (string :tag "Pipe to ps-lpr-command"))
bc0d41bd 1714 :group 'ps-print-printer)
03820514 1715
3556c6dd
GM
1716(defcustom ps-printer-name-option
1717 (cond (ps-windows-system
1718 "/D:")
1719 (ps-lp-system
1720 "-d")
1721 (t
1722 "-P" ))
1723 "*Option for `ps-printer-name' variable (see it).
1724
1725On 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\".
1727
1728On MS-DOS and MS-Windows systems, if it's been used print utility, it should be
1729the string \"/D:\".
1730
1731For any other printing utility, see the proper manual or documentation.
1732
1733Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
1734option printer name option.
1735
1736Any other value is treated as nil, that is, an empty printer name option.
1737
1738This 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"))
6bf5fb46 1743 :version "21.1"
3556c6dd
GM
1744 :group 'ps-print-printer)
1745
e0af0d3e 1746(defcustom ps-lpr-command lpr-command
52cf535f
AI
1747 "*Name of program for printing a PostScript file.
1748
3556c6dd
GM
1749On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1750will write directly to the printer port named by `ps-printer-name'. The
1751programs `print' and `nprint' (the standard print programs on Windows NT and
1752Novell Netware respectively) are handled specially, using `ps-printer-name' as
1753the destination for output; any other program is treated like `lpr' except that
1754an explicit filename is given as the last argument."
e0af0d3e 1755 :type 'string
bc0d41bd 1756 :group 'ps-print-printer)
e0af0d3e
RS
1757
1758(defcustom ps-lpr-switches lpr-switches
1759 "*A list of extra switches to pass to `ps-lpr-command'."
edc9cd35 1760 :type '(repeat :tag "PostScript lpr Switches"
ef1159c2
EZ
1761 (choice :menu-tag "PostScript lpr Switch"
1762 :tag "PostScript lpr Switch"
1763 string symbol (repeat sexp)))
bc0d41bd 1764 :group 'ps-print-printer)
12d89a2e 1765
52cf535f 1766(defcustom ps-print-region-function nil
bc0d41bd 1767 "*Specify a function to print the region on a PostScript printer.
319acba0
GM
1768See definition of `call-process-region' for calling conventions. The fourth
1769and the sixth arguments are both nil."
942a1d58 1770 :type '(choice (const nil) function)
bc0d41bd 1771 :group 'ps-print-printer)
52cf535f 1772
8e234846
GM
1773(defcustom ps-manual-feed nil
1774 "*Non-nil means the printer will manually feed paper.
1775
1776If it's nil, automatic feeding takes place."
1777 :type 'boolean
1778 :group 'ps-print-printer)
1779
bd7a2e26 1780(defcustom ps-end-with-control-d (and ps-windows-system t)
ef1159c2 1781 "*Non-nil means insert C-d at end of PostScript file generated."
6bf5fb46 1782 :version "21.1"
ef1159c2
EZ
1783 :type 'boolean
1784 :group 'ps-print-printer)
1785
bcc0d457 1786;;; Page layout
12d89a2e 1787
bcc0d457
RS
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
1791
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
1795
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
1805
e0af0d3e 1806(defcustom ps-page-dimensions-database
bc0d41bd
KH
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.
1820See `ps-paper-type'."
e0af0d3e
RS
1821 :type '(repeat (list :tag "Paper Type"
1822 (symbol :tag "Name")
1823 (number :tag "Width")
bc0d41bd
KH
1824 (number :tag "Height")
1825 (string :tag "Media")))
1826 :group 'ps-print-page)
e0af0d3e 1827
857686a6 1828;;;###autoload
e0af0d3e 1829(defcustom ps-paper-type 'letter
bc0d41bd 1830 "*Specify the size of paper to format for.
090be653 1831Should be one of the paper types defined in `ps-page-dimensions-database', for
e0af0d3e
RS
1832example `letter', `legal' or `a4'."
1833 :type '(symbol :validate (lambda (wid)
87a16a06
RS
1834 (if (assq (widget-value wid)
1835 ps-page-dimensions-database)
e0af0d3e
RS
1836 nil
1837 (widget-put wid :error "Unknown paper size")
1838 wid)))
bc0d41bd 1839 :group 'ps-print-page)
e0af0d3e 1840
8e234846
GM
1841(defcustom ps-warn-paper-type t
1842 "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1843
1844It's used when `ps-spool-config' is set to `setpagedevice'."
1845 :type 'boolean
1846 :group 'ps-print-page)
1847
87a16a06 1848(defcustom ps-landscape-mode nil
e0af0d3e
RS
1849 "*Non-nil means print in landscape mode."
1850 :type 'boolean
bc0d41bd 1851 :group 'ps-print-page)
e0af0d3e 1852
906d41a7 1853(defcustom ps-print-upside-down nil
319acba0 1854 "*Non-nil means print upside-down (that is, it's rotated by 180 grades)."
906d41a7 1855 :type 'boolean
319acba0 1856 :version "21.1"
906d41a7
GM
1857 :group 'ps-print-page)
1858
1fd9b7fe
GM
1859(defcustom ps-selected-pages nil
1860 "*Specify which pages to print.
1861
1862If it's nil, all pages are printed.
1863
1864If it's a list, the list element may be an integer or a cons cell (FROM . TO)
1865designating FROM page to TO page; any invalid element is ignored, that is, an
1866integer lesser than one or if FROM is greater than TO.
1867
1868Otherwise, it's treated as nil.
1869
1870After 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
1872documentation). So you can restore the latest selected pages by using
1873`ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
ea0c615d
GM
1874it for documentation).
1875
1876See also `ps-even-or-odd-pages'."
1fd9b7fe
GM
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)
1884
c3d6d211
GM
1885(defcustom ps-even-or-odd-pages nil
1886 "*Specify if it prints even/odd pages.
1887
1888Valid values are:
1889
1890 nil print all pages.
1891
4b3eb10f
GM
1892 `even-page' print only even pages.
1893
1894 `odd-page' print only odd pages.
1895
1896 `even-sheet' print only even sheets.
bd7a2e26
GM
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.
c3d6d211 1900
4b3eb10f 1901 `odd-sheet' print only odd sheets.
bd7a2e26
GM
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.
c3d6d211 1905
ea0c615d
GM
1906Any other value is treated as nil.
1907
1908If you set `ps-selected-pages' (see it for documentation), first the pages are
1909filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1910example, if we have:
1911
4b3eb10f 1912 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
ea0c615d 1913
4b3eb10f 1914Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
ea0c615d 1915
4b3eb10f 1916`ps-n-up-printing' = 1:
ea0c615d 1917 `ps-even-or-odd-pages' PAGES PRINTED
4b3eb10f
GM
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
1923
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
1931
1932So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1933sheet parity."
c3d6d211
GM
1934 :type '(choice :menu-tag "Print Even/Odd Pages"
1935 :tag "Print Even/Odd Pages"
1936 (const :tag "All Pages" nil)
4b3eb10f
GM
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))
c3d6d211
GM
1941 :group 'ps-print-page)
1942
857686a6 1943(defcustom ps-print-control-characters 'control-8-bit
bc0d41bd
KH
1944 "*Specify the printable form for control and 8-bit characters.
1945That is, instead of sending, for example, a ^D (\\004) to printer,
915293a2 1946it is sent the string \"^D\".
6bdb808e 1947
857686a6 1948Valid values are:
6bdb808e 1949
984e7bd9 1950 `8-bit' This is the value to use when you want an ASCII encoding of
d3ab8dac
KH
1951 any control or non-ASCII character. Control characters are
1952 encoded as \"^D\", and non-ASCII characters have an
1953 octal encoding.
6bdb808e 1954
984e7bd9 1955 `control-8-bit' This is the value to use when you want an ASCII encoding of
d3ab8dac
KH
1956 any control character, whether it is 7 or 8-bit.
1957 European 8-bits accented characters are printed according
1958 the current font.
6bdb808e 1959
c82b4a75 1960 `control' Only ASCII control characters have an ASCII encoding.
d3ab8dac
KH
1961 European 8-bits accented characters are printed according
1962 the current font.
6bdb808e 1963
984e7bd9 1964 nil No ASCII encoding. Any character is printed according the
d3ab8dac 1965 current font.
6bdb808e 1966
857686a6 1967Any other value is treated as nil."
8e234846
GM
1968 :type '(choice :menu-tag "Control Char"
1969 :tag "Control Char"
bc0d41bd 1970 (const 8-bit) (const control-8-bit)
edc9cd35 1971 (const control) (const :tag "nil" nil))
6e1b1da6 1972 :group 'ps-print-miscellany)
857686a6 1973
bc0d41bd
KH
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))
1982 nil
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)
1988
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)
1993
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)
1998
1999(defcustom ps-n-up-filling 'left-top
2000 "*Specify how page matrix is filled on each sheet of paper.
2001
2002Following are the valid values for `ps-n-up-filling' with a filling example
2003using a 3x4 page matrix:
2004
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
2008
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
2012
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
2016
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
2020
2021Any other value is treated as `left-top'."
8e234846
GM
2022 :type '(choice :menu-tag "N-Up Filling"
2023 :tag "N-Up Filling"
bc0d41bd
KH
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)
2029
e0af0d3e 2030(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
bc0d41bd 2031 "*Specify the number of columns"
87a16a06 2032 :type 'number
6e1b1da6 2033 :group 'ps-print-miscellany)
87a16a06 2034
535efc38 2035(defcustom ps-zebra-stripes nil
87a16a06 2036 "*Non-nil means print zebra stripes.
6e1b1da6 2037See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
87a16a06 2038 :type 'boolean
bc0d41bd 2039 :group 'ps-print-zebra)
87a16a06 2040
535efc38 2041(defcustom ps-zebra-stripe-height 3
87a16a06 2042 "*Number of zebra stripe lines.
6e1b1da6 2043See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
87a16a06 2044 :type 'number
bc0d41bd
KH
2045 :group 'ps-print-zebra)
2046
6e1b1da6
GM
2047(defcustom ps-zebra-color 0.95
2048 "*Zebra stripe gray scale or RGB color.
bc0d41bd 2049See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
8e234846
GM
2050 :type '(choice :menu-tag "Zebra Gray/Color"
2051 :tag "Zebra Gray/Color"
6e1b1da6
GM
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")))
bc0d41bd 2058 :group 'ps-print-zebra)
87a16a06 2059
8e234846 2060(defcustom ps-zebra-stripe-follow nil
2bd80d73
GM
2061 "*Specify how zebra stripes continue on next page.
2062
2063Visually, valid values are (the character `+' at right of each column indicates
2064that a line is printed):
2065
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 -------- ----------- --------- ----------------
2093
2094Any 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))
8e234846
GM
2101 :group 'ps-print-zebra)
2102
87a16a06
RS
2103(defcustom ps-line-number nil
2104 "*Non-nil means print line number."
2105 :type 'boolean
6e1b1da6 2106 :group 'ps-print-miscellany)
87a16a06 2107
906d41a7
GM
2108(defcustom ps-line-number-step 1
2109 "*Specify the interval that line number is printed.
2110
2111For example, `ps-line-number-step' is set to 2, the printing will look like:
2112
2113 1 one line
2114 one line
2115 3 one line
2116 one line
98f2fbe7 2117 5 one line
906d41a7
GM
2118 one line
2119 ...
2120
2121Valid values are:
2122
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.
2126
319acba0
GM
2127 `zebra' specifies that only the line number of the first line in a
2128 zebra stripe is to be printed.
906d41a7
GM
2129
2130Any other value is treated as `zebra'."
8e234846
GM
2131 :type '(choice :menu-tag "Line Number Step"
2132 :tag "Line Number Step"
906d41a7
GM
2133 (integer :tag "Step Interval")
2134 (const :tag "Synchronize Zebra" zebra))
2135 :group 'ps-print-miscellany)
2136
98f2fbe7
GM
2137(defcustom ps-line-number-start 1
2138 "*Specify the starting point in the interval given by `ps-line-number-step'.
2139
3556c6dd
GM
2140For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2141set to 3, the printing will look like:
98f2fbe7
GM
2142
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
2153 ...
2154
2155The values for `ps-line-number-start':
2156
319acba0
GM
2157 * If `ps-line-number-step' is an integer, must be between 1 and the value of
2158 `ps-line-number-step' inclusive.
98f2fbe7
GM
2159
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)
2165
87a16a06
RS
2166(defcustom ps-print-background-image nil
2167 "*EPS image list to be printed on background.
2168
2169The elements are:
2170
2171 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2172
2173FILENAME is a file name which contains an EPS image or some PostScript
2174programming like EPS.
2175FILENAME is ignored, if it doesn't exist or is read protected.
2176
2177X and Y are relative positions on paper to put the image.
2178If X and Y are nil, the image is centralized on paper.
2179
2180XSCALE and YSCALE are scale factor to be applied to image before printing.
2181If XSCALE and YSCALE are nil, the original size is used.
2182
2183ROTATION is the image rotation angle; if nil, the default is 0.
2184
2185PAGES designates the page to print background image.
319acba0
GM
2186PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2187page.
87a16a06
RS
2188If PAGES is nil, print background image on all pages.
2189
319acba0
GM
2190X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2191number or a string. If it is a string, the string should contain PostScript
2192programming that returns a float or integer value.
87a16a06
RS
2193
2194For example, if you wish to print an EPS image on all pages do:
2195
2196 '((\"~/images/EPS-image.ps\"))"
98f2fbe7
GM
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"))))))
bc0d41bd 2210 :group 'ps-print-background)
87a16a06
RS
2211
2212(defcustom ps-print-background-text nil
2213 "*Text list to be printed on background.
2214
2215The elements are:
2216
2217 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2218
2219STRING is the text to be printed on background.
2220
2221X and Y are positions on paper to put the text.
2222If X and Y are nil, the text is positioned at lower left corner.
2223
2224FONT is a font name to be used on printing the text.
2225If nil, \"Times-Roman\" is used.
2226
2227FONTSIZE is font size to be used, if nil, 200 is used.
2228
2229GRAY is the text gray factor (should be very light like 0.8).
2230If nil, the default is 0.85.
2231
319acba0
GM
2232ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
2233from lower left corner to upper right corner.
87a16a06
RS
2234
2235PAGES designates the page to print background text.
319acba0
GM
2236PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2237page.
87a16a06
RS
2238If PAGES is nil, print background text on all pages.
2239
319acba0
GM
2240X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2241number or a string. If it is a string, the string should contain PostScript
2242programming that returns a float or integer value.
87a16a06
RS
2243
2244For example, if you wish to print text \"Preliminary\" on all pages do:
2245
2246 '((\"Preliminary\"))"
98f2fbe7
GM
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"))))))
bc0d41bd 2261 :group 'ps-print-background)
bcc0d457
RS
2262
2263;;; Horizontal layout
2264
2265;; ------------------------------------------
2266;; | | | | | | | |
2267;; | lm | text | ic | text | ic | text | rm |
2268;; | | | | | | | |
2269;; ------------------------------------------
2270
e0af0d3e
RS
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)
bcc0d457 2275
e0af0d3e
RS
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)
bcc0d457 2280
e0af0d3e
RS
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)
bcc0d457
RS
2285
2286;;; Vertical layout
2287
2288;; |--------|
2289;; | tm |
2290;; |--------|
2291;; | header |
2292;; |--------|
2293;; | ho |
2294;; |--------|
2295;; | text |
2296;; |--------|
2297;; | bm |
2298;; |--------|
2299
e0af0d3e
RS
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)
bcc0d457 2304
e0af0d3e
RS
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)
bcc0d457 2309
e0af0d3e
RS
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)
bcc0d457 2314
e0af0d3e 2315(defcustom ps-header-line-pad 0.15
bcc0d457 2316 "*Portion of a header title line height to insert between the header frame
e0af0d3e
RS
2317and the text it contains, both in the vertical and horizontal directions."
2318 :type 'number
2319 :group 'ps-print-vertical)
bcc0d457 2320
319acba0
GM
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)
2325
2326(defcustom ps-footer-line-pad 0.15
2327 "*Portion of a footer title line height to insert between the footer frame
2328and the text it contains, both in the vertical and horizontal directions."
2329 :type 'number
2330 :group 'ps-print-vertical)
2331
2332;;; Header/Footer setup
12d89a2e 2333
e0af0d3e 2334(defcustom ps-print-header t
86c10ecb 2335 "*Non-nil means print a header at the top of each page.
319acba0
GM
2336By default, the header displays the buffer name, page number, and, if the
2337buffer is visiting a file, the file's directory. Headers are customizable by
2338changing variables `ps-left-header' and `ps-right-header'."
12b88fff 2339 :type 'boolean
6e1b1da6 2340 :group 'ps-print-headers)
12b88fff 2341
e0af0d3e
RS
2342(defcustom ps-print-header-frame t
2343 "*Non-nil means draw a gaudy frame around the header."
2344 :type 'boolean
6e1b1da6 2345 :group 'ps-print-headers)
e0af0d3e 2346
319acba0 2347(defcustom ps-header-frame-alist
efa89c1f 2348 '((fore-color . 0.0)
319acba0
GM
2349 (back-color . 0.9)
2350 (border-width . 0.4)
efa89c1f
GM
2351 (border-color . 0.0)
2352 (shadow-color . 0.0))
319acba0
GM
2353 "*Specify header frame properties alist.
2354
2355Valid frame properties are:
2356
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).
2363
2364 `back-color' Specify the background frame color (similar to
2365 `fore-color').
2366
2367 `shadow-color' Specify the shadow color (similar to `fore-color').
2368
2369 `border-color' Specify the border color (similar to `fore-color').
2370
2371 `border-width' Specify the border width.
2372
2373Any other property is ignored.
2374
2375Don'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"
efa89c1f 2385 (number :tag "Gray Scale" :value 0.0)
319acba0 2386 (string :tag "Color Name" :value "black")
efa89c1f 2387 (list :tag "RGB Color" :value (0.0 0.0 0.0)
319acba0
GM
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"
efa89c1f 2408 (number :tag "Gray Scale" :value 0.0)
319acba0 2409 (string :tag "Color Name" :value "black")
efa89c1f 2410 (list :tag "RGB Color" :value (0.0 0.0 0.0)
319acba0
GM
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"
efa89c1f 2418 (number :tag "Gray Scale" :value 0.0)
319acba0 2419 (string :tag "Color Name" :value "black")
efa89c1f 2420 (list :tag "RGB Color" :value (0.0 0.0 0.0)
319acba0
GM
2421 (number :tag "Red")
2422 (number :tag "Green")
2423 (number :tag "Blue"))))))
2424 :group 'ps-print-headers)
2425
e0af0d3e 2426(defcustom ps-header-lines 2
8bd22fcf 2427 "*Number of lines to display in page header, when generating PostScript."
e0af0d3e 2428 :type 'integer
6e1b1da6 2429 :group 'ps-print-headers)
bcc0d457 2430
319acba0
GM
2431(defcustom ps-print-footer nil
2432 "*Non-nil means print a footer at the bottom of each page.
2433By default, the footer displays page number.
2434Footers 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)
2439
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)
2445
2446(defcustom ps-footer-frame-alist
efa89c1f 2447 '((fore-color . 0.0)
319acba0
GM
2448 (back-color . 0.9)
2449 (border-width . 0.4)
efa89c1f
GM
2450 (border-color . 0.0)
2451 (shadow-color . 0.0))
319acba0
GM
2452 "*Specify footer frame properties alist.
2453
2454Don't change this alist directly, instead use customization, or `ps-value',
2455`ps-get', `ps-put' and `ps-del' functions (see them for documentation).
2456
2457See 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"
efa89c1f 2466 (number :tag "Gray Scale" :value 0.0)
319acba0 2467 (string :tag "Color Name" :value "black")
efa89c1f 2468 (list :tag "RGB Color" :value (0.0 0.0 0.0)
319acba0
GM
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"
efa89c1f 2489 (number :tag "Gray Scale" :value 0.0)
319acba0 2490 (string :tag "Color Name" :value "black")
efa89c1f 2491 (list :tag "RGB Color" :value (0.0 0.0 0.0)
319acba0
GM
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"
efa89c1f 2499 (number :tag "Gray Scale" :value 0.0)
319acba0 2500 (string :tag "Color Name" :value "black")
efa89c1f 2501 (list :tag "RGB Color" :value (0.0 0.0 0.0)
319acba0
GM
2502 (number :tag "Red")
2503 (number :tag "Green")
2504 (number :tag "Blue"))))))
2505 :group 'ps-print-headers)
2506
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)
2512
2513(defcustom ps-print-only-one-header nil
2514 "*Non-nil means print only one header/footer at the top/bottom of each page.
2515This is useful when printing more than one column, so it is possible to have
2516only one header/footer over all columns or one header/footer per column.
2517See also `ps-print-header' and `ps-print-footer'."
2518 :type 'boolean
2519 :group 'ps-print-headers)
2520
8e234846 2521(defcustom ps-switch-header 'duplex
319acba0 2522 "*Specify if headers/footers are switched or not.
8e234846
GM
2523
2524Valid values are:
2525
319acba0 2526nil Never switch headers/footers.
8e234846 2527
319acba0 2528t Always switch headers/footers.
8e234846 2529
319acba0 2530duplex Switch headers/footers only when duplexing is on, that is, when
8e234846
GM
2531 `ps-spool-duplex' is non-nil.
2532
319acba0
GM
2533Any other value is treated as t.
2534
2535See also `ps-print-header' and `ps-print-footer'."
2536 :type '(choice :menu-tag "Switch Header/Footer"
2537 :tag "Switch Header/Footer"
8e234846
GM
2538 (const :tag "Never Switch" nil)
2539 (const :tag "Always Switch" t)
2540 (const :tag "Switch When Duplexing" duplex))
2541 :group 'ps-print-headers)
2542
e0af0d3e 2543(defcustom ps-show-n-of-n t
00aa16af 2544 "*Non-nil means show page numbers as N/M, meaning page N of M.
8bd22fcf 2545NOTE: page numbers are displayed as part of headers,
6e1b1da6 2546 see variable `ps-print-header'."
e0af0d3e 2547 :type 'boolean
6e1b1da6 2548 :group 'ps-print-headers)
12d89a2e 2549
edc9cd35 2550(defcustom ps-spool-config
906d41a7 2551 (if ps-windows-system
edc9cd35
GM
2552 nil
2553 'lpr-switches)
319acba0 2554 "*Specify who is responsible for setting duplex and page size.
bc0d41bd
KH
2555
2556Valid values are:
2557
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.
2561
2562 `setpagedevice' duplex and page size are configured by ps-print using the
2563 setpagedevice PostScript operator.
2564
2565 nil duplex and page size are configured by ps-print *not* using
2566 the setpagedevice PostScript operator.
2567
2568Any other value is treated as nil.
2569
2570WARNING: 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."
8e234846
GM
2579 :type '(choice :menu-tag "Spool Config"
2580 :tag "Spool Config"
bc0d41bd 2581 (const lpr-switches) (const setpagedevice)
edc9cd35 2582 (const :tag "nil" nil))
6e1b1da6 2583 :group 'ps-print-headers)
bc0d41bd
KH
2584
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.
2588For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2589blank pages as needed between print jobs so that the next buffer printed will
2590start on the right page. Also, if headers are turned on, the headers will be
2591reversed on duplex printers so that the page numbers fall to the left on
0a5daee5
KH
2592even-numbered pages.
2593
2594See also `ps-spool-tumble'."
bc0d41bd 2595 :type 'boolean
6e1b1da6 2596 :group 'ps-print-headers)
bc0d41bd
KH
2597
2598(defcustom ps-spool-tumble nil
2599 "*Specify how the page images on opposite sides of a sheet are oriented.
319acba0
GM
2600If `ps-spool-tumble' is nil, produces output suitable for binding on the left
2601or right. If `ps-spool-tumble' is non-nil, produces output suitable for
2602binding at the top or bottom.
bc0d41bd
KH
2603
2604It has effect only when `ps-spool-duplex' is non-nil."
e0af0d3e 2605 :type 'boolean
6e1b1da6 2606 :group 'ps-print-headers)
bcc0d457
RS
2607
2608;;; Fonts
2609
e0af0d3e 2610(defcustom ps-font-info-database
bcc0d457 2611 '((Courier ; the family key
12b88fff
RS
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))
bcc0d457 2620 (Helvetica ; the family key
12b88fff
RS
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))
bcc0d457 2629 (Times
12b88fff
RS
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)
334cc3b7 2637 (avg-char-width . 4.71432))
bcc0d457 2638 (Palatino
12b88fff
RS
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))
bcc0d457 2647 (Helvetica-Narrow
12b88fff
RS
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))
bcc0d457 2656 (NewCenturySchlbk
12b88fff
RS
2657 (fonts (normal . "NewCenturySchlbk-Roman")
2658 (bold . "NewCenturySchlbk-Bold")
2659 (italic . "NewCenturySchlbk-Italic")
2660 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2661 (size . 10.0)
334cc3b7 2662 (line-height . 12.15)
12b88fff
RS
2663 (space-width . 2.78)
2664 (avg-char-width . 5.31162))
bcc0d457
RS
2665 ;; got no bold for the next ones
2666 (AvantGarde-Book
12b88fff
RS
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))
bcc0d457 2673 (AvantGarde-Demi
12b88fff
RS
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))
bcc0d457 2680 (Bookman-Demi
12b88fff
RS
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))
bcc0d457 2687 (Bookman-Light
12b88fff
RS
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))
bcc0d457
RS
2694 ;; got no bold and no italic for the next ones
2695 (Symbol
12b88fff
RS
2696 (fonts (normal . "Symbol"))
2697 (size . 10.0)
2698 (line-height . 13.03)
2699 (space-width . 2.5)
2700 (avg-char-width . 3.24324))
bcc0d457 2701 (Zapf-Dingbats
12b88fff
RS
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))
bcc0d457 2707 (Zapf-Chancery-MediumItalic
12b88fff
RS
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))
87a16a06 2713 )
bcc0d457
RS
2714 "*Font info database: font family (the key), name, bold, italic, bold-italic,
2715reference size, line height, space width, average character width.
2716To 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)
319acba0
GM
2719- open this file and delete the leading `%' (which is the PostScript comment
2720 character) from the line
1fd9b7fe 2721 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
bcc0d457 2722 to get the line
1fd9b7fe 2723 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
bcc0d457 2724- add the values to `ps-font-info-database'.
c3d6d211
GM
2725You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2726
319acba0
GM
2727Note also that ps-print DOESN'T download any font to your printer, instead it
2728uses the fonts resident in your printer."
ef1159c2
EZ
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"))))
e0af0d3e
RS
2755 :group 'ps-print-font)
2756
2757(defcustom ps-font-family 'Courier
d3ab8dac 2758 "*Font family name for ordinary text, when generating PostScript."
e0af0d3e
RS
2759 :type 'symbol
2760 :group 'ps-print-font)
2761
7d8b7e8e 2762(defcustom ps-font-size '(7 . 8.5)
d3ab8dac 2763 "*Font size, in points, for ordinary text, when generating PostScript."
ef1159c2
EZ
2764 :type '(choice :menu-tag "Ordinary Text Font Size"
2765 :tag "Ordinary Text Font Size"
2766 (number :tag "Text Size")
7d8b7e8e
KH
2767 (cons :tag "Landscape/Portrait"
2768 (number :tag "Landscape Text Size")
2769 (number :tag "Portrait Text Size")))
e0af0d3e
RS
2770 :group 'ps-print-font)
2771
2772(defcustom ps-header-font-family 'Helvetica
d3ab8dac 2773 "*Font family name for text in the header, when generating PostScript."
e0af0d3e
RS
2774 :type 'symbol
2775 :group 'ps-print-font)
2776
7d8b7e8e 2777(defcustom ps-header-font-size '(10 . 12)
d3ab8dac 2778 "*Font size, in points, for text in the header, when generating PostScript."
ef1159c2
EZ
2779 :type '(choice :menu-tag "Header Font Size"
2780 :tag "Header Font Size"
2781 (number :tag "Header Size")
7d8b7e8e
KH
2782 (cons :tag "Landscape/Portrait"
2783 (number :tag "Landscape Header Size")
2784 (number :tag "Portrait Header Size")))
e0af0d3e
RS
2785 :group 'ps-print-font)
2786
7d8b7e8e 2787(defcustom ps-header-title-font-size '(12 . 14)
d3ab8dac 2788 "*Font size, in points, for the top line of text in header, in PostScript."
ef1159c2
EZ
2789 :type '(choice :menu-tag "Header Title Font Size"
2790 :tag "Header Title Font Size"
2791 (number :tag "Header Title Size")
7d8b7e8e
KH
2792 (cons :tag "Landscape/Portrait"
2793 (number :tag "Landscape Header Title Size")
2794 (number :tag "Portrait Header Title Size")))
e0af0d3e 2795 :group 'ps-print-font)
bcc0d457 2796
319acba0
GM
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)
2802
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)
2813
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)
2827
ef1159c2
EZ
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)
2833
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)
2844
bcc0d457
RS
2845;;; Colors
2846
87a16a06 2847;; Printing color requires x-color-values.
ea0c615d
GM
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))
857686a6 2853 ; XEmacs
bc0d41bd 2854 "*Non-nil means print the buffer's text in color."
e0af0d3e
RS
2855 :type 'boolean
2856 :group 'ps-print-color)
12d89a2e 2857
e0af0d3e
RS
2858(defcustom ps-default-fg '(0.0 0.0 0.0)
2859 "*RGB values of the default foreground color. Defaults to black."
8e234846
GM
2860 :type '(choice :menu-tag "Default Foreground Gray/Color"
2861 :tag "Default Foreground Gray/Color"
6e1b1da6
GM
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")))
e0af0d3e 2868 :group 'ps-print-color)
12d89a2e 2869
e0af0d3e
RS
2870(defcustom ps-default-bg '(1.0 1.0 1.0)
2871 "*RGB values of the default background color. Defaults to white."
8e234846
GM
2872 :type '(choice :menu-tag "Default Background Gray/Color"
2873 :tag "Default Background Gray/Color"
6e1b1da6
GM
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")))
e0af0d3e 2880 :group 'ps-print-color)
12d89a2e 2881
e0af0d3e 2882(defcustom ps-auto-font-detect t
df5e6194 2883 "*Non-nil means automatically detect bold/italic/underline face attributes.
319acba0
GM
2884If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
2885`ps-underlined-faces'."
e0af0d3e
RS
2886 :type 'boolean
2887 :group 'ps-print-font)
12d89a2e 2888
e0af0d3e 2889(defcustom ps-bold-faces
090be653
RS
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))
86c10ecb 2896 "*A list of the \(non-bold\) faces that should be printed in bold font.
8bd22fcf 2897This applies to generating PostScript."
e0af0d3e
RS
2898 :type '(repeat face)
2899 :group 'ps-print-face)
12d89a2e 2900
e0af0d3e 2901(defcustom ps-italic-faces
090be653
RS
2902 (unless ps-print-color-p
2903 '(font-lock-variable-name-face
8bd22fcf 2904 font-lock-type-face
090be653
RS
2905 font-lock-string-face
2906 font-lock-comment-face
2907 font-lock-warning-face))
86c10ecb 2908 "*A list of the \(non-italic\) faces that should be printed in italic font.
8bd22fcf 2909This applies to generating PostScript."
e0af0d3e
RS
2910 :type '(repeat face)
2911 :group 'ps-print-face)
12d89a2e 2912
e0af0d3e 2913(defcustom ps-underlined-faces
090be653
RS
2914 (unless ps-print-color-p
2915 '(font-lock-function-name-face
883212ce 2916 font-lock-constant-face
090be653 2917 font-lock-warning-face))
86c10ecb 2918 "*A list of the \(non-underlined\) faces that should be printed underlined.
8bd22fcf 2919This applies to generating PostScript."
e0af0d3e
RS
2920 :type '(repeat face)
2921 :group 'ps-print-face)
12d89a2e 2922
906d41a7
GM
2923(defcustom ps-use-face-background nil
2924 "*Specify if face background should be used.
2925
2926Valid values are:
2927
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.
2931
2932Any other value will be treated as t."
8e234846
GM
2933 :type '(choice :menu-tag "Use Face Background"
2934 :tag "Use Face Background"
906d41a7
GM
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)
2941
e0af0d3e 2942(defcustom ps-left-header
12d89a2e 2943 (list 'ps-get-buffer-name 'ps-header-dirpart)
bcc0d457 2944 "*The items to display (each on a line) on the left part of the page header.
8bd22fcf 2945This applies to generating PostScript.
12d89a2e 2946
319acba0
GM
2947The value should be a list of strings and symbols, each representing an entry
2948in the PostScript array HeaderLinesLeft.
12d89a2e
RS
2949
2950Strings are inserted unchanged into the array; those representing
2951PostScript string literals should be delimited with PostScript string
2952delimiters '(' and ')'.
2953
319acba0
GM
2954For symbols with bound functions, the function is called and should return a
2955string to be inserted into the array. For symbols with bound values, the value
2956should be a string to be inserted into the array. In either case, function or
2957variable, the string value has PostScript string delimiters added to it."
ef1159c2
EZ
2958 :type '(repeat (choice :menu-tag "Left Header"
2959 :tag "Left Header"
2960 string symbol))
6e1b1da6 2961 :group 'ps-print-headers)
12d89a2e 2962
e0af0d3e 2963(defcustom ps-right-header
2bd80d73 2964 (list "/pagenumberstring load"
4b81a999 2965 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
bcc0d457 2966 "*The items to display (each on a line) on the right part of the page header.
8bd22fcf 2967This applies to generating PostScript.
12d89a2e 2968
319acba0 2969See the variable `ps-left-header' for a description of the format of this
4b81a999
GM
2970variable.
2971
2972There are the following basic functions implemented:
2973
2974 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
2975 as, for example, \"06/18/01\".
2976
2977 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
2978
2979 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
2980
2981You can also create your own time stamp function by using `format-time-string'
2982(which see)."
ef1159c2
EZ
2983 :type '(repeat (choice :menu-tag "Right Header"
2984 :tag "Right Header"
2985 string symbol))
6e1b1da6 2986 :group 'ps-print-headers)
ef2cbb24 2987
319acba0
GM
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.
2991This applies to generating PostScript.
2992
2993The value should be a list of strings and symbols, each representing an entry
2994in the PostScript array FooterLinesLeft.
2995
2996Strings are inserted unchanged into the array; those representing PostScript
2997string literals should be delimited with PostScript string delimiters '(' and
2998')'.
2999
3000For symbols with bound functions, the function is called and should return a
3001string to be inserted into the array. For symbols with bound values, the value
3002should be a string to be inserted into the array. In either case, function or
3003variable, 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)
3009
3010(defcustom ps-right-footer
3011 (list "/pagenumberstring load"
4b81a999 3012 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
319acba0
GM
3013 "*The items to display (each on a line) on the right part of the page footer.
3014This applies to generating PostScript.
3015
3016See the variable `ps-left-footer' for a description of the format of this
4b81a999
GM
3017variable.
3018
3019There are the following basic functions implemented:
3020
3021 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3022 as, for example, \"06/18/01\".
3023
3024 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3025
3026 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3027
3028You can also create your own time stamp function by using `format-time-string'
3029(which see)."
319acba0
GM
3030 :version "21.1"
3031 :type '(repeat (choice :menu-tag "Right Footer"
3032 :tag "Right Footer"
3033 string symbol))
3034 :group 'ps-print-headers)
3035
e0af0d3e
RS
3036(defcustom ps-razzle-dazzle t
3037 "*Non-nil means report progress while formatting buffer."
3038 :type 'boolean
6e1b1da6 3039 :group 'ps-print-miscellany)
12d89a2e 3040
a18ed129 3041(defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
12d89a2e 3042 "*Contains the header line identifying the output as PostScript.
319acba0
GM
3043By default, `ps-adobe-tag' contains the standard identifier. Some printers
3044require slightly different versions of this line."
a18ed129 3045 :type 'string
6e1b1da6 3046 :group 'ps-print-miscellany)
12d89a2e 3047
e0af0d3e 3048(defcustom ps-build-face-reference t
12d89a2e
RS
3049 "*Non-nil means build the reference face lists.
3050
319acba0
GM
3051ps-print sets this value to nil after it builds its internal reference lists of
3052bold and italic faces. By settings its value back to t, you can force ps-print
3053to rebuild the lists the next time you invoke one of the ...-with-faces
3054commands.
12d89a2e 3055
319acba0
GM
3056You should set this value back to t after you change the attributes of any
3057face, or create new faces. Most users shouldn't have to worry about its
3058setting, though."
e0af0d3e
RS
3059 :type 'boolean
3060 :group 'ps-print-face)
12d89a2e 3061
e0af0d3e 3062(defcustom ps-always-build-face-reference nil
12d89a2e
RS
3063 "*Non-nil means always rebuild the reference face lists.
3064
319acba0
GM
3065If this variable is non-nil, ps-print will rebuild its internal reference lists
3066of bold and italic faces *every* time one of the ...-with-faces commands is
3067called. Most users shouldn't need to set this variable."
e0af0d3e
RS
3068 :type 'boolean
3069 :group 'ps-print-face)
ef2cbb24 3070
bc0d41bd
KH
3071(defcustom ps-banner-page-when-duplexing nil
3072 "*Non-nil means the very first page is skipped.
3073It's like the very first character of buffer (or region) is ^L (\\014)."
3074 :type 'boolean
6e1b1da6 3075 :group 'ps-print-headers)
bc0d41bd 3076
98f2fbe7
GM
3077(defcustom ps-postscript-code-directory
3078 (or (and (fboundp 'locate-data-directory) ; xemacs
8e234846 3079 (locate-data-directory "ps-print"))
98f2fbe7 3080 data-directory) ; emacs
41481e4b
KH
3081 "*Directory where it's located the PostScript prologue file used by ps-print.
3082By default, this directory is the same as in the variable `data-directory'."
3083 :type 'directory
6e1b1da6 3084 :group 'ps-print-miscellany)
41481e4b 3085
6bf5fb46
GM
3086(defcustom ps-line-spacing 0
3087 "*Specify line spacing, in points, for ordinary text.
3088
3089See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3090
3091To 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)
3101
3102(defcustom ps-paragraph-spacing 0
3103 "*Specify paragraph spacing, in points, for ordinary text.
3104
3105See also `ps-line-spacing' and `ps-paragraph-regexp'.
3106
3107To 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)
3117
3118(defcustom ps-paragraph-regexp "[ \t]*$"
3119 "*Specify paragraph delimiter.
3120
3121It should be a regexp or nil.
3122
3123See 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)
3129
3130(defcustom ps-begin-cut-regexp nil
3131 "*Specify regexp which is start of a region to cut out when printing.
3132
3133As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
3134set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
3135some special printing instructions from the actual print. Special printing
3136instructions may be appended to the end of the file just like any other
3137buffer-local variables. See section \"Local Variables in Files\" on Emacs
3138manual for more information.
3139
3140Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3141actually gets printed. Both variables may be set to nil in which case no
3142cutting occurs."
3143 :type 'regexp
3144 :version "21.1"
3145 :group 'ps-print-miscellany)
3146
3147(defcustom ps-end-cut-regexp nil
3148 "*Specify regexp which is end of the region to cut out when printing.
3149
3150See `ps-begin-cut-regexp' for more information."
3151 :type 'regexp
3152 :version "21.1"
3153 :group 'ps-print-miscellany)
3154
0a5daee5 3155
1fd9b7fe
GM
3156;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3157;; Selected Pages
3158
3159
3160(defvar ps-last-selected-pages nil
3161 "Latest `ps-selected-pages' value.")
3162
3163
3164(defun ps-restore-selected-pages ()
3165 "Restore latest `ps-selected-pages' value."
3166 (interactive)
3167 (setq ps-selected-pages ps-last-selected-pages))
3168
3169
0a5daee5
KH
3170;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3171;; Customization
3172
3173
3174;;;###autoload
3175(defun ps-print-customize ()
3176 "Customization of ps-print group."
3177 (interactive)
3178 (customize-group 'ps-print))
3179
3180
ef2cbb24 3181;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12d89a2e 3182;; User commands
ef2cbb24 3183
0a5daee5 3184
00aa16af 3185;;;###autoload
ef2cbb24 3186(defun ps-print-buffer (&optional filename)
12d89a2e 3187 "Generate and print a PostScript image of the buffer.
ef2cbb24 3188
319acba0
GM
3189Interactively, when you use a prefix argument (C-u), the command prompts the
3190user for a file name, and saves the PostScript image in that file instead of
3191sending it to the printer.
ef2cbb24 3192
319acba0
GM
3193Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3194send the image to the printer. If FILENAME is a string, save the PostScript
3195image in a file with that name."
00aa16af 3196 (interactive (list (ps-print-preprint current-prefix-arg)))
87a16a06 3197 (ps-print-without-faces (point-min) (point-max) filename))
ef2cbb24
RS
3198
3199
00aa16af 3200;;;###autoload
ef2cbb24 3201(defun ps-print-buffer-with-faces (&optional filename)
12d89a2e 3202 "Generate and print a PostScript image of the buffer.
319acba0
GM
3203Like `ps-print-buffer', but includes font, color, and underline information in
3204the generated image. This command works only if you are using a window system,
3205so it has a way to determine color values."
00aa16af 3206 (interactive (list (ps-print-preprint current-prefix-arg)))
87a16a06 3207 (ps-print-with-faces (point-min) (point-max) filename))
ef2cbb24 3208
ef2cbb24 3209
00aa16af 3210;;;###autoload
ef2cbb24 3211(defun ps-print-region (from to &optional filename)
12d89a2e 3212 "Generate and print a PostScript image of the region.
12d89a2e 3213Like `ps-print-buffer', but prints just the current region."
00aa16af 3214 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
a18ed129 3215 (ps-print-without-faces from to filename t))
ef2cbb24 3216
ef2cbb24 3217
00aa16af 3218;;;###autoload
ef2cbb24 3219(defun ps-print-region-with-faces (from to &optional filename)
12d89a2e 3220 "Generate and print a PostScript image of the region.
319acba0
GM
3221Like `ps-print-region', but includes font, color, and underline information in
3222the generated image. This command works only if you are using a window system,
3223so it has a way to determine color values."
00aa16af 3224 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
a18ed129 3225 (ps-print-with-faces from to filename t))
ef2cbb24 3226
ef2cbb24 3227
00aa16af 3228;;;###autoload
ef2cbb24 3229(defun ps-spool-buffer ()
12d89a2e 3230 "Generate and spool a PostScript image of the buffer.
319acba0
GM
3231Like `ps-print-buffer' except that the PostScript image is saved in a local
3232buffer to be sent to the printer later.
ef2cbb24 3233
12d89a2e 3234Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3235 (interactive)
87a16a06 3236 (ps-spool-without-faces (point-min) (point-max)))
ef2cbb24 3237
ef2cbb24 3238
00aa16af 3239;;;###autoload
ef2cbb24 3240(defun ps-spool-buffer-with-faces ()
12d89a2e 3241 "Generate and spool a PostScript image of the buffer.
319acba0
GM
3242Like `ps-spool-buffer', but includes font, color, and underline information in
3243the generated image. This command works only if you are using a window system,
3244so it has a way to determine color values.
ef2cbb24 3245
12d89a2e 3246Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3247 (interactive)
87a16a06 3248 (ps-spool-with-faces (point-min) (point-max)))
ef2cbb24 3249
ef2cbb24 3250
00aa16af 3251;;;###autoload
ef2cbb24 3252(defun ps-spool-region (from to)
12d89a2e 3253 "Generate a PostScript image of the region and spool locally.
12d89a2e 3254Like `ps-spool-buffer', but spools just the current region.
ef2cbb24 3255
12d89a2e 3256Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3257 (interactive "r")
a18ed129 3258 (ps-spool-without-faces from to t))
ef2cbb24 3259
ef2cbb24 3260
00aa16af 3261;;;###autoload
ef2cbb24 3262(defun ps-spool-region-with-faces (from to)
12d89a2e 3263 "Generate a PostScript image of the region and spool locally.
319acba0
GM
3264Like `ps-spool-region', but includes font, color, and underline information in
3265the generated image. This command works only if you are using a window system,
3266so it has a way to determine color values.
ef2cbb24 3267
12d89a2e 3268Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3269 (interactive "r")
a18ed129 3270 (ps-spool-with-faces from to t))
ef2cbb24 3271
00aa16af 3272;;;###autoload
ef2cbb24
RS
3273(defun ps-despool (&optional filename)
3274 "Send the spooled PostScript to the printer.
3275
319acba0
GM
3276Interactively, when you use a prefix argument (C-u), the command prompts the
3277user for a file name, and saves the spooled PostScript image in that file
3278instead of sending it to the printer.
ef2cbb24 3279
319acba0
GM
3280Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3281send the image to the printer. If FILENAME is a string, save the PostScript
3282image in a file with that name."
00aa16af
RS
3283 (interactive (list (ps-print-preprint current-prefix-arg)))
3284 (ps-do-despool filename))
12d89a2e 3285
bcc0d457
RS
3286;;;###autoload
3287(defun ps-line-lengths ()
319acba0
GM
3288 "Display the correspondence between a line length and a font size, using the
3289current ps-print setup.
bcc0d457
RS
3290Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3291 (interactive)
3292 (ps-line-lengths-internal))
3293
3294;;;###autoload
3295(defun ps-nb-pages-buffer (nb-lines)
06fb6aab
RS
3296 "Display number of pages to print this buffer, for various font heights.
3297The table depends on the current ps-print setup."
bcc0d457
RS
3298 (interactive (list (count-lines (point-min) (point-max))))
3299 (ps-nb-pages nb-lines))
3300
3301;;;###autoload
3302(defun ps-nb-pages-region (nb-lines)
06fb6aab
RS
3303 "Display number of pages to print the region, for various font heights.
3304The table depends on the current ps-print setup."
bcc0d457
RS
3305 (interactive (list (count-lines (mark) (point))))
3306 (ps-nb-pages nb-lines))
3307
c86f4619
GM
3308(defvar ps-prefix-quote nil
3309 "Used for `ps-print-quote' (which see).")
efa89c1f 3310
bcc0d457
RS
3311;;;###autoload
3312(defun ps-setup ()
496725ad 3313 "Return the current PostScript-generation setup."
efa89c1f 3314 (let (ps-prefix-quote)
319acba0 3315 (mapconcat
efa89c1f 3316 #'ps-print-quote
319acba0
GM
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)
3327 nil
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)
3333 nil
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)
3341 nil
3342 '(17 . ps-default-fg)
3343 '(17 . ps-default-bg)
3344 '(17 . ps-razzle-dazzle)
3345 nil
3346 '(23 . ps-use-face-background)
3347 nil
3348 '(28 . ps-print-control-characters)
3349 nil
3350 '(26 . ps-print-background-image)
3351 nil
3352 '(25 . ps-print-background-text)
3353 nil
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)
3359 nil
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)
3388 nil
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)
3393 nil
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)
3410 nil
3411 '(23 . ps-even-or-odd-pages)
3412 '(23 . ps-selected-pages)
3413 '(23 . ps-last-selected-pages)
3414 nil
3415 '(31 . ps-build-face-reference)
3416 '(31 . ps-always-build-face-reference)
3417 nil
3418 '(20 . ps-auto-font-detect)
3419 '(20 . ps-bold-faces)
3420 '(20 . ps-italic-faces)
3421 '(20 . ps-underlined-faces)
c86f4619 3422 " )\n
bd7a2e26
GM
3423;; The following customized variables have long lists and are seldom modified:
3424;; ps-page-dimensions-database
3425;; ps-font-info-database
1fd9b7fe 3426
319acba0
GM
3427;;; ps-print - end of settings\n")
3428 "\n")))
bcc0d457 3429
0a5daee5 3430
12d89a2e
RS
3431;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3432;; Utility functions and variables:
3433
0a5daee5 3434
efa89c1f 3435(defun ps-print-quote (elt)
c86f4619
GM
3436 "Quote ELT for printing (used for showing settings).
3437
3438If ELT is nil, return an empty string.
3439If ELT is string, return it.
3440Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3441LEN 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
3443used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3444generated is:
3445
3446 * If `ps-prefix-quote' is nil:
3447 \"(setq SYM-NAME SYM-VALUE\"
3448 |<------->|
3449 LEN
3450
3451 * If `ps-prefix-quote' is non-nil:
3452 \" SYM-NAME SYM-VALUE\"
3453 |<------->|
3454 LEN
3455
3456If `ps-prefix-quote' is nil, it's set to t after generating string."
efa89c1f
GM
3457 (cond
3458 ((null elt) "")
3459 ((stringp elt) elt)
3460 (t
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
c86f4619
GM
3467 " "
3468 (setq ps-prefix-quote t)
efa89c1f
GM
3469 "(setq ")
3470 key
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))))))
3478 ))
3479
3480
319acba0
GM
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))))
3484
3485
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)))
3489
3490
3491(defun ps-put (alist-sym key value)
3492 "Store element (KEY . VALUE) into association list ALIST-SYM.
3493If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3494It 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:))
3501
3502
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))
3517
3518
4b81a999
GM
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"))
3522
3523
2bd80d73 3524(defun ps-time-stamp-mon-dd-yyyy ()
4b81a999 3525 "Return date as \"Jun 18 2001\"."
2bd80d73
GM
3526 (format-time-string "%b %d %Y"))
3527
3528
3529(defun ps-time-stamp-hh:mm:ss ()
4b81a999 3530 "Return time as \"17:28:31\"."
2bd80d73
GM
3531 (format-time-string "%T"))
3532
3533
877cf6b4
GM
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)))
3540
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,
12d89a2e
RS
3545 ; x-font-regexp
3546
08ea6f17 3547
3e9cb08f
GM
3548 ;; Return t if the device (which can be changed during an emacs session)
3549 ;; can handle colors.
ea0c615d 3550 ;; This function is not yet implemented for GNU emacs.
3e9cb08f
GM
3551 (cond ((and (eq ps-print-emacs-type 'xemacs)
3552 (>= emacs-minor-version 12)) ; xemacs
3553 (defun ps-color-device ()
ea0c615d 3554 (eq (ps-x-device-class) 'color)))
3e9cb08f
GM
3555
3556 (t ; emacs
3557 (defun ps-color-device ()
ea0c615d
GM
3558 (if (fboundp 'color-values)
3559 (ps-e-color-values "Green")
3560 t))))
3561
3e9cb08f 3562
47b54c71
GM
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)
3568
3569 (defun ps-extent-sorter (a b)
3570 (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
3571
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))))
3582
3583 (defun ps-xemacs-color-name (color)
3584 (if (ps-x-color-specifier-p color)
3585 (ps-x-color-name color)
3586 color))
3587
3e9cb08f
GM
3588 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
3589
2bd80d73
GM
3590 ;; to avoid XEmacs compilation gripes
3591 (defvar coding-system-for-write nil)
3592
3e9cb08f 3593 (defun ps-color-values (x-color)
ea0c615d
GM
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))
3599 (t
e8af40ee 3600 (error "No available function to determine X color values"))))
3e9cb08f
GM
3601
3602 (defalias 'ps-face-foreground-name 'face-foreground)
3603 (defalias 'ps-face-background-name 'face-background)
3604
3605 (defun ps-face-bold-p (face)
2bd80d73 3606 (or (ps-e-face-bold-p face)
3e9cb08f
GM
3607 (memq face ps-bold-faces)))
3608
3609 (defun ps-face-italic-p (face)
2bd80d73 3610 (or (ps-e-face-italic-p face)
3e9cb08f
GM
3611 (memq face ps-italic-faces)))
3612 )
3613 ; xemacs
3614 ; lucid
3615 (t ; epoch
3616
08ea6f17
GM
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)))
3e9cb08f 3620
3e9cb08f
GM
3621 (defun ps-color-values (x-color)
3622 (let ((color (ps-xemacs-color-name x-color)))
3623 (cond
3624 ((fboundp 'x-color-values)
ea0c615d 3625 (ps-e-x-color-values color))
3e9cb08f
GM
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))))
3632 (t
e8af40ee 3633 (error "No available function to determine X color values")))))
3e9cb08f
GM
3634
3635 (defun ps-face-foreground-name (face)
3636 (ps-xemacs-color-name (face-foreground face)))
3637
3638 (defun ps-face-background-name (face)
3639 (ps-xemacs-color-name (face-background face)))
3640
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
3644
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
3649 )))
3650
3651
ea0c615d 3652(defvar ps-print-color-scale 1.0)
47b54c71 3653
3e9cb08f
GM
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)))
3658
3659
3660(defun ps-face-underlined-p (face)
3661 (or (face-underline-p face)
3662 (memq face ps-underlined-faces)))
e65df0a1 3663
857686a6 3664
41481e4b 3665(defun ps-prologue-file (filenumber)
2bd80d73
GM
3666 "If prologue FILENUMBER exists and is readable, returns contents as string.
3667
3668Note: 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)
319acba0
GM
3675 (file-readable-p filename))
3676 (with-temp-buffer
3677 (insert-file-contents filename)
3678 (buffer-string))
e8af40ee 3679 (error "ps-print PostScript prologue `%s' file was not found"
2bd80d73 3680 filename))))
bcc0d457 3681
bcc0d457 3682
41481e4b 3683(defvar ps-mark-code-directory nil)
bcc0d457 3684
66e63857
GM
3685(defvar ps-print-prologue-0 ""
3686 "ps-print PostScript error handler.")
3687
41481e4b 3688(defvar ps-print-prologue-1 ""
6bf5fb46 3689 "ps-print PostScript prologue.")
12d89a2e
RS
3690
3691;; Start Editing Here:
ef2cbb24 3692
12d89a2e
RS
3693(defvar ps-source-buffer nil)
3694(defvar ps-spool-buffer-name "*PostScript*")
3695(defvar ps-spool-buffer nil)
ef2cbb24 3696
12d89a2e
RS
3697(defvar ps-output-head nil)
3698(defvar ps-output-tail nil)
ef2cbb24 3699
4b3eb10f
GM
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
bd7a2e26
GM
3706(defvar ps-lines-printed 0) ; total lines printed
3707(defvar ps-showline-count 1) ; line number counter
1fd9b7fe
GM
3708(defvar ps-first-page nil)
3709(defvar ps-last-page nil)
ea0c615d 3710(defvar ps-print-page-p t)
87a16a06 3711
857686a6 3712(defvar ps-control-or-escape-regexp nil)
98f2fbe7 3713(defvar ps-n-up-on nil)
857686a6 3714
87a16a06
RS
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)
ef2cbb24 3719
12d89a2e 3720(defvar ps-current-font 0)
6e1b1da6
GM
3721(defvar ps-default-foreground nil)
3722(defvar ps-default-color nil)
3723(defvar ps-current-color nil)
12d89a2e
RS
3724(defvar ps-current-bg nil)
3725
2bd80d73 3726(defvar ps-zebra-stripe-full-p nil)
12d89a2e
RS
3727(defvar ps-razchunk 0)
3728
d3ab8dac 3729(defvar ps-color-p nil)
bcc0d457
RS
3730(defvar ps-color-format
3731 (if (eq ps-print-emacs-type 'emacs)
12d89a2e 3732
12b88fff
RS
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"
12d89a2e 3737
12b88fff 3738 ;; Lucid emacsen will have to make do with %s (princ) for floats.
bcc0d457 3739 "%s %s %s"))
12d89a2e 3740
319acba0
GM
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.
12d89a2e 3744
bcc0d457 3745(defvar ps-header-pad 0
496725ad
RS
3746 "Vertical and horizontal space between the header frame and the text.
3747This is in units of points (1/72 inch).")
12d89a2e 3748
319acba0
GM
3749(defvar ps-footer-pad 0
3750 "Vertical and horizontal space between the footer frame and the text.
3751This is in units of points (1/72 inch).")
3752
bcc0d457 3753;; Define accessors to the dimensions list.
12d89a2e 3754
bcc0d457
RS
3755(defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3756(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
bc0d41bd 3757(defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
12d89a2e 3758
87a16a06 3759(defvar ps-landscape-page-height nil)
12d89a2e 3760
12d89a2e
RS
3761(defvar ps-print-width nil)
3762(defvar ps-print-height nil)
3763
8bd22fcf
KH
3764(defvar ps-height-remaining nil)
3765(defvar ps-width-remaining nil)
12d89a2e 3766
7d8b7e8e
KH
3767(defvar ps-font-size-internal nil)
3768(defvar ps-header-font-size-internal nil)
3769(defvar ps-header-title-font-size-internal nil)
319acba0 3770(defvar ps-footer-font-size-internal nil)
6bf5fb46
GM
3771(defvar ps-line-spacing-internal nil)
3772(defvar ps-paragraph-spacing-internal nil)
7d8b7e8e 3773
87a16a06
RS
3774\f
3775;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3776;; Internal Variables
3777
3778
3779(defvar ps-print-face-extension-alist nil
a18ed129 3780 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
87a16a06
RS
3781An element of this list has the following form:
3782
3783 (FACE . [BITS FG BG])
3784
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)
3791
a18ed129
RS
3792Don't change this list directly; instead,
3793use `ps-extend-face' and `ps-extend-face-list'.
3794See documentation for `ps-extend-face' for valid extension symbol.")
3795
3796
3797(defvar ps-print-face-alist nil
3798 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
3799
3800An element of this list has the same form as an element of
3801`ps-print-face-extension-alist'.
3802
3803Don't change this list directly; this list is used by `ps-face-attributes',
3804`ps-map-face' and `ps-build-reference-face-lists'.")
87a16a06
RS
3805
3806
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.
3817Each symbol correspond to one bit in a bit vector.")
3818
3819\f
3820;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
a18ed129 3821;; Remapping Faces
87a16a06
RS
3822
3823
3824;;;###autoload
3825(defun ps-extend-face-list (face-extension-list &optional merge-p)
3826 "Extend face in `ps-print-face-extension-alist'.
3827
a18ed129
RS
3828If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
3829with face extension in `ps-print-face-extension-alist'; otherwise, overrides.
87a16a06
RS
3830
3831The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
3832
3833See `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))))
3837
3838
3839;;;###autoload
3840(defun ps-extend-face (face-extension &optional merge-p)
3841 "Extend face in `ps-print-face-extension-alist'.
3842
6bdb808e 3843If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
a18ed129 3844with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
87a16a06
RS
3845
3846The elements of FACE-EXTENSION list have the form:
3847
3848 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
3849
3850FACE-NAME is a face name symbol.
3851
3852FOREGROUND and BACKGROUND may be nil or a string that denotes the
3853foreground and background colors respectively.
3854
3855EXTENSION 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.
a18ed129 3863 outline - print characters as hollow outlines.
87a16a06
RS
3864
3865If 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)))))
3883
3884
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))
3895
3896\f
857686a6 3897;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
bc0d41bd 3898;; Adapted from font-lock: (obsolete stuff)
857686a6
RS
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.
3903
0a5daee5 3904
857686a6
RS
3905(defun ps-font-lock-face-attributes ()
3906 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
3907 (boundp 'font-lock-face-attributes)
3e9cb08f 3908 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
857686a6 3909 (while face-attributes
6bdb808e
RS
3910 (let* ((face-attribute
3911 (car (prog1 face-attributes
3912 (setq face-attributes (cdr face-attributes)))))
857686a6
RS
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 )))))))
3937
3938\f
87a16a06
RS
3939;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3940;; Internal functions and variables
3941
3942
3556c6dd
GM
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)
12b88fff
RS
3947
3948
a18ed129 3949(defun ps-print-without-faces (from to &optional filename region-p)
857686a6 3950 (ps-spool-without-faces from to region-p)
87a16a06
RS
3951 (ps-do-despool filename))
3952
3953
a18ed129 3954(defun ps-spool-without-faces (from to &optional region-p)
12b88fff 3955 (run-hooks 'ps-print-hook)
712dc9e0 3956 (ps-printing-region region-p from)
87a16a06
RS
3957 (ps-generate (current-buffer) from to 'ps-generate-postscript))
3958
3959
a18ed129 3960(defun ps-print-with-faces (from to &optional filename region-p)
857686a6 3961 (ps-spool-with-faces from to region-p)
87a16a06
RS
3962 (ps-do-despool filename))
3963
3964
a18ed129 3965(defun ps-spool-with-faces (from to &optional region-p)
12b88fff 3966 (run-hooks 'ps-print-hook)
712dc9e0 3967 (ps-printing-region region-p from)
87a16a06
RS
3968 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
3969
3970
bc0d41bd 3971(defun ps-count-lines (from to)
a18ed129 3972 (+ (count-lines from to)
857686a6
RS
3973 (save-excursion
3974 (goto-char to)
3975 (if (= (current-column) 0) 1 0))))
87a16a06
RS
3976
3977
a18ed129 3978(defvar ps-printing-region nil
bc0d41bd
KH
3979 "Variable used to indicate if the region that ps-print is printing.
3980It is a cons, the car of which is the line number where the region begins, and
3981its cdr is the total number of lines in the buffer. Formatting functions can
3982use this information to print the original line number (and not the number of
3983lines printed), and to indicate in the header that the printout is of a partial
3984file.")
3985
3986
3987(defvar ps-printing-region-p nil
3988 "Non-nil means ps-print is printing a region.")
87a16a06
RS
3989
3990
712dc9e0 3991(defun ps-printing-region (region-p from)
bc0d41bd
KH
3992 (setq ps-printing-region-p region-p
3993 ps-printing-region
3994 (cons (if region-p
712dc9e0 3995 (ps-count-lines (point-min) from)
bc0d41bd
KH
3996 1)
3997 (ps-count-lines (point-min) (point-max)))))
87a16a06
RS
3998
3999\f
12d89a2e
RS
4000;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4001;; Internal functions
4002
0a5daee5 4003
7ae35a2f 4004(defsubst ps-font-alist (font-sym)
12b88fff
RS
4005 (get font-sym 'fonts))
4006
4007(defun ps-font (font-sym font-type)
4008 "Font family name for text of `font-type', when generating PostScript."
7ae35a2f 4009 (let* ((font-list (ps-font-alist font-sym))
12b88fff 4010 (normal-font (cdr (assq 'normal font-list))))
6bdb808e
RS
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)))
12b88fff 4014
319acba0 4015(defsubst ps-fonts (font-sym)
7ae35a2f 4016 (mapcar 'cdr (ps-font-alist font-sym)))
12b88fff 4017
319acba0 4018(defsubst ps-font-number (font-sym font-type)
7ae35a2f 4019 (or (ps-alist-position font-type (ps-font-alist font-sym))
12b88fff
RS
4020 0))
4021
4022(defsubst ps-line-height (font-sym)
4023 "The height of a line, for generating PostScript.
4024This is the value that ps-print uses to determine the height,
4025y-dimension, of the lines of text it has printed, and thus affects the
4026point at which page-breaks are placed.
4027The line-height is *not* the same as the point size of the font."
4028 (get font-sym 'line-height))
4029
4030(defsubst ps-title-line-height (font-sym)
4031 "The height of a `title' line, for generating PostScript.
4032This is the value that ps-print uses to determine the height,
4033y-dimension, of the lines of text it has printed, and thus affects the
4034point at which page-breaks are placed.
4035The title-line-height is *not* the same as the point size of the font."
4036 (get font-sym 'title-line-height))
4037
4038(defsubst ps-space-width (font-sym)
4039 "The width of a space character, for generating PostScript.
4040This value is used in expanding tab characters."
4041 (get font-sym 'space-width))
4042
4043(defsubst ps-avg-char-width (font-sym)
4044 "The average width, in points, of a character, for generating PostScript.
4045This is the value that ps-print uses to determine the length,
4046x-dimension, of the text it has printed, and thus affects the point at
4047which long lines wrap around."
4048 (get font-sym 'avg-char-width))
4049
bcc0d457 4050(defun ps-line-lengths-internal ()
87a16a06 4051 "Display the correspondence between a line length and a font size,
bcc0d457
RS
4052using the current ps-print setup.
4053Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
df5e6194
GM
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
4078 )
bcc0d457
RS
4079 (setq cw-min (/ (* icw fs-min) ifs)
4080 nb-cpl-max (floor (/ print-width cw-min))
4081 cw-max (/ (* icw fs-max) ifs)
8bd22fcf
KH
4082 nb-cpl-min (floor (/ print-width cw-max))
4083 nb-cpl nb-cpl-min)
bcc0d457
RS
4084 (set-buffer buf)
4085 (goto-char (point-max))
df5e6194 4086 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
8bd22fcf 4087 (insert ps-setup
df5e6194 4088 "\nnb char per line / font size\n")
bcc0d457 4089 (while (<= nb-cpl nb-cpl-max)
8bd22fcf
KH
4090 (setq cw (/ print-width (float nb-cpl))
4091 fs (/ (* ifs cw) icw))
df5e6194 4092 (insert (format "%16d %s\n" nb-cpl fs))
bcc0d457
RS
4093 (setq nb-cpl (1+ nb-cpl)))
4094 (insert "\n")
4095 (display-buffer buf 'not-this-window)))
4096
4097(defun ps-nb-pages (nb-lines)
496725ad
RS
4098 "Display correspondence between font size and the number of pages.
4099The correspondence is based on having NB-LINES lines of text,
4100and on the current ps-print setup."
df5e6194
GM
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)))
6bf5fb46
GM
4110 (ps-line-spacing-internal
4111 (or ps-line-spacing-internal
4112 (ps-get-size ps-line-spacing "line spacing")))
df5e6194 4113 (buf (get-buffer-create "*Nb-Pages*"))
6bf5fb46 4114 (ils ps-line-spacing-internal) ; initial line spacing
df5e6194
GM
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
4132 )
6bf5fb46 4133 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
bcc0d457
RS
4134 nb-lpp-max (floor (/ page-height lh-min))
4135 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
6bf5fb46 4136 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
bcc0d457 4137 nb-lpp-min (floor (/ page-height lh-max))
8bd22fcf
KH
4138 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
4139 nb-page nb-page-min)
bcc0d457
RS
4140 (set-buffer buf)
4141 (goto-char (point-max))
df5e6194 4142 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
8bd22fcf 4143 (insert ps-setup
df5e6194 4144 (format "\nThere are %d lines.\n\n" nb-lines)
8bd22fcf 4145 "nb page / font size\n")
bcc0d457
RS
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))
df5e6194 4150 (insert (format "%7d %s\n" nb-page fs))
bcc0d457
RS
4151 (setq nb-page (1+ nb-page)))
4152 (insert "\n")
4153 (display-buffer buf 'not-this-window)))
4154
6bdb808e
RS
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))
4158
12b88fff
RS
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
ef1159c2 4162 (error "Don't have data to scale font %s. Known fonts families are %s"
12b88fff
RS
4163 font-family
4164 (mapcar 'car ps-font-info-database)))
6bdb808e
RS
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)))))
bcc0d457 4172
12d89a2e 4173(defun ps-get-page-dimensions ()
bcc0d457
RS
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)
12b88fff 4181 (error "The number of columns %d should be positive"
8bd22fcf 4182 ps-number-of-columns)))
bcc0d457 4183
12b88fff 4184 (ps-select-font ps-font-family 'ps-font-for-text
7d8b7e8e 4185 ps-font-size-internal ps-font-size-internal)
12b88fff 4186 (ps-select-font ps-header-font-family 'ps-font-for-header
7d8b7e8e
KH
4187 ps-header-font-size-internal
4188 ps-header-title-font-size-internal)
319acba0
GM
4189 (ps-select-font ps-footer-font-family 'ps-font-for-footer
4190 ps-footer-font-size-internal ps-footer-font-size-internal)
bcc0d457
RS
4191
4192 (setq page-width (ps-page-dimensions-get-width page-dimensions)
4193 page-height (ps-page-dimensions-get-height page-dimensions))
4194
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))))
4199
4200 ;; It is used to get the lower right corner (only in landscape mode)
4201 (setq ps-landscape-page-height page-height)
4202
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
8bd22fcf
KH
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))
bcc0d457
RS
4210 (if (<= ps-print-width 0)
4211 (error "Bad horizontal layout:
4212page-width == %s
4213ps-left-margin == %s
4214ps-right-margin == %s
4215ps-inter-column == %s
4216ps-number-of-columns == %s
4217| lm | text | ic | text | ic | text | rm |
4218page-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))
4226
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:
4231ps-top-margin == %s
4232ps-bottom-margin == %s
4233page-height == bm + print-height + tm
4234=> print-height == %d !"
4235 ps-top-margin
4236 ps-bottom-margin
4237 ps-print-height))
319acba0
GM
4238 ;; If headers are turned on, deduct the height of the header from the print
4239 ;; height.
8bd22fcf 4240 (if ps-print-header
12b88fff
RS
4241 (setq ps-header-pad (* ps-header-line-pad
4242 (ps-title-line-height 'ps-font-for-header))
8bd22fcf
KH
4243 ps-print-height (- ps-print-height
4244 ps-header-offset
4245 ps-header-pad
12b88fff
RS
4246 (ps-title-line-height 'ps-font-for-header)
4247 (* (ps-line-height 'ps-font-for-header)
4248 (1- ps-header-lines))
8bd22fcf 4249 ps-header-pad)))
bcc0d457 4250 (if (<= ps-print-height 0)
319acba0 4251 (error "Bad vertical layout (header):
bcc0d457
RS
4252ps-top-margin == %s
4253ps-bottom-margin == %s
4254ps-header-offset == %s
4255ps-header-pad == %s
4256header-height == %s
4257page-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
12b88fff
RS
4264 (ps-title-line-height 'ps-font-for-header)
4265 (* (ps-line-height 'ps-font-for-header)
4266 (1- ps-header-lines))
bcc0d457 4267 ps-header-pad)
2bd80d73 4268 ps-print-height))
319acba0
GM
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):
4282ps-top-margin == %s
4283ps-bottom-margin == %s
4284ps-footer-offset == %s
4285ps-footer-pad == %s
4286footer-height == %s
4287page-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))
2bd80d73
GM
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))
6bf5fb46
GM
4301 (zebra (* (+ line-height ps-line-spacing-internal)
4302 ps-zebra-stripe-height)))
2bd80d73
GM
4303 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
4304 line-height))
4305 (if (<= ps-print-height 0)
319acba0 4306 (error "Bad vertical layout (full zebra stripe follow):
2bd80d73
GM
4307ps-zebra-stripe-follow == %s
4308ps-zebra-stripe-height == %s
4309font-text-height == %s
6bf5fb46
GM
4310line-spacing == %s
4311page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
2bd80d73
GM
4312=> print-height == %d !"
4313 ps-zebra-stripe-follow
4314 ps-zebra-stripe-height
4315 (ps-line-height 'ps-font-for-text)
6bf5fb46 4316 ps-line-spacing-internal
2bd80d73 4317 ps-print-height))))))
ef2cbb24 4318
edc9cd35
GM
4319(defun ps-print-preprint (prefix-arg)
4320 (and prefix-arg
4321 (or (numberp prefix-arg)
4322 (listp prefix-arg))
d3ab8dac
KH
4323 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4324 (buffer-name)))
4325 ".ps"))
8bd22fcf
KH
4326 (prompt (format "Save PostScript to file: (default %s) " name))
4327 (res (read-file-name prompt default-directory name nil)))
ea0c615d
GM
4328 (while (cond ((file-directory-p res)
4329 (ding)
4330 (setq prompt "It's a directory"))
4331 ((not (file-writable-p res))
d3ab8dac 4332 (ding)
ea0c615d 4333 (setq prompt "File is unwritable"))
d3ab8dac 4334 ((file-exists-p res)
ea0c615d 4335 (setq prompt "File exists")
d3ab8dac
KH
4336 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4337 res))))
4338 (t nil))
4339 (setq res (read-file-name
ea0c615d 4340 (format "%s; save PostScript to file: " prompt)
d3ab8dac
KH
4341 (file-name-directory res) nil nil
4342 (file-name-nondirectory res))))
8bd22fcf
KH
4343 (if (file-directory-p res)
4344 (expand-file-name name (file-name-as-directory res))
4345 res))))
12d89a2e
RS
4346
4347;; The following functions implement a simple list-buffering scheme so
4348;; that ps-print doesn't have to repeatedly switch between buffers
857686a6
RS
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
12d89a2e
RS
4351;; insert its contents into the spool buffer (*PostScript*).
4352
857686a6
RS
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.")
4380
6bf5fb46 4381(defsubst ps-output-string-prim (string)
12d89a2e
RS
4382 (insert "(") ;insert start-string delimiter
4383 (save-excursion ;insert string
e65df0a1 4384 (insert (string-as-unibyte string)))
12d89a2e 4385 ;; Find and quote special characters as necessary for PS
c82b4a75 4386 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
b61e2c11
RS
4387 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4388 (let ((special (following-char)))
e65df0a1
KH
4389 (delete-char 1)
4390 (insert (aref ps-string-escape-codes special))))
12d89a2e
RS
4391 (goto-char (point-max))
4392 (insert ")")) ;insert end-string delimiter
ef2cbb24 4393
6bf5fb46 4394(defsubst ps-init-output-queue ()
1fd9b7fe 4395 (setq ps-output-head (list "")
8bd22fcf 4396 ps-output-tail ps-output-head))
ef2cbb24 4397
1fd9b7fe
GM
4398
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)))))
4406
4407
6bf5fb46 4408(defsubst ps-print-page-p ()
ea0c615d
GM
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)))
4417 (t
4418 nil))
4b3eb10f 4419 (cond ((eq ps-even-or-odd-pages 'even-page)
ea0c615d 4420 (= (logand ps-page-postscript 1) 0))
4b3eb10f 4421 ((eq ps-even-or-odd-pages 'odd-page)
ea0c615d
GM
4422 (= (logand ps-page-postscript 1) 1))
4423 (t)
4424 ))))
1fd9b7fe
GM
4425
4426
6bf5fb46 4427(defsubst ps-print-sheet-p ()
4b3eb10f
GM
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))
4433 (t)
4434 )))
4435
4436
12d89a2e 4437(defun ps-output (&rest args)
ea0c615d 4438 (when ps-print-page-p
1fd9b7fe
GM
4439 (setcdr ps-output-tail args)
4440 (while (cdr ps-output-tail)
4441 (setq ps-output-tail (cdr ps-output-tail)))))
ef2cbb24 4442
12d89a2e
RS
4443(defun ps-output-string (string)
4444 (ps-output t string))
ef2cbb24 4445
e65df0a1
KH
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)))
4449
12d89a2e
RS
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)))
e65df0a1
KH
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)
12d89a2e 4461 (setq ps-output-head (cdr ps-output-head))
e65df0a1
KH
4462 (save-excursion
4463 (search-backward "\nBeginDoc")
4464 (forward-char 1)
4465 (apply 'insert (car ps-output-head))))
4466 (t
4467 (insert it))))
12d89a2e
RS
4468 (setq ps-output-head (cdr ps-output-head))))
4469 (ps-init-output-queue))
4470
4471(defun ps-insert-file (fname)
4472 (ps-flush-output)
12d89a2e
RS
4473 (save-excursion
4474 (set-buffer ps-spool-buffer)
4475 (goto-char (point-max))
4476 (insert-file fname)))
06fb6aab 4477
319acba0 4478;; These functions insert the arrays that define the contents of the headers.
ef2cbb24 4479
12d89a2e 4480(defun ps-generate-header-line (fonttag &optional content)
319acba0 4481 (ps-output " [" fonttag " ")
12d89a2e 4482 (cond
319acba0
GM
4483 ;; Literal strings should be output as is -- the string must contain its own
4484 ;; PS string delimiters, '(' and ')', if necessary.
12d89a2e 4485 ((stringp content)
6bf5fb46 4486 (ps-output (ps-mule-encode-header-string content fonttag)))
12d89a2e 4487
319acba0
GM
4488 ;; Functions are called -- they should return strings; they will be inserted
4489 ;; as strings and the PS string delimiters added.
12d89a2e 4490 ((and (symbolp content) (fboundp content))
6bf5fb46
GM
4491 (ps-output-string (ps-mule-encode-header-string (funcall content)
4492 fonttag)))
12d89a2e 4493
319acba0
GM
4494 ;; Variables will have their contents inserted. They should contain
4495 ;; strings, and will be inserted as strings.
12d89a2e 4496 ((and (symbolp content) (boundp content))
6bf5fb46
GM
4497 (ps-output-string (ps-mule-encode-header-string (symbol-value content)
4498 fonttag)))
12d89a2e
RS
4499
4500 ;; Anything else will get turned into an empty string.
4501 (t
4502 (ps-output-string "")))
319acba0 4503 (ps-output "]\n"))
12d89a2e 4504
319acba0
GM
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"))
12d89a2e 4515
bc0d41bd 4516
6e1b1da6
GM
4517(defun ps-output-boolean (name bool)
4518 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
ef2cbb24 4519
06fb6aab 4520
319acba0
GM
4521(defun ps-output-frame-properties (name alist)
4522 (ps-output "/" name " ["
efa89c1f 4523 (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
319acba0
GM
4524 (ps-format-color (cdr (assq 'back-color alist)) 0.9)
4525 (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
efa89c1f
GM
4526 (ps-format-color (cdr (assq 'border-color alist)) 0.0)
4527 (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
319acba0
GM
4528 "]def\n"))
4529
4530
87a16a06
RS
4531(defun ps-background-pages (page-list func)
4532 (if page-list
4533 (mapcar
bc0d41bd
KH
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)))))
87a16a06
RS
4539 page-list)
4540 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4541
4542
bc0d41bd
KH
4543(defconst ps-boundingbox-re
4544 "^%%BoundingBox:\
4545\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4546
4547
87a16a06
RS
4548(defun ps-get-boundingbox ()
4549 (save-excursion
4550 (set-buffer ps-spool-buffer)
4551 (save-excursion
bc0d41bd 4552 (if (re-search-forward ps-boundingbox-re nil t)
87a16a06
RS
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)))))
4562
4563
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.
4567
4568(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
4569 "%0.3f " ; emacs
4570 "%s ")) ; Lucid emacsen
4571
4572
4573(defun ps-float-format (value &optional default)
4574 (let ((literal (or value default)))
efa89c1f
GM
4575 (cond ((null literal)
4576 " ")
4577 ((numberp literal)
4578 (format ps-float-format (* literal 1.0))) ; force float number
4579 (t
4580 (format "%s " literal))
4581 )))
87a16a06
RS
4582
4583
4584(defun ps-background-text ()
4585 (mapcar
bc0d41bd
KH
4586 #'(lambda (text)
4587 (setq ps-background-text-count (1+ ps-background-text-count))
c3d6d211 4588 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
bc0d41bd
KH
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
8e234846 4598 (ps-float-format (nth 2 text) "0") ; y position
c3d6d211 4599 "\nShowBackText}def\n")
bc0d41bd
KH
4600 (ps-background-pages (nthcdr 7 text) ; page list
4601 (format "ShowBackText-%d\n"
4602 ps-background-text-count)))
87a16a06
RS
4603 ps-print-background-text))
4604
4605
4606(defun ps-background-image ()
4607 (mapcar
bc0d41bd
KH
4608 #'(lambda (image)
4609 (let ((image-file (expand-file-name (nth 0 image))))
41481e4b
KH
4610 (when (file-readable-p image-file)
4611 (setq ps-background-image-count (1+ ps-background-image-count))
4612 (ps-output
c3d6d211 4613 (format "/ShowBackImage-%d{\n--back-- "
41481e4b
KH
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)))))
c3d6d211 4640 (ps-output "\nEndBackImage}def\n")
41481e4b
KH
4641 (ps-background-pages (nthcdr 6 image) ; page list
4642 (format "ShowBackImage-%d\n"
4643 ps-background-image-count)))))
87a16a06
RS
4644 ps-print-background-image))
4645
4646
a18ed129 4647(defun ps-background (page-number)
87a16a06 4648 (let (has-local-background)
bc0d41bd
KH
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)
c3d6d211 4655 (ps-output "/printLocalBackground{\n"
bc0d41bd 4656 (aref range 2)))))
87a16a06 4657 ps-background-pages)
c3d6d211 4658 (and has-local-background (ps-output "}def\n"))))
87a16a06
RS
4659
4660
0140c600
EZ
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)))
4670
c82b4a75 4671
6bdb808e
RS
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'.
7ae35a2f 4675(defun ps-alist-position (item list)
6bdb808e
RS
4676 (let ((tail list) (index 0) found)
4677 (while tail
7ae35a2f 4678 (if (setq found (eq (car (car tail)) item))
6bdb808e
RS
4679 (setq tail nil)
4680 (setq index (1+ index)
4681 tail (cdr tail))))
4682 (and found index)))
4683
4684
bc0d41bd
KH
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))
4710 (a3
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)
8e234846 4736 (2 t 1 2 0) ; adjusted by PostScript code
bc0d41bd
KH
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)
8e234846 4779 (2 t 1 2 0) ; adjusted by PostScript code
bc0d41bd
KH
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)
8e234846 4875 (2 t 1 2 0) ; adjusted by PostScript code
bc0d41bd
KH
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))
4922 (b4
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))
4946 (b5
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.
4972
4973Each element has the following form:
4974
4975 (PAGE
4976 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
4977 ...)
4978
4979Where:
4980PAGE is the page size used (see `ps-paper-type').
4981MAX is the maximum elements of this page matrix.
4982LANDSCAPE 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.
4987LINES is the number of lines of page matrix.
4988COLUMNS is the number of columns of page matrix.
4989COL-MISSING is the number of columns missing to fill the sheet.")
4990
4991
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))
4996
4997
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)))
5007
5008
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.
5083
5084Each element has the following form:
5085
5086 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5087
5088Where:
5089KIND is a valid value of `ps-n-up-filling'.
5090XCOL YCOL are the relative position for the next column.
5091XLIN YLIN are the relative position for the beginning of next line.
5092REPEAT is the number of repetions for external loop.
5093END is the number of repetions for internal loop and also the number of pages in
5094 a row.
5095XSTART YSTART are the relative position for the first page in a sheet.")
5096
5097
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))))
5101
5102
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))
5111
5112
66e63857
GM
5113(defconst ps-error-handler-alist
5114 '((none . 0)
5115 (paper . 1)
5116 (system . 2)
5117 (paper-and-system . 3))
2bd80d73
GM
5118 "Alist for error handler message.")
5119
5120
5121(defconst ps-zebra-stripe-alist
5122 '((follow . 1)
5123 (full . 2)
5124 (full-follow . 3))
5125 "Alist for zebra stripe continuation.")
66e63857
GM
5126
5127
ef2cbb24 5128(defun ps-begin-file ()
7bb054a5 5129 (setq ps-page-order 0
4b3eb10f 5130 ps-page-printed 0
87a16a06
RS
5131 ps-background-text-count 0
5132 ps-background-image-count 0
5133 ps-background-pages nil
5134 ps-background-all-pages nil)
12d89a2e 5135
bc0d41bd
KH
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)))
98f2fbe7 5140 (and ps-n-up-on (setq tumble (not tumble)))
bc0d41bd
KH
5141 (ps-output
5142 ps-adobe-tag
5143 "%%Title: " (buffer-name) ; Take job name from name of
8bd22fcf 5144 ; first buffer printed
bc0d41bd
KH
5145 "\n%%Creator: " (user-full-name)
5146 " (using ps-print v" ps-print-version
2bd80d73 5147 ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
bc0d41bd
KH
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
8e234846 5162 (if tumble " duplex(tumble)\n" " duplex\n")
bc0d41bd
KH
5163 "\n"))
5164
66e63857 5165 (ps-insert-string ps-print-prologue-header)
bc0d41bd 5166
8e234846
GM
5167 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5168 (ps-page-dimensions-get-media dimensions)
6bf5fb46 5169 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
6e1b1da6
GM
5170 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5171 (format "/ErrorMessage %s def\n\n"
66e63857
GM
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")
5177
5178 (ps-insert-string ps-user-defined-prologue)
5179
5180 (ps-output "\n%%EndProcSet\n\n")
bc0d41bd 5181
bc0d41bd
KH
5182 (ps-output-boolean "LandscapeMode "
5183 (or ps-landscape-mode
5184 (eq (ps-n-up-landscape n-up) 'pag)))
906d41a7 5185 (ps-output-boolean "UpsideDown " ps-print-upside-down)
bc0d41bd
KH
5186 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
5187
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)
5195
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)
5199
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)
319acba0
GM
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))
bc0d41bd 5207
319acba0 5208 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
8e234846
GM
5209 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
5210 ps-spool-duplex
5211 ps-switch-header))
319acba0
GM
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)
bc0d41bd
KH
5219
5220 (let ((line-height (ps-line-height 'ps-font-for-text)))
6bf5fb46
GM
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)
2bd80d73 5225 (format "/LinesPerColumn %d def\n"
6bf5fb46
GM
5226 (let ((height (+ line-height
5227 ps-line-spacing-internal)))
5228 (round (/ (+ ps-print-height
5229 (* height 0.45))
5230 height))))))
bc0d41bd 5231
8e234846 5232 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
bc0d41bd
KH
5233 (ps-output-boolean "Zebra " ps-zebra-stripes)
5234 (ps-output-boolean "PrintLineNumber " ps-line-number)
906d41a7 5235 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
2bd80d73
GM
5236 (ps-output (format "/ZebraFollow %d def\n"
5237 (or (cdr (assq ps-zebra-stripe-follow
5238 ps-zebra-stripe-alist))
5239 0))
5240 (format "/PrintLineStep %d def\n"
906d41a7
GM
5241 (if (integerp ps-line-number-step)
5242 ps-line-number-step
98f2fbe7
GM
5243 ps-zebra-stripe-height))
5244 (format "/PrintLineStart %d def\n" ps-line-number-start)
319acba0
GM
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)
6e1b1da6
GM
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 "
bc0d41bd 5254 (if (eq ps-spool-config 'setpagedevice)
6e1b1da6
GM
5255 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5256 "false")
5257 " def\n\n/PageWidth "
bc0d41bd
KH
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))
6e1b1da6
GM
5265 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
5266 "/N-Up-Repeat "
bc0d41bd
KH
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")
5280
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))
5285
41481e4b 5286 (ps-output "\n" ps-print-prologue-1)
bc0d41bd 5287
c3d6d211 5288 (ps-output "\n/printGlobalBackground{\n")
7bb054a5 5289 (mapcar 'ps-output ps-background-all-pages)
c3d6d211 5290 (ps-output "}def\n/printLocalBackground{\n}def\n")
bc0d41bd 5291
ef1159c2
EZ
5292 ;; Header/line number fonts
5293 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
bc0d41bd
KH
5294 ps-header-title-font-size-internal
5295 (ps-font 'ps-font-for-header 'bold))
ef1159c2 5296 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
bc0d41bd 5297 ps-header-font-size-internal
ef1159c2
EZ
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)
319acba0
GM
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...
6bf5fb46
GM
5306
5307/h0 F
5308/HeaderTitleLineHeight FontHeight def
5309
5310/h1 F
5311/HeaderLineHeight FontHeight def
5312/HeaderDescent Descent def
5313
319acba0
GM
5314/H0 F
5315/FooterLineHeight FontHeight def
5316/FooterDescent Descent def
5317
6bf5fb46 5318% ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
bc0d41bd
KH
5319
5320 ;; Text fonts
5321 (let ((font (ps-font-alist 'ps-font-for-text))
5322 (i 0))
5323 (while font
c3d6d211 5324 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
bc0d41bd
KH
5325 i
5326 ps-font-size-internal
5327 (ps-font 'ps-font-for-text (car (car font)))))
5328 (setq font (cdr font)
5329 i (1+ i))))
5330
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)))))
5334
6bf5fb46 5335 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
bc0d41bd
KH
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)
c3d6d211
GM
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")))
8e234846
GM
5350 (ps-output "\n%%BeginFeature: *ManualFeed "
5351 (ps-boolean-capitalized ps-manual-feed)
5352 "\nBMark /ManualFeed "
5353 (ps-boolean-constant ps-manual-feed)
ef1159c2 5354 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
47d2ac75 5355 (and ps-banner-page-when-duplexing
98f2fbe7 5356 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
bc0d41bd
KH
5357
5358
6e1b1da6
GM
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
efa89c1f
GM
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
6e1b1da6
GM
5369 "] ")
5370 (ps-float-format (if (numberp the-color) the-color default)))))
5371
5372
66e63857
GM
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))))
5379
5380
bc0d41bd
KH
5381(defun ps-boolean-capitalized (bool)
5382 (if bool "True" "False"))
5383
ef2cbb24 5384
8e234846
GM
5385(defun ps-boolean-constant (bool)
5386 (if bool "true" "false"))
5387
5388
12d89a2e
RS
5389(defun ps-header-dirpart ()
5390 (let ((fname (buffer-file-name)))
5391 (if fname
5392 (if (string-equal (buffer-name) (file-name-nondirectory fname))
68e684a0 5393 (abbreviate-file-name (file-name-directory fname))
12d89a2e
RS
5394 fname)
5395 "")))
ef2cbb24 5396
bc0d41bd 5397
12d89a2e 5398(defun ps-get-buffer-name ()
bcc0d457
RS
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!")
87a16a06 5406 (t (concat
bc0d41bd 5407 (and ps-printing-region-p "Subset of: ")
87a16a06
RS
5408 (buffer-name)
5409 (and (buffer-modified-p) " (unsaved)")))))
ef2cbb24 5410
7d8b7e8e 5411
6bf5fb46
GM
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)))
5421 (t
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))
5430
5431
7d8b7e8e 5432(defun ps-get-font-size (font-sym)
6bf5fb46 5433 (ps-get-size (symbol-value font-sym) "font size" font-sym))
7d8b7e8e
KH
5434
5435
319acba0
GM
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))
5441 ))
5442
5443
12d89a2e 5444(defun ps-begin-job ()
1fd9b7fe 5445 ;; prologue files
41481e4b 5446 (or (equal ps-mark-code-directory ps-postscript-code-directory)
c3d6d211
GM
5447 (setq ps-print-prologue-0 (ps-prologue-file 0)
5448 ps-print-prologue-1 (ps-prologue-file 1)
c3d6d211 5449 ps-mark-code-directory ps-postscript-code-directory))
1fd9b7fe
GM
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
906d41a7
GM
5469 (or (listp ps-use-face-background)
5470 (setq ps-use-face-background t))
1fd9b7fe 5471 ;; line number
906d41a7
GM
5472 (and (integerp ps-line-number-step)
5473 (<= ps-line-number-step 0)
5474 (setq ps-line-number-step 1))
98f2fbe7
GM
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))))
1fd9b7fe 5480 ;; spooling buffer
7da17ab6
RS
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))))
1fd9b7fe 5486 ;; miscellaneous
2bd80d73
GM
5487 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5488 '(full full-follow))
5489 ps-page-postscript 0
7bb054a5
GM
5490 ps-page-sheet 0
5491 ps-page-n-up 0
4b3eb10f 5492 ps-page-column 0
bd7a2e26 5493 ps-lines-printed 0
7bb054a5
GM
5494 ps-print-page-p t
5495 ps-showline-count (car ps-printing-region)
6bf5fb46
GM
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")
7d8b7e8e
KH
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)
319acba0 5504 ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
857686a6 5505 ps-control-or-escape-regexp
298bfad9
KH
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]")
6e1b1da6
GM
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")))
319acba0
GM
5522 1.0))
5523 ;; initialize page dimensions
5524 (ps-get-page-dimensions))
6e1b1da6 5525
ef2cbb24 5526
ea0c615d
GM
5527(defun ps-page-number ()
5528 (if ps-print-only-one-header
4b3eb10f
GM
5529 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5530 ps-page-column))
87a16a06
RS
5531
5532
319acba0
GM
5533(defsubst ps-end-page ()
5534 (ps-output "EndPage\nEndDSCPage\n"))
5535
5536
5537(defsubst ps-next-page ()
ef2cbb24 5538 (ps-end-page)
12d89a2e
RS
5539 (ps-flush-output)
5540 (ps-begin-page))
5541
bc0d41bd
KH
5542
5543(defun ps-header-sheet ()
5544 ;; Print only when a new sheet begins.
4b3eb10f 5545 (and ps-print-page-p (> ps-page-sheet 0)
ea0c615d 5546 (ps-output "EndSheet\n"))
4b3eb10f
GM
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))
ef1159c2
EZ
5555 ;; spooling needs to redefine Lines and PageCount on each page
5556 "/Lines 0 def\n/PageCount 0 def\n"
4b3eb10f
GM
5557 (format "%d BeginSheet\nBeginDSCPage\n"
5558 ps-n-up-printing))))
ea0c615d
GM
5559
5560
5561(defun ps-header-page ()
7da17ab6
RS
5562 ;; set total line and page number when printing has finished
5563 ;; (see `ps-generate')
4b3eb10f 5564 (if (zerop (mod ps-page-column ps-number-of-columns))
ea0c615d
GM
5565 (progn
5566 (setq ps-page-postscript (1+ ps-page-postscript))
5567 (when (ps-print-page-p)
4b3eb10f 5568 (ps-print-sheet-p)
ea0c615d
GM
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)
4b3eb10f
GM
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)))))
ea0c615d
GM
5581 ;; Print only when a new column begins.
5582 (ps-output "BeginDSCPage\n")
5583 (run-hooks 'ps-print-begin-column-hook))
4b3eb10f 5584 (setq ps-page-column (1+ ps-page-column)))
a18ed129 5585
8bd22fcf 5586(defun ps-begin-page ()
8bd22fcf 5587 (setq ps-width-remaining ps-print-width
298bfad9 5588 ps-height-remaining ps-print-height)
12d89a2e 5589
a18ed129 5590 (ps-header-page)
12d89a2e 5591
87a16a06 5592 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
ea0c615d 5593 (format "/PageNumber %d def\n" (ps-page-number)))
12d89a2e 5594
090be653 5595 (when ps-print-header
319acba0
GM
5596 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
5597 (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
090be653 5598 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
12d89a2e 5599
319acba0
GM
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)))
5604
bd7a2e26 5605 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
87a16a06
RS
5606 (ps-set-font ps-current-font)
5607 (ps-set-bg ps-current-bg)
298bfad9
KH
5608 (ps-set-color ps-current-color)
5609 (ps-mule-begin-page))
ef2cbb24 5610
319acba0 5611(defsubst ps-skip-newline (limit)
bd7a2e26
GM
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)))
5616
6bf5fb46 5617(defsubst ps-next-line ()
bd7a2e26
GM
5618 (setq ps-showline-count (1+ ps-showline-count)
5619 ps-lines-printed (1+ ps-lines-printed))
6bf5fb46
GM
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))))
12b88fff
RS
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))
6bf5fb46 5630 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
ef2cbb24
RS
5631
5632(defun ps-continue-line ()
bd7a2e26 5633 (setq ps-lines-printed (1+ ps-lines-printed))
6bf5fb46 5634 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
12b88fff
RS
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"))))
12d89a2e
RS
5640
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))))
5647
c86f4619
GM
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))
5657
12d89a2e 5658(defun ps-basic-plot-string (from to &optional bg-color)
12b88fff
RS
5659 (let* ((wrappoint (ps-find-wrappoint from to
5660 (ps-avg-char-width 'ps-font-for-text)))
12d89a2e 5661 (to (car wrappoint))
298bfad9
KH
5662 (string (buffer-substring-no-properties from to)))
5663 (ps-mule-prepare-ascii-font string)
12d89a2e 5664 (ps-output-string string)
bcc0d457 5665 (ps-output " S\n")
12d89a2e
RS
5666 wrappoint))
5667
5668(defun ps-basic-plot-whitespace (from to &optional bg-color)
12b88fff
RS
5669 (let* ((wrappoint (ps-find-wrappoint from to
5670 (ps-space-width 'ps-font-for-text)))
12d89a2e 5671 (to (car wrappoint)))
12d89a2e
RS
5672 (ps-output (format "%d W\n" (- to from)))
5673 wrappoint))
5674
5675(defun ps-plot (plotfunc from to &optional bg-color)
ef2cbb24 5676 (while (< from to)
12d89a2e
RS
5677 (let* ((wrappoint (funcall plotfunc from to bg-color))
5678 (plotted-to (car wrappoint))
5679 (plotted-width (cdr wrappoint)))
8bd22fcf
KH
5680 (setq from plotted-to
5681 ps-width-remaining (- ps-width-remaining plotted-width))
12d89a2e
RS
5682 (if (< from to)
5683 (ps-continue-line))))
ef2cbb24
RS
5684 (if ps-razzle-dazzle
5685 (let* ((q-todo (- (point-max) (point-min)))
12d89a2e 5686 (q-done (- (point) (point-min)))
ef2cbb24 5687 (chunkfrac (/ q-todo 8))
857686a6 5688 (chunksize (min chunkfrac 1000)))
ef2cbb24 5689 (if (> (- q-done ps-razchunk) chunksize)
8bd22fcf 5690 (progn
ef2cbb24 5691 (setq ps-razchunk q-done)
8bd22fcf
KH
5692 (message "Formatting...%3d%%"
5693 (if (< q-todo 100)
5694 (/ (* 100 q-done) q-todo)
5695 (/ q-done (/ q-todo 100)))
5696 ))))))
12d89a2e 5697
298bfad9
KH
5698(defvar ps-last-font nil)
5699
12d89a2e 5700(defun ps-set-font (font)
e65df0a1
KH
5701 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
5702 (ps-output (format "/%s F\n" ps-last-font)))
12d89a2e 5703
12d89a2e
RS
5704(defun ps-set-bg (color)
5705 (if (setq ps-current-bg color)
8bd22fcf
KH
5706 (ps-output (format ps-color-format
5707 (nth 0 color) (nth 1 color) (nth 2 color))
12d89a2e
RS
5708 " true BG\n")
5709 (ps-output "false BG\n")))
5710
5711(defun ps-set-color (color)
6e1b1da6 5712 (setq ps-current-color (or color ps-default-foreground))
8bd22fcf
KH
5713 (ps-output (format ps-color-format
5714 (nth 0 ps-current-color)
043620f4
KH
5715 (nth 1 ps-current-color) (nth 2 ps-current-color))
5716 " FG\n"))
12d89a2e 5717
12d89a2e 5718
c86f4619
GM
5719(defsubst ps-plot-string (string)
5720 (ps-plot 'ps-basic-plot-str 0 (length string) string))
5721
5722
87a16a06 5723(defvar ps-current-effect 0)
12d89a2e 5724
87a16a06
RS
5725
5726(defun ps-plot-region (from to font &optional fg-color bg-color effects)
efa89c1f 5727 (or (equal font ps-current-font)
12d89a2e 5728 (ps-set-font font))
06fb6aab 5729
12d89a2e
RS
5730 ;; Specify a foreground color only if one's specified and it's
5731 ;; different than the current.
efa89c1f
GM
5732 (let ((fg (or fg-color ps-default-foreground)))
5733 (or (equal fg ps-current-color)
5734 (ps-set-color fg)))
06fb6aab 5735
efa89c1f 5736 (or (equal bg-color ps-current-bg)
12d89a2e 5737 (ps-set-bg bg-color))
06fb6aab 5738
87a16a06
RS
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)))
ef2cbb24 5747
12d89a2e 5748 ;; Starting at the beginning of the specified region...
ef2cbb24
RS
5749 (save-excursion
5750 (goto-char from)
12d89a2e
RS
5751
5752 ;; ...break the region up into chunks separated by tabs, linefeeds,
87a16a06 5753 ;; pagefeeds, control characters, and plot each chunk.
ef2cbb24 5754 (while (< from to)
6bf5fb46
GM
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))))
857686a6 5764 (if (re-search-forward ps-control-or-escape-regexp to t)
024ced4d 5765 ;; region with some control characters or some multi-byte characters
12b88fff 5766 (let* ((match-point (match-beginning 0))
ea0c615d 5767 (match (char-after match-point))
3e9cb08f 5768 (composition (ps-e-find-composition from (1+ match-point))))
9d4d60c1
KH
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)))
e65df0a1 5777 (when (< from match-point)
298bfad9 5778 (ps-mule-set-ascii-font)
e65df0a1 5779 (ps-plot 'ps-basic-plot-string from match-point bg-color))
857686a6
RS
5780 (cond
5781 ((= match ?\t) ; tab
be415ea7 5782 (let ((linestart (line-beginning-position)))
857686a6
RS
5783 (forward-char -1)
5784 (setq from (+ linestart (current-column)))
e65df0a1 5785 (when (re-search-forward "[ \t]+" to t)
298bfad9 5786 (ps-mule-set-ascii-font)
e65df0a1
KH
5787 (ps-plot 'ps-basic-plot-whitespace
5788 from (+ linestart (current-column))
5789 bg-color))))
857686a6
RS
5790
5791 ((= match ?\n) ; newline
bd7a2e26
GM
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)))
857686a6
RS
5800
5801 ((= match ?\f) ; form feed
12b88fff
RS
5802 ;; do not skip page if previous character is NEWLINE and
5803 ;; it is a beginning of page.
bd7a2e26
GM
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)))
e65df0a1 5810
9d4d60c1
KH
5811 (composition ; a composite sequence
5812 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
5813
024ced4d 5814 ((> match 255) ; a multi-byte character
9d4d60c1 5815 (let* ((charset (char-charset match))
3e9cb08f 5816 (composition (ps-e-find-composition match-point to))
9d4d60c1 5817 (stop (if (nth 2 composition) (car composition) to)))
e65df0a1 5818 (or (eq charset 'composition)
9d4d60c1 5819 (while (and (< (point) stop) (eq (charset-after) charset))
298bfad9 5820 (forward-char 1)))
e65df0a1 5821 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
3556c6dd 5822 ; characters from ^@ to ^_ and
857686a6
RS
5823 (t ; characters from 127 to 255
5824 (ps-control-character match)))
87a16a06 5825 (setq from (point)))
024ced4d 5826 ;; region without control characters nor multi-byte characters
298bfad9 5827 (ps-mule-set-ascii-font)
87a16a06
RS
5828 (ps-plot 'ps-basic-plot-string from to bg-color)
5829 (setq from to)))))
5830
857686a6
RS
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.")
5849
5850(defun ps-control-character (char)
5851 (let* ((str (aref ps-string-control-codes char))
5852 (from (1- (point)))
87a16a06
RS
5853 (len (length str))
5854 (to (+ from len))
12b88fff
RS
5855 (char-width (ps-avg-char-width 'ps-font-for-text))
5856 (wrappoint (ps-find-wrappoint from to char-width)))
87a16a06
RS
5857 (if (< (car wrappoint) to)
5858 (ps-continue-line))
12b88fff 5859 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
36243805 5860 (ps-mule-prepare-ascii-font str)
87a16a06
RS
5861 (ps-output-string str)
5862 (ps-output " S\n")))
ef2cbb24 5863
87a16a06 5864
a18ed129
RS
5865(defun ps-face-attributes (face)
5866 "Return face attribute vector.
87a16a06 5867
a18ed129
RS
5868If FACE is not in `ps-print-face-extension-alist' or in
5869`ps-print-face-alist', insert it on `ps-print-face-alist' and
5870return the attribute vector.
87a16a06
RS
5871
5872If FACE is not a valid face name, it is used default face."
df5e6194
GM
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)))
5888 (t
5889 (vector 0 nil nil))))
87a16a06 5890
043620f4 5891
906d41a7
GM
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)
df5e6194
GM
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)))
906d41a7
GM
5907 (t
5908 nil)
5909 ))
5910 background))
5911
5912
043620f4 5913(defun ps-face-attribute-list (face-or-list)
df5e6194
GM
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
5925 (t
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)))))
043620f4 5937
87a16a06 5938
12b88fff
RS
5939(defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
5940
5941
12d89a2e 5942(defun ps-plot-with-face (from to face)
12b88fff
RS
5943 (cond
5944 ((null face) ; print text with null face
87a16a06 5945 (ps-plot-region from to 0))
12b88fff
RS
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))
906d41a7 5951 (background (ps-face-background face (aref face-bit 2)))
d3ab8dac 5952 (fg-color (if (and ps-color-p foreground)
6e1b1da6 5953 (ps-color-scale foreground)
12b88fff 5954 ps-default-color))
d3ab8dac 5955 (bg-color (and ps-color-p background
6e1b1da6 5956 (ps-color-scale background))))
12b88fff
RS
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)))))
87a16a06 5963 (goto-char to))
12d89a2e
RS
5964
5965
043620f4
KH
5966;; Ensure that face-list is fbound.
5967(or (fboundp 'face-list) (defalias 'face-list 'list-faces))
12d89a2e 5968
a18ed129 5969
12d89a2e 5970(defun ps-build-reference-face-lists ()
857686a6
RS
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
a18ed129 5975 (setq ps-print-face-alist nil)
12d89a2e 5976 (if ps-auto-font-detect
a18ed129
RS
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))
12d89a2e 5981 (setq ps-build-face-reference nil))
ef2cbb24 5982
a18ed129
RS
5983
5984(defun ps-set-face-bold (face)
5985 (ps-set-face-attribute face 1))
5986
5987(defun ps-set-face-italic (face)
5988 (ps-set-face-attribute face 2))
5989
5990(defun ps-set-face-underline (face)
5991 (ps-set-face-attribute face 4))
5992
5993
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))))
5997
5998
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))
6011
6012
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
8e234846
GM
6018 (ps-face-foreground-name face)
6019 (ps-face-background-name face))))
a18ed129
RS
6020
6021
3e9cb08f 6022;; to avoid compilation gripes
ea0c615d
GM
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))))
043620f4 6031
043620f4 6032
ef2cbb24 6033(defun ps-generate-postscript-with-faces (from to)
87a16a06 6034 ;; Some initialization...
857686a6 6035 (setq ps-current-effect 0)
87a16a06 6036
00aa16af 6037 ;; Build the reference lists of faces if necessary.
8e234846
GM
6038 (when (or ps-always-build-face-reference
6039 ps-build-face-reference)
6040 (message "Collecting face information...")
6041 (ps-build-reference-face-lists))
00aa16af 6042 ;; Generate some PostScript.
ef2cbb24
RS
6043 (save-restriction
6044 (narrow-to-region from to)
d3ab8dac 6045 (ps-print-ensure-fontified from to)
12d89a2e
RS
6046 (let ((face 'default)
6047 (position to))
87a16a06 6048 (cond
8e234846 6049 ((memq ps-print-emacs-type '(xemacs lucid))
87a16a06
RS
6050 ;; Build the list of extents...
6051 (let ((a (cons 'dummy nil))
6052 record type extent extent-list)
3e9cb08f 6053 (ps-x-map-extents 'ps-mapper nil from to a)
8bd22fcf
KH
6054 (setq a (sort (cdr a) 'car-less-than-car)
6055 extent-list nil)
87a16a06
RS
6056
6057 ;; Loop through the extents...
6058 (while a
8bd22fcf 6059 (setq record (car a)
8bd22fcf 6060 position (car record)
87a16a06 6061
8bd22fcf 6062 record (cdr record)
bd7a2e26 6063 type (car record)
87a16a06 6064
bd7a2e26 6065 record (cdr record)
8bd22fcf 6066 extent (car record))
87a16a06
RS
6067
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
ea0c615d
GM
6072 ;; the buffer, this'll generate errors. This is a hack,
6073 ;; but don't call ps-plot-with-face unless from > point-min.
3e9cb08f
GM
6074 (and (>= from (point-min))
6075 (ps-plot-with-face from (min position (point-max)) face))
87a16a06
RS
6076
6077 (cond
6078 ((eq type 'push)
3e9cb08f 6079 (and (ps-x-extent-face extent)
d3ab8dac
KH
6080 (setq extent-list (sort (cons extent extent-list)
6081 'ps-extent-sorter))))
87a16a06
RS
6082
6083 ((eq type 'pull)
6084 (setq extent-list (sort (delq extent extent-list)
6085 'ps-extent-sorter))))
6086
d3ab8dac 6087 (setq face (if extent-list
3e9cb08f 6088 (ps-x-extent-face (car extent-list))
d3ab8dac 6089 'default)
8bd22fcf
KH
6090 from position
6091 a (cdr a)))))
87a16a06
RS
6092
6093 ((eq ps-print-emacs-type 'emacs)
6094 (let ((property-change from)
e65df0a1
KH
6095 (overlay-change from)
6096 (save-buffer-invisibility-spec buffer-invisibility-spec)
c86f4619
GM
6097 (buffer-invisibility-spec nil)
6098 before-string after-string)
87a16a06 6099 (while (< from to)
d3ab8dac 6100 (and (< property-change to) ; Don't search for property change
12d89a2e 6101 ; unless previous search succeeded.
d3ab8dac
KH
6102 (setq property-change (next-property-change from nil to)))
6103 (and (< overlay-change to) ; Don't search for overlay change
12d89a2e 6104 ; unless previous search succeeded.
2bd80d73
GM
6105 (setq overlay-change (min (ps-e-next-overlay-change from)
6106 to)))
c86f4619
GM
6107 (setq position (min property-change overlay-change)
6108 before-string nil
6109 after-string nil)
87a16a06
RS
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.
e65df0a1 6119 (if (eq save-buffer-invisibility-spec t)
87a16a06 6120 (not (null prop))
e65df0a1
KH
6121 (or (memq prop save-buffer-invisibility-spec)
6122 (assq prop save-buffer-invisibility-spec))))
12b88fff 6123 'emacs--invisible--face)
87a16a06
RS
6124 ((get-text-property from 'face))
6125 (t 'default)))
2bd80d73 6126 (let ((overlays (ps-e-overlays-at from))
87a16a06 6127 (face-priority -1)) ; text-property
d3ab8dac
KH
6128 (while (and overlays
6129 (not (eq face 'emacs--invisible--face)))
87a16a06 6130 (let* ((overlay (car overlays))
c86f4619
GM
6131 (overlay-invisible
6132 (ps-e-overlay-get overlay 'invisible))
6133 (overlay-priority
6134 (or (ps-e-overlay-get overlay 'priority) 0)))
d3ab8dac 6135 (and (> overlay-priority face-priority)
c86f4619
GM
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 ))))
87a16a06
RS
6156 (setq overlays (cdr overlays))))
6157 ;; Plot up to this record.
c86f4619
GM
6158 (and before-string
6159 (ps-plot-string before-string))
87a16a06 6160 (ps-plot-with-face from position face)
c86f4619
GM
6161 (and after-string
6162 (ps-plot-string after-string))
87a16a06
RS
6163 (setq from position)))))
6164 (ps-plot-with-face from to face))))
ef2cbb24
RS
6165
6166(defun ps-generate-postscript (from to)
12d89a2e 6167 (ps-plot-region from to 0 nil))
ef2cbb24
RS
6168
6169(defun ps-generate (buffer from to genfunc)
87a16a06
RS
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)
857686a6
RS
6178 (and ps-razzle-dazzle
6179 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
8bd22fcf
KH
6180 (setq ps-source-buffer buffer
6181 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
87a16a06
RS
6182 (ps-init-output-queue)
6183 (let (safe-marker completed-safely needs-begin-file)
6184 (unwind-protect
00aa16af
RS
6185 (progn
6186 (set-buffer ps-spool-buffer)
7da17ab6 6187 (set-buffer-multibyte nil)
915293a2 6188
87a16a06
RS
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))
6194
6195 (goto-char (point-min))
8bd22fcf
KH
6196 (or (looking-at (regexp-quote ps-adobe-tag))
6197 (setq needs-begin-file t))
ea0c615d
GM
6198
6199 (set-buffer ps-source-buffer)
87a16a06 6200 (save-excursion
ea0c615d
GM
6201 (let ((ps-print-page-p t)
6202 ps-even-or-odd-pages)
70f57a72
GM
6203 (ps-begin-job)
6204 (when needs-begin-file
6205 (ps-begin-file)
6206 (ps-mule-initialize))
6207 (ps-mule-begin-job from to)
ea0c615d
GM
6208 (ps-selected-pages)))
6209 (ps-begin-page)
87a16a06
RS
6210 (funcall genfunc from to)
6211 (ps-end-page)
ea0c615d 6212 (ps-end-job needs-begin-file)
87a16a06
RS
6213
6214 ;; Setting this variable tells the unwind form that the
8bd22fcf 6215 ;; the PostScript was generated without error.
87a16a06
RS
6216 (setq completed-safely t))
6217
6218 ;; Unwind form: If some bad mojo occurred while generating
8bd22fcf 6219 ;; PostScript, delete all the PostScript that was generated.
87a16a06
RS
6220 ;; This protects the previously spooled files from getting
6221 ;; corrupted.
8bd22fcf
KH
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))))))
87a16a06 6226
857686a6 6227 (and ps-razzle-dazzle (message "Formatting...done"))))))
ef2cbb24 6228
e65df0a1 6229
ea0c615d 6230(defun ps-end-job (needs-begin-file)
4b3eb10f
GM
6231 (let ((previous-print ps-print-page-p)
6232 (ps-print-page-p t))
ea0c615d
GM
6233 (ps-flush-output)
6234 (save-excursion
4b3eb10f 6235 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
ea0c615d 6236 (total-lines (cdr ps-printing-region))
ef1159c2 6237 (total-pages (ps-page-number)))
ea0c615d 6238 (set-buffer ps-spool-buffer)
ef1159c2
EZ
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)))))
ea0c615d
GM
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"
bd7a2e26
GM
6255 "/PrintLineNumber false def\n"
6256 (number-to-string ps-lines-printed) " BeginPage\n")
ea0c615d
GM
6257 (ps-end-page)))
6258 ;; Set end of PostScript file
4b3eb10f
GM
6259 (and previous-print
6260 (ps-output "EndSheet\n"))
6261 (ps-output "\n%%Trailer\n%%Pages: "
ea0c615d
GM
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")
ef1159c2
EZ
6268 (and ps-end-with-control-d
6269 (ps-output "\C-d"))
ea0c615d
GM
6270 (ps-flush-output))
6271 ;; disable selected pages
1fd9b7fe 6272 (setq ps-selected-pages nil))
7d8b7e8e
KH
6273
6274
857686a6 6275;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
ef2cbb24 6276(defun ps-do-despool (filename)
12d89a2e 6277 (if (or (not (boundp 'ps-spool-buffer))
bcc0d457 6278 (not (symbol-value 'ps-spool-buffer)))
12d89a2e 6279 (message "No spooled PostScript to print")
ef2cbb24
RS
6280 (if filename
6281 (save-excursion
857686a6 6282 (and ps-razzle-dazzle (message "Saving..."))
12d89a2e 6283 (set-buffer ps-spool-buffer)
ef2cbb24 6284 (setq filename (expand-file-name filename))
7ffaf659
EZ
6285 (let ((coding-system-for-write 'raw-text-unix))
6286 (write-region (point-min) (point-max) filename))
857686a6 6287 (and ps-razzle-dazzle (message "Wrote %s" filename)))
ef2cbb24 6288 ;; Else, spool to the printer
857686a6 6289 (and ps-razzle-dazzle (message "Printing..."))
ef2cbb24 6290 (save-excursion
12d89a2e 6291 (set-buffer ps-spool-buffer)
200127fd 6292 (let* ((coding-system-for-write 'raw-text-unix)
298bfad9
KH
6293 (ps-printer-name (or ps-printer-name
6294 (and (boundp 'printer-name)
2bd80d73 6295 (symbol-value 'printer-name))))
200127fd 6296 (ps-lpr-switches
3556c6dd
GM
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))))))
52cf535f
AI
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)
6307 nil
6308 (ps-flatten-list ; dynamic evaluation
6309 (mapcar 'ps-eval-switch ps-lpr-switches)))))
857686a6 6310 (and ps-razzle-dazzle (message "Printing...done")))
12d89a2e
RS
6311 (kill-buffer ps-spool-buffer)))
6312
857686a6
RS
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)))
6320
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.
6324
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)
6327
6328(defun ps-flatten-list (&rest list)
6329 (ps-flatten-list-1 list))
6330
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))))
6336
12d89a2e
RS
6337(defun ps-kill-emacs-check ()
6338 (let (ps-buffer)
8bd22fcf
KH
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"))))
12d89a2e 6347
d3ab8dac
KH
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'"))
6352 (t
6353 (setq kill-emacs-hook 'ps-kill-emacs-check)))
ef2cbb24 6354
298bfad9
KH
6355\f
6356;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12d89a2e 6357;;; Sample Setup Code:
ef2cbb24 6358
0a5daee5 6359
12d89a2e 6360;; This stuff is for anybody that's brave enough to look this far,
87a16a06
RS
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:
ef2cbb24 6363
298bfad9
KH
6364;; WARNING!!! The following code is *sample* code only.
6365;; Don't use it unless you understand what it does!
043620f4 6366
87a16a06
RS
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)))
00aa16af 6373
a18ed129
RS
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)))
6383
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"))
6389
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)))))
6400
12d89a2e 6401;; Look in an article or mail message for the Subject: line. To be
87a16a06 6402;; placed in `ps-left-headers'.
12d89a2e 6403(defun ps-article-subject ()
ef2cbb24 6404 (save-excursion
12d89a2e 6405 (goto-char (point-min))
45a870d9 6406 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
edc9cd35 6407 (buffer-substring (match-beginning 1) (match-end 1))
12d89a2e
RS
6408 "Subject ???")))
6409
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
87a16a06 6412;; it's provided. To be placed in `ps-left-headers'.
12d89a2e
RS
6413(defun ps-article-author ()
6414 (save-excursion
6415 (goto-char (point-min))
a97592dd 6416 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
edc9cd35 6417 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
12d89a2e
RS
6418 (cond
6419
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)))
6424
6425 ;; Next try to match addresses that look like
edc9cd35
GM
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)))
12d89a2e
RS
6430
6431 ;; Couldn't find a real name -- show the address instead.
6432 (t fromstring)))
6433 "From ???")))
6434
a18ed129 6435;; A hook to bind to `gnus-article-prepare-hook'. This will set the
87a16a06
RS
6436;; `ps-left-headers' specially for gnus articles. Unfortunately,
6437;; `gnus-article-mode-hook' is called only once, the first time the *Article*
12d89a2e
RS
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
87a16a06 6440;; only alternative is `gnus-article-prepare-hook'.
12d89a2e 6441(defun ps-gnus-article-prepare-hook ()
8bd22fcf
KH
6442 (setq ps-header-lines 3
6443 ps-left-header
12d89a2e
RS
6444 ;; The left headers will display the article's subject, its
6445 ;; author, and the newsgroup it was in.
8bd22fcf 6446 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
12d89a2e 6447
a18ed129
RS
6448;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
6449;; `ps-left-headers' specially for mail messages.
12d89a2e 6450(defun ps-vm-mode-hook ()
00aa16af 6451 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
8bd22fcf
KH
6452 (setq ps-header-lines 3
6453 ps-left-header
12d89a2e
RS
6454 ;; The left headers will display the message's subject, its
6455 ;; author, and the name of the folder it was in.
8bd22fcf 6456 '(ps-article-subject ps-article-author buffer-name)))
12d89a2e
RS
6457
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.
87a16a06 6463;; sb: Updated for Gnus 5.
12d89a2e
RS
6464(defun ps-gnus-print-article-from-summary ()
6465 (interactive)
a18ed129 6466 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
ef2cbb24 6467
87a16a06 6468;; See `ps-gnus-print-article-from-summary'. This function does the
12d89a2e
RS
6469;; same thing for vm.
6470(defun ps-vm-print-message-from-summary ()
6471 (interactive)
a18ed129 6472 (ps-print-message-from-summary 'vm-mail-buffer ""))
ef2cbb24 6473
87a16a06 6474;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
12d89a2e
RS
6475;; prsc.
6476(defun ps-gnus-summary-setup ()
00aa16af 6477 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
12d89a2e
RS
6478
6479;; Look in an article or mail message for the Subject: line. To be
87a16a06 6480;; placed in `ps-left-headers'.
12d89a2e
RS
6481(defun ps-info-file ()
6482 (save-excursion
6483 (goto-char (point-min))
a97592dd 6484 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
edc9cd35 6485 (buffer-substring (match-beginning 1) (match-end 1))
12d89a2e
RS
6486 "File ???")))
6487
6488;; Look in an article or mail message for the Subject: line. To be
87a16a06 6489;; placed in `ps-left-headers'.
12d89a2e
RS
6490(defun ps-info-node ()
6491 (save-excursion
6492 (goto-char (point-min))
a97592dd 6493 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
edc9cd35 6494 (buffer-substring (match-beginning 1) (match-end 1))
12d89a2e
RS
6495 "Node ???")))
6496
6497(defun ps-info-mode-hook ()
6498 (setq ps-left-header
6499 ;; The left headers will display the node name and file name.
8bd22fcf 6500 '(ps-info-node ps-info-file)))
12d89a2e 6501
043620f4
KH
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
87a16a06
RS
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
043620f4
KH
6506;; modification.)
6507
12d89a2e 6508(defun ps-jts-ps-setup ()
00aa16af
RS
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)
12d89a2e
RS
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)
00aa16af 6515 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
12d89a2e 6516 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
8bd22fcf
KH
6517 (setq ps-spool-duplex t
6518 ps-print-color-p nil
6519 ps-lpr-command "lpr"
6520 ps-lpr-switches '("-Jjct,duplex_long"))
bcc0d457
RS
6521 'ps-jts-ps-setup)
6522
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.)
6528
6529(defun ps-jack-setup ()
87a16a06 6530 (setq ps-print-color-p nil
bcc0d457 6531 ps-lpr-command "lpr"
8bd22fcf 6532 ps-lpr-switches nil
bcc0d457 6533
87a16a06
RS
6534 ps-paper-type 'a4
6535 ps-landscape-mode t
bcc0d457
RS
6536 ps-number-of-columns 2
6537
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
6550
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)
12d89a2e 6557
298bfad9
KH
6558\f
6559;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6560;; To make this file smaller, some commands go in a separate file.
6561;; But autoload them here to make the separation invisible.
6562
6563(autoload 'ps-mule-prepare-ascii-font "ps-mule"
6564 "Setup special ASCII font for STRING.
6565STRING should contain only ASCII characters.")
6566
6567(autoload 'ps-mule-set-ascii-font "ps-mule"
6568 "Adjust current font if current charset is not ASCII.")
6569
6570(autoload 'ps-mule-plot-string "ps-mule"
6bf5fb46 6571 "Generate PostScript code for plotting characters in the region FROM and TO.
298bfad9
KH
6572
6573It is assumed that all characters in this region belong to the same charset.
6574
6575Optional argument BG-COLOR specifies background color.
6576
6577Returns the value:
6578
6579 (ENDPOS . RUN-WIDTH)
6580
6581Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
6582the sequence.")
6583
6584(autoload 'ps-mule-initialize "ps-mule"
6585 "Initialize global data for printing multi-byte characters.")
6586
6587(autoload 'ps-mule-begin-job "ps-mule"
6588 "Start printing job for multi-byte chars between FROM and TO.
6589This checks if all multi-byte characters in the region are printable or not.")
6590
6591(autoload 'ps-mule-begin-page "ps-mule"
6592 "Initialize multi-byte charset for printing current page.")
6593
6bf5fb46
GM
6594(autoload 'ps-mule-encode-header-string "ps-mule"
6595 "Generate PostScript code for plotting characters in header STRING.
6596
6597It is assumed that the length of STRING is not zero.")
6598
298bfad9
KH
6599\f
6600;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6601
12d89a2e 6602(provide 'ps-print)
b87c5d3d 6603
12d89a2e 6604;;; ps-print.el ends here