aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKarl Heuer1997-11-23 02:26:50 +0000
committerKarl Heuer1997-11-23 02:26:50 +0000
commit8bd22fcf0ad2fd22a8a03aca8396cdaeedf3f6d8 (patch)
tree872088a866457e166fc4bca92f5be3f7a28efb5f /lisp
parent527a32d98e078c467a154987e545e78da6a2de4f (diff)
downloademacs-8bd22fcf0ad2fd22a8a03aca8396cdaeedf3f6d8.tar.gz
emacs-8bd22fcf0ad2fd22a8a03aca8396cdaeedf3f6d8.zip
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.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ps-print.el539
1 files changed, 258 insertions, 281 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index f358e69d0d1..91ba0d2099b 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -4,13 +4,13 @@
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
15Vinicius's last change version -- this file may have been edited as part of 15Vinicius's last change version -- this file may have been edited as part of
16Emacs without changes to the version number. When reporting bugs, 16Emacs without changes to the version number. When reporting bugs,
@@ -18,7 +18,7 @@ please also report the version of Emacs, if any, that ps-print was
18distributed with. 18distributed with.
19 19
20Please send all bug fixes and enhancements to 20Please 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.
@@ -391,7 +391,7 @@ Please send all bug fixes and enhancements to
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;;
@@ -753,7 +753,7 @@ Please send all bug fixes and enhancements to
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
@@ -1053,15 +1053,15 @@ customizable by changing variables `ps-left-header' and
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.
1063Note: page numbers are displayed as part of headers, see variable 1063NOTE: 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
@@ -1133,7 +1133,7 @@ reference size, line height, space width, average character width.
1133To get the info for another specific font (say Helvetica), do the following: 1133To 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
@@ -1153,28 +1153,28 @@ You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
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,
1177when generating Postscript." 1177when generating PostScript."
1178 :type 'number 1178 :type 'number
1179 :group 'ps-print-font) 1179 :group 'ps-print-font)
1180 1180
@@ -1212,36 +1212,36 @@ and `ps-underlined-faces'."
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.
1215This applies to generating Postscript." 1215This 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.
1226This applies to generating Postscript." 1227This 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.
1237This applies to generating Postscript." 1237This 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.
1244This applies to generating Postscript. 1244This applies to generating PostScript.
1245 1245
1246The value should be a list of strings and symbols, each representing an 1246The value should be a list of strings and symbols, each representing an
1247entry in the PostScript array HeaderLinesLeft. 1247entry in the PostScript array HeaderLinesLeft.
@@ -1262,7 +1262,7 @@ string delimiters added to it."
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.
1265This applies to generating Postscript. 1265This applies to generating PostScript.
1266 1266
1267See the variable `ps-left-header' for a description of the format of 1267See the variable `ps-left-header' for a description of the format of
1268this variable." 1268this variable."
@@ -1443,13 +1443,13 @@ The table depends on the current ps-print setup."
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
@@ -1522,29 +1522,29 @@ The table depends on the current ps-print setup."
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.
1538This is the value that ps-print uses to determine the length, 1538This is the value that ps-print uses to determine the length,
1539x-dimension, of the text it has printed, and thus affects the point at 1539x-dimension, of the text it has printed, and thus affects the point at
1540which long lines wrap around.") 1540which 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.
1544This value is used in expanding tab characters.") 1544This 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.
1548This is the value that ps-print uses to determine the height, 1548This is the value that ps-print uses to determine the height,
1549y-dimension, of the lines of text it has printed, and thus affects the 1549y-dimension, of the lines of text it has printed, and thus affects the
1550point at which page-breaks are placed. 1550point at which page-breaks are placed.
@@ -2221,8 +2221,8 @@ and the text it contains.")
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
@@ -2423,16 +2423,16 @@ Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
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")
@@ -2466,14 +2466,14 @@ using the current ps-print setup."
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)
@@ -2483,58 +2483,55 @@ using the current ps-print setup."
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 ()
@@ -2545,7 +2542,8 @@ using the current ps-print setup."
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)
@@ -2564,11 +2562,10 @@ using the current ps-print setup."
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:
2574page-width == %s 2571page-width == %s
@@ -2599,17 +2596,14 @@ page-height == bm + print-height + tm
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:
2615ps-top-margin == %s 2609ps-top-margin == %s
@@ -2625,21 +2619,20 @@ page-height == bm + print-height + tm - ho - hh
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
@@ -2651,19 +2644,17 @@ page-height == bm + print-height + tm - ho - hh
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)
@@ -2734,7 +2725,7 @@ page-height == bm + print-height + tm - ho - hh
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)
@@ -2875,40 +2866,40 @@ page-height == bm + print-height + tm - ho - hh
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)
@@ -2922,13 +2913,15 @@ page-height == bm + print-height + tm - ho - hh
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)
@@ -2942,21 +2935,21 @@ page-height == bm + print-height + tm - ho - hh
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)))
@@ -2983,10 +2976,9 @@ page-height == bm + print-height + tm - ho - hh
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 ()
@@ -3005,16 +2997,15 @@ page-height == bm + print-height + tm - ho - hh
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)
@@ -3040,24 +3031,16 @@ EndDSCPage\n"))
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)))
@@ -3085,8 +3068,8 @@ EndDSCPage\n"))
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
@@ -3095,28 +3078,28 @@ EndDSCPage\n"))
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
@@ -3158,7 +3141,7 @@ EndDSCPage\n"))
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)))
@@ -3167,7 +3150,7 @@ EndDSCPage\n"))
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))
@@ -3255,9 +3238,9 @@ If FACE is not a valid face name, it is used default face."
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))
@@ -3269,7 +3252,6 @@ If FACE is not a valid face name, it is used default face."
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))))
@@ -3278,16 +3260,14 @@ If FACE is not a valid face name, it is used default 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)
@@ -3355,14 +3335,15 @@ If FACE is not a valid face name, it is used default face."
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
@@ -3390,21 +3371,20 @@ If FACE is not a valid face name, it is used default face."
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
@@ -3413,9 +3393,8 @@ If FACE is not a valid face name, it is used default face."
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)
@@ -3430,10 +3409,10 @@ If FACE is not a valid face name, it is used default face."
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)
@@ -3474,17 +3453,17 @@ If FACE is not a valid face name, it is used default face."
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)
@@ -3506,8 +3485,8 @@ If FACE is not a valid face name, it is used default face."
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
@@ -3521,9 +3500,8 @@ If FACE is not a valid face name, it is used default face."
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))
@@ -3533,29 +3511,29 @@ If FACE is not a valid face name, it is used default face."
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"))))))
@@ -3596,15 +3574,14 @@ If FACE is not a valid face name, it is used default face."
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)
@@ -3696,21 +3673,21 @@ If FACE is not a valid face name, it is used default face."
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
@@ -3754,7 +3731,7 @@ If FACE is not a valid face name, it is used default face."
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
@@ -3771,10 +3748,10 @@ If FACE is not a valid face name, it is used default face."
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*
@@ -3786,7 +3763,7 @@ If FACE is not a valid face name, it is used default face."
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