1 |
;;; ps-print.el --- print text from the buffer as PostScript |
;;; ps-print.el --- print text from the buffer as PostScript |
2 |
|
|
3 |
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 |
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, |
4 |
;; Free Software Foundation, Inc. |
;; 2003 Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Jim Thompson (was <thompson@wg2.waii.com>) |
;; Author: Jim Thompson (was <thompson@wg2.waii.com>) |
7 |
;; Jacques Duthen (was <duthen@cegelec-red.fr>) |
;; Jacques Duthen (was <duthen@cegelec-red.fr>) |
8 |
;; Vinicius Jose Latorre <vinicius@cpqd.com.br> |
;; Vinicius Jose Latorre <viniciusjl@ig.com.br> |
9 |
;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
10 |
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) |
11 |
;; Vinicius Jose Latorre <vinicius@cpqd.com.br> |
;; Vinicius Jose Latorre <viniciusjl@ig.com.br> |
12 |
;; Keywords: wp, print, PostScript |
;; Keywords: wp, print, PostScript |
13 |
;; Time-stamp: <2001/09/17 14:50:19 vinicius> |
;; Time-stamp: <2003/03/05 21:54:55 vinicius> |
14 |
;; Version: 6.5.5 |
;; Version: 6.6 |
15 |
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ |
;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ |
16 |
|
|
17 |
(defconst ps-print-version "6.5.5" |
(defconst ps-print-version "6.6" |
18 |
"ps-print.el, v 6.5.5 <2001/09/17 vinicius> |
"ps-print.el, v 6.6 <2003/03/05 vinicius> |
19 |
|
|
20 |
Vinicius's last change version -- this file may have been edited as part of |
Vinicius's last change version -- this file may have been edited as part of |
21 |
Emacs without changes to the version number. When reporting bugs, please also |
Emacs without changes to the version number. When reporting bugs, please also |
22 |
report the version of Emacs, if any, that ps-print was distributed with. |
report the version of Emacs, if any, that ps-print was distributed with. |
23 |
|
|
24 |
Please send all bug fixes and enhancements to |
Please send all bug fixes and enhancements to |
25 |
Vinicius Jose Latorre <vinicius@cpqd.com.br>. |
Vinicius Jose Latorre <viniciusjl@ig.com.br>.") |
|
") |
|
26 |
|
|
27 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
28 |
|
|
49 |
;; |
;; |
50 |
;; This package provides printing of Emacs buffers on PostScript printers; the |
;; This package provides printing of Emacs buffers on PostScript printers; the |
51 |
;; buffer's bold and italic text attributes are preserved in the printer |
;; buffer's bold and italic text attributes are preserved in the printer |
52 |
;; output. ps-print is intended for use with Emacs or Lucid Emacs, together |
;; output. ps-print is intended for use with Emacs or XEmacs, together with a |
53 |
;; with a fontifying package such as font-lock or hilit. |
;; fontifying package such as font-lock or hilit. |
54 |
;; |
;; |
55 |
;; ps-print uses the same face attributes defined through font-lock or hilit to |
;; ps-print uses the same face attributes defined through font-lock or hilit to |
56 |
;; print a PostScript file, but some faces are better seeing on the screen than |
;; print a PostScript file, but some faces are better seeing on the screen than |
1075 |
;; (face...) list of faces whose background color will be used. |
;; (face...) list of faces whose background color will be used. |
1076 |
;; |
;; |
1077 |
;; Any other value will be treated as t. |
;; Any other value will be treated as t. |
1078 |
;; The default value is t. |
;; The default value is nil. |
1079 |
;; |
;; |
1080 |
;; |
;; |
1081 |
;; How Ps-Print Deals With Color |
;; How Ps-Print Deals With Color |
1211 |
;; New since version 2.8 |
;; New since version 2.8 |
1212 |
;; --------------------- |
;; --------------------- |
1213 |
;; |
;; |
1214 |
;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br> |
;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br> |
1215 |
;; |
;; |
1216 |
;; 20010619 |
;; 20010619 |
1217 |
;; `ps-time-stamp-locale-default' |
;; `ps-time-stamp-locale-default' |
1263 |
;; |
;; |
1264 |
;; `ps-print-region-function' |
;; `ps-print-region-function' |
1265 |
;; |
;; |
1266 |
;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br> |
;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br> |
1267 |
;; |
;; |
1268 |
;; 19990301 |
;; 19990301 |
1269 |
;; PostScript tumble and setpagedevice. |
;; PostScript tumble and setpagedevice. |
1276 |
;; |
;; |
1277 |
;; Multi-byte buffer handling. |
;; Multi-byte buffer handling. |
1278 |
;; |
;; |
1279 |
;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br> |
;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br> |
1280 |
;; |
;; |
1281 |
;; 19980306 |
;; 19980306 |
1282 |
;; Skip invisible text. |
;; Skip invisible text. |
1329 |
;; |
;; |
1330 |
;; Faces are always treated as opaque. |
;; Faces are always treated as opaque. |
1331 |
;; |
;; |
1332 |
;; Epoch and Emacs 19 not supported. At all. |
;; Epoch, Lucid and Emacs 19 not supported. At all. |
1333 |
;; |
;; |
1334 |
;; Fixed-pitch fonts work better for line folding, but are not required. |
;; Fixed-pitch fonts work better for line folding, but are not required. |
1335 |
;; |
;; |
1442 |
(error "`ps-print' requires floating point support")) |
(error "`ps-print' requires floating point support")) |
1443 |
|
|
1444 |
|
|
1445 |
|
(defvar ps-print-emacs-type |
1446 |
|
(let ((case-fold-search t)) |
1447 |
|
(cond ((string-match "XEmacs" emacs-version) 'xemacs) |
1448 |
|
((string-match "Lucid" emacs-version) |
1449 |
|
(error "`ps-print' doesn't support Lucid")) |
1450 |
|
((string-match "Epoch" emacs-version) |
1451 |
|
(error "`ps-print' doesn't support Epoch")) |
1452 |
|
(t |
1453 |
|
(unless (and (boundp 'emacs-major-version) |
1454 |
|
(> emacs-major-version 19)) |
1455 |
|
(error "`ps-print' only supports Emacs 20 and higher")) |
1456 |
|
'emacs)))) |
1457 |
|
|
1458 |
|
|
1459 |
;; For Emacs 20.2 and the earlier version. |
;; For Emacs 20.2 and the earlier version. |
1460 |
|
|
1461 |
(or (fboundp 'set-buffer-multibyte) |
(or (fboundp 'set-buffer-multibyte) |
1521 |
(defconst ps-windows-system |
(defconst ps-windows-system |
1522 |
(memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) |
(memq system-type '(emx win32 w32 mswindows ms-dos windows-nt))) |
1523 |
(defconst ps-lp-system |
(defconst ps-lp-system |
1524 |
(memq system-type '(usq-unix-v dgux hpux irix)))) |
(memq system-type '(usg-unix-v dgux hpux irix))) |
1525 |
|
|
1526 |
|
|
1527 |
|
(defun ps-xemacs-color-name (color) |
1528 |
|
(if (ps-x-color-specifier-p color) |
1529 |
|
(ps-x-color-name color) |
1530 |
|
color)) |
1531 |
|
|
1532 |
|
|
1533 |
|
(cond ((eq ps-print-emacs-type 'emacs) ; emacs |
1534 |
|
(defvar mark-active nil) |
1535 |
|
(defun ps-mark-active-p () |
1536 |
|
mark-active) |
1537 |
|
(defalias 'ps-face-foreground-name 'face-foreground) |
1538 |
|
(defalias 'ps-face-background-name 'face-background) |
1539 |
|
) |
1540 |
|
(t ; xemacs |
1541 |
|
(defalias 'ps-mark-active-p 'region-active-p) |
1542 |
|
(defun ps-face-foreground-name (face) |
1543 |
|
(ps-xemacs-color-name (face-foreground face))) |
1544 |
|
(defun ps-face-background-name (face) |
1545 |
|
(ps-xemacs-color-name (face-background face))) |
1546 |
|
))) |
1547 |
|
|
1548 |
|
|
1549 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1688 |
;; Setting for HP PostScript printer |
;; Setting for HP PostScript printer |
1689 |
(setq ps-user-defined-prologue |
(setq ps-user-defined-prologue |
1690 |
(concat \"<</DeferredMediaSelection true /PageSize [612 792] \" |
(concat \"<</DeferredMediaSelection true /PageSize [612 792] \" |
1691 |
\"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\")) |
\"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))" |
|
" |
|
1692 |
:type '(choice :menu-tag "User Defined Prologue" |
:type '(choice :menu-tag "User Defined Prologue" |
1693 |
:tag "User Defined Prologue" |
:tag "User Defined Prologue" |
1694 |
(const :tag "none" nil) string symbol) |
(const :tag "none" nil) string symbol) |
1707 |
\"%%+\" comment. For example, if you need to set numcopies to 3 and jog on |
\"%%+\" comment. For example, if you need to set numcopies to 3 and jog on |
1708 |
requirements and set %%LanguageLevel: to 2, do: |
requirements and set %%LanguageLevel: to 2, do: |
1709 |
|
|
1710 |
(setq ps-print-prologue-header |
(setq ps-print-prologue-header |
1711 |
\"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\") |
\"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\") |
1712 |
|
|
1713 |
The duplex requirement is inserted by ps-print (see `ps-spool-duplex'). |
The duplex requirement is inserted by ps-print (see `ps-spool-duplex'). |
1714 |
|
|
1763 |
"-P" )) |
"-P" )) |
1764 |
"*Option for `ps-printer-name' variable (see it). |
"*Option for `ps-printer-name' variable (see it). |
1765 |
|
|
1766 |
On Unix-like systems, if it's been used lpr utility, it should be the string |
On Unix-like systems, if `lpr' is in use, this should be the string |
1767 |
\"-P\"; if it's been used lp utility, it should be the string \"-d\". |
\"-P\"; if `lp' is in use, this should be the string \"-d\". |
1768 |
|
|
1769 |
On MS-DOS and MS-Windows systems, if it's been used print utility, it should be |
On MS-DOS and MS-Windows systems, if `print' is in use, this should be |
1770 |
the string \"/D:\". |
the string \"/D:\". |
1771 |
|
|
1772 |
For any other printing utility, see the proper manual or documentation. |
For any other printing utility, see its documentation. |
1773 |
|
|
1774 |
Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty |
Set this to \"\" or nil, if the utility given by `ps-lpr-command' |
1775 |
option printer name option. |
needs an empty printer name option--that is, pass the printer name |
1776 |
|
with no special option preceding it. |
1777 |
|
|
1778 |
Any other value is treated as nil, that is, an empty printer name option. |
Any value that is not a string is treated as nil. |
1779 |
|
|
1780 |
This variable is used only when `ps-printer-name' is a non-empty string." |
This variable is used only when `ps-printer-name' is a non-empty string." |
1781 |
:type '(choice :menu-tag "Printer Name Option" |
:type '(choice :menu-tag "Printer Name Option" |
1845 |
;; B4 10.125 inch x 14.33 inch |
;; B4 10.125 inch x 14.33 inch |
1846 |
;; B5 7.16 inch x 10.125 inch |
;; B5 7.16 inch x 10.125 inch |
1847 |
|
|
1848 |
|
;;;###autoload |
1849 |
(defcustom ps-page-dimensions-database |
(defcustom ps-page-dimensions-database |
1850 |
(list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") |
(list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") |
1851 |
(list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") |
(list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") |
1894 |
:group 'ps-print-page) |
:group 'ps-print-page) |
1895 |
|
|
1896 |
(defcustom ps-print-upside-down nil |
(defcustom ps-print-upside-down nil |
1897 |
"*Non-nil means print upside-down (that is, it's rotated by 180 grades)." |
"*Non-nil means print upside-down (that is, rotated by 180 degrees)." |
1898 |
:type 'boolean |
:type 'boolean |
1899 |
:version "21.1" |
:version "21.1" |
1900 |
:group 'ps-print-page) |
:group 'ps-print-page) |
1902 |
(defcustom ps-selected-pages nil |
(defcustom ps-selected-pages nil |
1903 |
"*Specify which pages to print. |
"*Specify which pages to print. |
1904 |
|
|
1905 |
If it's nil, all pages are printed. |
If nil, print all pages. |
1906 |
|
|
1907 |
If it's a list, the list element may be an integer or a cons cell (FROM . TO) |
If a list, the lists element may be an integer or a cons cell (FROM . TO) |
1908 |
designating FROM page to TO page; any invalid element is ignored, that is, an |
designating FROM page to TO page; any invalid element is ignored, that is, an |
1909 |
integer lesser than one or if FROM is greater than TO. |
integer lesser than one or if FROM is greater than TO. |
1910 |
|
|
1911 |
Otherwise, it's treated as nil. |
Otherwise, it's treated as nil. |
1912 |
|
|
1913 |
After ps-print processing `ps-selected-pages' is set to nil. But the latest |
After ps-print processing `ps-selected-pages' is set to nil. But the |
1914 |
`ps-selected-pages' is saved in `ps-last-selected-pages' (see it for |
latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which |
1915 |
documentation). So you can restore the latest selected pages by using |
see). So you can restore the latest selected pages by using |
1916 |
`ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see |
`ps-last-selected-pages' or with the `ps-restore-selected-pages' |
1917 |
it for documentation). |
command (which see). |
1918 |
|
|
1919 |
See also `ps-even-or-odd-pages'." |
See also `ps-even-or-odd-pages'." |
1920 |
:type '(repeat :tag "Selected Pages" |
:type '(repeat :tag "Selected Pages" |
2071 |
:group 'ps-print-n-up) |
:group 'ps-print-n-up) |
2072 |
|
|
2073 |
(defcustom ps-number-of-columns (if ps-landscape-mode 2 1) |
(defcustom ps-number-of-columns (if ps-landscape-mode 2 1) |
2074 |
"*Specify the number of columns" |
"*Specify the number of columns." |
2075 |
:type 'number |
:type 'number |
2076 |
:group 'ps-print-miscellany) |
:group 'ps-print-miscellany) |
2077 |
|
|
2231 |
If PAGES is nil, print background image on all pages. |
If PAGES is nil, print background image on all pages. |
2232 |
|
|
2233 |
X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer |
X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer |
2234 |
number or a string. If it is a string, the string should contain PostScript |
number or a string. If it is a string, the string should contain PostScript |
2235 |
programming that returns a float or integer value. |
programming that returns a float or integer value. |
2236 |
|
|
2237 |
For example, if you wish to print an EPS image on all pages do: |
For example, if you wish to print an EPS image on all pages do: |
2281 |
If PAGES is nil, print background text on all pages. |
If PAGES is nil, print background text on all pages. |
2282 |
|
|
2283 |
X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer |
X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer |
2284 |
number or a string. If it is a string, the string should contain PostScript |
number or a string. If it is a string, the string should contain PostScript |
2285 |
programming that returns a float or integer value. |
programming that returns a float or integer value. |
2286 |
|
|
2287 |
For example, if you wish to print text \"Preliminary\" on all pages do: |
For example, if you wish to print text \"Preliminary\" on all pages do: |
2356 |
:group 'ps-print-vertical) |
:group 'ps-print-vertical) |
2357 |
|
|
2358 |
(defcustom ps-header-line-pad 0.15 |
(defcustom ps-header-line-pad 0.15 |
2359 |
"*Portion of a header title line height to insert between the header frame |
"*Portion of a header title line height to insert. |
2360 |
and the text it contains, both in the vertical and horizontal directions." |
The insertion is done between the header frame and the text it contains, |
2361 |
|
both in the vertical and horizontal directions." |
2362 |
:type 'number |
:type 'number |
2363 |
:group 'ps-print-vertical) |
:group 'ps-print-vertical) |
2364 |
|
|
2368 |
:group 'ps-print-vertical) |
:group 'ps-print-vertical) |
2369 |
|
|
2370 |
(defcustom ps-footer-line-pad 0.15 |
(defcustom ps-footer-line-pad 0.15 |
2371 |
"*Portion of a footer title line height to insert between the footer frame |
"*Portion of a footer title line height to insert. |
2372 |
and the text it contains, both in the vertical and horizontal directions." |
The insertion is done between the footer frame and the text it contains, |
2373 |
|
both in the vertical and horizontal directions." |
2374 |
:type 'number |
:type 'number |
2375 |
:group 'ps-print-vertical) |
:group 'ps-print-vertical) |
2376 |
|
|
2620 |
specified by setpagedevice, your printing will be aborted. |
specified by setpagedevice, your printing will be aborted. |
2621 |
So, if you need to use setpagedevice, set `ps-spool-config' to |
So, if you need to use setpagedevice, set `ps-spool-config' to |
2622 |
`setpagedevice', generate a test file and send it to your printer; if |
`setpagedevice', generate a test file and send it to your printer; if |
2623 |
the printed file isn't ok, set `ps-spool-config' to nil." |
the printed file isn't OK, set `ps-spool-config' to nil." |
2624 |
:type '(choice :menu-tag "Spool Config" |
:type '(choice :menu-tag "Spool Config" |
2625 |
:tag "Spool Config" |
:tag "Spool Config" |
2626 |
(const lpr-switches) (const setpagedevice) |
(const lpr-switches) (const setpagedevice) |
2756 |
(space-width . 2.2) |
(space-width . 2.2) |
2757 |
(avg-char-width . 4.10811)) |
(avg-char-width . 4.10811)) |
2758 |
) |
) |
2759 |
"*Font info database: font family (the key), name, bold, italic, bold-italic, |
"*Font info database. |
2760 |
|
Each element comprises: font family (the key), name, bold, italic, bold-italic, |
2761 |
reference size, line height, space width, average character width. |
reference size, line height, space width, average character width. |
2762 |
To get the info for another specific font (say Helvetica), do the following: |
To get the info for another specific font (say Helvetica), do the following: |
2763 |
- create a new buffer |
- create a new buffer |
2891 |
;;; Colors |
;;; Colors |
2892 |
|
|
2893 |
;; Printing color requires x-color-values. |
;; Printing color requires x-color-values. |
2894 |
|
;; XEmacs change: Need autoload for the "Options->Printing->Color Printing" |
2895 |
|
;; widget to work. |
2896 |
|
;;;###autoload |
2897 |
(defcustom ps-print-color-p |
(defcustom ps-print-color-p |
2898 |
(or (and (fboundp 'color-values) ; Emacs |
(or (fboundp 'x-color-values) ; Emacs |
|
(ps-e-color-values "Green")) |
|
|
(fboundp 'x-color-values) ; Emacs |
|
2899 |
(fboundp 'color-instance-rgb-components)) |
(fboundp 'color-instance-rgb-components)) |
2900 |
; XEmacs |
; XEmacs |
2901 |
"*Specify how buffer's text color is printed. |
"*Specify how buffer's text color is printed. |
2917 |
(const :tag "Print Black/White Color" black-white)) |
(const :tag "Print Black/White Color" black-white)) |
2918 |
:group 'ps-print-color) |
:group 'ps-print-color) |
2919 |
|
|
2920 |
(defcustom ps-default-fg '(0.0 0.0 0.0) |
(defcustom ps-default-fg '(0.0 0.0 0.0) ; black |
2921 |
"*RGB values of the default foreground color. Defaults to black." |
"*RGB values of the default foreground color. Defaults to black. |
2922 |
|
|
2923 |
|
The `ps-default-fg' variable contains the default foreground color used by |
2924 |
|
ps-print, that is, if there is a face in a text that doesn't have a foreground |
2925 |
|
color, the `ps-default-fg' color should be used. |
2926 |
|
|
2927 |
|
Valid values are: |
2928 |
|
|
2929 |
|
t The foreground color of Emacs session will be used. |
2930 |
|
|
2931 |
|
NUMBER It's a real value between 0.0 (black) and 1.0 (white) that |
2932 |
|
indicate the gray color. |
2933 |
|
|
2934 |
|
COLOR-NAME It's a string wich contains the color name. For example: |
2935 |
|
\"yellow\". |
2936 |
|
|
2937 |
|
LIST It's a list of RGB values, that is a list of three real values |
2938 |
|
of the form: |
2939 |
|
|
2940 |
|
(RED, GREEN, BLUE) |
2941 |
|
|
2942 |
|
Where RED, GREEN and BLUE are reals between 0.0 (no color) and |
2943 |
|
1.0 (full color). |
2944 |
|
|
2945 |
|
Any other value is ignored and it's used the black color. |
2946 |
|
|
2947 |
|
It's used only when `ps-print-color-p' is non-nil." |
2948 |
:type '(choice :menu-tag "Default Foreground Gray/Color" |
:type '(choice :menu-tag "Default Foreground Gray/Color" |
2949 |
:tag "Default Foreground Gray/Color" |
:tag "Default Foreground Gray/Color" |
2950 |
|
(const :tag "Session Foreground" t) |
2951 |
(number :tag "Gray Scale" :value 0.0) |
(number :tag "Gray Scale" :value 0.0) |
2952 |
(string :tag "Color Name" :value "black") |
(string :tag "Color Name" :value "black") |
2953 |
(list :tag "RGB Color" :value (0.0 0.0 0.0) |
(list :tag "RGB Color" :value (0.0 0.0 0.0) |
2956 |
(number :tag "Blue"))) |
(number :tag "Blue"))) |
2957 |
:group 'ps-print-color) |
:group 'ps-print-color) |
2958 |
|
|
2959 |
(defcustom ps-default-bg '(1.0 1.0 1.0) |
(defcustom ps-default-bg '(1.0 1.0 1.0) ; white |
2960 |
"*RGB values of the default background color. Defaults to white." |
"*RGB values of the default background color. Defaults to white. |
2961 |
|
|
2962 |
|
The `ps-default-bg' variable contains the default background color used by |
2963 |
|
ps-print, that is, if there is a face in a text that doesn't have a background |
2964 |
|
color, the `ps-default-bg' color should be used. |
2965 |
|
|
2966 |
|
Valid values are: |
2967 |
|
|
2968 |
|
t The background color of Emacs session will be used. |
2969 |
|
|
2970 |
|
NUMBER It's a real value between 0.0 (black) and 1.0 (white) that |
2971 |
|
indicate the gray color. |
2972 |
|
|
2973 |
|
COLOR-NAME It's a string wich contains the color name. For example: |
2974 |
|
\"yellow\". |
2975 |
|
|
2976 |
|
LIST It's a list of RGB values, that is a list of three real values |
2977 |
|
of the form: |
2978 |
|
|
2979 |
|
(RED, GREEN, BLUE) |
2980 |
|
|
2981 |
|
Where RED, GREEN and BLUE are reals between 0.0 (no color) and |
2982 |
|
1.0 (full color). |
2983 |
|
|
2984 |
|
Any other value is ignored and it's used the white color. |
2985 |
|
|
2986 |
|
It's used only when `ps-print-color-p' is non-nil. |
2987 |
|
|
2988 |
|
See also `ps-use-face-background'." |
2989 |
:type '(choice :menu-tag "Default Background Gray/Color" |
:type '(choice :menu-tag "Default Background Gray/Color" |
2990 |
:tag "Default Background Gray/Color" |
:tag "Default Background Gray/Color" |
2991 |
|
(const :tag "Session Background" t) |
2992 |
(number :tag "Gray Scale" :value 1.0) |
(number :tag "Gray Scale" :value 1.0) |
2993 |
(string :tag "Color Name" :value "white") |
(string :tag "Color Name" :value "white") |
2994 |
(list :tag "RGB Color" :value (1.0 1.0 1.0) |
(list :tag "RGB Color" :value (1.0 1.0 1.0) |
3136 |
`ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\". |
`ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\". |
3137 |
|
|
3138 |
You can also create your own time stamp function by using `format-time-string' |
You can also create your own time stamp function by using `format-time-string' |
3139 |
(which see)." |
\(which see)." |
3140 |
:type '(repeat (choice :menu-tag "Right Header" |
:type '(repeat (choice :menu-tag "Right Header" |
3141 |
:tag "Right Header" |
:tag "Right Header" |
3142 |
string symbol)) |
string symbol)) |
3183 |
`ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\". |
`ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\". |
3184 |
|
|
3185 |
You can also create your own time stamp function by using `format-time-string' |
You can also create your own time stamp function by using `format-time-string' |
3186 |
(which see)." |
\(which see)." |
3187 |
:version "21.1" |
:version "21.1" |
3188 |
:type '(repeat (choice :menu-tag "Right Footer" |
:type '(repeat (choice :menu-tag "Right Footer" |
3189 |
:tag "Right Footer" |
:tag "Right Footer" |
3232 |
:group 'ps-print-headers) |
:group 'ps-print-headers) |
3233 |
|
|
3234 |
(defcustom ps-postscript-code-directory |
(defcustom ps-postscript-code-directory |
3235 |
(or (and (fboundp 'locate-data-directory) ; xemacs |
(or (cond |
3236 |
(locate-data-directory "ps-print")) |
((eq ps-print-emacs-type 'emacs) ; emacs |
3237 |
data-directory) ; emacs |
data-directory) |
3238 |
|
((fboundp 'locate-data-directory) ; xemacs |
3239 |
|
(locate-data-directory "ps-print")) |
3240 |
|
((boundp 'data-directory) ; xemacs |
3241 |
|
data-directory) |
3242 |
|
(t ; don't know what to do |
3243 |
|
nil)) |
3244 |
|
(error "`ps-postscript-code-directory' isn't set properly")) |
3245 |
"*Directory where it's located the PostScript prologue file used by ps-print. |
"*Directory where it's located the PostScript prologue file used by ps-print. |
3246 |
By default, this directory is the same as in the variable `data-directory'." |
By default, this directory is the same as in the variable `data-directory'." |
3247 |
:type 'directory |
:type 'directory |
3304 |
Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what |
Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what |
3305 |
actually gets printed. Both variables may be set to nil in which case no |
actually gets printed. Both variables may be set to nil in which case no |
3306 |
cutting occurs." |
cutting occurs." |
3307 |
:type 'regexp |
:type '(choice (const :tag "No Delimiter" nil) |
3308 |
|
(regexp :tag "Delimiter Regexp")) |
3309 |
:version "21.1" |
:version "21.1" |
3310 |
:group 'ps-print-miscellany) |
:group 'ps-print-miscellany) |
3311 |
|
|
3313 |
"*Specify regexp which is end of the region to cut out when printing. |
"*Specify regexp which is end of the region to cut out when printing. |
3314 |
|
|
3315 |
See `ps-begin-cut-regexp' for more information." |
See `ps-begin-cut-regexp' for more information." |
3316 |
:type 'regexp |
:type '(choice (const :tag "No Delimiter" nil) |
3317 |
|
(regexp :tag "Delimiter Regexp")) |
3318 |
:version "21.1" |
:version "21.1" |
3319 |
:group 'ps-print-miscellany) |
:group 'ps-print-miscellany) |
3320 |
|
|
3352 |
(defun ps-print-buffer (&optional filename) |
(defun ps-print-buffer (&optional filename) |
3353 |
"Generate and print a PostScript image of the buffer. |
"Generate and print a PostScript image of the buffer. |
3354 |
|
|
3355 |
Interactively, when you use a prefix argument (C-u), the command prompts the |
Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the |
3356 |
user for a file name, and saves the PostScript image in that file instead of |
user for a file name, and saves the PostScript image in that file instead of |
3357 |
sending it to the printer. |
sending it to the printer. |
3358 |
|
|
3439 |
(defun ps-despool (&optional filename) |
(defun ps-despool (&optional filename) |
3440 |
"Send the spooled PostScript to the printer. |
"Send the spooled PostScript to the printer. |
3441 |
|
|
3442 |
Interactively, when you use a prefix argument (C-u), the command prompts the |
Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the |
3443 |
user for a file name, and saves the spooled PostScript image in that file |
user for a file name, and saves the spooled PostScript image in that file |
3444 |
instead of sending it to the printer. |
instead of sending it to the printer. |
3445 |
|
|
3451 |
|
|
3452 |
;;;###autoload |
;;;###autoload |
3453 |
(defun ps-line-lengths () |
(defun ps-line-lengths () |
3454 |
"Display the correspondence between a line length and a font size, using the |
"Display the correspondence between a line length and a font size. |
3455 |
current ps-print setup. |
Done using the current ps-print setup. |
3456 |
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" |
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" |
3457 |
(interactive) |
(interactive) |
3458 |
(ps-line-lengths-internal)) |
(ps-line-lengths-internal)) |
3622 |
|
|
3623 |
If `ps-prefix-quote' is nil, it's set to t after generating string." |
If `ps-prefix-quote' is nil, it's set to t after generating string." |
3624 |
(cond |
(cond |
|
((null elt) "") |
|
3625 |
((stringp elt) elt) |
((stringp elt) elt) |
3626 |
(t |
((and (consp elt) (integerp (car elt)) |
3627 |
|
(symbolp (cdr elt)) (boundp (cdr elt))) |
3628 |
(let* ((col (car elt)) |
(let* ((col (car elt)) |
3629 |
(sym (cdr elt)) |
(sym (cdr elt)) |
3630 |
(key (symbol-name sym)) |
(key (symbol-name sym)) |
3642 |
((eq val t) "t") |
((eq val t) "t") |
3643 |
((or (symbolp val) (listp val)) (format "'%S" val)) |
((or (symbolp val) (listp val)) (format "'%S" val)) |
3644 |
(t (format "%S" val)))))) |
(t (format "%S" val)))))) |
3645 |
|
(t "") |
3646 |
)) |
)) |
3647 |
|
|
3648 |
|
|
3700 |
|
|
3701 |
|
|
3702 |
(eval-and-compile |
(eval-and-compile |
3703 |
(defvar ps-print-emacs-type |
(and (eq ps-print-emacs-type 'xemacs) |
3704 |
(cond ((string-match "XEmacs" emacs-version) 'xemacs) |
;; XEmacs change: Need to check for emacs-major-version too. |
3705 |
((string-match "Lucid" emacs-version) 'lucid) |
(or (< emacs-major-version 19) |
3706 |
((string-match "Epoch" emacs-version) 'epoch) |
(and (= emacs-major-version 19) (< emacs-minor-version 12))) |
3707 |
(t 'emacs))) |
(setq ps-print-color-p nil)) |
|
|
|
|
(if (memq ps-print-emacs-type '(lucid xemacs)) |
|
|
(if (< emacs-minor-version 12) |
|
|
(setq ps-print-color-p nil)) |
|
|
(require 'faces)) ; face-font, face-underline-p, |
|
|
; x-font-regexp |
|
3708 |
|
|
3709 |
|
|
3710 |
;; Return t if the device (which can be changed during an emacs session) |
;; Return t if the device (which can be changed during an emacs session) |
3711 |
;; can handle colors. |
;; can handle colors. |
3712 |
;; This function is not yet implemented for GNU emacs. |
;; This function is not yet implemented for GNU emacs. |
3713 |
(cond ((and (eq ps-print-emacs-type 'xemacs) |
(cond ((and (eq ps-print-emacs-type 'xemacs) |
3714 |
(>= emacs-minor-version 12)) ; xemacs |
;; XEmacs change: Need to check for emacs-major-version too. |
3715 |
|
(or (> emacs-major-version 19) |
3716 |
|
(and (= emacs-major-version 19) |
3717 |
|
(>= emacs-minor-version 12)))) ; xemacs >= 19.12 |
3718 |
(defun ps-color-device () |
(defun ps-color-device () |
3719 |
(eq (ps-x-device-class) 'color))) |
(eq (ps-x-device-class) 'color))) |
3720 |
|
|
3745 |
(case-fold-search t)) |
(case-fold-search t)) |
3746 |
(and kind-spec (string-match kind-regex kind-spec)))) |
(and kind-spec (string-match kind-regex kind-spec)))) |
3747 |
|
|
|
(defun ps-xemacs-color-name (color) |
|
|
(if (ps-x-color-specifier-p color) |
|
|
(ps-x-color-name color) |
|
|
color)) |
|
|
|
|
3748 |
(cond ((eq ps-print-emacs-type 'emacs) ; emacs |
(cond ((eq ps-print-emacs-type 'emacs) ; emacs |
3749 |
|
|
3750 |
(defun ps-color-values (x-color) |
(defun ps-color-values (x-color) |
3756 |
(t |
(t |
3757 |
(error "No available function to determine X color values")))) |
(error "No available function to determine X color values")))) |
3758 |
|
|
|
(defalias 'ps-face-foreground-name 'face-foreground) |
|
|
(defalias 'ps-face-background-name 'face-background) |
|
|
|
|
3759 |
(defun ps-face-bold-p (face) |
(defun ps-face-bold-p (face) |
3760 |
(or (ps-e-face-bold-p face) |
(or (ps-e-face-bold-p face) |
3761 |
(memq face ps-bold-faces))) |
(memq face ps-bold-faces))) |
3764 |
(or (ps-e-face-italic-p face) |
(or (ps-e-face-italic-p face) |
3765 |
(memq face ps-italic-faces))) |
(memq face ps-italic-faces))) |
3766 |
) |
) |
3767 |
; xemacs |
|
3768 |
; lucid |
(t ; xemacs |
|
(t ; epoch |
|
3769 |
|
|
3770 |
;; to avoid XEmacs compilation gripes |
;; to avoid XEmacs compilation gripes |
3771 |
(defvar coding-system-for-write nil) |
(defvar coding-system-for-write nil) |
3790 |
(t |
(t |
3791 |
(error "No available function to determine X color values"))))) |
(error "No available function to determine X color values"))))) |
3792 |
|
|
|
(defun ps-face-foreground-name (face) |
|
|
(ps-xemacs-color-name (face-foreground face))) |
|
|
|
|
|
(defun ps-face-background-name (face) |
|
|
(ps-xemacs-color-name (face-background face))) |
|
|
|
|
3793 |
(defun ps-face-bold-p (face) |
(defun ps-face-bold-p (face) |
3794 |
(or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold") |
(or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold") |
3795 |
(memq face ps-bold-faces))) ; Kludge-compatible |
(memq face ps-bold-faces))) ; Kludge-compatible |
3815 |
|
|
3816 |
|
|
3817 |
(defun ps-prologue-file (filenumber) |
(defun ps-prologue-file (filenumber) |
3818 |
"If prologue FILENUMBER exists and is readable, returns contents as string. |
"If prologue FILENUMBER exists and is readable, return contents as string. |
3819 |
|
|
3820 |
Note: No major/minor-mode is activated and no local variables are evaluated for |
Note: No major/minor-mode is activated and no local variables are evaluated for |
3821 |
FILENUMBER, but proper EOL-conversion and character interpretation is |
FILENUMBER, but proper EOL-conversion and character interpretation is |
3871 |
|
|
3872 |
(defvar ps-current-font 0) |
(defvar ps-current-font 0) |
3873 |
(defvar ps-default-foreground nil) |
(defvar ps-default-foreground nil) |
3874 |
|
(defvar ps-default-background nil) |
3875 |
(defvar ps-default-color nil) |
(defvar ps-default-color nil) |
3876 |
(defvar ps-current-color nil) |
(defvar ps-current-color nil) |
3877 |
(defvar ps-current-bg nil) |
(defvar ps-current-bg nil) |
3888 |
;; PostScript output. |
;; PostScript output. |
3889 |
"%0.3f %0.3f %0.3f" |
"%0.3f %0.3f %0.3f" |
3890 |
|
|
3891 |
;; Lucid emacsen will have to make do with %s (princ) for floats. |
;; XEmacs will have to make do with %s (princ) for floats. |
3892 |
"%s %s %s")) |
"%s %s %s")) |
3893 |
|
|
3894 |
;; These values determine how much print-height to deduct when headers/footers |
;; These values determine how much print-height to deduct when headers/footers |
3932 |
(defvar ps-black-white-faces-alist nil |
(defvar ps-black-white-faces-alist nil |
3933 |
"Alist of symbolic faces used for black/white PostScript printers. |
"Alist of symbolic faces used for black/white PostScript printers. |
3934 |
An element of this list has the same form as `ps-print-face-extension-alist' |
An element of this list has the same form as `ps-print-face-extension-alist' |
3935 |
(which see). |
\(which see). |
3936 |
|
|
3937 |
Don't change this list directly; instead, |
Don't change this list directly; instead, |
3938 |
use `ps-extend-face' and `ps-extend-face-list'. |
use `ps-extend-face' and `ps-extend-face-list'. |
4227 |
(get font-sym 'avg-char-width)) |
(get font-sym 'avg-char-width)) |
4228 |
|
|
4229 |
(defun ps-line-lengths-internal () |
(defun ps-line-lengths-internal () |
4230 |
"Display the correspondence between a line length and a font size, |
"Display the correspondence between a line length and a font size. |
4231 |
using the current ps-print setup. |
Done using the current ps-print setup. |
4232 |
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" |
Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head" |
4233 |
(let* ((ps-font-size-internal |
(let* ((ps-font-size-internal |
4234 |
(or ps-font-size-internal |
(or ps-font-size-internal |
4497 |
|
|
4498 |
|
|
4499 |
(defun ps-print-preprint-region (prefix-arg) |
(defun ps-print-preprint-region (prefix-arg) |
4500 |
(or mark-active |
(or (ps-mark-active-p) |
4501 |
(error "The mark is not set now")) |
(error "The mark is not set now")) |
4502 |
(list (point) (mark) (ps-print-preprint prefix-arg))) |
(list (point) (mark) (ps-print-preprint prefix-arg))) |
4503 |
|
|
4573 |
(while (progn (skip-chars-forward " -'*-[]-~") (not (eobp))) |
(while (progn (skip-chars-forward " -'*-[]-~") (not (eobp))) |
4574 |
(let ((special (following-char))) |
(let ((special (following-char))) |
4575 |
(delete-char 1) |
(delete-char 1) |
4576 |
(insert (aref ps-string-escape-codes special)))) |
(insert |
4577 |
|
(if (and (<= 0 special) (<= special 255)) |
4578 |
|
(aref ps-string-escape-codes special) |
4579 |
|
;; insert hexadecimal representation if character code is out of range |
4580 |
|
(format "\\%04X" special) |
4581 |
|
)))) |
4582 |
(goto-char (point-max)) |
(goto-char (point-max)) |
4583 |
(insert ")")) ;insert end-string delimiter |
(insert ")")) ;insert end-string delimiter |
4584 |
|
|
4754 |
|
|
4755 |
;; Emacs understands the %f format; we'll use it to limit color RGB values |
;; Emacs understands the %f format; we'll use it to limit color RGB values |
4756 |
;; to three decimals to cut down some on the size of the PostScript output. |
;; to three decimals to cut down some on the size of the PostScript output. |
4757 |
;; Lucid emacsen will have to make do with %s (princ) for floats. |
;; XEmacs will have to make do with %s (princ) for floats. |
4758 |
|
|
4759 |
(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs) |
(defvar ps-float-format (if (eq ps-print-emacs-type 'emacs) |
4760 |
"%0.3f " ; emacs |
"%0.3f " ; emacs |
4761 |
"%s ")) ; Lucid emacsen |
"%s ")) ; xemacs |
4762 |
|
|
4763 |
|
|
4764 |
(defun ps-float-format (value &optional default) |
(defun ps-float-format (value &optional default) |
5440 |
"/ZebraColor " |
"/ZebraColor " |
5441 |
(ps-format-color ps-zebra-color 0.95) |
(ps-format-color ps-zebra-color 0.95) |
5442 |
"def\n/BackgroundColor " |
"def\n/BackgroundColor " |
5443 |
(ps-format-color ps-default-bg 1.0) |
(ps-format-color ps-default-background 1.0) |
5444 |
"def\n/UseSetpagedevice " |
"def\n/UseSetpagedevice " |
5445 |
(if (eq ps-spool-config 'setpagedevice) |
(if (eq ps-spool-config 'setpagedevice) |
5446 |
"/setpagedevice where{pop languagelevel 2 eq}{false}ifelse" |
"/setpagedevice where{pop languagelevel 2 eq}{false}ifelse" |
5624 |
(ps-get-size (symbol-value font-sym) "font size" font-sym)) |
(ps-get-size (symbol-value font-sym) "font size" font-sym)) |
5625 |
|
|
5626 |
|
|
5627 |
(defsubst ps-rgb-color (color default) |
(defun ps-rgb-color (color default) |
5628 |
(cond ((and color (listp color)) color) |
(cond ((and color (listp color) (= (length color) 3) |
5629 |
|
(let ((cl color) |
5630 |
|
(ok t) e) |
5631 |
|
(while (and ok cl) |
5632 |
|
(setq e (car cl) |
5633 |
|
cl (cdr cl) |
5634 |
|
ok (and (floatp e) (<= 0.0 e) (<= e 1.0)))) |
5635 |
|
ok)) |
5636 |
|
color) |
5637 |
|
((and (floatp color) (<= 0.0 color) (<= color 1.0)) |
5638 |
|
(list color color color)) |
5639 |
((stringp color) (ps-color-scale color)) |
((stringp color) (ps-color-scale color)) |
|
((numberp color) (list color color color)) |
|
5640 |
(t (list default default default)) |
(t (list default default default)) |
5641 |
)) |
)) |
5642 |
|
|
5710 |
((eq ps-print-control-characters 'control) |
((eq ps-print-control-characters 'control) |
5711 |
"[\000-\037\177]") |
"[\000-\037\177]") |
5712 |
(t "[\t\n\f]")) |
(t "[\t\n\f]")) |
5713 |
ps-default-foreground (ps-rgb-color ps-default-fg 0.0) |
ps-default-background (ps-rgb-color |
5714 |
|
(if (eq ps-default-bg t) |
5715 |
|
(ps-face-background-name 'default) |
5716 |
|
ps-default-bg) |
5717 |
|
1.0) |
5718 |
|
ps-default-foreground (ps-rgb-color |
5719 |
|
(if (eq ps-default-fg t) |
5720 |
|
(ps-face-foreground-name 'default) |
5721 |
|
ps-default-fg) |
5722 |
|
0.0) |
5723 |
ps-default-color (and (eq ps-print-color-p t) ps-default-foreground) |
ps-default-color (and (eq ps-print-color-p t) ps-default-foreground) |
5724 |
ps-current-color ps-default-color |
ps-current-color ps-default-color |
5725 |
;; Set the color scale. We do it here instead of in the defvar so |
;; Set the color scale. We do it here instead of in the defvar so |
5730 |
(float (car (ps-color-values "white"))) |
(float (car (ps-color-values "white"))) |
5731 |
1.0)) |
1.0)) |
5732 |
;; initialize page dimensions |
;; initialize page dimensions |
5733 |
(ps-get-page-dimensions)) |
(ps-get-page-dimensions) |
5734 |
|
;; final check |
5735 |
|
(and ps-color-p |
5736 |
|
(equal ps-default-background ps-default-foreground) |
5737 |
|
(error |
5738 |
|
(concat |
5739 |
|
"`ps-default-fg' and `ps-default-bg' have the same color.\n" |
5740 |
|
"Text won't appear on page. Please, check these variables.")))) |
5741 |
|
|
5742 |
|
|
5743 |
(defun ps-page-number () |
(defun ps-page-number () |
6273 |
(let ((face 'default) |
(let ((face 'default) |
6274 |
(position to)) |
(position to)) |
6275 |
(cond |
(cond |
6276 |
((memq ps-print-emacs-type '(xemacs lucid)) |
((eq ps-print-emacs-type 'xemacs) |
6277 |
;; Build the list of extents... |
;; Build the list of extents... |
6278 |
(let ((a (cons 'dummy nil)) |
(let ((a (cons 'dummy nil)) |
6279 |
record type extent extent-list) |
record type extent extent-list) |