Mercurial > emacs
comparison lisp/ps-print.el @ 20331:39baaa9c5980
Some comment and doc fixes.
(ps-print-version): New version number (3.05.2) and doc fix.
(ps-print, ps-header-lines, ps-show-n-of-n, ps-font-info-database)
(ps-font-family, ps-font-size, ps-header-font-family)
(ps-header-font-size, ps-header-title-font-size, ps-bold-faces)
(ps-italic-faces, ps-underlined-faces, ps-left-header, ps-right-header)
(ps-font, ps-font-bold, ps-font-italic, ps-font-bold-italic)
(ps-avg-char-width, ps-space-width, ps-line-height): Doc fix.
(ps-error-scale-font): New fn.
(ps-soft-lf, ps-hard-lf): Fn deleted.
(ps-get-page-dimensions, ps-set-bg, ps-face-bold-p, ps-face-italic-p)
(ps-set-color): Reindentation.
(ps-output-string-prim, ps-xemacs-face-kind-p): Internal blank lines
deleted.
(ps-set-font): Little programming improvement.
(ps-line-lengths-internal, ps-nb-pages, ps-select-font)
(ps-select-header-font): Simplify some expressions.
(ps-plot-region): Replace (- X 1) by (1- X).
(ps-generate-header): Replace (+ X 1) by (1+ X).
(ps-print-preprint, ps-plot-with-face, ps-print-ensure-fontified)
(ps-kill-emacs-check): Replace (if (and A B) C) by (and A B C).
(ps-init-output-queue, ps-gnus-article-prepare-hook, ps-jts-ps-setup):
Replace (setq a b)(setq c d) by (setq a b c d).
(ps-begin-file, ps-end-file): Replace (ps-output A)(ps-output B)
by (ps-output A B).
(ps-begin-page): Replace (ps-output A)(ps-output B) by (ps-output A B),
replace (setq a b)(setq c d) by (setq a b c d).
(ps-next-line, ps-continue-line): Replace (setq a b)(setq c d)
by (setq a b c d), and incorporates ps-soft-lf and ps-hard-lf,
respectively.
(ps-plot): Replace (setq a b)(setq c d) by (setq a b c d),
and programming improvement.
(ps-generate-postscript-with-faces): Initialization fix,
replace (setq a b)(setq c d) by (setq a b c d),
replace (if (and A B) C) by (and A B C).
(ps-generate): Doc fix, reprogramming to set the page count,
replace (setq a b)(setq c d) by (setq a b c d),
replace (if A nil B) by (or A B),
replace (if (and A B) C) by (and A B C).
(ps-info-mode-hook): Replace (list 'A 'B) by '(A B).
(ps-jack-setup): Replace (list) by nil.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Sun, 23 Nov 1997 02:26:50 +0000 |
parents | d8e290881d8c |
children | 52b1ed13e4d2 |
comparison
equal
deleted
inserted
replaced
20330:f76b9c0ebc4b | 20331:39baaa9c5980 |
---|---|
2 | 2 |
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997 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 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.br> | 7 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> |
8 ;; Keywords: print, PostScript | 8 ;; Keywords: print, PostScript |
9 ;; Time-stamp: <97/08/27 13:00:37 vinicius> | 9 ;; Time-stamp: <97/08/28 22:35:25 vinicius> |
10 ;; Version: 3.05.1 | 10 ;; Version: 3.05.2 |
11 | 11 |
12 (defconst ps-print-version "3.05.1" | 12 (defconst ps-print-version "3.05.2" |
13 "ps-print.el, v 3.05.1 <97/08/24 vinicius> | 13 "ps-print.el, v 3.05.2 <97/08/28 vinicius> |
14 | 14 |
15 Vinicius's last change version -- this file may have been edited as part of | 15 Vinicius's last change version -- this file may have been edited as part of |
16 Emacs without changes to the version number. When reporting bugs, | 16 Emacs without changes to the version number. When reporting bugs, |
17 please also report the version of Emacs, if any, that ps-print was | 17 please also report the version of Emacs, if any, that ps-print was |
18 distributed with. | 18 distributed with. |
19 | 19 |
20 Please send all bug fixes and enhancements to | 20 Please send all bug fixes and enhancements to |
21 Jacques Duthen <duthen@cegelec-red.fr>. | 21 Vinicius Jose Latorre <vinicius@cpqd.com.br>. |
22 ") | 22 ") |
23 | 23 |
24 ;; This file is part of GNU Emacs. | 24 ;; This file is part of GNU Emacs. |
25 | 25 |
26 ;; GNU Emacs is free software; you can redistribute it and/or modify | 26 ;; GNU Emacs is free software; you can redistribute it and/or modify |
389 ;; Each rectangle extends all the way across the page. | 389 ;; Each rectangle extends all the way across the page. |
390 ;; | 390 ;; |
391 ;; The height, in lines, of each rectangle is controlled by | 391 ;; The height, in lines, of each rectangle is controlled by |
392 ;; the variable `ps-zebra-stripe-height', which is 3 by default. | 392 ;; the variable `ps-zebra-stripe-height', which is 3 by default. |
393 ;; The distance between stripes equals the height of a stripe. | 393 ;; The distance between stripes equals the height of a stripe. |
394 ;; | 394 ;; |
395 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes. | 395 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes. |
396 ;; Non-nil means yes, nil means no. The default is nil. | 396 ;; Non-nil means yes, nil means no. The default is nil. |
397 ;; | 397 ;; |
398 ;; See also section How Ps-Print Has A Text And/Or Image On Background. | 398 ;; See also section How Ps-Print Has A Text And/Or Image On Background. |
399 ;; | 399 ;; |
751 ;; User Variables: | 751 ;; User Variables: |
752 | 752 |
753 ;;; Interface to the command system | 753 ;;; Interface to the command system |
754 | 754 |
755 (defgroup ps-print nil | 755 (defgroup ps-print nil |
756 "Postscript generator for Emacs 19" | 756 "PostScript generator for Emacs 19" |
757 :prefix "ps-" | 757 :prefix "ps-" |
758 :group 'wp) | 758 :group 'wp) |
759 | 759 |
760 (defgroup ps-print-horizontal nil | 760 (defgroup ps-print-horizontal nil |
761 "Horizontal page layout" | 761 "Horizontal page layout" |
1051 "*Non-nil means draw a gaudy frame around the header." | 1051 "*Non-nil means draw a gaudy frame around the header." |
1052 :type 'boolean | 1052 :type 'boolean |
1053 :group 'ps-print-header) | 1053 :group 'ps-print-header) |
1054 | 1054 |
1055 (defcustom ps-header-lines 2 | 1055 (defcustom ps-header-lines 2 |
1056 "*Number of lines to display in page header, when generating Postscript." | 1056 "*Number of lines to display in page header, when generating PostScript." |
1057 :type 'integer | 1057 :type 'integer |
1058 :group 'ps-print-header) | 1058 :group 'ps-print-header) |
1059 (make-variable-buffer-local 'ps-header-lines) | 1059 (make-variable-buffer-local 'ps-header-lines) |
1060 | 1060 |
1061 (defcustom ps-show-n-of-n t | 1061 (defcustom ps-show-n-of-n t |
1062 "*Non-nil means show page numbers as N/M, meaning page N of M. | 1062 "*Non-nil means show page numbers as N/M, meaning page N of M. |
1063 Note: page numbers are displayed as part of headers, see variable | 1063 NOTE: page numbers are displayed as part of headers, |
1064 `ps-print-header'." | 1064 see variable `ps-print-headers'." |
1065 :type 'boolean | 1065 :type 'boolean |
1066 :group 'ps-print-header) | 1066 :group 'ps-print-header) |
1067 | 1067 |
1068 (defcustom ps-spool-duplex nil ; Not many people have duplex | 1068 (defcustom ps-spool-duplex nil ; Not many people have duplex |
1069 ; printers, so default to nil. | 1069 ; printers, so default to nil. |
1131 "*Font info database: font family (the key), name, bold, italic, bold-italic, | 1131 "*Font info database: font family (the key), name, bold, italic, bold-italic, |
1132 reference size, line height, space width, average character width. | 1132 reference size, line height, space width, average character width. |
1133 To get the info for another specific font (say Helvetica), do the following: | 1133 To get the info for another specific font (say Helvetica), do the following: |
1134 - create a new buffer | 1134 - create a new buffer |
1135 - generate the PostScript image to a file (C-u M-x ps-print-buffer) | 1135 - generate the PostScript image to a file (C-u M-x ps-print-buffer) |
1136 - open this file and delete the leading `%' (which is the Postscript | 1136 - open this file and delete the leading `%' (which is the PostScript |
1137 comment character) from the line | 1137 comment character) from the line |
1138 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage' | 1138 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage' |
1139 to get the line | 1139 to get the line |
1140 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage' | 1140 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage' |
1141 - add the values to `ps-font-info-database'. | 1141 - add the values to `ps-font-info-database'. |
1151 (number :tag "Space Width") | 1151 (number :tag "Space Width") |
1152 (number :tag "Average Character Width"))) | 1152 (number :tag "Average Character Width"))) |
1153 :group 'ps-print-font) | 1153 :group 'ps-print-font) |
1154 | 1154 |
1155 (defcustom ps-font-family 'Courier | 1155 (defcustom ps-font-family 'Courier |
1156 "Font family name for ordinary text, when generating Postscript." | 1156 "Font family name for ordinary text, when generating PostScript." |
1157 :type 'symbol | 1157 :type 'symbol |
1158 :group 'ps-print-font) | 1158 :group 'ps-print-font) |
1159 | 1159 |
1160 (defcustom ps-font-size (if ps-landscape-mode 7 8.5) | 1160 (defcustom ps-font-size (if ps-landscape-mode 7 8.5) |
1161 "Font size, in points, for ordinary text, when generating Postscript." | 1161 "Font size, in points, for ordinary text, when generating PostScript." |
1162 :type 'number | 1162 :type 'number |
1163 :group 'ps-print-font) | 1163 :group 'ps-print-font) |
1164 | 1164 |
1165 (defcustom ps-header-font-family 'Helvetica | 1165 (defcustom ps-header-font-family 'Helvetica |
1166 "Font family name for text in the header, when generating Postscript." | 1166 "Font family name for text in the header, when generating PostScript." |
1167 :type 'symbol | 1167 :type 'symbol |
1168 :group 'ps-print-font) | 1168 :group 'ps-print-font) |
1169 | 1169 |
1170 (defcustom ps-header-font-size (if ps-landscape-mode 10 12) | 1170 (defcustom ps-header-font-size (if ps-landscape-mode 10 12) |
1171 "Font size, in points, for text in the header, when generating Postscript." | 1171 "Font size, in points, for text in the header, when generating PostScript." |
1172 :type 'number | 1172 :type 'number |
1173 :group 'ps-print-font) | 1173 :group 'ps-print-font) |
1174 | 1174 |
1175 (defcustom ps-header-title-font-size (if ps-landscape-mode 12 14) | 1175 (defcustom ps-header-title-font-size (if ps-landscape-mode 12 14) |
1176 "Font size, in points, for the top line of text in the header, | 1176 "Font size, in points, for the top line of text in the header, |
1177 when generating Postscript." | 1177 when generating PostScript." |
1178 :type 'number | 1178 :type 'number |
1179 :group 'ps-print-font) | 1179 :group 'ps-print-font) |
1180 | 1180 |
1181 ;;; Colors | 1181 ;;; Colors |
1182 | 1182 |
1210 font-lock-builtin-face | 1210 font-lock-builtin-face |
1211 font-lock-variable-name-face | 1211 font-lock-variable-name-face |
1212 font-lock-keyword-face | 1212 font-lock-keyword-face |
1213 font-lock-warning-face)) | 1213 font-lock-warning-face)) |
1214 "*A list of the \(non-bold\) faces that should be printed in bold font. | 1214 "*A list of the \(non-bold\) faces that should be printed in bold font. |
1215 This applies to generating Postscript." | 1215 This applies to generating PostScript." |
1216 :type '(repeat face) | 1216 :type '(repeat face) |
1217 :group 'ps-print-face) | 1217 :group 'ps-print-face) |
1218 | 1218 |
1219 (defcustom ps-italic-faces | 1219 (defcustom ps-italic-faces |
1220 (unless ps-print-color-p | 1220 (unless ps-print-color-p |
1221 '(font-lock-variable-name-face | 1221 '(font-lock-variable-name-face |
1222 font-lock-type-face | |
1222 font-lock-string-face | 1223 font-lock-string-face |
1223 font-lock-comment-face | 1224 font-lock-comment-face |
1224 font-lock-warning-face)) | 1225 font-lock-warning-face)) |
1225 "*A list of the \(non-italic\) faces that should be printed in italic font. | 1226 "*A list of the \(non-italic\) faces that should be printed in italic font. |
1226 This applies to generating Postscript." | 1227 This applies to generating PostScript." |
1227 :type '(repeat face) | 1228 :type '(repeat face) |
1228 :group 'ps-print-face) | 1229 :group 'ps-print-face) |
1229 | 1230 |
1230 (defcustom ps-underlined-faces | 1231 (defcustom ps-underlined-faces |
1231 (unless ps-print-color-p | 1232 (unless ps-print-color-p |
1232 '(font-lock-function-name-face | 1233 '(font-lock-function-name-face |
1233 font-lock-type-face | |
1234 font-lock-reference-face | 1234 font-lock-reference-face |
1235 font-lock-warning-face)) | 1235 font-lock-warning-face)) |
1236 "*A list of the \(non-underlined\) faces that should be printed underlined. | 1236 "*A list of the \(non-underlined\) faces that should be printed underlined. |
1237 This applies to generating Postscript." | 1237 This applies to generating PostScript." |
1238 :type '(repeat face) | 1238 :type '(repeat face) |
1239 :group 'ps-print-face) | 1239 :group 'ps-print-face) |
1240 | 1240 |
1241 (defcustom ps-left-header | 1241 (defcustom ps-left-header |
1242 (list 'ps-get-buffer-name 'ps-header-dirpart) | 1242 (list 'ps-get-buffer-name 'ps-header-dirpart) |
1243 "*The items to display (each on a line) on the left part of the page header. | 1243 "*The items to display (each on a line) on the left part of the page header. |
1244 This applies to generating Postscript. | 1244 This applies to generating PostScript. |
1245 | 1245 |
1246 The value should be a list of strings and symbols, each representing an | 1246 The value should be a list of strings and symbols, each representing an |
1247 entry in the PostScript array HeaderLinesLeft. | 1247 entry in the PostScript array HeaderLinesLeft. |
1248 | 1248 |
1249 Strings are inserted unchanged into the array; those representing | 1249 Strings are inserted unchanged into the array; those representing |
1260 (make-variable-buffer-local 'ps-left-header) | 1260 (make-variable-buffer-local 'ps-left-header) |
1261 | 1261 |
1262 (defcustom ps-right-header | 1262 (defcustom ps-right-header |
1263 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss) | 1263 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss) |
1264 "*The items to display (each on a line) on the right part of the page header. | 1264 "*The items to display (each on a line) on the right part of the page header. |
1265 This applies to generating Postscript. | 1265 This applies to generating PostScript. |
1266 | 1266 |
1267 See the variable `ps-left-header' for a description of the format of | 1267 See the variable `ps-left-header' for a description of the format of |
1268 this variable." | 1268 this variable." |
1269 :type '(repeat (choice string symbol)) | 1269 :type '(repeat (choice string symbol)) |
1270 :group 'ps-print-header) | 1270 :group 'ps-print-header) |
1441 " | 1441 " |
1442 \(setq ps-print-color-p %s | 1442 \(setq ps-print-color-p %s |
1443 ps-lpr-command \"%s\" | 1443 ps-lpr-command \"%s\" |
1444 ps-lpr-switches %s | 1444 ps-lpr-switches %s |
1445 | 1445 |
1446 ps-paper-type '%s | 1446 ps-paper-type '%s |
1447 ps-landscape-mode %s | 1447 ps-landscape-mode %s |
1448 ps-number-of-columns %s | 1448 ps-number-of-columns %s |
1449 | 1449 |
1450 ps-zebra-stripes %s | 1450 ps-zebra-stripes %s |
1451 ps-zebra-stripe-height %s | 1451 ps-zebra-stripe-height %s |
1452 ps-line-number %s | 1452 ps-line-number %s |
1453 | 1453 |
1454 ps-print-background-image %s | 1454 ps-print-background-image %s |
1455 | 1455 |
1456 ps-print-background-text %s | 1456 ps-print-background-text %s |
1457 | 1457 |
1520 ; x-font-regexp | 1520 ; x-font-regexp |
1521 | 1521 |
1522 (require 'time-stamp) | 1522 (require 'time-stamp) |
1523 | 1523 |
1524 (defvar ps-font nil | 1524 (defvar ps-font nil |
1525 "Font family name for ordinary text, when generating Postscript.") | 1525 "Font family name for ordinary text, when generating PostScript.") |
1526 | 1526 |
1527 (defvar ps-font-bold nil | 1527 (defvar ps-font-bold nil |
1528 "Font family name for bold text, when generating Postscript.") | 1528 "Font family name for bold text, when generating PostScript.") |
1529 | 1529 |
1530 (defvar ps-font-italic nil | 1530 (defvar ps-font-italic nil |
1531 "Font family name for italic text, when generating Postscript.") | 1531 "Font family name for italic text, when generating PostScript.") |
1532 | 1532 |
1533 (defvar ps-font-bold-italic nil | 1533 (defvar ps-font-bold-italic nil |
1534 "Font family name for bold italic text, when generating Postscript.") | 1534 "Font family name for bold italic text, when generating PostScript.") |
1535 | 1535 |
1536 (defvar ps-avg-char-width nil | 1536 (defvar ps-avg-char-width nil |
1537 "The average width, in points, of a character, for generating Postscript. | 1537 "The average width, in points, of a character, for generating PostScript. |
1538 This is the value that ps-print uses to determine the length, | 1538 This is the value that ps-print uses to determine the length, |
1539 x-dimension, of the text it has printed, and thus affects the point at | 1539 x-dimension, of the text it has printed, and thus affects the point at |
1540 which long lines wrap around.") | 1540 which long lines wrap around.") |
1541 | 1541 |
1542 (defvar ps-space-width nil | 1542 (defvar ps-space-width nil |
1543 "The width of a space character, for generating Postscript. | 1543 "The width of a space character, for generating PostScript. |
1544 This value is used in expanding tab characters.") | 1544 This value is used in expanding tab characters.") |
1545 | 1545 |
1546 (defvar ps-line-height nil | 1546 (defvar ps-line-height nil |
1547 "The height of a line, for generating Postscript. | 1547 "The height of a line, for generating PostScript. |
1548 This is the value that ps-print uses to determine the height, | 1548 This is the value that ps-print uses to determine the height, |
1549 y-dimension, of the lines of text it has printed, and thus affects the | 1549 y-dimension, of the lines of text it has printed, and thus affects the |
1550 point at which page-breaks are placed. | 1550 point at which page-breaks are placed. |
1551 The line-height is *not* the same as the point size of the font.") | 1551 The line-height is *not* the same as the point size of the font.") |
1552 | 1552 |
2219 (defvar ps-landscape-page-height nil) | 2219 (defvar ps-landscape-page-height nil) |
2220 | 2220 |
2221 (defvar ps-print-width nil) | 2221 (defvar ps-print-width nil) |
2222 (defvar ps-print-height nil) | 2222 (defvar ps-print-height nil) |
2223 | 2223 |
2224 (defvar ps-height-remaining) | 2224 (defvar ps-height-remaining nil) |
2225 (defvar ps-width-remaining) | 2225 (defvar ps-width-remaining nil) |
2226 | 2226 |
2227 (defvar ps-print-color-scale nil) | 2227 (defvar ps-print-color-scale nil) |
2228 | 2228 |
2229 | 2229 |
2230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 2230 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2421 nb-cpl ; current nb of characters per line | 2421 nb-cpl ; current nb of characters per line |
2422 ) | 2422 ) |
2423 (setq cw-min (/ (* icw fs-min) ifs) | 2423 (setq cw-min (/ (* icw fs-min) ifs) |
2424 nb-cpl-max (floor (/ print-width cw-min)) | 2424 nb-cpl-max (floor (/ print-width cw-min)) |
2425 cw-max (/ (* icw fs-max) ifs) | 2425 cw-max (/ (* icw fs-max) ifs) |
2426 nb-cpl-min (floor (/ print-width cw-max))) | 2426 nb-cpl-min (floor (/ print-width cw-max)) |
2427 (setq nb-cpl nb-cpl-min) | 2427 nb-cpl nb-cpl-min) |
2428 (set-buffer buf) | 2428 (set-buffer buf) |
2429 (goto-char (point-max)) | 2429 (goto-char (point-max)) |
2430 (if (not (bolp)) (insert "\n")) | 2430 (or (bolp) (insert "\n")) |
2431 (insert ps-setup) | 2431 (insert ps-setup |
2432 (insert "nb char per line / font size\n") | 2432 "nb char per line / font size\n") |
2433 (while (<= nb-cpl nb-cpl-max) | 2433 (while (<= nb-cpl nb-cpl-max) |
2434 (setq cw (/ print-width (float nb-cpl)) | 2434 (setq cw (/ print-width (float nb-cpl)) |
2435 fs (/ (* ifs cw) icw)) | 2435 fs (/ (* ifs cw) icw)) |
2436 (insert (format "%3s %s\n" nb-cpl fs)) | 2436 (insert (format "%3s %s\n" nb-cpl fs)) |
2437 (setq nb-cpl (1+ nb-cpl))) | 2437 (setq nb-cpl (1+ nb-cpl))) |
2438 (insert "\n") | 2438 (insert "\n") |
2439 (display-buffer buf 'not-this-window))) | 2439 (display-buffer buf 'not-this-window))) |
2440 | 2440 |
2464 (setq lh-min (/ (* ilh fs-min) ifs) | 2464 (setq lh-min (/ (* ilh fs-min) ifs) |
2465 nb-lpp-max (floor (/ page-height lh-min)) | 2465 nb-lpp-max (floor (/ page-height lh-min)) |
2466 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max)) | 2466 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max)) |
2467 lh-max (/ (* ilh fs-max) ifs) | 2467 lh-max (/ (* ilh fs-max) ifs) |
2468 nb-lpp-min (floor (/ page-height lh-max)) | 2468 nb-lpp-min (floor (/ page-height lh-max)) |
2469 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))) | 2469 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)) |
2470 (setq nb-page nb-page-min) | 2470 nb-page nb-page-min) |
2471 (set-buffer buf) | 2471 (set-buffer buf) |
2472 (goto-char (point-max)) | 2472 (goto-char (point-max)) |
2473 (if (not (bolp)) (insert "\n")) | 2473 (or (bolp) (insert "\n")) |
2474 (insert ps-setup) | 2474 (insert ps-setup |
2475 (insert (format "%d lines\n" nb-lines)) | 2475 (format "%d lines\n" nb-lines) |
2476 (insert "nb page / font size\n") | 2476 "nb page / font size\n") |
2477 (while (<= nb-page nb-page-max) | 2477 (while (<= nb-page nb-page-max) |
2478 (setq nb-lpp (ceiling (/ nb-lines (float nb-page))) | 2478 (setq nb-lpp (ceiling (/ nb-lines (float nb-page))) |
2479 lh (/ page-height nb-lpp) | 2479 lh (/ page-height nb-lpp) |
2480 fs (/ (* ifs lh) ilh)) | 2480 fs (/ (* ifs lh) ilh)) |
2481 (insert (format "%s %s\n" nb-page fs)) | 2481 (insert (format "%s %s\n" nb-page fs)) |
2482 (setq nb-page (1+ nb-page))) | 2482 (setq nb-page (1+ nb-page))) |
2483 (insert "\n") | 2483 (insert "\n") |
2484 (display-buffer buf 'not-this-window))) | 2484 (display-buffer buf 'not-this-window))) |
2485 | 2485 |
2486 (defun ps-error-scale-font () | |
2487 (error "Don't have data to scale font %s.\nKnown fonts families are:\n%s" | |
2488 ps-font-family | |
2489 (mapcar 'car ps-font-info-database))) | |
2490 | |
2486 (defun ps-select-font () | 2491 (defun ps-select-font () |
2487 "Choose the font name and size (scaling data)." | 2492 "Choose the font name and size (scaling data)." |
2488 (let ((assoc (assq ps-font-family ps-font-info-database)) | 2493 (let ((assoc (cdr (assq ps-font-family ps-font-info-database))) |
2489 l fn fb fi bi sz lh sw aw) | 2494 fn fb fi bi sz lh sw aw) |
2490 (if (null assoc) | 2495 (or assoc (ps-error-scale-font)) |
2491 (error "Don't have data to scale font %s. Known fonts families are %s" | 2496 (setq fn (nth 0 assoc) |
2492 ps-font-family | 2497 fb (nth 1 assoc) |
2493 (mapcar 'car ps-font-info-database))) | 2498 fi (nth 2 assoc) |
2494 (setq l (cdr assoc) | 2499 bi (nth 3 assoc) |
2495 fn (prog1 (car l) (setq l (cdr l))) ; need `pop' | 2500 sz (nth 4 assoc) |
2496 fb (prog1 (car l) (setq l (cdr l))) | 2501 lh (nth 5 assoc) |
2497 fi (prog1 (car l) (setq l (cdr l))) | 2502 sw (nth 6 assoc) |
2498 bi (prog1 (car l) (setq l (cdr l))) | 2503 aw (nth 7 assoc) |
2499 sz (prog1 (car l) (setq l (cdr l))) | 2504 |
2500 lh (prog1 (car l) (setq l (cdr l))) | 2505 ps-font fn |
2501 sw (prog1 (car l) (setq l (cdr l))) | 2506 ps-font-bold fb |
2502 aw (prog1 (car l) (setq l (cdr l)))) | 2507 ps-font-italic fi |
2503 | 2508 ps-font-bold-italic bi |
2504 (setq ps-font fn) | 2509 ;; These data just need to be rescaled: |
2505 (setq ps-font-bold fb) | 2510 ps-line-height (/ (* lh ps-font-size) sz) |
2506 (setq ps-font-italic fi) | 2511 ps-space-width (/ (* sw ps-font-size) sz) |
2507 (setq ps-font-bold-italic bi) | 2512 ps-avg-char-width (/ (* aw ps-font-size) sz)) |
2508 ;; These data just need to be rescaled: | |
2509 (setq ps-line-height (/ (* lh ps-font-size) sz)) | |
2510 (setq ps-space-width (/ (* sw ps-font-size) sz)) | |
2511 (setq ps-avg-char-width (/ (* aw ps-font-size) sz)) | |
2512 ps-font-family)) | 2513 ps-font-family)) |
2513 | 2514 |
2514 (defun ps-select-header-font () | 2515 (defun ps-select-header-font () |
2515 "Choose the font name and size (scaling data) for the header." | 2516 "Choose the font name and size (scaling data) for the header." |
2516 (let ((assoc (assq ps-header-font-family ps-font-info-database)) | 2517 (let ((assoc (cdr (assq ps-header-font-family ps-font-info-database))) |
2517 l fn fb fi bi sz lh sw aw) | 2518 fn fb fi bi sz lh sw aw) |
2518 (if (null assoc) | 2519 (or assoc (ps-error-scale-font)) |
2519 (error "Don't have data to scale font %s. Known fonts families are %s" | 2520 (setq fn (nth 0 assoc) |
2520 ps-font-family | 2521 fb (nth 1 assoc) |
2521 (mapcar 'car ps-font-info-database))) | 2522 fi (nth 2 assoc) |
2522 (setq l (cdr assoc) | 2523 bi (nth 3 assoc) |
2523 fn (prog1 (car l) (setq l (cdr l))) ; need `pop' | 2524 sz (nth 4 assoc) |
2524 fb (prog1 (car l) (setq l (cdr l))) | 2525 lh (nth 5 assoc) |
2525 fi (prog1 (car l) (setq l (cdr l))) | 2526 sw (nth 6 assoc) |
2526 bi (prog1 (car l) (setq l (cdr l))) | 2527 aw (nth 7 assoc) |
2527 sz (prog1 (car l) (setq l (cdr l))) | 2528 |
2528 lh (prog1 (car l) (setq l (cdr l))) | 2529 ;; Font name |
2529 sw (prog1 (car l) (setq l (cdr l))) | 2530 ps-header-font fn |
2530 aw (prog1 (car l) (setq l (cdr l)))) | 2531 ps-header-title-font fb |
2531 | 2532 ;; Line height: These data just need to be rescaled: |
2532 ;; Font name | 2533 ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz) |
2533 (setq ps-header-font fn) | 2534 ps-header-line-height (/ (* lh ps-header-font-size) sz)) |
2534 (setq ps-header-title-font fb) | |
2535 ;; Line height: These data just need to be rescaled: | |
2536 (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz)) | |
2537 (setq ps-header-line-height (/ (* lh ps-header-font-size) sz)) | |
2538 ps-header-font-family)) | 2535 ps-header-font-family)) |
2539 | 2536 |
2540 (defun ps-get-page-dimensions () | 2537 (defun ps-get-page-dimensions () |
2541 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database))) | 2538 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database))) |
2542 page-width page-height) | 2539 page-width page-height) |
2543 (cond | 2540 (cond |
2544 ((null page-dimensions) | 2541 ((null page-dimensions) |
2545 (error "`ps-paper-type' must be one of:\n%s" | 2542 (error "`ps-paper-type' must be one of:\n%s" |
2546 (mapcar 'car ps-page-dimensions-database))) | 2543 (mapcar 'car ps-page-dimensions-database))) |
2547 ((< ps-number-of-columns 1) | 2544 ((< ps-number-of-columns 1) |
2548 (error "The number of columns %d should not be negative" ps-number-of-columns))) | 2545 (error "The number of columns %d should not be negative" |
2546 ps-number-of-columns))) | |
2549 | 2547 |
2550 (ps-select-font) | 2548 (ps-select-font) |
2551 (ps-select-header-font) | 2549 (ps-select-header-font) |
2552 | 2550 |
2553 (setq page-width (ps-page-dimensions-get-width page-dimensions) | 2551 (setq page-width (ps-page-dimensions-get-width page-dimensions) |
2562 (setq ps-landscape-page-height page-height) | 2560 (setq ps-landscape-page-height page-height) |
2563 | 2561 |
2564 ;; | lm | text | ic | text | ic | text | rm | | 2562 ;; | lm | text | ic | text | ic | text | rm | |
2565 ;; page-width == lm + n * pw + (n - 1) * ic + rm | 2563 ;; page-width == lm + n * pw + (n - 1) * ic + rm |
2566 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n | 2564 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n |
2567 (setq ps-print-width | 2565 (setq ps-print-width (/ (- page-width |
2568 (/ (- page-width | 2566 ps-left-margin ps-right-margin |
2569 ps-left-margin ps-right-margin | 2567 (* (1- ps-number-of-columns) ps-inter-column)) |
2570 (* (1- ps-number-of-columns) ps-inter-column)) | 2568 ps-number-of-columns)) |
2571 ps-number-of-columns)) | |
2572 (if (<= ps-print-width 0) | 2569 (if (<= ps-print-width 0) |
2573 (error "Bad horizontal layout: | 2570 (error "Bad horizontal layout: |
2574 page-width == %s | 2571 page-width == %s |
2575 ps-left-margin == %s | 2572 ps-left-margin == %s |
2576 ps-right-margin == %s | 2573 ps-right-margin == %s |
2597 ps-top-margin | 2594 ps-top-margin |
2598 ps-bottom-margin | 2595 ps-bottom-margin |
2599 ps-print-height)) | 2596 ps-print-height)) |
2600 ;; If headers are turned on, deduct the height of the header from | 2597 ;; If headers are turned on, deduct the height of the header from |
2601 ;; the print height. | 2598 ;; the print height. |
2602 (cond | 2599 (if ps-print-header |
2603 (ps-print-header | 2600 (setq ps-header-pad (* ps-header-line-pad ps-header-title-line-height) |
2604 (setq ps-header-pad | 2601 ps-print-height (- ps-print-height |
2605 (* ps-header-line-pad ps-header-title-line-height)) | 2602 ps-header-offset |
2606 (setq ps-print-height | 2603 ps-header-pad |
2607 (- ps-print-height | 2604 ps-header-title-line-height |
2608 ps-header-offset | 2605 (* ps-header-line-height (1- ps-header-lines)) |
2609 ps-header-pad | 2606 ps-header-pad))) |
2610 ps-header-title-line-height | |
2611 (* ps-header-line-height (- ps-header-lines 1)) | |
2612 ps-header-pad)))) | |
2613 (if (<= ps-print-height 0) | 2607 (if (<= ps-print-height 0) |
2614 (error "Bad vertical layout: | 2608 (error "Bad vertical layout: |
2615 ps-top-margin == %s | 2609 ps-top-margin == %s |
2616 ps-bottom-margin == %s | 2610 ps-bottom-margin == %s |
2617 ps-header-offset == %s | 2611 ps-header-offset == %s |
2623 ps-bottom-margin | 2617 ps-bottom-margin |
2624 ps-header-offset | 2618 ps-header-offset |
2625 ps-header-pad | 2619 ps-header-pad |
2626 (+ ps-header-pad | 2620 (+ ps-header-pad |
2627 ps-header-title-line-height | 2621 ps-header-title-line-height |
2628 (* ps-header-line-height (- ps-header-lines 1)) | 2622 (* ps-header-line-height (1- ps-header-lines)) |
2629 ps-header-pad) | 2623 ps-header-pad) |
2630 ps-print-height)))) | 2624 ps-print-height)))) |
2631 | 2625 |
2632 (defun ps-print-preprint (&optional filename) | 2626 (defun ps-print-preprint (&optional filename) |
2633 (if (and filename | 2627 (and filename |
2634 (or (numberp filename) | 2628 (or (numberp filename) |
2635 (listp filename))) | 2629 (listp filename)) |
2636 (let* ((name (concat (buffer-name) ".ps")) | 2630 (let* ((name (concat (buffer-name) ".ps")) |
2637 (prompt (format "Save PostScript to file: (default %s) " | 2631 (prompt (format "Save PostScript to file: (default %s) " name)) |
2638 name)) | 2632 (res (read-file-name prompt default-directory name nil))) |
2639 (res (read-file-name prompt default-directory name nil))) | 2633 (if (file-directory-p res) |
2640 (if (file-directory-p res) | 2634 (expand-file-name name (file-name-as-directory res)) |
2641 (expand-file-name name (file-name-as-directory res)) | 2635 res)))) |
2642 res)))) | |
2643 | 2636 |
2644 ;; The following functions implement a simple list-buffering scheme so | 2637 ;; The following functions implement a simple list-buffering scheme so |
2645 ;; that ps-print doesn't have to repeatedly switch between buffers | 2638 ;; that ps-print doesn't have to repeatedly switch between buffers |
2646 ;; while spooling. The functions ps-output and ps-output-string build | 2639 ;; while spooling. The functions ps-output and ps-output-string build |
2647 ;; up the lists; the function ps-flush-output takes the lists and | 2640 ;; up the lists; the function ps-flush-output takes the lists and |
2649 | 2642 |
2650 (defun ps-output-string-prim (string) | 2643 (defun ps-output-string-prim (string) |
2651 (insert "(") ;insert start-string delimiter | 2644 (insert "(") ;insert start-string delimiter |
2652 (save-excursion ;insert string | 2645 (save-excursion ;insert string |
2653 (insert string)) | 2646 (insert string)) |
2654 | |
2655 ;; Find and quote special characters as necessary for PS | 2647 ;; Find and quote special characters as necessary for PS |
2656 (while (re-search-forward "[()\\]" nil t) | 2648 (while (re-search-forward "[()\\]" nil t) |
2657 (save-excursion | 2649 (save-excursion |
2658 (forward-char -1) | 2650 (forward-char -1) |
2659 (insert "\\"))) | 2651 (insert "\\"))) |
2660 | |
2661 (goto-char (point-max)) | 2652 (goto-char (point-max)) |
2662 (insert ")")) ;insert end-string delimiter | 2653 (insert ")")) ;insert end-string delimiter |
2663 | 2654 |
2664 (defun ps-init-output-queue () | 2655 (defun ps-init-output-queue () |
2665 (setq ps-output-head (list "")) | 2656 (setq ps-output-head '("") |
2666 (setq ps-output-tail ps-output-head)) | 2657 ps-output-tail ps-output-head)) |
2667 | 2658 |
2668 (defun ps-output (&rest args) | 2659 (defun ps-output (&rest args) |
2669 (setcdr ps-output-tail args) | 2660 (setcdr ps-output-tail args) |
2670 (while (cdr ps-output-tail) | 2661 (while (cdr ps-output-tail) |
2671 (setq ps-output-tail (cdr ps-output-tail)))) | 2662 (setq ps-output-tail (cdr ps-output-tail)))) |
2732 (let ((count 1)) | 2723 (let ((count 1)) |
2733 (ps-generate-header-line "/h0" (car contents)) | 2724 (ps-generate-header-line "/h0" (car contents)) |
2734 (while (and (< count ps-header-lines) | 2725 (while (and (< count ps-header-lines) |
2735 (setq contents (cdr contents))) | 2726 (setq contents (cdr contents))) |
2736 (ps-generate-header-line "/h1" (car contents)) | 2727 (ps-generate-header-line "/h1" (car contents)) |
2737 (setq count (+ count 1))) | 2728 (setq count (1+ count))) |
2738 (ps-output "] def\n")))) | 2729 (ps-output "] def\n")))) |
2739 | 2730 |
2740 (defun ps-output-boolean (name bool) | 2731 (defun ps-output-boolean (name bool) |
2741 (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) | 2732 (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) |
2742 | 2733 |
2873 ps-background-text-count 0 | 2864 ps-background-text-count 0 |
2874 ps-background-image-count 0 | 2865 ps-background-image-count 0 |
2875 ps-background-pages nil | 2866 ps-background-pages nil |
2876 ps-background-all-pages nil) | 2867 ps-background-all-pages nil) |
2877 | 2868 |
2878 (ps-output ps-adobe-tag) | 2869 (ps-output ps-adobe-tag |
2879 (ps-output "%%Title: " (buffer-name)) ;Take job name from name of | 2870 "%%Title: " (buffer-name) ; Take job name from name of |
2880 ;first buffer printed | 2871 ; first buffer printed |
2881 (ps-output "\n%%Creator: " (user-full-name)) | 2872 "\n%%Creator: " (user-full-name) |
2882 (ps-output "\n%%CreationDate: " | 2873 "\n%%CreationDate: " |
2883 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) | 2874 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) |
2884 "\n%%Orientation: " | 2875 "\n%%Orientation: " |
2885 (if ps-landscape-mode "Landscape" "Portrait")) | 2876 (if ps-landscape-mode "Landscape" "Portrait") |
2886 (ps-output "\n%% DocumentFonts: Times-Roman Times-Italic " | 2877 "\n%% DocumentFonts: Times-Roman Times-Italic " |
2887 ps-font " " ps-font-bold " " ps-font-italic " " | 2878 ps-font " " ps-font-bold " " ps-font-italic " " |
2888 ps-font-bold-italic " " | 2879 ps-font-bold-italic " " |
2889 ps-header-font " " ps-header-title-font) | 2880 ps-header-font " " ps-header-title-font |
2890 (ps-output "\n%%Pages: (atend)\n") | 2881 "\n%%Pages: (atend)\n" |
2891 (ps-output "%%EndComments\n\n") | 2882 "%%EndComments\n\n") |
2892 | 2883 |
2893 (ps-output-boolean "LandscapeMode" ps-landscape-mode) | 2884 (ps-output-boolean "LandscapeMode" ps-landscape-mode) |
2894 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)) | 2885 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns) |
2895 | 2886 |
2896 (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)) | 2887 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height) |
2897 (ps-output (format "/PrintPageWidth %s def\n" | 2888 (format "/PrintPageWidth %s def\n" |
2898 (- (* (+ ps-print-width ps-inter-column) | 2889 (- (* (+ ps-print-width ps-inter-column) |
2899 ps-number-of-columns) | 2890 ps-number-of-columns) |
2900 ps-inter-column))) | 2891 ps-inter-column)) |
2901 (ps-output (format "/PrintWidth %s def\n" ps-print-width)) | 2892 (format "/PrintWidth %s def\n" ps-print-width) |
2902 (ps-output (format "/PrintHeight %s def\n" ps-print-height)) | 2893 (format "/PrintHeight %s def\n" ps-print-height) |
2903 | 2894 |
2904 (ps-output (format "/LeftMargin %s def\n" ps-left-margin)) | 2895 (format "/LeftMargin %s def\n" ps-left-margin) |
2905 (ps-output (format "/RightMargin %s def\n" ps-right-margin)) ; not used | 2896 (format "/RightMargin %s def\n" ps-right-margin) ; not used |
2906 (ps-output (format "/InterColumn %s def\n" ps-inter-column)) | 2897 (format "/InterColumn %s def\n" ps-inter-column) |
2907 | 2898 |
2908 (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin)) | 2899 (format "/BottomMargin %s def\n" ps-bottom-margin) |
2909 (ps-output (format "/TopMargin %s def\n" ps-top-margin)) ; not used | 2900 (format "/TopMargin %s def\n" ps-top-margin) ; not used |
2910 (ps-output (format "/HeaderOffset %s def\n" ps-header-offset)) | 2901 (format "/HeaderOffset %s def\n" ps-header-offset) |
2911 (ps-output (format "/HeaderPad %s def\n" ps-header-pad)) | 2902 (format "/HeaderPad %s def\n" ps-header-pad)) |
2912 | 2903 |
2913 (ps-output-boolean "PrintHeader" ps-print-header) | 2904 (ps-output-boolean "PrintHeader" ps-print-header) |
2914 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) | 2905 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) |
2915 (ps-output-boolean "ShowNofN" ps-show-n-of-n) | 2906 (ps-output-boolean "ShowNofN" ps-show-n-of-n) |
2916 (ps-output-boolean "Duplex" ps-spool-duplex) | 2907 (ps-output-boolean "Duplex" ps-spool-duplex) |
2920 (round (/ (+ ps-print-height | 2911 (round (/ (+ ps-print-height |
2921 (* ps-line-height 0.45)) | 2912 (* ps-line-height 0.45)) |
2922 ps-line-height)))) | 2913 ps-line-height)))) |
2923 | 2914 |
2924 (ps-output-boolean "Zebra" ps-zebra-stripes) | 2915 (ps-output-boolean "Zebra" ps-zebra-stripes) |
2925 (ps-output (format "/NumberOfZebra %d def\n" ps-zebra-stripe-height)) | |
2926 | |
2927 (ps-output-boolean "PrintLineNumber" ps-line-number) | 2916 (ps-output-boolean "PrintLineNumber" ps-line-number) |
2928 (ps-output (format "/Lines %d def\n" | 2917 (ps-output (format "/NumberOfZebra %d def\n" ps-zebra-stripe-height) |
2918 (format "/Lines %d def\n" | |
2929 (if ps-printing-region | 2919 (if ps-printing-region |
2930 (cdr ps-printing-region) | 2920 (cdr ps-printing-region) |
2931 (ps-count-lines (point-min) (point-max))))) | 2921 (ps-count-lines (point-min) (point-max)))) |
2922 "/PageCount 0 def\n") ; set total page number | |
2923 ; when printing has finished | |
2924 ; (see `ps-generate') | |
2932 | 2925 |
2933 (ps-background-text) | 2926 (ps-background-text) |
2934 (ps-background-image) | 2927 (ps-background-image) |
2935 (setq ps-background-all-pages (nreverse ps-background-all-pages) | 2928 (setq ps-background-all-pages (nreverse ps-background-all-pages) |
2936 ps-background-pages (nreverse ps-background-pages)) | 2929 ps-background-pages (nreverse ps-background-pages)) |
2940 (ps-output "/printGlobalBackground {\n") | 2933 (ps-output "/printGlobalBackground {\n") |
2941 (ps-output-list ps-background-all-pages) | 2934 (ps-output-list ps-background-all-pages) |
2942 (ps-output "} def\n/printLocalBackground {\n} def\n") | 2935 (ps-output "} def\n/printLocalBackground {\n} def\n") |
2943 | 2936 |
2944 ;; Header fonts | 2937 ;; Header fonts |
2945 (ps-output ; /h0 14 /Helvetica-Bold Font | 2938 (ps-output (format "/h0 %s /%s DefFont\n" ; /h0 14 /Helvetica-Bold DefFont |
2946 (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font)) | 2939 ps-header-title-font-size ps-header-title-font) |
2947 (ps-output ; /h1 12 /Helvetica Font | 2940 (format "/h1 %s /%s DefFont\n" ; /h1 12 /Helvetica DefFont |
2948 (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font)) | 2941 ps-header-font-size ps-header-font)) |
2949 | 2942 |
2950 (ps-output ps-print-prologue-2) | 2943 (ps-output ps-print-prologue-2) |
2951 | 2944 |
2952 ;; Text fonts | 2945 ;; Text fonts |
2953 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font)) | 2946 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font) |
2954 (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold)) | 2947 (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold) |
2955 (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic)) | 2948 (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic) |
2956 (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic)) | 2949 (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic)) |
2957 | 2950 |
2958 (ps-output "\nBeginDoc\n\n") | 2951 (ps-output "\nBeginDoc\n\n" |
2959 (ps-output "%%EndPrologue\n")) | 2952 "%%EndPrologue\n")) |
2960 | 2953 |
2961 (defun ps-header-dirpart () | 2954 (defun ps-header-dirpart () |
2962 (let ((fname (buffer-file-name))) | 2955 (let ((fname (buffer-file-name))) |
2963 (if fname | 2956 (if fname |
2964 (if (string-equal (buffer-name) (file-name-nondirectory fname)) | 2957 (if (string-equal (buffer-name) (file-name-nondirectory fname)) |
2981 | 2974 |
2982 (defun ps-begin-job () | 2975 (defun ps-begin-job () |
2983 (setq ps-page-count 0)) | 2976 (setq ps-page-count 0)) |
2984 | 2977 |
2985 (defun ps-end-file () | 2978 (defun ps-end-file () |
2986 (ps-output "\n%%Trailer\n") | 2979 (ps-output "\nEndDoc\n\n%%Trailer\n%%Pages: " |
2987 (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count) | 2980 (format "%d" (1+ (/ (1- ps-page-count) ps-number-of-columns))) |
2988 ps-number-of-columns)))) | 2981 "\n%%EOF\n")) |
2989 (ps-output "\nEndDoc\n\n%%EOF\n")) | |
2990 | 2982 |
2991 | 2983 |
2992 (defun ps-next-page () | 2984 (defun ps-next-page () |
2993 (ps-end-page) | 2985 (ps-end-page) |
2994 (ps-flush-output) | 2986 (ps-flush-output) |
3003 (ps-background page-number) | 2995 (ps-background page-number) |
3004 (and inc-p (incf ps-page-count))) | 2996 (and inc-p (incf ps-page-count))) |
3005 ;; Print when any other page begins. | 2997 ;; Print when any other page begins. |
3006 (ps-output "BeginDSCPage\n"))) | 2998 (ps-output "BeginDSCPage\n"))) |
3007 | 2999 |
3008 (defun ps-begin-page (&optional dummypage) | 3000 (defun ps-begin-page () |
3009 (ps-get-page-dimensions) | 3001 (ps-get-page-dimensions) |
3010 (setq ps-width-remaining ps-print-width) | 3002 (setq ps-width-remaining ps-print-width |
3011 (setq ps-height-remaining ps-print-height) | 3003 ps-height-remaining ps-print-height) |
3012 | 3004 |
3013 (ps-header-page) | 3005 (ps-header-page) |
3014 | 3006 |
3015 (ps-output (format "/LineNumber %d def\n" ps-showline-count) | 3007 (ps-output (format "/LineNumber %d def\n" ps-showline-count) |
3016 (format "/PageNumber %d def\n" (incf ps-page-count))) | 3008 (format "/PageNumber %d def\n" (incf ps-page-count))) |
3017 (ps-output "/PageCount 0 def\n") | |
3018 | 3009 |
3019 (when ps-print-header | 3010 (when ps-print-header |
3020 (ps-generate-header "HeaderLinesLeft" ps-left-header) | 3011 (ps-generate-header "HeaderLinesLeft" ps-left-header) |
3021 (ps-generate-header "HeaderLinesRight" ps-right-header) | 3012 (ps-generate-header "HeaderLinesRight" ps-right-header) |
3022 (ps-output (format "%d SetHeaderLines\n" ps-header-lines))) | 3013 (ps-output (format "%d SetHeaderLines\n" ps-header-lines))) |
3038 | 3029 |
3039 (defun ps-next-line () | 3030 (defun ps-next-line () |
3040 (setq ps-showline-count (1+ ps-showline-count)) | 3031 (setq ps-showline-count (1+ ps-showline-count)) |
3041 (if (< ps-height-remaining ps-line-height) | 3032 (if (< ps-height-remaining ps-line-height) |
3042 (ps-next-page) | 3033 (ps-next-page) |
3043 (setq ps-width-remaining ps-print-width) | 3034 (setq ps-width-remaining ps-print-width |
3044 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) | 3035 ps-height-remaining (- ps-height-remaining ps-line-height)) |
3045 (ps-hard-lf))) | 3036 (ps-output "HL\n"))) |
3046 | 3037 |
3047 (defun ps-continue-line () | 3038 (defun ps-continue-line () |
3048 (if (< ps-height-remaining ps-line-height) | 3039 (if (< ps-height-remaining ps-line-height) |
3049 (ps-next-page) | 3040 (ps-next-page) |
3050 (setq ps-width-remaining ps-print-width) | 3041 (setq ps-width-remaining ps-print-width |
3051 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) | 3042 ps-height-remaining (- ps-height-remaining ps-line-height)) |
3052 (ps-soft-lf))) | 3043 (ps-output "SL\n"))) |
3053 | |
3054 ;; [jack] Why hard and soft ? | |
3055 | |
3056 (defun ps-hard-lf () | |
3057 (ps-output "HL\n")) | |
3058 | |
3059 (defun ps-soft-lf () | |
3060 (ps-output "SL\n")) | |
3061 | 3044 |
3062 (defun ps-find-wrappoint (from to char-width) | 3045 (defun ps-find-wrappoint (from to char-width) |
3063 (let ((avail (truncate (/ ps-width-remaining char-width))) | 3046 (let ((avail (truncate (/ ps-width-remaining char-width))) |
3064 (todo (- to from))) | 3047 (todo (- to from))) |
3065 (if (< todo avail) | 3048 (if (< todo avail) |
3083 (defun ps-plot (plotfunc from to &optional bg-color) | 3066 (defun ps-plot (plotfunc from to &optional bg-color) |
3084 (while (< from to) | 3067 (while (< from to) |
3085 (let* ((wrappoint (funcall plotfunc from to bg-color)) | 3068 (let* ((wrappoint (funcall plotfunc from to bg-color)) |
3086 (plotted-to (car wrappoint)) | 3069 (plotted-to (car wrappoint)) |
3087 (plotted-width (cdr wrappoint))) | 3070 (plotted-width (cdr wrappoint))) |
3088 (setq from plotted-to) | 3071 (setq from plotted-to |
3089 (setq ps-width-remaining (- ps-width-remaining plotted-width)) | 3072 ps-width-remaining (- ps-width-remaining plotted-width)) |
3090 (if (< from to) | 3073 (if (< from to) |
3091 (ps-continue-line)))) | 3074 (ps-continue-line)))) |
3092 (if ps-razzle-dazzle | 3075 (if ps-razzle-dazzle |
3093 (let* ((q-todo (- (point-max) (point-min))) | 3076 (let* ((q-todo (- (point-max) (point-min))) |
3094 (q-done (- (point) (point-min))) | 3077 (q-done (- (point) (point-min))) |
3095 (chunkfrac (/ q-todo 8)) | 3078 (chunkfrac (/ q-todo 8)) |
3096 (chunksize (if (> chunkfrac 1000) 1000 chunkfrac))) | 3079 (chunksize (if (> chunkfrac 1000) 1000 chunkfrac))) |
3097 (if (> (- q-done ps-razchunk) chunksize) | 3080 (if (> (- q-done ps-razchunk) chunksize) |
3098 (let (foo) | 3081 (progn |
3099 (setq ps-razchunk q-done) | 3082 (setq ps-razchunk q-done) |
3100 (setq foo | 3083 (message "Formatting...%3d%%" |
3101 (if (< q-todo 100) | 3084 (if (< q-todo 100) |
3102 (/ (* 100 q-done) q-todo) | 3085 (/ (* 100 q-done) q-todo) |
3103 (/ q-done (/ q-todo 100)))) | 3086 (/ q-done (/ q-todo 100))) |
3104 (message "Formatting...%3d%%" foo)))))) | 3087 )))))) |
3105 | 3088 |
3106 (defun ps-set-font (font) | 3089 (defun ps-set-font (font) |
3107 (setq ps-current-font font) | 3090 (ps-output (format "/f%d F\n" (setq ps-current-font font)))) |
3108 (ps-output (format "/f%d F\n" ps-current-font))) | |
3109 | 3091 |
3110 (defun ps-set-bg (color) | 3092 (defun ps-set-bg (color) |
3111 (if (setq ps-current-bg color) | 3093 (if (setq ps-current-bg color) |
3112 (ps-output (format ps-color-format (nth 0 color) (nth 1 color) | 3094 (ps-output (format ps-color-format |
3113 (nth 2 color)) | 3095 (nth 0 color) (nth 1 color) (nth 2 color)) |
3114 " true BG\n") | 3096 " true BG\n") |
3115 (ps-output "false BG\n"))) | 3097 (ps-output "false BG\n"))) |
3116 | 3098 |
3117 (defun ps-set-color (color) | 3099 (defun ps-set-color (color) |
3118 (setq ps-current-color (or color ps-default-fg)) | 3100 (setq ps-current-color (or color ps-default-fg)) |
3119 (ps-output (format ps-color-format (nth 0 ps-current-color) | 3101 (ps-output (format ps-color-format |
3102 (nth 0 ps-current-color) | |
3120 (nth 1 ps-current-color) (nth 2 ps-current-color)) | 3103 (nth 1 ps-current-color) (nth 2 ps-current-color)) |
3121 " FG\n")) | 3104 " FG\n")) |
3122 | 3105 |
3123 | 3106 |
3124 (defvar ps-current-effect 0) | 3107 (defvar ps-current-effect 0) |
3156 ;; region with some control characters | 3139 ;; region with some control characters |
3157 (let ((match (char-after (match-beginning 0)))) | 3140 (let ((match (char-after (match-beginning 0)))) |
3158 (if (= match ?\t) ; tab | 3141 (if (= match ?\t) ; tab |
3159 (let ((linestart | 3142 (let ((linestart |
3160 (save-excursion (beginning-of-line) (point)))) | 3143 (save-excursion (beginning-of-line) (point)))) |
3161 (ps-plot 'ps-basic-plot-string from (- (point) 1) | 3144 (ps-plot 'ps-basic-plot-string from (1- (point)) |
3162 bg-color) | 3145 bg-color) |
3163 (forward-char -1) | 3146 (forward-char -1) |
3164 (setq from (+ linestart (current-column))) | 3147 (setq from (+ linestart (current-column))) |
3165 (if (re-search-forward "[ \t]+" to t) | 3148 (if (re-search-forward "[ \t]+" to t) |
3166 (ps-plot 'ps-basic-plot-whitespace | 3149 (ps-plot 'ps-basic-plot-whitespace |
3167 from (+ linestart (current-column)) | 3150 from (+ linestart (current-column)) |
3168 bg-color))) | 3151 bg-color))) |
3169 ;; any other control character except tab | 3152 ;; any other control character except tab |
3170 (ps-plot 'ps-basic-plot-string from (- (point) 1) bg-color) | 3153 (ps-plot 'ps-basic-plot-string from (1- (point)) bg-color) |
3171 (cond | 3154 (cond |
3172 ((= match ?\n) ; newline | 3155 ((= match ?\n) ; newline |
3173 (ps-next-line)) | 3156 (ps-next-line)) |
3174 | 3157 |
3175 ((= match ?\f) ; form feed | 3158 ((= match ?\f) ; form feed |
3253 (background (aref face-bit 2)) | 3236 (background (aref face-bit 2)) |
3254 (fg-color (if (and ps-print-color-p foreground) | 3237 (fg-color (if (and ps-print-color-p foreground) |
3255 (mapcar 'ps-color-value | 3238 (mapcar 'ps-color-value |
3256 (ps-color-values foreground)) | 3239 (ps-color-values foreground)) |
3257 ps-default-color)) | 3240 ps-default-color)) |
3258 (bg-color (if (and ps-print-color-p background) | 3241 (bg-color (and ps-print-color-p background |
3259 (mapcar 'ps-color-value | 3242 (mapcar 'ps-color-value |
3260 (ps-color-values background))))) | 3243 (ps-color-values background))))) |
3261 (ps-plot-region from to (logand effect 3) | 3244 (ps-plot-region from to (logand effect 3) |
3262 fg-color bg-color (lsh effect -2))) | 3245 fg-color bg-color (lsh effect -2))) |
3263 (ps-plot-region from to 0)) | 3246 (ps-plot-region from to 0)) |
3264 (goto-char to)) | 3247 (goto-char to)) |
3265 | 3248 |
3267 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) | 3250 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) |
3268 (let* ((frame-font (or (face-font face) (face-font 'default))) | 3251 (let* ((frame-font (or (face-font face) (face-font 'default))) |
3269 (kind-cons (assq kind (x-font-properties frame-font))) | 3252 (kind-cons (assq kind (x-font-properties frame-font))) |
3270 (kind-spec (cdr-safe kind-cons)) | 3253 (kind-spec (cdr-safe kind-cons)) |
3271 (case-fold-search t)) | 3254 (case-fold-search t)) |
3272 | |
3273 (or (and kind-spec (string-match kind-regex kind-spec)) | 3255 (or (and kind-spec (string-match kind-regex kind-spec)) |
3274 ;; Kludge-compatible: | 3256 ;; Kludge-compatible: |
3275 (memq face kind-list)))) | 3257 (memq face kind-list)))) |
3276 | 3258 |
3277 (defun ps-face-bold-p (face) | 3259 (defun ps-face-bold-p (face) |
3278 (if (eq ps-print-emacs-type 'emacs) | 3260 (if (eq ps-print-emacs-type 'emacs) |
3279 (or (face-bold-p face) | 3261 (or (face-bold-p face) |
3280 (memq face ps-bold-faces)) | 3262 (memq face ps-bold-faces)) |
3281 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold" | 3263 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold" ps-bold-faces))) |
3282 ps-bold-faces))) | |
3283 | 3264 |
3284 (defun ps-face-italic-p (face) | 3265 (defun ps-face-italic-p (face) |
3285 (if (eq ps-print-emacs-type 'emacs) | 3266 (if (eq ps-print-emacs-type 'emacs) |
3286 (or (face-italic-p face) | 3267 (or (face-italic-p face) |
3287 (memq face ps-italic-faces)) | 3268 (memq face ps-italic-faces)) |
3288 (or | 3269 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces) |
3289 (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces) | 3270 (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces)))) |
3290 (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces)))) | |
3291 | 3271 |
3292 (defun ps-face-underlined-p (face) | 3272 (defun ps-face-underlined-p (face) |
3293 (or (face-underline-p face) | 3273 (or (face-underline-p face) |
3294 (memq face ps-underlined-faces))) | 3274 (memq face ps-underlined-faces))) |
3295 | 3275 |
3353 | 3333 |
3354 (defun ps-extent-sorter (a b) | 3334 (defun ps-extent-sorter (a b) |
3355 (< (extent-priority a) (extent-priority b))) | 3335 (< (extent-priority a) (extent-priority b))) |
3356 | 3336 |
3357 (defun ps-print-ensure-fontified (start end) | 3337 (defun ps-print-ensure-fontified (start end) |
3358 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode) | 3338 (and (boundp 'lazy-lock-mode) lazy-lock-mode |
3359 (if (fboundp 'lazy-lock-fontify-region) | 3339 (if (fboundp 'lazy-lock-fontify-region) |
3360 (lazy-lock-fontify-region start end) ; the new | 3340 (lazy-lock-fontify-region start end) ; the new |
3361 (lazy-lock-fontify-buffer)))) ; the old | 3341 (lazy-lock-fontify-buffer)))) ; the old |
3362 | 3342 |
3363 (defun ps-generate-postscript-with-faces (from to) | 3343 (defun ps-generate-postscript-with-faces (from to) |
3364 ;; Some initialization... | 3344 ;; Some initialization... |
3365 (setq ps-current-effect 0) | 3345 (setq ps-current-effect 0 |
3346 ps-print-face-alist nil) | |
3366 | 3347 |
3367 ;; Build the reference lists of faces if necessary. | 3348 ;; Build the reference lists of faces if necessary. |
3368 (if (or ps-always-build-face-reference | 3349 (if (or ps-always-build-face-reference |
3369 ps-build-face-reference) | 3350 ps-build-face-reference) |
3370 (progn | 3351 (progn |
3388 (eq ps-print-emacs-type 'xemacs)) | 3369 (eq ps-print-emacs-type 'xemacs)) |
3389 ;; Build the list of extents... | 3370 ;; Build the list of extents... |
3390 (let ((a (cons 'dummy nil)) | 3371 (let ((a (cons 'dummy nil)) |
3391 record type extent extent-list) | 3372 record type extent extent-list) |
3392 (map-extents 'ps-mapper nil from to a) | 3373 (map-extents 'ps-mapper nil from to a) |
3393 (setq a (sort (cdr a) 'car-less-than-car)) | 3374 (setq a (sort (cdr a) 'car-less-than-car) |
3394 | 3375 extent-list nil) |
3395 (setq extent-list nil) | |
3396 | 3376 |
3397 ;; Loop through the extents... | 3377 ;; Loop through the extents... |
3398 (while a | 3378 (while a |
3399 (setq record (car a)) | 3379 (setq record (car a) |
3400 | 3380 |
3401 (setq position (car record)) | 3381 position (car record) |
3402 (setq record (cdr record)) | 3382 record (cdr record) |
3403 | 3383 |
3404 (setq type (car record)) | 3384 type (car record) |
3405 (setq record (cdr record)) | 3385 record (cdr record) |
3406 | 3386 |
3407 (setq extent (car record)) | 3387 extent (car record)) |
3408 | 3388 |
3409 ;; Plot up to this record. | 3389 ;; Plot up to this record. |
3410 ;; XEmacs 19.12: for some reason, we're getting into a | 3390 ;; XEmacs 19.12: for some reason, we're getting into a |
3411 ;; situation in which some of the records have | 3391 ;; situation in which some of the records have |
3412 ;; positions less than 'from'. Since we've narrowed | 3392 ;; positions less than 'from'. Since we've narrowed |
3413 ;; the buffer, this'll generate errors. This is a | 3393 ;; the buffer, this'll generate errors. This is a |
3414 ;; hack, but don't call ps-plot-with-face unless from > | 3394 ;; hack, but don't call ps-plot-with-face unless from > |
3415 ;; point-min. | 3395 ;; point-min. |
3416 (if (and (>= from (point-min)) | 3396 (and (>= from (point-min)) (<= position (point-max)) |
3417 (<= position (point-max))) | 3397 (ps-plot-with-face from position face)) |
3418 (ps-plot-with-face from position face)) | |
3419 | 3398 |
3420 (cond | 3399 (cond |
3421 ((eq type 'push) | 3400 ((eq type 'push) |
3422 (if (extent-face extent) | 3401 (if (extent-face extent) |
3423 (setq extent-list (sort (cons extent extent-list) | 3402 (setq extent-list (sort (cons extent extent-list) |
3428 'ps-extent-sorter)))) | 3407 'ps-extent-sorter)))) |
3429 | 3408 |
3430 (setq face | 3409 (setq face |
3431 (if extent-list | 3410 (if extent-list |
3432 (extent-face (car extent-list)) | 3411 (extent-face (car extent-list)) |
3433 'default)) | 3412 'default) |
3434 | 3413 |
3435 (setq from position) | 3414 from position |
3436 (setq a (cdr a))))) | 3415 a (cdr a))))) |
3437 | 3416 |
3438 ((eq ps-print-emacs-type 'emacs) | 3417 ((eq ps-print-emacs-type 'emacs) |
3439 (let ((property-change from) | 3418 (let ((property-change from) |
3440 (overlay-change from)) | 3419 (overlay-change from)) |
3441 (while (< from to) | 3420 (while (< from to) |
3472 (overlay-face (overlay-get overlay 'face)) | 3451 (overlay-face (overlay-get overlay 'face)) |
3473 (overlay-invisible (overlay-get overlay 'invisible)) | 3452 (overlay-invisible (overlay-get overlay 'invisible)) |
3474 (overlay-priority (or (overlay-get overlay | 3453 (overlay-priority (or (overlay-get overlay |
3475 'priority) | 3454 'priority) |
3476 0))) | 3455 0))) |
3477 (if (and (or overlay-invisible overlay-face) | 3456 (and (or overlay-invisible overlay-face) |
3478 (> overlay-priority face-priority)) | 3457 (> overlay-priority face-priority) |
3479 (setq face (cond ((if (eq buffer-invisibility-spec t) | 3458 (setq face (cond ((if (eq buffer-invisibility-spec t) |
3480 (not (null overlay-invisible)) | 3459 (not (null overlay-invisible)) |
3481 (or (memq overlay-invisible | 3460 (or (memq overlay-invisible |
3482 buffer-invisibility-spec) | 3461 buffer-invisibility-spec) |
3483 (assq overlay-invisible | 3462 (assq overlay-invisible |
3484 buffer-invisibility-spec))) | 3463 buffer-invisibility-spec))) |
3485 nil) | 3464 nil) |
3486 ((and face overlay-face))) | 3465 ((and face overlay-face))) |
3487 face-priority overlay-priority))) | 3466 face-priority overlay-priority))) |
3488 (setq overlays (cdr overlays)))) | 3467 (setq overlays (cdr overlays)))) |
3489 ;; Plot up to this record. | 3468 ;; Plot up to this record. |
3490 (ps-plot-with-face from position face) | 3469 (ps-plot-with-face from position face) |
3491 (setq from position))))) | 3470 (setq from position))))) |
3492 (ps-plot-with-face from to face)))) | 3471 (ps-plot-with-face from to face)))) |
3504 (save-restriction | 3483 (save-restriction |
3505 (narrow-to-region from to) | 3484 (narrow-to-region from to) |
3506 (if ps-razzle-dazzle | 3485 (if ps-razzle-dazzle |
3507 (message "Formatting...%3d%%" (setq ps-razchunk 0))) | 3486 (message "Formatting...%3d%%" (setq ps-razchunk 0))) |
3508 (set-buffer buffer) | 3487 (set-buffer buffer) |
3509 (setq ps-source-buffer buffer) | 3488 (setq ps-source-buffer buffer |
3510 (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) | 3489 ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) |
3511 (ps-init-output-queue) | 3490 (ps-init-output-queue) |
3512 (let (safe-marker completed-safely needs-begin-file) | 3491 (let (safe-marker completed-safely needs-begin-file) |
3513 (unwind-protect | 3492 (unwind-protect |
3514 (progn | 3493 (progn |
3515 (set-buffer ps-spool-buffer) | 3494 (set-buffer ps-spool-buffer) |
3519 ;; the end of this marker onwards. | 3498 ;; the end of this marker onwards. |
3520 (setq safe-marker (make-marker)) | 3499 (setq safe-marker (make-marker)) |
3521 (set-marker safe-marker (point-max)) | 3500 (set-marker safe-marker (point-max)) |
3522 | 3501 |
3523 (goto-char (point-min)) | 3502 (goto-char (point-min)) |
3524 (if (looking-at (regexp-quote ps-adobe-tag)) | 3503 (or (looking-at (regexp-quote ps-adobe-tag)) |
3525 nil | 3504 (setq needs-begin-file t)) |
3526 (setq needs-begin-file t)) | |
3527 (save-excursion | 3505 (save-excursion |
3528 (set-buffer ps-source-buffer) | 3506 (set-buffer ps-source-buffer) |
3529 (if needs-begin-file (ps-begin-file)) | 3507 (if needs-begin-file (ps-begin-file)) |
3530 (ps-begin-job) | 3508 (ps-begin-job) |
3531 (ps-begin-page)) | 3509 (ps-begin-page)) |
3532 (set-buffer ps-source-buffer) | 3510 (set-buffer ps-source-buffer) |
3533 (funcall genfunc from to) | 3511 (funcall genfunc from to) |
3534 (ps-end-page) | 3512 (ps-end-page) |
3535 | 3513 |
3536 (if (and ps-spool-duplex | 3514 (and ps-spool-duplex (= (mod ps-page-count 2) 1) |
3537 (= (mod ps-page-count 2) 1)) | 3515 (ps-dummy-page)) |
3538 (ps-dummy-page)) | |
3539 (ps-flush-output) | 3516 (ps-flush-output) |
3540 | 3517 |
3541 ;; Back to the PS output buffer to set the page count | 3518 ;; Back to the PS output buffer to set the page count |
3542 (set-buffer ps-spool-buffer) | 3519 (set-buffer ps-spool-buffer) |
3543 (goto-char (point-max)) | 3520 (goto-char (point-min)) |
3544 (while (re-search-backward "^/PageCount 0 def$" nil t) | 3521 (and (re-search-forward "^/PageCount 0 def$" nil t) |
3545 (replace-match (format "/PageCount %d def" ps-page-count) t)) | 3522 (replace-match (format "/PageCount %d def" ps-page-count) |
3523 t)) | |
3546 | 3524 |
3547 ;; Setting this variable tells the unwind form that the | 3525 ;; Setting this variable tells the unwind form that the |
3548 ;; the postscript was generated without error. | 3526 ;; the PostScript was generated without error. |
3549 (setq completed-safely t)) | 3527 (setq completed-safely t)) |
3550 | 3528 |
3551 ;; Unwind form: If some bad mojo occurred while generating | 3529 ;; Unwind form: If some bad mojo occurred while generating |
3552 ;; postscript, delete all the postscript that was generated. | 3530 ;; PostScript, delete all the PostScript that was generated. |
3553 ;; This protects the previously spooled files from getting | 3531 ;; This protects the previously spooled files from getting |
3554 ;; corrupted. | 3532 ;; corrupted. |
3555 (if (and (markerp safe-marker) (not completed-safely)) | 3533 (and (markerp safe-marker) (not completed-safely) |
3556 (progn | 3534 (progn |
3557 (set-buffer ps-spool-buffer) | 3535 (set-buffer ps-spool-buffer) |
3558 (delete-region (marker-position safe-marker) (point-max)))))) | 3536 (delete-region (marker-position safe-marker) (point-max)))))) |
3559 | 3537 |
3560 (if ps-razzle-dazzle | 3538 (if ps-razzle-dazzle |
3561 (message "Formatting...done")))))) | 3539 (message "Formatting...done")))))) |
3562 | 3540 |
3563 (defun ps-do-despool (filename) | 3541 (defun ps-do-despool (filename) |
3594 (message "Printing...done"))) | 3572 (message "Printing...done"))) |
3595 (kill-buffer ps-spool-buffer))) | 3573 (kill-buffer ps-spool-buffer))) |
3596 | 3574 |
3597 (defun ps-kill-emacs-check () | 3575 (defun ps-kill-emacs-check () |
3598 (let (ps-buffer) | 3576 (let (ps-buffer) |
3599 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) | 3577 (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) |
3600 (buffer-modified-p ps-buffer)) | 3578 (buffer-modified-p ps-buffer) |
3601 (if (y-or-n-p "Unprinted PostScript waiting; print now? ") | 3579 (y-or-n-p "Unprinted PostScript waiting; print now? ") |
3602 (ps-despool))) | 3580 (ps-despool)) |
3603 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) | 3581 (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) |
3604 (buffer-modified-p ps-buffer)) | 3582 (buffer-modified-p ps-buffer) |
3605 (if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ") | 3583 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")) |
3606 nil | 3584 (error "Unprinted PostScript")))) |
3607 (error "Unprinted PostScript"))))) | |
3608 | 3585 |
3609 (if (fboundp 'add-hook) | 3586 (if (fboundp 'add-hook) |
3610 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check) | 3587 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check) |
3611 (if kill-emacs-hook | 3588 (if kill-emacs-hook |
3612 (message "Won't override existing kill-emacs-hook") | 3589 (message "Won't override existing kill-emacs-hook") |
3694 ;; `gnus-article-mode-hook' is called only once, the first time the *Article* | 3671 ;; `gnus-article-mode-hook' is called only once, the first time the *Article* |
3695 ;; buffer enters that mode, so it would only work for the first time | 3672 ;; buffer enters that mode, so it would only work for the first time |
3696 ;; we ran gnus. The second time, this hook wouldn't get set up. The | 3673 ;; we ran gnus. The second time, this hook wouldn't get set up. The |
3697 ;; only alternative is `gnus-article-prepare-hook'. | 3674 ;; only alternative is `gnus-article-prepare-hook'. |
3698 (defun ps-gnus-article-prepare-hook () | 3675 (defun ps-gnus-article-prepare-hook () |
3699 (setq ps-header-lines 3) | 3676 (setq ps-header-lines 3 |
3700 (setq ps-left-header | 3677 ps-left-header |
3701 ;; The left headers will display the article's subject, its | 3678 ;; The left headers will display the article's subject, its |
3702 ;; author, and the newsgroup it was in. | 3679 ;; author, and the newsgroup it was in. |
3703 (list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name))) | 3680 '(ps-article-subject ps-article-author gnus-newsgroup-name))) |
3704 | 3681 |
3705 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the | 3682 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the |
3706 ;; `ps-left-headers' specially for mail messages. | 3683 ;; `ps-left-headers' specially for mail messages. |
3707 (defun ps-vm-mode-hook () | 3684 (defun ps-vm-mode-hook () |
3708 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary) | 3685 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary) |
3709 (setq ps-header-lines 3) | 3686 (setq ps-header-lines 3 |
3710 (setq ps-left-header | 3687 ps-left-header |
3711 ;; The left headers will display the message's subject, its | 3688 ;; The left headers will display the message's subject, its |
3712 ;; author, and the name of the folder it was in. | 3689 ;; author, and the name of the folder it was in. |
3713 (list 'ps-article-subject 'ps-article-author 'buffer-name))) | 3690 '(ps-article-subject ps-article-author buffer-name))) |
3714 | 3691 |
3715 ;; Every now and then I forget to switch from the *Summary* buffer to | 3692 ;; Every now and then I forget to switch from the *Summary* buffer to |
3716 ;; the *Article* before hitting prsc, and a nicely formatted list of | 3693 ;; the *Article* before hitting prsc, and a nicely formatted list of |
3717 ;; article subjects shows up at the printer. This function, bound to | 3694 ;; article subjects shows up at the printer. This function, bound to |
3718 ;; prsc for the gnus *Summary* buffer means I don't have to switch | 3695 ;; prsc for the gnus *Summary* buffer means I don't have to switch |
3752 "Node ???"))) | 3729 "Node ???"))) |
3753 | 3730 |
3754 (defun ps-info-mode-hook () | 3731 (defun ps-info-mode-hook () |
3755 (setq ps-left-header | 3732 (setq ps-left-header |
3756 ;; The left headers will display the node name and file name. | 3733 ;; The left headers will display the node name and file name. |
3757 (list 'ps-info-node 'ps-info-file))) | 3734 '(ps-info-node ps-info-file))) |
3758 | 3735 |
3759 ;; WARNING! The following function is a *sample* only, and is *not* | 3736 ;; WARNING! The following function is a *sample* only, and is *not* |
3760 ;; meant to be used as a whole unless you understand what the effects | 3737 ;; meant to be used as a whole unless you understand what the effects |
3761 ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- | 3738 ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- |
3762 ;; I'd be very surprised if it was useful to *anybody*, without | 3739 ;; I'd be very surprised if it was useful to *anybody*, without |
3769 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) | 3746 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) |
3770 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) | 3747 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) |
3771 (add-hook 'vm-mode-hook 'ps-vm-mode-hook) | 3748 (add-hook 'vm-mode-hook 'ps-vm-mode-hook) |
3772 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) | 3749 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) |
3773 (add-hook 'Info-mode-hook 'ps-info-mode-hook) | 3750 (add-hook 'Info-mode-hook 'ps-info-mode-hook) |
3774 (setq ps-spool-duplex t) | 3751 (setq ps-spool-duplex t |
3775 (setq ps-print-color-p nil) | 3752 ps-print-color-p nil |
3776 (setq ps-lpr-command "lpr") | 3753 ps-lpr-command "lpr" |
3777 (setq ps-lpr-switches '("-Jjct,duplex_long")) | 3754 ps-lpr-switches '("-Jjct,duplex_long")) |
3778 'ps-jts-ps-setup) | 3755 'ps-jts-ps-setup) |
3779 | 3756 |
3780 ;; WARNING! The following function is a *sample* only, and is *not* | 3757 ;; WARNING! The following function is a *sample* only, and is *not* |
3781 ;; meant to be used as a whole unless it corresponds to your needs. | 3758 ;; meant to be used as a whole unless it corresponds to your needs. |
3782 ;; (In fact, this is a copy of Jack's setup for ps-print -- | 3759 ;; (In fact, this is a copy of Jack's setup for ps-print -- |
3784 ;; without modification.) | 3761 ;; without modification.) |
3785 | 3762 |
3786 (defun ps-jack-setup () | 3763 (defun ps-jack-setup () |
3787 (setq ps-print-color-p nil | 3764 (setq ps-print-color-p nil |
3788 ps-lpr-command "lpr" | 3765 ps-lpr-command "lpr" |
3789 ps-lpr-switches (list) | 3766 ps-lpr-switches nil |
3790 | 3767 |
3791 ps-paper-type 'a4 | 3768 ps-paper-type 'a4 |
3792 ps-landscape-mode t | 3769 ps-landscape-mode t |
3793 ps-number-of-columns 2 | 3770 ps-number-of-columns 2 |
3794 | 3771 |