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