aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1996-09-28 04:34:34 +0000
committerRichard M. Stallman1996-09-28 04:34:34 +0000
commitbcc0d457987745d74dcfbbdb7828a2837e9b8f5b (patch)
treef5b8217db1b1673a17122cdd298b32f92ba2b0e7
parent08adb0997f202bfc0af5e3823ed327a90342d013 (diff)
downloademacs-bcc0d457987745d74dcfbbdb7828a2837e9b8f5b.tar.gz
emacs-bcc0d457987745d74dcfbbdb7828a2837e9b8f5b.zip
(ps-print-prologue-1): Fix bug in postscript comment lines.
(ps-nb-pages): Call ps-setup _before_ switching to the other buffer, because of buffer variables. Major rewrite. (ps-page-dimensions-database, ps-paper-type): Replace the following global variables: (ps-a4-page-height, ps-a4-page-width, ps-legal-page-height, ps-legal-page-width, ps-letter-page-height, ps-letter-page-width, ps-pages-alist, ps-page-dimensions): Variables deleted. (ps-page-height-i, ps-page-width-i): Variables deleted. (ps-print-prologue): Variable deleted. (ps-print-prologue-1, ps-print-prologue-2): New variables. Major rewrite of the postscript code to handle landscape mode, multiple columns and new font management. (ps-landscape-mode, ps-number-of-columns, ps-inter-column): New variables. Add landscape mode and multiple columns with interspacing. (ps-font-info-database, ps-font-family, ps-font-size, ps-header-font-family, ps-header-font-size, ps-header-title-font, ps-header-title-font-size): New variables. New font management interface. (ps-header-line-pad, ps-header-offset): New variables. (ps-header-font, ps-landscape-page-height): New internal variables. (ps-top-margin): Change its semantics. It is now really the top margin, not anymore twice the top margin. (/ReportAllFontInfo): New postscript function to get all the font families of the printer. (ps-setup): New function. (ps-line-lengths, ps-nb-pages-buffer, ps-nb-pages-region): New utility functions. (ps-page-dimensions-get-width, ps-page-dimensions-get-height): New macros. (/HeaderOffset): Fix bug with /PrintStartY. (/SetHeaderLines): Fix bug.
-rw-r--r--lisp/ps-print.el1599
1 files changed, 1230 insertions, 369 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index a79d236588f..57e9b378fe3 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -28,6 +28,62 @@
28;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)| 28;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)|
29;; 26-Feb-1994|2.8|~/packages/ps-print.el| 29;; 26-Feb-1994|2.8|~/packages/ps-print.el|
30 30
31;; 3.03 [jack] Sept 27, 1996 Jacques Duthen <duthen@cegelec-red.fr>
32;; Merge 31 diffs between 19.29 and 19.34
33
34;; 3.02 [jack] June 26, 1996 Jacques Duthen <duthen@cegelec-red.fr>
35;; Add new page dimensions to `ps-page-dimensions-database' for `paper-type'
36;; Improve landscape mode `ps-landscape-mode' and multiple columns
37;; printing `ps-number-of-columns':
38;; The text and the margins are no more scaled.
39;; Simplify the semantics of `ps-inter-column' (space between columns).
40;; Add error checking for negative `ps-print-width' and `ps-print-height'.
41;; Change the semantics of `ps-top-margin' which is now the TOP MARGIN,
42;; and add `ps-header-offset' instead of having `ps-top-margin' split in 2.
43;; Add `ps-header-font-family', `ps-header-font-size' and
44;; `ps-header-title-font-size' to control the header.
45;; Add `ps-header-line-pad'.
46;; Change the semantics of `ps-font-info-database' to have symbolic
47;; font families.
48;; Add new fonts to `ps-font-info-database': `Courier' `Helvetica'
49;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk'
50;; Make public `ps-font-family' and `ps-font-size' so that the user
51;; can directly control the text font and size without loading ps-print.
52;; Add error checking for unknown font families and a message giving
53;; the exhaustive list of available font families.
54;; Document how to install a new font family.
55;; Add `/ReportAllFontInfo' to get all the font families of the printer.
56;; Add the possibility to make `mixed' font families.
57;; Add `ps-setup' to get the current setup.
58;; Add tools `ps-line-lengths' `ps-nb-pages-buffer' `ps-nb-pages-region'
59;; to help choose the font size.
60;; Split `ps-print-prologue' in two to insert info from header fonts
61;; Replace indexes by macro `ps-page-dimensions-get-width'
62;; to get access to the dimensions list.
63;; Add `ps-select-font' inside `ps-get-page-dimensions'.
64;; Fix the "clumsy" `ps-page-height' management.
65;; Move `ps-get-page-dimensions' to the beginning of `ps-begin-file'
66;; to get early error checking.
67;; Add sample setup `ps-jack-setup'.
68;;
69;; Rewrite a lot of postscript code and add comments inside it
70;; (maybe they should not (or optionally) be included in the generated
71;; Postscript).
72;; Translate the origin to (lm, bm) to simplify the other moves.
73;; Fix bug in `/HeaderOffset' with `/PrintStartY'.
74;; Fix bug in `/SetHeaderLines'.
75;; Change `/ReportFontInfo' for use by `/ReportAllFontInfo'.
76;;
77
78;; 3.01 [jack] June 4, 1996 Jacques Duthen <duthen@cegelec-red.fr>
79;; Manage float value for every variable representing a size.
80;; Add `ps-font-info-database' `ps-inter-column'
81
82;; 3.00 [jack] May 17, 1996 Jacques Duthen <duthen@cegelec-red.fr>
83;; based on 2.8 Jim's Pretty-Good version:
84;; Add `ps-landscape-mode' and `ps-number-of-columns'
85;; for dumb multi-column landscape mode.
86
31;; Baseline-version: 2.8. (Jim's last change version -- this 87;; Baseline-version: 2.8. (Jim's last change version -- this
32;; file may have been edited as part of Emacs without changes to the 88;; file may have been edited as part of Emacs without changes to the
33;; version number. When reporting bugs, please also report the 89;; version number. When reporting bugs, please also report the
@@ -39,12 +95,14 @@
39;; 95;;
40;; About ps-print 96;; About ps-print
41;; -------------- 97;; --------------
98;;
42;; This package provides printing of Emacs buffers on PostScript 99;; This package provides printing of Emacs buffers on PostScript
43;; printers; the buffer's bold and italic text attributes are 100;; printers; the buffer's bold and italic text attributes are
44;; preserved in the printer output. Ps-print is intended for use with 101;; preserved in the printer output. Ps-print is intended for use with
45;; Emacs 19 or Lucid Emacs, together with a fontifying package such as 102;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
46;; font-lock or hilit. 103;; font-lock or hilit.
47;; 104;;
105;;
48;; Using ps-print 106;; Using ps-print
49;; -------------- 107;; --------------
50;; 108;;
@@ -76,7 +134,7 @@
76;; spool - The PostScript image is saved temporarily in an 134;; spool - The PostScript image is saved temporarily in an
77;; Emacs buffer. Many images may be spooled locally 135;; Emacs buffer. Many images may be spooled locally
78;; before printing them. To send the spooled images 136;; before printing them. To send the spooled images
79;; to the printer, use the command ps-despool. 137;; to the printer, use the command `ps-despool'.
80;; 138;;
81;; The spooling mechanism was designed for printing lots of small 139;; The spooling mechanism was designed for printing lots of small
82;; files (mail messages or netnews articles) to save paper that would 140;; files (mail messages or netnews articles) to save paper that would
@@ -84,7 +142,7 @@
84;; your output at the printer (it's easier to pick up one 50-page 142;; your output at the printer (it's easier to pick up one 50-page
85;; printout than to find 50 single-page printouts). 143;; printout than to find 50 single-page printouts).
86;; 144;;
87;; Ps-print has a hook in the kill-emacs-hooks so that you won't 145;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't
88;; accidentally quit from Emacs while you have unprinted PostScript 146;; accidentally quit from Emacs while you have unprinted PostScript
89;; waiting in the spool buffer. If you do attempt to exit with 147;; waiting in the spool buffer. If you do attempt to exit with
90;; spooled PostScript, you'll be asked if you want to print it, and if 148;; spooled PostScript, you'll be asked if you want to print it, and if
@@ -121,6 +179,7 @@
121;; 179;;
122;; 180;;
123;; Invoking Ps-Print 181;; Invoking Ps-Print
182;; -----------------
124;; 183;;
125;; To print your buffer, type 184;; To print your buffer, type
126;; 185;;
@@ -136,16 +195,16 @@
136;; to the printer; you will be prompted for the name of the file to 195;; to the printer; you will be prompted for the name of the file to
137;; save the image to. The prefix argument is ignored by the commands 196;; save the image to. The prefix argument is ignored by the commands
138;; that spool their images, but you may save the spooled images to a 197;; that spool their images, but you may save the spooled images to a
139;; file by giving a prefix argument to ps-despool: 198;; file by giving a prefix argument to `ps-despool':
140;; 199;;
141;; C-u M-x ps-despool 200;; C-u M-x ps-despool
142;; 201;;
143;; When invoked this way, ps-despool will prompt you for the name of 202;; When invoked this way, `ps-despool' will prompt you for the name of
144;; the file to save to. 203;; the file to save to.
145;; 204;;
146;; Any of the ps-print- commands can be bound to keys; I recommend 205;; Any of the `ps-print-' commands can be bound to keys; I recommend
147;; binding ps-spool-buffer-with-faces, ps-spool-region-with-faces, and 206;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
148;; ps-despool. Here are the bindings I use on my Sun 4 keyboard: 207;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
149;; 208;;
150;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc 209;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
151;; (global-set-key '(shift f22) 'ps-spool-region-with-faces) 210;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
@@ -153,105 +212,146 @@
153;; 212;;
154;; 213;;
155;; The Printer Interface 214;; The Printer Interface
215;; ---------------------
156;; 216;;
157;; The variables ps-lpr-command and ps-lpr-switches determine what 217;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
158;; command is used to send the PostScript images to the printer, and 218;; command is used to send the PostScript images to the printer, and
159;; what arguments to give the command. These are analogous to lpr- 219;; what arguments to give the command. These are analogous to
160;; command and lpr-switches. 220;; `lpr-command' and `lpr-switches'.
161;; 221;; Make sure that they contain appropriate values for your system;
162;; NOTE: ps-lpr-command and ps-lpr-switches take their initial values 222;; see the usage notes below and the documentation of these variables.
163;; from the variables lpr-command and lpr-switches. If you have 223;;
164;; lpr-command set to invoke a pretty-printer such as enscript, 224;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
165;; then ps-print won't work properly. ps-lpr-command must name 225;; from the variables `lpr-command' and `lpr-switches'. If you have
226;; `lpr-command' set to invoke a pretty-printer such as `enscript',
227;; then ps-print won't work properly. `ps-lpr-command' must name
166;; a program that does not format the files it prints. 228;; a program that does not format the files it prints.
167;; 229;;
168;; 230;;
169;; How Ps-Print Deals With Fonts 231;; The Page Layout
232;; ---------------
170;; 233;;
171;; The ps-print-*-with-faces commands attempt to determine which faces 234;; All dimensions are floats in PostScript points.
172;; should be printed in bold or italic, but their guesses aren't 235;; 1 inch == 2.54 cm == 72 points
173;; always right. For example, you might want to map colors into faces 236;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
174;; so that blue faces print in bold, and red faces in italic.
175;; 237;;
176;; It is possible to force ps-print to consider specific faces bold or 238;; The variable `ps-paper-type' determines the size of paper ps-print
177;; italic, no matter what font they are displayed in, by setting the 239;; formats for; it should contain one of the symbols:
178;; variables ps-bold-faces and ps-italic-faces. These variables 240;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
179;; contain lists of faces that ps-print should consider bold or 241;; `ledger' `statement' `executive' `a4small' `b4' `b5'
180;; italic; to set them, put code like the following into your .emacs
181;; file:
182;; 242;;
183;; (setq ps-bold-faces '(my-blue-face)) 243;; The variable `ps-landscape-mode' determines the orientation
184;; (setq ps-italic-faces '(my-red-face)) 244;; of the printing on the page:
245;; nil means `portrait' mode, non-nil means `landscape' mode.
246;; There is no oblique mode yet, though this is easy to do in ps.
247
248;; In landscape mode, the text is NOT scaled: you may print 70 lines
249;; in portrait mode and only 50 lignes in landscape mode.
250;; The margins represent margins in the printed paper:
251;; the top margin is the margin between the top of the page
252;; and the printed header, whatever the orientation is.
185;; 253;;
186;; Faces like bold-italic that are both bold and italic should go in 254;; The variable `ps-number-of-columns' determines the number of columns
187;; *both* lists. 255;; both in landscape and portrait mode.
256;; You can use:
257;; - (the standard) one column portrait mode
258;; - (my favorite) two columns landscape mode (which spares trees)
259;; but also
260;; - one column landscape mode for files with very long lines.
261;; - multi-column portrait or landscape mode
188;; 262;;
189;; Ps-print does not attempt to guess the sizes of fonts; all text is
190;; rendered using the Courier font family, in 10 point size. To
191;; change the font family, change the variables ps-font, ps-font-bold,
192;; ps-font-italic, and ps-font-bold-italic; fixed-pitch fonts work
193;; best, but are not required. To change the font size, change the
194;; variable ps-font-size.
195;; 263;;
196;; If you change the font family or size, you MUST also change the 264;; Horizontal layout
197;; variables ps-line-height, ps-avg-char-width, and ps-space-width, or 265;; -----------------
198;; ps-print cannot correctly place line and page breaks.
199;; 266;;
200;; Ps-print keeps internal lists of which fonts are bold and which are 267;; The horizontal layout is determined by the variables
201;; italic; these lists are built the first time you invoke ps-print. 268;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
202;; For the sake of efficiency, the lists are built only once; the same 269;; as follows:
203;; lists are referred in later invocations of ps-print.
204;; 270;;
205;; Because these lists are built only once, it's possible for them to 271;; ------------------------------------------
206;; get out of sync, if a face changes, or if new faces are added. To 272;; | | | | | | | |
207;; get the lists back in sync, you can set the variable 273;; | lm | text | ic | text | ic | text | rm |
208;; ps-build-face-reference to t, and the lists will be rebuilt the 274;; | | | | | | | |
209;; next time ps-print is invoked. 275;; ------------------------------------------
210;; 276;;
277;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
278;; Usually, lm = rm > 0 and ic = lm
279;; If (ic < 0), the text of adjacent columns can overlap.
211;; 280;;
212;; How Ps-Print Deals With Color
213;; 281;;
214;; Ps-print detects faces with foreground and background colors 282;; Vertical layout
215;; defined and embeds color information in the PostScript image. The 283;; ---------------
216;; default foreground and background colors are defined by the 284;;
217;; variables ps-default-fg and ps-default-bg. On black-and-white 285;; The vertical layout is determined by the variables
218;; printers, colors are displayed in grayscale. To turn off color 286;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
219;; output, set ps-print-color-p to nil. 287;; as follows:
288;;
289;; |--------| |--------|
290;; | tm | | tm |
291;; |--------| |--------|
292;; | header | | |
293;; |--------| | |
294;; | ho | | |
295;; |--------| or | text |
296;; | | | |
297;; | text | | |
298;; | | | |
299;; |--------| |--------|
300;; | bm | | bm |
301;; |--------| |--------|
302;;
303;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
304;; The margins represent margins in the printed paper:
305;; the top margin is the margin between the top of the page
306;; and the printed header, whatever the orientation is.
220;; 307;;
221;; 308;;
222;; Headers 309;; Headers
310;; -------
223;; 311;;
224;; Ps-print can print headers at the top of each page; the default 312;; Ps-print can print headers at the top of each column; the default
225;; headers contain the following four items: on the left, the name of 313;; headers contain the following four items: on the left, the name of
226;; the buffer and, if the buffer is visiting a file, the file's 314;; the buffer and, if the buffer is visiting a file, the file's
227;; directory; on the right, the page number and date of printing. The 315;; directory; on the right, the page number and date of printing.
228;; default headers look something like this: 316;; The default headers look something like this:
229;; 317;;
230;; ps-print.el 1/21 318;; ps-print.el 1/21
231;; /home/jct/emacs-lisp/ps/new 94/12/31 319;; /home/jct/emacs-lisp/ps/new 94/12/31
232;; 320;;
233;; When printing on duplex printers, left and right are reversed so 321;; When printing on duplex printers, left and right are reversed so
234;; that the page numbers are toward the outside. 322;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
235;; 323;;
236;; Headers are configurable. To turn them off completely, set 324;; Headers are configurable:
237;; ps-print-header to nil. To turn off the header's gaudy framing 325;; To turn them off completely, set `ps-print-header' to nil.
238;; box, set ps-print-header-frame to nil. Page numbers are printed in 326;; To turn off the header's gaudy framing box,
239;; "n/m" format, indicating page n of m pages; to omit the total page 327;; set `ps-print-header-frame' to nil.
240;; count and just print the page number, set ps-show-n-of-n to nil. 328;;
329;; The font family and size of text in the header are determined
330;; by the variables `ps-header-font-family', `ps-header-font-size' and
331;; `ps-header-title-font-size' (see below).
332;;
333;; The variable `ps-header-line-pad' determines the portion of a header
334;; title line height to insert between the header frame and the text
335;; it contains, both in the vertical and horizontal directions:
336;; .5 means half a line.
337
338;; Page numbers are printed in `n/m' format, indicating page n of m pages;
339;; to omit the total page count and just print the page number,
340;; set `ps-show-n-of-n' to nil.
241;; 341;;
242;; The amount of information in the header can be changed by changing 342;; The amount of information in the header can be changed by changing
243;; the number of lines. To show less, set ps-header-lines to 1, and 343;; the number of lines. To show less, set `ps-header-lines' to 1, and
244;; the header will show only the buffer name and page number. To show 344;; the header will show only the buffer name and page number. To show
245;; more, set ps-header-lines to 3, and the header will show the time of 345;; more, set `ps-header-lines' to 3, and the header will show the time of
246;; printing below the date. 346;; printing below the date.
247;; 347;;
248;; To change the content of the headers, change the variables 348;; To change the content of the headers, change the variables
249;; ps-left-header and ps-right-header. These variables are lists, 349;; `ps-left-header' and `ps-right-header'.
250;; specifying top-to-bottom the text to display on the left or right 350;; These variables are lists, specifying top-to-bottom the text
251;; side of the header. Each element of the list should be a string or 351;; to display on the left or right side of the header.
252;; a symbol. Strings are inserted directly into the PostScript 352;; Each element of the list should be a string or a symbol.
253;; arrays, and should contain the PostScript string delimiters '(' and 353;; Strings are inserted directly into the PostScript arrays,
254;; ')'. 354;; and should contain the PostScript string delimiters '(' and ')'.
255;; 355;;
256;; Symbols in the header format lists can either represent functions 356;; Symbols in the header format lists can either represent functions
257;; or variables. Functions are called, and should return a string to 357;; or variables. Functions are called, and should return a string to
@@ -275,58 +375,214 @@
275;; 375;;
276;; (setq larry-var "Larry") 376;; (setq larry-var "Larry")
277;; 377;;
278;; and a literal for "Curly". Here's how ps-left-header should be 378;; and a literal for "Curly". Here's how `ps-left-header' should be
279;; set: 379;; set:
280;; 380;;
281;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)")) 381;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
282;; 382;;
283;; Note that Curly has the PostScript string delimiters inside his 383;; Note that Curly has the PostScript string delimiters inside his
284;; quotes -- those aren't misplaced lisp delimiters! Without them, 384;; quotes -- those aren't misplaced lisp delimiters!
285;; PostScript would attempt to call the undefined function Curly, 385;; Without them, PostScript would attempt to call the undefined
286;; which would result in a PostScript error. Since most printers 386;; function Curly, which would result in a PostScript error.
287;; don't report PostScript errors except by aborting the print job, 387;; Since most printers don't report PostScript errors except by
288;; this kind of error can be hard to track down. Consider yourself 388;; aborting the print job, this kind of error can be hard to track down.
289;; warned. 389;; Consider yourself warned!
290;; 390;;
291;; 391;;
292;; Duplex Printers 392;; Duplex Printers
393;; ---------------
293;; 394;;
294;; If you have a duplex-capable printer (one that prints both sides of 395;; If you have a duplex-capable printer (one that prints both sides of
295;; the paper), set ps-spool-duplex to t. Ps-print will insert blank 396;; the paper), set `ps-spool-duplex' to t.
296;; pages to make sure each buffer starts on the correct side of the 397;; Ps-print will insert blank pages to make sure each buffer starts
297;; paper. Don't forget to set ps-lpr-switches to select duplex 398;; on the correct side of the paper.
298;; printing for your printer. 399;; Don't forget to set `ps-lpr-switches' to select duplex printing
400;; for your printer.
401;;
402;;
403;; Font managing
404;; -------------
405;;
406;; Ps-print now knows rather precisely some fonts:
407;; the variable `ps-font-info-database' contains information
408;; for a list of font families (currently mainly `Courier' `Helvetica'
409;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
410;; Each font family contains the font names for standard, bold, italic
411;; and bold-italic characters, a reference size (usually 10) and the
412;; corresponding line height, width of a space and average character width.
299;; 413;;
414;; The variable `ps-font-family' determines which font family
415;; is to be used for ordinary text.
416;; If its value does not correspond to a known font family,
417;; an error message is printed into the `*Messages*' buffer,
418;; which lists the currently available font families.
419;;
420;; The variable `ps-font-size' determines the size (in points)
421;; of the font for ordinary text, when generating Postscript.
422;; Its value is a float.
423;;
424;; Similarly, the variable `ps-header-font-family' determines
425;; which font family is to be used for text in the header.
426;; The variable `ps-header-font-size' determines the font size,
427;; in points, for text in the header.
428;; The variable `ps-header-title-font-size' determines the font size,
429;; in points, for the top line of text in the header.
430;;
431;;
432;; Adding a new font family
433;; ------------------------
434;;
435;; To use a new font family, you MUST first teach ps-print
436;; this font, ie add its information to `ps-font-info-database',
437;; otherwise ps-print cannot correctly place line and page breaks.
438;;
439;; For example, assuming `Helvetica' is unkown,
440;; you first need to do the following ONLY ONCE:
441;;
442;; - create a new buffer
443;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
444;; - open this file and find the line:
445;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
446;; - delete the leading `%' (which is the Postscript comment character)
447;; - replace in this line `Courier' by the new font (say `Helvetica')
448;; to get the line:
449;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
450;; - send this file to the printer (or to ghostscript).
451;; You should read the following on the output page:
452;;
453;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
454;; and a crude estimate of average character width is 5.09243
455;;
456;; - Add these values to the `ps-font-info-database':
457;; (setq ps-font-info-database
458;; (append
459;; '((Helvetica ; the family name
460;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
461;; 10.0 11.56 2.78 5.09243))
462;; ps-font-info-database))
463;; - Now you can use this font family with any size:
464;; (setq ps-font-family 'Helvetica)
465;; - if you want to use this family in another emacs session, you must
466;; put into your `~/.emacs':
467;; (require 'ps-print)
468;; (setq ps-font-info-database (append ...)))
469;; if you don't want to load ps-print, you have to copy the whole value:
470;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
471;; or, if you can wait until the `ps-print-hook' is implemented, do:
472;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...)))
473;; This does not work yet, since there is no `ps-print-hook' yet.
474;;
475;; You can create new `mixed' font families like:
476;; (my-mixed-family
477;; "Courier-Bold" "Helvetica"
478;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic"
479;; 10.0 10.55 6.0 6.0)
480;; Now you can use your new font family with any size:
481;; (setq ps-font-family 'my-mixed-family)
482;;
483;; You can get information on all the fonts resident in YOUR printer
484;; by uncommenting the line:
485;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
486;;
487;; The postscript file should be sent to YOUR postscript printer.
488;; If you send it to ghostscript or to another postscript printer,
489;; you may get slightly different results.
490;; Anyway, as ghostscript fonts are autoload, you won't get
491;; much font info.
492;;
493;;
494;; How Ps-Print Deals With Faces
495;; -----------------------------
300;; 496;;
301;; Paper Size 497;; The ps-print-*-with-faces commands attempt to determine which faces
498;; should be printed in bold or italic, but their guesses aren't
499;; always right. For example, you might want to map colors into faces
500;; so that blue faces print in bold, and red faces in italic.
302;; 501;;
303;; The variable ps-paper-type determines the size of paper ps-print 502;; It is possible to force ps-print to consider specific faces bold or
304;; formats for; it should contain one of the symbols ps-letter, 503;; italic, no matter what font they are displayed in, by setting the
305;; ps-legal, or ps-a4. The default is ps-letter. 504;; variables `ps-bold-faces' and `ps-italic-faces'. These variables
505;; contain lists of faces that ps-print should consider bold or
506;; italic; to set them, put code like the following into your .emacs
507;; file:
306;; 508;;
509;; (setq ps-bold-faces '(my-blue-face))
510;; (setq ps-italic-faces '(my-red-face))
511;;
512;; Faces like bold-italic that are both bold and italic should go in
513;; *both* lists.
514;;
515;; Ps-print keeps internal lists of which fonts are bold and which are
516;; italic; these lists are built the first time you invoke ps-print.
517;; For the sake of efficiency, the lists are built only once; the same
518;; lists are referred in later invocations of ps-print.
519;;
520;; Because these lists are built only once, it's possible for them to
521;; get out of sync, if a face changes, or if new faces are added. To
522;; get the lists back in sync, you can set the variable
523;; `ps-build-face-reference' to t, and the lists will be rebuilt the
524;; next time ps-print is invoked.
525;;
526;;
527;; How Ps-Print Deals With Color
528;; -----------------------------
529;;
530;; Ps-print detects faces with foreground and background colors
531;; defined and embeds color information in the PostScript image.
532;; The default foreground and background colors are defined by the
533;; variables `ps-default-fg' and `ps-default-bg'.
534;; On black-and-white printers, colors are displayed in grayscale.
535;; To turn off color output, set `ps-print-color-p' to nil.
536;;
537;;
538;; Utilities
539;; ---------
540;;
541;; Some tools are provided to help you customize your font setup.
542;;
543;; `ps-setup' returns (some part of) the current setup.
544;;
545;; To avoid wrapping too many lines, you may want to adjust the
546;; left and right margins and the font size. On UN*X systems, do:
547;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
548;; to determine the longest lines of your file.
549;; Then, the command `ps-line-lengths' will give you the correspondance
550;; between a line length (number of characters) and the maximum font
551;; size which doesn't wrap such a line with the current ps-print setup.
552;;
553;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
554;; the correspondance between a number of pages and the maximum font
555;; size which allow the number of lines of the current buffer or of
556;; its current region to fit in this number of pages.
557;; Note: line folding is not taken into account in this process
558;; and could change the results.
307;; 559;;
308;; Make sure that the variables ps-lpr-command and ps-lpr-switches
309;; contain appropriate values for your system; see the usage notes
310;; below and the documentation of these variables.
311;; 560;;
312;;
313;; New since version 1.5 561;; New since version 1.5
314;; --------------------- 562;; ---------------------
315;; Color output capability.
316;; 563;;
564;; Color output capability.
317;; Automatic detection of font attributes (bold, italic). 565;; Automatic detection of font attributes (bold, italic).
318;;
319;; Configurable headers with page numbers. 566;; Configurable headers with page numbers.
320;;
321;; Slightly faster. 567;; Slightly faster.
322;;
323;; Support for different paper sizes. 568;; Support for different paper sizes.
324;;
325;; Better conformance to PostScript Document Structure Conventions. 569;; Better conformance to PostScript Document Structure Conventions.
326;; 570;;
327;; 571;;
572;; New since version 2.8
573;; ---------------------
574;;
575;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
576;;
577;; Font familiy and float size for text and header.
578;; Landscape mode.
579;; Multiple columns.
580;; Tools for page setup.
581;;
582;;
328;; Known bugs and limitations of ps-print: 583;; Known bugs and limitations of ps-print:
329;; -------------------------------------- 584;; --------------------------------------
585;;
330;; Although color printing will work in XEmacs 19.12, it doesn't work 586;; Although color printing will work in XEmacs 19.12, it doesn't work
331;; well; in particular, bold or italic fonts don't print in the right 587;; well; in particular, bold or italic fonts don't print in the right
332;; background color. 588;; background color.
@@ -335,12 +591,12 @@
335;; 591;;
336;; Automatic font-attribute detection doesn't work well, especially 592;; Automatic font-attribute detection doesn't work well, especially
337;; with hilit19 and older versions of get-create-face. Users having 593;; with hilit19 and older versions of get-create-face. Users having
338;; problems with auto-font detection should use the lists ps-italic- 594;; problems with auto-font detection should use the lists
339;; faces and ps-bold-faces and/or turn off automatic detection by 595;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic
340;; setting ps-auto-font-detect to nil. 596;; detection by setting `ps-auto-font-detect' to nil.
341;; 597;;
342;; Automatic font-attribute detection doesn't work with XEmacs 19.12 598;; Automatic font-attribute detection doesn't work with XEmacs 19.12
343;; in tty mode; use the lists ps-italic-faces and ps-bold-faces 599;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces'
344;; instead. 600;; instead.
345;; 601;;
346;; Still too slow; could use some hand-optimization. 602;; Still too slow; could use some hand-optimization.
@@ -354,18 +610,30 @@
354;; 610;;
355;; Epoch and Emacs 18 not supported. At all. 611;; Epoch and Emacs 18 not supported. At all.
356;; 612;;
613;; Fixed-pitch fonts work better for line folding, but are not required.
614;;
615;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
616;; of folding lines.
357;; 617;;
358;; Features to add:
359;; ---------------
360;; 2-up and 4-up capability.
361;; 618;;
362;; Line numbers. 619;; Things to change:
620;; ----------------
363;; 621;;
364;; Wide-print (landscape) capability. 622;; Add `ps-print-hook' (I don't know how to do that (yet!)).
623;; Add 4-up capability (really needed?).
624;; Add line numbers (should not be too hard).
625;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
626;; Put one header per page over the columns (easy but needed?).
627;; Improve the memory management for big files (hard?).
628;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
629;; of folding lines.
365;; 630;;
366;; 631;;
367;; Acknowledgements 632;; Acknowledgements
368;; ---------------- 633;; ----------------
634;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
635;; [jack]
636;;
369;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for 637;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
370;; color and the invisible property. 638;; color and the invisible property.
371;; 639;;
@@ -391,38 +659,121 @@
391 659
392;;; Code: 660;;; Code:
393 661
394(defconst ps-print-version "2.8" 662(defconst ps-print-version "3.01"
395 "ps-print.el,v 2.8 1995/05/04 12:06:10 jct Exp 663 "ps-print.el,v 3.01 1996/06/13 18:12 jack
396 664
397Jim's last change version -- this file may have been edited as part of 665Jack's last change version -- this file may have been edited as part of
398Emacs without changes to the version number. When reporting bugs, 666Emacs without changes to the version number. When reporting bugs,
399please also report the version of Emacs, if any, that ps-print was 667please also report the version of Emacs, if any, that ps-print was
400distributed with. 668distributed with.
401 669
402Please send all bug fixes and enhancements to 670Please send all bug fixes and enhancements to
403 Jim Thompson <thompson@wg2.waii.com>.") 671 Jacques Duthen <duthen@cegelec-red.fr>.
672")
404 673
405;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 674;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
406;; User Variables: 675;; User Variables:
407 676
677;;; Interface to the command system
678
408(defvar ps-lpr-command lpr-command 679(defvar ps-lpr-command lpr-command
409 "*The shell command for printing a PostScript file.") 680 "*The shell command for printing a PostScript file.")
410 681
411(defvar ps-lpr-switches lpr-switches 682(defvar ps-lpr-switches lpr-switches
412 "*A list of extra switches to pass to `ps-lpr-command'.") 683 "*A list of extra switches to pass to `ps-lpr-command'.")
413 684
414(defvar ps-spool-duplex nil ; Not many people have duplex 685;;; Page layout
415 ; printers, so default to nil.
416 "*Non-nil indicates spooling is for a two-sided printer.
417For a duplex printer, the `ps-spool-*' commands will insert blank pages
418as needed between print jobs so that the next buffer printed will
419start on the right page. Also, if headers are turned on, the headers
420will be reversed on duplex printers so that the page numbers fall to
421the left on even-numbered pages.")
422 686
423(defvar ps-paper-type 'ps-letter 687;; All page dimensions are in PostScript points.
424 "*Specifies the size of paper to format for. Should be one of 688;; 1 inch == 2.54 cm == 72 points
425`ps-letter', `ps-legal', or `ps-a4'.") 689;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
690
691;; Letter 8.5 inch x 11.0 inch
692;; Legal 8.5 inch x 14.0 inch
693;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
694
695;; LetterSmall 7.68 inch x 10.16 inch
696;; Tabloid 11.0 inch x 17.0 inch
697;; Ledger 17.0 inch x 11.0 inch
698;; Statement 5.5 inch x 8.5 inch
699;; Executive 7.5 inch x 10.0 inch
700;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
701;; A4Small 7.47 inch x 10.85 inch
702;; B4 10.125 inch x 14.33 inch
703;; B5 7.16 inch x 10.125 inch
704
705(defvar ps-page-dimensions-database
706 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54))
707 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54))
708 (list 'letter (* 72 8.5) (* 72 11.0))
709 (list 'legal (* 72 8.5) (* 72 14.0))
710 (list 'letter-small (* 72 7.68) (* 72 10.16))
711 (list 'tabloid (* 72 11.0) (* 72 17.0))
712 (list 'ledger (* 72 17.0) (* 72 11.0))
713 (list 'statement (* 72 5.5) (* 72 8.5))
714 (list 'executive (* 72 7.5) (* 72 10.0))
715 (list 'a4small (* 72 7.47) (* 72 10.85))
716 (list 'b4 (* 72 10.125) (* 72 14.33))
717 (list 'b5 (* 72 7.16) (* 72 10.125)))
718 "*List associating a symbolic paper type to its width and height.
719see `ps-paper-type'.")
720
721(defvar ps-paper-type 'letter
722 "*Specifies the size of paper to format for.
723Should be one of the paper types defined in `ps-page-dimensions-database':
724`letter', `legal', `a4'...")
725
726(defvar ps-landscape-mode 'nil
727 "*Non-nil means print in landscape mode.")
728
729(defvar ps-number-of-columns 1
730 "*Specifies the number of columns")
731
732;;; Horizontal layout
733
734;; ------------------------------------------
735;; | | | | | | | |
736;; | lm | text | ic | text | ic | text | rm |
737;; | | | | | | | |
738;; ------------------------------------------
739
740(defvar ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
741 "*Left margin in points (1/72 inch).")
742
743(defvar ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
744 "*Right margin in points (1/72 inch).")
745
746(defvar ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
747 "*Horizontal space between columns in points (1/72 inch).")
748
749;;; Vertical layout
750
751;; |--------|
752;; | tm |
753;; |--------|
754;; | header |
755;; |--------|
756;; | ho |
757;; |--------|
758;; | text |
759;; |--------|
760;; | bm |
761;; |--------|
762
763(defvar ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
764 "*Bottom margin in points (1/72 inch).")
765
766(defvar ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
767 "*Top margin in points (1/72 inch).")
768
769(defvar ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
770 "*Vertical space in points (1/72 inch) between the main text and the header.")
771
772(defvar ps-header-line-pad 0.15
773 "*Portion of a header title line height to insert between the header frame
774and the text it contains, both in the vertical and horizontal directions.")
775
776;;; Header setup
426 777
427(defvar ps-print-header t 778(defvar ps-print-header t
428 "*Non-nil means print a header at the top of each page. 779 "*Non-nil means print a header at the top of each page.
@@ -434,15 +785,110 @@ customizable by changing variables `ps-header-left' and
434(defvar ps-print-header-frame t 785(defvar ps-print-header-frame t
435 "*Non-nil means draw a gaudy frame around the header.") 786 "*Non-nil means draw a gaudy frame around the header.")
436 787
788(defvar ps-header-lines 2
789 "*Number of lines to display in page header, when generating Postscript.")
790(make-variable-buffer-local 'ps-header-lines)
791
437(defvar ps-show-n-of-n t 792(defvar ps-show-n-of-n t
438 "*Non-nil means show page numbers as N/M, meaning page N of M. 793 "*Non-nil means show page numbers as N/M, meaning page N of M.
439Note: page numbers are displayed as part of headers, see variable 794Note: page numbers are displayed as part of headers, see variable
440`ps-print-headers'.") 795`ps-print-headers'.")
441 796
442(defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; Emacs 797(defvar ps-spool-duplex nil ; Not many people have duplex
443 (fboundp 'pixel-components)) ; XEmacs 798 ; printers, so default to nil.
444 (fboundp 'float)) 799 "*Non-nil indicates spooling is for a two-sided printer.
445; Printing color requires both floating point and x-color-values. 800For a duplex printer, the `ps-spool-*' commands will insert blank pages
801as needed between print jobs so that the next buffer printed will
802start on the right page. Also, if headers are turned on, the headers
803will be reversed on duplex printers so that the page numbers fall to
804the left on even-numbered pages.")
805
806;;; Fonts
807
808(defvar ps-font-info-database
809 '((Courier ; the family key
810 "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique"
811 10.0 10.55 6.0 6.0)
812 (Helvetica ; the family key
813 "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
814 10.0 11.56 2.78 5.09243)
815 (Times
816 "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic"
817 10.0 11.0 2.5 4.71432)
818 (Palatino
819 "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic"
820 10.0 12.1 2.5 5.08676)
821 (Helvetica-Narrow
822 "Helvetica-Narrow" "Helvetica-Narrow-Bold"
823 "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique"
824 10.0 11.56 2.2796 4.17579)
825 (NewCenturySchlbk
826 "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold"
827 "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic"
828 10.0 12.15 2.78 5.31162)
829 ;; got no bold for the next ones
830 (AvantGarde-Book
831 "AvantGarde-Book" "AvantGarde-Book"
832 "AvantGarde-BookOblique" "AvantGarde-BookOblique"
833 10.0 11.77 2.77 5.45189)
834 (AvantGarde-Demi
835 "AvantGarde-Demi" "AvantGarde-Demi"
836 "AvantGarde-DemiOblique" "AvantGarde-DemiOblique"
837 10.0 12.72 2.8 5.51351)
838 (Bookman-Demi
839 "Bookman-Demi" "Bookman-Demi"
840 "Bookman-DemiItalic" "Bookman-DemiItalic"
841 10.0 11.77 3.4 6.05946)
842 (Bookman-Light
843 "Bookman-Light" "Bookman-Light"
844 "Bookman-LightItalic" "Bookman-LightItalic"
845 10.0 11.79 3.2 5.67027)
846 ;; got no bold and no italic for the next ones
847 (Symbol
848 "Symbol" "Symbol" "Symbol" "Symbol"
849 10.0 13.03 2.5 3.24324)
850 (Zapf-Dingbats
851 "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats"
852 10.0 9.63 2.78 2.78)
853 (Zapf-Chancery-MediumItalic
854 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
855 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
856 10.0 11.45 2.2 4.10811)
857)
858 "*Font info database: font family (the key), name, bold, italic, bold-italic,
859reference size, line height, space width, average character width.
860To get the info for another specific font (say Helvetica), do the following:
861- create a new buffer
862- generate the PostScript image to a file (C-u M-x ps-print-buffer)
863- open this file and delete the leading `%' (which is the Postscript
864 comment character) from the line
865 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
866 to get the line
867 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
868- add the values to `ps-font-info-database'.
869You can get all the fonts of YOUR printer using `ReportAllFontInfo'.")
870
871(defvar ps-font-family 'Courier
872 "Font family name for ordinary text, when generating Postscript.")
873
874(defvar ps-font-size 8.5
875 "Font size, in points, for ordinary text, when generating Postscript.")
876
877(defvar ps-header-font-family 'Helvetica
878 "Font family name for text in the header, when generating Postscript.")
879
880(defvar ps-header-font-size 12
881 "Font size, in points, for text in the header, when generating Postscript.")
882
883(defvar ps-header-title-font-size 14
884 "Font size, in points, for the top line of text in the header,
885when generating Postscript.")
886
887;;; Colors
888
889(defvar ps-print-color-p (or (fboundp 'x-color-values) ; Emacs
890 (fboundp 'pixel-components)) ; XEmacs
891; Printing color requires x-color-values.
446 "*If non-nil, print the buffer's text in color.") 892 "*If non-nil, print the buffer's text in color.")
447 893
448(defvar ps-default-fg '(0.0 0.0 0.0) 894(defvar ps-default-fg '(0.0 0.0 0.0)
@@ -451,40 +897,6 @@ Note: page numbers are displayed as part of headers, see variable
451(defvar ps-default-bg '(1.0 1.0 1.0) 897(defvar ps-default-bg '(1.0 1.0 1.0)
452 "*RGB values of the default background color. Defaults to white.") 898 "*RGB values of the default background color. Defaults to white.")
453 899
454(defvar ps-font-size 10
455 "*Font size, in points, for generating Postscript.")
456
457(defvar ps-font "Courier"
458 "*Font family name for ordinary text, when generating Postscript.")
459
460(defvar ps-font-bold "Courier-Bold"
461 "*Font family name for bold text, when generating Postscript.")
462
463(defvar ps-font-italic "Courier-Oblique"
464 "*Font family name for italic text, when generating Postscript.")
465
466(defvar ps-font-bold-italic "Courier-BoldOblique"
467 "*Font family name for bold italic text, when generating Postscript.")
468
469(defvar ps-avg-char-width (if (fboundp 'float) 5.6 6)
470 "*The average width, in points, of a character, for generating Postscript.
471This is the value that ps-print uses to determine the length,
472x-dimension, of the text it has printed, and thus affects the point at
473which long lines wrap around. If you change the font or
474font size, you will probably have to adjust this value to match.")
475
476(defvar ps-space-width (if (fboundp 'float) 5.6 6)
477 "*The width of a space character, for generating Postscript.
478This value is used in expanding tab characters.")
479
480(defvar ps-line-height (if (fboundp 'float) 11.29 11)
481 "*The height of a line, for generating Postscript.
482This is the value that ps-print uses to determine the height,
483y-dimension, of the lines of text it has printed, and thus affects the
484point at which page-breaks are placed. If you change the font or font
485size, you will probably have to adjust this value to match. The
486line-height is *not* the same as the point size of the font.")
487
488(defvar ps-auto-font-detect t 900(defvar ps-auto-font-detect t
489 "*Non-nil means automatically detect bold/italic face attributes. 901 "*Non-nil means automatically detect bold/italic face attributes.
490nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', 902nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces',
@@ -502,13 +914,9 @@ This applies to generating Postscript.")
502 "*A list of the \(non-underlined\) faces that should be printed underlined. 914 "*A list of the \(non-underlined\) faces that should be printed underlined.
503This applies to generating Postscript.") 915This applies to generating Postscript.")
504 916
505(defvar ps-header-lines 2
506 "*Number of lines to display in page header, when generating Postscript.")
507(make-variable-buffer-local 'ps-header-lines)
508
509(defvar ps-left-header 917(defvar ps-left-header
510 (list 'ps-get-buffer-name 'ps-header-dirpart) 918 (list 'ps-get-buffer-name 'ps-header-dirpart)
511 "*The items to display on the right part of the page header. 919 "*The items to display (each on a line) on the left part of the page header.
512This applies to generating Postscript. 920This applies to generating Postscript.
513 921
514The value should be a list of strings and symbols, each representing an 922The value should be a list of strings and symbols, each representing an
@@ -527,7 +935,7 @@ string delimiters added to it.")
527 935
528(defvar ps-right-header 936(defvar ps-right-header
529 (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss) 937 (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss)
530 "*The items to display on the left part of the page header. 938 "*The items to display (each on a line) on the right part of the page header.
531This applies to generating Postscript. 939This applies to generating Postscript.
532 940
533See the variable `ps-left-header' for a description of the format of 941See the variable `ps-left-header' for a description of the format of
@@ -684,6 +1092,85 @@ number, prompt the user for the name of the file to save in."
684 (interactive (list (ps-print-preprint current-prefix-arg))) 1092 (interactive (list (ps-print-preprint current-prefix-arg)))
685 (ps-do-despool filename)) 1093 (ps-do-despool filename))
686 1094
1095;;;###autoload
1096(defun ps-line-lengths ()
1097 "*Display the correspondance between a line length and a font size,
1098using the current ps-print setup.
1099Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1100 (interactive)
1101 (ps-line-lengths-internal))
1102
1103;;;###autoload
1104(defun ps-nb-pages-buffer (nb-lines)
1105 "*Display an approximate correspondance between a font size and the number
1106of pages the current buffer would require to print
1107using the current ps-print setup."
1108 (interactive (list (count-lines (point-min) (point-max))))
1109 (ps-nb-pages nb-lines))
1110
1111;;;###autoload
1112(defun ps-nb-pages-region (nb-lines)
1113 "*Display an approximate correspondance between a font size and the number
1114of pages the current region would require to print
1115using the current ps-print setup."
1116 (interactive (list (count-lines (mark) (point))))
1117 (ps-nb-pages nb-lines))
1118
1119;;;###autoload
1120(defun ps-setup ()
1121 "*Return the current setup"
1122 (format "
1123 (setq ps-print-color-p %s
1124 ps-lpr-command \"%s\"
1125 ps-lpr-switches %s
1126
1127 ps-paper-type '%s
1128 ps-landscape-mode %s
1129 ps-number-of-columns %s
1130
1131 ps-left-margin %s
1132 ps-right-margin %s
1133 ps-inter-column %s
1134 ps-bottom-margin %s
1135 ps-top-margin %s
1136 ps-header-offset %s
1137 ps-header-line-pad %s
1138 ps-print-header %s
1139 ps-print-header-frame %s
1140 ps-header-lines %s
1141 ps-show-n-of-n %s
1142 ps-spool-duplex %s
1143
1144 ps-font-family '%s
1145 ps-font-size %s
1146 ps-header-font-family '%s
1147 ps-header-font-size %s
1148 ps-header-title-font-size %s)
1149"
1150 ps-print-color-p
1151 ps-lpr-command
1152 ps-lpr-switches
1153 ps-paper-type
1154 ps-landscape-mode
1155 ps-number-of-columns
1156 ps-left-margin
1157 ps-right-margin
1158 ps-inter-column
1159 ps-bottom-margin
1160 ps-top-margin
1161 ps-header-offset
1162 ps-header-line-pad
1163 ps-print-header
1164 ps-print-header-frame
1165 ps-header-lines
1166 ps-show-n-of-n
1167 ps-spool-duplex
1168 ps-font-family
1169 ps-font-size
1170 ps-header-font-family
1171 ps-header-font-size
1172 ps-header-title-font-size))
1173
687;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1174;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
688;; Utility functions and variables: 1175;; Utility functions and variables:
689 1176
@@ -702,12 +1189,41 @@ number, prompt the user for the name of the file to save in."
702 1189
703(require 'time-stamp) 1190(require 'time-stamp)
704 1191
705(defvar ps-print-prologue "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: 1192(defvar ps-font nil
706% If the ISOLatin1Encoding vector isn't known, define it. 1193 "Font family name for ordinary text, when generating Postscript.")
1194
1195(defvar ps-font-bold nil
1196 "Font family name for bold text, when generating Postscript.")
1197
1198(defvar ps-font-italic nil
1199 "Font family name for italic text, when generating Postscript.")
1200
1201(defvar ps-font-bold-italic nil
1202 "Font family name for bold italic text, when generating Postscript.")
1203
1204(defvar ps-avg-char-width nil
1205 "The average width, in points, of a character, for generating Postscript.
1206This is the value that ps-print uses to determine the length,
1207x-dimension, of the text it has printed, and thus affects the point at
1208which long lines wrap around.")
1209
1210(defvar ps-space-width nil
1211 "The width of a space character, for generating Postscript.
1212This value is used in expanding tab characters.")
1213
1214(defvar ps-line-height nil
1215 "The height of a line, for generating Postscript.
1216This is the value that ps-print uses to determine the height,
1217y-dimension, of the lines of text it has printed, and thus affects the
1218point at which page-breaks are placed.
1219The line-height is *not* the same as the point size of the font.")
1220
1221(defvar ps-print-prologue-1
1222 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
707/ISOLatin1Encoding where { pop } { 1223/ISOLatin1Encoding where { pop } {
708% Define the ISO Latin-1 encoding vector. 1224% -- The ISO Latin-1 encoding vector isn't known, so define it.
709% The first half is the same as the standard encoding, 1225% -- The first half is the same as the standard encoding,
710% except for minus instead of hyphen at code 055. 1226% -- except for minus instead of hyphen at code 055.
711/ISOLatin1Encoding 1227/ISOLatin1Encoding
712StandardEncoding 0 45 getinterval aload pop 1228StandardEncoding 0 45 getinterval aload pop
713 /minus 1229 /minus
@@ -715,12 +1231,12 @@ StandardEncoding 46 82 getinterval aload pop
715%*** NOTE: the following are missing in the Adobe documentation, 1231%*** NOTE: the following are missing in the Adobe documentation,
716%*** but appear in the displayed table: 1232%*** but appear in the displayed table:
717%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240. 1233%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
718% ^Px 1234% 0200 (128)
719 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef 1235 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
720 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef 1236 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
721 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent 1237 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
722 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron 1238 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
723% ^Tx 1239% 0240 (160)
724 /space /exclamdown /cent /sterling 1240 /space /exclamdown /cent /sterling
725 /currency /yen /brokenbar /section 1241 /currency /yen /brokenbar /section
726 /dieresis /copyright /ordfeminine /guillemotleft 1242 /dieresis /copyright /ordfeminine /guillemotleft
@@ -729,7 +1245,7 @@ StandardEncoding 46 82 getinterval aload pop
729 /acute /mu /paragraph /periodcentered 1245 /acute /mu /paragraph /periodcentered
730 /cedilla /onesuperior /ordmasculine /guillemotright 1246 /cedilla /onesuperior /ordmasculine /guillemotright
731 /onequarter /onehalf /threequarters /questiondown 1247 /onequarter /onehalf /threequarters /questiondown
732% ^Xx 1248% 0300 (192)
733 /Agrave /Aacute /Acircumflex /Atilde 1249 /Agrave /Aacute /Acircumflex /Atilde
734 /Adieresis /Aring /AE /Ccedilla 1250 /Adieresis /Aring /AE /Ccedilla
735 /Egrave /Eacute /Ecircumflex /Edieresis 1251 /Egrave /Eacute /Ecircumflex /Edieresis
@@ -738,7 +1254,7 @@ StandardEncoding 46 82 getinterval aload pop
738 /Ocircumflex /Otilde /Odieresis /multiply 1254 /Ocircumflex /Otilde /Odieresis /multiply
739 /Oslash /Ugrave /Uacute /Ucircumflex 1255 /Oslash /Ugrave /Uacute /Ucircumflex
740 /Udieresis /Yacute /Thorn /germandbls 1256 /Udieresis /Yacute /Thorn /germandbls
741% ^\\x 1257% 0340 (224)
742 /agrave /aacute /acircumflex /atilde 1258 /agrave /aacute /acircumflex /atilde
743 /adieresis /aring /ae /ccedilla 1259 /adieresis /aring /ae /ccedilla
744 /egrave /eacute /ecircumflex /edieresis 1260 /egrave /eacute /ecircumflex /edieresis
@@ -752,21 +1268,16 @@ StandardEncoding 46 82 getinterval aload pop
752 1268
753/reencodeFontISO { %def 1269/reencodeFontISO { %def
754 dup 1270 dup
755 length 5 add dict % Make a new font (a new dict 1271 length 5 add dict % Make a new font (a new dict the same size
756 % the same size as the old 1272 % as the old one) with room for our new symbols.
757 % one) with room for our new
758 % symbols.
759 1273
760 begin % Make the new font the 1274 begin % Make the new font the current dictionary.
761 % current dictionary.
762 1275
763 1276
764 { 1 index /FID ne 1277 { 1 index /FID ne
765 { def } { pop pop } ifelse 1278 { def } { pop pop } ifelse
766 } forall % Copy each of the symbols 1279 } forall % Copy each of the symbols from the old dictionary
767 % from the old dictionary to 1280 % to the new one except for the font ID.
768 % the new except for the font
769 % ID.
770 1281
771 /Encoding ISOLatin1Encoding def % Override the encoding with 1282 /Encoding ISOLatin1Encoding def % Override the encoding with
772 % the ISOLatin1 encoding. 1283 % the ISOLatin1 encoding.
@@ -774,14 +1285,27 @@ StandardEncoding 46 82 getinterval aload pop
774 % Use the font's bounding box to determine the ascent, descent, 1285 % Use the font's bounding box to determine the ascent, descent,
775 % and overall height; don't forget that these values have to be 1286 % and overall height; don't forget that these values have to be
776 % transformed using the font's matrix. 1287 % transformed using the font's matrix.
777 FontBBox 1288
778 FontMatrix transform /Ascent exch def pop 1289% ^ (x2 y2)
1290% | |
1291% | v
1292% | +----+ - -
1293% | | | ^
1294% | | | | Ascent (usually > 0)
1295% | | | |
1296% (0 0) -> +--+----+-------->
1297% | | |
1298% | | v Descent (usually < 0)
1299% (x1 y1) --> +----+ - -
1300
1301 FontBBox % -- x1 y1 x2 y2
1302 FontMatrix transform /Ascent exch def pop
779 FontMatrix transform /Descent exch def pop 1303 FontMatrix transform /Descent exch def pop
780 /FontHeight Ascent Descent sub def 1304 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
781 1305
782 % Define these in case they're not in the FontInfo (also, here 1306 % Define these in case they're not in the FontInfo
783 % they're easier to get to. 1307 % (also, here they're easier to get to.
784 /UnderlinePosition 1 def 1308 /UnderlinePosition 1 def
785 /UnderlineThickness 1 def 1309 /UnderlineThickness 1 def
786 1310
787 % Get the underline position and thickness if they're defined. 1311 % Get the underline position and thickness if they're defined.
@@ -802,28 +1326,22 @@ StandardEncoding 46 82 getinterval aload pop
802 1326
803 } if 1327 } if
804 1328
805 currentdict % Leave the new font on the 1329 currentdict % Leave the new font on the stack
806 % stack 1330 end % Stop using the font as the current dictionary.
807 1331 definefont % Put the font into the font dictionary
808 end % Stop using the font as the 1332 pop % Discard the returned font.
809 % current dictionary.
810
811 definefont % Put the font into the font
812 % dictionary
813
814 pop % Discard the returned font.
815} bind def 1333} bind def
816 1334
817/Font { 1335/DefFont { % Font definition
818 findfont exch scalefont reencodeFontISO 1336 findfont exch scalefont reencodeFontISO
819} def 1337} def
820 1338
821/F { % Font select 1339/F { % Font selection
822 findfont 1340 findfont
823 dup /Ascent get /Ascent exch def 1341 dup /Ascent get /Ascent exch def
824 dup /Descent get /Descent exch def 1342 dup /Descent get /Descent exch def
825 dup /FontHeight get /FontHeight exch def 1343 dup /FontHeight get /FontHeight exch def
826 dup /UnderlinePosition get /UnderlinePosition exch def 1344 dup /UnderlinePosition get /UnderlinePosition exch def
827 dup /UnderlineThickness get /UnderlineThickness exch def 1345 dup /UnderlineThickness get /UnderlineThickness exch def
828 setfont 1346 setfont
829} def 1347} def
@@ -836,15 +1354,23 @@ StandardEncoding 46 82 getinterval aload pop
836 { mark 4 1 roll ] /bgcolor exch def } if 1354 { mark 4 1 roll ] /bgcolor exch def } if
837} def 1355} def
838 1356
1357% B width C
1358% +-----------+
1359% | Ascent (usually > 0)
1360% A + +
1361% | Descent (usually < 0)
1362% +-----------+
1363% E width D
1364
839/dobackground { % width -- 1365/dobackground { % width --
840 currentpoint 1366 currentpoint % -- width x y
841 gsave 1367 gsave
842 newpath 1368 newpath
843 moveto 1369 moveto % A (x y)
844 0 Ascent rmoveto 1370 0 Ascent rmoveto % B
845 dup 0 rlineto 1371 dup 0 rlineto % C
846 0 Descent Ascent sub rlineto 1372 0 Descent Ascent sub rlineto % D
847 neg 0 rlineto 1373 neg 0 rlineto % E
848 closepath 1374 closepath
849 bgcolor aload pop setrgbcolor 1375 bgcolor aload pop setrgbcolor
850 fill 1376 fill
@@ -867,20 +1393,23 @@ StandardEncoding 46 82 getinterval aload pop
867 grestore 1393 grestore
868} def 1394} def
869 1395
870/eolbg { 1396/eolbg { % dobackground until right margin
871 currentpoint pop 1397 PrintWidth % -- x-eol
872 PrintWidth LeftMargin add exch sub dobackground 1398 currentpoint pop % -- cur-x
1399 sub % -- width until eol
1400 dobackground
873} def 1401} def
874 1402
875/eolul { 1403/eolul { % idem for underline
876 currentpoint exch pop 1404 PrintWidth % -- x-eol
877 PrintWidth LeftMargin add exch dounderline 1405 currentpoint exch pop % -- x-eol cur-y
1406 dounderline
878} def 1407} def
879 1408
880/SL { % Soft Linefeed 1409/SL { % Soft Linefeed
881 bg { eolbg } if 1410 bg { eolbg } if
882 ul { eolul } if 1411 ul { eolul } if
883 currentpoint LineHeight sub LeftMargin exch moveto pop 1412 0 currentpoint exch pop LineHeight sub moveto
884} def 1413} def
885 1414
886/HL /SL load def % Hard Linefeed 1415/HL /SL load def % Hard Linefeed
@@ -901,18 +1430,48 @@ StandardEncoding 46 82 getinterval aload pop
901 1430
902/W { 1431/W {
903 ul { sp1 } if 1432 ul { sp1 } if
904 ( ) stringwidth % Get the width of a space 1433 ( ) stringwidth % Get the width of a space in the current font.
905 pop % Discard the Y component 1434 pop % Discard the Y component.
906 mul % Multiply the width of a 1435 mul % Multiply the width of a space
907 % space by the number of 1436 % by the number of spaces to plot
908 % spaces to plot
909 bg { dup dobackground } if 1437 bg { dup dobackground } if
910 0 rmoveto 1438 0 rmoveto
911 ul { dounderline } if 1439 ul { dounderline } if
912} def 1440} def
913 1441
1442/BeginDoc {
1443 % ---- save the state of the document (useful for ghostscript!)
1444 /docState save def
1445 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
1446 /JackGhostscript where {
1447 pop 1 27.7 29.7 div scale
1448 } if
1449 LandscapeMode {
1450 % ---- translate to bottom-right corner of Portrait page
1451 LandscapePageHeight 0 translate
1452 90 rotate
1453 } if
1454 /ColumnWidth PrintWidth InterColumn add def
1455 % ---- translate to lower left corner of TEXT
1456 LeftMargin BottomMargin translate
1457 % ---- define where printing will start
1458 /f0 F % this installs Ascent
1459 /PrintStartY PrintHeight Ascent sub def
1460 /ColumnIndex 1 def
1461} def
1462
1463/EndDoc {
1464 % ---- on last page but not last column, spit out the page
1465 ColumnIndex 1 eq not { showpage } if
1466 % ---- restore the state of the document (useful for ghostscript!)
1467 docState restore
1468} def
1469
914/BeginDSCPage { 1470/BeginDSCPage {
915 /vmstate save def 1471 % ---- when 1st column, save the state of the page
1472 ColumnIndex 1 eq { /pageState save def } if
1473 % ---- save the state of the column
1474 /columnState save def
916} def 1475} def
917 1476
918/BeginPage { 1477/BeginPage {
@@ -920,71 +1479,90 @@ StandardEncoding 46 82 getinterval aload pop
920 PrintHeaderFrame { HeaderFrame } if 1479 PrintHeaderFrame { HeaderFrame } if
921 HeaderText 1480 HeaderText
922 } if 1481 } if
923 LeftMargin 1482 0 PrintStartY moveto % move to where printing will start
924 BottomMargin PrintHeight add
925 moveto % move to where printing will
926 % start.
927} def 1483} def
928 1484
929/EndPage { 1485/EndPage {
930 bg { eolbg } if 1486 bg { eolbg } if
931 ul { eolul } if 1487 ul { eolul } if
932 showpage % Spit out a page
933} def 1488} def
934 1489
935/EndDSCPage { 1490/EndDSCPage {
936 vmstate restore 1491 ColumnIndex NumberOfColumns eq {
1492 % ---- on last column, spit out the page
1493 showpage
1494 % ---- restore the state of the page
1495 pageState restore
1496 /ColumnIndex 1 def
1497 } { % else
1498 % ---- restore the state of the current column
1499 columnState restore
1500 % ---- and translate to the next column
1501 ColumnWidth 0 translate
1502 /ColumnIndex ColumnIndex 1 add def
1503 } ifelse
937} def 1504} def
938 1505
939/ul false def 1506/ul false def
940 1507
941/UL { /ul exch def } def 1508/UL { /ul exch def } def
942 1509
943/h0 14 /Helvetica-Bold Font 1510/SetHeaderLines { % nb-lines --
944/h1 12 /Helvetica Font
945
946/h1 F
947
948/HeaderLineHeight FontHeight def
949/HeaderDescent Descent def
950/HeaderPad 2 def
951
952/SetHeaderLines {
953 /HeaderOffset TopMargin 2 div def
954 /HeaderLines exch def 1511 /HeaderLines exch def
955 /HeaderHeight HeaderLines HeaderLineHeight mul HeaderPad 2 mul add def 1512 % ---- bottom up
956 /PrintHeight PrintHeight HeaderHeight sub def 1513 HeaderPad
1514 HeaderLines 1 sub HeaderLineHeight mul add
1515 HeaderTitleLineHeight add
1516 HeaderPad add
1517 /HeaderHeight exch def
957} def 1518} def
958 1519
959/HeaderFrameStart { 1520% |---------|
960 LeftMargin BottomMargin PrintHeight add HeaderOffset add 1521% | tm |
1522% |---------|
1523% | header |
1524% |-+-------| <-- (x y)
1525% | ho |
1526% |---------|
1527% | text |
1528% |-+-------| <-- (0 0)
1529% | bm |
1530% |---------|
1531
1532/HeaderFrameStart { % -- x y
1533 0 PrintHeight HeaderOffset add
961} def 1534} def
962 1535
963/HeaderFramePath { 1536/HeaderFramePath {
964 PrintWidth 0 rlineto 1537 PrintWidth 0 rlineto
965 0 HeaderHeight rlineto 1538 0 HeaderHeight rlineto
966 PrintWidth neg 0 rlineto 1539 PrintWidth neg 0 rlineto
967 0 HeaderHeight neg rlineto 1540 0 HeaderHeight neg rlineto
968} def 1541} def
969 1542
970/HeaderFrame { 1543/HeaderFrame {
971 gsave 1544 gsave
972 0.4 setlinewidth 1545 0.4 setlinewidth
1546 % ---- fill a black rectangle (the shadow of the next one)
973 HeaderFrameStart moveto 1547 HeaderFrameStart moveto
974 1 -1 rmoveto 1548 1 -1 rmoveto
975 HeaderFramePath 1549 HeaderFramePath
976 0 setgray fill 1550 0 setgray fill
1551 % ---- do the next rectangle ...
977 HeaderFrameStart moveto 1552 HeaderFrameStart moveto
978 HeaderFramePath 1553 HeaderFramePath
979 gsave 0.9 setgray fill grestore 1554 gsave 0.9 setgray fill grestore % filled with grey
980 gsave 0 setgray stroke grestore 1555 gsave 0 setgray stroke grestore % drawn with black
981 grestore 1556 grestore
982} def 1557} def
983 1558
984/HeaderStart { 1559/HeaderStart {
985 HeaderFrameStart 1560 HeaderFrameStart
986 exch HeaderPad add exch 1561 exch HeaderPad add exch % horizontal pad
987 HeaderLineHeight HeaderLines 1 sub mul add HeaderDescent sub HeaderPad add 1562 % ---- bottom up
1563 HeaderPad add % vertical pad
1564 HeaderDescent sub
1565 HeaderLineHeight HeaderLines 1 sub mul add
988} def 1566} def
989 1567
990/strcat { 1568/strcat {
@@ -1004,10 +1582,14 @@ StandardEncoding 46 82 getinterval aload pop
1004/HeaderText { 1582/HeaderText {
1005 HeaderStart moveto 1583 HeaderStart moveto
1006 1584
1007 HeaderLinesRight HeaderLinesLeft 1585 HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
1586
1587 % ---- hack: `PN 1 and' == `PN 2 modulo'
1588
1589 % ---- if duplex and even page number, then exchange left and right
1008 Duplex PageNumber 1 and 0 eq and { exch } if 1590 Duplex PageNumber 1 and 0 eq and { exch } if
1009 1591
1010 { 1592 { % ---- process the left lines
1011 aload pop 1593 aload pop
1012 exch F 1594 exch F
1013 gsave 1595 gsave
@@ -1019,7 +1601,7 @@ StandardEncoding 46 82 getinterval aload pop
1019 1601
1020 HeaderStart moveto 1602 HeaderStart moveto
1021 1603
1022 { 1604 { % ---- process the right lines
1023 aload pop 1605 aload pop
1024 exch F 1606 exch F
1025 gsave 1607 gsave
@@ -1034,15 +1616,14 @@ StandardEncoding 46 82 getinterval aload pop
1034 1616
1035/ReportFontInfo { 1617/ReportFontInfo {
1036 2 copy 1618 2 copy
1037 /t0 3 1 roll Font 1619 /t0 3 1 roll DefFont
1038 /t0 F 1620 /t0 F
1039 /lh FontHeight def 1621 /lh FontHeight def
1040 /sw ( ) stringwidth pop def 1622 /sw ( ) stringwidth pop def
1041 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch 1623 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
1042 stringwidth pop exch div def 1624 stringwidth pop exch div def
1043 /t1 12 /Helvetica-Oblique Font 1625 /t1 12 /Helvetica-Oblique DefFont
1044 /t1 F 1626 /t1 F
1045 72 72 moveto
1046 gsave 1627 gsave
1047 (For ) show 1628 (For ) show
1048 128 string cvs show 1629 128 string cvs show
@@ -1055,13 +1636,43 @@ StandardEncoding 46 82 getinterval aload pop
1055 (,) show 1636 (,) show
1056 grestore 1637 grestore
1057 0 FontHeight neg rmoveto 1638 0 FontHeight neg rmoveto
1058 (and a crude estimate of average character width is ) show 1639 gsave
1059 aw 32 string cvs show 1640 (and a crude estimate of average character width is ) show
1060 (.) show 1641 aw 32 string cvs show
1061 showpage 1642 (.) show
1643 grestore
1644 0 FontHeight neg rmoveto
1645} def
1646
1647/cm { % cm to point
1648 72 mul 2.54 div
1649} def
1650
1651/ReportAllFontInfo {
1652 FontDirectory
1653 { % key = font name value = font dictionary
1654 pop 10 exch ReportFontInfo
1655 } forall
1062} def 1656} def
1063 1657
1064% 10 /Courier ReportFontInfo 1658% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
1659% 3 cm 20 cm moveto ReportAllFontInfo showpage
1660
1661")
1662
1663(defvar ps-print-prologue-2
1664 "
1665% ---- These lines must be kept together because...
1666
1667/h0 F
1668/HeaderTitleLineHeight FontHeight def
1669
1670/h1 F
1671/HeaderLineHeight FontHeight def
1672/HeaderDescent Descent def
1673
1674% ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
1675
1065") 1676")
1066 1677
1067;; Start Editing Here: 1678;; Start Editing Here:
@@ -1084,64 +1695,39 @@ StandardEncoding 46 82 getinterval aload pop
1084 1695
1085(defvar ps-razchunk 0) 1696(defvar ps-razchunk 0)
1086 1697
1087(defvar ps-color-format (if (eq ps-print-emacs-type 'emacs) 1698(defvar ps-color-format
1699 (if (eq ps-print-emacs-type 'emacs)
1088 1700
1089 ;;Emacs understands the %f format; we'll 1701 ;;Emacs understands the %f format; we'll
1090 ;;use it to limit color RGB values to 1702 ;;use it to limit color RGB values to
1091 ;;three decimals to cut down some on the 1703 ;;three decimals to cut down some on the
1092 ;;size of the PostScript output. 1704 ;;size of the PostScript output.
1093 "%0.3f %0.3f %0.3f" 1705 "%0.3f %0.3f %0.3f"
1094 1706
1095 ;; Lucid emacsen will have to make do with 1707 ;; Lucid emacsen will have to make do with
1096 ;; %s (princ) for floats. 1708 ;; %s (princ) for floats.
1097 "%s %s %s")) 1709 "%s %s %s"))
1098 1710
1099;; These values determine how much print-height to deduct when headers 1711;; These values determine how much print-height to deduct when headers
1100;; are turned on. This is a pretty clumsy way of handling it, but 1712;; are turned on. This is a pretty clumsy way of handling it, but
1101;; it'll do for now. 1713;; it'll do for now.
1102(defvar ps-header-title-line-height (if (fboundp 'float) 16.0 16));Helvetica 14
1103(defvar ps-header-line-height (if (fboundp 'float) 13.7 14));Helvetica 12
1104(defvar ps-header-pad 2)
1105
1106;; LetterSmall 7.68 inch 10.16 inch
1107;; Tabloid 11.0 inch 17.0 inch
1108;; Ledger 17.0 inch 11.0 inch
1109;; Statement 5.5 inch 8.5 inch
1110;; Executive 7.5 inch 10.0 inch
1111;; A3 11.69 inch 16.5 inch
1112;; A4Small 7.47 inch 10.85 inch
1113;; B4 10.125 inch 14.33 inch
1114;; B5 7.16 inch 10.125 inch
1115
1116;; All page dimensions are in PostScript points.
1117
1118(defvar ps-left-margin 72) ; 1 inch
1119(defvar ps-right-margin 72) ; 1 inch
1120(defvar ps-bottom-margin 36) ; 1/2 inch
1121(defvar ps-top-margin 72) ; 1 inch
1122 1714
1123;; Letter 8.5 inch x 11.0 inch 1715(defvar ps-header-font)
1124(defvar ps-letter-page-height 792) ; 11 inches 1716(defvar ps-header-title-font)
1125(defvar ps-letter-page-width 612) ; 8.5 inches
1126 1717
1127;; Legal 8.5 inch x 14.0 inch 1718(defvar ps-header-line-height)
1128(defvar ps-legal-page-height 1008) ; 14.0 inches 1719(defvar ps-header-title-line-height)
1129(defvar ps-legal-page-width 612) ; 8.5 inches 1720(defvar ps-header-pad 0
1721 "Vertical and horizontal space in points (1/72 inch) between the header frame
1722and the text it contains.")
1130 1723
1131;; A4 8.26 inch x 11.69 inch 1724;; Define accessors to the dimensions list.
1132(defvar ps-a4-page-height 842) ; 11.69 inches
1133(defvar ps-a4-page-width 595) ; 8.26 inches
1134 1725
1135(defvar ps-pages-alist 1726(defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
1136 (list (list 'ps-letter ps-letter-page-width ps-letter-page-height) 1727(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
1137 (list 'ps-legal ps-legal-page-width ps-legal-page-height)
1138 (list 'ps-a4 ps-a4-page-width ps-a4-page-height)))
1139 1728
1140;; Define some constants to index into the page lists. 1729(defvar ps-landscape-page-height)
1141(defvar ps-page-width-i 1)
1142(defvar ps-page-height-i 2)
1143 1730
1144(defvar ps-page-dimensions nil)
1145(defvar ps-print-width nil) 1731(defvar ps-print-width nil)
1146(defvar ps-print-height nil) 1732(defvar ps-print-height nil)
1147 1733
@@ -1152,15 +1738,239 @@ StandardEncoding 46 82 getinterval aload pop
1152(defvar ps-ref-italic-faces nil) 1738(defvar ps-ref-italic-faces nil)
1153(defvar ps-ref-underlined-faces nil) 1739(defvar ps-ref-underlined-faces nil)
1154 1740
1741(defvar ps-print-color-scale nil)
1742
1155;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1743;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1156;; Internal functions 1744;; Internal functions
1157 1745
1746(defun ps-line-lengths-internal ()
1747 "Display the correspondance between a line length and a font size,
1748using the current ps-print setup.
1749Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1750 (let ((buf (get-buffer-create "*Line-lengths*"))
1751 (ifs ps-font-size) ; initial font size
1752 (icw ps-avg-char-width) ; initial character width
1753 (print-width (progn (ps-get-page-dimensions)
1754 ps-print-width))
1755 (ps-setup (ps-setup)) ; setup for the current buffer
1756 (fs-min 5) ; minimum font size
1757 cw-min ; minimum character width
1758 nb-cpl-max ; maximum nb of characters per line
1759 (fs-max 14) ; maximum font size
1760 cw-max ; maximum character width
1761 nb-cpl-min ; minimum nb of characters per line
1762 fs ; current font size
1763 cw ; current character width
1764 nb-cpl ; current nb of characters per line
1765 )
1766 (setq cw-min (/ (* icw fs-min) ifs)
1767 nb-cpl-max (floor (/ print-width cw-min))
1768 cw-max (/ (* icw fs-max) ifs)
1769 nb-cpl-min (floor (/ print-width cw-max)))
1770 (setq nb-cpl nb-cpl-min)
1771 (set-buffer buf)
1772 (goto-char (point-max))
1773 (if (not (bolp)) (insert "\n"))
1774 (insert ps-setup)
1775 (insert "nb char per line / font size\n")
1776 (while (<= nb-cpl nb-cpl-max)
1777 (setq cw (/ print-width (float nb-cpl))
1778 fs (/ (* ifs cw) icw))
1779 (insert (format "%3s %s\n" nb-cpl fs))
1780 (setq nb-cpl (1+ nb-cpl)))
1781 (insert "\n")
1782 (display-buffer buf 'not-this-window)))
1783
1784(defun ps-nb-pages (nb-lines)
1785 "Display an approximate correspondance between a font size and the number
1786of pages the number of lines would require to print
1787using the current ps-print setup."
1788 (let ((buf (get-buffer-create "*Nb-Pages*"))
1789 (ifs ps-font-size) ; initial font size
1790 (ilh ps-line-height) ; initial line height
1791 (page-height (progn (ps-get-page-dimensions)
1792 ps-print-height))
1793 (ps-setup (ps-setup)) ; setup for the current buffer
1794 (fs-min 4) ; minimum font size
1795 lh-min ; minimum line height
1796 nb-lpp-max ; maximum nb of lines per page
1797 nb-page-min ; minimum nb of pages
1798 (fs-max 14) ; maximum font size
1799 lh-max ; maximum line height
1800 nb-lpp-min ; minimum nb of lines per page
1801 nb-page-max ; maximum nb of pages
1802 fs ; current font size
1803 lh ; current line height
1804 nb-lpp ; current nb of lines per page
1805 nb-page ; current nb of pages
1806 )
1807 (setq lh-min (/ (* ilh fs-min) ifs)
1808 nb-lpp-max (floor (/ page-height lh-min))
1809 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
1810 lh-max (/ (* ilh fs-max) ifs)
1811 nb-lpp-min (floor (/ page-height lh-max))
1812 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)))
1813 (setq nb-page nb-page-min)
1814 (set-buffer buf)
1815 (goto-char (point-max))
1816 (if (not (bolp)) (insert "\n"))
1817 (insert ps-setup)
1818 (insert (format "%d lines\n" nb-lines))
1819 (insert "nb page / font size\n")
1820 (while (<= nb-page nb-page-max)
1821 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
1822 lh (/ page-height nb-lpp)
1823 fs (/ (* ifs lh) ilh))
1824 (insert (format "%s %s\n" nb-page fs))
1825 (setq nb-page (1+ nb-page)))
1826 (insert "\n")
1827 (display-buffer buf 'not-this-window)))
1828
1829(defun ps-select-font ()
1830 "Choose the font name and size (scaling data)."
1831 (let ((assoc (assq ps-font-family ps-font-info-database))
1832 l fn fb fi bi sz lh sw aw)
1833 (if (null assoc)
1834 (error "Don't have data to scale font %s. Known fonts families are %s"
1835 ps-font-family
1836 (mapcar 'car ps-font-info-database)))
1837 (setq l (cdr assoc)
1838 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
1839 fb (prog1 (car l) (setq l (cdr l)))
1840 fi (prog1 (car l) (setq l (cdr l)))
1841 bi (prog1 (car l) (setq l (cdr l)))
1842 sz (prog1 (car l) (setq l (cdr l)))
1843 lh (prog1 (car l) (setq l (cdr l)))
1844 sw (prog1 (car l) (setq l (cdr l)))
1845 aw (prog1 (car l) (setq l (cdr l))))
1846
1847 (setq ps-font fn)
1848 (setq ps-font-bold fb)
1849 (setq ps-font-italic fi)
1850 (setq ps-font-bold-italic bi)
1851 ;; These data just need to be rescaled:
1852 (setq ps-line-height (/ (* lh ps-font-size) sz))
1853 (setq ps-space-width (/ (* sw ps-font-size) sz))
1854 (setq ps-avg-char-width (/ (* aw ps-font-size) sz))
1855 ps-font-family))
1856
1857(defun ps-select-header-font ()
1858 "Choose the font name and size (scaling data) for the header."
1859 (let ((assoc (assq ps-header-font-family ps-font-info-database))
1860 l fn fb fi bi sz lh sw aw)
1861 (if (null assoc)
1862 (error "Don't have data to scale font %s. Known fonts families are %s"
1863 ps-font-family
1864 (mapcar 'car ps-font-info-database)))
1865 (setq l (cdr assoc)
1866 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
1867 fb (prog1 (car l) (setq l (cdr l)))
1868 fi (prog1 (car l) (setq l (cdr l)))
1869 bi (prog1 (car l) (setq l (cdr l)))
1870 sz (prog1 (car l) (setq l (cdr l)))
1871 lh (prog1 (car l) (setq l (cdr l)))
1872 sw (prog1 (car l) (setq l (cdr l)))
1873 aw (prog1 (car l) (setq l (cdr l))))
1874
1875 ;; Font name
1876 (setq ps-header-font fn)
1877 (setq ps-header-title-font fb)
1878 ;; Line height: These data just need to be rescaled:
1879 (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz))
1880 (setq ps-header-line-height (/ (* lh ps-header-font-size) sz))
1881 ps-header-font-family))
1882
1158(defun ps-get-page-dimensions () 1883(defun ps-get-page-dimensions ()
1159 (setq ps-page-dimensions (assq ps-paper-type ps-pages-alist)) 1884 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
1160 (let ((ps-page-width (nth ps-page-width-i ps-page-dimensions)) 1885 page-width page-height)
1161 (ps-page-height (nth ps-page-height-i ps-page-dimensions))) 1886 (cond
1162 (setq ps-print-height (- ps-page-height ps-top-margin ps-bottom-margin)) 1887 ((null page-dimensions)
1163 (setq ps-print-width (- ps-page-width ps-left-margin ps-right-margin)))) 1888 (error "`ps-paper-type' must be one of:\n%s"
1889 (mapcar 'car ps-page-dimensions-database)))
1890 ((< ps-number-of-columns 1)
1891 (error "The number of columns %d should not be negative")))
1892
1893 (ps-select-font)
1894 (ps-select-header-font)
1895
1896 (setq page-width (ps-page-dimensions-get-width page-dimensions)
1897 page-height (ps-page-dimensions-get-height page-dimensions))
1898
1899 ;; Landscape mode
1900 (if ps-landscape-mode
1901 ;; exchange width and height
1902 (setq page-width (prog1 page-height (setq page-height page-width))))
1903
1904 ;; It is used to get the lower right corner (only in landscape mode)
1905 (setq ps-landscape-page-height page-height)
1906
1907 ;; | lm | text | ic | text | ic | text | rm |
1908 ;; page-width == lm + n * pw + (n - 1) * ic + rm
1909 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
1910 (setq ps-print-width
1911 (/ (- page-width
1912 ps-left-margin ps-right-margin
1913 (* (1- ps-number-of-columns) ps-inter-column))
1914 ps-number-of-columns))
1915 (if (<= ps-print-width 0)
1916 (error "Bad horizontal layout:
1917page-width == %s
1918ps-left-margin == %s
1919ps-right-margin == %s
1920ps-inter-column == %s
1921ps-number-of-columns == %s
1922| lm | text | ic | text | ic | text | rm |
1923page-width == lm + n * print-width + (n - 1) * ic + rm
1924=> print-width == %d !"
1925 page-width
1926 ps-left-margin
1927 ps-right-margin
1928 ps-inter-column
1929 ps-number-of-columns
1930 ps-print-width))
1931
1932 (setq ps-print-height
1933 (- page-height ps-bottom-margin ps-top-margin))
1934 (if (<= ps-print-height 0)
1935 (error "Bad vertical layout:
1936ps-top-margin == %s
1937ps-bottom-margin == %s
1938page-height == bm + print-height + tm
1939=> print-height == %d !"
1940 ps-top-margin
1941 ps-bottom-margin
1942 ps-print-height))
1943 ;; If headers are turned on, deduct the height of the header from
1944 ;; the print height.
1945 (cond
1946 (ps-print-header
1947 (setq ps-header-pad
1948 (* ps-header-line-pad ps-header-title-line-height))
1949 (setq ps-print-height
1950 (- ps-print-height
1951 ps-header-offset
1952 ps-header-pad
1953 ps-header-title-line-height
1954 (* ps-header-line-height (- ps-header-lines 1))
1955 ps-header-pad))))
1956 (if (<= ps-print-height 0)
1957 (error "Bad vertical layout:
1958ps-top-margin == %s
1959ps-bottom-margin == %s
1960ps-header-offset == %s
1961ps-header-pad == %s
1962header-height == %s
1963page-height == bm + print-height + tm - ho - hh
1964=> print-height == %d !"
1965 ps-top-margin
1966 ps-bottom-margin
1967 ps-header-offset
1968 ps-header-pad
1969 (+ ps-header-pad
1970 ps-header-title-line-height
1971 (* ps-header-line-height (- ps-header-lines 1))
1972 ps-header-pad)
1973 ps-print-height))))
1164 1974
1165(defun ps-print-preprint (&optional filename) 1975(defun ps-print-preprint (&optional filename)
1166 (if (and filename 1976 (if (and filename
@@ -1273,6 +2083,7 @@ StandardEncoding 46 82 getinterval aload pop
1273 (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) 2083 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
1274 2084
1275(defun ps-begin-file () 2085(defun ps-begin-file ()
2086 (ps-get-page-dimensions)
1276 (setq ps-showpage-count 0) 2087 (setq ps-showpage-count 0)
1277 2088
1278 (ps-output ps-adobe-tag) 2089 (ps-output ps-adobe-tag)
@@ -1281,36 +2092,53 @@ StandardEncoding 46 82 getinterval aload pop
1281 (ps-output "%%Creator: " (user-full-name) "\n") 2092 (ps-output "%%Creator: " (user-full-name) "\n")
1282 (ps-output "%%CreationDate: " 2093 (ps-output "%%CreationDate: "
1283 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n") 2094 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n")
1284 (ps-output "%% DocumentFonts: Helvetica Helvetica-Bold " 2095 (ps-output "%% DocumentFonts: "
1285 ps-font " " ps-font-bold " " ps-font-italic " " 2096 ps-font " " ps-font-bold " " ps-font-italic " "
1286 ps-font-bold-italic "\n") 2097 ps-font-bold-italic " "
2098 ps-header-font " " ps-header-title-font "\n")
1287 (ps-output "%%Pages: (atend)\n") 2099 (ps-output "%%Pages: (atend)\n")
1288 (ps-output "%%EndComments\n\n") 2100 (ps-output "%%EndComments\n\n")
1289 2101
1290 (ps-output-boolean "Duplex" ps-spool-duplex) 2102 (ps-output-boolean "LandscapeMode" ps-landscape-mode)
1291 (ps-output-boolean "PrintHeader" ps-print-header) 2103 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns))
1292 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
1293 (ps-output-boolean "ShowNofN" ps-show-n-of-n)
1294 2104
1295 (ps-output (format "/LeftMargin %d def\n" ps-left-margin)) 2105 (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height))
1296 (ps-output (format "/RightMargin %d def\n" ps-right-margin)) 2106 (ps-output (format "/PrintWidth %s def\n" ps-print-width))
1297 (ps-output (format "/BottomMargin %d def\n" ps-bottom-margin)) 2107 (ps-output (format "/PrintHeight %s def\n" ps-print-height))
1298 (ps-output (format "/TopMargin %d def\n" ps-top-margin))
1299 2108
1300 (ps-get-page-dimensions) 2109 (ps-output (format "/LeftMargin %s def\n" ps-left-margin))
1301 (ps-output (format "/PrintWidth %d def\n" ps-print-width)) 2110 (ps-output (format "/RightMargin %s def\n" ps-right-margin)) ; not used
1302 (ps-output (format "/PrintHeight %d def\n" ps-print-height)) 2111 (ps-output (format "/InterColumn %s def\n" ps-inter-column))
1303 2112
1304 (ps-output (format "/LineHeight %s def\n" ps-line-height)) 2113 (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin))
2114 (ps-output (format "/TopMargin %s def\n" ps-top-margin)) ; not used
2115 (ps-output (format "/HeaderOffset %s def\n" ps-header-offset))
2116 (ps-output (format "/HeaderPad %s def\n" ps-header-pad))
1305 2117
1306 (ps-output ps-print-prologue) 2118 (ps-output-boolean "PrintHeader" ps-print-header)
2119 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
2120 (ps-output-boolean "ShowNofN" ps-show-n-of-n)
2121 (ps-output-boolean "Duplex" ps-spool-duplex)
2122
2123 (ps-output (format "/LineHeight %s def\n" ps-line-height))
1307 2124
1308 (ps-output (format "/f0 %d /%s Font\n" ps-font-size ps-font)) 2125 (ps-output ps-print-prologue-1)
1309 (ps-output (format "/f1 %d /%s Font\n" ps-font-size ps-font-bold))
1310 (ps-output (format "/f2 %d /%s Font\n" ps-font-size ps-font-italic))
1311 (ps-output (format "/f3 %d /%s Font\n" ps-font-size
1312 ps-font-bold-italic))
1313 2126
2127 ;; Header fonts
2128 (ps-output ; /h0 14 /Helvetica-Bold Font
2129 (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font))
2130 (ps-output ; /h1 12 /Helvetica Font
2131 (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font))
2132
2133 (ps-output ps-print-prologue-2)
2134
2135 ;; Text fonts
2136 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font))
2137 (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold))
2138 (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic))
2139 (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic))
2140
2141 (ps-output "\nBeginDoc\n\n")
1314 (ps-output "%%EndPrologue\n")) 2142 (ps-output "%%EndPrologue\n"))
1315 2143
1316(defun ps-header-dirpart () 2144(defun ps-header-dirpart ()
@@ -1322,15 +2150,20 @@ StandardEncoding 46 82 getinterval aload pop
1322 ""))) 2150 "")))
1323 2151
1324(defun ps-get-buffer-name () 2152(defun ps-get-buffer-name ()
1325 ;; Indulge me this little easter egg: 2153 (cond
1326 (if (string= (buffer-name) "ps-print.el") 2154 ;; Indulge Jim this little easter egg:
1327 "Hey, Cool! It's ps-print.el!!!" 2155 ((string= (buffer-name) "ps-print.el")
1328 (buffer-name))) 2156 "Hey, Cool! It's ps-print.el!!!")
2157 ;; Indulge Jack this other little easter egg:
2158 ((string= (buffer-name) "sokoban.el")
2159 "Super! C'est sokoban.el!")
2160 (t (buffer-name))))
1329 2161
1330(defun ps-begin-job () 2162(defun ps-begin-job ()
1331 (setq ps-page-count 0)) 2163 (setq ps-page-count 0))
1332 2164
1333(defun ps-end-file () 2165(defun ps-end-file ()
2166 (ps-output "\nEndDoc\n\n")
1334 (ps-output "%%Trailer\n") 2167 (ps-output "%%Trailer\n")
1335 (ps-output "%%Pages: " (format "%d\n" ps-showpage-count))) 2168 (ps-output "%%Pages: " (format "%d\n" ps-showpage-count)))
1336 2169
@@ -1341,18 +2174,9 @@ StandardEncoding 46 82 getinterval aload pop
1341 2174
1342(defun ps-begin-page (&optional dummypage) 2175(defun ps-begin-page (&optional dummypage)
1343 (ps-get-page-dimensions) 2176 (ps-get-page-dimensions)
1344 (setq ps-width-remaining ps-print-width) 2177 (setq ps-width-remaining ps-print-width)
1345 (setq ps-height-remaining ps-print-height) 2178 (setq ps-height-remaining ps-print-height)
1346 2179
1347 ;; If headers are turned on, deduct the height of the header from
1348 ;; the print height remaining. Clumsy clumsy clumsy.
1349 (if ps-print-header
1350 (setq ps-height-remaining
1351 (- ps-height-remaining
1352 ps-header-title-line-height
1353 (* ps-header-line-height (- ps-header-lines 1))
1354 (* 2 ps-header-pad))))
1355
1356 (setq ps-page-count (+ ps-page-count 1)) 2180 (setq ps-page-count (+ ps-page-count 1))
1357 2181
1358 (ps-output "\n%%Page: " 2182 (ps-output "\n%%Page: "
@@ -1363,14 +2187,14 @@ StandardEncoding 46 82 getinterval aload pop
1363 2187
1364 (if ps-print-header 2188 (if ps-print-header
1365 (progn 2189 (progn
1366 (ps-generate-header "HeaderLinesLeft" ps-left-header) 2190 (ps-generate-header "HeaderLinesLeft" ps-left-header)
1367 (ps-generate-header "HeaderLinesRight" ps-right-header) 2191 (ps-generate-header "HeaderLinesRight" ps-right-header)
1368 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))) 2192 (ps-output (format "%d SetHeaderLines\n" ps-header-lines))))
1369 2193
1370 (ps-output "BeginPage\n") 2194 (ps-output "BeginPage\n")
1371 (ps-set-font ps-current-font) 2195 (ps-set-font ps-current-font)
1372 (ps-set-bg ps-current-bg) 2196 (ps-set-bg ps-current-bg)
1373 (ps-set-color ps-current-color) 2197 (ps-set-color ps-current-color)
1374 (ps-set-underline ps-current-underline-p)) 2198 (ps-set-underline ps-current-underline-p))
1375 2199
1376(defun ps-end-page () 2200(defun ps-end-page ()
@@ -1390,17 +2214,19 @@ EndDSCPage\n"))
1390(defun ps-next-line () 2214(defun ps-next-line ()
1391 (if (< ps-height-remaining ps-line-height) 2215 (if (< ps-height-remaining ps-line-height)
1392 (ps-next-page) 2216 (ps-next-page)
1393 (setq ps-width-remaining ps-print-width) 2217 (setq ps-width-remaining ps-print-width)
1394 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) 2218 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
1395 (ps-hard-lf))) 2219 (ps-hard-lf)))
1396 2220
1397(defun ps-continue-line () 2221(defun ps-continue-line ()
1398 (if (< ps-height-remaining ps-line-height) 2222 (if (< ps-height-remaining ps-line-height)
1399 (ps-next-page) 2223 (ps-next-page)
1400 (setq ps-width-remaining ps-print-width) 2224 (setq ps-width-remaining ps-print-width)
1401 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) 2225 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
1402 (ps-soft-lf))) 2226 (ps-soft-lf)))
1403 2227
2228;; [jack] Why hard and soft ?
2229
1404(defun ps-hard-lf () 2230(defun ps-hard-lf ()
1405 (ps-output "HL\n")) 2231 (ps-output "HL\n"))
1406 2232
@@ -1419,7 +2245,7 @@ EndDSCPage\n"))
1419 (to (car wrappoint)) 2245 (to (car wrappoint))
1420 (string (buffer-substring from to))) 2246 (string (buffer-substring from to)))
1421 (ps-output-string string) 2247 (ps-output-string string)
1422 (ps-output " S\n") ; 2248 (ps-output " S\n")
1423 wrappoint)) 2249 wrappoint))
1424 2250
1425(defun ps-basic-plot-whitespace (from to &optional bg-color) 2251(defun ps-basic-plot-whitespace (from to &optional bg-color)
@@ -1456,8 +2282,6 @@ EndDSCPage\n"))
1456 (setq ps-current-font font) 2282 (setq ps-current-font font)
1457 (ps-output (format "/f%d F\n" ps-current-font))) 2283 (ps-output (format "/f%d F\n" ps-current-font)))
1458 2284
1459(defvar ps-print-color-scale nil)
1460
1461(defun ps-set-bg (color) 2285(defun ps-set-bg (color)
1462 (if (setq ps-current-bg color) 2286 (if (setq ps-current-bg color)
1463 (ps-output (format ps-color-format (nth 0 color) (nth 1 color) 2287 (ps-output (format ps-color-format (nth 0 color) (nth 1 color)
@@ -1675,8 +2499,8 @@ EndDSCPage\n"))
1675(defun ps-print-ensure-fontified (start end) 2499(defun ps-print-ensure-fontified (start end)
1676 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode) 2500 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode)
1677 (if (fboundp 'lazy-lock-fontify-region) 2501 (if (fboundp 'lazy-lock-fontify-region)
1678 (lazy-lock-fontify-region start end) 2502 (lazy-lock-fontify-region start end) ; the new
1679 (lazy-lock-fontify-buffer)))) 2503 (lazy-lock-fontify-buffer)))) ; the old
1680 2504
1681(defun ps-generate-postscript-with-faces (from to) 2505(defun ps-generate-postscript-with-faces (from to)
1682 ;; Build the reference lists of faces if necessary. 2506 ;; Build the reference lists of faces if necessary.
@@ -1698,7 +2522,8 @@ EndDSCPage\n"))
1698 (let ((face 'default) 2522 (let ((face 'default)
1699 (position to)) 2523 (position to))
1700 (ps-print-ensure-fontified from to) 2524 (ps-print-ensure-fontified from to)
1701 (cond ((or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs)) 2525 (cond ((or (eq ps-print-emacs-type 'lucid)
2526 (eq ps-print-emacs-type 'xemacs))
1702 ;; Build the list of extents... 2527 ;; Build the list of extents...
1703 (let ((a (cons 'dummy nil)) 2528 (let ((a (cons 'dummy nil))
1704 record type extent extent-list) 2529 record type extent extent-list)
@@ -1873,7 +2698,7 @@ EndDSCPage\n"))
1873 2698
1874(defun ps-do-despool (filename) 2699(defun ps-do-despool (filename)
1875 (if (or (not (boundp 'ps-spool-buffer)) 2700 (if (or (not (boundp 'ps-spool-buffer))
1876 (not ps-spool-buffer)) 2701 (not (symbol-value 'ps-spool-buffer)))
1877 (message "No spooled PostScript to print") 2702 (message "No spooled PostScript to print")
1878 (ps-end-file) 2703 (ps-end-file)
1879 (ps-flush-output) 2704 (ps-flush-output)
@@ -1916,7 +2741,7 @@ EndDSCPage\n"))
1916 (error "Unprinted PostScript"))))) 2741 (error "Unprinted PostScript")))))
1917 2742
1918(if (fboundp 'add-hook) 2743(if (fboundp 'add-hook)
1919 (add-hook 'kill-emacs-hook 'ps-kill-emacs-check) 2744 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)
1920 (if kill-emacs-hook 2745 (if kill-emacs-hook
1921 (message "Won't override existing kill-emacs-hook") 2746 (message "Won't override existing kill-emacs-hook")
1922 (setq kill-emacs-hook 'ps-kill-emacs-check))) 2747 (setq kill-emacs-hook 'ps-kill-emacs-check)))
@@ -2012,9 +2837,9 @@ EndDSCPage\n"))
2012;; same thing for vm. 2837;; same thing for vm.
2013(defun ps-vm-print-message-from-summary () 2838(defun ps-vm-print-message-from-summary ()
2014 (interactive) 2839 (interactive)
2015 (if vm-mail-buffer 2840 (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
2016 (save-excursion 2841 (save-excursion
2017 (set-buffer vm-mail-buffer) 2842 (set-buffer (symbol-value 'vm-mail-buffer))
2018 (ps-spool-buffer-with-faces)))) 2843 (ps-spool-buffer-with-faces))))
2019 2844
2020;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind 2845;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind
@@ -2047,7 +2872,7 @@ EndDSCPage\n"))
2047 2872
2048;; WARNING! The following function is a *sample* only, and is *not* 2873;; WARNING! The following function is a *sample* only, and is *not*
2049;; meant to be used as a whole unless you understand what the effects 2874;; meant to be used as a whole unless you understand what the effects
2050;; will be! (In fact, this is a copy if my setup for ps-print -- I'd 2875;; will be! (In fact, this is a copy of Jim's setup for ps-print -- I'd
2051;; be very surprised if it was useful to *anybody*, without 2876;; be very surprised if it was useful to *anybody*, without
2052;; modification.) 2877;; modification.)
2053 2878
@@ -2063,7 +2888,43 @@ EndDSCPage\n"))
2063 (setq ps-spool-duplex t) 2888 (setq ps-spool-duplex t)
2064 (setq ps-print-color-p nil) 2889 (setq ps-print-color-p nil)
2065 (setq ps-lpr-command "lpr") 2890 (setq ps-lpr-command "lpr")
2066 (setq ps-lpr-switches '("-Jjct,duplex_long"))) 2891 (setq ps-lpr-switches '("-Jjct,duplex_long"))
2892 'ps-jts-ps-setup)
2893
2894;; WARNING! The following function is a *sample* only, and is *not*
2895;; meant to be used as a whole unless it corresponds to your needs.
2896;; (In fact, this is a copy of Jack's setup for ps-print --
2897;; I would not be that surprised if it was useful to *anybody*,
2898;; without modification.)
2899
2900(defun ps-jack-setup ()
2901 (setq ps-print-color-p 'nil
2902 ps-lpr-command "lpr"
2903 ps-lpr-switches (list)
2904
2905 ps-paper-type 'a4
2906 ps-landscape-mode 't
2907 ps-number-of-columns 2
2908
2909 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
2910 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
2911 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
2912 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2913 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2914 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2915 ps-header-line-pad .15
2916 ps-print-header t
2917 ps-print-header-frame t
2918 ps-header-lines 2
2919 ps-show-n-of-n t
2920 ps-spool-duplex nil
2921
2922 ps-font-family 'Courier
2923 ps-font-size 5.5
2924 ps-header-font-family 'Helvetica
2925 ps-header-font-size 6
2926 ps-header-title-font-size 8)
2927 'ps-jack-setup)
2067 2928
2068(provide 'ps-print) 2929(provide 'ps-print)
2069 2930