Mercurial > emacs
annotate lisp/ps-print.el @ 15817:9e94b5fdaab1
(comint-file-name-chars): Was comint-file-name-regexp.
Give it a non-nil default value.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Thu, 01 Aug 1996 22:34:09 +0000 |
parents | 05c14d5cce5c |
children | e331a0dbe000 |
rev | line source |
---|---|
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1 ;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2 |
14734 | 3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. |
7257 | 4 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
5 ;; Author: Jim Thompson <thompson@wg2.waii.com> |
15754 | 6 ;; Maintainer: duthen@cegelec-red.fr (Jacques Duthen Prestataire) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
7 ;; Keywords: print, PostScript |
7257 | 8 |
10493 | 9 ;; This file is part of GNU Emacs. |
7257 | 10 |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
13 ;; the Free Software Foundation; either version 2, or (at your option) | |
14 ;; any later version. | |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
14169 | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
7257 | 25 |
10683 | 26 ;; LCD Archive Entry: |
27 ;; ps-print|James C. Thompson|thompson@wg2.waii.com| | |
28 ;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)| | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
29 ;; 26-Feb-1994|2.8|~/packages/ps-print.el| |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
30 |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
31 ;; Baseline-version: 2.8. (Jim's last change version -- this |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
32 ;; file may have been edited as part of Emacs without changes to the |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
33 ;; version number. When reporting bugs, please also report the |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
34 ;; version of Emacs, if any, that ps-print was distributed with.) |
10683 | 35 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
36 ;;; Commentary: |
7257 | 37 |
38 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
39 ;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
40 ;; About ps-print |
7257 | 41 ;; -------------- |
42 ;; This package provides printing of Emacs buffers on PostScript | |
43 ;; printers; the buffer's bold and italic text attributes are | |
44 ;; preserved in the printer output. Ps-print is intended for use with | |
10683 | 45 ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as |
46 ;; font-lock or hilit. | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
47 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
48 ;; Using ps-print |
7257 | 49 ;; -------------- |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
50 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
51 ;; The Commands |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
52 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
53 ;; Ps-print provides eight commands for generating PostScript images |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
54 ;; of Emacs buffers: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
55 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
56 ;; ps-print-buffer |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
57 ;; ps-print-buffer-with-faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
58 ;; ps-print-region |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
59 ;; ps-print-region-with-faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
60 ;; ps-spool-buffer |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
61 ;; ps-spool-buffer-with-faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
62 ;; ps-spool-region |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
63 ;; ps-spool-region-with-faces |
7257 | 64 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
65 ;; These commands all perform essentially the same function: they |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
66 ;; generate PostScript images suitable for printing on a PostScript |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
67 ;; printer or displaying with GhostScript. These commands are |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
68 ;; collectively referred to as "ps-print- commands". |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
69 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
70 ;; The word "print" or "spool" in the command name determines when the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
71 ;; PostScript image is sent to the printer: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
72 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
73 ;; print - The PostScript image is immediately sent to the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
74 ;; printer; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
75 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
76 ;; spool - The PostScript image is saved temporarily in an |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
77 ;; Emacs buffer. Many images may be spooled locally |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
78 ;; before printing them. To send the spooled images |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
79 ;; to the printer, use the command ps-despool. |
7257 | 80 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
81 ;; The spooling mechanism was designed for printing lots of small |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
82 ;; files (mail messages or netnews articles) to save paper that would |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
83 ;; otherwise be wasted on banner pages, and to make it easier to find |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
84 ;; your output at the printer (it's easier to pick up one 50-page |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
85 ;; printout than to find 50 single-page printouts). |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
86 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
87 ;; Ps-print has a hook in the kill-emacs-hooks so that you won't |
14040 | 88 ;; accidentally quit from Emacs while you have unprinted PostScript |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
89 ;; waiting in the spool buffer. If you do attempt to exit with |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
90 ;; spooled PostScript, you'll be asked if you want to print it, and if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
91 ;; you decline, you'll be asked to confirm the exit; this is modeled |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
92 ;; on the confirmation that Emacs uses for modified buffers. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
93 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
94 ;; The word "buffer" or "region" in the command name determines how |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
95 ;; much of the buffer is printed: |
7257 | 96 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
97 ;; buffer - Print the entire buffer. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
98 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
99 ;; region - Print just the current region. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
100 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
101 ;; The -with-faces suffix on the command name means that the command |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
102 ;; will include font, color, and underline information in the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
103 ;; PostScript image, so the printed image can look as pretty as the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
104 ;; buffer. The ps-print- commands without the -with-faces suffix |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
105 ;; don't include font, color, or underline information; images printed |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
106 ;; with these commands aren't as pretty, but are faster to generate. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
107 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
108 ;; Two ps-print- command examples: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
109 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
110 ;; ps-print-buffer - print the entire buffer, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
111 ;; without font, color, or |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
112 ;; underline information, and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
113 ;; send it immediately to the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
114 ;; printer. |
7257 | 115 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
116 ;; ps-spool-region-with-faces - print just the current region; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
117 ;; include font, color, and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
118 ;; underline information, and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
119 ;; spool the image in Emacs to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
120 ;; send to the printer later. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
121 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
122 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
123 ;; Invoking Ps-Print |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
124 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
125 ;; To print your buffer, type |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
126 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
127 ;; M-x ps-print-buffer |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
128 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
129 ;; or substitute one of the other seven ps-print- commands. The |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
130 ;; command will generate the PostScript image and print or spool it as |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
131 ;; specified. By giving the command a prefix argument |
7257 | 132 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
133 ;; C-u M-x ps-print-buffer |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
134 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
135 ;; it will save the PostScript image to a file instead of sending it |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
136 ;; to the printer; you will be prompted for the name of the file to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
137 ;; save the image to. The prefix argument is ignored by the commands |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
138 ;; that spool their images, but you may save the spooled images to a |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
139 ;; file by giving a prefix argument to ps-despool: |
7257 | 140 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
141 ;; C-u M-x ps-despool |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
142 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
143 ;; When invoked this way, ps-despool will prompt you for the name of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
144 ;; the file to save to. |
7257 | 145 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
146 ;; Any of the ps-print- commands can be bound to keys; I recommend |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
147 ;; binding ps-spool-buffer-with-faces, ps-spool-region-with-faces, and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
148 ;; ps-despool. Here are the bindings I use on my Sun 4 keyboard: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
149 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
150 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc |
7257 | 151 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces) |
152 ;; (global-set-key '(control f22) 'ps-despool) | |
153 ;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
154 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
155 ;; The Printer Interface |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
156 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
157 ;; The variables ps-lpr-command and ps-lpr-switches determine what |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
158 ;; command is used to send the PostScript images to the printer, and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
159 ;; what arguments to give the command. These are analogous to lpr- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
160 ;; command and lpr-switches. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
161 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
162 ;; NOTE: ps-lpr-command and ps-lpr-switches take their initial values |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
163 ;; from the variables lpr-command and lpr-switches. If you have |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
164 ;; lpr-command set to invoke a pretty-printer such as enscript, |
10683 | 165 ;; then ps-print won't work properly. ps-lpr-command must name |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
166 ;; a program that does not format the files it prints. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
167 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
168 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
169 ;; How Ps-Print Deals With Fonts |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
170 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
171 ;; The ps-print-*-with-faces commands attempt to determine which faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
172 ;; should be printed in bold or italic, but their guesses aren't |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
173 ;; always right. For example, you might want to map colors into faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
174 ;; so that blue faces print in bold, and red faces in italic. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
175 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
176 ;; It is possible to force ps-print to consider specific faces bold or |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
177 ;; italic, no matter what font they are displayed in, by setting the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
178 ;; variables ps-bold-faces and ps-italic-faces. These variables |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
179 ;; contain lists of faces that ps-print should consider bold or |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
180 ;; italic; to set them, put code like the following into your .emacs |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
181 ;; file: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
182 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
183 ;; (setq ps-bold-faces '(my-blue-face)) |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
184 ;; (setq ps-italic-faces '(my-red-face)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
185 ;; |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
186 ;; Faces like bold-italic that are both bold and italic should go in |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
187 ;; *both* lists. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
188 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
189 ;; Ps-print does not attempt to guess the sizes of fonts; all text is |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
190 ;; rendered using the Courier font family, in 10 point size. To |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
191 ;; change the font family, change the variables ps-font, ps-font-bold, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
192 ;; ps-font-italic, and ps-font-bold-italic; fixed-pitch fonts work |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
193 ;; best, but are not required. To change the font size, change the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
194 ;; variable ps-font-size. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
195 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
196 ;; If you change the font family or size, you MUST also change the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
197 ;; variables ps-line-height, ps-avg-char-width, and ps-space-width, or |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
198 ;; ps-print cannot correctly place line and page breaks. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
199 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
200 ;; Ps-print keeps internal lists of which fonts are bold and which are |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
201 ;; italic; these lists are built the first time you invoke ps-print. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
202 ;; For the sake of efficiency, the lists are built only once; the same |
14040 | 203 ;; lists are referred in later invocations of ps-print. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
204 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
205 ;; Because these lists are built only once, it's possible for them to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
206 ;; get out of sync, if a face changes, or if new faces are added. To |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
207 ;; get the lists back in sync, you can set the variable |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
208 ;; ps-build-face-reference to t, and the lists will be rebuilt the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
209 ;; next time ps-print is invoked. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
210 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
211 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
212 ;; How Ps-Print Deals With Color |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
213 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
214 ;; Ps-print detects faces with foreground and background colors |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
215 ;; defined and embeds color information in the PostScript image. The |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
216 ;; default foreground and background colors are defined by the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
217 ;; variables ps-default-fg and ps-default-bg. On black-and-white |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
218 ;; printers, colors are displayed in grayscale. To turn off color |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
219 ;; output, set ps-print-color-p to nil. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
220 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
221 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
222 ;; Headers |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
223 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
224 ;; Ps-print can print headers at the top of each page; the default |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
225 ;; headers contain the following four items: on the left, the name of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
226 ;; the buffer and, if the buffer is visiting a file, the file's |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
227 ;; directory; on the right, the page number and date of printing. The |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
228 ;; default headers look something like this: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
229 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
230 ;; ps-print.el 1/21 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
231 ;; /home/jct/emacs-lisp/ps/new 94/12/31 |
7257 | 232 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
233 ;; When printing on duplex printers, left and right are reversed so |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
234 ;; that the page numbers are toward the outside. |
7257 | 235 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
236 ;; Headers are configurable. To turn them off completely, set |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
237 ;; ps-print-header to nil. To turn off the header's gaudy framing |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
238 ;; box, set ps-print-header-frame to nil. Page numbers are printed in |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
239 ;; "n/m" format, indicating page n of m pages; to omit the total page |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
240 ;; count and just print the page number, set ps-show-n-of-n to nil. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
241 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
242 ;; The amount of information in the header can be changed by changing |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
243 ;; the number of lines. To show less, set ps-header-lines to 1, and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
244 ;; the header will show only the buffer name and page number. To show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
245 ;; more, set ps-header-lines to 3, and the header will show the time of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
246 ;; printing below the date. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
247 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
248 ;; To change the content of the headers, change the variables |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
249 ;; ps-left-header and ps-right-header. These variables are lists, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
250 ;; specifying top-to-bottom the text to display on the left or right |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
251 ;; side of the header. Each element of the list should be a string or |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
252 ;; a symbol. Strings are inserted directly into the PostScript |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
253 ;; arrays, and should contain the PostScript string delimiters '(' and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
254 ;; ')'. |
7257 | 255 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
256 ;; Symbols in the header format lists can either represent functions |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
257 ;; or variables. Functions are called, and should return a string to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
258 ;; show in the header. Variables should contain strings to display in |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
259 ;; the header. In either case, function or variable, the PostScript |
14040 | 260 ;; string delimiters are added by ps-print, and should not be part of |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
261 ;; the returned value. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
262 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
263 ;; Here's an example: say we want the left header to display the text |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
264 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
265 ;; Moe |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
266 ;; Larry |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
267 ;; Curly |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
268 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
269 ;; where we have a function to return "Moe" |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
270 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
271 ;; (defun moe-func () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
272 ;; "Moe") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
273 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
274 ;; a variable specifying "Larry" |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
275 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
276 ;; (setq larry-var "Larry") |
7257 | 277 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
278 ;; and a literal for "Curly". Here's how ps-left-header should be |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
279 ;; set: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
280 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
281 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)")) |
7257 | 282 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
283 ;; Note that Curly has the PostScript string delimiters inside his |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
284 ;; quotes -- those aren't misplaced lisp delimiters! Without them, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
285 ;; PostScript would attempt to call the undefined function Curly, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
286 ;; which would result in a PostScript error. Since most printers |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
287 ;; don't report PostScript errors except by aborting the print job, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
288 ;; this kind of error can be hard to track down. Consider yourself |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
289 ;; warned. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
290 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
291 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
292 ;; Duplex Printers |
7257 | 293 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
294 ;; If you have a duplex-capable printer (one that prints both sides of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
295 ;; the paper), set ps-spool-duplex to t. Ps-print will insert blank |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
296 ;; pages to make sure each buffer starts on the correct side of the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
297 ;; paper. Don't forget to set ps-lpr-switches to select duplex |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
298 ;; printing for your printer. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
299 ;; |
7257 | 300 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
301 ;; Paper Size |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
302 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
303 ;; The variable ps-paper-type determines the size of paper ps-print |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
304 ;; formats for; it should contain one of the symbols ps-letter, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
305 ;; ps-legal, or ps-a4. The default is ps-letter. |
7257 | 306 ;; |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
307 ;; |
13807 | 308 ;; Make sure that the variables ps-lpr-command and ps-lpr-switches |
309 ;; contain appropriate values for your system; see the usage notes | |
310 ;; below and the documentation of these variables. | |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
311 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
312 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
313 ;; New since version 1.5 |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
314 ;; --------------------- |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
315 ;; Color output capability. |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
316 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
317 ;; Automatic detection of font attributes (bold, italic). |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
318 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
319 ;; Configurable headers with page numbers. |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
320 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
321 ;; Slightly faster. |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
322 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
323 ;; Support for different paper sizes. |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
324 ;; |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
325 ;; Better conformance to PostScript Document Structure Conventions. |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
326 ;; |
7257 | 327 ;; |
328 ;; Known bugs and limitations of ps-print: | |
329 ;; -------------------------------------- | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
330 ;; Although color printing will work in XEmacs 19.12, it doesn't work |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
331 ;; well; in particular, bold or italic fonts don't print in the right |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
332 ;; background color. |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
333 ;; |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
334 ;; Invisible properties aren't correctly ignored in XEmacs 19.12. |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
335 ;; |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
336 ;; Automatic font-attribute detection doesn't work well, especially |
10683 | 337 ;; with hilit19 and older versions of get-create-face. Users having |
338 ;; problems with auto-font detection should use the lists ps-italic- | |
339 ;; faces and ps-bold-faces and/or turn off automatic detection by | |
340 ;; setting ps-auto-font-detect to nil. | |
341 ;; | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
342 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
343 ;; in tty mode; use the lists ps-italic-faces and ps-bold-faces |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
344 ;; instead. |
7257 | 345 ;; |
10683 | 346 ;; Still too slow; could use some hand-optimization. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
347 ;; |
7257 | 348 ;; ASCII Control characters other than tab, linefeed and pagefeed are |
349 ;; not handled. | |
350 ;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
351 ;; Default background color isn't working. |
7257 | 352 ;; |
353 ;; Faces are always treated as opaque. | |
354 ;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
355 ;; Epoch and Emacs 18 not supported. At all. |
7257 | 356 ;; |
357 ;; | |
358 ;; Features to add: | |
359 ;; --------------- | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
360 ;; 2-up and 4-up capability. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
361 ;; |
7257 | 362 ;; Line numbers. |
363 ;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
364 ;; Wide-print (landscape) capability. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
365 ;; |
7257 | 366 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
367 ;; Acknowledgements |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
368 ;; ---------------- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
369 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
370 ;; color and the invisible property. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
371 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
372 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
373 ;; the initial port to Emacs 19. His code is no longer part of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
374 ;; ps-print, but his work is still appreciated. |
7257 | 375 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
376 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
377 ;; for adding underline support. Their code also is no longer part of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
378 ;; ps-print, but their efforts are not forgotten. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
379 ;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
380 ;; Thanks also to all of you who mailed code to add features to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
381 ;; ps-print; although I didn't use your code, I still appreciate your |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
382 ;; sharing it with me. |
7257 | 383 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
384 ;; Thanks to all who mailed comments, encouragement, and criticism. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
385 ;; Thanks also to all who responded to my survey; I had too many |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
386 ;; responses to reply to them all, but I greatly appreciate your |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
387 ;; interest. |
7257 | 388 ;; |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
389 ;; Jim |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
7257 | 391 |
392 ;;; Code: | |
393 | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
394 (defconst ps-print-version "2.8" |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
395 "ps-print.el,v 2.8 1995/05/04 12:06:10 jct Exp |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
396 |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
397 Jim's last change version -- this file may have been edited as part of |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
398 Emacs without changes to the version number. When reporting bugs, |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
399 please also report the version of Emacs, if any, that ps-print was |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
400 distributed with. |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
401 |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
402 Please send all bug fixes and enhancements to |
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
403 Jim Thompson <thompson@wg2.waii.com>.") |
7257 | 404 |
405 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
406 ;; User Variables: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
407 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
408 (defvar ps-lpr-command lpr-command |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
409 "*The shell command for printing a PostScript file.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
410 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
411 (defvar ps-lpr-switches lpr-switches |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
412 "*A list of extra switches to pass to `ps-lpr-command'.") |
7257 | 413 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
414 (defvar ps-spool-duplex nil ; Not many people have duplex |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
415 ; printers, so default to nil. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
416 "*Non-nil indicates spooling is for a two-sided printer. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
417 For a duplex printer, the `ps-spool-*' commands will insert blank pages |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
418 as needed between print jobs so that the next buffer printed will |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
419 start on the right page. Also, if headers are turned on, the headers |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
420 will be reversed on duplex printers so that the page numbers fall to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
421 the left on even-numbered pages.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
422 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
423 (defvar ps-paper-type 'ps-letter |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
424 "*Specifies the size of paper to format for. Should be one of |
10683 | 425 `ps-letter', `ps-legal', or `ps-a4'.") |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
426 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
427 (defvar ps-print-header t |
10493 | 428 "*Non-nil means print a header at the top of each page. |
429 By default, the header displays the buffer name, page number, and, if | |
430 the buffer is visiting a file, the file's directory. Headers are | |
431 customizable by changing variables `ps-header-left' and | |
432 `ps-header-right'.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
433 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
434 (defvar ps-print-header-frame t |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
435 "*Non-nil means draw a gaudy frame around the header.") |
7257 | 436 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
437 (defvar ps-show-n-of-n t |
10683 | 438 "*Non-nil means show page numbers as N/M, meaning page N of M. |
439 Note: page numbers are displayed as part of headers, see variable | |
440 `ps-print-headers'.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
441 |
12768
68b1359ecd66
Renamed `fsf' to `emacs' in all names.
Richard M. Stallman <rms@gnu.org>
parents:
11799
diff
changeset
|
442 (defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; Emacs |
68b1359ecd66
Renamed `fsf' to `emacs' in all names.
Richard M. Stallman <rms@gnu.org>
parents:
11799
diff
changeset
|
443 (fboundp 'pixel-components)) ; XEmacs |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
444 (fboundp 'float)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
445 ; Printing color requires both floating point and x-color-values. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
446 "*If non-nil, print the buffer's text in color.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
447 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
448 (defvar ps-default-fg '(0.0 0.0 0.0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
449 "*RGB values of the default foreground color. Defaults to black.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
450 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
451 (defvar ps-default-bg '(1.0 1.0 1.0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
452 "*RGB values of the default background color. Defaults to white.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
453 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
454 (defvar ps-font-size 10 |
10493 | 455 "*Font size, in points, for generating Postscript.") |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
456 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
457 (defvar ps-font "Courier" |
10493 | 458 "*Font family name for ordinary text, when generating Postscript.") |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
459 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
460 (defvar ps-font-bold "Courier-Bold" |
10493 | 461 "*Font family name for bold text, when generating Postscript.") |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
462 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
463 (defvar ps-font-italic "Courier-Oblique" |
10493 | 464 "*Font family name for italic text, when generating Postscript.") |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
465 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
466 (defvar ps-font-bold-italic "Courier-BoldOblique" |
10493 | 467 "*Font family name for bold italic text, when generating Postscript.") |
7257 | 468 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
469 (defvar ps-avg-char-width (if (fboundp 'float) 5.6 6) |
10493 | 470 "*The average width, in points, of a character, for generating Postscript. |
471 This is the value that ps-print uses to determine the length, | |
472 x-dimension, of the text it has printed, and thus affects the point at | |
473 which long lines wrap around. If you change the font or | |
474 font size, you will probably have to adjust this value to match.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
475 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
476 (defvar ps-space-width (if (fboundp 'float) 5.6 6) |
10493 | 477 "*The width of a space character, for generating Postscript. |
478 This value is used in expanding tab characters.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
479 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
480 (defvar ps-line-height (if (fboundp 'float) 11.29 11) |
10493 | 481 "*The height of a line, for generating Postscript. |
482 This is the value that ps-print uses to determine the height, | |
483 y-dimension, of the lines of text it has printed, and thus affects the | |
484 point at which page-breaks are placed. If you change the font or font | |
485 size, you will probably have to adjust this value to match. The | |
486 line-height is *not* the same as the point size of the font.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
487 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
488 (defvar ps-auto-font-detect t |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
489 "*Non-nil means automatically detect bold/italic face attributes. |
10493 | 490 nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
491 and `ps-underlined-faces'.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
492 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
493 (defvar ps-bold-faces '() |
10493 | 494 "*A list of the \(non-bold\) faces that should be printed in bold font. |
495 This applies to generating Postscript.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
496 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
497 (defvar ps-italic-faces '() |
10493 | 498 "*A list of the \(non-italic\) faces that should be printed in italic font. |
499 This applies to generating Postscript.") | |
7257 | 500 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
501 (defvar ps-underlined-faces '() |
10493 | 502 "*A list of the \(non-underlined\) faces that should be printed underlined. |
503 This applies to generating Postscript.") | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
504 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
505 (defvar ps-header-lines 2 |
10493 | 506 "*Number of lines to display in page header, when generating Postscript.") |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
507 (make-variable-buffer-local 'ps-header-lines) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
508 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
509 (defvar ps-left-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
510 (list 'ps-get-buffer-name 'ps-header-dirpart) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
511 "*The items to display on the right part of the page header. |
10493 | 512 This applies to generating Postscript. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
513 |
10493 | 514 The value should be a list of strings and symbols, each representing an |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
515 entry in the PostScript array HeaderLinesLeft. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
516 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
517 Strings are inserted unchanged into the array; those representing |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
518 PostScript string literals should be delimited with PostScript string |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
519 delimiters '(' and ')'. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
520 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
521 For symbols with bound functions, the function is called and should |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
522 return a string to be inserted into the array. For symbols with bound |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
523 values, the value should be a string to be inserted into the array. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
524 In either case, function or variable, the string value has PostScript |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
525 string delimiters added to it.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
526 (make-variable-buffer-local 'ps-left-header) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
527 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
528 (defvar ps-right-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
529 (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
530 "*The items to display on the left part of the page header. |
10493 | 531 This applies to generating Postscript. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
532 |
10493 | 533 See the variable `ps-left-header' for a description of the format of |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
534 this variable.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
535 (make-variable-buffer-local 'ps-right-header) |
7257 | 536 |
537 (defvar ps-razzle-dazzle t | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
538 "*Non-nil means report progress while formatting buffer.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
539 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
540 (defvar ps-adobe-tag "%!PS-Adobe-1.0\n" |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
541 "*Contains the header line identifying the output as PostScript. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
542 By default, `ps-adobe-tag' contains the standard identifier. Some |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
543 printers require slightly different versions of this line.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
544 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
545 (defvar ps-build-face-reference t |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
546 "*Non-nil means build the reference face lists. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
547 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
548 Ps-print sets this value to nil after it builds its internal reference |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
549 lists of bold and italic faces. By settings its value back to t, you |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
550 can force ps-print to rebuild the lists the next time you invoke one |
10493 | 551 of the ...-with-faces commands. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
552 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
553 You should set this value back to t after you change the attributes of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
554 any face, or create new faces. Most users shouldn't have to worry |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
555 about its setting, though.") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
556 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
557 (defvar ps-always-build-face-reference nil |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
558 "*Non-nil means always rebuild the reference face lists. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
559 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
560 If this variable is non-nil, ps-print will rebuild its internal |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
561 reference lists of bold and italic faces *every* time one of the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
562 -with-faces commands is called. Most users shouldn't need to set this |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
563 variable.") |
7257 | 564 |
565 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
566 ;; User commands |
7257 | 567 |
10683 | 568 ;;;###autoload |
7257 | 569 (defun ps-print-buffer (&optional filename) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
570 "Generate and print a PostScript image of the buffer. |
7257 | 571 |
10493 | 572 When called with a numeric prefix argument (C-u), prompts the user for |
7257 | 573 the name of a file to save the PostScript image in, instead of sending |
574 it to the printer. | |
575 | |
576 More specifically, the FILENAME argument is treated as follows: if it | |
577 is nil, send the image to the printer. If FILENAME is a string, save | |
578 the PostScript image in a file with that name. If FILENAME is a | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
579 number, prompt the user for the name of the file to save in." |
7257 | 580 |
10683 | 581 (interactive (list (ps-print-preprint current-prefix-arg))) |
7257 | 582 (ps-generate (current-buffer) (point-min) (point-max) |
583 'ps-generate-postscript) | |
584 (ps-do-despool filename)) | |
585 | |
586 | |
10683 | 587 ;;;###autoload |
7257 | 588 (defun ps-print-buffer-with-faces (&optional filename) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
589 "Generate and print a PostScript image of the buffer. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
590 Like `ps-print-buffer', but includes font, color, and underline |
13807 | 591 information in the generated image. This command works only if you |
592 are using a window system, so it has a way to determine color values." | |
10683 | 593 (interactive (list (ps-print-preprint current-prefix-arg))) |
7257 | 594 (ps-generate (current-buffer) (point-min) (point-max) |
595 'ps-generate-postscript-with-faces) | |
596 (ps-do-despool filename)) | |
597 | |
598 | |
10683 | 599 ;;;###autoload |
7257 | 600 (defun ps-print-region (from to &optional filename) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
601 "Generate and print a PostScript image of the region. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
602 Like `ps-print-buffer', but prints just the current region." |
7257 | 603 |
10683 | 604 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) |
7257 | 605 (ps-generate (current-buffer) from to |
606 'ps-generate-postscript) | |
607 (ps-do-despool filename)) | |
608 | |
609 | |
10683 | 610 ;;;###autoload |
7257 | 611 (defun ps-print-region-with-faces (from to &optional filename) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
612 "Generate and print a PostScript image of the region. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
613 Like `ps-print-region', but includes font, color, and underline |
13807 | 614 information in the generated image. This command works only if you |
615 are using a window system, so it has a way to determine color values." | |
7257 | 616 |
10683 | 617 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg))) |
7257 | 618 (ps-generate (current-buffer) from to |
619 'ps-generate-postscript-with-faces) | |
620 (ps-do-despool filename)) | |
621 | |
622 | |
10683 | 623 ;;;###autoload |
7257 | 624 (defun ps-spool-buffer () |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
625 "Generate and spool a PostScript image of the buffer. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
626 Like `ps-print-buffer' except that the PostScript image is saved in a |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
627 local buffer to be sent to the printer later. |
7257 | 628 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
629 Use the command `ps-despool' to send the spooled images to the printer." |
7257 | 630 (interactive) |
631 (ps-generate (current-buffer) (point-min) (point-max) | |
632 'ps-generate-postscript)) | |
633 | |
634 | |
10683 | 635 ;;;###autoload |
7257 | 636 (defun ps-spool-buffer-with-faces () |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
637 "Generate and spool a PostScript image of the buffer. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
638 Like `ps-spool-buffer', but includes font, color, and underline |
13807 | 639 information in the generated image. This command works only if you |
13828
612d7bd4b5d1
(ps-spool-buffer-with-faces): Fix typo in previous chg.
Richard M. Stallman <rms@gnu.org>
parents:
13807
diff
changeset
|
640 are using a window system, so it has a way to determine color values. |
7257 | 641 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
642 Use the command `ps-despool' to send the spooled images to the printer." |
7257 | 643 |
644 (interactive) | |
645 (ps-generate (current-buffer) (point-min) (point-max) | |
646 'ps-generate-postscript-with-faces)) | |
647 | |
648 | |
10683 | 649 ;;;###autoload |
7257 | 650 (defun ps-spool-region (from to) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
651 "Generate a PostScript image of the region and spool locally. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
652 Like `ps-spool-buffer', but spools just the current region. |
7257 | 653 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
654 Use the command `ps-despool' to send the spooled images to the printer." |
7257 | 655 (interactive "r") |
656 (ps-generate (current-buffer) from to | |
657 'ps-generate-postscript)) | |
658 | |
659 | |
10683 | 660 ;;;###autoload |
7257 | 661 (defun ps-spool-region-with-faces (from to) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
662 "Generate a PostScript image of the region and spool locally. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
663 Like `ps-spool-region', but includes font, color, and underline |
13807 | 664 information in the generated image. This command works only if you |
13828
612d7bd4b5d1
(ps-spool-buffer-with-faces): Fix typo in previous chg.
Richard M. Stallman <rms@gnu.org>
parents:
13807
diff
changeset
|
665 are using a window system, so it has a way to determine color values. |
7257 | 666 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
667 Use the command `ps-despool' to send the spooled images to the printer." |
7257 | 668 (interactive "r") |
669 (ps-generate (current-buffer) from to | |
670 'ps-generate-postscript-with-faces)) | |
671 | |
10683 | 672 ;;;###autoload |
7257 | 673 (defun ps-despool (&optional filename) |
674 "Send the spooled PostScript to the printer. | |
675 | |
676 When called with a numeric prefix argument (C-u), prompt the user for | |
677 the name of a file to save the spooled PostScript in, instead of sending | |
678 it to the printer. | |
679 | |
680 More specifically, the FILENAME argument is treated as follows: if it | |
681 is nil, send the image to the printer. If FILENAME is a string, save | |
682 the PostScript image in a file with that name. If FILENAME is a | |
683 number, prompt the user for the name of the file to save in." | |
10683 | 684 (interactive (list (ps-print-preprint current-prefix-arg))) |
685 (ps-do-despool filename)) | |
7257 | 686 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
687 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
688 ;; Utility functions and variables: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
689 |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
690 (defvar ps-print-emacs-type |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
691 (cond ((string-match "XEmacs" emacs-version) 'xemacs) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
692 ((string-match "Lucid" emacs-version) 'lucid) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
693 ((string-match "Epoch" emacs-version) 'epoch) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
694 (t 'emacs))) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
695 |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
696 (if (or (eq ps-print-emacs-type 'lucid) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
697 (eq ps-print-emacs-type 'xemacs)) |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
698 (if (< emacs-minor-version 12) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
699 (setq ps-print-color-p nil)) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
700 (require 'faces)) ; face-font, face-underline-p, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
701 ; x-font-regexp |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
702 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
703 (require 'time-stamp) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
704 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
705 (defvar ps-print-prologue "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
706 % If the ISOLatin1Encoding vector isn't known, define it. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
707 /ISOLatin1Encoding where { pop } { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
708 % Define the ISO Latin-1 encoding vector. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
709 % The first half is the same as the standard encoding, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
710 % except for minus instead of hyphen at code 055. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
711 /ISOLatin1Encoding |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
712 StandardEncoding 0 45 getinterval aload pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
713 /minus |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
714 StandardEncoding 46 82 getinterval aload pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
715 %*** NOTE: the following are missing in the Adobe documentation, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
716 %*** but appear in the displayed table: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
717 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
718 % \20x |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
719 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
720 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
721 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
722 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
723 % \24x |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
724 /space /exclamdown /cent /sterling |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
725 /currency /yen /brokenbar /section |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
726 /dieresis /copyright /ordfeminine /guillemotleft |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
727 /logicalnot /hyphen /registered /macron |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
728 /degree /plusminus /twosuperior /threesuperior |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
729 /acute /mu /paragraph /periodcentered |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
730 /cedilla /onesuperior /ordmasculine /guillemotright |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
731 /onequarter /onehalf /threequarters /questiondown |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
732 % \30x |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
733 /Agrave /Aacute /Acircumflex /Atilde |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
734 /Adieresis /Aring /AE /Ccedilla |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
735 /Egrave /Eacute /Ecircumflex /Edieresis |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
736 /Igrave /Iacute /Icircumflex /Idieresis |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
737 /Eth /Ntilde /Ograve /Oacute |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
738 /Ocircumflex /Otilde /Odieresis /multiply |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
739 /Oslash /Ugrave /Uacute /Ucircumflex |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
740 /Udieresis /Yacute /Thorn /germandbls |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
741 % \34x |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
742 /agrave /aacute /acircumflex /atilde |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
743 /adieresis /aring /ae /ccedilla |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
744 /egrave /eacute /ecircumflex /edieresis |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
745 /igrave /iacute /icircumflex /idieresis |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
746 /eth /ntilde /ograve /oacute |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
747 /ocircumflex /otilde /odieresis /divide |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
748 /oslash /ugrave /uacute /ucircumflex |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
749 /udieresis /yacute /thorn /ydieresis |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
750 256 packedarray def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
751 } ifelse |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
752 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
753 /reencodeFontISO { %def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
754 dup |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
755 length 5 add dict % Make a new font (a new dict |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
756 % the same size as the old |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
757 % one) with room for our new |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
758 % symbols. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
759 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
760 begin % Make the new font the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
761 % current dictionary. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
762 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
763 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
764 { 1 index /FID ne |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
765 { def } { pop pop } ifelse |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
766 } forall % Copy each of the symbols |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
767 % from the old dictionary to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
768 % the new except for the font |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
769 % ID. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
770 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
771 /Encoding ISOLatin1Encoding def % Override the encoding with |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
772 % the ISOLatin1 encoding. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
773 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
774 % Use the font's bounding box to determine the ascent, descent, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
775 % and overall height; don't forget that these values have to be |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
776 % transformed using the font's matrix. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
777 FontBBox |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
778 FontMatrix transform /Ascent exch def pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
779 FontMatrix transform /Descent exch def pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
780 /FontHeight Ascent Descent sub def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
781 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
782 % Define these in case they're not in the FontInfo (also, here |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
783 % they're easier to get to. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
784 /UnderlinePosition 1 def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
785 /UnderlineThickness 1 def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
786 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
787 % Get the underline position and thickness if they're defined. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
788 currentdict /FontInfo known { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
789 FontInfo |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
790 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
791 dup /UnderlinePosition known { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
792 dup /UnderlinePosition get |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
793 0 exch FontMatrix transform exch pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
794 /UnderlinePosition exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
795 } if |
7257 | 796 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
797 dup /UnderlineThickness known { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
798 /UnderlineThickness get |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
799 0 exch FontMatrix transform exch pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
800 /UnderlineThickness exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
801 } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
802 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
803 } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
804 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
805 currentdict % Leave the new font on the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
806 % stack |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
807 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
808 end % Stop using the font as the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
809 % current dictionary. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
810 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
811 definefont % Put the font into the font |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
812 % dictionary |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
813 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
814 pop % Discard the returned font. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
815 } bind def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
816 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
817 /Font { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
818 findfont exch scalefont reencodeFontISO |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
819 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
820 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
821 /F { % Font select |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
822 findfont |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
823 dup /Ascent get /Ascent exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
824 dup /Descent get /Descent exch def |
10683 | 825 dup /FontHeight get /FontHeight exch def |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
826 dup /UnderlinePosition get /UnderlinePosition exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
827 dup /UnderlineThickness get /UnderlineThickness exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
828 setfont |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
829 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
830 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
831 /FG /setrgbcolor load def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
832 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
833 /bg false def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
834 /BG { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
835 dup /bg exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
836 { mark 4 1 roll ] /bgcolor exch def } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
837 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
838 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
839 /dobackground { % width -- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
840 currentpoint |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
841 gsave |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
842 newpath |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
843 moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
844 0 Ascent rmoveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
845 dup 0 rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
846 0 Descent Ascent sub rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
847 neg 0 rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
848 closepath |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
849 bgcolor aload pop setrgbcolor |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
850 fill |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
851 grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
852 } def |
7257 | 853 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
854 /dobackgroundstring { % string -- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
855 stringwidth pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
856 dobackground |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
857 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
858 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
859 /dounderline { % fromx fromy -- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
860 currentpoint |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
861 gsave |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
862 UnderlineThickness setlinewidth |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
863 4 2 roll |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
864 UnderlinePosition add moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
865 UnderlinePosition add lineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
866 stroke |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
867 grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
868 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
869 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
870 /eolbg { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
871 currentpoint pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
872 PrintWidth LeftMargin add exch sub dobackground |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
873 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
874 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
875 /eolul { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
876 currentpoint exch pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
877 PrintWidth LeftMargin add exch dounderline |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
878 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
879 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
880 /SL { % Soft Linefeed |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
881 bg { eolbg } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
882 ul { eolul } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
883 currentpoint LineHeight sub LeftMargin exch moveto pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
884 } def |
7257 | 885 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
886 /HL /SL load def % Hard Linefeed |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
887 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
888 /sp1 { currentpoint 3 -1 roll } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
889 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
890 % Some debug |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
891 /dcp { currentpoint exch 40 string cvs print (, ) print = } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
892 /dp { print 2 copy |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
893 exch 40 string cvs print (, ) print = } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
894 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
895 /S { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
896 bg { dup dobackgroundstring } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
897 ul { sp1 } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
898 show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
899 ul { dounderline } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
900 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
901 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
902 /W { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
903 ul { sp1 } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
904 ( ) stringwidth % Get the width of a space |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
905 pop % Discard the Y component |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
906 mul % Multiply the width of a |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
907 % space by the number of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
908 % spaces to plot |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
909 bg { dup dobackground } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
910 0 rmoveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
911 ul { dounderline } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
912 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
913 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
914 /BeginDSCPage { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
915 /vmstate save def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
916 } def |
7257 | 917 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
918 /BeginPage { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
919 PrintHeader { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
920 PrintHeaderFrame { HeaderFrame } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
921 HeaderText |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
922 } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
923 LeftMargin |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
924 BottomMargin PrintHeight add |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
925 moveto % move to where printing will |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
926 % start. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
927 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
928 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
929 /EndPage { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
930 bg { eolbg } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
931 ul { eolul } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
932 showpage % Spit out a page |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
933 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
934 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
935 /EndDSCPage { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
936 vmstate restore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
937 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
938 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
939 /ul false def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
940 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
941 /UL { /ul exch def } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
942 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
943 /h0 14 /Helvetica-Bold Font |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
944 /h1 12 /Helvetica Font |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
945 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
946 /h1 F |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
947 |
10683 | 948 /HeaderLineHeight FontHeight def |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
949 /HeaderDescent Descent def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
950 /HeaderPad 2 def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
951 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
952 /SetHeaderLines { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
953 /HeaderOffset TopMargin 2 div def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
954 /HeaderLines exch def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
955 /HeaderHeight HeaderLines HeaderLineHeight mul HeaderPad 2 mul add def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
956 /PrintHeight PrintHeight HeaderHeight sub def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
957 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
958 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
959 /HeaderFrameStart { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
960 LeftMargin BottomMargin PrintHeight add HeaderOffset add |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
961 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
962 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
963 /HeaderFramePath { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
964 PrintWidth 0 rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
965 0 HeaderHeight rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
966 PrintWidth neg 0 rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
967 0 HeaderHeight neg rlineto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
968 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
969 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
970 /HeaderFrame { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
971 gsave |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
972 0.4 setlinewidth |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
973 HeaderFrameStart moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
974 1 -1 rmoveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
975 HeaderFramePath |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
976 0 setgray fill |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
977 HeaderFrameStart moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
978 HeaderFramePath |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
979 gsave 0.9 setgray fill grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
980 gsave 0 setgray stroke grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
981 grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
982 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
983 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
984 /HeaderStart { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
985 HeaderFrameStart |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
986 exch HeaderPad add exch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
987 HeaderLineHeight HeaderLines 1 sub mul add HeaderDescent sub HeaderPad add |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
988 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
989 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
990 /strcat { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
991 dup length 3 -1 roll dup length dup 4 -1 roll add string dup |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
992 0 5 -1 roll putinterval |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
993 dup 4 2 roll exch putinterval |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
994 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
995 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
996 /pagenumberstring { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
997 PageNumber 32 string cvs |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
998 ShowNofN { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
999 (/) strcat |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1000 PageCount 32 string cvs strcat |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1001 } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1002 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1003 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1004 /HeaderText { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1005 HeaderStart moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1006 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1007 HeaderLinesRight HeaderLinesLeft |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1008 Duplex PageNumber 1 and 0 eq and { exch } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1009 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1010 { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1011 aload pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1012 exch F |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1013 gsave |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1014 dup xcheck { exec } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1015 show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1016 grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1017 0 HeaderLineHeight neg rmoveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1018 } forall |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1019 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1020 HeaderStart moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1021 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1022 { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1023 aload pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1024 exch F |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1025 gsave |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1026 dup xcheck { exec } if |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1027 dup stringwidth pop |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1028 PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1029 show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1030 grestore |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1031 0 HeaderLineHeight neg rmoveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1032 } forall |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1033 } def |
7257 | 1034 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1035 /ReportFontInfo { |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1036 2 copy |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1037 /t0 3 1 roll Font |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1038 /t0 F |
10683 | 1039 /lh FontHeight def |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1040 /sw ( ) stringwidth pop def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1041 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1042 stringwidth pop exch div def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1043 /t1 12 /Helvetica-Oblique Font |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1044 /t1 F |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1045 72 72 moveto |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1046 gsave |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1047 (For ) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1048 128 string cvs show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1049 ( ) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1050 32 string cvs show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1051 ( point, the line height is ) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1052 lh 32 string cvs show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1053 (, the space width is ) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1054 sw 32 string cvs show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1055 (,) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1056 grestore |
10683 | 1057 0 FontHeight neg rmoveto |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1058 (and a crude estimate of average character width is ) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1059 aw 32 string cvs show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1060 (.) show |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1061 showpage |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1062 } def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1063 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1064 % 10 /Courier ReportFontInfo |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1065 ") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1066 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1067 ;; Start Editing Here: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1068 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1069 (defvar ps-source-buffer nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1070 (defvar ps-spool-buffer-name "*PostScript*") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1071 (defvar ps-spool-buffer nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1072 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1073 (defvar ps-output-head nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1074 (defvar ps-output-tail nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1075 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1076 (defvar ps-page-count 0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1077 (defvar ps-showpage-count 0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1078 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1079 (defvar ps-current-font 0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1080 (defvar ps-current-underline-p nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1081 (defvar ps-default-color (if ps-print-color-p ps-default-fg)) ; black |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1082 (defvar ps-current-color ps-default-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1083 (defvar ps-current-bg nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1084 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1085 (defvar ps-razchunk 0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1086 |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1087 (defvar ps-color-format (if (eq ps-print-emacs-type 'emacs) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1088 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1089 ;;Emacs understands the %f format; we'll |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1090 ;;use it to limit color RGB values to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1091 ;;three decimals to cut down some on the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1092 ;;size of the PostScript output. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1093 "%0.3f %0.3f %0.3f" |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1094 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1095 ;; Lucid emacsen will have to make do with |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1096 ;; %s (princ) for floats. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1097 "%s %s %s")) |
7257 | 1098 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1099 ;; These values determine how much print-height to deduct when headers |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1100 ;; are turned on. This is a pretty clumsy way of handling it, but |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1101 ;; it'll do for now. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1102 (defvar ps-header-title-line-height (if (fboundp 'float) 16.0 16));Helvetica 14 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1103 (defvar ps-header-line-height (if (fboundp 'float) 13.7 14));Helvetica 12 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1104 (defvar ps-header-pad 2) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1105 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1106 ;; LetterSmall 7.68 inch 10.16 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1107 ;; Tabloid 11.0 inch 17.0 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1108 ;; Ledger 17.0 inch 11.0 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1109 ;; Statement 5.5 inch 8.5 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1110 ;; Executive 7.5 inch 10.0 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1111 ;; A3 11.69 inch 16.5 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1112 ;; A4Small 7.47 inch 10.85 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1113 ;; B4 10.125 inch 14.33 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1114 ;; B5 7.16 inch 10.125 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1115 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1116 ;; All page dimensions are in PostScript points. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1117 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1118 (defvar ps-left-margin 72) ; 1 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1119 (defvar ps-right-margin 72) ; 1 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1120 (defvar ps-bottom-margin 36) ; 1/2 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1121 (defvar ps-top-margin 72) ; 1 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1122 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1123 ;; Letter 8.5 inch x 11.0 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1124 (defvar ps-letter-page-height 792) ; 11 inches |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1125 (defvar ps-letter-page-width 612) ; 8.5 inches |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1126 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1127 ;; Legal 8.5 inch x 14.0 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1128 (defvar ps-legal-page-height 1008) ; 14.0 inches |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1129 (defvar ps-legal-page-width 612) ; 8.5 inches |
7257 | 1130 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1131 ;; A4 8.26 inch x 11.69 inch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1132 (defvar ps-a4-page-height 842) ; 11.69 inches |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1133 (defvar ps-a4-page-width 595) ; 8.26 inches |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1134 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1135 (defvar ps-pages-alist |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1136 (list (list 'ps-letter ps-letter-page-width ps-letter-page-height) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1137 (list 'ps-legal ps-legal-page-width ps-legal-page-height) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1138 (list 'ps-a4 ps-a4-page-width ps-a4-page-height))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1139 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1140 ;; Define some constants to index into the page lists. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1141 (defvar ps-page-width-i 1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1142 (defvar ps-page-height-i 2) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1143 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1144 (defvar ps-page-dimensions nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1145 (defvar ps-print-width nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1146 (defvar ps-print-height nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1147 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1148 (defvar ps-height-remaining) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1149 (defvar ps-width-remaining) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1150 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1151 (defvar ps-ref-bold-faces nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1152 (defvar ps-ref-italic-faces nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1153 (defvar ps-ref-underlined-faces nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1154 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1155 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1156 ;; Internal functions |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1157 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1158 (defun ps-get-page-dimensions () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1159 (setq ps-page-dimensions (assq ps-paper-type ps-pages-alist)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1160 (let ((ps-page-width (nth ps-page-width-i ps-page-dimensions)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1161 (ps-page-height (nth ps-page-height-i ps-page-dimensions))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1162 (setq ps-print-height (- ps-page-height ps-top-margin ps-bottom-margin)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1163 (setq ps-print-width (- ps-page-width ps-left-margin ps-right-margin)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1164 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1165 (defun ps-print-preprint (&optional filename) |
7257 | 1166 (if (and filename |
1167 (or (numberp filename) | |
1168 (listp filename))) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1169 (let* ((name (concat (buffer-name) ".ps")) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1170 (prompt (format "Save PostScript to file: (default %s) " |
15163
df250bc97b46
(ps-print-preprint): Special handling if
Richard M. Stallman <rms@gnu.org>
parents:
14734
diff
changeset
|
1171 name)) |
df250bc97b46
(ps-print-preprint): Special handling if
Richard M. Stallman <rms@gnu.org>
parents:
14734
diff
changeset
|
1172 (res (read-file-name prompt default-directory name nil))) |
df250bc97b46
(ps-print-preprint): Special handling if
Richard M. Stallman <rms@gnu.org>
parents:
14734
diff
changeset
|
1173 (if (file-directory-p res) |
df250bc97b46
(ps-print-preprint): Special handling if
Richard M. Stallman <rms@gnu.org>
parents:
14734
diff
changeset
|
1174 (expand-file-name name (file-name-as-directory res)) |
df250bc97b46
(ps-print-preprint): Special handling if
Richard M. Stallman <rms@gnu.org>
parents:
14734
diff
changeset
|
1175 res)))) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1176 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1177 ;; The following functions implement a simple list-buffering scheme so |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1178 ;; that ps-print doesn't have to repeatedly switch between buffers |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1179 ;; while spooling. The functions ps-output and ps-output-string build |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1180 ;; up the lists; the function ps-flush-output takes the lists and |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1181 ;; insert its contents into the spool buffer (*PostScript*). |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1182 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1183 (defun ps-output-string-prim (string) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1184 (insert "(") ;insert start-string delimiter |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1185 (save-excursion ;insert string |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1186 (insert string)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1187 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1188 ;; Find and quote special characters as necessary for PS |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1189 (while (re-search-forward "[()\\]" nil t) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1190 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1191 (forward-char -1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1192 (insert "\\"))) |
7257 | 1193 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1194 (goto-char (point-max)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1195 (insert ")")) ;insert end-string delimiter |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1196 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1197 (defun ps-init-output-queue () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1198 (setq ps-output-head (list "")) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1199 (setq ps-output-tail ps-output-head)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1200 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1201 (defun ps-output (&rest args) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1202 (setcdr ps-output-tail args) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1203 (while (cdr ps-output-tail) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1204 (setq ps-output-tail (cdr ps-output-tail)))) |
7257 | 1205 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1206 (defun ps-output-string (string) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1207 (ps-output t string)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1208 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1209 (defun ps-flush-output () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1210 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1211 (set-buffer ps-spool-buffer) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1212 (goto-char (point-max)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1213 (while ps-output-head |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1214 (let ((it (car ps-output-head))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1215 (if (not (eq t it)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1216 (insert it) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1217 (setq ps-output-head (cdr ps-output-head)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1218 (ps-output-string-prim (car ps-output-head)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1219 (setq ps-output-head (cdr ps-output-head)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1220 (ps-init-output-queue)) |
7257 | 1221 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1222 (defun ps-insert-file (fname) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1223 (ps-flush-output) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1224 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1225 ;; Check to see that the file exists and is readable; if not, throw |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1226 ;; and error. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1227 (if (not (file-readable-p fname)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1228 (error "Could not read file `%s'" fname)) |
7257 | 1229 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1230 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1231 (set-buffer ps-spool-buffer) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1232 (goto-char (point-max)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1233 (insert-file fname))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1234 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1235 ;; These functions insert the arrays that define the contents of the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1236 ;; headers. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1237 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1238 (defun ps-generate-header-line (fonttag &optional content) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1239 (ps-output " [ " fonttag " ") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1240 (cond |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1241 ;; Literal strings should be output as is -- the string must |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1242 ;; contain its own PS string delimiters, '(' and ')', if necessary. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1243 ((stringp content) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1244 (ps-output content)) |
7257 | 1245 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1246 ;; Functions are called -- they should return strings; they will be |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1247 ;; inserted as strings and the PS string delimiters added. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1248 ((and (symbolp content) (fboundp content)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1249 (ps-output-string (funcall content))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1250 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1251 ;; Variables will have their contents inserted. They should |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1252 ;; contain strings, and will be inserted as strings. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1253 ((and (symbolp content) (boundp content)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1254 (ps-output-string (symbol-value content))) |
7257 | 1255 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1256 ;; Anything else will get turned into an empty string. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1257 (t |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1258 (ps-output-string ""))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1259 (ps-output " ]\n")) |
7257 | 1260 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1261 (defun ps-generate-header (name contents) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1262 (ps-output "/" name " [\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1263 (if (> ps-header-lines 0) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1264 (let ((count 1)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1265 (ps-generate-header-line "/h0" (car contents)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1266 (while (and (< count ps-header-lines) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1267 (setq contents (cdr contents))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1268 (ps-generate-header-line "/h1" (car contents)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1269 (setq count (+ count 1))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1270 (ps-output "] def\n")))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1271 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1272 (defun ps-output-boolean (name bool) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1273 (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) |
7257 | 1274 |
1275 (defun ps-begin-file () | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1276 (setq ps-showpage-count 0) |
7257 | 1277 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1278 (ps-output ps-adobe-tag) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1279 (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1280 ;first buffer printed |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1281 (ps-output "%%Creator: " (user-full-name) "\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1282 (ps-output "%%CreationDate: " |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1283 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1284 (ps-output "%% DocumentFonts: Helvetica Helvetica-Bold " |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1285 ps-font " " ps-font-bold " " ps-font-italic " " |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1286 ps-font-bold-italic "\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1287 (ps-output "%%Pages: (atend)\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1288 (ps-output "%%EndComments\n\n") |
7257 | 1289 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1290 (ps-output-boolean "Duplex" ps-spool-duplex) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1291 (ps-output-boolean "PrintHeader" ps-print-header) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1292 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1293 (ps-output-boolean "ShowNofN" ps-show-n-of-n) |
7257 | 1294 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1295 (ps-output (format "/LeftMargin %d def\n" ps-left-margin)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1296 (ps-output (format "/RightMargin %d def\n" ps-right-margin)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1297 (ps-output (format "/BottomMargin %d def\n" ps-bottom-margin)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1298 (ps-output (format "/TopMargin %d def\n" ps-top-margin)) |
7257 | 1299 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1300 (ps-get-page-dimensions) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1301 (ps-output (format "/PrintWidth %d def\n" ps-print-width)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1302 (ps-output (format "/PrintHeight %d def\n" ps-print-height)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1303 |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
1304 (ps-output (format "/LineHeight %s def\n" ps-line-height)) |
10683 | 1305 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1306 (ps-output ps-print-prologue) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1307 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1308 (ps-output (format "/f0 %d /%s Font\n" ps-font-size ps-font)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1309 (ps-output (format "/f1 %d /%s Font\n" ps-font-size ps-font-bold)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1310 (ps-output (format "/f2 %d /%s Font\n" ps-font-size ps-font-italic)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1311 (ps-output (format "/f3 %d /%s Font\n" ps-font-size |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1312 ps-font-bold-italic)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1313 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1314 (ps-output "%%EndPrologue\n")) |
7257 | 1315 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1316 (defun ps-header-dirpart () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1317 (let ((fname (buffer-file-name))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1318 (if fname |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1319 (if (string-equal (buffer-name) (file-name-nondirectory fname)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1320 (file-name-directory fname) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1321 fname) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1322 ""))) |
7257 | 1323 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1324 (defun ps-get-buffer-name () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1325 ;; Indulge me this little easter egg: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1326 (if (string= (buffer-name) "ps-print.el") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1327 "Hey, Cool! It's ps-print.el!!!" |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1328 (buffer-name))) |
7257 | 1329 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1330 (defun ps-begin-job () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1331 (setq ps-page-count 0)) |
7257 | 1332 |
1333 (defun ps-end-file () | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1334 (ps-output "%%Trailer\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1335 (ps-output "%%Pages: " (format "%d\n" ps-showpage-count))) |
7257 | 1336 |
1337 (defun ps-next-page () | |
1338 (ps-end-page) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1339 (ps-flush-output) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1340 (ps-begin-page)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1341 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1342 (defun ps-begin-page (&optional dummypage) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1343 (ps-get-page-dimensions) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1344 (setq ps-width-remaining ps-print-width) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1345 (setq ps-height-remaining ps-print-height) |
7257 | 1346 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1347 ;; If headers are turned on, deduct the height of the header from |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1348 ;; the print height remaining. Clumsy clumsy clumsy. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1349 (if ps-print-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1350 (setq ps-height-remaining |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1351 (- ps-height-remaining |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1352 ps-header-title-line-height |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1353 (* ps-header-line-height (- ps-header-lines 1)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1354 (* 2 ps-header-pad)))) |
7257 | 1355 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1356 (setq ps-page-count (+ ps-page-count 1)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1357 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1358 (ps-output "\n%%Page: " |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1359 (format "%d %d\n" ps-page-count (+ 1 ps-showpage-count))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1360 (ps-output "BeginDSCPage\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1361 (ps-output (format "/PageNumber %d def\n" ps-page-count)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1362 (ps-output "/PageCount 0 def\n") |
7257 | 1363 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1364 (if ps-print-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1365 (progn |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1366 (ps-generate-header "HeaderLinesLeft" ps-left-header) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1367 (ps-generate-header "HeaderLinesRight" ps-right-header) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1368 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1369 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1370 (ps-output "BeginPage\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1371 (ps-set-font ps-current-font) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1372 (ps-set-bg ps-current-bg) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1373 (ps-set-color ps-current-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1374 (ps-set-underline ps-current-underline-p)) |
7257 | 1375 |
1376 (defun ps-end-page () | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1377 (setq ps-showpage-count (+ 1 ps-showpage-count)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1378 (ps-output "EndPage\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1379 (ps-output "EndDSCPage\n")) |
7257 | 1380 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1381 (defun ps-dummy-page () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1382 (setq ps-showpage-count (+ 1 ps-showpage-count)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1383 (ps-output "%%Page: " (format "- %d\n" ps-showpage-count) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1384 "BeginDSCPage |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1385 /PrintHeader false def |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1386 BeginPage |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1387 EndPage |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1388 EndDSCPage\n")) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1389 |
7257 | 1390 (defun ps-next-line () |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1391 (if (< ps-height-remaining ps-line-height) |
7257 | 1392 (ps-next-page) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1393 (setq ps-width-remaining ps-print-width) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1394 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1395 (ps-hard-lf))) |
7257 | 1396 |
1397 (defun ps-continue-line () | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1398 (if (< ps-height-remaining ps-line-height) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1399 (ps-next-page) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1400 (setq ps-width-remaining ps-print-width) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1401 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1402 (ps-soft-lf))) |
7257 | 1403 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1404 (defun ps-hard-lf () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1405 (ps-output "HL\n")) |
7257 | 1406 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1407 (defun ps-soft-lf () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1408 (ps-output "SL\n")) |
7257 | 1409 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1410 (defun ps-find-wrappoint (from to char-width) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1411 (let ((avail (truncate (/ ps-width-remaining char-width))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1412 (todo (- to from))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1413 (if (< todo avail) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1414 (cons to (* todo char-width)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1415 (cons (+ from avail) ps-width-remaining)))) |
7257 | 1416 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1417 (defun ps-basic-plot-string (from to &optional bg-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1418 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1419 (to (car wrappoint)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1420 (string (buffer-substring from to))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1421 (ps-output-string string) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1422 (ps-output " S\n") ; |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1423 wrappoint)) |
7257 | 1424 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1425 (defun ps-basic-plot-whitespace (from to &optional bg-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1426 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1427 (to (car wrappoint))) |
7257 | 1428 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1429 (ps-output (format "%d W\n" (- to from))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1430 wrappoint)) |
7257 | 1431 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1432 (defun ps-plot (plotfunc from to &optional bg-color) |
7257 | 1433 (while (< from to) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1434 (let* ((wrappoint (funcall plotfunc from to bg-color)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1435 (plotted-to (car wrappoint)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1436 (plotted-width (cdr wrappoint))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1437 (setq from plotted-to) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1438 (setq ps-width-remaining (- ps-width-remaining plotted-width)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1439 (if (< from to) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1440 (ps-continue-line)))) |
7257 | 1441 (if ps-razzle-dazzle |
1442 (let* ((q-todo (- (point-max) (point-min))) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1443 (q-done (- (point) (point-min))) |
7257 | 1444 (chunkfrac (/ q-todo 8)) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1445 (chunksize (if (> chunkfrac 1000) 1000 chunkfrac))) |
7257 | 1446 (if (> (- q-done ps-razchunk) chunksize) |
10683 | 1447 (let (foo) |
7257 | 1448 (setq ps-razchunk q-done) |
1449 (setq foo | |
1450 (if (< q-todo 100) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1451 (/ (* 100 q-done) q-todo) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1452 (/ q-done (/ q-todo 100)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1453 (message "Formatting...%d%%" foo)))))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1454 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1455 (defun ps-set-font (font) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1456 (setq ps-current-font font) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1457 (ps-output (format "/f%d F\n" ps-current-font))) |
7257 | 1458 |
10683 | 1459 (defvar ps-print-color-scale nil) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1460 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1461 (defun ps-set-bg (color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1462 (if (setq ps-current-bg color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1463 (ps-output (format ps-color-format (nth 0 color) (nth 1 color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1464 (nth 2 color)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1465 " true BG\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1466 (ps-output "false BG\n"))) |
7257 | 1467 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1468 (defun ps-set-color (color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1469 (if (setq ps-current-color color) |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1470 nil |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1471 (setq ps-current-color ps-default-fg)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1472 (ps-output (format ps-color-format (nth 0 ps-current-color) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1473 (nth 1 ps-current-color) (nth 2 ps-current-color)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1474 " FG\n")) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1475 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1476 (defun ps-set-underline (underline-p) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1477 (ps-output (if underline-p "true" "false") " UL\n") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1478 (setq ps-current-underline-p underline-p)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1479 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1480 (defun ps-plot-region (from to font fg-color &optional bg-color underline-p) |
7257 | 1481 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1482 (if (not (equal font ps-current-font)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1483 (ps-set-font font)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1484 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1485 ;; Specify a foreground color only if one's specified and it's |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1486 ;; different than the current. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1487 (if (not (equal fg-color ps-current-color)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1488 (ps-set-color fg-color)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1489 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1490 (if (not (equal bg-color ps-current-bg)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1491 (ps-set-bg bg-color)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1492 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1493 ;; Toggle underlining if different. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1494 (if (not (equal underline-p ps-current-underline-p)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1495 (ps-set-underline underline-p)) |
7257 | 1496 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1497 ;; Starting at the beginning of the specified region... |
7257 | 1498 (save-excursion |
1499 (goto-char from) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1500 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1501 ;; ...break the region up into chunks separated by tabs, linefeeds, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1502 ;; and pagefeeds, and plot each chunk. |
7257 | 1503 (while (< from to) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1504 (if (re-search-forward "[\t\n\f]" to t) |
7257 | 1505 (let ((match (char-after (match-beginning 0)))) |
1506 (cond | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1507 ((= match ?\t) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1508 (let ((linestart |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1509 (save-excursion (beginning-of-line) (point)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1510 (ps-plot 'ps-basic-plot-string from (- (point) 1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1511 bg-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1512 (forward-char -1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1513 (setq from (+ linestart (current-column))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1514 (if (re-search-forward "[ \t]+" to t) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1515 (ps-plot 'ps-basic-plot-whitespace |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1516 from (+ linestart (current-column)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1517 bg-color)))) |
7257 | 1518 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1519 ((= match ?\n) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1520 (ps-plot 'ps-basic-plot-string from (- (point) 1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1521 bg-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1522 (ps-next-line) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1523 ) |
7257 | 1524 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1525 ((= match ?\f) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1526 (ps-plot 'ps-basic-plot-string from (- (point) 1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1527 bg-color) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1528 (ps-next-page))) |
7257 | 1529 (setq from (point))) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1530 (ps-plot 'ps-basic-plot-string from to bg-color) |
7257 | 1531 (setq from to))))) |
1532 | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1533 (defun ps-color-value (x-color-value) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1534 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1535 (/ x-color-value ps-print-color-scale)) |
7257 | 1536 |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1537 (defun ps-color-values (x-color) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1538 (cond ((fboundp 'x-color-values) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1539 (x-color-values x-color)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1540 ((fboundp 'pixel-components) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1541 (pixel-components x-color)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1542 (t (error "No available function to determine X color values.")))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1543 |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1544 (defun ps-face-attributes (face) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1545 (let ((differs (face-differs-from-default-p face))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1546 (list (memq face ps-ref-bold-faces) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1547 (memq face ps-ref-italic-faces) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1548 (memq face ps-ref-underlined-faces) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1549 (and differs (face-foreground face)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1550 (and differs (face-background face))))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1551 |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1552 (defun ps-face-attribute-list (face-or-list) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1553 (if (listp face-or-list) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1554 (let (bold-p italic-p underline-p foreground background face-attr face) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1555 (while face-or-list |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1556 (setq face (car face-or-list)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1557 (setq face-attr (ps-face-attributes face)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1558 (setq bold-p (or bold-p (nth 0 face-attr))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1559 (setq italic-p (or italic-p (nth 1 face-attr))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1560 (setq underline-p (or underline-p (nth 2 face-attr))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1561 (if foreground |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1562 nil |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1563 (setq foreground (nth 3 face-attr))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1564 (if background |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1565 nil |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1566 (setq background (nth 4 face-attr))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1567 (setq face-or-list (cdr face-or-list))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1568 (list bold-p italic-p underline-p foreground background)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1569 |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1570 (ps-face-attributes face-or-list))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1571 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1572 (defun ps-plot-with-face (from to face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1573 (if face |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1574 (let* ((face-attr (ps-face-attribute-list face)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1575 (bold-p (nth 0 face-attr)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1576 (italic-p (nth 1 face-attr)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1577 (underline-p (nth 2 face-attr)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1578 (foreground (nth 3 face-attr)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1579 (background (nth 4 face-attr)) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1580 (fg-color (if (and ps-print-color-p foreground) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1581 (mapcar 'ps-color-value |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1582 (ps-color-values foreground)) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1583 ps-default-color)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1584 (bg-color (if (and ps-print-color-p background) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1585 (mapcar 'ps-color-value |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1586 (ps-color-values background))))) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1587 (ps-plot-region from to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1588 (cond ((and bold-p italic-p) 3) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1589 (italic-p 2) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1590 (bold-p 1) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1591 (t 0)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1592 ; (or fg-color '(0.0 0.0 0.0)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1593 fg-color |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1594 bg-color underline-p)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1595 (goto-char to))) |
7257 | 1596 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1597 |
12768
68b1359ecd66
Renamed `fsf' to `emacs' in all names.
Richard M. Stallman <rms@gnu.org>
parents:
11799
diff
changeset
|
1598 (defun ps-emacs-face-kind-p (face kind kind-regex kind-list) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1599 (let ((frame-font (face-font face)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1600 (face-defaults (face-font face t))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1601 (or |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1602 ;; Check FACE defaults: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1603 (and (listp face-defaults) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1604 (memq kind face-defaults)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1605 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1606 ;; Check the user's preferences |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1607 (memq face kind-list)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1608 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1609 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1610 (let* ((frame-font (or (face-font face) (face-font 'default))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1611 (kind-cons (assq kind (x-font-properties frame-font))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1612 (kind-spec (cdr-safe kind-cons)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1613 (case-fold-search t)) |
7257 | 1614 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1615 (or (and kind-spec (string-match kind-regex kind-spec)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1616 ;; Kludge-compatible: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1617 (memq face kind-list)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1618 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1619 (defun ps-face-bold-p (face) |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1620 (if (eq ps-print-emacs-type 'emacs) |
12768
68b1359ecd66
Renamed `fsf' to `emacs' in all names.
Richard M. Stallman <rms@gnu.org>
parents:
11799
diff
changeset
|
1621 (ps-emacs-face-kind-p face 'bold "-\\(bold\\|demibold\\)-" |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1622 ps-bold-faces) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1623 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold" |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1624 ps-bold-faces))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1625 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1626 (defun ps-face-italic-p (face) |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1627 (if (eq ps-print-emacs-type 'emacs) |
12768
68b1359ecd66
Renamed `fsf' to `emacs' in all names.
Richard M. Stallman <rms@gnu.org>
parents:
11799
diff
changeset
|
1628 (ps-emacs-face-kind-p face 'italic "-[io]-" ps-italic-faces) |
10683 | 1629 (or |
1630 (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces) | |
1631 (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces)))) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1632 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1633 (defun ps-face-underlined-p (face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1634 (or (face-underline-p face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1635 (memq face ps-underlined-faces))) |
7257 | 1636 |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1637 ;; Ensure that face-list is fbound. |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1638 (or (fboundp 'face-list) (defalias 'face-list 'list-faces)) |
7257 | 1639 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1640 (defun ps-build-reference-face-lists () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1641 (if ps-auto-font-detect |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1642 (let ((faces (face-list)) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1643 the-face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1644 (setq ps-ref-bold-faces nil |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1645 ps-ref-italic-faces nil |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1646 ps-ref-underlined-faces nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1647 (while faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1648 (setq the-face (car faces)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1649 (if (ps-face-italic-p the-face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1650 (setq ps-ref-italic-faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1651 (cons the-face ps-ref-italic-faces))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1652 (if (ps-face-bold-p the-face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1653 (setq ps-ref-bold-faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1654 (cons the-face ps-ref-bold-faces))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1655 (if (ps-face-underlined-p the-face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1656 (setq ps-ref-underlined-faces |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1657 (cons the-face ps-ref-underlined-faces))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1658 (setq faces (cdr faces)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1659 (setq ps-ref-bold-faces ps-bold-faces) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1660 (setq ps-ref-italic-faces ps-italic-faces) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1661 (setq ps-ref-underlined-faces ps-underlined-faces)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1662 (setq ps-build-face-reference nil)) |
7257 | 1663 |
1664 (defun ps-mapper (extent list) | |
1665 (nconc list (list (list (extent-start-position extent) 'push extent) | |
1666 (list (extent-end-position extent) 'pull extent))) | |
1667 nil) | |
1668 | |
1669 (defun ps-sorter (a b) | |
1670 (< (car a) (car b))) | |
10683 | 1671 |
1672 (defun ps-extent-sorter (a b) | |
1673 (< (extent-priority a) (extent-priority b))) | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1674 |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1675 (defun ps-print-ensure-fontified (start end) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1676 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1677 (if (fboundp 'lazy-lock-fontify-region) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1678 (lazy-lock-fontify-region start end) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1679 (lazy-lock-fontify-buffer)))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1680 |
7257 | 1681 (defun ps-generate-postscript-with-faces (from to) |
10683 | 1682 ;; Build the reference lists of faces if necessary. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1683 (if (or ps-always-build-face-reference |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1684 ps-build-face-reference) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1685 (progn |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1686 (message "Collecting face information...") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1687 (ps-build-reference-face-lists))) |
10683 | 1688 ;; Set the color scale. We do it here instead of in the defvar so |
1689 ;; that ps-print can be dumped into emacs. This expression can't be | |
1690 ;; evaluated at dump-time because X isn't initialized. | |
1691 (setq ps-print-color-scale | |
1692 (if ps-print-color-p | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1693 (float (car (ps-color-values "white"))) |
10683 | 1694 1.0)) |
1695 ;; Generate some PostScript. | |
7257 | 1696 (save-restriction |
1697 (narrow-to-region from to) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1698 (let ((face 'default) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1699 (position to)) |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1700 (ps-print-ensure-fontified from to) |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1701 (cond ((or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs)) |
7257 | 1702 ;; Build the list of extents... |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1703 (let ((a (cons 'dummy nil)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1704 record type extent extent-list) |
7257 | 1705 (map-extents 'ps-mapper nil from to a) |
1706 (setq a (cdr a)) | |
1707 (setq a (sort a 'ps-sorter)) | |
1708 | |
1709 (setq extent-list nil) | |
1710 | |
1711 ;; Loop through the extents... | |
1712 (while a | |
1713 (setq record (car a)) | |
1714 | |
1715 (setq position (car record)) | |
1716 (setq record (cdr record)) | |
1717 | |
1718 (setq type (car record)) | |
1719 (setq record (cdr record)) | |
1720 | |
1721 (setq extent (car record)) | |
1722 | |
1723 ;; Plot up to this record. | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1724 ;; XEmacs 19.12: for some reason, we're getting into a |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1725 ;; situation in which some of the records have |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1726 ;; positions less than 'from'. Since we've narrowed |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1727 ;; the buffer, this'll generate errors. This is a |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1728 ;; hack, but don't call ps-plot-with-face unless from > |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1729 ;; point-min. |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1730 (if (and (>= from (point-min)) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1731 (<= position (point-max))) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1732 (ps-plot-with-face from position face)) |
7257 | 1733 |
1734 (cond | |
1735 ((eq type 'push) | |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1736 (if (extent-face extent) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1737 (setq extent-list (sort (cons extent extent-list) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1738 'ps-extent-sorter)))) |
7257 | 1739 |
1740 ((eq type 'pull) | |
1741 (setq extent-list (sort (delq extent extent-list) | |
1742 'ps-extent-sorter)))) | |
1743 | |
1744 (setq face | |
1745 (if extent-list | |
1746 (extent-face (car extent-list)) | |
1747 'default)) | |
1748 | |
1749 (setq from position) | |
1750 (setq a (cdr a))))) | |
1751 | |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1752 ((eq ps-print-emacs-type 'emacs) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1753 (let ((property-change from) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1754 (overlay-change from)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1755 (while (< from to) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1756 (if (< property-change to) ; Don't search for property change |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1757 ; unless previous search succeeded. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1758 (setq property-change |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1759 (next-property-change from nil to))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1760 (if (< overlay-change to) ; Don't search for overlay change |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1761 ; unless previous search succeeded. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1762 (setq overlay-change |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1763 (min (next-overlay-change from) to))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1764 (setq position |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1765 (min property-change overlay-change)) |
14626
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1766 ;; The code below is not quite correct, |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1767 ;; because a non-nil overlay invisible property |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1768 ;; which is inactive according to the current value |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1769 ;; of buffer-invisibility-spec nonetheless overrides |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1770 ;; a face text property. |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1771 (setq face |
14626
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1772 (cond ((let ((prop (get-text-property from 'invisible))) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1773 ;; Decide whether this invisible property |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1774 ;; really makes the text invisible. |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1775 (if (eq buffer-invisibility-spec t) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1776 (not (null prop)) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1777 (or (memq prop buffer-invisibility-spec) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1778 (assq prop buffer-invisibility-spec)))) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1779 nil) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1780 ((get-text-property from 'face)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1781 (t 'default))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1782 (let ((overlays (overlays-at from)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1783 (face-priority -1)) ; text-property |
7257 | 1784 (while overlays |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1785 (let* ((overlay (car overlays)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1786 (overlay-face (overlay-get overlay 'face)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1787 (overlay-invisible (overlay-get overlay 'invisible)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1788 (overlay-priority (or (overlay-get overlay |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1789 'priority) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1790 0))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1791 (if (and (or overlay-invisible overlay-face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1792 (> overlay-priority face-priority)) |
14626
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1793 (setq face (cond ((if (eq buffer-invisibility-spec t) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1794 (not (null overlay-invisible)) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1795 (or (memq overlay-invisible buffer-invisibility-spec) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1796 (assq overlay-invisible buffer-invisibility-spec))) |
e555a2d12121
(ps-generate-postscript-with-faces):
Karl Heuer <kwzh@gnu.org>
parents:
14190
diff
changeset
|
1797 nil) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1798 ((and face overlay-face))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1799 face-priority overlay-priority))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1800 (setq overlays (cdr overlays)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1801 ;; Plot up to this record. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1802 (ps-plot-with-face from position face) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1803 (setq from position))))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1804 (ps-plot-with-face from to face)))) |
7257 | 1805 |
1806 (defun ps-generate-postscript (from to) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1807 (ps-plot-region from to 0 nil)) |
7257 | 1808 |
1809 (defun ps-generate (buffer from to genfunc) | |
10683 | 1810 (let ((from (min to from)) |
14712
974766c7bddc
(ps-generate): Bind inhibit-read-only.
Richard M. Stallman <rms@gnu.org>
parents:
14626
diff
changeset
|
1811 (to (max to from)) |
974766c7bddc
(ps-generate): Bind inhibit-read-only.
Richard M. Stallman <rms@gnu.org>
parents:
14626
diff
changeset
|
1812 ;; This avoids trouble if chars with read-only properties |
974766c7bddc
(ps-generate): Bind inhibit-read-only.
Richard M. Stallman <rms@gnu.org>
parents:
14626
diff
changeset
|
1813 ;; are copied into ps-spool-buffer. |
974766c7bddc
(ps-generate): Bind inhibit-read-only.
Richard M. Stallman <rms@gnu.org>
parents:
14626
diff
changeset
|
1814 (inhibit-read-only t)) |
10683 | 1815 (save-restriction |
1816 (narrow-to-region from to) | |
1817 (if ps-razzle-dazzle | |
1818 (message "Formatting...%d%%" (setq ps-razchunk 0))) | |
1819 (set-buffer buffer) | |
1820 (setq ps-source-buffer buffer) | |
1821 (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) | |
1822 (ps-init-output-queue) | |
1823 (let (safe-marker completed-safely needs-begin-file) | |
1824 (unwind-protect | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1825 (progn |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1826 (set-buffer ps-spool-buffer) |
10683 | 1827 |
1828 ;; Get a marker and make it point to the current end of the | |
1829 ;; buffer, If an error occurs, we'll delete everything from | |
1830 ;; the end of this marker onwards. | |
1831 (setq safe-marker (make-marker)) | |
1832 (set-marker safe-marker (point-max)) | |
1833 | |
1834 (goto-char (point-min)) | |
1835 (if (looking-at (regexp-quote "%!PS-Adobe-1.0")) | |
1836 nil | |
1837 (setq needs-begin-file t)) | |
1838 (save-excursion | |
1839 (set-buffer ps-source-buffer) | |
1840 (if needs-begin-file (ps-begin-file)) | |
1841 (ps-begin-job) | |
1842 (ps-begin-page)) | |
1843 (set-buffer ps-source-buffer) | |
1844 (funcall genfunc from to) | |
1845 (ps-end-page) | |
1846 | |
1847 (if (and ps-spool-duplex | |
1848 (= (mod ps-page-count 2) 1)) | |
1849 (ps-dummy-page)) | |
1850 (ps-flush-output) | |
1851 | |
1852 ;; Back to the PS output buffer to set the page count | |
1853 (set-buffer ps-spool-buffer) | |
1854 (goto-char (point-max)) | |
1855 (while (re-search-backward "^/PageCount 0 def$" nil t) | |
1856 (replace-match (format "/PageCount %d def" ps-page-count) t)) | |
7257 | 1857 |
10683 | 1858 ;; Setting this variable tells the unwind form that the |
1859 ;; the postscript was generated without error. | |
1860 (setq completed-safely t)) | |
1861 | |
14040 | 1862 ;; Unwind form: If some bad mojo occurred while generating |
10683 | 1863 ;; postscript, delete all the postscript that was generated. |
1864 ;; This protects the previously spooled files from getting | |
1865 ;; corrupted. | |
1866 (if (and (markerp safe-marker) (not completed-safely)) | |
1867 (progn | |
1868 (set-buffer ps-spool-buffer) | |
1869 (delete-region (marker-position safe-marker) (point-max)))))) | |
1870 | |
1871 (if ps-razzle-dazzle | |
1872 (message "Formatting...done"))))) | |
7257 | 1873 |
1874 (defun ps-do-despool (filename) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1875 (if (or (not (boundp 'ps-spool-buffer)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1876 (not ps-spool-buffer)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1877 (message "No spooled PostScript to print") |
7257 | 1878 (ps-end-file) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1879 (ps-flush-output) |
7257 | 1880 (if filename |
1881 (save-excursion | |
1882 (if ps-razzle-dazzle | |
1883 (message "Saving...")) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1884 (set-buffer ps-spool-buffer) |
7257 | 1885 (setq filename (expand-file-name filename)) |
1886 (write-region (point-min) (point-max) filename) | |
1887 (if ps-razzle-dazzle | |
1888 (message "Wrote %s" filename))) | |
1889 ;; Else, spool to the printer | |
1890 (if ps-razzle-dazzle | |
1891 (message "Printing...")) | |
1892 (save-excursion | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1893 (set-buffer ps-spool-buffer) |
14190
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1894 (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer)) |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1895 (write-region (point-min) (point-max) dos-ps-printer t 0) |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1896 (let ((binary-process-input t)) ; for MS-DOS |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1897 (apply 'call-process-region |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1898 (point-min) (point-max) ps-lpr-command nil |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1899 (if (fboundp 'start-process) 0 nil) |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1900 nil |
395b22713872
(ps-do-despool): On MS-DOS, allow both the usual and
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
1901 ps-lpr-switches)))) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1902 (if ps-razzle-dazzle |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1903 (message "Printing...done"))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1904 (kill-buffer ps-spool-buffer))) |
7257 | 1905 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1906 (defun ps-kill-emacs-check () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1907 (let (ps-buffer) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1908 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1909 (buffer-modified-p ps-buffer)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1910 (if (y-or-n-p "Unprinted PostScript waiting; print now? ") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1911 (ps-despool))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1912 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1913 (buffer-modified-p ps-buffer)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1914 (if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1915 nil |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1916 (error "Unprinted PostScript"))))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1917 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1918 (if (fboundp 'add-hook) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1919 (add-hook 'kill-emacs-hook 'ps-kill-emacs-check) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1920 (if kill-emacs-hook |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1921 (message "Won't override existing kill-emacs-hook") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1922 (setq kill-emacs-hook 'ps-kill-emacs-check))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1923 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1924 ;;; Sample Setup Code: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1925 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1926 ;; This stuff is for anybody that's brave enough to look this far, |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1927 ;; and able to figure out how to use it. It isn't really part of ps- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1928 ;; print, but I'll leave it here in hopes it might be useful: |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1929 |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1930 ;; WARNING!!! The following code is *sample* code only. Don't use it |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1931 ;; unless you understand what it does! |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
1932 |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1933 (defmacro ps-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1934 [f22] ''f22)) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1935 (defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1936 [C-f22] |
10683 | 1937 ''(control f22))) |
12769
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1938 (defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs) |
4a905565cfa6
(ps-print-emacs-type): Renamed from emacs-type.
Richard M. Stallman <rms@gnu.org>
parents:
12768
diff
changeset
|
1939 [S-f22] |
10683 | 1940 ''(shift f22))) |
1941 | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1942 ;; Look in an article or mail message for the Subject: line. To be |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1943 ;; placed in ps-left-headers. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1944 (defun ps-article-subject () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1945 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1946 (goto-char (point-min)) |
15620
7844c0f756d0
(ps-article-subject): Don't die if no subject header.
Karl Heuer <kwzh@gnu.org>
parents:
15163
diff
changeset
|
1947 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1948 (buffer-substring (match-beginning 1) (match-end 1)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1949 "Subject ???"))) |
7257 | 1950 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1951 ;; Look in an article or mail message for the From: line. Sorta-kinda |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1952 ;; understands RFC-822 addresses and can pull the real name out where |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1953 ;; it's provided. To be placed in ps-left-headers. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1954 (defun ps-article-author () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1955 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1956 (goto-char (point-min)) |
15621
6be6d1990543
(ps-article-author, ps-info-file, ps-info-node): Don't die if header is missing.
Karl Heuer <kwzh@gnu.org>
parents:
15620
diff
changeset
|
1957 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1958 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1959 (cond |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1960 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1961 ;; Try first to match addresses that look like |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1962 ;; thompson@wg2.waii.com (Jim Thompson) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1963 ((string-match ".*[ \t]+(\\(.*\\))" fromstring) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1964 (substring fromstring (match-beginning 1) (match-end 1))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1965 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1966 ;; Next try to match addresses that look like |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1967 ;; Jim Thompson <thompson@wg2.waii.com> |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1968 ((string-match "\\(.*\\)[ \t]+<.*>" fromstring) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1969 (substring fromstring (match-beginning 1) (match-end 1))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1970 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1971 ;; Couldn't find a real name -- show the address instead. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1972 (t fromstring))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1973 "From ???"))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1974 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1975 ;; A hook to bind to gnus-Article-prepare-hook. This will set the ps- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1976 ;; left-headers specially for gnus articles. Unfortunately, gnus- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1977 ;; article-mode-hook is called only once, the first time the *Article* |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1978 ;; buffer enters that mode, so it would only work for the first time |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1979 ;; we ran gnus. The second time, this hook wouldn't get set up. The |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1980 ;; only alternative is gnus-article-prepare-hook. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1981 (defun ps-gnus-article-prepare-hook () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1982 (setq ps-header-lines 3) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1983 (setq ps-left-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1984 ;; The left headers will display the article's subject, its |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1985 ;; author, and the newsgroup it was in. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1986 (list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name))) |
7257 | 1987 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1988 ;; A hook to bind to vm-mode-hook to locally bind prsc and set the ps- |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1989 ;; left-headers specially for mail messages. This header setup would |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1990 ;; also work, I think, for RMAIL. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1991 (defun ps-vm-mode-hook () |
10683 | 1992 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1993 (setq ps-header-lines 3) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1994 (setq ps-left-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1995 ;; The left headers will display the message's subject, its |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1996 ;; author, and the name of the folder it was in. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1997 (list 'ps-article-subject 'ps-article-author 'buffer-name))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1998 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
1999 ;; Every now and then I forget to switch from the *Summary* buffer to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2000 ;; the *Article* before hitting prsc, and a nicely formatted list of |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2001 ;; article subjects shows up at the printer. This function, bound to |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2002 ;; prsc for the gnus *Summary* buffer means I don't have to switch |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2003 ;; buffers first. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2004 (defun ps-gnus-print-article-from-summary () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2005 (interactive) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2006 (if (get-buffer "*Article*") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2007 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2008 (set-buffer "*Article*") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2009 (ps-spool-buffer-with-faces)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2010 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2011 ;; See ps-gnus-print-article-from-summary. This function does the |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2012 ;; same thing for vm. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2013 (defun ps-vm-print-message-from-summary () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2014 (interactive) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2015 (if vm-mail-buffer |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2016 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2017 (set-buffer vm-mail-buffer) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2018 (ps-spool-buffer-with-faces)))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2019 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2020 ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2021 ;; prsc. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2022 (defun ps-gnus-summary-setup () |
10683 | 2023 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary)) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2024 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2025 ;; Look in an article or mail message for the Subject: line. To be |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2026 ;; placed in ps-left-headers. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2027 (defun ps-info-file () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2028 (save-excursion |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2029 (goto-char (point-min)) |
15621
6be6d1990543
(ps-article-author, ps-info-file, ps-info-node): Don't die if header is missing.
Karl Heuer <kwzh@gnu.org>
parents:
15620
diff
changeset
|
2030 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2031 (buffer-substring (match-beginning 1) (match-end 1)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2032 "File ???"))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2033 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2034 ;; Look in an article or mail message for the Subject: line. To be |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2035 ;; placed in ps-left-headers. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2036 (defun ps-info-node () |
7257 | 2037 (save-excursion |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2038 (goto-char (point-min)) |
15621
6be6d1990543
(ps-article-author, ps-info-file, ps-info-node): Don't die if header is missing.
Karl Heuer <kwzh@gnu.org>
parents:
15620
diff
changeset
|
2039 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2040 (buffer-substring (match-beginning 1) (match-end 1)) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2041 "Node ???"))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2042 |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2043 (defun ps-info-mode-hook () |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2044 (setq ps-left-header |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2045 ;; The left headers will display the node name and file name. |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2046 (list 'ps-info-node 'ps-info-file))) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2047 |
11799
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
2048 ;; WARNING! The following function is a *sample* only, and is *not* |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
2049 ;; meant to be used as a whole unless you understand what the effects |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
2050 ;; will be! (In fact, this is a copy if my setup for ps-print -- I'd |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
2051 ;; be very surprised if it was useful to *anybody*, without |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
2052 ;; modification.) |
4a04c7799790
Miscellaneous fixes for better compatibility with
Karl Heuer <kwzh@gnu.org>
parents:
10738
diff
changeset
|
2053 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2054 (defun ps-jts-ps-setup () |
10683 | 2055 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc |
2056 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces) | |
2057 (global-set-key (ps-c-prsc) 'ps-despool) | |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2058 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2059 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2060 (add-hook 'vm-mode-hook 'ps-vm-mode-hook) |
10683 | 2061 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2062 (add-hook 'Info-mode-hook 'ps-info-mode-hook) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2063 (setq ps-spool-duplex t) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2064 (setq ps-print-color-p nil) |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2065 (setq ps-lpr-command "lpr") |
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2066 (setq ps-lpr-switches '("-Jjct,duplex_long"))) |
7257 | 2067 |
2068 (provide 'ps-print) | |
10738
e7d5b119b583
(ps-print-version): Add caveat about version number.
Richard M. Stallman <rms@gnu.org>
parents:
10683
diff
changeset
|
2069 |
10492
a0f38717d82d
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
7257
diff
changeset
|
2070 ;;; ps-print.el ends here |