1 ;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19.
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6 ;; Author: Jacques Duthen <duthen@club-internet.fr>
7 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.br>
8 ;; Keywords: print, PostScript
9 ;; Time-stamp: <97/01/09 13:52:08 duthen>
12 (defconst ps-print-version "3.04"
13 "ps-print.el, v 3.04 <97/01/09 duthen>
15 Jack's last change version -- this file may have been edited as part of
16 Emacs without changes to the version number. When reporting bugs,
17 please also report the version of Emacs, if any, that ps-print was
20 Please send all bug fixes and enhancements to
21 Jacques Duthen <duthen@club-internet.fr>>.
24 ;; This file is part of GNU Emacs.
26 ;; GNU Emacs is free software; you can redistribute it and/or modify
27 ;; it under the terms of the GNU General Public License as published by
28 ;; the Free Software Foundation; either version 2, or (at your option)
31 ;; GNU Emacs is distributed in the hope that it will be useful,
32 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
33 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
34 ;; GNU General Public License for more details.
36 ;; You should have received a copy of the GNU General Public License
37 ;; along with GNU Emacs; see the file COPYING. If not, write to the
38 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
39 ;; Boston, MA 02111-1307, USA.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; This package provides printing of Emacs buffers on PostScript
49 ;; printers; the buffer's bold and italic text attributes are
50 ;; preserved in the printer output. Ps-print is intended for use with
51 ;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
52 ;; font-lock or hilit.
60 ;; Ps-print provides eight commands for generating PostScript images
64 ;; ps-print-buffer-with-faces
66 ;; ps-print-region-with-faces
68 ;; ps-spool-buffer-with-faces
70 ;; ps-spool-region-with-faces
72 ;; These commands all perform essentially the same function: they
73 ;; generate PostScript images suitable for printing on a PostScript
74 ;; printer or displaying with GhostScript. These commands are
75 ;; collectively referred to as "ps-print- commands".
77 ;; The word "print" or "spool" in the command name determines when the
78 ;; PostScript image is sent to the printer:
80 ;; print - The PostScript image is immediately sent to the
83 ;; spool - The PostScript image is saved temporarily in an
84 ;; Emacs buffer. Many images may be spooled locally
85 ;; before printing them. To send the spooled images
86 ;; to the printer, use the command `ps-despool'.
88 ;; The spooling mechanism was designed for printing lots of small
89 ;; files (mail messages or netnews articles) to save paper that would
90 ;; otherwise be wasted on banner pages, and to make it easier to find
91 ;; your output at the printer (it's easier to pick up one 50-page
92 ;; printout than to find 50 single-page printouts).
94 ;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't
95 ;; accidentally quit from Emacs while you have unprinted PostScript
96 ;; waiting in the spool buffer. If you do attempt to exit with
97 ;; spooled PostScript, you'll be asked if you want to print it, and if
98 ;; you decline, you'll be asked to confirm the exit; this is modeled
99 ;; on the confirmation that Emacs uses for modified buffers.
101 ;; The word "buffer" or "region" in the command name determines how
102 ;; much of the buffer is printed:
104 ;; buffer - Print the entire buffer.
106 ;; region - Print just the current region.
108 ;; The -with-faces suffix on the command name means that the command
109 ;; will include font, color, and underline information in the
110 ;; PostScript image, so the printed image can look as pretty as the
111 ;; buffer. The ps-print- commands without the -with-faces suffix
112 ;; don't include font, color, or underline information; images printed
113 ;; with these commands aren't as pretty, but are faster to generate.
115 ;; Two ps-print- command examples:
117 ;; ps-print-buffer - print the entire buffer,
118 ;; without font, color, or
119 ;; underline information, and
120 ;; send it immediately to the
123 ;; ps-spool-region-with-faces - print just the current region;
124 ;; include font, color, and
125 ;; underline information, and
126 ;; spool the image in Emacs to
127 ;; send to the printer later.
133 ;; To print your buffer, type
135 ;; M-x ps-print-buffer
137 ;; or substitute one of the other seven ps-print- commands. The
138 ;; command will generate the PostScript image and print or spool it as
139 ;; specified. By giving the command a prefix argument
141 ;; C-u M-x ps-print-buffer
143 ;; it will save the PostScript image to a file instead of sending it
144 ;; to the printer; you will be prompted for the name of the file to
145 ;; save the image to. The prefix argument is ignored by the commands
146 ;; that spool their images, but you may save the spooled images to a
147 ;; file by giving a prefix argument to `ps-despool':
149 ;; C-u M-x ps-despool
151 ;; When invoked this way, `ps-despool' will prompt you for the name of
152 ;; the file to save to.
154 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
155 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
156 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
158 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
159 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
160 ;; (global-set-key '(control f22) 'ps-despool)
163 ;; The Printer Interface
164 ;; ---------------------
166 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
167 ;; command is used to send the PostScript images to the printer, and
168 ;; what arguments to give the command. These are analogous to
169 ;; `lpr-command' and `lpr-switches'.
170 ;; Make sure that they contain appropriate values for your system;
171 ;; see the usage notes below and the documentation of these variables.
173 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
174 ;; from the variables `lpr-command' and `lpr-switches'. If you have
175 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
176 ;; then ps-print won't work properly. `ps-lpr-command' must name
177 ;; a program that does not format the files it prints.
183 ;; All dimensions are floats in PostScript points.
184 ;; 1 inch == 2.54 cm == 72 points
185 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
187 ;; The variable `ps-paper-type' determines the size of paper ps-print
188 ;; formats for; it should contain one of the symbols:
189 ;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
190 ;; `ledger' `statement' `executive' `a4small' `b4' `b5'
192 ;; The variable `ps-landscape-mode' determines the orientation
193 ;; of the printing on the page:
194 ;; nil means `portrait' mode, non-nil means `landscape' mode.
195 ;; There is no oblique mode yet, though this is easy to do in ps.
197 ;; In landscape mode, the text is NOT scaled: you may print 70 lines
198 ;; in portrait mode and only 50 lignes in landscape mode.
199 ;; The margins represent margins in the printed paper:
200 ;; the top margin is the margin between the top of the page
201 ;; and the printed header, whatever the orientation is.
203 ;; The variable `ps-number-of-columns' determines the number of columns
204 ;; both in landscape and portrait mode.
206 ;; - (the standard) one column portrait mode
207 ;; - (my favorite) two columns landscape mode (which spares trees)
209 ;; - one column landscape mode for files with very long lines.
210 ;; - multi-column portrait or landscape mode
216 ;; The horizontal layout is determined by the variables
217 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
220 ;; ------------------------------------------
222 ;; | lm | text | ic | text | ic | text | rm |
224 ;; ------------------------------------------
226 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
227 ;; Usually, lm = rm > 0 and ic = lm
228 ;; If (ic < 0), the text of adjacent columns can overlap.
234 ;; The vertical layout is determined by the variables
235 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
238 ;; |--------| |--------|
240 ;; |--------| |--------|
244 ;; |--------| or | text |
248 ;; |--------| |--------|
250 ;; |--------| |--------|
252 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
253 ;; The margins represent margins in the printed paper:
254 ;; the top margin is the margin between the top of the page
255 ;; and the printed header, whatever the orientation is.
261 ;; Ps-print can print headers at the top of each column; the default
262 ;; headers contain the following four items: on the left, the name of
263 ;; the buffer and, if the buffer is visiting a file, the file's
264 ;; directory; on the right, the page number and date of printing.
265 ;; The default headers look something like this:
268 ;; /home/jct/emacs-lisp/ps/new 94/12/31
270 ;; When printing on duplex printers, left and right are reversed so
271 ;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
273 ;; Headers are configurable:
274 ;; To turn them off completely, set `ps-print-header' to nil.
275 ;; To turn off the header's gaudy framing box,
276 ;; set `ps-print-header-frame' to nil.
278 ;; The font family and size of text in the header are determined
279 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
280 ;; `ps-header-title-font-size' (see below).
282 ;; The variable `ps-header-line-pad' determines the portion of a header
283 ;; title line height to insert between the header frame and the text
284 ;; it contains, both in the vertical and horizontal directions:
285 ;; .5 means half a line.
287 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
288 ;; to omit the total page count and just print the page number,
289 ;; set `ps-show-n-of-n' to nil.
291 ;; The amount of information in the header can be changed by changing
292 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
293 ;; the header will show only the buffer name and page number. To show
294 ;; more, set `ps-header-lines' to 3, and the header will show the time of
295 ;; printing below the date.
297 ;; To change the content of the headers, change the variables
298 ;; `ps-left-header' and `ps-right-header'.
299 ;; These variables are lists, specifying top-to-bottom the text
300 ;; to display on the left or right side of the header.
301 ;; Each element of the list should be a string or a symbol.
302 ;; Strings are inserted directly into the PostScript arrays,
303 ;; and should contain the PostScript string delimiters '(' and ')'.
305 ;; Symbols in the header format lists can either represent functions
306 ;; or variables. Functions are called, and should return a string to
307 ;; show in the header. Variables should contain strings to display in
308 ;; the header. In either case, function or variable, the PostScript
309 ;; string delimiters are added by ps-print, and should not be part of
310 ;; the returned value.
312 ;; Here's an example: say we want the left header to display the text
318 ;; where we have a function to return "Moe"
320 ;; (defun moe-func ()
323 ;; a variable specifying "Larry"
325 ;; (setq larry-var "Larry")
327 ;; and a literal for "Curly". Here's how `ps-left-header' should be
330 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
332 ;; Note that Curly has the PostScript string delimiters inside his
333 ;; quotes -- those aren't misplaced lisp delimiters!
334 ;; Without them, PostScript would attempt to call the undefined
335 ;; function Curly, which would result in a PostScript error.
336 ;; Since most printers don't report PostScript errors except by
337 ;; aborting the print job, this kind of error can be hard to track down.
338 ;; Consider yourself warned!
344 ;; If you have a duplex-capable printer (one that prints both sides of
345 ;; the paper), set `ps-spool-duplex' to t.
346 ;; Ps-print will insert blank pages to make sure each buffer starts
347 ;; on the correct side of the paper.
348 ;; Don't forget to set `ps-lpr-switches' to select duplex printing
355 ;; Ps-print now knows rather precisely some fonts:
356 ;; the variable `ps-font-info-database' contains information
357 ;; for a list of font families (currently mainly `Courier' `Helvetica'
358 ;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
359 ;; Each font family contains the font names for standard, bold, italic
360 ;; and bold-italic characters, a reference size (usually 10) and the
361 ;; corresponding line height, width of a space and average character width.
363 ;; The variable `ps-font-family' determines which font family
364 ;; is to be used for ordinary text.
365 ;; If its value does not correspond to a known font family,
366 ;; an error message is printed into the `*Messages*' buffer,
367 ;; which lists the currently available font families.
369 ;; The variable `ps-font-size' determines the size (in points)
370 ;; of the font for ordinary text, when generating Postscript.
371 ;; Its value is a float.
373 ;; Similarly, the variable `ps-header-font-family' determines
374 ;; which font family is to be used for text in the header.
375 ;; The variable `ps-header-font-size' determines the font size,
376 ;; in points, for text in the header.
377 ;; The variable `ps-header-title-font-size' determines the font size,
378 ;; in points, for the top line of text in the header.
381 ;; Adding a new font family
382 ;; ------------------------
384 ;; To use a new font family, you MUST first teach ps-print
385 ;; this font, ie add its information to `ps-font-info-database',
386 ;; otherwise ps-print cannot correctly place line and page breaks.
388 ;; For example, assuming `Helvetica' is unkown,
389 ;; you first need to do the following ONLY ONCE:
391 ;; - create a new buffer
392 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
393 ;; - open this file and find the line:
394 ;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
395 ;; - delete the leading `%' (which is the Postscript comment character)
396 ;; - replace in this line `Courier' by the new font (say `Helvetica')
398 ;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
399 ;; - send this file to the printer (or to ghostscript).
400 ;; You should read the following on the output page:
402 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
403 ;; and a crude estimate of average character width is 5.09243
405 ;; - Add these values to the `ps-font-info-database':
406 ;; (setq ps-font-info-database
408 ;; '((Helvetica ; the family name
409 ;; "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
410 ;; 10.0 11.56 2.78 5.09243))
411 ;; ps-font-info-database))
412 ;; - Now you can use this font family with any size:
413 ;; (setq ps-font-family 'Helvetica)
414 ;; - if you want to use this family in another emacs session, you must
415 ;; put into your `~/.emacs':
416 ;; (require 'ps-print)
417 ;; (setq ps-font-info-database (append ...)))
418 ;; if you don't want to load ps-print, you have to copy the whole value:
419 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
420 ;; or, if you can wait until the `ps-print-hook' is implemented, do:
421 ;; (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...)))
422 ;; This does not work yet, since there is no `ps-print-hook' yet.
424 ;; You can create new `mixed' font families like:
426 ;; "Courier-Bold" "Helvetica"
427 ;; "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic"
428 ;; 10.0 10.55 6.0 6.0)
429 ;; Now you can use your new font family with any size:
430 ;; (setq ps-font-family 'my-mixed-family)
432 ;; You can get information on all the fonts resident in YOUR printer
433 ;; by uncommenting the line:
434 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
436 ;; The postscript file should be sent to YOUR postscript printer.
437 ;; If you send it to ghostscript or to another postscript printer,
438 ;; you may get slightly different results.
439 ;; Anyway, as ghostscript fonts are autoload, you won't get
443 ;; How Ps-Print Deals With Faces
444 ;; -----------------------------
446 ;; The ps-print-*-with-faces commands attempt to determine which faces
447 ;; should be printed in bold or italic, but their guesses aren't
448 ;; always right. For example, you might want to map colors into faces
449 ;; so that blue faces print in bold, and red faces in italic.
451 ;; It is possible to force ps-print to consider specific faces bold or
452 ;; italic, no matter what font they are displayed in, by setting the
453 ;; variables `ps-bold-faces' and `ps-italic-faces'. These variables
454 ;; contain lists of faces that ps-print should consider bold or
455 ;; italic; to set them, put code like the following into your .emacs
458 ;; (setq ps-bold-faces '(my-blue-face))
459 ;; (setq ps-italic-faces '(my-red-face))
461 ;; Faces like bold-italic that are both bold and italic should go in
464 ;; Ps-print keeps internal lists of which fonts are bold and which are
465 ;; italic; these lists are built the first time you invoke ps-print.
466 ;; For the sake of efficiency, the lists are built only once; the same
467 ;; lists are referred in later invocations of ps-print.
469 ;; Because these lists are built only once, it's possible for them to
470 ;; get out of sync, if a face changes, or if new faces are added. To
471 ;; get the lists back in sync, you can set the variable
472 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
473 ;; next time ps-print is invoked.
476 ;; How Ps-Print Deals With Color
477 ;; -----------------------------
479 ;; Ps-print detects faces with foreground and background colors
480 ;; defined and embeds color information in the PostScript image.
481 ;; The default foreground and background colors are defined by the
482 ;; variables `ps-default-fg' and `ps-default-bg'.
483 ;; On black-and-white printers, colors are displayed in grayscale.
484 ;; To turn off color output, set `ps-print-color-p' to nil.
490 ;; Some tools are provided to help you customize your font setup.
492 ;; `ps-setup' returns (some part of) the current setup.
494 ;; To avoid wrapping too many lines, you may want to adjust the
495 ;; left and right margins and the font size. On UN*X systems, do:
496 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
497 ;; to determine the longest lines of your file.
498 ;; Then, the command `ps-line-lengths' will give you the correspondance
499 ;; between a line length (number of characters) and the maximum font
500 ;; size which doesn't wrap such a line with the current ps-print setup.
502 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
503 ;; the correspondance between a number of pages and the maximum font
504 ;; size which allow the number of lines of the current buffer or of
505 ;; its current region to fit in this number of pages.
506 ;; Note: line folding is not taken into account in this process
507 ;; and could change the results.
510 ;; New since version 1.5
511 ;; ---------------------
513 ;; Color output capability.
514 ;; Automatic detection of font attributes (bold, italic).
515 ;; Configurable headers with page numbers.
517 ;; Support for different paper sizes.
518 ;; Better conformance to PostScript Document Structure Conventions.
521 ;; New since version 2.8
522 ;; ---------------------
524 ;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
526 ;; Font familiy and float size for text and header.
529 ;; Tools for page setup.
532 ;; Known bugs and limitations of ps-print:
533 ;; --------------------------------------
535 ;; Although color printing will work in XEmacs 19.12, it doesn't work
536 ;; well; in particular, bold or italic fonts don't print in the right
539 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
541 ;; Automatic font-attribute detection doesn't work well, especially
542 ;; with hilit19 and older versions of get-create-face. Users having
543 ;; problems with auto-font detection should use the lists
544 ;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic
545 ;; detection by setting `ps-auto-font-detect' to nil.
547 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
548 ;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces'
551 ;; Still too slow; could use some hand-optimization.
553 ;; ASCII Control characters other than tab, linefeed and pagefeed are
556 ;; Default background color isn't working.
558 ;; Faces are always treated as opaque.
560 ;; Epoch and Emacs 18 not supported. At all.
562 ;; Fixed-pitch fonts work better for line folding, but are not required.
564 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
571 ;; Add `ps-print-hook' (I don't know how to do that (yet!)).
572 ;; Add 4-up capability (really needed?).
573 ;; Add line numbers (should not be too hard).
574 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
575 ;; Put one header per page over the columns (easy but needed?).
576 ;; Improve the memory management for big files (hard?).
577 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
583 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
586 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
587 ;; color and the invisible property.
589 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
590 ;; the initial port to Emacs 19. His code is no longer part of
591 ;; ps-print, but his work is still appreciated.
593 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
594 ;; for adding underline support. Their code also is no longer part of
595 ;; ps-print, but their efforts are not forgotten.
597 ;; Thanks also to all of you who mailed code to add features to
598 ;; ps-print; although I didn't use your code, I still appreciate your
599 ;; sharing it with me.
601 ;; Thanks to all who mailed comments, encouragement, and criticism.
602 ;; Thanks also to all who responded to my survey; I had too many
603 ;; responses to reply to them all, but I greatly appreciate your
607 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
614 (unless (featurep 'lisp-float-type)
615 (error "`ps-print' requires floating point support"))
617 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
620 ;;; Interface to the command system
622 (defgroup ps-print nil
623 "Postscript generator for Emacs 19"
627 (defgroup ps-print-horizontal nil
628 "Horizontal page layout"
633 (defgroup ps-print-vertical nil
634 "Vertical page layout"
639 (defgroup ps-print-header nil
645 (defgroup ps-print-font nil
646 "Fonts customization"
651 (defgroup ps-print-color nil
652 "Color customization"
657 (defgroup ps-print-face nil
658 "Faces customization"
665 (defcustom ps-lpr-command lpr-command
666 "*The shell command for printing a PostScript file."
670 (defcustom ps-lpr-switches lpr-switches
671 "*A list of extra switches to pass to `ps-lpr-command'."
672 :type '(repeat string)
677 ;; All page dimensions are in PostScript points.
678 ;; 1 inch == 2.54 cm == 72 points
679 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
681 ;; Letter 8.5 inch x 11.0 inch
682 ;; Legal 8.5 inch x 14.0 inch
683 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
685 ;; LetterSmall 7.68 inch x 10.16 inch
686 ;; Tabloid 11.0 inch x 17.0 inch
687 ;; Ledger 17.0 inch x 11.0 inch
688 ;; Statement 5.5 inch x 8.5 inch
689 ;; Executive 7.5 inch x 10.0 inch
690 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
691 ;; A4Small 7.47 inch x 10.85 inch
692 ;; B4 10.125 inch x 14.33 inch
693 ;; B5 7.16 inch x 10.125 inch
695 (defcustom ps-page-dimensions-database
696 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54))
697 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54))
698 (list 'letter (* 72 8.5) (* 72 11.0))
699 (list 'legal (* 72 8.5) (* 72 14.0))
700 (list 'letter-small (* 72 7.68) (* 72 10.16))
701 (list 'tabloid (* 72 11.0) (* 72 17.0))
702 (list 'ledger (* 72 17.0) (* 72 11.0))
703 (list 'statement (* 72 5.5) (* 72 8.5))
704 (list 'executive (* 72 7.5) (* 72 10.0))
705 (list 'a4small (* 72 7.47) (* 72 10.85))
706 (list 'b4 (* 72 10.125) (* 72 14.33))
707 (list 'b5 (* 72 7.16) (* 72 10.125)))
708 "*List associating a symbolic paper type to its width and height.
709 see `ps-paper-type'."
710 :type '(repeat (list :tag "Paper Type"
712 (number :tag "Width")
713 (number :tag "Height")))
716 (defcustom ps-paper-type 'letter
717 "*Specifies the size of paper to format for.
718 Should be one of the paper types defined in `ps-page-dimensions-database', for
719 example `letter', `legal' or `a4'."
720 :type '(symbol :validate (lambda (wid)
721 (if (assq (widget-value wid) ps-page-dimensions-database)
723 (widget-put wid :error "Unknown paper size")
727 (defcustom ps-landscape-mode 'nil
728 "*Non-nil means print in landscape mode."
732 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
733 "*Specifies the number of columns"
737 ;;; Horizontal layout
739 ;; ------------------------------------------
741 ;; | lm | text | ic | text | ic | text | rm |
743 ;; ------------------------------------------
745 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
746 "*Left margin in points (1/72 inch)."
748 :group 'ps-print-horizontal)
750 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
751 "*Right margin in points (1/72 inch)."
753 :group 'ps-print-horizontal)
755 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
756 "*Horizontal space between columns in points (1/72 inch)."
758 :group 'ps-print-horizontal)
774 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
775 "*Bottom margin in points (1/72 inch)."
777 :group 'ps-print-vertical)
779 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
780 "*Top margin in points (1/72 inch)."
782 :group 'ps-print-vertical)
784 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
785 "*Vertical space in points (1/72 inch) between the main text and the header."
787 :group 'ps-print-vertical)
789 (defcustom ps-header-line-pad 0.15
790 "*Portion of a header title line height to insert between the header frame
791 and the text it contains, both in the vertical and horizontal directions."
793 :group 'ps-print-vertical)
797 (defcustom ps-print-header t
798 "*Non-nil means print a header at the top of each page.
799 By default, the header displays the buffer name, page number, and, if
800 the buffer is visiting a file, the file's directory. Headers are
801 customizable by changing variables `ps-left-header' and
804 :group 'ps-print-header)
806 (defcustom ps-print-header-frame t
807 "*Non-nil means draw a gaudy frame around the header."
809 :group 'ps-print-header)
811 (defcustom ps-header-lines 2
812 "*Number of lines to display in page header, when generating Postscript."
814 :group 'ps-print-header)
815 (make-variable-buffer-local 'ps-header-lines)
817 (defcustom ps-show-n-of-n t
818 "*Non-nil means show page numbers as N/M, meaning page N of M.
819 Note: page numbers are displayed as part of headers, see variable
822 :group 'ps-print-header)
824 (defcustom ps-spool-duplex nil ; Not many people have duplex
825 ; printers, so default to nil.
826 "*Non-nil indicates spooling is for a two-sided printer.
827 For a duplex printer, the `ps-spool-*' commands will insert blank pages
828 as needed between print jobs so that the next buffer printed will
829 start on the right page. Also, if headers are turned on, the headers
830 will be reversed on duplex printers so that the page numbers fall to
831 the left on even-numbered pages."
833 :group 'ps-print-header)
837 (defcustom ps-font-info-database
838 '((Courier ; the family key
839 "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique"
841 (Helvetica ; the family key
842 "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
843 10.0 11.56 2.78 5.09243)
845 "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic"
846 10.0 11.0 2.5 4.71432)
848 "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic"
849 10.0 12.1 2.5 5.08676)
851 "Helvetica-Narrow" "Helvetica-Narrow-Bold"
852 "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique"
853 10.0 11.56 2.2796 4.17579)
855 "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold"
856 "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic"
857 10.0 12.15 2.78 5.31162)
858 ;; got no bold for the next ones
860 "AvantGarde-Book" "AvantGarde-Book"
861 "AvantGarde-BookOblique" "AvantGarde-BookOblique"
862 10.0 11.77 2.77 5.45189)
864 "AvantGarde-Demi" "AvantGarde-Demi"
865 "AvantGarde-DemiOblique" "AvantGarde-DemiOblique"
866 10.0 12.72 2.8 5.51351)
868 "Bookman-Demi" "Bookman-Demi"
869 "Bookman-DemiItalic" "Bookman-DemiItalic"
870 10.0 11.77 3.4 6.05946)
872 "Bookman-Light" "Bookman-Light"
873 "Bookman-LightItalic" "Bookman-LightItalic"
874 10.0 11.79 3.2 5.67027)
875 ;; got no bold and no italic for the next ones
877 "Symbol" "Symbol" "Symbol" "Symbol"
878 10.0 13.03 2.5 3.24324)
880 "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats"
882 (Zapf-Chancery-MediumItalic
883 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
884 "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
885 10.0 11.45 2.2 4.10811)
887 "*Font info database: font family (the key), name, bold, italic, bold-italic,
888 reference size, line height, space width, average character width.
889 To get the info for another specific font (say Helvetica), do the following:
890 - create a new buffer
891 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
892 - open this file and delete the leading `%' (which is the Postscript
893 comment character) from the line
894 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
896 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
897 - add the values to `ps-font-info-database'.
898 You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
899 :type '(repeat (list :tag "Font Definition"
903 (string :tag "Italic")
904 (string :tag "Bold-Italic")
905 (number :tag "Reference Size")
906 (number :tag "Line Height")
907 (number :tag "Space Width")
908 (number :tag "Average Character Width")))
909 :group 'ps-print-font)
911 (defcustom ps-font-family 'Courier
912 "Font family name for ordinary text, when generating Postscript."
914 :group 'ps-print-font)
916 (defcustom ps-font-size (if ps-landscape-mode 7 8.5)
917 "Font size, in points, for ordinary text, when generating Postscript."
919 :group 'ps-print-font)
921 (defcustom ps-header-font-family 'Helvetica
922 "Font family name for text in the header, when generating Postscript."
924 :group 'ps-print-font)
926 (defcustom ps-header-font-size (if ps-landscape-mode 10 12)
927 "Font size, in points, for text in the header, when generating Postscript."
929 :group 'ps-print-font)
931 (defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)
932 "Font size, in points, for the top line of text in the header,
933 when generating Postscript."
935 :group 'ps-print-font)
939 (defcustom ps-print-color-p (or (fboundp 'x-color-values) ; Emacs
940 (fboundp 'pixel-components)) ; XEmacs
942 ; Printing color requires x-color-values.
943 "*If non-nil, print the buffer's text in color."
945 :group 'ps-print-color)
947 (defcustom ps-default-fg '(0.0 0.0 0.0)
948 "*RGB values of the default foreground color. Defaults to black."
949 :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
950 :group 'ps-print-color)
952 (defcustom ps-default-bg '(1.0 1.0 1.0)
953 "*RGB values of the default background color. Defaults to white."
954 :type '(list (number :tag "Red") (number :tag "Green") (number :tag "Blue"))
955 :group 'ps-print-color)
957 (defcustom ps-auto-font-detect t
958 "*Non-nil means automatically detect bold/italic face attributes.
959 nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces',
960 and `ps-underlined-faces'."
962 :group 'ps-print-font)
964 (defcustom ps-bold-faces
965 (unless ps-print-color-p
966 '(font-lock-function-name-face
967 font-lock-builtin-face
968 font-lock-variable-name-face
969 font-lock-keyword-face
970 font-lock-warning-face))
971 "*A list of the \(non-bold\) faces that should be printed in bold font.
972 This applies to generating Postscript."
974 :group 'ps-print-face)
976 (defcustom ps-italic-faces
977 (unless ps-print-color-p
978 '(font-lock-variable-name-face
979 font-lock-string-face
980 font-lock-comment-face
981 font-lock-warning-face))
982 "*A list of the \(non-italic\) faces that should be printed in italic font.
983 This applies to generating Postscript."
985 :group 'ps-print-face)
987 (defcustom ps-underlined-faces
988 (unless ps-print-color-p
989 '(font-lock-function-name-face
991 font-lock-reference-face
992 font-lock-warning-face))
993 "*A list of the \(non-underlined\) faces that should be printed underlined.
994 This applies to generating Postscript."
996 :group 'ps-print-face)
998 (defcustom ps-left-header
999 (list 'ps-get-buffer-name 'ps-header-dirpart)
1000 "*The items to display (each on a line) on the left part of the page header.
1001 This applies to generating Postscript.
1003 The value should be a list of strings and symbols, each representing an
1004 entry in the PostScript array HeaderLinesLeft.
1006 Strings are inserted unchanged into the array; those representing
1007 PostScript string literals should be delimited with PostScript string
1008 delimiters '(' and ')'.
1010 For symbols with bound functions, the function is called and should
1011 return a string to be inserted into the array. For symbols with bound
1012 values, the value should be a string to be inserted into the array.
1013 In either case, function or variable, the string value has PostScript
1014 string delimiters added to it."
1015 :type '(repeat (choice string symbol))
1016 :group 'ps-print-header)
1017 (make-variable-buffer-local 'ps-left-header)
1019 (defcustom ps-right-header
1020 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
1021 "*The items to display (each on a line) on the right part of the page header.
1022 This applies to generating Postscript.
1024 See the variable `ps-left-header' for a description of the format of
1026 :type '(repeat (choice string symbol))
1027 :group 'ps-print-header)
1028 (make-variable-buffer-local 'ps-right-header)
1030 (defcustom ps-razzle-dazzle t
1031 "*Non-nil means report progress while formatting buffer."
1035 (defvar ps-adobe-tag "%!PS-Adobe-1.0\n"
1036 "*Contains the header line identifying the output as PostScript.
1037 By default, `ps-adobe-tag' contains the standard identifier. Some
1038 printers require slightly different versions of this line.")
1040 (defcustom ps-build-face-reference t
1041 "*Non-nil means build the reference face lists.
1043 Ps-print sets this value to nil after it builds its internal reference
1044 lists of bold and italic faces. By settings its value back to t, you
1045 can force ps-print to rebuild the lists the next time you invoke one
1046 of the ...-with-faces commands.
1048 You should set this value back to t after you change the attributes of
1049 any face, or create new faces. Most users shouldn't have to worry
1050 about its setting, though."
1052 :group 'ps-print-face)
1054 (defcustom ps-always-build-face-reference nil
1055 "*Non-nil means always rebuild the reference face lists.
1057 If this variable is non-nil, ps-print will rebuild its internal
1058 reference lists of bold and italic faces *every* time one of the
1059 -with-faces commands is called. Most users shouldn't need to set this
1062 :group 'ps-print-face)
1064 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1068 (defun ps-print-buffer (&optional filename)
1069 "Generate and print a PostScript image of the buffer.
1071 When called with a numeric prefix argument (C-u), prompts the user for
1072 the name of a file to save the PostScript image in, instead of sending
1075 More specifically, the FILENAME argument is treated as follows: if it
1076 is nil, send the image to the printer. If FILENAME is a string, save
1077 the PostScript image in a file with that name. If FILENAME is a
1078 number, prompt the user for the name of the file to save in."
1080 (interactive (list (ps-print-preprint current-prefix-arg)))
1081 (ps-generate (current-buffer) (point-min) (point-max)
1082 'ps-generate-postscript)
1083 (ps-do-despool filename))
1087 (defun ps-print-buffer-with-faces (&optional filename)
1088 "Generate and print a PostScript image of the buffer.
1089 Like `ps-print-buffer', but includes font, color, and underline
1090 information in the generated image. This command works only if you
1091 are using a window system, so it has a way to determine color values."
1092 (interactive (list (ps-print-preprint current-prefix-arg)))
1093 (ps-generate (current-buffer) (point-min) (point-max)
1094 'ps-generate-postscript-with-faces)
1095 (ps-do-despool filename))
1099 (defun ps-print-region (from to &optional filename)
1100 "Generate and print a PostScript image of the region.
1101 Like `ps-print-buffer', but prints just the current region."
1103 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
1104 (ps-generate (current-buffer) from to
1105 'ps-generate-postscript)
1106 (ps-do-despool filename))
1110 (defun ps-print-region-with-faces (from to &optional filename)
1111 "Generate and print a PostScript image of the region.
1112 Like `ps-print-region', but includes font, color, and underline
1113 information in the generated image. This command works only if you
1114 are using a window system, so it has a way to determine color values."
1116 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
1117 (ps-generate (current-buffer) from to
1118 'ps-generate-postscript-with-faces)
1119 (ps-do-despool filename))
1123 (defun ps-spool-buffer ()
1124 "Generate and spool a PostScript image of the buffer.
1125 Like `ps-print-buffer' except that the PostScript image is saved in a
1126 local buffer to be sent to the printer later.
1128 Use the command `ps-despool' to send the spooled images to the printer."
1130 (ps-generate (current-buffer) (point-min) (point-max)
1131 'ps-generate-postscript))
1135 (defun ps-spool-buffer-with-faces ()
1136 "Generate and spool a PostScript image of the buffer.
1137 Like `ps-spool-buffer', but includes font, color, and underline
1138 information in the generated image. This command works only if you
1139 are using a window system, so it has a way to determine color values.
1141 Use the command `ps-despool' to send the spooled images to the printer."
1144 (ps-generate (current-buffer) (point-min) (point-max)
1145 'ps-generate-postscript-with-faces))
1149 (defun ps-spool-region (from to)
1150 "Generate a PostScript image of the region and spool locally.
1151 Like `ps-spool-buffer', but spools just the current region.
1153 Use the command `ps-despool' to send the spooled images to the printer."
1155 (ps-generate (current-buffer) from to
1156 'ps-generate-postscript))
1160 (defun ps-spool-region-with-faces (from to)
1161 "Generate a PostScript image of the region and spool locally.
1162 Like `ps-spool-region', but includes font, color, and underline
1163 information in the generated image. This command works only if you
1164 are using a window system, so it has a way to determine color values.
1166 Use the command `ps-despool' to send the spooled images to the printer."
1168 (ps-generate (current-buffer) from to
1169 'ps-generate-postscript-with-faces))
1172 (defun ps-despool (&optional filename)
1173 "Send the spooled PostScript to the printer.
1175 When called with a numeric prefix argument (C-u), prompt the user for
1176 the name of a file to save the spooled PostScript in, instead of sending
1179 More specifically, the FILENAME argument is treated as follows: if it
1180 is nil, send the image to the printer. If FILENAME is a string, save
1181 the PostScript image in a file with that name. If FILENAME is a
1182 number, prompt the user for the name of the file to save in."
1183 (interactive (list (ps-print-preprint current-prefix-arg)))
1184 (ps-do-despool filename))
1187 (defun ps-line-lengths ()
1188 "*Display the correspondance between a line length and a font size,
1189 using the current ps-print setup.
1190 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1192 (ps-line-lengths-internal))
1195 (defun ps-nb-pages-buffer (nb-lines)
1196 "*Display an approximate correspondance between a font size and the number
1197 of pages the current buffer would require to print
1198 using the current ps-print setup."
1199 (interactive (list (count-lines (point-min) (point-max))))
1200 (ps-nb-pages nb-lines))
1203 (defun ps-nb-pages-region (nb-lines)
1204 "*Display an approximate correspondance between a font size and the number
1205 of pages the current region would require to print
1206 using the current ps-print setup."
1207 (interactive (list (count-lines (mark) (point))))
1208 (ps-nb-pages nb-lines))
1212 "*Return the current setup"
1214 (setq ps-print-color-p %s
1215 ps-lpr-command \"%s\"
1219 ps-landscape-mode %s
1220 ps-number-of-columns %s
1228 ps-header-line-pad %s
1230 ps-print-header-frame %s
1237 ps-header-font-family '%s
1238 ps-header-font-size %s
1239 ps-header-title-font-size %s)
1246 ps-number-of-columns
1255 ps-print-header-frame
1261 ps-header-font-family
1263 ps-header-title-font-size))
1265 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1266 ;; Utility functions and variables:
1268 (defvar ps-print-emacs-type
1269 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
1270 ((string-match "Lucid" emacs-version) 'lucid)
1271 ((string-match "Epoch" emacs-version) 'epoch)
1274 (if (or (eq ps-print-emacs-type 'lucid)
1275 (eq ps-print-emacs-type 'xemacs))
1276 (if (< emacs-minor-version 12)
1277 (setq ps-print-color-p nil))
1278 (require 'faces)) ; face-font, face-underline-p,
1281 (require 'time-stamp)
1284 "Font family name for ordinary text, when generating Postscript.")
1286 (defvar ps-font-bold nil
1287 "Font family name for bold text, when generating Postscript.")
1289 (defvar ps-font-italic nil
1290 "Font family name for italic text, when generating Postscript.")
1292 (defvar ps-font-bold-italic nil
1293 "Font family name for bold italic text, when generating Postscript.")
1295 (defvar ps-avg-char-width nil
1296 "The average width, in points, of a character, for generating Postscript.
1297 This is the value that ps-print uses to determine the length,
1298 x-dimension, of the text it has printed, and thus affects the point at
1299 which long lines wrap around.")
1301 (defvar ps-space-width nil
1302 "The width of a space character, for generating Postscript.
1303 This value is used in expanding tab characters.")
1305 (defvar ps-line-height nil
1306 "The height of a line, for generating Postscript.
1307 This is the value that ps-print uses to determine the height,
1308 y-dimension, of the lines of text it has printed, and thus affects the
1309 point at which page-breaks are placed.
1310 The line-height is *not* the same as the point size of the font.")
1312 (defvar ps-print-prologue-1
1313 "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
1314 /ISOLatin1Encoding where { pop } {
1315 % -- The ISO Latin-1 encoding vector isn't known, so define it.
1316 % -- The first half is the same as the standard encoding,
1317 % -- except for minus instead of hyphen at code 055.
1319 StandardEncoding 0 45 getinterval aload pop
1321 StandardEncoding 46 82 getinterval aload pop
1322 %*** NOTE: the following are missing in the Adobe documentation,
1323 %*** but appear in the displayed table:
1324 %*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
1326 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
1327 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
1328 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
1329 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
1331 /space /exclamdown /cent /sterling
1332 /currency /yen /brokenbar /section
1333 /dieresis /copyright /ordfeminine /guillemotleft
1334 /logicalnot /hyphen /registered /macron
1335 /degree /plusminus /twosuperior /threesuperior
1336 /acute /mu /paragraph /periodcentered
1337 /cedilla /onesuperior /ordmasculine /guillemotright
1338 /onequarter /onehalf /threequarters /questiondown
1340 /Agrave /Aacute /Acircumflex /Atilde
1341 /Adieresis /Aring /AE /Ccedilla
1342 /Egrave /Eacute /Ecircumflex /Edieresis
1343 /Igrave /Iacute /Icircumflex /Idieresis
1344 /Eth /Ntilde /Ograve /Oacute
1345 /Ocircumflex /Otilde /Odieresis /multiply
1346 /Oslash /Ugrave /Uacute /Ucircumflex
1347 /Udieresis /Yacute /Thorn /germandbls
1349 /agrave /aacute /acircumflex /atilde
1350 /adieresis /aring /ae /ccedilla
1351 /egrave /eacute /ecircumflex /edieresis
1352 /igrave /iacute /icircumflex /idieresis
1353 /eth /ntilde /ograve /oacute
1354 /ocircumflex /otilde /odieresis /divide
1355 /oslash /ugrave /uacute /ucircumflex
1356 /udieresis /yacute /thorn /ydieresis
1360 /reencodeFontISO { %def
1362 length 5 add dict % Make a new font (a new dict the same size
1363 % as the old one) with room for our new symbols.
1365 begin % Make the new font the current dictionary.
1369 { def } { pop pop } ifelse
1370 } forall % Copy each of the symbols from the old dictionary
1371 % to the new one except for the font ID.
1373 /Encoding ISOLatin1Encoding def % Override the encoding with
1374 % the ISOLatin1 encoding.
1376 % Use the font's bounding box to determine the ascent, descent,
1377 % and overall height; don't forget that these values have to be
1378 % transformed using the font's matrix.
1385 % | | | | Ascent (usually > 0)
1387 % (0 0) -> +--+----+-------->
1389 % | | v Descent (usually < 0)
1390 % (x1 y1) --> +----+ - -
1392 FontBBox % -- x1 y1 x2 y2
1393 FontMatrix transform /Ascent exch def pop
1394 FontMatrix transform /Descent exch def pop
1395 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
1397 % Define these in case they're not in the FontInfo
1398 % (also, here they're easier to get to.
1399 /UnderlinePosition 1 def
1400 /UnderlineThickness 1 def
1402 % Get the underline position and thickness if they're defined.
1403 currentdict /FontInfo known {
1406 dup /UnderlinePosition known {
1407 dup /UnderlinePosition get
1408 0 exch FontMatrix transform exch pop
1409 /UnderlinePosition exch def
1412 dup /UnderlineThickness known {
1413 /UnderlineThickness get
1414 0 exch FontMatrix transform exch pop
1415 /UnderlineThickness exch def
1420 currentdict % Leave the new font on the stack
1421 end % Stop using the font as the current dictionary.
1422 definefont % Put the font into the font dictionary
1423 pop % Discard the returned font.
1426 /DefFont { % Font definition
1427 findfont exch scalefont reencodeFontISO
1430 /F { % Font selection
1432 dup /Ascent get /Ascent exch def
1433 dup /Descent get /Descent exch def
1434 dup /FontHeight get /FontHeight exch def
1435 dup /UnderlinePosition get /UnderlinePosition exch def
1436 dup /UnderlineThickness get /UnderlineThickness exch def
1440 /FG /setrgbcolor load def
1445 { mark 4 1 roll ] /bgcolor exch def } if
1450 % | Ascent (usually > 0)
1452 % | Descent (usually < 0)
1456 /dobackground { % width --
1457 currentpoint % -- width x y
1461 0 Ascent rmoveto % B
1463 0 Descent Ascent sub rlineto % D
1466 bgcolor aload pop setrgbcolor
1471 /dobackgroundstring { % string --
1476 /dounderline { % fromx fromy --
1479 UnderlineThickness setlinewidth
1481 UnderlinePosition add moveto
1482 UnderlinePosition add lineto
1487 /eolbg { % dobackground until right margin
1488 PrintWidth % -- x-eol
1489 currentpoint pop % -- cur-x
1490 sub % -- width until eol
1494 /eolul { % idem for underline
1495 PrintWidth % -- x-eol
1496 currentpoint exch pop % -- x-eol cur-y
1500 /SL { % Soft Linefeed
1503 0 currentpoint exch pop LineHeight sub moveto
1506 /HL /SL load def % Hard Linefeed
1508 /sp1 { currentpoint 3 -1 roll } def
1511 /dcp { currentpoint exch 40 string cvs print (, ) print = } def
1513 exch 40 string cvs print (, ) print = } def
1516 bg { dup dobackgroundstring } if
1519 ul { dounderline } if
1524 ( ) stringwidth % Get the width of a space in the current font.
1525 pop % Discard the Y component.
1526 mul % Multiply the width of a space
1527 % by the number of spaces to plot
1528 bg { dup dobackground } if
1530 ul { dounderline } if
1534 % ---- save the state of the document (useful for ghostscript!)
1536 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
1537 /JackGhostscript where {
1538 pop 1 27.7 29.7 div scale
1541 % ---- translate to bottom-right corner of Portrait page
1542 LandscapePageHeight 0 translate
1545 /ColumnWidth PrintWidth InterColumn add def
1546 % ---- translate to lower left corner of TEXT
1547 LeftMargin BottomMargin translate
1548 % ---- define where printing will start
1549 /f0 F % this installs Ascent
1550 /PrintStartY PrintHeight Ascent sub def
1555 % ---- on last page but not last column, spit out the page
1556 ColumnIndex 1 eq not { showpage } if
1557 % ---- restore the state of the document (useful for ghostscript!)
1562 % ---- when 1st column, save the state of the page
1563 ColumnIndex 1 eq { /pageState save def } if
1564 % ---- save the state of the column
1565 /columnState save def
1570 PrintHeaderFrame { HeaderFrame } if
1573 0 PrintStartY moveto % move to where printing will start
1582 ColumnIndex NumberOfColumns eq {
1583 % ---- on last column, spit out the page
1585 % ---- restore the state of the page
1589 % ---- restore the state of the current column
1591 % ---- and translate to the next column
1592 ColumnWidth 0 translate
1593 /ColumnIndex ColumnIndex 1 add def
1599 /UL { /ul exch def } def
1601 /SetHeaderLines { % nb-lines --
1602 /HeaderLines exch def
1605 HeaderLines 1 sub HeaderLineHeight mul add
1606 HeaderTitleLineHeight add
1608 /HeaderHeight exch def
1615 % |-+-------| <-- (x y)
1619 % |-+-------| <-- (0 0)
1623 /HeaderFrameStart { % -- x y
1624 0 PrintHeight HeaderOffset add
1628 PrintWidth 0 rlineto
1629 0 HeaderHeight rlineto
1630 PrintWidth neg 0 rlineto
1631 0 HeaderHeight neg rlineto
1637 % ---- fill a black rectangle (the shadow of the next one)
1638 HeaderFrameStart moveto
1642 % ---- do the next rectangle ...
1643 HeaderFrameStart moveto
1645 gsave 0.9 setgray fill grestore % filled with grey
1646 gsave 0 setgray stroke grestore % drawn with black
1652 exch HeaderPad add exch % horizontal pad
1654 HeaderPad add % vertical pad
1656 HeaderLineHeight HeaderLines 1 sub mul add
1660 dup length 3 -1 roll dup length dup 4 -1 roll add string dup
1661 0 5 -1 roll putinterval
1662 dup 4 2 roll exch putinterval
1666 PageNumber 32 string cvs
1669 PageCount 32 string cvs strcat
1676 HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
1678 % ---- hack: `PN 1 and' == `PN 2 modulo'
1680 % ---- if duplex and even page number, then exchange left and right
1681 Duplex PageNumber 1 and 0 eq and { exch } if
1683 { % ---- process the left lines
1687 dup xcheck { exec } if
1690 0 HeaderLineHeight neg rmoveto
1695 { % ---- process the right lines
1699 dup xcheck { exec } if
1701 PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto
1704 0 HeaderLineHeight neg rmoveto
1710 /t0 3 1 roll DefFont
1713 /sw ( ) stringwidth pop def
1714 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
1715 stringwidth pop exch div def
1716 /t1 12 /Helvetica-Oblique DefFont
1723 ( point, the line height is ) show
1724 lh 32 string cvs show
1725 (, the space width is ) show
1726 sw 32 string cvs show
1729 0 FontHeight neg rmoveto
1731 (and a crude estimate of average character width is ) show
1732 aw 32 string cvs show
1735 0 FontHeight neg rmoveto
1742 /ReportAllFontInfo {
1744 { % key = font name value = font dictionary
1745 pop 10 exch ReportFontInfo
1749 % 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
1750 % 3 cm 20 cm moveto ReportAllFontInfo showpage
1754 (defvar ps-print-prologue-2
1756 % ---- These lines must be kept together because...
1759 /HeaderTitleLineHeight FontHeight def
1762 /HeaderLineHeight FontHeight def
1763 /HeaderDescent Descent def
1765 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
1769 ;; Start Editing Here:
1771 (defvar ps-source-buffer nil)
1772 (defvar ps-spool-buffer-name "*PostScript*")
1773 (defvar ps-spool-buffer nil)
1775 (defvar ps-output-head nil)
1776 (defvar ps-output-tail nil)
1778 (defvar ps-page-count 0)
1779 (defvar ps-showpage-count 0)
1781 (defvar ps-current-font 0)
1782 (defvar ps-current-underline-p nil)
1783 (defvar ps-default-color (if ps-print-color-p ps-default-fg)) ; black
1784 (defvar ps-current-color ps-default-color)
1785 (defvar ps-current-bg nil)
1787 (defvar ps-razchunk 0)
1789 (defvar ps-color-format
1790 (if (eq ps-print-emacs-type 'emacs)
1792 ;;Emacs understands the %f format; we'll
1793 ;;use it to limit color RGB values to
1794 ;;three decimals to cut down some on the
1795 ;;size of the PostScript output.
1798 ;; Lucid emacsen will have to make do with
1799 ;; %s (princ) for floats.
1802 ;; These values determine how much print-height to deduct when headers
1803 ;; are turned on. This is a pretty clumsy way of handling it, but
1804 ;; it'll do for now.
1806 (defvar ps-header-font)
1807 (defvar ps-header-title-font)
1809 (defvar ps-header-line-height)
1810 (defvar ps-header-title-line-height)
1811 (defvar ps-header-pad 0
1812 "Vertical and horizontal space in points (1/72 inch) between the header frame
1813 and the text it contains.")
1815 ;; Define accessors to the dimensions list.
1817 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
1818 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
1820 (defvar ps-landscape-page-height)
1822 (defvar ps-print-width nil)
1823 (defvar ps-print-height nil)
1825 (defvar ps-height-remaining)
1826 (defvar ps-width-remaining)
1828 (defvar ps-ref-bold-faces nil)
1829 (defvar ps-ref-italic-faces nil)
1830 (defvar ps-ref-underlined-faces nil)
1832 (defvar ps-print-color-scale nil)
1834 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1835 ;; Internal functions
1837 (defun ps-line-lengths-internal ()
1838 "Display the correspondance between a line length and a font size,
1839 using the current ps-print setup.
1840 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
1841 (let ((buf (get-buffer-create "*Line-lengths*"))
1842 (ifs ps-font-size) ; initial font size
1843 (icw ps-avg-char-width) ; initial character width
1844 (print-width (progn (ps-get-page-dimensions)
1846 (ps-setup (ps-setup)) ; setup for the current buffer
1847 (fs-min 5) ; minimum font size
1848 cw-min ; minimum character width
1849 nb-cpl-max ; maximum nb of characters per line
1850 (fs-max 14) ; maximum font size
1851 cw-max ; maximum character width
1852 nb-cpl-min ; minimum nb of characters per line
1853 fs ; current font size
1854 cw ; current character width
1855 nb-cpl ; current nb of characters per line
1857 (setq cw-min (/ (* icw fs-min) ifs)
1858 nb-cpl-max (floor (/ print-width cw-min))
1859 cw-max (/ (* icw fs-max) ifs)
1860 nb-cpl-min (floor (/ print-width cw-max)))
1861 (setq nb-cpl nb-cpl-min)
1863 (goto-char (point-max))
1864 (if (not (bolp)) (insert "\n"))
1866 (insert "nb char per line / font size\n")
1867 (while (<= nb-cpl nb-cpl-max)
1868 (setq cw (/ print-width (float nb-cpl))
1869 fs (/ (* ifs cw) icw))
1870 (insert (format "%3s %s\n" nb-cpl fs))
1871 (setq nb-cpl (1+ nb-cpl)))
1873 (display-buffer buf 'not-this-window)))
1875 (defun ps-nb-pages (nb-lines)
1876 "Display an approximate correspondance between a font size and the number
1877 of pages the number of lines would require to print
1878 using the current ps-print setup."
1879 (let ((buf (get-buffer-create "*Nb-Pages*"))
1880 (ifs ps-font-size) ; initial font size
1881 (ilh ps-line-height) ; initial line height
1882 (page-height (progn (ps-get-page-dimensions)
1884 (ps-setup (ps-setup)) ; setup for the current buffer
1885 (fs-min 4) ; minimum font size
1886 lh-min ; minimum line height
1887 nb-lpp-max ; maximum nb of lines per page
1888 nb-page-min ; minimum nb of pages
1889 (fs-max 14) ; maximum font size
1890 lh-max ; maximum line height
1891 nb-lpp-min ; minimum nb of lines per page
1892 nb-page-max ; maximum nb of pages
1893 fs ; current font size
1894 lh ; current line height
1895 nb-lpp ; current nb of lines per page
1896 nb-page ; current nb of pages
1898 (setq lh-min (/ (* ilh fs-min) ifs)
1899 nb-lpp-max (floor (/ page-height lh-min))
1900 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
1901 lh-max (/ (* ilh fs-max) ifs)
1902 nb-lpp-min (floor (/ page-height lh-max))
1903 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)))
1904 (setq nb-page nb-page-min)
1906 (goto-char (point-max))
1907 (if (not (bolp)) (insert "\n"))
1909 (insert (format "%d lines\n" nb-lines))
1910 (insert "nb page / font size\n")
1911 (while (<= nb-page nb-page-max)
1912 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
1913 lh (/ page-height nb-lpp)
1914 fs (/ (* ifs lh) ilh))
1915 (insert (format "%s %s\n" nb-page fs))
1916 (setq nb-page (1+ nb-page)))
1918 (display-buffer buf 'not-this-window)))
1920 (defun ps-select-font ()
1921 "Choose the font name and size (scaling data)."
1922 (let ((assoc (assq ps-font-family ps-font-info-database))
1923 l fn fb fi bi sz lh sw aw)
1925 (error "Don't have data to scale font %s. Known fonts families are %s"
1927 (mapcar 'car ps-font-info-database)))
1929 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
1930 fb (prog1 (car l) (setq l (cdr l)))
1931 fi (prog1 (car l) (setq l (cdr l)))
1932 bi (prog1 (car l) (setq l (cdr l)))
1933 sz (prog1 (car l) (setq l (cdr l)))
1934 lh (prog1 (car l) (setq l (cdr l)))
1935 sw (prog1 (car l) (setq l (cdr l)))
1936 aw (prog1 (car l) (setq l (cdr l))))
1939 (setq ps-font-bold fb)
1940 (setq ps-font-italic fi)
1941 (setq ps-font-bold-italic bi)
1942 ;; These data just need to be rescaled:
1943 (setq ps-line-height (/ (* lh ps-font-size) sz))
1944 (setq ps-space-width (/ (* sw ps-font-size) sz))
1945 (setq ps-avg-char-width (/ (* aw ps-font-size) sz))
1948 (defun ps-select-header-font ()
1949 "Choose the font name and size (scaling data) for the header."
1950 (let ((assoc (assq ps-header-font-family ps-font-info-database))
1951 l fn fb fi bi sz lh sw aw)
1953 (error "Don't have data to scale font %s. Known fonts families are %s"
1955 (mapcar 'car ps-font-info-database)))
1957 fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
1958 fb (prog1 (car l) (setq l (cdr l)))
1959 fi (prog1 (car l) (setq l (cdr l)))
1960 bi (prog1 (car l) (setq l (cdr l)))
1961 sz (prog1 (car l) (setq l (cdr l)))
1962 lh (prog1 (car l) (setq l (cdr l)))
1963 sw (prog1 (car l) (setq l (cdr l)))
1964 aw (prog1 (car l) (setq l (cdr l))))
1967 (setq ps-header-font fn)
1968 (setq ps-header-title-font fb)
1969 ;; Line height: These data just need to be rescaled:
1970 (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz))
1971 (setq ps-header-line-height (/ (* lh ps-header-font-size) sz))
1972 ps-header-font-family))
1974 (defun ps-get-page-dimensions ()
1975 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
1976 page-width page-height)
1978 ((null page-dimensions)
1979 (error "`ps-paper-type' must be one of:\n%s"
1980 (mapcar 'car ps-page-dimensions-database)))
1981 ((< ps-number-of-columns 1)
1982 (error "The number of columns %d should not be negative")))
1985 (ps-select-header-font)
1987 (setq page-width (ps-page-dimensions-get-width page-dimensions)
1988 page-height (ps-page-dimensions-get-height page-dimensions))
1991 (if ps-landscape-mode
1992 ;; exchange width and height
1993 (setq page-width (prog1 page-height (setq page-height page-width))))
1995 ;; It is used to get the lower right corner (only in landscape mode)
1996 (setq ps-landscape-page-height page-height)
1998 ;; | lm | text | ic | text | ic | text | rm |
1999 ;; page-width == lm + n * pw + (n - 1) * ic + rm
2000 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
2001 (setq ps-print-width
2003 ps-left-margin ps-right-margin
2004 (* (1- ps-number-of-columns) ps-inter-column))
2005 ps-number-of-columns))
2006 (if (<= ps-print-width 0)
2007 (error "Bad horizontal layout:
2009 ps-left-margin == %s
2010 ps-right-margin == %s
2011 ps-inter-column == %s
2012 ps-number-of-columns == %s
2013 | lm | text | ic | text | ic | text | rm |
2014 page-width == lm + n * print-width + (n - 1) * ic + rm
2015 => print-width == %d !"
2020 ps-number-of-columns
2023 (setq ps-print-height
2024 (- page-height ps-bottom-margin ps-top-margin))
2025 (if (<= ps-print-height 0)
2026 (error "Bad vertical layout:
2028 ps-bottom-margin == %s
2029 page-height == bm + print-height + tm
2030 => print-height == %d !"
2034 ;; If headers are turned on, deduct the height of the header from
2035 ;; the print height.
2039 (* ps-header-line-pad ps-header-title-line-height))
2040 (setq ps-print-height
2044 ps-header-title-line-height
2045 (* ps-header-line-height (- ps-header-lines 1))
2047 (if (<= ps-print-height 0)
2048 (error "Bad vertical layout:
2050 ps-bottom-margin == %s
2051 ps-header-offset == %s
2054 page-height == bm + print-height + tm - ho - hh
2055 => print-height == %d !"
2061 ps-header-title-line-height
2062 (* ps-header-line-height (- ps-header-lines 1))
2066 (defun ps-print-preprint (&optional filename)
2068 (or (numberp filename)
2070 (let* ((name (concat (buffer-name) ".ps"))
2071 (prompt (format "Save PostScript to file: (default %s) "
2073 (res (read-file-name prompt default-directory name nil)))
2074 (if (file-directory-p res)
2075 (expand-file-name name (file-name-as-directory res))
2078 ;; The following functions implement a simple list-buffering scheme so
2079 ;; that ps-print doesn't have to repeatedly switch between buffers
2080 ;; while spooling. The functions ps-output and ps-output-string build
2081 ;; up the lists; the function ps-flush-output takes the lists and
2082 ;; insert its contents into the spool buffer (*PostScript*).
2084 (defun ps-output-string-prim (string)
2085 (insert "(") ;insert start-string delimiter
2086 (save-excursion ;insert string
2089 ;; Find and quote special characters as necessary for PS
2090 (while (re-search-forward "[()\\]" nil t)
2095 (goto-char (point-max))
2096 (insert ")")) ;insert end-string delimiter
2098 (defun ps-init-output-queue ()
2099 (setq ps-output-head (list ""))
2100 (setq ps-output-tail ps-output-head))
2102 (defun ps-output (&rest args)
2103 (setcdr ps-output-tail args)
2104 (while (cdr ps-output-tail)
2105 (setq ps-output-tail (cdr ps-output-tail))))
2107 (defun ps-output-string (string)
2108 (ps-output t string))
2110 (defun ps-flush-output ()
2112 (set-buffer ps-spool-buffer)
2113 (goto-char (point-max))
2114 (while ps-output-head
2115 (let ((it (car ps-output-head)))
2118 (setq ps-output-head (cdr ps-output-head))
2119 (ps-output-string-prim (car ps-output-head))))
2120 (setq ps-output-head (cdr ps-output-head))))
2121 (ps-init-output-queue))
2123 (defun ps-insert-file (fname)
2126 ;; Check to see that the file exists and is readable; if not, throw
2128 (if (not (file-readable-p fname))
2129 (error "Could not read file `%s'" fname))
2132 (set-buffer ps-spool-buffer)
2133 (goto-char (point-max))
2134 (insert-file fname)))
2136 ;; These functions insert the arrays that define the contents of the
2139 (defun ps-generate-header-line (fonttag &optional content)
2140 (ps-output " [ " fonttag " ")
2142 ;; Literal strings should be output as is -- the string must
2143 ;; contain its own PS string delimiters, '(' and ')', if necessary.
2145 (ps-output content))
2147 ;; Functions are called -- they should return strings; they will be
2148 ;; inserted as strings and the PS string delimiters added.
2149 ((and (symbolp content) (fboundp content))
2150 (ps-output-string (funcall content)))
2152 ;; Variables will have their contents inserted. They should
2153 ;; contain strings, and will be inserted as strings.
2154 ((and (symbolp content) (boundp content))
2155 (ps-output-string (symbol-value content)))
2157 ;; Anything else will get turned into an empty string.
2159 (ps-output-string "")))
2162 (defun ps-generate-header (name contents)
2163 (ps-output "/" name " [\n")
2164 (if (> ps-header-lines 0)
2166 (ps-generate-header-line "/h0" (car contents))
2167 (while (and (< count ps-header-lines)
2168 (setq contents (cdr contents)))
2169 (ps-generate-header-line "/h1" (car contents))
2170 (setq count (+ count 1)))
2171 (ps-output "] def\n"))))
2173 (defun ps-output-boolean (name bool)
2174 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
2176 (defun ps-begin-file ()
2177 (ps-get-page-dimensions)
2178 (setq ps-showpage-count 0)
2180 (ps-output ps-adobe-tag)
2181 (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of
2182 ;first buffer printed
2183 (ps-output "%%Creator: " (user-full-name) "\n")
2184 (ps-output "%%CreationDate: "
2185 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n")
2186 (ps-output "%% DocumentFonts: "
2187 ps-font " " ps-font-bold " " ps-font-italic " "
2188 ps-font-bold-italic " "
2189 ps-header-font " " ps-header-title-font "\n")
2190 (ps-output "%%Pages: (atend)\n")
2191 (ps-output "%%EndComments\n\n")
2193 (ps-output-boolean "LandscapeMode" ps-landscape-mode)
2194 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns))
2196 (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height))
2197 (ps-output (format "/PrintWidth %s def\n" ps-print-width))
2198 (ps-output (format "/PrintHeight %s def\n" ps-print-height))
2200 (ps-output (format "/LeftMargin %s def\n" ps-left-margin))
2201 (ps-output (format "/RightMargin %s def\n" ps-right-margin)) ; not used
2202 (ps-output (format "/InterColumn %s def\n" ps-inter-column))
2204 (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin))
2205 (ps-output (format "/TopMargin %s def\n" ps-top-margin)) ; not used
2206 (ps-output (format "/HeaderOffset %s def\n" ps-header-offset))
2207 (ps-output (format "/HeaderPad %s def\n" ps-header-pad))
2209 (ps-output-boolean "PrintHeader" ps-print-header)
2210 (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
2211 (ps-output-boolean "ShowNofN" ps-show-n-of-n)
2212 (ps-output-boolean "Duplex" ps-spool-duplex)
2214 (ps-output (format "/LineHeight %s def\n" ps-line-height))
2216 (ps-output ps-print-prologue-1)
2219 (ps-output ; /h0 14 /Helvetica-Bold Font
2220 (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font))
2221 (ps-output ; /h1 12 /Helvetica Font
2222 (format "/h1 %s /%s DefFont\n" ps-header-font-size ps-header-font))
2224 (ps-output ps-print-prologue-2)
2227 (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font))
2228 (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold))
2229 (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic))
2230 (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic))
2232 (ps-output "\nBeginDoc\n\n")
2233 (ps-output "%%EndPrologue\n"))
2235 (defun ps-header-dirpart ()
2236 (let ((fname (buffer-file-name)))
2238 (if (string-equal (buffer-name) (file-name-nondirectory fname))
2239 (file-name-directory fname)
2243 (defun ps-get-buffer-name ()
2245 ;; Indulge Jim this little easter egg:
2246 ((string= (buffer-name) "ps-print.el")
2247 "Hey, Cool! It's ps-print.el!!!")
2248 ;; Indulge Jack this other little easter egg:
2249 ((string= (buffer-name) "sokoban.el")
2250 "Super! C'est sokoban.el!")
2253 (defun ps-begin-job ()
2254 (setq ps-page-count 0))
2256 (defun ps-end-file ()
2257 (ps-output "\nEndDoc\n\n")
2258 (ps-output "%%Trailer\n")
2259 (ps-output (format "%%%%Pages: %d\n" (1+ (/ (1- ps-page-count)
2260 ps-number-of-columns)))))
2262 (defun ps-next-page ()
2267 (defun ps-begin-page (&optional dummypage)
2268 (ps-get-page-dimensions)
2269 (setq ps-width-remaining ps-print-width)
2270 (setq ps-height-remaining ps-print-height)
2272 ;; Print only when a new real page begins.
2273 (when (zerop (mod ps-page-count ps-number-of-columns))
2274 (ps-output (format "\n%%%%Page: %d %d\n"
2275 (1+ (/ ps-page-count ps-number-of-columns))
2276 (1+ (/ ps-page-count ps-number-of-columns)))))
2278 (ps-output "BeginDSCPage\n")
2279 (ps-output (format "/PageNumber %d def\n" (incf ps-page-count)))
2280 (ps-output "/PageCount 0 def\n")
2282 (when ps-print-header
2283 (ps-generate-header "HeaderLinesLeft" ps-left-header)
2284 (ps-generate-header "HeaderLinesRight" ps-right-header)
2285 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
2287 (ps-output "BeginPage\n")
2288 (ps-set-font ps-current-font)
2289 (ps-set-bg ps-current-bg)
2290 (ps-set-color ps-current-color)
2291 (ps-set-underline ps-current-underline-p))
2293 (defun ps-end-page ()
2294 (setq ps-showpage-count (+ 1 ps-showpage-count))
2295 (ps-output "EndPage\n")
2296 (ps-output "EndDSCPage\n"))
2298 (defun ps-dummy-page ()
2299 (setq ps-showpage-count (+ 1 ps-showpage-count))
2300 (ps-output "%%Page: " (format "- %d\n" ps-showpage-count)
2302 /PrintHeader false def
2307 (defun ps-next-line ()
2308 (if (< ps-height-remaining ps-line-height)
2310 (setq ps-width-remaining ps-print-width)
2311 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
2314 (defun ps-continue-line ()
2315 (if (< ps-height-remaining ps-line-height)
2317 (setq ps-width-remaining ps-print-width)
2318 (setq ps-height-remaining (- ps-height-remaining ps-line-height))
2321 ;; [jack] Why hard and soft ?
2323 (defun ps-hard-lf ()
2326 (defun ps-soft-lf ()
2329 (defun ps-find-wrappoint (from to char-width)
2330 (let ((avail (truncate (/ ps-width-remaining char-width)))
2333 (cons to (* todo char-width))
2334 (cons (+ from avail) ps-width-remaining))))
2336 (defun ps-basic-plot-string (from to &optional bg-color)
2337 (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width))
2338 (to (car wrappoint))
2339 (string (buffer-substring-no-properties from to)))
2340 (ps-output-string string)
2344 (defun ps-basic-plot-whitespace (from to &optional bg-color)
2345 (let* ((wrappoint (ps-find-wrappoint from to ps-space-width))
2346 (to (car wrappoint)))
2348 (ps-output (format "%d W\n" (- to from)))
2351 (defun ps-plot (plotfunc from to &optional bg-color)
2353 (let* ((wrappoint (funcall plotfunc from to bg-color))
2354 (plotted-to (car wrappoint))
2355 (plotted-width (cdr wrappoint)))
2356 (setq from plotted-to)
2357 (setq ps-width-remaining (- ps-width-remaining plotted-width))
2359 (ps-continue-line))))
2360 (if ps-razzle-dazzle
2361 (let* ((q-todo (- (point-max) (point-min)))
2362 (q-done (- (point) (point-min)))
2363 (chunkfrac (/ q-todo 8))
2364 (chunksize (if (> chunkfrac 1000) 1000 chunkfrac)))
2365 (if (> (- q-done ps-razchunk) chunksize)
2367 (setq ps-razchunk q-done)
2370 (/ (* 100 q-done) q-todo)
2371 (/ q-done (/ q-todo 100))))
2372 (message "Formatting...%3d%%" foo))))))
2374 (defun ps-set-font (font)
2375 (setq ps-current-font font)
2376 (ps-output (format "/f%d F\n" ps-current-font)))
2378 (defun ps-set-bg (color)
2379 (if (setq ps-current-bg color)
2380 (ps-output (format ps-color-format (nth 0 color) (nth 1 color)
2383 (ps-output "false BG\n")))
2385 (defun ps-set-color (color)
2386 (if (setq ps-current-color color)
2388 (setq ps-current-color ps-default-fg))
2389 (ps-output (format ps-color-format (nth 0 ps-current-color)
2390 (nth 1 ps-current-color) (nth 2 ps-current-color))
2393 (defun ps-set-underline (underline-p)
2394 (ps-output (if underline-p "true" "false") " UL\n")
2395 (setq ps-current-underline-p underline-p))
2397 (defun ps-plot-region (from to font fg-color &optional bg-color underline-p)
2399 (if (not (equal font ps-current-font))
2402 ;; Specify a foreground color only if one's specified and it's
2403 ;; different than the current.
2404 (if (not (equal fg-color ps-current-color))
2405 (ps-set-color fg-color))
2407 (if (not (equal bg-color ps-current-bg))
2408 (ps-set-bg bg-color))
2410 ;; Toggle underlining if different.
2411 (if (not (equal underline-p ps-current-underline-p))
2412 (ps-set-underline underline-p))
2414 ;; Starting at the beginning of the specified region...
2418 ;; ...break the region up into chunks separated by tabs, linefeeds,
2419 ;; and pagefeeds, and plot each chunk.
2421 (if (re-search-forward "[\t\n\f]" to t)
2422 (let ((match (char-after (match-beginning 0))))
2426 (save-excursion (beginning-of-line) (point))))
2427 (ps-plot 'ps-basic-plot-string from (- (point) 1)
2430 (setq from (+ linestart (current-column)))
2431 (if (re-search-forward "[ \t]+" to t)
2432 (ps-plot 'ps-basic-plot-whitespace
2433 from (+ linestart (current-column))
2437 (ps-plot 'ps-basic-plot-string from (- (point) 1)
2443 (ps-plot 'ps-basic-plot-string from (- (point) 1)
2446 (setq from (point)))
2447 (ps-plot 'ps-basic-plot-string from to bg-color)
2450 (defun ps-color-value (x-color-value)
2451 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
2452 (/ x-color-value ps-print-color-scale))
2454 (defun ps-color-values (x-color)
2455 (cond ((fboundp 'x-color-values)
2456 (x-color-values x-color))
2457 ((fboundp 'pixel-components)
2458 (pixel-components x-color))
2459 (t (error "No available function to determine X color values."))))
2461 (defun ps-face-attributes (face)
2462 (let ((differs (face-differs-from-default-p face)))
2463 (list (memq face ps-ref-bold-faces)
2464 (memq face ps-ref-italic-faces)
2465 (memq face ps-ref-underlined-faces)
2466 (and differs (face-foreground face))
2467 (and differs (face-background face)))))
2469 (defun ps-face-attribute-list (face-or-list)
2470 (if (listp face-or-list)
2471 (let (bold-p italic-p underline-p foreground background face-attr face)
2473 (setq face (car face-or-list))
2474 (setq face-attr (ps-face-attributes face))
2475 (setq bold-p (or bold-p (nth 0 face-attr)))
2476 (setq italic-p (or italic-p (nth 1 face-attr)))
2477 (setq underline-p (or underline-p (nth 2 face-attr)))
2480 (setq foreground (nth 3 face-attr)))
2483 (setq background (nth 4 face-attr)))
2484 (setq face-or-list (cdr face-or-list)))
2485 (list bold-p italic-p underline-p foreground background))
2487 (ps-face-attributes face-or-list)))
2489 (defun ps-plot-with-face (from to face)
2491 (let* ((face-attr (ps-face-attribute-list face))
2492 (bold-p (nth 0 face-attr))
2493 (italic-p (nth 1 face-attr))
2494 (underline-p (nth 2 face-attr))
2495 (foreground (nth 3 face-attr))
2496 (background (nth 4 face-attr))
2497 (fg-color (if (and ps-print-color-p foreground)
2498 (mapcar 'ps-color-value
2499 (ps-color-values foreground))
2501 (bg-color (if (and ps-print-color-p background)
2502 (mapcar 'ps-color-value
2503 (ps-color-values background)))))
2504 (ps-plot-region from to
2505 (cond ((and bold-p italic-p) 3)
2509 ; (or fg-color '(0.0 0.0 0.0))
2511 bg-color underline-p))
2515 (defun ps-emacs-face-kind-p (face kind kind-regex kind-list)
2516 (let ((frame-font (face-font face))
2517 (face-defaults (face-font face t)))
2519 ;; Check FACE defaults:
2520 (and (listp face-defaults)
2521 (memq kind face-defaults))
2523 ;; Check the user's preferences
2524 (memq face kind-list))))
2526 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
2527 (let* ((frame-font (or (face-font face) (face-font 'default)))
2528 (kind-cons (assq kind (x-font-properties frame-font)))
2529 (kind-spec (cdr-safe kind-cons))
2530 (case-fold-search t))
2532 (or (and kind-spec (string-match kind-regex kind-spec))
2533 ;; Kludge-compatible:
2534 (memq face kind-list))))
2536 (defun ps-face-bold-p (face)
2537 (if (eq ps-print-emacs-type 'emacs)
2538 (ps-emacs-face-kind-p face 'bold "-\\(bold\\|demibold\\)-"
2540 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
2543 (defun ps-face-italic-p (face)
2544 (if (eq ps-print-emacs-type 'emacs)
2545 (ps-emacs-face-kind-p face 'italic "-[io]-" ps-italic-faces)
2547 (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces)
2548 (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces))))
2550 (defun ps-face-underlined-p (face)
2551 (or (face-underline-p face)
2552 (memq face ps-underlined-faces)))
2554 ;; Ensure that face-list is fbound.
2555 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
2557 (defun ps-build-reference-face-lists ()
2558 (if ps-auto-font-detect
2559 (let ((faces (face-list))
2561 (setq ps-ref-bold-faces nil
2562 ps-ref-italic-faces nil
2563 ps-ref-underlined-faces nil)
2565 (setq the-face (car faces))
2566 (if (ps-face-italic-p the-face)
2567 (setq ps-ref-italic-faces
2568 (cons the-face ps-ref-italic-faces)))
2569 (if (ps-face-bold-p the-face)
2570 (setq ps-ref-bold-faces
2571 (cons the-face ps-ref-bold-faces)))
2572 (if (ps-face-underlined-p the-face)
2573 (setq ps-ref-underlined-faces
2574 (cons the-face ps-ref-underlined-faces)))
2575 (setq faces (cdr faces))))
2576 (setq ps-ref-bold-faces ps-bold-faces)
2577 (setq ps-ref-italic-faces ps-italic-faces)
2578 (setq ps-ref-underlined-faces ps-underlined-faces))
2579 (setq ps-build-face-reference nil))
2581 (defun ps-mapper (extent list)
2582 (nconc list (list (list (extent-start-position extent) 'push extent)
2583 (list (extent-end-position extent) 'pull extent)))
2586 (defun ps-extent-sorter (a b)
2587 (< (extent-priority a) (extent-priority b)))
2589 (defun ps-print-ensure-fontified (start end)
2590 (if (and (boundp 'lazy-lock-mode) lazy-lock-mode)
2591 (if (fboundp 'lazy-lock-fontify-region)
2592 (lazy-lock-fontify-region start end) ; the new
2593 (lazy-lock-fontify-buffer)))) ; the old
2595 (defun ps-generate-postscript-with-faces (from to)
2596 ;; Build the reference lists of faces if necessary.
2597 (if (or ps-always-build-face-reference
2598 ps-build-face-reference)
2600 (message "Collecting face information...")
2601 (ps-build-reference-face-lists)))
2602 ;; Set the color scale. We do it here instead of in the defvar so
2603 ;; that ps-print can be dumped into emacs. This expression can't be
2604 ;; evaluated at dump-time because X isn't initialized.
2605 (setq ps-print-color-scale
2606 (if ps-print-color-p
2607 (float (car (ps-color-values "white")))
2609 ;; Generate some PostScript.
2611 (narrow-to-region from to)
2612 (let ((face 'default)
2614 (ps-print-ensure-fontified from to)
2615 (cond ((or (eq ps-print-emacs-type 'lucid)
2616 (eq ps-print-emacs-type 'xemacs))
2617 ;; Build the list of extents...
2618 (let ((a (cons 'dummy nil))
2619 record type extent extent-list)
2620 (map-extents 'ps-mapper nil from to a)
2621 (setq a (sort (cdr a) 'car-less-than-car))
2623 (setq extent-list nil)
2625 ;; Loop through the extents...
2627 (setq record (car a))
2629 (setq position (car record))
2630 (setq record (cdr record))
2632 (setq type (car record))
2633 (setq record (cdr record))
2635 (setq extent (car record))
2637 ;; Plot up to this record.
2638 ;; XEmacs 19.12: for some reason, we're getting into a
2639 ;; situation in which some of the records have
2640 ;; positions less than 'from'. Since we've narrowed
2641 ;; the buffer, this'll generate errors. This is a
2642 ;; hack, but don't call ps-plot-with-face unless from >
2644 (if (and (>= from (point-min))
2645 (<= position (point-max)))
2646 (ps-plot-with-face from position face))
2650 (if (extent-face extent)
2651 (setq extent-list (sort (cons extent extent-list)
2652 'ps-extent-sorter))))
2655 (setq extent-list (sort (delq extent extent-list)
2656 'ps-extent-sorter))))
2660 (extent-face (car extent-list))
2663 (setq from position)
2666 ((eq ps-print-emacs-type 'emacs)
2667 (let ((property-change from)
2668 (overlay-change from))
2670 (if (< property-change to) ; Don't search for property change
2671 ; unless previous search succeeded.
2672 (setq property-change
2673 (next-property-change from nil to)))
2674 (if (< overlay-change to) ; Don't search for overlay change
2675 ; unless previous search succeeded.
2676 (setq overlay-change
2677 (min (next-overlay-change from) to)))
2679 (min property-change overlay-change))
2680 ;; The code below is not quite correct,
2681 ;; because a non-nil overlay invisible property
2682 ;; which is inactive according to the current value
2683 ;; of buffer-invisibility-spec nonetheless overrides
2684 ;; a face text property.
2686 (cond ((let ((prop (get-text-property from 'invisible)))
2687 ;; Decide whether this invisible property
2688 ;; really makes the text invisible.
2689 (if (eq buffer-invisibility-spec t)
2691 (or (memq prop buffer-invisibility-spec)
2692 (assq prop buffer-invisibility-spec))))
2694 ((get-text-property from 'face))
2696 (let ((overlays (overlays-at from))
2697 (face-priority -1)) ; text-property
2699 (let* ((overlay (car overlays))
2700 (overlay-face (overlay-get overlay 'face))
2701 (overlay-invisible (overlay-get overlay 'invisible))
2702 (overlay-priority (or (overlay-get overlay
2705 (if (and (or overlay-invisible overlay-face)
2706 (> overlay-priority face-priority))
2707 (setq face (cond ((if (eq buffer-invisibility-spec t)
2708 (not (null overlay-invisible))
2709 (or (memq overlay-invisible buffer-invisibility-spec)
2710 (assq overlay-invisible buffer-invisibility-spec)))
2712 ((and face overlay-face)))
2713 face-priority overlay-priority)))
2714 (setq overlays (cdr overlays))))
2715 ;; Plot up to this record.
2716 (ps-plot-with-face from position face)
2717 (setq from position)))))
2718 (ps-plot-with-face from to face))))
2720 (defun ps-generate-postscript (from to)
2721 (ps-plot-region from to 0 nil))
2723 (defun ps-generate (buffer from to genfunc)
2724 (let ((from (min to from))
2726 ;; This avoids trouble if chars with read-only properties
2727 ;; are copied into ps-spool-buffer.
2728 (inhibit-read-only t))
2730 (narrow-to-region from to)
2731 (if ps-razzle-dazzle
2732 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
2734 (setq ps-source-buffer buffer)
2735 (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
2736 (ps-init-output-queue)
2737 (let (safe-marker completed-safely needs-begin-file)
2740 (set-buffer ps-spool-buffer)
2742 ;; Get a marker and make it point to the current end of the
2743 ;; buffer, If an error occurs, we'll delete everything from
2744 ;; the end of this marker onwards.
2745 (setq safe-marker (make-marker))
2746 (set-marker safe-marker (point-max))
2748 (goto-char (point-min))
2749 (if (looking-at (regexp-quote "%!PS-Adobe-1.0"))
2751 (setq needs-begin-file t))
2753 (set-buffer ps-source-buffer)
2754 (if needs-begin-file (ps-begin-file))
2757 (set-buffer ps-source-buffer)
2758 (funcall genfunc from to)
2761 (if (and ps-spool-duplex
2762 (= (mod ps-page-count 2) 1))
2766 ;; Back to the PS output buffer to set the page count
2767 (set-buffer ps-spool-buffer)
2768 (goto-char (point-max))
2769 (while (re-search-backward "^/PageCount 0 def$" nil t)
2770 (replace-match (format "/PageCount %d def" ps-page-count) t))
2772 ;; Setting this variable tells the unwind form that the
2773 ;; the postscript was generated without error.
2774 (setq completed-safely t))
2776 ;; Unwind form: If some bad mojo occurred while generating
2777 ;; postscript, delete all the postscript that was generated.
2778 ;; This protects the previously spooled files from getting
2780 (if (and (markerp safe-marker) (not completed-safely))
2782 (set-buffer ps-spool-buffer)
2783 (delete-region (marker-position safe-marker) (point-max))))))
2785 (if ps-razzle-dazzle
2786 (message "Formatting...done")))))
2788 (defun ps-do-despool (filename)
2789 (if (or (not (boundp 'ps-spool-buffer))
2790 (not (symbol-value 'ps-spool-buffer)))
2791 (message "No spooled PostScript to print")
2796 (if ps-razzle-dazzle
2797 (message "Saving..."))
2798 (set-buffer ps-spool-buffer)
2799 (setq filename (expand-file-name filename))
2800 (write-region (point-min) (point-max) filename)
2801 (if ps-razzle-dazzle
2802 (message "Wrote %s" filename)))
2803 ;; Else, spool to the printer
2804 (if ps-razzle-dazzle
2805 (message "Printing..."))
2807 (set-buffer ps-spool-buffer)
2808 (if (and (eq system-type 'ms-dos) (stringp dos-ps-printer))
2809 (write-region (point-min) (point-max) dos-ps-printer t 0)
2810 (let ((binary-process-input t)) ; for MS-DOS
2811 (apply 'call-process-region
2812 (point-min) (point-max) ps-lpr-command nil
2813 (if (fboundp 'start-process) 0 nil)
2816 (if ps-razzle-dazzle
2817 (message "Printing...done")))
2818 (kill-buffer ps-spool-buffer)))
2820 (defun ps-kill-emacs-check ()
2822 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
2823 (buffer-modified-p ps-buffer))
2824 (if (y-or-n-p "Unprinted PostScript waiting; print now? ")
2826 (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
2827 (buffer-modified-p ps-buffer))
2828 (if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")
2830 (error "Unprinted PostScript")))))
2832 (if (fboundp 'add-hook)
2833 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)
2835 (message "Won't override existing kill-emacs-hook")
2836 (setq kill-emacs-hook 'ps-kill-emacs-check)))
2838 ;;; Sample Setup Code:
2840 ;; This stuff is for anybody that's brave enough to look this far,
2841 ;; and able to figure out how to use it. It isn't really part of ps-
2842 ;; print, but I'll leave it here in hopes it might be useful:
2844 ;; WARNING!!! The following code is *sample* code only. Don't use it
2845 ;; unless you understand what it does!
2847 (defmacro ps-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
2849 (defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
2852 (defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
2856 ;; Look in an article or mail message for the Subject: line. To be
2857 ;; placed in ps-left-headers.
2858 (defun ps-article-subject ()
2860 (goto-char (point-min))
2861 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
2862 (buffer-substring-no-properties (match-beginning 1) (match-end 1))
2865 ;; Look in an article or mail message for the From: line. Sorta-kinda
2866 ;; understands RFC-822 addresses and can pull the real name out where
2867 ;; it's provided. To be placed in ps-left-headers.
2868 (defun ps-article-author ()
2870 (goto-char (point-min))
2871 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
2872 (let ((fromstring (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
2875 ;; Try first to match addresses that look like
2876 ;; thompson@wg2.waii.com (Jim Thompson)
2877 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
2878 (substring fromstring (match-beginning 1) (match-end 1)))
2880 ;; Next try to match addresses that look like
2881 ;; Jim Thompson <thompson@wg2.waii.com>
2882 ((string-match "\\(.*\\)[ \t]+<.*>" fromstring)
2883 (substring fromstring (match-beginning 1) (match-end 1)))
2885 ;; Couldn't find a real name -- show the address instead.
2889 ;; A hook to bind to gnus-Article-prepare-hook. This will set the ps-
2890 ;; left-headers specially for gnus articles. Unfortunately, gnus-
2891 ;; article-mode-hook is called only once, the first time the *Article*
2892 ;; buffer enters that mode, so it would only work for the first time
2893 ;; we ran gnus. The second time, this hook wouldn't get set up. The
2894 ;; only alternative is gnus-article-prepare-hook.
2895 (defun ps-gnus-article-prepare-hook ()
2896 (setq ps-header-lines 3)
2897 (setq ps-left-header
2898 ;; The left headers will display the article's subject, its
2899 ;; author, and the newsgroup it was in.
2900 (list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name)))
2902 ;; A hook to bind to vm-mode-hook to locally bind prsc and set the ps-
2903 ;; left-headers specially for mail messages. This header setup would
2904 ;; also work, I think, for RMAIL.
2905 (defun ps-vm-mode-hook ()
2906 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
2907 (setq ps-header-lines 3)
2908 (setq ps-left-header
2909 ;; The left headers will display the message's subject, its
2910 ;; author, and the name of the folder it was in.
2911 (list 'ps-article-subject 'ps-article-author 'buffer-name)))
2913 ;; Every now and then I forget to switch from the *Summary* buffer to
2914 ;; the *Article* before hitting prsc, and a nicely formatted list of
2915 ;; article subjects shows up at the printer. This function, bound to
2916 ;; prsc for the gnus *Summary* buffer means I don't have to switch
2918 (defun ps-gnus-print-article-from-summary ()
2920 (if (get-buffer "*Article*")
2922 (set-buffer "*Article*")
2923 (ps-spool-buffer-with-faces))))
2925 ;; See ps-gnus-print-article-from-summary. This function does the
2926 ;; same thing for vm.
2927 (defun ps-vm-print-message-from-summary ()
2929 (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
2931 (set-buffer (symbol-value 'vm-mail-buffer))
2932 (ps-spool-buffer-with-faces))))
2934 ;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind
2936 (defun ps-gnus-summary-setup ()
2937 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
2939 ;; Look in an article or mail message for the Subject: line. To be
2940 ;; placed in ps-left-headers.
2941 (defun ps-info-file ()
2943 (goto-char (point-min))
2944 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
2945 (buffer-substring-no-properties (match-beginning 1) (match-end 1))
2948 ;; Look in an article or mail message for the Subject: line. To be
2949 ;; placed in ps-left-headers.
2950 (defun ps-info-node ()
2952 (goto-char (point-min))
2953 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
2954 (buffer-substring-no-properties (match-beginning 1) (match-end 1))
2957 (defun ps-info-mode-hook ()
2958 (setq ps-left-header
2959 ;; The left headers will display the node name and file name.
2960 (list 'ps-info-node 'ps-info-file)))
2962 ;; WARNING! The following function is a *sample* only, and is *not*
2963 ;; meant to be used as a whole unless you understand what the effects
2964 ;; will be! (In fact, this is a copy of Jim's setup for ps-print -- I'd
2965 ;; be very surprised if it was useful to *anybody*, without
2968 (defun ps-jts-ps-setup ()
2969 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
2970 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
2971 (global-set-key (ps-c-prsc) 'ps-despool)
2972 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
2973 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
2974 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
2975 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
2976 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
2977 (setq ps-spool-duplex t)
2978 (setq ps-print-color-p nil)
2979 (setq ps-lpr-command "lpr")
2980 (setq ps-lpr-switches '("-Jjct,duplex_long"))
2983 ;; WARNING! The following function is a *sample* only, and is *not*
2984 ;; meant to be used as a whole unless it corresponds to your needs.
2985 ;; (In fact, this is a copy of Jack's setup for ps-print --
2986 ;; I would not be that surprised if it was useful to *anybody*,
2987 ;; without modification.)
2989 (defun ps-jack-setup ()
2990 (setq ps-print-color-p 'nil
2991 ps-lpr-command "lpr"
2992 ps-lpr-switches (list)
2995 ps-landscape-mode 't
2996 ps-number-of-columns 2
2998 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
2999 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
3000 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
3001 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
3002 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
3003 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
3004 ps-header-line-pad .15
3006 ps-print-header-frame t
3011 ps-font-family 'Courier
3013 ps-header-font-family 'Helvetica
3014 ps-header-font-size 6
3015 ps-header-title-font-size 8)
3020 ;;; ps-print.el ends here