1 ;;; ps-print.el --- Print text from the buffer as PostScript
3 ;; Copyright (C) 1993, 2000 Free Software Foundation, Inc.
5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6 ;; Author: Jacques Duthen (was <duthen@cegelec-red.fr>)
7 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
8 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
9 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
11 ;; Keywords: wp, print, PostScript
12 ;; Time-stamp: <2000/10/28 23:38:44 Vinicius>
14 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
16 (defconst ps-print-version
"6.3"
17 "ps-print.el, v 6.3 <2000/10/28 vinicius>
19 Vinicius's last change version -- this file may have been edited as part of
20 Emacs without changes to the version number. When reporting bugs, please also
21 report the version of Emacs, if any, that ps-print was distributed with.
23 Please send all bug fixes and enhancements to
24 Vinicius Jose Latorre <vinicius@cpqd.com.br>.
27 ;; This file is part of GNU Emacs.
29 ;; GNU Emacs is free software; you can redistribute it and/or modify
30 ;; it under the terms of the GNU General Public License as published by
31 ;; the Free Software Foundation; either version 2, or (at your option)
34 ;; GNU Emacs is distributed in the hope that it will be useful,
35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
37 ;; GNU General Public License for more details.
39 ;; You should have received a copy of the GNU General Public License
40 ;; along with GNU Emacs; see the file COPYING. If not, write to the
41 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
42 ;; Boston, MA 02111-1307, USA.
46 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
51 ;; This package provides printing of Emacs buffers on PostScript printers;
52 ;; the 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
57 ;; to print a PostScript file, but some faces are better seeing on the screen
58 ;; than 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
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
82 ;; generate PostScript images suitable for printing on a PostScript
83 ;; printer or displaying with GhostScript. These commands are
84 ;; collectively referred to as "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
92 ;; spool - The PostScript image is saved temporarily in an
93 ;; Emacs buffer. Many images may be spooled locally
94 ;; before printing them. To send the spooled images
95 ;; to the printer, use the command `ps-despool'.
97 ;; The spooling mechanism was designed for printing lots of small
98 ;; files (mail messages or netnews articles) to save paper that would
99 ;; otherwise be wasted on banner pages, and to make it easier to find
100 ;; your output at the printer (it's easier to pick up one 50-page
101 ;; printout than to find 50 single-page printouts).
103 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't
104 ;; accidentally quit from Emacs while you have unprinted PostScript
105 ;; waiting in the spool buffer. If you do attempt to exit with
106 ;; spooled PostScript, you'll be asked if you want to print it, and if
107 ;; you decline, you'll be asked to confirm the exit; this is modeled
108 ;; on the confirmation that Emacs uses for modified buffers.
110 ;; The word "buffer" or "region" in the command name determines how
111 ;; much of the buffer is printed:
113 ;; buffer - Print the entire buffer.
115 ;; region - Print just the current region.
117 ;; The -with-faces suffix on the command name means that the command
118 ;; will include font, color, and underline information in the
119 ;; PostScript image, so the printed image can look as pretty as the
120 ;; buffer. The ps-print- commands without the -with-faces suffix
121 ;; don't include font, color, or underline information; images printed
122 ;; with these commands aren't as pretty, but are faster to generate.
124 ;; Two ps-print- command examples:
126 ;; ps-print-buffer - print the entire buffer,
127 ;; without font, color, or
128 ;; underline information, and
129 ;; send it immediately to the
132 ;; ps-spool-region-with-faces - print just the current region;
133 ;; include font, color, and
134 ;; underline information, and
135 ;; spool the image in Emacs to
136 ;; send to the printer later.
142 ;; To print your buffer, type
144 ;; M-x ps-print-buffer
146 ;; or substitute one of the other seven ps-print- commands. The
147 ;; command will generate the PostScript image and print or spool it as
148 ;; specified. By giving the command a prefix argument
150 ;; C-u M-x ps-print-buffer
152 ;; it will save the PostScript image to a file instead of sending it
153 ;; to the printer; you will be prompted for the name of the file to
154 ;; save the image to. The prefix argument is ignored by the commands
155 ;; that spool their images, but you may save the spooled images to a
156 ;; file by giving a prefix argument to `ps-despool':
158 ;; C-u M-x ps-despool
160 ;; When invoked this way, `ps-despool' will prompt you for the name of
161 ;; the file to save to.
163 ;; Any of the `ps-print-' commands can be bound to keys; I recommend
164 ;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
165 ;; and `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
167 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
168 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
169 ;; (global-set-key '(control f22) 'ps-despool)
172 ;; The Printer Interface
173 ;; ---------------------
175 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
176 ;; command is used to send the PostScript images to the printer, and
177 ;; what arguments to give the command. These are analogous to
178 ;; `lpr-command' and `lpr-switches'.
180 ;; Make sure that they contain appropriate values for your system;
181 ;; see the usage notes below and the documentation of these variables.
183 ;; The variable `ps-printer-name' determines the name of a local printer for
184 ;; printing PostScript files.
186 ;; The variable `ps-printer-name-option' determines the option used by some
187 ;; utilities to indicate the printer name, it's used only when
188 ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
189 ;; print, for example, `ps-printer-name-option' should be set to "-P".
191 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
192 ;; from the variables `lpr-command' and `lpr-switches'. If you have
193 ;; `lpr-command' set to invoke a pretty-printer such as `enscript',
194 ;; then ps-print won't work properly. `ps-lpr-command' must name
195 ;; a program that does not format the files it prints.
196 ;; `ps-printer-name' takes its initial value from the variable
197 ;; `printer-name'. `ps-printer-name-option' tries to guess which system
198 ;; Emacs is running and takes its initial value in accordance with this
201 ;; The variable `ps-print-region-function' specifies a function to print the
202 ;; region on a PostScript printer.
203 ;; See definition of `call-process-region' for calling conventions. The fourth
204 ;; and the sixth arguments are both nil.
206 ;; The variable `ps-manual-feed' indicates if the printer will manually feed
207 ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
208 ;; feeding takes place. The default is nil (automatic feeding).
210 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
211 ;; customize the following variables: `ps-printer-name',
212 ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
213 ;; `ps-spool-config'. See these variables documentation in the code or by
214 ;; typing, for example, C-h v ps-printer-name RET.
220 ;; All dimensions are floats in PostScript points.
221 ;; 1 inch == 2.54 cm == 72 points
222 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
224 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
225 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
226 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
229 ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
230 ;; PostScript printer doesn't have a paper with the size indicated by
231 ;; `ps-paper-type', instead it uses the default paper size. If variable
232 ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
233 ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
234 ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
235 ;; Printers). The default value is non-nil (it gives an error).
237 ;; The variable `ps-landscape-mode' determines the orientation of the printing
238 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
239 ;; There is no oblique mode yet, though this is easy to do in ps.
241 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in portrait
242 ;; mode and only 50 lines in landscape mode. The margins represent margins in
243 ;; the printed paper: the top margin is the margin between the top of the page
244 ;; and the printed header, whatever the orientation is.
246 ;; The variable `ps-number-of-columns' determines the number of columns both in
247 ;; landscape and portrait mode.
249 ;; - (the standard) one column portrait mode.
250 ;; - (my favorite) two columns landscape mode (which spares trees).
252 ;; - one column landscape mode for files with very long lines.
253 ;; - multi-column portrait or landscape mode.
255 ;; The variable `ps-print-upside-down' determines other orientation for printing
256 ;; page: nil means `normal' printing, non-nil means `upside-down' printing. The
257 ;; default value is 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 print only even pages.
280 ;; odd print only odd pages.
282 ;; Any other value is treated as nil. The default value is nil.
288 ;; The horizontal layout is determined by the variables
289 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
292 ;; ------------------------------------------
294 ;; | lm | text | ic | text | ic | text | rm |
296 ;; ------------------------------------------
298 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
299 ;; Usually, lm = rm > 0 and ic = lm
300 ;; If (ic < 0), the text of adjacent columns can overlap.
306 ;; The vertical layout is determined by the variables
307 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
310 ;; |--------| |--------|
312 ;; |--------| |--------|
316 ;; |--------| or | text |
320 ;; |--------| |--------|
322 ;; |--------| |--------|
324 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
325 ;; The margins represent margins in the printed paper:
326 ;; the top margin is the margin between the top of the page
327 ;; and the printed header, whatever the orientation is.
333 ;; ps-print can print headers at the top of each column or at the top
334 ;; of each page; the default headers contain the following four items:
335 ;; on the left, the name of the buffer and, if the buffer is visiting
336 ;; a file, the file's directory; on the right, the page number and
337 ;; date of printing. The default headers look something like this:
340 ;; /home/jct/emacs-lisp/ps/new 94/12/31
342 ;; When printing on duplex printers, left and right are reversed so
343 ;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
345 ;; Headers are configurable:
346 ;; To turn them off completely, set `ps-print-header' to nil.
347 ;; To turn off the header's gaudy framing box,
348 ;; set `ps-print-header-frame' to nil.
350 ;; To print only one header at the top of each page,
351 ;; set `ps-print-only-one-header' to t.
353 ;; To switch headers, set `ps-switch-header' to:
355 ;; nil Never switch headers.
357 ;; t Always switch headers.
359 ;; duplex Switch headers only when duplexing is on, that is, when
360 ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
362 ;; Any other value is treated as t. The default value is `duplex'.
364 ;; The font family and size of text in the header are determined
365 ;; by the variables `ps-header-font-family', `ps-header-font-size' and
366 ;; `ps-header-title-font-size' (see below).
368 ;; The variable `ps-header-line-pad' determines the portion of a header
369 ;; title line height to insert between the header frame and the text
370 ;; it contains, both in the vertical and horizontal directions:
371 ;; .5 means half a line.
373 ;; Page numbers are printed in `n/m' format, indicating page n of m pages;
374 ;; to omit the total page count and just print the page number,
375 ;; set `ps-show-n-of-n' to nil.
377 ;; The amount of information in the header can be changed by changing
378 ;; the number of lines. To show less, set `ps-header-lines' to 1, and
379 ;; the header will show only the buffer name and page number. To show
380 ;; more, set `ps-header-lines' to 3, and the header will show the time of
381 ;; printing below the date.
383 ;; To change the content of the headers, change the variables
384 ;; `ps-left-header' and `ps-right-header'.
385 ;; These variables are lists, specifying top-to-bottom the text
386 ;; to display on the left or right side of the header.
387 ;; Each element of the list should be a string or a symbol.
388 ;; Strings are inserted directly into the PostScript arrays,
389 ;; and should contain the PostScript string delimiters '(' and ')'.
391 ;; Symbols in the header format lists can either represent functions
392 ;; or variables. Functions are called, and should return a string to
393 ;; show in the header. Variables should contain strings to display in
394 ;; the header. In either case, function or variable, the PostScript
395 ;; string delimiters are added by ps-print, and should not be part of
396 ;; the returned value.
398 ;; Here's an example: say we want the left header to display the text
404 ;; where we have a function to return "Moe"
406 ;; (defun moe-func ()
409 ;; a variable specifying "Larry"
411 ;; (setq larry-var "Larry")
413 ;; and a literal for "Curly". Here's how `ps-left-header' should be
416 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
418 ;; Note that Curly has the PostScript string delimiters inside his
419 ;; quotes -- those aren't misplaced lisp delimiters!
421 ;; Without them, PostScript would attempt to call the undefined
422 ;; function Curly, which would result in a PostScript error.
424 ;; Since most printers don't report PostScript errors except by
425 ;; aborting the print job, this kind of error can be hard to track down.
427 ;; Consider yourself warned!
430 ;; PostScript Prologue Header
431 ;; --------------------------
433 ;; It is possible to add PostScript prologue header comments besides that
434 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
436 ;; `ps-print-prologue-header' may be a string or a symbol function which returns
437 ;; a string. Note that this string is inserted on PostScript prologue header
438 ;; section which is used to define some document characteristic through
439 ;; PostScript special comments, like "%%Requirements: jog\n".
441 ;; By default `ps-print-prologue-header' is nil.
443 ;; ps-print always inserts the %%Requirements: comment, so if you need to insert
444 ;; more requirements put them first in `ps-print-prologue-header' using the
445 ;; "%%+" comment. For example, if you need to set numcopies to 3 and jog on
446 ;; requirements and set %%LanguageLevel: to 2, do:
448 ;; (setq ps-print-prologue-header
449 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
451 ;; The duplex requirement is inserted by ps-print (see section Duplex Printers).
453 ;; Do not forget to terminate the string with "\n".
455 ;; For more information about PostScript document comments, see:
456 ;; PostScript Language Reference Manual (2nd edition)
457 ;; Adobe Systems Incorporated
458 ;; Appendix G: Document Structuring Conventions -- Version 3.0
460 ;; It is also possible to add an user defined PostScript prologue code before
461 ;; all generated prologue code by setting the variable
462 ;; `ps-user-defined-prologue'.
464 ;; `ps-user-defined-prologue' may be a string or a symbol function which returns
465 ;; a string. Note that this string is inserted after `ps-adobe-tag' and
466 ;; PostScript prologue comments, and before ps-print PostScript prologue code
467 ;; section. That is, this string is inserted after error handler initialization
468 ;; and before ps-print settings.
470 ;; By default `ps-user-defined-prologue' is nil.
472 ;; It's strongly recommended only insert PostScript code and/or comments
473 ;; specific for your printing system particularities. For example, some special
474 ;; initialization that only your printing system needs.
476 ;; Do not insert code for duplex printing, n-up printing or error handler,
477 ;; ps-print handles this in a suitable way.
479 ;; For more information about PostScript, see:
480 ;; PostScript Language Reference Manual (2nd edition)
481 ;; Adobe Systems Incorporated
483 ;; As an example for `ps-user-defined-prologue' setting:
485 ;; ;; Setting for HP PostScript printer
486 ;; (setq ps-user-defined-prologue
487 ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
488 ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
491 ;; PostScript Error Handler
492 ;; ------------------------
494 ;; ps-print instruments generated PostScript code with an error handler.
496 ;; The variable `ps-error-handler-message' specifies where the error handler
497 ;; message should be sent.
501 ;; none catch the error and *DON'T* send any message.
503 ;; paper catch the error and print on paper the error message.
504 ;; This is the default value.
506 ;; system catch the error and send back the error message to
507 ;; printing system. This is useful only if printing system
508 ;; send back an email reporting the error, or if there is
509 ;; some other alternative way to report back the error from
510 ;; the system to you.
512 ;; paper-and-system catch the error, print on paper the error message and
513 ;; send back the error message to printing system.
515 ;; Any other value is treated as `paper'.
521 ;; If you have a duplex-capable printer (one that prints both sides of the
522 ;; paper), set `ps-spool-duplex' to t.
523 ;; ps-print will insert blank pages to make sure each buffer starts on the
524 ;; correct side of the paper.
526 ;; The variable `ps-spool-config' specifies who is the responsable for setting
527 ;; duplex and page size switches. Valid values are:
529 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
530 ;; Don't forget to set `ps-lpr-switches' to select duplex
531 ;; printing for your printer.
533 ;; setpagedevice duplex and page size are configured by ps-print using the
534 ;; setpagedevice PostScript operator.
536 ;; nil duplex and page size are configured by ps-print *not* using
537 ;; the setpagedevice PostScript operator.
539 ;; Any other value is treated as nil.
541 ;; The default value is `lpr-switches'.
543 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility when
544 ;; viewing file generated using landscape. Also on some printers,
545 ;; setpagedevice affects zebra stripes; on other printers,
546 ;; setpagedevice affects the left margin.
547 ;; Besides all that, if your printer does not have the paper size
548 ;; specified by setpagedevice, your printing will be aborted.
549 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
550 ;; `setpagedevice', generate a test file and send it to your printer;
551 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
553 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
554 ;; sides of a sheet are oriented with respect to each other. If
555 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left or
556 ;; right. If `ps-spool-tumble' is non-nil, produces output suitable for binding
557 ;; at the top or bottom. It has effect only when `ps-spool-duplex' is non-nil.
558 ;; The default value is nil.
560 ;; Some printer system prints a header page and forces the first page be printed
561 ;; on header page back, when using duplex. If your printer system has this
562 ;; behavior, set variable `ps-banner-page-when-duplexing' to t.
564 ;; When `ps-banner-page-when-duplexing' is non-nil means the very first page is
565 ;; skipped. It's like the very first character of buffer (or region) is ^L
568 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the very
575 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
576 ;; paper. The value specified must be between 1 and 100. The default is 1.
578 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is set
579 ;; to a high value (for example, 23). If this happens, set a lower value.
581 ;; The variable `ps-n-up-margin' specifies the margin in points between the
582 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
585 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each page.
588 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
589 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
590 ;; filling example using a 3x4 page matrix:
592 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
594 ;; 9 10 11 12 1 2 3 4
596 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
598 ;; 12 11 10 9 4 3 2 1
600 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
604 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
608 ;; Any other value is treated as left-top.
610 ;; The default value is left-top.
613 ;; Control And 8-bit Characters
614 ;; ----------------------------
616 ;; The variable `ps-print-control-characters' specifies whether you want to see
617 ;; a printable form for control and 8-bit characters, that is, instead of
618 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
620 ;; Valid values for `ps-print-control-characters' are:
622 ;; 8-bit This is the value to use when you want an ASCII encoding of
623 ;; any control or non-ASCII character. Control characters are
624 ;; encoded as "^D", and non-ASCII characters have an
627 ;; control-8-bit This is the value to use when you want an ASCII encoding of
628 ;; any control character, whether it is 7 or 8-bit.
629 ;; European 8-bits accented characters are printed according
632 ;; control Only ASCII control characters have an ASCII encoding.
633 ;; European 8-bits accented characters are printed according
636 ;; nil No ASCII encoding. Any character is printed according the
639 ;; Any other value is treated as nil.
641 ;; The default is `control-8-bit'.
643 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
646 ;; Printing Multi-byte Buffer
647 ;; --------------------------
649 ;; See ps-mule.el for documentation.
655 ;; The variable `ps-line-number' specifies whether to number each line;
656 ;; non-nil means do so. The default is nil (don't number each line).
658 ;; The variable `ps-line-number-step' specifies the interval that line number is
659 ;; printed. For example, if `ps-line-number-step' is set to 2, the printing
672 ;; integer an integer that specifies the interval that line number is
673 ;; printed. If it's lesser than or equal to zero, it's used the
676 ;; `zebra' specifies that only the line number of the first line in a zebra
677 ;; stripe is to be printed.
679 ;; Any other value is treated as `zebra'.
680 ;; The default value is 1, so each line number is printed.
682 ;; The variable `ps-line-number-start' specifies the starting point in the
683 ;; interval given by `ps-line-number-step'. For example, if
684 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3, the
685 ;; printing will look like:
699 ;; The values for `ps-line-number-start':
701 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
702 ;; of `ps-line-number-step' inclusive.
704 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
705 ;; value of `ps-zebra-stripe-height' inclusive.
707 ;; The default value is 1, so the line number of the first line of each interval
714 ;; Zebra stripes are a kind of background that appear "underneath" the text
715 ;; and can make the text easier to read. They look like this:
717 ;; XXXXXXXXXXXXXXXXXXXXXXXX
718 ;; XXXXXXXXXXXXXXXXXXXXXXXX
719 ;; XXXXXXXXXXXXXXXXXXXXXXXX
723 ;; XXXXXXXXXXXXXXXXXXXXXXXX
724 ;; XXXXXXXXXXXXXXXXXXXXXXXX
725 ;; XXXXXXXXXXXXXXXXXXXXXXXX
727 ;; The blocks of X's represent rectangles filled with a light gray color.
728 ;; Each rectangle extends all the way across the page.
730 ;; The height, in lines, of each rectangle is controlled by
731 ;; the variable `ps-zebra-stripe-height', which is 3 by default.
732 ;; The distance between stripes equals the height of a stripe.
734 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
735 ;; Non-nil means yes, nil means no. The default is nil.
737 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
738 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
739 ;; color), a string which is a color name, or a list of 3 numbers which
740 ;; corresponds to the Red Green Blue color scale.
741 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
743 ;; The variable `ps-zebra-stripe-follow' specifies if zebra stripe should
744 ;; continue on next page or restart on each page. If `ps-zebra-stripe-follow'
745 ;; is nil, zebra stripe is restarted on each page. If `ps-zebra-stripe-follow'
746 ;; is non-nil, zebra stripe continues on next page. Visually, we have:
748 ;; `ps-zebra-stripe-follow' `ps-zebra-stripe-follow'
750 ;; Current Page ------------------------ ------------------------
751 ;; 1 XXXXXXXXXXXXXXXXXXXXX 1 XXXXXXXXXXXXXXXXXXXXX
752 ;; 2 XXXXXXXXXXXXXXXXXXXXX 2 XXXXXXXXXXXXXXXXXXXXX
753 ;; 3 XXXXXXXXXXXXXXXXXXXXX 3 XXXXXXXXXXXXXXXXXXXXX
757 ;; 7 XXXXXXXXXXXXXXXXXXXXX 7 XXXXXXXXXXXXXXXXXXXXX
758 ;; 8 XXXXXXXXXXXXXXXXXXXXX 8 XXXXXXXXXXXXXXXXXXXXX
759 ;; ------------------------ ------------------------
760 ;; Next Page ------------------------ ------------------------
761 ;; 9 XXXXXXXXXXXXXXXXXXXXX 9 XXXXXXXXXXXXXXXXXXXXX
762 ;; 10 XXXXXXXXXXXXXXXXXXXXX 10
763 ;; 11 XXXXXXXXXXXXXXXXXXXXX 11
765 ;; 13 13 XXXXXXXXXXXXXXXXXXXXX
766 ;; 14 14 XXXXXXXXXXXXXXXXXXXXX
767 ;; 15 XXXXXXXXXXXXXXXXXXXXX 15 XXXXXXXXXXXXXXXXXXXXX
768 ;; 16 XXXXXXXXXXXXXXXXXXXXX 16
769 ;; ------------------------ ------------------------
771 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
777 ;; ps-print has the following hook variables:
780 ;; It is evaluated once before any printing process. This is the right
781 ;; place to initialize ps-print global data.
782 ;; For an example, see section Adding a New Font Family.
784 ;; `ps-print-begin-sheet-hook'
785 ;; It is evaluated on each beginning of sheet of paper.
786 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
789 ;; `ps-print-begin-page-hook'
790 ;; It is evaluated on each beginning of page, except in the beginning
791 ;; of page that `ps-print-begin-sheet-hook' is evaluated.
793 ;; `ps-print-begin-column-hook'
794 ;; It is evaluated on each beginning of column, except in the beginning
795 ;; of column that `ps-print-begin-page-hook' is evaluated or that
796 ;; `ps-print-begin-sheet-hook' is evaluated.
802 ;; ps-print now knows rather precisely some fonts: the variable
803 ;; `ps-font-info-database' contains information for a list of font families
804 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino' `Helvetica-Narrow'
805 ;; `NewCenturySchlbk'). Each font family contains the font names for standard,
806 ;; bold, italic and bold-italic characters, a reference size (usually 10) and
807 ;; the corresponding line height, width of a space and average character width.
809 ;; The variable `ps-font-family' determines which font family is to be used for
810 ;; ordinary text. If its value does not correspond to a known font family, an
811 ;; error message is printed into the `*Messages*' buffer, which lists the
812 ;; currently available font families.
814 ;; The variable `ps-font-size' determines the size (in points) of the font for
815 ;; ordinary text, when generating PostScript. Its value is a float or a cons of
816 ;; floats which has the following form:
818 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
820 ;; Similarly, the variable `ps-header-font-family' determines which font family
821 ;; is to be used for text in the header.
823 ;; The variable `ps-header-font-size' determines the font size, in points, for
824 ;; text in the header (similar to `ps-font-size').
826 ;; The variable `ps-header-title-font-size' determines the font size, in points,
827 ;; for the top line of text in the header (similar to `ps-font-size').
830 ;; Adding a New Font Family
831 ;; ------------------------
833 ;; To use a new font family, you MUST first teach ps-print
834 ;; this font, i.e., add its information to `ps-font-info-database',
835 ;; otherwise ps-print cannot correctly place line and page breaks.
837 ;; For example, assuming `Helvetica' is unknown,
838 ;; you first need to do the following ONLY ONCE:
840 ;; - create a new buffer
841 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
842 ;; - open this file and find the line:
843 ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
844 ;; - delete the leading `%' (which is the PostScript comment character)
845 ;; - replace in this line `Courier' by the new font (say `Helvetica')
847 ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
848 ;; - send this file to the printer (or to ghostscript).
849 ;; You should read the following on the output page:
851 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
852 ;; and a crude estimate of average character width is 5.09243
854 ;; - Add these values to the `ps-font-info-database':
855 ;; (setq ps-font-info-database
857 ;; '((Helvetica ; the family key
858 ;; (fonts (normal . "Helvetica")
859 ;; (bold . "Helvetica-Bold")
860 ;; (italic . "Helvetica-Oblique")
861 ;; (bold-italic . "Helvetica-BoldOblique"))
863 ;; (line-height . 11.56)
864 ;; (space-width . 2.78)
865 ;; (avg-char-width . 5.09243)))
866 ;; ps-font-info-database))
867 ;; - Now you can use this font family with any size:
868 ;; (setq ps-font-family 'Helvetica)
869 ;; - if you want to use this family in another emacs session, you must
870 ;; put into your `~/.emacs':
871 ;; (require 'ps-print)
872 ;; (setq ps-font-info-database (append ...)))
873 ;; if you don't want to load ps-print, you have to copy the whole value:
874 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
875 ;; or, use `ps-print-hook' (see section Hooks):
876 ;; (add-hook 'ps-print-hook
878 ;; (or (assq 'Helvetica ps-font-info-database)
879 ;; (setq ps-font-info-database (append ...)))))
881 ;; You can create new `mixed' font families like:
883 ;; (fonts (normal . "Courier-Bold")
884 ;; (bold . "Helvetica")
885 ;; (italic . "Zapf-Chancery-MediumItalic")
886 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
887 ;; (w3-table-hack-x-face . "LineDrawNormal"))
889 ;; (line-height . 10.55)
890 ;; (space-width . 6.0)
891 ;; (avg-char-width . 6.0))
893 ;; Now you can use your new font family with any size:
894 ;; (setq ps-font-family 'my-mixed-family)
896 ;; Note that on above example the `w3-table-hack-x-face' entry refers to
897 ;; a face symbol, so when printing this face it'll be used the font
898 ;; `LineDrawNormal'. If the face `w3-table-hack-x-face' is remapped to
899 ;; use bold and/or italic attribute, the corresponding entry (bold, italic
900 ;; or bold-italic) will be used instead of `w3-table-hack-x-face' entry.
902 ;; Note also that the font family entry order is irrelevant, so the above
903 ;; example could also be written:
906 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
907 ;; (bold . "Helvetica")
908 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
909 ;; (italic . "Zapf-Chancery-MediumItalic")
910 ;; (normal . "Courier-Bold"))
911 ;; (avg-char-width . 6.0)
912 ;; (space-width . 6.0)
913 ;; (line-height . 10.55))
915 ;; Despite the note above, it is recommended that some convention about
916 ;; entry order be used.
918 ;; You can get information on all the fonts resident in YOUR printer
919 ;; by uncommenting the line:
920 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
922 ;; The PostScript file should be sent to YOUR PostScript printer.
923 ;; If you send it to ghostscript or to another PostScript printer,
924 ;; you may get slightly different results.
925 ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
927 ;; Note also that ps-print DOESN'T download any font to your printer, instead
928 ;; it uses the fonts resident in your printer.
931 ;; How Ps-Print Deals With Faces
932 ;; -----------------------------
934 ;; The ps-print-*-with-faces commands attempt to determine which faces
935 ;; should be printed in bold or italic, but their guesses aren't
936 ;; always right. For example, you might want to map colors into faces
937 ;; so that blue faces print in bold, and red faces in italic.
939 ;; It is possible to force ps-print to consider specific faces bold,
940 ;; italic or underline, no matter what font they are displayed in, by setting
941 ;; the variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
942 ;; These variables contain lists of faces that ps-print should consider bold,
943 ;; italic or underline; to set them, put code like the following into your
946 ;; (setq ps-bold-faces '(my-blue-face))
947 ;; (setq ps-italic-faces '(my-red-face))
948 ;; (setq ps-underlined-faces '(my-green-face))
950 ;; Faces like bold-italic that are both bold and italic should go in
953 ;; ps-print keeps internal lists of which fonts are bold and which are
954 ;; italic; these lists are built the first time you invoke ps-print.
955 ;; For the sake of efficiency, the lists are built only once; the same
956 ;; lists are referred in later invocations of ps-print.
958 ;; Because these lists are built only once, it's possible for them to
959 ;; get out of sync, if a face changes, or if new faces are added. To
960 ;; get the lists back in sync, you can set the variable
961 ;; `ps-build-face-reference' to t, and the lists will be rebuilt the
962 ;; next time ps-print is invoked. If you need that the lists always be
963 ;; rebuilt when ps-print is invoked, set the variable
964 ;; `ps-always-build-face-reference' to t.
966 ;; If you need to print without worrying about face background color, set the
967 ;; variable `ps-use-face-background' which specifies if face background should
968 ;; be used. Valid values are:
970 ;; t always use face background color.
971 ;; nil never use face background color.
972 ;; (face...) list of faces whose background color will be used.
974 ;; Any other value will be treated as t.
975 ;; The default value is t.
978 ;; How Ps-Print Deals With Color
979 ;; -----------------------------
981 ;; ps-print detects faces with foreground and background colors
982 ;; defined and embeds color information in the PostScript image.
983 ;; The default foreground and background colors are defined by the
984 ;; variables `ps-default-fg' and `ps-default-bg'.
985 ;; On black-and-white printers, colors are displayed in gray scale.
986 ;; To turn off color output, set `ps-print-color-p' to nil.
989 ;; How Ps-Print Maps Faces
990 ;; -----------------------
992 ;; As ps-print uses PostScript to print buffers, it is possible to have
993 ;; other attributes associated with faces. So the new attributes used
996 ;; strikeout - like underline, but the line is in middle of text.
997 ;; overline - like underline, but the line is over the text.
998 ;; shadow - text will have a shadow.
999 ;; box - text will be surrounded by a box.
1000 ;; outline - print characters as hollow outlines.
1002 ;; See the documentation for `ps-extend-face'.
1004 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1005 ;; color and bold attribute:
1007 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
1009 ;; If you want to use a new face, define it first with `defface',
1010 ;; and then call `ps-extend-face' to specify how to print it.
1013 ;; How Ps-Print Has A Text And/Or Image On Background
1014 ;; --------------------------------------------------
1016 ;; ps-print can print texts and/or EPS PostScript images on background; it is
1017 ;; possible to define the following text attributes: font name, font size,
1018 ;; initial position, angle, gray scale and pages to print.
1020 ;; It has the following EPS PostScript images attributes: file name containing
1021 ;; the image, initial position, X and Y scales, angle and pages to print.
1023 ;; See documentation for `ps-print-background-text' and
1024 ;; `ps-print-background-image'.
1026 ;; For example, if we wish to print text "preliminary" on all pages and text
1027 ;; "special" on page 5 and from page 11 to page 17, we could specify:
1029 ;; (setq ps-print-background-text
1030 ;; '(("preliminary")
1032 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
1033 ;; ; (upper left corner)
1035 ;; "PrintHeight neg PrintPageWidth atan" ; angle
1036 ;; 5 (11 . 17)) ; page list
1039 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
1040 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
1043 ;; (setq ps-print-background-image
1044 ;; '(("~/images/EPS-image1.ps"
1045 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
1046 ;; ("~/images/EPS-image2.ps"
1047 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y position
1048 ;; ; (upper left corner)
1050 ;; 5 (11 . 17)) ; page list
1053 ;; If it is not possible to read (or does not exist) an image file, that file
1056 ;; The printing order is:
1058 ;; 1. Print background color
1059 ;; 2. Print zebra stripes
1060 ;; 3. Print background texts that it should be on all pages
1061 ;; 4. Print background images that it should be on all pages
1062 ;; 5. Print background texts only for current page (if any)
1063 ;; 6. Print background images only for current page (if any)
1065 ;; 8. Print buffer text (with faces, if specified) and line number
1071 ;; Some tools are provided to help you customize your font setup.
1073 ;; `ps-setup' returns (some part of) the current setup.
1075 ;; To avoid wrapping too many lines, you may want to adjust the
1076 ;; left and right margins and the font size. On UN*X systems, do:
1077 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1078 ;; to determine the longest lines of your file.
1079 ;; Then, the command `ps-line-lengths' will give you the correspondence
1080 ;; between a line length (number of characters) and the maximum font
1081 ;; size which doesn't wrap such a line with the current ps-print setup.
1083 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
1084 ;; the correspondence between a number of pages and the maximum font
1085 ;; size which allow the number of lines of the current buffer or of
1086 ;; its current region to fit in this number of pages.
1088 ;; NOTE: line folding is not taken into account in this process and could
1089 ;; change the results.
1091 ;; The command `ps-print-customize' activates a customization buffer for
1092 ;; ps-print options.
1095 ;; New since version 1.5
1096 ;; ---------------------
1098 ;; Color output capability.
1099 ;; Automatic detection of font attributes (bold, italic).
1100 ;; Configurable headers with page numbers.
1102 ;; Support for different paper sizes.
1103 ;; Better conformance to PostScript Document Structure Conventions.
1106 ;; New since version 2.8
1107 ;; ---------------------
1109 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1112 ;; `ps-even-or-odd-pages'
1115 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
1116 ;; `ps-selected-pages', `ps-last-selected-pages',
1117 ;; `ps-restore-selected-pages', `ps-switch-header',
1118 ;; `ps-line-number-step', `ps-line-number-start',
1119 ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
1122 ;; PostScript error handler.
1123 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1126 ;; `ps-print-customize'.
1129 ;; Better customization.
1130 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1134 ;; Hook: `ps-print-begin-sheet-hook'.
1136 ;; [keinichi] 19990509 Kein'ichi Handa <handa@etl.go.jp>
1138 ;; `ps-print-region-function'
1140 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1143 ;; PostScript tumble and setpagedevice.
1146 ;; PostScript prologue header comment insertion.
1147 ;; Skip invisible text better.
1149 ;; [keinichi] 19980819 Kein'ichi Handa <handa@etl.go.jp>
1151 ;; Multi-byte buffer handling.
1153 ;; [vinicius] Vinicius Jose Latorre <vinicius@cpqd.com.br>
1156 ;; Skip invisible text.
1159 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1160 ;; `ps-print-begin-column-hook'.
1161 ;; Put one header per page over the columns.
1162 ;; Better database font management.
1163 ;; Better control characters handling.
1166 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1167 ;; Handle control characters.
1169 ;; New face attributes.
1172 ;; Text and/or image on background.
1174 ;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
1176 ;; Font family and float size for text and header.
1178 ;; Multiple columns.
1179 ;; Tools for page setup.
1182 ;; Known bugs and limitations of ps-print
1183 ;; --------------------------------------
1185 ;; Although color printing will work in XEmacs 19.12, it doesn't work
1186 ;; well; in particular, bold or italic fonts don't print in the right
1187 ;; background color.
1189 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1191 ;; Automatic font-attribute detection doesn't work well, especially
1192 ;; with hilit19 and older versions of get-create-face. Users having
1193 ;; problems with auto-font detection should use the lists
1194 ;; `ps-italic-faces', `ps-bold-faces' and `ps-underlined-faces' and/or
1195 ;; turn off automatic detection by setting `ps-auto-font-detect' to nil.
1197 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12
1198 ;; in tty mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1199 ;; `ps-underlined-faces' instead.
1201 ;; Still too slow; could use some hand-optimization.
1203 ;; Default background color isn't working.
1205 ;; Faces are always treated as opaque.
1207 ;; Epoch and Emacs 19 not supported. At all.
1209 ;; Fixed-pitch fonts work better for line folding, but are not required.
1211 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
1212 ;; of folding lines.
1218 ;; Avoid page break inside a paragraph.
1219 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1220 ;; Improve the memory management for big files (hard?).
1221 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
1222 ;; of folding lines.
1228 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1229 ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1231 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1232 ;; suggestion for `ps-postscript-code-directory' variable.
1234 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1235 ;; level 1 compatibility.
1237 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for upside-down,
1238 ;; line number step, line number start and zebra stripe follow suggestions, and
1239 ;; for XEmacs beta-tests.
1241 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1242 ;; prologue code suggestion and for odd/even printing suggestion.
1244 ;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
1246 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1249 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1252 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1253 ;; `ps-print-control-characters' variable documentation.
1255 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1256 ;; database font management.
1258 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1259 ;; header per page over the columns and correct line numbers when printing a
1262 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1263 ;; print time of `ps-lpr-switches'.
1265 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1266 ;; (his code was severely modified, but the main idea was kept).
1268 ;; Thanks to some suggestions on:
1269 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1270 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1271 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1273 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for the 3.4 version
1274 ;; I started from. [vinicius]
1276 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
1279 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
1280 ;; color and the invisible property.
1282 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
1283 ;; the initial port to Emacs 19. His code is no longer part of
1284 ;; ps-print, but his work is still appreciated.
1286 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
1287 ;; for adding underline support. Their code also is no longer part of
1288 ;; ps-print, but their efforts are not forgotten.
1290 ;; Thanks also to all of you who mailed code to add features to
1291 ;; ps-print; although I didn't use your code, I still appreciate your
1292 ;; sharing it with me.
1294 ;; Thanks to all who mailed comments, encouragement, and criticism.
1295 ;; Thanks also to all who responded to my survey; I had too many
1296 ;; responses to reply to them all, but I greatly appreciate your
1300 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1305 (unless (featurep 'lisp-float-type
)
1306 (error "`ps-print' requires floating point support"))
1309 ;; For Emacs 20.2 and the earlier version.
1311 (or (fboundp 'set-buffer-multibyte
)
1312 (defun set-buffer-multibyte (arg)
1313 (setq enable-multibyte-characters arg
)))
1315 (or (fboundp 'string-as-unibyte
)
1316 (defun string-as-unibyte (arg) arg
))
1318 (or (fboundp 'string-as-multibyte
)
1319 (defun string-as-multibyte (arg) arg
))
1321 (or (fboundp 'char-charset
)
1322 (defun char-charset (arg) 'ascii
))
1324 (or (fboundp 'charset-after
)
1325 (defun charset-after (&optional arg
)
1326 (char-charset (char-after arg
))))
1330 (or (fboundp 'line-beginning-position
)
1331 (defun line-beginning-position (&optional n
)
1333 (and n
(/= n
1) (forward-line (1- n
)))
1338 ;; to avoid compilation gripes
1341 (defalias 'ps-x-color-instance-p
'color-instance-p
)
1342 (defalias 'ps-x-color-instance-rgb-components
'color-instance-rgb-components
)
1343 (defalias 'ps-x-color-name
'color-name
)
1344 (defalias 'ps-x-color-specifier-p
'color-specifier-p
)
1345 (defalias 'ps-x-copy-coding-system
'copy-coding-system
)
1346 (defalias 'ps-x-device-class
'device-class
)
1347 (defalias 'ps-x-extent-end-position
'extent-end-position
)
1348 (defalias 'ps-x-extent-face
'extent-face
)
1349 (defalias 'ps-x-extent-priority
'extent-priority
)
1350 (defalias 'ps-x-extent-start-position
'extent-start-position
)
1351 (defalias 'ps-x-face-font-instance
'face-font-instance
)
1352 (defalias 'ps-x-find-coding-system
'find-coding-system
)
1353 (defalias 'ps-x-font-instance-properties
'font-instance-properties
)
1354 (defalias 'ps-x-make-color-instance
'make-color-instance
)
1355 (defalias 'ps-x-map-extents
'map-extents
)
1358 (defalias 'ps-e-x-color-values
'x-color-values
)
1359 (defalias 'ps-e-color-values
'color-values
)
1360 (if (fboundp 'find-composition
)
1361 (defalias 'ps-e-find-composition
'find-composition
)
1362 (defalias 'ps-e-find-composition
'ignore
))
1365 (defconst ps-windows-system
1366 (memq system-type
'(emx win32 w32 mswindows ms-dos windows-nt
)))
1367 (defconst ps-lp-system
1368 (memq system-type
'(usq-unix-v dgux hpux irix
))))
1371 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1375 ;;; Interface to the command system
1377 (defgroup postscript nil
1382 (defgroup ps-print nil
1383 "PostScript generator for Emacs"
1384 :link
'(emacs-library-link :tag
"Source Lisp File" "ps-print.el")
1389 (defgroup ps-print-horizontal nil
1390 "Horizontal page layout"
1395 (defgroup ps-print-vertical nil
1396 "Vertical page layout"
1401 (defgroup ps-print-headers nil
1407 (defgroup ps-print-font nil
1408 "Fonts customization"
1413 (defgroup ps-print-color nil
1414 "Color customization"
1419 (defgroup ps-print-face nil
1420 "Faces customization"
1426 (defgroup ps-print-n-up nil
1427 "N-up customization"
1432 (defgroup ps-print-zebra nil
1433 "Zebra customization"
1438 (defgroup ps-print-background nil
1439 "Background customization"
1444 (defgroup ps-print-printer nil
1445 "Printer customization"
1450 (defgroup ps-print-page nil
1451 "Page customization"
1456 (defgroup ps-print-miscellany nil
1457 "Miscellany customization"
1463 (defcustom ps-error-handler-message
'paper
1464 "*Specify where the error handler message should be sent.
1468 `none' catch the error and *DON'T* send any message.
1470 `paper' catch the error and print on paper the error message.
1472 `system' catch the error and send back the error message to
1473 printing system. This is useful only if printing system
1474 send back an email reporting the error, or if there is
1475 some other alternative way to report back the error from
1478 `paper-and-system' catch the error, print on paper the error message and
1479 send back the error message to printing system.
1481 Any other value is treated as `paper'."
1482 :type
'(choice :menu-tag
"Error Handler Message"
1483 :tag
"Error Handler Message"
1484 (const none
) (const paper
)
1485 (const system
) (const paper-and-system
))
1486 :group
'ps-print-miscellany
)
1488 (defcustom ps-user-defined-prologue nil
1489 "*User defined PostScript prologue code inserted before all prologue code.
1491 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1492 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1493 prologue comments, and before ps-print PostScript prologue code section. That
1494 is, this string is inserted after error handler initialization and before
1497 It's strongly recommended only insert PostScript code and/or comments specific
1498 for your printing system particularities. For example, some special
1499 initialization that only your printing system needs.
1501 Do not insert code for duplex printing, n-up printing or error handler, ps-print
1502 handles this in a suitable way.
1504 For more information about PostScript, see:
1505 PostScript Language Reference Manual (2nd edition)
1506 Adobe Systems Incorporated
1508 As an example for `ps-user-defined-prologue' setting:
1510 ;; Setting for HP PostScript printer
1511 (setq ps-user-defined-prologue
1512 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1513 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))
1515 :type
'(choice :menu-tag
"User Defined Prologue"
1516 :tag
"User Defined Prologue"
1517 (const :tag
"none" nil
) string symbol
)
1518 :group
'ps-print-miscellany
)
1520 (defcustom ps-print-prologue-header nil
1521 "*PostScript prologue header comments besides that ps-print generates.
1523 `ps-print-prologue-header' may be a string or a symbol function which
1524 returns a string. Note that this string is inserted on PostScript prologue
1525 header section which is used to define some document characteristic through
1526 PostScript special comments, like \"%%Requirements: jog\\n\".
1528 ps-print always inserts the %%Requirements: comment, so if you need to insert
1529 more requirements put them first in `ps-print-prologue-header' using the
1530 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1531 requirements and set %%LanguageLevel: to 2, do:
1533 (setq ps-print-prologue-header
1534 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1536 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1538 Do not forget to terminate the string with \"\\n\".
1540 For more information about PostScript document comments, see:
1541 PostScript Language Reference Manual (2nd edition)
1542 Adobe Systems Incorporated
1543 Appendix G: Document Structuring Conventions -- Version 3.0"
1544 :type
'(choice :menu-tag
"Prologue Header"
1545 :tag
"Prologue Header"
1546 (const :tag
"none" nil
) string symbol
)
1547 :group
'ps-print-miscellany
)
1549 (defcustom ps-printer-name
(and (boundp 'printer-name
)
1551 "*The name of a local printer for printing PostScript files.
1553 On Unix-like systems, a string value should be a name understood by lpr's -P
1554 option; a value of nil means use the value of `printer-name' instead.
1556 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1557 printer device or port to which PostScript files are written, provided
1558 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1559 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1560 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"//hostname/printer\"
1561 for a shared network printer. You can also set it to a name of a file, in
1562 which case the output gets appended to that file. \(Note that `ps-print'
1563 package already has facilities for printing to a file, so you might as well use
1564 them instead of changing the setting of this variable.\) If you want to
1565 silently discard the printed output, set this to \"NUL\".
1567 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1569 Any other value is treated as t, that is, an empty printer name.
1571 See also `ps-printer-name-option' for documentation."
1572 :type
'(choice :menu-tag
"Printer Name"
1574 (const :tag
"Same as printer-name" nil
)
1575 (const :tag
"No Printer Name" t
)
1576 (file :tag
"Print to file")
1577 (string :tag
"Pipe to ps-lpr-command"))
1578 :group
'ps-print-printer
)
1580 (defcustom ps-printer-name-option
1581 (cond (ps-windows-system
1587 "*Option for `ps-printer-name' variable (see it).
1589 On Unix-like systems, if it's been used lpr utility, it should be the string
1590 \"-P\"; if it's been used lp utility, it should be the string \"-d\".
1592 On MS-DOS and MS-Windows systems, if it's been used print utility, it should be
1595 For any other printing utility, see the proper manual or documentation.
1597 Set to \"\" or nil, if the utility given by `ps-lpr-command' needs an empty
1598 option printer name option.
1600 Any other value is treated as nil, that is, an empty printer name option.
1602 This variable is used only when `ps-printer-name' is a non-empty string."
1603 :type
'(choice :menu-tag
"Printer Name Option"
1604 :tag
"Printer Name Option"
1605 (const :tag
"None" nil
)
1606 (string :tag
"Option"))
1607 :group
'ps-print-printer
)
1609 (defcustom ps-lpr-command lpr-command
1610 "*Name of program for printing a PostScript file.
1612 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1613 will write directly to the printer port named by `ps-printer-name'. The
1614 programs `print' and `nprint' (the standard print programs on Windows NT and
1615 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1616 the destination for output; any other program is treated like `lpr' except that
1617 an explicit filename is given as the last argument."
1619 :group
'ps-print-printer
)
1621 (defcustom ps-lpr-switches lpr-switches
1622 "*A list of extra switches to pass to `ps-lpr-command'."
1623 :type
'(repeat :tag
"PostScript lpr Switches"
1624 (choice string symbol
(repeat sexp
)))
1625 :group
'ps-print-printer
)
1627 (defcustom ps-print-region-function nil
1628 "*Specify a function to print the region on a PostScript printer.
1629 See definition of `call-process-region' for calling conventions. The fourth and
1630 the sixth arguments are both nil."
1632 :group
'ps-print-printer
)
1634 (defcustom ps-manual-feed nil
1635 "*Non-nil means the printer will manually feed paper.
1637 If it's nil, automatic feeding takes place."
1639 :group
'ps-print-printer
)
1643 ;; All page dimensions are in PostScript points.
1644 ;; 1 inch == 2.54 cm == 72 points
1645 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1647 ;; Letter 8.5 inch x 11.0 inch
1648 ;; Legal 8.5 inch x 14.0 inch
1649 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1651 ;; LetterSmall 7.68 inch x 10.16 inch
1652 ;; Tabloid 11.0 inch x 17.0 inch
1653 ;; Ledger 17.0 inch x 11.0 inch
1654 ;; Statement 5.5 inch x 8.5 inch
1655 ;; Executive 7.5 inch x 10.0 inch
1656 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1657 ;; A4Small 7.47 inch x 10.85 inch
1658 ;; B4 10.125 inch x 14.33 inch
1659 ;; B5 7.16 inch x 10.125 inch
1661 (defcustom ps-page-dimensions-database
1662 (list (list 'a4
(/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1663 (list 'a3
(/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1664 (list 'letter
(* 72 8.5) (* 72 11.0) "Letter")
1665 (list 'legal
(* 72 8.5) (* 72 14.0) "Legal")
1666 (list 'letter-small
(* 72 7.68) (* 72 10.16) "LetterSmall")
1667 (list 'tabloid
(* 72 11.0) (* 72 17.0) "Tabloid")
1668 (list 'ledger
(* 72 17.0) (* 72 11.0) "Ledger")
1669 (list 'statement
(* 72 5.5) (* 72 8.5) "Statement")
1670 (list 'executive
(* 72 7.5) (* 72 10.0) "Executive")
1671 (list 'a4small
(* 72 7.47) (* 72 10.85) "A4Small")
1672 (list 'b4
(* 72 10.125) (* 72 14.33) "B4")
1673 (list 'b5
(* 72 7.16) (* 72 10.125) "B5"))
1674 "*List associating a symbolic paper type to its width, height and doc media.
1675 See `ps-paper-type'."
1676 :type
'(repeat (list :tag
"Paper Type"
1677 (symbol :tag
"Name")
1678 (number :tag
"Width")
1679 (number :tag
"Height")
1680 (string :tag
"Media")))
1681 :group
'ps-print-page
)
1684 (defcustom ps-paper-type
'letter
1685 "*Specify the size of paper to format for.
1686 Should be one of the paper types defined in `ps-page-dimensions-database', for
1687 example `letter', `legal' or `a4'."
1688 :type
'(symbol :validate
(lambda (wid)
1689 (if (assq (widget-value wid
)
1690 ps-page-dimensions-database
)
1692 (widget-put wid
:error
"Unknown paper size")
1694 :group
'ps-print-page
)
1696 (defcustom ps-warn-paper-type t
1697 "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1699 It's used when `ps-spool-config' is set to `setpagedevice'."
1701 :group
'ps-print-page
)
1703 (defcustom ps-landscape-mode nil
1704 "*Non-nil means print in landscape mode."
1706 :group
'ps-print-page
)
1708 (defcustom ps-print-upside-down nil
1709 "*Non-nil means print upside-down."
1711 :group
'ps-print-page
)
1713 (defcustom ps-selected-pages nil
1714 "*Specify which pages to print.
1716 If it's nil, all pages are printed.
1718 If it's a list, the list element may be an integer or a cons cell (FROM . TO)
1719 designating FROM page to TO page; any invalid element is ignored, that is, an
1720 integer lesser than one or if FROM is greater than TO.
1722 Otherwise, it's treated as nil.
1724 After ps-print processing `ps-selected-pages' is set to nil. But the latest
1725 `ps-selected-pages' is saved in `ps-last-selected-pages' (see it for
1726 documentation). So you can restore the latest selected pages by using
1727 `ps-last-selected-pages' or by calling `ps-restore-selected-pages' command (see
1728 it for documentation).
1730 See also `ps-even-or-odd-pages'."
1731 :type
'(repeat :tag
"Selected Pages"
1733 (integer :tag
"Number")
1735 (integer :tag
"From")
1736 (integer :tag
"To"))))
1737 :group
'ps-print-page
)
1739 (defcustom ps-even-or-odd-pages nil
1740 "*Specify if it prints even/odd pages.
1744 nil print all pages.
1746 `even' print only even pages.
1748 `odd' print only odd pages.
1750 Any other value is treated as nil.
1752 If you set `ps-selected-pages' (see it for documentation), first the pages are
1753 filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1754 example, if we have:
1756 (setq ps-selected-pages '(1 4 (6 . 10) 12))
1758 We have the following results:
1760 `ps-even-or-odd-pages' PAGES PRINTED
1761 nil 1, 4, 6, 7, 8, 9, 10, 12
1762 even 4, 6, 8, 10, 12
1764 :type
'(choice :menu-tag
"Print Even/Odd Pages"
1765 :tag
"Print Even/Odd Pages"
1766 (const :tag
"All Pages" nil
)
1767 (const :tag
"Only Even Pages" even
)
1768 (const :tag
"Only Odd Pages" odd
))
1769 :group
'ps-print-page
)
1771 (defcustom ps-print-control-characters
'control-8-bit
1772 "*Specify the printable form for control and 8-bit characters.
1773 That is, instead of sending, for example, a ^D (\\004) to printer,
1774 it is sent the string \"^D\".
1778 `8-bit' This is the value to use when you want an ASCII encoding of
1779 any control or non-ASCII character. Control characters are
1780 encoded as \"^D\", and non-ASCII characters have an
1783 `control-8-bit' This is the value to use when you want an ASCII encoding of
1784 any control character, whether it is 7 or 8-bit.
1785 European 8-bits accented characters are printed according
1788 `control' Only ASCII control characters have an ASCII encoding.
1789 European 8-bits accented characters are printed according
1792 nil No ASCII encoding. Any character is printed according the
1795 Any other value is treated as nil."
1796 :type
'(choice :menu-tag
"Control Char"
1798 (const 8-bit
) (const control-8-bit
)
1799 (const control
) (const :tag
"nil" nil
))
1800 :group
'ps-print-miscellany
)
1802 (defcustom ps-n-up-printing
1
1803 "*Specify the number of pages per sheet paper."
1805 :tag
"N Up Printing"
1808 (if (and (< 0 (widget-value wid
))
1809 (<= (widget-value wid
) 100))
1813 "Number of pages per sheet paper must be between 1 and 100.")
1815 :group
'ps-print-n-up
)
1817 (defcustom ps-n-up-margin
(/ (* 72 1.0) 2.54) ; 1 cm
1818 "*Specify the margin in points between the sheet border and n-up printing."
1820 :group
'ps-print-n-up
)
1822 (defcustom ps-n-up-border-p t
1823 "*Non-nil means a border is drawn around each page."
1825 :group
'ps-print-n-up
)
1827 (defcustom ps-n-up-filling
'left-top
1828 "*Specify how page matrix is filled on each sheet of paper.
1830 Following are the valid values for `ps-n-up-filling' with a filling example
1831 using a 3x4 page matrix:
1833 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
1837 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
1841 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
1845 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
1849 Any other value is treated as `left-top'."
1850 :type
'(choice :menu-tag
"N-Up Filling"
1852 (const left-top
) (const left-bottom
)
1853 (const right-top
) (const right-bottom
)
1854 (const top-left
) (const bottom-left
)
1855 (const top-right
) (const bottom-right
))
1856 :group
'ps-print-n-up
)
1858 (defcustom ps-number-of-columns
(if ps-landscape-mode
2 1)
1859 "*Specify the number of columns"
1861 :group
'ps-print-miscellany
)
1863 (defcustom ps-zebra-stripes nil
1864 "*Non-nil means print zebra stripes.
1865 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
1867 :group
'ps-print-zebra
)
1869 (defcustom ps-zebra-stripe-height
3
1870 "*Number of zebra stripe lines.
1871 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
1873 :group
'ps-print-zebra
)
1875 (defcustom ps-zebra-color
0.95
1876 "*Zebra stripe gray scale or RGB color.
1877 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
1878 :type
'(choice :menu-tag
"Zebra Gray/Color"
1879 :tag
"Zebra Gray/Color"
1880 (number :tag
"Gray Scale" :value
0.95)
1881 (string :tag
"Color Name" :value
"gray95")
1882 (list :tag
"RGB Color" :value
(0.95
0.95 0.95)
1884 (number :tag
"Green")
1885 (number :tag
"Blue")))
1886 :group
'ps-print-zebra
)
1888 (defcustom ps-zebra-stripe-follow nil
1889 "*Non-nil means zebra stripe continues on next page.
1891 If `ps-zebra-stripe-follow' is nil, zebra stripe is restarted on each page.
1892 If `ps-zebra-stripe-follow' is non-nil, zebra stripe continues on next page.
1896 `ps-zebra-stripe-follow' `ps-zebra-stripe-follow'
1898 Current Page ------------------------ ------------------------
1899 1 XXXXXXXXXXXXXXXXXXXXX 1 XXXXXXXXXXXXXXXXXXXXX
1900 2 XXXXXXXXXXXXXXXXXXXXX 2 XXXXXXXXXXXXXXXXXXXXX
1901 3 XXXXXXXXXXXXXXXXXXXXX 3 XXXXXXXXXXXXXXXXXXXXX
1905 7 XXXXXXXXXXXXXXXXXXXXX 7 XXXXXXXXXXXXXXXXXXXXX
1906 8 XXXXXXXXXXXXXXXXXXXXX 8 XXXXXXXXXXXXXXXXXXXXX
1907 ------------------------ ------------------------
1908 Next Page ------------------------ ------------------------
1909 9 XXXXXXXXXXXXXXXXXXXXX 9 XXXXXXXXXXXXXXXXXXXXX
1910 10 XXXXXXXXXXXXXXXXXXXXX 10
1911 11 XXXXXXXXXXXXXXXXXXXXX 11
1913 13 13 XXXXXXXXXXXXXXXXXXXXX
1914 14 14 XXXXXXXXXXXXXXXXXXXXX
1915 15 XXXXXXXXXXXXXXXXXXXXX 15 XXXXXXXXXXXXXXXXXXXXX
1916 16 XXXXXXXXXXXXXXXXXXXXX 16
1917 ------------------------ ------------------------"
1919 :group
'ps-print-zebra
)
1921 (defcustom ps-line-number nil
1922 "*Non-nil means print line number."
1924 :group
'ps-print-miscellany
)
1926 (defcustom ps-line-number-step
1
1927 "*Specify the interval that line number is printed.
1929 For example, `ps-line-number-step' is set to 2, the printing will look like:
1941 integer an integer that specifies the interval that line number is
1942 printed. If it's lesser than or equal to zero, it's used the
1945 `zebra' specifies that only the line number of the first line in a zebra
1946 stripe is to be printed.
1948 Any other value is treated as `zebra'."
1949 :type
'(choice :menu-tag
"Line Number Step"
1950 :tag
"Line Number Step"
1951 (integer :tag
"Step Interval")
1952 (const :tag
"Synchronize Zebra" zebra
))
1953 :group
'ps-print-miscellany
)
1955 (defcustom ps-line-number-start
1
1956 "*Specify the starting point in the interval given by `ps-line-number-step'.
1958 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
1959 set to 3, the printing will look like:
1973 The values for `ps-line-number-start':
1975 * If `ps-line-number-step' is an integer, must be between 1 and the value
1976 of `ps-line-number-step' inclusive.
1978 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
1979 value of `ps-zebra-strip-height' inclusive. Use this combination if you
1980 wish that line number be relative to zebra stripes."
1981 :type
'(integer :tag
"Start Step Interval")
1982 :group
'ps-print-miscellany
)
1984 (defcustom ps-print-background-image nil
1985 "*EPS image list to be printed on background.
1989 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
1991 FILENAME is a file name which contains an EPS image or some PostScript
1992 programming like EPS.
1993 FILENAME is ignored, if it doesn't exist or is read protected.
1995 X and Y are relative positions on paper to put the image.
1996 If X and Y are nil, the image is centralized on paper.
1998 XSCALE and YSCALE are scale factor to be applied to image before printing.
1999 If XSCALE and YSCALE are nil, the original size is used.
2001 ROTATION is the image rotation angle; if nil, the default is 0.
2003 PAGES designates the page to print background image.
2004 PAGES may be a number or a cons cell (FROM . TO) designating FROM page
2006 If PAGES is nil, print background image on all pages.
2008 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number,
2009 an integer number or a string. If it is a string, the string should contain
2010 PostScript programming that returns a float or integer value.
2012 For example, if you wish to print an EPS image on all pages do:
2014 '((\"~/images/EPS-image.ps\"))"
2017 (file :tag
"EPS File")
2018 (choice :tag
"X" (const :tag
"default" nil
) number string
)
2019 (choice :tag
"Y" (const :tag
"default" nil
) number string
)
2020 (choice :tag
"X Scale" (const :tag
"default" nil
) number string
)
2021 (choice :tag
"Y Scale" (const :tag
"default" nil
) number string
)
2022 (choice :tag
"Rotation" (const :tag
"default" nil
) number string
)
2023 (repeat :tag
"Pages" :inline t
2024 (radio (integer :tag
"Page")
2026 (integer :tag
"From")
2027 (integer :tag
"To"))))))
2028 :group
'ps-print-background
)
2030 (defcustom ps-print-background-text nil
2031 "*Text list to be printed on background.
2035 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2037 STRING is the text to be printed on background.
2039 X and Y are positions on paper to put the text.
2040 If X and Y are nil, the text is positioned at lower left corner.
2042 FONT is a font name to be used on printing the text.
2043 If nil, \"Times-Roman\" is used.
2045 FONTSIZE is font size to be used, if nil, 200 is used.
2047 GRAY is the text gray factor (should be very light like 0.8).
2048 If nil, the default is 0.85.
2050 ROTATION is the text rotation angle; if nil, the angle is given by
2051 the diagonal from lower left corner to upper right corner.
2053 PAGES designates the page to print background text.
2054 PAGES may be a number or a cons cell (FROM . TO) designating FROM page
2056 If PAGES is nil, print background text on all pages.
2058 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number,
2059 an integer number or a string. If it is a string, the string should contain
2060 PostScript programming that returns a float or integer value.
2062 For example, if you wish to print text \"Preliminary\" on all pages do:
2064 '((\"Preliminary\"))"
2067 (string :tag
"Text")
2068 (choice :tag
"X" (const :tag
"default" nil
) number string
)
2069 (choice :tag
"Y" (const :tag
"default" nil
) number string
)
2070 (choice :tag
"Font" (const :tag
"default" nil
) string
)
2071 (choice :tag
"Fontsize" (const :tag
"default" nil
) number string
)
2072 (choice :tag
"Gray" (const :tag
"default" nil
) number string
)
2073 (choice :tag
"Rotation" (const :tag
"default" nil
) number string
)
2074 (repeat :tag
"Pages" :inline t
2075 (radio (integer :tag
"Page")
2077 (integer :tag
"From")
2078 (integer :tag
"To"))))))
2079 :group
'ps-print-background
)
2081 ;;; Horizontal layout
2083 ;; ------------------------------------------
2085 ;; | lm | text | ic | text | ic | text | rm |
2087 ;; ------------------------------------------
2089 (defcustom ps-left-margin
(/ (* 72 2.0) 2.54) ; 2 cm
2090 "*Left margin in points (1/72 inch)."
2092 :group
'ps-print-horizontal
)
2094 (defcustom ps-right-margin
(/ (* 72 2.0) 2.54) ; 2 cm
2095 "*Right margin in points (1/72 inch)."
2097 :group
'ps-print-horizontal
)
2099 (defcustom ps-inter-column
(/ (* 72 2.0) 2.54) ; 2 cm
2100 "*Horizontal space between columns in points (1/72 inch)."
2102 :group
'ps-print-horizontal
)
2118 (defcustom ps-bottom-margin
(/ (* 72 1.5) 2.54) ; 1.5 cm
2119 "*Bottom margin in points (1/72 inch)."
2121 :group
'ps-print-vertical
)
2123 (defcustom ps-top-margin
(/ (* 72 1.5) 2.54) ; 1.5 cm
2124 "*Top margin in points (1/72 inch)."
2126 :group
'ps-print-vertical
)
2128 (defcustom ps-header-offset
(/ (* 72 1.0) 2.54) ; 1.0 cm
2129 "*Vertical space in points (1/72 inch) between the main text and the header."
2131 :group
'ps-print-vertical
)
2133 (defcustom ps-header-line-pad
0.15
2134 "*Portion of a header title line height to insert between the header frame
2135 and the text it contains, both in the vertical and horizontal directions."
2137 :group
'ps-print-vertical
)
2141 (defcustom ps-print-header t
2142 "*Non-nil means print a header at the top of each page.
2143 By default, the header displays the buffer name, page number, and, if
2144 the buffer is visiting a file, the file's directory. Headers are
2145 customizable by changing variables `ps-left-header' and
2148 :group
'ps-print-headers
)
2150 (defcustom ps-print-only-one-header nil
2151 "*Non-nil means print only one header at the top of each page.
2152 This is useful when printing more than one column, so it is possible
2153 to have only one header over all columns or one header per column.
2154 See also `ps-print-header'."
2156 :group
'ps-print-headers
)
2158 (defcustom ps-print-header-frame t
2159 "*Non-nil means draw a gaudy frame around the header."
2161 :group
'ps-print-headers
)
2163 (defcustom ps-header-lines
2
2164 "*Number of lines to display in page header, when generating PostScript."
2166 :group
'ps-print-headers
)
2168 (defcustom ps-switch-header
'duplex
2169 "*Specify if headers are switched or not.
2173 nil Never switch headers.
2175 t Always switch headers.
2177 duplex Switch headers only when duplexing is on, that is, when
2178 `ps-spool-duplex' is non-nil.
2180 Any other value is treated as t."
2181 :type
'(choice :menu-tag
"Switch Header"
2182 :tag
"Switch Header"
2183 (const :tag
"Never Switch" nil
)
2184 (const :tag
"Always Switch" t
)
2185 (const :tag
"Switch When Duplexing" duplex
))
2186 :group
'ps-print-headers
)
2188 (defcustom ps-show-n-of-n t
2189 "*Non-nil means show page numbers as N/M, meaning page N of M.
2190 NOTE: page numbers are displayed as part of headers,
2191 see variable `ps-print-header'."
2193 :group
'ps-print-headers
)
2195 (defcustom ps-spool-config
2196 (if ps-windows-system
2199 "*Specify who is responsable for setting duplex and page size switches.
2203 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2204 Don't forget to set `ps-lpr-switches' to select duplex
2205 printing for your printer.
2207 `setpagedevice' duplex and page size are configured by ps-print using the
2208 setpagedevice PostScript operator.
2210 nil duplex and page size are configured by ps-print *not* using
2211 the setpagedevice PostScript operator.
2213 Any other value is treated as nil.
2215 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2216 viewing file generated using landscape. Also on some printers,
2217 setpagedevice affects zebra stripes; on other printers, setpagedevice
2218 affects the left margin.
2219 Besides all that, if your printer does not have the paper size
2220 specified by setpagedevice, your printing will be aborted.
2221 So, if you need to use setpagedevice, set `ps-spool-config' to
2222 `setpagedevice', generate a test file and send it to your printer; if
2223 the printed file isn't ok, set `ps-spool-config' to nil."
2224 :type
'(choice :menu-tag
"Spool Config"
2226 (const lpr-switches
) (const setpagedevice
)
2227 (const :tag
"nil" nil
))
2228 :group
'ps-print-headers
)
2230 (defcustom ps-spool-duplex nil
; Not many people have duplex printers,
2231 ; so default to nil.
2232 "*Non-nil generates PostScript for a two-sided printer.
2233 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2234 blank pages as needed between print jobs so that the next buffer printed will
2235 start on the right page. Also, if headers are turned on, the headers will be
2236 reversed on duplex printers so that the page numbers fall to the left on
2237 even-numbered pages.
2239 See also `ps-spool-tumble'."
2241 :group
'ps-print-headers
)
2243 (defcustom ps-spool-tumble nil
2244 "*Specify how the page images on opposite sides of a sheet are oriented.
2245 If `ps-spool-tumble' is nil, produces output suitable for binding on the left or
2246 right. If `ps-spool-tumble' is non-nil, produces output suitable for binding at
2249 It has effect only when `ps-spool-duplex' is non-nil."
2251 :group
'ps-print-headers
)
2255 (defcustom ps-font-info-database
2256 '((Courier ; the family key
2257 (fonts (normal .
"Courier")
2258 (bold .
"Courier-Bold")
2259 (italic .
"Courier-Oblique")
2260 (bold-italic .
"Courier-BoldOblique"))
2262 (line-height .
10.55)
2264 (avg-char-width .
6.0))
2265 (Helvetica ; the family key
2266 (fonts (normal .
"Helvetica")
2267 (bold .
"Helvetica-Bold")
2268 (italic .
"Helvetica-Oblique")
2269 (bold-italic .
"Helvetica-BoldOblique"))
2271 (line-height .
11.56)
2272 (space-width .
2.78)
2273 (avg-char-width .
5.09243))
2275 (fonts (normal .
"Times-Roman")
2276 (bold .
"Times-Bold")
2277 (italic .
"Times-Italic")
2278 (bold-italic .
"Times-BoldItalic"))
2280 (line-height .
11.0)
2282 (avg-char-width .
4.71432))
2284 (fonts (normal .
"Palatino-Roman")
2285 (bold .
"Palatino-Bold")
2286 (italic .
"Palatino-Italic")
2287 (bold-italic .
"Palatino-BoldItalic"))
2289 (line-height .
12.1)
2291 (avg-char-width .
5.08676))
2293 (fonts (normal .
"Helvetica-Narrow")
2294 (bold .
"Helvetica-Narrow-Bold")
2295 (italic .
"Helvetica-Narrow-Oblique")
2296 (bold-italic .
"Helvetica-Narrow-BoldOblique"))
2298 (line-height .
11.56)
2299 (space-width .
2.2796)
2300 (avg-char-width .
4.17579))
2302 (fonts (normal .
"NewCenturySchlbk-Roman")
2303 (bold .
"NewCenturySchlbk-Bold")
2304 (italic .
"NewCenturySchlbk-Italic")
2305 (bold-italic .
"NewCenturySchlbk-BoldItalic"))
2307 (line-height .
12.15)
2308 (space-width .
2.78)
2309 (avg-char-width .
5.31162))
2310 ;; got no bold for the next ones
2312 (fonts (normal .
"AvantGarde-Book")
2313 (italic .
"AvantGarde-BookOblique"))
2315 (line-height .
11.77)
2316 (space-width .
2.77)
2317 (avg-char-width .
5.45189))
2319 (fonts (normal .
"AvantGarde-Demi")
2320 (italic .
"AvantGarde-DemiOblique"))
2322 (line-height .
12.72)
2324 (avg-char-width .
5.51351))
2326 (fonts (normal .
"Bookman-Demi")
2327 (italic .
"Bookman-DemiItalic"))
2329 (line-height .
11.77)
2331 (avg-char-width .
6.05946))
2333 (fonts (normal .
"Bookman-Light")
2334 (italic .
"Bookman-LightItalic"))
2336 (line-height .
11.79)
2338 (avg-char-width .
5.67027))
2339 ;; got no bold and no italic for the next ones
2341 (fonts (normal .
"Symbol"))
2343 (line-height .
13.03)
2345 (avg-char-width .
3.24324))
2347 (fonts (normal .
"Zapf-Dingbats"))
2349 (line-height .
9.63)
2350 (space-width .
2.78)
2351 (avg-char-width .
2.78))
2352 (Zapf-Chancery-MediumItalic
2353 (fonts (normal .
"Zapf-Chancery-MediumItalic"))
2355 (line-height .
11.45)
2357 (avg-char-width .
4.10811))
2359 "*Font info database: font family (the key), name, bold, italic, bold-italic,
2360 reference size, line height, space width, average character width.
2361 To get the info for another specific font (say Helvetica), do the following:
2362 - create a new buffer
2363 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2364 - open this file and delete the leading `%' (which is the PostScript
2365 comment character) from the line
2366 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2368 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2369 - add the values to `ps-font-info-database'.
2370 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2372 Note also that ps-print DOESN'T download any font to your printer, instead
2373 it uses the fonts resident in your printer."
2374 :type
'(repeat (list :tag
"Font Definition"
2375 (symbol :tag
"Font Family")
2377 (const :format
"" fonts
)
2378 (repeat :tag
"Faces"
2379 (cons (choice (const normal
)
2383 (symbol :tag
"Face"))
2384 (string :tag
"Font Name"))))
2386 (const :format
"" size
)
2387 (number :tag
"Reference Size"))
2389 (const :format
"" line-height
)
2390 (number :tag
"Line Height"))
2392 (const :format
"" space-width
)
2393 (number :tag
"Space Width"))
2395 (const :format
"" avg-char-width
)
2396 (number :tag
"Average Character Width"))))
2397 :group
'ps-print-font
)
2399 (defcustom ps-font-family
'Courier
2400 "*Font family name for ordinary text, when generating PostScript."
2402 :group
'ps-print-font
)
2404 (defcustom ps-font-size
'(7 .
8.5)
2405 "*Font size, in points, for ordinary text, when generating PostScript."
2406 :type
'(choice (number :tag
"Text Size")
2407 (cons :tag
"Landscape/Portrait"
2408 (number :tag
"Landscape Text Size")
2409 (number :tag
"Portrait Text Size")))
2410 :group
'ps-print-font
)
2412 (defcustom ps-header-font-family
'Helvetica
2413 "*Font family name for text in the header, when generating PostScript."
2415 :group
'ps-print-font
)
2417 (defcustom ps-header-font-size
'(10 .
12)
2418 "*Font size, in points, for text in the header, when generating PostScript."
2419 :type
'(choice (number :tag
"Header Size")
2420 (cons :tag
"Landscape/Portrait"
2421 (number :tag
"Landscape Header Size")
2422 (number :tag
"Portrait Header Size")))
2423 :group
'ps-print-font
)
2425 (defcustom ps-header-title-font-size
'(12 .
14)
2426 "*Font size, in points, for the top line of text in header, in PostScript."
2427 :type
'(choice (number :tag
"Header Title Size")
2428 (cons :tag
"Landscape/Portrait"
2429 (number :tag
"Landscape Header Title Size")
2430 (number :tag
"Portrait Header Title Size")))
2431 :group
'ps-print-font
)
2435 ;; Printing color requires x-color-values.
2436 (defcustom ps-print-color-p
2437 (or (and (fboundp 'color-values
) ; Emacs
2438 (ps-e-color-values "Green"))
2439 (fboundp 'x-color-values
) ; Emacs
2440 (fboundp 'color-instance-rgb-components
))
2442 "*Non-nil means print the buffer's text in color."
2444 :group
'ps-print-color
)
2446 (defcustom ps-default-fg
'(0.0
0.0 0.0)
2447 "*RGB values of the default foreground color. Defaults to black."
2448 :type
'(choice :menu-tag
"Default Foreground Gray/Color"
2449 :tag
"Default Foreground Gray/Color"
2450 (number :tag
"Gray Scale" :value
0.0)
2451 (string :tag
"Color Name" :value
"black")
2452 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2454 (number :tag
"Green")
2455 (number :tag
"Blue")))
2456 :group
'ps-print-color
)
2458 (defcustom ps-default-bg
'(1.0
1.0 1.0)
2459 "*RGB values of the default background color. Defaults to white."
2460 :type
'(choice :menu-tag
"Default Background Gray/Color"
2461 :tag
"Default Background Gray/Color"
2462 (number :tag
"Gray Scale" :value
1.0)
2463 (string :tag
"Color Name" :value
"white")
2464 (list :tag
"RGB Color" :value
(1.0
1.0 1.0)
2466 (number :tag
"Green")
2467 (number :tag
"Blue")))
2468 :group
'ps-print-color
)
2470 (defcustom ps-auto-font-detect t
2471 "*Non-nil means automatically detect bold/italic/underline face attributes.
2472 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces',
2473 and `ps-underlined-faces'."
2475 :group
'ps-print-font
)
2477 (defcustom ps-bold-faces
2478 (unless ps-print-color-p
2479 '(font-lock-function-name-face
2480 font-lock-builtin-face
2481 font-lock-variable-name-face
2482 font-lock-keyword-face
2483 font-lock-warning-face
))
2484 "*A list of the \(non-bold\) faces that should be printed in bold font.
2485 This applies to generating PostScript."
2486 :type
'(repeat face
)
2487 :group
'ps-print-face
)
2489 (defcustom ps-italic-faces
2490 (unless ps-print-color-p
2491 '(font-lock-variable-name-face
2493 font-lock-string-face
2494 font-lock-comment-face
2495 font-lock-warning-face
))
2496 "*A list of the \(non-italic\) faces that should be printed in italic font.
2497 This applies to generating PostScript."
2498 :type
'(repeat face
)
2499 :group
'ps-print-face
)
2501 (defcustom ps-underlined-faces
2502 (unless ps-print-color-p
2503 '(font-lock-function-name-face
2504 font-lock-constant-face
2505 font-lock-warning-face
))
2506 "*A list of the \(non-underlined\) faces that should be printed underlined.
2507 This applies to generating PostScript."
2508 :type
'(repeat face
)
2509 :group
'ps-print-face
)
2511 (defcustom ps-use-face-background nil
2512 "*Specify if face background should be used.
2516 t always use face background color.
2517 nil never use face background color.
2518 (face...) list of faces whose background color will be used.
2520 Any other value will be treated as t."
2521 :type
'(choice :menu-tag
"Use Face Background"
2522 :tag
"Use Face Background"
2523 (const :tag
"Always Use Face Background" t
)
2524 (const :tag
"Never Use Face Background" nil
)
2525 (repeat :menu-tag
"Face Background List"
2526 :tag
"Face Background List"
2528 :group
'ps-print-face
)
2530 (defcustom ps-left-header
2531 (list 'ps-get-buffer-name
'ps-header-dirpart
)
2532 "*The items to display (each on a line) on the left part of the page header.
2533 This applies to generating PostScript.
2535 The value should be a list of strings and symbols, each representing an
2536 entry in the PostScript array HeaderLinesLeft.
2538 Strings are inserted unchanged into the array; those representing
2539 PostScript string literals should be delimited with PostScript string
2540 delimiters '(' and ')'.
2542 For symbols with bound functions, the function is called and should
2543 return a string to be inserted into the array. For symbols with bound
2544 values, the value should be a string to be inserted into the array.
2545 In either case, function or variable, the string value has PostScript
2546 string delimiters added to it."
2547 :type
'(repeat (choice string symbol
))
2548 :group
'ps-print-headers
)
2550 (defcustom ps-right-header
2551 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy
'time-stamp-hh
:mm
:ss
)
2552 "*The items to display (each on a line) on the right part of the page header.
2553 This applies to generating PostScript.
2555 See the variable `ps-left-header' for a description of the format of
2557 :type
'(repeat (choice string symbol
))
2558 :group
'ps-print-headers
)
2560 (defcustom ps-razzle-dazzle t
2561 "*Non-nil means report progress while formatting buffer."
2563 :group
'ps-print-miscellany
)
2565 (defcustom ps-adobe-tag
"%!PS-Adobe-3.0\n"
2566 "*Contains the header line identifying the output as PostScript.
2567 By default, `ps-adobe-tag' contains the standard identifier. Some
2568 printers require slightly different versions of this line."
2570 :group
'ps-print-miscellany
)
2572 (defcustom ps-build-face-reference t
2573 "*Non-nil means build the reference face lists.
2575 ps-print sets this value to nil after it builds its internal reference
2576 lists of bold and italic faces. By settings its value back to t, you
2577 can force ps-print to rebuild the lists the next time you invoke one
2578 of the ...-with-faces commands.
2580 You should set this value back to t after you change the attributes of
2581 any face, or create new faces. Most users shouldn't have to worry
2582 about its setting, though."
2584 :group
'ps-print-face
)
2586 (defcustom ps-always-build-face-reference nil
2587 "*Non-nil means always rebuild the reference face lists.
2589 If this variable is non-nil, ps-print will rebuild its internal
2590 reference lists of bold and italic faces *every* time one of the
2591 ...-with-faces commands is called. Most users shouldn't need to set this
2594 :group
'ps-print-face
)
2596 (defcustom ps-banner-page-when-duplexing nil
2597 "*Non-nil means the very first page is skipped.
2598 It's like the very first character of buffer (or region) is ^L (\\014)."
2600 :group
'ps-print-headers
)
2602 (defcustom ps-postscript-code-directory
2603 (or (and (fboundp 'locate-data-directory
) ; xemacs
2604 (locate-data-directory "ps-print"))
2605 data-directory
) ; emacs
2606 "*Directory where it's located the PostScript prologue file used by ps-print.
2607 By default, this directory is the same as in the variable `data-directory'."
2609 :group
'ps-print-miscellany
)
2612 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2616 (defvar ps-last-selected-pages nil
2617 "Latest `ps-selected-pages' value.")
2620 (defun ps-restore-selected-pages ()
2621 "Restore latest `ps-selected-pages' value."
2623 (setq ps-selected-pages ps-last-selected-pages
))
2626 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2631 (defun ps-print-customize ()
2632 "Customization of ps-print group."
2634 (customize-group 'ps-print
))
2637 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2642 (defun ps-print-buffer (&optional filename
)
2643 "Generate and print a PostScript image of the buffer.
2645 Interactively, when you use a prefix argument (C-u), the command
2646 prompts the user for a file name, and saves the PostScript image
2647 in that file instead of sending it to the printer.
2649 Noninteractively, the argument FILENAME is treated as follows: if it
2650 is nil, send the image to the printer. If FILENAME is a string, save
2651 the PostScript image in a file with that name."
2652 (interactive (list (ps-print-preprint current-prefix-arg
)))
2653 (ps-print-without-faces (point-min) (point-max) filename
))
2657 (defun ps-print-buffer-with-faces (&optional filename
)
2658 "Generate and print a PostScript image of the buffer.
2659 Like `ps-print-buffer', but includes font, color, and underline
2660 information in the generated image. This command works only if you
2661 are using a window system, so it has a way to determine color values."
2662 (interactive (list (ps-print-preprint current-prefix-arg
)))
2663 (ps-print-with-faces (point-min) (point-max) filename
))
2667 (defun ps-print-region (from to
&optional filename
)
2668 "Generate and print a PostScript image of the region.
2669 Like `ps-print-buffer', but prints just the current region."
2670 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
2671 (ps-print-without-faces from to filename t
))
2675 (defun ps-print-region-with-faces (from to
&optional filename
)
2676 "Generate and print a PostScript image of the region.
2677 Like `ps-print-region', but includes font, color, and underline
2678 information in the generated image. This command works only if you
2679 are using a window system, so it has a way to determine color values."
2680 (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg
)))
2681 (ps-print-with-faces from to filename t
))
2685 (defun ps-spool-buffer ()
2686 "Generate and spool a PostScript image of the buffer.
2687 Like `ps-print-buffer' except that the PostScript image is saved in a
2688 local buffer to be sent to the printer later.
2690 Use the command `ps-despool' to send the spooled images to the printer."
2692 (ps-spool-without-faces (point-min) (point-max)))
2696 (defun ps-spool-buffer-with-faces ()
2697 "Generate and spool a PostScript image of the buffer.
2698 Like `ps-spool-buffer', but includes font, color, and underline
2699 information in the generated image. This command works only if you
2700 are using a window system, so it has a way to determine color values.
2702 Use the command `ps-despool' to send the spooled images to the printer."
2704 (ps-spool-with-faces (point-min) (point-max)))
2708 (defun ps-spool-region (from to
)
2709 "Generate a PostScript image of the region and spool locally.
2710 Like `ps-spool-buffer', but spools just the current region.
2712 Use the command `ps-despool' to send the spooled images to the printer."
2714 (ps-spool-without-faces from to t
))
2718 (defun ps-spool-region-with-faces (from to
)
2719 "Generate a PostScript image of the region and spool locally.
2720 Like `ps-spool-region', but includes font, color, and underline
2721 information in the generated image. This command works only if you
2722 are using a window system, so it has a way to determine color values.
2724 Use the command `ps-despool' to send the spooled images to the printer."
2726 (ps-spool-with-faces from to t
))
2729 (defun ps-despool (&optional filename
)
2730 "Send the spooled PostScript to the printer.
2732 Interactively, when you use a prefix argument (C-u), the command
2733 prompts the user for a file name, and saves the spooled PostScript
2734 image in that file instead of sending it to the printer.
2736 Noninteractively, the argument FILENAME is treated as follows: if it
2737 is nil, send the image to the printer. If FILENAME is a string, save
2738 the PostScript image in a file with that name."
2739 (interactive (list (ps-print-preprint current-prefix-arg
)))
2740 (ps-do-despool filename
))
2743 (defun ps-line-lengths ()
2744 "Display the correspondence between a line length and a font size,
2745 using the current ps-print setup.
2746 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
2748 (ps-line-lengths-internal))
2751 (defun ps-nb-pages-buffer (nb-lines)
2752 "Display number of pages to print this buffer, for various font heights.
2753 The table depends on the current ps-print setup."
2754 (interactive (list (count-lines (point-min) (point-max))))
2755 (ps-nb-pages nb-lines
))
2758 (defun ps-nb-pages-region (nb-lines)
2759 "Display number of pages to print the region, for various font heights.
2760 The table depends on the current ps-print setup."
2761 (interactive (list (count-lines (mark) (point))))
2762 (ps-nb-pages nb-lines
))
2766 "Return the current PostScript-generation setup."
2769 ;;; ps-print version %s
2771 \(setq ps-print-color-p %s
2775 ps-printer-name-option %s
2776 ps-print-region-function %s
2780 ps-warn-paper-type %s
2781 ps-landscape-mode %s
2782 ps-print-upside-down %s
2783 ps-number-of-columns %s
2786 ps-zebra-stripe-height %s
2787 ps-zebra-stripe-follow %S
2790 ps-line-number-step %s
2791 ps-line-number-start %S
2796 ps-use-face-background %s
2798 ps-print-control-characters %s
2800 ps-print-background-image %s
2802 ps-print-background-text %s
2804 ps-error-handler-message %s
2805 ps-user-defined-prologue %s
2806 ps-print-prologue-header %s
2814 ps-header-line-pad %s
2816 ps-print-only-one-header %s
2817 ps-print-header-frame %s
2824 ps-banner-page-when-duplexing %s
2831 ps-multibyte-buffer %s
2834 ps-header-font-family %s
2835 ps-header-font-size %s
2836 ps-header-title-font-size %s
2838 ps-even-or-odd-pages %s
2839 ps-selected-pages %s
2840 ps-last-selected-pages %s)
2842 ;;; ps-print - end of settings
2847 (ps-print-quote ps-lpr-switches
)
2848 (ps-print-quote ps-printer-name
)
2849 (ps-print-quote ps-printer-name-option
)
2850 (ps-print-quote ps-print-region-function
)
2852 (ps-print-quote ps-paper-type
)
2855 ps-print-upside-down
2856 ps-number-of-columns
2858 ps-zebra-stripe-height
2859 ps-zebra-stripe-follow
2860 (ps-print-quote ps-zebra-color
)
2862 (ps-print-quote ps-line-number-step
)
2863 ps-line-number-start
2864 (ps-print-quote ps-default-fg
)
2865 (ps-print-quote ps-default-bg
)
2866 (ps-print-quote ps-use-face-background
)
2867 (ps-print-quote ps-print-control-characters
)
2868 (ps-print-quote ps-print-background-image
)
2869 (ps-print-quote ps-print-background-text
)
2870 (ps-print-quote ps-error-handler-message
)
2871 (ps-print-quote ps-user-defined-prologue
)
2872 (ps-print-quote ps-print-prologue-header
)
2881 ps-print-only-one-header
2882 ps-print-header-frame
2883 (ps-print-quote ps-switch-header
)
2886 (ps-print-quote ps-spool-config
)
2889 ps-banner-page-when-duplexing
2893 (ps-print-quote ps-n-up-filling
)
2894 (ps-print-quote ps-multibyte-buffer
) ; see `ps-mule.el'
2895 (ps-print-quote ps-font-family
)
2896 (ps-print-quote ps-font-size
)
2897 (ps-print-quote ps-header-font-family
)
2898 (ps-print-quote ps-header-font-size
)
2899 (ps-print-quote ps-header-title-font-size
)
2900 (ps-print-quote ps-even-or-odd-pages
)
2901 (ps-print-quote ps-selected-pages
)
2902 (ps-print-quote ps-last-selected-pages
)))
2905 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2906 ;; Utility functions and variables:
2909 (defun ps-print-quote (sym)
2912 ((or (symbolp sym
) (listp sym
))
2921 (defvar ps-print-emacs-type
2922 (cond ((string-match "XEmacs" emacs-version
) 'xemacs
)
2923 ((string-match "Lucid" emacs-version
) 'lucid
)
2924 ((string-match "Epoch" emacs-version
) 'epoch
)
2927 (if (memq ps-print-emacs-type
'(lucid xemacs
))
2928 (if (< emacs-minor-version
12)
2929 (setq ps-print-color-p nil
))
2930 (require 'faces
)) ; face-font, face-underline-p,
2933 ;; Return t if the device (which can be changed during an emacs session)
2934 ;; can handle colors.
2935 ;; This function is not yet implemented for GNU emacs.
2936 (cond ((and (eq ps-print-emacs-type
'xemacs
)
2937 (>= emacs-minor-version
12)) ; xemacs
2938 (defun ps-color-device ()
2939 (eq (ps-x-device-class) 'color
)))
2942 (defun ps-color-device ()
2943 (if (fboundp 'color-values
)
2944 (ps-e-color-values "Green")
2948 (defun ps-mapper (extent list
)
2950 (list (list (ps-x-extent-start-position extent
) 'push extent
)
2951 (list (ps-x-extent-end-position extent
) 'pull extent
)))
2954 (defun ps-extent-sorter (a b
)
2955 (< (ps-x-extent-priority a
) (ps-x-extent-priority b
)))
2957 (defun ps-xemacs-face-kind-p (face kind kind-regex
)
2958 (let* ((frame-font (or (ps-x-face-font-instance face
)
2959 (ps-x-face-font-instance 'default
)))
2963 (ps-x-font-instance-properties frame-font
))))
2964 (kind-spec (cdr-safe kind-cons
))
2965 (case-fold-search t
))
2966 (and kind-spec
(string-match kind-regex kind-spec
))))
2968 (defun ps-xemacs-color-name (color)
2969 (if (ps-x-color-specifier-p color
)
2970 (ps-x-color-name color
)
2973 (cond ((eq ps-print-emacs-type
'emacs
) ; emacs
2975 (defun ps-color-values (x-color)
2977 ((fboundp 'color-values
)
2978 (ps-e-color-values x-color
))
2979 ((fboundp 'x-color-values
)
2980 (ps-e-x-color-values x-color
))
2982 (error "No available function to determine X color values."))))
2984 (defalias 'ps-face-foreground-name
'face-foreground
)
2985 (defalias 'ps-face-background-name
'face-background
)
2987 (defun ps-face-bold-p (face)
2988 (or (face-bold-p face
)
2989 (memq face ps-bold-faces
)))
2991 (defun ps-face-italic-p (face)
2992 (or (face-italic-p face
)
2993 (memq face ps-italic-faces
)))
2999 (or (ps-x-find-coding-system 'raw-text-unix
)
3000 (ps-x-copy-coding-system 'no-conversion-unix
'raw-text-unix
))
3002 (defun ps-color-values (x-color)
3003 (let ((color (ps-xemacs-color-name x-color
)))
3005 ((fboundp 'x-color-values
)
3006 (ps-e-x-color-values color
))
3007 ((and (fboundp 'color-instance-rgb-components
)
3009 (ps-x-color-instance-rgb-components
3010 (if (ps-x-color-instance-p x-color
)
3012 (ps-x-make-color-instance color
))))
3014 (error "No available function to determine X color values.")))))
3016 (defun ps-face-foreground-name (face)
3017 (ps-xemacs-color-name (face-foreground face
)))
3019 (defun ps-face-background-name (face)
3020 (ps-xemacs-color-name (face-background face
)))
3022 (defun ps-face-bold-p (face)
3023 (or (ps-xemacs-face-kind-p face
'WEIGHT_NAME
"bold\\|demibold")
3024 (memq face ps-bold-faces
))) ; Kludge-compatible
3026 (defun ps-face-italic-p (face)
3027 (or (ps-xemacs-face-kind-p face
'ANGLE_NAME
"i\\|o")
3028 (ps-xemacs-face-kind-p face
'SLANT
"i\\|o")
3029 (memq face ps-italic-faces
))) ; Kludge-compatible
3033 (defvar ps-print-color-scale
1.0)
3035 (defun ps-color-scale (color)
3036 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3037 (mapcar #'(lambda (value) (/ value ps-print-color-scale
))
3038 (ps-color-values color
)))
3041 (defun ps-face-underlined-p (face)
3042 (or (face-underline-p face
)
3043 (memq face ps-underlined-faces
)))
3046 (require 'time-stamp
)
3049 (defun ps-prologue-file (filenumber)
3051 (let* ((filename (format "%sps-prin%d.ps"
3052 ps-postscript-code-directory filenumber
))
3054 (or (find-file-noselect filename
'no-warn
'rawfile
)
3055 (error "ps-print PostScript prologue `%s' file was not found."
3060 (kill-buffer buffer
)))))
3063 (defvar ps-mark-code-directory nil
)
3065 (defvar ps-print-prologue-0
""
3066 "ps-print PostScript error handler.")
3068 (defvar ps-print-prologue-1
""
3069 "ps-print PostScript prologue begin.")
3071 (defvar ps-print-prologue-2
""
3072 "ps-print PostScript prologue end.")
3074 ;; Start Editing Here:
3076 (defvar ps-source-buffer nil
)
3077 (defvar ps-spool-buffer-name
"*PostScript*")
3078 (defvar ps-spool-buffer nil
)
3080 (defvar ps-output-head nil
)
3081 (defvar ps-output-tail nil
)
3083 (defvar ps-page-postscript
0)
3084 (defvar ps-page-order
0)
3085 (defvar ps-page-count
0)
3086 (defvar ps-page-n-up
0)
3087 (defvar ps-showline-count
1)
3088 (defvar ps-first-page nil
)
3089 (defvar ps-last-page nil
)
3090 (defvar ps-print-page-p t
)
3092 (defvar ps-control-or-escape-regexp nil
)
3093 (defvar ps-n-up-on nil
)
3095 (defvar ps-background-pages nil
)
3096 (defvar ps-background-all-pages nil
)
3097 (defvar ps-background-text-count
0)
3098 (defvar ps-background-image-count
0)
3100 (defvar ps-current-font
0)
3101 (defvar ps-default-foreground nil
)
3102 (defvar ps-default-color nil
)
3103 (defvar ps-current-color nil
)
3104 (defvar ps-current-bg nil
)
3106 (defvar ps-razchunk
0)
3108 (defvar ps-color-p nil
)
3109 (defvar ps-color-format
3110 (if (eq ps-print-emacs-type
'emacs
)
3112 ;; Emacs understands the %f format; we'll use it to limit color RGB
3113 ;; values to three decimals to cut down some on the size of the
3114 ;; PostScript output.
3117 ;; Lucid emacsen will have to make do with %s (princ) for floats.
3120 ;; These values determine how much print-height to deduct when headers
3121 ;; are turned on. This is a pretty clumsy way of handling it, but
3122 ;; it'll do for now.
3124 (defvar ps-header-pad
0
3125 "Vertical and horizontal space between the header frame and the text.
3126 This is in units of points (1/72 inch).")
3128 ;; Define accessors to the dimensions list.
3130 (defmacro ps-page-dimensions-get-width
(dims) `(nth 0 ,dims
))
3131 (defmacro ps-page-dimensions-get-height
(dims) `(nth 1 ,dims
))
3132 (defmacro ps-page-dimensions-get-media
(dims) `(nth 2 ,dims
))
3134 (defvar ps-landscape-page-height nil
)
3136 (defvar ps-print-width nil
)
3137 (defvar ps-print-height nil
)
3139 (defvar ps-height-remaining nil
)
3140 (defvar ps-width-remaining nil
)
3142 (defvar ps-font-size-internal nil
)
3143 (defvar ps-header-font-size-internal nil
)
3144 (defvar ps-header-title-font-size-internal nil
)
3147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3148 ;; Internal Variables
3151 (defvar ps-print-face-extension-alist nil
3152 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
3153 An element of this list has the following form:
3155 (FACE . [BITS FG BG])
3157 FACE is a symbol denoting a face name
3158 BITS is a bit vector, where each bit correspond
3159 to a feature (bold, underline, etc)
3160 (see documentation for `ps-print-face-map-alist')
3161 FG foreground color (string or nil)
3162 BG background color (string or nil)
3164 Don't change this list directly; instead,
3165 use `ps-extend-face' and `ps-extend-face-list'.
3166 See documentation for `ps-extend-face' for valid extension symbol.")
3169 (defvar ps-print-face-alist nil
3170 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
3172 An element of this list has the same form as an element of
3173 `ps-print-face-extension-alist'.
3175 Don't change this list directly; this list is used by `ps-face-attributes',
3176 `ps-map-face' and `ps-build-reference-face-lists'.")
3179 (defconst ps-print-face-map-alist
3188 "Alist of all features and the corresponding bit mask.
3189 Each symbol correspond to one bit in a bit vector.")
3192 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3197 (defun ps-extend-face-list (face-extension-list &optional merge-p
)
3198 "Extend face in `ps-print-face-extension-alist'.
3200 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
3201 with face extension in `ps-print-face-extension-alist'; otherwise, overrides.
3203 The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
3205 See `ps-extend-face' for documentation."
3206 (while face-extension-list
3207 (ps-extend-face (car face-extension-list
) merge-p
)
3208 (setq face-extension-list
(cdr face-extension-list
))))
3212 (defun ps-extend-face (face-extension &optional merge-p
)
3213 "Extend face in `ps-print-face-extension-alist'.
3215 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
3216 with face extensions in `ps-print-face-extension-alist'; otherwise, overrides.
3218 The elements of FACE-EXTENSION list have the form:
3220 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
3222 FACE-NAME is a face name symbol.
3224 FOREGROUND and BACKGROUND may be nil or a string that denotes the
3225 foreground and background colors respectively.
3227 EXTENSION is one of the following symbols:
3228 bold - use bold font.
3229 italic - use italic font.
3230 underline - put a line under text.
3231 strikeout - like underline, but the line is in middle of text.
3232 overline - like underline, but the line is over the text.
3233 shadow - text will have a shadow.
3234 box - text will be surrounded by a box.
3235 outline - print characters as hollow outlines.
3237 If EXTENSION is any other symbol, it is ignored."
3238 (let* ((face-name (nth 0 face-extension
))
3239 (foreground (nth 1 face-extension
))
3240 (background (nth 2 face-extension
))
3241 (ps-face (cdr (assq face-name ps-print-face-extension-alist
)))
3242 (face-vector (or ps-face
(vector 0 nil nil
)))
3243 (face-bit (ps-extension-bit face-extension
)))
3245 (aset face-vector
0 (if merge-p
3246 (logior (aref face-vector
0) face-bit
)
3248 (and foreground
(stringp foreground
) (aset face-vector
1 foreground
))
3249 (and background
(stringp background
) (aset face-vector
2 background
))
3250 ;; if face does not exist, insert it
3252 (setq ps-print-face-extension-alist
3253 (cons (cons face-name face-vector
)
3254 ps-print-face-extension-alist
)))))
3257 (defun ps-extension-bit (face-extension)
3259 ;; map valid symbol extension to bit vector
3260 (setq face-extension
(cdr (cdr face-extension
)))
3261 (while (setq face-extension
(cdr face-extension
))
3262 (setq face-bit
(logior face-bit
3263 (or (cdr (assq (car face-extension
)
3264 ps-print-face-map-alist
))
3269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3270 ;; Adapted from font-lock: (obsolete stuff)
3271 ;; Originally face attributes were specified via `font-lock-face-attributes'.
3272 ;; Users then changed the default face attributes by setting that variable.
3273 ;; However, we try and be back-compatible and respect its value if set except
3274 ;; for faces where M-x customize has been used to save changes for the face.
3277 (defun ps-font-lock-face-attributes ()
3278 (and (boundp 'font-lock-mode
) (symbol-value 'font-lock-mode
)
3279 (boundp 'font-lock-face-attributes
)
3280 (let ((face-attributes (symbol-value 'font-lock-face-attributes
)))
3281 (while face-attributes
3282 (let* ((face-attribute
3283 (car (prog1 face-attributes
3284 (setq face-attributes
(cdr face-attributes
)))))
3285 (face (car face-attribute
)))
3286 ;; Rustle up a `defface' SPEC from a
3287 ;; `font-lock-face-attributes' entry.
3288 (unless (get face
'saved-face
)
3289 (let ((foreground (nth 1 face-attribute
))
3290 (background (nth 2 face-attribute
))
3291 (bold-p (nth 3 face-attribute
))
3292 (italic-p (nth 4 face-attribute
))
3293 (underline-p (nth 5 face-attribute
))
3296 (setq face-spec
(cons ':foreground
3297 (cons foreground face-spec
))))
3299 (setq face-spec
(cons ':background
3300 (cons background face-spec
))))
3302 (setq face-spec
(append '(:bold t
) face-spec
)))
3304 (setq face-spec
(append '(:italic t
) face-spec
)))
3306 (setq face-spec
(append '(:underline t
) face-spec
)))
3307 (custom-declare-face face
(list (list t face-spec
)) nil
)
3311 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3312 ;; Internal functions and variables
3315 (defvar ps-print-hook nil
)
3316 (defvar ps-print-begin-sheet-hook nil
)
3317 (defvar ps-print-begin-page-hook nil
)
3318 (defvar ps-print-begin-column-hook nil
)
3321 (defun ps-print-without-faces (from to
&optional filename region-p
)
3322 (ps-spool-without-faces from to region-p
)
3323 (ps-do-despool filename
))
3326 (defun ps-spool-without-faces (from to
&optional region-p
)
3327 (run-hooks 'ps-print-hook
)
3328 (ps-printing-region region-p from
)
3329 (ps-generate (current-buffer) from to
'ps-generate-postscript
))
3332 (defun ps-print-with-faces (from to
&optional filename region-p
)
3333 (ps-spool-with-faces from to region-p
)
3334 (ps-do-despool filename
))
3337 (defun ps-spool-with-faces (from to
&optional region-p
)
3338 (run-hooks 'ps-print-hook
)
3339 (ps-printing-region region-p from
)
3340 (ps-generate (current-buffer) from to
'ps-generate-postscript-with-faces
))
3343 (defun ps-count-lines (from to
)
3344 (+ (count-lines from to
)
3347 (if (= (current-column) 0) 1 0))))
3350 (defvar ps-printing-region nil
3351 "Variable used to indicate if the region that ps-print is printing.
3352 It is a cons, the car of which is the line number where the region begins, and
3353 its cdr is the total number of lines in the buffer. Formatting functions can
3354 use this information to print the original line number (and not the number of
3355 lines printed), and to indicate in the header that the printout is of a partial
3359 (defvar ps-printing-region-p nil
3360 "Non-nil means ps-print is printing a region.")
3363 (defun ps-printing-region (region-p from
)
3364 (setq ps-printing-region-p region-p
3367 (ps-count-lines (point-min) from
)
3369 (ps-count-lines (point-min) (point-max)))))
3372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3373 ;; Internal functions
3376 (defsubst ps-font-alist
(font-sym)
3377 (get font-sym
'fonts
))
3379 (defun ps-font (font-sym font-type
)
3380 "Font family name for text of `font-type', when generating PostScript."
3381 (let* ((font-list (ps-font-alist font-sym
))
3382 (normal-font (cdr (assq 'normal font-list
))))
3383 (while (and font-list
(not (eq font-type
(car (car font-list
)))))
3384 (setq font-list
(cdr font-list
)))
3385 (or (cdr (car font-list
)) normal-font
)))
3387 (defun ps-fonts (font-sym)
3388 (mapcar 'cdr
(ps-font-alist font-sym
)))
3390 (defun ps-font-number (font-sym font-type
)
3391 (or (ps-alist-position font-type
(ps-font-alist font-sym
))
3394 (defsubst ps-line-height
(font-sym)
3395 "The height of a line, for generating PostScript.
3396 This is the value that ps-print uses to determine the height,
3397 y-dimension, of the lines of text it has printed, and thus affects the
3398 point at which page-breaks are placed.
3399 The line-height is *not* the same as the point size of the font."
3400 (get font-sym
'line-height
))
3402 (defsubst ps-title-line-height
(font-sym)
3403 "The height of a `title' line, for generating PostScript.
3404 This is the value that ps-print uses to determine the height,
3405 y-dimension, of the lines of text it has printed, and thus affects the
3406 point at which page-breaks are placed.
3407 The title-line-height is *not* the same as the point size of the font."
3408 (get font-sym
'title-line-height
))
3410 (defsubst ps-space-width
(font-sym)
3411 "The width of a space character, for generating PostScript.
3412 This value is used in expanding tab characters."
3413 (get font-sym
'space-width
))
3415 (defsubst ps-avg-char-width
(font-sym)
3416 "The average width, in points, of a character, for generating PostScript.
3417 This is the value that ps-print uses to determine the length,
3418 x-dimension, of the text it has printed, and thus affects the point at
3419 which long lines wrap around."
3420 (get font-sym
'avg-char-width
))
3422 (defun ps-line-lengths-internal ()
3423 "Display the correspondence between a line length and a font size,
3424 using the current ps-print setup.
3425 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3426 (let* ((ps-font-size-internal
3427 (or ps-font-size-internal
3428 (ps-get-font-size 'ps-font-size
)))
3429 (ps-header-font-size-internal
3430 (or ps-header-font-size-internal
3431 (ps-get-font-size 'ps-header-font-size
)))
3432 (ps-header-title-font-size-internal
3433 (or ps-header-title-font-size-internal
3434 (ps-get-font-size 'ps-header-title-font-size
)))
3435 (buf (get-buffer-create "*Line-lengths*"))
3436 (ifs ps-font-size-internal
) ; initial font size
3437 (icw (ps-avg-char-width 'ps-font-for-text
)) ; initial character width
3438 (print-width (progn (ps-get-page-dimensions)
3440 (ps-setup (ps-setup)) ; setup for the current buffer
3441 (fs-min 5) ; minimum font size
3442 cw-min
; minimum character width
3443 nb-cpl-max
; maximum nb of characters per line
3444 (fs-max 14) ; maximum font size
3445 cw-max
; maximum character width
3446 nb-cpl-min
; minimum nb of characters per line
3447 fs
; current font size
3448 cw
; current character width
3449 nb-cpl
; current nb of characters per line
3451 (setq cw-min
(/ (* icw fs-min
) ifs
)
3452 nb-cpl-max
(floor (/ print-width cw-min
))
3453 cw-max
(/ (* icw fs-max
) ifs
)
3454 nb-cpl-min
(floor (/ print-width cw-max
))
3457 (goto-char (point-max))
3458 (or (bobp) (insert "\n" (make-string 75 ?\
;) "\n"))
3460 "\nnb char per line / font size\n")
3461 (while (<= nb-cpl nb-cpl-max
)
3462 (setq cw
(/ print-width
(float nb-cpl
))
3463 fs
(/ (* ifs cw
) icw
))
3464 (insert (format "%16d %s\n" nb-cpl fs
))
3465 (setq nb-cpl
(1+ nb-cpl
)))
3467 (display-buffer buf
'not-this-window
)))
3469 (defun ps-nb-pages (nb-lines)
3470 "Display correspondence between font size and the number of pages.
3471 The correspondence is based on having NB-LINES lines of text,
3472 and on the current ps-print setup."
3473 (let* ((ps-font-size-internal
3474 (or ps-font-size-internal
3475 (ps-get-font-size 'ps-font-size
)))
3476 (ps-header-font-size-internal
3477 (or ps-header-font-size-internal
3478 (ps-get-font-size 'ps-header-font-size
)))
3479 (ps-header-title-font-size-internal
3480 (or ps-header-title-font-size-internal
3481 (ps-get-font-size 'ps-header-title-font-size
)))
3482 (buf (get-buffer-create "*Nb-Pages*"))
3483 (ifs ps-font-size-internal
) ; initial font size
3484 (ilh (ps-line-height 'ps-font-for-text
)) ; initial line height
3485 (page-height (progn (ps-get-page-dimensions)
3487 (ps-setup (ps-setup)) ; setup for the current buffer
3488 (fs-min 4) ; minimum font size
3489 lh-min
; minimum line height
3490 nb-lpp-max
; maximum nb of lines per page
3491 nb-page-min
; minimum nb of pages
3492 (fs-max 14) ; maximum font size
3493 lh-max
; maximum line height
3494 nb-lpp-min
; minimum nb of lines per page
3495 nb-page-max
; maximum nb of pages
3496 fs
; current font size
3497 lh
; current line height
3498 nb-lpp
; current nb of lines per page
3499 nb-page
; current nb of pages
3501 (setq lh-min
(/ (* ilh fs-min
) ifs
)
3502 nb-lpp-max
(floor (/ page-height lh-min
))
3503 nb-page-min
(ceiling (/ (float nb-lines
) nb-lpp-max
))
3504 lh-max
(/ (* ilh fs-max
) ifs
)
3505 nb-lpp-min
(floor (/ page-height lh-max
))
3506 nb-page-max
(ceiling (/ (float nb-lines
) nb-lpp-min
))
3507 nb-page nb-page-min
)
3509 (goto-char (point-max))
3510 (or (bobp) (insert "\n" (make-string 75 ?\
;) "\n"))
3512 (format "\nThere are %d lines.\n\n" nb-lines
)
3513 "nb page / font size\n")
3514 (while (<= nb-page nb-page-max
)
3515 (setq nb-lpp
(ceiling (/ nb-lines
(float nb-page
)))
3516 lh
(/ page-height nb-lpp
)
3517 fs
(/ (* ifs lh
) ilh
))
3518 (insert (format "%7d %s\n" nb-page fs
))
3519 (setq nb-page
(1+ nb-page
)))
3521 (display-buffer buf
'not-this-window
)))
3523 ;; macros used in `ps-select-font'
3524 (defmacro ps-lookup
(key) `(cdr (assq ,key font-entry
)))
3525 (defmacro ps-size-scale
(key) `(/ (* (ps-lookup ,key
) font-size
) size
))
3527 (defun ps-select-font (font-family sym font-size title-font-size
)
3528 (let ((font-entry (cdr (assq font-family ps-font-info-database
))))
3530 (error "Don't have data to scale font %s. Known fonts families are %s"
3532 (mapcar 'car ps-font-info-database
)))
3533 (let ((size (ps-lookup 'size
)))
3534 (put sym
'fonts
(ps-lookup 'fonts
))
3535 (put sym
'space-width
(ps-size-scale 'space-width
))
3536 (put sym
'avg-char-width
(ps-size-scale 'avg-char-width
))
3537 (put sym
'line-height
(ps-size-scale 'line-height
))
3538 (put sym
'title-line-height
3539 (/ (* (ps-lookup 'line-height
) title-font-size
) size
)))))
3541 (defun ps-get-page-dimensions ()
3542 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database
)))
3543 page-width page-height
)
3545 ((null page-dimensions
)
3546 (error "`ps-paper-type' must be one of:\n%s"
3547 (mapcar 'car ps-page-dimensions-database
)))
3548 ((< ps-number-of-columns
1)
3549 (error "The number of columns %d should be positive"
3550 ps-number-of-columns
)))
3552 (ps-select-font ps-font-family
'ps-font-for-text
3553 ps-font-size-internal ps-font-size-internal
)
3554 (ps-select-font ps-header-font-family
'ps-font-for-header
3555 ps-header-font-size-internal
3556 ps-header-title-font-size-internal
)
3558 (setq page-width
(ps-page-dimensions-get-width page-dimensions
)
3559 page-height
(ps-page-dimensions-get-height page-dimensions
))
3562 (if ps-landscape-mode
3563 ;; exchange width and height
3564 (setq page-width
(prog1 page-height
(setq page-height page-width
))))
3566 ;; It is used to get the lower right corner (only in landscape mode)
3567 (setq ps-landscape-page-height page-height
)
3569 ;; | lm | text | ic | text | ic | text | rm |
3570 ;; page-width == lm + n * pw + (n - 1) * ic + rm
3571 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
3572 (setq ps-print-width
(/ (- page-width
3573 ps-left-margin ps-right-margin
3574 (* (1- ps-number-of-columns
) ps-inter-column
))
3575 ps-number-of-columns
))
3576 (if (<= ps-print-width
0)
3577 (error "Bad horizontal layout:
3579 ps-left-margin == %s
3580 ps-right-margin == %s
3581 ps-inter-column == %s
3582 ps-number-of-columns == %s
3583 | lm | text | ic | text | ic | text | rm |
3584 page-width == lm + n * print-width + (n - 1) * ic + rm
3585 => print-width == %d !"
3590 ps-number-of-columns
3593 (setq ps-print-height
3594 (- page-height ps-bottom-margin ps-top-margin
))
3595 (if (<= ps-print-height
0)
3596 (error "Bad vertical layout:
3598 ps-bottom-margin == %s
3599 page-height == bm + print-height + tm
3600 => print-height == %d !"
3604 ;; If headers are turned on, deduct the height of the header from
3605 ;; the print height.
3607 (setq ps-header-pad
(* ps-header-line-pad
3608 (ps-title-line-height 'ps-font-for-header
))
3609 ps-print-height
(- ps-print-height
3612 (ps-title-line-height 'ps-font-for-header
)
3613 (* (ps-line-height 'ps-font-for-header
)
3614 (1- ps-header-lines
))
3616 (if (<= ps-print-height
0)
3617 (error "Bad vertical layout:
3619 ps-bottom-margin == %s
3620 ps-header-offset == %s
3623 page-height == bm + print-height + tm - ho - hh
3624 => print-height == %d !"
3630 (ps-title-line-height 'ps-font-for-header
)
3631 (* (ps-line-height 'ps-font-for-header
)
3632 (1- ps-header-lines
))
3636 (defun ps-print-preprint (prefix-arg)
3638 (or (numberp prefix-arg
)
3640 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
3643 (prompt (format "Save PostScript to file: (default %s) " name
))
3644 (res (read-file-name prompt default-directory name nil
)))
3645 (while (cond ((file-directory-p res
)
3647 (setq prompt
"It's a directory"))
3648 ((not (file-writable-p res
))
3650 (setq prompt
"File is unwritable"))
3651 ((file-exists-p res
)
3652 (setq prompt
"File exists")
3653 (not (y-or-n-p (format "File `%s' exists; overwrite? "
3656 (setq res
(read-file-name
3657 (format "%s; save PostScript to file: " prompt
)
3658 (file-name-directory res
) nil nil
3659 (file-name-nondirectory res
))))
3660 (if (file-directory-p res
)
3661 (expand-file-name name
(file-name-as-directory res
))
3664 ;; The following functions implement a simple list-buffering scheme so
3665 ;; that ps-print doesn't have to repeatedly switch between buffers
3666 ;; while spooling. The functions `ps-output' and `ps-output-string' build
3667 ;; up the lists; the function `ps-flush-output' takes the lists and
3668 ;; insert its contents into the spool buffer (*PostScript*).
3670 (defvar ps-string-escape-codes
3671 (let ((table (make-vector 256 nil
))
3673 ;; control characters
3674 (while (<= char ?
\037)
3675 (aset table char
(format "\\%03o" char
))
3676 (setq char
(1+ char
)))
3677 ;; printable characters
3678 (while (< char ?
\177)
3679 (aset table char
(format "%c" char
))
3680 (setq char
(1+ char
)))
3681 ;; DEL and 8-bit characters
3682 (while (<= char ?
\377)
3683 (aset table char
(format "\\%o" char
))
3684 (setq char
(1+ char
)))
3685 ;; Override ASCII formatting characters with named escape code:
3686 (aset table ?
\n "\\n") ; [NL] linefeed
3687 (aset table ?
\r "\\r") ; [CR] carriage return
3688 (aset table ?
\t "\\t") ; [HT] horizontal tab
3689 (aset table ?
\b "\\b") ; [BS] backspace
3690 (aset table ?
\f "\\f") ; [NP] form feed
3691 ;; Escape PostScript escape and string delimiter characters:
3692 (aset table ?
\\ "\\\\")
3693 (aset table ?\
( "\\(")
3694 (aset table ?\
) "\\)")
3696 "Vector used to map characters to PostScript string escape codes.")
3698 (defun ps-output-string-prim (string)
3699 (insert "(") ;insert start-string delimiter
3700 (save-excursion ;insert string
3701 (insert (string-as-unibyte string
)))
3702 ;; Find and quote special characters as necessary for PS
3703 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
3704 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
3705 (let ((special (following-char)))
3707 (insert (aref ps-string-escape-codes special
))))
3708 (goto-char (point-max))
3709 (insert ")")) ;insert end-string delimiter
3711 (defun ps-init-output-queue ()
3712 (setq ps-output-head
(list "")
3713 ps-output-tail ps-output-head
))
3716 (defun ps-selected-pages ()
3718 (setq ps-first-page
(car (car ps-selected-pages
))
3719 ps-last-page
(cdr (car ps-selected-pages
))
3720 ps-selected-pages
(cdr ps-selected-pages
))
3721 (and ps-selected-pages
3722 (< ps-last-page ps-page-postscript
)))))
3725 (defun ps-print-page-p ()
3726 (setq ps-print-page-p
3727 (and (cond ((null ps-first-page
))
3728 ((<= ps-page-postscript ps-last-page
)
3729 (<= ps-first-page ps-page-postscript
))
3732 (and (<= ps-first-page ps-page-postscript
)
3733 (<= ps-page-postscript ps-last-page
)))
3736 (cond ((eq ps-even-or-odd-pages
'even
)
3737 (= (logand ps-page-postscript
1) 0))
3738 ((eq ps-even-or-odd-pages
'odd
)
3739 (= (logand ps-page-postscript
1) 1))
3744 (defun ps-output (&rest args
)
3745 (when ps-print-page-p
3746 (setcdr ps-output-tail args
)
3747 (while (cdr ps-output-tail
)
3748 (setq ps-output-tail
(cdr ps-output-tail
)))))
3750 (defun ps-output-string (string)
3751 (ps-output t string
))
3753 (defun ps-output-list (the-list)
3754 (mapcar 'ps-output the-list
))
3756 ;; Output strings in the list ARGS in the PostScript prologue part.
3757 (defun ps-output-prologue (args)
3758 (ps-output 'prologue
(if (stringp args
) (list args
) args
)))
3760 (defun ps-flush-output ()
3762 (set-buffer ps-spool-buffer
)
3763 (goto-char (point-max))
3764 (while ps-output-head
3765 (let ((it (car ps-output-head
)))
3768 (setq ps-output-head
(cdr ps-output-head
))
3769 (ps-output-string-prim (car ps-output-head
)))
3771 (setq ps-output-head
(cdr ps-output-head
))
3773 (search-backward "\nBeginDoc")
3775 (apply 'insert
(car ps-output-head
))))
3778 (setq ps-output-head
(cdr ps-output-head
))))
3779 (ps-init-output-queue))
3781 (defun ps-insert-file (fname)
3784 (set-buffer ps-spool-buffer
)
3785 (goto-char (point-max))
3786 (insert-file fname
)))
3788 ;; These functions insert the arrays that define the contents of the
3791 (defun ps-generate-header-line (fonttag &optional content
)
3792 (ps-output " [ " fonttag
" ")
3794 ;; Literal strings should be output as is -- the string must
3795 ;; contain its own PS string delimiters, '(' and ')', if necessary.
3797 (ps-output content
))
3799 ;; Functions are called -- they should return strings; they will be
3800 ;; inserted as strings and the PS string delimiters added.
3801 ((and (symbolp content
) (fboundp content
))
3802 (ps-output-string (funcall content
)))
3804 ;; Variables will have their contents inserted. They should
3805 ;; contain strings, and will be inserted as strings.
3806 ((and (symbolp content
) (boundp content
))
3807 (ps-output-string (symbol-value content
)))
3809 ;; Anything else will get turned into an empty string.
3811 (ps-output-string "")))
3814 (defun ps-generate-header (name contents
)
3815 (ps-output "/" name
" [\n")
3816 (if (> ps-header-lines
0)
3818 (ps-generate-header-line "/h0" (car contents
))
3819 (while (and (< count ps-header-lines
)
3820 (setq contents
(cdr contents
)))
3821 (ps-generate-header-line "/h1" (car contents
))
3822 (setq count
(1+ count
)))
3823 (ps-output "] def\n"))))
3826 (defun ps-output-boolean (name bool
)
3827 (ps-output (format "/%s %s def\n" name
(if bool
"true" "false"))))
3830 (defun ps-background-pages (page-list func
)
3834 (let ((start (if (consp pages
) (car pages
) pages
))
3835 (end (if (consp pages
) (cdr pages
) pages
)))
3836 (and (integerp start
) (integerp end
) (<= start end
)
3837 (add-to-list 'ps-background-pages
(vector start end func
)))))
3839 (setq ps-background-all-pages
(cons func ps-background-all-pages
))))
3842 (defconst ps-boundingbox-re
3844 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
3847 (defun ps-get-boundingbox ()
3849 (set-buffer ps-spool-buffer
)
3851 (if (re-search-forward ps-boundingbox-re nil t
)
3852 (vector (string-to-number ; lower x
3853 (buffer-substring (match-beginning 1) (match-end 1)))
3854 (string-to-number ; lower y
3855 (buffer-substring (match-beginning 2) (match-end 2)))
3856 (string-to-number ; upper x
3857 (buffer-substring (match-beginning 3) (match-end 3)))
3858 (string-to-number ; upper y
3859 (buffer-substring (match-beginning 4) (match-end 4))))
3860 (vector 0 0 0 0)))))
3863 ;; Emacs understands the %f format; we'll use it to limit color RGB values
3864 ;; to three decimals to cut down some on the size of the PostScript output.
3865 ;; Lucid emacsen will have to make do with %s (princ) for floats.
3867 (defvar ps-float-format
(if (eq ps-print-emacs-type
'emacs
)
3869 "%s ")) ; Lucid emacsen
3872 (defun ps-float-format (value &optional default
)
3873 (let ((literal (or value default
)))
3875 (format (if (numberp literal
)
3882 (defun ps-background-text ()
3885 (setq ps-background-text-count
(1+ ps-background-text-count
))
3886 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count
))
3887 (ps-output-string (nth 0 text
)) ; text
3890 (ps-float-format (nth 4 text
) 200.0) ; font size
3891 (format "/%s " (or (nth 3 text
) "Times-Roman")) ; font name
3892 (ps-float-format (nth 6 text
)
3893 "PrintHeight PrintPageWidth atan") ; rotation
3894 (ps-float-format (nth 5 text
) 0.85) ; gray
3895 (ps-float-format (nth 1 text
) "0") ; x position
3896 (ps-float-format (nth 2 text
) "0") ; y position
3897 "\nShowBackText}def\n")
3898 (ps-background-pages (nthcdr 7 text
) ; page list
3899 (format "ShowBackText-%d\n"
3900 ps-background-text-count
)))
3901 ps-print-background-text
))
3904 (defun ps-background-image ()
3907 (let ((image-file (expand-file-name (nth 0 image
))))
3908 (when (file-readable-p image-file
)
3909 (setq ps-background-image-count
(1+ ps-background-image-count
))
3911 (format "/ShowBackImage-%d{\n--back-- "
3912 ps-background-image-count
)
3913 (ps-float-format (nth 5 image
) 0.0) ; rotation
3914 (ps-float-format (nth 3 image
) 1.0) ; x scale
3915 (ps-float-format (nth 4 image
) 1.0) ; y scale
3916 (ps-float-format (nth 1 image
) ; x position
3917 "PrintPageWidth 2 div")
3918 (ps-float-format (nth 2 image
) ; y position
3919 "PrintHeight 2 div BottomMargin add")
3920 "\nBeginBackImage\n")
3921 (ps-insert-file image-file
)
3922 ;; coordinate adjustment to centralize image
3923 ;; around x and y position
3924 (let ((box (ps-get-boundingbox)))
3926 (set-buffer ps-spool-buffer
)
3928 (if (re-search-backward "^--back--" nil t
)
3932 (- (+ (/ (- (aref box
2) (aref box
0)) 2.0)
3935 (- (+ (/ (- (aref box
3) (aref box
1)) 2.0)
3938 (ps-output "\nEndBackImage}def\n")
3939 (ps-background-pages (nthcdr 6 image
) ; page list
3940 (format "ShowBackImage-%d\n"
3941 ps-background-image-count
)))))
3942 ps-print-background-image
))
3945 (defun ps-background (page-number)
3946 (let (has-local-background)
3947 (mapcar #'(lambda (range)
3948 (and (<= (aref range
0) page-number
)
3949 (<= page-number
(aref range
1))
3950 (if has-local-background
3951 (ps-output (aref range
2))
3952 (setq has-local-background t
)
3953 (ps-output "/printLocalBackground{\n"
3955 ps-background-pages
)
3956 (and has-local-background
(ps-output "}def\n"))))
3959 ;; Return a list of the distinct elements of LIST.
3960 ;; Elements are compared with `equal'.
3961 (defun ps-remove-duplicates (list)
3962 (let (new (tail list
))
3964 (or (member (car tail
) new
)
3965 (setq new
(cons (car tail
) new
)))
3966 (setq tail
(cdr tail
)))
3970 ;; Find the first occurrence of ITEM in LIST.
3971 ;; Return the index of the matching item, or nil if not found.
3972 ;; Elements are compared with `eq'.
3973 (defun ps-alist-position (item list
)
3974 (let ((tail list
) (index 0) found
)
3976 (if (setq found
(eq (car (car tail
)) item
))
3978 (setq index
(1+ index
)
3983 (defconst ps-n-up-database
4034 (2 t
1 2 0) ; adjusted by PostScript code
4077 (2 t
1 2 0) ; adjusted by PostScript code
4122 ;; Ledger paper size is a special case, it is the only paper size where the
4123 ;; normal size is landscaped, that is, the height is smaller than width.
4124 ;; So, we use the special value `pag' in the `landscape' field.
4173 (2 t
1 2 0) ; adjusted by PostScript code
4269 "Alist which is the page matrix database used for N-up printing.
4271 Each element has the following form:
4274 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
4278 PAGE is the page size used (see `ps-paper-type').
4279 MAX is the maximum elements of this page matrix.
4280 LANDSCAPE specifies if page matrix is landscaped, has the following valid
4282 nil the sheet is in portrait mode.
4283 t the sheet is in landscape mode.
4284 pag the sheet is in portrait mode and page is in landscape mode.
4285 LINES is the number of lines of page matrix.
4286 COLUMNS is the number of columns of page matrix.
4287 COL-MISSING is the number of columns missing to fill the sheet.")
4290 (defmacro ps-n-up-landscape
(mat) `(nth 1 ,mat
))
4291 (defmacro ps-n-up-lines
(mat) `(nth 2 ,mat
))
4292 (defmacro ps-n-up-columns
(mat) `(nth 3 ,mat
))
4293 (defmacro ps-n-up-missing
(mat) `(nth 4 ,mat
))
4296 (defun ps-n-up-printing ()
4297 ;; force `ps-n-up-printing' be in range 1 to 100.
4298 (setq ps-n-up-printing
(max (min ps-n-up-printing
100) 1))
4299 ;; find suitable page matrix for a given `ps-paper-type'.
4300 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database
))))
4302 (while (> ps-n-up-printing
(caar the-list
))
4303 (setq the-list
(cdr the-list
))))
4307 (defconst ps-n-up-filling-database
4309 "PageWidth" ; N-Up-XColumn
4311 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
4312 "LandscapePageHeight neg" ; N-Up-YLine
4313 "N-Up-Lines" ; N-Up-Repeat
4314 "N-Up-Columns" ; N-Up-End
4318 "PageWidth" ; N-Up-XColumn
4320 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
4321 "LandscapePageHeight" ; N-Up-YLine
4322 "N-Up-Lines" ; N-Up-Repeat
4323 "N-Up-Columns" ; N-Up-End
4325 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
4327 "PageWidth neg" ; N-Up-XColumn
4329 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
4330 "LandscapePageHeight neg" ; N-Up-YLine
4331 "N-Up-Lines" ; N-Up-Repeat
4332 "N-Up-Columns" ; N-Up-End
4333 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
4336 "PageWidth neg" ; N-Up-XColumn
4338 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
4339 "LandscapePageHeight" ; N-Up-YLine
4340 "N-Up-Lines" ; N-Up-Repeat
4341 "N-Up-Columns" ; N-Up-End
4342 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
4343 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
4346 "LandscapePageHeight neg" ; N-Up-YColumn
4347 "PageWidth" ; N-Up-XLine
4348 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
4349 "N-Up-Columns" ; N-Up-Repeat
4350 "N-Up-Lines" ; N-Up-End
4355 "LandscapePageHeight" ; N-Up-YColumn
4356 "PageWidth" ; N-Up-XLine
4357 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
4358 "N-Up-Columns" ; N-Up-Repeat
4359 "N-Up-Lines" ; N-Up-End
4361 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
4364 "LandscapePageHeight neg" ; N-Up-YColumn
4365 "PageWidth neg" ; N-Up-XLine
4366 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
4367 "N-Up-Columns" ; N-Up-Repeat
4368 "N-Up-Lines" ; N-Up-End
4369 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
4373 "LandscapePageHeight" ; N-Up-YColumn
4374 "PageWidth neg" ; N-Up-XLine
4375 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
4376 "N-Up-Columns" ; N-Up-Repeat
4377 "N-Up-Lines" ; N-Up-End
4378 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
4379 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
4380 "Alist for n-up printing initializations.
4382 Each element has the following form:
4384 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
4387 KIND is a valid value of `ps-n-up-filling'.
4388 XCOL YCOL are the relative position for the next column.
4389 XLIN YLIN are the relative position for the beginning of next line.
4390 REPEAT is the number of repetions for external loop.
4391 END is the number of repetions for internal loop and also the number of pages in
4393 XSTART YSTART are the relative position for the first page in a sheet.")
4396 (defun ps-n-up-filling ()
4397 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database
)
4398 (assq 'left-top ps-n-up-filling-database
))))
4401 (defmacro ps-n-up-xcolumn
(init) `(nth 0 ,init
))
4402 (defmacro ps-n-up-ycolumn
(init) `(nth 1 ,init
))
4403 (defmacro ps-n-up-xline
(init) `(nth 2 ,init
))
4404 (defmacro ps-n-up-yline
(init) `(nth 3 ,init
))
4405 (defmacro ps-n-up-repeat
(init) `(nth 4 ,init
))
4406 (defmacro ps-n-up-end
(init) `(nth 5 ,init
))
4407 (defmacro ps-n-up-xstart
(init) `(nth 6 ,init
))
4408 (defmacro ps-n-up-ystart
(init) `(nth 7 ,init
))
4411 (defconst ps-error-handler-alist
4415 (paper-and-system .
3))
4416 "Alist for error handler message")
4419 (defun ps-begin-file ()
4420 (ps-get-page-dimensions)
4421 (setq ps-page-postscript
0
4425 ps-background-text-count
0
4426 ps-background-image-count
0
4427 ps-background-pages nil
4428 ps-background-all-pages nil
)
4430 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database
)))
4431 (tumble (if ps-landscape-mode
(not ps-spool-tumble
) ps-spool-tumble
))
4432 (n-up (ps-n-up-printing))
4433 (n-up-filling (ps-n-up-filling)))
4434 (and ps-n-up-on
(setq tumble
(not tumble
)))
4437 "%%Title: " (buffer-name) ; Take job name from name of
4438 ; first buffer printed
4439 "\n%%Creator: " (user-full-name)
4440 " (using ps-print v" ps-print-version
4441 ")\n%%CreationDate: "
4442 (time-stamp-hh:mm
:ss
) " " (time-stamp-mon-dd-yyyy)
4444 (if ps-landscape-mode
"Landscape" "Portrait")
4445 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
4446 (mapconcat 'identity
4447 (ps-remove-duplicates
4448 (append (ps-fonts 'ps-font-for-text
)
4449 (list (ps-font 'ps-font-for-header
'normal
)
4450 (ps-font 'ps-font-for-header
'bold
))))
4452 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions
)
4453 (format " %d" (round (ps-page-dimensions-get-width dimensions
)))
4454 (format " %d" (round (ps-page-dimensions-get-height dimensions
)))
4455 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
4457 (if tumble
" duplex(tumble)\n" " duplex\n")
4460 (ps-insert-string ps-print-prologue-header
)
4462 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
4463 (ps-page-dimensions-get-media dimensions
)
4464 "\n%%EndDefaults\n\n%%BeginPrologue\n\n"
4465 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
4466 (format "/ErrorMessage %s def\n\n"
4467 (or (cdr (assoc ps-error-handler-message
4468 ps-error-handler-alist
))
4471 "\n%%BeginProcSet: UserDefinedPrologue\n\n")
4473 (ps-insert-string ps-user-defined-prologue
)
4475 (ps-output "\n%%EndProcSet\n\n")
4477 (ps-output-boolean "LandscapeMode "
4478 (or ps-landscape-mode
4479 (eq (ps-n-up-landscape n-up
) 'pag
)))
4480 (ps-output-boolean "UpsideDown " ps-print-upside-down
)
4481 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns
)
4483 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height
)
4484 (format "/PrintPageWidth %s def\n"
4485 (- (* (+ ps-print-width ps-inter-column
)
4486 ps-number-of-columns
)
4488 (format "/PrintWidth %s def\n" ps-print-width
)
4489 (format "/PrintHeight %s def\n" ps-print-height
)
4491 (format "/LeftMargin %s def\n" ps-left-margin
)
4492 (format "/RightMargin %s def\n" ps-right-margin
)
4493 (format "/InterColumn %s def\n" ps-inter-column
)
4495 (format "/BottomMargin %s def\n" ps-bottom-margin
)
4496 (format "/TopMargin %s def\n" ps-top-margin
) ; not used
4497 (format "/HeaderOffset %s def\n" ps-header-offset
)
4498 (format "/HeaderPad %s def\n" ps-header-pad
))
4500 (ps-output-boolean "PrintHeader " ps-print-header
)
4501 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header
)
4502 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame
)
4503 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header
'duplex
)
4506 (ps-output-boolean "ShowNofN " ps-show-n-of-n
)
4508 (let ((line-height (ps-line-height 'ps-font-for-text
)))
4509 (ps-output (format "/LineHeight %s def\n" line-height
)
4510 (format "/LinesPerColumn %d def\n"
4511 (round (/ (+ ps-print-height
4512 (* line-height
0.45))
4515 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type
)
4516 (ps-output-boolean "Zebra " ps-zebra-stripes
)
4517 (ps-output-boolean "ZebraFollow " ps-zebra-stripe-follow
)
4518 (ps-output-boolean "PrintLineNumber " ps-line-number
)
4519 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step
)))
4520 (ps-output (format "/PrintLineStep %d def\n"
4521 (if (integerp ps-line-number-step
)
4523 ps-zebra-stripe-height
))
4524 (format "/PrintLineStart %d def\n" ps-line-number-start
)
4525 (format "/ZebraHeight %d def\n" ps-zebra-stripe-height
)
4527 (ps-format-color ps-zebra-color
0.95)
4528 "def\n/BackgroundColor "
4529 (ps-format-color ps-default-bg
1.0)
4530 "def\n/UseSetpagedevice "
4531 (if (eq ps-spool-config
'setpagedevice
)
4532 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
4534 " def\n\n/PageWidth "
4535 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
4536 (format "/N-Up %d def\n" ps-n-up-printing
))
4537 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up
) t
))
4538 (ps-output-boolean "N-Up-Border " ps-n-up-border-p
)
4539 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up
))
4540 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up
))
4541 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up
))
4542 (format "/N-Up-Margin %s def\n" ps-n-up-margin
)
4544 (if ps-landscape-mode
4545 (ps-n-up-end n-up-filling
)
4546 (ps-n-up-repeat n-up-filling
))
4548 (if ps-landscape-mode
4549 (ps-n-up-repeat n-up-filling
)
4550 (ps-n-up-end n-up-filling
))
4551 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling
)
4552 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling
)
4553 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling
)
4554 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling
)
4555 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling
)
4556 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling
) " def\n")
4558 (ps-background-text)
4559 (ps-background-image)
4560 (setq ps-background-all-pages
(nreverse ps-background-all-pages
)
4561 ps-background-pages
(nreverse ps-background-pages
))
4563 (ps-output "\n" ps-print-prologue-1
)
4565 (ps-output "\n/printGlobalBackground{\n")
4566 (ps-output-list ps-background-all-pages
)
4567 (ps-output "}def\n/printLocalBackground{\n}def\n")
4570 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14 /Helvetica-Bold DefFont
4571 ps-header-title-font-size-internal
4572 (ps-font 'ps-font-for-header
'bold
))
4573 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12 /Helvetica DefFont
4574 ps-header-font-size-internal
4575 (ps-font 'ps-font-for-header
'normal
)))
4577 (ps-output "\n" ps-print-prologue-2
"\n")
4580 (let ((font (ps-font-alist 'ps-font-for-text
))
4583 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
4585 ps-font-size-internal
4586 (ps-font 'ps-font-for-text
(car (car font
)))))
4587 (setq font
(cdr font
)
4590 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database
))))
4591 (ps-output (format "/SpaceWidthRatio %f def\n"
4592 (/ (ps-lookup 'space-width
) (ps-lookup 'size
)))))
4594 (ps-output "\n%%EndPrologue\n\n%%BeginSetup\n")
4595 (unless (eq ps-spool-config
'lpr-switches
)
4596 (ps-output "\n%%BeginFeature: *Duplex "
4597 (ps-boolean-capitalized ps-spool-duplex
)
4599 (ps-boolean-capitalized tumble
)
4600 "\nUseSetpagedevice\n{BMark/Duplex "
4601 (ps-boolean-constant ps-spool-duplex
)
4603 (ps-boolean-constant tumble
)
4604 " EMark setpagedevice}\n{statusdict begin "
4605 (ps-boolean-constant ps-spool-duplex
)
4607 (ps-boolean-constant tumble
)
4608 " settumble end}ifelse\n%%EndFeature\n")))
4609 (ps-output "\n%%BeginFeature: *ManualFeed "
4610 (ps-boolean-capitalized ps-manual-feed
)
4611 "\nBMark /ManualFeed "
4612 (ps-boolean-constant ps-manual-feed
)
4613 " EMark setpagedevice\n%%EndFeature\n"
4614 "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n")
4615 (and ps-banner-page-when-duplexing
4616 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
4619 (defun ps-format-color (color &optional default
)
4620 (let ((the-color (if (stringp color
)
4621 (ps-color-scale color
)
4623 (if (and the-color
(listp the-color
))
4625 (format ps-color-format
4630 (ps-float-format (if (numberp the-color
) the-color default
)))))
4633 (defun ps-insert-string (prologue)
4634 (let ((str (if (functionp prologue
)
4641 (defun ps-boolean-capitalized (bool)
4642 (if bool
"True" "False"))
4645 (defun ps-boolean-constant (bool)
4646 (if bool
"true" "false"))
4649 (defun ps-header-dirpart ()
4650 (let ((fname (buffer-file-name)))
4652 (if (string-equal (buffer-name) (file-name-nondirectory fname
))
4653 (abbreviate-file-name (file-name-directory fname
))
4658 (defun ps-get-buffer-name ()
4660 ;; Indulge Jim this little easter egg:
4661 ((string= (buffer-name) "ps-print.el")
4662 "Hey, Cool! It's ps-print.el!!!")
4663 ;; Indulge Jack this other little easter egg:
4664 ((string= (buffer-name) "sokoban.el")
4665 "Super! C'est sokoban.el!")
4667 (and ps-printing-region-p
"Subset of: ")
4669 (and (buffer-modified-p) " (unsaved)")))))
4672 (defun ps-get-font-size (font-sym)
4673 (let ((font-size (symbol-value font-sym
)))
4674 (cond ((numberp font-size
)
4676 ((and (consp font-size
)
4677 (numberp (car font-size
))
4678 (numberp (cdr font-size
)))
4679 (if ps-landscape-mode
4683 (error "Invalid font size `%S' for `%S'" font-size font-sym
)))))
4686 (defun ps-begin-job ()
4688 (let ((last-char (aref ps-postscript-code-directory
4689 (1- (length ps-postscript-code-directory
)))))
4690 (or (eq last-char ?
/)
4691 (and ps-windows-system
(eq last-char ?
\\))
4692 (setq ps-postscript-code-directory
4693 (concat ps-postscript-code-directory
"/"))))
4694 (or (equal ps-mark-code-directory ps-postscript-code-directory
)
4695 (setq ps-print-prologue-0
(ps-prologue-file 0)
4696 ps-print-prologue-1
(ps-prologue-file 1)
4697 ps-print-prologue-2
(ps-prologue-file 2)
4698 ps-mark-code-directory ps-postscript-code-directory
))
4701 (while ps-selected-pages
4702 (setq page
(car ps-selected-pages
)
4703 ps-selected-pages
(cdr ps-selected-pages
))
4704 (cond ((integerp page
)
4706 (setq new
(cons (cons page page
) new
))))
4708 (and (integerp (car page
)) (integerp (cdr page
))
4710 (<= (car page
) (cdr page
))
4711 (setq new
(cons page new
))))))
4712 (setq ps-selected-pages
(sort new
#'(lambda (one other
)
4713 (< (car one
) (car other
))))
4714 ps-last-selected-pages ps-selected-pages
4718 (or (listp ps-use-face-background
)
4719 (setq ps-use-face-background t
))
4721 (and (integerp ps-line-number-step
)
4722 (<= ps-line-number-step
0)
4723 (setq ps-line-number-step
1))
4724 (setq ps-n-up-on
(> ps-n-up-printing
1)
4725 ps-line-number-start
(max 1 (min ps-line-number-start
4726 (if (integerp ps-line-number-step
)
4728 ps-zebra-stripe-height
))))
4731 (set-buffer ps-spool-buffer
)
4732 (goto-char (point-max))
4733 (and (re-search-backward "^%%Trailer$" nil t
)
4734 (delete-region (match-beginning 0) (point-max))))
4736 (setq ps-showline-count
(car ps-printing-region
)
4738 ps-font-size-internal
(ps-get-font-size 'ps-font-size
)
4739 ps-header-font-size-internal
(ps-get-font-size 'ps-header-font-size
)
4740 ps-header-title-font-size-internal
4741 (ps-get-font-size 'ps-header-title-font-size
)
4742 ps-control-or-escape-regexp
4743 (cond ((eq ps-print-control-characters
'8-bit
)
4744 (string-as-unibyte "[\000-\037\177-\377]"))
4745 ((eq ps-print-control-characters
'control-8-bit
)
4746 (string-as-unibyte "[\000-\037\177-\237]"))
4747 ((eq ps-print-control-characters
'control
)
4750 ps-default-foreground
(ps-rgb-color ps-default-fg
0.0)
4751 ps-default-color
(and ps-print-color-p ps-default-foreground
)
4752 ps-current-color ps-default-color
4753 ;; Set the color scale. We do it here instead of in the defvar so
4754 ;; that ps-print can be dumped into emacs. This expression can't be
4755 ;; evaluated at dump-time because X isn't initialized.
4756 ps-color-p
(and ps-print-color-p
(ps-color-device))
4757 ps-print-color-scale
(if ps-color-p
4758 (float (car (ps-color-values "white")))
4762 (defun ps-rgb-color (color default
)
4763 (cond ((and color
(listp color
)) color
)
4764 ((stringp color
) (ps-color-scale color
))
4765 ((numberp color
) (list color color color
))
4766 (t (list default default default
))
4770 (defun ps-page-number ()
4771 (if ps-print-only-one-header
4772 (1+ (/ (1- ps-page-count
) ps-number-of-columns
))
4776 (defun ps-next-page ()
4782 (defun ps-header-sheet ()
4783 ;; Print only when a new sheet begins.
4784 (setq ps-page-order
(1+ ps-page-order
))
4785 (and (> ps-page-order
1)
4786 (ps-output "EndSheet\n"))
4787 (ps-output (if ps-n-up-on
4788 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
4789 ps-page-order ps-page-postscript ps-page-order
)
4790 (format "\n%%%%Page: %d %d\n"
4791 ps-page-postscript ps-page-order
))
4792 (format "%d BeginSheet\nBeginDSCPage\n"
4796 (defun ps-header-page ()
4797 ;; set total line and page number when printing has finished
4798 ;; (see `ps-generate')
4799 (if (zerop (mod ps-page-count ps-number-of-columns
))
4801 (setq ps-page-postscript
(1+ ps-page-postscript
))
4802 (when (ps-print-page-p)
4803 (if (zerop (mod ps-page-n-up ps-n-up-printing
))
4804 ;; Print only when a new sheet begins.
4807 (run-hooks 'ps-print-begin-sheet-hook
))
4808 ;; Print only when a new page begins.
4809 (ps-output "BeginDSCPage\n")
4810 (run-hooks 'ps-print-begin-page-hook
))
4811 (ps-background ps-page-postscript
)
4812 (setq ps-page-n-up
(1+ ps-page-n-up
))))
4813 ;; Print only when a new column begins.
4814 (ps-output "BeginDSCPage\n")
4815 (run-hooks 'ps-print-begin-column-hook
))
4816 (setq ps-page-count
(1+ ps-page-count
)))
4818 (defun ps-begin-page ()
4819 (ps-get-page-dimensions)
4820 (setq ps-width-remaining ps-print-width
4821 ps-height-remaining ps-print-height
)
4825 (ps-output (format "/LineNumber %d def\n" ps-showline-count
)
4826 (format "/PageNumber %d def\n" (ps-page-number)))
4828 (when ps-print-header
4829 (ps-generate-header "HeaderLinesLeft" ps-left-header
)
4830 (ps-generate-header "HeaderLinesRight" ps-right-header
)
4831 (ps-output (format "%d SetHeaderLines\n" ps-header-lines
)))
4833 (ps-output "BeginPage\n")
4834 (ps-set-font ps-current-font
)
4835 (ps-set-bg ps-current-bg
)
4836 (ps-set-color ps-current-color
)
4837 (ps-mule-begin-page))
4839 (defun ps-end-page ()
4840 (ps-output "EndPage\nEndDSCPage\n"))
4842 (defun ps-next-line ()
4843 (setq ps-showline-count
(1+ ps-showline-count
))
4844 (let ((lh (ps-line-height 'ps-font-for-text
)))
4845 (if (< ps-height-remaining lh
)
4847 (setq ps-width-remaining ps-print-width
4848 ps-height-remaining
(- ps-height-remaining lh
))
4849 (ps-output "HL\n"))))
4851 (defun ps-continue-line ()
4852 (let ((lh (ps-line-height 'ps-font-for-text
)))
4853 (if (< ps-height-remaining lh
)
4855 (setq ps-width-remaining ps-print-width
4856 ps-height-remaining
(- ps-height-remaining lh
))
4857 (ps-output "SL\n"))))
4859 (defun ps-find-wrappoint (from to char-width
)
4860 (let ((avail (truncate (/ ps-width-remaining char-width
)))
4863 (cons to
(* todo char-width
))
4864 (cons (+ from avail
) ps-width-remaining
))))
4866 (defun ps-basic-plot-string (from to
&optional bg-color
)
4867 (let* ((wrappoint (ps-find-wrappoint from to
4868 (ps-avg-char-width 'ps-font-for-text
)))
4869 (to (car wrappoint
))
4870 (string (buffer-substring-no-properties from to
)))
4871 (ps-mule-prepare-ascii-font string
)
4872 (ps-output-string string
)
4876 (defun ps-basic-plot-whitespace (from to
&optional bg-color
)
4877 (let* ((wrappoint (ps-find-wrappoint from to
4878 (ps-space-width 'ps-font-for-text
)))
4879 (to (car wrappoint
)))
4880 (ps-output (format "%d W\n" (- to from
)))
4883 (defun ps-plot (plotfunc from to
&optional bg-color
)
4885 (let* ((wrappoint (funcall plotfunc from to bg-color
))
4886 (plotted-to (car wrappoint
))
4887 (plotted-width (cdr wrappoint
)))
4888 (setq from plotted-to
4889 ps-width-remaining
(- ps-width-remaining plotted-width
))
4891 (ps-continue-line))))
4892 (if ps-razzle-dazzle
4893 (let* ((q-todo (- (point-max) (point-min)))
4894 (q-done (- (point) (point-min)))
4895 (chunkfrac (/ q-todo
8))
4896 (chunksize (min chunkfrac
1000)))
4897 (if (> (- q-done ps-razchunk
) chunksize
)
4899 (setq ps-razchunk q-done
)
4900 (message "Formatting...%3d%%"
4902 (/ (* 100 q-done
) q-todo
)
4903 (/ q-done
(/ q-todo
100)))
4906 (defvar ps-last-font nil
)
4908 (defun ps-set-font (font)
4909 (setq ps-last-font
(format "f%d" (setq ps-current-font font
)))
4910 (ps-output (format "/%s F\n" ps-last-font
)))
4912 (defun ps-set-bg (color)
4913 (if (setq ps-current-bg color
)
4914 (ps-output (format ps-color-format
4915 (nth 0 color
) (nth 1 color
) (nth 2 color
))
4917 (ps-output "false BG\n")))
4919 (defun ps-set-color (color)
4920 (setq ps-current-color
(or color ps-default-foreground
))
4921 (ps-output (format ps-color-format
4922 (nth 0 ps-current-color
)
4923 (nth 1 ps-current-color
) (nth 2 ps-current-color
))
4927 (defvar ps-current-effect
0)
4930 (defun ps-plot-region (from to font
&optional fg-color bg-color effects
)
4931 (if (not (equal font ps-current-font
))
4934 ;; Specify a foreground color only if one's specified and it's
4935 ;; different than the current.
4936 (if (not (equal fg-color ps-current-color
))
4937 (ps-set-color fg-color
))
4939 (if (not (equal bg-color ps-current-bg
))
4940 (ps-set-bg bg-color
))
4942 ;; Specify effects (underline, overline, box, etc)
4944 ((not (integerp effects
))
4945 (ps-output "0 EF\n")
4946 (setq ps-current-effect
0))
4947 ((/= effects ps-current-effect
)
4948 (ps-output (number-to-string effects
) " EF\n")
4949 (setq ps-current-effect effects
)))
4951 ;; Starting at the beginning of the specified region...
4955 ;; ...break the region up into chunks separated by tabs, linefeeds,
4956 ;; pagefeeds, control characters, and plot each chunk.
4958 (if (re-search-forward ps-control-or-escape-regexp to t
)
4959 ;; region with some control characters or some multi-byte characters
4960 (let* ((match-point (match-beginning 0))
4961 (match (char-after match-point
))
4962 (composition (ps-e-find-composition from
(1+ match-point
))))
4964 (if (and (nth 2 composition
)
4965 (<= (car composition
) match-point
))
4967 (setq match-point
(car composition
)
4969 (goto-char (nth 1 composition
)))
4970 (setq composition nil
)))
4971 (when (< from match-point
)
4972 (ps-mule-set-ascii-font)
4973 (ps-plot 'ps-basic-plot-string from match-point bg-color
))
4975 ((= match ?
\t) ; tab
4976 (let ((linestart (line-beginning-position)))
4978 (setq from
(+ linestart
(current-column)))
4979 (when (re-search-forward "[ \t]+" to t
)
4980 (ps-mule-set-ascii-font)
4981 (ps-plot 'ps-basic-plot-whitespace
4982 from
(+ linestart
(current-column))
4985 ((= match ?
\n) ; newline
4988 ((= match ?
\f) ; form feed
4989 ;; do not skip page if previous character is NEWLINE and
4990 ;; it is a beginning of page.
4991 (or (and (equal (char-after (1- match-point
)) ?
\n)
4992 (= ps-height-remaining ps-print-height
))
4995 (composition ; a composite sequence
4996 (ps-plot 'ps-mule-plot-composition match-point
(point) bg-color
))
4998 ((> match
255) ; a multi-byte character
4999 (let* ((charset (char-charset match
))
5000 (composition (ps-e-find-composition match-point to
))
5001 (stop (if (nth 2 composition
) (car composition
) to
)))
5002 (or (eq charset
'composition
)
5003 (while (and (< (point) stop
) (eq (charset-after) charset
))
5005 (ps-plot 'ps-mule-plot-string match-point
(point) bg-color
)))
5006 ; characters from ^@ to ^_ and
5007 (t ; characters from 127 to 255
5008 (ps-control-character match
)))
5009 (setq from
(point)))
5010 ;; region without control characters nor multi-byte characters
5011 (ps-mule-set-ascii-font)
5012 (ps-plot 'ps-basic-plot-string from to bg-color
)
5015 (defvar ps-string-control-codes
5016 (let ((table (make-vector 256 nil
))
5018 ;; control character
5019 (while (<= char ?
\037)
5020 (aset table char
(format "^%c" (+ char ?
@)))
5021 (setq char
(1+ char
)))
5022 ;; printable character
5023 (while (< char ?
\177)
5024 (aset table char
(format "%c" char
))
5025 (setq char
(1+ char
)))
5027 (aset table char
"^?")
5029 (while (<= (setq char
(1+ char
)) ?
\377)
5030 (aset table char
(format "\\%o" char
)))
5032 "Vector used to map characters to a printable string.")
5034 (defun ps-control-character (char)
5035 (let* ((str (aref ps-string-control-codes char
))
5039 (char-width (ps-avg-char-width 'ps-font-for-text
))
5040 (wrappoint (ps-find-wrappoint from to char-width
)))
5041 (if (< (car wrappoint
) to
)
5043 (setq ps-width-remaining
(- ps-width-remaining
(* len char-width
)))
5044 (ps-mule-prepare-ascii-font str
)
5045 (ps-output-string str
)
5046 (ps-output " S\n")))
5049 (defun ps-face-attributes (face)
5050 "Return face attribute vector.
5052 If FACE is not in `ps-print-face-extension-alist' or in
5053 `ps-print-face-alist', insert it on `ps-print-face-alist' and
5054 return the attribute vector.
5056 If FACE is not a valid face name, it is used default face."
5059 (cdr (or (assq face ps-print-face-extension-alist
)
5060 (assq face ps-print-face-alist
)
5061 (let* ((the-face (if (facep face
) face
'default
))
5062 (new-face (ps-screen-to-bit-face the-face
)))
5063 (or (and (eq the-face
'default
)
5064 (assq the-face ps-print-face-alist
))
5065 (setq ps-print-face-alist
5066 (cons new-face ps-print-face-alist
)))
5068 ((eq (car face
) 'foreground-color
)
5069 (vector 0 (cdr face
) nil
))
5070 ((eq (car face
) 'background-color
)
5071 (vector 0 nil
(cdr face
)))
5073 (vector 0 nil nil
))))
5076 (defun ps-face-background (face background
)
5077 (and (or (eq ps-use-face-background t
)
5078 (cond ((symbolp face
)
5079 (memq face ps-use-face-background
))
5081 (or (memq (car face
) '(foreground-color background-color
))
5084 (if (or (memq (car face
) ps-use-face-background
)
5086 '(foreground-color background-color
)))
5089 (setq face
(cdr face
))))
5097 (defun ps-face-attribute-list (face-or-list)
5100 ((not (listp face-or-list
))
5101 (ps-face-attributes face-or-list
))
5102 ;; only foreground color, not a `real' face
5103 ((eq (car face-or-list
) 'foreground-color
)
5104 (vector 0 (cdr face-or-list
) nil
))
5105 ;; only background color, not a `real' face
5106 ((eq (car face-or-list
) 'background-color
)
5107 (vector 0 nil
(cdr face-or-list
)))
5111 foreground background face-attr face
)
5113 (setq face
(car face-or-list
)
5114 face-or-list
(cdr face-or-list
)
5115 face-attr
(ps-face-attributes face
)
5116 effects
(logior effects
(aref face-attr
0)))
5117 (or foreground
(setq foreground
(aref face-attr
1)))
5119 (setq background
(ps-face-background face
(aref face-attr
2)))))
5120 (vector effects foreground background
)))))
5123 (defconst ps-font-type
(vector nil
'bold
'italic
'bold-italic
))
5126 (defun ps-plot-with-face (from to face
)
5128 ((null face
) ; print text with null face
5129 (ps-plot-region from to
0))
5130 ((eq face
'emacs--invisible--face
)) ; skip invisible text!!!
5131 (t ; otherwise, text has a valid face
5132 (let* ((face-bit (ps-face-attribute-list face
))
5133 (effect (aref face-bit
0))
5134 (foreground (aref face-bit
1))
5135 (background (ps-face-background face
(aref face-bit
2)))
5136 (fg-color (if (and ps-color-p foreground
)
5137 (ps-color-scale foreground
)
5139 (bg-color (and ps-color-p background
5140 (ps-color-scale background
))))
5143 (ps-font-number 'ps-font-for-text
5144 (or (aref ps-font-type
(logand effect
3))
5146 fg-color bg-color
(lsh effect -
2)))))
5150 ;; Ensure that face-list is fbound.
5151 (or (fboundp 'face-list
) (defalias 'face-list
'list-faces
))
5154 (defun ps-build-reference-face-lists ()
5155 ;; Ensure that face database is updated with faces on
5156 ;; `font-lock-face-attributes' (obsolete stuff)
5157 (ps-font-lock-face-attributes)
5158 ;; Now, rebuild reference face lists
5159 (setq ps-print-face-alist nil
)
5160 (if ps-auto-font-detect
5161 (mapcar 'ps-map-face
(face-list))
5162 (mapcar 'ps-set-face-bold ps-bold-faces
)
5163 (mapcar 'ps-set-face-italic ps-italic-faces
)
5164 (mapcar 'ps-set-face-underline ps-underlined-faces
))
5165 (setq ps-build-face-reference nil
))
5168 (defun ps-set-face-bold (face)
5169 (ps-set-face-attribute face
1))
5171 (defun ps-set-face-italic (face)
5172 (ps-set-face-attribute face
2))
5174 (defun ps-set-face-underline (face)
5175 (ps-set-face-attribute face
4))
5178 (defun ps-set-face-attribute (face effect
)
5179 (let ((face-bit (cdr (ps-map-face face
))))
5180 (aset face-bit
0 (logior (aref face-bit
0) effect
))))
5183 (defun ps-map-face (face)
5184 (let* ((face-map (ps-screen-to-bit-face face
))
5185 (ps-face-bit (cdr (assq (car face-map
) ps-print-face-alist
))))
5187 ;; if face exists, merge both
5188 (let ((face-bit (cdr face-map
)))
5189 (aset ps-face-bit
0 (logior (aref ps-face-bit
0) (aref face-bit
0)))
5190 (or (aref ps-face-bit
1) (aset ps-face-bit
1 (aref face-bit
1)))
5191 (or (aref ps-face-bit
2) (aset ps-face-bit
2 (aref face-bit
2))))
5192 ;; if face does not exist, insert it
5193 (setq ps-print-face-alist
(cons face-map ps-print-face-alist
)))
5197 (defun ps-screen-to-bit-face (face)
5199 (vector (logior (if (ps-face-bold-p face
) 1 0) ; bold
5200 (if (ps-face-italic-p face
) 2 0) ; italic
5201 (if (ps-face-underlined-p face
) 4 0)) ; underline
5202 (ps-face-foreground-name face
)
5203 (ps-face-background-name face
))))
5206 ;; to avoid compilation gripes
5207 (defun ps-print-ensure-fontified (start end
)
5209 ((and (boundp 'jit-lock-mode
) (symbol-value 'jit-lock-mode
))
5210 (defalias 'ps-jitify
'jit-lock-fontify-now
) ; avoid compilation gripes
5211 (ps-jitify start end
))
5212 ((and (boundp 'lazy-lock-mode
) (symbol-value 'lazy-lock-mode
))
5213 (defalias 'ps-lazify
'lazy-lock-fontify-region
) ; avoid compilation gripes
5214 (ps-lazify start end
))))
5217 (defun ps-generate-postscript-with-faces (from to
)
5218 ;; Some initialization...
5219 (setq ps-current-effect
0)
5221 ;; Build the reference lists of faces if necessary.
5222 (when (or ps-always-build-face-reference
5223 ps-build-face-reference
)
5224 (message "Collecting face information...")
5225 (ps-build-reference-face-lists))
5226 ;; Generate some PostScript.
5228 (narrow-to-region from to
)
5229 (ps-print-ensure-fontified from to
)
5230 (let ((face 'default
)
5233 ((memq ps-print-emacs-type
'(xemacs lucid
))
5234 ;; Build the list of extents...
5235 (let ((a (cons 'dummy nil
))
5236 record type extent extent-list
)
5237 (ps-x-map-extents 'ps-mapper nil from to a
)
5238 (setq a
(sort (cdr a
) 'car-less-than-car
)
5241 ;; Loop through the extents...
5243 (setq record
(car a
)
5245 position
(car record
)
5251 extent
(car record
))
5253 ;; Plot up to this record.
5254 ;; XEmacs 19.12: for some reason, we're getting into a
5255 ;; situation in which some of the records have
5256 ;; positions less than 'from'. Since we've narrowed
5257 ;; the buffer, this'll generate errors. This is a hack,
5258 ;; but don't call ps-plot-with-face unless from > point-min.
5259 (and (>= from
(point-min))
5260 (ps-plot-with-face from
(min position
(point-max)) face
))
5264 (and (ps-x-extent-face extent
)
5265 (setq extent-list
(sort (cons extent extent-list
)
5266 'ps-extent-sorter
))))
5269 (setq extent-list
(sort (delq extent extent-list
)
5270 'ps-extent-sorter
))))
5272 (setq face
(if extent-list
5273 (ps-x-extent-face (car extent-list
))
5278 ((eq ps-print-emacs-type
'emacs
)
5279 (let ((property-change from
)
5280 (overlay-change from
)
5281 (save-buffer-invisibility-spec buffer-invisibility-spec
)
5282 (buffer-invisibility-spec nil
))
5284 (and (< property-change to
) ; Don't search for property change
5285 ; unless previous search succeeded.
5286 (setq property-change
(next-property-change from nil to
)))
5287 (and (< overlay-change to
) ; Don't search for overlay change
5288 ; unless previous search succeeded.
5289 (setq overlay-change
(min (next-overlay-change from
) to
)))
5290 (setq position
(min property-change overlay-change
))
5291 ;; The code below is not quite correct,
5292 ;; because a non-nil overlay invisible property
5293 ;; which is inactive according to the current value
5294 ;; of buffer-invisibility-spec nonetheless overrides
5295 ;; a face text property.
5297 (cond ((let ((prop (get-text-property from
'invisible
)))
5298 ;; Decide whether this invisible property
5299 ;; really makes the text invisible.
5300 (if (eq save-buffer-invisibility-spec t
)
5302 (or (memq prop save-buffer-invisibility-spec
)
5303 (assq prop save-buffer-invisibility-spec
))))
5304 'emacs--invisible--face
)
5305 ((get-text-property from
'face
))
5307 (let ((overlays (overlays-at from
))
5308 (face-priority -
1)) ; text-property
5309 (while (and overlays
5310 (not (eq face
'emacs--invisible--face
)))
5311 (let* ((overlay (car overlays
))
5312 (overlay-invisible (overlay-get overlay
'invisible
))
5313 (overlay-priority (or (overlay-get overlay
'priority
)
5315 (and (> overlay-priority face-priority
)
5317 (cond ((if (eq save-buffer-invisibility-spec t
)
5318 (not (null overlay-invisible
))
5319 (or (memq overlay-invisible
5320 save-buffer-invisibility-spec
)
5321 (assq overlay-invisible
5322 save-buffer-invisibility-spec
)))
5323 'emacs--invisible--face
)
5324 ((overlay-get overlay
'face
))
5326 face-priority overlay-priority
)))
5327 (setq overlays
(cdr overlays
))))
5328 ;; Plot up to this record.
5329 (ps-plot-with-face from position face
)
5330 (setq from position
)))))
5331 (ps-plot-with-face from to face
))))
5333 (defun ps-generate-postscript (from to
)
5334 (ps-plot-region from to
0 nil
))
5336 (defun ps-generate (buffer from to genfunc
)
5338 (let ((from (min to from
))
5340 ;; This avoids trouble if chars with read-only properties
5341 ;; are copied into ps-spool-buffer.
5342 (inhibit-read-only t
))
5344 (narrow-to-region from to
)
5345 (and ps-razzle-dazzle
5346 (message "Formatting...%3d%%" (setq ps-razchunk
0)))
5347 (setq ps-source-buffer buffer
5348 ps-spool-buffer
(get-buffer-create ps-spool-buffer-name
))
5349 (ps-init-output-queue)
5350 (let (safe-marker completed-safely needs-begin-file
)
5353 (set-buffer ps-spool-buffer
)
5354 (set-buffer-multibyte nil
)
5356 ;; Get a marker and make it point to the current end of the
5357 ;; buffer, If an error occurs, we'll delete everything from
5358 ;; the end of this marker onwards.
5359 (setq safe-marker
(make-marker))
5360 (set-marker safe-marker
(point-max))
5362 (goto-char (point-min))
5363 (or (looking-at (regexp-quote ps-adobe-tag
))
5364 (setq needs-begin-file t
))
5366 (set-buffer ps-source-buffer
)
5368 (let ((ps-print-page-p t
)
5369 ps-even-or-odd-pages
)
5371 (when needs-begin-file
5373 (ps-mule-initialize))
5374 (ps-mule-begin-job from to
)
5375 (ps-selected-pages)))
5377 (funcall genfunc from to
)
5379 (ps-end-job needs-begin-file
)
5381 ;; Setting this variable tells the unwind form that the
5382 ;; the PostScript was generated without error.
5383 (setq completed-safely t
))
5385 ;; Unwind form: If some bad mojo occurred while generating
5386 ;; PostScript, delete all the PostScript that was generated.
5387 ;; This protects the previously spooled files from getting
5389 (and (markerp safe-marker
) (not completed-safely
)
5391 (set-buffer ps-spool-buffer
)
5392 (delete-region (marker-position safe-marker
) (point-max))))))
5394 (and ps-razzle-dazzle
(message "Formatting...done"))))))
5397 (defun ps-end-job (needs-begin-file)
5398 (let ((ps-print-page-p t
))
5401 (let ((pages-per-sheet (mod ps-page-n-up ps-n-up-printing
))
5402 (total-lines (cdr ps-printing-region
))
5403 (total-pages (ps-page-number))
5405 (set-buffer ps-spool-buffer
)
5406 ;; Back to the PS output buffer to set the last page n-up printing
5407 (goto-char (point-max))
5408 (and (> pages-per-sheet
0)
5409 (re-search-backward "^[0-9]+ BeginSheet$" nil t
)
5410 (replace-match (format "%d BeginSheet" pages-per-sheet
) t
))
5411 ;; Back to the PS output buffer to set the page count
5412 (goto-char (point-min))
5413 (and (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t
)
5414 (replace-match (format "/Lines %d def\n/PageCount %d def"
5415 total-lines total-pages
) t
))))
5417 (and ps-spool-duplex
(= (mod ps-page-order
2) 1)
5418 (let ((ps-n-up-printing 0))
5420 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
5421 "/PrintLineNumber false def\nBeginPage\n")
5423 ;; Set end of PostScript file
5424 (ps-output "EndSheet\n\n%%Trailer\n%%Pages: "
5426 (if (and needs-begin-file
5427 ps-banner-page-when-duplexing
)
5430 "\n\nEndDoc\n\n%%EOF\n")
5432 ;; disable selected pages
5433 (setq ps-selected-pages nil
))
5436 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
5437 (defun ps-do-despool (filename)
5438 (if (or (not (boundp 'ps-spool-buffer
))
5439 (not (symbol-value 'ps-spool-buffer
)))
5440 (message "No spooled PostScript to print")
5443 (and ps-razzle-dazzle
(message "Saving..."))
5444 (set-buffer ps-spool-buffer
)
5445 (setq filename
(expand-file-name filename
))
5446 (let ((coding-system-for-write 'raw-text-unix
))
5447 (write-region (point-min) (point-max) filename
))
5448 (and ps-razzle-dazzle
(message "Wrote %s" filename
)))
5449 ;; Else, spool to the printer
5450 (and ps-razzle-dazzle
(message "Printing..."))
5452 (set-buffer ps-spool-buffer
)
5453 (let* ((coding-system-for-write 'raw-text-unix
)
5454 (ps-printer-name (or ps-printer-name
5455 (and (boundp 'printer-name
)
5458 (append ps-lpr-switches
5459 (and (stringp ps-printer-name
)
5460 (string< "" ps-printer-name
)
5462 (and (stringp ps-printer-name-option
)
5463 ps-printer-name-option
)
5464 ps-printer-name
))))))
5465 (apply (or ps-print-region-function
'call-process-region
)
5466 (point-min) (point-max) ps-lpr-command nil
5467 (and (fboundp 'start-process
) 0)
5469 (ps-flatten-list ; dynamic evaluation
5470 (mapcar 'ps-eval-switch ps-lpr-switches
)))))
5471 (and ps-razzle-dazzle
(message "Printing...done")))
5472 (kill-buffer ps-spool-buffer
)))
5474 ;; Dynamic evaluation
5475 (defun ps-eval-switch (arg)
5476 (cond ((stringp arg
) arg
)
5477 ((functionp arg
) (apply arg nil
))
5478 ((symbolp arg
) (symbol-value arg
))
5479 ((consp arg
) (apply (car arg
) (cdr arg
)))
5482 ;; `ps-flatten-list' is defined here (copied from "message.el" and
5483 ;; enhanced to handle dotted pairs as well) until we can get some
5484 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
5486 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
5487 ;; => (a b c d e f g h i j)
5489 (defun ps-flatten-list (&rest list
)
5490 (ps-flatten-list-1 list
))
5492 (defun ps-flatten-list-1 (list)
5493 (cond ((null list
) nil
)
5494 ((consp list
) (append (ps-flatten-list-1 (car list
))
5495 (ps-flatten-list-1 (cdr list
))))
5498 (defun ps-kill-emacs-check ()
5500 (and (setq ps-buffer
(get-buffer ps-spool-buffer-name
))
5501 (buffer-modified-p ps-buffer
)
5502 (y-or-n-p "Unprinted PostScript waiting; print now? ")
5504 (and (setq ps-buffer
(get-buffer ps-spool-buffer-name
))
5505 (buffer-modified-p ps-buffer
)
5506 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
5507 (error "Unprinted PostScript"))))
5509 (cond ((fboundp 'add-hook
)
5510 (funcall 'add-hook
'kill-emacs-hook
'ps-kill-emacs-check
))
5512 (message "Won't override existing `kill-emacs-hook'"))
5514 (setq kill-emacs-hook
'ps-kill-emacs-check
)))
5517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5518 ;;; Sample Setup Code:
5521 ;; This stuff is for anybody that's brave enough to look this far,
5522 ;; and able to figure out how to use it. It isn't really part of
5523 ;; ps-print, but I'll leave it here in hopes it might be useful:
5525 ;; WARNING!!! The following code is *sample* code only.
5526 ;; Don't use it unless you understand what it does!
5528 (defmacro ps-prsc
()
5529 `(if (eq ps-print-emacs-type
'emacs
) [f22] 'f22))
5530 (defmacro ps-c-prsc ()
5531 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
5532 (defmacro ps-s-prsc ()
5533 `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
5535 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
5536 ;; `ps-left-headers' specially for mail messages.
5537 (defun ps-rmail-mode-hook ()
5538 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
5539 (setq ps-header-lines 3
5541 ;; The left headers will display the message's subject, its
5542 ;; author, and the name of the folder it was in.
5543 '(ps-article-subject ps-article-author buffer-name)))
5545 ;; See `ps-gnus-print-article-from-summary'. This function does the
5546 ;; same thing for rmail.
5547 (defun ps-rmail-print-message-from-summary ()
5549 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
5551 ;; Used in `ps-rmail-print-article-from-summary',
5552 ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
5553 (defun ps-print-message-from-summary (summary-buffer summary-default)
5554 (let ((ps-buf (or (and (boundp summary-buffer)
5555 (symbol-value summary-buffer))
5557 (and (get-buffer ps-buf)
5560 (ps-spool-buffer-with-faces)))))
5562 ;; Look in an article or mail message for the Subject: line. To be
5563 ;; placed in `ps-left-headers'.
5564 (defun ps-article-subject ()
5566 (goto-char (point-min))
5567 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
5568 (buffer-substring (match-beginning 1) (match-end 1))
5571 ;; Look in an article or mail message for the From: line. Sorta-kinda
5572 ;; understands RFC-822 addresses and can pull the real name out where
5573 ;; it's provided. To be placed in `ps-left-headers'.
5574 (defun ps-article-author ()
5576 (goto-char (point-min))
5577 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
5578 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
5581 ;; Try first to match addresses that look like
5582 ;; thompson@wg2.waii.com (Jim Thompson)
5583 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
5584 (substring fromstring (match-beginning 1) (match-end 1)))
5586 ;; Next try to match addresses that look like
5587 ;; Jim Thompson <thompson@wg2.waii.com> or
5588 ;; "Jim Thompson" <thompson@wg2.waii.com>
5589 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
5590 (substring fromstring (match-beginning 2) (match-end 2)))
5592 ;; Couldn't find a real name -- show the address instead.
5596 ;; A hook to bind to `gnus-article-prepare-hook'. This will set the
5597 ;; `ps-left-headers' specially for gnus articles. Unfortunately,
5598 ;; `gnus-article-mode-hook' is called only once, the first time the *Article*
5599 ;; buffer enters that mode, so it would only work for the first time
5600 ;; we ran gnus. The second time, this hook wouldn't get set up. The
5601 ;; only alternative is `gnus-article-prepare-hook'.
5602 (defun ps-gnus-article-prepare-hook ()
5603 (setq ps-header-lines 3
5605 ;; The left headers will display the article's subject, its
5606 ;; author, and the newsgroup it was in.
5607 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
5609 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
5610 ;; `ps-left-headers' specially for mail messages.
5611 (defun ps-vm-mode-hook ()
5612 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
5613 (setq ps-header-lines 3
5615 ;; The left headers will display the message's subject, its
5616 ;; author, and the name of the folder it was in.
5617 '(ps-article-subject ps-article-author buffer-name)))
5619 ;; Every now and then I forget to switch from the *Summary* buffer to
5620 ;; the *Article* before hitting prsc, and a nicely formatted list of
5621 ;; article subjects shows up at the printer. This function, bound to
5622 ;; prsc for the gnus *Summary* buffer means I don't have to switch
5624 ;; sb: Updated for Gnus 5.
5625 (defun ps-gnus-print-article-from-summary ()
5627 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
5629 ;; See `ps-gnus-print-article-from-summary'. This function does the
5630 ;; same thing for vm.
5631 (defun ps-vm-print-message-from-summary ()
5633 (ps-print-message-from-summary 'vm-mail-buffer ""))
5635 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
5637 (defun ps-gnus-summary-setup ()
5638 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
5640 ;; Look in an article or mail message for the Subject: line. To be
5641 ;; placed in `ps-left-headers'.
5642 (defun ps-info-file ()
5644 (goto-char (point-min))
5645 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
5646 (buffer-substring (match-beginning 1) (match-end 1))
5649 ;; Look in an article or mail message for the Subject: line. To be
5650 ;; placed in `ps-left-headers'.
5651 (defun ps-info-node ()
5653 (goto-char (point-min))
5654 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
5655 (buffer-substring (match-beginning 1) (match-end 1))
5658 (defun ps-info-mode-hook ()
5659 (setq ps-left-header
5660 ;; The left headers will display the node name and file name.
5661 '(ps-info-node ps-info-file)))
5663 ;; WARNING! The following function is a *sample* only, and is *not*
5664 ;; meant to be used as a whole unless you understand what the effects
5665 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
5666 ;; I'd be very surprised if it was useful to *anybody*, without
5669 (defun ps-jts-ps-setup ()
5670 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
5671 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
5672 (global-set-key (ps-c-prsc) 'ps-despool)
5673 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
5674 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
5675 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
5676 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
5677 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
5678 (setq ps-spool-duplex t
5679 ps-print-color-p nil
5680 ps-lpr-command "lpr"
5681 ps-lpr-switches '("-Jjct,duplex_long"))
5684 ;; WARNING! The following function is a *sample* only, and is *not*
5685 ;; meant to be used as a whole unless it corresponds to your needs.
5686 ;; (In fact, this is a copy of Jack's setup for ps-print --
5687 ;; I would not be that surprised if it was useful to *anybody*,
5688 ;; without modification.)
5690 (defun ps-jack-setup ()
5691 (setq ps-print-color-p nil
5692 ps-lpr-command "lpr"
5697 ps-number-of-columns 2
5699 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
5700 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
5701 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
5702 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
5703 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
5704 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
5705 ps-header-line-pad .15
5707 ps-print-header-frame t
5712 ps-font-family 'Courier
5714 ps-header-font-family 'Helvetica
5715 ps-header-font-size 6
5716 ps-header-title-font-size 8)
5720 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5721 ;; To make this file smaller, some commands go in a separate file.
5722 ;; But autoload them here to make the separation invisible.
5724 (autoload 'ps-mule-prepare-ascii-font "ps-mule"
5725 "Setup special ASCII font for STRING.
5726 STRING should contain only ASCII characters.")
5728 (autoload 'ps-mule-set-ascii-font "ps-mule"
5729 "Adjust current font if current charset is not ASCII.")
5731 (autoload 'ps-mule-plot-string "ps-mule"
5732 "Generate PostScript code for ploting characters in the region FROM and TO.
5734 It is assumed that all characters in this region belong to the same charset.
5736 Optional argument BG-COLOR specifies background color.
5740 (ENDPOS . RUN-WIDTH)
5742 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
5745 (autoload 'ps-mule-initialize "ps-mule"
5746 "Initialize global data for printing multi-byte characters.")
5748 (autoload 'ps-mule-begin-job "ps-mule"
5749 "Start printing job for multi-byte chars between FROM and TO.
5750 This checks if all multi-byte characters in the region are printable or not.")
5752 (autoload 'ps-mule-begin-page "ps-mule"
5753 "Initialize multi-byte charset for printing current page.")
5756 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5760 ;;; ps-print.el ends here