1 ;;; ps-print.el --- print text from the buffer as PostScript
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
4 ;; Free Software Foundation, Inc.
6 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
7 ;; Jacques Duthen (was <duthen@cegelec-red.fr>)
8 ;; Vinicius Jose Latorre <vinicius@cpqd.com.br>
9 ;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
11 ;; Vinicius Jose Latorre <vinicius@cpqd.com.br>
12 ;; Keywords: wp, print, PostScript
13 ;; Time-stamp: <2001/11/28 17:28:17 vinicius>
15 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
17 (defconst ps-print-version "6.5.6"
18 "ps-print.el, v 6.5.6 <2001/11/28 vinicius>
20 Vinicius's last change version -- this file may have been edited as part of
21 Emacs without changes to the version number. When reporting bugs, please also
22 report the version of Emacs, if any, that ps-print was distributed with.
24 Please send all bug fixes and enhancements to
25 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
28 ;; This file is part of GNU Emacs.
30 ;; GNU Emacs is free software; you can redistribute it and/or modify it under
31 ;; the terms of the GNU General Public License as published by the Free
32 ;; Software Foundation; either version 2, or (at your option) any later
35 ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
36 ;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
37 ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
40 ;; You should have received a copy of the GNU General Public License along with
41 ;; GNU Emacs; see the file COPYING. If not, write to the Free Software
42 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
46 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 ;; This package provides printing of Emacs buffers on PostScript printers; the
52 ;; buffer's bold and italic text attributes are preserved in the printer
53 ;; output. ps-print is intended for use with Emacs or Lucid Emacs, together
54 ;; with a fontifying package such as font-lock or hilit.
56 ;; ps-print uses the same face attributes defined through font-lock or hilit to
57 ;; print a PostScript file, but some faces are better seeing on the screen than
58 ;; on paper, specially when you have a black/white PostScript printer.
60 ;; ps-print allows a remap of face to another one that it is better to print,
61 ;; for example, the face font-lock-comment-face (if you are using font-lock)
62 ;; could have bold or italic attribute when printing, besides foreground color.
63 ;; This remap improves printing look (see How Ps-Print Maps Faces).
69 ;; ps-print provides eight commands for generating PostScript images of Emacs
73 ;; ps-print-buffer-with-faces
75 ;; ps-print-region-with-faces
77 ;; ps-spool-buffer-with-faces
79 ;; ps-spool-region-with-faces
81 ;; These commands all perform essentially the same function: they generate
82 ;; PostScript images suitable for printing on a PostScript printer or
83 ;; displaying with GhostScript. These commands are collectively referred to as
84 ;; "ps-print- commands".
86 ;; The word "print" or "spool" in the command name determines when the
87 ;; PostScript image is sent to the printer:
89 ;; print - The PostScript image is immediately sent to the printer;
91 ;; spool - The PostScript image is saved temporarily in an Emacs
92 ;; buffer. Many images may be spooled locally before
93 ;; printing them. To send the spooled images to the
94 ;; printer, use the command `ps-despool'.
96 ;; The spooling mechanism was designed for printing lots of small files (mail
97 ;; messages or netnews articles) to save paper that would otherwise be wasted
98 ;; on banner pages, and to make it easier to find your output at the printer
99 ;; (it's easier to pick up one 50-page printout than to find 50 single-page
102 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't accidentally
103 ;; quit from Emacs while you have unprinted PostScript waiting in the spool
104 ;; buffer. If you do attempt to exit with spooled PostScript, you'll be asked
105 ;; if you want to print it, and if you decline, you'll be asked to confirm the
106 ;; exit; this is modeled on the confirmation that Emacs uses for modified
109 ;; The word "buffer" or "region" in the command name determines how much of the
110 ;; 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 will
117 ;; include font, color, and underline information in the PostScript image, so
118 ;; the printed image can look as pretty as the buffer. The ps-print- commands
119 ;; without the -with-faces suffix don't include font, color, or underline
120 ;; information; images printed with these commands aren't as pretty, but are
121 ;; faster to generate.
123 ;; Two ps-print- command examples:
125 ;; ps-print-buffer - print the entire buffer, without font,
126 ;; color, or underline information, and
127 ;; send it immediately to the printer.
129 ;; ps-spool-region-with-faces - print just the current region; include
130 ;; font, color, and underline information,
131 ;; and spool the image in Emacs to send to
132 ;; the printer later.
138 ;; To print your buffer, type
140 ;; M-x ps-print-buffer
142 ;; or substitute one of the other seven ps-print- commands. The command will
143 ;; generate the PostScript image and print or spool it as specified. By giving
144 ;; the command a prefix argument
146 ;; C-u M-x ps-print-buffer
148 ;; it will save the PostScript image to a file instead of sending it to the
149 ;; printer; you will be prompted for the name of the file to save the image to.
150 ;; The prefix argument is ignored by the commands that spool their images, but
151 ;; you may save the spooled images to a file by giving a prefix argument to
154 ;; C-u M-x ps-despool
156 ;; When invoked this way, `ps-despool' will prompt you for the name of the file
159 ;; Any of the `ps-print-' commands can be bound to keys; I recommend binding
160 ;; `ps-spool-buffer-with-faces', `ps-spool-region-with-faces', and
161 ;; `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
163 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
164 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
165 ;; (global-set-key '(control f22) 'ps-despool)
168 ;; The Printer Interface
169 ;; ---------------------
171 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what command
172 ;; is used to send the PostScript images to the printer, and what arguments to
173 ;; give the command. These are analogous to `lpr-command' and `lpr-switches'.
175 ;; Make sure that they contain appropriate values for your system;
176 ;; see the usage notes below and the documentation of these variables.
178 ;; The variable `ps-printer-name' determines the name of a local printer for
179 ;; printing PostScript files.
181 ;; The variable `ps-printer-name-option' determines the option used by some
182 ;; utilities to indicate the printer name, it's used only when
183 ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
184 ;; print, for example, `ps-printer-name-option' should be set to "-P".
186 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values from
187 ;; the variables `lpr-command' and `lpr-switches'. If you have
188 ;; `lpr-command' set to invoke a pretty-printer such as `enscript', then
189 ;; ps-print won't work properly. `ps-lpr-command' must name a program
190 ;; that does not format the files it prints.
191 ;; `ps-printer-name' takes its initial value from the variable
192 ;; `printer-name'. `ps-printer-name-option' tries to guess which system
193 ;; Emacs is running and takes its initial value in accordance with this
196 ;; The variable `ps-print-region-function' specifies a function to print the
197 ;; region on a PostScript printer.
198 ;; See definition of `call-process-region' for calling conventions. The fourth
199 ;; and the sixth arguments are both nil.
201 ;; The variable `ps-manual-feed' indicates if the printer will manually feed
202 ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
203 ;; feeding takes place. The default is nil (automatic feeding).
205 ;; The variable `ps-end-with-control-d' specifies whether C-d (\x04) should be
206 ;; inserted at end of PostScript generated. Non-nil means do so. The default
207 ;; is nil (don't insert).
209 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
210 ;; customize the following variables: `ps-printer-name',
211 ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
212 ;; `ps-spool-config'. See these variables documentation in the code or by
213 ;; typing, for example, C-h v ps-printer-name RET.
219 ;; All dimensions are floats in PostScript points.
220 ;; 1 inch == 2.54 cm == 72 points
221 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
223 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
224 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
225 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
228 ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
229 ;; PostScript printer doesn't have a paper with the size indicated by
230 ;; `ps-paper-type', instead it uses the default paper size. If variable
231 ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
232 ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
233 ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
234 ;; Printers). The default value is non-nil (it gives an error).
236 ;; The variable `ps-landscape-mode' determines the orientation of the printing
237 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
238 ;; There is no oblique mode yet, though this is easy to do in ps.
240 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in
241 ;; portrait mode and only 50 lines in landscape mode. The margins represent
242 ;; margins in the printed paper: the top margin is the margin between the top
243 ;; of the page and the printed header, whatever the orientation is.
245 ;; The variable `ps-number-of-columns' determines the number of columns both in
246 ;; landscape and portrait mode.
248 ;; - (the standard) one column portrait mode.
249 ;; - (my favorite) two columns landscape mode (which spares trees).
251 ;; - one column landscape mode for files with very long lines.
252 ;; - multi-column portrait or landscape mode.
254 ;; The variable `ps-print-upside-down' determines other orientation for
255 ;; printing page: nil means `normal' printing, non-nil means `upside-down'
256 ;; printing (that is, the page is rotated by 180 grades). The default value is
257 ;; nil (`normal' printing).
259 ;; The `upside-down' orientation can be used in portrait or landscape mode.
261 ;; The variable `ps-selected-pages' specifies which pages to print. If it's
262 ;; nil, all pages are printed. If it's a list, the list element may be an
263 ;; integer or a cons cell (FROM . TO) designating FROM page to TO page; any
264 ;; invalid element is ignored, that is, an integer lesser than one or if FROM
265 ;; is greater than TO. Otherwise, it's treated as nil. The default value is
266 ;; nil (print all pages). After ps-print processing `ps-selected-pages' is set
267 ;; to nil. But the latest `ps-selected-pages' is saved in
268 ;; `ps-last-selected-pages' (see it for documentation). So you can restore the
269 ;; latest selected pages by using `ps-last-selected-pages' or by calling
270 ;; `ps-restore-selected-pages' command (see it for documentation).
272 ;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
276 ;; nil print all pages.
278 ;; even-page print only even pages.
280 ;; odd-page print only odd pages.
282 ;; even-sheet print only even sheets.
284 ;; odd-sheet print only odd sheets.
286 ;; Any other value is treated as nil. The default value is nil.
288 ;; See `ps-even-or-odd-pages' for more detailed documentation.
294 ;; The horizontal layout is determined by the variables
295 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
298 ;; ------------------------------------------
300 ;; | lm | text | ic | text | ic | text | rm |
302 ;; ------------------------------------------
304 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
305 ;; Usually, lm = rm > 0 and ic = lm
306 ;; If (ic < 0), the text of adjacent columns can overlap.
312 ;; The vertical layout is determined by the variables
313 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' `ps-footer-offset'
316 ;; |--------| |--------| |--------| |--------|
317 ;; | tm | | tm | | tm | | tm |
318 ;; |--------| |--------| |--------| |--------|
319 ;; | header | | | | header | | |
320 ;; |--------| | | |--------| | |
321 ;; | ho | | | | ho | | |
322 ;; |--------| | | |--------| | |
324 ;; | text | or | text | or | text | or | text |
326 ;; | | |--------| |--------| | |
327 ;; | | | fo | | fo | | |
328 ;; | | |--------| |--------| | |
329 ;; | | | footer | | footer | | |
330 ;; |--------| |--------| |--------| |--------|
331 ;; | bm | | bm | | bm | | bm |
332 ;; |--------| |--------| |--------| |--------|
334 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
335 ;; If `ps-print-footer' is nil, `ps-footer-offset' is not relevant.
336 ;; The margins represent margins in the printed paper:
337 ;; the top margin is the margin between the top of the page and the printed
338 ;; header, whatever the orientation is;
339 ;; the bottom margin is the margin between the bottom of the page and the
340 ;; printed footer, whatever the orientation is.
346 ;; ps-print can print headers at the top of each column or at the top of each
347 ;; page; the default headers contain the following four items: on the left, the
348 ;; name of the buffer and, if the buffer is visiting a file, the file's
349 ;; directory; on the right, the page number and date of printing. The default
350 ;; headers look something like this:
353 ;; /home/jct/emacs-lisp/ps/new 94/12/31
355 ;; When printing on duplex printers, left and right are reversed so that the
356 ;; page numbers are toward the outside (cf. `ps-spool-duplex').
358 ;; Headers are configurable:
359 ;; To turn them off completely, set `ps-print-header' to nil.
360 ;; To turn off the header's gaudy framing box,
361 ;; set `ps-print-header-frame' to nil.
363 ;; The variable `ps-header-frame-alist' specifies header frame properties
364 ;; alist. Valid frame properties are:
366 ;; fore-color Specify the foreground frame color.
367 ;; It should be a float number between 0.0 (black color)
368 ;; and 1.0 (white color), a string which is a color name,
369 ;; or a list of 3 float numbers which corresponds to the
370 ;; Red Green Blue color scale, each float number between
371 ;; 0.0 (dark color) and 1.0 (bright color).
372 ;; The default is 0 ("black").
374 ;; back-color Specify the background frame color (similar to
375 ;; fore-color). The default is 0.9 ("gray90").
377 ;; shadow-color Specify the shadow color (similar to fore-color).
378 ;; The default is 0 ("black").
380 ;; border-color Specify the border color (similar to fore-color).
381 ;; The default is 0 ("black").
383 ;; border-width Specify the border width.
384 ;; The default is 0.4.
386 ;; Any other property is ignored.
388 ;; Don't change this alist directly, instead use customization, or `ps-value',
389 ;; `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
391 ;; To print only one header at the top of each page, set
392 ;; `ps-print-only-one-header' to t.
394 ;; To switch headers, set `ps-switch-header' to:
396 ;; nil Never switch headers.
398 ;; t Always switch headers.
400 ;; duplex Switch headers only when duplexing is on, that is, when
401 ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
403 ;; Any other value is treated as t. The default value is `duplex'.
405 ;; The font family and size of text in the header are determined by the
406 ;; variables `ps-header-font-family', `ps-header-font-size' and
407 ;; `ps-header-title-font-size' (see below).
409 ;; The variable `ps-header-line-pad' determines the portion of a header title
410 ;; line height to insert between the header frame and the text it contains,
411 ;; both in the vertical and horizontal directions: .5 means half a line.
413 ;; Page numbers are printed in `n/m' format, indicating page n of m pages; to
414 ;; omit the total page count and just print the page number, set
415 ;; `ps-show-n-of-n' to nil.
417 ;; The amount of information in the header can be changed by changing the
418 ;; number of lines. To show less, set `ps-header-lines' to 1, and the header
419 ;; will show only the buffer name and page number. To show more, set
420 ;; `ps-header-lines' to 3, and the header will show the time of printing below
423 ;; To change the content of the headers, change the variables `ps-left-header'
424 ;; and `ps-right-header'.
425 ;; These variables are lists, specifying top-to-bottom the text to display on
426 ;; the left or right side of the header. Each element of the list should be a
427 ;; string or a symbol. Strings are inserted directly into the PostScript
428 ;; arrays, and should contain the PostScript string delimiters '(' and ')'.
430 ;; Symbols in the header format lists can either represent functions or
431 ;; variables. Functions are called, and should return a string to show in the
432 ;; header. Variables should contain strings to display in the header. In
433 ;; either case, function or variable, the PostScript string delimiters are
434 ;; added by ps-print, and should not be part of the returned value.
436 ;; Here's an example: say we want the left header to display the text
442 ;; where we have a function to return "Moe"
444 ;; (defun moe-func ()
447 ;; a variable specifying "Larry"
449 ;; (setq larry-var "Larry")
451 ;; and a literal for "Curly". Here's how `ps-left-header' should be set:
453 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
455 ;; Note that Curly has the PostScript string delimiters inside his quotes --
456 ;; those aren't misplaced lisp delimiters!
458 ;; Without them, PostScript would attempt to call the undefined function Curly,
459 ;; which would result in a PostScript error.
461 ;; Since most printers don't report PostScript errors except by aborting the
462 ;; print job, this kind of error can be hard to track down.
464 ;; Consider yourself warned!
466 ;; ps-print also print footers. The footer variables are: `ps-print-footer',
467 ;; `ps-footer-offset', `ps-print-footer-frame', `ps-footer-font-family',
468 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
469 ;; `ps-left-footer', `ps-right-footer' and `ps-footer-frame-alist'. These
470 ;; variables are similar to those one that control headers.
472 ;; The variables `ps-print-only-one-header' and `ps-switch-header' also control
473 ;; the footer (The same way that control header).
475 ;; As a footer example, if you want to have a centered page number in the
476 ;; footer but without headers, set:
478 ;; (setq ps-print-header nil
480 ;; ps-print-footer-frame nil
482 ;; ps-right-footer nil
484 ;; (list (concat "{pagenumberstring dup stringwidth pop"
485 ;; " 2 div PrintWidth 2 div exch sub 0 rmoveto}")))
488 ;; PostScript Prologue Header
489 ;; --------------------------
491 ;; It is possible to add PostScript prologue header comments besides that
492 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
494 ;; `ps-print-prologue-header' may be a string or a symbol function which
495 ;; returns a string. Note that this string is inserted on PostScript prologue
496 ;; header section which is used to define some document characteristic through
497 ;; PostScript special comments, like "%%Requirements: jog\n".
499 ;; By default `ps-print-prologue-header' is nil.
501 ;; ps-print always inserts the %%Requirements: comment, so if you need to
502 ;; insert more requirements put them first in `ps-print-prologue-header' using
503 ;; the "%%+" comment. For example, if you need to set numcopies to 3 and jog
504 ;; on requirements and set %%LanguageLevel: to 2, do:
506 ;; (setq ps-print-prologue-header
507 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
509 ;; The duplex requirement is inserted by ps-print (see section Duplex
512 ;; Do not forget to terminate the string with "\n".
514 ;; For more information about PostScript document comments, see:
515 ;; PostScript Language Reference Manual (2nd edition)
516 ;; Adobe Systems Incorporated
517 ;; Appendix G: Document Structuring Conventions -- Version 3.0
519 ;; It is also possible to add an user defined PostScript prologue code before
520 ;; all generated prologue code by setting the variable
521 ;; `ps-user-defined-prologue'.
523 ;; `ps-user-defined-prologue' may be a string or a symbol function which
524 ;; returns a string. Note that this string is inserted after `ps-adobe-tag'
525 ;; and PostScript prologue comments, and before ps-print PostScript prologue
526 ;; code section. That is, this string is inserted after error handler
527 ;; initialization and before ps-print settings.
529 ;; By default `ps-user-defined-prologue' is nil.
531 ;; It's strongly recommended only insert PostScript code and/or comments
532 ;; specific for your printing system particularities. For example, some
533 ;; special initialization that only your printing system needs.
535 ;; Do not insert code for duplex printing, n-up printing or error handler,
536 ;; ps-print handles this in a suitable way.
538 ;; For more information about PostScript, see:
539 ;; PostScript Language Reference Manual (2nd edition)
540 ;; Adobe Systems Incorporated
542 ;; As an example for `ps-user-defined-prologue' setting:
544 ;; ;; Setting for HP PostScript printer
545 ;; (setq ps-user-defined-prologue
546 ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
547 ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
550 ;; PostScript Error Handler
551 ;; ------------------------
553 ;; ps-print instruments generated PostScript code with an error handler.
555 ;; The variable `ps-error-handler-message' specifies where the error handler
556 ;; message should be sent.
560 ;; none catch the error and *DON'T* send any message.
562 ;; paper catch the error and print on paper the error message.
563 ;; This is the default value.
565 ;; system catch the error and send back the error message to
566 ;; printing system. This is useful only if printing
567 ;; system send back an email reporting the error, or if
568 ;; there is some other alternative way to report back the
569 ;; error from the system to you.
571 ;; paper-and-system catch the error, print on paper the error message and
572 ;; send back the error message to printing system.
574 ;; Any other value is treated as `paper'.
580 ;; If you have a duplex-capable printer (one that prints both sides of the
581 ;; paper), set `ps-spool-duplex' to t.
582 ;; ps-print will insert blank pages to make sure each buffer starts on the
583 ;; correct side of the paper.
585 ;; The variable `ps-spool-config' specifies who is the responsible for setting
586 ;; duplex and page size. Valid values are:
588 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
589 ;; Don't forget to set `ps-lpr-switches' to select duplex
590 ;; printing for your printer.
592 ;; setpagedevice duplex and page size are configured by ps-print using the
593 ;; setpagedevice PostScript operator.
595 ;; nil duplex and page size are configured by ps-print *not* using
596 ;; the setpagedevice PostScript operator.
598 ;; Any other value is treated as nil.
600 ;; The default value is `lpr-switches'.
602 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility
603 ;; when viewing file generated using landscape. Also on some
604 ;; printers, setpagedevice affects zebra stripes; on other printers,
605 ;; setpagedevice affects the left margin.
606 ;; Besides all that, if your printer does not have the paper size
607 ;; specified by setpagedevice, your printing will be aborted.
608 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
609 ;; `setpagedevice', generate a test file and send it to your printer;
610 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
612 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
613 ;; sides of a sheet are oriented with respect to each other. If
614 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left
615 ;; or right. If `ps-spool-tumble' is non-nil, produces output suitable for
616 ;; binding at the top or bottom. It has effect only when `ps-spool-duplex' is
617 ;; non-nil. The default value is nil.
619 ;; Some printer system prints a header page and forces the first page be
620 ;; printed on header page back, when using duplex. If your printer system has
621 ;; this behavior, set variable `ps-banner-page-when-duplexing' to t.
623 ;; When `ps-banner-page-when-duplexing' is non-nil, it prints a blank page as
624 ;; the very first printed page. So, it behaves as the very first character of
625 ;; buffer (or region) is ^L (\014).
627 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the
634 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
635 ;; paper. The value specified must be between 1 and 100. The default is 1.
637 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is
638 ;; set to a high value (for example, 23). If this happens, set a lower value.
640 ;; The variable `ps-n-up-margin' specifies the margin in points between the
641 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
644 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each
645 ;; page. The default is t.
647 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
648 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
649 ;; filling example using a 3x4 page matrix:
651 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
653 ;; 9 10 11 12 1 2 3 4
655 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
657 ;; 12 11 10 9 4 3 2 1
659 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
663 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
667 ;; Any other value is treated as `left-top'.
669 ;; The default value is left-top.
672 ;; Control And 8-bit Characters
673 ;; ----------------------------
675 ;; The variable `ps-print-control-characters' specifies whether you want to see
676 ;; a printable form for control and 8-bit characters, that is, instead of
677 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
679 ;; Valid values for `ps-print-control-characters' are:
681 ;; 8-bit This is the value to use when you want an ASCII encoding of
682 ;; any control or non-ASCII character. Control characters are
683 ;; encoded as "^D", and non-ASCII characters have an
686 ;; control-8-bit This is the value to use when you want an ASCII encoding of
687 ;; any control character, whether it is 7 or 8-bit.
688 ;; European 8-bits accented characters are printed according
691 ;; control Only ASCII control characters have an ASCII encoding.
692 ;; European 8-bits accented characters are printed according
695 ;; nil No ASCII encoding. Any character is printed according the
698 ;; Any other value is treated as nil.
700 ;; The default is `control-8-bit'.
702 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
705 ;; Printing Multi-byte Buffer
706 ;; --------------------------
708 ;; See ps-mule.el for documentation.
714 ;; The variable `ps-line-number' specifies whether to number each line;
715 ;; non-nil means do so. The default is nil (don't number each line).
717 ;; The variable `ps-line-number-color' specifies the color for line number.
718 ;; See `ps-zebra-color' for documentation. The default is "black" (or 0.0, or
721 ;; The variable `ps-line-number-font' specifies the font for line number.
722 ;; The default is "Times-Italic".
724 ;; The variable `ps-line-number-font-size' specifies the font size in points
725 ;; for line number. See `ps-font-size' for documentation. The default is 6.
727 ;; The variable `ps-line-number-step' specifies the interval that line number
728 ;; is printed. For example, if `ps-line-number-step' is set to 2, the printing
741 ;; integer an integer that specifies the interval that line number is
742 ;; printed. If it's lesser than or equal to zero, it's used the
745 ;; `zebra' specifies that only the line number of the first line in a
746 ;; zebra stripe is to be printed.
748 ;; Any other value is treated as `zebra'.
749 ;; The default value is 1, so each line number is printed.
751 ;; The variable `ps-line-number-start' specifies the starting point in the
752 ;; interval given by `ps-line-number-step'. For example, if
753 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3,
754 ;; the printing will look like:
768 ;; The values for `ps-line-number-start':
770 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
771 ;; of `ps-line-number-step' inclusive.
773 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
774 ;; value of `ps-zebra-stripe-height' inclusive.
776 ;; The default value is 1, so the line number of the first line of each
777 ;; interval is printed.
783 ;; Zebra stripes are a kind of background that appear "underneath" the text and
784 ;; can make the text easier to read. They look like this:
786 ;; XXXXXXXXXXXXXXXXXXXXXXXX
787 ;; XXXXXXXXXXXXXXXXXXXXXXXX
788 ;; XXXXXXXXXXXXXXXXXXXXXXXX
792 ;; XXXXXXXXXXXXXXXXXXXXXXXX
793 ;; XXXXXXXXXXXXXXXXXXXXXXXX
794 ;; XXXXXXXXXXXXXXXXXXXXXXXX
796 ;; The blocks of X's represent rectangles filled with a light gray color.
797 ;; Each rectangle extends all the way across the page.
799 ;; The height, in lines, of each rectangle is controlled by the variable
800 ;; `ps-zebra-stripe-height', which is 3 by default. The distance between
801 ;; stripes equals the height of a stripe.
803 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
804 ;; Non-nil means yes, nil means no. The default is nil.
806 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
807 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
808 ;; color), a string which is a color name, or a list of 3 numbers which
809 ;; corresponds to the Red Green Blue color scale.
810 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
812 ;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
813 ;; on next page. Visually, valid values are (the character `+' at right of
814 ;; each column indicates that a line is printed):
816 ;; `nil' `follow' `full' `full-follow'
817 ;; Current Page -------- ----------- --------- ----------------
818 ;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
819 ;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
820 ;; 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
824 ;; 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
825 ;; 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
826 ;; 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
829 ;; -------- ----------- --------- ----------------
830 ;; Next Page -------- ----------- --------- ----------------
831 ;; 12 XXXXX + 12 + 10 XXXXXX + 10 +
832 ;; 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
833 ;; 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
834 ;; 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
835 ;; 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
836 ;; 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
837 ;; 18 XXXXX + 18 + 16 XXXXXX + 16 +
838 ;; 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
839 ;; 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
840 ;; 21 + 21 XXXXXXXX +
842 ;; -------- ----------- --------- ----------------
844 ;; Any other value is treated as `nil'.
846 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
852 ;; ps-print has the following hook variables:
855 ;; It is evaluated once before any printing process. This is the right
856 ;; place to initialize ps-print global data.
857 ;; For an example, see section Adding a New Font Family.
859 ;; `ps-print-begin-sheet-hook'
860 ;; It is evaluated on each beginning of sheet of paper.
861 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
864 ;; `ps-print-begin-page-hook'
865 ;; It is evaluated on each beginning of page, except in the beginning of
866 ;; page that `ps-print-begin-sheet-hook' is evaluated.
868 ;; `ps-print-begin-column-hook'
869 ;; It is evaluated on each beginning of column, except in the beginning of
870 ;; column that `ps-print-begin-page-hook' is evaluated or that
871 ;; `ps-print-begin-sheet-hook' is evaluated.
877 ;; ps-print now knows rather precisely some fonts: the variable
878 ;; `ps-font-info-database' contains information for a list of font families
879 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino'
880 ;; `Helvetica-Narrow' `NewCenturySchlbk'). Each font family contains the font
881 ;; names for standard, bold, italic and bold-italic characters, a reference
882 ;; size (usually 10) and the corresponding line height, width of a space and
883 ;; average character width.
885 ;; The variable `ps-font-family' determines which font family is to be used for
886 ;; ordinary text. If its value does not correspond to a known font family, an
887 ;; error message is printed into the `*Messages*' buffer, which lists the
888 ;; currently available font families.
890 ;; The variable `ps-font-size' determines the size (in points) of the font for
891 ;; ordinary text, when generating PostScript. Its value is a float or a cons
892 ;; of floats which has the following form:
894 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
896 ;; Similarly, the variable `ps-header-font-family' determines which font family
897 ;; is to be used for text in the header.
899 ;; The variable `ps-header-font-size' determines the font size, in points, for
900 ;; text in the header (similar to `ps-font-size').
902 ;; The variable `ps-header-title-font-size' determines the font size, in
903 ;; points, for the top line of text in the header (similar to `ps-font-size').
905 ;; The variable `ps-line-spacing' determines the line spacing, in points, for
906 ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The
907 ;; default value is 0 (zero = no line spacing).
909 ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in
910 ;; points, for ordinary text, when generating PostScript (similar to
911 ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing).
913 ;; To get all lines with some spacing set both `ps-line-spacing' and
914 ;; `ps-paragraph-spacing' variables.
916 ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It
917 ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an
918 ;; empty line or a line containing only spaces and tabs.
920 ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start
921 ;; and end of a region to cut out when printing.
923 ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may
924 ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave
925 ;; out some special printing instructions from the actual print. Special
926 ;; printing instructions may be appended to the end of the file just like any
927 ;; other buffer-local variables. See section "Local Variables in Files" on
928 ;; Emacs manual for more information.
930 ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together
931 ;; what actually gets printed. Both variables may be set to nil in which case
932 ;; no cutting occurs. By default, both variables are set to nil.
935 ;; Adding a New Font Family
936 ;; ------------------------
938 ;; To use a new font family, you MUST first teach ps-print this font, i.e., add
939 ;; its information to `ps-font-info-database', otherwise ps-print cannot
940 ;; correctly place line and page breaks.
942 ;; For example, assuming `Helvetica' is unknown, you first need to do the
943 ;; following ONLY ONCE:
945 ;; - create a new buffer
946 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
947 ;; - open this file and find the line:
948 ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
949 ;; - delete the leading `%' (which is the PostScript comment character)
950 ;; - replace in this line `Courier' by the new font (say `Helvetica') to get
952 ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
953 ;; - send this file to the printer (or to ghostscript).
954 ;; You should read the following on the output page:
956 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
957 ;; and a crude estimate of average character width is 5.09243
959 ;; - Add these values to the `ps-font-info-database':
960 ;; (setq ps-font-info-database
962 ;; '((Helvetica ; the family key
963 ;; (fonts (normal . "Helvetica")
964 ;; (bold . "Helvetica-Bold")
965 ;; (italic . "Helvetica-Oblique")
966 ;; (bold-italic . "Helvetica-BoldOblique"))
968 ;; (line-height . 11.56)
969 ;; (space-width . 2.78)
970 ;; (avg-char-width . 5.09243)))
971 ;; ps-font-info-database))
972 ;; - Now you can use this font family with any size:
973 ;; (setq ps-font-family 'Helvetica)
974 ;; - if you want to use this family in another emacs session, you must put into
976 ;; (require 'ps-print)
977 ;; (setq ps-font-info-database (append ...)))
978 ;; if you don't want to load ps-print, you have to copy the whole value:
979 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
980 ;; or, use `ps-print-hook' (see section Hooks):
981 ;; (add-hook 'ps-print-hook
983 ;; (or (assq 'Helvetica ps-font-info-database)
984 ;; (setq ps-font-info-database (append ...)))))
986 ;; You can create new `mixed' font families like:
988 ;; (fonts (normal . "Courier-Bold")
989 ;; (bold . "Helvetica")
990 ;; (italic . "Zapf-Chancery-MediumItalic")
991 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
992 ;; (w3-table-hack-x-face . "LineDrawNormal"))
994 ;; (line-height . 10.55)
995 ;; (space-width . 6.0)
996 ;; (avg-char-width . 6.0))
998 ;; Now you can use your new font family with any size:
999 ;; (setq ps-font-family 'my-mixed-family)
1001 ;; Note that on above example the `w3-table-hack-x-face' entry refers to a face
1002 ;; symbol, so when printing this face it'll be used the font `LineDrawNormal'.
1003 ;; If the face `w3-table-hack-x-face' is remapped to use bold and/or italic
1004 ;; attribute, the corresponding entry (bold, italic or bold-italic) will be
1005 ;; used instead of `w3-table-hack-x-face' entry.
1007 ;; Note also that the font family entry order is irrelevant, so the above
1008 ;; example could also be written:
1011 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
1012 ;; (bold . "Helvetica")
1013 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
1014 ;; (italic . "Zapf-Chancery-MediumItalic")
1015 ;; (normal . "Courier-Bold"))
1016 ;; (avg-char-width . 6.0)
1017 ;; (space-width . 6.0)
1018 ;; (line-height . 10.55))
1020 ;; Despite the note above, it is recommended that some convention about
1021 ;; entry order be used.
1023 ;; You can get information on all the fonts resident in YOUR printer
1024 ;; by uncommenting the line:
1025 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
1027 ;; The PostScript file should be sent to YOUR PostScript printer.
1028 ;; If you send it to ghostscript or to another PostScript printer, you may get
1029 ;; slightly different results.
1030 ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
1032 ;; Note also that ps-print DOESN'T download any font to your printer, instead
1033 ;; it uses the fonts resident in your printer.
1036 ;; How Ps-Print Deals With Faces
1037 ;; -----------------------------
1039 ;; The ps-print-*-with-faces commands attempt to determine which faces should
1040 ;; be printed in bold or italic, but their guesses aren't always right. For
1041 ;; example, you might want to map colors into faces so that blue faces print in
1042 ;; bold, and red faces in italic.
1044 ;; It is possible to force ps-print to consider specific faces bold, italic or
1045 ;; underline, no matter what font they are displayed in, by setting the
1046 ;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
1047 ;; These variables contain lists of faces that ps-print should consider bold,
1048 ;; italic or underline; to set them, put code like the following into your
1051 ;; (setq ps-bold-faces '(my-blue-face))
1052 ;; (setq ps-italic-faces '(my-red-face))
1053 ;; (setq ps-underlined-faces '(my-green-face))
1055 ;; Faces like bold-italic that are both bold and italic should go in *both*
1058 ;; ps-print keeps internal lists of which fonts are bold and which are italic;
1059 ;; these lists are built the first time you invoke ps-print.
1060 ;; For the sake of efficiency, the lists are built only once; the same lists
1061 ;; are referred in later invocations of ps-print.
1063 ;; Because these lists are built only once, it's possible for them to get out
1064 ;; of sync, if a face changes, or if new faces are added. To get the lists
1065 ;; back in sync, you can set the variable `ps-build-face-reference' to t, and
1066 ;; the lists will be rebuilt the next time ps-print is invoked. If you need
1067 ;; that the lists always be rebuilt when ps-print is invoked, set the variable
1068 ;; `ps-always-build-face-reference' to t.
1070 ;; If you need to print without worrying about face background color, set the
1071 ;; variable `ps-use-face-background' which specifies if face background should
1072 ;; be used. Valid values are:
1074 ;; t always use face background color.
1075 ;; nil never use face background color.
1076 ;; (face...) list of faces whose background color will be used.
1078 ;; Any other value will be treated as t.
1079 ;; The default value is t.
1082 ;; How Ps-Print Deals With Color
1083 ;; -----------------------------
1085 ;; ps-print detects faces with foreground and background colors defined and
1086 ;; embeds color information in the PostScript image.
1087 ;; The default foreground and background colors are defined by the variables
1088 ;; `ps-default-fg' and `ps-default-bg'.
1089 ;; On black/white printers, colors are displayed in gray scale.
1090 ;; To turn off color output, set `ps-print-color-p' to nil.
1091 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
1092 ;; on black/white printers. See also `ps-black-white-faces' for documentation.
1095 ;; How Ps-Print Maps Faces
1096 ;; -----------------------
1098 ;; As ps-print uses PostScript to print buffers, it is possible to have other
1099 ;; attributes associated with faces. So the new attributes used by ps-print
1102 ;; strikeout - like underline, but the line is in middle of text.
1103 ;; overline - like underline, but the line is over the text.
1104 ;; shadow - text will have a shadow.
1105 ;; box - text will be surrounded by a box.
1106 ;; outline - print characters as hollow outlines.
1108 ;; See the documentation for `ps-extend-face'.
1110 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1111 ;; color and bold attribute:
1113 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
1115 ;; If you want to use a new face, define it first with `defface', and then call
1116 ;; `ps-extend-face' to specify how to print it.
1119 ;; How Ps-Print Has A Text And/Or Image On Background
1120 ;; --------------------------------------------------
1122 ;; ps-print can print texts and/or EPS PostScript images on background; it is
1123 ;; possible to define the following text attributes: font name, font size,
1124 ;; initial position, angle, gray scale and pages to print.
1126 ;; It has the following EPS PostScript images attributes: file name containing
1127 ;; the image, initial position, X and Y scales, angle and pages to print.
1129 ;; See documentation for `ps-print-background-text' and
1130 ;; `ps-print-background-image'.
1132 ;; For example, if we wish to print text "preliminary" on all pages and text
1133 ;; "special" on page 5 and from page 11 to page 17, we could specify:
1135 ;; (setq ps-print-background-text
1136 ;; '(("preliminary")
1138 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
1139 ;; ; (upper left corner)
1141 ;; "PrintHeight neg PrintPageWidth atan" ; angle
1142 ;; 5 (11 . 17)) ; page list
1145 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
1146 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
1149 ;; (setq ps-print-background-image
1150 ;; '(("~/images/EPS-image1.ps"
1151 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
1152 ;; ("~/images/EPS-image2.ps"
1153 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y pos.
1154 ;; ; (upper left corner)
1156 ;; 5 (11 . 17)) ; page list
1159 ;; If it is not possible to read (or does not exist) an image file, that file
1162 ;; The printing order is:
1164 ;; 1. Print background color
1165 ;; 2. Print zebra stripes
1166 ;; 3. Print background texts that it should be on all pages
1167 ;; 4. Print background images that it should be on all pages
1168 ;; 5. Print background texts only for current page (if any)
1169 ;; 6. Print background images only for current page (if any)
1171 ;; 8. Print buffer text (with faces, if specified) and line number
1177 ;; Some tools are provided to help you customize your font setup.
1179 ;; `ps-setup' returns (some part of) the current setup.
1181 ;; To avoid wrapping too many lines, you may want to adjust the left and right
1182 ;; margins and the font size. On UN*X systems, do:
1183 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1184 ;; to determine the longest lines of your file.
1185 ;; Then, the command `ps-line-lengths' will give you the correspondence between
1186 ;; a line length (number of characters) and the maximum font size which doesn't
1187 ;; wrap such a line with the current ps-print setup.
1189 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display the
1190 ;; correspondence between a number of pages and the maximum font size which
1191 ;; allow the number of lines of the current buffer or of its current region to
1192 ;; fit in this number of pages.
1194 ;; NOTE: line folding is not taken into account in this process and could
1195 ;; change the results.
1197 ;; The command `ps-print-customize' activates a customization buffer for
1198 ;; ps-print options.
1201 ;; New since version 1.5
1202 ;; ---------------------
1204 ;; Color output capability.
1205 ;; Automatic detection of font attributes (bold, italic).
1206 ;; Configurable headers with page numbers.
1208 ;; Support for different paper sizes.
1209 ;; Better conformance to PostScript Document Structure Conventions.
1212 ;; New since version 2.8
1213 ;; ---------------------
1215 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1218 ;; `ps-time-stamp-locale-default'
1221 ;; Handle before-string and after-string overlay properties.
1224 ;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
1225 ;; `ps-print-footer-frame', `ps-footer-font-family',
1226 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
1227 ;; `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
1228 ;; `ps-header-frame-alist'.
1231 ;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
1232 ;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
1235 ;; `ps-line-number-font', `ps-line-number-font-size' and
1236 ;; `ps-end-with-control-d'.
1239 ;; `ps-even-or-odd-pages'
1242 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
1243 ;; `ps-selected-pages', `ps-last-selected-pages',
1244 ;; `ps-restore-selected-pages', `ps-switch-header',
1245 ;; `ps-line-number-step', `ps-line-number-start',
1246 ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
1249 ;; PostScript error handler.
1250 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1253 ;; `ps-print-customize'.
1256 ;; Better customization.
1257 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1261 ;; Hook: `ps-print-begin-sheet-hook'.
1263 ;; [keinichi] 19990509 Kein'ichi Handa <handa@etl.go.jp>
1265 ;; `ps-print-region-function'
1267 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1270 ;; PostScript tumble and setpagedevice.
1273 ;; PostScript prologue header comment insertion.
1274 ;; Skip invisible text better.
1276 ;; [keinichi] 19980819 Kein'ichi Handa <handa@etl.go.jp>
1278 ;; Multi-byte buffer handling.
1280 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1283 ;; Skip invisible text.
1286 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1287 ;; `ps-print-begin-column-hook'.
1288 ;; Put one header per page over the columns.
1289 ;; Better database font management.
1290 ;; Better control characters handling.
1293 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1294 ;; Handle control characters.
1296 ;; New face attributes.
1299 ;; Text and/or image on background.
1301 ;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
1303 ;; Font family and float size for text and header.
1305 ;; Multiple columns.
1306 ;; Tools for page setup.
1309 ;; Known bugs and limitations of ps-print
1310 ;; --------------------------------------
1312 ;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
1313 ;; particular, bold or italic fonts don't print in the right background color.
1315 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1317 ;; Automatic font-attribute detection doesn't work well, especially with
1318 ;; hilit19 and older versions of get-create-face. Users having problems with
1319 ;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
1320 ;; and `ps-underlined-faces' and/or turn off automatic detection by setting
1321 ;; `ps-auto-font-detect' to nil.
1323 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
1324 ;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1325 ;; `ps-underlined-faces' instead.
1327 ;; Still too slow; could use some hand-optimization.
1329 ;; Default background color isn't working.
1331 ;; Faces are always treated as opaque.
1333 ;; Epoch and Emacs 19 not supported. At all.
1335 ;; Fixed-pitch fonts work better for line folding, but are not required.
1337 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
1344 ;; Avoid page break inside a paragraph.
1345 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1346 ;; Improve the memory management for big files (hard?).
1347 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
1354 ;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
1355 ;; for black/white PostScript printers.
1357 ;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
1358 ;; region to cut out when printing and footer suggestions.
1360 ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
1362 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
1365 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1366 ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1368 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1369 ;; suggestion for `ps-postscript-code-directory' variable.
1371 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1372 ;; level 1 compatibility.
1374 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for upside-down,
1375 ;; line number step, line number start and zebra stripe follow suggestions, and
1376 ;; for XEmacs beta-tests.
1378 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1379 ;; prologue code suggestion, for odd/even printing suggestion and for
1380 ;; `ps-prologue-file' enhancement.
1382 ;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
1384 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1387 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1390 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1391 ;; `ps-print-control-characters' variable documentation.
1393 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1394 ;; database font management.
1396 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1397 ;; header per page over the columns and correct line numbers when printing a
1400 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1401 ;; print time of `ps-lpr-switches'.
1403 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1404 ;; (his code was severely modified, but the main idea was kept).
1406 ;; Thanks to some suggestions on:
1407 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1408 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1409 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1411 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for version 3.4 I
1412 ;; started from. [vinicius]
1414 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from. [jack]
1416 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
1417 ;; the invisible property.
1419 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the
1420 ;; initial port to Emacs 19. His code is no longer part of ps-print, but his
1421 ;; work is still appreciated.
1423 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for
1424 ;; adding underline support. Their code also is no longer part of ps-print,
1425 ;; but their efforts are not forgotten.
1427 ;; Thanks also to all of you who mailed code to add features to ps-print;
1428 ;; although I didn't use your code, I still appreciate your sharing it with me.
1430 ;; Thanks to all who mailed comments, encouragement, and criticism.
1431 ;; Thanks also to all who responded to my survey; I had too many responses to
1432 ;; reply to them all, but I greatly appreciate your interest.
1435 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1442 (or (featurep 'lisp-float-type)
1443 (error "`ps-print' requires floating point support"))
1446 ;; For Emacs 20.2 and the earlier version.
1448 (or (fboundp 'set-buffer-multibyte)
1449 (defun set-buffer-multibyte (arg)
1450 (setq enable-multibyte-characters arg)))
1452 (or (fboundp 'string-as-unibyte)
1453 (defun string-as-unibyte (arg) arg))
1455 (or (fboundp 'string-as-multibyte)
1456 (defun string-as-multibyte (arg) arg))
1458 (or (fboundp 'char-charset)
1459 (defun char-charset (arg) 'ascii))
1461 (or (fboundp 'charset-after)
1462 (defun charset-after (&optional arg)
1463 (char-charset (char-after arg))))
1467 (or (fboundp 'line-beginning-position)
1468 (defun line-beginning-position (&optional n)
1470 (and n (/= n 1) (forward-line (1- n)))
1475 ;; to avoid compilation gripes
1478 (defalias 'ps-x-color-instance-p 'color-instance-p)
1479 (defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
1480 (defalias 'ps-x-color-name 'color-name)
1481 (defalias 'ps-x-color-specifier-p 'color-specifier-p)
1482 (defalias 'ps-x-copy-coding-system 'copy-coding-system)
1483 (defalias 'ps-x-device-class 'device-class)
1484 (defalias 'ps-x-extent-end-position 'extent-end-position)
1485 (defalias 'ps-x-extent-face 'extent-face)
1486 (defalias 'ps-x-extent-priority 'extent-priority)
1487 (defalias 'ps-x-extent-start-position 'extent-start-position)
1488 (defalias 'ps-x-face-font-instance 'face-font-instance)
1489 (defalias 'ps-x-find-coding-system 'find-coding-system)
1490 (defalias 'ps-x-font-instance-properties 'font-instance-properties)
1491 (defalias 'ps-x-make-color-instance 'make-color-instance)
1492 (defalias 'ps-x-map-extents 'map-extents)
1495 (defalias 'ps-e-face-bold-p 'face-bold-p)
1496 (defalias 'ps-e-face-italic-p 'face-italic-p)
1497 (defalias 'ps-e-next-overlay-change 'next-overlay-change)
1498 (defalias 'ps-e-overlays-at 'overlays-at)
1499 (defalias 'ps-e-overlay-get 'overlay-get)
1500 (defalias 'ps-e-overlay-end 'overlay-end)
1501 (defalias 'ps-e-x-color-values 'x-color-values)
1502 (defalias 'ps-e-color-values 'color-values)
1503 (if (fboundp 'find-composition)
1504 (defalias 'ps-e-find-composition 'find-composition)
1505 (defalias 'ps-e-find-composition 'ignore))
1508 (defconst ps-windows-system
1509 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
1510 (defconst ps-lp-system
1511 (memq system-type '(usq-unix-v dgux hpux irix)))
1514 (defvar ps-print-emacs-type
1515 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
1516 ((string-match "Lucid" emacs-version) 'lucid)
1517 ((string-match "Epoch" emacs-version) 'epoch)
1521 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1525 ;;; Interface to the command system
1527 (defgroup postscript nil
1532 (defgroup ps-print nil
1533 "PostScript generator for Emacs"
1534 :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
1539 (defgroup ps-print-horizontal nil
1540 "Horizontal page layout"
1545 (defgroup ps-print-vertical nil
1546 "Vertical page layout"
1551 (defgroup ps-print-headers nil
1552 "Headers & footers layout"
1554 :tag "Header & Footer"
1557 (defgroup ps-print-font nil
1558 "Fonts customization"
1563 (defgroup ps-print-color nil
1564 "Color customization"
1569 (defgroup ps-print-face nil
1570 "Faces customization"
1576 (defgroup ps-print-n-up nil
1577 "N-up customization"
1582 (defgroup ps-print-zebra nil
1583 "Zebra customization"
1588 (defgroup ps-print-background nil
1589 "Background customization"
1594 (defgroup ps-print-printer nil
1595 "Printer customization"
1600 (defgroup ps-print-page nil
1601 "Page customization"
1606 (defgroup ps-print-miscellany nil
1607 "Miscellany customization"
1613 (defcustom ps-error-handler-message 'paper
1614 "*Specify where the error handler message should be sent.
1618 `none' catch the error and *DON'T* send any message.
1620 `paper' catch the error and print on paper the error message.
1622 `system' catch the error and send back the error message to
1623 printing system. This is useful only if printing system
1624 send back an email reporting the error, or if there is
1625 some other alternative way to report back the error from
1628 `paper-and-system' catch the error, print on paper the error message and
1629 send back the error message to printing system.
1631 Any other value is treated as `paper'."
1632 :type '(choice :menu-tag "Error Handler Message"
1633 :tag "Error Handler Message"
1634 (const none) (const paper)
1635 (const system) (const paper-and-system))
1636 :group 'ps-print-miscellany)
1638 (defcustom ps-user-defined-prologue nil
1639 "*User defined PostScript prologue code inserted before all prologue code.
1641 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1642 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1643 prologue comments, and before ps-print PostScript prologue code section. That
1644 is, this string is inserted after error handler initialization and before
1647 It's strongly recommended only insert PostScript code and/or comments specific
1648 for your printing system particularities. For example, some special
1649 initialization that only your printing system needs.
1651 Do not insert code for duplex printing, n-up printing or error handler,
1652 ps-print handles this in a suitable way.
1654 For more information about PostScript, see:
1655 PostScript Language Reference Manual (2nd edition)
1656 Adobe Systems Incorporated
1658 As an example for `ps-user-defined-prologue' setting:
1660 ;; Setting for HP PostScript printer
1661 (setq ps-user-defined-prologue
1662 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1663 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))
1665 :type '(choice :menu-tag "User Defined Prologue"
1666 :tag "User Defined Prologue"
1667 (const :tag "none" nil) string symbol)
1668 :group 'ps-print-miscellany)
1670 (defcustom ps-print-prologue-header nil
1671 "*PostScript prologue header comments besides that ps-print generates.
1673 `ps-print-prologue-header' may be a string or a symbol function which returns a
1674 string. Note that this string is inserted on PostScript prologue header
1675 section which is used to define some document characteristic through PostScript
1676 special comments, like \"%%Requirements: jog\\n\".
1678 ps-print always inserts the %%Requirements: comment, so if you need to insert
1679 more requirements put them first in `ps-print-prologue-header' using the
1680 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1681 requirements and set %%LanguageLevel: to 2, do:
1683 (setq ps-print-prologue-header
1684 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1686 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1688 Do not forget to terminate the string with \"\\n\".
1690 For more information about PostScript document comments, see:
1691 PostScript Language Reference Manual (2nd edition)
1692 Adobe Systems Incorporated
1693 Appendix G: Document Structuring Conventions -- Version 3.0"
1694 :type '(choice :menu-tag "Prologue Header"
1695 :tag "Prologue Header"
1696 (const :tag "none" nil) string symbol)
1697 :group 'ps-print-miscellany)
1699 (defcustom ps-printer-name (and (boundp 'printer-name)
1700 (symbol-value 'printer-name))
1701 "*The name of a local printer for printing PostScript files.
1703 On Unix-like systems, a string value should be a name understood by lpr's -P
1704 option; a value of nil means use the value of `printer-name' instead.
1706 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1707 printer device or port to which PostScript files are written, provided
1708 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1709 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1710 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
1711 for a shared network printer. You can also set it to a name of a file, in
1712 which case the output gets appended to that file. \(Note that `ps-print'
1713 package already has facilities for printing to a file, so you might as well use
1714 them instead of changing the setting of this variable.\) If you want to
1715 silently discard the printed output, set this to \"NUL\".
1717 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1719 Any other value is treated as t, that is, an empty printer name.
1721 See also `ps-printer-name-option' for documentation."
1722 :type '(choice :menu-tag "Printer Name"
1724 (const :tag "Same as printer-name" nil)
1725 (const :tag "No Printer Name" t)
1726 (file :tag "Print to file")
1727 (string :tag "Pipe to ps-lpr-command"))
1728 :group 'ps-print-printer)
1730 (defcustom ps-printer-name-option
1731 (cond (ps-windows-system
1737 "*Option for `ps-printer-name' variable (see it).
1739 On Unix-like systems, if it's been used lpr utility, it should be the string
1740 \"-P\"; if it's been used lp utility, it should be the string \"-d\".
1742 On MS-DOS and MS-Windows systems, if it's been used print utility, it should be
1745 For any other printing utility, see the proper manual or documentation.
1747 Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
1748 option printer name option.
1750 Any other value is treated as nil, that is, an empty printer name option.
1752 This variable is used only when `ps-printer-name' is a non-empty string."
1753 :type '(choice :menu-tag "Printer Name Option"
1754 :tag "Printer Name Option"
1755 (const :tag "None" nil)
1756 (string :tag "Option"))
1758 :group 'ps-print-printer)
1760 (defcustom ps-lpr-command lpr-command
1761 "*Name of program for printing a PostScript file.
1763 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1764 will write directly to the printer port named by `ps-printer-name'. The
1765 programs `print' and `nprint' (the standard print programs on Windows NT and
1766 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1767 the destination for output; any other program is treated like `lpr' except that
1768 an explicit filename is given as the last argument."
1770 :group 'ps-print-printer)
1772 (defcustom ps-lpr-switches lpr-switches
1773 "*A list of extra switches to pass to `ps-lpr-command'."
1774 :type '(repeat :tag "PostScript lpr Switches"
1775 (choice :menu-tag "PostScript lpr Switch"
1776 :tag "PostScript lpr Switch"
1777 string symbol (repeat sexp)))
1778 :group 'ps-print-printer)
1780 (defcustom ps-print-region-function nil
1781 "*Specify a function to print the region on a PostScript printer.
1782 See definition of `call-process-region' for calling conventions. The fourth
1783 and the sixth arguments are both nil."
1784 :type '(choice (const nil) function)
1785 :group 'ps-print-printer)
1787 (defcustom ps-manual-feed nil
1788 "*Non-nil means the printer will manually feed paper.
1790 If it's nil, automatic feeding takes place."
1792 :group 'ps-print-printer)
1794 (defcustom ps-end-with-control-d (and ps-windows-system t)
1795 "*Non-nil means insert C-d at end of PostScript file generated."
1798 :group 'ps-print-printer)
1802 ;; All page dimensions are in PostScript points.
1803 ;; 1 inch == 2.54 cm == 72 points
1804 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1806 ;; Letter 8.5 inch x 11.0 inch
1807 ;; Legal 8.5 inch x 14.0 inch
1808 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1810 ;; LetterSmall 7.68 inch x 10.16 inch
1811 ;; Tabloid 11.0 inch x 17.0 inch
1812 ;; Ledger 17.0 inch x 11.0 inch
1813 ;; Statement 5.5 inch x 8.5 inch
1814 ;; Executive 7.5 inch x 10.0 inch
1815 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1816 ;; A4Small 7.47 inch x 10.85 inch
1817 ;; B4 10.125 inch x 14.33 inch
1818 ;; B5 7.16 inch x 10.125 inch
1821 (defcustom ps-page-dimensions-database
1822 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1823 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1824 (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
1825 (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
1826 (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
1827 (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
1828 (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
1829 (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
1830 (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
1831 (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
1832 (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
1833 (list 'b5 (* 72 7.16) (* 72 10.125) "B5"))
1834 "*List associating a symbolic paper type to its width, height and doc media.
1835 See `ps-paper-type'."
1836 :type '(repeat (list :tag "Paper Type"
1837 (symbol :tag "Name")
1838 (number :tag "Width")
1839 (number :tag "Height")
1840 (string :tag "Media")))
1841 :group 'ps-print-page)
1844 (defcustom ps-paper-type 'letter
1845 "*Specify the size of paper to format for.
1846 Should be one of the paper types defined in `ps-page-dimensions-database', for
1847 example `letter', `legal' or `a4'."
1848 :type '(symbol :validate (lambda (wid)
1849 (if (assq (widget-value wid)
1850 ps-page-dimensions-database)
1852 (widget-put wid :error "Unknown paper size")
1854 :group 'ps-print-page)
1856 (defcustom ps-warn-paper-type t
1857 "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1859 It's used when `ps-spool-config' is set to `setpagedevice'."
1861 :group 'ps-print-page)
1863 (defcustom ps-landscape-mode nil
1864 "*Non-nil means print in landscape mode."
1866 :group 'ps-print-page)
1868 (defcustom ps-print-upside-down nil
1869 "*Non-nil means print upside-down (that is, it's rotated by 180 grades)."
1872 :group 'ps-print-page)
1874 (defcustom ps-selected-pages nil
1875 "*Specify which pages to print.
1877 If it's nil, all pages are printed.
1879 If it's a list, the list element may be an integer or a cons cell (FROM . TO)
1880 designating FROM page to TO page; any invalid element is ignored, that is, an
1881 integer lesser than one or if FROM is greater than TO.
1883 Otherwise, it's treated as nil.
1885 After ps-print processing `ps-selected-pages' is set to nil. But the latest
1886 `ps-selected-pages' is saved in `ps-last-selected-pages' (see it for
1887 documentation). So you can restore the latest selected pages by using
1888 `ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
1889 it for documentation).
1891 See also `ps-even-or-odd-pages'."
1892 :type '(repeat :tag "Selected Pages"
1894 (integer :tag "Number")
1896 (integer :tag "From")
1897 (integer :tag "To"))))
1898 :group 'ps-print-page)
1900 (defcustom ps-even-or-odd-pages nil
1901 "*Specify if it prints even/odd pages.
1905 nil print all pages.
1907 `even-page' print only even pages.
1909 `odd-page' print only odd pages.
1911 `even-sheet' print only even sheets.
1912 That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
1913 but for values greater than 1, it'll print only the even sheet
1916 `odd-sheet' print only odd sheets.
1917 That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
1918 but for values greater than 1, it'll print only the odd sheet
1921 Any other value is treated as nil.
1923 If you set `ps-selected-pages' (see it for documentation), first the pages are
1924 filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1925 example, if we have:
1927 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
1929 Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
1931 `ps-n-up-printing' = 1:
1932 `ps-even-or-odd-pages' PAGES PRINTED
1933 nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
1934 even-page 4, 6, 8, 10, 12, 14, 16, 20
1935 odd-page 1, 7, 9, 13, 15
1936 even-sheet 4, 6, 8, 10, 12, 14, 16, 20
1937 odd-sheet 1, 7, 9, 13, 15
1939 `ps-n-up-printing' = 2:
1940 `ps-even-or-odd-pages' PAGES PRINTED
1941 nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
1942 even-page 4/6, 8/10, 12/14, 16/20
1943 odd-page 1/7, 9/13, 15
1944 even-sheet 6/7, 10/12, 15/16
1945 odd-sheet 1/4, 8/9, 13/14, 20
1947 So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1949 :type '(choice :menu-tag "Print Even/Odd Pages"
1950 :tag "Print Even/Odd Pages"
1951 (const :tag "All Pages" nil)
1952 (const :tag "Only Even Pages" even-page)
1953 (const :tag "Only Odd Pages" odd-page)
1954 (const :tag "Only Even Sheets" even-sheet)
1955 (const :tag "Only Odd Sheets" odd-sheet))
1956 :group 'ps-print-page)
1958 (defcustom ps-print-control-characters 'control-8-bit
1959 "*Specify the printable form for control and 8-bit characters.
1960 That is, instead of sending, for example, a ^D (\\004) to printer,
1961 it is sent the string \"^D\".
1965 `8-bit' This is the value to use when you want an ASCII encoding of
1966 any control or non-ASCII character. Control characters are
1967 encoded as \"^D\", and non-ASCII characters have an
1970 `control-8-bit' This is the value to use when you want an ASCII encoding of
1971 any control character, whether it is 7 or 8-bit.
1972 European 8-bits accented characters are printed according
1975 `control' Only ASCII control characters have an ASCII encoding.
1976 European 8-bits accented characters are printed according
1979 nil No ASCII encoding. Any character is printed according the
1982 Any other value is treated as nil."
1983 :type '(choice :menu-tag "Control Char"
1985 (const 8-bit) (const control-8-bit)
1986 (const control) (const :tag "nil" nil))
1987 :group 'ps-print-miscellany)
1989 (defcustom ps-n-up-printing 1
1990 "*Specify the number of pages per sheet paper."
1992 :tag "N Up Printing"
1995 (if (and (< 0 (widget-value wid))
1996 (<= (widget-value wid) 100))
2000 "Number of pages per sheet paper must be between 1 and 100.")
2002 :group 'ps-print-n-up)
2004 (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
2005 "*Specify the margin in points between the sheet border and n-up printing."
2007 :group 'ps-print-n-up)
2009 (defcustom ps-n-up-border-p t
2010 "*Non-nil means a border is drawn around each page."
2012 :group 'ps-print-n-up)
2014 (defcustom ps-n-up-filling 'left-top
2015 "*Specify how page matrix is filled on each sheet of paper.
2017 Following are the valid values for `ps-n-up-filling' with a filling example
2018 using a 3x4 page matrix:
2020 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
2024 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
2028 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
2032 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
2036 Any other value is treated as `left-top'."
2037 :type '(choice :menu-tag "N-Up Filling"
2039 (const left-top) (const left-bottom)
2040 (const right-top) (const right-bottom)
2041 (const top-left) (const bottom-left)
2042 (const top-right) (const bottom-right))
2043 :group 'ps-print-n-up)
2045 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
2046 "*Specify the number of columns"
2048 :group 'ps-print-miscellany)
2050 (defcustom ps-zebra-stripes nil
2051 "*Non-nil means print zebra stripes.
2052 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
2054 :group 'ps-print-zebra)
2056 (defcustom ps-zebra-stripe-height 3
2057 "*Number of zebra stripe lines.
2058 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
2060 :group 'ps-print-zebra)
2062 (defcustom ps-zebra-color 0.95
2063 "*Zebra stripe gray scale or RGB color.
2064 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
2065 :type '(choice :menu-tag "Zebra Gray/Color"
2066 :tag "Zebra Gray/Color"
2067 (number :tag "Gray Scale" :value 0.95)
2068 (string :tag "Color Name" :value "gray95")
2069 (list :tag "RGB Color" :value (0.95 0.95 0.95)
2071 (number :tag "Green")
2072 (number :tag "Blue")))
2073 :group 'ps-print-zebra)
2075 (defcustom ps-zebra-stripe-follow nil
2076 "*Specify how zebra stripes continue on next page.
2078 Visually, valid values are (the character `+' at right of each column indicates
2079 that a line is printed):
2081 `nil' `follow' `full' `full-follow'
2082 Current Page -------- ----------- --------- ----------------
2083 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
2084 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
2085 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
2089 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
2090 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
2091 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
2094 -------- ----------- --------- ----------------
2095 Next Page -------- ----------- --------- ----------------
2096 12 XXXXX + 12 + 10 XXXXXX + 10 +
2097 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
2098 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
2099 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
2100 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
2101 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
2102 18 XXXXX + 18 + 16 XXXXXX + 16 +
2103 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
2104 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
2107 -------- ----------- --------- ----------------
2109 Any other value is treated as `nil'."
2110 :type '(choice :menu-tag "Zebra Stripe Follow"
2111 :tag "Zebra Stripe Follow"
2112 (const :tag "Always Restart" nil)
2113 (const :tag "Continue on Next Page" follow)
2114 (const :tag "Print Only Full Stripe" full)
2115 (const :tag "Continue on Full Stripe" full-follow))
2116 :group 'ps-print-zebra)
2118 (defcustom ps-line-number nil
2119 "*Non-nil means print line number."
2121 :group 'ps-print-miscellany)
2123 (defcustom ps-line-number-step 1
2124 "*Specify the interval that line number is printed.
2126 For example, `ps-line-number-step' is set to 2, the printing will look like:
2138 integer an integer that specifies the interval that line number is
2139 printed. If it's lesser than or equal to zero, it's used the
2142 `zebra' specifies that only the line number of the first line in a
2143 zebra stripe is to be printed.
2145 Any other value is treated as `zebra'."
2146 :type '(choice :menu-tag "Line Number Step"
2147 :tag "Line Number Step"
2148 (integer :tag "Step Interval")
2149 (const :tag "Synchronize Zebra" zebra))
2150 :group 'ps-print-miscellany)
2152 (defcustom ps-line-number-start 1
2153 "*Specify the starting point in the interval given by `ps-line-number-step'.
2155 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2156 set to 3, the printing will look like:
2170 The values for `ps-line-number-start':
2172 * If `ps-line-number-step' is an integer, must be between 1 and the value of
2173 `ps-line-number-step' inclusive.
2175 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
2176 value of `ps-zebra-strip-height' inclusive. Use this combination if you
2177 wish that line number be relative to zebra stripes."
2178 :type '(integer :tag "Start Step Interval")
2179 :group 'ps-print-miscellany)
2181 (defcustom ps-print-background-image nil
2182 "*EPS image list to be printed on background.
2186 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2188 FILENAME is a file name which contains an EPS image or some PostScript
2189 programming like EPS.
2190 FILENAME is ignored, if it doesn't exist or is read protected.
2192 X and Y are relative positions on paper to put the image.
2193 If X and Y are nil, the image is centralized on paper.
2195 XSCALE and YSCALE are scale factor to be applied to image before printing.
2196 If XSCALE and YSCALE are nil, the original size is used.
2198 ROTATION is the image rotation angle; if nil, the default is 0.
2200 PAGES designates the page to print background image.
2201 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2203 If PAGES is nil, print background image on all pages.
2205 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2206 number or a string. If it is a string, the string should contain PostScript
2207 programming that returns a float or integer value.
2209 For example, if you wish to print an EPS image on all pages do:
2211 '((\"~/images/EPS-image.ps\"))"
2214 (file :tag "EPS File")
2215 (choice :tag "X" (const :tag "default" nil) number string)
2216 (choice :tag "Y" (const :tag "default" nil) number string)
2217 (choice :tag "X Scale" (const :tag "default" nil) number string)
2218 (choice :tag "Y Scale" (const :tag "default" nil) number string)
2219 (choice :tag "Rotation" (const :tag "default" nil) number string)
2220 (repeat :tag "Pages" :inline t
2221 (radio (integer :tag "Page")
2223 (integer :tag "From")
2224 (integer :tag "To"))))))
2225 :group 'ps-print-background)
2227 (defcustom ps-print-background-text nil
2228 "*Text list to be printed on background.
2232 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2234 STRING is the text to be printed on background.
2236 X and Y are positions on paper to put the text.
2237 If X and Y are nil, the text is positioned at lower left corner.
2239 FONT is a font name to be used on printing the text.
2240 If nil, \"Times-Roman\" is used.
2242 FONTSIZE is font size to be used, if nil, 200 is used.
2244 GRAY is the text gray factor (should be very light like 0.8).
2245 If nil, the default is 0.85.
2247 ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
2248 from lower left corner to upper right corner.
2250 PAGES designates the page to print background text.
2251 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2253 If PAGES is nil, print background text on all pages.
2255 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2256 number or a string. If it is a string, the string should contain PostScript
2257 programming that returns a float or integer value.
2259 For example, if you wish to print text \"Preliminary\" on all pages do:
2261 '((\"Preliminary\"))"
2264 (string :tag "Text")
2265 (choice :tag "X" (const :tag "default" nil) number string)
2266 (choice :tag "Y" (const :tag "default" nil) number string)
2267 (choice :tag "Font" (const :tag "default" nil) string)
2268 (choice :tag "Fontsize" (const :tag "default" nil) number string)
2269 (choice :tag "Gray" (const :tag "default" nil) number string)
2270 (choice :tag "Rotation" (const :tag "default" nil) number string)
2271 (repeat :tag "Pages" :inline t
2272 (radio (integer :tag "Page")
2274 (integer :tag "From")
2275 (integer :tag "To"))))))
2276 :group 'ps-print-background)
2278 ;;; Horizontal layout
2280 ;; ------------------------------------------
2282 ;; | lm | text | ic | text | ic | text | rm |
2284 ;; ------------------------------------------
2286 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
2287 "*Left margin in points (1/72 inch)."
2289 :group 'ps-print-horizontal)
2291 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
2292 "*Right margin in points (1/72 inch)."
2294 :group 'ps-print-horizontal)
2296 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
2297 "*Horizontal space between columns in points (1/72 inch)."
2299 :group 'ps-print-horizontal)
2315 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2316 "*Bottom margin in points (1/72 inch)."
2318 :group 'ps-print-vertical)
2320 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2321 "*Top margin in points (1/72 inch)."
2323 :group 'ps-print-vertical)
2325 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2326 "*Vertical space in points (1/72 inch) between the main text and the header."
2328 :group 'ps-print-vertical)
2330 (defcustom ps-header-line-pad 0.15
2331 "*Portion of a header title line height to insert between the header frame
2332 and the text it contains, both in the vertical and horizontal directions."
2334 :group 'ps-print-vertical)
2336 (defcustom ps-footer-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2337 "*Vertical space in points (1/72 inch) between the main text and the footer."
2339 :group 'ps-print-vertical)
2341 (defcustom ps-footer-line-pad 0.15
2342 "*Portion of a footer title line height to insert between the footer frame
2343 and the text it contains, both in the vertical and horizontal directions."
2345 :group 'ps-print-vertical)
2347 ;;; Header/Footer setup
2349 (defcustom ps-print-header t
2350 "*Non-nil means print a header at the top of each page.
2351 By default, the header displays the buffer name, page number, and, if the
2352 buffer is visiting a file, the file's directory. Headers are customizable by
2353 changing variables `ps-left-header' and `ps-right-header'."
2355 :group 'ps-print-headers)
2357 (defcustom ps-print-header-frame t
2358 "*Non-nil means draw a gaudy frame around the header."
2360 :group 'ps-print-headers)
2362 (defcustom ps-header-frame-alist
2363 '((fore-color . 0.0)
2365 (border-width . 0.4)
2366 (border-color . 0.0)
2367 (shadow-color . 0.0))
2368 "*Specify header frame properties alist.
2370 Valid frame properties are:
2372 `fore-color' Specify the foreground frame color.
2373 It should be a float number between 0.0 (black color)
2374 and 1.0 (white color), a string which is a color name,
2375 or a list of 3 float numbers which corresponds to the
2376 Red Green Blue color scale, each float number between
2377 0.0 (dark color) and 1.0 (bright color).
2379 `back-color' Specify the background frame color (similar to
2382 `shadow-color' Specify the shadow color (similar to `fore-color').
2384 `border-color' Specify the border color (similar to `fore-color').
2386 `border-width' Specify the border width.
2388 Any other property is ignored.
2390 Don't change this alist directly, instead use customization, or `ps-value',
2391 `ps-get', `ps-put' and `ps-del' functions (see them for documentation)."
2394 (choice :menu-tag "Header Frame Element"
2396 (cons :tag "Foreground Color" :format "%v"
2397 (const :format "" fore-color)
2398 (choice :menu-tag "Foreground Color"
2399 :tag "Foreground Color"
2400 (number :tag "Gray Scale" :value 0.0)
2401 (string :tag "Color Name" :value "black")
2402 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2404 (number :tag "Green")
2405 (number :tag "Blue"))))
2406 (cons :tag "Background Color" :format "%v"
2407 (const :format "" back-color)
2408 (choice :menu-tag "Background Color"
2409 :tag "Background Color"
2410 (number :tag "Gray Scale" :value 0.9)
2411 (string :tag "Color Name" :value "gray90")
2412 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2414 (number :tag "Green")
2415 (number :tag "Blue"))))
2416 (cons :tag "Border Width" :format "%v"
2417 (const :format "" border-width)
2418 (number :tag "Border Width" :value 0.4))
2419 (cons :tag "Border Color" :format "%v"
2420 (const :format "" border-color)
2421 (choice :menu-tag "Border Color"
2423 (number :tag "Gray Scale" :value 0.0)
2424 (string :tag "Color Name" :value "black")
2425 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2427 (number :tag "Green")
2428 (number :tag "Blue"))))
2429 (cons :tag "Shadow Color" :format "%v"
2430 (const :format "" shadow-color)
2431 (choice :menu-tag "Shadow Color"
2433 (number :tag "Gray Scale" :value 0.0)
2434 (string :tag "Color Name" :value "black")
2435 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2437 (number :tag "Green")
2438 (number :tag "Blue"))))))
2439 :group 'ps-print-headers)
2441 (defcustom ps-header-lines 2
2442 "*Number of lines to display in page header, when generating PostScript."
2444 :group 'ps-print-headers)
2446 (defcustom ps-print-footer nil
2447 "*Non-nil means print a footer at the bottom of each page.
2448 By default, the footer displays page number.
2449 Footers are customizable by changing variables `ps-left-footer' and
2453 :group 'ps-print-headers)
2455 (defcustom ps-print-footer-frame t
2456 "*Non-nil means draw a gaudy frame around the footer."
2459 :group 'ps-print-headers)
2461 (defcustom ps-footer-frame-alist
2462 '((fore-color . 0.0)
2464 (border-width . 0.4)
2465 (border-color . 0.0)
2466 (shadow-color . 0.0))
2467 "*Specify footer frame properties alist.
2469 Don't change this alist directly, instead use customization, or `ps-value',
2470 `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
2472 See also `ps-header-frame-alist' for documentation."
2475 (choice :menu-tag "Header Frame Element"
2477 (cons :tag "Foreground Color" :format "%v"
2478 (const :format "" fore-color)
2479 (choice :menu-tag "Foreground Color"
2480 :tag "Foreground Color"
2481 (number :tag "Gray Scale" :value 0.0)
2482 (string :tag "Color Name" :value "black")
2483 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2485 (number :tag "Green")
2486 (number :tag "Blue"))))
2487 (cons :tag "Background Color" :format "%v"
2488 (const :format "" back-color)
2489 (choice :menu-tag "Background Color"
2490 :tag "Background Color"
2491 (number :tag "Gray Scale" :value 0.9)
2492 (string :tag "Color Name" :value "gray90")
2493 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2495 (number :tag "Green")
2496 (number :tag "Blue"))))
2497 (cons :tag "Border Width" :format "%v"
2498 (const :format "" border-width)
2499 (number :tag "Border Width" :value 0.4))
2500 (cons :tag "Border Color" :format "%v"
2501 (const :format "" border-color)
2502 (choice :menu-tag "Border Color"
2504 (number :tag "Gray Scale" :value 0.0)
2505 (string :tag "Color Name" :value "black")
2506 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2508 (number :tag "Green")
2509 (number :tag "Blue"))))
2510 (cons :tag "Shadow Color" :format "%v"
2511 (const :format "" shadow-color)
2512 (choice :menu-tag "Shadow Color"
2514 (number :tag "Gray Scale" :value 0.0)
2515 (string :tag "Color Name" :value "black")
2516 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2518 (number :tag "Green")
2519 (number :tag "Blue"))))))
2520 :group 'ps-print-headers)
2522 (defcustom ps-footer-lines 2
2523 "*Number of lines to display in page footer, when generating PostScript."
2526 :group 'ps-print-headers)
2528 (defcustom ps-print-only-one-header nil
2529 "*Non-nil means print only one header/footer at the top/bottom of each page.
2530 This is useful when printing more than one column, so it is possible to have
2531 only one header/footer over all columns or one header/footer per column.
2532 See also `ps-print-header' and `ps-print-footer'."
2534 :group 'ps-print-headers)
2536 (defcustom ps-switch-header 'duplex
2537 "*Specify if headers/footers are switched or not.
2541 nil Never switch headers/footers.
2543 t Always switch headers/footers.
2545 duplex Switch headers/footers only when duplexing is on, that is, when
2546 `ps-spool-duplex' is non-nil.
2548 Any other value is treated as t.
2550 See also `ps-print-header' and `ps-print-footer'."
2551 :type '(choice :menu-tag "Switch Header/Footer"
2552 :tag "Switch Header/Footer"
2553 (const :tag "Never Switch" nil)
2554 (const :tag "Always Switch" t)
2555 (const :tag "Switch When Duplexing" duplex))
2556 :group 'ps-print-headers)
2558 (defcustom ps-show-n-of-n t
2559 "*Non-nil means show page numbers as N/M, meaning page N of M.
2560 NOTE: page numbers are displayed as part of headers,
2561 see variable `ps-print-header'."
2563 :group 'ps-print-headers)
2565 (defcustom ps-spool-config
2566 (if ps-windows-system
2569 "*Specify who is responsible for setting duplex and page size.
2573 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2574 Don't forget to set `ps-lpr-switches' to select duplex
2575 printing for your printer.
2577 `setpagedevice' duplex and page size are configured by ps-print using the
2578 setpagedevice PostScript operator.
2580 nil duplex and page size are configured by ps-print *not* using
2581 the setpagedevice PostScript operator.
2583 Any other value is treated as nil.
2585 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2586 viewing file generated using landscape. Also on some printers,
2587 setpagedevice affects zebra stripes; on other printers, setpagedevice
2588 affects the left margin.
2589 Besides all that, if your printer does not have the paper size
2590 specified by setpagedevice, your printing will be aborted.
2591 So, if you need to use setpagedevice, set `ps-spool-config' to
2592 `setpagedevice', generate a test file and send it to your printer; if
2593 the printed file isn't ok, set `ps-spool-config' to nil."
2594 :type '(choice :menu-tag "Spool Config"
2596 (const lpr-switches) (const setpagedevice)
2597 (const :tag "nil" nil))
2598 :group 'ps-print-headers)
2600 (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
2601 ; so default to nil.
2602 "*Non-nil generates PostScript for a two-sided printer.
2603 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2604 blank pages as needed between print jobs so that the next buffer printed will
2605 start on the right page. Also, if headers are turned on, the headers will be
2606 reversed on duplex printers so that the page numbers fall to the left on
2607 even-numbered pages.
2609 See also `ps-spool-tumble'."
2611 :group 'ps-print-headers)
2613 (defcustom ps-spool-tumble nil
2614 "*Specify how the page images on opposite sides of a sheet are oriented.
2615 If `ps-spool-tumble' is nil, produces output suitable for binding on the left
2616 or right. If `ps-spool-tumble' is non-nil, produces output suitable for
2617 binding at the top or bottom.
2619 It has effect only when `ps-spool-duplex' is non-nil."
2621 :group 'ps-print-headers)
2625 (defcustom ps-font-info-database
2626 '((Courier ; the family key
2627 (fonts (normal . "Courier")
2628 (bold . "Courier-Bold")
2629 (italic . "Courier-Oblique")
2630 (bold-italic . "Courier-BoldOblique"))
2632 (line-height . 10.55)
2634 (avg-char-width . 6.0))
2635 (Helvetica ; the family key
2636 (fonts (normal . "Helvetica")
2637 (bold . "Helvetica-Bold")
2638 (italic . "Helvetica-Oblique")
2639 (bold-italic . "Helvetica-BoldOblique"))
2641 (line-height . 11.56)
2642 (space-width . 2.78)
2643 (avg-char-width . 5.09243))
2645 (fonts (normal . "Times-Roman")
2646 (bold . "Times-Bold")
2647 (italic . "Times-Italic")
2648 (bold-italic . "Times-BoldItalic"))
2650 (line-height . 11.0)
2652 (avg-char-width . 4.71432))
2654 (fonts (normal . "Palatino-Roman")
2655 (bold . "Palatino-Bold")
2656 (italic . "Palatino-Italic")
2657 (bold-italic . "Palatino-BoldItalic"))
2659 (line-height . 12.1)
2661 (avg-char-width . 5.08676))
2663 (fonts (normal . "Helvetica-Narrow")
2664 (bold . "Helvetica-Narrow-Bold")
2665 (italic . "Helvetica-Narrow-Oblique")
2666 (bold-italic . "Helvetica-Narrow-BoldOblique"))
2668 (line-height . 11.56)
2669 (space-width . 2.2796)
2670 (avg-char-width . 4.17579))
2672 (fonts (normal . "NewCenturySchlbk-Roman")
2673 (bold . "NewCenturySchlbk-Bold")
2674 (italic . "NewCenturySchlbk-Italic")
2675 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2677 (line-height . 12.15)
2678 (space-width . 2.78)
2679 (avg-char-width . 5.31162))
2680 ;; got no bold for the next ones
2682 (fonts (normal . "AvantGarde-Book")
2683 (italic . "AvantGarde-BookOblique"))
2685 (line-height . 11.77)
2686 (space-width . 2.77)
2687 (avg-char-width . 5.45189))
2689 (fonts (normal . "AvantGarde-Demi")
2690 (italic . "AvantGarde-DemiOblique"))
2692 (line-height . 12.72)
2694 (avg-char-width . 5.51351))
2696 (fonts (normal . "Bookman-Demi")
2697 (italic . "Bookman-DemiItalic"))
2699 (line-height . 11.77)
2701 (avg-char-width . 6.05946))
2703 (fonts (normal . "Bookman-Light")
2704 (italic . "Bookman-LightItalic"))
2706 (line-height . 11.79)
2708 (avg-char-width . 5.67027))
2709 ;; got no bold and no italic for the next ones
2711 (fonts (normal . "Symbol"))
2713 (line-height . 13.03)
2715 (avg-char-width . 3.24324))
2717 (fonts (normal . "Zapf-Dingbats"))
2719 (line-height . 9.63)
2720 (space-width . 2.78)
2721 (avg-char-width . 2.78))
2722 (Zapf-Chancery-MediumItalic
2723 (fonts (normal . "Zapf-Chancery-MediumItalic"))
2725 (line-height . 11.45)
2727 (avg-char-width . 4.10811))
2729 "*Font info database: font family (the key), name, bold, italic, bold-italic,
2730 reference size, line height, space width, average character width.
2731 To get the info for another specific font (say Helvetica), do the following:
2732 - create a new buffer
2733 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2734 - open this file and delete the leading `%' (which is the PostScript comment
2735 character) from the line
2736 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2738 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2739 - add the values to `ps-font-info-database'.
2740 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2742 Note also that ps-print DOESN'T download any font to your printer, instead it
2743 uses the fonts resident in your printer."
2745 (list :tag "Font Definition"
2746 (symbol :tag "Font Family")
2748 (const :format "" fonts)
2749 (repeat :tag "Faces"
2750 (cons (choice :menu-tag "Font Weight/Slant"
2751 :tag "Font Weight/Slant"
2756 (symbol :tag "Face"))
2757 (string :tag "Font Name"))))
2759 (const :format "" size)
2760 (number :tag "Reference Size"))
2762 (const :format "" line-height)
2763 (number :tag "Line Height"))
2765 (const :format "" space-width)
2766 (number :tag "Space Width"))
2768 (const :format "" avg-char-width)
2769 (number :tag "Average Character Width"))))
2770 :group 'ps-print-font)
2772 (defcustom ps-font-family 'Courier
2773 "*Font family name for ordinary text, when generating PostScript."
2775 :group 'ps-print-font)
2777 (defcustom ps-font-size '(7 . 8.5)
2778 "*Font size, in points, for ordinary text, when generating PostScript."
2779 :type '(choice :menu-tag "Ordinary Text Font Size"
2780 :tag "Ordinary Text Font Size"
2781 (number :tag "Text Size")
2782 (cons :tag "Landscape/Portrait"
2783 (number :tag "Landscape Text Size")
2784 (number :tag "Portrait Text Size")))
2785 :group 'ps-print-font)
2787 (defcustom ps-header-font-family 'Helvetica
2788 "*Font family name for text in the header, when generating PostScript."
2790 :group 'ps-print-font)
2792 (defcustom ps-header-font-size '(10 . 12)
2793 "*Font size, in points, for text in the header, when generating PostScript."
2794 :type '(choice :menu-tag "Header Font Size"
2795 :tag "Header Font Size"
2796 (number :tag "Header Size")
2797 (cons :tag "Landscape/Portrait"
2798 (number :tag "Landscape Header Size")
2799 (number :tag "Portrait Header Size")))
2800 :group 'ps-print-font)
2802 (defcustom ps-header-title-font-size '(12 . 14)
2803 "*Font size, in points, for the top line of text in header, in PostScript."
2804 :type '(choice :menu-tag "Header Title Font Size"
2805 :tag "Header Title Font Size"
2806 (number :tag "Header Title Size")
2807 (cons :tag "Landscape/Portrait"
2808 (number :tag "Landscape Header Title Size")
2809 (number :tag "Portrait Header Title Size")))
2810 :group 'ps-print-font)
2812 (defcustom ps-footer-font-family 'Helvetica
2813 "*Font family name for text in the footer, when generating PostScript."
2816 :group 'ps-print-font)
2818 (defcustom ps-footer-font-size '(10 . 12)
2819 "*Font size, in points, for text in the footer, when generating PostScript."
2821 :type '(choice :menu-tag "Footer Font Size"
2822 :tag "Footer Font Size"
2823 (number :tag "Footer Size")
2824 (cons :tag "Landscape/Portrait"
2825 (number :tag "Landscape Footer Size")
2826 (number :tag "Portrait Footer Size")))
2827 :group 'ps-print-font)
2829 (defcustom ps-line-number-color "black"
2830 "*Specify color for line-number, when generating PostScript."
2831 :type '(choice :menu-tag "Line Number Color"
2832 :tag "Line Number Color"
2833 (number :tag "Gray Scale" :value 0)
2834 (string :tag "Color Name" :value "black")
2835 (list :tag "RGB Color" :value (0 0 0)
2837 (number :tag "Green")
2838 (number :tag "Blue")))
2840 :group 'ps-print-font
2841 :group 'ps-print-miscellany)
2843 (defcustom ps-line-number-font "Times-Italic"
2844 "*Font for line-number, when generating PostScript."
2846 :group 'ps-print-font
2847 :group 'ps-print-miscellany)
2849 (defcustom ps-line-number-font-size 6
2850 "*Font size, in points, for line number, when generating PostScript."
2851 :type '(choice :menu-tag "Line Number Font Size"
2852 :tag "Line Number Font Size"
2853 (number :tag "Font Size")
2854 (cons :tag "Landscape/Portrait"
2855 (number :tag "Landscape Font Size")
2856 (number :tag "Portrait Font Size")))
2857 :group 'ps-print-font
2858 :group 'ps-print-miscellany)
2862 ;; Printing color requires x-color-values.
2863 ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
2866 (defcustom ps-print-color-p
2867 (or (and (fboundp 'color-values) ; Emacs
2868 (ps-e-color-values "Green"))
2869 (fboundp 'x-color-values) ; Emacs
2870 (fboundp 'color-instance-rgb-components))
2872 "*Specify how buffer's text color is printed.
2876 nil Do not print colors.
2880 black-white Print colors on black/white printer.
2881 See also `ps-black-white-faces'.
2883 Any other value is treated as t."
2884 :type '(choice :menu-tag "Print Color"
2886 (const :tag "Do NOT Print Color" nil)
2887 (const :tag "Print Always Color" t)
2888 (const :tag "Print Black/White Color" black-white))
2889 :group 'ps-print-color)
2891 (defcustom ps-default-fg '(0.0 0.0 0.0)
2892 "*RGB values of the default foreground color. Defaults to black."
2893 :type '(choice :menu-tag "Default Foreground Gray/Color"
2894 :tag "Default Foreground Gray/Color"
2895 (number :tag "Gray Scale" :value 0.0)
2896 (string :tag "Color Name" :value "black")
2897 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2899 (number :tag "Green")
2900 (number :tag "Blue")))
2901 :group 'ps-print-color)
2903 (defcustom ps-default-bg '(1.0 1.0 1.0)
2904 "*RGB values of the default background color. Defaults to white."
2905 :type '(choice :menu-tag "Default Background Gray/Color"
2906 :tag "Default Background Gray/Color"
2907 (number :tag "Gray Scale" :value 1.0)
2908 (string :tag "Color Name" :value "white")
2909 (list :tag "RGB Color" :value (1.0 1.0 1.0)
2911 (number :tag "Green")
2912 (number :tag "Blue")))
2913 :group 'ps-print-color)
2915 (defcustom ps-auto-font-detect t
2916 "*Non-nil means automatically detect bold/italic/underline face attributes.
2917 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
2918 `ps-underlined-faces'."
2920 :group 'ps-print-font)
2922 (defcustom ps-black-white-faces
2923 '((font-lock-builtin-face "black" nil bold )
2924 (font-lock-comment-face "gray20" nil italic)
2925 (font-lock-constant-face "black" nil bold )
2926 (font-lock-function-name-face "black" nil bold )
2927 (font-lock-keyword-face "black" nil bold )
2928 (font-lock-string-face "black" nil italic)
2929 (font-lock-type-face "black" nil italic)
2930 (font-lock-variable-name-face "black" nil bold italic)
2931 (font-lock-warning-face "black" nil bold italic))
2932 "*Specify list of face attributes to print colors on black/white printers.
2934 The list elements are the same as defined on `ps-extend-face' (which see).
2936 This variable is used only when `ps-print-color-p' is set to `black-white'."
2939 (list :tag "Face Specification"
2940 (face :tag "Face Symbol")
2941 (choice :menu-tag "Foreground Color"
2942 :tag "Foreground Color"
2943 (const :tag "Black" nil)
2944 (string :tag "Color Name"))
2945 (choice :menu-tag "Background Color"
2946 :tag "Background Color"
2947 (const :tag "None" nil)
2948 (string :tag "Color Name"))
2950 (choice :menu-tag "Attribute"
2959 :group 'ps-print-face)
2961 (defcustom ps-bold-faces
2962 (unless ps-print-color-p
2963 '(font-lock-function-name-face
2964 font-lock-builtin-face
2965 font-lock-variable-name-face
2966 font-lock-keyword-face
2967 font-lock-warning-face))
2968 "*A list of the \(non-bold\) faces that should be printed in bold font.
2969 This applies to generating PostScript."
2970 :type '(repeat face)
2971 :group 'ps-print-face)
2973 (defcustom ps-italic-faces
2974 (unless ps-print-color-p
2975 '(font-lock-variable-name-face
2977 font-lock-string-face
2978 font-lock-comment-face
2979 font-lock-warning-face))
2980 "*A list of the \(non-italic\) faces that should be printed in italic font.
2981 This applies to generating PostScript."
2982 :type '(repeat face)
2983 :group 'ps-print-face)
2985 (defcustom ps-underlined-faces
2986 (unless ps-print-color-p
2987 '(font-lock-function-name-face
2988 font-lock-constant-face
2989 font-lock-warning-face))
2990 "*A list of the \(non-underlined\) faces that should be printed underlined.
2991 This applies to generating PostScript."
2992 :type '(repeat face)
2993 :group 'ps-print-face)
2995 (defcustom ps-use-face-background nil
2996 "*Specify if face background should be used.
3000 t always use face background color.
3001 nil never use face background color.
3002 (face...) list of faces whose background color will be used.
3004 Any other value will be treated as t."
3005 :type '(choice :menu-tag "Use Face Background"
3006 :tag "Use Face Background"
3007 (const :tag "Always Use Face Background" t)
3008 (const :tag "Never Use Face Background" nil)
3009 (repeat :menu-tag "Face Background List"
3010 :tag "Face Background List"
3012 :group 'ps-print-face)
3014 (defcustom ps-left-header
3015 (list 'ps-get-buffer-name 'ps-header-dirpart)
3016 "*The items to display (each on a line) on the left part of the page header.
3017 This applies to generating PostScript.
3019 The value should be a list of strings and symbols, each representing an entry
3020 in the PostScript array HeaderLinesLeft.
3022 Strings are inserted unchanged into the array; those representing
3023 PostScript string literals should be delimited with PostScript string
3024 delimiters '(' and ')'.
3026 For symbols with bound functions, the function is called and should return a
3027 string to be inserted into the array. For symbols with bound values, the value
3028 should be a string to be inserted into the array. In either case, function or
3029 variable, the string value has PostScript string delimiters added to it."
3030 :type '(repeat (choice :menu-tag "Left Header"
3033 :group 'ps-print-headers)
3035 (defcustom ps-right-header
3036 (list "/pagenumberstring load"
3037 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3038 "*The items to display (each on a line) on the right part of the page header.
3039 This applies to generating PostScript.
3041 See the variable `ps-left-header' for a description of the format of this
3044 There are the following basic functions implemented:
3046 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3047 as, for example, \"06/18/01\".
3049 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3051 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3053 You can also create your own time stamp function by using `format-time-string'
3055 :type '(repeat (choice :menu-tag "Right Header"
3058 :group 'ps-print-headers)
3060 (defcustom ps-left-footer
3061 (list 'ps-get-buffer-name 'ps-header-dirpart)
3062 "*The items to display (each on a line) on the left part of the page footer.
3063 This applies to generating PostScript.
3065 The value should be a list of strings and symbols, each representing an entry
3066 in the PostScript array FooterLinesLeft.
3068 Strings are inserted unchanged into the array; those representing PostScript
3069 string literals should be delimited with PostScript string delimiters '(' and
3072 For symbols with bound functions, the function is called and should return a
3073 string to be inserted into the array. For symbols with bound values, the value
3074 should be a string to be inserted into the array. In either case, function or
3075 variable, the string value has PostScript string delimiters added to it."
3077 :type '(repeat (choice :menu-tag "Left Footer"
3080 :group 'ps-print-headers)
3082 (defcustom ps-right-footer
3083 (list "/pagenumberstring load"
3084 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3085 "*The items to display (each on a line) on the right part of the page footer.
3086 This applies to generating PostScript.
3088 See the variable `ps-left-footer' for a description of the format of this
3091 There are the following basic functions implemented:
3093 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3094 as, for example, \"06/18/01\".
3096 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3098 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3100 You can also create your own time stamp function by using `format-time-string'
3103 :type '(repeat (choice :menu-tag "Right Footer"
3106 :group 'ps-print-headers)
3108 (defcustom ps-razzle-dazzle t
3109 "*Non-nil means report progress while formatting buffer."
3111 :group 'ps-print-miscellany)
3113 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
3114 "*Contains the header line identifying the output as PostScript.
3115 By default, `ps-adobe-tag' contains the standard identifier. Some printers
3116 require slightly different versions of this line."
3118 :group 'ps-print-miscellany)
3120 (defcustom ps-build-face-reference t
3121 "*Non-nil means build the reference face lists.
3123 ps-print sets this value to nil after it builds its internal reference lists of
3124 bold and italic faces. By settings its value back to t, you can force ps-print
3125 to rebuild the lists the next time you invoke one of the ...-with-faces
3128 You should set this value back to t after you change the attributes of any
3129 face, or create new faces. Most users shouldn't have to worry about its
3132 :group 'ps-print-face)
3134 (defcustom ps-always-build-face-reference nil
3135 "*Non-nil means always rebuild the reference face lists.
3137 If this variable is non-nil, ps-print will rebuild its internal reference lists
3138 of bold and italic faces *every* time one of the ...-with-faces commands is
3139 called. Most users shouldn't need to set this variable."
3141 :group 'ps-print-face)
3143 (defcustom ps-banner-page-when-duplexing nil
3144 "*Non-nil means the very first page is skipped.
3145 It's like the very first character of buffer (or region) is ^L (\\014)."
3147 :group 'ps-print-headers)
3149 (defcustom ps-postscript-code-directory
3151 ((eq ps-print-emacs-type 'emacs) ; emacs
3153 ((fboundp 'locate-data-directory) ; emacsens (xemacs, etc.)
3154 (locate-data-directory "ps-print"))
3155 ((boundp 'data-directory) ; emacsens (xemacs, etc.)
3157 (t ; don't know what to do
3159 (error "ps-postscript-code-directory isn't set properly"))
3160 "*Directory where it's located the PostScript prologue file used by ps-print.
3161 By default, this directory is the same as in the variable `data-directory'."
3163 :group 'ps-print-miscellany)
3165 (defcustom ps-line-spacing 0
3166 "*Specify line spacing, in points, for ordinary text.
3168 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3170 To get all lines with some spacing set both `ps-line-spacing' and
3171 `ps-paragraph-spacing' variables."
3172 :type '(choice :menu-tag "Line Spacing For Ordinary Text"
3173 :tag "Line Spacing For Ordinary Text"
3174 (number :tag "Line Spacing")
3175 (cons :tag "Landscape/Portrait"
3176 (number :tag "Landscape Line Spacing")
3177 (number :tag "Portrait Line Spacing")))
3179 :group 'ps-print-miscellany)
3181 (defcustom ps-paragraph-spacing 0
3182 "*Specify paragraph spacing, in points, for ordinary text.
3184 See also `ps-line-spacing' and `ps-paragraph-regexp'.
3186 To get all lines with some spacing set both `ps-line-spacing' and
3187 `ps-paragraph-spacing' variables."
3188 :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text"
3189 :tag "Paragraph Spacing For Ordinary Text"
3190 (number :tag "Paragraph Spacing")
3191 (cons :tag "Landscape/Portrait"
3192 (number :tag "Landscape Paragraph Spacing")
3193 (number :tag "Portrait Paragraph Spacing")))
3195 :group 'ps-print-miscellany)
3197 (defcustom ps-paragraph-regexp "[ \t]*$"
3198 "*Specify paragraph delimiter.
3200 It should be a regexp or nil.
3202 See also `ps-paragraph-spacing'."
3203 :type '(choice :menu-tag "Paragraph Delimiter"
3204 (const :tag "No Delimiter" nil)
3205 (regexp :tag "Delimiter Regexp"))
3207 :group 'ps-print-miscellany)
3209 (defcustom ps-begin-cut-regexp nil
3210 "*Specify regexp which is start of a region to cut out when printing.
3212 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
3213 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
3214 some special printing instructions from the actual print. Special printing
3215 instructions may be appended to the end of the file just like any other
3216 buffer-local variables. See section \"Local Variables in Files\" on Emacs
3217 manual for more information.
3219 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3220 actually gets printed. Both variables may be set to nil in which case no
3224 :group 'ps-print-miscellany)
3226 (defcustom ps-end-cut-regexp nil
3227 "*Specify regexp which is end of the region to cut out when printing.
3229 See `ps-begin-cut-regexp' for more information."
3232 :group 'ps-print-miscellany)
3235 (defvar ps-lpr-log-buffer " *Lpr-Message-Log*")
3237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3241 (defvar ps-last-selected-pages nil
3242 "Latest `ps-selected-pages' value.")
3245 (defun ps-restore-selected-pages ()
3246 "Restore latest `ps-selected-pages' value."
3248 (setq ps-selected-pages ps-last-selected-pages))
3251 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3256 (defun ps-print-customize ()
3257 "Customization of ps-print group."
3259 (customize-group 'ps-print))
3262 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3267 (defun ps-print-buffer (&optional filename)
3268 "Generate and print a PostScript image of the buffer.
3270 Interactively, when you use a prefix argument (C-u), the command prompts the
3271 user for a file name, and saves the PostScript image in that file instead of
3272 sending it to the printer.
3274 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3275 send the image to the printer. If FILENAME is a string, save the PostScript
3276 image in a file with that name."
3277 (interactive (list (ps-print-preprint current-prefix-arg)))
3278 (ps-print-without-faces (point-min) (point-max) filename))
3282 (defun ps-print-buffer-with-faces (&optional filename)
3283 "Generate and print a PostScript image of the buffer.
3284 Like `ps-print-buffer', but includes font, color, and underline information in
3285 the generated image. This command works only if you are using a window system,
3286 so it has a way to determine color values."
3287 (interactive (list (ps-print-preprint current-prefix-arg)))
3288 (ps-print-with-faces (point-min) (point-max) filename))
3292 (defun ps-print-region (from to &optional filename)
3293 "Generate and print a PostScript image of the region.
3294 Like `ps-print-buffer', but prints just the current region."
3295 (interactive (ps-print-preprint-region current-prefix-arg))
3296 (ps-print-without-faces from to filename t))
3300 (defun ps-print-region-with-faces (from to &optional filename)
3301 "Generate and print a PostScript image of the region.
3302 Like `ps-print-region', but includes font, color, and underline information in
3303 the generated image. This command works only if you are using a window system,
3304 so it has a way to determine color values."
3305 (interactive (ps-print-preprint-region current-prefix-arg))
3306 (ps-print-with-faces from to filename t))
3310 (defun ps-spool-buffer ()
3311 "Generate and spool a PostScript image of the buffer.
3312 Like `ps-print-buffer' except that the PostScript image is saved in a local
3313 buffer to be sent to the printer later.
3315 Use the command `ps-despool' to send the spooled images to the printer."
3317 (ps-spool-without-faces (point-min) (point-max)))
3321 (defun ps-spool-buffer-with-faces ()
3322 "Generate and spool a PostScript image of the buffer.
3323 Like `ps-spool-buffer', but includes font, color, and underline information in
3324 the generated image. This command works only if you are using a window system,
3325 so it has a way to determine color values.
3327 Use the command `ps-despool' to send the spooled images to the printer."
3329 (ps-spool-with-faces (point-min) (point-max)))
3333 (defun ps-spool-region (from to)
3334 "Generate a PostScript image of the region and spool locally.
3335 Like `ps-spool-buffer', but spools just the current region.
3337 Use the command `ps-despool' to send the spooled images to the printer."
3339 (ps-spool-without-faces from to t))
3343 (defun ps-spool-region-with-faces (from to)
3344 "Generate a PostScript image of the region and spool locally.
3345 Like `ps-spool-region', but includes font, color, and underline information in
3346 the generated image. This command works only if you are using a window system,
3347 so it has a way to determine color values.
3349 Use the command `ps-despool' to send the spooled images to the printer."
3351 (ps-spool-with-faces from to t))
3354 (defun ps-despool (&optional filename)
3355 "Send the spooled PostScript to the printer.
3357 Interactively, when you use a prefix argument (C-u), the command prompts the
3358 user for a file name, and saves the spooled PostScript image in that file
3359 instead of sending it to the printer.
3361 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3362 send the image to the printer. If FILENAME is a string, save the PostScript
3363 image in a file with that name."
3364 (interactive (list (ps-print-preprint current-prefix-arg)))
3365 (ps-do-despool filename))
3368 (defun ps-line-lengths ()
3369 "Display the correspondence between a line length and a font size, using the
3370 current ps-print setup.
3371 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3373 (ps-line-lengths-internal))
3376 (defun ps-nb-pages-buffer (nb-lines)
3377 "Display number of pages to print this buffer, for various font heights.
3378 The table depends on the current ps-print setup."
3379 (interactive (ps-count-lines-preprint (point-min) (point-max)))
3380 (ps-nb-pages nb-lines))
3383 (defun ps-nb-pages-region (nb-lines)
3384 "Display number of pages to print the region, for various font heights.
3385 The table depends on the current ps-print setup."
3386 (interactive (ps-count-lines-preprint (mark) (point)))
3387 (ps-nb-pages nb-lines))
3389 (defvar ps-prefix-quote nil
3390 "Used for `ps-print-quote' (which see).")
3394 "Return the current PostScript-generation setup."
3395 (let (ps-prefix-quote)
3399 (concat "\n;;; ps-print version " ps-print-version "\n")
3400 '(25 . ps-print-color-p)
3401 '(25 . ps-lpr-command)
3402 '(25 . ps-lpr-switches)
3403 '(25 . ps-printer-name)
3404 '(25 . ps-printer-name-option)
3405 '(25 . ps-print-region-function)
3406 '(25 . ps-manual-feed)
3407 '(25 . ps-end-with-control-d)
3409 '(23 . ps-paper-type)
3410 '(23 . ps-warn-paper-type)
3411 '(23 . ps-landscape-mode)
3412 '(23 . ps-print-upside-down)
3413 '(23 . ps-number-of-columns)
3415 '(23 . ps-zebra-stripes)
3416 '(23 . ps-zebra-stripe-height)
3417 '(23 . ps-zebra-stripe-follow)
3418 '(23 . ps-zebra-color)
3419 '(23 . ps-line-number)
3420 '(23 . ps-line-number-step)
3421 '(23 . ps-line-number-start)
3423 '(17 . ps-default-fg)
3424 '(17 . ps-default-bg)
3425 '(17 . ps-razzle-dazzle)
3427 '(23 . ps-use-face-background)
3429 '(28 . ps-print-control-characters)
3431 '(26 . ps-print-background-image)
3433 '(25 . ps-print-background-text)
3435 '(29 . ps-error-handler-message)
3436 '(29 . ps-user-defined-prologue)
3437 '(29 . ps-print-prologue-header)
3438 '(29 . ps-postscript-code-directory)
3439 '(29 . ps-adobe-tag)
3441 '(30 . ps-left-margin)
3442 '(30 . ps-right-margin)
3443 '(30 . ps-inter-column)
3444 '(30 . ps-bottom-margin)
3445 '(30 . ps-top-margin)
3446 '(30 . ps-print-only-one-header)
3447 '(30 . ps-switch-header)
3448 '(30 . ps-print-header)
3449 '(30 . ps-header-lines)
3450 '(30 . ps-header-offset)
3451 '(30 . ps-header-line-pad)
3452 '(30 . ps-print-header-frame)
3453 '(30 . ps-header-frame-alist)
3454 '(30 . ps-print-footer)
3455 '(30 . ps-footer-lines)
3456 '(30 . ps-footer-offset)
3457 '(30 . ps-footer-line-pad)
3458 '(30 . ps-print-footer-frame)
3459 '(30 . ps-footer-frame-alist)
3460 '(30 . ps-show-n-of-n)
3461 '(30 . ps-spool-config)
3462 '(30 . ps-spool-duplex)
3463 '(30 . ps-spool-tumble)
3464 '(30 . ps-banner-page-when-duplexing)
3465 '(30 . ps-left-header)
3466 '(30 . ps-right-header)
3467 '(30 . ps-left-footer)
3468 '(30 . ps-right-footer)
3470 '(23 . ps-n-up-printing)
3471 '(23 . ps-n-up-margin)
3472 '(23 . ps-n-up-border-p)
3473 '(23 . ps-n-up-filling)
3475 '(26 . ps-multibyte-buffer)
3476 '(26 . ps-font-family)
3477 '(26 . ps-font-size)
3478 '(26 . ps-header-font-family)
3479 '(26 . ps-header-font-size)
3480 '(26 . ps-header-title-font-size)
3481 '(26 . ps-footer-font-family)
3482 '(26 . ps-footer-font-size)
3483 '(26 . ps-line-number-color)
3484 '(26 . ps-line-number-font)
3485 '(26 . ps-line-number-font-size)
3486 '(26 . ps-line-spacing)
3487 '(26 . ps-paragraph-spacing)
3488 '(26 . ps-paragraph-regexp)
3489 '(26 . ps-begin-cut-regexp)
3490 '(26 . ps-end-cut-regexp)
3492 '(23 . ps-even-or-odd-pages)
3493 '(23 . ps-selected-pages)
3494 '(23 . ps-last-selected-pages)
3496 '(31 . ps-build-face-reference)
3497 '(31 . ps-always-build-face-reference)
3499 '(20 . ps-auto-font-detect)
3500 '(20 . ps-bold-faces)
3501 '(20 . ps-italic-faces)
3502 '(20 . ps-underlined-faces)
3503 '(20 . ps-black-white-faces)
3505 ;; The following customized variables have long lists and are seldom modified:
3506 ;; ps-page-dimensions-database
3507 ;; ps-font-info-database
3509 ;;; ps-print - end of settings\n")
3513 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3514 ;; Utility functions and variables:
3517 (defun ps-print-quote (elt)
3518 "Quote ELT for printing (used for showing settings).
3520 If ELT is nil, return an empty string.
3521 If ELT is string, return it.
3522 Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3523 LEN is the field length where SYM name will be inserted. The variable
3524 `ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
3525 used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3528 * If `ps-prefix-quote' is nil:
3529 \"(setq SYM-NAME SYM-VALUE\"
3533 * If `ps-prefix-quote' is non-nil:
3534 \" SYM-NAME SYM-VALUE\"
3538 If `ps-prefix-quote' is nil, it's set to t after generating string."
3543 (let* ((col (car elt))
3545 (key (symbol-name sym))
3547 (val (symbol-value sym)))
3548 (concat (if ps-prefix-quote
3550 (setq ps-prefix-quote t)
3554 (make-string (- col len) ?\ )
3556 (cond ((null val) "nil")
3558 ((or (symbolp val) (listp val)) (format "'%S" val))
3559 (t (format "%S" val))))))
3563 (defun ps-value (alist-sym key)
3564 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3565 (cdr (assq key (symbol-value alist-sym))))
3568 (defun ps-get (alist-sym key)
3569 "Return element from association list ALIST-SYM which car is `eq' to KEY."
3570 (assq key (symbol-value alist-sym)))
3573 (defun ps-put (alist-sym key value)
3574 "Store element (KEY . VALUE) into association list ALIST-SYM.
3575 If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3576 It can be retrieved with `(ps-get ALIST-SYM KEY)'."
3577 (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
3580 (setq elt: (cons key value))
3581 (set alist-sym (cons elt: (symbol-value alist-sym))))
3585 (defun ps-del (alist-sym key)
3586 "Delete by side effect element KEY from association list ALIST-SYM."
3587 (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
3590 (if (eq key (car (car a:list:)))
3593 (setcdr old (cdr a:list:))
3594 (set alist-sym (cdr a:list:)))
3597 a:list: (cdr a:list:)))))
3598 (symbol-value alist-sym))
3601 (defun ps-time-stamp-locale-default ()
3602 "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
3603 (format-time-string "%x"))
3606 (defun ps-time-stamp-mon-dd-yyyy ()
3607 "Return date as \"Jun 18 2001\"."
3608 (format-time-string "%b %d %Y"))
3611 (defun ps-time-stamp-hh:mm:ss ()
3612 "Return time as \"17:28:31\"."
3613 (format-time-string "%T"))
3617 (if (memq ps-print-emacs-type '(lucid xemacs))
3618 ;; XEmacs change: Need to check for emacs-major-version too.
3619 (if (or (< emacs-major-version 19)
3620 (and (= emacs-major-version 19) (< emacs-minor-version 12)))
3621 (setq ps-print-color-p nil))
3622 (require 'faces)) ; face-font, face-underline-p,
3626 ;; Return t if the device (which can be changed during an emacs session)
3627 ;; can handle colors.
3628 ;; This function is not yet implemented for GNU emacs.
3629 (cond ((and (eq ps-print-emacs-type 'xemacs)
3630 ;; XEmacs change: Need to check for emacs-major-version too.
3631 (or (> emacs-major-version 19)
3632 (and (= emacs-major-version 19)
3633 (>= emacs-minor-version 12)))) ; xemacs >= 19.12
3634 (defun ps-color-device ()
3635 (eq (ps-x-device-class) 'color)))
3638 (defun ps-color-device ()
3639 (if (fboundp 'color-values)
3640 (ps-e-color-values "Green")
3644 (defun ps-mapper (extent list)
3646 (list (list (ps-x-extent-start-position extent) 'push extent)
3647 (list (ps-x-extent-end-position extent) 'pull extent)))
3650 (defun ps-extent-sorter (a b)
3651 (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
3653 (defun ps-xemacs-face-kind-p (face kind kind-regex)
3654 (let* ((frame-font (or (ps-x-face-font-instance face)
3655 (ps-x-face-font-instance 'default)))
3659 (ps-x-font-instance-properties frame-font))))
3660 (kind-spec (cdr-safe kind-cons))
3661 (case-fold-search t))
3662 (and kind-spec (string-match kind-regex kind-spec))))
3664 (defun ps-xemacs-color-name (color)
3665 (if (ps-x-color-specifier-p color)
3666 (ps-x-color-name color)
3669 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
3671 (defun ps-color-values (x-color)
3673 ((fboundp 'color-values)
3674 (ps-e-color-values x-color))
3675 ((fboundp 'x-color-values)
3676 (ps-e-x-color-values x-color))
3678 (error "No available function to determine X color values"))))
3680 (defalias 'ps-face-foreground-name 'face-foreground)
3681 (defalias 'ps-face-background-name 'face-background)
3683 (defun ps-face-bold-p (face)
3684 (or (ps-e-face-bold-p face)
3685 (memq face ps-bold-faces)))
3687 (defun ps-face-italic-p (face)
3688 (or (ps-e-face-italic-p face)
3689 (memq face ps-italic-faces)))
3695 ;; to avoid XEmacs compilation gripes
3696 (defvar coding-system-for-write nil)
3697 (defvar coding-system-for-read nil)
3698 (defvar buffer-file-coding-system nil)
3700 (and (fboundp 'find-coding-system)
3701 (or (ps-x-find-coding-system 'raw-text-unix)
3702 (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))
3704 (defun ps-color-values (x-color)
3705 (let ((color (ps-xemacs-color-name x-color)))
3707 ((fboundp 'x-color-values)
3708 (ps-e-x-color-values color))
3709 ((and (fboundp 'color-instance-rgb-components)
3711 (ps-x-color-instance-rgb-components
3712 (if (ps-x-color-instance-p x-color)
3714 (ps-x-make-color-instance color))))
3716 (error "No available function to determine X color values")))))
3718 (defun ps-face-foreground-name (face)
3719 (ps-xemacs-color-name (face-foreground face)))
3721 (defun ps-face-background-name (face)
3722 (ps-xemacs-color-name (face-background face)))
3724 (defun ps-face-bold-p (face)
3725 (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
3726 (memq face ps-bold-faces))) ; Kludge-compatible
3728 (defun ps-face-italic-p (face)
3729 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
3730 (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
3731 (memq face ps-italic-faces))) ; Kludge-compatible
3735 (defvar ps-print-color-scale 1.0)
3737 (defun ps-color-scale (color)
3738 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3739 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
3740 (ps-color-values color)))
3743 (defun ps-face-underlined-p (face)
3744 (or (face-underline-p face)
3745 (memq face ps-underlined-faces)))
3748 (defun ps-prologue-file (filenumber)
3749 "If prologue FILENUMBER exists and is readable, returns contents as string.
3751 Note: No major/minor-mode is activated and no local variables are evaluated for
3752 FILENUMBER, but proper EOL-conversion and character interpretation is
3754 (let ((filename (convert-standard-filename
3755 (expand-file-name (format "ps-prin%d.ps" filenumber)
3756 ps-postscript-code-directory))))
3757 (if (and (file-exists-p filename)
3758 (file-readable-p filename))
3760 (insert-file-contents filename)
3762 (error "ps-print PostScript prologue `%s' file was not found"
3766 (defvar ps-mark-code-directory nil)
3768 (defvar ps-print-prologue-0 ""
3769 "ps-print PostScript error handler.")
3771 (defvar ps-print-prologue-1 ""
3772 "ps-print PostScript prologue.")
3774 ;; Start Editing Here:
3776 (defvar ps-source-buffer nil)
3777 (defvar ps-spool-buffer-name "*PostScript*")
3778 (defvar ps-spool-buffer nil)
3780 (defvar ps-output-head nil)
3781 (defvar ps-output-tail nil)
3783 (defvar ps-page-postscript 0) ; page number
3784 (defvar ps-page-order 0) ; PostScript page counter
3785 (defvar ps-page-sheet 0) ; sheet counter
3786 (defvar ps-page-column 0) ; column counter
3787 (defvar ps-page-printed 0) ; total pages printed
3788 (defvar ps-page-n-up 0) ; n-up counter
3789 (defvar ps-lines-printed 0) ; total lines printed
3790 (defvar ps-showline-count 1) ; line number counter
3791 (defvar ps-first-page nil)
3792 (defvar ps-last-page nil)
3793 (defvar ps-print-page-p t)
3795 (defvar ps-control-or-escape-regexp nil)
3796 (defvar ps-n-up-on nil)
3798 (defvar ps-background-pages nil)
3799 (defvar ps-background-all-pages nil)
3800 (defvar ps-background-text-count 0)
3801 (defvar ps-background-image-count 0)
3803 (defvar ps-current-font 0)
3804 (defvar ps-default-foreground nil)
3805 (defvar ps-default-color nil)
3806 (defvar ps-current-color nil)
3807 (defvar ps-current-bg nil)
3809 (defvar ps-zebra-stripe-full-p nil)
3810 (defvar ps-razchunk 0)
3812 (defvar ps-color-p nil)
3813 (defvar ps-color-format
3814 (if (eq ps-print-emacs-type 'emacs)
3816 ;; Emacs understands the %f format; we'll use it to limit color RGB
3817 ;; values to three decimals to cut down some on the size of the
3818 ;; PostScript output.
3821 ;; Lucid emacsen will have to make do with %s (princ) for floats.
3824 ;; These values determine how much print-height to deduct when headers/footers
3825 ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
3828 (defvar ps-header-pad 0
3829 "Vertical and horizontal space between the header frame and the text.
3830 This is in units of points (1/72 inch).")
3832 (defvar ps-footer-pad 0
3833 "Vertical and horizontal space between the footer frame and the text.
3834 This is in units of points (1/72 inch).")
3836 ;; Define accessors to the dimensions list.
3838 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3839 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
3840 (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
3842 (defvar ps-landscape-page-height nil)
3844 (defvar ps-print-width nil)
3845 (defvar ps-print-height nil)
3847 (defvar ps-height-remaining nil)
3848 (defvar ps-width-remaining nil)
3850 (defvar ps-font-size-internal nil)
3851 (defvar ps-header-font-size-internal nil)
3852 (defvar ps-header-title-font-size-internal nil)
3853 (defvar ps-footer-font-size-internal nil)
3854 (defvar ps-line-spacing-internal nil)
3855 (defvar ps-paragraph-spacing-internal nil)
3858 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3859 ;; Internal Variables
3862 (defvar ps-black-white-faces-alist nil
3863 "Alist of symbolic faces used for black/white PostScript printers.
3864 An element of this list has the same form as `ps-print-face-extension-alist'
3867 Don't change this list directly; instead,
3868 use `ps-extend-face' and `ps-extend-face-list'.
3869 See documentation for `ps-extend-face' for valid extension symbol.
3870 See also documentation for `ps-print-color-p'.")
3873 (defvar ps-print-face-extension-alist nil
3874 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
3875 An element of this list has the following form:
3877 (FACE . [BITS FG BG])
3879 FACE is a symbol denoting a face name
3880 BITS is a bit vector, where each bit correspond
3881 to a feature (bold, underline, etc)
3882 (see documentation for `ps-print-face-map-alist')
3883 FG foreground color (string or nil)
3884 BG background color (string or nil)
3886 Don't change this list directly; instead,
3887 use `ps-extend-face' and `ps-extend-face-list'.
3888 See documentation for `ps-extend-face' for valid extension symbol.")
3891 (defvar ps-print-face-alist nil
3892 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
3894 An element of this list has the same form as an element of
3895 `ps-print-face-extension-alist'.
3897 Don't change this list directly; this list is used by `ps-face-attributes',
3898 `ps-map-face' and `ps-build-reference-face-lists'.")
3901 (defconst ps-print-face-map-alist
3910 "Alist of all features and the corresponding bit mask.
3911 Each symbol correspond to one bit in a bit vector.")
3914 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3919 (defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym)
3920 "Extend face in ALIST-SYM.
3922 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
3923 with face extension in ALIST-SYM; otherwise, overrides.
3925 If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
3926 otherwise, it should be an alist symbol.
3928 The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
3930 See `ps-extend-face' for documentation."
3931 (while face-extension-list
3932 (ps-extend-face (car face-extension-list) merge-p alist-sym)
3933 (setq face-extension-list (cdr face-extension-list))))
3937 (defun ps-extend-face (face-extension &optional merge-p alist-sym)
3938 "Extend face in ALIST-SYM.
3940 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
3941 with face extensions in ALIST-SYM; otherwise, overrides.
3943 If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
3944 otherwise, it should be an alist symbol.
3946 The elements of FACE-EXTENSION list have the form:
3948 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
3950 FACE-NAME is a face name symbol.
3952 FOREGROUND and BACKGROUND may be nil or a string that denotes the
3953 foreground and background colors respectively.
3955 EXTENSION is one of the following symbols:
3956 bold - use bold font.
3957 italic - use italic font.
3958 underline - put a line under text.
3959 strikeout - like underline, but the line is in middle of text.
3960 overline - like underline, but the line is over the text.
3961 shadow - text will have a shadow.
3962 box - text will be surrounded by a box.
3963 outline - print characters as hollow outlines.
3965 If EXTENSION is any other symbol, it is ignored."
3967 (setq alist-sym 'ps-print-face-extension-alist))
3968 (let* ((background (nth 2 face-extension))
3969 (foreground (nth 1 face-extension))
3970 (face-name (nth 0 face-extension))
3971 (ps-face (cdr (assq face-name (symbol-value alist-sym))))
3972 (face-vector (or ps-face (vector 0 nil nil)))
3973 (face-bit (ps-extension-bit face-extension)))
3975 (aset face-vector 0 (if merge-p
3976 (logior (aref face-vector 0) face-bit)
3978 (and (or (not merge-p) (and foreground (stringp foreground)))
3979 (aset face-vector 1 foreground))
3980 (and (or (not merge-p) (and background (stringp background)))
3981 (aset face-vector 2 background))
3982 ;; if face does not exist, insert it
3984 (set alist-sym (cons (cons face-name face-vector)
3985 (symbol-value alist-sym))))))
3988 (defun ps-extension-bit (face-extension)
3990 ;; map valid symbol extension to bit vector
3991 (setq face-extension (cdr (cdr face-extension)))
3992 (while (setq face-extension (cdr face-extension))
3993 (setq face-bit (logior face-bit
3994 (or (cdr (assq (car face-extension)
3995 ps-print-face-map-alist))
4000 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4001 ;; Adapted from font-lock: (obsolete stuff)
4002 ;; Originally face attributes were specified via `font-lock-face-attributes'.
4003 ;; Users then changed the default face attributes by setting that variable.
4004 ;; However, we try and be back-compatible and respect its value if set except
4005 ;; for faces where M-x customize has been used to save changes for the face.
4008 (defun ps-font-lock-face-attributes ()
4009 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
4010 (boundp 'font-lock-face-attributes)
4011 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
4012 (while face-attributes
4013 (let* ((face-attribute
4014 (car (prog1 face-attributes
4015 (setq face-attributes (cdr face-attributes)))))
4016 (face (car face-attribute)))
4017 ;; Rustle up a `defface' SPEC from a
4018 ;; `font-lock-face-attributes' entry.
4019 (unless (get face 'saved-face)
4020 (let ((foreground (nth 1 face-attribute))
4021 (background (nth 2 face-attribute))
4022 (bold-p (nth 3 face-attribute))
4023 (italic-p (nth 4 face-attribute))
4024 (underline-p (nth 5 face-attribute))
4027 (setq face-spec (cons ':foreground
4028 (cons foreground face-spec))))
4030 (setq face-spec (cons ':background
4031 (cons background face-spec))))
4033 (setq face-spec (append '(:bold t) face-spec)))
4035 (setq face-spec (append '(:italic t) face-spec)))
4037 (setq face-spec (append '(:underline t) face-spec)))
4038 (custom-declare-face face (list (list t face-spec)) nil)
4042 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4043 ;; Internal functions and variables
4046 (defvar ps-print-hook nil)
4047 (defvar ps-print-begin-sheet-hook nil)
4048 (defvar ps-print-begin-page-hook nil)
4049 (defvar ps-print-begin-column-hook nil)
4052 (defun ps-print-without-faces (from to &optional filename region-p)
4053 (ps-spool-without-faces from to region-p)
4054 (ps-do-despool filename))
4057 (defun ps-spool-without-faces (from to &optional region-p)
4058 (run-hooks 'ps-print-hook)
4059 (ps-printing-region region-p from)
4060 (ps-generate (current-buffer) from to 'ps-generate-postscript))
4063 (defun ps-print-with-faces (from to &optional filename region-p)
4064 (ps-spool-with-faces from to region-p)
4065 (ps-do-despool filename))
4068 (defun ps-spool-with-faces (from to &optional region-p)
4069 (run-hooks 'ps-print-hook)
4070 (ps-printing-region region-p from)
4071 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
4074 (defun ps-count-lines-preprint (from to)
4076 (error "The mark is not set now"))
4077 (list (count-lines from to)))
4080 (defun ps-count-lines (from to)
4081 (+ (count-lines from to)
4084 (if (= (current-column) 0) 1 0))))
4087 (defvar ps-printing-region nil
4088 "Variable used to indicate if the region that ps-print is printing.
4089 It is a cons, the car of which is the line number where the region begins, and
4090 its cdr is the total number of lines in the buffer. Formatting functions can
4091 use this information to print the original line number (and not the number of
4092 lines printed), and to indicate in the header that the printout is of a partial
4096 (defvar ps-printing-region-p nil
4097 "Non-nil means ps-print is printing a region.")
4100 (defun ps-printing-region (region-p from)
4101 (setq ps-printing-region-p region-p
4104 (ps-count-lines (point-min) from)
4106 (ps-count-lines (point-min) (point-max)))))
4109 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4110 ;; Internal functions
4113 (defsubst ps-font-alist (font-sym)
4114 (get font-sym 'fonts))
4116 (defun ps-font (font-sym font-type)
4117 "Font family name for text of `font-type', when generating PostScript."
4118 (let* ((font-list (ps-font-alist font-sym))
4119 (normal-font (cdr (assq 'normal font-list))))
4120 (while (and font-list (not (eq font-type (car (car font-list)))))
4121 (setq font-list (cdr font-list)))
4122 (or (cdr (car font-list)) normal-font)))
4124 (defsubst ps-fonts (font-sym)
4125 (mapcar 'cdr (ps-font-alist font-sym)))
4127 (defsubst ps-font-number (font-sym font-type)
4128 (or (ps-alist-position font-type (ps-font-alist font-sym))
4131 (defsubst ps-line-height (font-sym)
4132 "The height of a line, for generating PostScript.
4133 This is the value that ps-print uses to determine the height,
4134 y-dimension, of the lines of text it has printed, and thus affects the
4135 point at which page-breaks are placed.
4136 The line-height is *not* the same as the point size of the font."
4137 (get font-sym 'line-height))
4139 (defsubst ps-title-line-height (font-sym)
4140 "The height of a `title' line, for generating PostScript.
4141 This is the value that ps-print uses to determine the height,
4142 y-dimension, of the lines of text it has printed, and thus affects the
4143 point at which page-breaks are placed.
4144 The title-line-height is *not* the same as the point size of the font."
4145 (get font-sym 'title-line-height))
4147 (defsubst ps-space-width (font-sym)
4148 "The width of a space character, for generating PostScript.
4149 This value is used in expanding tab characters."
4150 (get font-sym 'space-width))
4152 (defsubst ps-avg-char-width (font-sym)
4153 "The average width, in points, of a character, for generating PostScript.
4154 This is the value that ps-print uses to determine the length,
4155 x-dimension, of the text it has printed, and thus affects the point at
4156 which long lines wrap around."
4157 (get font-sym 'avg-char-width))
4159 (defun ps-line-lengths-internal ()
4160 "Display the correspondence between a line length and a font size,
4161 using the current ps-print setup.
4162 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4163 (let* ((ps-font-size-internal
4164 (or ps-font-size-internal
4165 (ps-get-font-size 'ps-font-size)))
4166 (ps-header-font-size-internal
4167 (or ps-header-font-size-internal
4168 (ps-get-font-size 'ps-header-font-size)))
4169 (ps-header-title-font-size-internal
4170 (or ps-header-title-font-size-internal
4171 (ps-get-font-size 'ps-header-title-font-size)))
4172 (buf (get-buffer-create "*Line-lengths*"))
4173 (ifs ps-font-size-internal) ; initial font size
4174 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
4175 (print-width (progn (ps-get-page-dimensions)
4177 (ps-setup (ps-setup)) ; setup for the current buffer
4178 (fs-min 5) ; minimum font size
4179 cw-min ; minimum character width
4180 nb-cpl-max ; maximum nb of characters per line
4181 (fs-max 14) ; maximum font size
4182 cw-max ; maximum character width
4183 nb-cpl-min ; minimum nb of characters per line
4184 fs ; current font size
4185 cw ; current character width
4186 nb-cpl ; current nb of characters per line
4188 (setq cw-min (/ (* icw fs-min) ifs)
4189 nb-cpl-max (floor (/ print-width cw-min))
4190 cw-max (/ (* icw fs-max) ifs)
4191 nb-cpl-min (floor (/ print-width cw-max))
4194 (goto-char (point-max))
4195 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4197 "\nnb char per line / font size\n")
4198 (while (<= nb-cpl nb-cpl-max)
4199 (setq cw (/ print-width (float nb-cpl))
4200 fs (/ (* ifs cw) icw))
4201 (insert (format "%16d %s\n" nb-cpl fs))
4202 (setq nb-cpl (1+ nb-cpl)))
4204 (display-buffer buf 'not-this-window)))
4206 (defun ps-nb-pages (nb-lines)
4207 "Display correspondence between font size and the number of pages.
4208 The correspondence is based on having NB-LINES lines of text,
4209 and on the current ps-print setup."
4210 (let* ((ps-font-size-internal
4211 (or ps-font-size-internal
4212 (ps-get-font-size 'ps-font-size)))
4213 (ps-header-font-size-internal
4214 (or ps-header-font-size-internal
4215 (ps-get-font-size 'ps-header-font-size)))
4216 (ps-header-title-font-size-internal
4217 (or ps-header-title-font-size-internal
4218 (ps-get-font-size 'ps-header-title-font-size)))
4219 (ps-line-spacing-internal
4220 (or ps-line-spacing-internal
4221 (ps-get-size ps-line-spacing "line spacing")))
4222 (buf (get-buffer-create "*Nb-Pages*"))
4223 (ils ps-line-spacing-internal) ; initial line spacing
4224 (ifs ps-font-size-internal) ; initial font size
4225 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
4226 (page-height (progn (ps-get-page-dimensions)
4228 (ps-setup (ps-setup)) ; setup for the current buffer
4229 (fs-min 4) ; minimum font size
4230 lh-min ; minimum line height
4231 nb-lpp-max ; maximum nb of lines per page
4232 nb-page-min ; minimum nb of pages
4233 (fs-max 14) ; maximum font size
4234 lh-max ; maximum line height
4235 nb-lpp-min ; minimum nb of lines per page
4236 nb-page-max ; maximum nb of pages
4237 fs ; current font size
4238 lh ; current line height
4239 nb-lpp ; current nb of lines per page
4240 nb-page ; current nb of pages
4242 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
4243 nb-lpp-max (floor (/ page-height lh-min))
4244 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
4245 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
4246 nb-lpp-min (floor (/ page-height lh-max))
4247 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
4248 nb-page nb-page-min)
4250 (goto-char (point-max))
4251 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4253 (format "\nThere are %d lines.\n\n" nb-lines)
4254 "nb page / font size\n")
4255 (while (<= nb-page nb-page-max)
4256 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
4257 lh (/ page-height nb-lpp)
4258 fs (/ (* ifs lh) ilh))
4259 (insert (format "%7d %s\n" nb-page fs))
4260 (setq nb-page (1+ nb-page)))
4262 (display-buffer buf 'not-this-window)))
4264 ;; macros used in `ps-select-font'
4265 (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
4266 (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
4268 (defun ps-select-font (font-family sym font-size title-font-size)
4269 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
4271 (error "Don't have data to scale font %s. Known fonts families are %s"
4273 (mapcar 'car ps-font-info-database)))
4274 (let ((size (ps-lookup 'size)))
4275 (put sym 'fonts (ps-lookup 'fonts))
4276 (put sym 'space-width (ps-size-scale 'space-width))
4277 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
4278 (put sym 'line-height (ps-size-scale 'line-height))
4279 (put sym 'title-line-height
4280 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
4282 (defun ps-get-page-dimensions ()
4283 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
4284 page-width page-height)
4286 ((null page-dimensions)
4287 (error "`ps-paper-type' must be one of:\n%s"
4288 (mapcar 'car ps-page-dimensions-database)))
4289 ((< ps-number-of-columns 1)
4290 (error "The number of columns %d should be positive"
4291 ps-number-of-columns)))
4293 (ps-select-font ps-font-family 'ps-font-for-text
4294 ps-font-size-internal ps-font-size-internal)
4295 (ps-select-font ps-header-font-family 'ps-font-for-header
4296 ps-header-font-size-internal
4297 ps-header-title-font-size-internal)
4298 (ps-select-font ps-footer-font-family 'ps-font-for-footer
4299 ps-footer-font-size-internal ps-footer-font-size-internal)
4301 (setq page-width (ps-page-dimensions-get-width page-dimensions)
4302 page-height (ps-page-dimensions-get-height page-dimensions))
4305 (if ps-landscape-mode
4306 ;; exchange width and height
4307 (setq page-width (prog1 page-height (setq page-height page-width))))
4309 ;; It is used to get the lower right corner (only in landscape mode)
4310 (setq ps-landscape-page-height page-height)
4312 ;; | lm | text | ic | text | ic | text | rm |
4313 ;; page-width == lm + n * pw + (n - 1) * ic + rm
4314 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
4315 (setq ps-print-width (/ (- page-width
4316 ps-left-margin ps-right-margin
4317 (* (1- ps-number-of-columns) ps-inter-column))
4318 ps-number-of-columns))
4319 (if (<= ps-print-width 0)
4320 (error "Bad horizontal layout:
4322 ps-left-margin == %s
4323 ps-right-margin == %s
4324 ps-inter-column == %s
4325 ps-number-of-columns == %s
4326 | lm | text | ic | text | ic | text | rm |
4327 page-width == lm + n * print-width + (n - 1) * ic + rm
4328 => print-width == %d !"
4333 ps-number-of-columns
4336 (setq ps-print-height
4337 (- page-height ps-bottom-margin ps-top-margin))
4338 (if (<= ps-print-height 0)
4339 (error "Bad vertical layout:
4341 ps-bottom-margin == %s
4342 page-height == bm + print-height + tm
4343 => print-height == %d !"
4347 ;; If headers are turned on, deduct the height of the header from the print
4350 (setq ps-header-pad (* ps-header-line-pad
4351 (ps-title-line-height 'ps-font-for-header))
4352 ps-print-height (- ps-print-height
4355 (ps-title-line-height 'ps-font-for-header)
4356 (* (ps-line-height 'ps-font-for-header)
4357 (1- ps-header-lines))
4359 (if (<= ps-print-height 0)
4360 (error "Bad vertical layout (header):
4362 ps-bottom-margin == %s
4363 ps-header-offset == %s
4366 page-height == bm + print-height + tm - ho - hh
4367 => print-height == %d !"
4373 (ps-title-line-height 'ps-font-for-header)
4374 (* (ps-line-height 'ps-font-for-header)
4375 (1- ps-header-lines))
4378 ;; If footers are turned on, deduct the height of the footer from the print
4381 (setq ps-footer-pad (* ps-footer-line-pad
4382 (ps-title-line-height 'ps-font-for-footer))
4383 ps-print-height (- ps-print-height
4386 (* (ps-line-height 'ps-font-for-footer)
4387 (1- ps-footer-lines))
4389 (if (<= ps-print-height 0)
4390 (error "Bad vertical layout (footer):
4392 ps-bottom-margin == %s
4393 ps-footer-offset == %s
4396 page-height == bm + print-height + tm - fo - fh
4397 => print-height == %d !"
4403 (* (ps-line-height 'ps-font-for-footer)
4404 (1- ps-footer-lines))
4407 ;; ps-zebra-stripe-follow is `full' or `full-follow'
4408 (if ps-zebra-stripe-full-p
4409 (let* ((line-height (ps-line-height 'ps-font-for-text))
4410 (zebra (* (+ line-height ps-line-spacing-internal)
4411 ps-zebra-stripe-height)))
4412 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
4414 (if (<= ps-print-height 0)
4415 (error "Bad vertical layout (full zebra stripe follow):
4416 ps-zebra-stripe-follow == %s
4417 ps-zebra-stripe-height == %s
4418 font-text-height == %s
4420 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
4421 => print-height == %d !"
4422 ps-zebra-stripe-follow
4423 ps-zebra-stripe-height
4424 (ps-line-height 'ps-font-for-text)
4425 ps-line-spacing-internal
4426 ps-print-height))))))
4429 (defun ps-print-preprint-region (prefix-arg)
4430 (or (and (fboundp 'mark-active)
4432 (and (fboundp 'region-active-p)
4434 (error "The mark is not set now"))
4435 (list (point) (mark) (ps-print-preprint prefix-arg)))
4438 (defun ps-print-preprint (prefix-arg)
4440 (or (numberp prefix-arg)
4442 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4445 (prompt (format "Save PostScript to file: (default %s) " name))
4446 (res (read-file-name prompt default-directory name nil)))
4447 (while (cond ((file-directory-p res)
4449 (setq prompt "It's a directory"))
4450 ((not (file-writable-p res))
4452 (setq prompt "File is unwritable"))
4453 ((file-exists-p res)
4454 (setq prompt "File exists")
4455 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4458 (setq res (read-file-name
4459 (format "%s; save PostScript to file: " prompt)
4460 (file-name-directory res) nil nil
4461 (file-name-nondirectory res))))
4462 (if (file-directory-p res)
4463 (expand-file-name name (file-name-as-directory res))
4466 ;; The following functions implement a simple list-buffering scheme so
4467 ;; that ps-print doesn't have to repeatedly switch between buffers
4468 ;; while spooling. The functions `ps-output' and `ps-output-string' build
4469 ;; up the lists; the function `ps-flush-output' takes the lists and
4470 ;; insert its contents into the spool buffer (*PostScript*).
4472 (defvar ps-string-escape-codes
4473 (let ((table (make-vector 256 nil))
4475 ;; control characters
4476 (while (<= char ?\037)
4477 (aset table char (format "\\%03o" char))
4478 (setq char (1+ char)))
4479 ;; printable characters
4480 (while (< char ?\177)
4481 (aset table char (format "%c" char))
4482 (setq char (1+ char)))
4483 ;; DEL and 8-bit characters
4484 (while (<= char ?\377)
4485 (aset table char (format "\\%o" char))
4486 (setq char (1+ char)))
4487 ;; Override ASCII formatting characters with named escape code:
4488 (aset table ?\n "\\n") ; [NL] linefeed
4489 (aset table ?\r "\\r") ; [CR] carriage return
4490 (aset table ?\t "\\t") ; [HT] horizontal tab
4491 (aset table ?\b "\\b") ; [BS] backspace
4492 (aset table ?\f "\\f") ; [NP] form feed
4493 ;; Escape PostScript escape and string delimiter characters:
4494 (aset table ?\\ "\\\\")
4495 (aset table ?\( "\\(")
4496 (aset table ?\) "\\)")
4498 "Vector used to map characters to PostScript string escape codes.")
4500 (defsubst ps-output-string-prim (string)
4501 (insert "(") ;insert start-string delimiter
4502 (save-excursion ;insert string
4503 (insert (string-as-unibyte string)))
4504 ;; Find and quote special characters as necessary for PS
4505 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4506 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4507 (let ((special (following-char)))
4509 (insert (aref ps-string-escape-codes special))))
4510 (goto-char (point-max))
4511 (insert ")")) ;insert end-string delimiter
4513 (defsubst ps-init-output-queue ()
4514 (setq ps-output-head (list "")
4515 ps-output-tail ps-output-head))
4518 (defun ps-selected-pages ()
4520 (setq ps-first-page (car (car ps-selected-pages))
4521 ps-last-page (cdr (car ps-selected-pages))
4522 ps-selected-pages (cdr ps-selected-pages))
4523 (and ps-selected-pages
4524 (< ps-last-page ps-page-postscript)))))
4527 (defsubst ps-print-page-p ()
4528 (setq ps-print-page-p
4529 (and (cond ((null ps-first-page))
4530 ((<= ps-page-postscript ps-last-page)
4531 (<= ps-first-page ps-page-postscript))
4534 (and (<= ps-first-page ps-page-postscript)
4535 (<= ps-page-postscript ps-last-page)))
4538 (cond ((eq ps-even-or-odd-pages 'even-page)
4539 (= (logand ps-page-postscript 1) 0))
4540 ((eq ps-even-or-odd-pages 'odd-page)
4541 (= (logand ps-page-postscript 1) 1))
4546 (defsubst ps-print-sheet-p ()
4547 (setq ps-print-page-p
4548 (cond ((eq ps-even-or-odd-pages 'even-sheet)
4549 (= (logand ps-page-sheet 1) 0))
4550 ((eq ps-even-or-odd-pages 'odd-sheet)
4551 (= (logand ps-page-sheet 1) 1))
4556 (defun ps-output (&rest args)
4557 (when ps-print-page-p
4558 (setcdr ps-output-tail args)
4559 (while (cdr ps-output-tail)
4560 (setq ps-output-tail (cdr ps-output-tail)))))
4562 (defun ps-output-string (string)
4563 (ps-output t string))
4565 ;; Output strings in the list ARGS in the PostScript prologue part.
4566 (defun ps-output-prologue (args)
4567 (ps-output 'prologue (if (stringp args) (list args) args)))
4569 (defun ps-flush-output ()
4571 (set-buffer ps-spool-buffer)
4572 (goto-char (point-max))
4573 (while ps-output-head
4574 (let ((it (car ps-output-head)))
4577 (setq ps-output-head (cdr ps-output-head))
4578 (ps-output-string-prim (car ps-output-head)))
4580 (setq ps-output-head (cdr ps-output-head))
4582 (search-backward "\nBeginDoc")
4584 (apply 'insert (car ps-output-head))))
4587 (setq ps-output-head (cdr ps-output-head))))
4588 (ps-init-output-queue))
4590 (defun ps-insert-file (fname)
4593 (set-buffer ps-spool-buffer)
4594 (goto-char (point-max))
4595 (insert-file fname)))
4597 ;; These functions insert the arrays that define the contents of the headers.
4599 (defun ps-generate-header-line (fonttag &optional content)
4600 (ps-output " [" fonttag " ")
4602 ;; Literal strings should be output as is -- the string must contain its own
4603 ;; PS string delimiters, '(' and ')', if necessary.
4605 (ps-output (ps-mule-encode-header-string content fonttag)))
4607 ;; Functions are called -- they should return strings; they will be inserted
4608 ;; as strings and the PS string delimiters added.
4609 ((and (symbolp content) (fboundp content))
4610 (ps-output-string (ps-mule-encode-header-string (funcall content)
4613 ;; Variables will have their contents inserted. They should contain
4614 ;; strings, and will be inserted as strings.
4615 ((and (symbolp content) (boundp content))
4616 (ps-output-string (ps-mule-encode-header-string (symbol-value content)
4619 ;; Anything else will get turned into an empty string.
4621 (ps-output-string "")))
4624 (defun ps-generate-header (name fonttag0 fonttag1 contents)
4625 (ps-output "/" name "[\n")
4626 (and contents (> ps-header-lines 0)
4628 (ps-generate-header-line fonttag0 (car contents))
4629 (while (and (< count ps-header-lines)
4630 (setq contents (cdr contents)))
4631 (ps-generate-header-line fonttag1 (car contents))
4632 (setq count (1+ count)))))
4633 (ps-output "]def\n"))
4636 (defun ps-output-boolean (name bool)
4637 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
4640 (defun ps-output-frame-properties (name alist)
4641 (ps-output "/" name " ["
4642 (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
4643 (ps-format-color (cdr (assq 'back-color alist)) 0.9)
4644 (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
4645 (ps-format-color (cdr (assq 'border-color alist)) 0.0)
4646 (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
4650 (defun ps-background-pages (page-list func)
4654 (let ((start (if (consp pages) (car pages) pages))
4655 (end (if (consp pages) (cdr pages) pages)))
4656 (and (integerp start) (integerp end) (<= start end)
4657 (add-to-list 'ps-background-pages (vector start end func)))))
4659 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4662 (defconst ps-boundingbox-re
4664 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4667 (defun ps-get-boundingbox ()
4669 (set-buffer ps-spool-buffer)
4671 (if (re-search-forward ps-boundingbox-re nil t)
4672 (vector (string-to-number ; lower x
4673 (buffer-substring (match-beginning 1) (match-end 1)))
4674 (string-to-number ; lower y
4675 (buffer-substring (match-beginning 2) (match-end 2)))
4676 (string-to-number ; upper x
4677 (buffer-substring (match-beginning 3) (match-end 3)))
4678 (string-to-number ; upper y
4679 (buffer-substring (match-beginning 4) (match-end 4))))
4680 (vector 0 0 0 0)))))
4683 ;; Emacs understands the %f format; we'll use it to limit color RGB values
4684 ;; to three decimals to cut down some on the size of the PostScript output.
4685 ;; Lucid emacsen will have to make do with %s (princ) for floats.
4687 (defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
4689 "%s ")) ; Lucid emacsen
4692 (defun ps-float-format (value &optional default)
4693 (let ((literal (or value default)))
4694 (cond ((null literal)
4697 (format ps-float-format (* literal 1.0))) ; force float number
4699 (format "%s " literal))
4703 (defun ps-background-text ()
4706 (setq ps-background-text-count (1+ ps-background-text-count))
4707 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
4708 (ps-output-string (nth 0 text)) ; text
4711 (ps-float-format (nth 4 text) 200.0) ; font size
4712 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
4713 (ps-float-format (nth 6 text)
4714 "PrintHeight PrintPageWidth atan") ; rotation
4715 (ps-float-format (nth 5 text) 0.85) ; gray
4716 (ps-float-format (nth 1 text) "0") ; x position
4717 (ps-float-format (nth 2 text) "0") ; y position
4718 "\nShowBackText}def\n")
4719 (ps-background-pages (nthcdr 7 text) ; page list
4720 (format "ShowBackText-%d\n"
4721 ps-background-text-count)))
4722 ps-print-background-text))
4725 (defun ps-background-image ()
4728 (let ((image-file (expand-file-name (nth 0 image))))
4729 (when (file-readable-p image-file)
4730 (setq ps-background-image-count (1+ ps-background-image-count))
4732 (format "/ShowBackImage-%d{\n--back-- "
4733 ps-background-image-count)
4734 (ps-float-format (nth 5 image) 0.0) ; rotation
4735 (ps-float-format (nth 3 image) 1.0) ; x scale
4736 (ps-float-format (nth 4 image) 1.0) ; y scale
4737 (ps-float-format (nth 1 image) ; x position
4738 "PrintPageWidth 2 div")
4739 (ps-float-format (nth 2 image) ; y position
4740 "PrintHeight 2 div BottomMargin add")
4741 "\nBeginBackImage\n")
4742 (ps-insert-file image-file)
4743 ;; coordinate adjustment to centralize image
4744 ;; around x and y position
4745 (let ((box (ps-get-boundingbox)))
4747 (set-buffer ps-spool-buffer)
4749 (if (re-search-backward "^--back--" nil t)
4753 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
4756 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
4759 (ps-output "\nEndBackImage}def\n")
4760 (ps-background-pages (nthcdr 6 image) ; page list
4761 (format "ShowBackImage-%d\n"
4762 ps-background-image-count)))))
4763 ps-print-background-image))
4766 (defun ps-background (page-number)
4767 (let (has-local-background)
4768 (mapcar #'(lambda (range)
4769 (and (<= (aref range 0) page-number)
4770 (<= page-number (aref range 1))
4771 (if has-local-background
4772 (ps-output (aref range 2))
4773 (setq has-local-background t)
4774 (ps-output "/printLocalBackground{\n"
4776 ps-background-pages)
4777 (and has-local-background (ps-output "}def\n"))))
4780 ;; Return a list of the distinct elements of LIST.
4781 ;; Elements are compared with `equal'.
4782 (defun ps-remove-duplicates (list)
4783 (let (new (tail list))
4785 (or (member (car tail) new)
4786 (setq new (cons (car tail) new)))
4787 (setq tail (cdr tail)))
4791 ;; Find the first occurrence of ITEM in LIST.
4792 ;; Return the index of the matching item, or nil if not found.
4793 ;; Elements are compared with `eq'.
4794 (defun ps-alist-position (item list)
4795 (let ((tail list) (index 0) found)
4797 (if (setq found (eq (car (car tail)) item))
4799 (setq index (1+ index)
4804 (defconst ps-n-up-database
4855 (2 t 1 2 0) ; adjusted by PostScript code
4898 (2 t 1 2 0) ; adjusted by PostScript code
4943 ;; Ledger paper size is a special case, it is the only paper size where the
4944 ;; normal size is landscaped, that is, the height is smaller than width.
4945 ;; So, we use the special value `pag' in the `landscape' field.
4994 (2 t 1 2 0) ; adjusted by PostScript code
5090 "Alist which is the page matrix database used for N-up printing.
5092 Each element has the following form:
5095 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
5099 PAGE is the page size used (see `ps-paper-type').
5100 MAX is the maximum elements of this page matrix.
5101 LANDSCAPE specifies if page matrix is landscaped, has the following valid
5103 nil the sheet is in portrait mode.
5104 t the sheet is in landscape mode.
5105 pag the sheet is in portrait mode and page is in landscape mode.
5106 LINES is the number of lines of page matrix.
5107 COLUMNS is the number of columns of page matrix.
5108 COL-MISSING is the number of columns missing to fill the sheet.")
5111 (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
5112 (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
5113 (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
5114 (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
5117 (defun ps-n-up-printing ()
5118 ;; force `ps-n-up-printing' be in range 1 to 100.
5119 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
5120 ;; find suitable page matrix for a given `ps-paper-type'.
5121 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
5123 (while (> ps-n-up-printing (caar the-list))
5124 (setq the-list (cdr the-list))))
5128 (defconst ps-n-up-filling-database
5130 "PageWidth" ; N-Up-XColumn
5132 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5133 "LandscapePageHeight neg" ; N-Up-YLine
5134 "N-Up-Lines" ; N-Up-Repeat
5135 "N-Up-Columns" ; N-Up-End
5139 "PageWidth" ; N-Up-XColumn
5141 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5142 "LandscapePageHeight" ; N-Up-YLine
5143 "N-Up-Lines" ; N-Up-Repeat
5144 "N-Up-Columns" ; N-Up-End
5146 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5148 "PageWidth neg" ; N-Up-XColumn
5150 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5151 "LandscapePageHeight neg" ; N-Up-YLine
5152 "N-Up-Lines" ; N-Up-Repeat
5153 "N-Up-Columns" ; N-Up-End
5154 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5157 "PageWidth neg" ; N-Up-XColumn
5159 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5160 "LandscapePageHeight" ; N-Up-YLine
5161 "N-Up-Lines" ; N-Up-Repeat
5162 "N-Up-Columns" ; N-Up-End
5163 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5164 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5167 "LandscapePageHeight neg" ; N-Up-YColumn
5168 "PageWidth" ; N-Up-XLine
5169 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5170 "N-Up-Columns" ; N-Up-Repeat
5171 "N-Up-Lines" ; N-Up-End
5176 "LandscapePageHeight" ; N-Up-YColumn
5177 "PageWidth" ; N-Up-XLine
5178 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5179 "N-Up-Columns" ; N-Up-Repeat
5180 "N-Up-Lines" ; N-Up-End
5182 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5185 "LandscapePageHeight neg" ; N-Up-YColumn
5186 "PageWidth neg" ; N-Up-XLine
5187 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5188 "N-Up-Columns" ; N-Up-Repeat
5189 "N-Up-Lines" ; N-Up-End
5190 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5194 "LandscapePageHeight" ; N-Up-YColumn
5195 "PageWidth neg" ; N-Up-XLine
5196 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5197 "N-Up-Columns" ; N-Up-Repeat
5198 "N-Up-Lines" ; N-Up-End
5199 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5200 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
5201 "Alist for n-up printing initializations.
5203 Each element has the following form:
5205 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5208 KIND is a valid value of `ps-n-up-filling'.
5209 XCOL YCOL are the relative position for the next column.
5210 XLIN YLIN are the relative position for the beginning of next line.
5211 REPEAT is the number of repetions for external loop.
5212 END is the number of repetions for internal loop and also the number of pages in
5214 XSTART YSTART are the relative position for the first page in a sheet.")
5217 (defun ps-n-up-filling ()
5218 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
5219 (assq 'left-top ps-n-up-filling-database))))
5222 (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
5223 (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
5224 (defmacro ps-n-up-xline (init) `(nth 2 ,init))
5225 (defmacro ps-n-up-yline (init) `(nth 3 ,init))
5226 (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
5227 (defmacro ps-n-up-end (init) `(nth 5 ,init))
5228 (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
5229 (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
5232 (defconst ps-error-handler-alist
5236 (paper-and-system . 3))
5237 "Alist for error handler message.")
5240 (defconst ps-zebra-stripe-alist
5244 "Alist for zebra stripe continuation.")
5247 (defun ps-begin-file ()
5248 (setq ps-page-order 0
5250 ps-background-text-count 0
5251 ps-background-image-count 0
5252 ps-background-pages nil
5253 ps-background-all-pages nil)
5255 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
5256 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
5257 (n-up (ps-n-up-printing))
5258 (n-up-filling (ps-n-up-filling)))
5259 (and ps-n-up-on (setq tumble (not tumble)))
5262 "%%Title: " (buffer-name) ; Take job name from name of
5263 ; first buffer printed
5264 "\n%%Creator: " (user-full-name)
5265 " (using ps-print v" ps-print-version
5266 ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
5268 (if ps-landscape-mode "Landscape" "Portrait")
5269 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
5270 (mapconcat 'identity
5271 (ps-remove-duplicates
5272 (append (ps-fonts 'ps-font-for-text)
5273 (list (ps-font 'ps-font-for-header 'normal)
5274 (ps-font 'ps-font-for-header 'bold))))
5276 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
5277 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
5278 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
5279 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
5281 (if tumble " duplex(tumble)\n" " duplex\n")
5284 (ps-insert-string ps-print-prologue-header)
5286 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5287 (ps-page-dimensions-get-media dimensions)
5288 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
5289 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5290 (format "/ErrorMessage %s def\n\n"
5291 (or (cdr (assoc ps-error-handler-message
5292 ps-error-handler-alist))
5295 "\n%%BeginProcSet: UserDefinedPrologue\n\n")
5297 (ps-insert-string ps-user-defined-prologue)
5299 (ps-output "\n%%EndProcSet\n\n")
5301 (ps-output-boolean "LandscapeMode "
5302 (or ps-landscape-mode
5303 (eq (ps-n-up-landscape n-up) 'pag)))
5304 (ps-output-boolean "UpsideDown " ps-print-upside-down)
5305 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
5307 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
5308 (format "/PrintPageWidth %s def\n"
5309 (- (* (+ ps-print-width ps-inter-column)
5310 ps-number-of-columns)
5312 (format "/PrintWidth %s def\n" ps-print-width)
5313 (format "/PrintHeight %s def\n" ps-print-height)
5315 (format "/LeftMargin %s def\n" ps-left-margin)
5316 (format "/RightMargin %s def\n" ps-right-margin)
5317 (format "/InterColumn %s def\n" ps-inter-column)
5319 (format "/BottomMargin %s def\n" ps-bottom-margin)
5320 (format "/TopMargin %s def\n" ps-top-margin) ; not used
5321 (format "/HeaderOffset %s def\n" ps-header-offset)
5322 (format "/HeaderPad %s def\n" ps-header-pad)
5323 (format "/FooterOffset %s def\n" ps-footer-offset)
5324 (format "/FooterPad %s def\n" ps-footer-pad)
5325 (format "/FooterLines %s def\n" ps-footer-lines))
5327 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
5328 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
5331 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
5332 (ps-output-boolean "PrintHeader " ps-print-header)
5333 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
5334 (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist)
5335 (ps-output-boolean "PrintFooter " ps-print-footer)
5336 (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame)
5337 (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist)
5339 (let ((line-height (ps-line-height 'ps-font-for-text)))
5340 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
5341 (format "/ParagraphSpacing %s def\n"
5342 ps-paragraph-spacing-internal)
5343 (format "/LineHeight %s def\n" line-height)
5344 (format "/LinesPerColumn %d def\n"
5345 (let ((height (+ line-height
5346 ps-line-spacing-internal)))
5347 (round (/ (+ ps-print-height
5351 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
5352 (ps-output-boolean "Zebra " ps-zebra-stripes)
5353 (ps-output-boolean "PrintLineNumber " ps-line-number)
5354 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
5355 (ps-output (format "/ZebraFollow %d def\n"
5356 (or (cdr (assq ps-zebra-stripe-follow
5357 ps-zebra-stripe-alist))
5359 (format "/PrintLineStep %d def\n"
5360 (if (integerp ps-line-number-step)
5362 ps-zebra-stripe-height))
5363 (format "/PrintLineStart %d def\n" ps-line-number-start)
5365 (ps-format-color ps-line-number-color 0.0)
5366 (format "def\n/ZebraHeight %d def\n"
5367 ps-zebra-stripe-height)
5369 (ps-format-color ps-zebra-color 0.95)
5370 "def\n/BackgroundColor "
5371 (ps-format-color ps-default-bg 1.0)
5372 "def\n/UseSetpagedevice "
5373 (if (eq ps-spool-config 'setpagedevice)
5374 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5376 " def\n\n/PageWidth "
5377 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
5378 (format "/N-Up %d def\n" ps-n-up-printing))
5379 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
5380 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
5381 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
5382 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
5383 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
5384 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
5386 (if ps-landscape-mode
5387 (ps-n-up-end n-up-filling)
5388 (ps-n-up-repeat n-up-filling))
5390 (if ps-landscape-mode
5391 (ps-n-up-repeat n-up-filling)
5392 (ps-n-up-end n-up-filling))
5393 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
5394 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
5395 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
5396 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
5397 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
5398 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
5400 (ps-background-text)
5401 (ps-background-image)
5402 (setq ps-background-all-pages (nreverse ps-background-all-pages)
5403 ps-background-pages (nreverse ps-background-pages))
5405 (ps-output "\n" ps-print-prologue-1)
5407 (ps-output "\n/printGlobalBackground{\n")
5408 (mapcar 'ps-output ps-background-all-pages)
5409 (ps-output "}def\n/printLocalBackground{\n}def\n")
5411 ;; Header/line number fonts
5412 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
5413 ps-header-title-font-size-internal
5414 (ps-font 'ps-font-for-header 'bold))
5415 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
5416 ps-header-font-size-internal
5417 (ps-font 'ps-font-for-header 'normal))
5418 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
5419 (ps-get-font-size 'ps-line-number-font-size)
5420 ps-line-number-font)
5421 (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
5422 ps-footer-font-size-internal
5423 (ps-font 'ps-font-for-footer 'normal))
5424 "\n\n% ---- These lines must be kept together because...
5427 /HeaderTitleLineHeight FontHeight def
5430 /HeaderLineHeight FontHeight def
5431 /HeaderDescent Descent def
5434 /FooterLineHeight FontHeight def
5435 /FooterDescent Descent def
5437 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
5440 (let ((font (ps-font-alist 'ps-font-for-text))
5443 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
5445 ps-font-size-internal
5446 (ps-font 'ps-font-for-text (car (car font)))))
5447 (setq font (cdr font)
5450 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
5451 (ps-output (format "/SpaceWidthRatio %f def\n"
5452 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
5454 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
5455 (unless (eq ps-spool-config 'lpr-switches)
5456 (ps-output "\n%%BeginFeature: *Duplex "
5457 (ps-boolean-capitalized ps-spool-duplex)
5459 (ps-boolean-capitalized tumble)
5460 "\nUseSetpagedevice\n{BMark/Duplex "
5461 (ps-boolean-constant ps-spool-duplex)
5463 (ps-boolean-constant tumble)
5464 " EMark setpagedevice}\n{statusdict begin "
5465 (ps-boolean-constant ps-spool-duplex)
5467 (ps-boolean-constant tumble)
5468 " settumble end}ifelse\n%%EndFeature\n")))
5469 (ps-output "\n%%BeginFeature: *ManualFeed "
5470 (ps-boolean-capitalized ps-manual-feed)
5471 "\nBMark /ManualFeed "
5472 (ps-boolean-constant ps-manual-feed)
5473 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
5474 (and ps-banner-page-when-duplexing
5475 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
5478 (defun ps-format-color (color &optional default)
5479 (let ((the-color (if (stringp color)
5480 (ps-color-scale color)
5482 (if (and the-color (listp the-color))
5484 (format ps-color-format
5485 (* (nth 0 the-color) 1.0) ; force float number
5486 (* (nth 1 the-color) 1.0) ; force float number
5487 (* (nth 2 the-color) 1.0)) ; force float number
5489 (ps-float-format (if (numberp the-color) the-color default)))))
5492 (defun ps-insert-string (prologue)
5493 (let ((str (if (functionp prologue)
5500 (defun ps-boolean-capitalized (bool)
5501 (if bool "True" "False"))
5504 (defun ps-boolean-constant (bool)
5505 (if bool "true" "false"))
5508 (defun ps-header-dirpart ()
5509 (let ((fname (buffer-file-name)))
5511 (if (string-equal (buffer-name) (file-name-nondirectory fname))
5512 (abbreviate-file-name (file-name-directory fname))
5517 (defun ps-get-buffer-name ()
5519 ;; Indulge Jim this little easter egg:
5520 ((string= (buffer-name) "ps-print.el")
5521 "Hey, Cool! It's ps-print.el!!!")
5522 ;; Indulge Jack this other little easter egg:
5523 ((string= (buffer-name) "sokoban.el")
5524 "Super! C'est sokoban.el!")
5526 (and ps-printing-region-p "Subset of: ")
5528 (and (buffer-modified-p) " (unsaved)")))))
5531 (defun ps-get-size (size mess &optional arg)
5532 (let ((siz (cond ((numberp size)
5535 (numberp (car size))
5536 (numberp (cdr size)))
5537 (if ps-landscape-mode
5543 (error "Invalid %s `%S'%s"
5546 (format " for `%S'" arg)
5551 (defun ps-get-font-size (font-sym)
5552 (ps-get-size (symbol-value font-sym) "font size" font-sym))
5555 (defsubst ps-rgb-color (color default)
5556 (cond ((and color (listp color)) color)
5557 ((stringp color) (ps-color-scale color))
5558 ((numberp color) (list color color color))
5559 (t (list default default default))
5563 (defun ps-begin-job ()
5565 (or (equal ps-mark-code-directory ps-postscript-code-directory)
5566 (setq ps-print-prologue-0 (ps-prologue-file 0)
5567 ps-print-prologue-1 (ps-prologue-file 1)
5568 ps-mark-code-directory ps-postscript-code-directory))
5571 (while ps-selected-pages
5572 (setq page (car ps-selected-pages)
5573 ps-selected-pages (cdr ps-selected-pages))
5574 (cond ((integerp page)
5576 (setq new (cons (cons page page) new))))
5578 (and (integerp (car page)) (integerp (cdr page))
5580 (<= (car page) (cdr page))
5581 (setq new (cons page new))))))
5582 (setq ps-selected-pages (sort new #'(lambda (one other)
5583 (< (car one) (car other))))
5584 ps-last-selected-pages ps-selected-pages
5588 (or (listp ps-use-face-background)
5589 (setq ps-use-face-background t))
5591 (and (integerp ps-line-number-step)
5592 (<= ps-line-number-step 0)
5593 (setq ps-line-number-step 1))
5594 (setq ps-n-up-on (> ps-n-up-printing 1)
5595 ps-line-number-start (max 1 (min ps-line-number-start
5596 (if (integerp ps-line-number-step)
5598 ps-zebra-stripe-height))))
5601 (set-buffer ps-spool-buffer)
5602 (goto-char (point-max))
5603 (and (re-search-backward "^%%Trailer$" nil t)
5604 (delete-region (match-beginning 0) (point-max))))
5606 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5607 '(full full-follow))
5608 ps-page-postscript 0
5614 ps-showline-count (car ps-printing-region)
5615 ps-line-spacing-internal (ps-get-size ps-line-spacing
5617 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
5618 "paragraph spacing")
5619 ps-font-size-internal (ps-get-font-size 'ps-font-size)
5620 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
5621 ps-header-title-font-size-internal
5622 (ps-get-font-size 'ps-header-title-font-size)
5623 ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
5624 ps-control-or-escape-regexp
5625 (cond ((eq ps-print-control-characters '8-bit)
5626 (string-as-unibyte "[\000-\037\177-\377]"))
5627 ((eq ps-print-control-characters 'control-8-bit)
5628 (string-as-unibyte "[\000-\037\177-\237]"))
5629 ((eq ps-print-control-characters 'control)
5632 ps-default-foreground (ps-rgb-color ps-default-fg 0.0)
5633 ps-default-color (and (eq ps-print-color-p t) ps-default-foreground)
5634 ps-current-color ps-default-color
5635 ;; Set the color scale. We do it here instead of in the defvar so
5636 ;; that ps-print can be dumped into emacs. This expression can't be
5637 ;; evaluated at dump-time because X isn't initialized.
5638 ps-color-p (and ps-print-color-p (ps-color-device))
5639 ps-print-color-scale (if ps-color-p
5640 (float (car (ps-color-values "white")))
5642 ;; initialize page dimensions
5643 (ps-get-page-dimensions))
5646 (defun ps-page-number ()
5647 (if ps-print-only-one-header
5648 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5652 (defsubst ps-end-page ()
5653 (ps-output "EndPage\nEndDSCPage\n"))
5656 (defsubst ps-next-page ()
5662 (defun ps-header-sheet ()
5663 ;; Print only when a new sheet begins.
5664 (and ps-print-page-p (> ps-page-sheet 0)
5665 (ps-output "EndSheet\n"))
5666 (setq ps-page-sheet (1+ ps-page-sheet))
5667 (when (ps-print-sheet-p)
5668 (setq ps-page-order (1+ ps-page-order))
5669 (ps-output (if ps-n-up-on
5670 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5671 ps-page-order ps-page-postscript ps-page-order)
5672 (format "\n%%%%Page: %d %d\n"
5673 ps-page-postscript ps-page-order))
5674 ;; spooling needs to redefine Lines and PageCount on each page
5675 "/Lines 0 def\n/PageCount 0 def\n"
5676 (format "%d BeginSheet\nBeginDSCPage\n"
5677 ps-n-up-printing))))
5680 (defun ps-header-page ()
5681 ;; set total line and page number when printing has finished
5682 ;; (see `ps-generate')
5683 (if (zerop (mod ps-page-column ps-number-of-columns))
5685 (setq ps-page-postscript (1+ ps-page-postscript))
5686 (when (ps-print-page-p)
5688 (if (zerop (mod ps-page-n-up ps-n-up-printing))
5689 ;; Print only when a new sheet begins.
5692 (run-hooks 'ps-print-begin-sheet-hook))
5693 ;; Print only when a new page begins.
5694 (ps-output "BeginDSCPage\n")
5695 (run-hooks 'ps-print-begin-page-hook))
5696 (ps-background ps-page-postscript)
5697 (setq ps-page-n-up (1+ ps-page-n-up))
5698 (and ps-print-page-p
5699 (setq ps-page-printed (1+ ps-page-printed)))))
5700 ;; Print only when a new column begins.
5701 (ps-output "BeginDSCPage\n")
5702 (run-hooks 'ps-print-begin-column-hook))
5703 (setq ps-page-column (1+ ps-page-column)))
5705 (defun ps-begin-page ()
5706 (setq ps-width-remaining ps-print-width
5707 ps-height-remaining ps-print-height)
5711 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
5712 (format "/PageNumber %d def\n" (ps-page-number)))
5714 (when ps-print-header
5715 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
5716 (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
5717 (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
5719 (when ps-print-footer
5720 (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
5721 (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
5722 (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
5724 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
5725 (ps-set-font ps-current-font)
5726 (ps-set-bg ps-current-bg)
5727 (ps-set-color ps-current-color)
5728 (ps-mule-begin-page))
5730 (defsubst ps-skip-newline (limit)
5731 (setq ps-showline-count (1+ ps-showline-count)
5732 ps-lines-printed (1+ ps-lines-printed))
5733 (and (< (point) limit)
5736 (defsubst ps-next-line ()
5737 (setq ps-showline-count (1+ ps-showline-count)
5738 ps-lines-printed (1+ ps-lines-printed))
5739 (let* ((paragraph-p (and ps-paragraph-regexp
5740 (looking-at ps-paragraph-regexp)))
5741 (lh (+ (ps-line-height 'ps-font-for-text)
5743 ps-paragraph-spacing-internal
5744 ps-line-spacing-internal))))
5745 (if (< ps-height-remaining lh)
5747 (setq ps-width-remaining ps-print-width
5748 ps-height-remaining (- ps-height-remaining lh))
5749 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
5751 (defun ps-continue-line ()
5752 (setq ps-lines-printed (1+ ps-lines-printed))
5753 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
5754 (if (< ps-height-remaining lh)
5756 (setq ps-width-remaining ps-print-width
5757 ps-height-remaining (- ps-height-remaining lh))
5758 (ps-output "SL\n"))))
5760 (defun ps-find-wrappoint (from to char-width)
5761 (let ((avail (truncate (/ ps-width-remaining char-width)))
5764 (cons to (* todo char-width))
5765 (cons (+ from avail) ps-width-remaining))))
5767 (defun ps-basic-plot-str (from to string)
5768 (let* ((wrappoint (ps-find-wrappoint from to
5769 (ps-avg-char-width 'ps-font-for-text)))
5770 (to (car wrappoint))
5771 (str (substring string from to)))
5772 (ps-mule-prepare-ascii-font str)
5773 (ps-output-string str)
5777 (defun ps-basic-plot-string (from to &optional bg-color)
5778 (let* ((wrappoint (ps-find-wrappoint from to
5779 (ps-avg-char-width 'ps-font-for-text)))
5780 (to (car wrappoint))
5781 (string (buffer-substring-no-properties from to)))
5782 (ps-mule-prepare-ascii-font string)
5783 (ps-output-string string)
5787 (defun ps-basic-plot-whitespace (from to &optional bg-color)
5788 (let* ((wrappoint (ps-find-wrappoint from to
5789 (ps-space-width 'ps-font-for-text)))
5790 (to (car wrappoint)))
5791 (ps-output (format "%d W\n" (- to from)))
5794 (defun ps-plot (plotfunc from to &optional bg-color)
5796 (let* ((wrappoint (funcall plotfunc from to bg-color))
5797 (plotted-to (car wrappoint))
5798 (plotted-width (cdr wrappoint)))
5799 (setq from plotted-to
5800 ps-width-remaining (- ps-width-remaining plotted-width))
5802 (ps-continue-line))))
5803 (if ps-razzle-dazzle
5804 (let* ((q-todo (- (point-max) (point-min)))
5805 (q-done (- (point) (point-min)))
5806 (chunkfrac (/ q-todo 8))
5807 (chunksize (min chunkfrac 1000)))
5808 (if (> (- q-done ps-razchunk) chunksize)
5810 (setq ps-razchunk q-done)
5811 (message "Formatting...%3d%%"
5813 (/ (* 100 q-done) q-todo)
5814 (/ q-done (/ q-todo 100)))
5817 (defvar ps-last-font nil)
5819 (defun ps-set-font (font)
5820 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
5821 (ps-output (format "/%s F\n" ps-last-font)))
5823 (defun ps-set-bg (color)
5824 (if (setq ps-current-bg color)
5825 (ps-output (format ps-color-format
5826 (nth 0 color) (nth 1 color) (nth 2 color))
5828 (ps-output "false BG\n")))
5830 (defun ps-set-color (color)
5831 (setq ps-current-color (or color ps-default-foreground))
5832 (ps-output (format ps-color-format
5833 (nth 0 ps-current-color)
5834 (nth 1 ps-current-color) (nth 2 ps-current-color))
5838 (defsubst ps-plot-string (string)
5839 (ps-plot 'ps-basic-plot-str 0 (length string) string))
5842 (defvar ps-current-effect 0)
5845 (defun ps-plot-region (from to font &optional fg-color bg-color effects)
5846 (or (equal font ps-current-font)
5849 ;; Specify a foreground color only if one's specified and it's
5850 ;; different than the current.
5851 (let ((fg (or fg-color ps-default-foreground)))
5852 (or (equal fg ps-current-color)
5855 (or (equal bg-color ps-current-bg)
5856 (ps-set-bg bg-color))
5858 ;; Specify effects (underline, overline, box, etc)
5860 ((not (integerp effects))
5861 (ps-output "0 EF\n")
5862 (setq ps-current-effect 0))
5863 ((/= effects ps-current-effect)
5864 (ps-output (number-to-string effects) " EF\n")
5865 (setq ps-current-effect effects)))
5867 ;; Starting at the beginning of the specified region...
5871 ;; ...break the region up into chunks separated by tabs, linefeeds,
5872 ;; pagefeeds, control characters, and plot each chunk.
5874 ;; skip lines between cut markers
5875 (and ps-begin-cut-regexp ps-end-cut-regexp
5876 (looking-at ps-begin-cut-regexp)
5878 (goto-char (match-end 0))
5879 (and (re-search-forward ps-end-cut-regexp to 'noerror)
5880 (= (following-char) ?\n)
5882 (setq from (point))))
5883 (if (re-search-forward ps-control-or-escape-regexp to t)
5884 ;; region with some control characters or some multi-byte characters
5885 (let* ((match-point (match-beginning 0))
5886 (match (char-after match-point))
5887 (composition (ps-e-find-composition from (1+ match-point))))
5889 (if (and (nth 2 composition)
5890 (<= (car composition) match-point))
5892 (setq match-point (car composition)
5894 (goto-char (nth 1 composition)))
5895 (setq composition nil)))
5896 (when (< from match-point)
5897 (ps-mule-set-ascii-font)
5898 (ps-plot 'ps-basic-plot-string from match-point bg-color))
5900 ((= match ?\t) ; tab
5901 (let ((linestart (line-beginning-position)))
5903 (setq from (+ linestart (current-column)))
5904 (when (re-search-forward "[ \t]+" to t)
5905 (ps-mule-set-ascii-font)
5906 (ps-plot 'ps-basic-plot-whitespace
5907 from (+ linestart (current-column))
5910 ((= match ?\n) ; newline
5911 (if (looking-at "\f[^\n]")
5912 ;; \n\ftext\n ==>> next page, but keep line counting!!
5914 (ps-skip-newline to)
5916 ;; \n\f\n ==>> it'll be handled by form feed
5917 ;; \ntext\n ==>> next line
5920 ((= match ?\f) ; form feed
5921 ;; do not skip page if previous character is NEWLINE and
5922 ;; it is a beginning of page.
5923 (unless (and (equal (char-after (1- match-point)) ?\n)
5924 (= ps-height-remaining ps-print-height))
5925 ;; \f\n ==>> skip \n, but keep line counting!!
5926 (and (equal (following-char) ?\n)
5927 (ps-skip-newline to))
5930 (composition ; a composite sequence
5931 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
5933 ((> match 255) ; a multi-byte character
5934 (let* ((charset (char-charset match))
5935 (composition (ps-e-find-composition match-point to))
5936 (stop (if (nth 2 composition) (car composition) to)))
5937 (or (eq charset 'composition)
5938 (while (and (< (point) stop) (eq (charset-after) charset))
5940 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
5941 ; characters from ^@ to ^_ and
5942 (t ; characters from 127 to 255
5943 (ps-control-character match)))
5944 (setq from (point)))
5945 ;; region without control characters nor multi-byte characters
5946 (ps-mule-set-ascii-font)
5947 (ps-plot 'ps-basic-plot-string from to bg-color)
5950 (defvar ps-string-control-codes
5951 (let ((table (make-vector 256 nil))
5953 ;; control character
5954 (while (<= char ?\037)
5955 (aset table char (format "^%c" (+ char ?@)))
5956 (setq char (1+ char)))
5957 ;; printable character
5958 (while (< char ?\177)
5959 (aset table char (format "%c" char))
5960 (setq char (1+ char)))
5962 (aset table char "^?")
5964 (while (<= (setq char (1+ char)) ?\377)
5965 (aset table char (format "\\%o" char)))
5967 "Vector used to map characters to a printable string.")
5969 (defun ps-control-character (char)
5970 (let* ((str (aref ps-string-control-codes char))
5974 (char-width (ps-avg-char-width 'ps-font-for-text))
5975 (wrappoint (ps-find-wrappoint from to char-width)))
5976 (if (< (car wrappoint) to)
5978 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
5979 (ps-mule-prepare-ascii-font str)
5980 (ps-output-string str)
5981 (ps-output " S\n")))
5984 (defun ps-face-attributes (face)
5985 "Return face attribute vector.
5987 If FACE is not in `ps-print-face-extension-alist' or in
5988 `ps-print-face-alist', insert it on `ps-print-face-alist' and
5989 return the attribute vector.
5991 If FACE is not a valid face name, it is used default face."
5993 (ps-black-white-faces-alist
5994 (or (and (symbolp face)
5995 (cdr (assq face ps-black-white-faces-alist)))
5996 (vector 0 nil nil)))
5998 (cdr (or (assq face ps-print-face-extension-alist)
5999 (assq face ps-print-face-alist)
6000 (let* ((the-face (if (facep face) face 'default))
6001 (new-face (ps-screen-to-bit-face the-face)))
6002 (or (and (eq the-face 'default)
6003 (assq the-face ps-print-face-alist))
6004 (setq ps-print-face-alist
6005 (cons new-face ps-print-face-alist)))
6007 ((eq (car face) 'foreground-color)
6008 (vector 0 (cdr face) nil))
6009 ((eq (car face) 'background-color)
6010 (vector 0 nil (cdr face)))
6012 (vector 0 nil nil))))
6015 (defun ps-face-background (face background)
6016 (and (or (eq ps-use-face-background t)
6017 (cond ((symbolp face)
6018 (memq face ps-use-face-background))
6020 (or (memq (car face) '(foreground-color background-color))
6023 (if (or (memq (car face) ps-use-face-background)
6025 '(foreground-color background-color)))
6028 (setq face (cdr face))))
6036 (defun ps-face-attribute-list (face-or-list)
6039 ((not (listp face-or-list))
6040 (ps-face-attributes face-or-list))
6041 ;; only foreground color, not a `real' face
6042 ((eq (car face-or-list) 'foreground-color)
6043 (vector 0 (cdr face-or-list) nil))
6044 ;; only background color, not a `real' face
6045 ((eq (car face-or-list) 'background-color)
6046 (vector 0 nil (cdr face-or-list)))
6050 foreground background face-attr face)
6052 (setq face (car face-or-list)
6053 face-or-list (cdr face-or-list)
6054 face-attr (ps-face-attributes face)
6055 effects (logior effects (aref face-attr 0)))
6056 (or foreground (setq foreground (aref face-attr 1)))
6058 (setq background (ps-face-background face (aref face-attr 2)))))
6059 (vector effects foreground background)))))
6062 (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
6065 (defun ps-plot-with-face (from to face)
6067 ((null face) ; print text with null face
6068 (ps-plot-region from to 0))
6069 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
6070 (t ; otherwise, text has a valid face
6071 (let* ((face-bit (ps-face-attribute-list face))
6072 (effect (aref face-bit 0))
6073 (foreground (aref face-bit 1))
6074 (background (ps-face-background face (aref face-bit 2)))
6075 (fg-color (if (and ps-color-p foreground)
6076 (ps-color-scale foreground)
6078 (bg-color (and ps-color-p background
6079 (ps-color-scale background))))
6082 (ps-font-number 'ps-font-for-text
6083 (or (aref ps-font-type (logand effect 3))
6085 fg-color bg-color (lsh effect -2)))))
6089 ;; Ensure that face-list is fbound.
6090 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
6093 (defun ps-build-reference-face-lists ()
6094 ;; Ensure that face database is updated with faces on
6095 ;; `font-lock-face-attributes' (obsolete stuff)
6096 (ps-font-lock-face-attributes)
6097 ;; Now, rebuild reference face lists
6098 (setq ps-print-face-alist nil)
6099 (if ps-auto-font-detect
6100 (mapcar 'ps-map-face (face-list))
6101 (mapcar 'ps-set-face-bold ps-bold-faces)
6102 (mapcar 'ps-set-face-italic ps-italic-faces)
6103 (mapcar 'ps-set-face-underline ps-underlined-faces))
6104 (setq ps-build-face-reference nil))
6107 (defun ps-set-face-bold (face)
6108 (ps-set-face-attribute face 1))
6110 (defun ps-set-face-italic (face)
6111 (ps-set-face-attribute face 2))
6113 (defun ps-set-face-underline (face)
6114 (ps-set-face-attribute face 4))
6117 (defun ps-set-face-attribute (face effect)
6118 (let ((face-bit (cdr (ps-map-face face))))
6119 (aset face-bit 0 (logior (aref face-bit 0) effect))))
6122 (defun ps-map-face (face)
6123 (let* ((face-map (ps-screen-to-bit-face face))
6124 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
6126 ;; if face exists, merge both
6127 (let ((face-bit (cdr face-map)))
6128 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
6129 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
6130 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
6131 ;; if face does not exist, insert it
6132 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
6136 (defun ps-screen-to-bit-face (face)
6138 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
6139 (if (ps-face-italic-p face) 2 0) ; italic
6140 (if (ps-face-underlined-p face) 4 0)) ; underline
6141 (ps-face-foreground-name face)
6142 (ps-face-background-name face))))
6145 ;; to avoid compilation gripes
6146 (defun ps-print-ensure-fontified (start end)
6148 ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
6149 (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
6150 (ps-jitify start end))
6151 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
6152 (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
6153 (ps-lazify start end))))
6156 (defun ps-generate-postscript-with-faces (from to)
6157 ;; Some initialization...
6158 (setq ps-current-effect 0)
6160 ;; Build the reference lists of faces if necessary.
6161 (when (or ps-always-build-face-reference
6162 ps-build-face-reference)
6163 (message "Collecting face information...")
6164 (ps-build-reference-face-lists))
6166 ;; Black/white printer.
6167 (setq ps-black-white-faces-alist nil)
6168 (and (eq ps-print-color-p 'black-white)
6169 (ps-extend-face-list ps-black-white-faces nil
6170 'ps-black-white-faces-alist))
6172 ;; Generate some PostScript.
6174 (narrow-to-region from to)
6175 (ps-print-ensure-fontified from to)
6176 (let ((face 'default)
6179 ((memq ps-print-emacs-type '(xemacs lucid))
6180 ;; Build the list of extents...
6181 (let ((a (cons 'dummy nil))
6182 record type extent extent-list)
6183 (ps-x-map-extents 'ps-mapper nil from to a)
6184 (setq a (sort (cdr a) 'car-less-than-car)
6187 ;; Loop through the extents...
6189 (setq record (car a)
6190 position (car record)
6196 extent (car record))
6198 ;; Plot up to this record.
6199 ;; XEmacs 19.12: for some reason, we're getting into a
6200 ;; situation in which some of the records have
6201 ;; positions less than 'from'. Since we've narrowed
6202 ;; the buffer, this'll generate errors. This is a hack,
6203 ;; but don't call ps-plot-with-face unless from > point-min.
6204 (and (>= from (point-min))
6205 (ps-plot-with-face from (min position (point-max)) face))
6209 (and (ps-x-extent-face extent)
6210 (setq extent-list (sort (cons extent extent-list)
6211 'ps-extent-sorter))))
6214 (setq extent-list (sort (delq extent extent-list)
6215 'ps-extent-sorter))))
6217 (setq face (if extent-list
6218 (ps-x-extent-face (car extent-list))
6223 ((eq ps-print-emacs-type 'emacs)
6224 (let ((property-change from)
6225 (overlay-change from)
6226 (save-buffer-invisibility-spec buffer-invisibility-spec)
6227 (buffer-invisibility-spec nil)
6228 before-string after-string)
6230 (and (< property-change to) ; Don't search for property change
6231 ; unless previous search succeeded.
6232 (setq property-change (next-property-change from nil to)))
6233 (and (< overlay-change to) ; Don't search for overlay change
6234 ; unless previous search succeeded.
6235 (setq overlay-change (min (ps-e-next-overlay-change from)
6237 (setq position (min property-change overlay-change)
6240 ;; The code below is not quite correct,
6241 ;; because a non-nil overlay invisible property
6242 ;; which is inactive according to the current value
6243 ;; of buffer-invisibility-spec nonetheless overrides
6244 ;; a face text property.
6246 (cond ((let ((prop (get-text-property from 'invisible)))
6247 ;; Decide whether this invisible property
6248 ;; really makes the text invisible.
6249 (if (eq save-buffer-invisibility-spec t)
6251 (or (memq prop save-buffer-invisibility-spec)
6252 (assq prop save-buffer-invisibility-spec))))
6253 'emacs--invisible--face)
6254 ((get-text-property from 'face))
6256 (let ((overlays (ps-e-overlays-at from))
6257 (face-priority -1)) ; text-property
6258 (while (and overlays
6259 (not (eq face 'emacs--invisible--face)))
6260 (let* ((overlay (car overlays))
6262 (ps-e-overlay-get overlay 'invisible))
6264 (or (ps-e-overlay-get overlay 'priority) 0)))
6265 (and (> overlay-priority face-priority)
6267 (or (ps-e-overlay-get overlay 'before-string)
6270 (or (and (<= (ps-e-overlay-end overlay) position)
6271 (ps-e-overlay-get overlay 'after-string))
6273 face-priority overlay-priority
6276 ((if (eq save-buffer-invisibility-spec t)
6277 (not (null overlay-invisible))
6278 (or (memq overlay-invisible
6279 save-buffer-invisibility-spec)
6280 (assq overlay-invisible
6281 save-buffer-invisibility-spec)))
6282 'emacs--invisible--face)
6283 ((ps-e-overlay-get overlay 'face))
6286 (setq overlays (cdr overlays))))
6287 ;; Plot up to this record.
6289 (ps-plot-string before-string))
6290 (ps-plot-with-face from position face)
6292 (ps-plot-string after-string))
6293 (setq from position)))))
6294 (ps-plot-with-face from to face))))
6296 (defun ps-generate-postscript (from to)
6297 (ps-plot-region from to 0 nil))
6299 (defun ps-generate (buffer from to genfunc)
6301 (let ((from (min to from))
6303 ;; This avoids trouble if chars with read-only properties
6304 ;; are copied into ps-spool-buffer.
6305 (inhibit-read-only t))
6307 (narrow-to-region from to)
6308 (and ps-razzle-dazzle
6309 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
6310 (setq ps-source-buffer buffer
6311 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
6312 (ps-init-output-queue)
6313 (let (safe-marker completed-safely needs-begin-file)
6316 (set-buffer ps-spool-buffer)
6317 (set-buffer-multibyte nil)
6319 ;; Get a marker and make it point to the current end of the
6320 ;; buffer, If an error occurs, we'll delete everything from
6321 ;; the end of this marker onwards.
6322 (setq safe-marker (make-marker))
6323 (set-marker safe-marker (point-max))
6325 (goto-char (point-min))
6326 (or (looking-at (regexp-quote ps-adobe-tag))
6327 (setq needs-begin-file t))
6329 (set-buffer ps-source-buffer)
6331 (let ((ps-print-page-p t)
6332 ps-even-or-odd-pages)
6334 (when needs-begin-file
6336 (ps-mule-initialize))
6337 (ps-mule-begin-job from to)
6338 (ps-selected-pages)))
6340 (funcall genfunc from to)
6342 (ps-end-job needs-begin-file)
6344 ;; Setting this variable tells the unwind form that the
6345 ;; the PostScript was generated without error.
6346 (setq completed-safely t))
6348 ;; Unwind form: If some bad mojo occurred while generating
6349 ;; PostScript, delete all the PostScript that was generated.
6350 ;; This protects the previously spooled files from getting
6352 (and (markerp safe-marker) (not completed-safely)
6354 (set-buffer ps-spool-buffer)
6355 (delete-region (marker-position safe-marker) (point-max))))))
6357 (and ps-razzle-dazzle (message "Formatting...done"))))))
6360 (defun ps-end-job (needs-begin-file)
6361 (let ((previous-print ps-print-page-p)
6362 (ps-print-page-p t))
6365 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
6366 (total-lines (cdr ps-printing-region))
6367 (total-pages (ps-page-number)))
6368 (set-buffer ps-spool-buffer)
6369 (let (case-fold-search)
6370 ;; Back to the PS output buffer to set the last page n-up printing
6371 (goto-char (point-max))
6372 (and (> pages-per-sheet 0)
6373 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
6374 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
6375 ;; Back to the PS output buffer to set the page count
6376 (goto-char (point-min))
6377 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
6378 (replace-match (format "/Lines %d def\n/PageCount %d def"
6379 total-lines total-pages) t)))))
6381 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
6382 (let ((ps-n-up-printing 0))
6384 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
6385 "/PrintLineNumber false def\n"
6386 (number-to-string ps-lines-printed) " BeginPage\n")
6388 ;; Set end of PostScript file
6390 (ps-output "EndSheet\n"))
6391 (ps-output "\n%%Trailer\n%%Pages: "
6393 (if (and needs-begin-file
6394 ps-banner-page-when-duplexing)
6397 "\n\nEndDoc\n\n%%EOF\n")
6398 (and ps-end-with-control-d
6401 ;; disable selected pages
6402 (setq ps-selected-pages nil))
6405 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
6406 (defun ps-do-despool (filename)
6407 (if (or (not (boundp 'ps-spool-buffer))
6408 (not (symbol-value 'ps-spool-buffer)))
6409 (message "No spooled PostScript to print")
6412 (and ps-razzle-dazzle (message "Saving..."))
6413 (set-buffer ps-spool-buffer)
6414 (setq filename (expand-file-name filename))
6415 (let ((coding-system-for-write 'raw-text-unix))
6416 (write-region (point-min) (point-max) filename))
6417 (and ps-razzle-dazzle (message "Wrote %s" filename)))
6418 ;; Else, spool to the printer
6419 (and ps-razzle-dazzle (message "Printing..."))
6421 (set-buffer ps-spool-buffer)
6422 (let* ((coding-system-for-write 'raw-text-unix)
6423 (ps-printer-name (or ps-printer-name
6424 (and (boundp 'printer-name)
6425 (symbol-value 'printer-name))))
6427 (append ps-lpr-switches
6428 (and (stringp ps-printer-name)
6429 (string< "" ps-printer-name)
6431 (and (stringp ps-printer-name-option)
6432 ps-printer-name-option)
6433 ps-printer-name)))))
6435 (apply (or ps-print-region-function 'call-process-region)
6436 (point-min) (point-max) ps-lpr-command nil
6438 (if (get-buffer ps-lpr-log-buffer)
6439 (kill-buffer (get-buffer ps-lpr-log-buffer)))
6440 (get-buffer-create ps-lpr-log-buffer))
6442 (ps-flatten-list ; dynamic evaluation
6443 (mapcar 'ps-eval-switch ps-lpr-switches)))))
6444 (if (= 0 return-code)
6445 (and ps-razzle-dazzle (message "Printing...done"))
6448 (mapconcat 'ps-eval-switch ps-lpr-switches " ")
6449 (buffer-substring nil nil (get-buffer ps-lpr-log-buffer)))))))
6450 (kill-buffer ps-spool-buffer)))
6452 ;; Dynamic evaluation
6453 (defun ps-eval-switch (arg)
6454 (cond ((stringp arg) arg)
6455 ((functionp arg) (apply arg nil))
6456 ((symbolp arg) (symbol-value arg))
6457 ((consp arg) (apply (car arg) (cdr arg)))
6460 ;; `ps-flatten-list' is defined here (copied from "message.el" and
6461 ;; enhanced to handle dotted pairs as well) until we can get some
6462 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
6464 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
6465 ;; => (a b c d e f g h i j)
6467 (defun ps-flatten-list (&rest list)
6468 (ps-flatten-list-1 list))
6470 (defun ps-flatten-list-1 (list)
6471 (cond ((null list) nil)
6472 ((consp list) (append (ps-flatten-list-1 (car list))
6473 (ps-flatten-list-1 (cdr list))))
6476 (defun ps-kill-emacs-check ()
6478 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6479 (buffer-modified-p ps-buffer)
6480 (y-or-n-p "Unprinted PostScript waiting; print now? ")
6482 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6483 (buffer-modified-p ps-buffer)
6484 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
6485 (error "Unprinted PostScript"))))
6487 (cond ((fboundp 'add-hook)
6488 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
6490 (message "Won't override existing `kill-emacs-hook'"))
6492 (setq kill-emacs-hook 'ps-kill-emacs-check)))
6495 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6496 ;;; Sample Setup Code:
6499 ;; This stuff is for anybody that's brave enough to look this far,
6500 ;; and able to figure out how to use it. It isn't really part of
6501 ;; ps-print, but I'll leave it here in hopes it might be useful:
6503 ;; WARNING!!! The following code is *sample* code only.
6504 ;; Don't use it unless you understand what it does!
6506 (defmacro ps-prsc ()
6507 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
6508 (defmacro ps-c-prsc ()
6509 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
6510 (defmacro ps-s-prsc ()
6511 `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
6513 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
6514 ;; `ps-left-headers' specially for mail messages.
6515 (defun ps-rmail-mode-hook ()
6516 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
6517 (setq ps-header-lines 3
6519 ;; The left headers will display the message's subject, its
6520 ;; author, and the name of the folder it was in.
6521 '(ps-article-subject ps-article-author buffer-name)))
6523 ;; See `ps-gnus-print-article-from-summary'. This function does the
6524 ;; same thing for rmail.
6525 (defun ps-rmail-print-message-from-summary ()
6527 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
6529 ;; Used in `ps-rmail-print-article-from-summary',
6530 ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
6531 (defun ps-print-message-from-summary (summary-buffer summary-default)
6532 (let ((ps-buf (or (and (boundp summary-buffer)
6533 (symbol-value summary-buffer))
6535 (and (get-buffer ps-buf)
6538 (ps-spool-buffer-with-faces)))))
6540 ;; Look in an article or mail message for the Subject: line. To be
6541 ;; placed in `ps-left-headers'.
6542 (defun ps-article-subject ()
6544 (goto-char (point-min))
6545 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
6546 (buffer-substring (match-beginning 1) (match-end 1))
6549 ;; Look in an article or mail message for the From: line. Sorta-kinda
6550 ;; understands RFC-822 addresses and can pull the real name out where
6551 ;; it's provided. To be placed in `ps-left-headers'.
6552 (defun ps-article-author ()
6554 (goto-char (point-min))
6555 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
6556 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
6559 ;; Try first to match addresses that look like
6560 ;; thompson@wg2.waii.com (Jim Thompson)
6561 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
6562 (substring fromstring (match-beginning 1) (match-end 1)))
6564 ;; Next try to match addresses that look like
6565 ;; Jim Thompson <thompson@wg2.waii.com> or
6566 ;; "Jim Thompson" <thompson@wg2.waii.com>
6567 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
6568 (substring fromstring (match-beginning 2) (match-end 2)))
6570 ;; Couldn't find a real name -- show the address instead.
6574 ;; A hook to bind to `gnus-article-prepare-hook'. This will set the
6575 ;; `ps-left-headers' specially for gnus articles. Unfortunately,
6576 ;; `gnus-article-mode-hook' is called only once, the first time the *Article*
6577 ;; buffer enters that mode, so it would only work for the first time
6578 ;; we ran gnus. The second time, this hook wouldn't get set up. The
6579 ;; only alternative is `gnus-article-prepare-hook'.
6580 (defun ps-gnus-article-prepare-hook ()
6581 (setq ps-header-lines 3
6583 ;; The left headers will display the article's subject, its
6584 ;; author, and the newsgroup it was in.
6585 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
6587 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
6588 ;; `ps-left-headers' specially for mail messages.
6589 (defun ps-vm-mode-hook ()
6590 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
6591 (setq ps-header-lines 3
6593 ;; The left headers will display the message's subject, its
6594 ;; author, and the name of the folder it was in.
6595 '(ps-article-subject ps-article-author buffer-name)))
6597 ;; Every now and then I forget to switch from the *Summary* buffer to
6598 ;; the *Article* before hitting prsc, and a nicely formatted list of
6599 ;; article subjects shows up at the printer. This function, bound to
6600 ;; prsc for the gnus *Summary* buffer means I don't have to switch
6602 ;; sb: Updated for Gnus 5.
6603 (defun ps-gnus-print-article-from-summary ()
6605 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
6607 ;; See `ps-gnus-print-article-from-summary'. This function does the
6608 ;; same thing for vm.
6609 (defun ps-vm-print-message-from-summary ()
6611 (ps-print-message-from-summary 'vm-mail-buffer ""))
6613 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
6615 (defun ps-gnus-summary-setup ()
6616 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
6618 ;; Look in an article or mail message for the Subject: line. To be
6619 ;; placed in `ps-left-headers'.
6620 (defun ps-info-file ()
6622 (goto-char (point-min))
6623 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
6624 (buffer-substring (match-beginning 1) (match-end 1))
6627 ;; Look in an article or mail message for the Subject: line. To be
6628 ;; placed in `ps-left-headers'.
6629 (defun ps-info-node ()
6631 (goto-char (point-min))
6632 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
6633 (buffer-substring (match-beginning 1) (match-end 1))
6636 (defun ps-info-mode-hook ()
6637 (setq ps-left-header
6638 ;; The left headers will display the node name and file name.
6639 '(ps-info-node ps-info-file)))
6641 ;; WARNING! The following function is a *sample* only, and is *not*
6642 ;; meant to be used as a whole unless you understand what the effects
6643 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
6644 ;; I'd be very surprised if it was useful to *anybody*, without
6647 (defun ps-jts-ps-setup ()
6648 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
6649 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
6650 (global-set-key (ps-c-prsc) 'ps-despool)
6651 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
6652 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
6653 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
6654 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
6655 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
6656 (setq ps-spool-duplex t
6657 ps-print-color-p nil
6658 ps-lpr-command "lpr"
6659 ps-lpr-switches '("-Jjct,duplex_long"))
6662 ;; WARNING! The following function is a *sample* only, and is *not*
6663 ;; meant to be used as a whole unless it corresponds to your needs.
6664 ;; (In fact, this is a copy of Jack's setup for ps-print --
6665 ;; I would not be that surprised if it was useful to *anybody*,
6666 ;; without modification.)
6668 (defun ps-jack-setup ()
6669 (setq ps-print-color-p nil
6670 ps-lpr-command "lpr"
6675 ps-number-of-columns 2
6677 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6678 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6679 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
6680 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6681 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6682 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
6683 ps-header-line-pad .15
6685 ps-print-header-frame t
6690 ps-font-family 'Courier
6692 ps-header-font-family 'Helvetica
6693 ps-header-font-size 6
6694 ps-header-title-font-size 8)
6698 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6699 ;; To make this file smaller, some commands go in a separate file.
6700 ;; But autoload them here to make the separation invisible.
6702 (autoload 'ps-mule-prepare-ascii-font "ps-mule"
6703 "Setup special ASCII font for STRING.
6704 STRING should contain only ASCII characters.")
6706 (autoload 'ps-mule-set-ascii-font "ps-mule"
6707 "Adjust current font if current charset is not ASCII.")
6709 (autoload 'ps-mule-plot-string "ps-mule"
6710 "Generate PostScript code for plotting characters in the region FROM and TO.
6712 It is assumed that all characters in this region belong to the same charset.
6714 Optional argument BG-COLOR specifies background color.
6718 (ENDPOS . RUN-WIDTH)
6720 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
6723 (autoload 'ps-mule-initialize "ps-mule"
6724 "Initialize global data for printing multi-byte characters.")
6726 (autoload 'ps-mule-begin-job "ps-mule"
6727 "Start printing job for multi-byte chars between FROM and TO.
6728 This checks if all multi-byte characters in the region are printable or not.")
6730 (autoload 'ps-mule-begin-page "ps-mule"
6731 "Initialize multi-byte charset for printing current page.")
6733 (autoload 'ps-mule-encode-header-string "ps-mule"
6734 "Generate PostScript code for plotting characters in header STRING.
6736 It is assumed that the length of STRING is not zero.")
6739 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6743 ;;; ps-print.el ends here