1 ;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19.
3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6 ;; Maintainer: Jacques Duthen <duthen@cegelec-red.fr>
7 ;; Keywords: print, PostScript
8 ;; Time-stamp: <97/01/09 13:52:08 duthen>
11 (defconst ps-print-version
"3.04"
12 "ps-print.el, v 3.04 <97/01/09 duthen>
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
19 Please send all bug fixes and enhancements to
20 Jacques Duthen <duthen@cegelec-red.fr>.
23 ;; This file is part of GNU Emacs.
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
27 ;; the Free Software Foundation; either version 2, or (at your option)
30 ;; GNU Emacs is distributed in the hope that it will be useful,
31 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
32 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
33 ;; GNU General Public License for more details.
35 ;; You should have received a copy of the GNU General Public License
36 ;; along with GNU Emacs; see the file COPYING. If not, write to the
37 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
38 ;; Boston, MA 02111-1307, USA.
42 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;; This package provides printing of Emacs buffers on PostScript
48 ;; printers; the buffer's bold and italic text attributes are
49 ;; preserved in the printer output. Ps-print is intended for use with
50 ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
51 ;; font-lock or hilit.
59 ;; Ps-print provides eight commands for generating PostScript images
63 ;; ps-print-buffer-with-faces
65 ;; ps-print-region-with-faces
67 ;; ps-spool-buffer-with-faces
69 ;; ps-spool-region-with-faces
71 ;; These commands all perform essentially the same function: they
72 ;; generate PostScript images suitable for printing on a PostScript
73 ;; printer or displaying with GhostScript. These commands are
74 ;; collectively referred to as "ps-print- commands".
76 ;; The word "print" or "spool" in the command name determines when the
77 ;; PostScript image is sent to the printer:
79 ;; print - The PostScript image is immediately sent to the
82 ;; spool - The PostScript image is saved temporarily in an
83 ;; Emacs buffer. Many images may be spooled locally
84 ;; before printing them. To send the spooled images
85 ;; to the printer, use the command `ps-despool'.
87 ;; The spooling mechanism was designed for printing lots of small
88 ;; files (mail messages or netnews articles) to save paper that would
89 ;; otherwise be wasted on banner pages, and to make it easier to find
90 ;; your output at the printer (it's easier to pick up one 50-page
91 ;; printout than to find 50 single-page printouts).
93 ;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't
94 ;; accidentally quit from Emacs while you have unprinted PostScript
95 ;; waiting in the spool buffer. If you do attempt to exit with
96 ;; spooled PostScript, you'll be asked if you want to print it, and if
97 ;; you decline, you'll be asked to confirm the exit; this is modeled
98 ;; on the confirmation that Emacs uses for modified buffers.
100 ;; The word "buffer" or "region" in the command name determines how
101 ;; much of the buffer is printed:
103 ;; buffer - Print the entire buffer.
105 ;; region - Print just the current region.
107 ;; The -with-faces suffix on the command name means that the command
108 ;; will include font, color, and underline information in the
109 ;; PostScript image, so the printed image can look as pretty as the
110 ;; buffer. The ps-print- commands without the -with-faces suffix
111 ;; don't include font, color, or underline information; images printed
112 ;; with these commands aren't as pretty, but are faster to generate.
114 ;; Two ps-print- command examples:
116 ;; ps-print-buffer - print the entire buffer,
117 ;; without font, color, or
118 ;; underline information, and
119 ;; send it immediately to the
122 ;; ps-spool-region-with-faces - print just the current region;
123 ;; include font, color, and
124 ;; underline information, and
125 ;; spool the image in Emacs to
126 ;; send to the printer later.
132 ;; To print your buffer, type
134 ;; M-x ps-print-buffer
136 ;; or substitute one of the other seven ps-print- commands. The
137 ;; command will generate the PostScript image and print or spool it as
138 ;; specified. By giving the command a prefix argument
140 ;; C-u M-x ps-print-buffer
142 ;; it will save the PostScript image to a file instead of sending it
143 ;; to the printer; you will be prompted for the name of the file to
144 ;; save the image to. The prefix argument is ignored by the commands
145 ;; that spool their images, but you may save the spooled images to a
146 ;; file by giving a prefix argument to `ps-despool':
148 ;; C-u M-x ps-despool
150 ;; When invoked this way, `ps-despool' will prompt you for the name of
151 ;; the file to save to.
153 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
154 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
155 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
157 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
158 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
159 ;; (global-set-key '(control f22) 'ps-despool)
162 ;; The Printer Interface
163 ;; ---------------------
165 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
166 ;; command is used to send the PostScript images to the printer, and
167 ;; what arguments to give the command. These are analogous to
168 ;; `lpr-command' and `lpr-switches'.
169 ;; Make sure that they contain appropriate values for your system;
170 ;; see the usage notes below and the documentation of these variables.
172 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
173 ;; from the variables `lpr-command' and `lpr-switches'. If you have
174 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
175 ;; then ps-print won't work properly. `ps-lpr-command' must name
176 ;; a program that does not format the files it prints.
182 ;; All dimensions are floats in PostScript points.
183 ;; 1 inch == 2.54 cm == 72 points
184 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
186 ;; The variable `ps-paper-type' determines the size of paper ps-print
187 ;; formats for; it should contain one of the symbols:
188 ;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
189 ;; `ledger' `statement' `executive' `a4small' `b4' `b5'
191 ;; The variable `ps-landscape-mode' determines the orientation
192 ;; of the printing on the page:
193 ;; nil means `portrait' mode, non-nil means `landscape' mode.
194 ;; There is no oblique mode yet, though this is easy to do in ps.
196 ;; In landscape mode, the text is NOT scaled: you may print 70 lines
197 ;; in portrait mode and only 50 lignes in landscape mode.
198 ;; The margins represent margins in the printed paper:
199 ;; the top margin is the margin between the top of the page
200 ;; and the printed header, whatever the orientation is.
202 ;; The variable `ps-number-of-columns' determines the number of columns
203 ;; both in landscape and portrait mode.
205 ;; - (the standard) one column portrait mode
206 ;; - (my favorite) two columns landscape mode (which spares trees)
208 ;; - one column landscape mode for files with very long lines.
209 ;; - multi-column portrait or landscape mode
215 ;; The horizontal layout is determined by the variables
216 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
219 ;; ------------------------------------------
221 ;; | lm | text | ic | text | ic | text | rm |
223 ;; ------------------------------------------
225 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
226 ;; Usually, lm = rm > 0 and ic = lm
227 ;; If (ic < 0), the text of adjacent columns can overlap.
233 ;; The vertical layout is determined by the variables
234 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
237 ;; |--------| |--------|
239 ;; |--------| |--------|
243 ;; |--------| or | text |
247 ;; |--------| |--------|
249 ;; |--------| |--------|
251 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
252 ;; The margins represent margins in the printed paper:
253 ;; the top margin is the margin between the top of the page
254 ;; and the printed header, whatever the orientation is.
260 ;; Ps-print can print headers at the top of each column; the default
261 ;; headers contain the following four items: on the left, the name of
262 ;; the buffer and, if the buffer is visiting a file, the file's
263 ;; directory; on the right, the page number and date of printing.
264 ;; The default headers look something like this:
267 ;; /home/jct/emacs-lisp/ps/new 94/12/31
269 ;; When printing on duplex printers, left and right are reversed so
270 ;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
272 ;; Headers are configurable:
273 ;; To turn them off completely, set `ps-print-header' to nil.
274 ;; To turn off the header's gaudy framing box,
275 ;; set `ps-print-header-frame' to nil.
277 ;; The font family and size of text in the header are determined
278 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
279 ;; `ps-header-title-font-size' (see below).
281 ;; The variable `ps-header-line-pad' determines the portion of a header
282 ;; title line height to insert between the header frame and the text
283 ;; it contains, both in the vertical and horizontal directions:
284 ;; .5 means half a line.
286 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
287 ;; to omit the total page count and just print the page number,
288 ;; set `ps-show-n-of-n' to nil.
290 ;; The amount of information in the header can be changed by changing
291 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
292 ;; the header will show only the buffer name and page number. To show
293 ;; more, set `ps-header-lines' to 3, and the header will show the time of
294 ;; printing below the date.
296 ;; To change the content of the headers, change the variables
297 ;; `ps-left-header' and `ps-right-header'.
298 ;; These variables are lists, specifying top-to-bottom the text
299 ;; to display on the left or right side of the header.
300 ;; Each element of the list should be a string or a symbol.
301 ;; Strings are inserted directly into the PostScript arrays,
302 ;; and should contain the PostScript string delimiters '(' and ')'.
304 ;; Symbols in the header format lists can either represent functions
305 ;; or variables. Functions are called, and should return a string to
306 ;; show in the header. Variables should contain strings to display in
307 ;; the header. In either case, function or variable, the PostScript
308 ;; string delimiters are added by ps-print, and should not be part of
309 ;; the returned value.
311 ;; Here's an example: say we want the left header to display the text
317 ;; where we have a function to return "Moe"
319 ;; (defun moe-func ()
322 ;; a variable specifying "Larry"
324 ;; (setq larry-var "Larry")
326 ;; and a literal for "Curly". Here's how `ps-left-header' should be
329 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
331 ;; Note that Curly has the PostScript string delimiters inside his
332 ;; quotes -- those aren't misplaced lisp delimiters!
333 ;; Without them, PostScript would attempt to call the undefined
334 ;; function Curly, which would result in a PostScript error.
335 ;; Since most printers don't report PostScript errors except by
336 ;; aborting the print job, this kind of error can be hard to track down.
337 ;; Consider yourself warned!
343 ;; If you have a duplex-capable printer (one that prints both sides of
344 ;; the paper), set `ps-spool-duplex' to t.
345 ;; Ps-print will insert blank pages to make sure each buffer starts
346 ;; on the correct side of the paper.
347 ;; Don't forget to set `ps-lpr-switches' to select duplex printing
354 ;; Ps-print now knows rather precisely some fonts:
355 ;; the variable `ps-font-info-database' contains information
356 ;; for a list of font families (currently mainly `Courier' `Helvetica'
357 ;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
358 ;; Each font family contains the font names for standard, bold, italic
359 ;; and bold-italic characters, a reference size (usually 10) and the
360 ;; corresponding line height, width of a space and average character width.
362 ;; The variable `ps-font-family' determines which font family
363 ;; is to be used for ordinary text.
364 ;; If its value does not correspond to a known font family,
365 ;; an error message is printed into the `*Messages*' buffer,
366 ;; which lists the currently available font families.
368 ;; The variable `ps-font-size' determines the size (in points)
369 ;; of the font for ordinary text, when generating Postscript.
370 ;; Its value is a float.
372 ;; Similarly, the variable `ps-header-font-family' determines
373 ;; which font family is to be used for text in the header.
374 ;; The variable `ps-header-font-size' determines the font size,
375 ;; in points, for text in the header.
376 ;; The variable `ps-header-title-font-size' determines the font size,
377 ;; in points, for the top line of text in the header.
380 ;; Adding a new font family
381 ;; ------------------------
383 ;; To use a new font family, you MUST first teach ps-print
384 ;; this font, ie add its information to `ps-font-info-database',
385 ;; otherwise ps-print cannot correctly place line and page breaks.
387 ;; For example, assuming `Helvetica' is unkown,
388 ;; you first need to do the following ONLY ONCE:
390 ;; - create a new buffer
391 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
392 ;; - open this file and find the line:
393 ;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
394 ;; - delete the leading `%' (which is the Postscript comment character)
395 ;; - replace in this line `Courier' by the new font (say `Helvetica')
397 ;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
398 ;; - send this file to the printer (or to ghostscript).
399 ;; You should read the following on the output page:
401 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
402 ;; and a crude estimate of average character width is 5.09243
404 ;; - Add these values to the `ps-font-info-database':
405 ;; (setq ps-font-info-database
407 ;; '((Helvetica ; the family name
408 ;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
409 ;; 10.0 11.56 2.78 5.09243))
410 ;; ps-font-info-database))
411 ;; - Now you can use this font family with any size:
412 ;; (setq ps-font-family 'Helvetica)
413 ;; - if you want to use this family in another emacs session, you must
414 ;; put into your `~/.emacs':
415 ;; (require 'ps-print)
416 ;; (setq ps-font-info-database (append ...)))
417 ;; if you don't want to load ps-print, you have to copy the whole value:
418 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
419 ;; or, if you can wait until the `ps-print-hook' is implemented, do:
420 ;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...)))
421 ;; This does not work yet, since there is no `ps-print-hook' yet.
423 ;; You can create new `mixed' font families like:
425 ;; "Courier-Bold" "Helvetica"
426 ;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic"
427 ;; 10.0 10.55 6.0 6.0)
428 ;; Now you can use your new font family with any size:
429 ;; (setq ps-font-family 'my-mixed-family)
431 ;; You can get information on all the fonts resident in YOUR printer
432 ;; by uncommenting the line:
433 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
435 ;; The postscript file should be sent to YOUR postscript printer.
436 ;; If you send it to ghostscript or to another postscript printer,
437 ;; you may get slightly different results.
438 ;; Anyway, as ghostscript fonts are autoload, you won't get
442 ;; How Ps-Print Deals With Faces
443 ;; -----------------------------
445 ;; The ps-print-*-with-faces commands attempt to determine which faces
446 ;; should be printed in bold or italic, but their guesses aren't
447 ;; always right. For example, you might want to map colors into faces
448 ;; so that blue faces print in bold, and red faces in italic.
450 ;; It is possible to force ps-print to consider specific faces bold or
451 ;; italic, no matter what font they are displayed in, by setting the
452 ;; variables `ps-bold-faces' and `ps-italic-faces'. These variables
453 ;; contain lists of faces that ps-print should consider bold or
454 ;; italic; to set them, put code like the following into your .emacs
457 ;; (setq ps-bold-faces '(my-blue-face))
458 ;; (setq ps-italic-faces '(my-red-face))
460 ;; Faces like bold-italic that are both bold and italic should go in
463 ;; Ps-print keeps internal lists of which fonts are bold and which are
464 ;; italic; these lists are built the first time you invoke ps-print.
465 ;; For the sake of efficiency, the lists are built only once; the same
466 ;; lists are referred in later invocations of ps-print.
468 ;; Because these lists are built only once, it's possible for them to
469 ;; get out of sync, if a face changes, or if new faces are added. To
470 ;; get the lists back in sync, you can set the variable
471 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
472 ;; next time ps-print is invoked.
475 ;; How Ps-Print Deals With Color
476 ;; -----------------------------
478 ;; Ps-print detects faces with foreground and background colors
479 ;; defined and embeds color information in the PostScript image.
480 ;; The default foreground and background colors are defined by the
481 ;; variables `ps-default-fg' and `ps-default-bg'.
482 ;; On black-and-white printers, colors are displayed in grayscale.
483 ;; To turn off color output, set `ps-print-color-p' to nil.
489 ;; Some tools are provided to help you customize your font setup.
491 ;; `ps-setup' returns (some part of) the current setup.
493 ;; To avoid wrapping too many lines, you may want to adjust the
494 ;; left and right margins and the font size. On UN*X systems, do:
495 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
496 ;; to determine the longest lines of your file.
497 ;; Then, the command `ps-line-lengths' will give you the correspondance
498 ;; between a line length (number of characters) and the maximum font
499 ;; size which doesn't wrap such a line with the current ps-print setup.
501 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
502 ;; the correspondance between a number of pages and the maximum font
503 ;; size which allow the number of lines of the current buffer or of
504 ;; its current region to fit in this number of pages.
505 ;; Note: line folding is not taken into account in this process
506 ;; and could change the results.
509 ;; New since version 1.5
510 ;; ---------------------
512 ;; Color output capability.
513 ;; Automatic detection of font attributes (bold, italic).
514 ;; Configurable headers with page numbers.
516 ;; Support for different paper sizes.
517 ;; Better conformance to PostScript Document Structure Conventions.
520 ;; New since version 2.8
521 ;; ---------------------
523 ;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
525 ;; Font familiy and float size for text and header.
528 ;; Tools for page setup.
531 ;; Known bugs and limitations of ps-print:
532 ;; --------------------------------------
534 ;; Although color printing will work in XEmacs 19.12, it doesn't work
535 ;; well; in particular, bold or italic fonts don't print in the right
538 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
540 ;; Automatic font-attribute detection doesn't work well, especially
541 ;; with hilit19 and older versions of get-create-face. Users having
542 ;; problems with auto-font detection should use the lists
543 ;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic
544 ;; detection by setting `ps-auto-font-detect' to nil.
546 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
547 ;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces'
550 ;; Still too slow; could use some hand-optimization.
552 ;; ASCII Control characters other than tab, linefeed and pagefeed are
555 ;; Default background color isn't working.
557 ;; Faces are always treated as opaque.
559 ;; Epoch and Emacs 18 not supported. At all.
561 ;; Fixed-pitch fonts work better for line folding, but are not required.
563 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
570 ;; Add `ps-print-hook' (I don't know how to do that (yet!)).
571 ;; Add 4-up capability (really needed?).
572 ;; Add line numbers (should not be too hard).
573 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
574 ;; Put one header per page over the columns (easy but needed?).
575 ;; Improve the memory management for big files (hard?).
576 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
582 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
585 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
586 ;; color and the invisible property.
588 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
589 ;; the initial port to Emacs 19. His code is no longer part of
590 ;; ps-print, but his work is still appreciated.
592 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
593 ;; for adding underline support. Their code also is no longer part of
594 ;; ps-print, but their efforts are not forgotten.
596 ;; Thanks also to all of you who mailed code to add features to
597 ;; ps-print; although I didn't use your code, I still appreciate your
598 ;; sharing it with me.
600 ;; Thanks to all who mailed comments, encouragement, and criticism.
601 ;; Thanks also to all who responded to my survey; I had too many
602 ;; responses to reply to them all, but I greatly appreciate your
606 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
613 (unless (featurep 'lisp-float-type
)
614 (error "`ps-print' requires floating point support"))
616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
619 ;;; Interface to the command system
621 (defvar ps-lpr-command lpr-command
622 "*The shell command for printing a PostScript file.")
624 (defvar ps-lpr-switches lpr-switches
625 "*A list of extra switches to pass to `ps-lpr-command'.")
629 ;; All page dimensions are in PostScript points.
630 ;; 1 inch == 2.54 cm == 72 points
631 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
633 ;; Letter 8.5 inch x 11.0 inch
634 ;; Legal 8.5 inch x 14.0 inch
635 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
637 ;; LetterSmall 7.68 inch x 10.16 inch
638 ;; Tabloid 11.0 inch x 17.0 inch
639 ;; Ledger 17.0 inch x 11.0 inch
640 ;; Statement 5.5 inch x 8.5 inch
641 ;; Executive 7.5 inch x 10.0 inch
642 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
643 ;; A4Small 7.47 inch x 10.85 inch
644 ;; B4 10.125 inch x 14.33 inch
645 ;; B5 7.16 inch x 10.125 inch
647 (defvar ps-page-dimensions-database
648 (list (list 'a4
(/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54))
649 (list 'a3
(/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54))
650 (list 'letter
(* 72 8.5) (* 72 11.0))
651 (list 'legal
(* 72 8.5) (* 72 14.0))
652 (list 'letter-small
(* 72 7.68) (* 72 10.16))
653 (list 'tabloid
(* 72 11.0) (* 72 17.0))
654 (list 'ledger
(* 72 17.0) (* 72 11.0))
655 (list 'statement
(* 72 5.5) (* 72 8.5))
656 (list 'executive
(* 72 7.5) (* 72 10.0))
657 (list 'a4small
(* 72 7.47) (* 72 10.85))
658 (list 'b4
(* 72 10.125) (* 72 14.33))
659 (list 'b5
(* 72 7.16) (* 72 10.125)))
660 "*List associating a symbolic paper type to its width and height.
661 see `ps-paper-type'.")
663 (defvar ps-paper-type
'letter
664 "*Specifies the size of paper to format for.
665 Should be one of the paper types defined in `ps-page-dimensions-database', for
666 example `letter', `legal' or `a4'.")
668 (defvar ps-landscape-mode
'nil
669 "*Non-nil means print in landscape mode.")
671 (defvar ps-number-of-columns
(if ps-landscape-mode
2 1)
672 "*Specifies the number of columns")
674 ;;; Horizontal layout
676 ;; ------------------------------------------
678 ;; | lm | text | ic | text | ic | text | rm |
680 ;; ------------------------------------------
682 (defvar ps-left-margin
(/ (* 72 2.0) 2.54) ; 2 cm
683 "*Left margin in points (1/72 inch).")
685 (defvar ps-right-margin
(/ (* 72 2.0) 2.54) ; 2 cm
686 "*Right margin in points (1/72 inch).")
688 (defvar ps-inter-column
(/ (* 72 2.0) 2.54) ; 2 cm
689 "*Horizontal space between columns in points (1/72 inch).")
705 (defvar ps-bottom-margin
(/ (* 72 1.5) 2.54) ; 1.5 cm
706 "*Bottom margin in points (1/72 inch).")
708 (defvar ps-top-margin
(/ (* 72 1.5) 2.54) ; 1.5 cm
709 "*Top margin in points (1/72 inch).")
711 (defvar ps-header-offset
(/ (* 72 1.0) 2.54) ; 1.0 cm
712 "*Vertical space in points (1/72 inch) between the main text and the header.")
714 (defvar ps-header-line-pad
0.15
715 "*Portion of a header title line height to insert between the header frame
716 and the text it contains, both in the vertical and horizontal directions.")
720 (defvar ps-print-header t
721 "*Non-nil means print a header at the top of each page.
722 By default, the header displays the buffer name, page number, and, if
723 the buffer is visiting a file, the file's directory. Headers are
724 customizable by changing variables `ps-header-left' and
727 (defvar ps-print-header-frame t
728 "*Non-nil means draw a gaudy frame around the header.")
730 (defvar ps-header-lines
2
731 "*Number of lines to display in page header, when generating Postscript.")
732 (make-variable-buffer-local 'ps-header-lines
)
734 (defvar ps-show-n-of-n t
735 "*Non-nil means show page numbers as N/M, meaning page N of M.
736 Note: page numbers are displayed as part of headers, see variable
737 `ps-print-headers'.")
739 (defvar ps-spool-duplex nil
; Not many people have duplex
740 ; printers, so default to nil.
741 "*Non-nil indicates spooling is for a two-sided printer.
742 For a duplex printer, the `ps-spool-*' commands will insert blank pages
743 as needed between print jobs so that the next buffer printed will
744 start on the right page. Also, if headers are turned on, the headers
745 will be reversed on duplex printers so that the page numbers fall to
746 the left on even-numbered pages.")
750 (defvar ps-font-info-database
751 '((Courier ; the family key
752 "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique"
754 (Helvetica ; the family key
755 "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
756 10.0 11.56 2.78 5.09243)
758 "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic"
759 10.0 11.0 2.5 4.71432)
761 "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic"
762 10.0 12.1 2.5 5.08676)
764 "Helvetica-Narrow" "Helvetica-Narrow-Bold"
765 "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique"
766 10.0 11.56 2.2796 4.17579)
768 "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold"
769 "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic"
770 10.0 12.15 2.78 5.31162)
771 ;; got no bold for the next ones
773 "AvantGarde-Book" "AvantGarde-Book"
774 "AvantGarde-BookOblique" "AvantGarde-BookOblique"
775 10.0 11.77 2.77 5.45189)
777 "AvantGarde-Demi" "AvantGarde-Demi"
778 "AvantGarde-DemiOblique" "AvantGarde-DemiOblique"
779 10.0 12.72 2.8 5.51351)
781 "Bookman-Demi" "Bookman-Demi"
782 "Bookman-DemiItalic" "Bookman-DemiItalic"
783 10.0 11.77 3.4 6.05946)
785 "Bookman-Light" "Bookman-Light"
786 "Bookman-LightItalic" "Bookman-LightItalic"
787 10.0 11.79 3.2 5.67027)
788 ;; got no bold and no italic for the next ones
790 "Symbol" "Symbol" "Symbol" "Symbol"
791 10.0 13.03 2.5 3.24324)
793 "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats"
795 (Zapf-Chancery-MediumItalic
796 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
797 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
798 10.0 11.45 2.2 4.10811)
800 "*Font info database: font family (the key), name, bold, italic, bold-italic,
801 reference size, line height, space width, average character width.
802 To get the info for another specific font (say Helvetica), do the following:
803 - create a new buffer
804 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
805 - open this file and delete the leading `%' (which is the Postscript
806 comment character) from the line
807 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
809 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
810 - add the values to `ps-font-info-database'.
811 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.")
813 (defvar ps-font-family
'Courier
814 "Font family name for ordinary text, when generating Postscript.")
816 (defvar ps-font-size
(if ps-landscape-mode
7 8.5)
817 "Font size, in points, for ordinary text, when generating Postscript.")
819 (defvar ps-header-font-family
'Helvetica
820 "Font family name for text in the header, when generating Postscript.")
822 (defvar ps-header-font-size
(if ps-landscape-mode
10 12)
823 "Font size, in points, for text in the header, when generating Postscript.")
825 (defvar ps-header-title-font-size
(if ps-landscape-mode
12 14)
826 "Font size, in points, for the top line of text in the header,
827 when generating Postscript.")
831 (defvar ps-print-color-p
(or (fboundp 'x-color-values
) ; Emacs
832 (fboundp 'pixel-components
)) ; XEmacs
833 ; Printing color requires x-color-values.
834 "*If non-nil, print the buffer's text in color.")
836 (defvar ps-default-fg
'(0.0
0.0 0.0)
837 "*RGB values of the default foreground color. Defaults to black.")
839 (defvar ps-default-bg
'(1.0
1.0 1.0)
840 "*RGB values of the default background color. Defaults to white.")
842 (defvar ps-auto-font-detect t
843 "*Non-nil means automatically detect bold/italic face attributes.
844 nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces',
845 and `ps-underlined-faces'.")
847 (defvar ps-bold-faces
848 (unless ps-print-color-p
849 '(font-lock-function-name-face
850 font-lock-builtin-face
851 font-lock-variable-name-face
852 font-lock-keyword-face
853 font-lock-warning-face
))
854 "*A list of the \(non-bold\) faces that should be printed in bold font.
855 This applies to generating Postscript.")
857 (defvar ps-italic-faces
858 (unless ps-print-color-p
859 '(font-lock-variable-name-face
860 font-lock-string-face
861 font-lock-comment-face
862 font-lock-warning-face
))
863 "*A list of the \(non-italic\) faces that should be printed in italic font.
864 This applies to generating Postscript.")
866 (defvar ps-underlined-faces
867 (unless ps-print-color-p
868 '(font-lock-function-name-face
870 font-lock-reference-face
871 font-lock-warning-face
))
872 "*A list of the \(non-underlined\) faces that should be printed underlined.
873 This applies to generating Postscript.")
875 (defvar ps-left-header
876 (list 'ps-get-buffer-name
'ps-header-dirpart
)
877 "*The items to display (each on a line) on the left part of the page header.
878 This applies to generating Postscript.
880 The value should be a list of strings and symbols, each representing an
881 entry in the PostScript array HeaderLinesLeft.
883 Strings are inserted unchanged into the array; those representing
884 PostScript string literals should be delimited with PostScript string
885 delimiters '(' and ')'.
887 For symbols with bound functions, the function is called and should
888 return a string to be inserted into the array. For symbols with bound
889 values, the value should be a string to be inserted into the array.
890 In either case, function or variable, the string value has PostScript
891 string delimiters added to it.")
892 (make-variable-buffer-local 'ps-left-header
)
894 (defvar ps-right-header
895 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy
'time-stamp-hh
:mm
:ss
)
896 "*The items to display (each on a line) on the right part of the page header.
897 This applies to generating Postscript.
899 See the variable `ps-left-header' for a description of the format of
901 (make-variable-buffer-local 'ps-right-header
)
903 (defvar ps-razzle-dazzle t
904 "*Non-nil means report progress while formatting buffer.")
906 (defvar ps-adobe-tag
"%!PS-Adobe-1.0\n"
907 "*Contains the header line identifying the output as PostScript.
908 By default, `ps-adobe-tag' contains the standard identifier. Some
909 printers require slightly different versions of this line.")
911 (defvar ps-build-face-reference t
912 "*Non-nil means build the reference face lists.
914 Ps-print sets this value to nil after it builds its internal reference
915 lists of bold and italic faces. By settings its value back to t, you
916 can force ps-print to rebuild the lists the next time you invoke one
917 of the ...-with-faces commands.
919 You should set this value back to t after you change the attributes of
920 any face, or create new faces. Most users shouldn't have to worry
921 about its setting, though.")
923 (defvar ps-always-build-face-reference nil
924 "*Non-nil means always rebuild the reference face lists.
926 If this variable is non-nil, ps-print will rebuild its internal
927 reference lists of bold and italic faces *every* time one of the
928 -with-faces commands is called. Most users shouldn't need to set this
931 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
935 (defun ps-print-buffer (&optional filename
)
936 "Generate and print a PostScript image of the buffer.
938 When called with a numeric prefix argument (C-u), prompts the user for
939 the name of a file to save the PostScript image in, instead of sending
942 More specifically, the FILENAME argument is treated as follows: if it
943 is nil, send the image to the printer. If FILENAME is a string, save
944 the PostScript image in a file with that name. If FILENAME is a
945 number, prompt the user for the name of the file to save in."
947 (interactive (list (ps-print-preprint current-prefix-arg
)))
948 (ps-generate (current-buffer) (point-min) (point-max)
949 'ps-generate-postscript
)
950 (ps-do-despool filename
))
954 (defun ps-print-buffer-with-faces (&optional filename
)
955 "Generate and print a PostScript image of the buffer.
956 Like `ps-print-buffer', but includes font, color, and underline
957 information in the generated image. This command works only if you
958 are using a window system, so it has a way to determine color values."
959 (interactive (list (ps-print-preprint current-prefix-arg
)))
960 (ps-generate (current-buffer) (point-min) (point-max)
961 'ps-generate-postscript-with-faces
)
962 (ps-do-despool filename
))
966 (defun ps-print-region (from to
&optional filename
)
967 "Generate and print a PostScript image of the region.
968 Like `ps-print-buffer', but prints just the current region."
970 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
971 (ps-generate (current-buffer) from to
972 'ps-generate-postscript
)
973 (ps-do-despool filename
))
977 (defun ps-print-region-with-faces (from to
&optional filename
)
978 "Generate and print a PostScript image of the region.
979 Like `ps-print-region', but includes font, color, and underline
980 information in the generated image. This command works only if you
981 are using a window system, so it has a way to determine color values."
983 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
984 (ps-generate (current-buffer) from to
985 'ps-generate-postscript-with-faces
)
986 (ps-do-despool filename
))
990 (defun ps-spool-buffer ()
991 "Generate and spool a PostScript image of the buffer.
992 Like `ps-print-buffer' except that the PostScript image is saved in a
993 local buffer to be sent to the printer later.
995 Use the command `ps-despool' to send the spooled images to the printer."
997 (ps-generate (current-buffer) (point-min) (point-max)
998 'ps-generate-postscript
))
1002 (defun ps-spool-buffer-with-faces ()
1003 "Generate and spool a PostScript image of the buffer.
1004 Like `ps-spool-buffer', but includes font, color, and underline
1005 information in the generated image. This command works only if you
1006 are using a window system, so it has a way to determine color values.
1008 Use the command `ps-despool' to send the spooled images to the printer."
1011 (ps-generate (current-buffer) (point-min) (point-max)
1012 'ps-generate-postscript-with-faces
))
1016 (defun ps-spool-region (from to
)
1017 "Generate a PostScript image of the region and spool locally.
1018 Like `ps-spool-buffer', but spools just the current region.
1020 Use the command `ps-despool' to send the spooled images to the printer."
1022 (ps-generate (current-buffer) from to
1023 'ps-generate-postscript
))
1027 (defun ps-spool-region-with-faces (from to
)
1028 "Generate a PostScript image of the region and spool locally.
1029 Like `ps-spool-region', but includes font, color, and underline
1030 information in the generated image. This command works only if you
1031 are using a window system, so it has a way to determine color values.
1033 Use the command `ps-despool' to send the spooled images to the printer."
1035 (ps-generate (current-buffer) from to
1036 'ps-generate-postscript-with-faces
))
1039 (defun ps-despool (&optional filename
)
1040 "Send the spooled PostScript to the printer.
1042 When called with a numeric prefix argument (C-u), prompt the user for
1043 the name of a file to save the spooled PostScript in, instead of sending
1046 More specifically, the FILENAME argument is treated as follows: if it
1047 is nil, send the image to the printer. If FILENAME is a string, save
1048 the PostScript image in a file with that name. If FILENAME is a
1049 number, prompt the user for the name of the file to save in."
1050 (interactive (list (ps-print-preprint current-prefix-arg
)))
1051 (ps-do-despool filename
))
1054 (defun ps-line-lengths ()
1055 "*Display the correspondance between a line length and a font size,
1056 using the current ps-print setup.
1057 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1059 (ps-line-lengths-internal))
1062 (defun ps-nb-pages-buffer (nb-lines)
1063 "*Display an approximate correspondance between a font size and the number
1064 of pages the current buffer would require to print
1065 using the current ps-print setup."
1066 (interactive (list (count-lines (point-min) (point-max))))
1067 (ps-nb-pages nb-lines
))
1070 (defun ps-nb-pages-region (nb-lines)
1071 "*Display an approximate correspondance between a font size and the number
1072 of pages the current region would require to print
1073 using the current ps-print setup."
1074 (interactive (list (count-lines (mark) (point))))
1075 (ps-nb-pages nb-lines
))
1079 "*Return the current setup"
1081 (setq ps-print-color-p %s
1082 ps-lpr-command \"%s\"
1086 ps-landscape-mode %s
1087 ps-number-of-columns %s
1095 ps-header-line-pad %s
1097 ps-print-header-frame %s
1104 ps-header-font-family '%s
1105 ps-header-font-size %s
1106 ps-header-title-font-size %s)
1113 ps-number-of-columns
1122 ps-print-header-frame
1128 ps-header-font-family
1130 ps-header-title-font-size
))
1132 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1133 ;; Utility functions and variables:
1135 (defvar ps-print-emacs-type
1136 (cond ((string-match "XEmacs" emacs-version
) 'xemacs
)
1137 ((string-match "Lucid" emacs-version
) 'lucid
)
1138 ((string-match "Epoch" emacs-version
) 'epoch
)
1141 (if (or (eq ps-print-emacs-type
'lucid
)
1142 (eq ps-print-emacs-type
'xemacs
))
1143 (if (< emacs-minor-version
12)
1144 (setq ps-print-color-p nil
))
1145 (require 'faces
)) ; face-font, face-underline-p,
1148 (require 'time-stamp
)
1151 "Font family name for ordinary text, when generating Postscript.")
1153 (defvar ps-font-bold nil
1154 "Font family name for bold text, when generating Postscript.")
1156 (defvar ps-font-italic nil
1157 "Font family name for italic text, when generating Postscript.")
1159 (defvar ps-font-bold-italic nil
1160 "Font family name for bold italic text, when generating Postscript.")
1162 (defvar ps-avg-char-width nil
1163 "The average width, in points, of a character, for generating Postscript.
1164 This is the value that ps-print uses to determine the length,
1165 x-dimension, of the text it has printed, and thus affects the point at
1166 which long lines wrap around.")
1168 (defvar ps-space-width nil
1169 "The width of a space character, for generating Postscript.
1170 This value is used in expanding tab characters.")
1172 (defvar ps-line-height nil
1173 "The height of a line, for generating Postscript.
1174 This is the value that ps-print uses to determine the height,
1175 y-dimension, of the lines of text it has printed, and thus affects the
1176 point at which page-breaks are placed.
1177 The line-height is *not* the same as the point size of the font.")
1179 (defvar ps-print-prologue-1
1180 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
1181 /ISOLatin1Encoding where { pop } {
1182 % -- The ISO Latin-1 encoding vector isn't known, so define it.
1183 % -- The first half is the same as the standard encoding,
1184 % -- except for minus instead of hyphen at code 055.
1186 StandardEncoding 0 45 getinterval aload pop
1188 StandardEncoding 46 82 getinterval aload pop
1189 %*** NOTE: the following are missing in the Adobe documentation,
1190 %*** but appear in the displayed table:
1191 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
1193 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
1194 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
1195 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
1196 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
1198 /space /exclamdown /cent /sterling
1199 /currency /yen /brokenbar /section
1200 /dieresis /copyright /ordfeminine /guillemotleft
1201 /logicalnot /hyphen /registered /macron
1202 /degree /plusminus /twosuperior /threesuperior
1203 /acute /mu /paragraph /periodcentered
1204 /cedilla /onesuperior /ordmasculine /guillemotright
1205 /onequarter /onehalf /threequarters /questiondown
1207 /Agrave /Aacute /Acircumflex /Atilde
1208 /Adieresis /Aring /AE /Ccedilla
1209 /Egrave /Eacute /Ecircumflex /Edieresis
1210 /Igrave /Iacute /Icircumflex /Idieresis
1211 /Eth /Ntilde /Ograve /Oacute
1212 /Ocircumflex /Otilde /Odieresis /multiply
1213 /Oslash /Ugrave /Uacute /Ucircumflex
1214 /Udieresis /Yacute /Thorn /germandbls
1216 /agrave /aacute /acircumflex /atilde
1217 /adieresis /aring /ae /ccedilla
1218 /egrave /eacute /ecircumflex /edieresis
1219 /igrave /iacute /icircumflex /idieresis
1220 /eth /ntilde /ograve /oacute
1221 /ocircumflex /otilde /odieresis /divide
1222 /oslash /ugrave /uacute /ucircumflex
1223 /udieresis /yacute /thorn /ydieresis
1227 /reencodeFontISO { %def
1229 length 5 add dict % Make a new font (a new dict the same size
1230 % as the old one) with room for our new symbols.
1232 begin % Make the new font the current dictionary.
1236 { def } { pop pop } ifelse
1237 } forall % Copy each of the symbols from the old dictionary
1238 % to the new one except for the font ID.
1240 /Encoding ISOLatin1Encoding def % Override the encoding with
1241 % the ISOLatin1 encoding.
1243 % Use the font's bounding box to determine the ascent, descent,
1244 % and overall height; don't forget that these values have to be
1245 % transformed using the font's matrix.
1252 % | | | | Ascent (usually > 0)
1254 % (0 0) -> +--+----+-------->
1256 % | | v Descent (usually < 0)
1257 % (x1 y1) --> +----+ - -
1259 FontBBox % -- x1 y1 x2 y2
1260 FontMatrix transform /Ascent exch def pop
1261 FontMatrix transform /Descent exch def pop
1262 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
1264 % Define these in case they're not in the FontInfo
1265 % (also, here they're easier to get to.
1266 /UnderlinePosition 1 def
1267 /UnderlineThickness 1 def
1269 % Get the underline position and thickness if they're defined.
1270 currentdict /FontInfo known {
1273 dup /UnderlinePosition known {
1274 dup /UnderlinePosition get
1275 0 exch FontMatrix transform exch pop
1276 /UnderlinePosition exch def
1279 dup /UnderlineThickness known {
1280 /UnderlineThickness get
1281 0 exch FontMatrix transform exch pop
1282 /UnderlineThickness exch def
1287 currentdict % Leave the new font on the stack
1288 end % Stop using the font as the current dictionary.
1289 definefont % Put the font into the font dictionary
1290 pop % Discard the returned font.
1293 /DefFont { % Font definition
1294 findfont exch scalefont reencodeFontISO
1297 /F { % Font selection
1299 dup /Ascent get /Ascent exch def
1300 dup /Descent get /Descent exch def
1301 dup /FontHeight get /FontHeight exch def
1302 dup /UnderlinePosition get /UnderlinePosition exch def
1303 dup /UnderlineThickness get /UnderlineThickness exch def
1307 /FG /setrgbcolor load def
1312 { mark 4 1 roll ] /bgcolor exch def } if
1317 % | Ascent (usually > 0)
1319 % | Descent (usually < 0)
1323 /dobackground { % width --
1324 currentpoint % -- width x y
1328 0 Ascent rmoveto % B
1330 0 Descent Ascent sub rlineto % D
1333 bgcolor aload pop setrgbcolor
1338 /dobackgroundstring { % string --
1343 /dounderline { % fromx fromy --
1346 UnderlineThickness setlinewidth
1348 UnderlinePosition add moveto
1349 UnderlinePosition add lineto
1354 /eolbg { % dobackground until right margin
1355 PrintWidth % -- x-eol
1356 currentpoint pop % -- cur-x
1357 sub % -- width until eol
1361 /eolul { % idem for underline
1362 PrintWidth % -- x-eol
1363 currentpoint exch pop % -- x-eol cur-y
1367 /SL { % Soft Linefeed
1370 0 currentpoint exch pop LineHeight sub moveto
1373 /HL /SL load def % Hard Linefeed
1375 /sp1 { currentpoint 3 -1 roll } def
1378 /dcp { currentpoint exch 40 string cvs print (, ) print = } def
1380 exch 40 string cvs print (, ) print = } def
1383 bg { dup dobackgroundstring } if
1386 ul { dounderline } if
1391 ( ) stringwidth % Get the width of a space in the current font.
1392 pop % Discard the Y component.
1393 mul % Multiply the width of a space
1394 % by the number of spaces to plot
1395 bg { dup dobackground } if
1397 ul { dounderline } if
1401 % ---- save the state of the document (useful for ghostscript!)
1403 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
1404 /JackGhostscript where {
1405 pop 1 27.7 29.7 div scale
1408 % ---- translate to bottom-right corner of Portrait page
1409 LandscapePageHeight 0 translate
1412 /ColumnWidth PrintWidth InterColumn add def
1413 % ---- translate to lower left corner of TEXT
1414 LeftMargin BottomMargin translate
1415 % ---- define where printing will start
1416 /f0 F % this installs Ascent
1417 /PrintStartY PrintHeight Ascent sub def
1422 % ---- on last page but not last column, spit out the page
1423 ColumnIndex 1 eq not { showpage } if
1424 % ---- restore the state of the document (useful for ghostscript!)
1429 % ---- when 1st column, save the state of the page
1430 ColumnIndex 1 eq { /pageState save def } if
1431 % ---- save the state of the column
1432 /columnState save def
1437 PrintHeaderFrame { HeaderFrame } if
1440 0 PrintStartY moveto % move to where printing will start
1449 ColumnIndex NumberOfColumns eq {
1450 % ---- on last column, spit out the page
1452 % ---- restore the state of the page
1456 % ---- restore the state of the current column
1458 % ---- and translate to the next column
1459 ColumnWidth 0 translate
1460 /ColumnIndex ColumnIndex 1 add def
1466 /UL { /ul exch def } def
1468 /SetHeaderLines { % nb-lines --
1469 /HeaderLines exch def
1472 HeaderLines 1 sub HeaderLineHeight mul add
1473 HeaderTitleLineHeight add
1475 /HeaderHeight exch def
1482 % |-+-------| <-- (x y)
1486 % |-+-------| <-- (0 0)
1490 /HeaderFrameStart { % -- x y
1491 0 PrintHeight HeaderOffset add
1495 PrintWidth 0 rlineto
1496 0 HeaderHeight rlineto
1497 PrintWidth neg 0 rlineto
1498 0 HeaderHeight neg rlineto
1504 % ---- fill a black rectangle (the shadow of the next one)
1505 HeaderFrameStart moveto
1509 % ---- do the next rectangle ...
1510 HeaderFrameStart moveto
1512 gsave 0.9 setgray fill grestore % filled with grey
1513 gsave 0 setgray stroke grestore % drawn with black
1519 exch HeaderPad add exch % horizontal pad
1521 HeaderPad add % vertical pad
1523 HeaderLineHeight HeaderLines 1 sub mul add
1527 dup length 3 -1 roll dup length dup 4 -1 roll add string dup
1528 0 5 -1 roll putinterval
1529 dup 4 2 roll exch putinterval
1533 PageNumber 32 string cvs
1536 PageCount 32 string cvs strcat
1543 HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
1545 % ---- hack: `PN 1 and' == `PN 2 modulo'
1547 % ---- if duplex and even page number, then exchange left and right
1548 Duplex PageNumber 1 and 0 eq and { exch } if
1550 { % ---- process the left lines
1554 dup xcheck { exec } if
1557 0 HeaderLineHeight neg rmoveto
1562 { % ---- process the right lines
1566 dup xcheck { exec } if
1568 PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto
1571 0 HeaderLineHeight neg rmoveto
1577 /t0 3 1 roll DefFont
1580 /sw ( ) stringwidth pop def
1581 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
1582 stringwidth pop exch div def
1583 /t1 12 /Helvetica-Oblique DefFont
1590 ( point, the line height is ) show
1591 lh 32 string cvs show
1592 (, the space width is ) show
1593 sw 32 string cvs show
1596 0 FontHeight neg rmoveto
1598 (and a crude estimate of average character width is ) show
1599 aw 32 string cvs show
1602 0 FontHeight neg rmoveto
1609 /ReportAllFontInfo {
1611 { % key = font name value = font dictionary
1612 pop 10 exch ReportFontInfo
1616 % 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
1617 % 3 cm 20 cm moveto ReportAllFontInfo showpage
1621 (defvar ps-print-prologue-2
1623 % ---- These lines must be kept together because...
1626 /HeaderTitleLineHeight FontHeight def
1629 /HeaderLineHeight FontHeight def
1630 /HeaderDescent Descent def
1632 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
1636 ;; Start Editing Here:
1638 (defvar ps-source-buffer nil
)
1639 (defvar ps-spool-buffer-name
"*PostScript*")
1640 (defvar ps-spool-buffer nil
)
1642 (defvar ps-output-head nil
)
1643 (defvar ps-output-tail nil
)
1645 (defvar ps-page-count
0)
1646 (defvar ps-showpage-count
0)
1648 (defvar ps-current-font
0)
1649 (defvar ps-current-underline-p nil
)
1650 (defvar ps-default-color
(if ps-print-color-p ps-default-fg
)) ; black
1651 (defvar ps-current-color ps-default-color
)
1652 (defvar ps-current-bg nil
)
1654 (defvar ps-razchunk
0)
1656 (defvar ps-color-format
1657 (if (eq ps-print-emacs-type
'emacs
)
1659 ;;Emacs understands the %f format; we'll
1660 ;;use it to limit color RGB values to
1661 ;;three decimals to cut down some on the
1662 ;;size of the PostScript output.
1665 ;; Lucid emacsen will have to make do with
1666 ;; %s (princ) for floats.
1669 ;; These values determine how much print-height to deduct when headers
1670 ;; are turned on. This is a pretty clumsy way of handling it, but
1671 ;; it'll do for now.
1673 (defvar ps-header-font
)
1674 (defvar ps-header-title-font
)
1676 (defvar ps-header-line-height
)
1677 (defvar ps-header-title-line-height
)
1678 (defvar ps-header-pad
0
1679 "Vertical and horizontal space in points (1/72 inch) between the header frame
1680 and the text it contains.")
1682 ;; Define accessors to the dimensions list.
1684 (defmacro ps-page-dimensions-get-width
(dims) `(nth 0 ,dims
))
1685 (defmacro ps-page-dimensions-get-height
(dims) `(nth 1 ,dims
))
1687 (defvar ps-landscape-page-height
)
1689 (defvar ps-print-width nil
)
1690 (defvar ps-print-height nil
)
1692 (defvar ps-height-remaining
)
1693 (defvar ps-width-remaining
)
1695 (defvar ps-ref-bold-faces nil
)
1696 (defvar ps-ref-italic-faces nil
)
1697 (defvar ps-ref-underlined-faces nil
)
1699 (defvar ps-print-color-scale nil
)
1701 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1702 ;; Internal functions
1704 (defun ps-line-lengths-internal ()
1705 "Display the correspondance between a line length and a font size,
1706 using the current ps-print setup.
1707 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1708 (let ((buf (get-buffer-create "*Line-lengths*"))
1709 (ifs ps-font-size
) ; initial font size
1710 (icw ps-avg-char-width
) ; initial character width
1711 (print-width (progn (ps-get-page-dimensions)
1713 (ps-setup (ps-setup)) ; setup for the current buffer
1714 (fs-min 5) ; minimum font size
1715 cw-min
; minimum character width
1716 nb-cpl-max
; maximum nb of characters per line
1717 (fs-max 14) ; maximum font size
1718 cw-max
; maximum character width
1719 nb-cpl-min
; minimum nb of characters per line
1720 fs
; current font size
1721 cw
; current character width
1722 nb-cpl
; current nb of characters per line
1724 (setq cw-min
(/ (* icw fs-min
) ifs
)
1725 nb-cpl-max
(floor (/ print-width cw-min
))
1726 cw-max
(/ (* icw fs-max
) ifs
)
1727 nb-cpl-min
(floor (/ print-width cw-max
)))
1728 (setq nb-cpl nb-cpl-min
)
1730 (goto-char (point-max))
1731 (if (not (bolp)) (insert "\n"))
1733 (insert "nb char per line / font size\n")
1734 (while (<= nb-cpl nb-cpl-max
)
1735 (setq cw
(/ print-width
(float nb-cpl
))
1736 fs
(/ (* ifs cw
) icw
))
1737 (insert (format "%3s %s\n" nb-cpl fs
))
1738 (setq nb-cpl
(1+ nb-cpl
)))
1740 (display-buffer buf
'not-this-window
)))
1742 (defun ps-nb-pages (nb-lines)
1743 "Display an approximate correspondance between a font size and the number
1744 of pages the number of lines would require to print
1745 using the current ps-print setup."
1746 (let ((buf (get-buffer-create "*Nb-Pages*"))
1747 (ifs ps-font-size
) ; initial font size
1748 (ilh ps-line-height
) ; initial line height
1749 (page-height (progn (ps-get-page-dimensions)
1751 (ps-setup (ps-setup)) ; setup for the current buffer
1752 (fs-min 4) ; minimum font size
1753 lh-min
; minimum line height
1754 nb-lpp-max
; maximum nb of lines per page
1755 nb-page-min
; minimum nb of pages
1756 (fs-max 14) ; maximum font size
1757 lh-max
; maximum line height
1758 nb-lpp-min
; minimum nb of lines per page
1759 nb-page-max
; maximum nb of pages
1760 fs
; current font size
1761 lh
; current line height
1762 nb-lpp
; current nb of lines per page
1763 nb-page
; current nb of pages
1765 (setq lh-min
(/ (* ilh fs-min
) ifs
)
1766 nb-lpp-max
(floor (/ page-height lh-min
))
1767 nb-page-min
(ceiling (/ (float nb-lines
) nb-lpp-max
))
1768 lh-max
(/ (* ilh fs-max
) ifs
)
1769 nb-lpp-min
(floor (/ page-height lh-max
))
1770 nb-page-max
(ceiling (/ (float nb-lines
) nb-lpp-min
)))
1771 (setq nb-page nb-page-min
)
1773 (goto-char (point-max))
1774 (if (not (bolp)) (insert "\n"))
1776 (insert (format "%d lines\n" nb-lines
))
1777 (insert "nb page / font size\n")
1778 (while (<= nb-page nb-page-max
)
1779 (setq nb-lpp
(ceiling (/ nb-lines
(float nb-page
)))
1780 lh
(/ page-height nb-lpp
)
1781 fs
(/ (* ifs lh
) ilh
))
1782 (insert (format "%s %s\n" nb-page fs
))
1783 (setq nb-page
(1+ nb-page
)))
1785 (display-buffer buf
'not-this-window
)))
1787 (defun ps-select-font ()
1788 "Choose the font name and size (scaling data)."
1789 (let ((assoc (assq ps-font-family ps-font-info-database
))
1790 l fn fb fi bi sz lh sw aw
)
1792 (error "Don't have data to scale font %s. Known fonts families are %s"
1794 (mapcar 'car ps-font-info-database
)))
1796 fn
(prog1 (car l
) (setq l
(cdr l
))) ; need `pop'
1797 fb
(prog1 (car l
) (setq l
(cdr l
)))
1798 fi
(prog1 (car l
) (setq l
(cdr l
)))
1799 bi
(prog1 (car l
) (setq l
(cdr l
)))
1800 sz
(prog1 (car l
) (setq l
(cdr l
)))
1801 lh
(prog1 (car l
) (setq l
(cdr l
)))
1802 sw
(prog1 (car l
) (setq l
(cdr l
)))
1803 aw
(prog1 (car l
) (setq l
(cdr l
))))
1806 (setq ps-font-bold fb
)
1807 (setq ps-font-italic fi
)
1808 (setq ps-font-bold-italic bi
)
1809 ;; These data just need to be rescaled:
1810 (setq ps-line-height
(/ (* lh ps-font-size
) sz
))
1811 (setq ps-space-width
(/ (* sw ps-font-size
) sz
))
1812 (setq ps-avg-char-width
(/ (* aw ps-font-size
) sz
))
1815 (defun ps-select-header-font ()
1816 "Choose the font name and size (scaling data) for the header."
1817 (let ((assoc (assq ps-header-font-family ps-font-info-database
))
1818 l fn fb fi bi sz lh sw aw
)
1820 (error "Don't have data to scale font %s. Known fonts families are %s"
1822 (mapcar 'car ps-font-info-database
)))
1824 fn
(prog1 (car l
) (setq l
(cdr l
))) ; need `pop'
1825 fb
(prog1 (car l
) (setq l
(cdr l
)))
1826 fi
(prog1 (car l
) (setq l
(cdr l
)))
1827 bi
(prog1 (car l
) (setq l
(cdr l
)))
1828 sz
(prog1 (car l
) (setq l
(cdr l
)))
1829 lh
(prog1 (car l
) (setq l
(cdr l
)))
1830 sw
(prog1 (car l
) (setq l
(cdr l
)))
1831 aw
(prog1 (car l
) (setq l
(cdr l
))))
1834 (setq ps-header-font fn
)
1835 (setq ps-header-title-font fb
)
1836 ;; Line height: These data just need to be rescaled:
1837 (setq ps-header-title-line-height
(/ (* lh ps-header-title-font-size
) sz
))
1838 (setq ps-header-line-height
(/ (* lh ps-header-font-size
) sz
))
1839 ps-header-font-family
))
1841 (defun ps-get-page-dimensions ()
1842 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database
)))
1843 page-width page-height
)
1845 ((null page-dimensions
)
1846 (error "`ps-paper-type' must be one of:\n%s"
1847 (mapcar 'car ps-page-dimensions-database
)))
1848 ((< ps-number-of-columns
1)
1849 (error "The number of columns %d should not be negative")))
1852 (ps-select-header-font)
1854 (setq page-width
(ps-page-dimensions-get-width page-dimensions
)
1855 page-height
(ps-page-dimensions-get-height page-dimensions
))
1858 (if ps-landscape-mode
1859 ;; exchange width and height
1860 (setq page-width
(prog1 page-height
(setq page-height page-width
))))
1862 ;; It is used to get the lower right corner (only in landscape mode)
1863 (setq ps-landscape-page-height page-height
)
1865 ;; | lm | text | ic | text | ic | text | rm |
1866 ;; page-width == lm + n * pw + (n - 1) * ic + rm
1867 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
1868 (setq ps-print-width
1870 ps-left-margin ps-right-margin
1871 (* (1- ps-number-of-columns
) ps-inter-column
))
1872 ps-number-of-columns
))
1873 (if (<= ps-print-width
0)
1874 (error "Bad horizontal layout:
1876 ps-left-margin == %s
1877 ps-right-margin == %s
1878 ps-inter-column == %s
1879 ps-number-of-columns == %s
1880 | lm | text | ic | text | ic | text | rm |
1881 page-width == lm + n * print-width + (n - 1) * ic + rm
1882 => print-width == %d !"
1887 ps-number-of-columns
1890 (setq ps-print-height
1891 (- page-height ps-bottom-margin ps-top-margin
))
1892 (if (<= ps-print-height
0)
1893 (error "Bad vertical layout:
1895 ps-bottom-margin == %s
1896 page-height == bm + print-height + tm
1897 => print-height == %d !"
1901 ;; If headers are turned on, deduct the height of the header from
1902 ;; the print height.
1906 (* ps-header-line-pad ps-header-title-line-height
))
1907 (setq ps-print-height
1911 ps-header-title-line-height
1912 (* ps-header-line-height
(- ps-header-lines
1))
1914 (if (<= ps-print-height
0)
1915 (error "Bad vertical layout:
1917 ps-bottom-margin == %s
1918 ps-header-offset == %s
1921 page-height == bm + print-height + tm - ho - hh
1922 => print-height == %d !"
1928 ps-header-title-line-height
1929 (* ps-header-line-height
(- ps-header-lines
1))
1933 (defun ps-print-preprint (&optional filename
)
1935 (or (numberp filename
)
1937 (let* ((name (concat (buffer-name) ".ps"))
1938 (prompt (format "Save PostScript to file: (default %s) "
1940 (res (read-file-name prompt default-directory name nil
)))
1941 (if (file-directory-p res
)
1942 (expand-file-name name
(file-name-as-directory res
))
1945 ;; The following functions implement a simple list-buffering scheme so
1946 ;; that ps-print doesn't have to repeatedly switch between buffers
1947 ;; while spooling. The functions ps-output and ps-output-string build
1948 ;; up the lists; the function ps-flush-output takes the lists and
1949 ;; insert its contents into the spool buffer (*PostScript*).
1951 (defun ps-output-string-prim (string)
1952 (insert "(") ;insert start-string delimiter
1953 (save-excursion ;insert string
1956 ;; Find and quote special characters as necessary for PS
1957 (while (re-search-forward "[()\\]" nil t
)
1962 (goto-char (point-max))
1963 (insert ")")) ;insert end-string delimiter
1965 (defun ps-init-output-queue ()
1966 (setq ps-output-head
(list ""))
1967 (setq ps-output-tail ps-output-head
))
1969 (defun ps-output (&rest args
)
1970 (setcdr ps-output-tail args
)
1971 (while (cdr ps-output-tail
)
1972 (setq ps-output-tail
(cdr ps-output-tail
))))
1974 (defun ps-output-string (string)
1975 (ps-output t string
))
1977 (defun ps-flush-output ()
1979 (set-buffer ps-spool-buffer
)
1980 (goto-char (point-max))
1981 (while ps-output-head
1982 (let ((it (car ps-output-head
)))
1985 (setq ps-output-head
(cdr ps-output-head
))
1986 (ps-output-string-prim (car ps-output-head
))))
1987 (setq ps-output-head
(cdr ps-output-head
))))
1988 (ps-init-output-queue))
1990 (defun ps-insert-file (fname)
1993 ;; Check to see that the file exists and is readable; if not, throw
1995 (if (not (file-readable-p fname
))
1996 (error "Could not read file `%s'" fname
))
1999 (set-buffer ps-spool-buffer
)
2000 (goto-char (point-max))
2001 (insert-file fname
)))
2003 ;; These functions insert the arrays that define the contents of the
2006 (defun ps-generate-header-line (fonttag &optional content
)
2007 (ps-output " [ " fonttag
" ")
2009 ;; Literal strings should be output as is -- the string must
2010 ;; contain its own PS string delimiters, '(' and ')', if necessary.
2012 (ps-output content
))
2014 ;; Functions are called -- they should return strings; they will be
2015 ;; inserted as strings and the PS string delimiters added.
2016 ((and (symbolp content
) (fboundp content
))
2017 (ps-output-string (funcall content
)))
2019 ;; Variables will have their contents inserted. They should
2020 ;; contain strings, and will be inserted as strings.
2021 ((and (symbolp content
) (boundp content
))
2022 (ps-output-string (symbol-value content
)))
2024 ;; Anything else will get turned into an empty string.
2026 (ps-output-string "")))
2029 (defun ps-generate-header (name contents
)
2030 (ps-output "/" name
" [\n")
2031 (if (> ps-header-lines
0)
2033 (ps-generate-header-line "/h0" (car contents
))
2034 (while (and (< count ps-header-lines
)
2035 (setq contents
(cdr contents
)))
2036 (ps-generate-header-line "/h1" (car contents
))
2037 (setq count
(+ count
1)))
2038 (ps-output "] def\n"))))
2040 (defun ps-output-boolean (name bool
)
2041 (ps-output (format "/%s %s def\n" name
(if bool
"true" "false"))))
2043 (defun ps-begin-file ()
2044 (ps-get-page-dimensions)
2045 (setq ps-showpage-count
0)
2047 (ps-output ps-adobe-tag
)
2048 (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of
2049 ;first buffer printed
2050 (ps-output "%%Creator: " (user-full-name) "\n")
2051 (ps-output "%%CreationDate: "
2052 (time-stamp-hh:mm
:ss
) " " (time-stamp-mon-dd-yyyy) "\n")
2053 (ps-output "%% DocumentFonts: "
2054 ps-font
" " ps-font-bold
" " ps-font-italic
" "
2055 ps-font-bold-italic
" "
2056 ps-header-font
" " ps-header-title-font
"\n")
2057 (ps-output "%%Pages: (atend)\n")
2058 (ps-output "%%EndComments\n\n")
2060 (ps-output-boolean "LandscapeMode" ps-landscape-mode
)
2061 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns
))
2063 (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height
))
2064 (ps-output (format "/PrintWidth %s def\n" ps-print-width
))
2065 (ps-output (format "/PrintHeight %s def\n" ps-print-height
))
2067 (ps-output (format "/LeftMargin %s def\n" ps-left-margin
))
2068 (ps-output (format "/RightMargin %s def\n" ps-right-margin
)) ; not used
2069 (ps-output (format "/InterColumn %s def\n" ps-inter-column
))
2071 (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin
))
2072 (ps-output (format "/TopMargin %s def\n" ps-top-margin
)) ; not used
2073 (ps-output (format "/HeaderOffset %s def\n" ps-header-offset
))
2074 (ps-output (format "/HeaderPad %s def\n" ps-header-pad
))
2076 (ps-output-boolean "PrintHeader" ps-print-header
)
2077 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame
)
2078 (ps-output-boolean "ShowNofN" ps-show-n-of-n
)
2079 (ps-output-boolean "Duplex" ps-spool-duplex
)
2081 (ps-output (format "/LineHeight %s def\n" ps-line-height
))
2083 (ps-output ps-print-prologue-1
)
2086 (ps-output ; /h0 14 /Helvetica-Bold Font
2087 (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font
))
2088 (ps-output ; /h1 12 /Helvetica Font
2089 (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font
))
2091 (ps-output ps-print-prologue-2
)
2094 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font
))
2095 (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold
))
2096 (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic
))
2097 (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic
))
2099 (ps-output "\nBeginDoc\n\n")
2100 (ps-output "%%EndPrologue\n"))
2102 (defun ps-header-dirpart ()
2103 (let ((fname (buffer-file-name)))
2105 (if (string-equal (buffer-name) (file-name-nondirectory fname
))
2106 (file-name-directory fname
)
2110 (defun ps-get-buffer-name ()
2112 ;; Indulge Jim this little easter egg:
2113 ((string= (buffer-name) "ps-print.el")
2114 "Hey, Cool! It's ps-print.el!!!")
2115 ;; Indulge Jack this other little easter egg:
2116 ((string= (buffer-name) "sokoban.el")
2117 "Super! C'est sokoban.el!")
2120 (defun ps-begin-job ()
2121 (setq ps-page-count
0))
2123 (defun ps-end-file ()
2124 (ps-output "\nEndDoc\n\n")
2125 (ps-output "%%Trailer\n")
2126 (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count
)
2127 ps-number-of-columns
)))))
2129 (defun ps-next-page ()
2134 (defun ps-begin-page (&optional dummypage
)
2135 (ps-get-page-dimensions)
2136 (setq ps-width-remaining ps-print-width
)
2137 (setq ps-height-remaining ps-print-height
)
2139 ;; Print only when a new real page begins.
2140 (when (zerop (mod ps-page-count ps-number-of-columns
))
2141 (ps-output (format "\n%%%%Page: %d %d\n"
2142 (1+ (/ ps-page-count ps-number-of-columns
))
2143 (1+ (/ ps-page-count ps-number-of-columns
)))))
2145 (ps-output "BeginDSCPage\n")
2146 (ps-output (format "/PageNumber %d def\n" (incf ps-page-count
)))
2147 (ps-output "/PageCount 0 def\n")
2149 (when ps-print-header
2150 (ps-generate-header "HeaderLinesLeft" ps-left-header
)
2151 (ps-generate-header "HeaderLinesRight" ps-right-header
)
2152 (ps-output (format "%d SetHeaderLines\n" ps-header-lines
)))
2154 (ps-output "BeginPage\n")
2155 (ps-set-font ps-current-font
)
2156 (ps-set-bg ps-current-bg
)
2157 (ps-set-color ps-current-color
)
2158 (ps-set-underline ps-current-underline-p
))
2160 (defun ps-end-page ()
2161 (setq ps-showpage-count
(+ 1 ps-showpage-count
))
2162 (ps-output "EndPage\n")
2163 (ps-output "EndDSCPage\n"))
2165 (defun ps-dummy-page ()
2166 (setq ps-showpage-count
(+ 1 ps-showpage-count
))
2167 (ps-output "%%Page: " (format "- %d\n" ps-showpage-count
)
2169 /PrintHeader false def
2174 (defun ps-next-line ()
2175 (if (< ps-height-remaining ps-line-height
)
2177 (setq ps-width-remaining ps-print-width
)
2178 (setq ps-height-remaining
(- ps-height-remaining ps-line-height
))
2181 (defun ps-continue-line ()
2182 (if (< ps-height-remaining ps-line-height
)
2184 (setq ps-width-remaining ps-print-width
)
2185 (setq ps-height-remaining
(- ps-height-remaining ps-line-height
))
2188 ;; [jack] Why hard and soft ?
2190 (defun ps-hard-lf ()
2193 (defun ps-soft-lf ()
2196 (defun ps-find-wrappoint (from to char-width
)
2197 (let ((avail (truncate (/ ps-width-remaining char-width
)))
2200 (cons to
(* todo char-width
))
2201 (cons (+ from avail
) ps-width-remaining
))))
2203 (defun ps-basic-plot-string (from to
&optional bg-color
)
2204 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width
))
2205 (to (car wrappoint
))
2206 (string (buffer-substring from to
)))
2207 (ps-output-string string
)
2211 (defun ps-basic-plot-whitespace (from to
&optional bg-color
)
2212 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width
))
2213 (to (car wrappoint
)))
2215 (ps-output (format "%d W\n" (- to from
)))
2218 (defun ps-plot (plotfunc from to
&optional bg-color
)
2220 (let* ((wrappoint (funcall plotfunc from to bg-color
))
2221 (plotted-to (car wrappoint
))
2222 (plotted-width (cdr wrappoint
)))
2223 (setq from plotted-to
)
2224 (setq ps-width-remaining
(- ps-width-remaining plotted-width
))
2226 (ps-continue-line))))
2227 (if ps-razzle-dazzle
2228 (let* ((q-todo (- (point-max) (point-min)))
2229 (q-done (- (point) (point-min)))
2230 (chunkfrac (/ q-todo
8))
2231 (chunksize (if (> chunkfrac
1000) 1000 chunkfrac
)))
2232 (if (> (- q-done ps-razchunk
) chunksize
)
2234 (setq ps-razchunk q-done
)
2237 (/ (* 100 q-done
) q-todo
)
2238 (/ q-done
(/ q-todo
100))))
2239 (message "Formatting...%3d%%" foo
))))))
2241 (defun ps-set-font (font)
2242 (setq ps-current-font font
)
2243 (ps-output (format "/f%d F\n" ps-current-font
)))
2245 (defun ps-set-bg (color)
2246 (if (setq ps-current-bg color
)
2247 (ps-output (format ps-color-format
(nth 0 color
) (nth 1 color
)
2250 (ps-output "false BG\n")))
2252 (defun ps-set-color (color)
2253 (if (setq ps-current-color color
)
2255 (setq ps-current-color ps-default-fg
))
2256 (ps-output (format ps-color-format
(nth 0 ps-current-color
)
2257 (nth 1 ps-current-color
) (nth 2 ps-current-color
))
2260 (defun ps-set-underline (underline-p)
2261 (ps-output (if underline-p
"true" "false") " UL\n")
2262 (setq ps-current-underline-p underline-p
))
2264 (defun ps-plot-region (from to font fg-color
&optional bg-color underline-p
)
2266 (if (not (equal font ps-current-font
))
2269 ;; Specify a foreground color only if one's specified and it's
2270 ;; different than the current.
2271 (if (not (equal fg-color ps-current-color
))
2272 (ps-set-color fg-color
))
2274 (if (not (equal bg-color ps-current-bg
))
2275 (ps-set-bg bg-color
))
2277 ;; Toggle underlining if different.
2278 (if (not (equal underline-p ps-current-underline-p
))
2279 (ps-set-underline underline-p
))
2281 ;; Starting at the beginning of the specified region...
2285 ;; ...break the region up into chunks separated by tabs, linefeeds,
2286 ;; and pagefeeds, and plot each chunk.
2288 (if (re-search-forward "[\t\n\f]" to t
)
2289 (let ((match (char-after (match-beginning 0))))
2293 (save-excursion (beginning-of-line) (point))))
2294 (ps-plot 'ps-basic-plot-string from
(- (point) 1)
2297 (setq from
(+ linestart
(current-column)))
2298 (if (re-search-forward "[ \t]+" to t
)
2299 (ps-plot 'ps-basic-plot-whitespace
2300 from
(+ linestart
(current-column))
2304 (ps-plot 'ps-basic-plot-string from
(- (point) 1)
2310 (ps-plot 'ps-basic-plot-string from
(- (point) 1)
2313 (setq from
(point)))
2314 (ps-plot 'ps-basic-plot-string from to bg-color
)
2317 (defun ps-color-value (x-color-value)
2318 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
2319 (/ x-color-value ps-print-color-scale
))
2321 (defun ps-color-values (x-color)
2322 (cond ((fboundp 'x-color-values
)
2323 (x-color-values x-color
))
2324 ((fboundp 'pixel-components
)
2325 (pixel-components x-color
))
2326 (t (error "No available function to determine X color values."))))
2328 (defun ps-face-attributes (face)
2329 (let ((differs (face-differs-from-default-p face
)))
2330 (list (memq face ps-ref-bold-faces
)
2331 (memq face ps-ref-italic-faces
)
2332 (memq face ps-ref-underlined-faces
)
2333 (and differs
(face-foreground face
))
2334 (and differs
(face-background face
)))))
2336 (defun ps-face-attribute-list (face-or-list)
2337 (if (listp face-or-list
)
2338 (let (bold-p italic-p underline-p foreground background face-attr face
)
2340 (setq face
(car face-or-list
))
2341 (setq face-attr
(ps-face-attributes face
))
2342 (setq bold-p
(or bold-p
(nth 0 face-attr
)))
2343 (setq italic-p
(or italic-p
(nth 1 face-attr
)))
2344 (setq underline-p
(or underline-p
(nth 2 face-attr
)))
2347 (setq foreground
(nth 3 face-attr
)))
2350 (setq background
(nth 4 face-attr
)))
2351 (setq face-or-list
(cdr face-or-list
)))
2352 (list bold-p italic-p underline-p foreground background
))
2354 (ps-face-attributes face-or-list
)))
2356 (defun ps-plot-with-face (from to face
)
2358 (let* ((face-attr (ps-face-attribute-list face
))
2359 (bold-p (nth 0 face-attr
))
2360 (italic-p (nth 1 face-attr
))
2361 (underline-p (nth 2 face-attr
))
2362 (foreground (nth 3 face-attr
))
2363 (background (nth 4 face-attr
))
2364 (fg-color (if (and ps-print-color-p foreground
)
2365 (mapcar 'ps-color-value
2366 (ps-color-values foreground
))
2368 (bg-color (if (and ps-print-color-p background
)
2369 (mapcar 'ps-color-value
2370 (ps-color-values background
)))))
2371 (ps-plot-region from to
2372 (cond ((and bold-p italic-p
) 3)
2376 ; (or fg-color '(0.0 0.0 0.0))
2378 bg-color underline-p
))
2382 (defun ps-emacs-face-kind-p (face kind kind-regex kind-list
)
2383 (let ((frame-font (face-font face
))
2384 (face-defaults (face-font face t
)))
2386 ;; Check FACE defaults:
2387 (and (listp face-defaults
)
2388 (memq kind face-defaults
))
2390 ;; Check the user's preferences
2391 (memq face kind-list
))))
2393 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list
)
2394 (let* ((frame-font (or (face-font face
) (face-font 'default
)))
2395 (kind-cons (assq kind
(x-font-properties frame-font
)))
2396 (kind-spec (cdr-safe kind-cons
))
2397 (case-fold-search t
))
2399 (or (and kind-spec
(string-match kind-regex kind-spec
))
2400 ;; Kludge-compatible:
2401 (memq face kind-list
))))
2403 (defun ps-face-bold-p (face)
2404 (if (eq ps-print-emacs-type
'emacs
)
2405 (ps-emacs-face-kind-p face
'bold
"-\\(bold\\|demibold\\)-"
2407 (ps-xemacs-face-kind-p face
'WEIGHT_NAME
"bold\\|demibold"
2410 (defun ps-face-italic-p (face)
2411 (if (eq ps-print-emacs-type
'emacs
)
2412 (ps-emacs-face-kind-p face
'italic
"-[io]-" ps-italic-faces
)
2414 (ps-xemacs-face-kind-p face
'ANGLE_NAME
"i\\|o" ps-italic-faces
)
2415 (ps-xemacs-face-kind-p face
'SLANT
"i\\|o" ps-italic-faces
))))
2417 (defun ps-face-underlined-p (face)
2418 (or (face-underline-p face
)
2419 (memq face ps-underlined-faces
)))
2421 ;; Ensure that face-list is fbound.
2422 (or (fboundp 'face-list
) (defalias 'face-list
'list-faces
))
2424 (defun ps-build-reference-face-lists ()
2425 (if ps-auto-font-detect
2426 (let ((faces (face-list))
2428 (setq ps-ref-bold-faces nil
2429 ps-ref-italic-faces nil
2430 ps-ref-underlined-faces nil
)
2432 (setq the-face
(car faces
))
2433 (if (ps-face-italic-p the-face
)
2434 (setq ps-ref-italic-faces
2435 (cons the-face ps-ref-italic-faces
)))
2436 (if (ps-face-bold-p the-face
)
2437 (setq ps-ref-bold-faces
2438 (cons the-face ps-ref-bold-faces
)))
2439 (if (ps-face-underlined-p the-face
)
2440 (setq ps-ref-underlined-faces
2441 (cons the-face ps-ref-underlined-faces
)))
2442 (setq faces
(cdr faces
))))
2443 (setq ps-ref-bold-faces ps-bold-faces
)
2444 (setq ps-ref-italic-faces ps-italic-faces
)
2445 (setq ps-ref-underlined-faces ps-underlined-faces
))
2446 (setq ps-build-face-reference nil
))
2448 (defun ps-mapper (extent list
)
2449 (nconc list
(list (list (extent-start-position extent
) 'push extent
)
2450 (list (extent-end-position extent
) 'pull extent
)))
2453 (defun ps-extent-sorter (a b
)
2454 (< (extent-priority a
) (extent-priority b
)))
2456 (defun ps-print-ensure-fontified (start end
)
2457 (if (and (boundp 'lazy-lock-mode
) lazy-lock-mode
)
2458 (if (fboundp 'lazy-lock-fontify-region
)
2459 (lazy-lock-fontify-region start end
) ; the new
2460 (lazy-lock-fontify-buffer)))) ; the old
2462 (defun ps-generate-postscript-with-faces (from to
)
2463 ;; Build the reference lists of faces if necessary.
2464 (if (or ps-always-build-face-reference
2465 ps-build-face-reference
)
2467 (message "Collecting face information...")
2468 (ps-build-reference-face-lists)))
2469 ;; Set the color scale. We do it here instead of in the defvar so
2470 ;; that ps-print can be dumped into emacs. This expression can't be
2471 ;; evaluated at dump-time because X isn't initialized.
2472 (setq ps-print-color-scale
2473 (if ps-print-color-p
2474 (float (car (ps-color-values "white")))
2476 ;; Generate some PostScript.
2478 (narrow-to-region from to
)
2479 (let ((face 'default
)
2481 (ps-print-ensure-fontified from to
)
2482 (cond ((or (eq ps-print-emacs-type
'lucid
)
2483 (eq ps-print-emacs-type
'xemacs
))
2484 ;; Build the list of extents...
2485 (let ((a (cons 'dummy nil
))
2486 record type extent extent-list
)
2487 (map-extents 'ps-mapper nil from to a
)
2488 (setq a
(sort (cdr a
) 'car-less-than-car
))
2490 (setq extent-list nil
)
2492 ;; Loop through the extents...
2494 (setq record
(car a
))
2496 (setq position
(car record
))
2497 (setq record
(cdr record
))
2499 (setq type
(car record
))
2500 (setq record
(cdr record
))
2502 (setq extent
(car record
))
2504 ;; Plot up to this record.
2505 ;; XEmacs 19.12: for some reason, we're getting into a
2506 ;; situation in which some of the records have
2507 ;; positions less than 'from'. Since we've narrowed
2508 ;; the buffer, this'll generate errors. This is a
2509 ;; hack, but don't call ps-plot-with-face unless from >
2511 (if (and (>= from
(point-min))
2512 (<= position
(point-max)))
2513 (ps-plot-with-face from position face
))
2517 (if (extent-face extent
)
2518 (setq extent-list
(sort (cons extent extent-list
)
2519 'ps-extent-sorter
))))
2522 (setq extent-list
(sort (delq extent extent-list
)
2523 'ps-extent-sorter
))))
2527 (extent-face (car extent-list
))
2530 (setq from position
)
2533 ((eq ps-print-emacs-type
'emacs
)
2534 (let ((property-change from
)
2535 (overlay-change from
))
2537 (if (< property-change to
) ; Don't search for property change
2538 ; unless previous search succeeded.
2539 (setq property-change
2540 (next-property-change from nil to
)))
2541 (if (< overlay-change to
) ; Don't search for overlay change
2542 ; unless previous search succeeded.
2543 (setq overlay-change
2544 (min (next-overlay-change from
) to
)))
2546 (min property-change overlay-change
))
2547 ;; The code below is not quite correct,
2548 ;; because a non-nil overlay invisible property
2549 ;; which is inactive according to the current value
2550 ;; of buffer-invisibility-spec nonetheless overrides
2551 ;; a face text property.
2553 (cond ((let ((prop (get-text-property from
'invisible
)))
2554 ;; Decide whether this invisible property
2555 ;; really makes the text invisible.
2556 (if (eq buffer-invisibility-spec t
)
2558 (or (memq prop buffer-invisibility-spec
)
2559 (assq prop buffer-invisibility-spec
))))
2561 ((get-text-property from
'face
))
2563 (let ((overlays (overlays-at from
))
2564 (face-priority -
1)) ; text-property
2566 (let* ((overlay (car overlays
))
2567 (overlay-face (overlay-get overlay
'face
))
2568 (overlay-invisible (overlay-get overlay
'invisible
))
2569 (overlay-priority (or (overlay-get overlay
2572 (if (and (or overlay-invisible overlay-face
)
2573 (> overlay-priority face-priority
))
2574 (setq face
(cond ((if (eq buffer-invisibility-spec t
)
2575 (not (null overlay-invisible
))
2576 (or (memq overlay-invisible buffer-invisibility-spec
)
2577 (assq overlay-invisible buffer-invisibility-spec
)))
2579 ((and face overlay-face
)))
2580 face-priority overlay-priority
)))
2581 (setq overlays
(cdr overlays
))))
2582 ;; Plot up to this record.
2583 (ps-plot-with-face from position face
)
2584 (setq from position
)))))
2585 (ps-plot-with-face from to face
))))
2587 (defun ps-generate-postscript (from to
)
2588 (ps-plot-region from to
0 nil
))
2590 (defun ps-generate (buffer from to genfunc
)
2591 (let ((from (min to from
))
2593 ;; This avoids trouble if chars with read-only properties
2594 ;; are copied into ps-spool-buffer.
2595 (inhibit-read-only t
))
2597 (narrow-to-region from to
)
2598 (if ps-razzle-dazzle
2599 (message "Formatting...%3d%%" (setq ps-razchunk
0)))
2601 (setq ps-source-buffer buffer
)
2602 (setq ps-spool-buffer
(get-buffer-create ps-spool-buffer-name
))
2603 (ps-init-output-queue)
2604 (let (safe-marker completed-safely needs-begin-file
)
2607 (set-buffer ps-spool-buffer
)
2609 ;; Get a marker and make it point to the current end of the
2610 ;; buffer, If an error occurs, we'll delete everything from
2611 ;; the end of this marker onwards.
2612 (setq safe-marker
(make-marker))
2613 (set-marker safe-marker
(point-max))
2615 (goto-char (point-min))
2616 (if (looking-at (regexp-quote "%!PS-Adobe-1.0"))
2618 (setq needs-begin-file t
))
2620 (set-buffer ps-source-buffer
)
2621 (if needs-begin-file
(ps-begin-file))
2624 (set-buffer ps-source-buffer
)
2625 (funcall genfunc from to
)
2628 (if (and ps-spool-duplex
2629 (= (mod ps-page-count
2) 1))
2633 ;; Back to the PS output buffer to set the page count
2634 (set-buffer ps-spool-buffer
)
2635 (goto-char (point-max))
2636 (while (re-search-backward "^/PageCount 0 def$" nil t
)
2637 (replace-match (format "/PageCount %d def" ps-page-count
) t
))
2639 ;; Setting this variable tells the unwind form that the
2640 ;; the postscript was generated without error.
2641 (setq completed-safely t
))
2643 ;; Unwind form: If some bad mojo occurred while generating
2644 ;; postscript, delete all the postscript that was generated.
2645 ;; This protects the previously spooled files from getting
2647 (if (and (markerp safe-marker
) (not completed-safely
))
2649 (set-buffer ps-spool-buffer
)
2650 (delete-region (marker-position safe-marker
) (point-max))))))
2652 (if ps-razzle-dazzle
2653 (message "Formatting...done")))))
2655 (defun ps-do-despool (filename)
2656 (if (or (not (boundp 'ps-spool-buffer
))
2657 (not (symbol-value 'ps-spool-buffer
)))
2658 (message "No spooled PostScript to print")
2663 (if ps-razzle-dazzle
2664 (message "Saving..."))
2665 (set-buffer ps-spool-buffer
)
2666 (setq filename
(expand-file-name filename
))
2667 (write-region (point-min) (point-max) filename
)
2668 (if ps-razzle-dazzle
2669 (message "Wrote %s" filename
)))
2670 ;; Else, spool to the printer
2671 (if ps-razzle-dazzle
2672 (message "Printing..."))
2674 (set-buffer ps-spool-buffer
)
2675 (if (and (eq system-type
'ms-dos
) (stringp dos-ps-printer
))
2676 (write-region (point-min) (point-max) dos-ps-printer t
0)
2677 (let ((binary-process-input t
)) ; for MS-DOS
2678 (apply 'call-process-region
2679 (point-min) (point-max) ps-lpr-command nil
2680 (if (fboundp 'start-process
) 0 nil
)
2683 (if ps-razzle-dazzle
2684 (message "Printing...done")))
2685 (kill-buffer ps-spool-buffer
)))
2687 (defun ps-kill-emacs-check ()
2689 (if (and (setq ps-buffer
(get-buffer ps-spool-buffer-name
))
2690 (buffer-modified-p ps-buffer
))
2691 (if (y-or-n-p "Unprinted PostScript waiting; print now? ")
2693 (if (and (setq ps-buffer
(get-buffer ps-spool-buffer-name
))
2694 (buffer-modified-p ps-buffer
))
2695 (if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")
2697 (error "Unprinted PostScript")))))
2699 (if (fboundp 'add-hook
)
2700 (funcall 'add-hook
'kill-emacs-hook
'ps-kill-emacs-check
)
2702 (message "Won't override existing kill-emacs-hook")
2703 (setq kill-emacs-hook
'ps-kill-emacs-check
)))
2705 ;;; Sample Setup Code:
2707 ;; This stuff is for anybody that's brave enough to look this far,
2708 ;; and able to figure out how to use it. It isn't really part of ps-
2709 ;; print, but I'll leave it here in hopes it might be useful:
2711 ;; WARNING!!! The following code is *sample* code only. Don't use it
2712 ;; unless you understand what it does!
2714 (defmacro ps-prsc
() (list 'if
(list 'eq
'ps-print-emacs-type
''emacs
)
2716 (defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
2719 (defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
2723 ;; Look in an article or mail message for the Subject: line. To be
2724 ;; placed in ps-left-headers.
2725 (defun ps-article-subject ()
2727 (goto-char (point-min))
2728 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
2729 (buffer-substring (match-beginning 1) (match-end 1))
2732 ;; Look in an article or mail message for the From: line. Sorta-kinda
2733 ;; understands RFC-822 addresses and can pull the real name out where
2734 ;; it's provided. To be placed in ps-left-headers.
2735 (defun ps-article-author ()
2737 (goto-char (point-min))
2738 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
2739 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
2742 ;; Try first to match addresses that look like
2743 ;; thompson@wg2.waii.com (Jim Thompson)
2744 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
2745 (substring fromstring (match-beginning 1) (match-end 1)))
2747 ;; Next try to match addresses that look like
2748 ;; Jim Thompson <thompson@wg2.waii.com>
2749 ((string-match "\\(.*\\)[ \t]+<.*>" fromstring)
2750 (substring fromstring (match-beginning 1) (match-end 1)))
2752 ;; Couldn't find a real name -- show the address instead.
2756 ;; A hook to bind to gnus-Article-prepare-hook. This will set the ps-
2757 ;; left-headers specially for gnus articles. Unfortunately, gnus-
2758 ;; article-mode-hook is called only once, the first time the *Article*
2759 ;; buffer enters that mode, so it would only work for the first time
2760 ;; we ran gnus. The second time, this hook wouldn't get set up. The
2761 ;; only alternative is gnus-article-prepare-hook.
2762 (defun ps-gnus-article-prepare-hook ()
2763 (setq ps-header-lines 3)
2764 (setq ps-left-header
2765 ;; The left headers will display the article's subject, its
2766 ;; author, and the newsgroup it was in.
2767 (list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name)))
2769 ;; A hook to bind to vm-mode-hook to locally bind prsc and set the ps-
2770 ;; left-headers specially for mail messages. This header setup would
2771 ;; also work, I think, for RMAIL.
2772 (defun ps-vm-mode-hook ()
2773 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
2774 (setq ps-header-lines 3)
2775 (setq ps-left-header
2776 ;; The left headers will display the message's subject, its
2777 ;; author, and the name of the folder it was in.
2778 (list 'ps-article-subject 'ps-article-author 'buffer-name)))
2780 ;; Every now and then I forget to switch from the *Summary* buffer to
2781 ;; the *Article* before hitting prsc, and a nicely formatted list of
2782 ;; article subjects shows up at the printer. This function, bound to
2783 ;; prsc for the gnus *Summary* buffer means I don't have to switch
2785 (defun ps-gnus-print-article-from-summary ()
2787 (if (get-buffer "*Article*")
2789 (set-buffer "*Article*")
2790 (ps-spool-buffer-with-faces))))
2792 ;; See ps-gnus-print-article-from-summary. This function does the
2793 ;; same thing for vm.
2794 (defun ps-vm-print-message-from-summary ()
2796 (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
2798 (set-buffer (symbol-value 'vm-mail-buffer))
2799 (ps-spool-buffer-with-faces))))
2801 ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind
2803 (defun ps-gnus-summary-setup ()
2804 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
2806 ;; Look in an article or mail message for the Subject: line. To be
2807 ;; placed in ps-left-headers.
2808 (defun ps-info-file ()
2810 (goto-char (point-min))
2811 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
2812 (buffer-substring (match-beginning 1) (match-end 1))
2815 ;; Look in an article or mail message for the Subject: line. To be
2816 ;; placed in ps-left-headers.
2817 (defun ps-info-node ()
2819 (goto-char (point-min))
2820 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
2821 (buffer-substring (match-beginning 1) (match-end 1))
2824 (defun ps-info-mode-hook ()
2825 (setq ps-left-header
2826 ;; The left headers will display the node name and file name.
2827 (list 'ps-info-node 'ps-info-file)))
2829 ;; WARNING! The following function is a *sample* only, and is *not*
2830 ;; meant to be used as a whole unless you understand what the effects
2831 ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- I'd
2832 ;; be very surprised if it was useful to *anybody*, without
2835 (defun ps-jts-ps-setup ()
2836 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
2837 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
2838 (global-set-key (ps-c-prsc) 'ps-despool)
2839 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
2840 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
2841 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
2842 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
2843 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
2844 (setq ps-spool-duplex t)
2845 (setq ps-print-color-p nil)
2846 (setq ps-lpr-command "lpr")
2847 (setq ps-lpr-switches '("-Jjct,duplex_long"))
2850 ;; WARNING! The following function is a *sample* only, and is *not*
2851 ;; meant to be used as a whole unless it corresponds to your needs.
2852 ;; (In fact, this is a copy of Jack's setup for ps-print --
2853 ;; I would not be that surprised if it was useful to *anybody*,
2854 ;; without modification.)
2856 (defun ps-jack-setup ()
2857 (setq ps-print-color-p 'nil
2858 ps-lpr-command "lpr"
2859 ps-lpr-switches (list)
2862 ps-landscape-mode 't
2863 ps-number-of-columns 2
2865 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
2866 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
2867 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
2868 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2869 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2870 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2871 ps-header-line-pad .15
2873 ps-print-header-frame t
2878 ps-font-family 'Courier
2880 ps-header-font-family 'Helvetica
2881 ps-header-font-size 6
2882 ps-header-title-font-size 8)
2887 ;;; ps-print.el ends here