Mercurial > emacs
comparison lisp/ps-print.el @ 28426:5236c7327cd6
PostScript programming fix for ghostview, doc fix.
(ps-print-version): New version number (5.1.3).
(ps-begin-file, ps-begin-job, ps-set-color, ps-do-despool, ps-setup)
(ps-insert-file, ps-output-boolean, ps-plot-with-face)
(ps-generate-postscript-with-faces): Code fix.
(ps-color-values): XEmacs compatibility.
(ps-print-background-image, ps-print-background-text, ps-printer-name)
(ps-default-fg, ps-default-bg): Adjust customization.
(ps-zebra-color): Adjust customization, renaming old ps-zebra-gray var.
(ps-color-scale): Renaming old ps-color-value fun.
(ps-print-headers): Replace ps-print-header group to avoid conflict
with ps-print-header variable.
(ps-print-miscellany): New group.
(ps-format-color, ps-rgb-color): New funs.
(ps-default-foreground): New var.
(ps-printer-name-option): New const.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Thu, 30 Mar 2000 13:21:45 +0000 |
parents | 02eba379a4e5 |
children | 1694ed739e69 |
comparison
equal
deleted
inserted
replaced
28425:6cc408ca6aef | 28426:5236c7327cd6 |
---|---|
7 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> | 7 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> |
8 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | 8 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
9 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | 9 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
10 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> | 10 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> |
11 ;; Keywords: wp, print, PostScript | 11 ;; Keywords: wp, print, PostScript |
12 ;; Time-stamp: <2000/03/22 09:12:07 vinicius> | 12 ;; Time-stamp: <2000/03/29 15:45:24 vinicius> |
13 ;; Version: 5.1.2 | 13 ;; Version: 5.1.3 |
14 | 14 |
15 (defconst ps-print-version "5.1.2" | 15 (defconst ps-print-version "5.1.3" |
16 "ps-print.el, v 5.1.2 <2000/03/22 vinicius> | 16 "ps-print.el, v 5.1.3 <2000/03/29 vinicius> |
17 | 17 |
18 Vinicius's last change version -- this file may have been edited as part of | 18 Vinicius's last change version -- this file may have been edited as part of |
19 Emacs without changes to the version number. When reporting bugs, | 19 Emacs without changes to the version number. When reporting bugs, |
20 please also report the version of Emacs, if any, that ps-print was | 20 please also report the version of Emacs, if any, that ps-print was |
21 distributed with. | 21 distributed with. |
434 ;; | 434 ;; |
435 ;; paper catch the error and print on paper the error message. | 435 ;; paper catch the error and print on paper the error message. |
436 ;; This is the default value. | 436 ;; This is the default value. |
437 ;; | 437 ;; |
438 ;; system catch the error and send back the error message to | 438 ;; system catch the error and send back the error message to |
439 ;; printing system. | 439 ;; printing system. This is useful only if printing system |
440 ;; send back an email reporting the error, or if there is | |
441 ;; some other alternative way to report back the error from | |
442 ;; the system to you. | |
440 ;; | 443 ;; |
441 ;; paper-and-system catch the error, print on paper the error message and | 444 ;; paper-and-system catch the error, print on paper the error message and |
442 ;; send back the error message to printing system. | 445 ;; send back the error message to printing system. |
443 ;; | 446 ;; |
444 ;; Any other value is treated as `paper'. | 447 ;; Any other value is treated as `paper'. |
609 ;; The distance between stripes equals the height of a stripe. | 612 ;; The distance between stripes equals the height of a stripe. |
610 ;; | 613 ;; |
611 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes. | 614 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes. |
612 ;; Non-nil means yes, nil means no. The default is nil. | 615 ;; Non-nil means yes, nil means no. The default is nil. |
613 ;; | 616 ;; |
614 ;; The variable `ps-zebra-gray' controls the zebra stripes gray scale. | 617 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB |
615 ;; It should be a float number between 0.0 (black color) and 1.0 (white color). | 618 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white |
616 ;; The default is 0.95. | 619 ;; color), a string which is a color name, or a list of 3 numbers which |
620 ;; corresponds to the Red Green Blue color scale. | |
621 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)). | |
617 ;; | 622 ;; |
618 ;; See also section How Ps-Print Has A Text And/Or Image On Background. | 623 ;; See also section How Ps-Print Has A Text And/Or Image On Background. |
619 ;; | 624 ;; |
620 ;; | 625 ;; |
621 ;; Hooks | 626 ;; Hooks |
814 ;; | 819 ;; |
815 ;; ps-print detects faces with foreground and background colors | 820 ;; ps-print detects faces with foreground and background colors |
816 ;; defined and embeds color information in the PostScript image. | 821 ;; defined and embeds color information in the PostScript image. |
817 ;; The default foreground and background colors are defined by the | 822 ;; The default foreground and background colors are defined by the |
818 ;; variables `ps-default-fg' and `ps-default-bg'. | 823 ;; variables `ps-default-fg' and `ps-default-bg'. |
819 ;; On black-and-white printers, colors are displayed in grayscale. | 824 ;; On black-and-white printers, colors are displayed in gray scale. |
820 ;; To turn off color output, set `ps-print-color-p' to nil. | 825 ;; To turn off color output, set `ps-print-color-p' to nil. |
821 ;; | 826 ;; |
822 ;; | 827 ;; |
823 ;; How Ps-Print Maps Faces | 828 ;; How Ps-Print Maps Faces |
824 ;; ----------------------- | 829 ;; ----------------------- |
887 ;; If it is not possible to read (or does not exist) an image file, that file | 892 ;; If it is not possible to read (or does not exist) an image file, that file |
888 ;; is ignored. | 893 ;; is ignored. |
889 ;; | 894 ;; |
890 ;; The printing order is: | 895 ;; The printing order is: |
891 ;; | 896 ;; |
892 ;; 1. Print zebra stripes | 897 ;; 1. Print background color |
893 ;; 2. Print background texts that it should be on all pages | 898 ;; 2. Print zebra stripes |
894 ;; 3. Print background images that it should be on all pages | 899 ;; 3. Print background texts that it should be on all pages |
895 ;; 4. Print background texts only for current page (if any) | 900 ;; 4. Print background images that it should be on all pages |
896 ;; 5. Print background images only for current page (if any) | 901 ;; 5. Print background texts only for current page (if any) |
897 ;; 6. Print header | 902 ;; 6. Print background images only for current page (if any) |
898 ;; 7. Print buffer text (with faces, if specified) and line number | 903 ;; 7. Print header |
904 ;; 8. Print buffer text (with faces, if specified) and line number | |
899 ;; | 905 ;; |
900 ;; | 906 ;; |
901 ;; Utilities | 907 ;; Utilities |
902 ;; --------- | 908 ;; --------- |
903 ;; | 909 ;; |
949 ;; `ps-print-customize'. | 955 ;; `ps-print-customize'. |
950 ;; | 956 ;; |
951 ;; [vinicius] 990703 Vinicius Jose Latorre <vinicius@cpqd.com.br> | 957 ;; [vinicius] 990703 Vinicius Jose Latorre <vinicius@cpqd.com.br> |
952 ;; | 958 ;; |
953 ;; Better customization. | 959 ;; Better customization. |
954 ;; `ps-banner-page-when-duplexing' and `ps-zebra-gray'. | 960 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'. |
955 ;; | 961 ;; |
956 ;; [vinicius] 990513 Vinicius Jose Latorre <vinicius@cpqd.com.br> | 962 ;; [vinicius] 990513 Vinicius Jose Latorre <vinicius@cpqd.com.br> |
957 ;; | 963 ;; |
958 ;; N-up printing. | 964 ;; N-up printing. |
959 ;; Hook: `ps-print-begin-sheet-hook'. | 965 ;; Hook: `ps-print-begin-sheet-hook'. |
1162 "Vertical page layout" | 1168 "Vertical page layout" |
1163 :prefix "ps-" | 1169 :prefix "ps-" |
1164 :tag "Vertical" | 1170 :tag "Vertical" |
1165 :group 'ps-print) | 1171 :group 'ps-print) |
1166 | 1172 |
1167 (defgroup ps-print-header nil | 1173 (defgroup ps-print-headers nil |
1168 "Headers layout" | 1174 "Headers layout" |
1169 :prefix "ps-" | 1175 :prefix "ps-" |
1170 :tag "Header" | 1176 :tag "Header" |
1171 :group 'ps-print) | 1177 :group 'ps-print) |
1172 | 1178 |
1217 "Page customization" | 1223 "Page customization" |
1218 :prefix "ps-" | 1224 :prefix "ps-" |
1219 :tag "Page" | 1225 :tag "Page" |
1220 :group 'ps-print) | 1226 :group 'ps-print) |
1221 | 1227 |
1228 (defgroup ps-print-miscellany nil | |
1229 "Miscellany customization" | |
1230 :prefix "ps-" | |
1231 :tag "Miscellany" | |
1232 :group 'ps-print) | |
1233 | |
1222 | 1234 |
1223 (defcustom ps-error-handler-message 'paper | 1235 (defcustom ps-error-handler-message 'paper |
1224 "*Specify where the error handler message should be sent. | 1236 "*Specify where the error handler message should be sent. |
1225 | 1237 |
1226 Valid values are: | 1238 Valid values are: |
1228 `none' catch the error and *DON'T* send any message. | 1240 `none' catch the error and *DON'T* send any message. |
1229 | 1241 |
1230 `paper' catch the error and print on paper the error message. | 1242 `paper' catch the error and print on paper the error message. |
1231 | 1243 |
1232 `system' catch the error and send back the error message to | 1244 `system' catch the error and send back the error message to |
1233 printing system. | 1245 printing system. This is useful only if printing system |
1246 send back an email reporting the error, or if there is | |
1247 some other alternative way to report back the error from | |
1248 the system to you. | |
1234 | 1249 |
1235 `paper-and-system' catch the error, print on paper the error message and | 1250 `paper-and-system' catch the error, print on paper the error message and |
1236 send back the error message to printing system. | 1251 send back the error message to printing system. |
1237 | 1252 |
1238 Any other value is treated as `paper'." | 1253 Any other value is treated as `paper'." |
1239 :type '(choice :tag "Error Handler Message" | 1254 :type '(choice :tag "Error Handler Message" |
1240 (const none) (const paper) | 1255 (const none) (const paper) |
1241 (const system) (const paper-and-system)) | 1256 (const system) (const paper-and-system)) |
1242 :group 'ps-print) | 1257 :group 'ps-print-miscellany) |
1243 | 1258 |
1244 (defcustom ps-user-defined-prologue nil | 1259 (defcustom ps-user-defined-prologue nil |
1245 "*User defined PostScript prologue code inserted before all prologue code. | 1260 "*User defined PostScript prologue code inserted before all prologue code. |
1246 | 1261 |
1247 `ps-user-defined-prologue' may be a string or a symbol function which returns a | 1262 `ps-user-defined-prologue' may be a string or a symbol function which returns a |
1262 For more information about PostScript, see: | 1277 For more information about PostScript, see: |
1263 PostScript Language Reference Manual (2nd edition) | 1278 PostScript Language Reference Manual (2nd edition) |
1264 Adobe Systems Incorporated" | 1279 Adobe Systems Incorporated" |
1265 :type '(choice :tag "User Defined Prologue" | 1280 :type '(choice :tag "User Defined Prologue" |
1266 string symbol (other :tag "nil" nil)) | 1281 string symbol (other :tag "nil" nil)) |
1267 :group 'ps-print) | 1282 :group 'ps-print-miscellany) |
1268 | 1283 |
1269 (defcustom ps-print-prologue-header nil | 1284 (defcustom ps-print-prologue-header nil |
1270 "*PostScript prologue header comments besides that ps-print generates. | 1285 "*PostScript prologue header comments besides that ps-print generates. |
1271 | 1286 |
1272 `ps-print-prologue-header' may be a string or a symbol function which | 1287 `ps-print-prologue-header' may be a string or a symbol function which |
1290 PostScript Language Reference Manual (2nd edition) | 1305 PostScript Language Reference Manual (2nd edition) |
1291 Adobe Systems Incorporated | 1306 Adobe Systems Incorporated |
1292 Appendix G: Document Structuring Conventions -- Version 3.0" | 1307 Appendix G: Document Structuring Conventions -- Version 3.0" |
1293 :type '(choice :tag "Prologue Header" | 1308 :type '(choice :tag "Prologue Header" |
1294 string symbol (other :tag "nil" nil)) | 1309 string symbol (other :tag "nil" nil)) |
1295 :group 'ps-print) | 1310 :group 'ps-print-miscellany) |
1296 | 1311 |
1297 (defcustom ps-printer-name (and (boundp 'printer-name) | 1312 (defcustom ps-printer-name (and (boundp 'printer-name) |
1298 printer-name) | 1313 printer-name) |
1299 "*The name of a local printer for printing PostScript files. | 1314 "*The name of a local printer for printing PostScript files. |
1300 | 1315 |
1312 appended to that file. \(Note that `ps-print' package already has | 1327 appended to that file. \(Note that `ps-print' package already has |
1313 facilities for printing to a file, so you might as well use them instead | 1328 facilities for printing to a file, so you might as well use them instead |
1314 of changing the setting of this variable.\) If you want to silently | 1329 of changing the setting of this variable.\) If you want to silently |
1315 discard the printed output, set this to \"NUL\"." | 1330 discard the printed output, set this to \"NUL\"." |
1316 :type '(choice :tag "Printer Name" | 1331 :type '(choice :tag "Printer Name" |
1317 file (other :tag "Pipe to ps-lpr-command" pipe)) | 1332 (file :tag "Print to file") |
1333 (string :tag "Pipe to ps-lpr-command") | |
1334 (other :tag "Same as printer-name" nil)) | |
1318 :group 'ps-print-printer) | 1335 :group 'ps-print-printer) |
1319 | 1336 |
1320 (defcustom ps-lpr-command lpr-command | 1337 (defcustom ps-lpr-command lpr-command |
1321 "*Name of program for printing a PostScript file. | 1338 "*Name of program for printing a PostScript file. |
1322 | 1339 |
1428 | 1445 |
1429 Any other value is treated as nil." | 1446 Any other value is treated as nil." |
1430 :type '(choice :tag "Control Char" | 1447 :type '(choice :tag "Control Char" |
1431 (const 8-bit) (const control-8-bit) | 1448 (const 8-bit) (const control-8-bit) |
1432 (const control) (other :tag "nil" nil)) | 1449 (const control) (other :tag "nil" nil)) |
1433 :group 'ps-print) | 1450 :group 'ps-print-miscellany) |
1434 | 1451 |
1435 (defcustom ps-n-up-printing 1 | 1452 (defcustom ps-n-up-printing 1 |
1436 "*Specify the number of pages per sheet paper." | 1453 "*Specify the number of pages per sheet paper." |
1437 :type '(integer | 1454 :type '(integer |
1438 :tag "N Up Printing" | 1455 :tag "N Up Printing" |
1488 :group 'ps-print-n-up) | 1505 :group 'ps-print-n-up) |
1489 | 1506 |
1490 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1) | 1507 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1) |
1491 "*Specify the number of columns" | 1508 "*Specify the number of columns" |
1492 :type 'number | 1509 :type 'number |
1493 :group 'ps-print) | 1510 :group 'ps-print-miscellany) |
1494 | 1511 |
1495 (defcustom ps-zebra-stripes nil | 1512 (defcustom ps-zebra-stripes nil |
1496 "*Non-nil means print zebra stripes. | 1513 "*Non-nil means print zebra stripes. |
1497 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-gray'." | 1514 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'." |
1498 :type 'boolean | 1515 :type 'boolean |
1499 :group 'ps-print-zebra) | 1516 :group 'ps-print-zebra) |
1500 | 1517 |
1501 (defcustom ps-zebra-stripe-height 3 | 1518 (defcustom ps-zebra-stripe-height 3 |
1502 "*Number of zebra stripe lines. | 1519 "*Number of zebra stripe lines. |
1503 See also documentation for `ps-zebra-stripes' and `ps-zebra-gray'." | 1520 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'." |
1504 :type 'number | 1521 :type 'number |
1505 :group 'ps-print-zebra) | 1522 :group 'ps-print-zebra) |
1506 | 1523 |
1507 (defcustom ps-zebra-gray 0.95 | 1524 (defcustom ps-zebra-color 0.95 |
1508 "*Zebra stripe gray scale. | 1525 "*Zebra stripe gray scale or RGB color. |
1509 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'." | 1526 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'." |
1510 :type 'number | 1527 :type '(choice :tag "Zebra Gray/Color" |
1528 (number :tag "Gray Scale" :value 0.95) | |
1529 (string :tag "Color Name" :value "gray95") | |
1530 (list :tag "RGB Color" :value (0.95 0.95 0.95) | |
1531 (number :tag "Red") | |
1532 (number :tag "Green") | |
1533 (number :tag "Blue"))) | |
1511 :group 'ps-print-zebra) | 1534 :group 'ps-print-zebra) |
1512 | 1535 |
1513 (defcustom ps-line-number nil | 1536 (defcustom ps-line-number nil |
1514 "*Non-nil means print line number." | 1537 "*Non-nil means print line number." |
1515 :type 'boolean | 1538 :type 'boolean |
1516 :group 'ps-print) | 1539 :group 'ps-print-miscellany) |
1517 | 1540 |
1518 (defcustom ps-print-background-image nil | 1541 (defcustom ps-print-background-image nil |
1519 "*EPS image list to be printed on background. | 1542 "*EPS image list to be printed on background. |
1520 | 1543 |
1521 The elements are: | 1544 The elements are: |
1545 | 1568 |
1546 For example, if you wish to print an EPS image on all pages do: | 1569 For example, if you wish to print an EPS image on all pages do: |
1547 | 1570 |
1548 '((\"~/images/EPS-image.ps\"))" | 1571 '((\"~/images/EPS-image.ps\"))" |
1549 :type '(repeat (list (file :tag "EPS File") | 1572 :type '(repeat (list (file :tag "EPS File") |
1550 (choice :tag "X" number string (const nil)) | 1573 (choice :tag "X" (const :tag "default" nil) number string) |
1551 (choice :tag "Y" number string (const nil)) | 1574 (choice :tag "Y" (const :tag "default" nil) number string) |
1552 (choice :tag "X Scale" number string (const nil)) | 1575 (choice :tag "X Scale" (const :tag "default" nil) number string) |
1553 (choice :tag "Y Scale" number string (const nil)) | 1576 (choice :tag "Y Scale" (const :tag "default" nil) number string) |
1554 (choice :tag "Rotation" number string (const nil)) | 1577 (choice :tag "Rotation" (const :tag "default" nil) number string) |
1555 (repeat :tag "Pages" :inline t | 1578 (repeat :tag "Pages" :inline t |
1556 (radio (integer :tag "Page") | 1579 (radio (integer :tag "Page") |
1557 (cons :tag "Range" | 1580 (cons :tag "Range" |
1558 (integer :tag "From") | 1581 (integer :tag "From") |
1559 (integer :tag "To")))))) | 1582 (integer :tag "To")))))) |
1593 | 1616 |
1594 For example, if you wish to print text \"Preliminary\" on all pages do: | 1617 For example, if you wish to print text \"Preliminary\" on all pages do: |
1595 | 1618 |
1596 '((\"Preliminary\"))" | 1619 '((\"Preliminary\"))" |
1597 :type '(repeat (list (string :tag "Text") | 1620 :type '(repeat (list (string :tag "Text") |
1598 (choice :tag "X" number string (const nil)) | 1621 (choice :tag "X" (const :tag "default" nil) number string) |
1599 (choice :tag "Y" number string (const nil)) | 1622 (choice :tag "Y" (const :tag "default" nil) number string) |
1600 (choice :tag "Font" string (const nil)) | 1623 (choice :tag "Font" (const :tag "default" nil) string) |
1601 (choice :tag "Fontsize" number string (const nil)) | 1624 (choice :tag "Fontsize" (const :tag "default" nil) number string) |
1602 (choice :tag "Gray" number string (const nil)) | 1625 (choice :tag "Gray" (const :tag "default" nil) number string) |
1603 (choice :tag "Rotation" number string (const nil)) | 1626 (choice :tag "Rotation" (const :tag "default" nil) number string) |
1604 (repeat :tag "Pages" :inline t | 1627 (repeat :tag "Pages" :inline t |
1605 (radio (integer :tag "Page") | 1628 (radio (integer :tag "Page") |
1606 (cons :tag "Range" | 1629 (cons :tag "Range" |
1607 (integer :tag "From") | 1630 (integer :tag "From") |
1608 (integer :tag "To")))))) | 1631 (integer :tag "To")))))) |
1673 By default, the header displays the buffer name, page number, and, if | 1696 By default, the header displays the buffer name, page number, and, if |
1674 the buffer is visiting a file, the file's directory. Headers are | 1697 the buffer is visiting a file, the file's directory. Headers are |
1675 customizable by changing variables `ps-left-header' and | 1698 customizable by changing variables `ps-left-header' and |
1676 `ps-right-header'." | 1699 `ps-right-header'." |
1677 :type 'boolean | 1700 :type 'boolean |
1678 :group 'ps-print-header) | 1701 :group 'ps-print-headers) |
1679 | 1702 |
1680 (defcustom ps-print-only-one-header nil | 1703 (defcustom ps-print-only-one-header nil |
1681 "*Non-nil means print only one header at the top of each page. | 1704 "*Non-nil means print only one header at the top of each page. |
1682 This is useful when printing more than one column, so it is possible | 1705 This is useful when printing more than one column, so it is possible |
1683 to have only one header over all columns or one header per column. | 1706 to have only one header over all columns or one header per column. |
1684 See also `ps-print-header'." | 1707 See also `ps-print-header'." |
1685 :type 'boolean | 1708 :type 'boolean |
1686 :group 'ps-print-header) | 1709 :group 'ps-print-headers) |
1687 | 1710 |
1688 (defcustom ps-print-header-frame t | 1711 (defcustom ps-print-header-frame t |
1689 "*Non-nil means draw a gaudy frame around the header." | 1712 "*Non-nil means draw a gaudy frame around the header." |
1690 :type 'boolean | 1713 :type 'boolean |
1691 :group 'ps-print-header) | 1714 :group 'ps-print-headers) |
1692 | 1715 |
1693 (defcustom ps-header-lines 2 | 1716 (defcustom ps-header-lines 2 |
1694 "*Number of lines to display in page header, when generating PostScript." | 1717 "*Number of lines to display in page header, when generating PostScript." |
1695 :type 'integer | 1718 :type 'integer |
1696 :group 'ps-print-header) | 1719 :group 'ps-print-headers) |
1697 | 1720 |
1698 (defcustom ps-show-n-of-n t | 1721 (defcustom ps-show-n-of-n t |
1699 "*Non-nil means show page numbers as N/M, meaning page N of M. | 1722 "*Non-nil means show page numbers as N/M, meaning page N of M. |
1700 NOTE: page numbers are displayed as part of headers, | 1723 NOTE: page numbers are displayed as part of headers, |
1701 see variable `ps-print-headers'." | 1724 see variable `ps-print-header'." |
1702 :type 'boolean | 1725 :type 'boolean |
1703 :group 'ps-print-header) | 1726 :group 'ps-print-headers) |
1704 | 1727 |
1705 (defcustom ps-spool-config (if (memq system-type | 1728 (defcustom ps-spool-config (if (memq system-type |
1706 '(win32 w32 mswindows ms-dos windows-nt)) | 1729 '(win32 w32 mswindows ms-dos windows-nt)) |
1707 nil | 1730 nil |
1708 'lpr-switches) | 1731 'lpr-switches) |
1732 `setpagedevice', generate a test file and send it to your printer; if | 1755 `setpagedevice', generate a test file and send it to your printer; if |
1733 the printed file isn't ok, set `ps-spool-config' to nil." | 1756 the printed file isn't ok, set `ps-spool-config' to nil." |
1734 :type '(choice :tag "Spool Config" | 1757 :type '(choice :tag "Spool Config" |
1735 (const lpr-switches) (const setpagedevice) | 1758 (const lpr-switches) (const setpagedevice) |
1736 (other :tag "nil" nil)) | 1759 (other :tag "nil" nil)) |
1737 :group 'ps-print-header) | 1760 :group 'ps-print-headers) |
1738 | 1761 |
1739 (defcustom ps-spool-duplex nil ; Not many people have duplex printers, | 1762 (defcustom ps-spool-duplex nil ; Not many people have duplex printers, |
1740 ; so default to nil. | 1763 ; so default to nil. |
1741 "*Non-nil generates PostScript for a two-sided printer. | 1764 "*Non-nil generates PostScript for a two-sided printer. |
1742 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert | 1765 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert |
1745 reversed on duplex printers so that the page numbers fall to the left on | 1768 reversed on duplex printers so that the page numbers fall to the left on |
1746 even-numbered pages. | 1769 even-numbered pages. |
1747 | 1770 |
1748 See also `ps-spool-tumble'." | 1771 See also `ps-spool-tumble'." |
1749 :type 'boolean | 1772 :type 'boolean |
1750 :group 'ps-print-header) | 1773 :group 'ps-print-headers) |
1751 | 1774 |
1752 (defcustom ps-spool-tumble nil | 1775 (defcustom ps-spool-tumble nil |
1753 "*Specify how the page images on opposite sides of a sheet are oriented. | 1776 "*Specify how the page images on opposite sides of a sheet are oriented. |
1754 If `ps-spool-tumble' is nil, produces output suitable for binding on the left or | 1777 If `ps-spool-tumble' is nil, produces output suitable for binding on the left or |
1755 right. If `ps-spool-tumble' is non-nil, produces output suitable for binding at | 1778 right. If `ps-spool-tumble' is non-nil, produces output suitable for binding at |
1756 the top or bottom. | 1779 the top or bottom. |
1757 | 1780 |
1758 It has effect only when `ps-spool-duplex' is non-nil." | 1781 It has effect only when `ps-spool-duplex' is non-nil." |
1759 :type 'boolean | 1782 :type 'boolean |
1760 :group 'ps-print-header) | 1783 :group 'ps-print-headers) |
1761 | 1784 |
1762 ;;; Fonts | 1785 ;;; Fonts |
1763 | 1786 |
1764 (defcustom ps-font-info-database | 1787 (defcustom ps-font-info-database |
1765 '((Courier ; the family key | 1788 '((Courier ; the family key |
1946 :type 'boolean | 1969 :type 'boolean |
1947 :group 'ps-print-color) | 1970 :group 'ps-print-color) |
1948 | 1971 |
1949 (defcustom ps-default-fg '(0.0 0.0 0.0) | 1972 (defcustom ps-default-fg '(0.0 0.0 0.0) |
1950 "*RGB values of the default foreground color. Defaults to black." | 1973 "*RGB values of the default foreground color. Defaults to black." |
1951 :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue")) | 1974 :type '(choice :tag "Default Foreground Gray/Color" |
1975 (number :tag "Gray Scale" :value 0.0) | |
1976 (string :tag "Color Name" :value "black") | |
1977 (list :tag "RGB Color" :value (0.0 0.0 0.0) | |
1978 (number :tag "Red") | |
1979 (number :tag "Green") | |
1980 (number :tag "Blue"))) | |
1952 :group 'ps-print-color) | 1981 :group 'ps-print-color) |
1953 | 1982 |
1954 (defcustom ps-default-bg '(1.0 1.0 1.0) | 1983 (defcustom ps-default-bg '(1.0 1.0 1.0) |
1955 "*RGB values of the default background color. Defaults to white." | 1984 "*RGB values of the default background color. Defaults to white." |
1956 :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue")) | 1985 :type '(choice :tag "Default Background Gray/Color" |
1986 (number :tag "Gray Scale" :value 1.0) | |
1987 (string :tag "Color Name" :value "white") | |
1988 (list :tag "RGB Color" :value (1.0 1.0 1.0) | |
1989 (number :tag "Red") | |
1990 (number :tag "Green") | |
1991 (number :tag "Blue"))) | |
1957 :group 'ps-print-color) | 1992 :group 'ps-print-color) |
1958 | 1993 |
1959 (defcustom ps-auto-font-detect t | 1994 (defcustom ps-auto-font-detect t |
1960 "*Non-nil means automatically detect bold/italic face attributes. | 1995 "*Non-nil means automatically detect bold/italic face attributes. |
1961 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', | 1996 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', |
2013 return a string to be inserted into the array. For symbols with bound | 2048 return a string to be inserted into the array. For symbols with bound |
2014 values, the value should be a string to be inserted into the array. | 2049 values, the value should be a string to be inserted into the array. |
2015 In either case, function or variable, the string value has PostScript | 2050 In either case, function or variable, the string value has PostScript |
2016 string delimiters added to it." | 2051 string delimiters added to it." |
2017 :type '(repeat (choice string symbol)) | 2052 :type '(repeat (choice string symbol)) |
2018 :group 'ps-print-header) | 2053 :group 'ps-print-headers) |
2019 | 2054 |
2020 (defcustom ps-right-header | 2055 (defcustom ps-right-header |
2021 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss) | 2056 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss) |
2022 "*The items to display (each on a line) on the right part of the page header. | 2057 "*The items to display (each on a line) on the right part of the page header. |
2023 This applies to generating PostScript. | 2058 This applies to generating PostScript. |
2024 | 2059 |
2025 See the variable `ps-left-header' for a description of the format of | 2060 See the variable `ps-left-header' for a description of the format of |
2026 this variable." | 2061 this variable." |
2027 :type '(repeat (choice string symbol)) | 2062 :type '(repeat (choice string symbol)) |
2028 :group 'ps-print-header) | 2063 :group 'ps-print-headers) |
2029 | 2064 |
2030 (defcustom ps-razzle-dazzle t | 2065 (defcustom ps-razzle-dazzle t |
2031 "*Non-nil means report progress while formatting buffer." | 2066 "*Non-nil means report progress while formatting buffer." |
2032 :type 'boolean | 2067 :type 'boolean |
2033 :group 'ps-print) | 2068 :group 'ps-print-miscellany) |
2034 | 2069 |
2035 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n" | 2070 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n" |
2036 "*Contains the header line identifying the output as PostScript. | 2071 "*Contains the header line identifying the output as PostScript. |
2037 By default, `ps-adobe-tag' contains the standard identifier. Some | 2072 By default, `ps-adobe-tag' contains the standard identifier. Some |
2038 printers require slightly different versions of this line." | 2073 printers require slightly different versions of this line." |
2039 :type 'string | 2074 :type 'string |
2040 :group 'ps-print) | 2075 :group 'ps-print-miscellany) |
2041 | 2076 |
2042 (defcustom ps-build-face-reference t | 2077 (defcustom ps-build-face-reference t |
2043 "*Non-nil means build the reference face lists. | 2078 "*Non-nil means build the reference face lists. |
2044 | 2079 |
2045 ps-print sets this value to nil after it builds its internal reference | 2080 ps-print sets this value to nil after it builds its internal reference |
2065 | 2100 |
2066 (defcustom ps-banner-page-when-duplexing nil | 2101 (defcustom ps-banner-page-when-duplexing nil |
2067 "*Non-nil means the very first page is skipped. | 2102 "*Non-nil means the very first page is skipped. |
2068 It's like the very first character of buffer (or region) is ^L (\\014)." | 2103 It's like the very first character of buffer (or region) is ^L (\\014)." |
2069 :type 'boolean | 2104 :type 'boolean |
2070 :group 'ps-print-header) | 2105 :group 'ps-print-headers) |
2071 | 2106 |
2072 (defcustom ps-postscript-code-directory data-directory | 2107 (defcustom ps-postscript-code-directory data-directory |
2073 "*Directory where it's located the PostScript prologue file used by ps-print. | 2108 "*Directory where it's located the PostScript prologue file used by ps-print. |
2074 By default, this directory is the same as in the variable `data-directory'." | 2109 By default, this directory is the same as in the variable `data-directory'." |
2075 :type 'directory | 2110 :type 'directory |
2076 :group 'ps-print) | 2111 :group 'ps-print-miscellany) |
2077 | 2112 |
2078 | 2113 |
2079 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 2114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2080 ;; Customization | 2115 ;; Customization |
2081 | 2116 |
2229 ps-landscape-mode %s | 2264 ps-landscape-mode %s |
2230 ps-number-of-columns %s | 2265 ps-number-of-columns %s |
2231 | 2266 |
2232 ps-zebra-stripes %s | 2267 ps-zebra-stripes %s |
2233 ps-zebra-stripe-height %s | 2268 ps-zebra-stripe-height %s |
2234 ps-zebra-gray %s | 2269 ps-zebra-color %s |
2235 ps-line-number %s | 2270 ps-line-number %s |
2271 | |
2272 ps-default-fg %s | |
2273 ps-default-bg %s | |
2236 | 2274 |
2237 ps-print-control-characters %s | 2275 ps-print-control-characters %s |
2238 | 2276 |
2239 ps-print-background-image %s | 2277 ps-print-background-image %s |
2240 | 2278 |
2281 (ps-print-quote ps-paper-type) | 2319 (ps-print-quote ps-paper-type) |
2282 ps-landscape-mode | 2320 ps-landscape-mode |
2283 ps-number-of-columns | 2321 ps-number-of-columns |
2284 ps-zebra-stripes | 2322 ps-zebra-stripes |
2285 ps-zebra-stripe-height | 2323 ps-zebra-stripe-height |
2286 ps-zebra-gray | 2324 (ps-print-quote ps-zebra-color) |
2287 ps-line-number | 2325 ps-line-number |
2326 (ps-print-quote ps-default-fg) | |
2327 (ps-print-quote ps-default-bg) | |
2288 (ps-print-quote ps-print-control-characters) | 2328 (ps-print-quote ps-print-control-characters) |
2289 (ps-print-quote ps-print-background-image) | 2329 (ps-print-quote ps-print-background-image) |
2290 (ps-print-quote ps-print-background-text) | 2330 (ps-print-quote ps-print-background-text) |
2291 (ps-print-quote ps-error-handler-message) | 2331 (ps-print-quote ps-error-handler-message) |
2292 (ps-print-quote ps-user-defined-prologue) | 2332 (ps-print-quote ps-user-defined-prologue) |
2413 (defvar ps-background-all-pages nil) | 2453 (defvar ps-background-all-pages nil) |
2414 (defvar ps-background-text-count 0) | 2454 (defvar ps-background-text-count 0) |
2415 (defvar ps-background-image-count 0) | 2455 (defvar ps-background-image-count 0) |
2416 | 2456 |
2417 (defvar ps-current-font 0) | 2457 (defvar ps-current-font 0) |
2418 (defvar ps-default-color (and ps-print-color-p ps-default-fg)) ; black | 2458 (defvar ps-default-foreground nil) |
2419 (defvar ps-current-color ps-default-color) | 2459 (defvar ps-default-color nil) |
2460 (defvar ps-current-color nil) | |
2420 (defvar ps-current-bg nil) | 2461 (defvar ps-current-bg nil) |
2421 | 2462 |
2422 (defvar ps-razchunk 0) | 2463 (defvar ps-razchunk 0) |
2423 | 2464 |
2424 (defvar ps-color-p nil) | 2465 (defvar ps-color-p nil) |
3045 (setq ps-output-head (cdr ps-output-head)))) | 3086 (setq ps-output-head (cdr ps-output-head)))) |
3046 (ps-init-output-queue)) | 3087 (ps-init-output-queue)) |
3047 | 3088 |
3048 (defun ps-insert-file (fname) | 3089 (defun ps-insert-file (fname) |
3049 (ps-flush-output) | 3090 (ps-flush-output) |
3050 ;; Check to see that the file exists and is readable; if not, throw | |
3051 ;; an error. | |
3052 (or (file-readable-p fname) | |
3053 (error "Could not read file `%s'" fname)) | |
3054 (save-excursion | 3091 (save-excursion |
3055 (set-buffer ps-spool-buffer) | 3092 (set-buffer ps-spool-buffer) |
3056 (goto-char (point-max)) | 3093 (goto-char (point-max)) |
3057 (insert-file fname))) | 3094 (insert-file fname))) |
3058 | 3095 |
3092 (ps-generate-header-line "/h1" (car contents)) | 3129 (ps-generate-header-line "/h1" (car contents)) |
3093 (setq count (1+ count))) | 3130 (setq count (1+ count))) |
3094 (ps-output "] def\n")))) | 3131 (ps-output "] def\n")))) |
3095 | 3132 |
3096 | 3133 |
3097 (defun ps-output-boolean (name bool &optional no-def) | 3134 (defun ps-output-boolean (name bool) |
3098 (ps-output (format "/%s %s%s" | 3135 (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) |
3099 name (if bool "true" "false") (if no-def "\n" " def\n")))) | |
3100 | 3136 |
3101 | 3137 |
3102 (defun ps-background-pages (page-list func) | 3138 (defun ps-background-pages (page-list func) |
3103 (if page-list | 3139 (if page-list |
3104 (mapcar | 3140 (mapcar |
3725 "\n")) | 3761 "\n")) |
3726 | 3762 |
3727 (ps-insert-string ps-print-prologue-header) | 3763 (ps-insert-string ps-print-prologue-header) |
3728 | 3764 |
3729 (ps-output "%%EndComments\n\n%%BeginPrologue\n\n" | 3765 (ps-output "%%EndComments\n\n%%BeginPrologue\n\n" |
3730 "/gs_languagelevel /languagelevel where" | 3766 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n" |
3731 "{pop languagelevel}{1}ifelse def\n" | 3767 (format "/ErrorMessage %s def\n\n" |
3732 (format "/ErrorMessage %s def\n\n" | |
3733 (or (cdr (assoc ps-error-handler-message | 3768 (or (cdr (assoc ps-error-handler-message |
3734 ps-error-handler-alist)) | 3769 ps-error-handler-alist)) |
3735 1)) ; send to paper | 3770 1)) ; send to paper |
3736 ps-print-prologue-0 | 3771 ps-print-prologue-0 |
3737 "\n%%BeginProcSet: UserDefinedPrologue\n\n") | 3772 "\n%%BeginProcSet: UserDefinedPrologue\n\n") |
3777 line-height))))) | 3812 line-height))))) |
3778 | 3813 |
3779 (ps-output-boolean "Zebra " ps-zebra-stripes) | 3814 (ps-output-boolean "Zebra " ps-zebra-stripes) |
3780 (ps-output-boolean "PrintLineNumber " ps-line-number) | 3815 (ps-output-boolean "PrintLineNumber " ps-line-number) |
3781 (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height) | 3816 (ps-output (format "/ZebraHeight %d def\n" ps-zebra-stripe-height) |
3782 (format "/ZebraGray %s def\n" ps-zebra-gray) | 3817 "/ZebraColor " |
3783 "/UseSetpagedevice " | 3818 (ps-format-color ps-zebra-color 0.95) |
3819 "def\n/BackgroundColor " | |
3820 (ps-format-color ps-default-bg 1.0) | |
3821 "def\n/UseSetpagedevice " | |
3784 (if (eq ps-spool-config 'setpagedevice) | 3822 (if (eq ps-spool-config 'setpagedevice) |
3785 "/setpagedevice where {pop true}{false}ifelse def\n" | 3823 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse" |
3786 "false def\n") | 3824 "false") |
3787 "\n/PageWidth " | 3825 " def\n\n/PageWidth " |
3788 "PrintPageWidth LeftMargin add RightMargin add def\n\n" | 3826 "PrintPageWidth LeftMargin add RightMargin add def\n\n" |
3789 (format "/N-Up %d def\n" ps-n-up-printing)) | 3827 (format "/N-Up %d def\n" ps-n-up-printing)) |
3790 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t)) | 3828 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t)) |
3791 (ps-output-boolean "N-Up-Border " ps-n-up-border-p) | 3829 (ps-output-boolean "N-Up-Border " ps-n-up-border-p) |
3792 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up)) | 3830 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up)) |
3793 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up)) | 3831 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up)) |
3794 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up)) | 3832 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up)) |
3795 (format "/N-Up-Margin %s" ps-n-up-margin) | 3833 (format "/N-Up-Margin %s def\n" ps-n-up-margin) |
3796 " def\n/N-Up-Repeat " | 3834 "/N-Up-Repeat " |
3797 (if ps-landscape-mode | 3835 (if ps-landscape-mode |
3798 (ps-n-up-end n-up-filling) | 3836 (ps-n-up-end n-up-filling) |
3799 (ps-n-up-repeat n-up-filling)) | 3837 (ps-n-up-repeat n-up-filling)) |
3800 " def\n/N-Up-End " | 3838 " def\n/N-Up-End " |
3801 (if ps-landscape-mode | 3839 (if ps-landscape-mode |
3854 ps-print-duplex-feature | 3892 ps-print-duplex-feature |
3855 "\n%%EndFeature\n"))) | 3893 "\n%%EndFeature\n"))) |
3856 (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n") | 3894 (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n") |
3857 (and ps-banner-page-when-duplexing | 3895 (and ps-banner-page-when-duplexing |
3858 (ps-output "\n%%Page: 0 0\nsave showpage restore\n"))) | 3896 (ps-output "\n%%Page: 0 0\nsave showpage restore\n"))) |
3897 | |
3898 | |
3899 (defun ps-format-color (color &optional default) | |
3900 (let ((the-color (if (stringp color) | |
3901 (ps-color-scale color) | |
3902 color))) | |
3903 (if (and the-color (listp the-color)) | |
3904 (concat "[" | |
3905 (format ps-color-format | |
3906 (nth 0 the-color) | |
3907 (nth 1 the-color) | |
3908 (nth 2 the-color)) | |
3909 "] ") | |
3910 (ps-float-format (if (numberp the-color) the-color default))))) | |
3859 | 3911 |
3860 | 3912 |
3861 (defun ps-insert-string (prologue) | 3913 (defun ps-insert-string (prologue) |
3862 (let ((str (if (functionp prologue) | 3914 (let ((str (if (functionp prologue) |
3863 (funcall prologue) | 3915 (funcall prologue) |
3930 (string-as-unibyte "[\000-\037\177-\377]")) | 3982 (string-as-unibyte "[\000-\037\177-\377]")) |
3931 ((eq ps-print-control-characters 'control-8-bit) | 3983 ((eq ps-print-control-characters 'control-8-bit) |
3932 (string-as-unibyte "[\000-\037\177-\237]")) | 3984 (string-as-unibyte "[\000-\037\177-\237]")) |
3933 ((eq ps-print-control-characters 'control) | 3985 ((eq ps-print-control-characters 'control) |
3934 "[\000-\037\177]") | 3986 "[\000-\037\177]") |
3935 (t "[\t\n\f]")))) | 3987 (t "[\t\n\f]")) |
3988 ps-default-foreground (ps-rgb-color ps-default-fg 0.0) | |
3989 ps-default-color (and ps-print-color-p ps-default-foreground) | |
3990 ps-current-color ps-default-color | |
3991 ;; Set the color scale. We do it here instead of in the defvar so | |
3992 ;; that ps-print can be dumped into emacs. This expression can't be | |
3993 ;; evaluated at dump-time because X isn't initialized. | |
3994 ps-color-p (and ps-print-color-p (ps-color-device)) | |
3995 ps-print-color-scale (if ps-color-p | |
3996 (float (car (ps-color-values "white"))) | |
3997 1.0))) | |
3998 | |
3999 | |
4000 (defun ps-rgb-color (color default) | |
4001 (cond ((and color (listp color)) color) | |
4002 ((stringp color) (ps-color-scale color)) | |
4003 ((numberp color) (list color color color)) | |
4004 (t (list default default default)) | |
4005 )) | |
4006 | |
3936 | 4007 |
3937 (defmacro ps-page-number () | 4008 (defmacro ps-page-number () |
3938 `(1+ (/ (1- ps-page-count) ps-number-of-columns))) | 4009 `(1+ (/ (1- ps-page-count) ps-number-of-columns))) |
3939 | 4010 |
3940 (defun ps-end-file (needs-begin-file) | 4011 (defun ps-end-file (needs-begin-file) |
4112 (nth 0 color) (nth 1 color) (nth 2 color)) | 4183 (nth 0 color) (nth 1 color) (nth 2 color)) |
4113 " true BG\n") | 4184 " true BG\n") |
4114 (ps-output "false BG\n"))) | 4185 (ps-output "false BG\n"))) |
4115 | 4186 |
4116 (defun ps-set-color (color) | 4187 (defun ps-set-color (color) |
4117 (setq ps-current-color (or color ps-default-fg)) | 4188 (setq ps-current-color (or color ps-default-foreground)) |
4118 (ps-output (format ps-color-format | 4189 (ps-output (format ps-color-format |
4119 (nth 0 ps-current-color) | 4190 (nth 0 ps-current-color) |
4120 (nth 1 ps-current-color) (nth 2 ps-current-color)) | 4191 (nth 1 ps-current-color) (nth 2 ps-current-color)) |
4121 " FG\n")) | 4192 " FG\n")) |
4122 | 4193 |
4241 (setq ps-width-remaining (- ps-width-remaining (* len char-width))) | 4312 (setq ps-width-remaining (- ps-width-remaining (* len char-width))) |
4242 (ps-mule-prepare-ascii-font str) | 4313 (ps-mule-prepare-ascii-font str) |
4243 (ps-output-string str) | 4314 (ps-output-string str) |
4244 (ps-output " S\n"))) | 4315 (ps-output " S\n"))) |
4245 | 4316 |
4246 (defun ps-color-value (x-color-value) | 4317 (defun ps-color-scale (color) |
4247 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. | 4318 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. |
4248 (/ x-color-value ps-print-color-scale)) | 4319 (mapcar #'(lambda (value) (/ value ps-print-color-scale)) |
4320 (ps-color-values color))) | |
4249 | 4321 |
4250 | 4322 |
4251 (cond ((eq ps-print-emacs-type 'emacs) ; emacs | 4323 (cond ((eq ps-print-emacs-type 'emacs) ; emacs |
4252 | 4324 |
4253 (defun ps-color-values (x-color) | 4325 (defun ps-color-values (x-color) |
4257 ) | 4329 ) |
4258 ; xemacs | 4330 ; xemacs |
4259 ; lucid | 4331 ; lucid |
4260 (t ; epoch | 4332 (t ; epoch |
4261 (defun ps-color-values (x-color) | 4333 (defun ps-color-values (x-color) |
4262 (cond ((fboundp 'x-color-values) | 4334 (let ((the-color (if (color-specifier-p x-color) |
4263 (x-color-values x-color)) | 4335 (color-name x-color) |
4264 ((and (fboundp 'color-instance-rgb-components) | 4336 x-color))) |
4265 (ps-color-device)) | 4337 (cond |
4266 (color-instance-rgb-components | 4338 ((fboundp 'x-color-values) |
4267 (if (color-instance-p x-color) | 4339 (x-color-values the-color)) |
4268 x-color | 4340 ((and (fboundp 'color-instance-rgb-components) |
4269 (make-color-instance | 4341 (ps-color-device)) |
4270 (if (color-specifier-p x-color) | 4342 (color-instance-rgb-components |
4271 (color-name x-color) | 4343 (if (color-instance-p x-color) |
4272 x-color))))) | 4344 x-color |
4273 (t | 4345 (make-color-instance the-color)))) |
4274 (error "No available function to determine X color values.")))) | 4346 (t |
4347 (error "No available function to determine X color values."))))) | |
4275 )) | 4348 )) |
4276 | 4349 |
4277 | 4350 |
4278 (defun ps-face-attributes (face) | 4351 (defun ps-face-attributes (face) |
4279 "Return face attribute vector. | 4352 "Return face attribute vector. |
4321 (let* ((face-bit (ps-face-attribute-list face)) | 4394 (let* ((face-bit (ps-face-attribute-list face)) |
4322 (effect (aref face-bit 0)) | 4395 (effect (aref face-bit 0)) |
4323 (foreground (aref face-bit 1)) | 4396 (foreground (aref face-bit 1)) |
4324 (background (aref face-bit 2)) | 4397 (background (aref face-bit 2)) |
4325 (fg-color (if (and ps-color-p foreground) | 4398 (fg-color (if (and ps-color-p foreground) |
4326 (mapcar 'ps-color-value | 4399 (ps-color-scale foreground) |
4327 (ps-color-values foreground)) | |
4328 ps-default-color)) | 4400 ps-default-color)) |
4329 (bg-color (and ps-color-p background | 4401 (bg-color (and ps-color-p background |
4330 (mapcar 'ps-color-value | 4402 (ps-color-scale background)))) |
4331 (ps-color-values background))))) | |
4332 (ps-plot-region | 4403 (ps-plot-region |
4333 from to | 4404 from to |
4334 (ps-font-number 'ps-font-for-text | 4405 (ps-font-number 'ps-font-for-text |
4335 (or (aref ps-font-type (logand effect 3)) | 4406 (or (aref ps-font-type (logand effect 3)) |
4336 face)) | 4407 face)) |
4461 (if (or ps-always-build-face-reference | 4532 (if (or ps-always-build-face-reference |
4462 ps-build-face-reference) | 4533 ps-build-face-reference) |
4463 (progn | 4534 (progn |
4464 (message "Collecting face information...") | 4535 (message "Collecting face information...") |
4465 (ps-build-reference-face-lists))) | 4536 (ps-build-reference-face-lists))) |
4466 ;; Set the color scale. We do it here instead of in the defvar so | |
4467 ;; that ps-print can be dumped into emacs. This expression can't be | |
4468 ;; evaluated at dump-time because X isn't initialized. | |
4469 (setq ps-color-p (and ps-print-color-p (ps-color-device)) | |
4470 ps-print-color-scale (if ps-color-p | |
4471 (float (car (ps-color-values "white"))) | |
4472 1.0)) | |
4473 ;; Generate some PostScript. | 4537 ;; Generate some PostScript. |
4474 (save-restriction | 4538 (save-restriction |
4475 (narrow-to-region from to) | 4539 (narrow-to-region from to) |
4476 (ps-print-ensure-fontified from to) | 4540 (ps-print-ensure-fontified from to) |
4477 (let ((face 'default) | 4541 (let ((face 'default) |
4655 (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t) | 4719 (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t) |
4656 (replace-match (format "/Lines %d def\n/PageCount %d def" | 4720 (replace-match (format "/Lines %d def\n/PageCount %d def" |
4657 total-lines total-pages) t)))) | 4721 total-lines total-pages) t)))) |
4658 | 4722 |
4659 | 4723 |
4724 (defconst ps-printer-name-option | |
4725 (cond ((memq system-type '(win32 w32 mswindows ms-dos windows-nt)) | |
4726 "-P") | |
4727 ((memq system-type '(usq-unix-v dgux hpux irix)) | |
4728 "-d") | |
4729 (t | |
4730 "-P" ))) | |
4731 | |
4732 | |
4660 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'. | 4733 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'. |
4661 (defun ps-do-despool (filename) | 4734 (defun ps-do-despool (filename) |
4662 (if (or (not (boundp 'ps-spool-buffer)) | 4735 (if (or (not (boundp 'ps-spool-buffer)) |
4663 (not (symbol-value 'ps-spool-buffer))) | 4736 (not (symbol-value 'ps-spool-buffer))) |
4664 (message "No spooled PostScript to print") | 4737 (message "No spooled PostScript to print") |
4678 (ps-printer-name (or ps-printer-name | 4751 (ps-printer-name (or ps-printer-name |
4679 (and (boundp 'printer-name) | 4752 (and (boundp 'printer-name) |
4680 printer-name))) | 4753 printer-name))) |
4681 (ps-lpr-switches | 4754 (ps-lpr-switches |
4682 (append (and (stringp ps-printer-name) | 4755 (append (and (stringp ps-printer-name) |
4683 (list (concat "-P" ps-printer-name))) | 4756 (list (concat ps-printer-name-option |
4757 ps-printer-name))) | |
4684 ps-lpr-switches))) | 4758 ps-lpr-switches))) |
4685 (apply (or ps-print-region-function 'call-process-region) | 4759 (apply (or ps-print-region-function 'call-process-region) |
4686 (point-min) (point-max) ps-lpr-command nil | 4760 (point-min) (point-max) ps-lpr-command nil |
4687 (and (fboundp 'start-process) 0) | 4761 (and (fboundp 'start-process) 0) |
4688 nil | 4762 nil |