1 ;;; ps-print.el --- Print text from the buffer as PostScript
3 ;; Copyright (C) 1993-2000 Free Software Foundation, Inc.
5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6 ;; Author: Jacques Duthen (was <duthen@cegelec-red.fr>)
7 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
8 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
9 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
11 ;; Keywords: wp, print, PostScript
12 ;; Time-stamp: <2000/05/12 19:56:11 vinicius>
15 (defconst ps-print-version "5.2.1"
16 "ps-print.el, v 5.2.1 <2000/05/12 vinicius>
18 Vinicius's last change version -- this file may have been edited as part of
19 Emacs without changes to the version number. When reporting bugs, please also
20 report the version of Emacs, if any, that ps-print was distributed with.
22 Please send all bug fixes and enhancements to
23 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
26 ;; This file is part of GNU Emacs.
28 ;; GNU Emacs is free software; you can redistribute it and/or modify
29 ;; it under the terms of the GNU General Public License as published by
30 ;; the Free Software Foundation; either version 2, or (at your option)
33 ;; GNU Emacs is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
36 ;; GNU General Public License for more details.
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with GNU Emacs; see the file COPYING. If not, write to the
40 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
41 ;; Boston, MA 02111-1307, USA.
45 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50 ;; This package provides printing of Emacs buffers on PostScript printers;
51 ;; the buffer's bold and italic text attributes are preserved in the printer
52 ;; output. ps-print is intended for use with Emacs or Lucid Emacs, together
53 ;; with a fontifying package such as font-lock or hilit.
55 ;; ps-print uses the same face attributes defined through font-lock or hilit
56 ;; to print a PostScript file, but some faces are better seeing on the screen
57 ;; than on paper, specially when you have a black/white PostScript printer.
59 ;; ps-print allows a remap of face to another one that it is better to print,
60 ;; for example, the face font-lock-comment-face (if you are using font-lock)
61 ;; could have bold or italic attribute when printing, besides foreground color.
62 ;; This remap improves printing look (see How Ps-Print Maps Faces).
68 ;; ps-print provides eight commands for generating PostScript images
72 ;; ps-print-buffer-with-faces
74 ;; ps-print-region-with-faces
76 ;; ps-spool-buffer-with-faces
78 ;; ps-spool-region-with-faces
80 ;; These commands all perform essentially the same function: they
81 ;; generate PostScript images suitable for printing on a PostScript
82 ;; printer or displaying with GhostScript. These commands are
83 ;; collectively referred to as "ps-print- commands".
85 ;; The word "print" or "spool" in the command name determines when the
86 ;; PostScript image is sent to the printer:
88 ;; print - The PostScript image is immediately sent to the
91 ;; spool - The PostScript image is saved temporarily in an
92 ;; Emacs buffer. Many images may be spooled locally
93 ;; before printing them. To send the spooled images
94 ;; to the printer, use the command `ps-despool'.
96 ;; The spooling mechanism was designed for printing lots of small
97 ;; files (mail messages or netnews articles) to save paper that would
98 ;; otherwise be wasted on banner pages, and to make it easier to find
99 ;; your output at the printer (it's easier to pick up one 50-page
100 ;; printout than to find 50 single-page printouts).
102 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't
103 ;; accidentally quit from Emacs while you have unprinted PostScript
104 ;; waiting in the spool buffer. If you do attempt to exit with
105 ;; spooled PostScript, you'll be asked if you want to print it, and if
106 ;; you decline, you'll be asked to confirm the exit; this is modeled
107 ;; on the confirmation that Emacs uses for modified buffers.
109 ;; The word "buffer" or "region" in the command name determines how
110 ;; much of the buffer is printed:
112 ;; buffer - Print the entire buffer.
114 ;; region - Print just the current region.
116 ;; The -with-faces suffix on the command name means that the command
117 ;; will include font, color, and underline information in the
118 ;; PostScript image, so the printed image can look as pretty as the
119 ;; buffer. The ps-print- commands without the -with-faces suffix
120 ;; don't include font, color, or underline information; images printed
121 ;; with these commands aren't as pretty, but are faster to generate.
123 ;; Two ps-print- command examples:
125 ;; ps-print-buffer - print the entire buffer,
126 ;; without font, color, or
127 ;; underline information, and
128 ;; send it immediately to the
131 ;; ps-spool-region-with-faces - print just the current region;
132 ;; include font, color, and
133 ;; underline information, and
134 ;; spool the image in Emacs to
135 ;; send to the printer later.
141 ;; To print your buffer, type
143 ;; M-x ps-print-buffer
145 ;; or substitute one of the other seven ps-print- commands. The
146 ;; command will generate the PostScript image and print or spool it as
147 ;; specified. By giving the command a prefix argument
149 ;; C-u M-x ps-print-buffer
151 ;; it will save the PostScript image to a file instead of sending it
152 ;; to the printer; you will be prompted for the name of the file to
153 ;; save the image to. The prefix argument is ignored by the commands
154 ;; that spool their images, but you may save the spooled images to a
155 ;; file by giving a prefix argument to `ps-despool':
157 ;; C-u M-x ps-despool
159 ;; When invoked this way, `ps-despool' will prompt you for the name of
160 ;; the file to save to.
162 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
163 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
164 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
166 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
167 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
168 ;; (global-set-key '(control f22) 'ps-despool)
171 ;; The Printer Interface
172 ;; ---------------------
174 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
175 ;; command is used to send the PostScript images to the printer, and
176 ;; what arguments to give the command. These are analogous to
177 ;; `lpr-command' and `lpr-switches'.
179 ;; Make sure that they contain appropriate values for your system;
180 ;; see the usage notes below and the documentation of these variables.
182 ;; The variable `ps-printer-name' determines the name of a local printer for
183 ;; printing PostScript files.
185 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
186 ;; from the variables `lpr-command' and `lpr-switches'. If you have
187 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
188 ;; then ps-print won't work properly. `ps-lpr-command' must name
189 ;; a program that does not format the files it prints.
190 ;; `ps-printer-name' takes its initial value from the variable
193 ;; The variable `ps-print-region-function' specifies a function to print the
194 ;; region on a PostScript printer.
195 ;; See definition of `call-process-region' for calling conventions. The fourth
196 ;; and the sixth arguments are both nil.
198 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
199 ;; customize the following variables: `ps-printer-name', `ps-lpr-command',
200 ;; `ps-lpr-switches' and `ps-spool-config'. See these variables documentation
201 ;; in the code or by typing, for example, C-h v ps-printer-name RET.
207 ;; All dimensions are floats in PostScript points.
208 ;; 1 inch == 2.54 cm == 72 points
209 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
211 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
212 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
213 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
216 ;; The variable `ps-landscape-mode' determines the orientation of the printing
217 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
218 ;; There is no oblique mode yet, though this is easy to do in ps.
220 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in portrait
221 ;; mode and only 50 lines in landscape mode. The margins represent margins in
222 ;; the printed paper: the top margin is the margin between the top of the page
223 ;; and the printed header, whatever the orientation is.
225 ;; The variable `ps-number-of-columns' determines the number of columns both in
226 ;; landscape and portrait mode.
228 ;; - (the standard) one column portrait mode.
229 ;; - (my favorite) two columns landscape mode (which spares trees).
231 ;; - one column landscape mode for files with very long lines.
232 ;; - multi-column portrait or landscape mode.
234 ;; The variable `ps-print-upside-down' determines other orientation for printing
235 ;; page: nil means `normal' printing, non-nil means `upside-down' printing. The
236 ;; default value is nil (`normal' printing).
238 ;; The `upside-down' orientation can be used in portrait or landscape mode.
244 ;; The horizontal layout is determined by the variables
245 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
248 ;; ------------------------------------------
250 ;; | lm | text | ic | text | ic | text | rm |
252 ;; ------------------------------------------
254 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
255 ;; Usually, lm = rm > 0 and ic = lm
256 ;; If (ic < 0), the text of adjacent columns can overlap.
262 ;; The vertical layout is determined by the variables
263 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
266 ;; |--------| |--------|
268 ;; |--------| |--------|
272 ;; |--------| or | text |
276 ;; |--------| |--------|
278 ;; |--------| |--------|
280 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
281 ;; The margins represent margins in the printed paper:
282 ;; the top margin is the margin between the top of the page
283 ;; and the printed header, whatever the orientation is.
289 ;; ps-print can print headers at the top of each column or at the top
290 ;; of each page; the default headers contain the following four items:
291 ;; on the left, the name of the buffer and, if the buffer is visiting
292 ;; a file, the file's directory; on the right, the page number and
293 ;; date of printing. The default headers look something like this:
296 ;; /home/jct/emacs-lisp/ps/new 94/12/31
298 ;; When printing on duplex printers, left and right are reversed so
299 ;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
301 ;; Headers are configurable:
302 ;; To turn them off completely, set `ps-print-header' to nil.
303 ;; To turn off the header's gaudy framing box,
304 ;; set `ps-print-header-frame' to nil.
306 ;; To print only one header at the top of each page,
307 ;; set `ps-print-only-one-header' to t.
309 ;; The font family and size of text in the header are determined
310 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
311 ;; `ps-header-title-font-size' (see below).
313 ;; The variable `ps-header-line-pad' determines the portion of a header
314 ;; title line height to insert between the header frame and the text
315 ;; it contains, both in the vertical and horizontal directions:
316 ;; .5 means half a line.
318 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
319 ;; to omit the total page count and just print the page number,
320 ;; set `ps-show-n-of-n' to nil.
322 ;; The amount of information in the header can be changed by changing
323 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
324 ;; the header will show only the buffer name and page number. To show
325 ;; more, set `ps-header-lines' to 3, and the header will show the time of
326 ;; printing below the date.
328 ;; To change the content of the headers, change the variables
329 ;; `ps-left-header' and `ps-right-header'.
330 ;; These variables are lists, specifying top-to-bottom the text
331 ;; to display on the left or right side of the header.
332 ;; Each element of the list should be a string or a symbol.
333 ;; Strings are inserted directly into the PostScript arrays,
334 ;; and should contain the PostScript string delimiters '(' and ')'.
336 ;; Symbols in the header format lists can either represent functions
337 ;; or variables. Functions are called, and should return a string to
338 ;; show in the header. Variables should contain strings to display in
339 ;; the header. In either case, function or variable, the PostScript
340 ;; string delimiters are added by ps-print, and should not be part of
341 ;; the returned value.
343 ;; Here's an example: say we want the left header to display the text
349 ;; where we have a function to return "Moe"
351 ;; (defun moe-func ()
354 ;; a variable specifying "Larry"
356 ;; (setq larry-var "Larry")
358 ;; and a literal for "Curly". Here's how `ps-left-header' should be
361 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
363 ;; Note that Curly has the PostScript string delimiters inside his
364 ;; quotes -- those aren't misplaced lisp delimiters!
366 ;; Without them, PostScript would attempt to call the undefined
367 ;; function Curly, which would result in a PostScript error.
369 ;; Since most printers don't report PostScript errors except by
370 ;; aborting the print job, this kind of error can be hard to track down.
372 ;; Consider yourself warned!
375 ;; PostScript Prologue Header
376 ;; --------------------------
378 ;; It is possible to add PostScript prologue header comments besides that
379 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
381 ;; `ps-print-prologue-header' may be a string or a symbol function which returns
382 ;; a string. Note that this string is inserted on PostScript prologue header
383 ;; section which is used to define some document characteristic through
384 ;; PostScript special comments, like "%%Requirements: jog\n".
386 ;; By default `ps-print-prologue-header' is nil.
388 ;; ps-print always inserts the %%Requirements: comment, so if you need to insert
389 ;; more requirements put them first in `ps-print-prologue-header' using the
390 ;; "%%+" comment. For example, if you need to set numcopies to 3 and jog on
391 ;; requirements and set %%LanguageLevel: to 2, do:
393 ;; (setq ps-print-prologue-header
394 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
396 ;; The duplex requirement is inserted by ps-print (see section Duplex Printers).
398 ;; Do not forget to terminate the string with "\n".
400 ;; For more information about PostScript document comments, see:
401 ;; PostScript Language Reference Manual (2nd edition)
402 ;; Adobe Systems Incorporated
403 ;; Appendix G: Document Structuring Conventions -- Version 3.0
405 ;; It is also possible to add an user defined PostScript prologue code before
406 ;; all generated prologue code by setting the variable
407 ;; `ps-user-defined-prologue'.
409 ;; `ps-user-defined-prologue' may be a string or a symbol function which returns
410 ;; a string. Note that this string is inserted after `ps-adobe-tag' and
411 ;; PostScript prologue comments, and before ps-print PostScript prologue code
412 ;; section. That is, this string is inserted after error handler initialization
413 ;; and before ps-print settings.
415 ;; By default `ps-user-defined-prologue' is nil.
417 ;; It's recommended to initiate and terminate the string with "\n".
419 ;; It's strongly recommended only insert PostScript code and/or comments
420 ;; specific for your printing system particularities. For example, some special
421 ;; initialization that only your printing system needs.
423 ;; Do not insert code for duplex printing, n-up printing or error handler,
424 ;; ps-print handles this in a suitable way.
426 ;; For more information about PostScript, see:
427 ;; PostScript Language Reference Manual (2nd edition)
428 ;; Adobe Systems Incorporated
431 ;; PostScript Error Handler
432 ;; ------------------------
434 ;; ps-print instruments generated PostScript code with an error handler.
436 ;; The variable `ps-error-handler-message' specifies where the error handler
437 ;; message should be sent.
441 ;; none catch the error and *DON'T* send any message.
443 ;; paper catch the error and print on paper the error message.
444 ;; This is the default value.
446 ;; system catch the error and send back the error message to
447 ;; printing system. This is useful only if printing system
448 ;; send back an email reporting the error, or if there is
449 ;; some other alternative way to report back the error from
450 ;; the system to you.
452 ;; paper-and-system catch the error, print on paper the error message and
453 ;; send back the error message to printing system.
455 ;; Any other value is treated as `paper'.
461 ;; If you have a duplex-capable printer (one that prints both sides of the
462 ;; paper), set `ps-spool-duplex' to t.
463 ;; ps-print will insert blank pages to make sure each buffer starts on the
464 ;; correct side of the paper.
466 ;; The variable `ps-spool-config' specifies who is the responsable for setting
467 ;; duplex and page size switches. Valid values are:
469 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
470 ;; Don't forget to set `ps-lpr-switches' to select duplex
471 ;; printing for your printer.
473 ;; setpagedevice duplex and page size are configured by ps-print using the
474 ;; setpagedevice PostScript operator.
476 ;; nil duplex and page size are configured by ps-print *not* using
477 ;; the setpagedevice PostScript operator.
479 ;; Any other value is treated as nil.
481 ;; The default value is `lpr-switches'.
483 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility when
484 ;; viewing file generated using landscape. Also on some printers,
485 ;; setpagedevice affects zebra stripes; on other printers,
486 ;; setpagedevice affects the left margin.
487 ;; Besides all that, if your printer does not have the paper size
488 ;; specified by setpagedevice, your printing will be aborted.
489 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
490 ;; `setpagedevice', generate a test file and send it to your printer;
491 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
493 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
494 ;; sides of a sheet are oriented with respect to each other. If
495 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left or
496 ;; right. If `ps-spool-tumble' is non-nil, produces output suitable for binding
497 ;; at the top or bottom. It has effect only when `ps-spool-duplex' is non-nil.
498 ;; The default value is nil.
500 ;; Some printer system prints a header page and forces the first page be printed
501 ;; on header page back, when using duplex. If your printer system has this
502 ;; behavior, set variable `ps-banner-page-when-duplexing' to t.
504 ;; When `ps-banner-page-when-duplexing' is non-nil means the very first page is
505 ;; skipped. It's like the very first character of buffer (or region) is ^L
508 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the very
515 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
516 ;; paper. The value specified must be between 1 and 100. The default is 1.
518 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is set
519 ;; to a high value (for example, 23). If this happens, set a lower value.
521 ;; The variable `ps-n-up-margin' specifies the margin in points between the
522 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
525 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each page.
528 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
529 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
530 ;; filling example using a 3x4 page matrix:
532 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
534 ;; 9 10 11 12 1 2 3 4
536 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
538 ;; 12 11 10 9 4 3 2 1
540 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
544 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
548 ;; Any other value is treated as left-top.
550 ;; The default value is left-top.
553 ;; Control And 8-bit Characters
554 ;; ----------------------------
556 ;; The variable `ps-print-control-characters' specifies whether you want to see
557 ;; a printable form for control and 8-bit characters, that is, instead of
558 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
560 ;; Valid values for `ps-print-control-characters' are:
562 ;; 8-bit This is the value to use when you want an ASCII encoding of
563 ;; any control or non-ASCII character. Control characters are
564 ;; encoded as "^D", and non-ASCII characters have an
567 ;; control-8-bit This is the value to use when you want an ASCII encoding of
568 ;; any control character, whether it is 7 or 8-bit.
569 ;; European 8-bits accented characters are printed according
572 ;; control Only ASCII control characters have an ASCII encoding.
573 ;; European 8-bits accented characters are printed according
576 ;; nil No ASCII encoding. Any character is printed according the
579 ;; Any other value is treated as nil.
581 ;; The default is `control-8-bit'.
583 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
586 ;; Printing Multi-byte Buffer
587 ;; --------------------------
589 ;; See ps-mule.el for documentation.
595 ;; The variable `ps-line-number' specifies whether to number each line;
596 ;; non-nil means do so. The default is nil (don't number each line).
598 ;; The variable `ps-line-number-step' specifies the interval that line number is
599 ;; printed. For example, if `ps-line-number-step' is set to 2, the printing
612 ;; integer an integer that specifies the interval that line number is
613 ;; printed. If it's lesser than or equal to zero, it's used the
616 ;; `zebra' specifies that only the line number of the first line in a zebra
617 ;; stripe is to be printed.
619 ;; Any other value is treated as `zebra'.
620 ;; The default value is 1, so each line number is printed.
622 ;; The variable `ps-line-number-start' specifies the starting point in the
623 ;; interval given by `ps-line-number-step'. For example, if
624 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3, the
625 ;; printing will look like:
639 ;; The values for `ps-line-number-start':
641 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
642 ;; of `ps-line-number-step' inclusive.
644 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
645 ;; value of `ps-zebra-strip-height' inclusive.
647 ;; The default value is 1, so the line number of the first line of each interval
654 ;; Zebra stripes are a kind of background that appear "underneath" the text
655 ;; and can make the text easier to read. They look like this:
657 ;; XXXXXXXXXXXXXXXXXXXXXXXX
658 ;; XXXXXXXXXXXXXXXXXXXXXXXX
659 ;; XXXXXXXXXXXXXXXXXXXXXXXX
663 ;; XXXXXXXXXXXXXXXXXXXXXXXX
664 ;; XXXXXXXXXXXXXXXXXXXXXXXX
665 ;; XXXXXXXXXXXXXXXXXXXXXXXX
667 ;; The blocks of X's represent rectangles filled with a light gray color.
668 ;; Each rectangle extends all the way across the page.
670 ;; The height, in lines, of each rectangle is controlled by
671 ;; the variable `ps-zebra-stripe-height', which is 3 by default.
672 ;; The distance between stripes equals the height of a stripe.
674 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
675 ;; Non-nil means yes, nil means no. The default is nil.
677 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
678 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
679 ;; color), a string which is a color name, or a list of 3 numbers which
680 ;; corresponds to the Red Green Blue color scale.
681 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
683 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
689 ;; ps-print has the following hook variables:
692 ;; It is evaluated once before any printing process. This is the right
693 ;; place to initialize ps-print global data.
694 ;; For an example, see section Adding a New Font Family.
696 ;; `ps-print-begin-sheet-hook'
697 ;; It is evaluated on each beginning of sheet of paper.
698 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
701 ;; `ps-print-begin-page-hook'
702 ;; It is evaluated on each beginning of page, except in the beginning
703 ;; of page that `ps-print-begin-sheet-hook' is evaluated.
705 ;; `ps-print-begin-column-hook'
706 ;; It is evaluated on each beginning of column, except in the beginning
707 ;; of column that `ps-print-begin-page-hook' is evaluated or that
708 ;; `ps-print-begin-sheet-hook' is evaluated.
714 ;; ps-print now knows rather precisely some fonts: the variable
715 ;; `ps-font-info-database' contains information for a list of font families
716 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino' `Helvetica-Narrow'
717 ;; `NewCenturySchlbk'). Each font family contains the font names for standard,
718 ;; bold, italic and bold-italic characters, a reference size (usually 10) and
719 ;; the corresponding line height, width of a space and average character width.
721 ;; The variable `ps-font-family' determines which font family is to be used for
722 ;; ordinary text. If its value does not correspond to a known font family, an
723 ;; error message is printed into the `*Messages*' buffer, which lists the
724 ;; currently available font families.
726 ;; The variable `ps-font-size' determines the size (in points) of the font for
727 ;; ordinary text, when generating PostScript. Its value is a float or a cons of
728 ;; floats which has the following form:
730 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
732 ;; Similarly, the variable `ps-header-font-family' determines which font family
733 ;; is to be used for text in the header.
735 ;; The variable `ps-header-font-size' determines the font size, in points, for
736 ;; text in the header (similar to `ps-font-size').
738 ;; The variable `ps-header-title-font-size' determines the font size, in points,
739 ;; for the top line of text in the header (similar to `ps-font-size').
742 ;; Adding a New Font Family
743 ;; ------------------------
745 ;; To use a new font family, you MUST first teach ps-print
746 ;; this font, i.e., add its information to `ps-font-info-database',
747 ;; otherwise ps-print cannot correctly place line and page breaks.
749 ;; For example, assuming `Helvetica' is unknown,
750 ;; you first need to do the following ONLY ONCE:
752 ;; - create a new buffer
753 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
754 ;; - open this file and find the line:
755 ;; `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
756 ;; - delete the leading `%' (which is the PostScript comment character)
757 ;; - replace in this line `Courier' by the new font (say `Helvetica')
759 ;; `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
760 ;; - send this file to the printer (or to ghostscript).
761 ;; You should read the following on the output page:
763 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
764 ;; and a crude estimate of average character width is 5.09243
766 ;; - Add these values to the `ps-font-info-database':
767 ;; (setq ps-font-info-database
769 ;; '((Helvetica ; the family key
770 ;; (fonts (normal . "Helvetica")
771 ;; (bold . "Helvetica-Bold")
772 ;; (italic . "Helvetica-Oblique")
773 ;; (bold-italic . "Helvetica-BoldOblique"))
775 ;; (line-height . 11.56)
776 ;; (space-width . 2.78)
777 ;; (avg-char-width . 5.09243)))
778 ;; ps-font-info-database))
779 ;; - Now you can use this font family with any size:
780 ;; (setq ps-font-family 'Helvetica)
781 ;; - if you want to use this family in another emacs session, you must
782 ;; put into your `~/.emacs':
783 ;; (require 'ps-print)
784 ;; (setq ps-font-info-database (append ...)))
785 ;; if you don't want to load ps-print, you have to copy the whole value:
786 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
787 ;; or, use `ps-print-hook' (see section Hooks):
788 ;; (add-hook 'ps-print-hook
790 ;; (or (assq 'Helvetica ps-font-info-database)
791 ;; (setq ps-font-info-database (append ...)))))
793 ;; You can create new `mixed' font families like:
795 ;; (fonts (normal . "Courier-Bold")
796 ;; (bold . "Helvetica")
797 ;; (italic . "Zapf-Chancery-MediumItalic")
798 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
799 ;; (w3-table-hack-x-face . "LineDrawNormal"))
801 ;; (line-height . 10.55)
802 ;; (space-width . 6.0)
803 ;; (avg-char-width . 6.0))
805 ;; Now you can use your new font family with any size:
806 ;; (setq ps-font-family 'my-mixed-family)
808 ;; Note that on above example the `w3-table-hack-x-face' entry refers to
809 ;; a face symbol, so when printing this face it'll be used the font
810 ;; `LineDrawNormal'. If the face `w3-table-hack-x-face' is remapped to
811 ;; use bold and/or italic attribute, the corresponding entry (bold, italic
812 ;; or bold-italic) will be used instead of `w3-table-hack-x-face' entry.
814 ;; Note also that the font family entry order is irrelevant, so the above
815 ;; example could also be written:
818 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
819 ;; (bold . "Helvetica")
820 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
821 ;; (italic . "Zapf-Chancery-MediumItalic")
822 ;; (normal . "Courier-Bold"))
823 ;; (avg-char-width . 6.0)
824 ;; (space-width . 6.0)
825 ;; (line-height . 10.55))
827 ;; Despite the note above, it is recommended that some convention about
828 ;; entry order be used.
830 ;; You can get information on all the fonts resident in YOUR printer
831 ;; by uncommenting the line:
832 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
834 ;; The PostScript file should be sent to YOUR PostScript printer.
835 ;; If you send it to ghostscript or to another PostScript printer,
836 ;; you may get slightly different results.
837 ;; Anyway, as ghostscript fonts are autoload, you won't get
841 ;; How Ps-Print Deals With Faces
842 ;; -----------------------------
844 ;; The ps-print-*-with-faces commands attempt to determine which faces
845 ;; should be printed in bold or italic, but their guesses aren't
846 ;; always right. For example, you might want to map colors into faces
847 ;; so that blue faces print in bold, and red faces in italic.
849 ;; It is possible to force ps-print to consider specific faces bold,
850 ;; italic or underline, no matter what font they are displayed in, by setting
851 ;; the variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
852 ;; These variables contain lists of faces that ps-print should consider bold,
853 ;; italic or underline; to set them, put code like the following into your
856 ;; (setq ps-bold-faces '(my-blue-face))
857 ;; (setq ps-italic-faces '(my-red-face))
858 ;; (setq ps-underlined-faces '(my-green-face))
860 ;; Faces like bold-italic that are both bold and italic should go in
863 ;; ps-print keeps internal lists of which fonts are bold and which are
864 ;; italic; these lists are built the first time you invoke ps-print.
865 ;; For the sake of efficiency, the lists are built only once; the same
866 ;; lists are referred in later invocations of ps-print.
868 ;; Because these lists are built only once, it's possible for them to
869 ;; get out of sync, if a face changes, or if new faces are added. To
870 ;; get the lists back in sync, you can set the variable
871 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
872 ;; next time ps-print is invoked. If you need that the lists always be
873 ;; rebuilt when ps-print is invoked, set the variable
874 ;; `ps-always-build-face-reference' to t.
876 ;; If you need to print without worrying about face background color, set the
877 ;; variable `ps-use-face-background' which specifies if face background should
878 ;; be used. Valid values are:
880 ;; t always use face background color.
881 ;; nil never use face background color.
882 ;; (face...) list of faces whose background color will be used.
884 ;; Any other value will be treated as t.
885 ;; The default value is t.
888 ;; How Ps-Print Deals With Color
889 ;; -----------------------------
891 ;; ps-print detects faces with foreground and background colors
892 ;; defined and embeds color information in the PostScript image.
893 ;; The default foreground and background colors are defined by the
894 ;; variables `ps-default-fg' and `ps-default-bg'.
895 ;; On black-and-white printers, colors are displayed in gray scale.
896 ;; To turn off color output, set `ps-print-color-p' to nil.
899 ;; How Ps-Print Maps Faces
900 ;; -----------------------
902 ;; As ps-print uses PostScript to print buffers, it is possible to have
903 ;; other attributes associated with faces. So the new attributes used
906 ;; strikeout - like underline, but the line is in middle of text.
907 ;; overline - like underline, but the line is over the text.
908 ;; shadow - text will have a shadow.
909 ;; box - text will be surrounded by a box.
910 ;; outline - print characters as hollow outlines.
912 ;; See the documentation for `ps-extend-face'.
914 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
915 ;; color and bold attribute:
917 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
919 ;; If you want to use a new face, define it first with `defface',
920 ;; and then call `ps-extend-face' to specify how to print it.
923 ;; How Ps-Print Has A Text And/Or Image On Background
924 ;; --------------------------------------------------
926 ;; ps-print can print texts and/or EPS PostScript images on background; it is
927 ;; possible to define the following text attributes: font name, font size,
928 ;; initial position, angle, gray scale and pages to print.
930 ;; It has the following EPS PostScript images attributes: file name containing
931 ;; the image, initial position, X and Y scales, angle and pages to print.
933 ;; See documentation for `ps-print-background-text' and
934 ;; `ps-print-background-image'.
936 ;; For example, if we wish to print text "preliminary" on all pages and text
937 ;; "special" on page 5 and from page 11 to page 17, we could specify:
939 ;; (setq ps-print-background-text
942 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
943 ;; ; (upper left corner)
945 ;; "PrintHeight neg PrintPageWidth atan" ; angle
946 ;; 5 (11 . 17)) ; page list
949 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
950 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
953 ;; (setq ps-print-background-image
954 ;; '(("~/images/EPS-image1.ps"
955 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
956 ;; ("~/images/EPS-image2.ps"
957 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y position
958 ;; ; (upper left corner)
960 ;; 5 (11 . 17)) ; page list
963 ;; If it is not possible to read (or does not exist) an image file, that file
966 ;; The printing order is:
968 ;; 1. Print background color
969 ;; 2. Print zebra stripes
970 ;; 3. Print background texts that it should be on all pages
971 ;; 4. Print background images that it should be on all pages
972 ;; 5. Print background texts only for current page (if any)
973 ;; 6. Print background images only for current page (if any)
975 ;; 8. Print buffer text (with faces, if specified) and line number
981 ;; Some tools are provided to help you customize your font setup.
983 ;; `ps-setup' returns (some part of) the current setup.
985 ;; To avoid wrapping too many lines, you may want to adjust the
986 ;; left and right margins and the font size. On UN*X systems, do:
987 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
988 ;; to determine the longest lines of your file.
989 ;; Then, the command `ps-line-lengths' will give you the correspondence
990 ;; between a line length (number of characters) and the maximum font
991 ;; size which doesn't wrap such a line with the current ps-print setup.
993 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
994 ;; the correspondence between a number of pages and the maximum font
995 ;; size which allow the number of lines of the current buffer or of
996 ;; its current region to fit in this number of pages.
998 ;; NOTE: line folding is not taken into account in this process and could
999 ;; change the results.
1001 ;; The command `ps-print-customize' activates a customization buffer for
1002 ;; ps-print options.
1005 ;; New since version 1.5
1006 ;; ---------------------
1008 ;; Color output capability.
1009 ;; Automatic detection of font attributes (bold, italic).
1010 ;; Configurable headers with page numbers.
1012 ;; Support for different paper sizes.
1013 ;; Better conformance to PostScript Document Structure Conventions.
1016 ;; New since version 2.8
1017 ;; ---------------------
1019 ;; [vinicius] 20000310 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1021 ;; PostScript error handler.
1022 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1024 ;; [vinicius] 991211 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1026 ;; `ps-print-customize'.
1028 ;; [vinicius] 990703 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1030 ;; Better customization.
1031 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1033 ;; [vinicius] 990513 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1036 ;; Hook: `ps-print-begin-sheet-hook'.
1038 ;; [keinichi] 990509 Kein'ichi Handa <handa@etl.go.jp>
1040 ;; `ps-print-region-function'
1042 ;; [vinicius] 990301 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1044 ;; PostScript tumble and setpagedevice.
1046 ;; [vinicius] 980922 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1048 ;; PostScript prologue header comment insertion.
1049 ;; Skip invisible text better.
1051 ;; [keinichi] 980819 Kein'ichi Handa <handa@etl.go.jp>
1053 ;; Multi-byte buffer handling.
1055 ;; [vinicius] 980306 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1057 ;; Skip invisible text.
1059 ;; [vinicius] 971130 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1061 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1062 ;; `ps-print-begin-column-hook'.
1063 ;; Put one header per page over the columns.
1064 ;; Better database font management.
1065 ;; Better control characters handling.
1067 ;; [vinicius] 971121 Vinicius Jose Latorre <vinicius@cpqd.com.br>
1069 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1070 ;; Handle control characters.
1072 ;; New face attributes.
1075 ;; Text and/or image on background.
1077 ;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
1079 ;; Font family and float size for text and header.
1081 ;; Multiple columns.
1082 ;; Tools for page setup.
1085 ;; Known bugs and limitations of ps-print
1086 ;; --------------------------------------
1088 ;; Although color printing will work in XEmacs 19.12, it doesn't work
1089 ;; well; in particular, bold or italic fonts don't print in the right
1090 ;; background color.
1092 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1094 ;; Automatic font-attribute detection doesn't work well, especially
1095 ;; with hilit19 and older versions of get-create-face. Users having
1096 ;; problems with auto-font detection should use the lists
1097 ;; `ps-italic-faces', `ps-bold-faces' and `ps-underlined-faces' and/or
1098 ;; turn off automatic detection by setting `ps-auto-font-detect' to nil.
1100 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
1101 ;; in tty mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1102 ;; `ps-underlined-faces' instead.
1104 ;; Still too slow; could use some hand-optimization.
1106 ;; Default background color isn't working.
1108 ;; Faces are always treated as opaque.
1110 ;; Epoch and Emacs 19 not supported. At all.
1112 ;; Fixed-pitch fonts work better for line folding, but are not required.
1114 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
1115 ;; of folding lines.
1121 ;; Avoid page break inside a paragraph.
1122 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1123 ;; Improve the memory management for big files (hard?).
1124 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
1125 ;; of folding lines.
1131 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1132 ;; suggestion for `ps-postscript-code-directory' variable.
1134 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1135 ;; level 1 compatibility.
1137 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for upside-down
1138 ;; and line number step suggestions.
1140 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1141 ;; prologue code suggestion.
1143 ;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
1145 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1148 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1151 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1152 ;; `ps-print-control-characters' variable documentation.
1154 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1155 ;; database font management.
1157 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1158 ;; header per page over the columns and correct line numbers when printing a
1161 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1162 ;; print time of `ps-lpr-switches'.
1164 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1165 ;; (his code was severely modified, but the main idea was kept).
1167 ;; Thanks to some suggestions on:
1168 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1169 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1170 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1172 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
1173 ;; I started from. [vinicius]
1175 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
1178 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
1179 ;; color and the invisible property.
1181 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
1182 ;; the initial port to Emacs 19. His code is no longer part of
1183 ;; ps-print, but his work is still appreciated.
1185 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
1186 ;; for adding underline support. Their code also is no longer part of
1187 ;; ps-print, but their efforts are not forgotten.
1189 ;; Thanks also to all of you who mailed code to add features to
1190 ;; ps-print; although I didn't use your code, I still appreciate your
1191 ;; sharing it with me.
1193 ;; Thanks to all who mailed comments, encouragement, and criticism.
1194 ;; Thanks also to all who responded to my survey; I had too many
1195 ;; responses to reply to them all, but I greatly appreciate your
1199 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1203 (unless (featurep 'lisp-float-type)
1204 (error "`ps-print' requires floating point support"))
1207 ;; For Emacs 20.2 and the earlier version.
1209 (or (fboundp 'set-buffer-multibyte)
1210 (defun set-buffer-multibyte (arg)
1211 (setq enable-multibyte-characters arg)))
1213 (or (fboundp 'string-as-unibyte)
1214 (defun string-as-unibyte (arg) arg))
1216 (or (fboundp 'string-as-multibyte)
1217 (defun string-as-multibyte (arg) arg))
1219 (or (fboundp 'charset-after)
1220 (defun charset-after (&optional arg)
1221 (char-charset (char-after arg))))
1224 (or (fboundp 'line-beginning-position)
1225 (defun line-beginning-position (&optional n)
1227 (and n (/= n 1) (forward-line (1- n)))
1232 (defconst ps-windows-system
1233 (memq system-type '(win32 w32 mswindows ms-dos windows-nt)))
1234 (defconst ps-lp-system
1235 (memq system-type '(usq-unix-v dgux hpux irix)))
1238 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1242 ;;; Interface to the command system
1244 (defgroup postscript nil
1249 (defgroup ps-print nil
1250 "PostScript generator for Emacs 19"
1255 (defgroup ps-print-horizontal nil
1256 "Horizontal page layout"
1261 (defgroup ps-print-vertical nil
1262 "Vertical page layout"
1267 (defgroup ps-print-headers nil
1273 (defgroup ps-print-font nil
1274 "Fonts customization"
1279 (defgroup ps-print-color nil
1280 "Color customization"
1285 (defgroup ps-print-face nil
1286 "Faces customization"
1292 (defgroup ps-print-n-up nil
1293 "N-up customization"
1298 (defgroup ps-print-zebra nil
1299 "Zebra customization"
1304 (defgroup ps-print-background nil
1305 "Background customization"
1310 (defgroup ps-print-printer nil
1311 "Printer customization"
1316 (defgroup ps-print-page nil
1317 "Page customization"
1322 (defgroup ps-print-miscellany nil
1323 "Miscellany customization"
1329 (defcustom ps-error-handler-message 'paper
1330 "*Specify where the error handler message should be sent.
1334 `none' catch the error and *DON'T* send any message.
1336 `paper' catch the error and print on paper the error message.
1338 `system' catch the error and send back the error message to
1339 printing system. This is useful only if printing system
1340 send back an email reporting the error, or if there is
1341 some other alternative way to report back the error from
1344 `paper-and-system' catch the error, print on paper the error message and
1345 send back the error message to printing system.
1347 Any other value is treated as `paper'."
1348 :type '(choice :tag "Error Handler Message"
1349 (const none) (const paper)
1350 (const system) (const paper-and-system))
1351 :group 'ps-print-miscellany)
1353 (defcustom ps-user-defined-prologue nil
1354 "*User defined PostScript prologue code inserted before all prologue code.
1356 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1357 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1358 prologue comments, and before ps-print PostScript prologue code section. That
1359 is, this string is inserted after error handler initialization and before
1362 It's recommended to initiate and terminate the string with \"\\n\".
1364 It's strongly recommended only insert PostScript code and/or comments specific
1365 for your printing system particularities. For example, some special
1366 initialization that only your printing system needs.
1368 Do not insert code for duplex printing, n-up printing or error handler, ps-print
1369 handles this in a suitable way.
1371 For more information about PostScript, see:
1372 PostScript Language Reference Manual (2nd edition)
1373 Adobe Systems Incorporated"
1374 :type '(choice :tag "User Defined Prologue"
1375 (const :tag "none" nil) string symbol)
1376 :group 'ps-print-miscellany)
1378 (defcustom ps-print-prologue-header nil
1379 "*PostScript prologue header comments besides that ps-print generates.
1381 `ps-print-prologue-header' may be a string or a symbol function which
1382 returns a string. Note that this string is inserted on PostScript prologue
1383 header section which is used to define some document characteristic through
1384 PostScript special comments, like \"%%Requirements: jog\\n\".
1386 ps-print always inserts the %%Requirements: comment, so if you need to insert
1387 more requirements put them first in `ps-print-prologue-header' using the
1388 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1389 requirements and set %%LanguageLevel: to 2, do:
1391 (setq ps-print-prologue-header
1392 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1394 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1396 Do not forget to terminate the string with \"\\n\".
1398 For more information about PostScript document comments, see:
1399 PostScript Language Reference Manual (2nd edition)
1400 Adobe Systems Incorporated
1401 Appendix G: Document Structuring Conventions -- Version 3.0"
1402 :type '(choice :tag "Prologue Header"
1403 (const :tag "none" nil) string symbol)
1404 :group 'ps-print-miscellany)
1406 (defcustom ps-printer-name (and (boundp 'printer-name)
1408 "*The name of a local printer for printing PostScript files.
1410 On Unix-like systems, a string value should be a name understood by
1411 lpr's -P option; a value of nil means use the value of `printer-name'
1412 instead. Any other value will be ignored.
1414 On MS-DOS and MS-Windows systems, a string value is taken as the name of
1415 the printer device or port to which PostScript files are written,
1416 provided `ps-lpr-command' is \"\". By default it is the same as
1417 `printer-name'; typical non-default settings would be \"LPT1\" to
1418 \"LPT3\" for parallel printers, or \"COM1\" to \"COM4\" or \"AUX\" for
1419 serial printers, or \"//hostname/printer\" for a shared network printer.
1420 You can also set it to a name of a file, in which case the output gets
1421 appended to that file. \(Note that `ps-print' package already has
1422 facilities for printing to a file, so you might as well use them instead
1423 of changing the setting of this variable.\) If you want to silently
1424 discard the printed output, set this to \"NUL\"."
1425 :type '(choice :tag "Printer Name"
1426 (file :tag "Print to file")
1427 (string :tag "Pipe to ps-lpr-command")
1428 (const :tag "Same as printer-name" nil))
1429 :group 'ps-print-printer)
1431 (defcustom ps-lpr-command lpr-command
1432 "*Name of program for printing a PostScript file.
1434 On MS-DOS and MS-Windows systems, if the value is an empty string then
1435 Emacs will write directly to the printer port named by `ps-printer-name'.
1436 The programs `print' and `nprint' (the standard print programs on Windows
1437 NT and Novell Netware respectively) are handled specially, using
1438 `ps-printer-name' as the destination for output; any other program is
1439 treated like `lpr' except that an explicit filename is given as the last
1442 :group 'ps-print-printer)
1444 (defcustom ps-lpr-switches lpr-switches
1445 "*A list of extra switches to pass to `ps-lpr-command'."
1446 :type '(repeat :tag "PostScript lpr Switches"
1447 (choice string symbol (repeat sexp)))
1448 :group 'ps-print-printer)
1450 (defcustom ps-print-region-function nil
1451 "*Specify a function to print the region on a PostScript printer.
1452 See definition of `call-process-region' for calling conventions. The fourth and
1453 the sixth arguments are both nil."
1455 :group 'ps-print-printer)
1459 ;; All page dimensions are in PostScript points.
1460 ;; 1 inch == 2.54 cm == 72 points
1461 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1463 ;; Letter 8.5 inch x 11.0 inch
1464 ;; Legal 8.5 inch x 14.0 inch
1465 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1467 ;; LetterSmall 7.68 inch x 10.16 inch
1468 ;; Tabloid 11.0 inch x 17.0 inch
1469 ;; Ledger 17.0 inch x 11.0 inch
1470 ;; Statement 5.5 inch x 8.5 inch
1471 ;; Executive 7.5 inch x 10.0 inch
1472 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1473 ;; A4Small 7.47 inch x 10.85 inch
1474 ;; B4 10.125 inch x 14.33 inch
1475 ;; B5 7.16 inch x 10.125 inch
1477 (defcustom ps-page-dimensions-database
1478 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1479 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1480 (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
1481 (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
1482 (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
1483 (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
1484 (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
1485 (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
1486 (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
1487 (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
1488 (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
1489 (list 'b5 (* 72 7.16) (* 72 10.125) "B5"))
1490 "*List associating a symbolic paper type to its width, height and doc media.
1491 See `ps-paper-type'."
1492 :type '(repeat (list :tag "Paper Type"
1493 (symbol :tag "Name")
1494 (number :tag "Width")
1495 (number :tag "Height")
1496 (string :tag "Media")))
1497 :group 'ps-print-page)
1500 (defcustom ps-paper-type 'letter
1501 "*Specify the size of paper to format for.
1502 Should be one of the paper types defined in `ps-page-dimensions-database', for
1503 example `letter', `legal' or `a4'."
1504 :type '(symbol :validate (lambda (wid)
1505 (if (assq (widget-value wid)
1506 ps-page-dimensions-database)
1508 (widget-put wid :error "Unknown paper size")
1510 :group 'ps-print-page)
1512 (defcustom ps-landscape-mode nil
1513 "*Non-nil means print in landscape mode."
1515 :group 'ps-print-page)
1517 (defcustom ps-print-upside-down nil
1518 "*Non-nil means print upside-down."
1520 :group 'ps-print-page)
1522 (defcustom ps-print-control-characters 'control-8-bit
1523 "*Specify the printable form for control and 8-bit characters.
1524 That is, instead of sending, for example, a ^D (\\004) to printer,
1525 it is sent the string \"^D\".
1529 `8-bit' This is the value to use when you want an ASCII encoding of
1530 any control or non-ASCII character. Control characters are
1531 encoded as \"^D\", and non-ASCII characters have an
1534 `control-8-bit' This is the value to use when you want an ASCII encoding of
1535 any control character, whether it is 7 or 8-bit.
1536 European 8-bits accented characters are printed according
1539 `control' Only ASCII control characters have an ASCII encoding.
1540 European 8-bits accented characters are printed according
1543 nil No ASCII encoding. Any character is printed according the
1546 Any other value is treated as nil."
1547 :type '(choice :tag "Control Char"
1548 (const 8-bit) (const control-8-bit)
1549 (const control) (const :tag "nil" nil))
1550 :group 'ps-print-miscellany)
1552 (defcustom ps-n-up-printing 1
1553 "*Specify the number of pages per sheet paper."
1555 :tag "N Up Printing"
1558 (if (and (< 0 (widget-value wid))
1559 (<= (widget-value wid) 100))
1563 "Number of pages per sheet paper must be between 1 and 100.")
1565 :group 'ps-print-n-up)
1567 (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
1568 "*Specify the margin in points between the sheet border and n-up printing."
1570 :group 'ps-print-n-up)
1572 (defcustom ps-n-up-border-p t
1573 "*Non-nil means a border is drawn around each page."
1575 :group 'ps-print-n-up)
1577 (defcustom ps-n-up-filling 'left-top
1578 "*Specify how page matrix is filled on each sheet of paper.
1580 Following are the valid values for `ps-n-up-filling' with a filling example
1581 using a 3x4 page matrix:
1583 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
1587 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
1591 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
1595 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
1599 Any other value is treated as `left-top'."
1600 :type '(choice :tag "N-Up Filling"
1601 (const left-top) (const left-bottom)
1602 (const right-top) (const right-bottom)
1603 (const top-left) (const bottom-left)
1604 (const top-right) (const bottom-right))
1605 :group 'ps-print-n-up)
1607 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
1608 "*Specify the number of columns"
1610 :group 'ps-print-miscellany)
1612 (defcustom ps-zebra-stripes nil
1613 "*Non-nil means print zebra stripes.
1614 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
1616 :group 'ps-print-zebra)
1618 (defcustom ps-zebra-stripe-height 3
1619 "*Number of zebra stripe lines.
1620 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
1622 :group 'ps-print-zebra)
1624 (defcustom ps-zebra-color 0.95
1625 "*Zebra stripe gray scale or RGB color.
1626 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
1627 :type '(choice :tag "Zebra Gray/Color"
1628 (number :tag "Gray Scale" :value 0.95)
1629 (string :tag "Color Name" :value "gray95")
1630 (list :tag "RGB Color" :value (0.95 0.95 0.95)
1632 (number :tag "Green")
1633 (number :tag "Blue")))
1634 :group 'ps-print-zebra)
1636 (defcustom ps-line-number nil
1637 "*Non-nil means print line number."
1639 :group 'ps-print-miscellany)
1641 (defcustom ps-line-number-step 1
1642 "*Specify the interval that line number is printed.
1644 For example, `ps-line-number-step' is set to 2, the printing will look like:
1656 integer an integer that specifies the interval that line number is
1657 printed. If it's lesser than or equal to zero, it's used the
1660 `zebra' specifies that only the line number of the first line in a zebra
1661 stripe is to be printed.
1663 Any other value is treated as `zebra'."
1664 :type '(choice :tag "Line Number Step"
1665 (integer :tag "Step Interval")
1666 (const :tag "Synchronize Zebra" zebra))
1667 :group 'ps-print-miscellany)
1669 (defcustom ps-line-number-start 1
1670 "*Specify the starting point in the interval given by `ps-line-number-step'.
1672 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3, the
1673 printing will look like:
1687 The values for `ps-line-number-start':
1689 * If `ps-line-number-step' is an integer, must be between 1 and the value
1690 of `ps-line-number-step' inclusive.
1692 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
1693 value of `ps-zebra-strip-height' inclusive. Use this combination if you
1694 wish that line number be relative to zebra stripes."
1695 :type '(integer :tag "Start Step Interval")
1696 :group 'ps-print-miscellany)
1698 (defcustom ps-print-background-image nil
1699 "*EPS image list to be printed on background.
1703 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
1705 FILENAME is a file name which contains an EPS image or some PostScript
1706 programming like EPS.
1707 FILENAME is ignored, if it doesn't exist or is read protected.
1709 X and Y are relative positions on paper to put the image.
1710 If X and Y are nil, the image is centralized on paper.
1712 XSCALE and YSCALE are scale factor to be applied to image before printing.
1713 If XSCALE and YSCALE are nil, the original size is used.
1715 ROTATION is the image rotation angle; if nil, the default is 0.
1717 PAGES designates the page to print background image.
1718 PAGES may be a number or a cons cell (FROM . TO) designating FROM page
1720 If PAGES is nil, print background image on all pages.
1722 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number,
1723 an integer number or a string. If it is a string, the string should contain
1724 PostScript programming that returns a float or integer value.
1726 For example, if you wish to print an EPS image on all pages do:
1728 '((\"~/images/EPS-image.ps\"))"
1731 (file :tag "EPS File")
1732 (choice :tag "X" (const :tag "default" nil) number string)
1733 (choice :tag "Y" (const :tag "default" nil) number string)
1734 (choice :tag "X Scale" (const :tag "default" nil) number string)
1735 (choice :tag "Y Scale" (const :tag "default" nil) number string)
1736 (choice :tag "Rotation" (const :tag "default" nil) number string)
1737 (repeat :tag "Pages" :inline t
1738 (radio (integer :tag "Page")
1740 (integer :tag "From")
1741 (integer :tag "To"))))))
1742 :group 'ps-print-background)
1744 (defcustom ps-print-background-text nil
1745 "*Text list to be printed on background.
1749 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
1751 STRING is the text to be printed on background.
1753 X and Y are positions on paper to put the text.
1754 If X and Y are nil, the text is positioned at lower left corner.
1756 FONT is a font name to be used on printing the text.
1757 If nil, \"Times-Roman\" is used.
1759 FONTSIZE is font size to be used, if nil, 200 is used.
1761 GRAY is the text gray factor (should be very light like 0.8).
1762 If nil, the default is 0.85.
1764 ROTATION is the text rotation angle; if nil, the angle is given by
1765 the diagonal from lower left corner to upper right corner.
1767 PAGES designates the page to print background text.
1768 PAGES may be a number or a cons cell (FROM . TO) designating FROM page
1770 If PAGES is nil, print background text on all pages.
1772 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number,
1773 an integer number or a string. If it is a string, the string should contain
1774 PostScript programming that returns a float or integer value.
1776 For example, if you wish to print text \"Preliminary\" on all pages do:
1778 '((\"Preliminary\"))"
1781 (string :tag "Text")
1782 (choice :tag "X" (const :tag "default" nil) number string)
1783 (choice :tag "Y" (const :tag "default" nil) number string)
1784 (choice :tag "Font" (const :tag "default" nil) string)
1785 (choice :tag "Fontsize" (const :tag "default" nil) number string)
1786 (choice :tag "Gray" (const :tag "default" nil) number string)
1787 (choice :tag "Rotation" (const :tag "default" nil) number string)
1788 (repeat :tag "Pages" :inline t
1789 (radio (integer :tag "Page")
1791 (integer :tag "From")
1792 (integer :tag "To"))))))
1793 :group 'ps-print-background)
1795 ;;; Horizontal layout
1797 ;; ------------------------------------------
1799 ;; | lm | text | ic | text | ic | text | rm |
1801 ;; ------------------------------------------
1803 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
1804 "*Left margin in points (1/72 inch)."
1806 :group 'ps-print-horizontal)
1808 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
1809 "*Right margin in points (1/72 inch)."
1811 :group 'ps-print-horizontal)
1813 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
1814 "*Horizontal space between columns in points (1/72 inch)."
1816 :group 'ps-print-horizontal)
1832 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
1833 "*Bottom margin in points (1/72 inch)."
1835 :group 'ps-print-vertical)
1837 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
1838 "*Top margin in points (1/72 inch)."
1840 :group 'ps-print-vertical)
1842 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
1843 "*Vertical space in points (1/72 inch) between the main text and the header."
1845 :group 'ps-print-vertical)
1847 (defcustom ps-header-line-pad 0.15
1848 "*Portion of a header title line height to insert between the header frame
1849 and the text it contains, both in the vertical and horizontal directions."
1851 :group 'ps-print-vertical)
1855 (defcustom ps-print-header t
1856 "*Non-nil means print a header at the top of each page.
1857 By default, the header displays the buffer name, page number, and, if
1858 the buffer is visiting a file, the file's directory. Headers are
1859 customizable by changing variables `ps-left-header' and
1862 :group 'ps-print-headers)
1864 (defcustom ps-print-only-one-header nil
1865 "*Non-nil means print only one header at the top of each page.
1866 This is useful when printing more than one column, so it is possible
1867 to have only one header over all columns or one header per column.
1868 See also `ps-print-header'."
1870 :group 'ps-print-headers)
1872 (defcustom ps-print-header-frame t
1873 "*Non-nil means draw a gaudy frame around the header."
1875 :group 'ps-print-headers)
1877 (defcustom ps-header-lines 2
1878 "*Number of lines to display in page header, when generating PostScript."
1880 :group 'ps-print-headers)
1882 (defcustom ps-show-n-of-n t
1883 "*Non-nil means show page numbers as N/M, meaning page N of M.
1884 NOTE: page numbers are displayed as part of headers,
1885 see variable `ps-print-header'."
1887 :group 'ps-print-headers)
1889 (defcustom ps-spool-config
1890 (if ps-windows-system
1893 "*Specify who is responsable for setting duplex and page size switches.
1897 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
1898 Don't forget to set `ps-lpr-switches' to select duplex
1899 printing for your printer.
1901 `setpagedevice' duplex and page size are configured by ps-print using the
1902 setpagedevice PostScript operator.
1904 nil duplex and page size are configured by ps-print *not* using
1905 the setpagedevice PostScript operator.
1907 Any other value is treated as nil.
1909 WARNING: The setpagedevice PostScript operator affects ghostview utility when
1910 viewing file generated using landscape. Also on some printers,
1911 setpagedevice affects zebra stripes; on other printers, setpagedevice
1912 affects the left margin.
1913 Besides all that, if your printer does not have the paper size
1914 specified by setpagedevice, your printing will be aborted.
1915 So, if you need to use setpagedevice, set `ps-spool-config' to
1916 `setpagedevice', generate a test file and send it to your printer; if
1917 the printed file isn't ok, set `ps-spool-config' to nil."
1918 :type '(choice :tag "Spool Config"
1919 (const lpr-switches) (const setpagedevice)
1920 (const :tag "nil" nil))
1921 :group 'ps-print-headers)
1923 (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
1924 ; so default to nil.
1925 "*Non-nil generates PostScript for a two-sided printer.
1926 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
1927 blank pages as needed between print jobs so that the next buffer printed will
1928 start on the right page. Also, if headers are turned on, the headers will be
1929 reversed on duplex printers so that the page numbers fall to the left on
1930 even-numbered pages.
1932 See also `ps-spool-tumble'."
1934 :group 'ps-print-headers)
1936 (defcustom ps-spool-tumble nil
1937 "*Specify how the page images on opposite sides of a sheet are oriented.
1938 If `ps-spool-tumble' is nil, produces output suitable for binding on the left or
1939 right. If `ps-spool-tumble' is non-nil, produces output suitable for binding at
1942 It has effect only when `ps-spool-duplex' is non-nil."
1944 :group 'ps-print-headers)
1948 (defcustom ps-font-info-database
1949 '((Courier ; the family key
1950 (fonts (normal . "Courier")
1951 (bold . "Courier-Bold")
1952 (italic . "Courier-Oblique")
1953 (bold-italic . "Courier-BoldOblique"))
1955 (line-height . 10.55)
1957 (avg-char-width . 6.0))
1958 (Helvetica ; the family key
1959 (fonts (normal . "Helvetica")
1960 (bold . "Helvetica-Bold")
1961 (italic . "Helvetica-Oblique")
1962 (bold-italic . "Helvetica-BoldOblique"))
1964 (line-height . 11.56)
1965 (space-width . 2.78)
1966 (avg-char-width . 5.09243))
1968 (fonts (normal . "Times-Roman")
1969 (bold . "Times-Bold")
1970 (italic . "Times-Italic")
1971 (bold-italic . "Times-BoldItalic"))
1973 (line-height . 11.0)
1975 (avg-char-width . 4.71432))
1977 (fonts (normal . "Palatino-Roman")
1978 (bold . "Palatino-Bold")
1979 (italic . "Palatino-Italic")
1980 (bold-italic . "Palatino-BoldItalic"))
1982 (line-height . 12.1)
1984 (avg-char-width . 5.08676))
1986 (fonts (normal . "Helvetica-Narrow")
1987 (bold . "Helvetica-Narrow-Bold")
1988 (italic . "Helvetica-Narrow-Oblique")
1989 (bold-italic . "Helvetica-Narrow-BoldOblique"))
1991 (line-height . 11.56)
1992 (space-width . 2.2796)
1993 (avg-char-width . 4.17579))
1995 (fonts (normal . "NewCenturySchlbk-Roman")
1996 (bold . "NewCenturySchlbk-Bold")
1997 (italic . "NewCenturySchlbk-Italic")
1998 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2000 (line-height . 12.15)
2001 (space-width . 2.78)
2002 (avg-char-width . 5.31162))
2003 ;; got no bold for the next ones
2005 (fonts (normal . "AvantGarde-Book")
2006 (italic . "AvantGarde-BookOblique"))
2008 (line-height . 11.77)
2009 (space-width . 2.77)
2010 (avg-char-width . 5.45189))
2012 (fonts (normal . "AvantGarde-Demi")
2013 (italic . "AvantGarde-DemiOblique"))
2015 (line-height . 12.72)
2017 (avg-char-width . 5.51351))
2019 (fonts (normal . "Bookman-Demi")
2020 (italic . "Bookman-DemiItalic"))
2022 (line-height . 11.77)
2024 (avg-char-width . 6.05946))
2026 (fonts (normal . "Bookman-Light")
2027 (italic . "Bookman-LightItalic"))
2029 (line-height . 11.79)
2031 (avg-char-width . 5.67027))
2032 ;; got no bold and no italic for the next ones
2034 (fonts (normal . "Symbol"))
2036 (line-height . 13.03)
2038 (avg-char-width . 3.24324))
2040 (fonts (normal . "Zapf-Dingbats"))
2042 (line-height . 9.63)
2043 (space-width . 2.78)
2044 (avg-char-width . 2.78))
2045 (Zapf-Chancery-MediumItalic
2046 (fonts (normal . "Zapf-Chancery-MediumItalic"))
2048 (line-height . 11.45)
2050 (avg-char-width . 4.10811))
2052 "*Font info database: font family (the key), name, bold, italic, bold-italic,
2053 reference size, line height, space width, average character width.
2054 To get the info for another specific font (say Helvetica), do the following:
2055 - create a new buffer
2056 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2057 - open this file and delete the leading `%' (which is the PostScript
2058 comment character) from the line
2059 `% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage'
2061 `3 cm 20 cm moveto 10 /Helvetica ReportFontInfo showpage'
2062 - add the values to `ps-font-info-database'.
2063 You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
2064 :type '(repeat (list :tag "Font Definition"
2065 (symbol :tag "Font Family")
2067 (const :format "" fonts)
2068 (repeat :tag "Faces"
2069 (cons (choice (const normal)
2073 (symbol :tag "Face"))
2074 (string :tag "Font Name"))))
2076 (const :format "" size)
2077 (number :tag "Reference Size"))
2079 (const :format "" line-height)
2080 (number :tag "Line Height"))
2082 (const :format "" space-width)
2083 (number :tag "Space Width"))
2085 (const :format "" avg-char-width)
2086 (number :tag "Average Character Width"))))
2087 :group 'ps-print-font)
2089 (defcustom ps-font-family 'Courier
2090 "*Font family name for ordinary text, when generating PostScript."
2092 :group 'ps-print-font)
2094 (defcustom ps-font-size '(7 . 8.5)
2095 "*Font size, in points, for ordinary text, when generating PostScript."
2096 :type '(choice (number :tag "Text Size")
2097 (cons :tag "Landscape/Portrait"
2098 (number :tag "Landscape Text Size")
2099 (number :tag "Portrait Text Size")))
2100 :group 'ps-print-font)
2102 (defcustom ps-header-font-family 'Helvetica
2103 "*Font family name for text in the header, when generating PostScript."
2105 :group 'ps-print-font)
2107 (defcustom ps-header-font-size '(10 . 12)
2108 "*Font size, in points, for text in the header, when generating PostScript."
2109 :type '(choice (number :tag "Header Size")
2110 (cons :tag "Landscape/Portrait"
2111 (number :tag "Landscape Header Size")
2112 (number :tag "Portrait Header Size")))
2113 :group 'ps-print-font)
2115 (defcustom ps-header-title-font-size '(12 . 14)
2116 "*Font size, in points, for the top line of text in header, in PostScript."
2117 :type '(choice (number :tag "Header Title Size")
2118 (cons :tag "Landscape/Portrait"
2119 (number :tag "Landscape Header Title Size")
2120 (number :tag "Portrait Header Title Size")))
2121 :group 'ps-print-font)
2125 ;; Printing color requires x-color-values.
2126 (defcustom ps-print-color-p (or (fboundp 'x-color-values) ; Emacs
2127 (fboundp 'color-instance-rgb-components))
2129 "*Non-nil means print the buffer's text in color."
2131 :group 'ps-print-color)
2133 (defcustom ps-default-fg '(0.0 0.0 0.0)
2134 "*RGB values of the default foreground color. Defaults to black."
2135 :type '(choice :tag "Default Foreground Gray/Color"
2136 (number :tag "Gray Scale" :value 0.0)
2137 (string :tag "Color Name" :value "black")
2138 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2140 (number :tag "Green")
2141 (number :tag "Blue")))
2142 :group 'ps-print-color)
2144 (defcustom ps-default-bg '(1.0 1.0 1.0)
2145 "*RGB values of the default background color. Defaults to white."
2146 :type '(choice :tag "Default Background Gray/Color"
2147 (number :tag "Gray Scale" :value 1.0)
2148 (string :tag "Color Name" :value "white")
2149 (list :tag "RGB Color" :value (1.0 1.0 1.0)
2151 (number :tag "Green")
2152 (number :tag "Blue")))
2153 :group 'ps-print-color)
2155 (defcustom ps-auto-font-detect t
2156 "*Non-nil means automatically detect bold/italic face attributes.
2157 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces',
2158 and `ps-underlined-faces'."
2160 :group 'ps-print-font)
2162 (defcustom ps-bold-faces
2163 (unless ps-print-color-p
2164 '(font-lock-function-name-face
2165 font-lock-builtin-face
2166 font-lock-variable-name-face
2167 font-lock-keyword-face
2168 font-lock-warning-face))
2169 "*A list of the \(non-bold\) faces that should be printed in bold font.
2170 This applies to generating PostScript."
2171 :type '(repeat face)
2172 :group 'ps-print-face)
2174 (defcustom ps-italic-faces
2175 (unless ps-print-color-p
2176 '(font-lock-variable-name-face
2178 font-lock-string-face
2179 font-lock-comment-face
2180 font-lock-warning-face))
2181 "*A list of the \(non-italic\) faces that should be printed in italic font.
2182 This applies to generating PostScript."
2183 :type '(repeat face)
2184 :group 'ps-print-face)
2186 (defcustom ps-underlined-faces
2187 (unless ps-print-color-p
2188 '(font-lock-function-name-face
2189 font-lock-constant-face
2190 font-lock-warning-face))
2191 "*A list of the \(non-underlined\) faces that should be printed underlined.
2192 This applies to generating PostScript."
2193 :type '(repeat face)
2194 :group 'ps-print-face)
2196 (defcustom ps-use-face-background nil
2197 "*Specify if face background should be used.
2201 t always use face background color.
2202 nil never use face background color.
2203 (face...) list of faces whose background color will be used.
2205 Any other value will be treated as t."
2206 :type '(choice :tag "Use Face Background"
2207 (const :tag "Always Use Face Background" t)
2208 (const :tag "Never Use Face Background" nil)
2209 (repeat :menu-tag "Face Background List"
2210 :tag "Face Background List"
2212 :group 'ps-print-face)
2214 (defcustom ps-left-header
2215 (list 'ps-get-buffer-name 'ps-header-dirpart)
2216 "*The items to display (each on a line) on the left part of the page header.
2217 This applies to generating PostScript.
2219 The value should be a list of strings and symbols, each representing an
2220 entry in the PostScript array HeaderLinesLeft.
2222 Strings are inserted unchanged into the array; those representing
2223 PostScript string literals should be delimited with PostScript string
2224 delimiters '(' and ')'.
2226 For symbols with bound functions, the function is called and should
2227 return a string to be inserted into the array. For symbols with bound
2228 values, the value should be a string to be inserted into the array.
2229 In either case, function or variable, the string value has PostScript
2230 string delimiters added to it."
2231 :type '(repeat (choice string symbol))
2232 :group 'ps-print-headers)
2234 (defcustom ps-right-header
2235 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
2236 "*The items to display (each on a line) on the right part of the page header.
2237 This applies to generating PostScript.
2239 See the variable `ps-left-header' for a description of the format of
2241 :type '(repeat (choice string symbol))
2242 :group 'ps-print-headers)
2244 (defcustom ps-razzle-dazzle t
2245 "*Non-nil means report progress while formatting buffer."
2247 :group 'ps-print-miscellany)
2249 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
2250 "*Contains the header line identifying the output as PostScript.
2251 By default, `ps-adobe-tag' contains the standard identifier. Some
2252 printers require slightly different versions of this line."
2254 :group 'ps-print-miscellany)
2256 (defcustom ps-build-face-reference t
2257 "*Non-nil means build the reference face lists.
2259 ps-print sets this value to nil after it builds its internal reference
2260 lists of bold and italic faces. By settings its value back to t, you
2261 can force ps-print to rebuild the lists the next time you invoke one
2262 of the ...-with-faces commands.
2264 You should set this value back to t after you change the attributes of
2265 any face, or create new faces. Most users shouldn't have to worry
2266 about its setting, though."
2268 :group 'ps-print-face)
2270 (defcustom ps-always-build-face-reference nil
2271 "*Non-nil means always rebuild the reference face lists.
2273 If this variable is non-nil, ps-print will rebuild its internal
2274 reference lists of bold and italic faces *every* time one of the
2275 ...-with-faces commands is called. Most users shouldn't need to set this
2278 :group 'ps-print-face)
2280 (defcustom ps-banner-page-when-duplexing nil
2281 "*Non-nil means the very first page is skipped.
2282 It's like the very first character of buffer (or region) is ^L (\\014)."
2284 :group 'ps-print-headers)
2286 (defcustom ps-postscript-code-directory
2287 (or (and (fboundp 'locate-data-directory) ; xemacs
2288 (locate-data-directory "ps-print"))
2289 data-directory) ; emacs
2290 "*Directory where it's located the PostScript prologue file used by ps-print.
2291 By default, this directory is the same as in the variable `data-directory'."
2293 :group 'ps-print-miscellany)
2296 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2301 (defun ps-print-customize ()
2302 "Customization of ps-print group."
2304 (customize-group 'ps-print))
2307 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2312 (defun ps-print-buffer (&optional filename)
2313 "Generate and print a PostScript image of the buffer.
2315 Interactively, when you use a prefix argument (C-u), the command
2316 prompts the user for a file name, and saves the PostScript image
2317 in that file instead of sending it to the printer.
2319 Noninteractively, the argument FILENAME is treated as follows: if it
2320 is nil, send the image to the printer. If FILENAME is a string, save
2321 the PostScript image in a file with that name."
2322 (interactive (list (ps-print-preprint current-prefix-arg)))
2323 (ps-print-without-faces (point-min) (point-max) filename))
2327 (defun ps-print-buffer-with-faces (&optional filename)
2328 "Generate and print a PostScript image of the buffer.
2329 Like `ps-print-buffer', but includes font, color, and underline
2330 information in the generated image. This command works only if you
2331 are using a window system, so it has a way to determine color values."
2332 (interactive (list (ps-print-preprint current-prefix-arg)))
2333 (ps-print-with-faces (point-min) (point-max) filename))
2337 (defun ps-print-region (from to &optional filename)
2338 "Generate and print a PostScript image of the region.
2339 Like `ps-print-buffer', but prints just the current region."
2340 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
2341 (ps-print-without-faces from to filename t))
2345 (defun ps-print-region-with-faces (from to &optional filename)
2346 "Generate and print a PostScript image of the region.
2347 Like `ps-print-region', but includes font, color, and underline
2348 information in the generated image. This command works only if you
2349 are using a window system, so it has a way to determine color values."
2350 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
2351 (ps-print-with-faces from to filename t))
2355 (defun ps-spool-buffer ()
2356 "Generate and spool a PostScript image of the buffer.
2357 Like `ps-print-buffer' except that the PostScript image is saved in a
2358 local buffer to be sent to the printer later.
2360 Use the command `ps-despool' to send the spooled images to the printer."
2362 (ps-spool-without-faces (point-min) (point-max)))
2366 (defun ps-spool-buffer-with-faces ()
2367 "Generate and spool a PostScript image of the buffer.
2368 Like `ps-spool-buffer', but includes font, color, and underline
2369 information in the generated image. This command works only if you
2370 are using a window system, so it has a way to determine color values.
2372 Use the command `ps-despool' to send the spooled images to the printer."
2374 (ps-spool-with-faces (point-min) (point-max)))
2378 (defun ps-spool-region (from to)
2379 "Generate a PostScript image of the region and spool locally.
2380 Like `ps-spool-buffer', but spools just the current region.
2382 Use the command `ps-despool' to send the spooled images to the printer."
2384 (ps-spool-without-faces from to t))
2388 (defun ps-spool-region-with-faces (from to)
2389 "Generate a PostScript image of the region and spool locally.
2390 Like `ps-spool-region', but includes font, color, and underline
2391 information in the generated image. This command works only if you
2392 are using a window system, so it has a way to determine color values.
2394 Use the command `ps-despool' to send the spooled images to the printer."
2396 (ps-spool-with-faces from to t))
2399 (defun ps-despool (&optional filename)
2400 "Send the spooled PostScript to the printer.
2402 Interactively, when you use a prefix argument (C-u), the command
2403 prompts the user for a file name, and saves the spooled PostScript
2404 image in that file instead of sending it to the printer.
2406 Noninteractively, the argument FILENAME is treated as follows: if it
2407 is nil, send the image to the printer. If FILENAME is a string, save
2408 the PostScript image in a file with that name."
2409 (interactive (list (ps-print-preprint current-prefix-arg)))
2410 (ps-do-despool filename))
2413 (defun ps-line-lengths ()
2414 "Display the correspondence between a line length and a font size,
2415 using the current ps-print setup.
2416 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
2418 (ps-line-lengths-internal))
2421 (defun ps-nb-pages-buffer (nb-lines)
2422 "Display number of pages to print this buffer, for various font heights.
2423 The table depends on the current ps-print setup."
2424 (interactive (list (count-lines (point-min) (point-max))))
2425 (ps-nb-pages nb-lines))
2428 (defun ps-nb-pages-region (nb-lines)
2429 "Display number of pages to print the region, for various font heights.
2430 The table depends on the current ps-print setup."
2431 (interactive (list (count-lines (mark) (point))))
2432 (ps-nb-pages nb-lines))
2436 "Return the current PostScript-generation setup."
2439 \(setq ps-print-color-p %s
2443 ps-print-region-function %s
2446 ps-landscape-mode %s
2447 ps-print-upside-down %s
2448 ps-number-of-columns %s
2451 ps-zebra-stripe-height %s
2454 ps-line-number-step %s
2455 ps-line-number-start %S
2460 ps-use-face-background %s
2462 ps-print-control-characters %s
2464 ps-print-background-image %s
2466 ps-print-background-text %s
2468 ps-error-handler-message %s
2469 ps-user-defined-prologue %s
2470 ps-print-prologue-header %s
2478 ps-header-line-pad %s
2480 ps-print-only-one-header %s
2481 ps-print-header-frame %s
2487 ps-banner-page-when-duplexing %s
2494 ps-multibyte-buffer %s
2497 ps-header-font-family %s
2498 ps-header-font-size %s
2499 ps-header-title-font-size %s)
2503 (ps-print-quote ps-lpr-switches)
2505 (ps-print-quote ps-print-region-function)
2506 (ps-print-quote ps-paper-type)
2508 ps-print-upside-down
2509 ps-number-of-columns
2511 ps-zebra-stripe-height
2512 (ps-print-quote ps-zebra-color)
2514 (ps-print-quote ps-line-number-step)
2515 ps-line-number-start
2516 (ps-print-quote ps-default-fg)
2517 (ps-print-quote ps-default-bg)
2518 (ps-print-quote ps-use-face-background)
2519 (ps-print-quote ps-print-control-characters)
2520 (ps-print-quote ps-print-background-image)
2521 (ps-print-quote ps-print-background-text)
2522 (ps-print-quote ps-error-handler-message)
2523 (ps-print-quote ps-user-defined-prologue)
2524 (ps-print-quote ps-print-prologue-header)
2533 ps-print-only-one-header
2534 ps-print-header-frame
2537 (ps-print-quote ps-spool-config)
2540 ps-banner-page-when-duplexing
2544 (ps-print-quote ps-n-up-filling)
2545 (ps-print-quote ps-multibyte-buffer) ; see `ps-mule.el'
2546 (ps-print-quote ps-font-family)
2547 (ps-print-quote ps-font-size)
2548 (ps-print-quote ps-header-font-family)
2549 (ps-print-quote ps-header-font-size)
2550 (ps-print-quote ps-header-title-font-size)))
2553 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2554 ;; Utility functions and variables:
2557 (defun ps-print-quote (sym)
2560 ((or (symbolp sym) (listp sym))
2567 (defvar ps-print-emacs-type
2568 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
2569 ((string-match "Lucid" emacs-version) 'lucid)
2570 ((string-match "Epoch" emacs-version) 'epoch)
2573 (if (or (eq ps-print-emacs-type 'lucid)
2574 (eq ps-print-emacs-type 'xemacs))
2575 (if (< emacs-minor-version 12)
2576 (setq ps-print-color-p nil))
2577 (require 'faces)) ; face-font, face-underline-p,
2580 ;; Return t if the device (which can be changed during an emacs session)
2581 ;; can handle colors.
2582 ;; This is function is not yet implemented for GNU emacs.
2583 (cond ((and (eq ps-print-emacs-type 'xemacs)
2584 (>= emacs-minor-version 12)) ; xemacs
2585 (defun ps-color-device ()
2586 (eq (device-class) 'color))
2590 (defun ps-color-device ()
2595 (require 'time-stamp)
2598 (defun ps-prologue-file (filenumber)
2600 (let* ((filename (format "%sps-prin%d.ps"
2601 ps-postscript-code-directory filenumber))
2603 (or (find-file-noselect filename 'no-warn 'rawfile)
2604 (error "ps-print PostScript prologue `%s' file was not found."
2609 (kill-buffer buffer)))))
2612 (defvar ps-mark-code-directory nil)
2614 (defvar ps-print-prologue-0 ""
2615 "ps-print PostScript error handler.")
2617 (defvar ps-print-prologue-1 ""
2618 "ps-print PostScript prologue begin.")
2620 (defvar ps-print-prologue-2 ""
2621 "ps-print PostScript prologue end.")
2623 (defvar ps-print-duplex-feature ""
2624 "ps-print PostScript duplex feature.")
2626 ;; Start Editing Here:
2628 (defvar ps-source-buffer nil)
2629 (defvar ps-spool-buffer-name "*PostScript*")
2630 (defvar ps-spool-buffer nil)
2632 (defvar ps-output-head nil)
2633 (defvar ps-output-tail nil)
2635 (defvar ps-page-postscript 0)
2636 (defvar ps-page-order 0)
2637 (defvar ps-page-count 0)
2638 (defvar ps-showline-count 1)
2640 (defvar ps-control-or-escape-regexp nil)
2641 (defvar ps-n-up-on nil)
2643 (defvar ps-background-pages nil)
2644 (defvar ps-background-all-pages nil)
2645 (defvar ps-background-text-count 0)
2646 (defvar ps-background-image-count 0)
2648 (defvar ps-current-font 0)
2649 (defvar ps-default-foreground nil)
2650 (defvar ps-default-color nil)
2651 (defvar ps-current-color nil)
2652 (defvar ps-current-bg nil)
2654 (defvar ps-razchunk 0)
2656 (defvar ps-color-p nil)
2657 (defvar ps-color-format
2658 (if (eq ps-print-emacs-type 'emacs)
2660 ;; Emacs understands the %f format; we'll use it to limit color RGB
2661 ;; values to three decimals to cut down some on the size of the
2662 ;; PostScript output.
2665 ;; Lucid emacsen will have to make do with %s (princ) for floats.
2668 ;; These values determine how much print-height to deduct when headers
2669 ;; are turned on. This is a pretty clumsy way of handling it, but
2670 ;; it'll do for now.
2672 (defvar ps-header-pad 0
2673 "Vertical and horizontal space between the header frame and the text.
2674 This is in units of points (1/72 inch).")
2676 ;; Define accessors to the dimensions list.
2678 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
2679 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
2680 (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
2682 (defvar ps-landscape-page-height nil)
2684 (defvar ps-print-width nil)
2685 (defvar ps-print-height nil)
2687 (defvar ps-height-remaining nil)
2688 (defvar ps-width-remaining nil)
2690 (defvar ps-print-color-scale nil)
2692 (defvar ps-font-size-internal nil)
2693 (defvar ps-header-font-size-internal nil)
2694 (defvar ps-header-title-font-size-internal nil)
2697 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2698 ;; Internal Variables
2701 (defvar ps-print-face-extension-alist nil
2702 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
2703 An element of this list has the following form:
2705 (FACE . [BITS FG BG])
2707 FACE is a symbol denoting a face name
2708 BITS is a bit vector, where each bit correspond
2709 to a feature (bold, underline, etc)
2710 (see documentation for `ps-print-face-map-alist')
2711 FG foreground color (string or nil)
2712 BG background color (string or nil)
2714 Don't change this list directly; instead,
2715 use `ps-extend-face' and `ps-extend-face-list'.
2716 See documentation for `ps-extend-face' for valid extension symbol.")
2719 (defvar ps-print-face-alist nil
2720 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
2722 An element of this list has the same form as an element of
2723 `ps-print-face-extension-alist'.
2725 Don't change this list directly; this list is used by `ps-face-attributes',
2726 `ps-map-face' and `ps-build-reference-face-lists'.")
2729 (defconst ps-print-face-map-alist
2738 "Alist of all features and the corresponding bit mask.
2739 Each symbol correspond to one bit in a bit vector.")
2742 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2747 (defun ps-extend-face-list (face-extension-list &optional merge-p)
2748 "Extend face in `ps-print-face-extension-alist'.
2750 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
2751 with face extension in `ps-print-face-extension-alist'; otherwise, overrides.
2753 The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
2755 See `ps-extend-face' for documentation."
2756 (while face-extension-list
2757 (ps-extend-face (car face-extension-list) merge-p)
2758 (setq face-extension-list (cdr face-extension-list))))
2762 (defun ps-extend-face (face-extension &optional merge-p)
2763 "Extend face in `ps-print-face-extension-alist'.
2765 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
2766 with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
2768 The elements of FACE-EXTENSION list have the form:
2770 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
2772 FACE-NAME is a face name symbol.
2774 FOREGROUND and BACKGROUND may be nil or a string that denotes the
2775 foreground and background colors respectively.
2777 EXTENSION is one of the following symbols:
2778 bold - use bold font.
2779 italic - use italic font.
2780 underline - put a line under text.
2781 strikeout - like underline, but the line is in middle of text.
2782 overline - like underline, but the line is over the text.
2783 shadow - text will have a shadow.
2784 box - text will be surrounded by a box.
2785 outline - print characters as hollow outlines.
2787 If EXTENSION is any other symbol, it is ignored."
2788 (let* ((face-name (nth 0 face-extension))
2789 (foreground (nth 1 face-extension))
2790 (background (nth 2 face-extension))
2791 (ps-face (cdr (assq face-name ps-print-face-extension-alist)))
2792 (face-vector (or ps-face (vector 0 nil nil)))
2793 (face-bit (ps-extension-bit face-extension)))
2795 (aset face-vector 0 (if merge-p
2796 (logior (aref face-vector 0) face-bit)
2798 (and foreground (stringp foreground) (aset face-vector 1 foreground))
2799 (and background (stringp background) (aset face-vector 2 background))
2800 ;; if face does not exist, insert it
2802 (setq ps-print-face-extension-alist
2803 (cons (cons face-name face-vector)
2804 ps-print-face-extension-alist)))))
2807 (defun ps-extension-bit (face-extension)
2809 ;; map valid symbol extension to bit vector
2810 (setq face-extension (cdr (cdr face-extension)))
2811 (while (setq face-extension (cdr face-extension))
2812 (setq face-bit (logior face-bit
2813 (or (cdr (assq (car face-extension)
2814 ps-print-face-map-alist))
2819 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2820 ;; Adapted from font-lock: (obsolete stuff)
2821 ;; Originally face attributes were specified via `font-lock-face-attributes'.
2822 ;; Users then changed the default face attributes by setting that variable.
2823 ;; However, we try and be back-compatible and respect its value if set except
2824 ;; for faces where M-x customize has been used to save changes for the face.
2827 (defun ps-font-lock-face-attributes ()
2828 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
2829 (boundp 'font-lock-face-attributes)
2830 (let ((face-attributes font-lock-face-attributes))
2831 (while face-attributes
2832 (let* ((face-attribute
2833 (car (prog1 face-attributes
2834 (setq face-attributes (cdr face-attributes)))))
2835 (face (car face-attribute)))
2836 ;; Rustle up a `defface' SPEC from a
2837 ;; `font-lock-face-attributes' entry.
2838 (unless (get face 'saved-face)
2839 (let ((foreground (nth 1 face-attribute))
2840 (background (nth 2 face-attribute))
2841 (bold-p (nth 3 face-attribute))
2842 (italic-p (nth 4 face-attribute))
2843 (underline-p (nth 5 face-attribute))
2846 (setq face-spec (cons ':foreground
2847 (cons foreground face-spec))))
2849 (setq face-spec (cons ':background
2850 (cons background face-spec))))
2852 (setq face-spec (append '(:bold t) face-spec)))
2854 (setq face-spec (append '(:italic t) face-spec)))
2856 (setq face-spec (append '(:underline t) face-spec)))
2857 (custom-declare-face face (list (list t face-spec)) nil)
2861 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2862 ;; Internal functions and variables
2865 (make-local-hook 'ps-print-hook)
2866 (make-local-hook 'ps-print-begin-sheet-hook)
2867 (make-local-hook 'ps-print-begin-page-hook)
2868 (make-local-hook 'ps-print-begin-column-hook)
2871 (defun ps-print-without-faces (from to &optional filename region-p)
2872 (ps-spool-without-faces from to region-p)
2873 (ps-do-despool filename))
2876 (defun ps-spool-without-faces (from to &optional region-p)
2877 (run-hooks 'ps-print-hook)
2878 (ps-printing-region region-p from)
2879 (ps-generate (current-buffer) from to 'ps-generate-postscript))
2882 (defun ps-print-with-faces (from to &optional filename region-p)
2883 (ps-spool-with-faces from to region-p)
2884 (ps-do-despool filename))
2887 (defun ps-spool-with-faces (from to &optional region-p)
2888 (run-hooks 'ps-print-hook)
2889 (ps-printing-region region-p from)
2890 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
2893 (defun ps-count-lines (from to)
2894 (+ (count-lines from to)
2897 (if (= (current-column) 0) 1 0))))
2900 (defvar ps-printing-region nil
2901 "Variable used to indicate if the region that ps-print is printing.
2902 It is a cons, the car of which is the line number where the region begins, and
2903 its cdr is the total number of lines in the buffer. Formatting functions can
2904 use this information to print the original line number (and not the number of
2905 lines printed), and to indicate in the header that the printout is of a partial
2909 (defvar ps-printing-region-p nil
2910 "Non-nil means ps-print is printing a region.")
2913 (defun ps-printing-region (region-p from)
2914 (setq ps-printing-region-p region-p
2917 (ps-count-lines (point-min) from)
2919 (ps-count-lines (point-min) (point-max)))))
2922 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2923 ;; Internal functions
2926 (defsubst ps-font-alist (font-sym)
2927 (get font-sym 'fonts))
2929 (defun ps-font (font-sym font-type)
2930 "Font family name for text of `font-type', when generating PostScript."
2931 (let* ((font-list (ps-font-alist font-sym))
2932 (normal-font (cdr (assq 'normal font-list))))
2933 (while (and font-list (not (eq font-type (car (car font-list)))))
2934 (setq font-list (cdr font-list)))
2935 (or (cdr (car font-list)) normal-font)))
2937 (defun ps-fonts (font-sym)
2938 (mapcar 'cdr (ps-font-alist font-sym)))
2940 (defun ps-font-number (font-sym font-type)
2941 (or (ps-alist-position font-type (ps-font-alist font-sym))
2944 (defsubst ps-line-height (font-sym)
2945 "The height of a line, for generating PostScript.
2946 This is the value that ps-print uses to determine the height,
2947 y-dimension, of the lines of text it has printed, and thus affects the
2948 point at which page-breaks are placed.
2949 The line-height is *not* the same as the point size of the font."
2950 (get font-sym 'line-height))
2952 (defsubst ps-title-line-height (font-sym)
2953 "The height of a `title' line, for generating PostScript.
2954 This is the value that ps-print uses to determine the height,
2955 y-dimension, of the lines of text it has printed, and thus affects the
2956 point at which page-breaks are placed.
2957 The title-line-height is *not* the same as the point size of the font."
2958 (get font-sym 'title-line-height))
2960 (defsubst ps-space-width (font-sym)
2961 "The width of a space character, for generating PostScript.
2962 This value is used in expanding tab characters."
2963 (get font-sym 'space-width))
2965 (defsubst ps-avg-char-width (font-sym)
2966 "The average width, in points, of a character, for generating PostScript.
2967 This is the value that ps-print uses to determine the length,
2968 x-dimension, of the text it has printed, and thus affects the point at
2969 which long lines wrap around."
2970 (get font-sym 'avg-char-width))
2972 (defun ps-line-lengths-internal ()
2973 "Display the correspondence between a line length and a font size,
2974 using the current ps-print setup.
2975 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
2976 (let ((buf (get-buffer-create "*Line-lengths*"))
2977 (ifs ps-font-size-internal) ; initial font size
2978 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
2979 (print-width (progn (ps-get-page-dimensions)
2981 (ps-setup (ps-setup)) ; setup for the current buffer
2982 (fs-min 5) ; minimum font size
2983 cw-min ; minimum character width
2984 nb-cpl-max ; maximum nb of characters per line
2985 (fs-max 14) ; maximum font size
2986 cw-max ; maximum character width
2987 nb-cpl-min ; minimum nb of characters per line
2988 fs ; current font size
2989 cw ; current character width
2990 nb-cpl ; current nb of characters per line
2992 (setq cw-min (/ (* icw fs-min) ifs)
2993 nb-cpl-max (floor (/ print-width cw-min))
2994 cw-max (/ (* icw fs-max) ifs)
2995 nb-cpl-min (floor (/ print-width cw-max))
2998 (goto-char (point-max))
2999 (or (bolp) (insert "\n"))
3001 "nb char per line / font size\n")
3002 (while (<= nb-cpl nb-cpl-max)
3003 (setq cw (/ print-width (float nb-cpl))
3004 fs (/ (* ifs cw) icw))
3005 (insert (format "%3s %s\n" nb-cpl fs))
3006 (setq nb-cpl (1+ nb-cpl)))
3008 (display-buffer buf 'not-this-window)))
3010 (defun ps-nb-pages (nb-lines)
3011 "Display correspondence between font size and the number of pages.
3012 The correspondence is based on having NB-LINES lines of text,
3013 and on the current ps-print setup."
3014 (let ((buf (get-buffer-create "*Nb-Pages*"))
3015 (ifs ps-font-size-internal) ; initial font size
3016 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
3017 (page-height (progn (ps-get-page-dimensions)
3019 (ps-setup (ps-setup)) ; setup for the current buffer
3020 (fs-min 4) ; minimum font size
3021 lh-min ; minimum line height
3022 nb-lpp-max ; maximum nb of lines per page
3023 nb-page-min ; minimum nb of pages
3024 (fs-max 14) ; maximum font size
3025 lh-max ; maximum line height
3026 nb-lpp-min ; minimum nb of lines per page
3027 nb-page-max ; maximum nb of pages
3028 fs ; current font size
3029 lh ; current line height
3030 nb-lpp ; current nb of lines per page
3031 nb-page ; current nb of pages
3033 (setq lh-min (/ (* ilh fs-min) ifs)
3034 nb-lpp-max (floor (/ page-height lh-min))
3035 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
3036 lh-max (/ (* ilh fs-max) ifs)
3037 nb-lpp-min (floor (/ page-height lh-max))
3038 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
3039 nb-page nb-page-min)
3041 (goto-char (point-max))
3042 (or (bolp) (insert "\n"))
3044 (format "%d lines\n" nb-lines)
3045 "nb page / font size\n")
3046 (while (<= nb-page nb-page-max)
3047 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
3048 lh (/ page-height nb-lpp)
3049 fs (/ (* ifs lh) ilh))
3050 (insert (format "%s %s\n" nb-page fs))
3051 (setq nb-page (1+ nb-page)))
3053 (display-buffer buf 'not-this-window)))
3055 ;; macros used in `ps-select-font'
3056 (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
3057 (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
3059 (defun ps-select-font (font-family sym font-size title-font-size)
3060 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
3062 (error "Don't have data to scale font %s. Known fonts families are %s"
3064 (mapcar 'car ps-font-info-database)))
3065 (let ((size (ps-lookup 'size)))
3066 (put sym 'fonts (ps-lookup 'fonts))
3067 (put sym 'space-width (ps-size-scale 'space-width))
3068 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
3069 (put sym 'line-height (ps-size-scale 'line-height))
3070 (put sym 'title-line-height
3071 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
3073 (defun ps-get-page-dimensions ()
3074 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
3075 page-width page-height)
3077 ((null page-dimensions)
3078 (error "`ps-paper-type' must be one of:\n%s"
3079 (mapcar 'car ps-page-dimensions-database)))
3080 ((< ps-number-of-columns 1)
3081 (error "The number of columns %d should be positive"
3082 ps-number-of-columns)))
3084 (ps-select-font ps-font-family 'ps-font-for-text
3085 ps-font-size-internal ps-font-size-internal)
3086 (ps-select-font ps-header-font-family 'ps-font-for-header
3087 ps-header-font-size-internal
3088 ps-header-title-font-size-internal)
3090 (setq page-width (ps-page-dimensions-get-width page-dimensions)
3091 page-height (ps-page-dimensions-get-height page-dimensions))
3094 (if ps-landscape-mode
3095 ;; exchange width and height
3096 (setq page-width (prog1 page-height (setq page-height page-width))))
3098 ;; It is used to get the lower right corner (only in landscape mode)
3099 (setq ps-landscape-page-height page-height)
3101 ;; | lm | text | ic | text | ic | text | rm |
3102 ;; page-width == lm + n * pw + (n - 1) * ic + rm
3103 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
3104 (setq ps-print-width (/ (- page-width
3105 ps-left-margin ps-right-margin
3106 (* (1- ps-number-of-columns) ps-inter-column))
3107 ps-number-of-columns))
3108 (if (<= ps-print-width 0)
3109 (error "Bad horizontal layout:
3111 ps-left-margin == %s
3112 ps-right-margin == %s
3113 ps-inter-column == %s
3114 ps-number-of-columns == %s
3115 | lm | text | ic | text | ic | text | rm |
3116 page-width == lm + n * print-width + (n - 1) * ic + rm
3117 => print-width == %d !"
3122 ps-number-of-columns
3125 (setq ps-print-height
3126 (- page-height ps-bottom-margin ps-top-margin))
3127 (if (<= ps-print-height 0)
3128 (error "Bad vertical layout:
3130 ps-bottom-margin == %s
3131 page-height == bm + print-height + tm
3132 => print-height == %d !"
3136 ;; If headers are turned on, deduct the height of the header from
3137 ;; the print height.
3139 (setq ps-header-pad (* ps-header-line-pad
3140 (ps-title-line-height 'ps-font-for-header))
3141 ps-print-height (- ps-print-height
3144 (ps-title-line-height 'ps-font-for-header)
3145 (* (ps-line-height 'ps-font-for-header)
3146 (1- ps-header-lines))
3148 (if (<= ps-print-height 0)
3149 (error "Bad vertical layout:
3151 ps-bottom-margin == %s
3152 ps-header-offset == %s
3155 page-height == bm + print-height + tm - ho - hh
3156 => print-height == %d !"
3162 (ps-title-line-height 'ps-font-for-header)
3163 (* (ps-line-height 'ps-font-for-header)
3164 (1- ps-header-lines))
3168 (defun ps-print-preprint (prefix-arg)
3170 (or (numberp prefix-arg)
3172 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
3175 (prompt (format "Save PostScript to file: (default %s) " name))
3176 (res (read-file-name prompt default-directory name nil)))
3177 (while (cond ((not (file-writable-p res))
3179 (setq prompt "is unwritable"))
3180 ((file-exists-p res)
3181 (setq prompt "exists")
3182 (not (y-or-n-p (format "File `%s' exists; overwrite? "
3185 (setq res (read-file-name
3186 (format "File %s; save PostScript to file: " prompt)
3187 (file-name-directory res) nil nil
3188 (file-name-nondirectory res))))
3189 (if (file-directory-p res)
3190 (expand-file-name name (file-name-as-directory res))
3193 ;; The following functions implement a simple list-buffering scheme so
3194 ;; that ps-print doesn't have to repeatedly switch between buffers
3195 ;; while spooling. The functions `ps-output' and `ps-output-string' build
3196 ;; up the lists; the function `ps-flush-output' takes the lists and
3197 ;; insert its contents into the spool buffer (*PostScript*).
3199 (defvar ps-string-escape-codes
3200 (let ((table (make-vector 256 nil))
3202 ;; control characters
3203 (while (<= char ?\037)
3204 (aset table char (format "\\%03o" char))
3205 (setq char (1+ char)))
3206 ;; printable characters
3207 (while (< char ?\177)
3208 (aset table char (format "%c" char))
3209 (setq char (1+ char)))
3210 ;; DEL and 8-bit characters
3211 (while (<= char ?\377)
3212 (aset table char (format "\\%o" char))
3213 (setq char (1+ char)))
3214 ;; Override ASCII formatting characters with named escape code:
3215 (aset table ?\n "\\n") ; [NL] linefeed
3216 (aset table ?\r "\\r") ; [CR] carriage return
3217 (aset table ?\t "\\t") ; [HT] horizontal tab
3218 (aset table ?\b "\\b") ; [BS] backspace
3219 (aset table ?\f "\\f") ; [NP] form feed
3220 ;; Escape PostScript escape and string delimiter characters:
3221 (aset table ?\\ "\\\\")
3222 (aset table ?\( "\\(")
3223 (aset table ?\) "\\)")
3225 "Vector used to map characters to PostScript string escape codes.")
3227 (defun ps-output-string-prim (string)
3228 (insert "(") ;insert start-string delimiter
3229 (save-excursion ;insert string
3230 (insert (string-as-unibyte string)))
3231 ;; Find and quote special characters as necessary for PS
3232 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
3233 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
3234 (let ((special (following-char)))
3236 (insert (aref ps-string-escape-codes special))))
3237 (goto-char (point-max))
3238 (insert ")")) ;insert end-string delimiter
3240 (defun ps-init-output-queue ()
3241 (setq ps-output-head '("")
3242 ps-output-tail ps-output-head))
3244 (defun ps-output (&rest args)
3245 (setcdr ps-output-tail args)
3246 (while (cdr ps-output-tail)
3247 (setq ps-output-tail (cdr ps-output-tail))))
3249 (defun ps-output-string (string)
3250 (ps-output t string))
3252 (defun ps-output-list (the-list)
3253 (mapcar 'ps-output the-list))
3255 ;; Output strings in the list ARGS in the PostScript prologue part.
3256 (defun ps-output-prologue (args)
3257 (ps-output 'prologue (if (stringp args) (list args) args)))
3259 (defun ps-flush-output ()
3261 (set-buffer ps-spool-buffer)
3262 (goto-char (point-max))
3263 (while ps-output-head
3264 (let ((it (car ps-output-head)))
3267 (setq ps-output-head (cdr ps-output-head))
3268 (ps-output-string-prim (car ps-output-head)))
3270 (setq ps-output-head (cdr ps-output-head))
3272 (search-backward "\nBeginDoc")
3274 (apply 'insert (car ps-output-head))))
3277 (setq ps-output-head (cdr ps-output-head))))
3278 (ps-init-output-queue))
3280 (defun ps-insert-file (fname)
3283 (set-buffer ps-spool-buffer)
3284 (goto-char (point-max))
3285 (insert-file fname)))
3287 ;; These functions insert the arrays that define the contents of the
3290 (defun ps-generate-header-line (fonttag &optional content)
3291 (ps-output " [ " fonttag " ")
3293 ;; Literal strings should be output as is -- the string must
3294 ;; contain its own PS string delimiters, '(' and ')', if necessary.
3296 (ps-output content))
3298 ;; Functions are called -- they should return strings; they will be
3299 ;; inserted as strings and the PS string delimiters added.
3300 ((and (symbolp content) (fboundp content))
3301 (ps-output-string (funcall content)))
3303 ;; Variables will have their contents inserted. They should
3304 ;; contain strings, and will be inserted as strings.
3305 ((and (symbolp content) (boundp content))
3306 (ps-output-string (symbol-value content)))
3308 ;; Anything else will get turned into an empty string.
3310 (ps-output-string "")))
3313 (defun ps-generate-header (name contents)
3314 (ps-output "/" name " [\n")
3315 (if (> ps-header-lines 0)
3317 (ps-generate-header-line "/h0" (car contents))
3318 (while (and (< count ps-header-lines)
3319 (setq contents (cdr contents)))
3320 (ps-generate-header-line "/h1" (car contents))
3321 (setq count (1+ count)))
3322 (ps-output "] def\n"))))
3325 (defun ps-output-boolean (name bool)
3326 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
3329 (defun ps-background-pages (page-list func)
3333 (let ((start (if (consp pages) (car pages) pages))
3334 (end (if (consp pages) (cdr pages) pages)))
3335 (and (integerp start) (integerp end) (<= start end)
3336 (add-to-list 'ps-background-pages (vector start end func)))))
3338 (setq ps-background-all-pages (cons func ps-background-all-pages))))
3341 (defconst ps-boundingbox-re
3343 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
3346 (defun ps-get-boundingbox ()
3348 (set-buffer ps-spool-buffer)
3350 (if (re-search-forward ps-boundingbox-re nil t)
3351 (vector (string-to-number ; lower x
3352 (buffer-substring (match-beginning 1) (match-end 1)))
3353 (string-to-number ; lower y
3354 (buffer-substring (match-beginning 2) (match-end 2)))
3355 (string-to-number ; upper x
3356 (buffer-substring (match-beginning 3) (match-end 3)))
3357 (string-to-number ; upper y
3358 (buffer-substring (match-beginning 4) (match-end 4))))
3359 (vector 0 0 0 0)))))
3362 ;; Emacs understands the %f format; we'll use it to limit color RGB values
3363 ;; to three decimals to cut down some on the size of the PostScript output.
3364 ;; Lucid emacsen will have to make do with %s (princ) for floats.
3366 (defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
3368 "%s ")) ; Lucid emacsen
3371 (defun ps-float-format (value &optional default)
3372 (let ((literal (or value default)))
3374 (format (if (numberp literal)
3381 (defun ps-background-text ()
3384 (setq ps-background-text-count (1+ ps-background-text-count))
3385 (ps-output (format "/ShowBackText-%d {\n" ps-background-text-count))
3386 (ps-output-string (nth 0 text)) ; text
3389 (ps-float-format (nth 4 text) 200.0) ; font size
3390 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
3391 (ps-float-format (nth 6 text)
3392 "PrintHeight PrintPageWidth atan") ; rotation
3393 (ps-float-format (nth 5 text) 0.85) ; gray
3394 (ps-float-format (nth 1 text) "0") ; x position
3395 (ps-float-format (nth 2 text) "BottomMargin") ; y position
3396 "\nShowBackText} def\n")
3397 (ps-background-pages (nthcdr 7 text) ; page list
3398 (format "ShowBackText-%d\n"
3399 ps-background-text-count)))
3400 ps-print-background-text))
3403 (defun ps-background-image ()
3406 (let ((image-file (expand-file-name (nth 0 image))))
3407 (when (file-readable-p image-file)
3408 (setq ps-background-image-count (1+ ps-background-image-count))
3410 (format "/ShowBackImage-%d {\n--back-- "
3411 ps-background-image-count)
3412 (ps-float-format (nth 5 image) 0.0) ; rotation
3413 (ps-float-format (nth 3 image) 1.0) ; x scale
3414 (ps-float-format (nth 4 image) 1.0) ; y scale
3415 (ps-float-format (nth 1 image) ; x position
3416 "PrintPageWidth 2 div")
3417 (ps-float-format (nth 2 image) ; y position
3418 "PrintHeight 2 div BottomMargin add")
3419 "\nBeginBackImage\n")
3420 (ps-insert-file image-file)
3421 ;; coordinate adjustment to centralize image
3422 ;; around x and y position
3423 (let ((box (ps-get-boundingbox)))
3425 (set-buffer ps-spool-buffer)
3427 (if (re-search-backward "^--back--" nil t)
3431 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
3434 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
3437 (ps-output "\nEndBackImage} def\n")
3438 (ps-background-pages (nthcdr 6 image) ; page list
3439 (format "ShowBackImage-%d\n"
3440 ps-background-image-count)))))
3441 ps-print-background-image))
3444 (defun ps-background (page-number)
3445 (let (has-local-background)
3446 (mapcar #'(lambda (range)
3447 (and (<= (aref range 0) page-number)
3448 (<= page-number (aref range 1))
3449 (if has-local-background
3450 (ps-output (aref range 2))
3451 (setq has-local-background t)
3452 (ps-output "/printLocalBackground {\n"
3454 ps-background-pages)
3455 (and has-local-background (ps-output "} def\n"))))
3458 ;; Return a list of the distinct elements of LIST.
3459 ;; Elements are compared with `equal'.
3460 (defun ps-remove-duplicates (list)
3461 (let (new (tail list))
3463 (or (member (car tail) new)
3464 (setq new (cons (car tail) new)))
3465 (setq tail (cdr tail)))
3469 ;; Find the first occurrence of ITEM in LIST.
3470 ;; Return the index of the matching item, or nil if not found.
3471 ;; Elements are compared with `eq'.
3472 (defun ps-alist-position (item list)
3473 (let ((tail list) (index 0) found)
3475 (if (setq found (eq (car (car tail)) item))
3477 (setq index (1+ index)
3482 (defconst ps-n-up-database
3619 ;; Ledger paper size is a special case, it is the only paper size where the
3620 ;; normal size is landscaped, that is, the height is smaller than width.
3621 ;; So, we use the special value `pag' in the `landscape' field.
3765 "Alist which is the page matrix database used for N-up printing.
3767 Each element has the following form:
3770 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
3774 PAGE is the page size used (see `ps-paper-type').
3775 MAX is the maximum elements of this page matrix.
3776 LANDSCAPE specifies if page matrix is landscaped, has the following valid
3778 nil the sheet is in portrait mode.
3779 t the sheet is in landscape mode.
3780 pag the sheet is in portrait mode and page is in landscape mode.
3781 LINES is the number of lines of page matrix.
3782 COLUMNS is the number of columns of page matrix.
3783 COL-MISSING is the number of columns missing to fill the sheet.")
3786 (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
3787 (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
3788 (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
3789 (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
3792 (defun ps-n-up-printing ()
3793 ;; force `ps-n-up-printing' be in range 1 to 100.
3794 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
3795 ;; find suitable page matrix for a given `ps-paper-type'.
3796 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
3798 (while (> ps-n-up-printing (caar the-list))
3799 (setq the-list (cdr the-list))))
3803 (defconst ps-n-up-filling-database
3805 "PageWidth" ; N-Up-XColumn
3807 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
3808 "LandscapePageHeight neg" ; N-Up-YLine
3809 "N-Up-Lines" ; N-Up-Repeat
3810 "N-Up-Columns" ; N-Up-End
3814 "PageWidth" ; N-Up-XColumn
3816 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
3817 "LandscapePageHeight" ; N-Up-YLine
3818 "N-Up-Lines" ; N-Up-Repeat
3819 "N-Up-Columns" ; N-Up-End
3821 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
3823 "PageWidth neg" ; N-Up-XColumn
3825 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
3826 "LandscapePageHeight neg" ; N-Up-YLine
3827 "N-Up-Lines" ; N-Up-Repeat
3828 "N-Up-Columns" ; N-Up-End
3829 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
3832 "PageWidth neg" ; N-Up-XColumn
3834 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
3835 "LandscapePageHeight" ; N-Up-YLine
3836 "N-Up-Lines" ; N-Up-Repeat
3837 "N-Up-Columns" ; N-Up-End
3838 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
3839 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
3842 "LandscapePageHeight neg" ; N-Up-YColumn
3843 "PageWidth" ; N-Up-XLine
3844 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
3845 "N-Up-Columns" ; N-Up-Repeat
3846 "N-Up-Lines" ; N-Up-End
3851 "LandscapePageHeight" ; N-Up-YColumn
3852 "PageWidth" ; N-Up-XLine
3853 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
3854 "N-Up-Columns" ; N-Up-Repeat
3855 "N-Up-Lines" ; N-Up-End
3857 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
3860 "LandscapePageHeight neg" ; N-Up-YColumn
3861 "PageWidth neg" ; N-Up-XLine
3862 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
3863 "N-Up-Columns" ; N-Up-Repeat
3864 "N-Up-Lines" ; N-Up-End
3865 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
3869 "LandscapePageHeight" ; N-Up-YColumn
3870 "PageWidth neg" ; N-Up-XLine
3871 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
3872 "N-Up-Columns" ; N-Up-Repeat
3873 "N-Up-Lines" ; N-Up-End
3874 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
3875 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
3876 "Alist for n-up printing initializations.
3878 Each element has the following form:
3880 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
3883 KIND is a valid value of `ps-n-up-filling'.
3884 XCOL YCOL are the relative position for the next column.
3885 XLIN YLIN are the relative position for the beginning of next line.
3886 REPEAT is the number of repetions for external loop.
3887 END is the number of repetions for internal loop and also the number of pages in
3889 XSTART YSTART are the relative position for the first page in a sheet.")
3892 (defun ps-n-up-filling ()
3893 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
3894 (assq 'left-top ps-n-up-filling-database))))
3897 (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
3898 (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
3899 (defmacro ps-n-up-xline (init) `(nth 2 ,init))
3900 (defmacro ps-n-up-yline (init) `(nth 3 ,init))
3901 (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
3902 (defmacro ps-n-up-end (init) `(nth 5 ,init))
3903 (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
3904 (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
3907 (defconst ps-error-handler-alist
3911 (paper-and-system . 3))
3912 "Alist for error handler message")
3915 (defun ps-begin-file ()
3916 (ps-get-page-dimensions)
3917 (setq ps-page-postscript 0
3919 ps-background-text-count 0
3920 ps-background-image-count 0
3921 ps-background-pages nil
3922 ps-background-all-pages nil)
3924 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
3925 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
3926 (n-up (ps-n-up-printing))
3927 (n-up-filling (ps-n-up-filling)))
3928 (and ps-n-up-on (setq tumble (not tumble)))
3931 "%%Title: " (buffer-name) ; Take job name from name of
3932 ; first buffer printed
3933 "\n%%Creator: " (user-full-name)
3934 " (using ps-print v" ps-print-version
3935 ")\n%%CreationDate: "
3936 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
3938 (if ps-landscape-mode "Landscape" "Portrait")
3939 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
3940 (mapconcat 'identity
3941 (ps-remove-duplicates
3942 (append (ps-fonts 'ps-font-for-text)
3943 (list (ps-font 'ps-font-for-header 'normal)
3944 (ps-font 'ps-font-for-header 'bold))))
3946 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
3947 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
3948 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
3949 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
3951 (format " duplex%s" (if tumble "(tumble)\n" "\n"))
3954 (ps-insert-string ps-print-prologue-header)
3956 (ps-output "%%EndComments\n\n%%BeginPrologue\n\n"
3957 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
3958 (format "/ErrorMessage %s def\n\n"
3959 (or (cdr (assoc ps-error-handler-message
3960 ps-error-handler-alist))
3963 "\n%%BeginProcSet: UserDefinedPrologue\n\n")
3965 (ps-insert-string ps-user-defined-prologue)
3967 (ps-output "\n%%EndProcSet\n\n")
3969 (ps-output-boolean "LandscapeMode "
3970 (or ps-landscape-mode
3971 (eq (ps-n-up-landscape n-up) 'pag)))
3972 (ps-output-boolean "UpsideDown " ps-print-upside-down)
3973 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
3975 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
3976 (format "/PrintPageWidth %s def\n"
3977 (- (* (+ ps-print-width ps-inter-column)
3978 ps-number-of-columns)
3980 (format "/PrintWidth %s def\n" ps-print-width)
3981 (format "/PrintHeight %s def\n" ps-print-height)
3983 (format "/LeftMargin %s def\n" ps-left-margin)
3984 (format "/RightMargin %s def\n" ps-right-margin)
3985 (format "/InterColumn %s def\n" ps-inter-column)
3987 (format "/BottomMargin %s def\n" ps-bottom-margin)
3988 (format "/TopMargin %s def\n" ps-top-margin) ; not used
3989 (format "/HeaderOffset %s def\n" ps-header-offset)
3990 (format "/HeaderPad %s def\n" ps-header-pad))
3992 (ps-output-boolean "PrintHeader " ps-print-header)
3993 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
3994 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
3995 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
3996 (ps-output-boolean "DuplexValue " ps-spool-duplex)
3997 (ps-output-boolean "TumbleValue " tumble)
3999 (let ((line-height (ps-line-height 'ps-font-for-text)))
4000 (ps-output (format "/LineHeight %s def\n" line-height)
4001 (format "/LinesPerColumn %d def\n"
4002 (round (/ (+ ps-print-height
4003 (* line-height 0.45))
4006 (ps-output-boolean "Zebra " ps-zebra-stripes)
4007 (ps-output-boolean "PrintLineNumber " ps-line-number)
4008 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
4009 (ps-output (format "/PrintLineStep %d def\n"
4010 (if (integerp ps-line-number-step)
4012 ps-zebra-stripe-height))
4013 (format "/PrintLineStart %d def\n" ps-line-number-start)
4014 (format "/ZebraHeight %d def\n" ps-zebra-stripe-height)
4016 (ps-format-color ps-zebra-color 0.95)
4017 "def\n/BackgroundColor "
4018 (ps-format-color ps-default-bg 1.0)
4019 "def\n/UseSetpagedevice "
4020 (if (eq ps-spool-config 'setpagedevice)
4021 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
4023 " def\n\n/PageWidth "
4024 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
4025 (format "/N-Up %d def\n" ps-n-up-printing))
4026 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
4027 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
4028 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
4029 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
4030 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
4031 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
4033 (if ps-landscape-mode
4034 (ps-n-up-end n-up-filling)
4035 (ps-n-up-repeat n-up-filling))
4037 (if ps-landscape-mode
4038 (ps-n-up-repeat n-up-filling)
4039 (ps-n-up-end n-up-filling))
4040 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
4041 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
4042 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
4043 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
4044 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
4045 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
4047 (ps-background-text)
4048 (ps-background-image)
4049 (setq ps-background-all-pages (nreverse ps-background-all-pages)
4050 ps-background-pages (nreverse ps-background-pages))
4052 (ps-output "\n" ps-print-prologue-1)
4054 (ps-output "\n/printGlobalBackground {\n")
4055 (ps-output-list ps-background-all-pages)
4056 (ps-output "} def\n/printLocalBackground {\n} def\n")
4059 (ps-output (format "/h0 %s (%s) cvn DefFont\n" ; /h0 14 /Helvetica-Bold DefFont
4060 ps-header-title-font-size-internal
4061 (ps-font 'ps-font-for-header 'bold))
4062 (format "/h1 %s (%s) cvn DefFont\n" ; /h1 12 /Helvetica DefFont
4063 ps-header-font-size-internal
4064 (ps-font 'ps-font-for-header 'normal)))
4066 (ps-output "\n" ps-print-prologue-2 "\n")
4069 (let ((font (ps-font-alist 'ps-font-for-text))
4072 (ps-output (format "/f%d %s (%s) cvn DefFont\n"
4074 ps-font-size-internal
4075 (ps-font 'ps-font-for-text (car (car font)))))
4076 (setq font (cdr font)
4079 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
4080 (ps-output (format "/SpaceWidthRatio %f def\n"
4081 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
4083 (ps-output "\n%%EndPrologue\n\n%%BeginSetup\n")
4084 (unless (eq ps-spool-config 'lpr-switches)
4085 (ps-output "\n%%BeginFeature: *Duplex "
4086 (ps-boolean-capitalized ps-spool-duplex)
4088 (ps-boolean-capitalized tumble)
4090 ps-print-duplex-feature
4091 "\n%%EndFeature\n")))
4092 (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n")
4093 (and ps-banner-page-when-duplexing
4094 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
4097 (defun ps-format-color (color &optional default)
4098 (let ((the-color (if (stringp color)
4099 (ps-color-scale color)
4101 (if (and the-color (listp the-color))
4103 (format ps-color-format
4108 (ps-float-format (if (numberp the-color) the-color default)))))
4111 (defun ps-insert-string (prologue)
4112 (let ((str (if (functionp prologue)
4119 (defun ps-boolean-capitalized (bool)
4120 (if bool "True" "False"))
4123 (defun ps-header-dirpart ()
4124 (let ((fname (buffer-file-name)))
4126 (if (string-equal (buffer-name) (file-name-nondirectory fname))
4127 (abbreviate-file-name (file-name-directory fname))
4132 (defun ps-get-buffer-name ()
4134 ;; Indulge Jim this little easter egg:
4135 ((string= (buffer-name) "ps-print.el")
4136 "Hey, Cool! It's ps-print.el!!!")
4137 ;; Indulge Jack this other little easter egg:
4138 ((string= (buffer-name) "sokoban.el")
4139 "Super! C'est sokoban.el!")
4141 (and ps-printing-region-p "Subset of: ")
4143 (and (buffer-modified-p) " (unsaved)")))))
4146 (defun ps-get-font-size (font-sym)
4147 (let ((font-size (symbol-value font-sym)))
4148 (cond ((numberp font-size)
4150 ((and (consp font-size)
4151 (numberp (car font-size))
4152 (numberp (cdr font-size)))
4153 (if ps-landscape-mode
4157 (error "Invalid font size `%S' for `%S'" font-size font-sym)))))
4160 (defun ps-begin-job ()
4161 (let ((last-char (aref ps-postscript-code-directory
4162 (1- (length ps-postscript-code-directory)))))
4163 (or (eq last-char ?/)
4164 (and ps-windows-system (eq last-char ?\\))
4165 (setq ps-postscript-code-directory
4166 (concat ps-postscript-code-directory "/"))))
4167 (or (equal ps-mark-code-directory ps-postscript-code-directory)
4168 (setq ps-print-prologue-0 (ps-prologue-file 0)
4169 ps-print-prologue-1 (ps-prologue-file 1)
4170 ps-print-prologue-2 (ps-prologue-file 2)
4171 ps-print-duplex-feature (ps-prologue-file 3)
4172 ps-mark-code-directory ps-postscript-code-directory))
4173 (or (listp ps-use-face-background)
4174 (setq ps-use-face-background t))
4175 (and (integerp ps-line-number-step)
4176 (<= ps-line-number-step 0)
4177 (setq ps-line-number-step 1))
4178 (setq ps-n-up-on (> ps-n-up-printing 1)
4179 ps-line-number-start (max 1 (min ps-line-number-start
4180 (if (integerp ps-line-number-step)
4182 ps-zebra-stripe-height))))
4184 (set-buffer ps-spool-buffer)
4185 (goto-char (point-max))
4186 (and (re-search-backward "^%%Trailer$" nil t)
4187 (delete-region (match-beginning 0) (point-max))))
4188 (setq ps-showline-count (car ps-printing-region)
4190 ps-font-size-internal (ps-get-font-size 'ps-font-size)
4191 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
4192 ps-header-title-font-size-internal
4193 (ps-get-font-size 'ps-header-title-font-size)
4194 ps-control-or-escape-regexp
4195 (cond ((eq ps-print-control-characters '8-bit)
4196 (string-as-unibyte "[\000-\037\177-\377]"))
4197 ((eq ps-print-control-characters 'control-8-bit)
4198 (string-as-unibyte "[\000-\037\177-\237]"))
4199 ((eq ps-print-control-characters 'control)
4202 ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
4203 ps-default-color (and ps-print-color-p ps-default-foreground)
4204 ps-current-color ps-default-color
4205 ;; Set the color scale. We do it here instead of in the defvar so
4206 ;; that ps-print can be dumped into emacs. This expression can't be
4207 ;; evaluated at dump-time because X isn't initialized.
4208 ps-color-p (and ps-print-color-p (ps-color-device))
4209 ps-print-color-scale (if ps-color-p
4210 (float (car (ps-color-values "white")))
4214 (defun ps-rgb-color (color default)
4215 (cond ((and color (listp color)) color)
4216 ((stringp color) (ps-color-scale color))
4217 ((numberp color) (list color color color))
4218 (t (list default default default))
4222 (defmacro ps-page-number ()
4223 `(1+ (/ (1- ps-page-count) ps-number-of-columns)))
4225 (defun ps-end-file (needs-begin-file)
4227 ;; Back to the PS output buffer to set the last page n-up printing
4229 (let ((pages-per-sheet (mod ps-page-postscript ps-n-up-printing))
4231 (set-buffer ps-spool-buffer)
4232 (goto-char (point-max))
4233 (and (> pages-per-sheet 0)
4234 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
4235 (replace-match (format "%d BeginSheet" pages-per-sheet) t))))
4237 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
4239 ;; Set end of PostScript file
4240 (ps-output "EndSheet\n\n%%Trailer\n%%Pages: "
4242 (if (and needs-begin-file ps-banner-page-when-duplexing)
4245 "\n\nEndDoc\n\n%%EOF\n"))
4248 (defun ps-next-page ()
4254 (defun ps-header-sheet ()
4255 ;; Print only when a new sheet begins.
4256 (setq ps-page-postscript (1+ ps-page-postscript)
4257 ps-page-order (1+ ps-page-order))
4258 (and (> ps-page-order 1)
4259 (ps-output "EndSheet\n"))
4260 (ps-output (if ps-n-up-on
4261 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
4262 ps-page-order ps-page-postscript ps-page-order)
4263 (format "\n%%%%Page: %d %d\n"
4264 ps-page-postscript ps-page-order))
4265 (format "%d BeginSheet\nBeginDSCPage\n" ps-n-up-printing)))
4268 (defsubst ps-header-page ()
4269 ;; set total line and page number when printing has finished
4270 ;; (see `ps-generate')
4273 (zerop (mod ps-page-count ps-number-of-columns))
4274 (setq ps-page-count (1+ ps-page-count)))
4276 (if (zerop (mod ps-page-postscript ps-n-up-printing))
4277 ;; Print only when a new sheet begins.
4280 'ps-print-begin-sheet-hook)
4281 ;; Print only when a new page begins.
4282 (setq ps-page-postscript (1+ ps-page-postscript))
4283 (ps-output "BeginDSCPage\n")
4284 'ps-print-begin-page-hook)
4285 (ps-background ps-page-postscript))
4286 ;; Print only when a new column begins.
4287 (ps-output "BeginDSCPage\n")
4288 'ps-print-begin-column-hook)))
4290 (defun ps-begin-page ()
4291 (ps-get-page-dimensions)
4292 (setq ps-width-remaining ps-print-width
4293 ps-height-remaining ps-print-height)
4297 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
4298 (format "/PageNumber %d def\n" (if ps-print-only-one-header
4302 (when ps-print-header
4303 (ps-generate-header "HeaderLinesLeft" ps-left-header)
4304 (ps-generate-header "HeaderLinesRight" ps-right-header)
4305 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
4307 (ps-output "BeginPage\n")
4308 (ps-set-font ps-current-font)
4309 (ps-set-bg ps-current-bg)
4310 (ps-set-color ps-current-color)
4311 (ps-mule-begin-page))
4313 (defun ps-end-page ()
4314 (ps-output "EndPage\nEndDSCPage\n"))
4316 (defun ps-dummy-page ()
4317 (let ((ps-n-up-printing 0))
4319 (ps-output "/PrintHeader false def
4321 /PrintLineNumber false def
4325 (setq ps-page-postscript ps-n-up-printing))
4327 (defun ps-next-line ()
4328 (setq ps-showline-count (1+ ps-showline-count))
4329 (let ((lh (ps-line-height 'ps-font-for-text)))
4330 (if (< ps-height-remaining lh)
4332 (setq ps-width-remaining ps-print-width
4333 ps-height-remaining (- ps-height-remaining lh))
4334 (ps-output "HL\n"))))
4336 (defun ps-continue-line ()
4337 (let ((lh (ps-line-height 'ps-font-for-text)))
4338 (if (< ps-height-remaining lh)
4340 (setq ps-width-remaining ps-print-width
4341 ps-height-remaining (- ps-height-remaining lh))
4342 (ps-output "SL\n"))))
4344 (defun ps-find-wrappoint (from to char-width)
4345 (let ((avail (truncate (/ ps-width-remaining char-width)))
4348 (cons to (* todo char-width))
4349 (cons (+ from avail) ps-width-remaining))))
4351 (defun ps-basic-plot-string (from to &optional bg-color)
4352 (let* ((wrappoint (ps-find-wrappoint from to
4353 (ps-avg-char-width 'ps-font-for-text)))
4354 (to (car wrappoint))
4355 (string (buffer-substring-no-properties from to)))
4356 (ps-mule-prepare-ascii-font string)
4357 (ps-output-string string)
4361 (defun ps-basic-plot-whitespace (from to &optional bg-color)
4362 (let* ((wrappoint (ps-find-wrappoint from to
4363 (ps-space-width 'ps-font-for-text)))
4364 (to (car wrappoint)))
4365 (ps-output (format "%d W\n" (- to from)))
4368 (defun ps-plot (plotfunc from to &optional bg-color)
4370 (let* ((wrappoint (funcall plotfunc from to bg-color))
4371 (plotted-to (car wrappoint))
4372 (plotted-width (cdr wrappoint)))
4373 (setq from plotted-to
4374 ps-width-remaining (- ps-width-remaining plotted-width))
4376 (ps-continue-line))))
4377 (if ps-razzle-dazzle
4378 (let* ((q-todo (- (point-max) (point-min)))
4379 (q-done (- (point) (point-min)))
4380 (chunkfrac (/ q-todo 8))
4381 (chunksize (min chunkfrac 1000)))
4382 (if (> (- q-done ps-razchunk) chunksize)
4384 (setq ps-razchunk q-done)
4385 (message "Formatting...%3d%%"
4387 (/ (* 100 q-done) q-todo)
4388 (/ q-done (/ q-todo 100)))
4391 (defvar ps-last-font nil)
4393 (defun ps-set-font (font)
4394 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
4395 (ps-output (format "/%s F\n" ps-last-font)))
4397 (defun ps-set-bg (color)
4398 (if (setq ps-current-bg color)
4399 (ps-output (format ps-color-format
4400 (nth 0 color) (nth 1 color) (nth 2 color))
4402 (ps-output "false BG\n")))
4404 (defun ps-set-color (color)
4405 (setq ps-current-color (or color ps-default-foreground))
4406 (ps-output (format ps-color-format
4407 (nth 0 ps-current-color)
4408 (nth 1 ps-current-color) (nth 2 ps-current-color))
4412 (defvar ps-current-effect 0)
4415 (defun ps-plot-region (from to font &optional fg-color bg-color effects)
4416 (if (not (equal font ps-current-font))
4419 ;; Specify a foreground color only if one's specified and it's
4420 ;; different than the current.
4421 (if (not (equal fg-color ps-current-color))
4422 (ps-set-color fg-color))
4424 (if (not (equal bg-color ps-current-bg))
4425 (ps-set-bg bg-color))
4427 ;; Specify effects (underline, overline, box, etc)
4429 ((not (integerp effects))
4430 (ps-output "0 EF\n")
4431 (setq ps-current-effect 0))
4432 ((/= effects ps-current-effect)
4433 (ps-output (number-to-string effects) " EF\n")
4434 (setq ps-current-effect effects)))
4436 ;; Starting at the beginning of the specified region...
4440 ;; ...break the region up into chunks separated by tabs, linefeeds,
4441 ;; pagefeeds, control characters, and plot each chunk.
4443 (if (re-search-forward ps-control-or-escape-regexp to t)
4444 ;; region with some control characters or some multi-byte characters
4445 (let* ((match-point (match-beginning 0))
4446 (match (char-after match-point))
4447 (composition (find-composition from (1+ match-point))))
4449 (if (and (nth 2 composition)
4450 (<= (car composition) match-point))
4452 (setq match-point (car composition)
4454 (goto-char (nth 1 composition)))
4455 (setq composition nil)))
4456 (when (< from match-point)
4457 (ps-mule-set-ascii-font)
4458 (ps-plot 'ps-basic-plot-string from match-point bg-color))
4460 ((= match ?\t) ; tab
4461 (let ((linestart (line-beginning-position)))
4463 (setq from (+ linestart (current-column)))
4464 (when (re-search-forward "[ \t]+" to t)
4465 (ps-mule-set-ascii-font)
4466 (ps-plot 'ps-basic-plot-whitespace
4467 from (+ linestart (current-column))
4470 ((= match ?\n) ; newline
4473 ((= match ?\f) ; form feed
4474 ;; do not skip page if previous character is NEWLINE and
4475 ;; it is a beginning of page.
4476 (or (and (= (char-after (1- match-point)) ?\n)
4477 (= ps-height-remaining ps-print-height))
4480 (composition ; a composite sequence
4481 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
4483 ; characters from ^@ to ^_ and
4484 ((> match 255) ; a multi-byte character
4485 (let* ((charset (char-charset match))
4486 (composition (find-composition match-point to))
4487 (stop (if (nth 2 composition) (car composition) to)))
4488 (or (eq charset 'composition)
4489 (while (and (< (point) stop) (eq (charset-after) charset))
4491 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
4493 (t ; characters from 127 to 255
4494 (ps-control-character match)))
4495 (setq from (point)))
4496 ;; region without control characters nor multi-byte characters
4497 (ps-mule-set-ascii-font)
4498 (ps-plot 'ps-basic-plot-string from to bg-color)
4501 (defvar ps-string-control-codes
4502 (let ((table (make-vector 256 nil))
4504 ;; control character
4505 (while (<= char ?\037)
4506 (aset table char (format "^%c" (+ char ?@)))
4507 (setq char (1+ char)))
4508 ;; printable character
4509 (while (< char ?\177)
4510 (aset table char (format "%c" char))
4511 (setq char (1+ char)))
4513 (aset table char "^?")
4515 (while (<= (setq char (1+ char)) ?\377)
4516 (aset table char (format "\\%o" char)))
4518 "Vector used to map characters to a printable string.")
4520 (defun ps-control-character (char)
4521 (let* ((str (aref ps-string-control-codes char))
4525 (char-width (ps-avg-char-width 'ps-font-for-text))
4526 (wrappoint (ps-find-wrappoint from to char-width)))
4527 (if (< (car wrappoint) to)
4529 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
4530 (ps-mule-prepare-ascii-font str)
4531 (ps-output-string str)
4532 (ps-output " S\n")))
4534 (defun ps-color-scale (color)
4535 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
4536 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
4537 (ps-color-values color)))
4540 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
4542 (defun ps-color-values (x-color)
4543 (if (fboundp 'x-color-values)
4544 (x-color-values x-color)
4545 (error "No available function to determine X color values.")))
4550 (defun ps-color-values (x-color)
4551 (let ((the-color (if (color-specifier-p x-color)
4552 (color-name x-color)
4555 ((fboundp 'x-color-values)
4556 (x-color-values the-color))
4557 ((and (fboundp 'color-instance-rgb-components)
4559 (color-instance-rgb-components
4560 (if (color-instance-p x-color)
4562 (make-color-instance the-color))))
4564 (error "No available function to determine X color values.")))))
4568 (defun ps-face-attributes (face)
4569 "Return face attribute vector.
4571 If FACE is not in `ps-print-face-extension-alist' or in
4572 `ps-print-face-alist', insert it on `ps-print-face-alist' and
4573 return the attribute vector.
4575 If FACE is not a valid face name, it is used default face."
4576 (cdr (or (assq face ps-print-face-extension-alist)
4577 (assq face ps-print-face-alist)
4578 (let* ((the-face (if (facep face) face 'default))
4579 (new-face (ps-screen-to-bit-face the-face)))
4580 (or (and (eq the-face 'default)
4581 (assq the-face ps-print-face-alist))
4582 (setq ps-print-face-alist (cons new-face ps-print-face-alist)))
4586 (defun ps-face-background (face background)
4587 (and (or (eq ps-use-face-background t)
4588 (cond ((symbolp face)
4589 (memq face ps-use-face-background))
4593 (if (memq (car face) ps-use-face-background)
4596 (setq face (cdr face))))
4604 (defun ps-face-attribute-list (face-or-list)
4605 (if (listp face-or-list)
4608 foreground background face-attr face)
4610 (setq face (car face-or-list)
4611 face-or-list (cdr face-or-list)
4612 face-attr (ps-face-attributes face)
4613 effects (logior effects (aref face-attr 0)))
4614 (or foreground (setq foreground (aref face-attr 1)))
4616 (setq background (ps-face-background face (aref face-attr 2)))))
4617 (vector effects foreground background))
4619 (ps-face-attributes face-or-list)))
4622 (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
4625 (defun ps-plot-with-face (from to face)
4627 ((null face) ; print text with null face
4628 (ps-plot-region from to 0))
4629 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
4630 (t ; otherwise, text has a valid face
4631 (let* ((face-bit (ps-face-attribute-list face))
4632 (effect (aref face-bit 0))
4633 (foreground (aref face-bit 1))
4634 (background (ps-face-background face (aref face-bit 2)))
4635 (fg-color (if (and ps-color-p foreground)
4636 (ps-color-scale foreground)
4638 (bg-color (and ps-color-p background
4639 (ps-color-scale background))))
4642 (ps-font-number 'ps-font-for-text
4643 (or (aref ps-font-type (logand effect 3))
4645 fg-color bg-color (lsh effect -2)))))
4649 (defun ps-xemacs-face-kind-p (face kind kind-regex)
4650 (let* ((frame-font (or (face-font-instance face)
4651 (face-font-instance 'default)))
4652 (kind-cons (and frame-font
4654 (font-instance-properties frame-font))))
4655 (kind-spec (cdr-safe kind-cons))
4656 (case-fold-search t))
4657 (and kind-spec (string-match kind-regex kind-spec))))
4660 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
4662 (defun ps-face-bold-p (face)
4663 (or (face-bold-p face)
4664 (memq face ps-bold-faces)))
4666 (defun ps-face-italic-p (face)
4667 (or (face-italic-p face)
4668 (memq face ps-italic-faces)))
4673 (defun ps-face-bold-p (face)
4674 (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
4675 (memq face ps-bold-faces))) ; Kludge-compatible
4677 (defun ps-face-italic-p (face)
4678 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
4679 (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
4680 (memq face ps-italic-faces))) ; Kludge-compatible
4684 (defun ps-face-underlined-p (face)
4685 (or (face-underline-p face)
4686 (memq face ps-underlined-faces)))
4689 ;; Ensure that face-list is fbound.
4690 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
4693 (defun ps-build-reference-face-lists ()
4694 ;; Ensure that face database is updated with faces on
4695 ;; `font-lock-face-attributes' (obsolete stuff)
4696 (ps-font-lock-face-attributes)
4697 ;; Now, rebuild reference face lists
4698 (setq ps-print-face-alist nil)
4699 (if ps-auto-font-detect
4700 (mapcar 'ps-map-face (face-list))
4701 (mapcar 'ps-set-face-bold ps-bold-faces)
4702 (mapcar 'ps-set-face-italic ps-italic-faces)
4703 (mapcar 'ps-set-face-underline ps-underlined-faces))
4704 (setq ps-build-face-reference nil))
4707 (defun ps-set-face-bold (face)
4708 (ps-set-face-attribute face 1))
4710 (defun ps-set-face-italic (face)
4711 (ps-set-face-attribute face 2))
4713 (defun ps-set-face-underline (face)
4714 (ps-set-face-attribute face 4))
4717 (defun ps-set-face-attribute (face effect)
4718 (let ((face-bit (cdr (ps-map-face face))))
4719 (aset face-bit 0 (logior (aref face-bit 0) effect))))
4722 (defun ps-map-face (face)
4723 (let* ((face-map (ps-screen-to-bit-face face))
4724 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
4726 ;; if face exists, merge both
4727 (let ((face-bit (cdr face-map)))
4728 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
4729 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
4730 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
4731 ;; if face does not exist, insert it
4732 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
4736 (defun ps-screen-to-bit-face (face)
4738 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
4739 (if (ps-face-italic-p face) 2 0) ; italic
4740 (if (ps-face-underlined-p face) 4 0)) ; underline
4741 (face-foreground face)
4742 (face-background face))))
4745 (cond ((not (eq ps-print-emacs-type 'emacs))
4749 (defun ps-mapper (extent list)
4750 (nconc list (list (list (extent-start-position extent) 'push extent)
4751 (list (extent-end-position extent) 'pull extent)))
4754 (defun ps-extent-sorter (a b)
4755 (< (extent-priority a) (extent-priority b)))
4759 (defun ps-print-ensure-fontified (start end)
4760 (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode)
4761 (lazy-lock-fontify-region start end)))
4763 (defun ps-generate-postscript-with-faces (from to)
4764 ;; Some initialization...
4765 (setq ps-current-effect 0)
4767 ;; Build the reference lists of faces if necessary.
4768 (if (or ps-always-build-face-reference
4769 ps-build-face-reference)
4771 (message "Collecting face information...")
4772 (ps-build-reference-face-lists)))
4773 ;; Generate some PostScript.
4775 (narrow-to-region from to)
4776 (ps-print-ensure-fontified from to)
4777 (let ((face 'default)
4780 ((or (eq ps-print-emacs-type 'lucid)
4781 (eq ps-print-emacs-type 'xemacs))
4782 ;; Build the list of extents...
4783 (let ((a (cons 'dummy nil))
4784 record type extent extent-list)
4785 (map-extents 'ps-mapper nil from to a)
4786 (setq a (sort (cdr a) 'car-less-than-car)
4789 ;; Loop through the extents...
4791 (setq record (car a)
4793 position (car record)
4799 extent (car record))
4801 ;; Plot up to this record.
4802 ;; XEmacs 19.12: for some reason, we're getting into a
4803 ;; situation in which some of the records have
4804 ;; positions less than 'from'. Since we've narrowed
4805 ;; the buffer, this'll generate errors. This is a
4806 ;; hack, but don't call ps-plot-with-face unless from >
4808 (and (>= from (point-min)) (<= position (point-max))
4809 (ps-plot-with-face from position face))
4813 (and (extent-face extent)
4814 (setq extent-list (sort (cons extent extent-list)
4815 'ps-extent-sorter))))
4818 (setq extent-list (sort (delq extent extent-list)
4819 'ps-extent-sorter))))
4821 (setq face (if extent-list
4822 (extent-face (car extent-list))
4827 ((eq ps-print-emacs-type 'emacs)
4828 (let ((property-change from)
4829 (overlay-change from)
4830 (save-buffer-invisibility-spec buffer-invisibility-spec)
4831 (buffer-invisibility-spec nil))
4833 (and (< property-change to) ; Don't search for property change
4834 ; unless previous search succeeded.
4835 (setq property-change (next-property-change from nil to)))
4836 (and (< overlay-change to) ; Don't search for overlay change
4837 ; unless previous search succeeded.
4838 (setq overlay-change (min (next-overlay-change from) to)))
4839 (setq position (min property-change overlay-change))
4840 ;; The code below is not quite correct,
4841 ;; because a non-nil overlay invisible property
4842 ;; which is inactive according to the current value
4843 ;; of buffer-invisibility-spec nonetheless overrides
4844 ;; a face text property.
4846 (cond ((let ((prop (get-text-property from 'invisible)))
4847 ;; Decide whether this invisible property
4848 ;; really makes the text invisible.
4849 (if (eq save-buffer-invisibility-spec t)
4851 (or (memq prop save-buffer-invisibility-spec)
4852 (assq prop save-buffer-invisibility-spec))))
4853 'emacs--invisible--face)
4854 ((get-text-property from 'face))
4856 (let ((overlays (overlays-at from))
4857 (face-priority -1)) ; text-property
4858 (while (and overlays
4859 (not (eq face 'emacs--invisible--face)))
4860 (let* ((overlay (car overlays))
4861 (overlay-invisible (overlay-get overlay 'invisible))
4862 (overlay-priority (or (overlay-get overlay 'priority)
4864 (and (> overlay-priority face-priority)
4866 (cond ((if (eq save-buffer-invisibility-spec t)
4867 (not (null overlay-invisible))
4868 (or (memq overlay-invisible
4869 save-buffer-invisibility-spec)
4870 (assq overlay-invisible
4871 save-buffer-invisibility-spec)))
4872 'emacs--invisible--face)
4873 ((overlay-get overlay 'face))
4875 face-priority overlay-priority)))
4876 (setq overlays (cdr overlays))))
4877 ;; Plot up to this record.
4878 (ps-plot-with-face from position face)
4879 (setq from position)))))
4880 (ps-plot-with-face from to face))))
4882 (defun ps-generate-postscript (from to)
4883 (ps-plot-region from to 0 nil))
4885 (defun ps-generate (buffer from to genfunc)
4887 (let ((from (min to from))
4889 ;; This avoids trouble if chars with read-only properties
4890 ;; are copied into ps-spool-buffer.
4891 (inhibit-read-only t))
4893 (narrow-to-region from to)
4894 (and ps-razzle-dazzle
4895 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
4896 (setq ps-source-buffer buffer
4897 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
4898 (ps-init-output-queue)
4899 (let (safe-marker completed-safely needs-begin-file)
4902 (set-buffer ps-spool-buffer)
4903 (set-buffer-multibyte nil)
4905 ;; Get a marker and make it point to the current end of the
4906 ;; buffer, If an error occurs, we'll delete everything from
4907 ;; the end of this marker onwards.
4908 (setq safe-marker (make-marker))
4909 (set-marker safe-marker (point-max))
4911 (goto-char (point-min))
4912 (or (looking-at (regexp-quote ps-adobe-tag))
4913 (setq needs-begin-file t))
4915 (set-buffer ps-source-buffer)
4917 (when needs-begin-file
4919 (ps-mule-initialize))
4920 (ps-mule-begin-job from to)
4922 (set-buffer ps-source-buffer)
4923 (funcall genfunc from to)
4926 (ps-end-file needs-begin-file)
4929 ;; Setting this variable tells the unwind form that the
4930 ;; the PostScript was generated without error.
4931 (setq completed-safely t))
4933 ;; Unwind form: If some bad mojo occurred while generating
4934 ;; PostScript, delete all the PostScript that was generated.
4935 ;; This protects the previously spooled files from getting
4937 (and (markerp safe-marker) (not completed-safely)
4939 (set-buffer ps-spool-buffer)
4940 (delete-region (marker-position safe-marker) (point-max))))))
4942 (and ps-razzle-dazzle (message "Formatting...done"))))))
4945 (defun ps-end-job ()
4947 (let ((total-lines (cdr ps-printing-region))
4948 (total-pages (if ps-print-only-one-header
4952 (set-buffer ps-spool-buffer)
4953 ;; Back to the PS output buffer to set the page count
4954 (goto-char (point-min))
4955 (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
4956 (replace-match (format "/Lines %d def\n/PageCount %d def"
4957 total-lines total-pages) t))))
4960 (defvar ps-printer-name-option
4961 (cond (ps-windows-system
4969 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
4970 (defun ps-do-despool (filename)
4971 (if (or (not (boundp 'ps-spool-buffer))
4972 (not (symbol-value 'ps-spool-buffer)))
4973 (message "No spooled PostScript to print")
4976 (and ps-razzle-dazzle (message "Saving..."))
4977 (set-buffer ps-spool-buffer)
4978 (setq filename (expand-file-name filename))
4979 (let ((coding-system-for-write 'raw-text-unix))
4980 (write-region (point-min) (point-max) filename))
4981 (and ps-razzle-dazzle (message "Wrote %s" filename)))
4982 ;; Else, spool to the printer
4983 (and ps-razzle-dazzle (message "Printing..."))
4985 (set-buffer ps-spool-buffer)
4986 (let* ((coding-system-for-write 'raw-text-unix)
4987 (ps-printer-name (or ps-printer-name
4988 (and (boundp 'printer-name)
4991 (append (and (stringp ps-printer-name)
4992 (list (concat ps-printer-name-option
4995 (apply (or ps-print-region-function 'call-process-region)
4996 (point-min) (point-max) ps-lpr-command nil
4997 (and (fboundp 'start-process) 0)
4999 (ps-flatten-list ; dynamic evaluation
5000 (mapcar 'ps-eval-switch ps-lpr-switches)))))
5001 (and ps-razzle-dazzle (message "Printing...done")))
5002 (kill-buffer ps-spool-buffer)))
5004 ;; Dynamic evaluation
5005 (defun ps-eval-switch (arg)
5006 (cond ((stringp arg) arg)
5007 ((functionp arg) (apply arg nil))
5008 ((symbolp arg) (symbol-value arg))
5009 ((consp arg) (apply (car arg) (cdr arg)))
5012 ;; `ps-flatten-list' is defined here (copied from "message.el" and
5013 ;; enhanced to handle dotted pairs as well) until we can get some
5014 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
5016 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
5017 ;; => (a b c d e f g h i j)
5019 (defun ps-flatten-list (&rest list)
5020 (ps-flatten-list-1 list))
5022 (defun ps-flatten-list-1 (list)
5023 (cond ((null list) nil)
5024 ((consp list) (append (ps-flatten-list-1 (car list))
5025 (ps-flatten-list-1 (cdr list))))
5028 (defun ps-kill-emacs-check ()
5030 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
5031 (buffer-modified-p ps-buffer)
5032 (y-or-n-p "Unprinted PostScript waiting; print now? ")
5034 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
5035 (buffer-modified-p ps-buffer)
5036 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
5037 (error "Unprinted PostScript"))))
5039 (cond ((fboundp 'add-hook)
5040 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
5042 (message "Won't override existing `kill-emacs-hook'"))
5044 (setq kill-emacs-hook 'ps-kill-emacs-check)))
5047 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5048 ;;; Sample Setup Code:
5051 ;; This stuff is for anybody that's brave enough to look this far,
5052 ;; and able to figure out how to use it. It isn't really part of
5053 ;; ps-print, but I'll leave it here in hopes it might be useful:
5055 ;; WARNING!!! The following code is *sample* code only.
5056 ;; Don't use it unless you understand what it does!
5058 (defmacro ps-prsc ()
5059 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
5060 (defmacro ps-c-prsc ()
5061 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
5062 (defmacro ps-s-prsc ()
5063 `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
5065 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
5066 ;; `ps-left-headers' specially for mail messages.
5067 (defun ps-rmail-mode-hook ()
5068 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
5069 (setq ps-header-lines 3
5071 ;; The left headers will display the message's subject, its
5072 ;; author, and the name of the folder it was in.
5073 '(ps-article-subject ps-article-author buffer-name)))
5075 ;; See `ps-gnus-print-article-from-summary'. This function does the
5076 ;; same thing for rmail.
5077 (defun ps-rmail-print-message-from-summary ()
5079 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
5081 ;; Used in `ps-rmail-print-article-from-summary',
5082 ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
5083 (defun ps-print-message-from-summary (summary-buffer summary-default)
5084 (let ((ps-buf (or (and (boundp summary-buffer)
5085 (symbol-value summary-buffer))
5087 (and (get-buffer ps-buf)
5090 (ps-spool-buffer-with-faces)))))
5092 ;; Look in an article or mail message for the Subject: line. To be
5093 ;; placed in `ps-left-headers'.
5094 (defun ps-article-subject ()
5096 (goto-char (point-min))
5097 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
5098 (buffer-substring (match-beginning 1) (match-end 1))
5101 ;; Look in an article or mail message for the From: line. Sorta-kinda
5102 ;; understands RFC-822 addresses and can pull the real name out where
5103 ;; it's provided. To be placed in `ps-left-headers'.
5104 (defun ps-article-author ()
5106 (goto-char (point-min))
5107 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
5108 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
5111 ;; Try first to match addresses that look like
5112 ;; thompson@wg2.waii.com (Jim Thompson)
5113 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
5114 (substring fromstring (match-beginning 1) (match-end 1)))
5116 ;; Next try to match addresses that look like
5117 ;; Jim Thompson <thompson@wg2.waii.com> or
5118 ;; "Jim Thompson" <thompson@wg2.waii.com>
5119 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
5120 (substring fromstring (match-beginning 2) (match-end 2)))
5122 ;; Couldn't find a real name -- show the address instead.
5126 ;; A hook to bind to `gnus-article-prepare-hook'. This will set the
5127 ;; `ps-left-headers' specially for gnus articles. Unfortunately,
5128 ;; `gnus-article-mode-hook' is called only once, the first time the *Article*
5129 ;; buffer enters that mode, so it would only work for the first time
5130 ;; we ran gnus. The second time, this hook wouldn't get set up. The
5131 ;; only alternative is `gnus-article-prepare-hook'.
5132 (defun ps-gnus-article-prepare-hook ()
5133 (setq ps-header-lines 3
5135 ;; The left headers will display the article's subject, its
5136 ;; author, and the newsgroup it was in.
5137 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
5139 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
5140 ;; `ps-left-headers' specially for mail messages.
5141 (defun ps-vm-mode-hook ()
5142 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
5143 (setq ps-header-lines 3
5145 ;; The left headers will display the message's subject, its
5146 ;; author, and the name of the folder it was in.
5147 '(ps-article-subject ps-article-author buffer-name)))
5149 ;; Every now and then I forget to switch from the *Summary* buffer to
5150 ;; the *Article* before hitting prsc, and a nicely formatted list of
5151 ;; article subjects shows up at the printer. This function, bound to
5152 ;; prsc for the gnus *Summary* buffer means I don't have to switch
5154 ;; sb: Updated for Gnus 5.
5155 (defun ps-gnus-print-article-from-summary ()
5157 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
5159 ;; See `ps-gnus-print-article-from-summary'. This function does the
5160 ;; same thing for vm.
5161 (defun ps-vm-print-message-from-summary ()
5163 (ps-print-message-from-summary 'vm-mail-buffer ""))
5165 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
5167 (defun ps-gnus-summary-setup ()
5168 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
5170 ;; Look in an article or mail message for the Subject: line. To be
5171 ;; placed in `ps-left-headers'.
5172 (defun ps-info-file ()
5174 (goto-char (point-min))
5175 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
5176 (buffer-substring (match-beginning 1) (match-end 1))
5179 ;; Look in an article or mail message for the Subject: line. To be
5180 ;; placed in `ps-left-headers'.
5181 (defun ps-info-node ()
5183 (goto-char (point-min))
5184 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
5185 (buffer-substring (match-beginning 1) (match-end 1))
5188 (defun ps-info-mode-hook ()
5189 (setq ps-left-header
5190 ;; The left headers will display the node name and file name.
5191 '(ps-info-node ps-info-file)))
5193 ;; WARNING! The following function is a *sample* only, and is *not*
5194 ;; meant to be used as a whole unless you understand what the effects
5195 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
5196 ;; I'd be very surprised if it was useful to *anybody*, without
5199 (defun ps-jts-ps-setup ()
5200 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
5201 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
5202 (global-set-key (ps-c-prsc) 'ps-despool)
5203 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
5204 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
5205 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
5206 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
5207 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
5208 (setq ps-spool-duplex t
5209 ps-print-color-p nil
5210 ps-lpr-command "lpr"
5211 ps-lpr-switches '("-Jjct,duplex_long"))
5214 ;; WARNING! The following function is a *sample* only, and is *not*
5215 ;; meant to be used as a whole unless it corresponds to your needs.
5216 ;; (In fact, this is a copy of Jack's setup for ps-print --
5217 ;; I would not be that surprised if it was useful to *anybody*,
5218 ;; without modification.)
5220 (defun ps-jack-setup ()
5221 (setq ps-print-color-p nil
5222 ps-lpr-command "lpr"
5227 ps-number-of-columns 2
5229 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
5230 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
5231 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
5232 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
5233 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
5234 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
5235 ps-header-line-pad .15
5237 ps-print-header-frame t
5242 ps-font-family 'Courier
5244 ps-header-font-family 'Helvetica
5245 ps-header-font-size 6
5246 ps-header-title-font-size 8)
5250 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5251 ;; To make this file smaller, some commands go in a separate file.
5252 ;; But autoload them here to make the separation invisible.
5254 (autoload 'ps-mule-prepare-ascii-font "ps-mule"
5255 "Setup special ASCII font for STRING.
5256 STRING should contain only ASCII characters.")
5258 (autoload 'ps-mule-set-ascii-font "ps-mule"
5259 "Adjust current font if current charset is not ASCII.")
5261 (autoload 'ps-mule-plot-string "ps-mule"
5262 "Generate PostScript code for ploting characters in the region FROM and TO.
5264 It is assumed that all characters in this region belong to the same charset.
5266 Optional argument BG-COLOR specifies background color.
5270 (ENDPOS . RUN-WIDTH)
5272 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
5275 (autoload 'ps-mule-initialize "ps-mule"
5276 "Initialize global data for printing multi-byte characters.")
5278 (autoload 'ps-mule-begin-job "ps-mule"
5279 "Start printing job for multi-byte chars between FROM and TO.
5280 This checks if all multi-byte characters in the region are printable or not.")
5282 (autoload 'ps-mule-begin-page "ps-mule"
5283 "Initialize multi-byte charset for printing current page.")
5286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5290 ;;; ps-print.el ends here