(dired-move-to-filename-regexp): Allow one digit in the
[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
27dc47aa
GM
13;; Time-stamp: <2001/08/07 13:22:04 vinicius>
14;; Version: 6.5.4
652a9be9 15;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
e65df0a1 16
27dc47aa
GM
17(defconst ps-print-version "6.5.4"
18 "ps-print.el, v 6.5.4 <2001/08/07 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."
66a863f0
GM
3214 (interactive
3215 (unless mark-active
3216 (error "The mark is not set now"))
3217 (list (point) (mark) (ps-print-preprint current-prefix-arg)))
a18ed129 3218 (ps-print-without-faces from to filename t))
ef2cbb24 3219
ef2cbb24 3220
00aa16af 3221;;;###autoload
ef2cbb24 3222(defun ps-print-region-with-faces (from to &optional filename)
12d89a2e 3223 "Generate and print a PostScript image of the region.
319acba0
GM
3224Like `ps-print-region', but includes font, color, and underline information in
3225the generated image. This command works only if you are using a window system,
3226so it has a way to determine color values."
66a863f0
GM
3227 (interactive
3228 (unless mark-active
3229 (error "The mark is not set now"))
3230 (list (point) (mark) (ps-print-preprint current-prefix-arg)))
a18ed129 3231 (ps-print-with-faces from to filename t))
ef2cbb24 3232
ef2cbb24 3233
00aa16af 3234;;;###autoload
ef2cbb24 3235(defun ps-spool-buffer ()
12d89a2e 3236 "Generate and spool a PostScript image of the buffer.
319acba0
GM
3237Like `ps-print-buffer' except that the PostScript image is saved in a local
3238buffer to be sent to the printer later.
ef2cbb24 3239
12d89a2e 3240Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3241 (interactive)
87a16a06 3242 (ps-spool-without-faces (point-min) (point-max)))
ef2cbb24 3243
ef2cbb24 3244
00aa16af 3245;;;###autoload
ef2cbb24 3246(defun ps-spool-buffer-with-faces ()
12d89a2e 3247 "Generate and spool a PostScript image of the buffer.
319acba0
GM
3248Like `ps-spool-buffer', but includes font, color, and underline information in
3249the generated image. This command works only if you are using a window system,
3250so it has a way to determine color values.
ef2cbb24 3251
12d89a2e 3252Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3253 (interactive)
87a16a06 3254 (ps-spool-with-faces (point-min) (point-max)))
ef2cbb24 3255
ef2cbb24 3256
00aa16af 3257;;;###autoload
ef2cbb24 3258(defun ps-spool-region (from to)
12d89a2e 3259 "Generate a PostScript image of the region and spool locally.
12d89a2e 3260Like `ps-spool-buffer', but spools just the current region.
ef2cbb24 3261
12d89a2e 3262Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3263 (interactive "r")
a18ed129 3264 (ps-spool-without-faces from to t))
ef2cbb24 3265
ef2cbb24 3266
00aa16af 3267;;;###autoload
ef2cbb24 3268(defun ps-spool-region-with-faces (from to)
12d89a2e 3269 "Generate a PostScript image of the region and spool locally.
319acba0
GM
3270Like `ps-spool-region', but includes font, color, and underline information in
3271the generated image. This command works only if you are using a window system,
3272so it has a way to determine color values.
ef2cbb24 3273
12d89a2e 3274Use the command `ps-despool' to send the spooled images to the printer."
ef2cbb24 3275 (interactive "r")
a18ed129 3276 (ps-spool-with-faces from to t))
ef2cbb24 3277
00aa16af 3278;;;###autoload
ef2cbb24
RS
3279(defun ps-despool (&optional filename)
3280 "Send the spooled PostScript to the printer.
3281
319acba0
GM
3282Interactively, when you use a prefix argument (C-u), the command prompts the
3283user for a file name, and saves the spooled PostScript image in that file
3284instead of sending it to the printer.
ef2cbb24 3285
319acba0
GM
3286Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3287send the image to the printer. If FILENAME is a string, save the PostScript
3288image in a file with that name."
00aa16af
RS
3289 (interactive (list (ps-print-preprint current-prefix-arg)))
3290 (ps-do-despool filename))
12d89a2e 3291
bcc0d457
RS
3292;;;###autoload
3293(defun ps-line-lengths ()
319acba0
GM
3294 "Display the correspondence between a line length and a font size, using the
3295current ps-print setup.
bcc0d457
RS
3296Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3297 (interactive)
3298 (ps-line-lengths-internal))
3299
3300;;;###autoload
3301(defun ps-nb-pages-buffer (nb-lines)
06fb6aab
RS
3302 "Display number of pages to print this buffer, for various font heights.
3303The table depends on the current ps-print setup."
bcc0d457
RS
3304 (interactive (list (count-lines (point-min) (point-max))))
3305 (ps-nb-pages nb-lines))
3306
3307;;;###autoload
3308(defun ps-nb-pages-region (nb-lines)
06fb6aab
RS
3309 "Display number of pages to print the region, for various font heights.
3310The table depends on the current ps-print setup."
66a863f0
GM
3311 (interactive
3312 (unless mark-active
3313 (error "The mark is not set now"))
3314 (list (count-lines (mark) (point))))
bcc0d457
RS
3315 (ps-nb-pages nb-lines))
3316
c86f4619
GM
3317(defvar ps-prefix-quote nil
3318 "Used for `ps-print-quote' (which see).")
efa89c1f 3319
bcc0d457
RS
3320;;;###autoload
3321(defun ps-setup ()
496725ad 3322 "Return the current PostScript-generation setup."
efa89c1f 3323 (let (ps-prefix-quote)
319acba0 3324 (mapconcat
efa89c1f 3325 #'ps-print-quote
319acba0
GM
3326 (list
3327 (concat "\n;;; ps-print version " ps-print-version "\n")
3328 '(25 . ps-print-color-p)
3329 '(25 . ps-lpr-command)
3330 '(25 . ps-lpr-switches)
3331 '(25 . ps-printer-name)
3332 '(25 . ps-printer-name-option)
3333 '(25 . ps-print-region-function)
3334 '(25 . ps-manual-feed)
3335 '(25 . ps-end-with-control-d)
3336 nil
3337 '(23 . ps-paper-type)
3338 '(23 . ps-warn-paper-type)
3339 '(23 . ps-landscape-mode)
3340 '(23 . ps-print-upside-down)
3341 '(23 . ps-number-of-columns)
3342 nil
3343 '(23 . ps-zebra-stripes)
3344 '(23 . ps-zebra-stripe-height)
3345 '(23 . ps-zebra-stripe-follow)
3346 '(23 . ps-zebra-color)
3347 '(23 . ps-line-number)
3348 '(23 . ps-line-number-step)
3349 '(23 . ps-line-number-start)
3350 nil
3351 '(17 . ps-default-fg)
3352 '(17 . ps-default-bg)
3353 '(17 . ps-razzle-dazzle)
3354 nil
3355 '(23 . ps-use-face-background)
3356 nil
3357 '(28 . ps-print-control-characters)
3358 nil
3359 '(26 . ps-print-background-image)
3360 nil
3361 '(25 . ps-print-background-text)
3362 nil
3363 '(29 . ps-error-handler-message)
3364 '(29 . ps-user-defined-prologue)
3365 '(29 . ps-print-prologue-header)
3366 '(29 . ps-postscript-code-directory)
3367 '(29 . ps-adobe-tag)
3368 nil
3369 '(30 . ps-left-margin)
3370 '(30 . ps-right-margin)
3371 '(30 . ps-inter-column)
3372 '(30 . ps-bottom-margin)
3373 '(30 . ps-top-margin)
3374 '(30 . ps-print-only-one-header)
3375 '(30 . ps-switch-header)
3376 '(30 . ps-print-header)
3377 '(30 . ps-header-lines)
3378 '(30 . ps-header-offset)
3379 '(30 . ps-header-line-pad)
3380 '(30 . ps-print-header-frame)
3381 '(30 . ps-header-frame-alist)
3382 '(30 . ps-print-footer)
3383 '(30 . ps-footer-lines)
3384 '(30 . ps-footer-offset)
3385 '(30 . ps-footer-line-pad)
3386 '(30 . ps-print-footer-frame)
3387 '(30 . ps-footer-frame-alist)
3388 '(30 . ps-show-n-of-n)
3389 '(30 . ps-spool-config)
3390 '(30 . ps-spool-duplex)
3391 '(30 . ps-spool-tumble)
3392 '(30 . ps-banner-page-when-duplexing)
3393 '(30 . ps-left-header)
3394 '(30 . ps-right-header)
3395 '(30 . ps-left-footer)
3396 '(30 . ps-right-footer)
3397 nil
3398 '(23 . ps-n-up-printing)
3399 '(23 . ps-n-up-margin)
3400 '(23 . ps-n-up-border-p)
3401 '(23 . ps-n-up-filling)
3402 nil
3403 '(26 . ps-multibyte-buffer)
3404 '(26 . ps-font-family)
3405 '(26 . ps-font-size)
3406 '(26 . ps-header-font-family)
3407 '(26 . ps-header-font-size)
3408 '(26 . ps-header-title-font-size)
3409 '(26 . ps-footer-font-family)
3410 '(26 . ps-footer-font-size)
3411 '(26 . ps-line-number-color)
3412 '(26 . ps-line-number-font)
3413 '(26 . ps-line-number-font-size)
3414 '(26 . ps-line-spacing)
3415 '(26 . ps-paragraph-spacing)
3416 '(26 . ps-paragraph-regexp)
3417 '(26 . ps-begin-cut-regexp)
3418 '(26 . ps-end-cut-regexp)
3419 nil
3420 '(23 . ps-even-or-odd-pages)
3421 '(23 . ps-selected-pages)
3422 '(23 . ps-last-selected-pages)
3423 nil
3424 '(31 . ps-build-face-reference)
3425 '(31 . ps-always-build-face-reference)
3426 nil
3427 '(20 . ps-auto-font-detect)
3428 '(20 . ps-bold-faces)
3429 '(20 . ps-italic-faces)
3430 '(20 . ps-underlined-faces)
c86f4619 3431 " )\n
bd7a2e26
GM
3432;; The following customized variables have long lists and are seldom modified:
3433;; ps-page-dimensions-database
3434;; ps-font-info-database
1fd9b7fe 3435
319acba0
GM
3436;;; ps-print - end of settings\n")
3437 "\n")))
bcc0d457 3438
0a5daee5 3439
12d89a2e
RS
3440;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3441;; Utility functions and variables:
3442
0a5daee5 3443
efa89c1f 3444(defun ps-print-quote (elt)
c86f4619
GM
3445 "Quote ELT for printing (used for showing settings).
3446
3447If ELT is nil, return an empty string.
3448If ELT is string, return it.
3449Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3450LEN is the field length where SYM name will be inserted. The variable
3451`ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
3452used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3453generated is:
3454
3455 * If `ps-prefix-quote' is nil:
3456 \"(setq SYM-NAME SYM-VALUE\"
3457 |<------->|
3458 LEN
3459
3460 * If `ps-prefix-quote' is non-nil:
3461 \" SYM-NAME SYM-VALUE\"
3462 |<------->|
3463 LEN
3464
3465If `ps-prefix-quote' is nil, it's set to t after generating string."
efa89c1f
GM
3466 (cond
3467 ((null elt) "")
3468 ((stringp elt) elt)
3469 (t
3470 (let* ((col (car elt))
3471 (sym (cdr elt))
3472 (key (symbol-name sym))
3473 (len (length key))
3474 (val (symbol-value sym)))
3475 (concat (if ps-prefix-quote
c86f4619
GM
3476 " "
3477 (setq ps-prefix-quote t)
efa89c1f
GM
3478 "(setq ")
3479 key
3480 (if (> col len)
3481 (make-string (- col len) ?\ )
3482 " ")
3483 (cond ((null val) "nil")
3484 ((eq val t) "t")
3485 ((or (symbolp val) (listp val)) (format "'%S" val))
3486 (t (format "%S" val))))))
3487 ))
3488
3489
319acba0
GM
3490(defun ps-value (alist-sym key)
3491 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3492 (cdr (assq key (symbol-value alist-sym))))
3493
3494
3495(defun ps-get (alist-sym key)
3496 "Return element from association list ALIST-SYM which car is `eq' to KEY."
3497 (assq key (symbol-value alist-sym)))
3498
3499
3500(defun ps-put (alist-sym key value)
3501 "Store element (KEY . VALUE) into association list ALIST-SYM.
3502If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3503It can be retrieved with `(ps-get ALIST-SYM KEY)'."
3504 (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
3505 (if elt:
3506 (setcdr elt: value)
3507 (setq elt: (cons key value))
3508 (set alist-sym (cons elt: (symbol-value alist-sym))))
3509 elt:))
3510
3511
3512(defun ps-del (alist-sym key)
3513 "Delete by side effect element KEY from association list ALIST-SYM."
3514 (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
3515 old)
3516 (while a:list:
3517 (if (eq key (car (car a:list:)))
3518 (progn
3519 (if old
3520 (setcdr old (cdr a:list:))
3521 (set alist-sym (cdr a:list:)))
3522 (setq a:list: nil))
3523 (setq old a:list:
3524 a:list: (cdr a:list:)))))
3525 (symbol-value alist-sym))
3526
3527
4b81a999
GM
3528(defun ps-time-stamp-locale-default ()
3529 "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
3530 (format-time-string "%x"))
3531
3532
2bd80d73 3533(defun ps-time-stamp-mon-dd-yyyy ()
4b81a999 3534 "Return date as \"Jun 18 2001\"."
2bd80d73
GM
3535 (format-time-string "%b %d %Y"))
3536
3537
3538(defun ps-time-stamp-hh:mm:ss ()
4b81a999 3539 "Return time as \"17:28:31\"."
2bd80d73
GM
3540 (format-time-string "%T"))
3541
3542
877cf6b4
GM
3543(eval-and-compile
3544 (defvar ps-print-emacs-type
3545 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
3546 ((string-match "Lucid" emacs-version) 'lucid)
3547 ((string-match "Epoch" emacs-version) 'epoch)
3548 (t 'emacs)))
3549
3550 (if (memq ps-print-emacs-type '(lucid xemacs))
3551 (if (< emacs-minor-version 12)
3552 (setq ps-print-color-p nil))
3553 (require 'faces)) ; face-font, face-underline-p,
12d89a2e
RS
3554 ; x-font-regexp
3555
08ea6f17 3556
3e9cb08f
GM
3557 ;; Return t if the device (which can be changed during an emacs session)
3558 ;; can handle colors.
ea0c615d 3559 ;; This function is not yet implemented for GNU emacs.
3e9cb08f
GM
3560 (cond ((and (eq ps-print-emacs-type 'xemacs)
3561 (>= emacs-minor-version 12)) ; xemacs
3562 (defun ps-color-device ()
ea0c615d 3563 (eq (ps-x-device-class) 'color)))
3e9cb08f
GM
3564
3565 (t ; emacs
3566 (defun ps-color-device ()
ea0c615d
GM
3567 (if (fboundp 'color-values)
3568 (ps-e-color-values "Green")
3569 t))))
3570
3e9cb08f 3571
47b54c71
GM
3572 (defun ps-mapper (extent list)
3573 (nconc list
3574 (list (list (ps-x-extent-start-position extent) 'push extent)
3575 (list (ps-x-extent-end-position extent) 'pull extent)))
3576 nil)
3577
3578 (defun ps-extent-sorter (a b)
3579 (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
3580
3581 (defun ps-xemacs-face-kind-p (face kind kind-regex)
3582 (let* ((frame-font (or (ps-x-face-font-instance face)
3583 (ps-x-face-font-instance 'default)))
3584 (kind-cons
3585 (and frame-font
3586 (assq kind
3587 (ps-x-font-instance-properties frame-font))))
3588 (kind-spec (cdr-safe kind-cons))
3589 (case-fold-search t))
3590 (and kind-spec (string-match kind-regex kind-spec))))
3591
3592 (defun ps-xemacs-color-name (color)
3593 (if (ps-x-color-specifier-p color)
3594 (ps-x-color-name color)
3595 color))
3596
3e9cb08f
GM
3597 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
3598
3599 (defun ps-color-values (x-color)
ea0c615d
GM
3600 (cond
3601 ((fboundp 'color-values)
3602 (ps-e-color-values x-color))
3603 ((fboundp 'x-color-values)
3604 (ps-e-x-color-values x-color))
3605 (t
e8af40ee 3606 (error "No available function to determine X color values"))))
3e9cb08f
GM
3607
3608 (defalias 'ps-face-foreground-name 'face-foreground)
3609 (defalias 'ps-face-background-name 'face-background)
3610
3611 (defun ps-face-bold-p (face)
2bd80d73 3612 (or (ps-e-face-bold-p face)
3e9cb08f
GM
3613 (memq face ps-bold-faces)))
3614
3615 (defun ps-face-italic-p (face)
2bd80d73 3616 (or (ps-e-face-italic-p face)
3e9cb08f
GM
3617 (memq face ps-italic-faces)))
3618 )
3619 ; xemacs
3620 ; lucid
3621 (t ; epoch
3622
27dc47aa
GM
3623 ;; to avoid XEmacs compilation gripes
3624 (defvar coding-system-for-write nil)
3625 (defvar coding-system-for-read nil)
3626 (defvar buffer-file-coding-system nil)
3627
08ea6f17
GM
3628 (and (fboundp 'find-coding-system)
3629 (or (ps-x-find-coding-system 'raw-text-unix)
3630 (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))
3e9cb08f 3631
3e9cb08f
GM
3632 (defun ps-color-values (x-color)
3633 (let ((color (ps-xemacs-color-name x-color)))
3634 (cond
3635 ((fboundp 'x-color-values)
ea0c615d 3636 (ps-e-x-color-values color))
3e9cb08f
GM
3637 ((and (fboundp 'color-instance-rgb-components)
3638 (ps-color-device))
3639 (ps-x-color-instance-rgb-components
3640 (if (ps-x-color-instance-p x-color)
3641 x-color
3642 (ps-x-make-color-instance color))))
3643 (t
e8af40ee 3644 (error "No available function to determine X color values")))))
3e9cb08f
GM
3645
3646 (defun ps-face-foreground-name (face)
3647 (ps-xemacs-color-name (face-foreground face)))
3648
3649 (defun ps-face-background-name (face)
3650 (ps-xemacs-color-name (face-background face)))
3651
3652 (defun ps-face-bold-p (face)
3653 (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
3654 (memq face ps-bold-faces))) ; Kludge-compatible
3655
3656 (defun ps-face-italic-p (face)
3657 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
3658 (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
3659 (memq face ps-italic-faces))) ; Kludge-compatible
3660 )))
3661
3662
ea0c615d 3663(defvar ps-print-color-scale 1.0)
47b54c71 3664
3e9cb08f
GM
3665(defun ps-color-scale (color)
3666 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3667 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
3668 (ps-color-values color)))
3669
3670
3671(defun ps-face-underlined-p (face)
3672 (or (face-underline-p face)
3673 (memq face ps-underlined-faces)))
e65df0a1 3674
857686a6 3675
41481e4b 3676(defun ps-prologue-file (filenumber)
2bd80d73
GM
3677 "If prologue FILENUMBER exists and is readable, returns contents as string.
3678
3679Note: No major/minor-mode is activated and no local variables are evaluated for
3680 FILENUMBER, but proper EOL-conversion and character interpretation is
3681 done!"
3682 (let ((filename (convert-standard-filename
3683 (expand-file-name (format "ps-prin%d.ps" filenumber)
3684 ps-postscript-code-directory))))
3685 (if (and (file-exists-p filename)
319acba0
GM
3686 (file-readable-p filename))
3687 (with-temp-buffer
3688 (insert-file-contents filename)
3689 (buffer-string))
e8af40ee 3690 (error "ps-print PostScript prologue `%s' file was not found"
2bd80d73 3691 filename))))
bcc0d457 3692
bcc0d457 3693
41481e4b 3694(defvar ps-mark-code-directory nil)
bcc0d457 3695
66e63857
GM
3696(defvar ps-print-prologue-0 ""
3697 "ps-print PostScript error handler.")
3698
41481e4b 3699(defvar ps-print-prologue-1 ""
6bf5fb46 3700 "ps-print PostScript prologue.")
12d89a2e
RS
3701
3702;; Start Editing Here:
ef2cbb24 3703
12d89a2e
RS
3704(defvar ps-source-buffer nil)
3705(defvar ps-spool-buffer-name "*PostScript*")
3706(defvar ps-spool-buffer nil)
ef2cbb24 3707
12d89a2e
RS
3708(defvar ps-output-head nil)
3709(defvar ps-output-tail nil)
ef2cbb24 3710
4b3eb10f
GM
3711(defvar ps-page-postscript 0) ; page number
3712(defvar ps-page-order 0) ; PostScript page counter
3713(defvar ps-page-sheet 0) ; sheet counter
3714(defvar ps-page-column 0) ; column counter
3715(defvar ps-page-printed 0) ; total pages printed
3716(defvar ps-page-n-up 0) ; n-up counter
bd7a2e26
GM
3717(defvar ps-lines-printed 0) ; total lines printed
3718(defvar ps-showline-count 1) ; line number counter
1fd9b7fe
GM
3719(defvar ps-first-page nil)
3720(defvar ps-last-page nil)
ea0c615d 3721(defvar ps-print-page-p t)
87a16a06 3722
857686a6 3723(defvar ps-control-or-escape-regexp nil)
98f2fbe7 3724(defvar ps-n-up-on nil)
857686a6 3725
87a16a06
RS
3726(defvar ps-background-pages nil)
3727(defvar ps-background-all-pages nil)
3728(defvar ps-background-text-count 0)
3729(defvar ps-background-image-count 0)
ef2cbb24 3730
12d89a2e 3731(defvar ps-current-font 0)
6e1b1da6
GM
3732(defvar ps-default-foreground nil)
3733(defvar ps-default-color nil)
3734(defvar ps-current-color nil)
12d89a2e
RS
3735(defvar ps-current-bg nil)
3736
2bd80d73 3737(defvar ps-zebra-stripe-full-p nil)
12d89a2e
RS
3738(defvar ps-razchunk 0)
3739
d3ab8dac 3740(defvar ps-color-p nil)
bcc0d457
RS
3741(defvar ps-color-format
3742 (if (eq ps-print-emacs-type 'emacs)
12d89a2e 3743
12b88fff
RS
3744 ;; Emacs understands the %f format; we'll use it to limit color RGB
3745 ;; values to three decimals to cut down some on the size of the
3746 ;; PostScript output.
3747 "%0.3f %0.3f %0.3f"
12d89a2e 3748
12b88fff 3749 ;; Lucid emacsen will have to make do with %s (princ) for floats.
bcc0d457 3750 "%s %s %s"))
12d89a2e 3751
319acba0
GM
3752;; These values determine how much print-height to deduct when headers/footers
3753;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
3754;; now.
12d89a2e 3755
bcc0d457 3756(defvar ps-header-pad 0
496725ad
RS
3757 "Vertical and horizontal space between the header frame and the text.
3758This is in units of points (1/72 inch).")
12d89a2e 3759
319acba0
GM
3760(defvar ps-footer-pad 0
3761 "Vertical and horizontal space between the footer frame and the text.
3762This is in units of points (1/72 inch).")
3763
bcc0d457 3764;; Define accessors to the dimensions list.
12d89a2e 3765
bcc0d457
RS
3766(defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3767(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
bc0d41bd 3768(defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
12d89a2e 3769
87a16a06 3770(defvar ps-landscape-page-height nil)
12d89a2e 3771
12d89a2e
RS
3772(defvar ps-print-width nil)
3773(defvar ps-print-height nil)
3774
8bd22fcf
KH
3775(defvar ps-height-remaining nil)
3776(defvar ps-width-remaining nil)
12d89a2e 3777
7d8b7e8e
KH
3778(defvar ps-font-size-internal nil)
3779(defvar ps-header-font-size-internal nil)
3780(defvar ps-header-title-font-size-internal nil)
319acba0 3781(defvar ps-footer-font-size-internal nil)
6bf5fb46
GM
3782(defvar ps-line-spacing-internal nil)
3783(defvar ps-paragraph-spacing-internal nil)
7d8b7e8e 3784
87a16a06
RS
3785\f
3786;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3787;; Internal Variables
3788
3789
3790(defvar ps-print-face-extension-alist nil
a18ed129 3791 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
87a16a06
RS
3792An element of this list has the following form:
3793
3794 (FACE . [BITS FG BG])
3795
3796 FACE is a symbol denoting a face name
3797 BITS is a bit vector, where each bit correspond
3798 to a feature (bold, underline, etc)
3799 (see documentation for `ps-print-face-map-alist')
3800 FG foreground color (string or nil)
3801 BG background color (string or nil)
3802
a18ed129
RS
3803Don't change this list directly; instead,
3804use `ps-extend-face' and `ps-extend-face-list'.
3805See documentation for `ps-extend-face' for valid extension symbol.")
3806
3807
3808(defvar ps-print-face-alist nil
3809 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
3810
3811An element of this list has the same form as an element of
3812`ps-print-face-extension-alist'.
3813
3814Don't change this list directly; this list is used by `ps-face-attributes',
3815`ps-map-face' and `ps-build-reference-face-lists'.")
87a16a06
RS
3816
3817
3818(defconst ps-print-face-map-alist
3819 '((bold . 1)
3820 (italic . 2)
3821 (underline . 4)
3822 (strikeout . 8)
3823 (overline . 16)
3824 (shadow . 32)
3825 (box . 64)
3826 (outline . 128))
3827 "Alist of all features and the corresponding bit mask.
3828Each symbol correspond to one bit in a bit vector.")
3829
3830\f
3831;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
a18ed129 3832;; Remapping Faces
87a16a06
RS
3833
3834
3835;;;###autoload
3836(defun ps-extend-face-list (face-extension-list &optional merge-p)
3837 "Extend face in `ps-print-face-extension-alist'.
3838
a18ed129
RS
3839If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
3840with face extension in `ps-print-face-extension-alist'; otherwise, overrides.
87a16a06
RS
3841
3842The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
3843
3844See `ps-extend-face' for documentation."
3845 (while face-extension-list
3846 (ps-extend-face (car face-extension-list) merge-p)
3847 (setq face-extension-list (cdr face-extension-list))))
3848
3849
3850;;;###autoload
3851(defun ps-extend-face (face-extension &optional merge-p)
3852 "Extend face in `ps-print-face-extension-alist'.
3853
6bdb808e 3854If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
a18ed129 3855with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
87a16a06
RS
3856
3857The elements of FACE-EXTENSION list have the form:
3858
3859 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
3860
3861FACE-NAME is a face name symbol.
3862
3863FOREGROUND and BACKGROUND may be nil or a string that denotes the
3864foreground and background colors respectively.
3865
3866EXTENSION is one of the following symbols:
3867 bold - use bold font.
3868 italic - use italic font.
3869 underline - put a line under text.
3870 strikeout - like underline, but the line is in middle of text.
3871 overline - like underline, but the line is over the text.
3872 shadow - text will have a shadow.
3873 box - text will be surrounded by a box.
a18ed129 3874 outline - print characters as hollow outlines.
87a16a06
RS
3875
3876If EXTENSION is any other symbol, it is ignored."
3877 (let* ((face-name (nth 0 face-extension))
3878 (foreground (nth 1 face-extension))
3879 (background (nth 2 face-extension))
3880 (ps-face (cdr (assq face-name ps-print-face-extension-alist)))
3881 (face-vector (or ps-face (vector 0 nil nil)))
3882 (face-bit (ps-extension-bit face-extension)))
3883 ;; extend face
3884 (aset face-vector 0 (if merge-p
3885 (logior (aref face-vector 0) face-bit)
3886 face-bit))
3887 (and foreground (stringp foreground) (aset face-vector 1 foreground))
3888 (and background (stringp background) (aset face-vector 2 background))
3889 ;; if face does not exist, insert it
3890 (or ps-face
3891 (setq ps-print-face-extension-alist
3892 (cons (cons face-name face-vector)
3893 ps-print-face-extension-alist)))))
3894
3895
3896(defun ps-extension-bit (face-extension)
3897 (let ((face-bit 0))
3898 ;; map valid symbol extension to bit vector
3899 (setq face-extension (cdr (cdr face-extension)))
3900 (while (setq face-extension (cdr face-extension))
3901 (setq face-bit (logior face-bit
3902 (or (cdr (assq (car face-extension)
3903 ps-print-face-map-alist))
3904 0))))
3905 face-bit))
3906
3907\f
857686a6 3908;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
bc0d41bd 3909;; Adapted from font-lock: (obsolete stuff)
857686a6
RS
3910;; Originally face attributes were specified via `font-lock-face-attributes'.
3911;; Users then changed the default face attributes by setting that variable.
3912;; However, we try and be back-compatible and respect its value if set except
3913;; for faces where M-x customize has been used to save changes for the face.
3914
0a5daee5 3915
857686a6
RS
3916(defun ps-font-lock-face-attributes ()
3917 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
3918 (boundp 'font-lock-face-attributes)
3e9cb08f 3919 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
857686a6 3920 (while face-attributes
6bdb808e
RS
3921 (let* ((face-attribute
3922 (car (prog1 face-attributes
3923 (setq face-attributes (cdr face-attributes)))))
857686a6
RS
3924 (face (car face-attribute)))
3925 ;; Rustle up a `defface' SPEC from a
3926 ;; `font-lock-face-attributes' entry.
3927 (unless (get face 'saved-face)
3928 (let ((foreground (nth 1 face-attribute))
3929 (background (nth 2 face-attribute))
3930 (bold-p (nth 3 face-attribute))
3931 (italic-p (nth 4 face-attribute))
3932 (underline-p (nth 5 face-attribute))
3933 face-spec)
3934 (when foreground
3935 (setq face-spec (cons ':foreground
3936 (cons foreground face-spec))))
3937 (when background
3938 (setq face-spec (cons ':background
3939 (cons background face-spec))))
3940 (when bold-p
3941 (setq face-spec (append '(:bold t) face-spec)))
3942 (when italic-p
3943 (setq face-spec (append '(:italic t) face-spec)))
3944 (when underline-p
3945 (setq face-spec (append '(:underline t) face-spec)))
3946 (custom-declare-face face (list (list t face-spec)) nil)
3947 )))))))
3948
3949\f
87a16a06
RS
3950;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3951;; Internal functions and variables
3952
3953
3556c6dd
GM
3954(defvar ps-print-hook nil)
3955(defvar ps-print-begin-sheet-hook nil)
3956(defvar ps-print-begin-page-hook nil)
3957(defvar ps-print-begin-column-hook nil)
12b88fff
RS
3958
3959
a18ed129 3960(defun ps-print-without-faces (from to &optional filename region-p)
857686a6 3961 (ps-spool-without-faces from to region-p)
87a16a06
RS
3962 (ps-do-despool filename))
3963
3964
a18ed129 3965(defun ps-spool-without-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))
3969
3970
a18ed129 3971(defun ps-print-with-faces (from to &optional filename region-p)
857686a6 3972 (ps-spool-with-faces from to region-p)
87a16a06
RS
3973 (ps-do-despool filename))
3974
3975
a18ed129 3976(defun ps-spool-with-faces (from to &optional region-p)
12b88fff 3977 (run-hooks 'ps-print-hook)
712dc9e0 3978 (ps-printing-region region-p from)
87a16a06
RS
3979 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
3980
3981
bc0d41bd 3982(defun ps-count-lines (from to)
a18ed129 3983 (+ (count-lines from to)
857686a6
RS
3984 (save-excursion
3985 (goto-char to)
3986 (if (= (current-column) 0) 1 0))))
87a16a06
RS
3987
3988
a18ed129 3989(defvar ps-printing-region nil
bc0d41bd
KH
3990 "Variable used to indicate if the region that ps-print is printing.
3991It is a cons, the car of which is the line number where the region begins, and
3992its cdr is the total number of lines in the buffer. Formatting functions can
3993use this information to print the original line number (and not the number of
3994lines printed), and to indicate in the header that the printout is of a partial
3995file.")
3996
3997
3998(defvar ps-printing-region-p nil
3999 "Non-nil means ps-print is printing a region.")
87a16a06
RS
4000
4001
712dc9e0 4002(defun ps-printing-region (region-p from)
bc0d41bd
KH
4003 (setq ps-printing-region-p region-p
4004 ps-printing-region
4005 (cons (if region-p
712dc9e0 4006 (ps-count-lines (point-min) from)
bc0d41bd
KH
4007 1)
4008 (ps-count-lines (point-min) (point-max)))))
87a16a06
RS
4009
4010\f
12d89a2e
RS
4011;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4012;; Internal functions
4013
0a5daee5 4014
7ae35a2f 4015(defsubst ps-font-alist (font-sym)
12b88fff
RS
4016 (get font-sym 'fonts))
4017
4018(defun ps-font (font-sym font-type)
4019 "Font family name for text of `font-type', when generating PostScript."
7ae35a2f 4020 (let* ((font-list (ps-font-alist font-sym))
12b88fff 4021 (normal-font (cdr (assq 'normal font-list))))
6bdb808e
RS
4022 (while (and font-list (not (eq font-type (car (car font-list)))))
4023 (setq font-list (cdr font-list)))
4024 (or (cdr (car font-list)) normal-font)))
12b88fff 4025
319acba0 4026(defsubst ps-fonts (font-sym)
7ae35a2f 4027 (mapcar 'cdr (ps-font-alist font-sym)))
12b88fff 4028
319acba0 4029(defsubst ps-font-number (font-sym font-type)
7ae35a2f 4030 (or (ps-alist-position font-type (ps-font-alist font-sym))
12b88fff
RS
4031 0))
4032
4033(defsubst ps-line-height (font-sym)
4034 "The height of a line, for generating PostScript.
4035This is the value that ps-print uses to determine the height,
4036y-dimension, of the lines of text it has printed, and thus affects the
4037point at which page-breaks are placed.
4038The line-height is *not* the same as the point size of the font."
4039 (get font-sym 'line-height))
4040
4041(defsubst ps-title-line-height (font-sym)
4042 "The height of a `title' line, for generating PostScript.
4043This is the value that ps-print uses to determine the height,
4044y-dimension, of the lines of text it has printed, and thus affects the
4045point at which page-breaks are placed.
4046The title-line-height is *not* the same as the point size of the font."
4047 (get font-sym 'title-line-height))
4048
4049(defsubst ps-space-width (font-sym)
4050 "The width of a space character, for generating PostScript.
4051This value is used in expanding tab characters."
4052 (get font-sym 'space-width))
4053
4054(defsubst ps-avg-char-width (font-sym)
4055 "The average width, in points, of a character, for generating PostScript.
4056This is the value that ps-print uses to determine the length,
4057x-dimension, of the text it has printed, and thus affects the point at
4058which long lines wrap around."
4059 (get font-sym 'avg-char-width))
4060
bcc0d457 4061(defun ps-line-lengths-internal ()
87a16a06 4062 "Display the correspondence between a line length and a font size,
bcc0d457
RS
4063using the current ps-print setup.
4064Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
df5e6194
GM
4065 (let* ((ps-font-size-internal
4066 (or ps-font-size-internal
4067 (ps-get-font-size 'ps-font-size)))
4068 (ps-header-font-size-internal
4069 (or ps-header-font-size-internal
4070 (ps-get-font-size 'ps-header-font-size)))
4071 (ps-header-title-font-size-internal
4072 (or ps-header-title-font-size-internal
4073 (ps-get-font-size 'ps-header-title-font-size)))
4074 (buf (get-buffer-create "*Line-lengths*"))
4075 (ifs ps-font-size-internal) ; initial font size
4076 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
4077 (print-width (progn (ps-get-page-dimensions)
4078 ps-print-width))
4079 (ps-setup (ps-setup)) ; setup for the current buffer
4080 (fs-min 5) ; minimum font size
4081 cw-min ; minimum character width
4082 nb-cpl-max ; maximum nb of characters per line
4083 (fs-max 14) ; maximum font size
4084 cw-max ; maximum character width
4085 nb-cpl-min ; minimum nb of characters per line
4086 fs ; current font size
4087 cw ; current character width
4088 nb-cpl ; current nb of characters per line
4089 )
bcc0d457
RS
4090 (setq cw-min (/ (* icw fs-min) ifs)
4091 nb-cpl-max (floor (/ print-width cw-min))
4092 cw-max (/ (* icw fs-max) ifs)
8bd22fcf
KH
4093 nb-cpl-min (floor (/ print-width cw-max))
4094 nb-cpl nb-cpl-min)
bcc0d457
RS
4095 (set-buffer buf)
4096 (goto-char (point-max))
df5e6194 4097 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
8bd22fcf 4098 (insert ps-setup
df5e6194 4099 "\nnb char per line / font size\n")
bcc0d457 4100 (while (<= nb-cpl nb-cpl-max)
8bd22fcf
KH
4101 (setq cw (/ print-width (float nb-cpl))
4102 fs (/ (* ifs cw) icw))
df5e6194 4103 (insert (format "%16d %s\n" nb-cpl fs))
bcc0d457
RS
4104 (setq nb-cpl (1+ nb-cpl)))
4105 (insert "\n")
4106 (display-buffer buf 'not-this-window)))
4107
4108(defun ps-nb-pages (nb-lines)
496725ad
RS
4109 "Display correspondence between font size and the number of pages.
4110The correspondence is based on having NB-LINES lines of text,
4111and on the current ps-print setup."
df5e6194
GM
4112 (let* ((ps-font-size-internal
4113 (or ps-font-size-internal
4114 (ps-get-font-size 'ps-font-size)))
4115 (ps-header-font-size-internal
4116 (or ps-header-font-size-internal
4117 (ps-get-font-size 'ps-header-font-size)))
4118 (ps-header-title-font-size-internal
4119 (or ps-header-title-font-size-internal
4120 (ps-get-font-size 'ps-header-title-font-size)))
6bf5fb46
GM
4121 (ps-line-spacing-internal
4122 (or ps-line-spacing-internal
4123 (ps-get-size ps-line-spacing "line spacing")))
df5e6194 4124 (buf (get-buffer-create "*Nb-Pages*"))
6bf5fb46 4125 (ils ps-line-spacing-internal) ; initial line spacing
df5e6194
GM
4126 (ifs ps-font-size-internal) ; initial font size
4127 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
4128 (page-height (progn (ps-get-page-dimensions)
4129 ps-print-height))
4130 (ps-setup (ps-setup)) ; setup for the current buffer
4131 (fs-min 4) ; minimum font size
4132 lh-min ; minimum line height
4133 nb-lpp-max ; maximum nb of lines per page
4134 nb-page-min ; minimum nb of pages
4135 (fs-max 14) ; maximum font size
4136 lh-max ; maximum line height
4137 nb-lpp-min ; minimum nb of lines per page
4138 nb-page-max ; maximum nb of pages
4139 fs ; current font size
4140 lh ; current line height
4141 nb-lpp ; current nb of lines per page
4142 nb-page ; current nb of pages
4143 )
6bf5fb46 4144 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
bcc0d457
RS
4145 nb-lpp-max (floor (/ page-height lh-min))
4146 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
6bf5fb46 4147 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
bcc0d457 4148 nb-lpp-min (floor (/ page-height lh-max))
8bd22fcf
KH
4149 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
4150 nb-page nb-page-min)
bcc0d457
RS
4151 (set-buffer buf)
4152 (goto-char (point-max))
df5e6194 4153 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
8bd22fcf 4154 (insert ps-setup
df5e6194 4155 (format "\nThere are %d lines.\n\n" nb-lines)
8bd22fcf 4156 "nb page / font size\n")
bcc0d457
RS
4157 (while (<= nb-page nb-page-max)
4158 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
4159 lh (/ page-height nb-lpp)
4160 fs (/ (* ifs lh) ilh))
df5e6194 4161 (insert (format "%7d %s\n" nb-page fs))
bcc0d457
RS
4162 (setq nb-page (1+ nb-page)))
4163 (insert "\n")
4164 (display-buffer buf 'not-this-window)))
4165
6bdb808e
RS
4166;; macros used in `ps-select-font'
4167(defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
4168(defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
4169
12b88fff
RS
4170(defun ps-select-font (font-family sym font-size title-font-size)
4171 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
4172 (or font-entry
ef1159c2 4173 (error "Don't have data to scale font %s. Known fonts families are %s"
12b88fff
RS
4174 font-family
4175 (mapcar 'car ps-font-info-database)))
6bdb808e
RS
4176 (let ((size (ps-lookup 'size)))
4177 (put sym 'fonts (ps-lookup 'fonts))
4178 (put sym 'space-width (ps-size-scale 'space-width))
4179 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
4180 (put sym 'line-height (ps-size-scale 'line-height))
4181 (put sym 'title-line-height
4182 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
bcc0d457 4183
12d89a2e 4184(defun ps-get-page-dimensions ()
bcc0d457
RS
4185 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
4186 page-width page-height)
4187 (cond
4188 ((null page-dimensions)
4189 (error "`ps-paper-type' must be one of:\n%s"
4190 (mapcar 'car ps-page-dimensions-database)))
4191 ((< ps-number-of-columns 1)
12b88fff 4192 (error "The number of columns %d should be positive"
8bd22fcf 4193 ps-number-of-columns)))
bcc0d457 4194
12b88fff 4195 (ps-select-font ps-font-family 'ps-font-for-text
7d8b7e8e 4196 ps-font-size-internal ps-font-size-internal)
12b88fff 4197 (ps-select-font ps-header-font-family 'ps-font-for-header
7d8b7e8e
KH
4198 ps-header-font-size-internal
4199 ps-header-title-font-size-internal)
319acba0
GM
4200 (ps-select-font ps-footer-font-family 'ps-font-for-footer
4201 ps-footer-font-size-internal ps-footer-font-size-internal)
bcc0d457
RS
4202
4203 (setq page-width (ps-page-dimensions-get-width page-dimensions)
4204 page-height (ps-page-dimensions-get-height page-dimensions))
4205
4206 ;; Landscape mode
4207 (if ps-landscape-mode
4208 ;; exchange width and height
4209 (setq page-width (prog1 page-height (setq page-height page-width))))
4210
4211 ;; It is used to get the lower right corner (only in landscape mode)
4212 (setq ps-landscape-page-height page-height)
4213
4214 ;; | lm | text | ic | text | ic | text | rm |
4215 ;; page-width == lm + n * pw + (n - 1) * ic + rm
4216 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
8bd22fcf
KH
4217 (setq ps-print-width (/ (- page-width
4218 ps-left-margin ps-right-margin
4219 (* (1- ps-number-of-columns) ps-inter-column))
4220 ps-number-of-columns))
bcc0d457
RS
4221 (if (<= ps-print-width 0)
4222 (error "Bad horizontal layout:
4223page-width == %s
4224ps-left-margin == %s
4225ps-right-margin == %s
4226ps-inter-column == %s
4227ps-number-of-columns == %s
4228| lm | text | ic | text | ic | text | rm |
4229page-width == lm + n * print-width + (n - 1) * ic + rm
4230=> print-width == %d !"
4231 page-width
4232 ps-left-margin
4233 ps-right-margin
4234 ps-inter-column
4235 ps-number-of-columns
4236 ps-print-width))
4237
4238 (setq ps-print-height
4239 (- page-height ps-bottom-margin ps-top-margin))
4240 (if (<= ps-print-height 0)
4241 (error "Bad vertical layout:
4242ps-top-margin == %s
4243ps-bottom-margin == %s
4244page-height == bm + print-height + tm
4245=> print-height == %d !"
4246 ps-top-margin
4247 ps-bottom-margin
4248 ps-print-height))
319acba0
GM
4249 ;; If headers are turned on, deduct the height of the header from the print
4250 ;; height.
8bd22fcf 4251 (if ps-print-header
12b88fff
RS
4252 (setq ps-header-pad (* ps-header-line-pad
4253 (ps-title-line-height 'ps-font-for-header))
8bd22fcf
KH
4254 ps-print-height (- ps-print-height
4255 ps-header-offset
4256 ps-header-pad
12b88fff
RS
4257 (ps-title-line-height 'ps-font-for-header)
4258 (* (ps-line-height 'ps-font-for-header)
4259 (1- ps-header-lines))
8bd22fcf 4260 ps-header-pad)))
bcc0d457 4261 (if (<= ps-print-height 0)
319acba0 4262 (error "Bad vertical layout (header):
bcc0d457
RS
4263ps-top-margin == %s
4264ps-bottom-margin == %s
4265ps-header-offset == %s
4266ps-header-pad == %s
4267header-height == %s
4268page-height == bm + print-height + tm - ho - hh
4269=> print-height == %d !"
4270 ps-top-margin
4271 ps-bottom-margin
4272 ps-header-offset
4273 ps-header-pad
4274 (+ ps-header-pad
12b88fff
RS
4275 (ps-title-line-height 'ps-font-for-header)
4276 (* (ps-line-height 'ps-font-for-header)
4277 (1- ps-header-lines))
bcc0d457 4278 ps-header-pad)
2bd80d73 4279 ps-print-height))
319acba0
GM
4280 ;; If footers are turned on, deduct the height of the footer from the print
4281 ;; height.
4282 (if ps-print-footer
4283 (setq ps-footer-pad (* ps-footer-line-pad
4284 (ps-title-line-height 'ps-font-for-footer))
4285 ps-print-height (- ps-print-height
4286 ps-footer-offset
4287 ps-footer-pad
4288 (* (ps-line-height 'ps-font-for-footer)
4289 (1- ps-footer-lines))
4290 ps-footer-pad)))
4291 (if (<= ps-print-height 0)
4292 (error "Bad vertical layout (footer):
4293ps-top-margin == %s
4294ps-bottom-margin == %s
4295ps-footer-offset == %s
4296ps-footer-pad == %s
4297footer-height == %s
4298page-height == bm + print-height + tm - fo - fh
4299=> print-height == %d !"
4300 ps-top-margin
4301 ps-bottom-margin
4302 ps-footer-offset
4303 ps-footer-pad
4304 (+ ps-footer-pad
4305 (* (ps-line-height 'ps-font-for-footer)
4306 (1- ps-footer-lines))
4307 ps-footer-pad)
4308 ps-print-height))
2bd80d73
GM
4309 ;; ps-zebra-stripe-follow is `full' or `full-follow'
4310 (if ps-zebra-stripe-full-p
4311 (let* ((line-height (ps-line-height 'ps-font-for-text))
6bf5fb46
GM
4312 (zebra (* (+ line-height ps-line-spacing-internal)
4313 ps-zebra-stripe-height)))
2bd80d73
GM
4314 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
4315 line-height))
4316 (if (<= ps-print-height 0)
319acba0 4317 (error "Bad vertical layout (full zebra stripe follow):
2bd80d73
GM
4318ps-zebra-stripe-follow == %s
4319ps-zebra-stripe-height == %s
4320font-text-height == %s
6bf5fb46
GM
4321line-spacing == %s
4322page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
2bd80d73
GM
4323=> print-height == %d !"
4324 ps-zebra-stripe-follow
4325 ps-zebra-stripe-height
4326 (ps-line-height 'ps-font-for-text)
6bf5fb46 4327 ps-line-spacing-internal
2bd80d73 4328 ps-print-height))))))
ef2cbb24 4329
edc9cd35
GM
4330(defun ps-print-preprint (prefix-arg)
4331 (and prefix-arg
4332 (or (numberp prefix-arg)
4333 (listp prefix-arg))
d3ab8dac
KH
4334 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4335 (buffer-name)))
4336 ".ps"))
8bd22fcf
KH
4337 (prompt (format "Save PostScript to file: (default %s) " name))
4338 (res (read-file-name prompt default-directory name nil)))
ea0c615d
GM
4339 (while (cond ((file-directory-p res)
4340 (ding)
4341 (setq prompt "It's a directory"))
4342 ((not (file-writable-p res))
d3ab8dac 4343 (ding)
ea0c615d 4344 (setq prompt "File is unwritable"))
d3ab8dac 4345 ((file-exists-p res)
ea0c615d 4346 (setq prompt "File exists")
d3ab8dac
KH
4347 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4348 res))))
4349 (t nil))
4350 (setq res (read-file-name
ea0c615d 4351 (format "%s; save PostScript to file: " prompt)
d3ab8dac
KH
4352 (file-name-directory res) nil nil
4353 (file-name-nondirectory res))))
8bd22fcf
KH
4354 (if (file-directory-p res)
4355 (expand-file-name name (file-name-as-directory res))
4356 res))))
12d89a2e
RS
4357
4358;; The following functions implement a simple list-buffering scheme so
4359;; that ps-print doesn't have to repeatedly switch between buffers
857686a6
RS
4360;; while spooling. The functions `ps-output' and `ps-output-string' build
4361;; up the lists; the function `ps-flush-output' takes the lists and
12d89a2e
RS
4362;; insert its contents into the spool buffer (*PostScript*).
4363
857686a6
RS
4364(defvar ps-string-escape-codes
4365 (let ((table (make-vector 256 nil))
4366 (char ?\000))
4367 ;; control characters
4368 (while (<= char ?\037)
4369 (aset table char (format "\\%03o" char))
4370 (setq char (1+ char)))
4371 ;; printable characters
4372 (while (< char ?\177)
4373 (aset table char (format "%c" char))
4374 (setq char (1+ char)))
4375 ;; DEL and 8-bit characters
4376 (while (<= char ?\377)
4377 (aset table char (format "\\%o" char))
4378 (setq char (1+ char)))
4379 ;; Override ASCII formatting characters with named escape code:
4380 (aset table ?\n "\\n") ; [NL] linefeed
4381 (aset table ?\r "\\r") ; [CR] carriage return
4382 (aset table ?\t "\\t") ; [HT] horizontal tab
4383 (aset table ?\b "\\b") ; [BS] backspace
4384 (aset table ?\f "\\f") ; [NP] form feed
4385 ;; Escape PostScript escape and string delimiter characters:
4386 (aset table ?\\ "\\\\")
4387 (aset table ?\( "\\(")
4388 (aset table ?\) "\\)")
4389 table)
4390 "Vector used to map characters to PostScript string escape codes.")
4391
6bf5fb46 4392(defsubst ps-output-string-prim (string)
12d89a2e
RS
4393 (insert "(") ;insert start-string delimiter
4394 (save-excursion ;insert string
e65df0a1 4395 (insert (string-as-unibyte string)))
12d89a2e 4396 ;; Find and quote special characters as necessary for PS
c82b4a75 4397 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
b61e2c11
RS
4398 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4399 (let ((special (following-char)))
e65df0a1
KH
4400 (delete-char 1)
4401 (insert (aref ps-string-escape-codes special))))
12d89a2e
RS
4402 (goto-char (point-max))
4403 (insert ")")) ;insert end-string delimiter
ef2cbb24 4404
6bf5fb46 4405(defsubst ps-init-output-queue ()
1fd9b7fe 4406 (setq ps-output-head (list "")
8bd22fcf 4407 ps-output-tail ps-output-head))
ef2cbb24 4408
1fd9b7fe
GM
4409
4410(defun ps-selected-pages ()
4411 (while (progn
4412 (setq ps-first-page (car (car ps-selected-pages))
4413 ps-last-page (cdr (car ps-selected-pages))
4414 ps-selected-pages (cdr ps-selected-pages))
4415 (and ps-selected-pages
4416 (< ps-last-page ps-page-postscript)))))
4417
4418
6bf5fb46 4419(defsubst ps-print-page-p ()
ea0c615d
GM
4420 (setq ps-print-page-p
4421 (and (cond ((null ps-first-page))
4422 ((<= ps-page-postscript ps-last-page)
4423 (<= ps-first-page ps-page-postscript))
4424 (ps-selected-pages
4425 (ps-selected-pages)
4426 (and (<= ps-first-page ps-page-postscript)
4427 (<= ps-page-postscript ps-last-page)))
4428 (t
4429 nil))
4b3eb10f 4430 (cond ((eq ps-even-or-odd-pages 'even-page)
ea0c615d 4431 (= (logand ps-page-postscript 1) 0))
4b3eb10f 4432 ((eq ps-even-or-odd-pages 'odd-page)
ea0c615d
GM
4433 (= (logand ps-page-postscript 1) 1))
4434 (t)
4435 ))))
1fd9b7fe
GM
4436
4437
6bf5fb46 4438(defsubst ps-print-sheet-p ()
4b3eb10f
GM
4439 (setq ps-print-page-p
4440 (cond ((eq ps-even-or-odd-pages 'even-sheet)
4441 (= (logand ps-page-sheet 1) 0))
4442 ((eq ps-even-or-odd-pages 'odd-sheet)
4443 (= (logand ps-page-sheet 1) 1))
4444 (t)
4445 )))
4446
4447
12d89a2e 4448(defun ps-output (&rest args)
ea0c615d 4449 (when ps-print-page-p
1fd9b7fe
GM
4450 (setcdr ps-output-tail args)
4451 (while (cdr ps-output-tail)
4452 (setq ps-output-tail (cdr ps-output-tail)))))
ef2cbb24 4453
12d89a2e
RS
4454(defun ps-output-string (string)
4455 (ps-output t string))
ef2cbb24 4456
e65df0a1
KH
4457;; Output strings in the list ARGS in the PostScript prologue part.
4458(defun ps-output-prologue (args)
4459 (ps-output 'prologue (if (stringp args) (list args) args)))
4460
12d89a2e
RS
4461(defun ps-flush-output ()
4462 (save-excursion
4463 (set-buffer ps-spool-buffer)
4464 (goto-char (point-max))
4465 (while ps-output-head
4466 (let ((it (car ps-output-head)))
e65df0a1
KH
4467 (cond
4468 ((eq t it)
4469 (setq ps-output-head (cdr ps-output-head))
4470 (ps-output-string-prim (car ps-output-head)))
4471 ((eq 'prologue it)
12d89a2e 4472 (setq ps-output-head (cdr ps-output-head))
e65df0a1
KH
4473 (save-excursion
4474 (search-backward "\nBeginDoc")
4475 (forward-char 1)
4476 (apply 'insert (car ps-output-head))))
4477 (t
4478 (insert it))))
12d89a2e
RS
4479 (setq ps-output-head (cdr ps-output-head))))
4480 (ps-init-output-queue))
4481
4482(defun ps-insert-file (fname)
4483 (ps-flush-output)
12d89a2e
RS
4484 (save-excursion
4485 (set-buffer ps-spool-buffer)
4486 (goto-char (point-max))
4487 (insert-file fname)))
06fb6aab 4488
319acba0 4489;; These functions insert the arrays that define the contents of the headers.
ef2cbb24 4490
12d89a2e 4491(defun ps-generate-header-line (fonttag &optional content)
319acba0 4492 (ps-output " [" fonttag " ")
12d89a2e 4493 (cond
319acba0
GM
4494 ;; Literal strings should be output as is -- the string must contain its own
4495 ;; PS string delimiters, '(' and ')', if necessary.
12d89a2e 4496 ((stringp content)
6bf5fb46 4497 (ps-output (ps-mule-encode-header-string content fonttag)))
12d89a2e 4498
319acba0
GM
4499 ;; Functions are called -- they should return strings; they will be inserted
4500 ;; as strings and the PS string delimiters added.
12d89a2e 4501 ((and (symbolp content) (fboundp content))
6bf5fb46
GM
4502 (ps-output-string (ps-mule-encode-header-string (funcall content)
4503 fonttag)))
12d89a2e 4504
319acba0
GM
4505 ;; Variables will have their contents inserted. They should contain
4506 ;; strings, and will be inserted as strings.
12d89a2e 4507 ((and (symbolp content) (boundp content))
6bf5fb46
GM
4508 (ps-output-string (ps-mule-encode-header-string (symbol-value content)
4509 fonttag)))
12d89a2e
RS
4510
4511 ;; Anything else will get turned into an empty string.
4512 (t
4513 (ps-output-string "")))
319acba0 4514 (ps-output "]\n"))
12d89a2e 4515
319acba0
GM
4516(defun ps-generate-header (name fonttag0 fonttag1 contents)
4517 (ps-output "/" name "[\n")
4518 (and contents (> ps-header-lines 0)
4519 (let ((count 1))
4520 (ps-generate-header-line fonttag0 (car contents))
4521 (while (and (< count ps-header-lines)
4522 (setq contents (cdr contents)))
4523 (ps-generate-header-line fonttag1 (car contents))
4524 (setq count (1+ count)))))
4525 (ps-output "]def\n"))
12d89a2e 4526
bc0d41bd 4527
6e1b1da6
GM
4528(defun ps-output-boolean (name bool)
4529 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
ef2cbb24 4530
06fb6aab 4531
319acba0
GM
4532(defun ps-output-frame-properties (name alist)
4533 (ps-output "/" name " ["
efa89c1f 4534 (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
319acba0
GM
4535 (ps-format-color (cdr (assq 'back-color alist)) 0.9)
4536 (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
efa89c1f
GM
4537 (ps-format-color (cdr (assq 'border-color alist)) 0.0)
4538 (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
319acba0
GM
4539 "]def\n"))
4540
4541
87a16a06
RS
4542(defun ps-background-pages (page-list func)
4543 (if page-list
4544 (mapcar
bc0d41bd
KH
4545 #'(lambda (pages)
4546 (let ((start (if (consp pages) (car pages) pages))
4547 (end (if (consp pages) (cdr pages) pages)))
4548 (and (integerp start) (integerp end) (<= start end)
4549 (add-to-list 'ps-background-pages (vector start end func)))))
87a16a06
RS
4550 page-list)
4551 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4552
4553
bc0d41bd
KH
4554(defconst ps-boundingbox-re
4555 "^%%BoundingBox:\
4556\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4557
4558
87a16a06
RS
4559(defun ps-get-boundingbox ()
4560 (save-excursion
4561 (set-buffer ps-spool-buffer)
4562 (save-excursion
bc0d41bd 4563 (if (re-search-forward ps-boundingbox-re nil t)
87a16a06
RS
4564 (vector (string-to-number ; lower x
4565 (buffer-substring (match-beginning 1) (match-end 1)))
4566 (string-to-number ; lower y
4567 (buffer-substring (match-beginning 2) (match-end 2)))
4568 (string-to-number ; upper x
4569 (buffer-substring (match-beginning 3) (match-end 3)))
4570 (string-to-number ; upper y
4571 (buffer-substring (match-beginning 4) (match-end 4))))
4572 (vector 0 0 0 0)))))
4573
4574
4575;; Emacs understands the %f format; we'll use it to limit color RGB values
4576;; to three decimals to cut down some on the size of the PostScript output.
4577;; Lucid emacsen will have to make do with %s (princ) for floats.
4578
4579(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
4580 "%0.3f " ; emacs
4581 "%s ")) ; Lucid emacsen
4582
4583
4584(defun ps-float-format (value &optional default)
4585 (let ((literal (or value default)))
efa89c1f
GM
4586 (cond ((null literal)
4587 " ")
4588 ((numberp literal)
4589 (format ps-float-format (* literal 1.0))) ; force float number
4590 (t
4591 (format "%s " literal))
4592 )))
87a16a06
RS
4593
4594
4595(defun ps-background-text ()
4596 (mapcar
bc0d41bd
KH
4597 #'(lambda (text)
4598 (setq ps-background-text-count (1+ ps-background-text-count))
c3d6d211 4599 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
bc0d41bd
KH
4600 (ps-output-string (nth 0 text)) ; text
4601 (ps-output
4602 "\n"
4603 (ps-float-format (nth 4 text) 200.0) ; font size
4604 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
4605 (ps-float-format (nth 6 text)
4606 "PrintHeight PrintPageWidth atan") ; rotation
4607 (ps-float-format (nth 5 text) 0.85) ; gray
4608 (ps-float-format (nth 1 text) "0") ; x position
8e234846 4609 (ps-float-format (nth 2 text) "0") ; y position
c3d6d211 4610 "\nShowBackText}def\n")
bc0d41bd
KH
4611 (ps-background-pages (nthcdr 7 text) ; page list
4612 (format "ShowBackText-%d\n"
4613 ps-background-text-count)))
87a16a06
RS
4614 ps-print-background-text))
4615
4616
4617(defun ps-background-image ()
4618 (mapcar
bc0d41bd
KH
4619 #'(lambda (image)
4620 (let ((image-file (expand-file-name (nth 0 image))))
41481e4b
KH
4621 (when (file-readable-p image-file)
4622 (setq ps-background-image-count (1+ ps-background-image-count))
4623 (ps-output
c3d6d211 4624 (format "/ShowBackImage-%d{\n--back-- "
41481e4b
KH
4625 ps-background-image-count)
4626 (ps-float-format (nth 5 image) 0.0) ; rotation
4627 (ps-float-format (nth 3 image) 1.0) ; x scale
4628 (ps-float-format (nth 4 image) 1.0) ; y scale
4629 (ps-float-format (nth 1 image) ; x position
4630 "PrintPageWidth 2 div")
4631 (ps-float-format (nth 2 image) ; y position
4632 "PrintHeight 2 div BottomMargin add")
4633 "\nBeginBackImage\n")
4634 (ps-insert-file image-file)
4635 ;; coordinate adjustment to centralize image
4636 ;; around x and y position
4637 (let ((box (ps-get-boundingbox)))
4638 (save-excursion
4639 (set-buffer ps-spool-buffer)
4640 (save-excursion
4641 (if (re-search-backward "^--back--" nil t)
4642 (replace-match
4643 (format "%s %s"
4644 (ps-float-format
4645 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
4646 (aref box 0))))
4647 (ps-float-format
4648 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
4649 (aref box 1)))))
4650 t)))))
c3d6d211 4651 (ps-output "\nEndBackImage}def\n")
41481e4b
KH
4652 (ps-background-pages (nthcdr 6 image) ; page list
4653 (format "ShowBackImage-%d\n"
4654 ps-background-image-count)))))
87a16a06
RS
4655 ps-print-background-image))
4656
4657
a18ed129 4658(defun ps-background (page-number)
87a16a06 4659 (let (has-local-background)
bc0d41bd
KH
4660 (mapcar #'(lambda (range)
4661 (and (<= (aref range 0) page-number)
4662 (<= page-number (aref range 1))
4663 (if has-local-background
4664 (ps-output (aref range 2))
4665 (setq has-local-background t)
c3d6d211 4666 (ps-output "/printLocalBackground{\n"
bc0d41bd 4667 (aref range 2)))))
87a16a06 4668 ps-background-pages)
c3d6d211 4669 (and has-local-background (ps-output "}def\n"))))
87a16a06
RS
4670
4671
0140c600
EZ
4672;; Return a list of the distinct elements of LIST.
4673;; Elements are compared with `equal'.
4674(defun ps-remove-duplicates (list)
4675 (let (new (tail list))
4676 (while tail
4677 (or (member (car tail) new)
4678 (setq new (cons (car tail) new)))
4679 (setq tail (cdr tail)))
4680 (nreverse new)))
4681
c82b4a75 4682
6bdb808e
RS
4683;; Find the first occurrence of ITEM in LIST.
4684;; Return the index of the matching item, or nil if not found.
4685;; Elements are compared with `eq'.
7ae35a2f 4686(defun ps-alist-position (item list)
6bdb808e
RS
4687 (let ((tail list) (index 0) found)
4688 (while tail
7ae35a2f 4689 (if (setq found (eq (car (car tail)) item))
6bdb808e
RS
4690 (setq tail nil)
4691 (setq index (1+ index)
4692 tail (cdr tail))))
4693 (and found index)))
4694
4695
bc0d41bd
KH
4696(defconst ps-n-up-database
4697 '((a4
4698 (1 nil 1 1 0)
4699 (2 t 1 2 0)
4700 (4 nil 2 2 0)
4701 (6 t 2 3 1)
4702 (8 t 2 4 0)
4703 (9 nil 3 3 0)
4704 (12 t 3 4 2)
4705 (16 nil 4 4 0)
4706 (18 t 3 6 0)
4707 (20 nil 5 4 1)
4708 (25 nil 5 5 0)
4709 (30 nil 6 5 1)
4710 (32 t 4 8 0)
4711 (36 nil 6 6 0)
4712 (42 nil 7 6 1)
4713 (49 nil 7 7 0)
4714 (50 t 5 10 0)
4715 (56 nil 8 7 1)
4716 (64 nil 8 8 0)
4717 (72 nil 9 8 1)
4718 (81 nil 9 9 0)
4719 (90 nil 10 9 1)
4720 (100 nil 10 10 0))
4721 (a3
4722 (1 nil 1 1 0)
4723 (2 t 1 2 0)
4724 (4 nil 2 2 0)
4725 (6 t 2 3 1)
4726 (8 t 2 4 0)
4727 (9 nil 3 3 0)
4728 (12 nil 4 3 1)
4729 (16 nil 4 4 0)
4730 (18 t 3 6 0)
4731 (20 nil 5 4 1)
4732 (25 nil 5 5 0)
4733 (30 nil 6 5 1)
4734 (32 t 4 8 0)
4735 (36 nil 6 6 0)
4736 (42 nil 7 6 1)
4737 (49 nil 7 7 0)
4738 (50 t 5 10 0)
4739 (56 nil 8 7 1)
4740 (64 nil 8 8 0)
4741 (72 nil 9 8 1)
4742 (81 nil 9 9 0)
4743 (90 nil 10 9 1)
4744 (100 nil 10 10 0))
4745 (letter
4746 (1 nil 1 1 0)
8e234846 4747 (2 t 1 2 0) ; adjusted by PostScript code
bc0d41bd
KH
4748 (4 nil 2 2 0)
4749 (6 t 2 3 0)
4750 (9 nil 3 3 0)
4751 (12 nil 4 3 1)
4752 (16 nil 4 4 0)
4753 (20 nil 5 4 1)
4754 (25 nil 5 5 0)
4755 (30 nil 6 5 1)
4756 (36 nil 6 6 0)
4757 (40 t 5 8 0)
4758 (42 nil 7 6 1)
4759 (49 nil 7 7 0)
4760 (56 nil 8 7 1)
4761 (64 nil 8 8 0)
4762 (72 nil 9 8 1)
4763 (81 nil 9 9 0)
4764 (90 nil 10 9 1)
4765 (100 nil 10 10 0))
4766 (legal
4767 (1 nil 1 1 0)
4768 (2 t 1 2 0)
4769 (4 nil 2 2 0)
4770 (6 nil 3 2 1)
4771 (9 nil 3 3 0)
4772 (10 t 2 5 0)
4773 (12 nil 4 3 1)
4774 (16 nil 4 4 0)
4775 (20 nil 5 4 1)
4776 (25 nil 5 5 0)
4777 (30 nil 6 5 1)
4778 (36 nil 6 6 0)
4779 (42 nil 7 6 1)
4780 (49 nil 7 7 0)
4781 (56 nil 8 7 1)
4782 (64 nil 8 8 0)
4783 (70 t 5 14 0)
4784 (72 nil 9 8 1)
4785 (81 nil 9 9 0)
4786 (90 nil 10 9 1)
4787 (100 nil 10 10 0))
4788 (letter-small
4789 (1 nil 1 1 0)
8e234846 4790 (2 t 1 2 0) ; adjusted by PostScript code
bc0d41bd
KH
4791 (4 nil 2 2 0)
4792 (6 t 2 3 0)
4793 (9 nil 3 3 0)
4794 (12 t 3 4 1)
4795 (15 t 3 5 0)
4796 (16 nil 4 4 0)
4797 (20 nil 5 4 1)
4798 (25 nil 5 5 0)
4799 (28 t 4 7 0)
4800 (30 nil 6 5 1)
4801 (36 nil 6 6 0)
4802 (40 t 5 8 0)
4803 (42 nil 7 6 1)
4804 (49 nil 7 7 0)
4805 (56 nil 8 7 1)
4806 (60 t 6 10 0)
4807 (64 nil 8 8 0)
4808 (72 ni 9 8 1)
4809 (81 nil 9 9 0)
4810 (84 t 7 12 0)
4811 (90 nil 10 9 1)
4812 (100 nil 10 10 0))
4813 (tabloid
4814 (1 nil 1 1 0)
4815 (2 t 1 2 0)
4816 (4 nil 2 2 0)
4817 (6 t 2 3 1)
4818 (8 t 2 4 0)
4819 (9 nil 3 3 0)
4820 (12 nil 4 3 1)
4821 (16 nil 4 4 0)
4822 (20 nil 5 4 1)
4823 (25 nil 5 5 0)
4824 (30 nil 6 5 1)
4825 (36 nil 6 6 0)
4826 (42 nil 7 6 1)
4827 (49 nil 7 7 0)
4828 (56 nil 8 7 1)
4829 (64 nil 8 8 0)
4830 (72 nil 9 8 1)
4831 (81 nil 9 9 0)
4832 (84 t 6 14 0)
4833 (90 nil 10 9 1)
4834 (100 nil 10 10 0))
4835 ;; Ledger paper size is a special case, it is the only paper size where the
4836 ;; normal size is landscaped, that is, the height is smaller than width.
4837 ;; So, we use the special value `pag' in the `landscape' field.
4838 (ledger
4839 (1 nil 1 1 0)
4840 (2 pag 1 2 0)
4841 (4 nil 2 2 0)
4842 (6 pag 2 3 1)
4843 (8 pag 2 4 0)
4844 (9 nil 3 3 0)
4845 (12 nil 4 3 1)
4846 (16 nil 4 4 0)
4847 (20 nil 5 4 1)
4848 (25 nil 5 5 0)
4849 (30 nil 6 5 1)
4850 (36 nil 6 6 0)
4851 (42 nil 7 6 1)
4852 (49 nil 7 7 0)
4853 (56 nil 8 7 1)
4854 (64 nil 8 8 0)
4855 (72 nil 9 8 1)
4856 (81 nil 9 9 0)
4857 (84 pag 6 14 0)
4858 (90 nil 10 9 1)
4859 (100 nil 10 10 0))
4860 (statement
4861 (1 nil 1 1 0)
4862 (2 t 1 2 0)
4863 (4 nil 2 2 0)
4864 (6 nil 3 2 1)
4865 (9 nil 3 3 0)
4866 (10 t 2 5 0)
4867 (12 nil 4 3 1)
4868 (16 nil 4 4 0)
4869 (20 nil 5 4 1)
4870 (21 t 3 7 0)
4871 (25 nil 5 5 0)
4872 (30 nil 6 5 1)
4873 (36 nil 6 6 0)
4874 (40 t 4 10 0)
4875 (42 nil 7 6 1)
4876 (49 nil 7 7 0)
4877 (56 nil 8 7 1)
4878 (60 t 5 12 0)
4879 (64 nil 8 8 0)
4880 (72 nil 9 8 1)
4881 (81 nil 9 9 0)
4882 (90 nil 10 9 1)
4883 (100 nil 10 10 0))
4884 (executive
4885 (1 nil 1 1 0)
8e234846 4886 (2 t 1 2 0) ; adjusted by PostScript code
bc0d41bd
KH
4887 (4 nil 2 2 0)
4888 (6 t 2 3 0)
4889 (9 nil 3 3 0)
4890 (12 nil 4 3 1)
4891 (16 nil 4 4 0)
4892 (20 nil 5 4 1)
4893 (25 nil 5 5 0)
4894 (28 t 4 7 0)
4895 (30 nil 6 5 1)
4896 (36 nil 6 6 0)
4897 (42 nil 7 6 1)
4898 (45 t 5 9 0)
4899 (49 nil 7 7 0)
4900 (56 nil 8 7 1)
4901 (60 t 6 10 0)
4902 (64 nil 8 8 0)
4903 (72 nil 9 8 1)
4904 (81 nil 9 9 0)
4905 (84 t 7 12 0)
4906 (90 nil 10 9 1)
4907 (100 nil 10 10 0))
4908 (a4small
4909 (1 nil 1 1 0)
4910 (2 t 1 2 0)
4911 (4 nil 2 2 0)
4912 (6 t 2 3 1)
4913 (8 t 2 4 0)
4914 (9 nil 3 3 0)
4915 (12 nil 4 3 1)
4916 (16 nil 4 4 0)
4917 (18 t 3 6 0)
4918 (20 nil 5 4 1)
4919 (25 nil 5 5 0)
4920 (30 nil 6 5 1)
4921 (32 t 4 8 0)
4922 (36 nil 6 6 0)
4923 (42 nil 7 6 1)
4924 (49 nil 7 7 0)
4925 (50 t 5 10 0)
4926 (56 nil 8 7 1)
4927 (64 nil 8 8 0)
4928 (72 nil 9 8 1)
4929 (78 t 6 13 0)
4930 (81 nil 9 9 0)
4931 (90 nil 10 9 1)
4932 (100 nil 10 10 0))
4933 (b4
4934 (1 nil 1 1 0)
4935 (2 t 1 2 0)
4936 (4 nil 2 2 0)
4937 (6 t 2 3 1)
4938 (8 t 2 4 0)
4939 (9 nil 3 3 0)
4940 (12 nil 4 3 1)
4941 (16 nil 4 4 0)
4942 (18 t 3 6 0)
4943 (20 nil 5 4 1)
4944 (25 nil 5 5 0)
4945 (30 nil 6 5 1)
4946 (32 t 4 8 0)
4947 (36 nil 6 6 0)
4948 (42 nil 7 6 1)
4949 (49 nil 7 7 0)
4950 (50 t 5 10 0)
4951 (56 nil 8 7 1)
4952 (64 nil 8 8 0)
4953 (72 nil 9 8 1)
4954 (81 nil 9 9 0)
4955 (90 nil 10 9 1)
4956 (100 nil 10 10 0))
4957 (b5
4958 (1 nil 1 1 0)
4959 (2 t 1 2 0)
4960 (4 nil 2 2 0)
4961 (6 t 2 3 1)
4962 (8 t 2 4 0)
4963 (9 nil 3 3 0)
4964 (12 nil 4 3 1)
4965 (16 nil 4 4 0)
4966 (18 t 3 6 0)
4967 (20 nil 5 4 1)
4968 (25 nil 5 5 0)
4969 (30 nil 6 5 1)
4970 (32 t 4 8 0)
4971 (36 nil 6 6 0)
4972 (42 nil 7 6 1)
4973 (49 nil 7 7 0)
4974 (50 t 5 10 0)
4975 (56 nil 8 7 1)
4976 (64 nil 8 8 0)
4977 (72 nil 9 8 0)
4978 (81 nil 9 9 0)
4979 (90 nil 10 9 1)
4980 (98 t 7 14 0)
4981 (100 nil 10 10 0)))
4982 "Alist which is the page matrix database used for N-up printing.
4983
4984Each element has the following form:
4985
4986 (PAGE
4987 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
4988 ...)
4989
4990Where:
4991PAGE is the page size used (see `ps-paper-type').
4992MAX is the maximum elements of this page matrix.
4993LANDSCAPE specifies if page matrix is landscaped, has the following valid
4994 values:
4995 nil the sheet is in portrait mode.
4996 t the sheet is in landscape mode.
4997 pag the sheet is in portrait mode and page is in landscape mode.
4998LINES is the number of lines of page matrix.
4999COLUMNS is the number of columns of page matrix.
5000COL-MISSING is the number of columns missing to fill the sheet.")
5001
5002
5003(defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
5004(defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
5005(defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
5006(defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
5007
5008
5009(defun ps-n-up-printing ()
5010 ;; force `ps-n-up-printing' be in range 1 to 100.
5011 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
5012 ;; find suitable page matrix for a given `ps-paper-type'.
5013 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
5014 (and the-list
5015 (while (> ps-n-up-printing (caar the-list))
5016 (setq the-list (cdr the-list))))
5017 (car the-list)))
5018
5019
5020(defconst ps-n-up-filling-database
5021 '((left-top
5022 "PageWidth" ; N-Up-XColumn
5023 "0" ; N-Up-YColumn
5024 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5025 "LandscapePageHeight neg" ; N-Up-YLine
5026 "N-Up-Lines" ; N-Up-Repeat
5027 "N-Up-Columns" ; N-Up-End
5028 "0" ; N-Up-XStart
5029 "0") ; N-Up-YStart
5030 (left-bottom
5031 "PageWidth" ; N-Up-XColumn
5032 "0" ; N-Up-YColumn
5033 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5034 "LandscapePageHeight" ; N-Up-YLine
5035 "N-Up-Lines" ; N-Up-Repeat
5036 "N-Up-Columns" ; N-Up-End
5037 "0" ; N-Up-XStart
5038 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5039 (right-top
5040 "PageWidth neg" ; N-Up-XColumn
5041 "0" ; N-Up-YColumn
5042 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5043 "LandscapePageHeight neg" ; N-Up-YLine
5044 "N-Up-Lines" ; N-Up-Repeat
5045 "N-Up-Columns" ; N-Up-End
5046 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5047 "0") ; N-Up-YStart
5048 (right-bottom
5049 "PageWidth neg" ; N-Up-XColumn
5050 "0" ; N-Up-YColumn
5051 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5052 "LandscapePageHeight" ; N-Up-YLine
5053 "N-Up-Lines" ; N-Up-Repeat
5054 "N-Up-Columns" ; N-Up-End
5055 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5056 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5057 (top-left
5058 "0" ; N-Up-XColumn
5059 "LandscapePageHeight neg" ; N-Up-YColumn
5060 "PageWidth" ; N-Up-XLine
5061 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5062 "N-Up-Columns" ; N-Up-Repeat
5063 "N-Up-Lines" ; N-Up-End
5064 "0" ; N-Up-XStart
5065 "0") ; N-Up-YStart
5066 (bottom-left
5067 "0" ; N-Up-XColumn
5068 "LandscapePageHeight" ; N-Up-YColumn
5069 "PageWidth" ; N-Up-XLine
5070 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5071 "N-Up-Columns" ; N-Up-Repeat
5072 "N-Up-Lines" ; N-Up-End
5073 "0" ; N-Up-XStart
5074 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5075 (top-right
5076 "0" ; N-Up-XColumn
5077 "LandscapePageHeight neg" ; N-Up-YColumn
5078 "PageWidth neg" ; N-Up-XLine
5079 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5080 "N-Up-Columns" ; N-Up-Repeat
5081 "N-Up-Lines" ; N-Up-End
5082 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5083 "0") ; N-Up-YStart
5084 (bottom-right
5085 "0" ; N-Up-XColumn
5086 "LandscapePageHeight" ; N-Up-YColumn
5087 "PageWidth neg" ; N-Up-XLine
5088 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5089 "N-Up-Columns" ; N-Up-Repeat
5090 "N-Up-Lines" ; N-Up-End
5091 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5092 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
5093 "Alist for n-up printing initializations.
5094
5095Each element has the following form:
5096
5097 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5098
5099Where:
5100KIND is a valid value of `ps-n-up-filling'.
5101XCOL YCOL are the relative position for the next column.
5102XLIN YLIN are the relative position for the beginning of next line.
5103REPEAT is the number of repetions for external loop.
5104END is the number of repetions for internal loop and also the number of pages in
5105 a row.
5106XSTART YSTART are the relative position for the first page in a sheet.")
5107
5108
5109(defun ps-n-up-filling ()
5110 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
5111 (assq 'left-top ps-n-up-filling-database))))
5112
5113
5114(defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
5115(defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
5116(defmacro ps-n-up-xline (init) `(nth 2 ,init))
5117(defmacro ps-n-up-yline (init) `(nth 3 ,init))
5118(defmacro ps-n-up-repeat (init) `(nth 4 ,init))
5119(defmacro ps-n-up-end (init) `(nth 5 ,init))
5120(defmacro ps-n-up-xstart (init) `(nth 6 ,init))
5121(defmacro ps-n-up-ystart (init) `(nth 7 ,init))
5122
5123
66e63857
GM
5124(defconst ps-error-handler-alist
5125 '((none . 0)
5126 (paper . 1)
5127 (system . 2)
5128 (paper-and-system . 3))
2bd80d73
GM
5129 "Alist for error handler message.")
5130
5131
5132(defconst ps-zebra-stripe-alist
5133 '((follow . 1)
5134 (full . 2)
5135 (full-follow . 3))
5136 "Alist for zebra stripe continuation.")
66e63857
GM
5137
5138
ef2cbb24 5139(defun ps-begin-file ()
7bb054a5 5140 (setq ps-page-order 0
4b3eb10f 5141 ps-page-printed 0
87a16a06
RS
5142 ps-background-text-count 0
5143 ps-background-image-count 0
5144 ps-background-pages nil
5145 ps-background-all-pages nil)
12d89a2e 5146
bc0d41bd
KH
5147 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
5148 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
5149 (n-up (ps-n-up-printing))
5150 (n-up-filling (ps-n-up-filling)))
98f2fbe7 5151 (and ps-n-up-on (setq tumble (not tumble)))
bc0d41bd
KH
5152 (ps-output
5153 ps-adobe-tag
5154 "%%Title: " (buffer-name) ; Take job name from name of
8bd22fcf 5155 ; first buffer printed
bc0d41bd
KH
5156 "\n%%Creator: " (user-full-name)
5157 " (using ps-print v" ps-print-version
2bd80d73 5158 ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
bc0d41bd
KH
5159 "\n%%Orientation: "
5160 (if ps-landscape-mode "Landscape" "Portrait")
5161 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
5162 (mapconcat 'identity
5163 (ps-remove-duplicates
5164 (append (ps-fonts 'ps-font-for-text)
5165 (list (ps-font 'ps-font-for-header 'normal)
5166 (ps-font 'ps-font-for-header 'bold))))
5167 "\n%%+ font ")
5168 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
5169 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
5170 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
5171 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
5172 (if ps-spool-duplex
8e234846 5173 (if tumble " duplex(tumble)\n" " duplex\n")
bc0d41bd
KH
5174 "\n"))
5175
66e63857 5176 (ps-insert-string ps-print-prologue-header)
bc0d41bd 5177
8e234846
GM
5178 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5179 (ps-page-dimensions-get-media dimensions)
6bf5fb46 5180 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
6e1b1da6
GM
5181 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5182 (format "/ErrorMessage %s def\n\n"
66e63857
GM
5183 (or (cdr (assoc ps-error-handler-message
5184 ps-error-handler-alist))
5185 1)) ; send to paper
5186 ps-print-prologue-0
5187 "\n%%BeginProcSet: UserDefinedPrologue\n\n")
5188
5189 (ps-insert-string ps-user-defined-prologue)
5190
5191 (ps-output "\n%%EndProcSet\n\n")
bc0d41bd 5192
bc0d41bd
KH
5193 (ps-output-boolean "LandscapeMode "
5194 (or ps-landscape-mode
5195 (eq (ps-n-up-landscape n-up) 'pag)))
906d41a7 5196 (ps-output-boolean "UpsideDown " ps-print-upside-down)
bc0d41bd
KH
5197 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
5198
5199 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
5200 (format "/PrintPageWidth %s def\n"
5201 (- (* (+ ps-print-width ps-inter-column)
5202 ps-number-of-columns)
5203 ps-inter-column))
5204 (format "/PrintWidth %s def\n" ps-print-width)
5205 (format "/PrintHeight %s def\n" ps-print-height)
5206
5207 (format "/LeftMargin %s def\n" ps-left-margin)
5208 (format "/RightMargin %s def\n" ps-right-margin)
5209 (format "/InterColumn %s def\n" ps-inter-column)
5210
5211 (format "/BottomMargin %s def\n" ps-bottom-margin)
5212 (format "/TopMargin %s def\n" ps-top-margin) ; not used
5213 (format "/HeaderOffset %s def\n" ps-header-offset)
319acba0
GM
5214 (format "/HeaderPad %s def\n" ps-header-pad)
5215 (format "/FooterOffset %s def\n" ps-footer-offset)
5216 (format "/FooterPad %s def\n" ps-footer-pad)
5217 (format "/FooterLines %s def\n" ps-footer-lines))
bc0d41bd 5218
319acba0 5219 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
8e234846
GM
5220 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
5221 ps-spool-duplex
5222 ps-switch-header))
319acba0
GM
5223 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
5224 (ps-output-boolean "PrintHeader " ps-print-header)
5225 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
5226 (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist)
5227 (ps-output-boolean "PrintFooter " ps-print-footer)
5228 (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame)
5229 (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist)
bc0d41bd
KH
5230
5231 (let ((line-height (ps-line-height 'ps-font-for-text)))
6bf5fb46
GM
5232 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
5233 (format "/ParagraphSpacing %s def\n"
5234 ps-paragraph-spacing-internal)
5235 (format "/LineHeight %s def\n" line-height)
2bd80d73 5236 (format "/LinesPerColumn %d def\n"
6bf5fb46
GM
5237 (let ((height (+ line-height
5238 ps-line-spacing-internal)))
5239 (round (/ (+ ps-print-height
5240 (* height 0.45))
5241 height))))))
bc0d41bd 5242
8e234846 5243 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
bc0d41bd
KH
5244 (ps-output-boolean "Zebra " ps-zebra-stripes)
5245 (ps-output-boolean "PrintLineNumber " ps-line-number)
906d41a7 5246 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
2bd80d73
GM
5247 (ps-output (format "/ZebraFollow %d def\n"
5248 (or (cdr (assq ps-zebra-stripe-follow
5249 ps-zebra-stripe-alist))
5250 0))
5251 (format "/PrintLineStep %d def\n"
906d41a7
GM
5252 (if (integerp ps-line-number-step)
5253 ps-line-number-step
98f2fbe7
GM
5254 ps-zebra-stripe-height))
5255 (format "/PrintLineStart %d def\n" ps-line-number-start)
319acba0
GM
5256 "/LineNumberColor "
5257 (ps-format-color ps-line-number-color 0.0)
5258 (format "def\n/ZebraHeight %d def\n"
5259 ps-zebra-stripe-height)
6e1b1da6
GM
5260 "/ZebraColor "
5261 (ps-format-color ps-zebra-color 0.95)
5262 "def\n/BackgroundColor "
5263 (ps-format-color ps-default-bg 1.0)
5264 "def\n/UseSetpagedevice "
bc0d41bd 5265 (if (eq ps-spool-config 'setpagedevice)
6e1b1da6
GM
5266 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5267 "false")
5268 " def\n\n/PageWidth "
bc0d41bd
KH
5269 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
5270 (format "/N-Up %d def\n" ps-n-up-printing))
5271 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
5272 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
5273 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
5274 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
5275 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
6e1b1da6
GM
5276 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
5277 "/N-Up-Repeat "
bc0d41bd
KH
5278 (if ps-landscape-mode
5279 (ps-n-up-end n-up-filling)
5280 (ps-n-up-repeat n-up-filling))
5281 " def\n/N-Up-End "
5282 (if ps-landscape-mode
5283 (ps-n-up-repeat n-up-filling)
5284 (ps-n-up-end n-up-filling))
5285 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
5286 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
5287 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
5288 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
5289 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
5290 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
5291
5292 (ps-background-text)
5293 (ps-background-image)
5294 (setq ps-background-all-pages (nreverse ps-background-all-pages)
5295 ps-background-pages (nreverse ps-background-pages))
5296
41481e4b 5297 (ps-output "\n" ps-print-prologue-1)
bc0d41bd 5298
c3d6d211 5299 (ps-output "\n/printGlobalBackground{\n")
7bb054a5 5300 (mapcar 'ps-output ps-background-all-pages)
c3d6d211 5301 (ps-output "}def\n/printLocalBackground{\n}def\n")
bc0d41bd 5302
ef1159c2
EZ
5303 ;; Header/line number fonts
5304 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
bc0d41bd
KH
5305 ps-header-title-font-size-internal
5306 (ps-font 'ps-font-for-header 'bold))
ef1159c2 5307 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
bc0d41bd 5308 ps-header-font-size-internal
ef1159c2
EZ
5309 (ps-font 'ps-font-for-header 'normal))
5310 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
5311 (ps-get-font-size 'ps-line-number-font-size)
319acba0
GM
5312 ps-line-number-font)
5313 (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
5314 ps-footer-font-size-internal
5315 (ps-font 'ps-font-for-footer 'normal))
5316 "\n\n% ---- These lines must be kept together because...
6bf5fb46
GM
5317
5318/h0 F
5319/HeaderTitleLineHeight FontHeight def
5320
5321/h1 F
5322/HeaderLineHeight FontHeight def
5323/HeaderDescent Descent def
5324
319acba0
GM
5325/H0 F
5326/FooterLineHeight FontHeight def
5327/FooterDescent Descent def
5328
6bf5fb46 5329% ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
bc0d41bd
KH
5330
5331 ;; Text fonts
5332 (let ((font (ps-font-alist 'ps-font-for-text))
5333 (i 0))
5334 (while font
c3d6d211 5335 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
bc0d41bd
KH
5336 i
5337 ps-font-size-internal
5338 (ps-font 'ps-font-for-text (car (car font)))))
5339 (setq font (cdr font)
5340 i (1+ i))))
5341
5342 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
5343 (ps-output (format "/SpaceWidthRatio %f def\n"
5344 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
5345
6bf5fb46 5346 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
bc0d41bd
KH
5347 (unless (eq ps-spool-config 'lpr-switches)
5348 (ps-output "\n%%BeginFeature: *Duplex "
5349 (ps-boolean-capitalized ps-spool-duplex)
5350 " *Tumble "
5351 (ps-boolean-capitalized tumble)
c3d6d211
GM
5352 "\nUseSetpagedevice\n{BMark/Duplex "
5353 (ps-boolean-constant ps-spool-duplex)
5354 "/Tumble "
5355 (ps-boolean-constant tumble)
5356 " EMark setpagedevice}\n{statusdict begin "
5357 (ps-boolean-constant ps-spool-duplex)
5358 " setduplexmode "
5359 (ps-boolean-constant tumble)
5360 " settumble end}ifelse\n%%EndFeature\n")))
8e234846
GM
5361 (ps-output "\n%%BeginFeature: *ManualFeed "
5362 (ps-boolean-capitalized ps-manual-feed)
5363 "\nBMark /ManualFeed "
5364 (ps-boolean-constant ps-manual-feed)
ef1159c2 5365 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
47d2ac75 5366 (and ps-banner-page-when-duplexing
98f2fbe7 5367 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
bc0d41bd
KH
5368
5369
6e1b1da6
GM
5370(defun ps-format-color (color &optional default)
5371 (let ((the-color (if (stringp color)
5372 (ps-color-scale color)
5373 color)))
5374 (if (and the-color (listp the-color))
5375 (concat "["
5376 (format ps-color-format
efa89c1f
GM
5377 (* (nth 0 the-color) 1.0) ; force float number
5378 (* (nth 1 the-color) 1.0) ; force float number
5379 (* (nth 2 the-color) 1.0)) ; force float number
6e1b1da6
GM
5380 "] ")
5381 (ps-float-format (if (numberp the-color) the-color default)))))
5382
5383
66e63857
GM
5384(defun ps-insert-string (prologue)
5385 (let ((str (if (functionp prologue)
5386 (funcall prologue)
5387 prologue)))
5388 (and (stringp str)
5389 (ps-output str))))
5390
5391
bc0d41bd
KH
5392(defun ps-boolean-capitalized (bool)
5393 (if bool "True" "False"))
5394
ef2cbb24 5395
8e234846
GM
5396(defun ps-boolean-constant (bool)
5397 (if bool "true" "false"))
5398
5399
12d89a2e
RS
5400(defun ps-header-dirpart ()
5401 (let ((fname (buffer-file-name)))
5402 (if fname
5403 (if (string-equal (buffer-name) (file-name-nondirectory fname))
68e684a0 5404 (abbreviate-file-name (file-name-directory fname))
12d89a2e
RS
5405 fname)
5406 "")))
ef2cbb24 5407
bc0d41bd 5408
12d89a2e 5409(defun ps-get-buffer-name ()
bcc0d457
RS
5410 (cond
5411 ;; Indulge Jim this little easter egg:
5412 ((string= (buffer-name) "ps-print.el")
5413 "Hey, Cool! It's ps-print.el!!!")
5414 ;; Indulge Jack this other little easter egg:
5415 ((string= (buffer-name) "sokoban.el")
5416 "Super! C'est sokoban.el!")
87a16a06 5417 (t (concat
bc0d41bd 5418 (and ps-printing-region-p "Subset of: ")
87a16a06
RS
5419 (buffer-name)
5420 (and (buffer-modified-p) " (unsaved)")))))
ef2cbb24 5421
7d8b7e8e 5422
6bf5fb46
GM
5423(defun ps-get-size (size mess &optional arg)
5424 (let ((siz (cond ((numberp size)
5425 size)
5426 ((and (consp size)
5427 (numberp (car size))
5428 (numberp (cdr size)))
5429 (if ps-landscape-mode
5430 (car size)
5431 (cdr size)))
5432 (t
5433 -1))))
5434 (and (< siz 0)
5435 (error "Invalid %s `%S'%s"
5436 mess size
5437 (if arg
5438 (format " for `%S'" arg)
5439 "")))
5440 siz))
5441
5442
7d8b7e8e 5443(defun ps-get-font-size (font-sym)
6bf5fb46 5444 (ps-get-size (symbol-value font-sym) "font size" font-sym))
7d8b7e8e
KH
5445
5446
319acba0
GM
5447(defsubst ps-rgb-color (color default)
5448 (cond ((and color (listp color)) color)
5449 ((stringp color) (ps-color-scale color))
5450 ((numberp color) (list color color color))
5451 (t (list default default default))
5452 ))
5453
5454
12d89a2e 5455(defun ps-begin-job ()
1fd9b7fe 5456 ;; prologue files
41481e4b 5457 (or (equal ps-mark-code-directory ps-postscript-code-directory)
c3d6d211
GM
5458 (setq ps-print-prologue-0 (ps-prologue-file 0)
5459 ps-print-prologue-1 (ps-prologue-file 1)
c3d6d211 5460 ps-mark-code-directory ps-postscript-code-directory))
1fd9b7fe
GM
5461 ;; selected pages
5462 (let (new page)
5463 (while ps-selected-pages
5464 (setq page (car ps-selected-pages)
5465 ps-selected-pages (cdr ps-selected-pages))
5466 (cond ((integerp page)
5467 (and (> page 0)
5468 (setq new (cons (cons page page) new))))
5469 ((consp page)
5470 (and (integerp (car page)) (integerp (cdr page))
5471 (> (car page) 0)
5472 (<= (car page) (cdr page))
5473 (setq new (cons page new))))))
5474 (setq ps-selected-pages (sort new #'(lambda (one other)
5475 (< (car one) (car other))))
5476 ps-last-selected-pages ps-selected-pages
5477 ps-first-page nil
5478 ps-last-page nil))
5479 ;; face background
906d41a7
GM
5480 (or (listp ps-use-face-background)
5481 (setq ps-use-face-background t))
1fd9b7fe 5482 ;; line number
906d41a7
GM
5483 (and (integerp ps-line-number-step)
5484 (<= ps-line-number-step 0)
5485 (setq ps-line-number-step 1))
98f2fbe7
GM
5486 (setq ps-n-up-on (> ps-n-up-printing 1)
5487 ps-line-number-start (max 1 (min ps-line-number-start
5488 (if (integerp ps-line-number-step)
5489 ps-line-number-step
5490 ps-zebra-stripe-height))))
1fd9b7fe 5491 ;; spooling buffer
7da17ab6
RS
5492 (save-excursion
5493 (set-buffer ps-spool-buffer)
5494 (goto-char (point-max))
5495 (and (re-search-backward "^%%Trailer$" nil t)
5496 (delete-region (match-beginning 0) (point-max))))
1fd9b7fe 5497 ;; miscellaneous
2bd80d73
GM
5498 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5499 '(full full-follow))
5500 ps-page-postscript 0
7bb054a5
GM
5501 ps-page-sheet 0
5502 ps-page-n-up 0
4b3eb10f 5503 ps-page-column 0
bd7a2e26 5504 ps-lines-printed 0
7bb054a5
GM
5505 ps-print-page-p t
5506 ps-showline-count (car ps-printing-region)
6bf5fb46
GM
5507 ps-line-spacing-internal (ps-get-size ps-line-spacing
5508 "line spacing")
5509 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
5510 "paragraph spacing")
7d8b7e8e
KH
5511 ps-font-size-internal (ps-get-font-size 'ps-font-size)
5512 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
5513 ps-header-title-font-size-internal
5514 (ps-get-font-size 'ps-header-title-font-size)
319acba0 5515 ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
857686a6 5516 ps-control-or-escape-regexp
298bfad9
KH
5517 (cond ((eq ps-print-control-characters '8-bit)
5518 (string-as-unibyte "[\000-\037\177-\377]"))
5519 ((eq ps-print-control-characters 'control-8-bit)
5520 (string-as-unibyte "[\000-\037\177-\237]"))
5521 ((eq ps-print-control-characters 'control)
5522 "[\000-\037\177]")
6e1b1da6
GM
5523 (t "[\t\n\f]"))
5524 ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
5525 ps-default-color (and ps-print-color-p ps-default-foreground)
5526 ps-current-color ps-default-color
5527 ;; Set the color scale. We do it here instead of in the defvar so
5528 ;; that ps-print can be dumped into emacs. This expression can't be
5529 ;; evaluated at dump-time because X isn't initialized.
5530 ps-color-p (and ps-print-color-p (ps-color-device))
5531 ps-print-color-scale (if ps-color-p
5532 (float (car (ps-color-values "white")))
319acba0
GM
5533 1.0))
5534 ;; initialize page dimensions
5535 (ps-get-page-dimensions))
6e1b1da6 5536
ef2cbb24 5537
ea0c615d
GM
5538(defun ps-page-number ()
5539 (if ps-print-only-one-header
4b3eb10f
GM
5540 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5541 ps-page-column))
87a16a06
RS
5542
5543
319acba0
GM
5544(defsubst ps-end-page ()
5545 (ps-output "EndPage\nEndDSCPage\n"))
5546
5547
5548(defsubst ps-next-page ()
ef2cbb24 5549 (ps-end-page)
12d89a2e
RS
5550 (ps-flush-output)
5551 (ps-begin-page))
5552
bc0d41bd
KH
5553
5554(defun ps-header-sheet ()
5555 ;; Print only when a new sheet begins.
4b3eb10f 5556 (and ps-print-page-p (> ps-page-sheet 0)
ea0c615d 5557 (ps-output "EndSheet\n"))
4b3eb10f
GM
5558 (setq ps-page-sheet (1+ ps-page-sheet))
5559 (when (ps-print-sheet-p)
5560 (setq ps-page-order (1+ ps-page-order))
5561 (ps-output (if ps-n-up-on
5562 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5563 ps-page-order ps-page-postscript ps-page-order)
5564 (format "\n%%%%Page: %d %d\n"
5565 ps-page-postscript ps-page-order))
ef1159c2
EZ
5566 ;; spooling needs to redefine Lines and PageCount on each page
5567 "/Lines 0 def\n/PageCount 0 def\n"
4b3eb10f
GM
5568 (format "%d BeginSheet\nBeginDSCPage\n"
5569 ps-n-up-printing))))
ea0c615d
GM
5570
5571
5572(defun ps-header-page ()
7da17ab6
RS
5573 ;; set total line and page number when printing has finished
5574 ;; (see `ps-generate')
4b3eb10f 5575 (if (zerop (mod ps-page-column ps-number-of-columns))
ea0c615d
GM
5576 (progn
5577 (setq ps-page-postscript (1+ ps-page-postscript))
5578 (when (ps-print-page-p)
4b3eb10f 5579 (ps-print-sheet-p)
ea0c615d
GM
5580 (if (zerop (mod ps-page-n-up ps-n-up-printing))
5581 ;; Print only when a new sheet begins.
5582 (progn
5583 (ps-header-sheet)
5584 (run-hooks 'ps-print-begin-sheet-hook))
5585 ;; Print only when a new page begins.
5586 (ps-output "BeginDSCPage\n")
5587 (run-hooks 'ps-print-begin-page-hook))
5588 (ps-background ps-page-postscript)
4b3eb10f
GM
5589 (setq ps-page-n-up (1+ ps-page-n-up))
5590 (and ps-print-page-p
5591 (setq ps-page-printed (1+ ps-page-printed)))))
ea0c615d
GM
5592 ;; Print only when a new column begins.
5593 (ps-output "BeginDSCPage\n")
5594 (run-hooks 'ps-print-begin-column-hook))
4b3eb10f 5595 (setq ps-page-column (1+ ps-page-column)))
a18ed129 5596
8bd22fcf 5597(defun ps-begin-page ()
8bd22fcf 5598 (setq ps-width-remaining ps-print-width
298bfad9 5599 ps-height-remaining ps-print-height)
12d89a2e 5600
a18ed129 5601 (ps-header-page)
12d89a2e 5602
87a16a06 5603 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
ea0c615d 5604 (format "/PageNumber %d def\n" (ps-page-number)))
12d89a2e 5605
090be653 5606 (when ps-print-header
319acba0
GM
5607 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
5608 (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
090be653 5609 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
12d89a2e 5610
319acba0
GM
5611 (when ps-print-footer
5612 (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
5613 (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
5614 (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
5615
bd7a2e26 5616 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
87a16a06
RS
5617 (ps-set-font ps-current-font)
5618 (ps-set-bg ps-current-bg)
298bfad9
KH
5619 (ps-set-color ps-current-color)
5620 (ps-mule-begin-page))
ef2cbb24 5621
319acba0 5622(defsubst ps-skip-newline (limit)
bd7a2e26
GM
5623 (setq ps-showline-count (1+ ps-showline-count)
5624 ps-lines-printed (1+ ps-lines-printed))
5625 (and (< (point) limit)
5626 (forward-char 1)))
5627
6bf5fb46 5628(defsubst ps-next-line ()
bd7a2e26
GM
5629 (setq ps-showline-count (1+ ps-showline-count)
5630 ps-lines-printed (1+ ps-lines-printed))
6bf5fb46
GM
5631 (let* ((paragraph-p (and ps-paragraph-regexp
5632 (looking-at ps-paragraph-regexp)))
5633 (lh (+ (ps-line-height 'ps-font-for-text)
5634 (if paragraph-p
5635 ps-paragraph-spacing-internal
5636 ps-line-spacing-internal))))
12b88fff
RS
5637 (if (< ps-height-remaining lh)
5638 (ps-next-page)
5639 (setq ps-width-remaining ps-print-width
5640 ps-height-remaining (- ps-height-remaining lh))
6bf5fb46 5641 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
ef2cbb24
RS
5642
5643(defun ps-continue-line ()
bd7a2e26 5644 (setq ps-lines-printed (1+ ps-lines-printed))
6bf5fb46 5645 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
12b88fff
RS
5646 (if (< ps-height-remaining lh)
5647 (ps-next-page)
5648 (setq ps-width-remaining ps-print-width
5649 ps-height-remaining (- ps-height-remaining lh))
5650 (ps-output "SL\n"))))
12d89a2e
RS
5651
5652(defun ps-find-wrappoint (from to char-width)
5653 (let ((avail (truncate (/ ps-width-remaining char-width)))
5654 (todo (- to from)))
5655 (if (< todo avail)
5656 (cons to (* todo char-width))
5657 (cons (+ from avail) ps-width-remaining))))
5658
c86f4619
GM
5659(defun ps-basic-plot-str (from to string)
5660 (let* ((wrappoint (ps-find-wrappoint from to
5661 (ps-avg-char-width 'ps-font-for-text)))
5662 (to (car wrappoint))
5663 (str (substring string from to)))
5664 (ps-mule-prepare-ascii-font str)
5665 (ps-output-string str)
5666 (ps-output " S\n")
5667 wrappoint))
5668
12d89a2e 5669(defun ps-basic-plot-string (from to &optional bg-color)
12b88fff
RS
5670 (let* ((wrappoint (ps-find-wrappoint from to
5671 (ps-avg-char-width 'ps-font-for-text)))
12d89a2e 5672 (to (car wrappoint))
298bfad9
KH
5673 (string (buffer-substring-no-properties from to)))
5674 (ps-mule-prepare-ascii-font string)
12d89a2e 5675 (ps-output-string string)
bcc0d457 5676 (ps-output " S\n")
12d89a2e
RS
5677 wrappoint))
5678
5679(defun ps-basic-plot-whitespace (from to &optional bg-color)
12b88fff
RS
5680 (let* ((wrappoint (ps-find-wrappoint from to
5681 (ps-space-width 'ps-font-for-text)))
12d89a2e 5682 (to (car wrappoint)))
12d89a2e
RS
5683 (ps-output (format "%d W\n" (- to from)))
5684 wrappoint))
5685
5686(defun ps-plot (plotfunc from to &optional bg-color)
ef2cbb24 5687 (while (< from to)
12d89a2e
RS
5688 (let* ((wrappoint (funcall plotfunc from to bg-color))
5689 (plotted-to (car wrappoint))
5690 (plotted-width (cdr wrappoint)))
8bd22fcf
KH
5691 (setq from plotted-to
5692 ps-width-remaining (- ps-width-remaining plotted-width))
12d89a2e
RS
5693 (if (< from to)
5694 (ps-continue-line))))
ef2cbb24
RS
5695 (if ps-razzle-dazzle
5696 (let* ((q-todo (- (point-max) (point-min)))
12d89a2e 5697 (q-done (- (point) (point-min)))
ef2cbb24 5698 (chunkfrac (/ q-todo 8))
857686a6 5699 (chunksize (min chunkfrac 1000)))
ef2cbb24 5700 (if (> (- q-done ps-razchunk) chunksize)
8bd22fcf 5701 (progn
ef2cbb24 5702 (setq ps-razchunk q-done)
8bd22fcf
KH
5703 (message "Formatting...%3d%%"
5704 (if (< q-todo 100)
5705 (/ (* 100 q-done) q-todo)
5706 (/ q-done (/ q-todo 100)))
5707 ))))))
12d89a2e 5708
298bfad9
KH
5709(defvar ps-last-font nil)
5710
12d89a2e 5711(defun ps-set-font (font)
e65df0a1
KH
5712 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
5713 (ps-output (format "/%s F\n" ps-last-font)))
12d89a2e 5714
12d89a2e
RS
5715(defun ps-set-bg (color)
5716 (if (setq ps-current-bg color)
8bd22fcf
KH
5717 (ps-output (format ps-color-format
5718 (nth 0 color) (nth 1 color) (nth 2 color))
12d89a2e
RS
5719 " true BG\n")
5720 (ps-output "false BG\n")))
5721
5722(defun ps-set-color (color)
6e1b1da6 5723 (setq ps-current-color (or color ps-default-foreground))
8bd22fcf
KH
5724 (ps-output (format ps-color-format
5725 (nth 0 ps-current-color)
043620f4
KH
5726 (nth 1 ps-current-color) (nth 2 ps-current-color))
5727 " FG\n"))
12d89a2e 5728
12d89a2e 5729
c86f4619
GM
5730(defsubst ps-plot-string (string)
5731 (ps-plot 'ps-basic-plot-str 0 (length string) string))
5732
5733
87a16a06 5734(defvar ps-current-effect 0)
12d89a2e 5735
87a16a06
RS
5736
5737(defun ps-plot-region (from to font &optional fg-color bg-color effects)
efa89c1f 5738 (or (equal font ps-current-font)
12d89a2e 5739 (ps-set-font font))
06fb6aab 5740
12d89a2e
RS
5741 ;; Specify a foreground color only if one's specified and it's
5742 ;; different than the current.
efa89c1f
GM
5743 (let ((fg (or fg-color ps-default-foreground)))
5744 (or (equal fg ps-current-color)
5745 (ps-set-color fg)))
06fb6aab 5746
efa89c1f 5747 (or (equal bg-color ps-current-bg)
12d89a2e 5748 (ps-set-bg bg-color))
06fb6aab 5749
87a16a06
RS
5750 ;; Specify effects (underline, overline, box, etc)
5751 (cond
5752 ((not (integerp effects))
5753 (ps-output "0 EF\n")
5754 (setq ps-current-effect 0))
5755 ((/= effects ps-current-effect)
5756 (ps-output (number-to-string effects) " EF\n")
5757 (setq ps-current-effect effects)))
ef2cbb24 5758
12d89a2e 5759 ;; Starting at the beginning of the specified region...
ef2cbb24
RS
5760 (save-excursion
5761 (goto-char from)
12d89a2e
RS
5762
5763 ;; ...break the region up into chunks separated by tabs, linefeeds,
87a16a06 5764 ;; pagefeeds, control characters, and plot each chunk.
ef2cbb24 5765 (while (< from to)
6bf5fb46
GM
5766 ;; skip lines between cut markers
5767 (and ps-begin-cut-regexp ps-end-cut-regexp
5768 (looking-at ps-begin-cut-regexp)
5769 (progn
5770 (goto-char (match-end 0))
5771 (and (re-search-forward ps-end-cut-regexp to 'noerror)
5772 (= (following-char) ?\n)
5773 (forward-char 1))
5774 (setq from (point))))
857686a6 5775 (if (re-search-forward ps-control-or-escape-regexp to t)
024ced4d 5776 ;; region with some control characters or some multi-byte characters
12b88fff 5777 (let* ((match-point (match-beginning 0))
ea0c615d 5778 (match (char-after match-point))
3e9cb08f 5779 (composition (ps-e-find-composition from (1+ match-point))))
9d4d60c1
KH
5780 (if composition
5781 (if (and (nth 2 composition)
5782 (<= (car composition) match-point))
5783 (progn
5784 (setq match-point (car composition)
5785 match 0)
5786 (goto-char (nth 1 composition)))
5787 (setq composition nil)))
e65df0a1 5788 (when (< from match-point)
298bfad9 5789 (ps-mule-set-ascii-font)
e65df0a1 5790 (ps-plot 'ps-basic-plot-string from match-point bg-color))
857686a6
RS
5791 (cond
5792 ((= match ?\t) ; tab
be415ea7 5793 (let ((linestart (line-beginning-position)))
857686a6
RS
5794 (forward-char -1)
5795 (setq from (+ linestart (current-column)))
e65df0a1 5796 (when (re-search-forward "[ \t]+" to t)
298bfad9 5797 (ps-mule-set-ascii-font)
e65df0a1
KH
5798 (ps-plot 'ps-basic-plot-whitespace
5799 from (+ linestart (current-column))
5800 bg-color))))
857686a6
RS
5801
5802 ((= match ?\n) ; newline
bd7a2e26
GM
5803 (if (looking-at "\f[^\n]")
5804 ;; \n\ftext\n ==>> next page, but keep line counting!!
5805 (progn
5806 (ps-skip-newline to)
5807 (ps-next-page))
5808 ;; \n\f\n ==>> it'll be handled by form feed
5809 ;; \ntext\n ==>> next line
5810 (ps-next-line)))
857686a6
RS
5811
5812 ((= match ?\f) ; form feed
12b88fff
RS
5813 ;; do not skip page if previous character is NEWLINE and
5814 ;; it is a beginning of page.
bd7a2e26
GM
5815 (unless (and (equal (char-after (1- match-point)) ?\n)
5816 (= ps-height-remaining ps-print-height))
5817 ;; \f\n ==>> skip \n, but keep line counting!!
5818 (and (equal (following-char) ?\n)
5819 (ps-skip-newline to))
5820 (ps-next-page)))
e65df0a1 5821
9d4d60c1
KH
5822 (composition ; a composite sequence
5823 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
5824
024ced4d 5825 ((> match 255) ; a multi-byte character
9d4d60c1 5826 (let* ((charset (char-charset match))
3e9cb08f 5827 (composition (ps-e-find-composition match-point to))
9d4d60c1 5828 (stop (if (nth 2 composition) (car composition) to)))
e65df0a1 5829 (or (eq charset 'composition)
9d4d60c1 5830 (while (and (< (point) stop) (eq (charset-after) charset))
298bfad9 5831 (forward-char 1)))
e65df0a1 5832 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
3556c6dd 5833 ; characters from ^@ to ^_ and
857686a6
RS
5834 (t ; characters from 127 to 255
5835 (ps-control-character match)))
87a16a06 5836 (setq from (point)))
024ced4d 5837 ;; region without control characters nor multi-byte characters
298bfad9 5838 (ps-mule-set-ascii-font)
87a16a06
RS
5839 (ps-plot 'ps-basic-plot-string from to bg-color)
5840 (setq from to)))))
5841
857686a6
RS
5842(defvar ps-string-control-codes
5843 (let ((table (make-vector 256 nil))
5844 (char ?\000))
5845 ;; control character
5846 (while (<= char ?\037)
5847 (aset table char (format "^%c" (+ char ?@)))
5848 (setq char (1+ char)))
5849 ;; printable character
5850 (while (< char ?\177)
5851 (aset table char (format "%c" char))
5852 (setq char (1+ char)))
5853 ;; DEL
5854 (aset table char "^?")
5855 ;; 8-bit character
5856 (while (<= (setq char (1+ char)) ?\377)
5857 (aset table char (format "\\%o" char)))
5858 table)
5859 "Vector used to map characters to a printable string.")
5860
5861(defun ps-control-character (char)
5862 (let* ((str (aref ps-string-control-codes char))
5863 (from (1- (point)))
87a16a06
RS
5864 (len (length str))
5865 (to (+ from len))
12b88fff
RS
5866 (char-width (ps-avg-char-width 'ps-font-for-text))
5867 (wrappoint (ps-find-wrappoint from to char-width)))
87a16a06
RS
5868 (if (< (car wrappoint) to)
5869 (ps-continue-line))
12b88fff 5870 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
36243805 5871 (ps-mule-prepare-ascii-font str)
87a16a06
RS
5872 (ps-output-string str)
5873 (ps-output " S\n")))
ef2cbb24 5874
87a16a06 5875
a18ed129
RS
5876(defun ps-face-attributes (face)
5877 "Return face attribute vector.
87a16a06 5878
a18ed129
RS
5879If FACE is not in `ps-print-face-extension-alist' or in
5880`ps-print-face-alist', insert it on `ps-print-face-alist' and
5881return the attribute vector.
87a16a06
RS
5882
5883If FACE is not a valid face name, it is used default face."
df5e6194
GM
5884 (cond
5885 ((symbolp face)
5886 (cdr (or (assq face ps-print-face-extension-alist)
5887 (assq face ps-print-face-alist)
5888 (let* ((the-face (if (facep face) face 'default))
5889 (new-face (ps-screen-to-bit-face the-face)))
5890 (or (and (eq the-face 'default)
5891 (assq the-face ps-print-face-alist))
5892 (setq ps-print-face-alist
5893 (cons new-face ps-print-face-alist)))
5894 new-face))))
5895 ((eq (car face) 'foreground-color)
5896 (vector 0 (cdr face) nil))
5897 ((eq (car face) 'background-color)
5898 (vector 0 nil (cdr face)))
5899 (t
5900 (vector 0 nil nil))))
87a16a06 5901
043620f4 5902
906d41a7
GM
5903(defun ps-face-background (face background)
5904 (and (or (eq ps-use-face-background t)
5905 (cond ((symbolp face)
5906 (memq face ps-use-face-background))
5907 ((listp face)
df5e6194
GM
5908 (or (memq (car face) '(foreground-color background-color))
5909 (let (ok)
5910 (while face
5911 (if (or (memq (car face) ps-use-face-background)
5912 (memq (car face)
5913 '(foreground-color background-color)))
5914 (setq face nil
5915 ok t)
5916 (setq face (cdr face))))
5917 ok)))
906d41a7
GM
5918 (t
5919 nil)
5920 ))
5921 background))
5922
5923
043620f4 5924(defun ps-face-attribute-list (face-or-list)
df5e6194
GM
5925 (cond
5926 ;; simple face
5927 ((not (listp face-or-list))
5928 (ps-face-attributes face-or-list))
5929 ;; only foreground color, not a `real' face
5930 ((eq (car face-or-list) 'foreground-color)
5931 (vector 0 (cdr face-or-list) nil))
5932 ;; only background color, not a `real' face
5933 ((eq (car face-or-list) 'background-color)
5934 (vector 0 nil (cdr face-or-list)))
5935 ;; list of faces
5936 (t
5937 (let ((effects 0)
5938 foreground background face-attr face)
5939 (while face-or-list
5940 (setq face (car face-or-list)
5941 face-or-list (cdr face-or-list)
5942 face-attr (ps-face-attributes face)
5943 effects (logior effects (aref face-attr 0)))
5944 (or foreground (setq foreground (aref face-attr 1)))
5945 (or background
5946 (setq background (ps-face-background face (aref face-attr 2)))))
5947 (vector effects foreground background)))))
043620f4 5948
87a16a06 5949
12b88fff
RS
5950(defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
5951
5952
12d89a2e 5953(defun ps-plot-with-face (from to face)
12b88fff
RS
5954 (cond
5955 ((null face) ; print text with null face
87a16a06 5956 (ps-plot-region from to 0))
12b88fff
RS
5957 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
5958 (t ; otherwise, text has a valid face
5959 (let* ((face-bit (ps-face-attribute-list face))
5960 (effect (aref face-bit 0))
5961 (foreground (aref face-bit 1))
906d41a7 5962 (background (ps-face-background face (aref face-bit 2)))
d3ab8dac 5963 (fg-color (if (and ps-color-p foreground)
6e1b1da6 5964 (ps-color-scale foreground)
12b88fff 5965 ps-default-color))
d3ab8dac 5966 (bg-color (and ps-color-p background
6e1b1da6 5967 (ps-color-scale background))))
12b88fff
RS
5968 (ps-plot-region
5969 from to
5970 (ps-font-number 'ps-font-for-text
5971 (or (aref ps-font-type (logand effect 3))
5972 face))
5973 fg-color bg-color (lsh effect -2)))))
87a16a06 5974 (goto-char to))
12d89a2e
RS
5975
5976
043620f4
KH
5977;; Ensure that face-list is fbound.
5978(or (fboundp 'face-list) (defalias 'face-list 'list-faces))
12d89a2e 5979
a18ed129 5980
12d89a2e 5981(defun ps-build-reference-face-lists ()
857686a6
RS
5982 ;; Ensure that face database is updated with faces on
5983 ;; `font-lock-face-attributes' (obsolete stuff)
5984 (ps-font-lock-face-attributes)
5985 ;; Now, rebuild reference face lists
a18ed129 5986 (setq ps-print-face-alist nil)
12d89a2e 5987 (if ps-auto-font-detect
a18ed129
RS
5988 (mapcar 'ps-map-face (face-list))
5989 (mapcar 'ps-set-face-bold ps-bold-faces)
5990 (mapcar 'ps-set-face-italic ps-italic-faces)
5991 (mapcar 'ps-set-face-underline ps-underlined-faces))
12d89a2e 5992 (setq ps-build-face-reference nil))
ef2cbb24 5993
a18ed129
RS
5994
5995(defun ps-set-face-bold (face)
5996 (ps-set-face-attribute face 1))
5997
5998(defun ps-set-face-italic (face)
5999 (ps-set-face-attribute face 2))
6000
6001(defun ps-set-face-underline (face)
6002 (ps-set-face-attribute face 4))
6003
6004
6005(defun ps-set-face-attribute (face effect)
6006 (let ((face-bit (cdr (ps-map-face face))))
6007 (aset face-bit 0 (logior (aref face-bit 0) effect))))
6008
6009
6010(defun ps-map-face (face)
6011 (let* ((face-map (ps-screen-to-bit-face face))
6012 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
6013 (if ps-face-bit
6014 ;; if face exists, merge both
6015 (let ((face-bit (cdr face-map)))
6016 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
6017 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
6018 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
6019 ;; if face does not exist, insert it
6020 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
6021 face-map))
6022
6023
6024(defun ps-screen-to-bit-face (face)
6025 (cons face
6026 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
6027 (if (ps-face-italic-p face) 2 0) ; italic
6028 (if (ps-face-underlined-p face) 4 0)) ; underline
8e234846
GM
6029 (ps-face-foreground-name face)
6030 (ps-face-background-name face))))
a18ed129
RS
6031
6032
3e9cb08f 6033;; to avoid compilation gripes
ea0c615d
GM
6034(defun ps-print-ensure-fontified (start end)
6035 (cond
6036 ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
6037 (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
6038 (ps-jitify start end))
6039 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
6040 (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
6041 (ps-lazify start end))))
043620f4 6042
043620f4 6043
ef2cbb24 6044(defun ps-generate-postscript-with-faces (from to)
87a16a06 6045 ;; Some initialization...
857686a6 6046 (setq ps-current-effect 0)
87a16a06 6047
00aa16af 6048 ;; Build the reference lists of faces if necessary.
8e234846
GM
6049 (when (or ps-always-build-face-reference
6050 ps-build-face-reference)
6051 (message "Collecting face information...")
6052 (ps-build-reference-face-lists))
00aa16af 6053 ;; Generate some PostScript.
ef2cbb24
RS
6054 (save-restriction
6055 (narrow-to-region from to)
d3ab8dac 6056 (ps-print-ensure-fontified from to)
12d89a2e
RS
6057 (let ((face 'default)
6058 (position to))
87a16a06 6059 (cond
8e234846 6060 ((memq ps-print-emacs-type '(xemacs lucid))
87a16a06
RS
6061 ;; Build the list of extents...
6062 (let ((a (cons 'dummy nil))
6063 record type extent extent-list)
3e9cb08f 6064 (ps-x-map-extents 'ps-mapper nil from to a)
8bd22fcf
KH
6065 (setq a (sort (cdr a) 'car-less-than-car)
6066 extent-list nil)
87a16a06
RS
6067
6068 ;; Loop through the extents...
6069 (while a
8bd22fcf 6070 (setq record (car a)
8bd22fcf 6071 position (car record)
87a16a06 6072
8bd22fcf 6073 record (cdr record)
bd7a2e26 6074 type (car record)
87a16a06 6075
bd7a2e26 6076 record (cdr record)
8bd22fcf 6077 extent (car record))
87a16a06
RS
6078
6079 ;; Plot up to this record.
6080 ;; XEmacs 19.12: for some reason, we're getting into a
6081 ;; situation in which some of the records have
6082 ;; positions less than 'from'. Since we've narrowed
ea0c615d
GM
6083 ;; the buffer, this'll generate errors. This is a hack,
6084 ;; but don't call ps-plot-with-face unless from > point-min.
3e9cb08f
GM
6085 (and (>= from (point-min))
6086 (ps-plot-with-face from (min position (point-max)) face))
87a16a06
RS
6087
6088 (cond
6089 ((eq type 'push)
3e9cb08f 6090 (and (ps-x-extent-face extent)
d3ab8dac
KH
6091 (setq extent-list (sort (cons extent extent-list)
6092 'ps-extent-sorter))))
87a16a06
RS
6093
6094 ((eq type 'pull)
6095 (setq extent-list (sort (delq extent extent-list)
6096 'ps-extent-sorter))))
6097
d3ab8dac 6098 (setq face (if extent-list
3e9cb08f 6099 (ps-x-extent-face (car extent-list))
d3ab8dac 6100 'default)
8bd22fcf
KH
6101 from position
6102 a (cdr a)))))
87a16a06
RS
6103
6104 ((eq ps-print-emacs-type 'emacs)
6105 (let ((property-change from)
e65df0a1
KH
6106 (overlay-change from)
6107 (save-buffer-invisibility-spec buffer-invisibility-spec)
c86f4619
GM
6108 (buffer-invisibility-spec nil)
6109 before-string after-string)
87a16a06 6110 (while (< from to)
d3ab8dac 6111 (and (< property-change to) ; Don't search for property change
12d89a2e 6112 ; unless previous search succeeded.
d3ab8dac
KH
6113 (setq property-change (next-property-change from nil to)))
6114 (and (< overlay-change to) ; Don't search for overlay change
12d89a2e 6115 ; unless previous search succeeded.
2bd80d73
GM
6116 (setq overlay-change (min (ps-e-next-overlay-change from)
6117 to)))
c86f4619
GM
6118 (setq position (min property-change overlay-change)
6119 before-string nil
6120 after-string nil)
87a16a06
RS
6121 ;; The code below is not quite correct,
6122 ;; because a non-nil overlay invisible property
6123 ;; which is inactive according to the current value
6124 ;; of buffer-invisibility-spec nonetheless overrides
6125 ;; a face text property.
6126 (setq face
6127 (cond ((let ((prop (get-text-property from 'invisible)))
6128 ;; Decide whether this invisible property
6129 ;; really makes the text invisible.
e65df0a1 6130 (if (eq save-buffer-invisibility-spec t)
87a16a06 6131 (not (null prop))
e65df0a1
KH
6132 (or (memq prop save-buffer-invisibility-spec)
6133 (assq prop save-buffer-invisibility-spec))))
12b88fff 6134 'emacs--invisible--face)
87a16a06
RS
6135 ((get-text-property from 'face))
6136 (t 'default)))
2bd80d73 6137 (let ((overlays (ps-e-overlays-at from))
87a16a06 6138 (face-priority -1)) ; text-property
d3ab8dac
KH
6139 (while (and overlays
6140 (not (eq face 'emacs--invisible--face)))
87a16a06 6141 (let* ((overlay (car overlays))
c86f4619
GM
6142 (overlay-invisible
6143 (ps-e-overlay-get overlay 'invisible))
6144 (overlay-priority
6145 (or (ps-e-overlay-get overlay 'priority) 0)))
d3ab8dac 6146 (and (> overlay-priority face-priority)
c86f4619
GM
6147 (setq before-string
6148 (or (ps-e-overlay-get overlay 'before-string)
6149 before-string)
6150 after-string
6151 (or (and (<= (ps-e-overlay-end overlay) position)
6152 (ps-e-overlay-get overlay 'after-string))
6153 after-string)
6154 face-priority overlay-priority
6155 face
6156 (cond
6157 ((if (eq save-buffer-invisibility-spec t)
6158 (not (null overlay-invisible))
6159 (or (memq overlay-invisible
6160 save-buffer-invisibility-spec)
6161 (assq overlay-invisible
6162 save-buffer-invisibility-spec)))
6163 'emacs--invisible--face)
6164 ((ps-e-overlay-get overlay 'face))
6165 (t face)
6166 ))))
87a16a06
RS
6167 (setq overlays (cdr overlays))))
6168 ;; Plot up to this record.
c86f4619
GM
6169 (and before-string
6170 (ps-plot-string before-string))
87a16a06 6171 (ps-plot-with-face from position face)
c86f4619
GM
6172 (and after-string
6173 (ps-plot-string after-string))
87a16a06
RS
6174 (setq from position)))))
6175 (ps-plot-with-face from to face))))
ef2cbb24
RS
6176
6177(defun ps-generate-postscript (from to)
12d89a2e 6178 (ps-plot-region from to 0 nil))
ef2cbb24
RS
6179
6180(defun ps-generate (buffer from to genfunc)
87a16a06
RS
6181 (save-excursion
6182 (let ((from (min to from))
6183 (to (max to from))
6184 ;; This avoids trouble if chars with read-only properties
6185 ;; are copied into ps-spool-buffer.
6186 (inhibit-read-only t))
6187 (save-restriction
6188 (narrow-to-region from to)
857686a6
RS
6189 (and ps-razzle-dazzle
6190 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
8bd22fcf
KH
6191 (setq ps-source-buffer buffer
6192 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
87a16a06
RS
6193 (ps-init-output-queue)
6194 (let (safe-marker completed-safely needs-begin-file)
6195 (unwind-protect
00aa16af
RS
6196 (progn
6197 (set-buffer ps-spool-buffer)
7da17ab6 6198 (set-buffer-multibyte nil)
915293a2 6199
87a16a06
RS
6200 ;; Get a marker and make it point to the current end of the
6201 ;; buffer, If an error occurs, we'll delete everything from
6202 ;; the end of this marker onwards.
6203 (setq safe-marker (make-marker))
6204 (set-marker safe-marker (point-max))
6205
6206 (goto-char (point-min))
8bd22fcf
KH
6207 (or (looking-at (regexp-quote ps-adobe-tag))
6208 (setq needs-begin-file t))
ea0c615d
GM
6209
6210 (set-buffer ps-source-buffer)
87a16a06 6211 (save-excursion
ea0c615d
GM
6212 (let ((ps-print-page-p t)
6213 ps-even-or-odd-pages)
70f57a72
GM
6214 (ps-begin-job)
6215 (when needs-begin-file
6216 (ps-begin-file)
6217 (ps-mule-initialize))
6218 (ps-mule-begin-job from to)
ea0c615d
GM
6219 (ps-selected-pages)))
6220 (ps-begin-page)
87a16a06
RS
6221 (funcall genfunc from to)
6222 (ps-end-page)
ea0c615d 6223 (ps-end-job needs-begin-file)
87a16a06
RS
6224
6225 ;; Setting this variable tells the unwind form that the
8bd22fcf 6226 ;; the PostScript was generated without error.
87a16a06
RS
6227 (setq completed-safely t))
6228
6229 ;; Unwind form: If some bad mojo occurred while generating
8bd22fcf 6230 ;; PostScript, delete all the PostScript that was generated.
87a16a06
RS
6231 ;; This protects the previously spooled files from getting
6232 ;; corrupted.
8bd22fcf
KH
6233 (and (markerp safe-marker) (not completed-safely)
6234 (progn
6235 (set-buffer ps-spool-buffer)
6236 (delete-region (marker-position safe-marker) (point-max))))))
87a16a06 6237
857686a6 6238 (and ps-razzle-dazzle (message "Formatting...done"))))))
ef2cbb24 6239
e65df0a1 6240
ea0c615d 6241(defun ps-end-job (needs-begin-file)
4b3eb10f
GM
6242 (let ((previous-print ps-print-page-p)
6243 (ps-print-page-p t))
ea0c615d
GM
6244 (ps-flush-output)
6245 (save-excursion
4b3eb10f 6246 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
ea0c615d 6247 (total-lines (cdr ps-printing-region))
ef1159c2 6248 (total-pages (ps-page-number)))
ea0c615d 6249 (set-buffer ps-spool-buffer)
ef1159c2
EZ
6250 (let (case-fold-search)
6251 ;; Back to the PS output buffer to set the last page n-up printing
6252 (goto-char (point-max))
6253 (and (> pages-per-sheet 0)
6254 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
6255 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
6256 ;; Back to the PS output buffer to set the page count
6257 (goto-char (point-min))
6258 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
6259 (replace-match (format "/Lines %d def\n/PageCount %d def"
6260 total-lines total-pages) t)))))
ea0c615d
GM
6261 ;; Set dummy page
6262 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
6263 (let ((ps-n-up-printing 0))
6264 (ps-header-sheet)
6265 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
bd7a2e26
GM
6266 "/PrintLineNumber false def\n"
6267 (number-to-string ps-lines-printed) " BeginPage\n")
ea0c615d
GM
6268 (ps-end-page)))
6269 ;; Set end of PostScript file
4b3eb10f
GM
6270 (and previous-print
6271 (ps-output "EndSheet\n"))
6272 (ps-output "\n%%Trailer\n%%Pages: "
ea0c615d
GM
6273 (number-to-string
6274 (if (and needs-begin-file
6275 ps-banner-page-when-duplexing)
6276 (1+ ps-page-order)
6277 ps-page-order))
6278 "\n\nEndDoc\n\n%%EOF\n")
ef1159c2
EZ
6279 (and ps-end-with-control-d
6280 (ps-output "\C-d"))
ea0c615d
GM
6281 (ps-flush-output))
6282 ;; disable selected pages
1fd9b7fe 6283 (setq ps-selected-pages nil))
7d8b7e8e
KH
6284
6285
857686a6 6286;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
ef2cbb24 6287(defun ps-do-despool (filename)
12d89a2e 6288 (if (or (not (boundp 'ps-spool-buffer))
bcc0d457 6289 (not (symbol-value 'ps-spool-buffer)))
12d89a2e 6290 (message "No spooled PostScript to print")
ef2cbb24
RS
6291 (if filename
6292 (save-excursion
857686a6 6293 (and ps-razzle-dazzle (message "Saving..."))
12d89a2e 6294 (set-buffer ps-spool-buffer)
ef2cbb24 6295 (setq filename (expand-file-name filename))
7ffaf659
EZ
6296 (let ((coding-system-for-write 'raw-text-unix))
6297 (write-region (point-min) (point-max) filename))
857686a6 6298 (and ps-razzle-dazzle (message "Wrote %s" filename)))
ef2cbb24 6299 ;; Else, spool to the printer
857686a6 6300 (and ps-razzle-dazzle (message "Printing..."))
ef2cbb24 6301 (save-excursion
12d89a2e 6302 (set-buffer ps-spool-buffer)
200127fd 6303 (let* ((coding-system-for-write 'raw-text-unix)
298bfad9
KH
6304 (ps-printer-name (or ps-printer-name
6305 (and (boundp 'printer-name)
2bd80d73 6306 (symbol-value 'printer-name))))
200127fd 6307 (ps-lpr-switches
3556c6dd
GM
6308 (append ps-lpr-switches
6309 (and (stringp ps-printer-name)
6310 (string< "" ps-printer-name)
6311 (list (concat
6312 (and (stringp ps-printer-name-option)
6313 ps-printer-name-option)
6314 ps-printer-name))))))
52cf535f
AI
6315 (apply (or ps-print-region-function 'call-process-region)
6316 (point-min) (point-max) ps-lpr-command nil
6317 (and (fboundp 'start-process) 0)
6318 nil
6319 (ps-flatten-list ; dynamic evaluation
6320 (mapcar 'ps-eval-switch ps-lpr-switches)))))
857686a6 6321 (and ps-razzle-dazzle (message "Printing...done")))
12d89a2e
RS
6322 (kill-buffer ps-spool-buffer)))
6323
857686a6
RS
6324;; Dynamic evaluation
6325(defun ps-eval-switch (arg)
6326 (cond ((stringp arg) arg)
6327 ((functionp arg) (apply arg nil))
6328 ((symbolp arg) (symbol-value arg))
6329 ((consp arg) (apply (car arg) (cdr arg)))
6330 (t nil)))
6331
6332;; `ps-flatten-list' is defined here (copied from "message.el" and
6333;; enhanced to handle dotted pairs as well) until we can get some
6334;; sensible autoloads, or `flatten-list' gets put somewhere decent.
6335
6336;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
6337;; => (a b c d e f g h i j)
6338
6339(defun ps-flatten-list (&rest list)
6340 (ps-flatten-list-1 list))
6341
6342(defun ps-flatten-list-1 (list)
6343 (cond ((null list) nil)
6344 ((consp list) (append (ps-flatten-list-1 (car list))
6345 (ps-flatten-list-1 (cdr list))))
6346 (t (list list))))
6347
12d89a2e
RS
6348(defun ps-kill-emacs-check ()
6349 (let (ps-buffer)
8bd22fcf
KH
6350 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6351 (buffer-modified-p ps-buffer)
6352 (y-or-n-p "Unprinted PostScript waiting; print now? ")
6353 (ps-despool))
6354 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6355 (buffer-modified-p ps-buffer)
6356 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
6357 (error "Unprinted PostScript"))))
12d89a2e 6358
d3ab8dac
KH
6359(cond ((fboundp 'add-hook)
6360 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
6361 (kill-emacs-hook
6362 (message "Won't override existing `kill-emacs-hook'"))
6363 (t
6364 (setq kill-emacs-hook 'ps-kill-emacs-check)))
ef2cbb24 6365
298bfad9
KH
6366\f
6367;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12d89a2e 6368;;; Sample Setup Code:
ef2cbb24 6369
0a5daee5 6370
12d89a2e 6371;; This stuff is for anybody that's brave enough to look this far,
87a16a06
RS
6372;; and able to figure out how to use it. It isn't really part of
6373;; ps-print, but I'll leave it here in hopes it might be useful:
ef2cbb24 6374
298bfad9
KH
6375;; WARNING!!! The following code is *sample* code only.
6376;; Don't use it unless you understand what it does!
043620f4 6377
87a16a06
RS
6378(defmacro ps-prsc ()
6379 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
6380(defmacro ps-c-prsc ()
6381 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
6382(defmacro ps-s-prsc ()
6383 `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
00aa16af 6384
a18ed129
RS
6385;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
6386;; `ps-left-headers' specially for mail messages.
6387(defun ps-rmail-mode-hook ()
6388 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
6389 (setq ps-header-lines 3
6390 ps-left-header
6391 ;; The left headers will display the message's subject, its
6392 ;; author, and the name of the folder it was in.
6393 '(ps-article-subject ps-article-author buffer-name)))
6394
6395;; See `ps-gnus-print-article-from-summary'. This function does the
6396;; same thing for rmail.
6397(defun ps-rmail-print-message-from-summary ()
6398 (interactive)
6399 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
6400
6401;; Used in `ps-rmail-print-article-from-summary',
6402;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
6403(defun ps-print-message-from-summary (summary-buffer summary-default)
6404 (let ((ps-buf (or (and (boundp summary-buffer)
6405 (symbol-value summary-buffer))
6406 summary-default)))
6407 (and (get-buffer ps-buf)
6408 (save-excursion
6409 (set-buffer ps-buf)
6410 (ps-spool-buffer-with-faces)))))
6411
12d89a2e 6412;; Look in an article or mail message for the Subject: line. To be
87a16a06 6413;; placed in `ps-left-headers'.
12d89a2e 6414(defun ps-article-subject ()
ef2cbb24 6415 (save-excursion
12d89a2e 6416 (goto-char (point-min))
45a870d9 6417 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
edc9cd35 6418 (buffer-substring (match-beginning 1) (match-end 1))
12d89a2e
RS
6419 "Subject ???")))
6420
6421;; Look in an article or mail message for the From: line. Sorta-kinda
6422;; understands RFC-822 addresses and can pull the real name out where
87a16a06 6423;; it's provided. To be placed in `ps-left-headers'.
12d89a2e
RS
6424(defun ps-article-author ()
6425 (save-excursion
6426 (goto-char (point-min))
a97592dd 6427 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
edc9cd35 6428 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
12d89a2e
RS
6429 (cond
6430
6431 ;; Try first to match addresses that look like
6432 ;; thompson@wg2.waii.com (Jim Thompson)
6433 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
6434 (substring fromstring (match-beginning 1) (match-end 1)))
6435
6436 ;; Next try to match addresses that look like
edc9cd35
GM
6437 ;; Jim Thompson <thompson@wg2.waii.com> or
6438 ;; "Jim Thompson" <thompson@wg2.waii.com>
6439 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
6440 (substring fromstring (match-beginning 2) (match-end 2)))
12d89a2e
RS
6441
6442 ;; Couldn't find a real name -- show the address instead.
6443 (t fromstring)))
6444 "From ???")))
6445
a18ed129 6446;; A hook to bind to `gnus-article-prepare-hook'. This will set the
87a16a06
RS
6447;; `ps-left-headers' specially for gnus articles. Unfortunately,
6448;; `gnus-article-mode-hook' is called only once, the first time the *Article*
12d89a2e
RS
6449;; buffer enters that mode, so it would only work for the first time
6450;; we ran gnus. The second time, this hook wouldn't get set up. The
87a16a06 6451;; only alternative is `gnus-article-prepare-hook'.
12d89a2e 6452(defun ps-gnus-article-prepare-hook ()
8bd22fcf
KH
6453 (setq ps-header-lines 3
6454 ps-left-header
12d89a2e
RS
6455 ;; The left headers will display the article's subject, its
6456 ;; author, and the newsgroup it was in.
8bd22fcf 6457 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
12d89a2e 6458
a18ed129
RS
6459;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
6460;; `ps-left-headers' specially for mail messages.
12d89a2e 6461(defun ps-vm-mode-hook ()
00aa16af 6462 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
8bd22fcf
KH
6463 (setq ps-header-lines 3
6464 ps-left-header
12d89a2e
RS
6465 ;; The left headers will display the message's subject, its
6466 ;; author, and the name of the folder it was in.
8bd22fcf 6467 '(ps-article-subject ps-article-author buffer-name)))
12d89a2e
RS
6468
6469;; Every now and then I forget to switch from the *Summary* buffer to
6470;; the *Article* before hitting prsc, and a nicely formatted list of
6471;; article subjects shows up at the printer. This function, bound to
6472;; prsc for the gnus *Summary* buffer means I don't have to switch
6473;; buffers first.
87a16a06 6474;; sb: Updated for Gnus 5.
12d89a2e
RS
6475(defun ps-gnus-print-article-from-summary ()
6476 (interactive)
a18ed129 6477 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
ef2cbb24 6478
87a16a06 6479;; See `ps-gnus-print-article-from-summary'. This function does the
12d89a2e
RS
6480;; same thing for vm.
6481(defun ps-vm-print-message-from-summary ()
6482 (interactive)
a18ed129 6483 (ps-print-message-from-summary 'vm-mail-buffer ""))
ef2cbb24 6484
87a16a06 6485;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
12d89a2e
RS
6486;; prsc.
6487(defun ps-gnus-summary-setup ()
00aa16af 6488 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
12d89a2e
RS
6489
6490;; Look in an article or mail message for the Subject: line. To be
87a16a06 6491;; placed in `ps-left-headers'.
12d89a2e
RS
6492(defun ps-info-file ()
6493 (save-excursion
6494 (goto-char (point-min))
a97592dd 6495 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
edc9cd35 6496 (buffer-substring (match-beginning 1) (match-end 1))
12d89a2e
RS
6497 "File ???")))
6498
6499;; Look in an article or mail message for the Subject: line. To be
87a16a06 6500;; placed in `ps-left-headers'.
12d89a2e
RS
6501(defun ps-info-node ()
6502 (save-excursion
6503 (goto-char (point-min))
a97592dd 6504 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
edc9cd35 6505 (buffer-substring (match-beginning 1) (match-end 1))
12d89a2e
RS
6506 "Node ???")))
6507
6508(defun ps-info-mode-hook ()
6509 (setq ps-left-header
6510 ;; The left headers will display the node name and file name.
8bd22fcf 6511 '(ps-info-node ps-info-file)))
12d89a2e 6512
043620f4
KH
6513;; WARNING! The following function is a *sample* only, and is *not*
6514;; meant to be used as a whole unless you understand what the effects
87a16a06
RS
6515;; will be! (In fact, this is a copy of Jim's setup for ps-print --
6516;; I'd be very surprised if it was useful to *anybody*, without
043620f4
KH
6517;; modification.)
6518
12d89a2e 6519(defun ps-jts-ps-setup ()
00aa16af
RS
6520 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
6521 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
6522 (global-set-key (ps-c-prsc) 'ps-despool)
12d89a2e
RS
6523 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
6524 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
6525 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
00aa16af 6526 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
12d89a2e 6527 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
8bd22fcf
KH
6528 (setq ps-spool-duplex t
6529 ps-print-color-p nil
6530 ps-lpr-command "lpr"
6531 ps-lpr-switches '("-Jjct,duplex_long"))
bcc0d457
RS
6532 'ps-jts-ps-setup)
6533
6534;; WARNING! The following function is a *sample* only, and is *not*
6535;; meant to be used as a whole unless it corresponds to your needs.
6536;; (In fact, this is a copy of Jack's setup for ps-print --
6537;; I would not be that surprised if it was useful to *anybody*,
6538;; without modification.)
6539
6540(defun ps-jack-setup ()
87a16a06 6541 (setq ps-print-color-p nil
bcc0d457 6542 ps-lpr-command "lpr"
8bd22fcf 6543 ps-lpr-switches nil
bcc0d457 6544
87a16a06
RS
6545 ps-paper-type 'a4
6546 ps-landscape-mode t
bcc0d457
RS
6547 ps-number-of-columns 2
6548
6549 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6550 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6551 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
6552 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6553 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6554 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
6555 ps-header-line-pad .15
6556 ps-print-header t
6557 ps-print-header-frame t
6558 ps-header-lines 2
6559 ps-show-n-of-n t
6560 ps-spool-duplex nil
6561
6562 ps-font-family 'Courier
6563 ps-font-size 5.5
6564 ps-header-font-family 'Helvetica
6565 ps-header-font-size 6
6566 ps-header-title-font-size 8)
6567 'ps-jack-setup)
12d89a2e 6568
298bfad9
KH
6569\f
6570;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6571;; To make this file smaller, some commands go in a separate file.
6572;; But autoload them here to make the separation invisible.
6573
6574(autoload 'ps-mule-prepare-ascii-font "ps-mule"
6575 "Setup special ASCII font for STRING.
6576STRING should contain only ASCII characters.")
6577
6578(autoload 'ps-mule-set-ascii-font "ps-mule"
6579 "Adjust current font if current charset is not ASCII.")
6580
6581(autoload 'ps-mule-plot-string "ps-mule"
6bf5fb46 6582 "Generate PostScript code for plotting characters in the region FROM and TO.
298bfad9
KH
6583
6584It is assumed that all characters in this region belong to the same charset.
6585
6586Optional argument BG-COLOR specifies background color.
6587
6588Returns the value:
6589
6590 (ENDPOS . RUN-WIDTH)
6591
6592Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
6593the sequence.")
6594
6595(autoload 'ps-mule-initialize "ps-mule"
6596 "Initialize global data for printing multi-byte characters.")
6597
6598(autoload 'ps-mule-begin-job "ps-mule"
6599 "Start printing job for multi-byte chars between FROM and TO.
6600This checks if all multi-byte characters in the region are printable or not.")
6601
6602(autoload 'ps-mule-begin-page "ps-mule"
6603 "Initialize multi-byte charset for printing current page.")
6604
6bf5fb46
GM
6605(autoload 'ps-mule-encode-header-string "ps-mule"
6606 "Generate PostScript code for plotting characters in header STRING.
6607
6608It is assumed that the length of STRING is not zero.")
6609
298bfad9
KH
6610\f
6611;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6612
12d89a2e 6613(provide 'ps-print)
b87c5d3d 6614
12d89a2e 6615;;; ps-print.el ends here