Mercurial > hg > xemacs-beta

comparison lisp/packages/ps-print.el @ 82:6a378aca36af r20-0b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b91
author cvs
date Mon, 13 Aug 2007 09:07:36 +0200
parents 54cc21c15cbb
children 821dec489c24
comparison
equal deleted inserted replaced
81:ebca3d831cea 82:6a378aca36af
1 ;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19. 1 ;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19.
2 2
3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. 3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
4 4
5 ;; Author: Jim Thompson <thompson@wg2.waii.com> 5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6 ;; Maintainer: duthen@cegelec-red.fr (Jacques Duthen Prestataire) 6 ;; Maintainer: Jacques Duthen <duthen@cegelec-red.fr>
7 ;; Keywords: print, PostScript 7 ;; Keywords: print, PostScript
8 8 ;; Time-stamp: <97/01/17 16:41:00 duthen>
9 ;; This file is part of XEmacs. 9 ;; Version: 3.05
10 10
11 ;; XEmacs is free software; you can redistribute it and/or modify it 11 (defconst ps-print-version "3.05"
12 ;; under the terms of the GNU General Public License as published by 12 "ps-print.el, v 3.05 <97/01/17 duthen>
13
14 Jack's last change version -- this file may have been edited as part of
15 Emacs without changes to the version number. When reporting bugs,
16 please also report the version of Emacs, if any, that ps-print was
17 distributed with.
18
19 Please send all bug fixes and enhancements to
20 Jacques Duthen <duthen@cegelec-red.fr>.
21 ")
22
23 ;; This file is part of GNU Emacs.
24
25 ;; GNU Emacs is free software; you can redistribute it and/or modify
26 ;; 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) 27 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version. 28 ;; any later version.
15 29
16 ;; XEmacs is distributed in the hope that it will be useful, but 30 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of 31 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 32 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; General Public License for more details. 33 ;; GNU General Public License for more details.
20 34
21 ;; You should have received a copy of the GNU General Public License 35 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free 36 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 37 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; 02111-1307, USA. 38 ;; Boston, MA 02111-1307, USA.
25 39
26 ;; LCD Archive Entry: 40 ;; LCD Archive Entry:
27 ;; ps-print|James C. Thompson|thompson@wg2.waii.com| 41 ;; ps-print|James C. Thompson|thompson@wg2.waii.com|
28 ;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)| 42 ;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)|
29 ;; 26-Feb-1994|2.8|~/packages/ps-print.el| 43 ;; 26-Feb-1994|2.8|~/packages/ps-print.el|
30 44
45 ;; 3.05 [jack] <97/01/16 duthen>
46 ;; Ben Wing <ben@666.com> took ps-print.el from the official 19.34
47 ;; GNU distribution:
48 ;; -rw-rw-r-- 1 duthen 69315 Jul 22 1996 ps-print.el
49 ;; He patched it for XEmacs.
50 ;; Steven L Baur <steve@miranova.com> sent me this version which has
51 ;; 26 diffs with 19.34.
52 ;; I merge these 26 diffs into my 3.04 version.
53
54 ;; `ps-paper-type': ###autoload.
55 ;; `ps-print-color-p' `ps-color-values': Replace pixel-components by
56 ;; color-instance-rgb-components for XEmacs.
57 ;; `ps-color-device': New function to dynamically test the device
58 ;; color capability, added where ps-print-color-p is tested.
59 ;; `ps-xemacs-face-kind-p': Fixed.
60 ;; `ps-do-despool': Permit dynamic evaluation at print time of
61 ;; ps-lpr-switches.
62 ;; `ps-eval-switch' `ps-flatten-list' `ps-flatten-list-1': New for
63 ;; the previous feature.
64 ;; `ps-gnus-print-article-from-summary': Updated for Gnus 5.
65
66
67 ;; 3.04 [jack] after [simon] Oct 8, 1996 Simon Marshall <simon@gnu.ai.mit.edu>
68 ;; `ps-print-version':
69 ;; Fix value.
70 ;; `cl' `lisp-float-type':
71 ;; Require them.
72 ;; `ps-number-of-columns' `ps-*-font-size':
73 ;; Try to select defaults better suited when `ps-landscape-mode' is non-nil.
74 ;; `ps-*-faces':
75 ;; Change default for Font Lock mode faces when `ps-print-color-p' is nil.
76 ;; `ps-right-header':
77 ;; Replace `time-stamp-yy/mm/dd' by `time-stamp-mon-dd-yyyy'.
78 ;; `ps-end-file' `ps-begin-page':
79 ;; Fix bug in page count for Ghostview.
80 ;; `ps-generate-postscript-with-faces':
81 ;; Replace `ps-sorter' by `car-less-than-car'.
82 ;; `ps-plot' `ps-generate':
83 ;; Replace `%d' by `%3d'.
84
85 ;; 3.03 [jack] Sept 27, 1996 Jacques Duthen <duthen@cegelec-red.fr>
86 ;; Merge 31 diffs between 19.29 and 19.34
87
88 ;; 3.02 [jack] June 26, 1996 Jacques Duthen <duthen@cegelec-red.fr>
89 ;; Add new page dimensions to `ps-page-dimensions-database' for `paper-type'
90 ;; Improve landscape mode `ps-landscape-mode' and multiple columns
91 ;; printing `ps-number-of-columns':
92 ;; The text and the margins are no more scaled.
93 ;; Simplify the semantics of `ps-inter-column' (space between columns).
94 ;; Add error checking for negative `ps-print-width' and `ps-print-height'.
95 ;; Change the semantics of `ps-top-margin' which is now the TOP MARGIN,
96 ;; and add `ps-header-offset' instead of having `ps-top-margin' split in 2.
97 ;; Add `ps-header-font-family', `ps-header-font-size' and
98 ;; `ps-header-title-font-size' to control the header.
99 ;; Add `ps-header-line-pad'.
100 ;; Change the semantics of `ps-font-info-database' to have symbolic
101 ;; font families.
102 ;; Add new fonts to `ps-font-info-database': `Courier' `Helvetica'
103 ;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk'
104 ;; Make public `ps-font-family' and `ps-font-size' so that the user
105 ;; can directly control the text font and size without loading ps-print.
106 ;; Add error checking for unknown font families and a message giving
107 ;; the exhaustive list of available font families.
108 ;; Document how to install a new font family.
109 ;; Add `/ReportAllFontInfo' to get all the font families of the printer.
110 ;; Add the possibility to make `mixed' font families.
111 ;; Add `ps-setup' to get the current setup.
112 ;; Add tools `ps-line-lengths' `ps-nb-pages-buffer' `ps-nb-pages-region'
113 ;; to help choose the font size.
114 ;; Split `ps-print-prologue' in two to insert info from header fonts
115 ;; Replace indexes by macro `ps-page-dimensions-get-width'
116 ;; to get access to the dimensions list.
117 ;; Add `ps-select-font' inside `ps-get-page-dimensions'.
118 ;; Fix the "clumsy" `ps-page-height' management.
119 ;; Move `ps-get-page-dimensions' to the beginning of `ps-begin-file'
120 ;; to get early error checking.
121 ;; Add sample setup `ps-jack-setup'.
122 ;;
123 ;; Rewrite a lot of postscript code and add comments inside it
124 ;; (maybe they should not (or optionally) be included in the generated
125 ;; Postscript).
126 ;; Translate the origin to (lm, bm) to simplify the other moves.
127 ;; Fix bug in `/HeaderOffset' with `/PrintStartY'.
128 ;; Fix bug in `/SetHeaderLines'.
129 ;; Change `/ReportFontInfo' for use by `/ReportAllFontInfo'.
130
131 ;; 3.01 [jack] June 4, 1996 Jacques Duthen <duthen@cegelec-red.fr>
132 ;; Manage float value for every variable representing a size.
133 ;; Add `ps-font-info-database' `ps-inter-column'
134
135 ;; 3.00 [jack] May 17, 1996 Jacques Duthen <duthen@cegelec-red.fr>
136 ;; based on 2.8 Jim's Pretty-Good version:
137 ;; Add `ps-landscape-mode' and `ps-number-of-columns'
138 ;; for dumb multi-column landscape mode.
139
31 ;; Baseline-version: 2.8. (Jim's last change version -- this 140 ;; Baseline-version: 2.8. (Jim's last change version -- this
32 ;; file may have been edited as part of Emacs without changes to the 141 ;; file may have been edited as part of Emacs without changes to the
33 ;; version number. When reporting bugs, please also report the 142 ;; version number. When reporting bugs, please also report the
34 ;; version of Emacs, if any, that ps-print was distributed with.) 143 ;; version of Emacs, if any, that ps-print was distributed with.)
35 144
36 ;;; Synched up with: FSF 19.34.
37
38 ;;; Commentary: 145 ;;; Commentary:
39 146
40 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41 ;; 148 ;;
42 ;; About ps-print 149 ;; About ps-print
43 ;; -------------- 150 ;; --------------
151 ;;
44 ;; This package provides printing of Emacs buffers on PostScript 152 ;; This package provides printing of Emacs buffers on PostScript
45 ;; printers; the buffer's bold and italic text attributes are 153 ;; printers; the buffer's bold and italic text attributes are
46 ;; preserved in the printer output. Ps-print is intended for use with 154 ;; preserved in the printer output. Ps-print is intended for use with
47 ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as 155 ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
48 ;; font-lock or hilit. 156 ;; font-lock or hilit.
157 ;;
49 ;; 158 ;;
50 ;; Using ps-print 159 ;; Using ps-print
51 ;; -------------- 160 ;; --------------
52 ;; 161 ;;
53 ;; The Commands 162 ;; The Commands
76 ;; printer; 185 ;; printer;
77 ;; 186 ;;
78 ;; spool - The PostScript image is saved temporarily in an 187 ;; spool - The PostScript image is saved temporarily in an
79 ;; Emacs buffer. Many images may be spooled locally 188 ;; Emacs buffer. Many images may be spooled locally
80 ;; before printing them. To send the spooled images 189 ;; before printing them. To send the spooled images
81 ;; to the printer, use the command ps-despool. 190 ;; to the printer, use the command `ps-despool'.
82 ;; 191 ;;
83 ;; The spooling mechanism was designed for printing lots of small 192 ;; The spooling mechanism was designed for printing lots of small
84 ;; files (mail messages or netnews articles) to save paper that would 193 ;; files (mail messages or netnews articles) to save paper that would
85 ;; otherwise be wasted on banner pages, and to make it easier to find 194 ;; otherwise be wasted on banner pages, and to make it easier to find
86 ;; your output at the printer (it's easier to pick up one 50-page 195 ;; your output at the printer (it's easier to pick up one 50-page
87 ;; printout than to find 50 single-page printouts). 196 ;; printout than to find 50 single-page printouts).
88 ;; 197 ;;
89 ;; Ps-print has a hook in the kill-emacs-hooks so that you won't 198 ;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't
90 ;; accidentally quit from Emacs while you have unprinted PostScript 199 ;; accidentally quit from Emacs while you have unprinted PostScript
91 ;; waiting in the spool buffer. If you do attempt to exit with 200 ;; waiting in the spool buffer. If you do attempt to exit with
92 ;; spooled PostScript, you'll be asked if you want to print it, and if 201 ;; spooled PostScript, you'll be asked if you want to print it, and if
93 ;; you decline, you'll be asked to confirm the exit; this is modeled 202 ;; you decline, you'll be asked to confirm the exit; this is modeled
94 ;; on the confirmation that Emacs uses for modified buffers. 203 ;; on the confirmation that Emacs uses for modified buffers.
121 ;; spool the image in Emacs to 230 ;; spool the image in Emacs to
122 ;; send to the printer later. 231 ;; send to the printer later.
123 ;; 232 ;;
124 ;; 233 ;;
125 ;; Invoking Ps-Print 234 ;; Invoking Ps-Print
235 ;; -----------------
126 ;; 236 ;;
127 ;; To print your buffer, type 237 ;; To print your buffer, type
128 ;; 238 ;;
129 ;; M-x ps-print-buffer 239 ;; M-x ps-print-buffer
130 ;; 240 ;;
136 ;; 246 ;;
137 ;; it will save the PostScript image to a file instead of sending it 247 ;; it will save the PostScript image to a file instead of sending it
138 ;; to the printer; you will be prompted for the name of the file to 248 ;; to the printer; you will be prompted for the name of the file to
139 ;; save the image to. The prefix argument is ignored by the commands 249 ;; save the image to. The prefix argument is ignored by the commands
140 ;; that spool their images, but you may save the spooled images to a 250 ;; that spool their images, but you may save the spooled images to a
141 ;; file by giving a prefix argument to ps-despool: 251 ;; file by giving a prefix argument to `ps-despool':
142 ;; 252 ;;
143 ;; C-u M-x ps-despool 253 ;; C-u M-x ps-despool
144 ;; 254 ;;
145 ;; When invoked this way, ps-despool will prompt you for the name of 255 ;; When invoked this way, `ps-despool' will prompt you for the name of
146 ;; the file to save to. 256 ;; the file to save to.
147 ;; 257 ;;
148 ;; Any of the ps-print- commands can be bound to keys; I recommend 258 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
149 ;; binding ps-spool-buffer-with-faces, ps-spool-region-with-faces, and 259 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
150 ;; ps-despool. Here are the bindings I use on my Sun 4 keyboard: 260 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
151 ;; 261 ;;
152 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc 262 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
153 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces) 263 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
154 ;; (global-set-key '(control f22) 'ps-despool) 264 ;; (global-set-key '(control f22) 'ps-despool)
155 ;; 265 ;;
156 ;; 266 ;;
157 ;; The Printer Interface 267 ;; The Printer Interface
158 ;; 268 ;; ---------------------
159 ;; The variables ps-lpr-command and ps-lpr-switches determine what 269 ;;
270 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
160 ;; command is used to send the PostScript images to the printer, and 271 ;; command is used to send the PostScript images to the printer, and
161 ;; what arguments to give the command. These are analogous to lpr- 272 ;; what arguments to give the command. These are analogous to
162 ;; command and lpr-switches. 273 ;; `lpr-command' and `lpr-switches'.
163 ;; 274 ;;
164 ;; NOTE: ps-lpr-command and ps-lpr-switches take their initial values 275 ;; Make sure that they contain appropriate values for your system;
165 ;; from the variables lpr-command and lpr-switches. If you have 276 ;; see the usage notes below and the documentation of these variables.
166 ;; lpr-command set to invoke a pretty-printer such as enscript, 277 ;;
167 ;; then ps-print won't work properly. ps-lpr-command must name 278 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
279 ;; from the variables `lpr-command' and `lpr-switches'. If you have
280 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
281 ;; then ps-print won't work properly. `ps-lpr-command' must name
168 ;; a program that does not format the files it prints. 282 ;; a program that does not format the files it prints.
169 ;; 283 ;;
170 ;; 284 ;;
171 ;; How Ps-Print Deals With Fonts 285 ;; The Page Layout
286 ;; ---------------
287 ;;
288 ;; All dimensions are floats in PostScript points.
289 ;; 1 inch == 2.54 cm == 72 points
290 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
291 ;;
292 ;; The variable `ps-paper-type' determines the size of paper ps-print
293 ;; formats for; it should contain one of the symbols:
294 ;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
295 ;; `ledger' `statement' `executive' `a4small' `b4' `b5'
296 ;;
297 ;; The variable `ps-landscape-mode' determines the orientation
298 ;; of the printing on the page:
299 ;; nil means `portrait' mode, non-nil means `landscape' mode.
300 ;; There is no oblique mode yet, though this is easy to do in ps.
301
302 ;; In landscape mode, the text is NOT scaled: you may print 70 lines
303 ;; in portrait mode and only 50 lignes in landscape mode.
304 ;; The margins represent margins in the printed paper:
305 ;; the top margin is the margin between the top of the page
306 ;; and the printed header, whatever the orientation is.
307 ;;
308 ;; The variable `ps-number-of-columns' determines the number of columns
309 ;; both in landscape and portrait mode.
310 ;; You can use:
311 ;; - (the standard) one column portrait mode
312 ;; - (my favorite) two columns landscape mode (which spares trees)
313 ;; but also
314 ;; - one column landscape mode for files with very long lines.
315 ;; - multi-column portrait or landscape mode
316 ;;
317 ;;
318 ;; Horizontal layout
319 ;; -----------------
320 ;;
321 ;; The horizontal layout is determined by the variables
322 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
323 ;; as follows:
324 ;;
325 ;; ------------------------------------------
326 ;; | | | | | | | |
327 ;; | lm | text | ic | text | ic | text | rm |
328 ;; | | | | | | | |
329 ;; ------------------------------------------
330 ;;
331 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
332 ;; Usually, lm = rm > 0 and ic = lm
333 ;; If (ic < 0), the text of adjacent columns can overlap.
334 ;;
335 ;;
336 ;; Vertical layout
337 ;; ---------------
338 ;;
339 ;; The vertical layout is determined by the variables
340 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
341 ;; as follows:
342 ;;
343 ;; |--------| |--------|
344 ;; | tm | | tm |
345 ;; |--------| |--------|
346 ;; | header | | |
347 ;; |--------| | |
348 ;; | ho | | |
349 ;; |--------| or | text |
350 ;; | | | |
351 ;; | text | | |
352 ;; | | | |
353 ;; |--------| |--------|
354 ;; | bm | | bm |
355 ;; |--------| |--------|
356 ;;
357 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
358 ;; The margins represent margins in the printed paper:
359 ;; the top margin is the margin between the top of the page
360 ;; and the printed header, whatever the orientation is.
361 ;;
362 ;;
363 ;; Headers
364 ;; -------
365 ;;
366 ;; Ps-print can print headers at the top of each column; the default
367 ;; headers contain the following four items: on the left, the name of
368 ;; the buffer and, if the buffer is visiting a file, the file's
369 ;; directory; on the right, the page number and date of printing.
370 ;; The default headers look something like this:
371 ;;
372 ;; ps-print.el 1/21
373 ;; /home/jct/emacs-lisp/ps/new 94/12/31
374 ;;
375 ;; When printing on duplex printers, left and right are reversed so
376 ;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
377 ;;
378 ;; Headers are configurable:
379 ;; To turn them off completely, set `ps-print-header' to nil.
380 ;; To turn off the header's gaudy framing box,
381 ;; set `ps-print-header-frame' to nil.
382 ;;
383 ;; The font family and size of text in the header are determined
384 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
385 ;; `ps-header-title-font-size' (see below).
386 ;;
387 ;; The variable `ps-header-line-pad' determines the portion of a header
388 ;; title line height to insert between the header frame and the text
389 ;; it contains, both in the vertical and horizontal directions:
390 ;; .5 means half a line.
391
392 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
393 ;; to omit the total page count and just print the page number,
394 ;; set `ps-show-n-of-n' to nil.
395 ;;
396 ;; The amount of information in the header can be changed by changing
397 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
398 ;; the header will show only the buffer name and page number. To show
399 ;; more, set `ps-header-lines' to 3, and the header will show the time of
400 ;; printing below the date.
401 ;;
402 ;; To change the content of the headers, change the variables
403 ;; `ps-left-header' and `ps-right-header'.
404 ;; These variables are lists, specifying top-to-bottom the text
405 ;; to display on the left or right side of the header.
406 ;; Each element of the list should be a string or a symbol.
407 ;; Strings are inserted directly into the PostScript arrays,
408 ;; and should contain the PostScript string delimiters '(' and ')'.
409 ;;
410 ;; Symbols in the header format lists can either represent functions
411 ;; or variables. Functions are called, and should return a string to
412 ;; show in the header. Variables should contain strings to display in
413 ;; the header. In either case, function or variable, the PostScript
414 ;; string delimiters are added by ps-print, and should not be part of
415 ;; the returned value.
416 ;;
417 ;; Here's an example: say we want the left header to display the text
418 ;;
419 ;; Moe
420 ;; Larry
421 ;; Curly
422 ;;
423 ;; where we have a function to return "Moe"
424 ;;
425 ;; (defun moe-func ()
426 ;; "Moe")
427 ;;
428 ;; a variable specifying "Larry"
429 ;;
430 ;; (setq larry-var "Larry")
431 ;;
432 ;; and a literal for "Curly". Here's how `ps-left-header' should be
433 ;; set:
434 ;;
435 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
436 ;;
437 ;; Note that Curly has the PostScript string delimiters inside his
438 ;; quotes -- those aren't misplaced lisp delimiters!
439 ;;
440 ;; Without them, PostScript would attempt to call the undefined
441 ;; function Curly, which would result in a PostScript error.
442 ;;
443 ;; Since most printers don't report PostScript errors except by
444 ;; aborting the print job, this kind of error can be hard to track down.
445 ;;
446 ;; Consider yourself warned!
447 ;;
448 ;;
449 ;; Duplex Printers
450 ;; ---------------
451 ;;
452 ;; If you have a duplex-capable printer (one that prints both sides of
453 ;; the paper), set `ps-spool-duplex' to t.
454 ;; Ps-print will insert blank pages to make sure each buffer starts
455 ;; on the correct side of the paper.
456 ;; Don't forget to set `ps-lpr-switches' to select duplex printing
457 ;; for your printer.
458 ;;
459 ;;
460 ;; Font managing
461 ;; -------------
462 ;;
463 ;; Ps-print now knows rather precisely some fonts:
464 ;; the variable `ps-font-info-database' contains information
465 ;; for a list of font families (currently mainly `Courier' `Helvetica'
466 ;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
467 ;; Each font family contains the font names for standard, bold, italic
468 ;; and bold-italic characters, a reference size (usually 10) and the
469 ;; corresponding line height, width of a space and average character width.
470 ;;
471 ;; The variable `ps-font-family' determines which font family
472 ;; is to be used for ordinary text.
473 ;; If its value does not correspond to a known font family,
474 ;; an error message is printed into the `*Messages*' buffer,
475 ;; which lists the currently available font families.
476 ;;
477 ;; The variable `ps-font-size' determines the size (in points)
478 ;; of the font for ordinary text, when generating Postscript.
479 ;; Its value is a float.
480 ;;
481 ;; Similarly, the variable `ps-header-font-family' determines
482 ;; which font family is to be used for text in the header.
483 ;; The variable `ps-header-font-size' determines the font size,
484 ;; in points, for text in the header.
485 ;; The variable `ps-header-title-font-size' determines the font size,
486 ;; in points, for the top line of text in the header.
487 ;;
488 ;;
489 ;; Adding a new font family
490 ;; ------------------------
491 ;;
492 ;; To use a new font family, you MUST first teach ps-print
493 ;; this font, ie add its information to `ps-font-info-database',
494 ;; otherwise ps-print cannot correctly place line and page breaks.
495 ;;
496 ;; For example, assuming `Helvetica' is unkown,
497 ;; you first need to do the following ONLY ONCE:
498 ;;
499 ;; - create a new buffer
500 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
501 ;; - open this file and find the line:
502 ;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
503 ;; - delete the leading `%' (which is the Postscript comment character)
504 ;; - replace in this line `Courier' by the new font (say `Helvetica')
505 ;; to get the line:
506 ;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
507 ;; - send this file to the printer (or to ghostscript).
508 ;; You should read the following on the output page:
509 ;;
510 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
511 ;; and a crude estimate of average character width is 5.09243
512 ;;
513 ;; - Add these values to the `ps-font-info-database':
514 ;; (setq ps-font-info-database
515 ;; (append
516 ;; '((Helvetica ; the family name
517 ;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
518 ;; 10.0 11.56 2.78 5.09243))
519 ;; ps-font-info-database))
520 ;; - Now you can use this font family with any size:
521 ;; (setq ps-font-family 'Helvetica)
522 ;; - if you want to use this family in another emacs session, you must
523 ;; put into your `~/.emacs':
524 ;; (require 'ps-print)
525 ;; (setq ps-font-info-database (append ...)))
526 ;; if you don't want to load ps-print, you have to copy the whole value:
527 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
528 ;; or, if you can wait until the `ps-print-hook' is implemented, do:
529 ;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...)))
530 ;; This does not work yet, since there is no `ps-print-hook' yet.
531 ;;
532 ;; You can create new `mixed' font families like:
533 ;; (my-mixed-family
534 ;; "Courier-Bold" "Helvetica"
535 ;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic"
536 ;; 10.0 10.55 6.0 6.0)
537 ;; Now you can use your new font family with any size:
538 ;; (setq ps-font-family 'my-mixed-family)
539 ;;
540 ;; You can get information on all the fonts resident in YOUR printer
541 ;; by uncommenting the line:
542 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
543 ;;
544 ;; The postscript file should be sent to YOUR postscript printer.
545 ;; If you send it to ghostscript or to another postscript printer,
546 ;; you may get slightly different results.
547 ;; Anyway, as ghostscript fonts are autoload, you won't get
548 ;; much font info.
549 ;;
550 ;;
551 ;; How Ps-Print Deals With Faces
552 ;; -----------------------------
172 ;; 553 ;;
173 ;; The ps-print-*-with-faces commands attempt to determine which faces 554 ;; The ps-print-*-with-faces commands attempt to determine which faces
174 ;; should be printed in bold or italic, but their guesses aren't 555 ;; should be printed in bold or italic, but their guesses aren't
175 ;; always right. For example, you might want to map colors into faces 556 ;; always right. For example, you might want to map colors into faces
176 ;; so that blue faces print in bold, and red faces in italic. 557 ;; so that blue faces print in bold, and red faces in italic.
177 ;; 558 ;;
178 ;; It is possible to force ps-print to consider specific faces bold or 559 ;; It is possible to force ps-print to consider specific faces bold or
179 ;; italic, no matter what font they are displayed in, by setting the 560 ;; italic, no matter what font they are displayed in, by setting the
180 ;; variables ps-bold-faces and ps-italic-faces. These variables 561 ;; variables `ps-bold-faces' and `ps-italic-faces'. These variables
181 ;; contain lists of faces that ps-print should consider bold or 562 ;; contain lists of faces that ps-print should consider bold or
182 ;; italic; to set them, put code like the following into your .emacs 563 ;; italic; to set them, put code like the following into your .emacs
183 ;; file: 564 ;; file:
184 ;; 565 ;;
185 ;; (setq ps-bold-faces '(my-blue-face)) 566 ;; (setq ps-bold-faces '(my-blue-face))
186 ;; (setq ps-italic-faces '(my-red-face)) 567 ;; (setq ps-italic-faces '(my-red-face))
187 ;; 568 ;;
188 ;; Faces like bold-italic that are both bold and italic should go in 569 ;; Faces like bold-italic that are both bold and italic should go in
189 ;; *both* lists. 570 ;; *both* lists.
190 ;;
191 ;; Ps-print does not attempt to guess the sizes of fonts; all text is
192 ;; rendered using the Courier font family, in 10 point size. To
193 ;; change the font family, change the variables ps-font, ps-font-bold,
194 ;; ps-font-italic, and ps-font-bold-italic; fixed-pitch fonts work
195 ;; best, but are not required. To change the font size, change the
196 ;; variable ps-font-size.
197 ;;
198 ;; If you change the font family or size, you MUST also change the
199 ;; variables ps-line-height, ps-avg-char-width, and ps-space-width, or
200 ;; ps-print cannot correctly place line and page breaks.
201 ;; 571 ;;
202 ;; Ps-print keeps internal lists of which fonts are bold and which are 572 ;; Ps-print keeps internal lists of which fonts are bold and which are
203 ;; italic; these lists are built the first time you invoke ps-print. 573 ;; italic; these lists are built the first time you invoke ps-print.
204 ;; For the sake of efficiency, the lists are built only once; the same 574 ;; For the sake of efficiency, the lists are built only once; the same
205 ;; lists are referred in later invocations of ps-print. 575 ;; lists are referred in later invocations of ps-print.
206 ;; 576 ;;
207 ;; Because these lists are built only once, it's possible for them to 577 ;; Because these lists are built only once, it's possible for them to
208 ;; get out of sync, if a face changes, or if new faces are added. To 578 ;; get out of sync, if a face changes, or if new faces are added. To
209 ;; get the lists back in sync, you can set the variable 579 ;; get the lists back in sync, you can set the variable
210 ;; ps-build-face-reference to t, and the lists will be rebuilt the 580 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
211 ;; next time ps-print is invoked. 581 ;; next time ps-print is invoked.
212 ;; 582 ;;
213 ;; 583 ;;
214 ;; How Ps-Print Deals With Color 584 ;; How Ps-Print Deals With Color
585 ;; -----------------------------
215 ;; 586 ;;
216 ;; Ps-print detects faces with foreground and background colors 587 ;; Ps-print detects faces with foreground and background colors
217 ;; defined and embeds color information in the PostScript image. The 588 ;; defined and embeds color information in the PostScript image.
218 ;; default foreground and background colors are defined by the 589 ;; The default foreground and background colors are defined by the
219 ;; variables ps-default-fg and ps-default-bg. On black-and-white 590 ;; variables `ps-default-fg' and `ps-default-bg'.
220 ;; printers, colors are displayed in grayscale. To turn off color 591 ;; On black-and-white printers, colors are displayed in grayscale.
221 ;; output, set ps-print-color-p to nil. 592 ;; To turn off color output, set `ps-print-color-p' to nil.
222 ;; 593 ;;
223 ;; 594 ;;
224 ;; Headers 595 ;; Utilities
225 ;; 596 ;; ---------
226 ;; Ps-print can print headers at the top of each page; the default 597 ;;
227 ;; headers contain the following four items: on the left, the name of 598 ;; Some tools are provided to help you customize your font setup.
228 ;; the buffer and, if the buffer is visiting a file, the file's 599 ;;
229 ;; directory; on the right, the page number and date of printing. The 600 ;; `ps-setup' returns (some part of) the current setup.
230 ;; default headers look something like this: 601 ;;
231 ;; 602 ;; To avoid wrapping too many lines, you may want to adjust the
232 ;; ps-print.el 1/21 603 ;; left and right margins and the font size. On UN*X systems, do:
233 ;; /home/jct/emacs-lisp/ps/new 94/12/31 604 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
234 ;; 605 ;; to determine the longest lines of your file.
235 ;; When printing on duplex printers, left and right are reversed so 606 ;; Then, the command `ps-line-lengths' will give you the correspondance
236 ;; that the page numbers are toward the outside. 607 ;; between a line length (number of characters) and the maximum font
237 ;; 608 ;; size which doesn't wrap such a line with the current ps-print setup.
238 ;; Headers are configurable. To turn them off completely, set 609 ;;
239 ;; ps-print-header to nil. To turn off the header's gaudy framing 610 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
240 ;; box, set ps-print-header-frame to nil. Page numbers are printed in 611 ;; the correspondance between a number of pages and the maximum font
241 ;; "n/m" format, indicating page n of m pages; to omit the total page 612 ;; size which allow the number of lines of the current buffer or of
242 ;; count and just print the page number, set ps-show-n-of-n to nil. 613 ;; its current region to fit in this number of pages.
243 ;; 614 ;; Note: line folding is not taken into account in this process
244 ;; The amount of information in the header can be changed by changing 615 ;; and could change the results.
245 ;; the number of lines. To show less, set ps-header-lines to 1, and 616 ;;
246 ;; the header will show only the buffer name and page number. To show 617 ;;
247 ;; more, set ps-header-lines to 3, and the header will show the time of
248 ;; printing below the date.
249 ;;
250 ;; To change the content of the headers, change the variables
251 ;; ps-left-header and ps-right-header. These variables are lists,
252 ;; specifying top-to-bottom the text to display on the left or right
253 ;; side of the header. Each element of the list should be a string or
254 ;; a symbol. Strings are inserted directly into the PostScript
255 ;; arrays, and should contain the PostScript string delimiters '(' and
256 ;; ')'.
257 ;;
258 ;; Symbols in the header format lists can either represent functions
259 ;; or variables. Functions are called, and should return a string to
260 ;; show in the header. Variables should contain strings to display in
261 ;; the header. In either case, function or variable, the PostScript
262 ;; string delimeters are added by ps-print, and should not be part of
263 ;; the returned value.
264 ;;
265 ;; Here's an example: say we want the left header to display the text
266 ;;
267 ;; Moe
268 ;; Larry
269 ;; Curly
270 ;;
271 ;; where we have a function to return "Moe"
272 ;;
273 ;; (defun moe-func ()
274 ;; "Moe")
275 ;;
276 ;; a variable specifying "Larry"
277 ;;
278 ;; (setq larry-var "Larry")
279 ;;
280 ;; and a literal for "Curly". Here's how ps-left-header should be
281 ;; set:
282 ;;
283 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
284 ;;
285 ;; Note that Curly has the PostScript string delimiters inside his
286 ;; quotes -- those aren't misplaced lisp delimiters! Without them,
287 ;; PostScript would attempt to call the undefined function Curly,
288 ;; which would result in a PostScript error. Since most printers
289 ;; don't report PostScript errors except by aborting the print job,
290 ;; this kind of error can be hard to track down. Consider yourself
291 ;; warned.
292 ;;
293 ;;
294 ;; Duplex Printers
295 ;;
296 ;; If you have a duplex-capable printer (one that prints both sides of
297 ;; the paper), set ps-spool-duplex to t. Ps-print will insert blank
298 ;; pages to make sure each buffer starts on the correct side of the
299 ;; paper. Don't forget to set ps-lpr-switches to select duplex
300 ;; printing for your printer.
301 ;;
302 ;;
303 ;; Paper Size
304 ;;
305 ;; The variable ps-paper-type determines the size of paper ps-print
306 ;; formats for; it should contain one of the symbols ps-letter,
307 ;; ps-legal, or ps-a4. The default is ps-letter.
308 ;;
309 ;; Make sure that the variables ps-lpr-command and ps-lpr-switches
310 ;; contain appropriate values for your system; see the usage notes
311 ;; below and the documentation of these variables.
312 ;;
313 ;; New since version 1.5 618 ;; New since version 1.5
314 ;; --------------------- 619 ;; ---------------------
620 ;;
315 ;; Color output capability. 621 ;; Color output capability.
316 ;;
317 ;; Automatic detection of font attributes (bold, italic). 622 ;; Automatic detection of font attributes (bold, italic).
318 ;;
319 ;; Configurable headers with page numbers. 623 ;; Configurable headers with page numbers.
320 ;;
321 ;; Slightly faster. 624 ;; Slightly faster.
322 ;;
323 ;; Support for different paper sizes. 625 ;; Support for different paper sizes.
324 ;;
325 ;; Better conformance to PostScript Document Structure Conventions. 626 ;; Better conformance to PostScript Document Structure Conventions.
627 ;;
628 ;;
629 ;; New since version 2.8
630 ;; ---------------------
631 ;;
632 ;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
633 ;;
634 ;; Font familiy and float size for text and header.
635 ;; Landscape mode.
636 ;; Multiple columns.
637 ;; Tools for page setup.
326 ;; 638 ;;
327 ;; 639 ;;
328 ;; Known bugs and limitations of ps-print: 640 ;; Known bugs and limitations of ps-print:
329 ;; -------------------------------------- 641 ;; --------------------------------------
642 ;;
330 ;; Although color printing will work in XEmacs 19.12, it doesn't work 643 ;; Although color printing will work in XEmacs 19.12, it doesn't work
331 ;; well; in particular, bold or italic fonts don't print in the right 644 ;; well; in particular, bold or italic fonts don't print in the right
332 ;; background color. 645 ;; background color.
333 ;; 646 ;;
334 ;; Invisible properties aren't correctly ignored in XEmacs 19.12. 647 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
335 ;; 648 ;;
336 ;; Automatic font-attribute detection doesn't work well, especially 649 ;; Automatic font-attribute detection doesn't work well, especially
337 ;; with hilit19 and older versions of get-create-face. Users having 650 ;; with hilit19 and older versions of get-create-face. Users having
338 ;; problems with auto-font detection should use the lists ps-italic- 651 ;; problems with auto-font detection should use the lists
339 ;; faces and ps-bold-faces and/or turn off automatic detection by 652 ;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic
340 ;; setting ps-auto-font-detect to nil. 653 ;; detection by setting `ps-auto-font-detect' to nil.
341 ;; 654 ;;
342 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 655 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
343 ;; in tty mode; use the lists ps-italic-faces and ps-bold-faces 656 ;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces'
344 ;; instead. 657 ;; instead.
345 ;; 658 ;;
346 ;; Still too slow; could use some hand-optimization. 659 ;; Still too slow; could use some hand-optimization.
347 ;; 660 ;;
348 ;; ASCII Control characters other than tab, linefeed and pagefeed are 661 ;; ASCII Control characters other than tab, linefeed and pagefeed are
352 ;; 665 ;;
353 ;; Faces are always treated as opaque. 666 ;; Faces are always treated as opaque.
354 ;; 667 ;;
355 ;; Epoch and Emacs 18 not supported. At all. 668 ;; Epoch and Emacs 18 not supported. At all.
356 ;; 669 ;;
357 ;; 670 ;; Fixed-pitch fonts work better for line folding, but are not required.
358 ;; Features to add: 671 ;;
359 ;; --------------- 672 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
360 ;; 2-up and 4-up capability. 673 ;; of folding lines.
361 ;; 674 ;;
362 ;; Line numbers. 675 ;;
363 ;; 676 ;; Things to change:
364 ;; Wide-print (landscape) capability. 677 ;; ----------------
678 ;;
679 ;; Add `ps-print-hook' (I don't know how to do that (yet!)).
680 ;; Add 4-up capability (really needed?).
681 ;; Add line numbers (should not be too hard).
682 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
683 ;; Put one header per page over the columns (easy but needed?).
684 ;; Improve the memory management for big files (hard?).
685 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
686 ;; of folding lines.
365 ;; 687 ;;
366 ;; 688 ;;
367 ;; Acknowledgements 689 ;; Acknowledgements
368 ;; ---------------- 690 ;; ----------------
691 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
692 ;; [jack]
693 ;;
369 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for 694 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
370 ;; color and the invisible property. 695 ;; color and the invisible property.
371 ;; 696 ;;
372 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing 697 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
373 ;; the initial port to Emacs 19. His code is no longer part of 698 ;; the initial port to Emacs 19. His code is no longer part of
389 ;; Jim 714 ;; Jim
390 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 715 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
391 716
392 ;;; Code: 717 ;;; Code:
393 718
394 (defconst ps-print-version "2.8" 719 (eval-when-compile
395 "ps-print.el,v 2.8 1995/05/04 12:06:10 jct Exp 720 (require 'cl))
396 721
397 Jim's last change version -- this file may have been edited as part of 722 (unless (featurep 'lisp-float-type)
398 Emacs without changes to the version number. When reporting bugs, 723 (error "`ps-print' requires floating point support"))
399 please also report the version of Emacs, if any, that ps-print was
400 distributed with.
401
402 Please send all bug fixes and enhancements to
403 Jim Thompson <thompson@wg2.waii.com>.")
404 724
405 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 725 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
406 ;; User Variables: 726 ;; User Variables:
407 727
728 ;;; Interface to the command system
729
408 (defvar ps-lpr-command lpr-command 730 (defvar ps-lpr-command lpr-command
409 "*The shell command for printing a PostScript file.") 731 "*The shell command for printing a PostScript file.")
410 732
411 (defvar ps-lpr-switches lpr-switches 733 (defvar ps-lpr-switches lpr-switches
412 "*A list of extra switches to pass to `ps-lpr-command'.") 734 "*A list of extra switches to pass to `ps-lpr-command'.")
735
736 ;;; Page layout
737
738 ;; All page dimensions are in PostScript points.
739 ;; 1 inch == 2.54 cm == 72 points
740 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
741
742 ;; Letter 8.5 inch x 11.0 inch
743 ;; Legal 8.5 inch x 14.0 inch
744 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
745
746 ;; LetterSmall 7.68 inch x 10.16 inch
747 ;; Tabloid 11.0 inch x 17.0 inch
748 ;; Ledger 17.0 inch x 11.0 inch
749 ;; Statement 5.5 inch x 8.5 inch
750 ;; Executive 7.5 inch x 10.0 inch
751 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
752 ;; A4Small 7.47 inch x 10.85 inch
753 ;; B4 10.125 inch x 14.33 inch
754 ;; B5 7.16 inch x 10.125 inch
755
756 (defvar ps-page-dimensions-database
757 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54))
758 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54))
759 (list 'letter (* 72 8.5) (* 72 11.0))
760 (list 'legal (* 72 8.5) (* 72 14.0))
761 (list 'letter-small (* 72 7.68) (* 72 10.16))
762 (list 'tabloid (* 72 11.0) (* 72 17.0))
763 (list 'ledger (* 72 17.0) (* 72 11.0))
764 (list 'statement (* 72 5.5) (* 72 8.5))
765 (list 'executive (* 72 7.5) (* 72 10.0))
766 (list 'a4small (* 72 7.47) (* 72 10.85))
767 (list 'b4 (* 72 10.125) (* 72 14.33))
768 (list 'b5 (* 72 7.16) (* 72 10.125)))
769 "*List associating a symbolic paper type to its width and height.
770 see `ps-paper-type'.")
771
772 ;;;###autoload
773 (defvar ps-paper-type 'letter
774 "*Specifies the size of paper to format for.
775 Should be one of the paper types defined in `ps-page-dimensions-database', for
776 example `letter', `legal' or `a4'.")
777
778 (defvar ps-landscape-mode 'nil
779 "*Non-nil means print in landscape mode.")
780
781 (defvar ps-number-of-columns (if ps-landscape-mode 2 1)
782 "*Specifies the number of columns")
783
784 ;;; Horizontal layout
785
786 ;; ------------------------------------------
787 ;; | | | | | | | |
788 ;; | lm | text | ic | text | ic | text | rm |
789 ;; | | | | | | | |
790 ;; ------------------------------------------
791
792 (defvar ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
793 "*Left margin in points (1/72 inch).")
794
795 (defvar ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
796 "*Right margin in points (1/72 inch).")
797
798 (defvar ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
799 "*Horizontal space between columns in points (1/72 inch).")
800
801 ;;; Vertical layout
802
803 ;; |--------|
804 ;; | tm |
805 ;; |--------|
806 ;; | header |
807 ;; |--------|
808 ;; | ho |
809 ;; |--------|
810 ;; | text |
811 ;; |--------|
812 ;; | bm |
813 ;; |--------|
814
815 (defvar ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
816 "*Bottom margin in points (1/72 inch).")
817
818 (defvar ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
819 "*Top margin in points (1/72 inch).")
820
821 (defvar ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
822 "*Vertical space in points (1/72 inch) between the main text and the header.")
823
824 (defvar ps-header-line-pad 0.15
825 "*Portion of a header title line height to insert between the header frame
826 and the text it contains, both in the vertical and horizontal directions.")
827
828 ;;; Header setup
829
830 (defvar ps-print-header t
831 "*Non-nil means print a header at the top of each page.
832 By default, the header displays the buffer name, page number, and, if
833 the buffer is visiting a file, the file's directory. Headers are
834 customizable by changing variables `ps-header-left' and
835 `ps-header-right'.")
836
837 (defvar ps-print-header-frame t
838 "*Non-nil means draw a gaudy frame around the header.")
839
840 (defvar ps-header-lines 2
841 "*Number of lines to display in page header, when generating Postscript.")
842 (make-variable-buffer-local 'ps-header-lines)
843
844 (defvar ps-show-n-of-n t
845 "*Non-nil means show page numbers as N/M, meaning page N of M.
846 Note: page numbers are displayed as part of headers, see variable
847 `ps-print-headers'.")
413 848
414 (defvar ps-spool-duplex nil ; Not many people have duplex 849 (defvar ps-spool-duplex nil ; Not many people have duplex
415 ; printers, so default to nil. 850 ; printers, so default to nil.
416 "*Non-nil indicates spooling is for a two-sided printer. 851 "*Non-nil indicates spooling is for a two-sided printer.
417 For a duplex printer, the `ps-spool-*' commands will insert blank pages 852 For a duplex printer, the `ps-spool-*' commands will insert blank pages
418 as needed between print jobs so that the next buffer printed will 853 as needed between print jobs so that the next buffer printed will
419 start on the right page. Also, if headers are turned on, the headers 854 start on the right page. Also, if headers are turned on, the headers
420 will be reversed on duplex printers so that the page numbers fall to 855 will be reversed on duplex printers so that the page numbers fall to
421 the left on even-numbered pages.") 856 the left on even-numbered pages.")
422 857
423 ;;;###autoload 858 ;;; Fonts
424 (defvar ps-paper-type 'ps-letter 859
425 "*Specifies the size of paper to format for. Should be one of 860 (defvar ps-font-info-database
426 `ps-letter', `ps-legal', or `ps-a4'.") 861 '((Courier ; the family key
427 862 "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique"
428 (defvar ps-print-header t 863 10.0 10.55 6.0 6.0)
429 "*Non-nil means print a header at the top of each page. 864 (Helvetica ; the family key
430 By default, the header displays the buffer name, page number, and, if 865 "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
431 the buffer is visiting a file, the file's directory. Headers are 866 10.0 11.56 2.78 5.09243)
432 customizable by changing variables `ps-header-left' and 867 (Times
433 `ps-header-right'.") 868 "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic"
434 869 10.0 11.0 2.5 4.71432)
435 (defvar ps-print-header-frame t 870 (Palatino
436 "*Non-nil means draw a gaudy frame around the header.") 871 "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic"
437 872 10.0 12.1 2.5 5.08676)
438 (defvar ps-show-n-of-n t 873 (Helvetica-Narrow
439 "*Non-nil means show page numbers as N/M, meaning page N of M. 874 "Helvetica-Narrow" "Helvetica-Narrow-Bold"
440 Note: page numbers are displayed as part of headers, see variable 875 "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique"
441 `ps-print-headers'.") 876 10.0 11.56 2.2796 4.17579)
877 (NewCenturySchlbk
878 "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold"
879 "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic"
880 10.0 12.15 2.78 5.31162)
881 ;; got no bold for the next ones
882 (AvantGarde-Book
883 "AvantGarde-Book" "AvantGarde-Book"
884 "AvantGarde-BookOblique" "AvantGarde-BookOblique"
885 10.0 11.77 2.77 5.45189)
886 (AvantGarde-Demi
887 "AvantGarde-Demi" "AvantGarde-Demi"
888 "AvantGarde-DemiOblique" "AvantGarde-DemiOblique"
889 10.0 12.72 2.8 5.51351)
890 (Bookman-Demi
891 "Bookman-Demi" "Bookman-Demi"
892 "Bookman-DemiItalic" "Bookman-DemiItalic"
893 10.0 11.77 3.4 6.05946)
894 (Bookman-Light
895 "Bookman-Light" "Bookman-Light"
896 "Bookman-LightItalic" "Bookman-LightItalic"
897 10.0 11.79 3.2 5.67027)
898 ;; got no bold and no italic for the next ones
899 (Symbol
900 "Symbol" "Symbol" "Symbol" "Symbol"
901 10.0 13.03 2.5 3.24324)
902 (Zapf-Dingbats
903 "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats"
904 10.0 9.63 2.78 2.78)
905 (Zapf-Chancery-MediumItalic
906 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
907 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
908 10.0 11.45 2.2 4.10811)
909 )
910 "*Font info database: font family (the key), name, bold, italic, bold-italic,
911 reference size, line height, space width, average character width.
912 To get the info for another specific font (say Helvetica), do the following:
913 - create a new buffer
914 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
915 - open this file and delete the leading `%' (which is the Postscript
916 comment character) from the line
917 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
918 to get the line
919 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
920 - add the values to `ps-font-info-database'.
921 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.")
922
923 (defvar ps-font-family 'Courier
924 "Font family name for ordinary text, when generating Postscript.")
925
926 (defvar ps-font-size (if ps-landscape-mode 7 8.5)
927 "Font size, in points, for ordinary text, when generating Postscript.")
928
929 (defvar ps-header-font-family 'Helvetica
930 "Font family name for text in the header, when generating Postscript.")
931
932 (defvar ps-header-font-size (if ps-landscape-mode 10 12)
933 "Font size, in points, for text in the header, when generating Postscript.")
934
935 (defvar ps-header-title-font-size (if ps-landscape-mode 12 14)
936 "Font size, in points, for the top line of text in the header,
937 when generating Postscript.")
938
939 ;;; Colors
442 940
443 ;;;###autoload 941 ;;;###autoload
444 ;;; The 19.33 fsf version includes a test on pixel components instead 942 ;;; The 19.33 fsf version includes a test on pixel components instead
445 ;;; of color-instance-rgb-components 943 ;;; of color-instance-rgb-components
446 (defvar ps-print-color-p (and (or (fboundp 'x-color-values) ; fsf 944 (defvar ps-print-color-p (or (fboundp 'x-color-values) ; fsf
447 (fboundp 'color-instance-rgb-components)) 945 (fboundp 'color-instance-rgb-components))
448 ; xemacs 946 ; xemacs
449 (fboundp 'float)) 947 ; Printing color requires x-color-values.
450 ; Printing color requires both floating point and x-color-values.
451 "*If non-nil, print the buffer's text in color.") 948 "*If non-nil, print the buffer's text in color.")
452 949
453 (defvar ps-default-fg '(0.0 0.0 0.0) 950 (defvar ps-default-fg '(0.0 0.0 0.0)
454 "*RGB values of the default foreground color. Defaults to black.") 951 "*RGB values of the default foreground color. Defaults to black.")
455 952
456 (defvar ps-default-bg '(1.0 1.0 1.0) 953 (defvar ps-default-bg '(1.0 1.0 1.0)
457 "*RGB values of the default background color. Defaults to white.") 954 "*RGB values of the default background color. Defaults to white.")
458
459 (defvar ps-font-size 10
460 "*Font size, in points, for generating Postscript.")
461
462 (defvar ps-font "Courier"
463 "*Font family name for ordinary text, when generating Postscript.")
464
465 (defvar ps-font-bold "Courier-Bold"
466 "*Font family name for bold text, when generating Postscript.")
467
468 (defvar ps-font-italic "Courier-Oblique"
469 "*Font family name for italic text, when generating Postscript.")
470
471 (defvar ps-font-bold-italic "Courier-BoldOblique"
472 "*Font family name for bold italic text, when generating Postscript.")
473
474 (defvar ps-avg-char-width (if (fboundp 'float) 5.6 6)
475 "*The average width, in points, of a character, for generating Postscript.
476 This is the value that ps-print uses to determine the length,
477 x-dimension, of the text it has printed, and thus affects the point at
478 which long lines wrap around. If you change the font or
479 font size, you will probably have to adjust this value to match.")
480
481 (defvar ps-space-width (if (fboundp 'float) 5.6 6)
482 "*The width of a space character, for generating Postscript.
483 This value is used in expanding tab characters.")
484
485 (defvar ps-line-height (if (fboundp 'float) 11.29 11)
486 "*The height of a line, for generating Postscript.
487 This is the value that ps-print uses to determine the height,
488 y-dimension, of the lines of text it has printed, and thus affects the
489 point at which page-breaks are placed. If you change the font or font
490 size, you will probably have to adjust this value to match. The
491 line-height is *not* the same as the point size of the font.")
492 955
493 (defvar ps-auto-font-detect t 956 (defvar ps-auto-font-detect t
494 "*Non-nil means automatically detect bold/italic face attributes. 957 "*Non-nil means automatically detect bold/italic face attributes.
495 nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces', 958 nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces',
496 and `ps-underlined-faces'.") 959 and `ps-underlined-faces'.")
497 960
498 (defvar ps-bold-faces '() 961 (defvar ps-bold-faces
962 (unless ps-print-color-p
963 '(font-lock-function-name-face
964 font-lock-builtin-face
965 font-lock-variable-name-face
966 font-lock-keyword-face
967 font-lock-warning-face))
499 "*A list of the \(non-bold\) faces that should be printed in bold font. 968 "*A list of the \(non-bold\) faces that should be printed in bold font.
500 This applies to generating Postscript.") 969 This applies to generating Postscript.")
501 970
502 (defvar ps-italic-faces '() 971 (defvar ps-italic-faces
972 (unless ps-print-color-p
973 '(font-lock-variable-name-face
974 font-lock-string-face
975 font-lock-comment-face
976 font-lock-warning-face))
503 "*A list of the \(non-italic\) faces that should be printed in italic font. 977 "*A list of the \(non-italic\) faces that should be printed in italic font.
504 This applies to generating Postscript.") 978 This applies to generating Postscript.")
505 979
506 (defvar ps-underlined-faces '() 980 (defvar ps-underlined-faces
981 (unless ps-print-color-p
982 '(font-lock-function-name-face
983 font-lock-type-face
984 font-lock-reference-face
985 font-lock-warning-face))
507 "*A list of the \(non-underlined\) faces that should be printed underlined. 986 "*A list of the \(non-underlined\) faces that should be printed underlined.
508 This applies to generating Postscript.") 987 This applies to generating Postscript.")
509 988
510 (defvar ps-header-lines 2
511 "*Number of lines to display in page header, when generating Postscript.")
512 (make-variable-buffer-local 'ps-header-lines)
513
514 (defvar ps-left-header 989 (defvar ps-left-header
515 (list 'ps-get-buffer-name 'ps-header-dirpart) 990 (list 'ps-get-buffer-name 'ps-header-dirpart)
516 "*The items to display on the right part of the page header. 991 "*The items to display (each on a line) on the left part of the page header.
517 This applies to generating Postscript. 992 This applies to generating Postscript.
518 993
519 The value should be a list of strings and symbols, each representing an 994 The value should be a list of strings and symbols, each representing an
520 entry in the PostScript array HeaderLinesLeft. 995 entry in the PostScript array HeaderLinesLeft.
521 996
529 In either case, function or variable, the string value has PostScript 1004 In either case, function or variable, the string value has PostScript
530 string delimiters added to it.") 1005 string delimiters added to it.")
531 (make-variable-buffer-local 'ps-left-header) 1006 (make-variable-buffer-local 'ps-left-header)
532 1007
533 (defvar ps-right-header 1008 (defvar ps-right-header
534 (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss) 1009 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
535 "*The items to display on the left part of the page header. 1010 "*The items to display (each on a line) on the right part of the page header.
536 This applies to generating Postscript. 1011 This applies to generating Postscript.
537 1012
538 See the variable `ps-left-header' for a description of the format of 1013 See the variable `ps-left-header' for a description of the format of
539 this variable.") 1014 this variable.")
540 (make-variable-buffer-local 'ps-right-header) 1015 (make-variable-buffer-local 'ps-right-header)
687 the PostScript image in a file with that name. If FILENAME is a 1162 the PostScript image in a file with that name. If FILENAME is a
688 number, prompt the user for the name of the file to save in." 1163 number, prompt the user for the name of the file to save in."
689 (interactive (list (ps-print-preprint current-prefix-arg))) 1164 (interactive (list (ps-print-preprint current-prefix-arg)))
690 (ps-do-despool filename)) 1165 (ps-do-despool filename))
691 1166
1167 ;;;###autoload
1168 (defun ps-line-lengths ()
1169 "*Display the correspondance between a line length and a font size,
1170 using the current ps-print setup.
1171 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1172 (interactive)
1173 (ps-line-lengths-internal))
1174
1175 ;;;###autoload
1176 (defun ps-nb-pages-buffer (nb-lines)
1177 "*Display an approximate correspondance between a font size and the number
1178 of pages the current buffer would require to print
1179 using the current ps-print setup."
1180 (interactive (list (count-lines (point-min) (point-max))))
1181 (ps-nb-pages nb-lines))
1182
1183 ;;;###autoload
1184 (defun ps-nb-pages-region (nb-lines)
1185 "*Display an approximate correspondance between a font size and the number
1186 of pages the current region would require to print
1187 using the current ps-print setup."
1188 (interactive (list (count-lines (mark) (point))))
1189 (ps-nb-pages nb-lines))
1190
1191 ;;;###autoload
1192 (defun ps-setup ()
1193 "*Return the current setup"
1194 (format "
1195 (setq ps-print-color-p %s
1196 ps-lpr-command \"%s\"
1197 ps-lpr-switches %s
1198
1199 ps-paper-type '%s
1200 ps-landscape-mode %s
1201 ps-number-of-columns %s
1202
1203 ps-left-margin %s
1204 ps-right-margin %s
1205 ps-inter-column %s
1206 ps-bottom-margin %s
1207 ps-top-margin %s
1208 ps-header-offset %s
1209 ps-header-line-pad %s
1210 ps-print-header %s
1211 ps-print-header-frame %s
1212 ps-header-lines %s
1213 ps-show-n-of-n %s
1214 ps-spool-duplex %s
1215
1216 ps-font-family '%s
1217 ps-font-size %s
1218 ps-header-font-family '%s
1219 ps-header-font-size %s
1220 ps-header-title-font-size %s)
1221 "
1222 ps-print-color-p
1223 ps-lpr-command
1224 ps-lpr-switches
1225 ps-paper-type
1226 ps-landscape-mode
1227 ps-number-of-columns
1228 ps-left-margin
1229 ps-right-margin
1230 ps-inter-column
1231 ps-bottom-margin
1232 ps-top-margin
1233 ps-header-offset
1234 ps-header-line-pad
1235 ps-print-header
1236 ps-print-header-frame
1237 ps-header-lines
1238 ps-show-n-of-n
1239 ps-spool-duplex
1240 ps-font-family
1241 ps-font-size
1242 ps-header-font-family
1243 ps-header-font-size
1244 ps-header-title-font-size))
1245
692 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
693 ;; Utility functions and variables: 1247 ;; Utility functions and variables:
694 1248
695 (defvar ps-print-emacs-type 1249 (defvar ps-print-emacs-type
696 (cond ((string-match "XEmacs" emacs-version) 'xemacs) 1250 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
703 (if (< emacs-minor-version 12) 1257 (if (< emacs-minor-version 12)
704 (setq ps-print-color-p nil)) 1258 (setq ps-print-color-p nil))
705 (require 'faces)) ; face-font, face-underline-p, 1259 (require 'faces)) ; face-font, face-underline-p,
706 ; x-font-regexp 1260 ; x-font-regexp
707 1261
708 (defun xemacs-color-device () 1262 ;; Return t if the device (which can be changed during an emacs
1263 ;; session) can handle colors.
1264 ;; This is function is not yet implemented for GNU emacs.
1265 (defun ps-color-device ()
709 (if (and (eq ps-print-emacs-type 'xemacs) 1266 (if (and (eq ps-print-emacs-type 'xemacs)
710 (>= emacs-minor-version 12)) 1267 (>= emacs-minor-version 12))
711 (eq (device-class) 'color) 1268 (eq (device-class) 'color)
712 t)) 1269 t))
713 1270
714 (require 'time-stamp) 1271 (require 'time-stamp)
715 1272
716 (defvar ps-print-prologue "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4: 1273 (defvar ps-font nil
717 % If the ISOLatin1Encoding vector isn't known, define it. 1274 "Font family name for ordinary text, when generating Postscript.")
1275
1276 (defvar ps-font-bold nil
1277 "Font family name for bold text, when generating Postscript.")
1278
1279 (defvar ps-font-italic nil
1280 "Font family name for italic text, when generating Postscript.")
1281
1282 (defvar ps-font-bold-italic nil
1283 "Font family name for bold italic text, when generating Postscript.")
1284
1285 (defvar ps-avg-char-width nil
1286 "The average width, in points, of a character, for generating Postscript.
1287 This is the value that ps-print uses to determine the length,
1288 x-dimension, of the text it has printed, and thus affects the point at
1289 which long lines wrap around.")
1290
1291 (defvar ps-space-width nil
1292 "The width of a space character, for generating Postscript.
1293 This value is used in expanding tab characters.")
1294
1295 (defvar ps-line-height nil
1296 "The height of a line, for generating Postscript.
1297 This is the value that ps-print uses to determine the height,
1298 y-dimension, of the lines of text it has printed, and thus affects the
1299 point at which page-breaks are placed.
1300 The line-height is *not* the same as the point size of the font.")
1301
1302 (defvar ps-print-prologue-1
1303 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
718 /ISOLatin1Encoding where { pop } { 1304 /ISOLatin1Encoding where { pop } {
719 % Define the ISO Latin-1 encoding vector. 1305 % -- The ISO Latin-1 encoding vector isn't known, so define it.
720 % The first half is the same as the standard encoding, 1306 % -- The first half is the same as the standard encoding,
721 % except for minus instead of hyphen at code 055. 1307 % -- except for minus instead of hyphen at code 055.
722 /ISOLatin1Encoding 1308 /ISOLatin1Encoding
723 StandardEncoding 0 45 getinterval aload pop 1309 StandardEncoding 0 45 getinterval aload pop
724 /minus 1310 /minus
725 StandardEncoding 46 82 getinterval aload pop 1311 StandardEncoding 46 82 getinterval aload pop
726 %*** NOTE: the following are missing in the Adobe documentation, 1312 %*** NOTE: the following are missing in the Adobe documentation,
727 %*** but appear in the displayed table: 1313 %*** but appear in the displayed table:
728 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240. 1314 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
729 % ^Px 1315 % 0200 (128)
730 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef 1316 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
731 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef 1317 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
732 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent 1318 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
733 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron 1319 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
734 % ^Tx 1320 % 0240 (160)
735 /space /exclamdown /cent /sterling 1321 /space /exclamdown /cent /sterling
736 /currency /yen /brokenbar /section 1322 /currency /yen /brokenbar /section
737 /dieresis /copyright /ordfeminine /guillemotleft 1323 /dieresis /copyright /ordfeminine /guillemotleft
738 /logicalnot /hyphen /registered /macron 1324 /logicalnot /hyphen /registered /macron
739 /degree /plusminus /twosuperior /threesuperior 1325 /degree /plusminus /twosuperior /threesuperior
740 /acute /mu /paragraph /periodcentered 1326 /acute /mu /paragraph /periodcentered
741 /cedilla /onesuperior /ordmasculine /guillemotright 1327 /cedilla /onesuperior /ordmasculine /guillemotright
742 /onequarter /onehalf /threequarters /questiondown 1328 /onequarter /onehalf /threequarters /questiondown
743 % ^Xx 1329 % 0300 (192)
744 /Agrave /Aacute /Acircumflex /Atilde 1330 /Agrave /Aacute /Acircumflex /Atilde
745 /Adieresis /Aring /AE /Ccedilla 1331 /Adieresis /Aring /AE /Ccedilla
746 /Egrave /Eacute /Ecircumflex /Edieresis 1332 /Egrave /Eacute /Ecircumflex /Edieresis
747 /Igrave /Iacute /Icircumflex /Idieresis 1333 /Igrave /Iacute /Icircumflex /Idieresis
748 /Eth /Ntilde /Ograve /Oacute 1334 /Eth /Ntilde /Ograve /Oacute
749 /Ocircumflex /Otilde /Odieresis /multiply 1335 /Ocircumflex /Otilde /Odieresis /multiply
750 /Oslash /Ugrave /Uacute /Ucircumflex 1336 /Oslash /Ugrave /Uacute /Ucircumflex
751 /Udieresis /Yacute /Thorn /germandbls 1337 /Udieresis /Yacute /Thorn /germandbls
752 % ^\\x 1338 % 0340 (224)
753 /agrave /aacute /acircumflex /atilde 1339 /agrave /aacute /acircumflex /atilde
754 /adieresis /aring /ae /ccedilla 1340 /adieresis /aring /ae /ccedilla
755 /egrave /eacute /ecircumflex /edieresis 1341 /egrave /eacute /ecircumflex /edieresis
756 /igrave /iacute /icircumflex /idieresis 1342 /igrave /iacute /icircumflex /idieresis
757 /eth /ntilde /ograve /oacute 1343 /eth /ntilde /ograve /oacute
761 256 packedarray def 1347 256 packedarray def
762 } ifelse 1348 } ifelse
763 1349
764 /reencodeFontISO { %def 1350 /reencodeFontISO { %def
765 dup 1351 dup
766 length 5 add dict % Make a new font (a new dict 1352 length 5 add dict % Make a new font (a new dict the same size
767 % the same size as the old 1353 % as the old one) with room for our new symbols.
768 % one) with room for our new 1354
769 % symbols. 1355 begin % Make the new font the current dictionary.
770
771 begin % Make the new font the
772 % current dictionary.
773 1356
774 1357
775 { 1 index /FID ne 1358 { 1 index /FID ne
776 { def } { pop pop } ifelse 1359 { def } { pop pop } ifelse
777 } forall % Copy each of the symbols 1360 } forall % Copy each of the symbols from the old dictionary
778 % from the old dictionary to 1361 % to the new one except for the font ID.
779 % the new except for the font
780 % ID.
781 1362
782 /Encoding ISOLatin1Encoding def % Override the encoding with 1363 /Encoding ISOLatin1Encoding def % Override the encoding with
783 % the ISOLatin1 encoding. 1364 % the ISOLatin1 encoding.
784 1365
785 % Use the font's bounding box to determine the ascent, descent, 1366 % Use the font's bounding box to determine the ascent, descent,
786 % and overall height; don't forget that these values have to be 1367 % and overall height; don't forget that these values have to be
787 % transformed using the font's matrix. 1368 % transformed using the font's matrix.
788 FontBBox 1369
789 FontMatrix transform /Ascent exch def pop 1370 % ^ (x2 y2)
1371 % | |
1372 % | v
1373 % | +----+ - -
1374 % | | | ^
1375 % | | | | Ascent (usually > 0)
1376 % | | | |
1377 % (0 0) -> +--+----+-------->
1378 % | | |
1379 % | | v Descent (usually < 0)
1380 % (x1 y1) --> +----+ - -
1381
1382 FontBBox % -- x1 y1 x2 y2
1383 FontMatrix transform /Ascent exch def pop
790 FontMatrix transform /Descent exch def pop 1384 FontMatrix transform /Descent exch def pop
791 /FontHeight Ascent Descent sub def 1385 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
792 1386
793 % Define these in case they're not in the FontInfo (also, here 1387 % Define these in case they're not in the FontInfo
794 % they're easier to get to. 1388 % (also, here they're easier to get to.
795 /UnderlinePosition 1 def 1389 /UnderlinePosition 1 def
796 /UnderlineThickness 1 def 1390 /UnderlineThickness 1 def
797 1391
798 % Get the underline position and thickness if they're defined. 1392 % Get the underline position and thickness if they're defined.
799 currentdict /FontInfo known { 1393 currentdict /FontInfo known {
800 FontInfo 1394 FontInfo
811 /UnderlineThickness exch def 1405 /UnderlineThickness exch def
812 } if 1406 } if
813 1407
814 } if 1408 } if
815 1409
816 currentdict % Leave the new font on the 1410 currentdict % Leave the new font on the stack
817 % stack 1411 end % Stop using the font as the current dictionary.
818 1412 definefont % Put the font into the font dictionary
819 end % Stop using the font as the 1413 pop % Discard the returned font.
820 % current dictionary.
821
822 definefont % Put the font into the font
823 % dictionary
824
825 pop % Discard the returned font.
826 } bind def 1414 } bind def
827 1415
828 /Font { 1416 /DefFont { % Font definition
829 findfont exch scalefont reencodeFontISO 1417 findfont exch scalefont reencodeFontISO
830 } def 1418 } def
831 1419
832 /F { % Font select 1420 /F { % Font selection
833 findfont 1421 findfont
834 dup /Ascent get /Ascent exch def 1422 dup /Ascent get /Ascent exch def
835 dup /Descent get /Descent exch def 1423 dup /Descent get /Descent exch def
836 dup /FontHeight get /FontHeight exch def 1424 dup /FontHeight get /FontHeight exch def
837 dup /UnderlinePosition get /UnderlinePosition exch def 1425 dup /UnderlinePosition get /UnderlinePosition exch def
838 dup /UnderlineThickness get /UnderlineThickness exch def 1426 dup /UnderlineThickness get /UnderlineThickness exch def
839 setfont 1427 setfont
840 } def 1428 } def
841 1429
842 /FG /setrgbcolor load def 1430 /FG /setrgbcolor load def
845 /BG { 1433 /BG {
846 dup /bg exch def 1434 dup /bg exch def
847 { mark 4 1 roll ] /bgcolor exch def } if 1435 { mark 4 1 roll ] /bgcolor exch def } if
848 } def 1436 } def
849 1437
1438 % B width C
1439 % +-----------+
1440 % | Ascent (usually > 0)
1441 % A + +
1442 % | Descent (usually < 0)
1443 % +-----------+
1444 % E width D
1445
850 /dobackground { % width -- 1446 /dobackground { % width --
851 currentpoint 1447 currentpoint % -- width x y
852 gsave 1448 gsave
853 newpath 1449 newpath
854 moveto 1450 moveto % A (x y)
855 0 Ascent rmoveto 1451 0 Ascent rmoveto % B
856 dup 0 rlineto 1452 dup 0 rlineto % C
857 0 Descent Ascent sub rlineto 1453 0 Descent Ascent sub rlineto % D
858 neg 0 rlineto 1454 neg 0 rlineto % E
859 closepath 1455 closepath
860 bgcolor aload pop setrgbcolor 1456 bgcolor aload pop setrgbcolor
861 fill 1457 fill
862 grestore 1458 grestore
863 } def 1459 } def
876 UnderlinePosition add lineto 1472 UnderlinePosition add lineto
877 stroke 1473 stroke
878 grestore 1474 grestore
879 } def 1475 } def
880 1476
881 /eolbg { 1477 /eolbg { % dobackground until right margin
882 currentpoint pop 1478 PrintWidth % -- x-eol
883 PrintWidth LeftMargin add exch sub dobackground 1479 currentpoint pop % -- cur-x
1480 sub % -- width until eol
1481 dobackground
884 } def 1482 } def
885 1483
886 /eolul { 1484 /eolul { % idem for underline
887 currentpoint exch pop 1485 PrintWidth % -- x-eol
888 PrintWidth LeftMargin add exch dounderline 1486 currentpoint exch pop % -- x-eol cur-y
1487 dounderline
889 } def 1488 } def
890 1489
891 /SL { % Soft Linefeed 1490 /SL { % Soft Linefeed
892 bg { eolbg } if 1491 bg { eolbg } if
893 ul { eolul } if 1492 ul { eolul } if
894 currentpoint LineHeight sub LeftMargin exch moveto pop 1493 0 currentpoint exch pop LineHeight sub moveto
895 } def 1494 } def
896 1495
897 /HL /SL load def % Hard Linefeed 1496 /HL /SL load def % Hard Linefeed
898 1497
899 /sp1 { currentpoint 3 -1 roll } def 1498 /sp1 { currentpoint 3 -1 roll } def
910 ul { dounderline } if 1509 ul { dounderline } if
911 } def 1510 } def
912 1511
913 /W { 1512 /W {
914 ul { sp1 } if 1513 ul { sp1 } if
915 ( ) stringwidth % Get the width of a space 1514 ( ) stringwidth % Get the width of a space in the current font.
916 pop % Discard the Y component 1515 pop % Discard the Y component.
917 mul % Multiply the width of a 1516 mul % Multiply the width of a space
918 % space by the number of 1517 % by the number of spaces to plot
919 % spaces to plot
920 bg { dup dobackground } if 1518 bg { dup dobackground } if
921 0 rmoveto 1519 0 rmoveto
922 ul { dounderline } if 1520 ul { dounderline } if
923 } def 1521 } def
924 1522
1523 /BeginDoc {
1524 % ---- save the state of the document (useful for ghostscript!)
1525 /docState save def
1526 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
1527 /JackGhostscript where {
1528 pop 1 27.7 29.7 div scale
1529 } if
1530 LandscapeMode {
1531 % ---- translate to bottom-right corner of Portrait page
1532 LandscapePageHeight 0 translate
1533 90 rotate
1534 } if
1535 /ColumnWidth PrintWidth InterColumn add def
1536 % ---- translate to lower left corner of TEXT
1537 LeftMargin BottomMargin translate
1538 % ---- define where printing will start
1539 /f0 F % this installs Ascent
1540 /PrintStartY PrintHeight Ascent sub def
1541 /ColumnIndex 1 def
1542 } def
1543
1544 /EndDoc {
1545 % ---- on last page but not last column, spit out the page
1546 ColumnIndex 1 eq not { showpage } if
1547 % ---- restore the state of the document (useful for ghostscript!)
1548 docState restore
1549 } def
1550
925 /BeginDSCPage { 1551 /BeginDSCPage {
926 /vmstate save def 1552 % ---- when 1st column, save the state of the page
1553 ColumnIndex 1 eq { /pageState save def } if
1554 % ---- save the state of the column
1555 /columnState save def
927 } def 1556 } def
928 1557
929 /BeginPage { 1558 /BeginPage {
930 PrintHeader { 1559 PrintHeader {
931 PrintHeaderFrame { HeaderFrame } if 1560 PrintHeaderFrame { HeaderFrame } if
932 HeaderText 1561 HeaderText
933 } if 1562 } if
934 LeftMargin 1563 0 PrintStartY moveto % move to where printing will start
935 BottomMargin PrintHeight add
936 moveto % move to where printing will
937 % start.
938 } def 1564 } def
939 1565
940 /EndPage { 1566 /EndPage {
941 bg { eolbg } if 1567 bg { eolbg } if
942 ul { eolul } if 1568 ul { eolul } if
943 showpage % Spit out a page
944 } def 1569 } def
945 1570
946 /EndDSCPage { 1571 /EndDSCPage {
947 vmstate restore 1572 ColumnIndex NumberOfColumns eq {
1573 % ---- on last column, spit out the page
1574 showpage
1575 % ---- restore the state of the page
1576 pageState restore
1577 /ColumnIndex 1 def
1578 } { % else
1579 % ---- restore the state of the current column
1580 columnState restore
1581 % ---- and translate to the next column
1582 ColumnWidth 0 translate
1583 /ColumnIndex ColumnIndex 1 add def
1584 } ifelse
948 } def 1585 } def
949 1586
950 /ul false def 1587 /ul false def
951 1588
952 /UL { /ul exch def } def 1589 /UL { /ul exch def } def
953 1590
954 /h0 14 /Helvetica-Bold Font 1591 /SetHeaderLines { % nb-lines --
955 /h1 12 /Helvetica Font
956
957 /h1 F
958
959 /HeaderLineHeight FontHeight def
960 /HeaderDescent Descent def
961 /HeaderPad 2 def
962
963 /SetHeaderLines {
964 /HeaderOffset TopMargin 2 div def
965 /HeaderLines exch def 1592 /HeaderLines exch def
966 /HeaderHeight HeaderLines HeaderLineHeight mul HeaderPad 2 mul add def 1593 % ---- bottom up
967 /PrintHeight PrintHeight HeaderHeight sub def 1594 HeaderPad
1595 HeaderLines 1 sub HeaderLineHeight mul add
1596 HeaderTitleLineHeight add
1597 HeaderPad add
1598 /HeaderHeight exch def
968 } def 1599 } def
969 1600
970 /HeaderFrameStart { 1601 % |---------|
971 LeftMargin BottomMargin PrintHeight add HeaderOffset add 1602 % | tm |
1603 % |---------|
1604 % | header |
1605 % |-+-------| <-- (x y)
1606 % | ho |
1607 % |---------|
1608 % | text |
1609 % |-+-------| <-- (0 0)
1610 % | bm |
1611 % |---------|
1612
1613 /HeaderFrameStart { % -- x y
1614 0 PrintHeight HeaderOffset add
972 } def 1615 } def
973 1616
974 /HeaderFramePath { 1617 /HeaderFramePath {
975 PrintWidth 0 rlineto 1618 PrintWidth 0 rlineto
976 0 HeaderHeight rlineto 1619 0 HeaderHeight rlineto
977 PrintWidth neg 0 rlineto 1620 PrintWidth neg 0 rlineto
978 0 HeaderHeight neg rlineto 1621 0 HeaderHeight neg rlineto
979 } def 1622 } def
980 1623
981 /HeaderFrame { 1624 /HeaderFrame {
982 gsave 1625 gsave
983 0.4 setlinewidth 1626 0.4 setlinewidth
1627 % ---- fill a black rectangle (the shadow of the next one)
984 HeaderFrameStart moveto 1628 HeaderFrameStart moveto
985 1 -1 rmoveto 1629 1 -1 rmoveto
986 HeaderFramePath 1630 HeaderFramePath
987 0 setgray fill 1631 0 setgray fill
1632 % ---- do the next rectangle ...
988 HeaderFrameStart moveto 1633 HeaderFrameStart moveto
989 HeaderFramePath 1634 HeaderFramePath
990 gsave 0.9 setgray fill grestore 1635 gsave 0.9 setgray fill grestore % filled with grey
991 gsave 0 setgray stroke grestore 1636 gsave 0 setgray stroke grestore % drawn with black
992 grestore 1637 grestore
993 } def 1638 } def
994 1639
995 /HeaderStart { 1640 /HeaderStart {
996 HeaderFrameStart 1641 HeaderFrameStart
997 exch HeaderPad add exch 1642 exch HeaderPad add exch % horizontal pad
998 HeaderLineHeight HeaderLines 1 sub mul add HeaderDescent sub HeaderPad add 1643 % ---- bottom up
1644 HeaderPad add % vertical pad
1645 HeaderDescent sub
1646 HeaderLineHeight HeaderLines 1 sub mul add
999 } def 1647 } def
1000 1648
1001 /strcat { 1649 /strcat {
1002 dup length 3 -1 roll dup length dup 4 -1 roll add string dup 1650 dup length 3 -1 roll dup length dup 4 -1 roll add string dup
1003 0 5 -1 roll putinterval 1651 0 5 -1 roll putinterval
1013 } def 1661 } def
1014 1662
1015 /HeaderText { 1663 /HeaderText {
1016 HeaderStart moveto 1664 HeaderStart moveto
1017 1665
1018 HeaderLinesRight HeaderLinesLeft 1666 HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
1667
1668 % ---- hack: `PN 1 and' == `PN 2 modulo'
1669
1670 % ---- if duplex and even page number, then exchange left and right
1019 Duplex PageNumber 1 and 0 eq and { exch } if 1671 Duplex PageNumber 1 and 0 eq and { exch } if
1020 1672
1021 { 1673 { % ---- process the left lines
1022 aload pop 1674 aload pop
1023 exch F 1675 exch F
1024 gsave 1676 gsave
1025 dup xcheck { exec } if 1677 dup xcheck { exec } if
1026 show 1678 show
1028 0 HeaderLineHeight neg rmoveto 1680 0 HeaderLineHeight neg rmoveto
1029 } forall 1681 } forall
1030 1682
1031 HeaderStart moveto 1683 HeaderStart moveto
1032 1684
1033 { 1685 { % ---- process the right lines
1034 aload pop 1686 aload pop
1035 exch F 1687 exch F
1036 gsave 1688 gsave
1037 dup xcheck { exec } if 1689 dup xcheck { exec } if
1038 dup stringwidth pop 1690 dup stringwidth pop
1043 } forall 1695 } forall
1044 } def 1696 } def
1045 1697
1046 /ReportFontInfo { 1698 /ReportFontInfo {
1047 2 copy 1699 2 copy
1048 /t0 3 1 roll Font 1700 /t0 3 1 roll DefFont
1049 /t0 F 1701 /t0 F
1050 /lh FontHeight def 1702 /lh FontHeight def
1051 /sw ( ) stringwidth pop def 1703 /sw ( ) stringwidth pop def
1052 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch 1704 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
1053 stringwidth pop exch div def 1705 stringwidth pop exch div def
1054 /t1 12 /Helvetica-Oblique Font 1706 /t1 12 /Helvetica-Oblique DefFont
1055 /t1 F 1707 /t1 F
1056 72 72 moveto
1057 gsave 1708 gsave
1058 (For ) show 1709 (For ) show
1059 128 string cvs show 1710 128 string cvs show
1060 ( ) show 1711 ( ) show
1061 32 string cvs show 1712 32 string cvs show
1064 (, the space width is ) show 1715 (, the space width is ) show
1065 sw 32 string cvs show 1716 sw 32 string cvs show
1066 (,) show 1717 (,) show
1067 grestore 1718 grestore
1068 0 FontHeight neg rmoveto 1719 0 FontHeight neg rmoveto
1069 (and a crude estimate of average character width is ) show 1720 gsave
1070 aw 32 string cvs show 1721 (and a crude estimate of average character width is ) show
1071 (.) show 1722 aw 32 string cvs show
1072 showpage 1723 (.) show
1724 grestore
1725 0 FontHeight neg rmoveto
1073 } def 1726 } def
1074 1727
1075 % 10 /Courier ReportFontInfo 1728 /cm { % cm to point
1729 72 mul 2.54 div
1730 } def
1731
1732 /ReportAllFontInfo {
1733 FontDirectory
1734 { % key = font name value = font dictionary
1735 pop 10 exch ReportFontInfo
1736 } forall
1737 } def
1738
1739 % 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
1740 % 3 cm 20 cm moveto ReportAllFontInfo showpage
1741
1742 ")
1743
1744 (defvar ps-print-prologue-2
1745 "
1746 % ---- These lines must be kept together because...
1747
1748 /h0 F
1749 /HeaderTitleLineHeight FontHeight def
1750
1751 /h1 F
1752 /HeaderLineHeight FontHeight def
1753 /HeaderDescent Descent def
1754
1755 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
1756
1076 ") 1757 ")
1077 1758
1078 ;; Start Editing Here: 1759 ;; Start Editing Here:
1079 1760
1080 (defvar ps-source-buffer nil) 1761 (defvar ps-source-buffer nil)
1093 (defvar ps-current-color ps-default-color) 1774 (defvar ps-current-color ps-default-color)
1094 (defvar ps-current-bg nil) 1775 (defvar ps-current-bg nil)
1095 1776
1096 (defvar ps-razchunk 0) 1777 (defvar ps-razchunk 0)
1097 1778
1098 (defvar ps-color-format (if (eq ps-print-emacs-type 'emacs) 1779 (defvar ps-color-format
1099 1780 (if (eq ps-print-emacs-type 'emacs)
1100 ;;Emacs understands the %f format; we'll 1781
1101 ;;use it to limit color RGB values to 1782 ;;Emacs understands the %f format; we'll
1102 ;;three decimals to cut down some on the 1783 ;;use it to limit color RGB values to
1103 ;;size of the PostScript output. 1784 ;;three decimals to cut down some on the
1104 "%0.3f %0.3f %0.3f" 1785 ;;size of the PostScript output.
1105 1786 "%0.3f %0.3f %0.3f"
1106 ;; Lucid emacsen will have to make do with 1787
1107 ;; %s (princ) for floats. 1788 ;; Lucid emacsen will have to make do with
1108 "%s %s %s")) 1789 ;; %s (princ) for floats.
1790 "%s %s %s"))
1109 1791
1110 ;; These values determine how much print-height to deduct when headers 1792 ;; These values determine how much print-height to deduct when headers
1111 ;; are turned on. This is a pretty clumsy way of handling it, but 1793 ;; are turned on. This is a pretty clumsy way of handling it, but
1112 ;; it'll do for now. 1794 ;; it'll do for now.
1113 (defvar ps-header-title-line-height (if (fboundp 'float) 16.0 16));Helvetica 14 1795
1114 (defvar ps-header-line-height (if (fboundp 'float) 13.7 14));Helvetica 12 1796 (defvar ps-header-font)
1115 (defvar ps-header-pad 2) 1797 (defvar ps-header-title-font)
1116 1798
1117 ;; LetterSmall 7.68 inch 10.16 inch 1799 (defvar ps-header-line-height)
1118 ;; Tabloid 11.0 inch 17.0 inch 1800 (defvar ps-header-title-line-height)
1119 ;; Ledger 17.0 inch 11.0 inch 1801 (defvar ps-header-pad 0
1120 ;; Statement 5.5 inch 8.5 inch 1802 "Vertical and horizontal space in points (1/72 inch) between the header frame
1121 ;; Executive 7.5 inch 10.0 inch 1803 and the text it contains.")
1122 ;; A3 11.69 inch 16.5 inch 1804
1123 ;; A4Small 7.47 inch 10.85 inch 1805 ;; Define accessors to the dimensions list.
1124 ;; B4 10.125 inch 14.33 inch 1806
1125 ;; B5 7.16 inch 10.125 inch 1807 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
1126 1808 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
1127 ;; All page dimensions are in PostScript points. 1809
1128 1810 (defvar ps-landscape-page-height)
1129 (defvar ps-left-margin 72) ; 1 inch 1811
1130 (defvar ps-right-margin 72) ; 1 inch
1131 (defvar ps-bottom-margin 36) ; 1/2 inch
1132 (defvar ps-top-margin 72) ; 1 inch
1133
1134 ;; Letter 8.5 inch x 11.0 inch
1135 (defvar ps-letter-page-height 792) ; 11 inches
1136 (defvar ps-letter-page-width 612) ; 8.5 inches
1137
1138 ;; Legal 8.5 inch x 14.0 inch
1139 (defvar ps-legal-page-height 1008) ; 14.0 inches
1140 (defvar ps-legal-page-width 612) ; 8.5 inches
1141
1142 ;; A4 8.26 inch x 11.69 inch
1143 (defvar ps-a4-page-height 842) ; 11.69 inches
1144 (defvar ps-a4-page-width 595) ; 8.26 inches
1145
1146 (defvar ps-pages-alist
1147 (list (list 'ps-letter ps-letter-page-width ps-letter-page-height)
1148 (list 'ps-legal ps-legal-page-width ps-legal-page-height)
1149 (list 'ps-a4 ps-a4-page-width ps-a4-page-height)))
1150
1151 ;; Define some constants to index into the page lists.
1152 (defvar ps-page-width-i 1)
1153 (defvar ps-page-height-i 2)
1154
1155 (defvar ps-page-dimensions nil)
1156 (defvar ps-print-width nil) 1812 (defvar ps-print-width nil)
1157 (defvar ps-print-height nil) 1813 (defvar ps-print-height nil)
1158 1814
1159 (defvar ps-height-remaining) 1815 (defvar ps-height-remaining)
1160 (defvar ps-width-remaining) 1816 (defvar ps-width-remaining)
1161 1817
1162 (defvar ps-ref-bold-faces nil) 1818 (defvar ps-ref-bold-faces nil)
1163 (defvar ps-ref-italic-faces nil) 1819 (defvar ps-ref-italic-faces nil)
1164 (defvar ps-ref-underlined-faces nil) 1820 (defvar ps-ref-underlined-faces nil)
1165 1821
1822 (defvar ps-print-color-scale nil)
1823
1166 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1824 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1167 ;; Internal functions 1825 ;; Internal functions
1168 1826
1827 (defun ps-line-lengths-internal ()
1828 "Display the correspondance between a line length and a font size,
1829 using the current ps-print setup.
1830 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1831 (let ((buf (get-buffer-create "*Line-lengths*"))
1832 (ifs ps-font-size) ; initial font size
1833 (icw ps-avg-char-width) ; initial character width
1834 (print-width (progn (ps-get-page-dimensions)
1835 ps-print-width))
1836 (ps-setup (ps-setup)) ; setup for the current buffer
1837 (fs-min 5) ; minimum font size
1838 cw-min ; minimum character width
1839 nb-cpl-max ; maximum nb of characters per line
1840 (fs-max 14) ; maximum font size
1841 cw-max ; maximum character width
1842 nb-cpl-min ; minimum nb of characters per line
1843 fs ; current font size
1844 cw ; current character width
1845 nb-cpl ; current nb of characters per line
1846 )
1847 (setq cw-min (/ (* icw fs-min) ifs)
1848 nb-cpl-max (floor (/ print-width cw-min))
1849 cw-max (/ (* icw fs-max) ifs)
1850 nb-cpl-min (floor (/ print-width cw-max)))
1851 (setq nb-cpl nb-cpl-min)
1852 (set-buffer buf)
1853 (goto-char (point-max))
1854 (if (not (bolp)) (insert "\n"))
1855 (insert ps-setup)
1856 (insert "nb char per line / font size\n")
1857 (while (<= nb-cpl nb-cpl-max)
1858 (setq cw (/ print-width (float nb-cpl))
1859 fs (/ (* ifs cw) icw))
1860 (insert (format "%3s %s\n" nb-cpl fs))
1861 (setq nb-cpl (1+ nb-cpl)))
1862 (insert "\n")
1863 (display-buffer buf 'not-this-window)))
1864
1865 (defun ps-nb-pages (nb-lines)
1866 "Display an approximate correspondance between a font size and the number
1867 of pages the number of lines would require to print
1868 using the current ps-print setup."
1869 (let ((buf (get-buffer-create "*Nb-Pages*"))
1870 (ifs ps-font-size) ; initial font size
1871 (ilh ps-line-height) ; initial line height
1872 (page-height (progn (ps-get-page-dimensions)
1873 ps-print-height))
1874 (ps-setup (ps-setup)) ; setup for the current buffer
1875 (fs-min 4) ; minimum font size
1876 lh-min ; minimum line height
1877 nb-lpp-max ; maximum nb of lines per page
1878 nb-page-min ; minimum nb of pages
1879 (fs-max 14) ; maximum font size
1880 lh-max ; maximum line height
1881 nb-lpp-min ; minimum nb of lines per page
1882 nb-page-max ; maximum nb of pages
1883 fs ; current font size
1884 lh ; current line height
1885 nb-lpp ; current nb of lines per page
1886 nb-page ; current nb of pages
1887 )
1888 (setq lh-min (/ (* ilh fs-min) ifs)
1889 nb-lpp-max (floor (/ page-height lh-min))
1890 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
1891 lh-max (/ (* ilh fs-max) ifs)
1892 nb-lpp-min (floor (/ page-height lh-max))
1893 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)))
1894 (setq nb-page nb-page-min)
1895 (set-buffer buf)
1896 (goto-char (point-max))
1897 (if (not (bolp)) (insert "\n"))
1898 (insert ps-setup)
1899 (insert (format "%d lines\n" nb-lines))
1900 (insert "nb page / font size\n")
1901 (while (<= nb-page nb-page-max)
1902 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
1903 lh (/ page-height nb-lpp)
1904 fs (/ (* ifs lh) ilh))
1905 (insert (format "%s %s\n" nb-page fs))
1906 (setq nb-page (1+ nb-page)))
1907 (insert "\n")
1908 (display-buffer buf 'not-this-window)))
1909
1910 (defun ps-select-font ()
1911 "Choose the font name and size (scaling data)."
1912 (let ((assoc (assq ps-font-family ps-font-info-database))
1913 l fn fb fi bi sz lh sw aw)
1914 (if (null assoc)
1915 (error "Don't have data to scale font %s. Known fonts families are %s"
1916 ps-font-family
1917 (mapcar 'car ps-font-info-database)))
1918 (setq l (cdr assoc)
1919 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
1920 fb (prog1 (car l) (setq l (cdr l)))
1921 fi (prog1 (car l) (setq l (cdr l)))
1922 bi (prog1 (car l) (setq l (cdr l)))
1923 sz (prog1 (car l) (setq l (cdr l)))
1924 lh (prog1 (car l) (setq l (cdr l)))
1925 sw (prog1 (car l) (setq l (cdr l)))
1926 aw (prog1 (car l) (setq l (cdr l))))
1927
1928 (setq ps-font fn)
1929 (setq ps-font-bold fb)
1930 (setq ps-font-italic fi)
1931 (setq ps-font-bold-italic bi)
1932 ;; These data just need to be rescaled:
1933 (setq ps-line-height (/ (* lh ps-font-size) sz))
1934 (setq ps-space-width (/ (* sw ps-font-size) sz))
1935 (setq ps-avg-char-width (/ (* aw ps-font-size) sz))
1936 ps-font-family))
1937
1938 (defun ps-select-header-font ()
1939 "Choose the font name and size (scaling data) for the header."
1940 (let ((assoc (assq ps-header-font-family ps-font-info-database))
1941 l fn fb fi bi sz lh sw aw)
1942 (if (null assoc)
1943 (error "Don't have data to scale font %s. Known fonts families are %s"
1944 ps-font-family
1945 (mapcar 'car ps-font-info-database)))
1946 (setq l (cdr assoc)
1947 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
1948 fb (prog1 (car l) (setq l (cdr l)))
1949 fi (prog1 (car l) (setq l (cdr l)))
1950 bi (prog1 (car l) (setq l (cdr l)))
1951 sz (prog1 (car l) (setq l (cdr l)))
1952 lh (prog1 (car l) (setq l (cdr l)))
1953 sw (prog1 (car l) (setq l (cdr l)))
1954 aw (prog1 (car l) (setq l (cdr l))))
1955
1956 ;; Font name
1957 (setq ps-header-font fn)
1958 (setq ps-header-title-font fb)
1959 ;; Line height: These data just need to be rescaled:
1960 (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz))
1961 (setq ps-header-line-height (/ (* lh ps-header-font-size) sz))
1962 ps-header-font-family))
1963
1169 (defun ps-get-page-dimensions () 1964 (defun ps-get-page-dimensions ()
1170 (setq ps-page-dimensions (assq ps-paper-type ps-pages-alist)) 1965 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
1171 (let ((ps-page-width (nth ps-page-width-i ps-page-dimensions)) 1966 page-width page-height)
1172 (ps-page-height (nth ps-page-height-i ps-page-dimensions))) 1967 (cond
1173 (setq ps-print-height (- ps-page-height ps-top-margin ps-bottom-margin)) 1968 ((null page-dimensions)
1174 (setq ps-print-width (- ps-page-width ps-left-margin ps-right-margin)))) 1969 (error "`ps-paper-type' must be one of:\n%s"
1970 (mapcar 'car ps-page-dimensions-database)))
1971 ((< ps-number-of-columns 1)
1972 (error "The number of columns %d should not be negative")))
1973
1974 (ps-select-font)
1975 (ps-select-header-font)
1976
1977 (setq page-width (ps-page-dimensions-get-width page-dimensions)
1978 page-height (ps-page-dimensions-get-height page-dimensions))
1979
1980 ;; Landscape mode
1981 (if ps-landscape-mode
1982 ;; exchange width and height
1983 (setq page-width (prog1 page-height (setq page-height page-width))))
1984
1985 ;; It is used to get the lower right corner (only in landscape mode)
1986 (setq ps-landscape-page-height page-height)
1987
1988 ;; | lm | text | ic | text | ic | text | rm |
1989 ;; page-width == lm + n * pw + (n - 1) * ic + rm
1990 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
1991 (setq ps-print-width
1992 (/ (- page-width
1993 ps-left-margin ps-right-margin
1994 (* (1- ps-number-of-columns) ps-inter-column))
1995 ps-number-of-columns))
1996 (if (<= ps-print-width 0)
1997 (error "Bad horizontal layout:
1998 page-width == %s
1999 ps-left-margin == %s
2000 ps-right-margin == %s
2001 ps-inter-column == %s
2002 ps-number-of-columns == %s
2003 | lm | text | ic | text | ic | text | rm |
2004 page-width == lm + n * print-width + (n - 1) * ic + rm
2005 => print-width == %d !"
2006 page-width
2007 ps-left-margin
2008 ps-right-margin
2009 ps-inter-column
2010 ps-number-of-columns
2011 ps-print-width))
2012
2013 (setq ps-print-height
2014 (- page-height ps-bottom-margin ps-top-margin))
2015 (if (<= ps-print-height 0)
2016 (error "Bad vertical layout:
2017 ps-top-margin == %s
2018 ps-bottom-margin == %s
2019 page-height == bm + print-height + tm
2020 => print-height == %d !"
2021 ps-top-margin
2022 ps-bottom-margin
2023 ps-print-height))
2024 ;; If headers are turned on, deduct the height of the header from
2025 ;; the print height.
2026 (cond
2027 (ps-print-header
2028 (setq ps-header-pad
2029 (* ps-header-line-pad ps-header-title-line-height))
2030 (setq ps-print-height
2031 (- ps-print-height
2032 ps-header-offset
2033 ps-header-pad
2034 ps-header-title-line-height
2035 (* ps-header-line-height (- ps-header-lines 1))
2036 ps-header-pad))))
2037 (if (<= ps-print-height 0)
2038 (error "Bad vertical layout:
2039 ps-top-margin == %s
2040 ps-bottom-margin == %s
2041 ps-header-offset == %s
2042 ps-header-pad == %s
2043 header-height == %s
2044 page-height == bm + print-height + tm - ho - hh
2045 => print-height == %d !"
2046 ps-top-margin
2047 ps-bottom-margin
2048 ps-header-offset
2049 ps-header-pad
2050 (+ ps-header-pad
2051 ps-header-title-line-height
2052 (* ps-header-line-height (- ps-header-lines 1))
2053 ps-header-pad)
2054 ps-print-height))))
1175 2055
1176 (defun ps-print-preprint (&optional filename) 2056 (defun ps-print-preprint (&optional filename)
1177 (if (and filename 2057 (if (and filename
1178 (or (numberp filename) 2058 (or (numberp filename)
1179 (listp filename))) 2059 (listp filename)))
1282 2162
1283 (defun ps-output-boolean (name bool) 2163 (defun ps-output-boolean (name bool)
1284 (ps-output (format "/%s %s def\n" name (if bool "true" "false")))) 2164 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
1285 2165
1286 (defun ps-begin-file () 2166 (defun ps-begin-file ()
2167 (ps-get-page-dimensions)
1287 (setq ps-showpage-count 0) 2168 (setq ps-showpage-count 0)
1288 2169
1289 (ps-output ps-adobe-tag) 2170 (ps-output ps-adobe-tag)
1290 (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of 2171 (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of
1291 ;first buffer printed 2172 ;first buffer printed
1292 (ps-output "%%Creator: " (user-full-name) "\n") 2173 (ps-output "%%Creator: " (user-full-name) "\n")
1293 (ps-output "%%CreationDate: " 2174 (ps-output "%%CreationDate: "
1294 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n") 2175 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n")
1295 (ps-output "%% DocumentFonts: Helvetica Helvetica-Bold " 2176 (ps-output "%% DocumentFonts: "
1296 ps-font " " ps-font-bold " " ps-font-italic " " 2177 ps-font " " ps-font-bold " " ps-font-italic " "
1297 ps-font-bold-italic "\n") 2178 ps-font-bold-italic " "
2179 ps-header-font " " ps-header-title-font "\n")
1298 (ps-output "%%Pages: (atend)\n") 2180 (ps-output "%%Pages: (atend)\n")
1299 (ps-output "%%EndComments\n\n") 2181 (ps-output "%%EndComments\n\n")
1300 2182
1301 (ps-output-boolean "Duplex" ps-spool-duplex) 2183 (ps-output-boolean "LandscapeMode" ps-landscape-mode)
1302 (ps-output-boolean "PrintHeader" ps-print-header) 2184 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns))
2185
2186 (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height))
2187 (ps-output (format "/PrintWidth %s def\n" ps-print-width))
2188 (ps-output (format "/PrintHeight %s def\n" ps-print-height))
2189
2190 (ps-output (format "/LeftMargin %s def\n" ps-left-margin))
2191 (ps-output (format "/RightMargin %s def\n" ps-right-margin)) ; not used
2192 (ps-output (format "/InterColumn %s def\n" ps-inter-column))
2193
2194 (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin))
2195 (ps-output (format "/TopMargin %s def\n" ps-top-margin)) ; not used
2196 (ps-output (format "/HeaderOffset %s def\n" ps-header-offset))
2197 (ps-output (format "/HeaderPad %s def\n" ps-header-pad))
2198
2199 (ps-output-boolean "PrintHeader" ps-print-header)
1303 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame) 2200 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
1304 (ps-output-boolean "ShowNofN" ps-show-n-of-n) 2201 (ps-output-boolean "ShowNofN" ps-show-n-of-n)
1305 2202 (ps-output-boolean "Duplex" ps-spool-duplex)
1306 (ps-output (format "/LeftMargin %d def\n" ps-left-margin)) 2203
1307 (ps-output (format "/RightMargin %d def\n" ps-right-margin)) 2204 (ps-output (format "/LineHeight %s def\n" ps-line-height))
1308 (ps-output (format "/BottomMargin %d def\n" ps-bottom-margin)) 2205
1309 (ps-output (format "/TopMargin %d def\n" ps-top-margin)) 2206 (ps-output ps-print-prologue-1)
1310 2207
1311 (ps-get-page-dimensions) 2208 ;; Header fonts
1312 (ps-output (format "/PrintWidth %d def\n" ps-print-width)) 2209 (ps-output ; /h0 14 /Helvetica-Bold Font
1313 (ps-output (format "/PrintHeight %d def\n" ps-print-height)) 2210 (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font))
1314 2211 (ps-output ; /h1 12 /Helvetica Font
1315 (ps-output (format "/LineHeight %s def\n" ps-line-height)) 2212 (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font))
1316 2213
1317 (ps-output ps-print-prologue) 2214 (ps-output ps-print-prologue-2)
1318 2215
1319 (ps-output (format "/f0 %d /%s Font\n" ps-font-size ps-font)) 2216 ;; Text fonts
1320 (ps-output (format "/f1 %d /%s Font\n" ps-font-size ps-font-bold)) 2217 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font))
1321 (ps-output (format "/f2 %d /%s Font\n" ps-font-size ps-font-italic)) 2218 (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold))
1322 (ps-output (format "/f3 %d /%s Font\n" ps-font-size 2219 (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic))
1323 ps-font-bold-italic)) 2220 (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic))
1324 2221
2222 (ps-output "\nBeginDoc\n\n")
1325 (ps-output "%%EndPrologue\n")) 2223 (ps-output "%%EndPrologue\n"))
1326 2224
1327 (defun ps-header-dirpart () 2225 (defun ps-header-dirpart ()
1328 (let ((fname (buffer-file-name))) 2226 (let ((fname (buffer-file-name)))
1329 (if fname 2227 (if fname
1331 (file-name-directory fname) 2229 (file-name-directory fname)
1332 fname) 2230 fname)
1333 ""))) 2231 "")))
1334 2232
1335 (defun ps-get-buffer-name () 2233 (defun ps-get-buffer-name ()
1336 ;; Indulge me this little easter egg: 2234 (cond
1337 (if (string= (buffer-name) "ps-print.el") 2235 ;; Indulge Jim this little easter egg:
1338 "Hey, Cool! It's ps-print.el!!!" 2236 ((string= (buffer-name) "ps-print.el")
1339 (buffer-name))) 2237 "Hey, Cool! It's ps-print.el!!!")
2238 ;; Indulge Jack this other little easter egg:
2239 ((string= (buffer-name) "sokoban.el")
2240 "Super! C'est sokoban.el!")
2241 (t (buffer-name))))
1340 2242
1341 (defun ps-begin-job () 2243 (defun ps-begin-job ()
1342 (setq ps-page-count 0)) 2244 (setq ps-page-count 0))
1343 2245
1344 (defun ps-end-file () 2246 (defun ps-end-file ()
2247 (ps-output "\nEndDoc\n\n")
1345 (ps-output "%%Trailer\n") 2248 (ps-output "%%Trailer\n")
1346 (ps-output "%%Pages: " (format "%d\n" ps-showpage-count))) 2249 (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count)
2250 ps-number-of-columns)))))
1347 2251
1348 (defun ps-next-page () 2252 (defun ps-next-page ()
1349 (ps-end-page) 2253 (ps-end-page)
1350 (ps-flush-output) 2254 (ps-flush-output)
1351 (ps-begin-page)) 2255 (ps-begin-page))
1352 2256
1353 (defun ps-begin-page (&optional dummypage) 2257 (defun ps-begin-page (&optional dummypage)
1354 (ps-get-page-dimensions) 2258 (ps-get-page-dimensions)
1355 (setq ps-width-remaining ps-print-width) 2259 (setq ps-width-remaining ps-print-width)
1356 (setq ps-height-remaining ps-print-height) 2260 (setq ps-height-remaining ps-print-height)
1357 2261
1358 ;; If headers are turned on, deduct the height of the header from 2262 ;; Print only when a new real page begins.
1359 ;; the print height remaining. Clumsy clumsy clumsy. 2263 (when (zerop (mod ps-page-count ps-number-of-columns))
1360 (if ps-print-header 2264 (ps-output (format "\n%%%%Page: %d %d\n"
1361 (setq ps-height-remaining 2265 (1+ (/ ps-page-count ps-number-of-columns))
1362 (- ps-height-remaining 2266 (1+ (/ ps-page-count ps-number-of-columns)))))
1363 ps-header-title-line-height 2267
1364 (* ps-header-line-height (- ps-header-lines 1))
1365 (* 2 ps-header-pad))))
1366
1367 (setq ps-page-count (+ ps-page-count 1))
1368
1369 (ps-output "\n%%Page: "
1370 (format "%d %d\n" ps-page-count (+ 1 ps-showpage-count)))
1371 (ps-output "BeginDSCPage\n") 2268 (ps-output "BeginDSCPage\n")
1372 (ps-output (format "/PageNumber %d def\n" ps-page-count)) 2269 (ps-output (format "/PageNumber %d def\n" (incf ps-page-count)))
1373 (ps-output "/PageCount 0 def\n") 2270 (ps-output "/PageCount 0 def\n")
1374 2271
1375 (if ps-print-header 2272 (when ps-print-header
1376 (progn 2273 (ps-generate-header "HeaderLinesLeft" ps-left-header)
1377 (ps-generate-header "HeaderLinesLeft" ps-left-header) 2274 (ps-generate-header "HeaderLinesRight" ps-right-header)
1378 (ps-generate-header "HeaderLinesRight" ps-right-header) 2275 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
1379 (ps-output (format "%d SetHeaderLines\n" ps-header-lines))))
1380 2276
1381 (ps-output "BeginPage\n") 2277 (ps-output "BeginPage\n")
1382 (ps-set-font ps-current-font) 2278 (ps-set-font ps-current-font)
1383 (ps-set-bg ps-current-bg) 2279 (ps-set-bg ps-current-bg)
1384 (ps-set-color ps-current-color) 2280 (ps-set-color ps-current-color)
1385 (ps-set-underline ps-current-underline-p)) 2281 (ps-set-underline ps-current-underline-p))
1386 2282
1387 (defun ps-end-page () 2283 (defun ps-end-page ()
1388 (setq ps-showpage-count (+ 1 ps-showpage-count)) 2284 (setq ps-showpage-count (+ 1 ps-showpage-count))
1389 (ps-output "EndPage\n") 2285 (ps-output "EndPage\n")
1399 EndDSCPage\n")) 2295 EndDSCPage\n"))
1400 2296
1401 (defun ps-next-line () 2297 (defun ps-next-line ()
1402 (if (< ps-height-remaining ps-line-height) 2298 (if (< ps-height-remaining ps-line-height)
1403 (ps-next-page) 2299 (ps-next-page)
1404 (setq ps-width-remaining ps-print-width) 2300 (setq ps-width-remaining ps-print-width)
1405 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) 2301 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
1406 (ps-hard-lf))) 2302 (ps-hard-lf)))
1407 2303
1408 (defun ps-continue-line () 2304 (defun ps-continue-line ()
1409 (if (< ps-height-remaining ps-line-height) 2305 (if (< ps-height-remaining ps-line-height)
1410 (ps-next-page) 2306 (ps-next-page)
1411 (setq ps-width-remaining ps-print-width) 2307 (setq ps-width-remaining ps-print-width)
1412 (setq ps-height-remaining (- ps-height-remaining ps-line-height)) 2308 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
1413 (ps-soft-lf))) 2309 (ps-soft-lf)))
2310
2311 ;; [jack] Why hard and soft ?
1414 2312
1415 (defun ps-hard-lf () 2313 (defun ps-hard-lf ()
1416 (ps-output "HL\n")) 2314 (ps-output "HL\n"))
1417 2315
1418 (defun ps-soft-lf () 2316 (defun ps-soft-lf ()
1428 (defun ps-basic-plot-string (from to &optional bg-color) 2326 (defun ps-basic-plot-string (from to &optional bg-color)
1429 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width)) 2327 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width))
1430 (to (car wrappoint)) 2328 (to (car wrappoint))
1431 (string (buffer-substring from to))) 2329 (string (buffer-substring from to)))
1432 (ps-output-string string) 2330 (ps-output-string string)
1433 (ps-output " S\n") ; 2331 (ps-output " S\n")
1434 wrappoint)) 2332 wrappoint))
1435 2333
1436 (defun ps-basic-plot-whitespace (from to &optional bg-color) 2334 (defun ps-basic-plot-whitespace (from to &optional bg-color)
1437 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width)) 2335 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width))
1438 (to (car wrappoint))) 2336 (to (car wrappoint)))
1459 (setq ps-razchunk q-done) 2357 (setq ps-razchunk q-done)
1460 (setq foo 2358 (setq foo
1461 (if (< q-todo 100) 2359 (if (< q-todo 100)
1462 (/ (* 100 q-done) q-todo) 2360 (/ (* 100 q-done) q-todo)
1463 (/ q-done (/ q-todo 100)))) 2361 (/ q-done (/ q-todo 100))))
1464 (message "Formatting...%d%%" foo)))))) 2362 (message "Formatting...%3d%%" foo))))))
1465 2363
1466 (defun ps-set-font (font) 2364 (defun ps-set-font (font)
1467 (setq ps-current-font font) 2365 (setq ps-current-font font)
1468 (ps-output (format "/f%d F\n" ps-current-font))) 2366 (ps-output (format "/f%d F\n" ps-current-font)))
1469
1470 (defvar ps-print-color-scale nil)
1471 2367
1472 (defun ps-set-bg (color) 2368 (defun ps-set-bg (color)
1473 (if (setq ps-current-bg color) 2369 (if (setq ps-current-bg color)
1474 (ps-output (format ps-color-format (nth 0 color) (nth 1 color) 2370 (ps-output (format ps-color-format (nth 0 color) (nth 1 color)
1475 (nth 2 color)) 2371 (nth 2 color))
1546 (/ x-color-value ps-print-color-scale)) 2442 (/ x-color-value ps-print-color-scale))
1547 2443
1548 (defun ps-color-values (x-color) 2444 (defun ps-color-values (x-color)
1549 (cond ((fboundp 'x-color-values) 2445 (cond ((fboundp 'x-color-values)
1550 (x-color-values x-color)) 2446 (x-color-values x-color))
1551 ;; From fsf 19.33
1552 ;; ((fboundp 'pixel-components)
1553 ;; (pixel-components x-color))
1554 ((and (fboundp 'color-instance-rgb-components) 2447 ((and (fboundp 'color-instance-rgb-components)
1555 (xemacs-color-device)) 2448 (ps-color-device))
1556 (color-instance-rgb-components 2449 (color-instance-rgb-components
1557 (if (color-instance-p x-color) x-color 2450 (if (color-instance-p x-color) x-color
1558 (if (color-specifier-p x-color) 2451 (if (color-specifier-p x-color)
1559 (make-color-instance (color-name x-color)) 2452 (make-color-instance (color-name x-color))
1560 (make-color-instance x-color))))) 2453 (make-color-instance x-color)))))
1595 (italic-p (nth 1 face-attr)) 2488 (italic-p (nth 1 face-attr))
1596 (underline-p (nth 2 face-attr)) 2489 (underline-p (nth 2 face-attr))
1597 (foreground (nth 3 face-attr)) 2490 (foreground (nth 3 face-attr))
1598 (background (nth 4 face-attr)) 2491 (background (nth 4 face-attr))
1599 (fg-color (if (and ps-print-color-p 2492 (fg-color (if (and ps-print-color-p
1600 (xemacs-color-device) 2493 (ps-color-device)
1601 foreground) 2494 foreground)
1602 (mapcar 'ps-color-value 2495 (mapcar 'ps-color-value
1603 (ps-color-values foreground)) 2496 (ps-color-values foreground))
1604 ps-default-color)) 2497 ps-default-color))
1605 (bg-color (if (and ps-print-color-p 2498 (bg-color (if (and ps-print-color-p
1606 (xemacs-color-device) 2499 (ps-color-device)
1607 background) 2500 background)
1608 (mapcar 'ps-color-value 2501 (mapcar 'ps-color-value
1609 (ps-color-values background))))) 2502 (ps-color-values background)))))
1610 (ps-plot-region from to 2503 (ps-plot-region from to
1611 (cond ((and bold-p italic-p) 3) 2504 (cond ((and bold-p italic-p) 3)
1628 2521
1629 ;; Check the user's preferences 2522 ;; Check the user's preferences
1630 (memq face kind-list)))) 2523 (memq face kind-list))))
1631 2524
1632 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list) 2525 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
1633 ;; fsf 19.33:
1634 ;; (let* ((frame-font (or (face-font face) (face-font 'default)))
1635 ;; (kind-cons (assq kind (x-font-properties frame-font)))
1636 (let* ((frame-font 2526 (let* ((frame-font
1637 (or (face-font-instance face) (face-font-instance 'default))) 2527 (or (face-font-instance face) (face-font-instance 'default)))
1638 (kind-cons (and frame-font 2528 (kind-cons (and frame-font
1639 (assq kind (font-instance-properties frame-font)))) 2529 (assq kind (font-instance-properties frame-font))))
1640 (kind-spec (cdr-safe kind-cons)) 2530 (kind-spec (cdr-safe kind-cons))
1692 (defun ps-mapper (extent list) 2582 (defun ps-mapper (extent list)
1693 (nconc list (list (list (extent-start-position extent) 'push extent) 2583 (nconc list (list (list (extent-start-position extent) 'push extent)
1694 (list (extent-end-position extent) 'pull extent))) 2584 (list (extent-end-position extent) 'pull extent)))
1695 nil) 2585 nil)
1696 2586
1697 (defun ps-sorter (a b)
1698 (< (car a) (car b)))
1699
1700 (defun ps-extent-sorter (a b) 2587 (defun ps-extent-sorter (a b)
1701 (< (extent-priority a) (extent-priority b))) 2588 (< (extent-priority a) (extent-priority b)))
1702 2589
1703 (defun ps-print-ensure-fontified (start end) 2590 (defun ps-print-ensure-fontified (start end)
1704 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode) 2591 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode)
1705 (if (fboundp 'lazy-lock-fontify-region) 2592 (if (fboundp 'lazy-lock-fontify-region)
1706 (lazy-lock-fontify-region start end) 2593 (lazy-lock-fontify-region start end) ; the new
1707 (lazy-lock-fontify-buffer)))) 2594 (lazy-lock-fontify-buffer)))) ; the old
1708 2595
1709 (defun ps-generate-postscript-with-faces (from to) 2596 (defun ps-generate-postscript-with-faces (from to)
1710 ;; Build the reference lists of faces if necessary. 2597 ;; Build the reference lists of faces if necessary.
1711 (if (or ps-always-build-face-reference 2598 (if (or ps-always-build-face-reference
1712 ps-build-face-reference) 2599 ps-build-face-reference)
1715 (ps-build-reference-face-lists))) 2602 (ps-build-reference-face-lists)))
1716 ;; Set the color scale. We do it here instead of in the defvar so 2603 ;; Set the color scale. We do it here instead of in the defvar so
1717 ;; that ps-print can be dumped into emacs. This expression can't be 2604 ;; that ps-print can be dumped into emacs. This expression can't be
1718 ;; evaluated at dump-time because X isn't initialized. 2605 ;; evaluated at dump-time because X isn't initialized.
1719 (setq ps-print-color-scale 2606 (setq ps-print-color-scale
1720 (if (and ps-print-color-p (xemacs-color-device)) 2607 (if (and ps-print-color-p (ps-color-device))
1721 (float (car (ps-color-values "white"))) 2608 (float (car (ps-color-values "white")))
1722 1.0)) 2609 1.0))
1723 ;; Generate some PostScript. 2610 ;; Generate some PostScript.
1724 (save-restriction 2611 (save-restriction
1725 (narrow-to-region from to) 2612 (narrow-to-region from to)
1726 (let ((face 'default) 2613 (let ((face 'default)
1727 (position to)) 2614 (position to))
1728 (ps-print-ensure-fontified from to) 2615 (ps-print-ensure-fontified from to)
1729 (cond ((or (eq ps-print-emacs-type 'lucid) (eq ps-print-emacs-type 'xemacs)) 2616 (cond ((or (eq ps-print-emacs-type 'lucid)
2617 (eq ps-print-emacs-type 'xemacs))
1730 ;; Build the list of extents... 2618 ;; Build the list of extents...
1731 (let ((a (cons 'dummy nil)) 2619 (let ((a (cons 'dummy nil))
1732 record type extent extent-list) 2620 record type extent extent-list)
1733 (map-extents 'ps-mapper nil from to a) 2621 (map-extents 'ps-mapper nil from to a)
1734 (setq a (cdr a)) 2622 (setq a (sort (cdr a) 'car-less-than-car))
1735 (setq a (sort a 'ps-sorter))
1736 2623
1737 (setq extent-list nil) 2624 (setq extent-list nil)
1738 2625
1739 ;; Loop through the extents... 2626 ;; Loop through the extents...
1740 (while a 2627 (while a
1841 ;; are copied into ps-spool-buffer. 2728 ;; are copied into ps-spool-buffer.
1842 (inhibit-read-only t)) 2729 (inhibit-read-only t))
1843 (save-restriction 2730 (save-restriction
1844 (narrow-to-region from to) 2731 (narrow-to-region from to)
1845 (if ps-razzle-dazzle 2732 (if ps-razzle-dazzle
1846 (message "Formatting...%d%%" (setq ps-razchunk 0))) 2733 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
1847 (set-buffer buffer) 2734 (set-buffer buffer)
1848 (setq ps-source-buffer buffer) 2735 (setq ps-source-buffer buffer)
1849 (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name)) 2736 (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
1850 (ps-init-output-queue) 2737 (ps-init-output-queue)
1851 (let (safe-marker completed-safely needs-begin-file) 2738 (let (safe-marker completed-safely needs-begin-file)
1897 (delete-region (marker-position safe-marker) (point-max)))))) 2784 (delete-region (marker-position safe-marker) (point-max))))))
1898 2785
1899 (if ps-razzle-dazzle 2786 (if ps-razzle-dazzle
1900 (message "Formatting...done"))))) 2787 (message "Formatting...done")))))
1901 2788
1902 ;; XEmacs change
1903 (require 'message) ; Until We can get some sensible autoloads, or
1904 ; message-flatten-list gets put somewhere decent.
1905 ;; Permit dynamic evaluation at print time of ps-lpr-switches 2789 ;; Permit dynamic evaluation at print time of ps-lpr-switches
1906 (defun ps-do-despool (filename) 2790 (defun ps-do-despool (filename)
1907 (if (or (not (boundp 'ps-spool-buffer)) 2791 (if (or (not (boundp 'ps-spool-buffer))
1908 (not ps-spool-buffer)) 2792 (not (symbol-value 'ps-spool-buffer)))
1909 (message "No spooled PostScript to print") 2793 (message "No spooled PostScript to print")
1910 (ps-end-file) 2794 (ps-end-file)
1911 (ps-flush-output) 2795 (ps-flush-output)
1912 (if filename 2796 (if filename
1913 (save-excursion 2797 (save-excursion
1924 (save-excursion 2808 (save-excursion
1925 (set-buffer ps-spool-buffer) 2809 (set-buffer ps-spool-buffer)
1926 (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer)) 2810 (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer))
1927 (write-region (point-min) (point-max) dos-ps-printer t 0) 2811 (write-region (point-min) (point-max) dos-ps-printer t 0)
1928 (let ((binary-process-input t) ; for MS-DOS 2812 (let ((binary-process-input t) ; for MS-DOS
1929 (ps-lpr-sw (message-flatten-list ; XEmacs 2813 (ps-lpr-sw ; Dynamic evaluation
1930 (mapcar '(lambda (arg) ; Dynamic evaluation 2814 (ps-flatten-list (mapcar 'ps-eval-switch ps-lpr-switches))))
1931 (cond ((stringp arg) arg)
1932 ((functionp arg) (apply arg nil))
1933 ((symbolp arg) (eval arg))
1934 ((consp arg) (apply (car arg)
1935 (cdr arg)))
1936 (t nil)))
1937 ps-lpr-switches))))
1938 (apply 'call-process-region 2815 (apply 'call-process-region
1939 (point-min) (point-max) ps-lpr-command nil 2816 (point-min) (point-max) ps-lpr-command nil
1940 (if (fboundp 'start-process) 0 nil) 2817 (if (fboundp 'start-process) 0 nil)
1941 nil 2818 nil
1942 ps-lpr-sw)))) 2819 ps-lpr-sw))))
1943 (if ps-razzle-dazzle 2820 (if ps-razzle-dazzle
1944 (message "Printing...done"))) 2821 (message "Printing...done")))
1945 (kill-buffer ps-spool-buffer))) 2822 (kill-buffer ps-spool-buffer)))
2823
2824 ;; Dynamic evaluation
2825 (defun ps-eval-switch (arg)
2826 (cond ((stringp arg) arg)
2827 ((functionp arg) (apply arg nil))
2828 ((symbolp arg) (symbol-value arg))
2829 ((consp arg) (apply (car arg) (cdr arg)))
2830 (t nil)))
2831
2832 ;; `ps-flatten-list' is defined here (copied from "message.el" and
2833 ;; enhanced to handle dotted pairs as well) until we can get some
2834 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
2835
2836 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
2837 ;; => (a b c d e f g h i j)
2838
2839 (defun ps-flatten-list (&rest list)
2840 (ps-flatten-list-1 list))
2841
2842 (defun ps-flatten-list-1 (list)
2843 (cond
2844 ((null list) (list))
2845 ((consp list)
2846 (append (ps-flatten-list-1 (car list))
2847 (ps-flatten-list-1 (cdr list))))
2848 (t (list list))))
1946 2849
1947 (defun ps-kill-emacs-check () 2850 (defun ps-kill-emacs-check ()
1948 (let (ps-buffer) 2851 (let (ps-buffer)
1949 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name)) 2852 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
1950 (buffer-modified-p ps-buffer)) 2853 (buffer-modified-p ps-buffer))
2055 2958
2056 ;; See ps-gnus-print-article-from-summary. This function does the 2959 ;; See ps-gnus-print-article-from-summary. This function does the
2057 ;; same thing for vm. 2960 ;; same thing for vm.
2058 (defun ps-vm-print-message-from-summary () 2961 (defun ps-vm-print-message-from-summary ()
2059 (interactive) 2962 (interactive)
2060 (if vm-mail-buffer 2963 (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
2061 (save-excursion 2964 (save-excursion
2062 (set-buffer vm-mail-buffer) 2965 (set-buffer (symbol-value 'vm-mail-buffer))
2063 (ps-spool-buffer-with-faces)))) 2966 (ps-spool-buffer-with-faces))))
2064 2967
2065 ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind 2968 ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind
2066 ;; prsc. 2969 ;; prsc.
2067 (defun ps-gnus-summary-setup () 2970 (defun ps-gnus-summary-setup ()
2090 ;; The left headers will display the node name and file name. 2993 ;; The left headers will display the node name and file name.
2091 (list 'ps-info-node 'ps-info-file))) 2994 (list 'ps-info-node 'ps-info-file)))
2092 2995
2093 ;; WARNING! The following function is a *sample* only, and is *not* 2996 ;; WARNING! The following function is a *sample* only, and is *not*
2094 ;; meant to be used as a whole unless you understand what the effects 2997 ;; meant to be used as a whole unless you understand what the effects
2095 ;; will be! (In fact, this is a copy if my setup for ps-print -- I'd 2998 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
2096 ;; be very surprised if it was useful to *anybody*, without 2999 ;; I'd be very surprised if it was useful to *anybody*, without
2097 ;; modification.) 3000 ;; modification.)
2098 3001
2099 (defun ps-jts-ps-setup () 3002 (defun ps-jts-ps-setup ()
2100 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc 3003 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
2101 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces) 3004 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
2106 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook) 3009 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
2107 (add-hook 'Info-mode-hook 'ps-info-mode-hook) 3010 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
2108 (setq ps-spool-duplex t) 3011 (setq ps-spool-duplex t)
2109 (setq ps-print-color-p nil) 3012 (setq ps-print-color-p nil)
2110 (setq ps-lpr-command "lpr") 3013 (setq ps-lpr-command "lpr")
2111 (setq ps-lpr-switches '("-Jjct,duplex_long"))) 3014 (setq ps-lpr-switches '("-Jjct,duplex_long"))
3015 'ps-jts-ps-setup)
3016
3017 ;; WARNING! The following function is a *sample* only, and is *not*
3018 ;; meant to be used as a whole unless it corresponds to your needs.
3019 ;; (In fact, this is a copy of Jack's setup for ps-print --
3020 ;; I would not be that surprised if it was useful to *anybody*,
3021 ;; without modification.)
3022
3023 (defun ps-jack-setup ()
3024 (setq ps-print-color-p 'nil
3025 ps-lpr-command "lpr"
3026 ps-lpr-switches (list)
3027
3028 ps-paper-type 'a4
3029 ps-landscape-mode 't
3030 ps-number-of-columns 2
3031
3032 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
3033 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
3034 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
3035 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
3036 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
3037 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
3038 ps-header-line-pad .15
3039 ps-print-header t
3040 ps-print-header-frame t
3041 ps-header-lines 2
3042 ps-show-n-of-n t
3043 ps-spool-duplex nil
3044
3045 ps-font-family 'Courier
3046 ps-font-size 5.5
3047 ps-header-font-family 'Helvetica
3048 ps-header-font-size 6
3049 ps-header-title-font-size 8)
3050 'ps-jack-setup)
2112 3051
2113 (provide 'ps-print) 3052 (provide 'ps-print)
2114 3053
2115 ;;; ps-print.el ends here 3054 ;;; ps-print.el ends here