aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1998-03-07 06:04:46 +0000
committerRichard M. Stallman1998-03-07 06:04:46 +0000
commit12b88fff5fcc9ab3babbf4f2f1296eec3b0b898a (patch)
tree1e674d5c6f46df653b9f55b2e1518678691bed07
parentf8449323058067b822415b4821e2eb66effe0ecb (diff)
downloademacs-12b88fff5fcc9ab3babbf4f2f1296eec3b0b898a.tar.gz
emacs-12b88fff5fcc9ab3babbf4f2f1296eec3b0b898a.zip
Some comment, doc and bug fixes.
(ps-print-version): New version number (3.06) and doc fix. (ps-print-only-one-header, ps-font-type): New var. (ps-font-info-database): Better font database management. (ps-error-scale-font, ps-select-header-font): Funs eliminated. (ps-font, ps-font-bold, ps-font-italic, ps-font-bold-italic) (ps-avg-char-width, ps-space-width, ps-line-height) (ps-header-font, ps-header-title-font, ps-header-line-height) (ps-header-title-line-height): Vars eliminated. (ps-font-list, ps-font, ps-fonts, ps-font-number, ps-line-height) (ps-title-line-height, ps-space-width, ps-avg-char-width,): New funs. (ps-print-prologue-1): Adjust PostScript programming. (ps-color-format): Doc indentation. (ps-print-hook, ps-print-begin-page-hook, ps-print-begin-column-hook): New hook vars. (ps-spool-without-faces, ps-spool-with-faces): Run hook var. (ps-line-lengths-internal, ps-nb-pages, ps-select-font) (ps-get-page-dimensions, ps-begin-file, ps-end-file, ps-header-page) (ps-begin-page, ps-dummy-page, ps-next-line, ps-continue-line) (ps-basic-plot-string, ps-basic-plot-whitespace, ps-plot-region) (ps-control-character, ps-color-values, ps-generate): Adjust programming. (ps-page-number): New macro. (ps-plot-with-face, ps-generate-postscript-with-faces): Fix invisible text printing.
-rw-r--r--lisp/ps-print.el709
1 files changed, 454 insertions, 255 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 1228a464db9..e74d40245d5 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -1,17 +1,17 @@
1;;; ps-print.el --- Print text from the buffer as PostScript 1;;; ps-print.el --- Print text from the buffer as PostScript
2 2
3;; Copyright (C) 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. 3;; Copyright (C) 1993, 94, 95, 96, 97, 1998 Free Software Foundation, Inc.
4 4
5;; Author: Jim Thompson (was <thompson@wg2.waii.com>) 5;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6;; Author: Jacques Duthen <duthen@cegelec-red.fr> 6;; Author: Jacques Duthen <duthen@cegelec-red.fr>
7;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> 7;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
8;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> 8;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
9;; Keywords: print, PostScript 9;; Keywords: print, PostScript
10;; Time-stamp: <97/11/21 22:12:47 vinicius> 10;; Time-stamp: <98/03/06 11:14:08 vinicius>
11;; Version: 3.05.3 11;; Version: 3.06
12 12
13(defconst ps-print-version "3.05.3" 13(defconst ps-print-version "3.06"
14 "ps-print.el, v 3.05.3 <97/11/21 vinicius> 14 "ps-print.el, v 3.06 <98/03/06 vinicius>
15 15
16Vinicius's last change version -- this file may have been edited as part of 16Vinicius's last change version -- this file may have been edited as part of
17Emacs without changes to the version number. When reporting bugs, 17Emacs without changes to the version number. When reporting bugs,
@@ -269,11 +269,11 @@ Please send all bug fixes and enhancements to
269;; Headers 269;; Headers
270;; ------- 270;; -------
271;; 271;;
272;; Ps-print can print headers at the top of each column; the default 272;; Ps-print can print headers at the top of each column or at the top
273;; headers contain the following four items: on the left, the name of 273;; of each page; the default headers contain the following four items:
274;; the buffer and, if the buffer is visiting a file, the file's 274;; on the left, the name of the buffer and, if the buffer is visiting
275;; directory; on the right, the page number and date of printing. 275;; a file, the file's directory; on the right, the page number and
276;; The default headers look something like this: 276;; date of printing. The default headers look something like this:
277;; 277;;
278;; ps-print.el 1/21 278;; ps-print.el 1/21
279;; /home/jct/emacs-lisp/ps/new 94/12/31 279;; /home/jct/emacs-lisp/ps/new 94/12/31
@@ -286,6 +286,9 @@ Please send all bug fixes and enhancements to
286;; To turn off the header's gaudy framing box, 286;; To turn off the header's gaudy framing box,
287;; set `ps-print-header-frame' to nil. 287;; set `ps-print-header-frame' to nil.
288;; 288;;
289;; To print only one header at the top of each page,
290;; set `ps-print-only-one-header' to t.
291;;
289;; The font family and size of text in the header are determined 292;; The font family and size of text in the header are determined
290;; by the variables `ps-header-font-family', `ps-header-font-size' and 293;; by the variables `ps-header-font-family', `ps-header-font-size' and
291;; `ps-header-title-font-size' (see below). 294;; `ps-header-title-font-size' (see below).
@@ -423,7 +426,28 @@ Please send all bug fixes and enhancements to
423;; See also section How Ps-Print Has A Text And/Or Image On Background. 426;; See also section How Ps-Print Has A Text And/Or Image On Background.
424;; 427;;
425;; 428;;
426;; Font managing 429;; Hooks
430;; -----
431;;
432;; Ps-print has the following hook variables:
433;;
434;; `ps-print-hook'
435;; It is evaluated once before any printing process. This is the right
436;; place to initialize ps-print global data.
437;; For an example, see section Adding a New Font Family.
438;;
439;; `ps-print-begin-page-hook'
440;; It is evaluated on each real beginning of page, that is, ps-print
441;; considers each beginning of column as a beginning of page, and a real
442;; beginning of page is when the beginning of column coincides with a
443;; paper change on your printer.
444;;
445;; `ps-print-begin-column-hook'
446;; It is evaluated on each beginning of column, except in the beginning
447;; of column that `ps-print-begin-page-hook' is evaluated.
448;;
449;;
450;; Font Managing
427;; ------------- 451;; -------------
428;; 452;;
429;; Ps-print now knows rather precisely some fonts: 453;; Ps-print now knows rather precisely some fonts:
@@ -452,7 +476,7 @@ Please send all bug fixes and enhancements to
452;; in points, for the top line of text in the header. 476;; in points, for the top line of text in the header.
453;; 477;;
454;; 478;;
455;; Adding a new font family 479;; Adding a New Font Family
456;; ------------------------ 480;; ------------------------
457;; 481;;
458;; To use a new font family, you MUST first teach ps-print 482;; To use a new font family, you MUST first teach ps-print
@@ -478,11 +502,17 @@ Please send all bug fixes and enhancements to
478;; 502;;
479;; - Add these values to the `ps-font-info-database': 503;; - Add these values to the `ps-font-info-database':
480;; (setq ps-font-info-database 504;; (setq ps-font-info-database
481;; (append 505;; (append
482;; '((Helvetica ; the family name 506;; '((Helvetica ; the family key
483;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique" 507;; (fonts (normal . "Helvetica")
484;; 10.0 11.56 2.78 5.09243)) 508;; (bold . "Helvetica-Bold")
485;; ps-font-info-database)) 509;; (italic . "Helvetica-Oblique")
510;; (bold-italic . "Helvetica-BoldOblique"))
511;; (size . 10.0)
512;; (line-height . 11.56)
513;; (space-width . 2.78)
514;; (avg-char-width . 5.09243)))
515;; ps-font-info-database))
486;; - Now you can use this font family with any size: 516;; - Now you can use this font family with any size:
487;; (setq ps-font-family 'Helvetica) 517;; (setq ps-font-family 'Helvetica)
488;; - if you want to use this family in another emacs session, you must 518;; - if you want to use this family in another emacs session, you must
@@ -491,18 +521,46 @@ Please send all bug fixes and enhancements to
491;; (setq ps-font-info-database (append ...))) 521;; (setq ps-font-info-database (append ...)))
492;; if you don't want to load ps-print, you have to copy the whole value: 522;; if you don't want to load ps-print, you have to copy the whole value:
493;; (setq ps-font-info-database '(<your stuff> <the standard stuff>)) 523;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
494;; or, if you can wait until the `ps-print-hook' is implemented, do: 524;; or, use `ps-print-hook' (see section Hooks):
495;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...))) 525;; (add-hook 'ps-print-hook
496;; This does not work yet, since there is no `ps-print-hook' yet. 526;; '(lambda () (setq ps-font-info-database (append ...))))
497;; 527;;
498;; You can create new `mixed' font families like: 528;; You can create new `mixed' font families like:
499;; (my-mixed-family 529;; (my-mixed-family
500;; "Courier-Bold" "Helvetica" 530;; (fonts (normal . "Courier-Bold")
501;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic" 531;; (bold . "Helvetica")
502;; 10.0 10.55 6.0 6.0) 532;; (italic . "Zapf-Chancery-MediumItalic")
533;; (bold-italic . "NewCenturySchlbk-BoldItalic")
534;; (w3-table-hack-x-face . "LineDrawNormal"))
535;; (size . 10.0)
536;; (line-height . 10.55)
537;; (space-width . 6.0)
538;; (avg-char-width . 6.0))
503;; Now you can use your new font family with any size: 539;; Now you can use your new font family with any size:
504;; (setq ps-font-family 'my-mixed-family) 540;; (setq ps-font-family 'my-mixed-family)
505;; 541;;
542;; Note that on above example the `w3-table-hack-x-face' entry refers to
543;; a face symbol, so when printing this face it'll be used the font
544;; `LineDrawNormal'. If the face `w3-table-hack-x-face' is remapped to
545;; use bold and/or italic attribute, the corresponding entry (bold, italic
546;; or bold-italic) will be used instead of `w3-table-hack-x-face' entry.
547;;
548;; Note also that the font family entry order is irrelevant, so the above
549;; example could also be written:
550;; (my-mixed-family
551;; (size . 10.0)
552;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
553;; (bold . "Helvetica")
554;; (bold-italic . "NewCenturySchlbk-BoldItalic")
555;; (italic . "Zapf-Chancery-MediumItalic")
556;; (normal . "Courier-Bold"))
557;; (avg-char-width . 6.0)
558;; (space-width . 6.0)
559;; (line-height . 10.55))
560;;
561;; Despite the note above, it is recommended that some convention about
562;; entry order be used.
563;;
506;; You can get information on all the fonts resident in YOUR printer 564;; You can get information on all the fonts resident in YOUR printer
507;; by uncommenting the line: 565;; by uncommenting the line:
508;; % 3 cm 20 cm moveto ReportAllFontInfo showpage 566;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
@@ -529,7 +587,7 @@ Please send all bug fixes and enhancements to
529;; italic or underline; to set them, put code like the following into your 587;; italic or underline; to set them, put code like the following into your
530;; .emacs file: 588;; .emacs file:
531;; 589;;
532;; (setq ps-bold-faces '(my-blue-face)) 590;; (setq ps-bold-faces '(my-blue-face))
533;; (setq ps-italic-faces '(my-red-face)) 591;; (setq ps-italic-faces '(my-red-face))
534;; (setq ps-underlined-faces '(my-green-face)) 592;; (setq ps-underlined-faces '(my-green-face))
535;; 593;;
@@ -607,7 +665,7 @@ Please send all bug fixes and enhancements to
607;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position 665;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
608;; ; (upper left corner) 666;; ; (upper left corner)
609;; nil nil nil 667;; nil nil nil
610;; "PrintHeight neg PrintWidth atan" ; angle 668;; "PrintHeight neg PrintPageWidth atan" ; angle
611;; 5 (11 . 17)) ; page list 669;; 5 (11 . 17)) ; page list
612;; )) 670;; ))
613;; 671;;
@@ -677,8 +735,21 @@ Please send all bug fixes and enhancements to
677;; New since version 2.8 735;; New since version 2.8
678;; --------------------- 736;; ---------------------
679;; 737;;
738;; [vinicius] 980306 Vinicius Jose Latorre <vinicius@cpqd.com.br>
739;;
740;; Skip invisible text
741;;
742;; [vinicius] 971130 Vinicius Jose Latorre <vinicius@cpqd.com.br>
743;;
744;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
745;; `ps-print-begin-column-hook'.
746;; Put one header per page over the columns.
747;; Better database font management.
748;; Better control characters handling.
749;;
680;; [vinicius] 971121 Vinicius Jose Latorre <vinicius@cpqd.com.br> 750;; [vinicius] 971121 Vinicius Jose Latorre <vinicius@cpqd.com.br>
681;; 751;;
752;; Dynamic evaluation at print time of `ps-lpr-switches'.
682;; Handle control characters. 753;; Handle control characters.
683;; Face remapping. 754;; Face remapping.
684;; New face attributes. 755;; New face attributes.
@@ -730,10 +801,8 @@ Please send all bug fixes and enhancements to
730;; Things to change: 801;; Things to change:
731;; ---------------- 802;; ----------------
732;; 803;;
733;; Add `ps-print-hook' (I don't know how to do that (yet!)). 804;; Avoid page break inside a paragraph.
734;; Add 4-up capability (really needed?).
735;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy). 805;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
736;; Put one header per page over the columns (easy but needed?).
737;; Improve the memory management for big files (hard?). 806;; Improve the memory management for big files (hard?).
738;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care 807;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
739;; of folding lines. 808;; of folding lines.
@@ -741,6 +810,21 @@ Please send all bug fixes and enhancements to
741;; 810;;
742;; Acknowledgements 811;; Acknowledgements
743;; ---------------- 812;; ----------------
813;;
814;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
815;; database font management.
816;;
817;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
818;; header per page over the columns.
819;;
820;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
821;; print time of `ps-lpr-switches'.
822;;
823;; Thanks to some suggestions on:
824;; * Face color map: Marco Melgazzi <marco@techie.com>
825;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
826;; * Check ps-paper-type: Sudhakar Frederick <sfrederi@asc.corp.mot.com>
827;;
744;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version 828;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
745;; I started from. [vinicius] 829;; I started from. [vinicius]
746;; 830;;
@@ -906,7 +990,8 @@ Valid values are:
906 (characters from \000 to \037 and \177). 990 (characters from \000 to \037 and \177).
907 nil raw character (no printable form). 991 nil raw character (no printable form).
908Any other value is treated as nil." 992Any other value is treated as nil."
909 :type '(choice (const 8-bit) (const control-8-bit) (const control) (const nil)) 993 :type '(choice (const 8-bit) (const control-8-bit)
994 (const control) (const nil))
910 :group 'ps-print) 995 :group 'ps-print)
911 996
912(defcustom ps-number-of-columns (if ps-landscape-mode 2 1) 997(defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
@@ -1093,6 +1178,14 @@ customizable by changing variables `ps-left-header' and
1093 :type 'boolean 1178 :type 'boolean
1094 :group 'ps-print-header) 1179 :group 'ps-print-header)
1095 1180
1181(defcustom ps-print-only-one-header nil
1182 "*Non-nil means print only one header at the top of each page.
1183This is useful when printing more than one column, so it is possible
1184to have only one header over all columns or one header per column.
1185See also `ps-print-header'."
1186 :type 'boolean
1187 :group 'ps-print-header)
1188
1096(defcustom ps-print-header-frame t 1189(defcustom ps-print-header-frame t
1097 "*Non-nil means draw a gaudy frame around the header." 1190 "*Non-nil means draw a gaudy frame around the header."
1098 :type 'boolean 1191 :type 'boolean
@@ -1126,53 +1219,107 @@ the left on even-numbered pages."
1126 1219
1127(defcustom ps-font-info-database 1220(defcustom ps-font-info-database
1128 '((Courier ; the family key 1221 '((Courier ; the family key
1129 "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique" 1222 (fonts (normal . "Courier")
1130 10.0 10.55 6.0 6.0) 1223 (bold . "Courier-Bold")
1224 (italic . "Courier-Oblique")
1225 (bold-italic . "Courier-BoldOblique"))
1226 (size . 10.0)
1227 (line-height . 10.55)
1228 (space-width . 6.0)
1229 (avg-char-width . 6.0))
1131 (Helvetica ; the family key 1230 (Helvetica ; the family key
1132 "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique" 1231 (fonts (normal . "Helvetica")
1133 10.0 11.56 2.78 5.09243) 1232 (bold . "Helvetica-Bold")
1233 (italic . "Helvetica-Oblique")
1234 (bold-italic . "Helvetica-BoldOblique"))
1235 (size . 10.0)
1236 (line-height . 11.56)
1237 (space-width . 2.78)
1238 (avg-char-width . 5.09243))
1134 (Times 1239 (Times
1135 "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic" 1240 (fonts (normal . "Times-Roman")
1136 10.0 11.0 2.5 4.71432) 1241 (bold . "Times-Bold")
1242 (italic . "Times-Italic")
1243 (bold-italic . "Times-BoldItalic"))
1244 (size . 10.0)
1245 (line-height . 11.0)
1246 (space-width . 2.5)
1247 (avg-char-width 4.71432))
1137 (Palatino 1248 (Palatino
1138 "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic" 1249 (fonts (normal . "Palatino-Roman")
1139 10.0 12.1 2.5 5.08676) 1250 (bold . "Palatino-Bold")
1251 (italic . "Palatino-Italic")
1252 (bold-italic . "Palatino-BoldItalic"))
1253 (size . 10.0)
1254 (line-height . 12.1)
1255 (space-width . 2.5)
1256 (avg-char-width . 5.08676))
1140 (Helvetica-Narrow 1257 (Helvetica-Narrow
1141 "Helvetica-Narrow" "Helvetica-Narrow-Bold" 1258 (fonts (normal . "Helvetica-Narrow")
1142 "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique" 1259 (bold . "Helvetica-Narrow-Bold")
1143 10.0 11.56 2.2796 4.17579) 1260 (italic . "Helvetica-Narrow-Oblique")
1261 (bold-italic . "Helvetica-Narrow-BoldOblique"))
1262 (size . 10.0)
1263 (line-height . 11.56)
1264 (space-width . 2.2796)
1265 (avg-char-width . 4.17579))
1144 (NewCenturySchlbk 1266 (NewCenturySchlbk
1145 "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold" 1267 (fonts (normal . "NewCenturySchlbk-Roman")
1146 "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic" 1268 (bold . "NewCenturySchlbk-Bold")
1147 10.0 12.15 2.78 5.31162) 1269 (italic . "NewCenturySchlbk-Italic")
1270 (bold-italic . "NewCenturySchlbk-BoldItalic"))
1271 (size . 10.0)
1272 (line-height 12.15)
1273 (space-width . 2.78)
1274 (avg-char-width . 5.31162))
1148 ;; got no bold for the next ones 1275 ;; got no bold for the next ones
1149 (AvantGarde-Book 1276 (AvantGarde-Book
1150 "AvantGarde-Book" "AvantGarde-Book" 1277 (fonts (normal . "AvantGarde-Book")
1151 "AvantGarde-BookOblique" "AvantGarde-BookOblique" 1278 (italic . "AvantGarde-BookOblique"))
1152 10.0 11.77 2.77 5.45189) 1279 (size . 10.0)
1280 (line-height . 11.77)
1281 (space-width . 2.77)
1282 (avg-char-width . 5.45189))
1153 (AvantGarde-Demi 1283 (AvantGarde-Demi
1154 "AvantGarde-Demi" "AvantGarde-Demi" 1284 (fonts (normal . "AvantGarde-Demi")
1155 "AvantGarde-DemiOblique" "AvantGarde-DemiOblique" 1285 (italic . "AvantGarde-DemiOblique"))
1156 10.0 12.72 2.8 5.51351) 1286 (size . 10.0)
1287 (line-height . 12.72)
1288 (space-width . 2.8)
1289 (avg-char-width . 5.51351))
1157 (Bookman-Demi 1290 (Bookman-Demi
1158 "Bookman-Demi" "Bookman-Demi" 1291 (fonts (normal . "Bookman-Demi")
1159 "Bookman-DemiItalic" "Bookman-DemiItalic" 1292 (italic . "Bookman-DemiItalic"))
1160 10.0 11.77 3.4 6.05946) 1293 (size . 10.0)
1294 (line-height . 11.77)
1295 (space-width . 3.4)
1296 (avg-char-width . 6.05946))
1161 (Bookman-Light 1297 (Bookman-Light
1162 "Bookman-Light" "Bookman-Light" 1298 (fonts (normal . "Bookman-Light")
1163 "Bookman-LightItalic" "Bookman-LightItalic" 1299 (italic . "Bookman-LightItalic"))
1164 10.0 11.79 3.2 5.67027) 1300 (size . 10.0)
1301 (line-height . 11.79)
1302 (space-width . 3.2)
1303 (avg-char-width . 5.67027))
1165 ;; got no bold and no italic for the next ones 1304 ;; got no bold and no italic for the next ones
1166 (Symbol 1305 (Symbol
1167 "Symbol" "Symbol" "Symbol" "Symbol" 1306 (fonts (normal . "Symbol"))
1168 10.0 13.03 2.5 3.24324) 1307 (size . 10.0)
1308 (line-height . 13.03)
1309 (space-width . 2.5)
1310 (avg-char-width . 3.24324))
1169 (Zapf-Dingbats 1311 (Zapf-Dingbats
1170 "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" 1312 (fonts (normal . "Zapf-Dingbats"))
1171 10.0 9.63 2.78 2.78) 1313 (size . 10.0)
1314 (line-height . 9.63)
1315 (space-width . 2.78)
1316 (avg-char-width . 2.78))
1172 (Zapf-Chancery-MediumItalic 1317 (Zapf-Chancery-MediumItalic
1173 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic" 1318 (fonts (normal . "Zapf-Chancery-MediumItalic"))
1174 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic" 1319 (size . 10.0)
1175 10.0 11.45 2.2 4.10811) 1320 (line-height . 11.45)
1321 (space-width . 2.2)
1322 (avg-char-width . 4.10811))
1176 ) 1323 )
1177 "*Font info database: font family (the key), name, bold, italic, bold-italic, 1324 "*Font info database: font family (the key), name, bold, italic, bold-italic,
1178reference size, line height, space width, average character width. 1325reference size, line height, space width, average character width.
@@ -1187,15 +1334,22 @@ To get the info for another specific font (say Helvetica), do the following:
1187- add the values to `ps-font-info-database'. 1334- add the values to `ps-font-info-database'.
1188You can get all the fonts of YOUR printer using `ReportAllFontInfo'." 1335You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
1189 :type '(repeat (list :tag "Font Definition" 1336 :type '(repeat (list :tag "Font Definition"
1190 (symbol :tag "Font") 1337 (symbol :tag "Font Family")
1191 (string :tag "Name") 1338 (cons (const fonts)
1192 (string :tag "Bold") 1339 (repeat (cons (choice (const normal)
1193 (string :tag "Italic") 1340 (const bold)
1194 (string :tag "Bold-Italic") 1341 (const italic)
1195 (number :tag "Reference Size") 1342 (const bold-italic)
1196 (number :tag "Line Height") 1343 (symbol :tag "Face"))
1197 (number :tag "Space Width") 1344 (string :tag "Font Name"))))
1198 (number :tag "Average Character Width"))) 1345 (cons (const size)
1346 (number :tag "Reference Size"))
1347 (cons (const line-height)
1348 (number :tag "Line Height"))
1349 (cons (const space-width)
1350 (number :tag "Space Width"))
1351 (cons (const avg-char-width)
1352 (number :tag "Average Character Width"))))
1199 :group 'ps-print-font) 1353 :group 'ps-print-font)
1200 1354
1201(defcustom ps-font-family 'Courier 1355(defcustom ps-font-family 'Courier
@@ -1580,35 +1734,6 @@ The table depends on the current ps-print setup."
1580 1734
1581(require 'time-stamp) 1735(require 'time-stamp)
1582 1736
1583(defvar ps-font nil
1584 "Font family name for ordinary text, when generating PostScript.")
1585
1586(defvar ps-font-bold nil
1587 "Font family name for bold text, when generating PostScript.")
1588
1589(defvar ps-font-italic nil
1590 "Font family name for italic text, when generating PostScript.")
1591
1592(defvar ps-font-bold-italic nil
1593 "Font family name for bold italic text, when generating PostScript.")
1594
1595(defvar ps-avg-char-width nil
1596 "The average width, in points, of a character, for generating PostScript.
1597This is the value that ps-print uses to determine the length,
1598x-dimension, of the text it has printed, and thus affects the point at
1599which long lines wrap around.")
1600
1601(defvar ps-space-width nil
1602 "The width of a space character, for generating PostScript.
1603This value is used in expanding tab characters.")
1604
1605(defvar ps-line-height nil
1606 "The height of a line, for generating PostScript.
1607This is the value that ps-print uses to determine the height,
1608y-dimension, of the lines of text it has printed, and thus affects the
1609point at which page-breaks are placed.
1610The line-height is *not* the same as the point size of the font.")
1611
1612(defvar ps-print-prologue-1 1737(defvar ps-print-prologue-1
1613 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: 1738 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
1614/ISOLatin1Encoding where { pop } { 1739/ISOLatin1Encoding where { pop } {
@@ -1670,8 +1795,10 @@ StandardEncoding 46 82 getinterval aload pop
1670 } forall % Copy each of the symbols from the old dictionary 1795 } forall % Copy each of the symbols from the old dictionary
1671 % to the new one except for the font ID. 1796 % to the new one except for the font ID.
1672 1797
1673 /Encoding ISOLatin1Encoding def % Override the encoding with 1798 currentdict /FontType get 0 ne {
1799 /Encoding ISOLatin1Encoding def % Override the encoding with
1674 % the ISOLatin1 encoding. 1800 % the ISOLatin1 encoding.
1801 } if
1675 1802
1676 % Use the font's bounding box to determine the ascent, descent, 1803 % Use the font's bounding box to determine the ascent, descent,
1677 % and overall height; don't forget that these values have to be 1804 % and overall height; don't forget that these values have to be
@@ -1689,9 +1816,17 @@ StandardEncoding 46 82 getinterval aload pop
1689% | | v Descent (usually < 0) 1816% | | v Descent (usually < 0)
1690% (x1 y1) --> +----+ - - 1817% (x1 y1) --> +----+ - -
1691 1818
1692 FontBBox % -- x1 y1 x2 y2 1819 currentdict /FontType get 0 ne {
1693 FontMatrix transform /Ascent exch def pop 1820 FontBBox % -- x1 y1 x2 y2
1694 FontMatrix transform /Descent exch def pop 1821 FontMatrix transform /Ascent exch def pop
1822 FontMatrix transform /Descent exch def pop
1823 } {
1824 /PrimaryFont FDepVector 0 get def
1825 PrimaryFont /FontBBox get aload pop
1826 PrimaryFont /FontMatrix get transform /Ascent exch def pop
1827 PrimaryFont /FontMatrix get transform /Descent exch def pop
1828 } ifelse
1829
1695 /FontHeight Ascent Descent sub def % use `sub' because descent < 0 1830 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
1696 1831
1697 % Define these in case they're not in the FontInfo 1832 % Define these in case they're not in the FontInfo
@@ -2016,6 +2151,8 @@ StandardEncoding 46 82 getinterval aload pop
2016 /columnState save def 2151 /columnState save def
2017} def 2152} def
2018 2153
2154/PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
2155
2019/BeginPage { 2156/BeginPage {
2020 % ---- when 1st column, print all background effects 2157 % ---- when 1st column, print all background effects
2021 ColumnIndex 1 eq { 2158 ColumnIndex 1 eq {
@@ -2025,8 +2162,10 @@ StandardEncoding 46 82 getinterval aload pop
2025 printLocalBackground 2162 printLocalBackground
2026 } if 2163 } if
2027 PrintHeader { 2164 PrintHeader {
2028 PrintHeaderFrame { HeaderFrame } if 2165 PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse {
2029 HeaderText 2166 PrintHeaderFrame {HeaderFrame}if
2167 HeaderText
2168 } if
2030 } if 2169 } if
2031 0 PrintStartY moveto % move to where printing will start 2170 0 PrintStartY moveto % move to where printing will start
2032 PLN 2171 PLN
@@ -2079,10 +2218,10 @@ StandardEncoding 46 82 getinterval aload pop
2079} def 2218} def
2080 2219
2081/HeaderFramePath { 2220/HeaderFramePath {
2082 PrintWidth 0 rlineto 2221 PrintHeaderWidth 0 rlineto
2083 0 HeaderHeight rlineto 2222 0 HeaderHeight rlineto
2084 PrintWidth neg 0 rlineto 2223 PrintHeaderWidth neg 0 rlineto
2085 0 HeaderHeight neg rlineto 2224 0 HeaderHeight neg rlineto
2086} def 2225} def
2087 2226
2088/HeaderFrame { 2227/HeaderFrame {
@@ -2152,7 +2291,7 @@ StandardEncoding 46 82 getinterval aload pop
2152 gsave 2291 gsave
2153 dup xcheck { exec } if 2292 dup xcheck { exec } if
2154 dup stringwidth pop 2293 dup stringwidth pop
2155 PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto 2294 PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
2156 show 2295 show
2157 grestore 2296 grestore
2158 0 HeaderLineHeight neg rmoveto 2297 0 HeaderLineHeight neg rmoveto
@@ -2249,25 +2388,18 @@ StandardEncoding 46 82 getinterval aload pop
2249(defvar ps-color-format 2388(defvar ps-color-format
2250 (if (eq ps-print-emacs-type 'emacs) 2389 (if (eq ps-print-emacs-type 'emacs)
2251 2390
2252 ;;Emacs understands the %f format; we'll 2391 ;; Emacs understands the %f format; we'll use it to limit color RGB
2253 ;;use it to limit color RGB values to 2392 ;; values to three decimals to cut down some on the size of the
2254 ;;three decimals to cut down some on the 2393 ;; PostScript output.
2255 ;;size of the PostScript output. 2394 "%0.3f %0.3f %0.3f"
2256 "%0.3f %0.3f %0.3f"
2257 2395
2258 ;; Lucid emacsen will have to make do with 2396 ;; Lucid emacsen will have to make do with %s (princ) for floats.
2259 ;; %s (princ) for floats.
2260 "%s %s %s")) 2397 "%s %s %s"))
2261 2398
2262;; These values determine how much print-height to deduct when headers 2399;; These values determine how much print-height to deduct when headers
2263;; are turned on. This is a pretty clumsy way of handling it, but 2400;; are turned on. This is a pretty clumsy way of handling it, but
2264;; it'll do for now. 2401;; it'll do for now.
2265 2402
2266(defvar ps-header-font nil)
2267(defvar ps-header-title-font nil)
2268
2269(defvar ps-header-line-height nil)
2270(defvar ps-header-title-line-height nil)
2271(defvar ps-header-pad 0 2403(defvar ps-header-pad 0
2272 "Vertical and horizontal space in points (1/72 inch) between the header frame 2404 "Vertical and horizontal space in points (1/72 inch) between the header frame
2273and the text it contains.") 2405and the text it contains.")
@@ -2453,12 +2585,18 @@ If EXTENSION is any other symbol, it is ignored."
2453;; Internal functions and variables 2585;; Internal functions and variables
2454 2586
2455 2587
2588(make-local-hook 'ps-print-hook)
2589(make-local-hook 'ps-print-begin-page-hook)
2590(make-local-hook 'ps-print-begin-column-hook)
2591
2592
2456(defun ps-print-without-faces (from to &optional filename region-p) 2593(defun ps-print-without-faces (from to &optional filename region-p)
2457 (ps-spool-without-faces from to region-p) 2594 (ps-spool-without-faces from to region-p)
2458 (ps-do-despool filename)) 2595 (ps-do-despool filename))
2459 2596
2460 2597
2461(defun ps-spool-without-faces (from to &optional region-p) 2598(defun ps-spool-without-faces (from to &optional region-p)
2599 (run-hooks 'ps-print-hook)
2462 (ps-printing-region region-p) 2600 (ps-printing-region region-p)
2463 (ps-generate (current-buffer) from to 'ps-generate-postscript)) 2601 (ps-generate (current-buffer) from to 'ps-generate-postscript))
2464 2602
@@ -2469,6 +2607,7 @@ If EXTENSION is any other symbol, it is ignored."
2469 2607
2470 2608
2471(defun ps-spool-with-faces (from to &optional region-p) 2609(defun ps-spool-with-faces (from to &optional region-p)
2610 (run-hooks 'ps-print-hook)
2472 (ps-printing-region region-p) 2611 (ps-printing-region region-p)
2473 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)) 2612 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
2474 2613
@@ -2499,13 +2638,59 @@ and to indicate in the header that the printout is of a partial file.")
2499;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2638;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2500;; Internal functions 2639;; Internal functions
2501 2640
2641(defsubst ps-font-list (font-sym)
2642 (get font-sym 'fonts))
2643
2644(defun ps-font (font-sym font-type)
2645 "Font family name for text of `font-type', when generating PostScript."
2646 (let* ((font-list (ps-font-list font-sym))
2647 (normal-font (cdr (assq 'normal font-list))))
2648 (loop for font in font-list do
2649 (when (eq font-type (car font))
2650 (return (or (cdr font) normal-font))))))
2651
2652(defun ps-fonts (font-sym)
2653 (loop for font in (ps-font-list font-sym) collect (cdr font)))
2654
2655(defun ps-font-number (font-sym font-type)
2656 (or (position font-type (ps-font-list font-sym) :key 'car)
2657 0))
2658
2659(defsubst ps-line-height (font-sym)
2660 "The height of a line, for generating PostScript.
2661This is the value that ps-print uses to determine the height,
2662y-dimension, of the lines of text it has printed, and thus affects the
2663point at which page-breaks are placed.
2664The line-height is *not* the same as the point size of the font."
2665 (get font-sym 'line-height))
2666
2667(defsubst ps-title-line-height (font-sym)
2668 "The height of a `title' line, for generating PostScript.
2669This is the value that ps-print uses to determine the height,
2670y-dimension, of the lines of text it has printed, and thus affects the
2671point at which page-breaks are placed.
2672The title-line-height is *not* the same as the point size of the font."
2673 (get font-sym 'title-line-height))
2674
2675(defsubst ps-space-width (font-sym)
2676 "The width of a space character, for generating PostScript.
2677This value is used in expanding tab characters."
2678 (get font-sym 'space-width))
2679
2680(defsubst ps-avg-char-width (font-sym)
2681 "The average width, in points, of a character, for generating PostScript.
2682This is the value that ps-print uses to determine the length,
2683x-dimension, of the text it has printed, and thus affects the point at
2684which long lines wrap around."
2685 (get font-sym 'avg-char-width))
2686
2502(defun ps-line-lengths-internal () 2687(defun ps-line-lengths-internal ()
2503 "Display the correspondence between a line length and a font size, 2688 "Display the correspondence between a line length and a font size,
2504using the current ps-print setup. 2689using the current ps-print setup.
2505Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" 2690Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
2506 (let ((buf (get-buffer-create "*Line-lengths*")) 2691 (let ((buf (get-buffer-create "*Line-lengths*"))
2507 (ifs ps-font-size) ; initial font size 2692 (ifs ps-font-size) ; initial font size
2508 (icw ps-avg-char-width) ; initial character width 2693 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
2509 (print-width (progn (ps-get-page-dimensions) 2694 (print-width (progn (ps-get-page-dimensions)
2510 ps-print-width)) 2695 ps-print-width))
2511 (ps-setup (ps-setup)) ; setup for the current buffer 2696 (ps-setup (ps-setup)) ; setup for the current buffer
@@ -2543,7 +2728,7 @@ of pages the number of lines would require to print
2543using the current ps-print setup." 2728using the current ps-print setup."
2544 (let ((buf (get-buffer-create "*Nb-Pages*")) 2729 (let ((buf (get-buffer-create "*Nb-Pages*"))
2545 (ifs ps-font-size) ; initial font size 2730 (ifs ps-font-size) ; initial font size
2546 (ilh ps-line-height) ; initial line height 2731 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
2547 (page-height (progn (ps-get-page-dimensions) 2732 (page-height (progn (ps-get-page-dimensions)
2548 ps-print-height)) 2733 ps-print-height))
2549 (ps-setup (ps-setup)) ; setup for the current buffer 2734 (ps-setup (ps-setup)) ; setup for the current buffer
@@ -2582,56 +2767,21 @@ using the current ps-print setup."
2582 (insert "\n") 2767 (insert "\n")
2583 (display-buffer buf 'not-this-window))) 2768 (display-buffer buf 'not-this-window)))
2584 2769
2585(defun ps-error-scale-font () 2770(defun ps-select-font (font-family sym font-size title-font-size)
2586 (error "Don't have data to scale font %s.\nKnown fonts families are:\n%s" 2771 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
2587 ps-font-family 2772 (or font-entry
2588 (mapcar 'car ps-font-info-database))) 2773 (error "Don't have data to scale font %s. Known fonts families are %s"
2589 2774 font-family
2590(defun ps-select-font () 2775 (mapcar 'car ps-font-info-database)))
2591 "Choose the font name and size (scaling data)." 2776 (flet ((lookup (key) (cdr (assq key font-entry))))
2592 (let ((assoc (cdr (assq ps-font-family ps-font-info-database))) 2777 (let ((size (lookup 'size)))
2593 fn fb fi bi sz lh sw aw) 2778 (put sym 'fonts (lookup 'fonts))
2594 (or assoc (ps-error-scale-font)) 2779 (flet ((size-scale (key) (/ (* (lookup key) font-size) size)))
2595 (setq fn (nth 0 assoc) 2780 (put sym 'space-width (size-scale 'space-width))
2596 fb (nth 1 assoc) 2781 (put sym 'avg-char-width (size-scale 'avg-char-width))
2597 fi (nth 2 assoc) 2782 (put sym 'line-height (size-scale 'line-height))
2598 bi (nth 3 assoc) 2783 (put sym 'title-line-height
2599 sz (nth 4 assoc) 2784 (/ (* (lookup 'line-height) title-font-size) size)))))))
2600 lh (nth 5 assoc)
2601 sw (nth 6 assoc)
2602 aw (nth 7 assoc)
2603
2604 ps-font fn
2605 ps-font-bold fb
2606 ps-font-italic fi
2607 ps-font-bold-italic bi
2608 ;; These data just need to be rescaled:
2609 ps-line-height (/ (* lh ps-font-size) sz)
2610 ps-space-width (/ (* sw ps-font-size) sz)
2611 ps-avg-char-width (/ (* aw ps-font-size) sz))
2612 ps-font-family))
2613
2614(defun ps-select-header-font ()
2615 "Choose the font name and size (scaling data) for the header."
2616 (let ((assoc (cdr (assq ps-header-font-family ps-font-info-database)))
2617 fn fb fi bi sz lh sw aw)
2618 (or assoc (ps-error-scale-font))
2619 (setq fn (nth 0 assoc)
2620 fb (nth 1 assoc)
2621 fi (nth 2 assoc)
2622 bi (nth 3 assoc)
2623 sz (nth 4 assoc)
2624 lh (nth 5 assoc)
2625 sw (nth 6 assoc)
2626 aw (nth 7 assoc)
2627
2628 ;; Font name
2629 ps-header-font fn
2630 ps-header-title-font fb
2631 ;; Line height: These data just need to be rescaled:
2632 ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz)
2633 ps-header-line-height (/ (* lh ps-header-font-size) sz))
2634 ps-header-font-family))
2635 2785
2636(defun ps-get-page-dimensions () 2786(defun ps-get-page-dimensions ()
2637 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database))) 2787 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
@@ -2641,11 +2791,13 @@ using the current ps-print setup."
2641 (error "`ps-paper-type' must be one of:\n%s" 2791 (error "`ps-paper-type' must be one of:\n%s"
2642 (mapcar 'car ps-page-dimensions-database))) 2792 (mapcar 'car ps-page-dimensions-database)))
2643 ((< ps-number-of-columns 1) 2793 ((< ps-number-of-columns 1)
2644 (error "The number of columns %d should not be negative" 2794 (error "The number of columns %d should be positive"
2645 ps-number-of-columns))) 2795 ps-number-of-columns)))
2646 2796
2647 (ps-select-font) 2797 (ps-select-font ps-font-family 'ps-font-for-text
2648 (ps-select-header-font) 2798 ps-font-size ps-font-size)
2799 (ps-select-font ps-header-font-family 'ps-font-for-header
2800 ps-header-font-size ps-header-title-font-size)
2649 2801
2650 (setq page-width (ps-page-dimensions-get-width page-dimensions) 2802 (setq page-width (ps-page-dimensions-get-width page-dimensions)
2651 page-height (ps-page-dimensions-get-height page-dimensions)) 2803 page-height (ps-page-dimensions-get-height page-dimensions))
@@ -2696,12 +2848,14 @@ page-height == bm + print-height + tm
2696 ;; If headers are turned on, deduct the height of the header from 2848 ;; If headers are turned on, deduct the height of the header from
2697 ;; the print height. 2849 ;; the print height.
2698 (if ps-print-header 2850 (if ps-print-header
2699 (setq ps-header-pad (* ps-header-line-pad ps-header-title-line-height) 2851 (setq ps-header-pad (* ps-header-line-pad
2852 (ps-title-line-height 'ps-font-for-header))
2700 ps-print-height (- ps-print-height 2853 ps-print-height (- ps-print-height
2701 ps-header-offset 2854 ps-header-offset
2702 ps-header-pad 2855 ps-header-pad
2703 ps-header-title-line-height 2856 (ps-title-line-height 'ps-font-for-header)
2704 (* ps-header-line-height (1- ps-header-lines)) 2857 (* (ps-line-height 'ps-font-for-header)
2858 (1- ps-header-lines))
2705 ps-header-pad))) 2859 ps-header-pad)))
2706 (if (<= ps-print-height 0) 2860 (if (<= ps-print-height 0)
2707 (error "Bad vertical layout: 2861 (error "Bad vertical layout:
@@ -2717,8 +2871,9 @@ page-height == bm + print-height + tm - ho - hh
2717 ps-header-offset 2871 ps-header-offset
2718 ps-header-pad 2872 ps-header-pad
2719 (+ ps-header-pad 2873 (+ ps-header-pad
2720 ps-header-title-line-height 2874 (ps-title-line-height 'ps-font-for-header)
2721 (* ps-header-line-height (1- ps-header-lines)) 2875 (* (ps-line-height 'ps-font-for-header)
2876 (1- ps-header-lines))
2722 ps-header-pad) 2877 ps-header-pad)
2723 ps-print-height)))) 2878 ps-print-height))))
2724 2879
@@ -3003,9 +3158,13 @@ page-height == bm + print-height + tm - ho - hh
3003 "\n%%Orientation: " 3158 "\n%%Orientation: "
3004 (if ps-landscape-mode "Landscape" "Portrait") 3159 (if ps-landscape-mode "Landscape" "Portrait")
3005 "\n%% DocumentFonts: Times-Roman Times-Italic " 3160 "\n%% DocumentFonts: Times-Roman Times-Italic "
3006 ps-font " " ps-font-bold " " ps-font-italic " " 3161 (mapconcat 'identity
3007 ps-font-bold-italic " " 3162 (remove-duplicates
3008 ps-header-font " " ps-header-title-font 3163 (append (ps-fonts 'ps-font-for-text)
3164 (list (ps-font 'ps-font-for-header 'normal)
3165 (ps-font 'ps-font-for-header 'bold)))
3166 :test 'equal)
3167 " ")
3009 "\n%%Pages: (atend)\n" 3168 "\n%%Pages: (atend)\n"
3010 "%%EndComments\n\n") 3169 "%%EndComments\n\n")
3011 3170
@@ -3029,16 +3188,18 @@ page-height == bm + print-height + tm - ho - hh
3029 (format "/HeaderOffset %s def\n" ps-header-offset) 3188 (format "/HeaderOffset %s def\n" ps-header-offset)
3030 (format "/HeaderPad %s def\n" ps-header-pad)) 3189 (format "/HeaderPad %s def\n" ps-header-pad))
3031 3190
3032 (ps-output-boolean "PrintHeader" ps-print-header) 3191 (ps-output-boolean "PrintHeader" ps-print-header)
3033 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) 3192 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
3034 (ps-output-boolean "ShowNofN" ps-show-n-of-n) 3193 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
3035 (ps-output-boolean "Duplex" ps-spool-duplex) 3194 (ps-output-boolean "ShowNofN" ps-show-n-of-n)
3195 (ps-output-boolean "Duplex" ps-spool-duplex)
3036 3196
3037 (ps-output (format "/LineHeight %s def\n" ps-line-height) 3197 (let ((line-height (ps-line-height 'ps-font-for-text)))
3038 (format "/LinesPerColumn %d def\n" 3198 (ps-output (format "/LineHeight %s def\n" line-height)
3039 (round (/ (+ ps-print-height 3199 (format "/LinesPerColumn %d def\n"
3040 (* ps-line-height 0.45)) 3200 (round (/ (+ ps-print-height
3041 ps-line-height)))) 3201 (* line-height 0.45))
3202 line-height)))))
3042 3203
3043 (ps-output-boolean "Zebra" ps-zebra-stripes) 3204 (ps-output-boolean "Zebra" ps-zebra-stripes)
3044 (ps-output-boolean "PrintLineNumber" ps-line-number) 3205 (ps-output-boolean "PrintLineNumber" ps-line-number)
@@ -3064,17 +3225,22 @@ page-height == bm + print-height + tm - ho - hh
3064 3225
3065 ;; Header fonts 3226 ;; Header fonts
3066 (ps-output (format "/h0 %s /%s DefFont\n" ; /h0 14 /Helvetica-Bold DefFont 3227 (ps-output (format "/h0 %s /%s DefFont\n" ; /h0 14 /Helvetica-Bold DefFont
3067 ps-header-title-font-size ps-header-title-font) 3228 ps-header-title-font-size (ps-font 'ps-font-for-header
3229 'bold))
3068 (format "/h1 %s /%s DefFont\n" ; /h1 12 /Helvetica DefFont 3230 (format "/h1 %s /%s DefFont\n" ; /h1 12 /Helvetica DefFont
3069 ps-header-font-size ps-header-font)) 3231 ps-header-font-size (ps-font 'ps-font-for-header
3232 'normal)))
3070 3233
3071 (ps-output ps-print-prologue-2) 3234 (ps-output ps-print-prologue-2)
3072 3235
3073 ;; Text fonts 3236 ;; Text fonts
3074 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font) 3237 (loop for font in (ps-font-list 'ps-font-for-text)
3075 (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold) 3238 for i from 0
3076 (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic) 3239 do
3077 (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic)) 3240 (ps-output (format "/f%d %s /%s DefFont\n"
3241 i
3242 ps-font-size
3243 (ps-font 'ps-font-for-text (car font)))))
3078 3244
3079 (ps-output "\nBeginDoc\n\n" 3245 (ps-output "\nBeginDoc\n\n"
3080 "%%EndPrologue\n")) 3246 "%%EndPrologue\n"))
@@ -3103,14 +3269,20 @@ page-height == bm + print-height + tm - ho - hh
3103(defun ps-begin-job () 3269(defun ps-begin-job ()
3104 (setq ps-page-count 0 3270 (setq ps-page-count 0
3105 ps-control-or-escape-regexp 3271 ps-control-or-escape-regexp
3106 (cond ((eq ps-print-control-characters '8-bit) "[\000-\037\177-\377]") 3272 (cond ((eq ps-print-control-characters '8-bit)
3107 ((eq ps-print-control-characters 'control-8-bit) "[\000-\037\177-\237]") 3273 "[\000-\037\177-\377]")
3108 ((eq ps-print-control-characters 'control) "[\000-\037\177]") 3274 ((eq ps-print-control-characters 'control-8-bit)
3275 "[\000-\037\177-\237]")
3276 ((eq ps-print-control-characters 'control)
3277 "[\000-\037\177]")
3109 (t "[\t\n\f]")))) 3278 (t "[\t\n\f]"))))
3110 3279
3280(defmacro ps-page-number ()
3281 `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
3282
3111(defun ps-end-file () 3283(defun ps-end-file ()
3112 (ps-output "\nEndDoc\n\n%%Trailer\n%%Pages: " 3284 (ps-output "\nEndDoc\n\n%%Trailer\n%%Pages: "
3113 (format "%d" (1+ (/ (1- ps-page-count) ps-number-of-columns))) 3285 (format "%d" (ps-page-number))
3114 "\n%%EOF\n")) 3286 "\n%%EOF\n"))
3115 3287
3116 3288
@@ -3119,16 +3291,19 @@ page-height == bm + print-height + tm - ho - hh
3119 (ps-flush-output) 3291 (ps-flush-output)
3120 (ps-begin-page)) 3292 (ps-begin-page))
3121 3293
3122(defun ps-header-page (&optional inc-p) 3294(defun ps-header-page ()
3123 (if (zerop (mod ps-page-count ps-number-of-columns)) 3295 (if (prog1
3296 (zerop (mod ps-page-count ps-number-of-columns))
3297 (incf ps-page-count))
3124 ;; Print only when a new real page begins. 3298 ;; Print only when a new real page begins.
3125 (let ((page-number (1+ (/ ps-page-count ps-number-of-columns)))) 3299 (let ((page-number (ps-page-number)))
3126 (ps-output (format "\n%%%%Page: %d %d\n" page-number page-number)) 3300 (ps-output (format "\n%%%%Page: %d %d\n" page-number page-number))
3127 (ps-output "BeginDSCPage\n") 3301 (ps-output "BeginDSCPage\n")
3128 (ps-background page-number) 3302 (ps-background page-number)
3129 (and inc-p (incf ps-page-count))) 3303 (run-hooks 'ps-print-begin-page-hook))
3130 ;; Print when any other page begins. 3304 ;; Print when any other page begins.
3131 (ps-output "BeginDSCPage\n"))) 3305 (ps-output "BeginDSCPage\n")
3306 (run-hooks 'ps-print-begin-column-hook)))
3132 3307
3133(defun ps-begin-page () 3308(defun ps-begin-page ()
3134 (ps-get-page-dimensions) 3309 (ps-get-page-dimensions)
@@ -3138,7 +3313,9 @@ page-height == bm + print-height + tm - ho - hh
3138 (ps-header-page) 3313 (ps-header-page)
3139 3314
3140 (ps-output (format "/LineNumber %d def\n" ps-showline-count) 3315 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
3141 (format "/PageNumber %d def\n" (incf ps-page-count))) 3316 (format "/PageNumber %d def\n" (if ps-print-only-one-header
3317 (ps-page-number)
3318 ps-page-count)))
3142 3319
3143 (when ps-print-header 3320 (when ps-print-header
3144 (ps-generate-header "HeaderLinesLeft" ps-left-header) 3321 (ps-generate-header "HeaderLinesLeft" ps-left-header)
@@ -3154,7 +3331,7 @@ page-height == bm + print-height + tm - ho - hh
3154 (ps-output "EndPage\nEndDSCPage\n")) 3331 (ps-output "EndPage\nEndDSCPage\n"))
3155 3332
3156(defun ps-dummy-page () 3333(defun ps-dummy-page ()
3157 (ps-header-page t) 3334 (ps-header-page)
3158 (ps-output "/PrintHeader false def 3335 (ps-output "/PrintHeader false def
3159BeginPage 3336BeginPage
3160EndPage 3337EndPage
@@ -3162,18 +3339,20 @@ EndDSCPage\n"))
3162 3339
3163(defun ps-next-line () 3340(defun ps-next-line ()
3164 (setq ps-showline-count (1+ ps-showline-count)) 3341 (setq ps-showline-count (1+ ps-showline-count))
3165 (if (< ps-height-remaining ps-line-height) 3342 (let ((lh (ps-line-height 'ps-font-for-text)))
3166 (ps-next-page) 3343 (if (< ps-height-remaining lh)
3167 (setq ps-width-remaining ps-print-width 3344 (ps-next-page)
3168 ps-height-remaining (- ps-height-remaining ps-line-height)) 3345 (setq ps-width-remaining ps-print-width
3169 (ps-output "HL\n"))) 3346 ps-height-remaining (- ps-height-remaining lh))
3347 (ps-output "HL\n"))))
3170 3348
3171(defun ps-continue-line () 3349(defun ps-continue-line ()
3172 (if (< ps-height-remaining ps-line-height) 3350 (let ((lh (ps-line-height 'ps-font-for-text)))
3173 (ps-next-page) 3351 (if (< ps-height-remaining lh)
3174 (setq ps-width-remaining ps-print-width 3352 (ps-next-page)
3175 ps-height-remaining (- ps-height-remaining ps-line-height)) 3353 (setq ps-width-remaining ps-print-width
3176 (ps-output "SL\n"))) 3354 ps-height-remaining (- ps-height-remaining lh))
3355 (ps-output "SL\n"))))
3177 3356
3178(defun ps-find-wrappoint (from to char-width) 3357(defun ps-find-wrappoint (from to char-width)
3179 (let ((avail (truncate (/ ps-width-remaining char-width))) 3358 (let ((avail (truncate (/ ps-width-remaining char-width)))
@@ -3183,7 +3362,8 @@ EndDSCPage\n"))
3183 (cons (+ from avail) ps-width-remaining)))) 3362 (cons (+ from avail) ps-width-remaining))))
3184 3363
3185(defun ps-basic-plot-string (from to &optional bg-color) 3364(defun ps-basic-plot-string (from to &optional bg-color)
3186 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width)) 3365 (let* ((wrappoint (ps-find-wrappoint from to
3366 (ps-avg-char-width 'ps-font-for-text)))
3187 (to (car wrappoint)) 3367 (to (car wrappoint))
3188 (string (buffer-substring-no-properties from to))) 3368 (string (buffer-substring-no-properties from to)))
3189 (ps-output-string string) 3369 (ps-output-string string)
@@ -3191,7 +3371,8 @@ EndDSCPage\n"))
3191 wrappoint)) 3371 wrappoint))
3192 3372
3193(defun ps-basic-plot-whitespace (from to &optional bg-color) 3373(defun ps-basic-plot-whitespace (from to &optional bg-color)
3194 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width)) 3374 (let* ((wrappoint (ps-find-wrappoint from to
3375 (ps-space-width 'ps-font-for-text)))
3195 (to (car wrappoint))) 3376 (to (car wrappoint)))
3196 (ps-output (format "%d W\n" (- to from))) 3377 (ps-output (format "%d W\n" (- to from)))
3197 wrappoint)) 3378 wrappoint))
@@ -3270,7 +3451,8 @@ EndDSCPage\n"))
3270 (while (< from to) 3451 (while (< from to)
3271 (if (re-search-forward ps-control-or-escape-regexp to t) 3452 (if (re-search-forward ps-control-or-escape-regexp to t)
3272 ;; region with some control characters 3453 ;; region with some control characters
3273 (let ((match (char-after (match-beginning 0)))) 3454 (let* ((match-point (match-beginning 0))
3455 (match (char-after match-point)))
3274 (ps-plot 'ps-basic-plot-string from (1- (point)) bg-color) 3456 (ps-plot 'ps-basic-plot-string from (1- (point)) bg-color)
3275 (cond 3457 (cond
3276 ((= match ?\t) ; tab 3458 ((= match ?\t) ; tab
@@ -3286,7 +3468,11 @@ EndDSCPage\n"))
3286 (ps-next-line)) 3468 (ps-next-line))
3287 3469
3288 ((= match ?\f) ; form feed 3470 ((= match ?\f) ; form feed
3289 (ps-next-page)) 3471 ;; do not skip page if previous character is NEWLINE and
3472 ;; it is a beginning of page.
3473 (or (and (= (char-after (1- match-point)) ?\n)
3474 (= ps-height-remaining ps-print-height))
3475 (ps-next-page)))
3290 ; characters from ^@ to ^_ and 3476 ; characters from ^@ to ^_ and
3291 (t ; characters from 127 to 255 3477 (t ; characters from 127 to 255
3292 (ps-control-character match))) 3478 (ps-control-character match)))
@@ -3319,10 +3505,11 @@ EndDSCPage\n"))
3319 (from (1- (point))) 3505 (from (1- (point)))
3320 (len (length str)) 3506 (len (length str))
3321 (to (+ from len)) 3507 (to (+ from len))
3322 (wrappoint (ps-find-wrappoint from to ps-avg-char-width))) 3508 (char-width (ps-avg-char-width 'ps-font-for-text))
3509 (wrappoint (ps-find-wrappoint from to char-width)))
3323 (if (< (car wrappoint) to) 3510 (if (< (car wrappoint) to)
3324 (ps-continue-line)) 3511 (ps-continue-line))
3325 (setq ps-width-remaining (- ps-width-remaining (* len ps-avg-char-width))) 3512 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
3326 (ps-output-string str) 3513 (ps-output-string str)
3327 (ps-output " S\n"))) 3514 (ps-output " S\n")))
3328 3515
@@ -3333,16 +3520,15 @@ EndDSCPage\n"))
3333(defun ps-color-values (x-color) 3520(defun ps-color-values (x-color)
3334 (cond ((fboundp 'x-color-values) 3521 (cond ((fboundp 'x-color-values)
3335 (x-color-values x-color)) 3522 (x-color-values x-color))
3336 ((fboundp 'color-instance-rgb-components) 3523 ((and (fboundp 'color-instance-rgb-components)
3337 (if (ps-color-device) 3524 (ps-color-device))
3338 (color-instance-rgb-components 3525 (color-instance-rgb-components
3339 (if (color-instance-p x-color) 3526 (if (color-instance-p x-color)
3340 x-color 3527 x-color
3341 (make-color-instance 3528 (make-color-instance
3342 (if (color-specifier-p x-color) 3529 (if (color-specifier-p x-color)
3343 (color-name x-color) 3530 (color-name x-color)
3344 x-color)))) 3531 x-color)))))
3345 (error "No available function to determine X color values.")))
3346 (t (error "No available function to determine X color values.")))) 3532 (t (error "No available function to determine X color values."))))
3347 3533
3348 3534
@@ -3380,22 +3566,32 @@ If FACE is not a valid face name, it is used default face."
3380 (ps-face-attributes face-or-list))) 3566 (ps-face-attributes face-or-list)))
3381 3567
3382 3568
3569(defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
3570
3571
3383(defun ps-plot-with-face (from to face) 3572(defun ps-plot-with-face (from to face)
3384 (if face 3573 (cond
3385 (let* ((face-bit (ps-face-attribute-list face)) 3574 ((null face) ; print text with null face
3386 (effect (aref face-bit 0))
3387 (foreground (aref face-bit 1))
3388 (background (aref face-bit 2))
3389 (fg-color (if (and ps-print-color-p foreground (ps-color-device))
3390 (mapcar 'ps-color-value
3391 (ps-color-values foreground))
3392 ps-default-color))
3393 (bg-color (and ps-print-color-p background (ps-color-device)
3394 (mapcar 'ps-color-value
3395 (ps-color-values background)))))
3396 (ps-plot-region from to (logand effect 3)
3397 fg-color bg-color (lsh effect -2)))
3398 (ps-plot-region from to 0)) 3575 (ps-plot-region from to 0))
3576 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
3577 (t ; otherwise, text has a valid face
3578 (let* ((face-bit (ps-face-attribute-list face))
3579 (effect (aref face-bit 0))
3580 (foreground (aref face-bit 1))
3581 (background (aref face-bit 2))
3582 (fg-color (if (and ps-print-color-p foreground (ps-color-device))
3583 (mapcar 'ps-color-value
3584 (ps-color-values foreground))
3585 ps-default-color))
3586 (bg-color (and ps-print-color-p background (ps-color-device)
3587 (mapcar 'ps-color-value
3588 (ps-color-values background)))))
3589 (ps-plot-region
3590 from to
3591 (ps-font-number 'ps-font-for-text
3592 (or (aref ps-font-type (logand effect 3))
3593 face))
3594 fg-color bg-color (lsh effect -2)))))
3399 (goto-char to)) 3595 (goto-char to))
3400 3596
3401 3597
@@ -3598,7 +3794,7 @@ If FACE is not a valid face name, it is used default face."
3598 (not (null prop)) 3794 (not (null prop))
3599 (or (memq prop buffer-invisibility-spec) 3795 (or (memq prop buffer-invisibility-spec)
3600 (assq prop buffer-invisibility-spec)))) 3796 (assq prop buffer-invisibility-spec))))
3601 nil) 3797 'emacs--invisible--face)
3602 ((get-text-property from 'face)) 3798 ((get-text-property from 'face))
3603 (t 'default))) 3799 (t 'default)))
3604 (let ((overlays (overlays-at from)) 3800 (let ((overlays (overlays-at from))
@@ -3676,7 +3872,10 @@ If FACE is not a valid face name, it is used default face."
3676 (set-buffer ps-spool-buffer) 3872 (set-buffer ps-spool-buffer)
3677 (goto-char (point-min)) 3873 (goto-char (point-min))
3678 (and (re-search-forward "^/PageCount 0 def$" nil t) 3874 (and (re-search-forward "^/PageCount 0 def$" nil t)
3679 (replace-match (format "/PageCount %d def" ps-page-count) 3875 (replace-match (format "/PageCount %d def"
3876 (if ps-print-only-one-header
3877 (ps-page-number)
3878 ps-page-count))
3680 t)) 3879 t))
3681 3880
3682 ;; Setting this variable tells the unwind form that the 3881 ;; Setting this variable tells the unwind form that the