(ibuffer-backward-line, ibuffer-forward-line)
[emacs.git] / lisp / ps-print.el
blobac6d37854e38bbe29a3d0ec421cbf57256710c69
1 ;;; ps-print.el --- print text from the buffer as PostScript
3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
4 ;; 2003 Free Software Foundation, Inc.
6 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
7 ;; Jacques Duthen (was <duthen@cegelec-red.fr>)
8 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
9 ;; Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
11 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
12 ;; Keywords: wp, print, PostScript
13 ;; Time-stamp: <2003/05/14 22:34:05 vinicius>
14 ;; Version: 6.6.1
15 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/
17 (defconst ps-print-version "6.6.1"
18 "ps-print.el, v 6.6.1 <2003/05/14 vinicius>
20 Vinicius's last change version -- this file may have been edited as part of
21 Emacs without changes to the version number. When reporting bugs, please also
22 report the version of Emacs, if any, that ps-print was distributed with.
24 Please send all bug fixes and enhancements to
25 Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
27 ;; This file is part of GNU Emacs.
29 ;; GNU Emacs is free software; you can redistribute it and/or modify it under
30 ;; the terms of the GNU General Public License as published by the Free
31 ;; Software Foundation; either version 2, or (at your option) any later
32 ;; version.
34 ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY
35 ;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
36 ;; FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
37 ;; details.
39 ;; You should have received a copy of the GNU General Public License along with
40 ;; GNU Emacs; see the file COPYING. If not, write to the Free Software
41 ;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
43 ;;; Commentary:
45 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;; About ps-print
48 ;; --------------
50 ;; This package provides printing of Emacs buffers on PostScript printers; the
51 ;; buffer's bold and italic text attributes are preserved in the printer
52 ;; output. ps-print is intended for use with Emacs or XEmacs, together with a
53 ;; fontifying package such as font-lock or hilit.
55 ;; ps-print uses the same face attributes defined through font-lock or hilit to
56 ;; print a PostScript file, but some faces are better seeing on the screen than
57 ;; on paper, specially when you have a black/white PostScript printer.
59 ;; ps-print allows a remap of face to another one that it is better to print,
60 ;; for example, the face font-lock-comment-face (if you are using font-lock)
61 ;; could have bold or italic attribute when printing, besides foreground color.
62 ;; This remap improves printing look (see How Ps-Print Maps Faces).
65 ;; Using ps-print
66 ;; --------------
68 ;; ps-print provides eight commands for generating PostScript images of Emacs
69 ;; buffers:
71 ;; ps-print-buffer
72 ;; ps-print-buffer-with-faces
73 ;; ps-print-region
74 ;; ps-print-region-with-faces
75 ;; ps-spool-buffer
76 ;; ps-spool-buffer-with-faces
77 ;; ps-spool-region
78 ;; ps-spool-region-with-faces
80 ;; These commands all perform essentially the same function: they generate
81 ;; PostScript images suitable for printing on a PostScript printer or
82 ;; displaying with GhostScript. These commands are collectively referred to as
83 ;; "ps-print- commands".
85 ;; The word "print" or "spool" in the command name determines when the
86 ;; PostScript image is sent to the printer:
88 ;; print - The PostScript image is immediately sent to the printer;
90 ;; spool - The PostScript image is saved temporarily in an Emacs
91 ;; buffer. Many images may be spooled locally before
92 ;; printing them. To send the spooled images to the
93 ;; printer, use the command `ps-despool'.
95 ;; The spooling mechanism was designed for printing lots of small files (mail
96 ;; messages or netnews articles) to save paper that would otherwise be wasted
97 ;; on banner pages, and to make it easier to find your output at the printer
98 ;; (it's easier to pick up one 50-page printout than to find 50 single-page
99 ;; printouts).
101 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't accidentally
102 ;; quit from Emacs while you have unprinted PostScript waiting in the spool
103 ;; buffer. If you do attempt to exit with spooled PostScript, you'll be asked
104 ;; if you want to print it, and if you decline, you'll be asked to confirm the
105 ;; exit; this is modeled on the confirmation that Emacs uses for modified
106 ;; buffers.
108 ;; The word "buffer" or "region" in the command name determines how much of the
109 ;; buffer is printed:
111 ;; buffer - Print the entire buffer.
113 ;; region - Print just the current region.
115 ;; The -with-faces suffix on the command name means that the command will
116 ;; include font, color, and underline information in the PostScript image, so
117 ;; the printed image can look as pretty as the buffer. The ps-print- commands
118 ;; without the -with-faces suffix don't include font, color, or underline
119 ;; information; images printed with these commands aren't as pretty, but are
120 ;; faster to generate.
122 ;; Two ps-print- command examples:
124 ;; ps-print-buffer - print the entire buffer, without font,
125 ;; color, or underline information, and
126 ;; send it immediately to the printer.
128 ;; ps-spool-region-with-faces - print just the current region; include
129 ;; font, color, and underline information,
130 ;; and spool the image in Emacs to send to
131 ;; the printer later.
134 ;; Invoking Ps-Print
135 ;; -----------------
137 ;; To print your buffer, type
139 ;; M-x ps-print-buffer
141 ;; or substitute one of the other seven ps-print- commands. The command will
142 ;; generate the PostScript image and print or spool it as specified. By giving
143 ;; the command a prefix argument
145 ;; C-u M-x ps-print-buffer
147 ;; it will save the PostScript image to a file instead of sending it to the
148 ;; printer; you will be prompted for the name of the file to save the image to.
149 ;; The prefix argument is ignored by the commands that spool their images, but
150 ;; you may save the spooled images to a file by giving a prefix argument to
151 ;; `ps-despool':
153 ;; C-u M-x ps-despool
155 ;; When invoked this way, `ps-despool' will prompt you for the name of the file
156 ;; to save to.
158 ;; Any of the `ps-print-' commands can be bound to keys; I recommend binding
159 ;; `ps-spool-buffer-with-faces', `ps-spool-region-with-faces', and
160 ;; `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
162 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
163 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
164 ;; (global-set-key '(control f22) 'ps-despool)
167 ;; The Printer Interface
168 ;; ---------------------
170 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what command
171 ;; is used to send the PostScript images to the printer, and what arguments to
172 ;; give the command. These are analogous to `lpr-command' and `lpr-switches'.
174 ;; Make sure that they contain appropriate values for your system;
175 ;; see the usage notes below and the documentation of these variables.
177 ;; The variable `ps-printer-name' determines the name of a local printer for
178 ;; printing PostScript files.
180 ;; The variable `ps-printer-name-option' determines the option used by some
181 ;; utilities to indicate the printer name, it's used only when
182 ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
183 ;; print, for example, `ps-printer-name-option' should be set to "-P".
185 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values from
186 ;; the variables `lpr-command' and `lpr-switches'. If you have
187 ;; `lpr-command' set to invoke a pretty-printer such as `enscript', then
188 ;; ps-print won't work properly. `ps-lpr-command' must name a program
189 ;; that does not format the files it prints.
190 ;; `ps-printer-name' takes its initial value from the variable
191 ;; `printer-name'. `ps-printer-name-option' tries to guess which system
192 ;; Emacs is running and takes its initial value in accordance with this
193 ;; guess.
195 ;; The variable `ps-print-region-function' specifies a function to print the
196 ;; region on a PostScript printer.
197 ;; See definition of `call-process-region' for calling conventions. The fourth
198 ;; and the sixth arguments are both nil.
200 ;; The variable `ps-manual-feed' indicates if the printer will manually feed
201 ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
202 ;; feeding takes place. The default is nil (automatic feeding).
204 ;; The variable `ps-end-with-control-d' specifies whether C-d (\x04) should be
205 ;; inserted at end of PostScript generated. Non-nil means do so. The default
206 ;; is nil (don't insert).
208 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
209 ;; customize the following variables: `ps-printer-name',
210 ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
211 ;; `ps-spool-config'. See these variables documentation in the code or by
212 ;; typing, for example, C-h v ps-printer-name RET.
215 ;; The Page Layout
216 ;; ---------------
218 ;; All dimensions are floats in PostScript points.
219 ;; 1 inch == 2.54 cm == 72 points
220 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
222 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
223 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
224 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
225 ;; `b5'.
227 ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
228 ;; PostScript printer doesn't have a paper with the size indicated by
229 ;; `ps-paper-type', instead it uses the default paper size. If variable
230 ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
231 ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
232 ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
233 ;; Printers). The default value is non-nil (it gives an error).
235 ;; The variable `ps-landscape-mode' determines the orientation of the printing
236 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
237 ;; There is no oblique mode yet, though this is easy to do in ps.
239 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in
240 ;; portrait mode and only 50 lines in landscape mode. The margins represent
241 ;; margins in the printed paper: the top margin is the margin between the top
242 ;; of the page and the printed header, whatever the orientation is.
244 ;; The variable `ps-number-of-columns' determines the number of columns both in
245 ;; landscape and portrait mode.
246 ;; You can use:
247 ;; - (the standard) one column portrait mode.
248 ;; - (my favorite) two columns landscape mode (which spares trees).
249 ;; but also:
250 ;; - one column landscape mode for files with very long lines.
251 ;; - multi-column portrait or landscape mode.
253 ;; The variable `ps-print-upside-down' determines other orientation for
254 ;; printing page: nil means `normal' printing, non-nil means `upside-down'
255 ;; printing (that is, the page is rotated by 180 grades). The default value is
256 ;; nil (`normal' printing).
258 ;; The `upside-down' orientation can be used in portrait or landscape mode.
260 ;; The variable `ps-selected-pages' specifies which pages to print. If it's
261 ;; nil, all pages are printed. If it's a list, the list element may be an
262 ;; integer or a cons cell (FROM . TO) designating FROM page to TO page; any
263 ;; invalid element is ignored, that is, an integer lesser than one or if FROM
264 ;; is greater than TO. Otherwise, it's treated as nil. The default value is
265 ;; nil (print all pages). After ps-print processing `ps-selected-pages' is set
266 ;; to nil. But the latest `ps-selected-pages' is saved in
267 ;; `ps-last-selected-pages' (see it for documentation). So you can restore the
268 ;; latest selected pages by using `ps-last-selected-pages' or by calling
269 ;; `ps-restore-selected-pages' command (see it for documentation).
271 ;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
273 ;; Valid values are:
275 ;; nil print all pages.
277 ;; even-page print only even pages.
279 ;; odd-page print only odd pages.
281 ;; even-sheet print only even sheets.
283 ;; odd-sheet print only odd sheets.
285 ;; Any other value is treated as nil. The default value is nil.
287 ;; See `ps-even-or-odd-pages' for more detailed documentation.
290 ;; Horizontal layout
291 ;; -----------------
293 ;; The horizontal layout is determined by the variables
294 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
295 ;; as follows:
297 ;; ------------------------------------------
298 ;; | | | | | | | |
299 ;; | lm | text | ic | text | ic | text | rm |
300 ;; | | | | | | | |
301 ;; ------------------------------------------
303 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
304 ;; Usually, lm = rm > 0 and ic = lm
305 ;; If (ic < 0), the text of adjacent columns can overlap.
308 ;; Vertical layout
309 ;; ---------------
311 ;; The vertical layout is determined by the variables
312 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' `ps-footer-offset'
313 ;; as follows:
315 ;; |--------| |--------| |--------| |--------|
316 ;; | tm | | tm | | tm | | tm |
317 ;; |--------| |--------| |--------| |--------|
318 ;; | header | | | | header | | |
319 ;; |--------| | | |--------| | |
320 ;; | ho | | | | ho | | |
321 ;; |--------| | | |--------| | |
322 ;; | | | | | | | |
323 ;; | text | or | text | or | text | or | text |
324 ;; | | | | | | | |
325 ;; | | |--------| |--------| | |
326 ;; | | | fo | | fo | | |
327 ;; | | |--------| |--------| | |
328 ;; | | | footer | | footer | | |
329 ;; |--------| |--------| |--------| |--------|
330 ;; | bm | | bm | | bm | | bm |
331 ;; |--------| |--------| |--------| |--------|
333 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
334 ;; If `ps-print-footer' is nil, `ps-footer-offset' is not relevant.
335 ;; The margins represent margins in the printed paper:
336 ;; the top margin is the margin between the top of the page and the printed
337 ;; header, whatever the orientation is;
338 ;; the bottom margin is the margin between the bottom of the page and the
339 ;; printed footer, whatever the orientation is.
342 ;; Headers & Footers
343 ;; -----------------
345 ;; ps-print can print headers at the top of each column or at the top of each
346 ;; page; the default headers contain the following four items: on the left, the
347 ;; name of the buffer and, if the buffer is visiting a file, the file's
348 ;; directory; on the right, the page number and date of printing. The default
349 ;; headers look something like this:
351 ;; ps-print.el 1/21
352 ;; /home/jct/emacs-lisp/ps/new 94/12/31
354 ;; When printing on duplex printers, left and right are reversed so that the
355 ;; page numbers are toward the outside (cf. `ps-spool-duplex').
357 ;; Headers are configurable:
358 ;; To turn them off completely, set `ps-print-header' to nil.
359 ;; To turn off the header's gaudy framing box,
360 ;; set `ps-print-header-frame' to nil.
362 ;; The variable `ps-header-frame-alist' specifies header frame properties
363 ;; alist. Valid frame properties are:
365 ;; fore-color Specify the foreground frame color.
366 ;; It should be a float number between 0.0 (black color)
367 ;; and 1.0 (white color), a string which is a color name,
368 ;; or a list of 3 float numbers which corresponds to the
369 ;; Red Green Blue color scale, each float number between
370 ;; 0.0 (dark color) and 1.0 (bright color).
371 ;; The default is 0 ("black").
373 ;; back-color Specify the background frame color (similar to
374 ;; fore-color). The default is 0.9 ("gray90").
376 ;; shadow-color Specify the shadow color (similar to fore-color).
377 ;; The default is 0 ("black").
379 ;; border-color Specify the border color (similar to fore-color).
380 ;; The default is 0 ("black").
382 ;; border-width Specify the border width.
383 ;; The default is 0.4.
385 ;; Any other property is ignored.
387 ;; Don't change this alist directly, instead use customization, or `ps-value',
388 ;; `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
390 ;; To print only one header at the top of each page, set
391 ;; `ps-print-only-one-header' to t.
393 ;; To switch headers, set `ps-switch-header' to:
395 ;; nil Never switch headers.
397 ;; t Always switch headers.
399 ;; duplex Switch headers only when duplexing is on, that is, when
400 ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
402 ;; Any other value is treated as t. The default value is `duplex'.
404 ;; The font family and size of text in the header are determined by the
405 ;; variables `ps-header-font-family', `ps-header-font-size' and
406 ;; `ps-header-title-font-size' (see below).
408 ;; The variable `ps-header-line-pad' determines the portion of a header title
409 ;; line height to insert between the header frame and the text it contains,
410 ;; both in the vertical and horizontal directions: .5 means half a line.
412 ;; Page numbers are printed in `n/m' format, indicating page n of m pages; to
413 ;; omit the total page count and just print the page number, set
414 ;; `ps-show-n-of-n' to nil.
416 ;; The amount of information in the header can be changed by changing the
417 ;; number of lines. To show less, set `ps-header-lines' to 1, and the header
418 ;; will show only the buffer name and page number. To show more, set
419 ;; `ps-header-lines' to 3, and the header will show the time of printing below
420 ;; the date.
422 ;; To change the content of the headers, change the variables `ps-left-header'
423 ;; and `ps-right-header'.
424 ;; These variables are lists, specifying top-to-bottom the text to display on
425 ;; the left or right side of the header. Each element of the list should be a
426 ;; string or a symbol. Strings are inserted directly into the PostScript
427 ;; arrays, and should contain the PostScript string delimiters '(' and ')'.
429 ;; Symbols in the header format lists can either represent functions or
430 ;; variables. Functions are called, and should return a string to show in the
431 ;; header. Variables should contain strings to display in the header. In
432 ;; either case, function or variable, the PostScript string delimiters are
433 ;; added by ps-print, and should not be part of the returned value.
435 ;; Here's an example: say we want the left header to display the text
437 ;; Moe
438 ;; Larry
439 ;; Curly
441 ;; where we have a function to return "Moe"
443 ;; (defun moe-func ()
444 ;; "Moe")
446 ;; a variable specifying "Larry"
448 ;; (setq larry-var "Larry")
450 ;; and a literal for "Curly". Here's how `ps-left-header' should be set:
452 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
454 ;; Note that Curly has the PostScript string delimiters inside his quotes --
455 ;; those aren't misplaced lisp delimiters!
457 ;; Without them, PostScript would attempt to call the undefined function Curly,
458 ;; which would result in a PostScript error.
460 ;; Since most printers don't report PostScript errors except by aborting the
461 ;; print job, this kind of error can be hard to track down.
463 ;; Consider yourself warned!
465 ;; ps-print also print footers. The footer variables are: `ps-print-footer',
466 ;; `ps-footer-offset', `ps-print-footer-frame', `ps-footer-font-family',
467 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
468 ;; `ps-left-footer', `ps-right-footer' and `ps-footer-frame-alist'. These
469 ;; variables are similar to those one that control headers.
471 ;; The variables `ps-print-only-one-header' and `ps-switch-header' also control
472 ;; the footer (The same way that control header).
474 ;; As a footer example, if you want to have a centered page number in the
475 ;; footer but without headers, set:
477 ;; (setq ps-print-header nil
478 ;; ps-print-footer t
479 ;; ps-print-footer-frame nil
480 ;; ps-footer-lines 1
481 ;; ps-right-footer nil
482 ;; ps-left-footer
483 ;; (list (concat "{pagenumberstring dup stringwidth pop"
484 ;; " 2 div PrintWidth 2 div exch sub 0 rmoveto}")))
487 ;; PostScript Prologue Header
488 ;; --------------------------
490 ;; It is possible to add PostScript prologue header comments besides that
491 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
493 ;; `ps-print-prologue-header' may be a string or a symbol function which
494 ;; returns a string. Note that this string is inserted on PostScript prologue
495 ;; header section which is used to define some document characteristic through
496 ;; PostScript special comments, like "%%Requirements: jog\n".
498 ;; By default `ps-print-prologue-header' is nil.
500 ;; ps-print always inserts the %%Requirements: comment, so if you need to
501 ;; insert more requirements put them first in `ps-print-prologue-header' using
502 ;; the "%%+" comment. For example, if you need to set numcopies to 3 and jog
503 ;; on requirements and set %%LanguageLevel: to 2, do:
505 ;; (setq ps-print-prologue-header
506 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
508 ;; The duplex requirement is inserted by ps-print (see section Duplex
509 ;; Printers).
511 ;; Do not forget to terminate the string with "\n".
513 ;; For more information about PostScript document comments, see:
514 ;; PostScript Language Reference Manual (2nd edition)
515 ;; Adobe Systems Incorporated
516 ;; Appendix G: Document Structuring Conventions -- Version 3.0
518 ;; It is also possible to add an user defined PostScript prologue code before
519 ;; all generated prologue code by setting the variable
520 ;; `ps-user-defined-prologue'.
522 ;; `ps-user-defined-prologue' may be a string or a symbol function which
523 ;; returns a string. Note that this string is inserted after `ps-adobe-tag'
524 ;; and PostScript prologue comments, and before ps-print PostScript prologue
525 ;; code section. That is, this string is inserted after error handler
526 ;; initialization and before ps-print settings.
528 ;; By default `ps-user-defined-prologue' is nil.
530 ;; It's strongly recommended only insert PostScript code and/or comments
531 ;; specific for your printing system particularities. For example, some
532 ;; special initialization that only your printing system needs.
534 ;; Do not insert code for duplex printing, n-up printing or error handler,
535 ;; ps-print handles this in a suitable way.
537 ;; For more information about PostScript, see:
538 ;; PostScript Language Reference Manual (2nd edition)
539 ;; Adobe Systems Incorporated
541 ;; As an example for `ps-user-defined-prologue' setting:
543 ;; ;; Setting for HP PostScript printer
544 ;; (setq ps-user-defined-prologue
545 ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
546 ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
549 ;; PostScript Error Handler
550 ;; ------------------------
552 ;; ps-print instruments generated PostScript code with an error handler.
554 ;; The variable `ps-error-handler-message' specifies where the error handler
555 ;; message should be sent.
557 ;; Valid values are:
559 ;; none catch the error and *DON'T* send any message.
561 ;; paper catch the error and print on paper the error message.
562 ;; This is the default value.
564 ;; system catch the error and send back the error message to
565 ;; printing system. This is useful only if printing
566 ;; system send back an email reporting the error, or if
567 ;; there is some other alternative way to report back the
568 ;; error from the system to you.
570 ;; paper-and-system catch the error, print on paper the error message and
571 ;; send back the error message to printing system.
573 ;; Any other value is treated as `paper'.
576 ;; Duplex Printers
577 ;; ---------------
579 ;; If you have a duplex-capable printer (one that prints both sides of the
580 ;; paper), set `ps-spool-duplex' to t.
581 ;; ps-print will insert blank pages to make sure each buffer starts on the
582 ;; correct side of the paper.
584 ;; The variable `ps-spool-config' specifies who is the responsible for setting
585 ;; duplex and page size. Valid values are:
587 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
588 ;; Don't forget to set `ps-lpr-switches' to select duplex
589 ;; printing for your printer.
591 ;; setpagedevice duplex and page size are configured by ps-print using the
592 ;; setpagedevice PostScript operator.
594 ;; nil duplex and page size are configured by ps-print *not* using
595 ;; the setpagedevice PostScript operator.
597 ;; Any other value is treated as nil.
599 ;; The default value is `lpr-switches'.
601 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility
602 ;; when viewing file generated using landscape. Also on some
603 ;; printers, setpagedevice affects zebra stripes; on other printers,
604 ;; setpagedevice affects the left margin.
605 ;; Besides all that, if your printer does not have the paper size
606 ;; specified by setpagedevice, your printing will be aborted.
607 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
608 ;; `setpagedevice', generate a test file and send it to your printer;
609 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
611 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
612 ;; sides of a sheet are oriented with respect to each other. If
613 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left
614 ;; or right. If `ps-spool-tumble' is non-nil, produces output suitable for
615 ;; binding at the top or bottom. It has effect only when `ps-spool-duplex' is
616 ;; non-nil. The default value is nil.
618 ;; Some printer system prints a header page and forces the first page be
619 ;; printed on header page back, when using duplex. If your printer system has
620 ;; this behavior, set variable `ps-banner-page-when-duplexing' to t.
622 ;; When `ps-banner-page-when-duplexing' is non-nil, it prints a blank page as
623 ;; the very first printed page. So, it behaves as the very first character of
624 ;; buffer (or region) is ^L (\014).
626 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the
627 ;; very first page).
630 ;; N-up Printing
631 ;; -------------
633 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
634 ;; paper. The value specified must be between 1 and 100. The default is 1.
636 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is
637 ;; set to a high value (for example, 23). If this happens, set a lower value.
639 ;; The variable `ps-n-up-margin' specifies the margin in points between the
640 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
641 ;; or 28.35 points).
643 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each
644 ;; page. The default is t.
646 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
647 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
648 ;; filling example using a 3x4 page matrix:
650 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
651 ;; 5 6 7 8 5 6 7 8
652 ;; 9 10 11 12 1 2 3 4
654 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
655 ;; 8 7 6 5 8 7 6 5
656 ;; 12 11 10 9 4 3 2 1
658 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
659 ;; 2 5 8 11 2 5 8 11
660 ;; 3 6 9 12 1 4 7 10
662 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
663 ;; 11 8 5 2 11 8 5 2
664 ;; 12 9 6 3 10 7 4 1
666 ;; Any other value is treated as `left-top'.
668 ;; The default value is left-top.
671 ;; Control And 8-bit Characters
672 ;; ----------------------------
674 ;; The variable `ps-print-control-characters' specifies whether you want to see
675 ;; a printable form for control and 8-bit characters, that is, instead of
676 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
678 ;; Valid values for `ps-print-control-characters' are:
680 ;; 8-bit This is the value to use when you want an ASCII encoding of
681 ;; any control or non-ASCII character. Control characters are
682 ;; encoded as "^D", and non-ASCII characters have an
683 ;; octal encoding.
685 ;; control-8-bit This is the value to use when you want an ASCII encoding of
686 ;; any control character, whether it is 7 or 8-bit.
687 ;; European 8-bits accented characters are printed according
688 ;; the current font.
690 ;; control Only ASCII control characters have an ASCII encoding.
691 ;; European 8-bits accented characters are printed according
692 ;; the current font.
694 ;; nil No ASCII encoding. Any character is printed according the
695 ;; current font.
697 ;; Any other value is treated as nil.
699 ;; The default is `control-8-bit'.
701 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
704 ;; Printing Multi-byte Buffer
705 ;; --------------------------
707 ;; See ps-mule.el for documentation.
710 ;; Line Number
711 ;; -----------
713 ;; The variable `ps-line-number' specifies whether to number each line;
714 ;; non-nil means do so. The default is nil (don't number each line).
716 ;; The variable `ps-line-number-color' specifies the color for line number.
717 ;; See `ps-zebra-color' for documentation. The default is "black" (or 0.0, or
718 ;; '(0.0 0.0 0.0)).
720 ;; The variable `ps-line-number-font' specifies the font for line number.
721 ;; The default is "Times-Italic".
723 ;; The variable `ps-line-number-font-size' specifies the font size in points
724 ;; for line number. See `ps-font-size' for documentation. The default is 6.
726 ;; The variable `ps-line-number-step' specifies the interval that line number
727 ;; is printed. For example, if `ps-line-number-step' is set to 2, the printing
728 ;; will look like:
730 ;; 1 one line
731 ;; one line
732 ;; 3 one line
733 ;; one line
734 ;; 5 one line
735 ;; one line
736 ;; ...
738 ;; Valid values are:
740 ;; integer an integer that specifies the interval that line number is
741 ;; printed. If it's lesser than or equal to zero, it's used the
742 ;; value 1.
744 ;; `zebra' specifies that only the line number of the first line in a
745 ;; zebra stripe is to be printed.
747 ;; Any other value is treated as `zebra'.
748 ;; The default value is 1, so each line number is printed.
750 ;; The variable `ps-line-number-start' specifies the starting point in the
751 ;; interval given by `ps-line-number-step'. For example, if
752 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3,
753 ;; the printing will look like:
755 ;; one line
756 ;; one line
757 ;; 3 one line
758 ;; one line
759 ;; one line
760 ;; 6 one line
761 ;; one line
762 ;; one line
763 ;; 9 one line
764 ;; one line
765 ;; ...
767 ;; The values for `ps-line-number-start':
769 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
770 ;; of `ps-line-number-step' inclusive.
772 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
773 ;; value of `ps-zebra-stripe-height' inclusive.
775 ;; The default value is 1, so the line number of the first line of each
776 ;; interval is printed.
779 ;; Zebra Stripes
780 ;; -------------
782 ;; Zebra stripes are a kind of background that appear "underneath" the text and
783 ;; can make the text easier to read. They look like this:
785 ;; XXXXXXXXXXXXXXXXXXXXXXXX
786 ;; XXXXXXXXXXXXXXXXXXXXXXXX
787 ;; XXXXXXXXXXXXXXXXXXXXXXXX
791 ;; XXXXXXXXXXXXXXXXXXXXXXXX
792 ;; XXXXXXXXXXXXXXXXXXXXXXXX
793 ;; XXXXXXXXXXXXXXXXXXXXXXXX
795 ;; The blocks of X's represent rectangles filled with a light gray color.
796 ;; Each rectangle extends all the way across the page.
798 ;; The height, in lines, of each rectangle is controlled by the variable
799 ;; `ps-zebra-stripe-height', which is 3 by default. The distance between
800 ;; stripes equals the height of a stripe.
802 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
803 ;; Non-nil means yes, nil means no. The default is nil.
805 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
806 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
807 ;; color), a string which is a color name, or a list of 3 numbers which
808 ;; corresponds to the Red Green Blue color scale.
809 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
811 ;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
812 ;; on next page. Visually, valid values are (the character `+' at right of
813 ;; each column indicates that a line is printed):
815 ;; `nil' `follow' `full' `full-follow'
816 ;; Current Page -------- ----------- --------- ----------------
817 ;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
818 ;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
819 ;; 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
820 ;; 4 + 4 + 4 + 4 +
821 ;; 5 + 5 + 5 + 5 +
822 ;; 6 + 6 + 6 + 6 +
823 ;; 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
824 ;; 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
825 ;; 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
826 ;; 10 + 10 +
827 ;; 11 + 11 +
828 ;; -------- ----------- --------- ----------------
829 ;; Next Page -------- ----------- --------- ----------------
830 ;; 12 XXXXX + 12 + 10 XXXXXX + 10 +
831 ;; 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
832 ;; 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
833 ;; 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
834 ;; 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
835 ;; 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
836 ;; 18 XXXXX + 18 + 16 XXXXXX + 16 +
837 ;; 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
838 ;; 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
839 ;; 21 + 21 XXXXXXXX +
840 ;; 22 + 22 +
841 ;; -------- ----------- --------- ----------------
843 ;; Any other value is treated as nil.
845 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
848 ;; Hooks
849 ;; -----
851 ;; ps-print has the following hook variables:
853 ;; `ps-print-hook'
854 ;; It is evaluated once before any printing process. This is the right
855 ;; place to initialize ps-print global data.
856 ;; For an example, see section Adding a New Font Family.
858 ;; `ps-print-begin-sheet-hook'
859 ;; It is evaluated on each beginning of sheet of paper.
860 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
861 ;; evaluated.
863 ;; `ps-print-begin-page-hook'
864 ;; It is evaluated on each beginning of page, except in the beginning of
865 ;; page that `ps-print-begin-sheet-hook' is evaluated.
867 ;; `ps-print-begin-column-hook'
868 ;; It is evaluated on each beginning of column, except in the beginning of
869 ;; column that `ps-print-begin-page-hook' is evaluated or that
870 ;; `ps-print-begin-sheet-hook' is evaluated.
873 ;; Font Managing
874 ;; -------------
876 ;; ps-print now knows rather precisely some fonts: the variable
877 ;; `ps-font-info-database' contains information for a list of font families
878 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino'
879 ;; `Helvetica-Narrow' `NewCenturySchlbk'). Each font family contains the font
880 ;; names for standard, bold, italic and bold-italic characters, a reference
881 ;; size (usually 10) and the corresponding line height, width of a space and
882 ;; average character width.
884 ;; The variable `ps-font-family' determines which font family is to be used for
885 ;; ordinary text. If its value does not correspond to a known font family, an
886 ;; error message is printed into the `*Messages*' buffer, which lists the
887 ;; currently available font families.
889 ;; The variable `ps-font-size' determines the size (in points) of the font for
890 ;; ordinary text, when generating PostScript. Its value is a float or a cons
891 ;; of floats which has the following form:
893 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
895 ;; Similarly, the variable `ps-header-font-family' determines which font family
896 ;; is to be used for text in the header.
898 ;; The variable `ps-header-font-size' determines the font size, in points, for
899 ;; text in the header (similar to `ps-font-size').
901 ;; The variable `ps-header-title-font-size' determines the font size, in
902 ;; points, for the top line of text in the header (similar to `ps-font-size').
904 ;; The variable `ps-line-spacing' determines the line spacing, in points, for
905 ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The
906 ;; default value is 0 (zero = no line spacing).
908 ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in
909 ;; points, for ordinary text, when generating PostScript (similar to
910 ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing).
912 ;; To get all lines with some spacing set both `ps-line-spacing' and
913 ;; `ps-paragraph-spacing' variables.
915 ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It
916 ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an
917 ;; empty line or a line containing only spaces and tabs.
919 ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start
920 ;; and end of a region to cut out when printing.
922 ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may
923 ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave
924 ;; out some special printing instructions from the actual print. Special
925 ;; printing instructions may be appended to the end of the file just like any
926 ;; other buffer-local variables. See section "Local Variables in Files" on
927 ;; Emacs manual for more information.
929 ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together
930 ;; what actually gets printed. Both variables may be set to nil in which case
931 ;; no cutting occurs. By default, both variables are set to nil.
934 ;; Adding a New Font Family
935 ;; ------------------------
937 ;; To use a new font family, you MUST first teach ps-print this font, i.e., add
938 ;; its information to `ps-font-info-database', otherwise ps-print cannot
939 ;; correctly place line and page breaks.
941 ;; For example, assuming `Helvetica' is unknown, you first need to do the
942 ;; following ONLY ONCE:
944 ;; - create a new buffer
945 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
946 ;; - open this file and find the line:
947 ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
948 ;; - delete the leading `%' (which is the PostScript comment character)
949 ;; - replace in this line `Courier' by the new font (say `Helvetica') to get
950 ;; the line:
951 ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
952 ;; - send this file to the printer (or to ghostscript).
953 ;; You should read the following on the output page:
955 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
956 ;; and a crude estimate of average character width is 5.09243
958 ;; - Add these values to the `ps-font-info-database':
959 ;; (setq ps-font-info-database
960 ;; (append
961 ;; '((Helvetica ; the family key
962 ;; (fonts (normal . "Helvetica")
963 ;; (bold . "Helvetica-Bold")
964 ;; (italic . "Helvetica-Oblique")
965 ;; (bold-italic . "Helvetica-BoldOblique"))
966 ;; (size . 10.0)
967 ;; (line-height . 11.56)
968 ;; (space-width . 2.78)
969 ;; (avg-char-width . 5.09243)))
970 ;; ps-font-info-database))
971 ;; - Now you can use this font family with any size:
972 ;; (setq ps-font-family 'Helvetica)
973 ;; - if you want to use this family in another emacs session, you must put into
974 ;; your `~/.emacs':
975 ;; (require 'ps-print)
976 ;; (setq ps-font-info-database (append ...)))
977 ;; if you don't want to load ps-print, you have to copy the whole value:
978 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
979 ;; or, use `ps-print-hook' (see section Hooks):
980 ;; (add-hook 'ps-print-hook
981 ;; '(lambda ()
982 ;; (or (assq 'Helvetica ps-font-info-database)
983 ;; (setq ps-font-info-database (append ...)))))
985 ;; You can create new `mixed' font families like:
986 ;; (my-mixed-family
987 ;; (fonts (normal . "Courier-Bold")
988 ;; (bold . "Helvetica")
989 ;; (italic . "Zapf-Chancery-MediumItalic")
990 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
991 ;; (w3-table-hack-x-face . "LineDrawNormal"))
992 ;; (size . 10.0)
993 ;; (line-height . 10.55)
994 ;; (space-width . 6.0)
995 ;; (avg-char-width . 6.0))
997 ;; Now you can use your new font family with any size:
998 ;; (setq ps-font-family 'my-mixed-family)
1000 ;; Note that on above example the `w3-table-hack-x-face' entry refers to a face
1001 ;; symbol, so when printing this face it'll be used the font `LineDrawNormal'.
1002 ;; If the face `w3-table-hack-x-face' is remapped to use bold and/or italic
1003 ;; attribute, the corresponding entry (bold, italic or bold-italic) will be
1004 ;; used instead of `w3-table-hack-x-face' entry.
1006 ;; Note also that the font family entry order is irrelevant, so the above
1007 ;; example could also be written:
1008 ;; (my-mixed-family
1009 ;; (size . 10.0)
1010 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
1011 ;; (bold . "Helvetica")
1012 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
1013 ;; (italic . "Zapf-Chancery-MediumItalic")
1014 ;; (normal . "Courier-Bold"))
1015 ;; (avg-char-width . 6.0)
1016 ;; (space-width . 6.0)
1017 ;; (line-height . 10.55))
1019 ;; Despite the note above, it is recommended that some convention about
1020 ;; entry order be used.
1022 ;; You can get information on all the fonts resident in YOUR printer
1023 ;; by uncommenting the line:
1024 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
1026 ;; The PostScript file should be sent to YOUR PostScript printer.
1027 ;; If you send it to ghostscript or to another PostScript printer, you may get
1028 ;; slightly different results.
1029 ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
1031 ;; Note also that ps-print DOESN'T download any font to your printer, instead
1032 ;; it uses the fonts resident in your printer.
1035 ;; How Ps-Print Deals With Faces
1036 ;; -----------------------------
1038 ;; The ps-print-*-with-faces commands attempt to determine which faces should
1039 ;; be printed in bold or italic, but their guesses aren't always right. For
1040 ;; example, you might want to map colors into faces so that blue faces print in
1041 ;; bold, and red faces in italic.
1043 ;; It is possible to force ps-print to consider specific faces bold, italic or
1044 ;; underline, no matter what font they are displayed in, by setting the
1045 ;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
1046 ;; These variables contain lists of faces that ps-print should consider bold,
1047 ;; italic or underline; to set them, put code like the following into your
1048 ;; .emacs file:
1050 ;; (setq ps-bold-faces '(my-blue-face))
1051 ;; (setq ps-italic-faces '(my-red-face))
1052 ;; (setq ps-underlined-faces '(my-green-face))
1054 ;; Faces like bold-italic that are both bold and italic should go in *both*
1055 ;; lists.
1057 ;; ps-print keeps internal lists of which fonts are bold and which are italic;
1058 ;; these lists are built the first time you invoke ps-print.
1059 ;; For the sake of efficiency, the lists are built only once; the same lists
1060 ;; are referred in later invocations of ps-print.
1062 ;; Because these lists are built only once, it's possible for them to get out
1063 ;; of sync, if a face changes, or if new faces are added. To get the lists
1064 ;; back in sync, you can set the variable `ps-build-face-reference' to t, and
1065 ;; the lists will be rebuilt the next time ps-print is invoked. If you need
1066 ;; that the lists always be rebuilt when ps-print is invoked, set the variable
1067 ;; `ps-always-build-face-reference' to t.
1069 ;; If you need to print without worrying about face background color, set the
1070 ;; variable `ps-use-face-background' which specifies if face background should
1071 ;; be used. Valid values are:
1073 ;; t always use face background color.
1074 ;; nil never use face background color.
1075 ;; (face...) list of faces whose background color will be used.
1077 ;; Any other value will be treated as t.
1078 ;; The default value is nil.
1081 ;; How Ps-Print Deals With Color
1082 ;; -----------------------------
1084 ;; ps-print detects faces with foreground and background colors defined and
1085 ;; embeds color information in the PostScript image.
1086 ;; The default foreground and background colors are defined by the variables
1087 ;; `ps-default-fg' and `ps-default-bg'.
1088 ;; On black/white printers, colors are displayed in gray scale.
1089 ;; To turn off color output, set `ps-print-color-p' to nil.
1090 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
1091 ;; on black/white printers. See also `ps-black-white-faces' for documentation.
1094 ;; How Ps-Print Maps Faces
1095 ;; -----------------------
1097 ;; As ps-print uses PostScript to print buffers, it is possible to have other
1098 ;; attributes associated with faces. So the new attributes used by ps-print
1099 ;; are:
1101 ;; strikeout - like underline, but the line is in middle of text.
1102 ;; overline - like underline, but the line is over the text.
1103 ;; shadow - text will have a shadow.
1104 ;; box - text will be surrounded by a box.
1105 ;; outline - print characters as hollow outlines.
1107 ;; See the documentation for `ps-extend-face'.
1109 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1110 ;; color and bold attribute:
1112 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
1114 ;; If you want to use a new face, define it first with `defface', and then call
1115 ;; `ps-extend-face' to specify how to print it.
1118 ;; How Ps-Print Has A Text And/Or Image On Background
1119 ;; --------------------------------------------------
1121 ;; ps-print can print texts and/or EPS PostScript images on background; it is
1122 ;; possible to define the following text attributes: font name, font size,
1123 ;; initial position, angle, gray scale and pages to print.
1125 ;; It has the following EPS PostScript images attributes: file name containing
1126 ;; the image, initial position, X and Y scales, angle and pages to print.
1128 ;; See documentation for `ps-print-background-text' and
1129 ;; `ps-print-background-image'.
1131 ;; For example, if we wish to print text "preliminary" on all pages and text
1132 ;; "special" on page 5 and from page 11 to page 17, we could specify:
1134 ;; (setq ps-print-background-text
1135 ;; '(("preliminary")
1136 ;; ("special"
1137 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
1138 ;; ; (upper left corner)
1139 ;; nil nil nil
1140 ;; "PrintHeight neg PrintPageWidth atan" ; angle
1141 ;; 5 (11 . 17)) ; page list
1142 ;; ))
1144 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
1145 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
1146 ;; specify:
1148 ;; (setq ps-print-background-image
1149 ;; '(("~/images/EPS-image1.ps"
1150 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
1151 ;; ("~/images/EPS-image2.ps"
1152 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y pos.
1153 ;; ; (upper left corner)
1154 ;; nil nil nil
1155 ;; 5 (11 . 17)) ; page list
1156 ;; ))
1158 ;; If it is not possible to read (or does not exist) an image file, that file
1159 ;; is ignored.
1161 ;; The printing order is:
1163 ;; 1. Print background color
1164 ;; 2. Print zebra stripes
1165 ;; 3. Print background texts that it should be on all pages
1166 ;; 4. Print background images that it should be on all pages
1167 ;; 5. Print background texts only for current page (if any)
1168 ;; 6. Print background images only for current page (if any)
1169 ;; 7. Print header
1170 ;; 8. Print buffer text (with faces, if specified) and line number
1173 ;; Utilities
1174 ;; ---------
1176 ;; Some tools are provided to help you customize your font setup.
1178 ;; `ps-setup' returns (some part of) the current setup.
1180 ;; To avoid wrapping too many lines, you may want to adjust the left and right
1181 ;; margins and the font size. On UN*X systems, do:
1182 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1183 ;; to determine the longest lines of your file.
1184 ;; Then, the command `ps-line-lengths' will give you the correspondence between
1185 ;; a line length (number of characters) and the maximum font size which doesn't
1186 ;; wrap such a line with the current ps-print setup.
1188 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display the
1189 ;; correspondence between a number of pages and the maximum font size which
1190 ;; allow the number of lines of the current buffer or of its current region to
1191 ;; fit in this number of pages.
1193 ;; NOTE: line folding is not taken into account in this process and could
1194 ;; change the results.
1196 ;; The command `ps-print-customize' activates a customization buffer for
1197 ;; ps-print options.
1200 ;; New since version 1.5
1201 ;; ---------------------
1203 ;; Color output capability.
1204 ;; Automatic detection of font attributes (bold, italic).
1205 ;; Configurable headers with page numbers.
1206 ;; Slightly faster.
1207 ;; Support for different paper sizes.
1208 ;; Better conformance to PostScript Document Structure Conventions.
1211 ;; New since version 2.8
1212 ;; ---------------------
1214 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1216 ;; 20010619
1217 ;; `ps-time-stamp-locale-default'
1219 ;; 20010530
1220 ;; Handle before-string and after-string overlay properties.
1222 ;; 20010407
1223 ;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
1224 ;; `ps-print-footer-frame', `ps-footer-font-family',
1225 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
1226 ;; `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
1227 ;; `ps-header-frame-alist'.
1229 ;; 20010328
1230 ;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
1231 ;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
1233 ;; 20001122
1234 ;; `ps-line-number-font', `ps-line-number-font-size' and
1235 ;; `ps-end-with-control-d'.
1237 ;; 20000821
1238 ;; `ps-even-or-odd-pages'
1240 ;; 20000617
1241 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
1242 ;; `ps-selected-pages', `ps-last-selected-pages',
1243 ;; `ps-restore-selected-pages', `ps-switch-header',
1244 ;; `ps-line-number-step', `ps-line-number-start',
1245 ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
1247 ;; 20000310
1248 ;; PostScript error handler.
1249 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1251 ;; 19991211
1252 ;; `ps-print-customize'.
1254 ;; 19990703
1255 ;; Better customization.
1256 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1258 ;; 19990513
1259 ;; N-up printing.
1260 ;; Hook: `ps-print-begin-sheet-hook'.
1262 ;; [keinichi] 19990509 Kein'ichi Handa <handa@etl.go.jp>
1264 ;; `ps-print-region-function'
1266 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1268 ;; 19990301
1269 ;; PostScript tumble and setpagedevice.
1271 ;; 19980922
1272 ;; PostScript prologue header comment insertion.
1273 ;; Skip invisible text better.
1275 ;; [keinichi] 19980819 Kein'ichi Handa <handa@etl.go.jp>
1277 ;; Multi-byte buffer handling.
1279 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1281 ;; 19980306
1282 ;; Skip invisible text.
1284 ;; 19971130
1285 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1286 ;; `ps-print-begin-column-hook'.
1287 ;; Put one header per page over the columns.
1288 ;; Better database font management.
1289 ;; Better control characters handling.
1291 ;; 19971121
1292 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1293 ;; Handle control characters.
1294 ;; Face remapping.
1295 ;; New face attributes.
1296 ;; Line number.
1297 ;; Zebra stripes.
1298 ;; Text and/or image on background.
1300 ;; [jack] 19960517 Jacques Duthen <duthen@cegelec-red.fr>
1302 ;; Font family and float size for text and header.
1303 ;; Landscape mode.
1304 ;; Multiple columns.
1305 ;; Tools for page setup.
1308 ;; Known bugs and limitations of ps-print
1309 ;; --------------------------------------
1311 ;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
1312 ;; particular, bold or italic fonts don't print in the right background color.
1314 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1316 ;; Automatic font-attribute detection doesn't work well, especially with
1317 ;; hilit19 and older versions of get-create-face. Users having problems with
1318 ;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
1319 ;; and `ps-underlined-faces' and/or turn off automatic detection by setting
1320 ;; `ps-auto-font-detect' to nil.
1322 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
1323 ;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1324 ;; `ps-underlined-faces' instead.
1326 ;; Still too slow; could use some hand-optimization.
1328 ;; Default background color isn't working.
1330 ;; Faces are always treated as opaque.
1332 ;; Epoch, Lucid and Emacs 19 not supported. At all.
1334 ;; Fixed-pitch fonts work better for line folding, but are not required.
1336 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
1337 ;; lines.
1340 ;; Things to change
1341 ;; ----------------
1343 ;; Avoid page break inside a paragraph.
1344 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1345 ;; Improve the memory management for big files (hard?).
1346 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
1347 ;; lines.
1350 ;; Acknowledgments
1351 ;; ---------------
1353 ;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
1354 ;; for black/white PostScript printers.
1356 ;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
1357 ;; region to cut out when printing and footer suggestions.
1359 ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
1361 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
1362 ;; suggestion.
1364 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1365 ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1367 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1368 ;; suggestion for `ps-postscript-code-directory' variable.
1370 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1371 ;; level 1 compatibility.
1373 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for upside-down,
1374 ;; line number step, line number start and zebra stripe follow suggestions, and
1375 ;; for XEmacs beta-tests.
1377 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1378 ;; prologue code suggestion, for odd/even printing suggestion and for
1379 ;; `ps-prologue-file' enhancement.
1381 ;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling.
1383 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1384 ;; empty columns.
1386 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1387 ;; last page.
1389 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1390 ;; `ps-print-control-characters' variable documentation.
1392 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1393 ;; database font management.
1395 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1396 ;; header per page over the columns and correct line numbers when printing a
1397 ;; region.
1399 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1400 ;; print time of `ps-lpr-switches'.
1402 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1403 ;; (his code was severely modified, but the main idea was kept).
1405 ;; Thanks to some suggestions on:
1406 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1407 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1408 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1410 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for version 3.4 I
1411 ;; started from. [vinicius]
1413 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from. [jack]
1415 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
1416 ;; the invisible property.
1418 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the
1419 ;; initial port to Emacs 19. His code is no longer part of ps-print, but his
1420 ;; work is still appreciated.
1422 ;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for
1423 ;; adding underline support. Their code also is no longer part of ps-print,
1424 ;; but their efforts are not forgotten.
1426 ;; Thanks also to all of you who mailed code to add features to ps-print;
1427 ;; although I didn't use your code, I still appreciate your sharing it with me.
1429 ;; Thanks to all who mailed comments, encouragement, and criticism.
1430 ;; Thanks also to all who responded to my survey; I had too many responses to
1431 ;; reply to them all, but I greatly appreciate your interest.
1433 ;; Jim
1434 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1436 ;;; Code:
1438 (eval-and-compile
1439 (require 'lpr)
1441 (or (featurep 'lisp-float-type)
1442 (error "`ps-print' requires floating point support"))
1445 (defvar ps-print-emacs-type
1446 (let ((case-fold-search t))
1447 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
1448 ((string-match "Lucid" emacs-version)
1449 (error "`ps-print' doesn't support Lucid"))
1450 ((string-match "Epoch" emacs-version)
1451 (error "`ps-print' doesn't support Epoch"))
1453 (unless (and (boundp 'emacs-major-version)
1454 (> emacs-major-version 19))
1455 (error "`ps-print' only supports Emacs 20 and higher"))
1456 'emacs))))
1459 ;; For Emacs 20.2 and the earlier version.
1461 (or (fboundp 'set-buffer-multibyte)
1462 (defun set-buffer-multibyte (arg)
1463 (setq enable-multibyte-characters arg)))
1465 (or (fboundp 'string-as-unibyte)
1466 (defun string-as-unibyte (arg) arg))
1468 (or (fboundp 'string-as-multibyte)
1469 (defun string-as-multibyte (arg) arg))
1471 (or (fboundp 'char-charset)
1472 (defun char-charset (arg) 'ascii))
1474 (or (fboundp 'charset-after)
1475 (defun charset-after (&optional arg)
1476 (char-charset (char-after arg))))
1479 ;; GNU Emacs
1480 (or (fboundp 'line-beginning-position)
1481 (defun line-beginning-position (&optional n)
1482 (save-excursion
1483 (and n (/= n 1) (forward-line (1- n)))
1484 (beginning-of-line)
1485 (point))))
1488 ;; to avoid compilation gripes
1490 ;; XEmacs
1491 (defalias 'ps-x-color-instance-p 'color-instance-p)
1492 (defalias 'ps-x-color-instance-rgb-components 'color-instance-rgb-components)
1493 (defalias 'ps-x-color-name 'color-name)
1494 (defalias 'ps-x-color-specifier-p 'color-specifier-p)
1495 (defalias 'ps-x-copy-coding-system 'copy-coding-system)
1496 (defalias 'ps-x-device-class 'device-class)
1497 (defalias 'ps-x-extent-end-position 'extent-end-position)
1498 (defalias 'ps-x-extent-face 'extent-face)
1499 (defalias 'ps-x-extent-priority 'extent-priority)
1500 (defalias 'ps-x-extent-start-position 'extent-start-position)
1501 (defalias 'ps-x-face-font-instance 'face-font-instance)
1502 (defalias 'ps-x-find-coding-system 'find-coding-system)
1503 (defalias 'ps-x-font-instance-properties 'font-instance-properties)
1504 (defalias 'ps-x-make-color-instance 'make-color-instance)
1505 (defalias 'ps-x-map-extents 'map-extents)
1507 ;; GNU Emacs
1508 (defalias 'ps-e-face-bold-p 'face-bold-p)
1509 (defalias 'ps-e-face-italic-p 'face-italic-p)
1510 (defalias 'ps-e-next-overlay-change 'next-overlay-change)
1511 (defalias 'ps-e-overlays-at 'overlays-at)
1512 (defalias 'ps-e-overlay-get 'overlay-get)
1513 (defalias 'ps-e-overlay-end 'overlay-end)
1514 (defalias 'ps-e-x-color-values 'x-color-values)
1515 (defalias 'ps-e-color-values 'color-values)
1516 (if (fboundp 'find-composition)
1517 (defalias 'ps-e-find-composition 'find-composition)
1518 (defalias 'ps-e-find-composition 'ignore))
1521 (defconst ps-windows-system
1522 (memq system-type '(emx win32 w32 mswindows ms-dos windows-nt)))
1523 (defconst ps-lp-system
1524 (memq system-type '(usg-unix-v dgux hpux irix)))
1527 (defun ps-xemacs-color-name (color)
1528 (if (ps-x-color-specifier-p color)
1529 (ps-x-color-name color)
1530 color))
1533 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
1534 (defvar mark-active nil)
1535 (defun ps-mark-active-p ()
1536 mark-active)
1537 (defalias 'ps-face-foreground-name 'face-foreground)
1538 (defalias 'ps-face-background-name 'face-background)
1540 (t ; xemacs
1541 (defalias 'ps-mark-active-p 'region-active-p)
1542 (defun ps-face-foreground-name (face)
1543 (ps-xemacs-color-name (face-foreground face)))
1544 (defun ps-face-background-name (face)
1545 (ps-xemacs-color-name (face-background face)))
1549 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1550 ;; User Variables:
1553 ;;; Interface to the command system
1555 (defgroup postscript nil
1556 "PostScript Group"
1557 :tag "PostScript"
1558 :group 'emacs)
1560 (defgroup ps-print nil
1561 "PostScript generator for Emacs"
1562 :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
1563 :prefix "ps-"
1564 :group 'wp
1565 :group 'postscript)
1567 (defgroup ps-print-horizontal nil
1568 "Horizontal page layout"
1569 :prefix "ps-"
1570 :tag "Horizontal"
1571 :group 'ps-print)
1573 (defgroup ps-print-vertical nil
1574 "Vertical page layout"
1575 :prefix "ps-"
1576 :tag "Vertical"
1577 :group 'ps-print)
1579 (defgroup ps-print-headers nil
1580 "Headers & footers layout"
1581 :prefix "ps-"
1582 :tag "Header & Footer"
1583 :group 'ps-print)
1585 (defgroup ps-print-font nil
1586 "Fonts customization"
1587 :prefix "ps-"
1588 :tag "Font"
1589 :group 'ps-print)
1591 (defgroup ps-print-color nil
1592 "Color customization"
1593 :prefix "ps-"
1594 :tag "Color"
1595 :group 'ps-print)
1597 (defgroup ps-print-face nil
1598 "Faces customization"
1599 :prefix "ps-"
1600 :tag "PS Faces"
1601 :group 'ps-print
1602 :group 'faces)
1604 (defgroup ps-print-n-up nil
1605 "N-up customization"
1606 :prefix "ps-"
1607 :tag "N-Up"
1608 :group 'ps-print)
1610 (defgroup ps-print-zebra nil
1611 "Zebra customization"
1612 :prefix "ps-"
1613 :tag "Zebra"
1614 :group 'ps-print)
1616 (defgroup ps-print-background nil
1617 "Background customization"
1618 :prefix "ps-"
1619 :tag "Background"
1620 :group 'ps-print)
1622 (defgroup ps-print-printer '((lpr custom-group))
1623 "Printer customization"
1624 :prefix "ps-"
1625 :tag "Printer"
1626 :group 'ps-print)
1628 (defgroup ps-print-page nil
1629 "Page customization"
1630 :prefix "ps-"
1631 :tag "Page"
1632 :group 'ps-print)
1634 (defgroup ps-print-miscellany nil
1635 "Miscellany customization"
1636 :prefix "ps-"
1637 :tag "Miscellany"
1638 :group 'ps-print)
1641 (defcustom ps-error-handler-message 'paper
1642 "*Specify where the error handler message should be sent.
1644 Valid values are:
1646 `none' catch the error and *DON'T* send any message.
1648 `paper' catch the error and print on paper the error message.
1650 `system' catch the error and send back the error message to
1651 printing system. This is useful only if printing system
1652 send back an email reporting the error, or if there is
1653 some other alternative way to report back the error from
1654 the system to you.
1656 `paper-and-system' catch the error, print on paper the error message and
1657 send back the error message to printing system.
1659 Any other value is treated as `paper'."
1660 :type '(choice :menu-tag "Error Handler Message"
1661 :tag "Error Handler Message"
1662 (const none) (const paper)
1663 (const system) (const paper-and-system))
1664 :group 'ps-print-miscellany)
1666 (defcustom ps-user-defined-prologue nil
1667 "*User defined PostScript prologue code inserted before all prologue code.
1669 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1670 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1671 prologue comments, and before ps-print PostScript prologue code section. That
1672 is, this string is inserted after error handler initialization and before
1673 ps-print settings.
1675 It's strongly recommended only insert PostScript code and/or comments specific
1676 for your printing system particularities. For example, some special
1677 initialization that only your printing system needs.
1679 Do not insert code for duplex printing, n-up printing or error handler,
1680 ps-print handles this in a suitable way.
1682 For more information about PostScript, see:
1683 PostScript Language Reference Manual (2nd edition)
1684 Adobe Systems Incorporated
1686 As an example for `ps-user-defined-prologue' setting:
1688 ;; Setting for HP PostScript printer
1689 (setq ps-user-defined-prologue
1690 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1691 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
1692 :type '(choice :menu-tag "User Defined Prologue"
1693 :tag "User Defined Prologue"
1694 (const :tag "none" nil) string symbol)
1695 :group 'ps-print-miscellany)
1697 (defcustom ps-print-prologue-header nil
1698 "*PostScript prologue header comments besides that ps-print generates.
1700 `ps-print-prologue-header' may be a string or a symbol function which returns a
1701 string. Note that this string is inserted on PostScript prologue header
1702 section which is used to define some document characteristic through PostScript
1703 special comments, like \"%%Requirements: jog\\n\".
1705 ps-print always inserts the %%Requirements: comment, so if you need to insert
1706 more requirements put them first in `ps-print-prologue-header' using the
1707 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1708 requirements and set %%LanguageLevel: to 2, do:
1710 (setq ps-print-prologue-header
1711 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1713 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1715 Do not forget to terminate the string with \"\\n\".
1717 For more information about PostScript document comments, see:
1718 PostScript Language Reference Manual (2nd edition)
1719 Adobe Systems Incorporated
1720 Appendix G: Document Structuring Conventions -- Version 3.0"
1721 :type '(choice :menu-tag "Prologue Header"
1722 :tag "Prologue Header"
1723 (const :tag "none" nil) string symbol)
1724 :group 'ps-print-miscellany)
1726 (defcustom ps-printer-name (and (boundp 'printer-name)
1727 (symbol-value 'printer-name))
1728 "*The name of a local printer for printing PostScript files.
1730 On Unix-like systems, a string value should be a name understood by lpr's -P
1731 option; a value of nil means use the value of `printer-name' instead.
1733 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1734 printer device or port to which PostScript files are written, provided
1735 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1736 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1737 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
1738 for a shared network printer. You can also set it to a name of a file, in
1739 which case the output gets appended to that file. \(Note that `ps-print'
1740 package already has facilities for printing to a file, so you might as well use
1741 them instead of changing the setting of this variable.\) If you want to
1742 silently discard the printed output, set this to \"NUL\".
1744 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1746 Any other value is treated as t, that is, an empty printer name.
1748 See also `ps-printer-name-option' for documentation."
1749 :type '(choice :menu-tag "Printer Name"
1750 :tag "Printer Name"
1751 (const :tag "Same as printer-name" nil)
1752 (const :tag "No Printer Name" t)
1753 (file :tag "Print to file")
1754 (string :tag "Pipe to ps-lpr-command"))
1755 :group 'ps-print-printer)
1757 (defcustom ps-printer-name-option
1758 (cond (ps-windows-system
1759 "/D:")
1760 (ps-lp-system
1761 "-d")
1763 "-P" ))
1764 "*Option for `ps-printer-name' variable (see it).
1766 On Unix-like systems, if `lpr' is in use, this should be the string
1767 \"-P\"; if `lp' is in use, this should be the string \"-d\".
1769 On MS-DOS and MS-Windows systems, if `print' is in use, this should be
1770 the string \"/D:\".
1772 For any other printing utility, see its documentation.
1774 Set this to \"\" or nil, if the utility given by `ps-lpr-command'
1775 needs an empty printer name option--that is, pass the printer name
1776 with no special option preceding it.
1778 Any value that is not a string is treated as nil.
1780 This variable is used only when `ps-printer-name' is a non-empty string."
1781 :type '(choice :menu-tag "Printer Name Option"
1782 :tag "Printer Name Option"
1783 (const :tag "None" nil)
1784 (string :tag "Option"))
1785 :version "21.1"
1786 :group 'ps-print-printer)
1788 (defcustom ps-lpr-command lpr-command
1789 "*Name of program for printing a PostScript file.
1791 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1792 will write directly to the printer port named by `ps-printer-name'. The
1793 programs `print' and `nprint' (the standard print programs on Windows NT and
1794 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1795 the destination for output; any other program is treated like `lpr' except that
1796 an explicit filename is given as the last argument."
1797 :type 'string
1798 :group 'ps-print-printer)
1800 (defcustom ps-lpr-switches lpr-switches
1801 "*A list of extra switches to pass to `ps-lpr-command'."
1802 :type '(repeat :tag "PostScript lpr Switches"
1803 (choice :menu-tag "PostScript lpr Switch"
1804 :tag "PostScript lpr Switch"
1805 string symbol (repeat sexp)))
1806 :group 'ps-print-printer)
1808 (defcustom ps-print-region-function nil
1809 "*Specify a function to print the region on a PostScript printer.
1810 See definition of `call-process-region' for calling conventions. The fourth
1811 and the sixth arguments are both nil."
1812 :type '(choice (const nil) function)
1813 :group 'ps-print-printer)
1815 (defcustom ps-manual-feed nil
1816 "*Non-nil means the printer will manually feed paper.
1818 If it's nil, automatic feeding takes place."
1819 :type 'boolean
1820 :group 'ps-print-printer)
1822 (defcustom ps-end-with-control-d (and ps-windows-system t)
1823 "*Non-nil means insert C-d at end of PostScript file generated."
1824 :version "21.1"
1825 :type 'boolean
1826 :group 'ps-print-printer)
1828 ;;; Page layout
1830 ;; All page dimensions are in PostScript points.
1831 ;; 1 inch == 2.54 cm == 72 points
1832 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1834 ;; Letter 8.5 inch x 11.0 inch
1835 ;; Legal 8.5 inch x 14.0 inch
1836 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1838 ;; LetterSmall 7.68 inch x 10.16 inch
1839 ;; Tabloid 11.0 inch x 17.0 inch
1840 ;; Ledger 17.0 inch x 11.0 inch
1841 ;; Statement 5.5 inch x 8.5 inch
1842 ;; Executive 7.5 inch x 10.0 inch
1843 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1844 ;; A4Small 7.47 inch x 10.85 inch
1845 ;; B4 10.125 inch x 14.33 inch
1846 ;; B5 7.16 inch x 10.125 inch
1848 ;;;###autoload
1849 (defcustom ps-page-dimensions-database
1850 (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1851 (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1852 (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
1853 (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
1854 (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
1855 (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
1856 (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
1857 (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
1858 (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
1859 (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
1860 (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
1861 (list 'b5 (* 72 7.16) (* 72 10.125) "B5"))
1862 "*List associating a symbolic paper type to its width, height and doc media.
1863 See `ps-paper-type'."
1864 :type '(repeat (list :tag "Paper Type"
1865 (symbol :tag "Name")
1866 (number :tag "Width")
1867 (number :tag "Height")
1868 (string :tag "Media")))
1869 :group 'ps-print-page)
1871 ;;;###autoload
1872 (defcustom ps-paper-type 'letter
1873 "*Specify the size of paper to format for.
1874 Should be one of the paper types defined in `ps-page-dimensions-database', for
1875 example `letter', `legal' or `a4'."
1876 :type '(symbol :validate (lambda (wid)
1877 (if (assq (widget-value wid)
1878 ps-page-dimensions-database)
1880 (widget-put wid :error "Unknown paper size")
1881 wid)))
1882 :group 'ps-print-page)
1884 (defcustom ps-warn-paper-type t
1885 "*Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1887 It's used when `ps-spool-config' is set to `setpagedevice'."
1888 :type 'boolean
1889 :group 'ps-print-page)
1891 (defcustom ps-landscape-mode nil
1892 "*Non-nil means print in landscape mode."
1893 :type 'boolean
1894 :group 'ps-print-page)
1896 (defcustom ps-print-upside-down nil
1897 "*Non-nil means print upside-down (that is, rotated by 180 degrees)."
1898 :type 'boolean
1899 :version "21.1"
1900 :group 'ps-print-page)
1902 (defcustom ps-selected-pages nil
1903 "*Specify which pages to print.
1905 If nil, print all pages.
1907 If a list, the lists element may be an integer or a cons cell (FROM . TO)
1908 designating FROM page to TO page; any invalid element is ignored, that is, an
1909 integer lesser than one or if FROM is greater than TO.
1911 Otherwise, it's treated as nil.
1913 After ps-print processing `ps-selected-pages' is set to nil. But the
1914 latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
1915 see). So you can restore the latest selected pages by using
1916 `ps-last-selected-pages' or with the `ps-restore-selected-pages'
1917 command (which see).
1919 See also `ps-even-or-odd-pages'."
1920 :type '(repeat :tag "Selected Pages"
1921 (radio :tag "Page"
1922 (integer :tag "Number")
1923 (cons :tag "Range"
1924 (integer :tag "From")
1925 (integer :tag "To"))))
1926 :group 'ps-print-page)
1928 (defcustom ps-even-or-odd-pages nil
1929 "*Specify if it prints even/odd pages.
1931 Valid values are:
1933 nil print all pages.
1935 `even-page' print only even pages.
1937 `odd-page' print only odd pages.
1939 `even-sheet' print only even sheets.
1940 That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
1941 but for values greater than 1, it'll print only the even sheet
1942 of paper.
1944 `odd-sheet' print only odd sheets.
1945 That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
1946 but for values greater than 1, it'll print only the odd sheet
1947 of paper.
1949 Any other value is treated as nil.
1951 If you set `ps-selected-pages' (see it for documentation), first the pages are
1952 filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1953 example, if we have:
1955 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
1957 Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
1959 `ps-n-up-printing' = 1:
1960 `ps-even-or-odd-pages' PAGES PRINTED
1961 nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
1962 even-page 4, 6, 8, 10, 12, 14, 16, 20
1963 odd-page 1, 7, 9, 13, 15
1964 even-sheet 4, 6, 8, 10, 12, 14, 16, 20
1965 odd-sheet 1, 7, 9, 13, 15
1967 `ps-n-up-printing' = 2:
1968 `ps-even-or-odd-pages' PAGES PRINTED
1969 nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
1970 even-page 4/6, 8/10, 12/14, 16/20
1971 odd-page 1/7, 9/13, 15
1972 even-sheet 6/7, 10/12, 15/16
1973 odd-sheet 1/4, 8/9, 13/14, 20
1975 So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1976 sheet parity."
1977 :type '(choice :menu-tag "Print Even/Odd Pages"
1978 :tag "Print Even/Odd Pages"
1979 (const :tag "All Pages" nil)
1980 (const :tag "Only Even Pages" even-page)
1981 (const :tag "Only Odd Pages" odd-page)
1982 (const :tag "Only Even Sheets" even-sheet)
1983 (const :tag "Only Odd Sheets" odd-sheet))
1984 :group 'ps-print-page)
1986 (defcustom ps-print-control-characters 'control-8-bit
1987 "*Specify the printable form for control and 8-bit characters.
1988 That is, instead of sending, for example, a ^D (\\004) to printer,
1989 it is sent the string \"^D\".
1991 Valid values are:
1993 `8-bit' This is the value to use when you want an ASCII encoding of
1994 any control or non-ASCII character. Control characters are
1995 encoded as \"^D\", and non-ASCII characters have an
1996 octal encoding.
1998 `control-8-bit' This is the value to use when you want an ASCII encoding of
1999 any control character, whether it is 7 or 8-bit.
2000 European 8-bits accented characters are printed according
2001 the current font.
2003 `control' Only ASCII control characters have an ASCII encoding.
2004 European 8-bits accented characters are printed according
2005 the current font.
2007 nil No ASCII encoding. Any character is printed according the
2008 current font.
2010 Any other value is treated as nil."
2011 :type '(choice :menu-tag "Control Char"
2012 :tag "Control Char"
2013 (const 8-bit) (const control-8-bit)
2014 (const control) (const :tag "nil" nil))
2015 :group 'ps-print-miscellany)
2017 (defcustom ps-n-up-printing 1
2018 "*Specify the number of pages per sheet paper."
2019 :type '(integer
2020 :tag "N Up Printing"
2021 :validate
2022 (lambda (wid)
2023 (if (and (< 0 (widget-value wid))
2024 (<= (widget-value wid) 100))
2026 (widget-put
2027 wid :error
2028 "Number of pages per sheet paper must be between 1 and 100.")
2029 wid)))
2030 :group 'ps-print-n-up)
2032 (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
2033 "*Specify the margin in points between the sheet border and n-up printing."
2034 :type 'number
2035 :group 'ps-print-n-up)
2037 (defcustom ps-n-up-border-p t
2038 "*Non-nil means a border is drawn around each page."
2039 :type 'boolean
2040 :group 'ps-print-n-up)
2042 (defcustom ps-n-up-filling 'left-top
2043 "*Specify how page matrix is filled on each sheet of paper.
2045 Following are the valid values for `ps-n-up-filling' with a filling example
2046 using a 3x4 page matrix:
2048 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
2049 5 6 7 8 5 6 7 8
2050 9 10 11 12 1 2 3 4
2052 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
2053 8 7 6 5 8 7 6 5
2054 12 11 10 9 4 3 2 1
2056 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
2057 2 5 8 11 2 5 8 11
2058 3 6 9 12 1 4 7 10
2060 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
2061 11 8 5 2 11 8 5 2
2062 12 9 6 3 10 7 4 1
2064 Any other value is treated as `left-top'."
2065 :type '(choice :menu-tag "N-Up Filling"
2066 :tag "N-Up Filling"
2067 (const left-top) (const left-bottom)
2068 (const right-top) (const right-bottom)
2069 (const top-left) (const bottom-left)
2070 (const top-right) (const bottom-right))
2071 :group 'ps-print-n-up)
2073 (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
2074 "*Specify the number of columns."
2075 :type 'number
2076 :group 'ps-print-miscellany)
2078 (defcustom ps-zebra-stripes nil
2079 "*Non-nil means print zebra stripes.
2080 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
2081 :type 'boolean
2082 :group 'ps-print-zebra)
2084 (defcustom ps-zebra-stripe-height 3
2085 "*Number of zebra stripe lines.
2086 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
2087 :type 'number
2088 :group 'ps-print-zebra)
2090 (defcustom ps-zebra-color 0.95
2091 "*Zebra stripe gray scale or RGB color.
2092 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
2093 :type '(choice :menu-tag "Zebra Gray/Color"
2094 :tag "Zebra Gray/Color"
2095 (number :tag "Gray Scale" :value 0.95)
2096 (string :tag "Color Name" :value "gray95")
2097 (list :tag "RGB Color" :value (0.95 0.95 0.95)
2098 (number :tag "Red")
2099 (number :tag "Green")
2100 (number :tag "Blue")))
2101 :group 'ps-print-zebra)
2103 (defcustom ps-zebra-stripe-follow nil
2104 "*Specify how zebra stripes continue on next page.
2106 Visually, valid values are (the character `+' at right of each column indicates
2107 that a line is printed):
2109 `nil' `follow' `full' `full-follow'
2110 Current Page -------- ----------- --------- ----------------
2111 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
2112 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
2113 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
2114 4 + 4 + 4 + 4 +
2115 5 + 5 + 5 + 5 +
2116 6 + 6 + 6 + 6 +
2117 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
2118 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
2119 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
2120 10 + 10 +
2121 11 + 11 +
2122 -------- ----------- --------- ----------------
2123 Next Page -------- ----------- --------- ----------------
2124 12 XXXXX + 12 + 10 XXXXXX + 10 +
2125 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
2126 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
2127 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
2128 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
2129 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
2130 18 XXXXX + 18 + 16 XXXXXX + 16 +
2131 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
2132 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
2133 21 + 21 XXXXXXXX +
2134 22 + 22 +
2135 -------- ----------- --------- ----------------
2137 Any other value is treated as nil."
2138 :type '(choice :menu-tag "Zebra Stripe Follow"
2139 :tag "Zebra Stripe Follow"
2140 (const :tag "Always Restart" nil)
2141 (const :tag "Continue on Next Page" follow)
2142 (const :tag "Print Only Full Stripe" full)
2143 (const :tag "Continue on Full Stripe" full-follow))
2144 :group 'ps-print-zebra)
2146 (defcustom ps-line-number nil
2147 "*Non-nil means print line number."
2148 :type 'boolean
2149 :group 'ps-print-miscellany)
2151 (defcustom ps-line-number-step 1
2152 "*Specify the interval that line number is printed.
2154 For example, `ps-line-number-step' is set to 2, the printing will look like:
2156 1 one line
2157 one line
2158 3 one line
2159 one line
2160 5 one line
2161 one line
2164 Valid values are:
2166 integer an integer that specifies the interval that line number is
2167 printed. If it's lesser than or equal to zero, it's used the
2168 value 1.
2170 `zebra' specifies that only the line number of the first line in a
2171 zebra stripe is to be printed.
2173 Any other value is treated as `zebra'."
2174 :type '(choice :menu-tag "Line Number Step"
2175 :tag "Line Number Step"
2176 (integer :tag "Step Interval")
2177 (const :tag "Synchronize Zebra" zebra))
2178 :group 'ps-print-miscellany)
2180 (defcustom ps-line-number-start 1
2181 "*Specify the starting point in the interval given by `ps-line-number-step'.
2183 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2184 set to 3, the printing will look like:
2186 one line
2187 one line
2188 3 one line
2189 one line
2190 one line
2191 6 one line
2192 one line
2193 one line
2194 9 one line
2195 one line
2198 The values for `ps-line-number-start':
2200 * If `ps-line-number-step' is an integer, must be between 1 and the value of
2201 `ps-line-number-step' inclusive.
2203 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
2204 value of `ps-zebra-strip-height' inclusive. Use this combination if you
2205 wish that line number be relative to zebra stripes."
2206 :type '(integer :tag "Start Step Interval")
2207 :group 'ps-print-miscellany)
2209 (defcustom ps-print-background-image nil
2210 "*EPS image list to be printed on background.
2212 The elements are:
2214 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2216 FILENAME is a file name which contains an EPS image or some PostScript
2217 programming like EPS.
2218 FILENAME is ignored, if it doesn't exist or is read protected.
2220 X and Y are relative positions on paper to put the image.
2221 If X and Y are nil, the image is centralized on paper.
2223 XSCALE and YSCALE are scale factor to be applied to image before printing.
2224 If XSCALE and YSCALE are nil, the original size is used.
2226 ROTATION is the image rotation angle; if nil, the default is 0.
2228 PAGES designates the page to print background image.
2229 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2230 page.
2231 If PAGES is nil, print background image on all pages.
2233 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2234 number or a string. If it is a string, the string should contain PostScript
2235 programming that returns a float or integer value.
2237 For example, if you wish to print an EPS image on all pages do:
2239 '((\"~/images/EPS-image.ps\"))"
2240 :type '(repeat
2241 (list
2242 (file :tag "EPS File")
2243 (choice :tag "X" (const :tag "default" nil) number string)
2244 (choice :tag "Y" (const :tag "default" nil) number string)
2245 (choice :tag "X Scale" (const :tag "default" nil) number string)
2246 (choice :tag "Y Scale" (const :tag "default" nil) number string)
2247 (choice :tag "Rotation" (const :tag "default" nil) number string)
2248 (repeat :tag "Pages" :inline t
2249 (radio (integer :tag "Page")
2250 (cons :tag "Range"
2251 (integer :tag "From")
2252 (integer :tag "To"))))))
2253 :group 'ps-print-background)
2255 (defcustom ps-print-background-text nil
2256 "*Text list to be printed on background.
2258 The elements are:
2260 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2262 STRING is the text to be printed on background.
2264 X and Y are positions on paper to put the text.
2265 If X and Y are nil, the text is positioned at lower left corner.
2267 FONT is a font name to be used on printing the text.
2268 If nil, \"Times-Roman\" is used.
2270 FONTSIZE is font size to be used, if nil, 200 is used.
2272 GRAY is the text gray factor (should be very light like 0.8).
2273 If nil, the default is 0.85.
2275 ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
2276 from lower left corner to upper right corner.
2278 PAGES designates the page to print background text.
2279 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2280 page.
2281 If PAGES is nil, print background text on all pages.
2283 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2284 number or a string. If it is a string, the string should contain PostScript
2285 programming that returns a float or integer value.
2287 For example, if you wish to print text \"Preliminary\" on all pages do:
2289 '((\"Preliminary\"))"
2290 :type '(repeat
2291 (list
2292 (string :tag "Text")
2293 (choice :tag "X" (const :tag "default" nil) number string)
2294 (choice :tag "Y" (const :tag "default" nil) number string)
2295 (choice :tag "Font" (const :tag "default" nil) string)
2296 (choice :tag "Fontsize" (const :tag "default" nil) number string)
2297 (choice :tag "Gray" (const :tag "default" nil) number string)
2298 (choice :tag "Rotation" (const :tag "default" nil) number string)
2299 (repeat :tag "Pages" :inline t
2300 (radio (integer :tag "Page")
2301 (cons :tag "Range"
2302 (integer :tag "From")
2303 (integer :tag "To"))))))
2304 :group 'ps-print-background)
2306 ;;; Horizontal layout
2308 ;; ------------------------------------------
2309 ;; | | | | | | | |
2310 ;; | lm | text | ic | text | ic | text | rm |
2311 ;; | | | | | | | |
2312 ;; ------------------------------------------
2314 (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
2315 "*Left margin in points (1/72 inch)."
2316 :type 'number
2317 :group 'ps-print-horizontal)
2319 (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
2320 "*Right margin in points (1/72 inch)."
2321 :type 'number
2322 :group 'ps-print-horizontal)
2324 (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
2325 "*Horizontal space between columns in points (1/72 inch)."
2326 :type 'number
2327 :group 'ps-print-horizontal)
2329 ;;; Vertical layout
2331 ;; |--------|
2332 ;; | tm |
2333 ;; |--------|
2334 ;; | header |
2335 ;; |--------|
2336 ;; | ho |
2337 ;; |--------|
2338 ;; | text |
2339 ;; |--------|
2340 ;; | bm |
2341 ;; |--------|
2343 (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2344 "*Bottom margin in points (1/72 inch)."
2345 :type 'number
2346 :group 'ps-print-vertical)
2348 (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
2349 "*Top margin in points (1/72 inch)."
2350 :type 'number
2351 :group 'ps-print-vertical)
2353 (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2354 "*Vertical space in points (1/72 inch) between the main text and the header."
2355 :type 'number
2356 :group 'ps-print-vertical)
2358 (defcustom ps-header-line-pad 0.15
2359 "*Portion of a header title line height to insert.
2360 The insertion is done between the header frame and the text it contains,
2361 both in the vertical and horizontal directions."
2362 :type 'number
2363 :group 'ps-print-vertical)
2365 (defcustom ps-footer-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
2366 "*Vertical space in points (1/72 inch) between the main text and the footer."
2367 :type 'number
2368 :group 'ps-print-vertical)
2370 (defcustom ps-footer-line-pad 0.15
2371 "*Portion of a footer title line height to insert.
2372 The insertion is done between the footer frame and the text it contains,
2373 both in the vertical and horizontal directions."
2374 :type 'number
2375 :group 'ps-print-vertical)
2377 ;;; Header/Footer setup
2379 (defcustom ps-print-header t
2380 "*Non-nil means print a header at the top of each page.
2381 By default, the header displays the buffer name, page number, and, if the
2382 buffer is visiting a file, the file's directory. Headers are customizable by
2383 changing variables `ps-left-header' and `ps-right-header'."
2384 :type 'boolean
2385 :group 'ps-print-headers)
2387 (defcustom ps-print-header-frame t
2388 "*Non-nil means draw a gaudy frame around the header."
2389 :type 'boolean
2390 :group 'ps-print-headers)
2392 (defcustom ps-header-frame-alist
2393 '((fore-color . 0.0)
2394 (back-color . 0.9)
2395 (border-width . 0.4)
2396 (border-color . 0.0)
2397 (shadow-color . 0.0))
2398 "*Specify header frame properties alist.
2400 Valid frame properties are:
2402 `fore-color' Specify the foreground frame color.
2403 It should be a float number between 0.0 (black color)
2404 and 1.0 (white color), a string which is a color name,
2405 or a list of 3 float numbers which corresponds to the
2406 Red Green Blue color scale, each float number between
2407 0.0 (dark color) and 1.0 (bright color).
2409 `back-color' Specify the background frame color (similar to
2410 `fore-color').
2412 `shadow-color' Specify the shadow color (similar to `fore-color').
2414 `border-color' Specify the border color (similar to `fore-color').
2416 `border-width' Specify the border width.
2418 Any other property is ignored.
2420 Don't change this alist directly, instead use customization, or `ps-value',
2421 `ps-get', `ps-put' and `ps-del' functions (see them for documentation)."
2422 :version "21.1"
2423 :type '(repeat
2424 (choice :menu-tag "Header Frame Element"
2425 :tag ""
2426 (cons :tag "Foreground Color" :format "%v"
2427 (const :format "" fore-color)
2428 (choice :menu-tag "Foreground Color"
2429 :tag "Foreground Color"
2430 (number :tag "Gray Scale" :value 0.0)
2431 (string :tag "Color Name" :value "black")
2432 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2433 (number :tag "Red")
2434 (number :tag "Green")
2435 (number :tag "Blue"))))
2436 (cons :tag "Background Color" :format "%v"
2437 (const :format "" back-color)
2438 (choice :menu-tag "Background Color"
2439 :tag "Background Color"
2440 (number :tag "Gray Scale" :value 0.9)
2441 (string :tag "Color Name" :value "gray90")
2442 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2443 (number :tag "Red")
2444 (number :tag "Green")
2445 (number :tag "Blue"))))
2446 (cons :tag "Border Width" :format "%v"
2447 (const :format "" border-width)
2448 (number :tag "Border Width" :value 0.4))
2449 (cons :tag "Border Color" :format "%v"
2450 (const :format "" border-color)
2451 (choice :menu-tag "Border Color"
2452 :tag "Border Color"
2453 (number :tag "Gray Scale" :value 0.0)
2454 (string :tag "Color Name" :value "black")
2455 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2456 (number :tag "Red")
2457 (number :tag "Green")
2458 (number :tag "Blue"))))
2459 (cons :tag "Shadow Color" :format "%v"
2460 (const :format "" shadow-color)
2461 (choice :menu-tag "Shadow Color"
2462 :tag "Shadow Color"
2463 (number :tag "Gray Scale" :value 0.0)
2464 (string :tag "Color Name" :value "black")
2465 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2466 (number :tag "Red")
2467 (number :tag "Green")
2468 (number :tag "Blue"))))))
2469 :group 'ps-print-headers)
2471 (defcustom ps-header-lines 2
2472 "*Number of lines to display in page header, when generating PostScript."
2473 :type 'integer
2474 :group 'ps-print-headers)
2476 (defcustom ps-print-footer nil
2477 "*Non-nil means print a footer at the bottom of each page.
2478 By default, the footer displays page number.
2479 Footers are customizable by changing variables `ps-left-footer' and
2480 `ps-right-footer'."
2481 :version "21.1"
2482 :type 'boolean
2483 :group 'ps-print-headers)
2485 (defcustom ps-print-footer-frame t
2486 "*Non-nil means draw a gaudy frame around the footer."
2487 :version "21.1"
2488 :type 'boolean
2489 :group 'ps-print-headers)
2491 (defcustom ps-footer-frame-alist
2492 '((fore-color . 0.0)
2493 (back-color . 0.9)
2494 (border-width . 0.4)
2495 (border-color . 0.0)
2496 (shadow-color . 0.0))
2497 "*Specify footer frame properties alist.
2499 Don't change this alist directly, instead use customization, or `ps-value',
2500 `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
2502 See also `ps-header-frame-alist' for documentation."
2503 :version "21.1"
2504 :type '(repeat
2505 (choice :menu-tag "Header Frame Element"
2506 :tag ""
2507 (cons :tag "Foreground Color" :format "%v"
2508 (const :format "" fore-color)
2509 (choice :menu-tag "Foreground Color"
2510 :tag "Foreground Color"
2511 (number :tag "Gray Scale" :value 0.0)
2512 (string :tag "Color Name" :value "black")
2513 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2514 (number :tag "Red")
2515 (number :tag "Green")
2516 (number :tag "Blue"))))
2517 (cons :tag "Background Color" :format "%v"
2518 (const :format "" back-color)
2519 (choice :menu-tag "Background Color"
2520 :tag "Background Color"
2521 (number :tag "Gray Scale" :value 0.9)
2522 (string :tag "Color Name" :value "gray90")
2523 (list :tag "RGB Color" :value (0.9 0.9 0.9)
2524 (number :tag "Red")
2525 (number :tag "Green")
2526 (number :tag "Blue"))))
2527 (cons :tag "Border Width" :format "%v"
2528 (const :format "" border-width)
2529 (number :tag "Border Width" :value 0.4))
2530 (cons :tag "Border Color" :format "%v"
2531 (const :format "" border-color)
2532 (choice :menu-tag "Border Color"
2533 :tag "Border Color"
2534 (number :tag "Gray Scale" :value 0.0)
2535 (string :tag "Color Name" :value "black")
2536 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2537 (number :tag "Red")
2538 (number :tag "Green")
2539 (number :tag "Blue"))))
2540 (cons :tag "Shadow Color" :format "%v"
2541 (const :format "" shadow-color)
2542 (choice :menu-tag "Shadow Color"
2543 :tag "Shadow Color"
2544 (number :tag "Gray Scale" :value 0.0)
2545 (string :tag "Color Name" :value "black")
2546 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2547 (number :tag "Red")
2548 (number :tag "Green")
2549 (number :tag "Blue"))))))
2550 :group 'ps-print-headers)
2552 (defcustom ps-footer-lines 2
2553 "*Number of lines to display in page footer, when generating PostScript."
2554 :version "21.1"
2555 :type 'integer
2556 :group 'ps-print-headers)
2558 (defcustom ps-print-only-one-header nil
2559 "*Non-nil means print only one header/footer at the top/bottom of each page.
2560 This is useful when printing more than one column, so it is possible to have
2561 only one header/footer over all columns or one header/footer per column.
2562 See also `ps-print-header' and `ps-print-footer'."
2563 :type 'boolean
2564 :group 'ps-print-headers)
2566 (defcustom ps-switch-header 'duplex
2567 "*Specify if headers/footers are switched or not.
2569 Valid values are:
2571 nil Never switch headers/footers.
2573 t Always switch headers/footers.
2575 duplex Switch headers/footers only when duplexing is on, that is, when
2576 `ps-spool-duplex' is non-nil.
2578 Any other value is treated as t.
2580 See also `ps-print-header' and `ps-print-footer'."
2581 :type '(choice :menu-tag "Switch Header/Footer"
2582 :tag "Switch Header/Footer"
2583 (const :tag "Never Switch" nil)
2584 (const :tag "Always Switch" t)
2585 (const :tag "Switch When Duplexing" duplex))
2586 :group 'ps-print-headers)
2588 (defcustom ps-show-n-of-n t
2589 "*Non-nil means show page numbers as N/M, meaning page N of M.
2590 NOTE: page numbers are displayed as part of headers,
2591 see variable `ps-print-header'."
2592 :type 'boolean
2593 :group 'ps-print-headers)
2595 (defcustom ps-spool-config
2596 (if ps-windows-system
2598 'lpr-switches)
2599 "*Specify who is responsible for setting duplex and page size.
2601 Valid values are:
2603 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2604 Don't forget to set `ps-lpr-switches' to select duplex
2605 printing for your printer.
2607 `setpagedevice' duplex and page size are configured by ps-print using the
2608 setpagedevice PostScript operator.
2610 nil duplex and page size are configured by ps-print *not* using
2611 the setpagedevice PostScript operator.
2613 Any other value is treated as nil.
2615 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2616 viewing file generated using landscape. Also on some printers,
2617 setpagedevice affects zebra stripes; on other printers, setpagedevice
2618 affects the left margin.
2619 Besides all that, if your printer does not have the paper size
2620 specified by setpagedevice, your printing will be aborted.
2621 So, if you need to use setpagedevice, set `ps-spool-config' to
2622 `setpagedevice', generate a test file and send it to your printer; if
2623 the printed file isn't OK, set `ps-spool-config' to nil."
2624 :type '(choice :menu-tag "Spool Config"
2625 :tag "Spool Config"
2626 (const lpr-switches) (const setpagedevice)
2627 (const :tag "nil" nil))
2628 :group 'ps-print-headers)
2630 (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
2631 ; so default to nil.
2632 "*Non-nil generates PostScript for a two-sided printer.
2633 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2634 blank pages as needed between print jobs so that the next buffer printed will
2635 start on the right page. Also, if headers are turned on, the headers will be
2636 reversed on duplex printers so that the page numbers fall to the left on
2637 even-numbered pages.
2639 See also `ps-spool-tumble'."
2640 :type 'boolean
2641 :group 'ps-print-headers)
2643 (defcustom ps-spool-tumble nil
2644 "*Specify how the page images on opposite sides of a sheet are oriented.
2645 If `ps-spool-tumble' is nil, produces output suitable for binding on the left
2646 or right. If `ps-spool-tumble' is non-nil, produces output suitable for
2647 binding at the top or bottom.
2649 It has effect only when `ps-spool-duplex' is non-nil."
2650 :type 'boolean
2651 :group 'ps-print-headers)
2653 ;;; Fonts
2655 (defcustom ps-font-info-database
2656 '((Courier ; the family key
2657 (fonts (normal . "Courier")
2658 (bold . "Courier-Bold")
2659 (italic . "Courier-Oblique")
2660 (bold-italic . "Courier-BoldOblique"))
2661 (size . 10.0)
2662 (line-height . 10.55)
2663 (space-width . 6.0)
2664 (avg-char-width . 6.0))
2665 (Helvetica ; the family key
2666 (fonts (normal . "Helvetica")
2667 (bold . "Helvetica-Bold")
2668 (italic . "Helvetica-Oblique")
2669 (bold-italic . "Helvetica-BoldOblique"))
2670 (size . 10.0)
2671 (line-height . 11.56)
2672 (space-width . 2.78)
2673 (avg-char-width . 5.09243))
2674 (Times
2675 (fonts (normal . "Times-Roman")
2676 (bold . "Times-Bold")
2677 (italic . "Times-Italic")
2678 (bold-italic . "Times-BoldItalic"))
2679 (size . 10.0)
2680 (line-height . 11.0)
2681 (space-width . 2.5)
2682 (avg-char-width . 4.71432))
2683 (Palatino
2684 (fonts (normal . "Palatino-Roman")
2685 (bold . "Palatino-Bold")
2686 (italic . "Palatino-Italic")
2687 (bold-italic . "Palatino-BoldItalic"))
2688 (size . 10.0)
2689 (line-height . 12.1)
2690 (space-width . 2.5)
2691 (avg-char-width . 5.08676))
2692 (Helvetica-Narrow
2693 (fonts (normal . "Helvetica-Narrow")
2694 (bold . "Helvetica-Narrow-Bold")
2695 (italic . "Helvetica-Narrow-Oblique")
2696 (bold-italic . "Helvetica-Narrow-BoldOblique"))
2697 (size . 10.0)
2698 (line-height . 11.56)
2699 (space-width . 2.2796)
2700 (avg-char-width . 4.17579))
2701 (NewCenturySchlbk
2702 (fonts (normal . "NewCenturySchlbk-Roman")
2703 (bold . "NewCenturySchlbk-Bold")
2704 (italic . "NewCenturySchlbk-Italic")
2705 (bold-italic . "NewCenturySchlbk-BoldItalic"))
2706 (size . 10.0)
2707 (line-height . 12.15)
2708 (space-width . 2.78)
2709 (avg-char-width . 5.31162))
2710 ;; got no bold for the next ones
2711 (AvantGarde-Book
2712 (fonts (normal . "AvantGarde-Book")
2713 (italic . "AvantGarde-BookOblique"))
2714 (size . 10.0)
2715 (line-height . 11.77)
2716 (space-width . 2.77)
2717 (avg-char-width . 5.45189))
2718 (AvantGarde-Demi
2719 (fonts (normal . "AvantGarde-Demi")
2720 (italic . "AvantGarde-DemiOblique"))
2721 (size . 10.0)
2722 (line-height . 12.72)
2723 (space-width . 2.8)
2724 (avg-char-width . 5.51351))
2725 (Bookman-Demi
2726 (fonts (normal . "Bookman-Demi")
2727 (italic . "Bookman-DemiItalic"))
2728 (size . 10.0)
2729 (line-height . 11.77)
2730 (space-width . 3.4)
2731 (avg-char-width . 6.05946))
2732 (Bookman-Light
2733 (fonts (normal . "Bookman-Light")
2734 (italic . "Bookman-LightItalic"))
2735 (size . 10.0)
2736 (line-height . 11.79)
2737 (space-width . 3.2)
2738 (avg-char-width . 5.67027))
2739 ;; got no bold and no italic for the next ones
2740 (Symbol
2741 (fonts (normal . "Symbol"))
2742 (size . 10.0)
2743 (line-height . 13.03)
2744 (space-width . 2.5)
2745 (avg-char-width . 3.24324))
2746 (Zapf-Dingbats
2747 (fonts (normal . "Zapf-Dingbats"))
2748 (size . 10.0)
2749 (line-height . 9.63)
2750 (space-width . 2.78)
2751 (avg-char-width . 2.78))
2752 (Zapf-Chancery-MediumItalic
2753 (fonts (normal . "Zapf-Chancery-MediumItalic"))
2754 (size . 10.0)
2755 (line-height . 11.45)
2756 (space-width . 2.2)
2757 (avg-char-width . 4.10811))
2759 "*Font info database.
2760 Each element comprises: font family (the key), name, bold, italic, bold-italic,
2761 reference size, line height, space width, average character width.
2762 To get the info for another specific font (say Helvetica), do the following:
2763 - create a new buffer
2764 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2765 - open this file and delete the leading `%' (which is the PostScript comment
2766 character) from the line
2767 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2768 to get the line
2769 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2770 - add the values to `ps-font-info-database'.
2771 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2773 Note also that ps-print DOESN'T download any font to your printer, instead it
2774 uses the fonts resident in your printer."
2775 :type '(repeat
2776 (list :tag "Font Definition"
2777 (symbol :tag "Font Family")
2778 (cons :format "%v"
2779 (const :format "" fonts)
2780 (repeat :tag "Faces"
2781 (cons (choice :menu-tag "Font Weight/Slant"
2782 :tag "Font Weight/Slant"
2783 (const normal)
2784 (const bold)
2785 (const italic)
2786 (const bold-italic)
2787 (symbol :tag "Face"))
2788 (string :tag "Font Name"))))
2789 (cons :format "%v"
2790 (const :format "" size)
2791 (number :tag "Reference Size"))
2792 (cons :format "%v"
2793 (const :format "" line-height)
2794 (number :tag "Line Height"))
2795 (cons :format "%v"
2796 (const :format "" space-width)
2797 (number :tag "Space Width"))
2798 (cons :format "%v"
2799 (const :format "" avg-char-width)
2800 (number :tag "Average Character Width"))))
2801 :group 'ps-print-font)
2803 (defcustom ps-font-family 'Courier
2804 "*Font family name for ordinary text, when generating PostScript."
2805 :type 'symbol
2806 :group 'ps-print-font)
2808 (defcustom ps-font-size '(7 . 8.5)
2809 "*Font size, in points, for ordinary text, when generating PostScript."
2810 :type '(choice :menu-tag "Ordinary Text Font Size"
2811 :tag "Ordinary Text Font Size"
2812 (number :tag "Text Size")
2813 (cons :tag "Landscape/Portrait"
2814 (number :tag "Landscape Text Size")
2815 (number :tag "Portrait Text Size")))
2816 :group 'ps-print-font)
2818 (defcustom ps-header-font-family 'Helvetica
2819 "*Font family name for text in the header, when generating PostScript."
2820 :type 'symbol
2821 :group 'ps-print-font)
2823 (defcustom ps-header-font-size '(10 . 12)
2824 "*Font size, in points, for text in the header, when generating PostScript."
2825 :type '(choice :menu-tag "Header Font Size"
2826 :tag "Header Font Size"
2827 (number :tag "Header Size")
2828 (cons :tag "Landscape/Portrait"
2829 (number :tag "Landscape Header Size")
2830 (number :tag "Portrait Header Size")))
2831 :group 'ps-print-font)
2833 (defcustom ps-header-title-font-size '(12 . 14)
2834 "*Font size, in points, for the top line of text in header, in PostScript."
2835 :type '(choice :menu-tag "Header Title Font Size"
2836 :tag "Header Title Font Size"
2837 (number :tag "Header Title Size")
2838 (cons :tag "Landscape/Portrait"
2839 (number :tag "Landscape Header Title Size")
2840 (number :tag "Portrait Header Title Size")))
2841 :group 'ps-print-font)
2843 (defcustom ps-footer-font-family 'Helvetica
2844 "*Font family name for text in the footer, when generating PostScript."
2845 :version "21.1"
2846 :type 'symbol
2847 :group 'ps-print-font)
2849 (defcustom ps-footer-font-size '(10 . 12)
2850 "*Font size, in points, for text in the footer, when generating PostScript."
2851 :version "21.1"
2852 :type '(choice :menu-tag "Footer Font Size"
2853 :tag "Footer Font Size"
2854 (number :tag "Footer Size")
2855 (cons :tag "Landscape/Portrait"
2856 (number :tag "Landscape Footer Size")
2857 (number :tag "Portrait Footer Size")))
2858 :group 'ps-print-font)
2860 (defcustom ps-line-number-color "black"
2861 "*Specify color for line-number, when generating PostScript."
2862 :type '(choice :menu-tag "Line Number Color"
2863 :tag "Line Number Color"
2864 (number :tag "Gray Scale" :value 0)
2865 (string :tag "Color Name" :value "black")
2866 (list :tag "RGB Color" :value (0 0 0)
2867 (number :tag "Red")
2868 (number :tag "Green")
2869 (number :tag "Blue")))
2870 :version "21.1"
2871 :group 'ps-print-font
2872 :group 'ps-print-miscellany)
2874 (defcustom ps-line-number-font "Times-Italic"
2875 "*Font for line-number, when generating PostScript."
2876 :type 'string
2877 :group 'ps-print-font
2878 :group 'ps-print-miscellany)
2880 (defcustom ps-line-number-font-size 6
2881 "*Font size, in points, for line number, when generating PostScript."
2882 :type '(choice :menu-tag "Line Number Font Size"
2883 :tag "Line Number Font Size"
2884 (number :tag "Font Size")
2885 (cons :tag "Landscape/Portrait"
2886 (number :tag "Landscape Font Size")
2887 (number :tag "Portrait Font Size")))
2888 :group 'ps-print-font
2889 :group 'ps-print-miscellany)
2891 ;;; Colors
2893 ;; Printing color requires x-color-values.
2894 ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
2895 ;; widget to work.
2896 ;;;###autoload
2897 (defcustom ps-print-color-p
2898 (or (fboundp 'x-color-values) ; Emacs
2899 (fboundp 'color-instance-rgb-components))
2900 ; XEmacs
2901 "*Specify how buffer's text color is printed.
2903 Valid values are:
2905 nil Do not print colors.
2907 t Print colors.
2909 black-white Print colors on black/white printer.
2910 See also `ps-black-white-faces'.
2912 Any other value is treated as t."
2913 :type '(choice :menu-tag "Print Color"
2914 :tag "Print Color"
2915 (const :tag "Do NOT Print Color" nil)
2916 (const :tag "Print Always Color" t)
2917 (const :tag "Print Black/White Color" black-white))
2918 :group 'ps-print-color)
2920 (defcustom ps-default-fg '(0.0 0.0 0.0) ; black
2921 "*RGB values of the default foreground color. Defaults to black.
2923 The `ps-default-fg' variable contains the default foreground color used by
2924 ps-print, that is, if there is a face in a text that doesn't have a foreground
2925 color, the `ps-default-fg' color should be used.
2927 Valid values are:
2929 t The foreground color of Emacs session will be used.
2931 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
2932 indicate the gray color.
2934 COLOR-NAME It's a string wich contains the color name. For example:
2935 \"yellow\".
2937 LIST It's a list of RGB values, that is a list of three real values
2938 of the form:
2940 (RED, GREEN, BLUE)
2942 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
2943 1.0 (full color).
2945 Any other value is ignored and it's used the black color.
2947 It's used only when `ps-print-color-p' is non-nil."
2948 :type '(choice :menu-tag "Default Foreground Gray/Color"
2949 :tag "Default Foreground Gray/Color"
2950 (const :tag "Session Foreground" t)
2951 (number :tag "Gray Scale" :value 0.0)
2952 (string :tag "Color Name" :value "black")
2953 (list :tag "RGB Color" :value (0.0 0.0 0.0)
2954 (number :tag "Red")
2955 (number :tag "Green")
2956 (number :tag "Blue")))
2957 :group 'ps-print-color)
2959 (defcustom ps-default-bg '(1.0 1.0 1.0) ; white
2960 "*RGB values of the default background color. Defaults to white.
2962 The `ps-default-bg' variable contains the default background color used by
2963 ps-print, that is, if there is a face in a text that doesn't have a background
2964 color, the `ps-default-bg' color should be used.
2966 Valid values are:
2968 t The background color of Emacs session will be used.
2970 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
2971 indicate the gray color.
2973 COLOR-NAME It's a string wich contains the color name. For example:
2974 \"yellow\".
2976 LIST It's a list of RGB values, that is a list of three real values
2977 of the form:
2979 (RED, GREEN, BLUE)
2981 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
2982 1.0 (full color).
2984 Any other value is ignored and it's used the white color.
2986 It's used only when `ps-print-color-p' is non-nil.
2988 See also `ps-use-face-background'."
2989 :type '(choice :menu-tag "Default Background Gray/Color"
2990 :tag "Default Background Gray/Color"
2991 (const :tag "Session Background" t)
2992 (number :tag "Gray Scale" :value 1.0)
2993 (string :tag "Color Name" :value "white")
2994 (list :tag "RGB Color" :value (1.0 1.0 1.0)
2995 (number :tag "Red")
2996 (number :tag "Green")
2997 (number :tag "Blue")))
2998 :group 'ps-print-color)
3000 (defcustom ps-auto-font-detect t
3001 "*Non-nil means automatically detect bold/italic/underline face attributes.
3002 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
3003 `ps-underlined-faces'."
3004 :type 'boolean
3005 :group 'ps-print-font)
3007 (defcustom ps-black-white-faces
3008 '((font-lock-builtin-face "black" nil bold )
3009 (font-lock-comment-face "gray20" nil italic)
3010 (font-lock-constant-face "black" nil bold )
3011 (font-lock-function-name-face "black" nil bold )
3012 (font-lock-keyword-face "black" nil bold )
3013 (font-lock-string-face "black" nil italic)
3014 (font-lock-type-face "black" nil italic)
3015 (font-lock-variable-name-face "black" nil bold italic)
3016 (font-lock-warning-face "black" nil bold italic))
3017 "*Specify list of face attributes to print colors on black/white printers.
3019 The list elements are the same as defined on `ps-extend-face' (which see).
3021 This variable is used only when `ps-print-color-p' is set to `black-white'."
3022 :version "21.1"
3023 :type '(repeat
3024 (list :tag "Face Specification"
3025 (face :tag "Face Symbol")
3026 (choice :menu-tag "Foreground Color"
3027 :tag "Foreground Color"
3028 (const :tag "Black" nil)
3029 (string :tag "Color Name"))
3030 (choice :menu-tag "Background Color"
3031 :tag "Background Color"
3032 (const :tag "None" nil)
3033 (string :tag "Color Name"))
3034 (repeat :inline t
3035 (choice :menu-tag "Attribute"
3036 (const bold)
3037 (const italic)
3038 (const underline)
3039 (const strikeout)
3040 (const overline)
3041 (const shadow)
3042 (const box)
3043 (const outline)))))
3044 :group 'ps-print-face)
3046 (defcustom ps-bold-faces
3047 (unless ps-print-color-p
3048 '(font-lock-function-name-face
3049 font-lock-builtin-face
3050 font-lock-variable-name-face
3051 font-lock-keyword-face
3052 font-lock-warning-face))
3053 "*A list of the \(non-bold\) faces that should be printed in bold font.
3054 This applies to generating PostScript."
3055 :type '(repeat face)
3056 :group 'ps-print-face)
3058 (defcustom ps-italic-faces
3059 (unless ps-print-color-p
3060 '(font-lock-variable-name-face
3061 font-lock-type-face
3062 font-lock-string-face
3063 font-lock-comment-face
3064 font-lock-warning-face))
3065 "*A list of the \(non-italic\) faces that should be printed in italic font.
3066 This applies to generating PostScript."
3067 :type '(repeat face)
3068 :group 'ps-print-face)
3070 (defcustom ps-underlined-faces
3071 (unless ps-print-color-p
3072 '(font-lock-function-name-face
3073 font-lock-constant-face
3074 font-lock-warning-face))
3075 "*A list of the \(non-underlined\) faces that should be printed underlined.
3076 This applies to generating PostScript."
3077 :type '(repeat face)
3078 :group 'ps-print-face)
3080 (defcustom ps-use-face-background nil
3081 "*Specify if face background should be used.
3083 Valid values are:
3085 t always use face background color.
3086 nil never use face background color.
3087 (face...) list of faces whose background color will be used.
3089 Any other value will be treated as t."
3090 :type '(choice :menu-tag "Use Face Background"
3091 :tag "Use Face Background"
3092 (const :tag "Always Use Face Background" t)
3093 (const :tag "Never Use Face Background" nil)
3094 (repeat :menu-tag "Face Background List"
3095 :tag "Face Background List"
3096 face))
3097 :group 'ps-print-face)
3099 (defcustom ps-left-header
3100 (list 'ps-get-buffer-name 'ps-header-dirpart)
3101 "*The items to display (each on a line) on the left part of the page header.
3102 This applies to generating PostScript.
3104 The value should be a list of strings and symbols, each representing an entry
3105 in the PostScript array HeaderLinesLeft.
3107 Strings are inserted unchanged into the array; those representing
3108 PostScript string literals should be delimited with PostScript string
3109 delimiters '(' and ')'.
3111 For symbols with bound functions, the function is called and should return a
3112 string to be inserted into the array. For symbols with bound values, the value
3113 should be a string to be inserted into the array. In either case, function or
3114 variable, the string value has PostScript string delimiters added to it."
3115 :type '(repeat (choice :menu-tag "Left Header"
3116 :tag "Left Header"
3117 string symbol))
3118 :group 'ps-print-headers)
3120 (defcustom ps-right-header
3121 (list "/pagenumberstring load"
3122 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3123 "*The items to display (each on a line) on the right part of the page header.
3124 This applies to generating PostScript.
3126 See the variable `ps-left-header' for a description of the format of this
3127 variable.
3129 There are the following basic functions implemented:
3131 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3132 as, for example, \"06/18/01\".
3134 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3136 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3138 You can also create your own time stamp function by using `format-time-string'
3139 \(which see)."
3140 :type '(repeat (choice :menu-tag "Right Header"
3141 :tag "Right Header"
3142 string symbol))
3143 :group 'ps-print-headers)
3145 (defcustom ps-left-footer
3146 (list 'ps-get-buffer-name 'ps-header-dirpart)
3147 "*The items to display (each on a line) on the left part of the page footer.
3148 This applies to generating PostScript.
3150 The value should be a list of strings and symbols, each representing an entry
3151 in the PostScript array FooterLinesLeft.
3153 Strings are inserted unchanged into the array; those representing PostScript
3154 string literals should be delimited with PostScript string delimiters '(' and
3155 ')'.
3157 For symbols with bound functions, the function is called and should return a
3158 string to be inserted into the array. For symbols with bound values, the value
3159 should be a string to be inserted into the array. In either case, function or
3160 variable, the string value has PostScript string delimiters added to it."
3161 :version "21.1"
3162 :type '(repeat (choice :menu-tag "Left Footer"
3163 :tag "Left Footer"
3164 string symbol))
3165 :group 'ps-print-headers)
3167 (defcustom ps-right-footer
3168 (list "/pagenumberstring load"
3169 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
3170 "*The items to display (each on a line) on the right part of the page footer.
3171 This applies to generating PostScript.
3173 See the variable `ps-left-footer' for a description of the format of this
3174 variable.
3176 There are the following basic functions implemented:
3178 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3179 as, for example, \"06/18/01\".
3181 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3183 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3185 You can also create your own time stamp function by using `format-time-string'
3186 \(which see)."
3187 :version "21.1"
3188 :type '(repeat (choice :menu-tag "Right Footer"
3189 :tag "Right Footer"
3190 string symbol))
3191 :group 'ps-print-headers)
3193 (defcustom ps-razzle-dazzle t
3194 "*Non-nil means report progress while formatting buffer."
3195 :type 'boolean
3196 :group 'ps-print-miscellany)
3198 (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
3199 "*Contains the header line identifying the output as PostScript.
3200 By default, `ps-adobe-tag' contains the standard identifier. Some printers
3201 require slightly different versions of this line."
3202 :type 'string
3203 :group 'ps-print-miscellany)
3205 (defcustom ps-build-face-reference t
3206 "*Non-nil means build the reference face lists.
3208 ps-print sets this value to nil after it builds its internal reference lists of
3209 bold and italic faces. By settings its value back to t, you can force ps-print
3210 to rebuild the lists the next time you invoke one of the ...-with-faces
3211 commands.
3213 You should set this value back to t after you change the attributes of any
3214 face, or create new faces. Most users shouldn't have to worry about its
3215 setting, though."
3216 :type 'boolean
3217 :group 'ps-print-face)
3219 (defcustom ps-always-build-face-reference nil
3220 "*Non-nil means always rebuild the reference face lists.
3222 If this variable is non-nil, ps-print will rebuild its internal reference lists
3223 of bold and italic faces *every* time one of the ...-with-faces commands is
3224 called. Most users shouldn't need to set this variable."
3225 :type 'boolean
3226 :group 'ps-print-face)
3228 (defcustom ps-banner-page-when-duplexing nil
3229 "*Non-nil means the very first page is skipped.
3230 It's like the very first character of buffer (or region) is ^L (\\014)."
3231 :type 'boolean
3232 :group 'ps-print-headers)
3234 (defcustom ps-postscript-code-directory
3235 (or (cond
3236 ((eq ps-print-emacs-type 'emacs) ; emacs
3237 data-directory)
3238 ((fboundp 'locate-data-directory) ; xemacs
3239 (locate-data-directory "ps-print"))
3240 ((boundp 'data-directory) ; xemacs
3241 data-directory)
3242 (t ; don't know what to do
3243 nil))
3244 (error "`ps-postscript-code-directory' isn't set properly"))
3245 "*Directory where it's located the PostScript prologue file used by ps-print.
3246 By default, this directory is the same as in the variable `data-directory'."
3247 :type 'directory
3248 :group 'ps-print-miscellany)
3250 (defcustom ps-line-spacing 0
3251 "*Specify line spacing, in points, for ordinary text.
3253 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3255 To get all lines with some spacing set both `ps-line-spacing' and
3256 `ps-paragraph-spacing' variables."
3257 :type '(choice :menu-tag "Line Spacing For Ordinary Text"
3258 :tag "Line Spacing For Ordinary Text"
3259 (number :tag "Line Spacing")
3260 (cons :tag "Landscape/Portrait"
3261 (number :tag "Landscape Line Spacing")
3262 (number :tag "Portrait Line Spacing")))
3263 :version "21.1"
3264 :group 'ps-print-miscellany)
3266 (defcustom ps-paragraph-spacing 0
3267 "*Specify paragraph spacing, in points, for ordinary text.
3269 See also `ps-line-spacing' and `ps-paragraph-regexp'.
3271 To get all lines with some spacing set both `ps-line-spacing' and
3272 `ps-paragraph-spacing' variables."
3273 :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text"
3274 :tag "Paragraph Spacing For Ordinary Text"
3275 (number :tag "Paragraph Spacing")
3276 (cons :tag "Landscape/Portrait"
3277 (number :tag "Landscape Paragraph Spacing")
3278 (number :tag "Portrait Paragraph Spacing")))
3279 :version "21.1"
3280 :group 'ps-print-miscellany)
3282 (defcustom ps-paragraph-regexp "[ \t]*$"
3283 "*Specify paragraph delimiter.
3285 It should be a regexp or nil.
3287 See also `ps-paragraph-spacing'."
3288 :type '(choice :menu-tag "Paragraph Delimiter"
3289 (const :tag "No Delimiter" nil)
3290 (regexp :tag "Delimiter Regexp"))
3291 :version "21.1"
3292 :group 'ps-print-miscellany)
3294 (defcustom ps-begin-cut-regexp nil
3295 "*Specify regexp which is start of a region to cut out when printing.
3297 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
3298 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
3299 some special printing instructions from the actual print. Special printing
3300 instructions may be appended to the end of the file just like any other
3301 buffer-local variables. See section \"Local Variables in Files\" on Emacs
3302 manual for more information.
3304 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3305 actually gets printed. Both variables may be set to nil in which case no
3306 cutting occurs."
3307 :type '(choice (const :tag "No Delimiter" nil)
3308 (regexp :tag "Delimiter Regexp"))
3309 :version "21.1"
3310 :group 'ps-print-miscellany)
3312 (defcustom ps-end-cut-regexp nil
3313 "*Specify regexp which is end of the region to cut out when printing.
3315 See `ps-begin-cut-regexp' for more information."
3316 :type '(choice (const :tag "No Delimiter" nil)
3317 (regexp :tag "Delimiter Regexp"))
3318 :version "21.1"
3319 :group 'ps-print-miscellany)
3322 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3323 ;; Selected Pages
3326 (defvar ps-last-selected-pages nil
3327 "Latest `ps-selected-pages' value.")
3330 (defun ps-restore-selected-pages ()
3331 "Restore latest `ps-selected-pages' value."
3332 (interactive)
3333 (setq ps-selected-pages ps-last-selected-pages))
3336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3337 ;; Customization
3340 ;;;###autoload
3341 (defun ps-print-customize ()
3342 "Customization of ps-print group."
3343 (interactive)
3344 (customize-group 'ps-print))
3347 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3348 ;; User commands
3351 ;;;###autoload
3352 (defun ps-print-buffer (&optional filename)
3353 "Generate and print a PostScript image of the buffer.
3355 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3356 user for a file name, and saves the PostScript image in that file instead of
3357 sending it to the printer.
3359 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3360 send the image to the printer. If FILENAME is a string, save the PostScript
3361 image in a file with that name."
3362 (interactive (list (ps-print-preprint current-prefix-arg)))
3363 (ps-print-without-faces (point-min) (point-max) filename))
3366 ;;;###autoload
3367 (defun ps-print-buffer-with-faces (&optional filename)
3368 "Generate and print a PostScript image of the buffer.
3369 Like `ps-print-buffer', but includes font, color, and underline information in
3370 the generated image. This command works only if you are using a window system,
3371 so it has a way to determine color values."
3372 (interactive (list (ps-print-preprint current-prefix-arg)))
3373 (ps-print-with-faces (point-min) (point-max) filename))
3376 ;;;###autoload
3377 (defun ps-print-region (from to &optional filename)
3378 "Generate and print a PostScript image of the region.
3379 Like `ps-print-buffer', but prints just the current region."
3380 (interactive (ps-print-preprint-region current-prefix-arg))
3381 (ps-print-without-faces from to filename t))
3384 ;;;###autoload
3385 (defun ps-print-region-with-faces (from to &optional filename)
3386 "Generate and print a PostScript image of the region.
3387 Like `ps-print-region', but includes font, color, and underline information in
3388 the generated image. This command works only if you are using a window system,
3389 so it has a way to determine color values."
3390 (interactive (ps-print-preprint-region current-prefix-arg))
3391 (ps-print-with-faces from to filename t))
3394 ;;;###autoload
3395 (defun ps-spool-buffer ()
3396 "Generate and spool a PostScript image of the buffer.
3397 Like `ps-print-buffer' except that the PostScript image is saved in a local
3398 buffer to be sent to the printer later.
3400 Use the command `ps-despool' to send the spooled images to the printer."
3401 (interactive)
3402 (ps-spool-without-faces (point-min) (point-max)))
3405 ;;;###autoload
3406 (defun ps-spool-buffer-with-faces ()
3407 "Generate and spool a PostScript image of the buffer.
3408 Like `ps-spool-buffer', but includes font, color, and underline information in
3409 the generated image. This command works only if you are using a window system,
3410 so it has a way to determine color values.
3412 Use the command `ps-despool' to send the spooled images to the printer."
3413 (interactive)
3414 (ps-spool-with-faces (point-min) (point-max)))
3417 ;;;###autoload
3418 (defun ps-spool-region (from to)
3419 "Generate a PostScript image of the region and spool locally.
3420 Like `ps-spool-buffer', but spools just the current region.
3422 Use the command `ps-despool' to send the spooled images to the printer."
3423 (interactive "r")
3424 (ps-spool-without-faces from to t))
3427 ;;;###autoload
3428 (defun ps-spool-region-with-faces (from to)
3429 "Generate a PostScript image of the region and spool locally.
3430 Like `ps-spool-region', but includes font, color, and underline information in
3431 the generated image. This command works only if you are using a window system,
3432 so it has a way to determine color values.
3434 Use the command `ps-despool' to send the spooled images to the printer."
3435 (interactive "r")
3436 (ps-spool-with-faces from to t))
3438 ;;;###autoload
3439 (defun ps-despool (&optional filename)
3440 "Send the spooled PostScript to the printer.
3442 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3443 user for a file name, and saves the spooled PostScript image in that file
3444 instead of sending it to the printer.
3446 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3447 send the image to the printer. If FILENAME is a string, save the PostScript
3448 image in a file with that name."
3449 (interactive (list (ps-print-preprint current-prefix-arg)))
3450 (ps-do-despool filename))
3452 ;;;###autoload
3453 (defun ps-line-lengths ()
3454 "Display the correspondence between a line length and a font size.
3455 Done using the current ps-print setup.
3456 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3457 (interactive)
3458 (ps-line-lengths-internal))
3460 ;;;###autoload
3461 (defun ps-nb-pages-buffer (nb-lines)
3462 "Display number of pages to print this buffer, for various font heights.
3463 The table depends on the current ps-print setup."
3464 (interactive (ps-count-lines-preprint (point-min) (point-max)))
3465 (ps-nb-pages nb-lines))
3467 ;;;###autoload
3468 (defun ps-nb-pages-region (nb-lines)
3469 "Display number of pages to print the region, for various font heights.
3470 The table depends on the current ps-print setup."
3471 (interactive (ps-count-lines-preprint (mark) (point)))
3472 (ps-nb-pages nb-lines))
3474 (defvar ps-prefix-quote nil
3475 "Used for `ps-print-quote' (which see).")
3477 ;;;###autoload
3478 (defun ps-setup ()
3479 "Return the current PostScript-generation setup."
3480 (let (ps-prefix-quote)
3481 (mapconcat
3482 #'ps-print-quote
3483 (list
3484 (concat "\n;;; ps-print version " ps-print-version "\n")
3485 '(25 . ps-print-color-p)
3486 '(25 . ps-lpr-command)
3487 '(25 . ps-lpr-switches)
3488 '(25 . ps-printer-name)
3489 '(25 . ps-printer-name-option)
3490 '(25 . ps-print-region-function)
3491 '(25 . ps-manual-feed)
3492 '(25 . ps-end-with-control-d)
3494 '(23 . ps-paper-type)
3495 '(23 . ps-warn-paper-type)
3496 '(23 . ps-landscape-mode)
3497 '(23 . ps-print-upside-down)
3498 '(23 . ps-number-of-columns)
3500 '(23 . ps-zebra-stripes)
3501 '(23 . ps-zebra-stripe-height)
3502 '(23 . ps-zebra-stripe-follow)
3503 '(23 . ps-zebra-color)
3504 '(23 . ps-line-number)
3505 '(23 . ps-line-number-step)
3506 '(23 . ps-line-number-start)
3508 '(17 . ps-default-fg)
3509 '(17 . ps-default-bg)
3510 '(17 . ps-razzle-dazzle)
3512 '(23 . ps-use-face-background)
3514 '(28 . ps-print-control-characters)
3516 '(26 . ps-print-background-image)
3518 '(25 . ps-print-background-text)
3520 '(29 . ps-error-handler-message)
3521 '(29 . ps-user-defined-prologue)
3522 '(29 . ps-print-prologue-header)
3523 '(29 . ps-postscript-code-directory)
3524 '(29 . ps-adobe-tag)
3526 '(30 . ps-left-margin)
3527 '(30 . ps-right-margin)
3528 '(30 . ps-inter-column)
3529 '(30 . ps-bottom-margin)
3530 '(30 . ps-top-margin)
3531 '(30 . ps-print-only-one-header)
3532 '(30 . ps-switch-header)
3533 '(30 . ps-print-header)
3534 '(30 . ps-header-lines)
3535 '(30 . ps-header-offset)
3536 '(30 . ps-header-line-pad)
3537 '(30 . ps-print-header-frame)
3538 '(30 . ps-header-frame-alist)
3539 '(30 . ps-print-footer)
3540 '(30 . ps-footer-lines)
3541 '(30 . ps-footer-offset)
3542 '(30 . ps-footer-line-pad)
3543 '(30 . ps-print-footer-frame)
3544 '(30 . ps-footer-frame-alist)
3545 '(30 . ps-show-n-of-n)
3546 '(30 . ps-spool-config)
3547 '(30 . ps-spool-duplex)
3548 '(30 . ps-spool-tumble)
3549 '(30 . ps-banner-page-when-duplexing)
3550 '(30 . ps-left-header)
3551 '(30 . ps-right-header)
3552 '(30 . ps-left-footer)
3553 '(30 . ps-right-footer)
3555 '(23 . ps-n-up-printing)
3556 '(23 . ps-n-up-margin)
3557 '(23 . ps-n-up-border-p)
3558 '(23 . ps-n-up-filling)
3560 '(26 . ps-multibyte-buffer)
3561 '(26 . ps-font-family)
3562 '(26 . ps-font-size)
3563 '(26 . ps-header-font-family)
3564 '(26 . ps-header-font-size)
3565 '(26 . ps-header-title-font-size)
3566 '(26 . ps-footer-font-family)
3567 '(26 . ps-footer-font-size)
3568 '(26 . ps-line-number-color)
3569 '(26 . ps-line-number-font)
3570 '(26 . ps-line-number-font-size)
3571 '(26 . ps-line-spacing)
3572 '(26 . ps-paragraph-spacing)
3573 '(26 . ps-paragraph-regexp)
3574 '(26 . ps-begin-cut-regexp)
3575 '(26 . ps-end-cut-regexp)
3577 '(23 . ps-even-or-odd-pages)
3578 '(23 . ps-selected-pages)
3579 '(23 . ps-last-selected-pages)
3581 '(31 . ps-build-face-reference)
3582 '(31 . ps-always-build-face-reference)
3584 '(20 . ps-auto-font-detect)
3585 '(20 . ps-bold-faces)
3586 '(20 . ps-italic-faces)
3587 '(20 . ps-underlined-faces)
3588 '(20 . ps-black-white-faces)
3589 " )\n
3590 ;; The following customized variables have long lists and are seldom modified:
3591 ;; ps-page-dimensions-database
3592 ;; ps-font-info-database
3594 ;;; ps-print - end of settings\n")
3595 "\n")))
3598 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3599 ;; Utility functions and variables:
3602 (defun ps-print-quote (elt)
3603 "Quote ELT for printing (used for showing settings).
3605 If ELT is nil, return an empty string.
3606 If ELT is string, return it.
3607 Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3608 LEN is the field length where SYM name will be inserted. The variable
3609 `ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
3610 used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3611 generated is:
3613 * If `ps-prefix-quote' is nil:
3614 \"(setq SYM-NAME SYM-VALUE\"
3615 |<------->|
3618 * If `ps-prefix-quote' is non-nil:
3619 \" SYM-NAME SYM-VALUE\"
3620 |<------->|
3623 If `ps-prefix-quote' is nil, it's set to t after generating string."
3624 (cond
3625 ((stringp elt) elt)
3626 ((and (consp elt) (integerp (car elt))
3627 (symbolp (cdr elt)) (boundp (cdr elt)))
3628 (let* ((col (car elt))
3629 (sym (cdr elt))
3630 (key (symbol-name sym))
3631 (len (length key))
3632 (val (symbol-value sym)))
3633 (concat (if ps-prefix-quote
3635 (setq ps-prefix-quote t)
3636 "(setq ")
3638 (if (> col len)
3639 (make-string (- col len) ?\ )
3640 " ")
3641 (cond ((null val) "nil")
3642 ((eq val t) "t")
3643 ((or (symbolp val) (listp val)) (format "'%S" val))
3644 (t (format "%S" val))))))
3645 (t "")
3649 (defun ps-value (alist-sym key)
3650 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3651 (cdr (assq key (symbol-value alist-sym))))
3654 (defun ps-get (alist-sym key)
3655 "Return element from association list ALIST-SYM which car is `eq' to KEY."
3656 (assq key (symbol-value alist-sym)))
3659 (defun ps-put (alist-sym key value)
3660 "Store element (KEY . VALUE) into association list ALIST-SYM.
3661 If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3662 It can be retrieved with `(ps-get ALIST-SYM KEY)'."
3663 (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
3664 (if elt:
3665 (setcdr elt: value)
3666 (setq elt: (cons key value))
3667 (set alist-sym (cons elt: (symbol-value alist-sym))))
3668 elt:))
3671 (defun ps-del (alist-sym key)
3672 "Delete by side effect element KEY from association list ALIST-SYM."
3673 (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
3674 old)
3675 (while a:list:
3676 (if (eq key (car (car a:list:)))
3677 (progn
3678 (if old
3679 (setcdr old (cdr a:list:))
3680 (set alist-sym (cdr a:list:)))
3681 (setq a:list: nil))
3682 (setq old a:list:
3683 a:list: (cdr a:list:)))))
3684 (symbol-value alist-sym))
3687 (defun ps-time-stamp-locale-default ()
3688 "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
3689 (format-time-string "%x"))
3692 (defun ps-time-stamp-mon-dd-yyyy ()
3693 "Return date as \"Jun 18 2001\"."
3694 (format-time-string "%b %d %Y"))
3697 (defun ps-time-stamp-hh:mm:ss ()
3698 "Return time as \"17:28:31\"."
3699 (format-time-string "%T"))
3702 (eval-and-compile
3703 (and (eq ps-print-emacs-type 'xemacs)
3704 ;; XEmacs change: Need to check for emacs-major-version too.
3705 (or (< emacs-major-version 19)
3706 (and (= emacs-major-version 19) (< emacs-minor-version 12)))
3707 (setq ps-print-color-p nil))
3710 ;; Return t if the device (which can be changed during an emacs session)
3711 ;; can handle colors.
3712 ;; This function is not yet implemented for GNU emacs.
3713 (cond ((and (eq ps-print-emacs-type 'xemacs)
3714 ;; XEmacs change: Need to check for emacs-major-version too.
3715 (or (> emacs-major-version 19)
3716 (and (= emacs-major-version 19)
3717 (>= emacs-minor-version 12)))) ; xemacs >= 19.12
3718 (defun ps-color-device ()
3719 (eq (ps-x-device-class) 'color)))
3721 (t ; emacs
3722 (defun ps-color-device ()
3723 (if (fboundp 'color-values)
3724 (ps-e-color-values "Green")
3725 t))))
3728 (defun ps-mapper (extent list)
3729 (nconc list
3730 (list (list (ps-x-extent-start-position extent) 'push extent)
3731 (list (ps-x-extent-end-position extent) 'pull extent)))
3732 nil)
3734 (defun ps-extent-sorter (a b)
3735 (< (ps-x-extent-priority a) (ps-x-extent-priority b)))
3737 (defun ps-xemacs-face-kind-p (face kind kind-regex)
3738 (let* ((frame-font (or (ps-x-face-font-instance face)
3739 (ps-x-face-font-instance 'default)))
3740 (kind-cons
3741 (and frame-font
3742 (assq kind
3743 (ps-x-font-instance-properties frame-font))))
3744 (kind-spec (cdr-safe kind-cons))
3745 (case-fold-search t))
3746 (and kind-spec (string-match kind-regex kind-spec))))
3748 (cond ((eq ps-print-emacs-type 'emacs) ; emacs
3750 (defun ps-color-values (x-color)
3751 (cond
3752 ((fboundp 'color-values)
3753 (ps-e-color-values x-color))
3754 ((fboundp 'x-color-values)
3755 (ps-e-x-color-values x-color))
3757 (error "No available function to determine X color values"))))
3759 (defun ps-face-bold-p (face)
3760 (or (ps-e-face-bold-p face)
3761 (memq face ps-bold-faces)))
3763 (defun ps-face-italic-p (face)
3764 (or (ps-e-face-italic-p face)
3765 (memq face ps-italic-faces)))
3768 (t ; xemacs
3770 ;; to avoid XEmacs compilation gripes
3771 (defvar coding-system-for-write nil)
3772 (defvar coding-system-for-read nil)
3773 (defvar buffer-file-coding-system nil)
3775 (and (fboundp 'find-coding-system)
3776 (or (ps-x-find-coding-system 'raw-text-unix)
3777 (ps-x-copy-coding-system 'no-conversion-unix 'raw-text-unix)))
3779 (defun ps-color-values (x-color)
3780 (let ((color (ps-xemacs-color-name x-color)))
3781 (cond
3782 ((fboundp 'x-color-values)
3783 (ps-e-x-color-values color))
3784 ((and (fboundp 'color-instance-rgb-components)
3785 (ps-color-device))
3786 (ps-x-color-instance-rgb-components
3787 (if (ps-x-color-instance-p x-color)
3788 x-color
3789 (ps-x-make-color-instance color))))
3791 (error "No available function to determine X color values")))))
3793 (defun ps-face-bold-p (face)
3794 (or (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold")
3795 (memq face ps-bold-faces))) ; Kludge-compatible
3797 (defun ps-face-italic-p (face)
3798 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o")
3799 (ps-xemacs-face-kind-p face 'SLANT "i\\|o")
3800 (memq face ps-italic-faces))) ; Kludge-compatible
3804 (defvar ps-print-color-scale 1.0)
3806 (defun ps-color-scale (color)
3807 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3808 (mapcar #'(lambda (value) (/ value ps-print-color-scale))
3809 (ps-color-values color)))
3812 (defun ps-face-underlined-p (face)
3813 (or (face-underline-p face)
3814 (memq face ps-underlined-faces)))
3817 (defun ps-prologue-file (filenumber)
3818 "If prologue FILENUMBER exists and is readable, return contents as string.
3820 Note: No major/minor-mode is activated and no local variables are evaluated for
3821 FILENUMBER, but proper EOL-conversion and character interpretation is
3822 done!"
3823 (let ((filename (convert-standard-filename
3824 (expand-file-name (format "ps-prin%d.ps" filenumber)
3825 ps-postscript-code-directory))))
3826 (if (and (file-exists-p filename)
3827 (file-readable-p filename))
3828 (with-temp-buffer
3829 (insert-file-contents filename)
3830 (buffer-string))
3831 (error "ps-print PostScript prologue `%s' file was not found"
3832 filename))))
3835 (defvar ps-mark-code-directory nil)
3837 (defvar ps-print-prologue-0 ""
3838 "ps-print PostScript error handler.")
3840 (defvar ps-print-prologue-1 ""
3841 "ps-print PostScript prologue.")
3843 ;; Start Editing Here:
3845 (defvar ps-source-buffer nil)
3846 (defvar ps-spool-buffer-name "*PostScript*")
3847 (defvar ps-spool-buffer nil)
3849 (defvar ps-output-head nil)
3850 (defvar ps-output-tail nil)
3852 (defvar ps-page-postscript 0) ; page number
3853 (defvar ps-page-order 0) ; PostScript page counter
3854 (defvar ps-page-sheet 0) ; sheet counter
3855 (defvar ps-page-column 0) ; column counter
3856 (defvar ps-page-printed 0) ; total pages printed
3857 (defvar ps-page-n-up 0) ; n-up counter
3858 (defvar ps-lines-printed 0) ; total lines printed
3859 (defvar ps-showline-count 1) ; line number counter
3860 (defvar ps-first-page nil)
3861 (defvar ps-last-page nil)
3862 (defvar ps-print-page-p t)
3864 (defvar ps-control-or-escape-regexp nil)
3865 (defvar ps-n-up-on nil)
3867 (defvar ps-background-pages nil)
3868 (defvar ps-background-all-pages nil)
3869 (defvar ps-background-text-count 0)
3870 (defvar ps-background-image-count 0)
3872 (defvar ps-current-font 0)
3873 (defvar ps-default-foreground nil)
3874 (defvar ps-default-background nil)
3875 (defvar ps-default-color nil)
3876 (defvar ps-current-color nil)
3877 (defvar ps-current-bg nil)
3879 (defvar ps-zebra-stripe-full-p nil)
3880 (defvar ps-razchunk 0)
3882 (defvar ps-color-p nil)
3883 (defvar ps-color-format
3884 (if (eq ps-print-emacs-type 'emacs)
3886 ;; Emacs understands the %f format; we'll use it to limit color RGB
3887 ;; values to three decimals to cut down some on the size of the
3888 ;; PostScript output.
3889 "%0.3f %0.3f %0.3f"
3891 ;; XEmacs will have to make do with %s (princ) for floats.
3892 "%s %s %s"))
3894 ;; These values determine how much print-height to deduct when headers/footers
3895 ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
3896 ;; now.
3898 (defvar ps-header-pad 0
3899 "Vertical and horizontal space between the header frame and the text.
3900 This is in units of points (1/72 inch).")
3902 (defvar ps-footer-pad 0
3903 "Vertical and horizontal space between the footer frame and the text.
3904 This is in units of points (1/72 inch).")
3906 ;; Define accessors to the dimensions list.
3908 (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
3909 (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
3910 (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
3912 (defvar ps-landscape-page-height nil)
3914 (defvar ps-print-width nil)
3915 (defvar ps-print-height nil)
3917 (defvar ps-height-remaining nil)
3918 (defvar ps-width-remaining nil)
3920 (defvar ps-font-size-internal nil)
3921 (defvar ps-header-font-size-internal nil)
3922 (defvar ps-header-title-font-size-internal nil)
3923 (defvar ps-footer-font-size-internal nil)
3924 (defvar ps-line-spacing-internal nil)
3925 (defvar ps-paragraph-spacing-internal nil)
3928 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3929 ;; Internal Variables
3932 (defvar ps-black-white-faces-alist nil
3933 "Alist of symbolic faces used for black/white PostScript printers.
3934 An element of this list has the same form as `ps-print-face-extension-alist'
3935 \(which see).
3937 Don't change this list directly; instead,
3938 use `ps-extend-face' and `ps-extend-face-list'.
3939 See documentation for `ps-extend-face' for valid extension symbol.
3940 See also documentation for `ps-print-color-p'.")
3943 (defvar ps-print-face-extension-alist nil
3944 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
3945 An element of this list has the following form:
3947 (FACE . [BITS FG BG])
3949 FACE is a symbol denoting a face name
3950 BITS is a bit vector, where each bit correspond
3951 to a feature (bold, underline, etc)
3952 (see documentation for `ps-print-face-map-alist')
3953 FG foreground color (string or nil)
3954 BG background color (string or nil)
3956 Don't change this list directly; instead,
3957 use `ps-extend-face' and `ps-extend-face-list'.
3958 See documentation for `ps-extend-face' for valid extension symbol.")
3961 (defvar ps-print-face-alist nil
3962 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
3964 An element of this list has the same form as an element of
3965 `ps-print-face-extension-alist'.
3967 Don't change this list directly; this list is used by `ps-face-attributes',
3968 `ps-map-face' and `ps-build-reference-face-lists'.")
3971 (defconst ps-print-face-map-alist
3972 '((bold . 1)
3973 (italic . 2)
3974 (underline . 4)
3975 (strikeout . 8)
3976 (overline . 16)
3977 (shadow . 32)
3978 (box . 64)
3979 (outline . 128))
3980 "Alist of all features and the corresponding bit mask.
3981 Each symbol correspond to one bit in a bit vector.")
3984 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3985 ;; Remapping Faces
3988 ;;;###autoload
3989 (defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym)
3990 "Extend face in ALIST-SYM.
3992 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
3993 with face extension in ALIST-SYM; otherwise, overrides.
3995 If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
3996 otherwise, it should be an alist symbol.
3998 The elements in FACE-EXTENSION-LIST is like those for `ps-extend-face'.
4000 See `ps-extend-face' for documentation."
4001 (while face-extension-list
4002 (ps-extend-face (car face-extension-list) merge-p alist-sym)
4003 (setq face-extension-list (cdr face-extension-list))))
4006 ;;;###autoload
4007 (defun ps-extend-face (face-extension &optional merge-p alist-sym)
4008 "Extend face in ALIST-SYM.
4010 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
4011 with face extensions in ALIST-SYM; otherwise, overrides.
4013 If optional ALIST-SYM is nil, it's used `ps-print-face-extension-alist';
4014 otherwise, it should be an alist symbol.
4016 The elements of FACE-EXTENSION list have the form:
4018 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
4020 FACE-NAME is a face name symbol.
4022 FOREGROUND and BACKGROUND may be nil or a string that denotes the
4023 foreground and background colors respectively.
4025 EXTENSION is one of the following symbols:
4026 bold - use bold font.
4027 italic - use italic font.
4028 underline - put a line under text.
4029 strikeout - like underline, but the line is in middle of text.
4030 overline - like underline, but the line is over the text.
4031 shadow - text will have a shadow.
4032 box - text will be surrounded by a box.
4033 outline - print characters as hollow outlines.
4035 If EXTENSION is any other symbol, it is ignored."
4036 (or alist-sym
4037 (setq alist-sym 'ps-print-face-extension-alist))
4038 (let* ((background (nth 2 face-extension))
4039 (foreground (nth 1 face-extension))
4040 (face-name (nth 0 face-extension))
4041 (ps-face (cdr (assq face-name (symbol-value alist-sym))))
4042 (face-vector (or ps-face (vector 0 nil nil)))
4043 (face-bit (ps-extension-bit face-extension)))
4044 ;; extend face
4045 (aset face-vector 0 (if merge-p
4046 (logior (aref face-vector 0) face-bit)
4047 face-bit))
4048 (and (or (not merge-p) (and foreground (stringp foreground)))
4049 (aset face-vector 1 foreground))
4050 (and (or (not merge-p) (and background (stringp background)))
4051 (aset face-vector 2 background))
4052 ;; if face does not exist, insert it
4053 (or ps-face
4054 (set alist-sym (cons (cons face-name face-vector)
4055 (symbol-value alist-sym))))))
4058 (defun ps-extension-bit (face-extension)
4059 (let ((face-bit 0))
4060 ;; map valid symbol extension to bit vector
4061 (setq face-extension (cdr (cdr face-extension)))
4062 (while (setq face-extension (cdr face-extension))
4063 (setq face-bit (logior face-bit
4064 (or (cdr (assq (car face-extension)
4065 ps-print-face-map-alist))
4066 0))))
4067 face-bit))
4070 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4071 ;; Adapted from font-lock: (obsolete stuff)
4072 ;; Originally face attributes were specified via `font-lock-face-attributes'.
4073 ;; Users then changed the default face attributes by setting that variable.
4074 ;; However, we try and be back-compatible and respect its value if set except
4075 ;; for faces where M-x customize has been used to save changes for the face.
4078 (defun ps-font-lock-face-attributes ()
4079 (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
4080 (boundp 'font-lock-face-attributes)
4081 (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
4082 (while face-attributes
4083 (let* ((face-attribute
4084 (car (prog1 face-attributes
4085 (setq face-attributes (cdr face-attributes)))))
4086 (face (car face-attribute)))
4087 ;; Rustle up a `defface' SPEC from a
4088 ;; `font-lock-face-attributes' entry.
4089 (unless (get face 'saved-face)
4090 (let ((foreground (nth 1 face-attribute))
4091 (background (nth 2 face-attribute))
4092 (bold-p (nth 3 face-attribute))
4093 (italic-p (nth 4 face-attribute))
4094 (underline-p (nth 5 face-attribute))
4095 face-spec)
4096 (when foreground
4097 (setq face-spec (cons ':foreground
4098 (cons foreground face-spec))))
4099 (when background
4100 (setq face-spec (cons ':background
4101 (cons background face-spec))))
4102 (when bold-p
4103 (setq face-spec (append '(:weight bold) face-spec)))
4104 (when italic-p
4105 (setq face-spec (append '(:slant italic) face-spec)))
4106 (when underline-p
4107 (setq face-spec (append '(:underline t) face-spec)))
4108 (custom-declare-face face (list (list t face-spec)) nil)
4109 )))))))
4112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4113 ;; Internal functions and variables
4116 (defvar ps-print-hook nil)
4117 (defvar ps-print-begin-sheet-hook nil)
4118 (defvar ps-print-begin-page-hook nil)
4119 (defvar ps-print-begin-column-hook nil)
4122 (defun ps-print-without-faces (from to &optional filename region-p)
4123 (ps-spool-without-faces from to region-p)
4124 (ps-do-despool filename))
4127 (defun ps-spool-without-faces (from to &optional region-p)
4128 (run-hooks 'ps-print-hook)
4129 (ps-printing-region region-p from)
4130 (ps-generate (current-buffer) from to 'ps-generate-postscript))
4133 (defun ps-print-with-faces (from to &optional filename region-p)
4134 (ps-spool-with-faces from to region-p)
4135 (ps-do-despool filename))
4138 (defun ps-spool-with-faces (from to &optional region-p)
4139 (run-hooks 'ps-print-hook)
4140 (ps-printing-region region-p from)
4141 (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces))
4144 (defun ps-count-lines-preprint (from to)
4145 (or (and from to)
4146 (error "The mark is not set now"))
4147 (list (count-lines from to)))
4150 (defun ps-count-lines (from to)
4151 (+ (count-lines from to)
4152 (save-excursion
4153 (goto-char to)
4154 (if (= (current-column) 0) 1 0))))
4157 (defvar ps-printing-region nil
4158 "Variable used to indicate if the region that ps-print is printing.
4159 It is a cons, the car of which is the line number where the region begins, and
4160 its cdr is the total number of lines in the buffer. Formatting functions can
4161 use this information to print the original line number (and not the number of
4162 lines printed), and to indicate in the header that the printout is of a partial
4163 file.")
4166 (defvar ps-printing-region-p nil
4167 "Non-nil means ps-print is printing a region.")
4170 (defun ps-printing-region (region-p from)
4171 (setq ps-printing-region-p region-p
4172 ps-printing-region
4173 (cons (if region-p
4174 (ps-count-lines (point-min) from)
4176 (ps-count-lines (point-min) (point-max)))))
4179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4180 ;; Internal functions
4183 (defsubst ps-font-alist (font-sym)
4184 (get font-sym 'fonts))
4186 (defun ps-font (font-sym font-type)
4187 "Font family name for text of `font-type', when generating PostScript."
4188 (let* ((font-list (ps-font-alist font-sym))
4189 (normal-font (cdr (assq 'normal font-list))))
4190 (while (and font-list (not (eq font-type (car (car font-list)))))
4191 (setq font-list (cdr font-list)))
4192 (or (cdr (car font-list)) normal-font)))
4194 (defsubst ps-fonts (font-sym)
4195 (mapcar 'cdr (ps-font-alist font-sym)))
4197 (defsubst ps-font-number (font-sym font-type)
4198 (or (ps-alist-position font-type (ps-font-alist font-sym))
4201 (defsubst ps-line-height (font-sym)
4202 "The height of a line, for generating PostScript.
4203 This is the value that ps-print uses to determine the height,
4204 y-dimension, of the lines of text it has printed, and thus affects the
4205 point at which page-breaks are placed.
4206 The line-height is *not* the same as the point size of the font."
4207 (get font-sym 'line-height))
4209 (defsubst ps-title-line-height (font-sym)
4210 "The height of a `title' line, for generating PostScript.
4211 This is the value that ps-print uses to determine the height,
4212 y-dimension, of the lines of text it has printed, and thus affects the
4213 point at which page-breaks are placed.
4214 The title-line-height is *not* the same as the point size of the font."
4215 (get font-sym 'title-line-height))
4217 (defsubst ps-space-width (font-sym)
4218 "The width of a space character, for generating PostScript.
4219 This value is used in expanding tab characters."
4220 (get font-sym 'space-width))
4222 (defsubst ps-avg-char-width (font-sym)
4223 "The average width, in points, of a character, for generating PostScript.
4224 This is the value that ps-print uses to determine the length,
4225 x-dimension, of the text it has printed, and thus affects the point at
4226 which long lines wrap around."
4227 (get font-sym 'avg-char-width))
4229 (defun ps-line-lengths-internal ()
4230 "Display the correspondence between a line length and a font size.
4231 Done using the current ps-print setup.
4232 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4233 (let* ((ps-font-size-internal
4234 (or ps-font-size-internal
4235 (ps-get-font-size 'ps-font-size)))
4236 (ps-header-font-size-internal
4237 (or ps-header-font-size-internal
4238 (ps-get-font-size 'ps-header-font-size)))
4239 (ps-header-title-font-size-internal
4240 (or ps-header-title-font-size-internal
4241 (ps-get-font-size 'ps-header-title-font-size)))
4242 (buf (get-buffer-create "*Line-lengths*"))
4243 (ifs ps-font-size-internal) ; initial font size
4244 (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
4245 (print-width (progn (ps-get-page-dimensions)
4246 ps-print-width))
4247 (ps-setup (ps-setup)) ; setup for the current buffer
4248 (fs-min 5) ; minimum font size
4249 cw-min ; minimum character width
4250 nb-cpl-max ; maximum nb of characters per line
4251 (fs-max 14) ; maximum font size
4252 cw-max ; maximum character width
4253 nb-cpl-min ; minimum nb of characters per line
4254 fs ; current font size
4255 cw ; current character width
4256 nb-cpl ; current nb of characters per line
4258 (setq cw-min (/ (* icw fs-min) ifs)
4259 nb-cpl-max (floor (/ print-width cw-min))
4260 cw-max (/ (* icw fs-max) ifs)
4261 nb-cpl-min (floor (/ print-width cw-max))
4262 nb-cpl nb-cpl-min)
4263 (set-buffer buf)
4264 (goto-char (point-max))
4265 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4266 (insert ps-setup
4267 "\nnb char per line / font size\n")
4268 (while (<= nb-cpl nb-cpl-max)
4269 (setq cw (/ print-width (float nb-cpl))
4270 fs (/ (* ifs cw) icw))
4271 (insert (format "%16d %s\n" nb-cpl fs))
4272 (setq nb-cpl (1+ nb-cpl)))
4273 (insert "\n")
4274 (display-buffer buf 'not-this-window)))
4276 (defun ps-nb-pages (nb-lines)
4277 "Display correspondence between font size and the number of pages.
4278 The correspondence is based on having NB-LINES lines of text,
4279 and on the current ps-print setup."
4280 (let* ((ps-font-size-internal
4281 (or ps-font-size-internal
4282 (ps-get-font-size 'ps-font-size)))
4283 (ps-header-font-size-internal
4284 (or ps-header-font-size-internal
4285 (ps-get-font-size 'ps-header-font-size)))
4286 (ps-header-title-font-size-internal
4287 (or ps-header-title-font-size-internal
4288 (ps-get-font-size 'ps-header-title-font-size)))
4289 (ps-line-spacing-internal
4290 (or ps-line-spacing-internal
4291 (ps-get-size ps-line-spacing "line spacing")))
4292 (buf (get-buffer-create "*Nb-Pages*"))
4293 (ils ps-line-spacing-internal) ; initial line spacing
4294 (ifs ps-font-size-internal) ; initial font size
4295 (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
4296 (page-height (progn (ps-get-page-dimensions)
4297 ps-print-height))
4298 (ps-setup (ps-setup)) ; setup for the current buffer
4299 (fs-min 4) ; minimum font size
4300 lh-min ; minimum line height
4301 nb-lpp-max ; maximum nb of lines per page
4302 nb-page-min ; minimum nb of pages
4303 (fs-max 14) ; maximum font size
4304 lh-max ; maximum line height
4305 nb-lpp-min ; minimum nb of lines per page
4306 nb-page-max ; maximum nb of pages
4307 fs ; current font size
4308 lh ; current line height
4309 nb-lpp ; current nb of lines per page
4310 nb-page ; current nb of pages
4312 (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
4313 nb-lpp-max (floor (/ page-height lh-min))
4314 nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
4315 lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
4316 nb-lpp-min (floor (/ page-height lh-max))
4317 nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
4318 nb-page nb-page-min)
4319 (set-buffer buf)
4320 (goto-char (point-max))
4321 (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
4322 (insert ps-setup
4323 (format "\nThere are %d lines.\n\n" nb-lines)
4324 "nb page / font size\n")
4325 (while (<= nb-page nb-page-max)
4326 (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
4327 lh (/ page-height nb-lpp)
4328 fs (/ (* ifs lh) ilh))
4329 (insert (format "%7d %s\n" nb-page fs))
4330 (setq nb-page (1+ nb-page)))
4331 (insert "\n")
4332 (display-buffer buf 'not-this-window)))
4334 ;; macros used in `ps-select-font'
4335 (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
4336 (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
4338 (defun ps-select-font (font-family sym font-size title-font-size)
4339 (let ((font-entry (cdr (assq font-family ps-font-info-database))))
4340 (or font-entry
4341 (error "Don't have data to scale font %s. Known fonts families are %s"
4342 font-family
4343 (mapcar 'car ps-font-info-database)))
4344 (let ((size (ps-lookup 'size)))
4345 (put sym 'fonts (ps-lookup 'fonts))
4346 (put sym 'space-width (ps-size-scale 'space-width))
4347 (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
4348 (put sym 'line-height (ps-size-scale 'line-height))
4349 (put sym 'title-line-height
4350 (/ (* (ps-lookup 'line-height) title-font-size) size)))))
4352 (defun ps-get-page-dimensions ()
4353 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
4354 page-width page-height)
4355 (cond
4356 ((null page-dimensions)
4357 (error "`ps-paper-type' must be one of:\n%s"
4358 (mapcar 'car ps-page-dimensions-database)))
4359 ((< ps-number-of-columns 1)
4360 (error "The number of columns %d should be positive"
4361 ps-number-of-columns)))
4363 (ps-select-font ps-font-family 'ps-font-for-text
4364 ps-font-size-internal ps-font-size-internal)
4365 (ps-select-font ps-header-font-family 'ps-font-for-header
4366 ps-header-font-size-internal
4367 ps-header-title-font-size-internal)
4368 (ps-select-font ps-footer-font-family 'ps-font-for-footer
4369 ps-footer-font-size-internal ps-footer-font-size-internal)
4371 (setq page-width (ps-page-dimensions-get-width page-dimensions)
4372 page-height (ps-page-dimensions-get-height page-dimensions))
4374 ;; Landscape mode
4375 (if ps-landscape-mode
4376 ;; exchange width and height
4377 (setq page-width (prog1 page-height (setq page-height page-width))))
4379 ;; It is used to get the lower right corner (only in landscape mode)
4380 (setq ps-landscape-page-height page-height)
4382 ;; | lm | text | ic | text | ic | text | rm |
4383 ;; page-width == lm + n * pw + (n - 1) * ic + rm
4384 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
4385 (setq ps-print-width (/ (- page-width
4386 ps-left-margin ps-right-margin
4387 (* (1- ps-number-of-columns) ps-inter-column))
4388 ps-number-of-columns))
4389 (if (<= ps-print-width 0)
4390 (error "Bad horizontal layout:
4391 page-width == %s
4392 ps-left-margin == %s
4393 ps-right-margin == %s
4394 ps-inter-column == %s
4395 ps-number-of-columns == %s
4396 | lm | text | ic | text | ic | text | rm |
4397 page-width == lm + n * print-width + (n - 1) * ic + rm
4398 => print-width == %d !"
4399 page-width
4400 ps-left-margin
4401 ps-right-margin
4402 ps-inter-column
4403 ps-number-of-columns
4404 ps-print-width))
4406 (setq ps-print-height
4407 (- page-height ps-bottom-margin ps-top-margin))
4408 (if (<= ps-print-height 0)
4409 (error "Bad vertical layout:
4410 ps-top-margin == %s
4411 ps-bottom-margin == %s
4412 page-height == bm + print-height + tm
4413 => print-height == %d !"
4414 ps-top-margin
4415 ps-bottom-margin
4416 ps-print-height))
4417 ;; If headers are turned on, deduct the height of the header from the print
4418 ;; height.
4419 (if ps-print-header
4420 (setq ps-header-pad (* ps-header-line-pad
4421 (ps-title-line-height 'ps-font-for-header))
4422 ps-print-height (- ps-print-height
4423 ps-header-offset
4424 ps-header-pad
4425 (ps-title-line-height 'ps-font-for-header)
4426 (* (ps-line-height 'ps-font-for-header)
4427 (1- ps-header-lines))
4428 ps-header-pad)))
4429 (if (<= ps-print-height 0)
4430 (error "Bad vertical layout (header):
4431 ps-top-margin == %s
4432 ps-bottom-margin == %s
4433 ps-header-offset == %s
4434 ps-header-pad == %s
4435 header-height == %s
4436 page-height == bm + print-height + tm - ho - hh
4437 => print-height == %d !"
4438 ps-top-margin
4439 ps-bottom-margin
4440 ps-header-offset
4441 ps-header-pad
4442 (+ ps-header-pad
4443 (ps-title-line-height 'ps-font-for-header)
4444 (* (ps-line-height 'ps-font-for-header)
4445 (1- ps-header-lines))
4446 ps-header-pad)
4447 ps-print-height))
4448 ;; If footers are turned on, deduct the height of the footer from the print
4449 ;; height.
4450 (if ps-print-footer
4451 (setq ps-footer-pad (* ps-footer-line-pad
4452 (ps-title-line-height 'ps-font-for-footer))
4453 ps-print-height (- ps-print-height
4454 ps-footer-offset
4455 ps-footer-pad
4456 (* (ps-line-height 'ps-font-for-footer)
4457 (1- ps-footer-lines))
4458 ps-footer-pad)))
4459 (if (<= ps-print-height 0)
4460 (error "Bad vertical layout (footer):
4461 ps-top-margin == %s
4462 ps-bottom-margin == %s
4463 ps-footer-offset == %s
4464 ps-footer-pad == %s
4465 footer-height == %s
4466 page-height == bm + print-height + tm - fo - fh
4467 => print-height == %d !"
4468 ps-top-margin
4469 ps-bottom-margin
4470 ps-footer-offset
4471 ps-footer-pad
4472 (+ ps-footer-pad
4473 (* (ps-line-height 'ps-font-for-footer)
4474 (1- ps-footer-lines))
4475 ps-footer-pad)
4476 ps-print-height))
4477 ;; ps-zebra-stripe-follow is `full' or `full-follow'
4478 (if ps-zebra-stripe-full-p
4479 (let* ((line-height (ps-line-height 'ps-font-for-text))
4480 (zebra (* (+ line-height ps-line-spacing-internal)
4481 ps-zebra-stripe-height)))
4482 (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
4483 line-height))
4484 (if (<= ps-print-height 0)
4485 (error "Bad vertical layout (full zebra stripe follow):
4486 ps-zebra-stripe-follow == %s
4487 ps-zebra-stripe-height == %s
4488 font-text-height == %s
4489 line-spacing == %s
4490 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
4491 => print-height == %d !"
4492 ps-zebra-stripe-follow
4493 ps-zebra-stripe-height
4494 (ps-line-height 'ps-font-for-text)
4495 ps-line-spacing-internal
4496 ps-print-height))))))
4499 (defun ps-print-preprint-region (prefix-arg)
4500 (or (ps-mark-active-p)
4501 (error "The mark is not set now"))
4502 (list (point) (mark) (ps-print-preprint prefix-arg)))
4505 (defun ps-print-preprint (prefix-arg)
4506 (and prefix-arg
4507 (or (numberp prefix-arg)
4508 (listp prefix-arg))
4509 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4510 (buffer-name)))
4511 ".ps"))
4512 (prompt (format "Save PostScript to file: (default %s) " name))
4513 (res (read-file-name prompt default-directory name nil)))
4514 (while (cond ((file-directory-p res)
4515 (ding)
4516 (setq prompt "It's a directory"))
4517 ((not (file-writable-p res))
4518 (ding)
4519 (setq prompt "File is unwritable"))
4520 ((file-exists-p res)
4521 (setq prompt "File exists")
4522 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4523 res))))
4524 (t nil))
4525 (setq res (read-file-name
4526 (format "%s; save PostScript to file: " prompt)
4527 (file-name-directory res) nil nil
4528 (file-name-nondirectory res))))
4529 (if (file-directory-p res)
4530 (expand-file-name name (file-name-as-directory res))
4531 res))))
4533 ;; The following functions implement a simple list-buffering scheme so
4534 ;; that ps-print doesn't have to repeatedly switch between buffers
4535 ;; while spooling. The functions `ps-output' and `ps-output-string' build
4536 ;; up the lists; the function `ps-flush-output' takes the lists and
4537 ;; insert its contents into the spool buffer (*PostScript*).
4539 (defvar ps-string-escape-codes
4540 (let ((table (make-vector 256 nil))
4541 (char ?\000))
4542 ;; control characters
4543 (while (<= char ?\037)
4544 (aset table char (format "\\%03o" char))
4545 (setq char (1+ char)))
4546 ;; printable characters
4547 (while (< char ?\177)
4548 (aset table char (format "%c" char))
4549 (setq char (1+ char)))
4550 ;; DEL and 8-bit characters
4551 (while (<= char ?\377)
4552 (aset table char (format "\\%o" char))
4553 (setq char (1+ char)))
4554 ;; Override ASCII formatting characters with named escape code:
4555 (aset table ?\n "\\n") ; [NL] linefeed
4556 (aset table ?\r "\\r") ; [CR] carriage return
4557 (aset table ?\t "\\t") ; [HT] horizontal tab
4558 (aset table ?\b "\\b") ; [BS] backspace
4559 (aset table ?\f "\\f") ; [NP] form feed
4560 ;; Escape PostScript escape and string delimiter characters:
4561 (aset table ?\\ "\\\\")
4562 (aset table ?\( "\\(")
4563 (aset table ?\) "\\)")
4564 table)
4565 "Vector used to map characters to PostScript string escape codes.")
4567 (defsubst ps-output-string-prim (string)
4568 (insert "(") ;insert start-string delimiter
4569 (save-excursion ;insert string
4570 (insert (string-as-unibyte string)))
4571 ;; Find and quote special characters as necessary for PS
4572 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4573 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4574 (let ((special (following-char)))
4575 (delete-char 1)
4576 (insert
4577 (if (and (<= 0 special) (<= special 255))
4578 (aref ps-string-escape-codes special)
4579 ;; insert hexadecimal representation if character code is out of range
4580 (format "\\%04X" special)
4581 ))))
4582 (goto-char (point-max))
4583 (insert ")")) ;insert end-string delimiter
4585 (defsubst ps-init-output-queue ()
4586 (setq ps-output-head (list "")
4587 ps-output-tail ps-output-head))
4590 (defun ps-selected-pages ()
4591 (while (progn
4592 (setq ps-first-page (car (car ps-selected-pages))
4593 ps-last-page (cdr (car ps-selected-pages))
4594 ps-selected-pages (cdr ps-selected-pages))
4595 (and ps-selected-pages
4596 (< ps-last-page ps-page-postscript)))))
4599 (defsubst ps-print-page-p ()
4600 (setq ps-print-page-p
4601 (and (cond ((null ps-first-page))
4602 ((<= ps-page-postscript ps-last-page)
4603 (<= ps-first-page ps-page-postscript))
4604 (ps-selected-pages
4605 (ps-selected-pages)
4606 (and (<= ps-first-page ps-page-postscript)
4607 (<= ps-page-postscript ps-last-page)))
4609 nil))
4610 (cond ((eq ps-even-or-odd-pages 'even-page)
4611 (= (logand ps-page-postscript 1) 0))
4612 ((eq ps-even-or-odd-pages 'odd-page)
4613 (= (logand ps-page-postscript 1) 1))
4615 ))))
4618 (defsubst ps-print-sheet-p ()
4619 (setq ps-print-page-p
4620 (cond ((eq ps-even-or-odd-pages 'even-sheet)
4621 (= (logand ps-page-sheet 1) 0))
4622 ((eq ps-even-or-odd-pages 'odd-sheet)
4623 (= (logand ps-page-sheet 1) 1))
4628 (defun ps-output (&rest args)
4629 (when ps-print-page-p
4630 (setcdr ps-output-tail args)
4631 (while (cdr ps-output-tail)
4632 (setq ps-output-tail (cdr ps-output-tail)))))
4634 (defun ps-output-string (string)
4635 (ps-output t string))
4637 ;; Output strings in the list ARGS in the PostScript prologue part.
4638 (defun ps-output-prologue (args)
4639 (ps-output 'prologue (if (stringp args) (list args) args)))
4641 (defun ps-flush-output ()
4642 (save-excursion
4643 (set-buffer ps-spool-buffer)
4644 (goto-char (point-max))
4645 (while ps-output-head
4646 (let ((it (car ps-output-head)))
4647 (cond
4648 ((eq t it)
4649 (setq ps-output-head (cdr ps-output-head))
4650 (ps-output-string-prim (car ps-output-head)))
4651 ((eq 'prologue it)
4652 (setq ps-output-head (cdr ps-output-head))
4653 (save-excursion
4654 (search-backward "\nBeginDoc")
4655 (forward-char 1)
4656 (apply 'insert (car ps-output-head))))
4658 (insert it))))
4659 (setq ps-output-head (cdr ps-output-head))))
4660 (ps-init-output-queue))
4662 (defun ps-insert-file (fname)
4663 (ps-flush-output)
4664 (save-excursion
4665 (set-buffer ps-spool-buffer)
4666 (goto-char (point-max))
4667 (insert-file fname)))
4669 ;; These functions are used in `ps-mule' to get charset of header and footer.
4670 ;; To avoid unnecessary calls to functions in `ps-left-header',
4671 ;; `ps-right-header', `ps-left-footer' and `ps-right-footer'.
4673 (defun ps-generate-string-list (content)
4674 (let (str)
4675 (while content
4676 (setq str (cons (cond
4677 ((stringp (car content))
4678 (car content))
4679 ((and (symbolp (car content)) (fboundp (car content)))
4680 (concat "(" (funcall (car content)) ")"))
4681 ((and (symbolp (car content)) (boundp (car content)))
4682 (concat "(" (symbol-value (car content)) ")"))
4684 ""))
4685 str)
4686 content (cdr content)))
4687 (nreverse str)))
4689 (defvar ps-lh-cache nil)
4690 (defvar ps-rh-cache nil)
4691 (defvar ps-lf-cache nil)
4692 (defvar ps-rf-cache nil)
4694 (defun ps-header-footer-string ()
4695 (and ps-print-header
4696 (setq ps-lh-cache (ps-generate-string-list ps-left-header)
4697 ps-rh-cache (ps-generate-string-list ps-right-header)))
4698 (and ps-print-footer
4699 (setq ps-lf-cache (ps-generate-string-list ps-left-footer)
4700 ps-rf-cache (ps-generate-string-list ps-right-footer)))
4701 (mapconcat 'identity
4702 (append ps-lh-cache ps-rh-cache ps-lf-cache ps-rf-cache)
4703 ""))
4705 ;; These functions insert the arrays that define the contents of the headers.
4707 (defun ps-generate-header-line (fonttag &optional content)
4708 (ps-output " [" fonttag " ")
4709 (cond
4710 ;; Literal strings should be output as is -- the string must contain its own
4711 ;; PS string delimiters, '(' and ')', if necessary.
4712 ((stringp content)
4713 (ps-output (ps-mule-encode-header-string content fonttag)))
4715 ;; Functions are called -- they should return strings; they will be inserted
4716 ;; as strings and the PS string delimiters added.
4717 ((and (symbolp content) (fboundp content))
4718 (ps-output-string (ps-mule-encode-header-string (funcall content)
4719 fonttag)))
4721 ;; Variables will have their contents inserted. They should contain
4722 ;; strings, and will be inserted as strings.
4723 ((and (symbolp content) (boundp content))
4724 (ps-output-string (ps-mule-encode-header-string (symbol-value content)
4725 fonttag)))
4727 ;; Anything else will get turned into an empty string.
4729 (ps-output-string "")))
4730 (ps-output "]\n"))
4732 (defun ps-generate-header (name fonttag0 fonttag1 contents)
4733 (ps-output "/" name "[\n")
4734 (and contents (> ps-header-lines 0)
4735 (let ((count 1))
4736 (ps-generate-header-line fonttag0 (car contents))
4737 (while (and (< count ps-header-lines)
4738 (setq contents (cdr contents)))
4739 (ps-generate-header-line fonttag1 (car contents))
4740 (setq count (1+ count)))))
4741 (ps-output "]def\n"))
4744 (defun ps-output-boolean (name bool)
4745 (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
4748 (defun ps-output-frame-properties (name alist)
4749 (ps-output "/" name " ["
4750 (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
4751 (ps-format-color (cdr (assq 'back-color alist)) 0.9)
4752 (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
4753 (ps-format-color (cdr (assq 'border-color alist)) 0.0)
4754 (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
4755 "]def\n"))
4758 (defun ps-background-pages (page-list func)
4759 (if page-list
4760 (mapcar
4761 #'(lambda (pages)
4762 (let ((start (if (consp pages) (car pages) pages))
4763 (end (if (consp pages) (cdr pages) pages)))
4764 (and (integerp start) (integerp end) (<= start end)
4765 (add-to-list 'ps-background-pages (vector start end func)))))
4766 page-list)
4767 (setq ps-background-all-pages (cons func ps-background-all-pages))))
4770 (defconst ps-boundingbox-re
4771 "^%%BoundingBox:\
4772 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4775 (defun ps-get-boundingbox ()
4776 (save-excursion
4777 (set-buffer ps-spool-buffer)
4778 (save-excursion
4779 (if (re-search-forward ps-boundingbox-re nil t)
4780 (vector (string-to-number ; lower x
4781 (buffer-substring (match-beginning 1) (match-end 1)))
4782 (string-to-number ; lower y
4783 (buffer-substring (match-beginning 2) (match-end 2)))
4784 (string-to-number ; upper x
4785 (buffer-substring (match-beginning 3) (match-end 3)))
4786 (string-to-number ; upper y
4787 (buffer-substring (match-beginning 4) (match-end 4))))
4788 (vector 0 0 0 0)))))
4791 ;; Emacs understands the %f format; we'll use it to limit color RGB values
4792 ;; to three decimals to cut down some on the size of the PostScript output.
4793 ;; XEmacs will have to make do with %s (princ) for floats.
4795 (defvar ps-float-format (if (eq ps-print-emacs-type 'emacs)
4796 "%0.3f " ; emacs
4797 "%s ")) ; xemacs
4800 (defun ps-float-format (value &optional default)
4801 (let ((literal (or value default)))
4802 (cond ((null literal)
4803 " ")
4804 ((numberp literal)
4805 (format ps-float-format (* literal 1.0))) ; force float number
4807 (format "%s " literal))
4811 (defun ps-background-text ()
4812 (mapcar
4813 #'(lambda (text)
4814 (setq ps-background-text-count (1+ ps-background-text-count))
4815 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
4816 (ps-output-string (nth 0 text)) ; text
4817 (ps-output
4818 "\n"
4819 (ps-float-format (nth 4 text) 200.0) ; font size
4820 (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
4821 (ps-float-format (nth 6 text)
4822 "PrintHeight PrintPageWidth atan") ; rotation
4823 (ps-float-format (nth 5 text) 0.85) ; gray
4824 (ps-float-format (nth 1 text) "0") ; x position
4825 (ps-float-format (nth 2 text) "0") ; y position
4826 "\nShowBackText}def\n")
4827 (ps-background-pages (nthcdr 7 text) ; page list
4828 (format "ShowBackText-%d\n"
4829 ps-background-text-count)))
4830 ps-print-background-text))
4833 (defun ps-background-image ()
4834 (mapcar
4835 #'(lambda (image)
4836 (let ((image-file (expand-file-name (nth 0 image))))
4837 (when (file-readable-p image-file)
4838 (setq ps-background-image-count (1+ ps-background-image-count))
4839 (ps-output
4840 (format "/ShowBackImage-%d{\n--back-- "
4841 ps-background-image-count)
4842 (ps-float-format (nth 5 image) 0.0) ; rotation
4843 (ps-float-format (nth 3 image) 1.0) ; x scale
4844 (ps-float-format (nth 4 image) 1.0) ; y scale
4845 (ps-float-format (nth 1 image) ; x position
4846 "PrintPageWidth 2 div")
4847 (ps-float-format (nth 2 image) ; y position
4848 "PrintHeight 2 div BottomMargin add")
4849 "\nBeginBackImage\n")
4850 (ps-insert-file image-file)
4851 ;; coordinate adjustment to centralize image
4852 ;; around x and y position
4853 (let ((box (ps-get-boundingbox)))
4854 (save-excursion
4855 (set-buffer ps-spool-buffer)
4856 (save-excursion
4857 (if (re-search-backward "^--back--" nil t)
4858 (replace-match
4859 (format "%s %s"
4860 (ps-float-format
4861 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
4862 (aref box 0))))
4863 (ps-float-format
4864 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
4865 (aref box 1)))))
4866 t)))))
4867 (ps-output "\nEndBackImage}def\n")
4868 (ps-background-pages (nthcdr 6 image) ; page list
4869 (format "ShowBackImage-%d\n"
4870 ps-background-image-count)))))
4871 ps-print-background-image))
4874 (defun ps-background (page-number)
4875 (let (has-local-background)
4876 (mapcar #'(lambda (range)
4877 (and (<= (aref range 0) page-number)
4878 (<= page-number (aref range 1))
4879 (if has-local-background
4880 (ps-output (aref range 2))
4881 (setq has-local-background t)
4882 (ps-output "/printLocalBackground{\n"
4883 (aref range 2)))))
4884 ps-background-pages)
4885 (and has-local-background (ps-output "}def\n"))))
4888 ;; Return a list of the distinct elements of LIST.
4889 ;; Elements are compared with `equal'.
4890 (defun ps-remove-duplicates (list)
4891 (let (new (tail list))
4892 (while tail
4893 (or (member (car tail) new)
4894 (setq new (cons (car tail) new)))
4895 (setq tail (cdr tail)))
4896 (nreverse new)))
4899 ;; Find the first occurrence of ITEM in LIST.
4900 ;; Return the index of the matching item, or nil if not found.
4901 ;; Elements are compared with `eq'.
4902 (defun ps-alist-position (item list)
4903 (let ((tail list) (index 0) found)
4904 (while tail
4905 (if (setq found (eq (car (car tail)) item))
4906 (setq tail nil)
4907 (setq index (1+ index)
4908 tail (cdr tail))))
4909 (and found index)))
4912 (defconst ps-n-up-database
4913 '((a4
4914 (1 nil 1 1 0)
4915 (2 t 1 2 0)
4916 (4 nil 2 2 0)
4917 (6 t 2 3 1)
4918 (8 t 2 4 0)
4919 (9 nil 3 3 0)
4920 (12 t 3 4 2)
4921 (16 nil 4 4 0)
4922 (18 t 3 6 0)
4923 (20 nil 5 4 1)
4924 (25 nil 5 5 0)
4925 (30 nil 6 5 1)
4926 (32 t 4 8 0)
4927 (36 nil 6 6 0)
4928 (42 nil 7 6 1)
4929 (49 nil 7 7 0)
4930 (50 t 5 10 0)
4931 (56 nil 8 7 1)
4932 (64 nil 8 8 0)
4933 (72 nil 9 8 1)
4934 (81 nil 9 9 0)
4935 (90 nil 10 9 1)
4936 (100 nil 10 10 0))
4938 (1 nil 1 1 0)
4939 (2 t 1 2 0)
4940 (4 nil 2 2 0)
4941 (6 t 2 3 1)
4942 (8 t 2 4 0)
4943 (9 nil 3 3 0)
4944 (12 nil 4 3 1)
4945 (16 nil 4 4 0)
4946 (18 t 3 6 0)
4947 (20 nil 5 4 1)
4948 (25 nil 5 5 0)
4949 (30 nil 6 5 1)
4950 (32 t 4 8 0)
4951 (36 nil 6 6 0)
4952 (42 nil 7 6 1)
4953 (49 nil 7 7 0)
4954 (50 t 5 10 0)
4955 (56 nil 8 7 1)
4956 (64 nil 8 8 0)
4957 (72 nil 9 8 1)
4958 (81 nil 9 9 0)
4959 (90 nil 10 9 1)
4960 (100 nil 10 10 0))
4961 (letter
4962 (1 nil 1 1 0)
4963 (2 t 1 2 0) ; adjusted by PostScript code
4964 (4 nil 2 2 0)
4965 (6 t 2 3 0)
4966 (9 nil 3 3 0)
4967 (12 nil 4 3 1)
4968 (16 nil 4 4 0)
4969 (20 nil 5 4 1)
4970 (25 nil 5 5 0)
4971 (30 nil 6 5 1)
4972 (36 nil 6 6 0)
4973 (40 t 5 8 0)
4974 (42 nil 7 6 1)
4975 (49 nil 7 7 0)
4976 (56 nil 8 7 1)
4977 (64 nil 8 8 0)
4978 (72 nil 9 8 1)
4979 (81 nil 9 9 0)
4980 (90 nil 10 9 1)
4981 (100 nil 10 10 0))
4982 (legal
4983 (1 nil 1 1 0)
4984 (2 t 1 2 0)
4985 (4 nil 2 2 0)
4986 (6 nil 3 2 1)
4987 (9 nil 3 3 0)
4988 (10 t 2 5 0)
4989 (12 nil 4 3 1)
4990 (16 nil 4 4 0)
4991 (20 nil 5 4 1)
4992 (25 nil 5 5 0)
4993 (30 nil 6 5 1)
4994 (36 nil 6 6 0)
4995 (42 nil 7 6 1)
4996 (49 nil 7 7 0)
4997 (56 nil 8 7 1)
4998 (64 nil 8 8 0)
4999 (70 t 5 14 0)
5000 (72 nil 9 8 1)
5001 (81 nil 9 9 0)
5002 (90 nil 10 9 1)
5003 (100 nil 10 10 0))
5004 (letter-small
5005 (1 nil 1 1 0)
5006 (2 t 1 2 0) ; adjusted by PostScript code
5007 (4 nil 2 2 0)
5008 (6 t 2 3 0)
5009 (9 nil 3 3 0)
5010 (12 t 3 4 1)
5011 (15 t 3 5 0)
5012 (16 nil 4 4 0)
5013 (20 nil 5 4 1)
5014 (25 nil 5 5 0)
5015 (28 t 4 7 0)
5016 (30 nil 6 5 1)
5017 (36 nil 6 6 0)
5018 (40 t 5 8 0)
5019 (42 nil 7 6 1)
5020 (49 nil 7 7 0)
5021 (56 nil 8 7 1)
5022 (60 t 6 10 0)
5023 (64 nil 8 8 0)
5024 (72 ni 9 8 1)
5025 (81 nil 9 9 0)
5026 (84 t 7 12 0)
5027 (90 nil 10 9 1)
5028 (100 nil 10 10 0))
5029 (tabloid
5030 (1 nil 1 1 0)
5031 (2 t 1 2 0)
5032 (4 nil 2 2 0)
5033 (6 t 2 3 1)
5034 (8 t 2 4 0)
5035 (9 nil 3 3 0)
5036 (12 nil 4 3 1)
5037 (16 nil 4 4 0)
5038 (20 nil 5 4 1)
5039 (25 nil 5 5 0)
5040 (30 nil 6 5 1)
5041 (36 nil 6 6 0)
5042 (42 nil 7 6 1)
5043 (49 nil 7 7 0)
5044 (56 nil 8 7 1)
5045 (64 nil 8 8 0)
5046 (72 nil 9 8 1)
5047 (81 nil 9 9 0)
5048 (84 t 6 14 0)
5049 (90 nil 10 9 1)
5050 (100 nil 10 10 0))
5051 ;; Ledger paper size is a special case, it is the only paper size where the
5052 ;; normal size is landscaped, that is, the height is smaller than width.
5053 ;; So, we use the special value `pag' in the `landscape' field.
5054 (ledger
5055 (1 nil 1 1 0)
5056 (2 pag 1 2 0)
5057 (4 nil 2 2 0)
5058 (6 pag 2 3 1)
5059 (8 pag 2 4 0)
5060 (9 nil 3 3 0)
5061 (12 nil 4 3 1)
5062 (16 nil 4 4 0)
5063 (20 nil 5 4 1)
5064 (25 nil 5 5 0)
5065 (30 nil 6 5 1)
5066 (36 nil 6 6 0)
5067 (42 nil 7 6 1)
5068 (49 nil 7 7 0)
5069 (56 nil 8 7 1)
5070 (64 nil 8 8 0)
5071 (72 nil 9 8 1)
5072 (81 nil 9 9 0)
5073 (84 pag 6 14 0)
5074 (90 nil 10 9 1)
5075 (100 nil 10 10 0))
5076 (statement
5077 (1 nil 1 1 0)
5078 (2 t 1 2 0)
5079 (4 nil 2 2 0)
5080 (6 nil 3 2 1)
5081 (9 nil 3 3 0)
5082 (10 t 2 5 0)
5083 (12 nil 4 3 1)
5084 (16 nil 4 4 0)
5085 (20 nil 5 4 1)
5086 (21 t 3 7 0)
5087 (25 nil 5 5 0)
5088 (30 nil 6 5 1)
5089 (36 nil 6 6 0)
5090 (40 t 4 10 0)
5091 (42 nil 7 6 1)
5092 (49 nil 7 7 0)
5093 (56 nil 8 7 1)
5094 (60 t 5 12 0)
5095 (64 nil 8 8 0)
5096 (72 nil 9 8 1)
5097 (81 nil 9 9 0)
5098 (90 nil 10 9 1)
5099 (100 nil 10 10 0))
5100 (executive
5101 (1 nil 1 1 0)
5102 (2 t 1 2 0) ; adjusted by PostScript code
5103 (4 nil 2 2 0)
5104 (6 t 2 3 0)
5105 (9 nil 3 3 0)
5106 (12 nil 4 3 1)
5107 (16 nil 4 4 0)
5108 (20 nil 5 4 1)
5109 (25 nil 5 5 0)
5110 (28 t 4 7 0)
5111 (30 nil 6 5 1)
5112 (36 nil 6 6 0)
5113 (42 nil 7 6 1)
5114 (45 t 5 9 0)
5115 (49 nil 7 7 0)
5116 (56 nil 8 7 1)
5117 (60 t 6 10 0)
5118 (64 nil 8 8 0)
5119 (72 nil 9 8 1)
5120 (81 nil 9 9 0)
5121 (84 t 7 12 0)
5122 (90 nil 10 9 1)
5123 (100 nil 10 10 0))
5124 (a4small
5125 (1 nil 1 1 0)
5126 (2 t 1 2 0)
5127 (4 nil 2 2 0)
5128 (6 t 2 3 1)
5129 (8 t 2 4 0)
5130 (9 nil 3 3 0)
5131 (12 nil 4 3 1)
5132 (16 nil 4 4 0)
5133 (18 t 3 6 0)
5134 (20 nil 5 4 1)
5135 (25 nil 5 5 0)
5136 (30 nil 6 5 1)
5137 (32 t 4 8 0)
5138 (36 nil 6 6 0)
5139 (42 nil 7 6 1)
5140 (49 nil 7 7 0)
5141 (50 t 5 10 0)
5142 (56 nil 8 7 1)
5143 (64 nil 8 8 0)
5144 (72 nil 9 8 1)
5145 (78 t 6 13 0)
5146 (81 nil 9 9 0)
5147 (90 nil 10 9 1)
5148 (100 nil 10 10 0))
5150 (1 nil 1 1 0)
5151 (2 t 1 2 0)
5152 (4 nil 2 2 0)
5153 (6 t 2 3 1)
5154 (8 t 2 4 0)
5155 (9 nil 3 3 0)
5156 (12 nil 4 3 1)
5157 (16 nil 4 4 0)
5158 (18 t 3 6 0)
5159 (20 nil 5 4 1)
5160 (25 nil 5 5 0)
5161 (30 nil 6 5 1)
5162 (32 t 4 8 0)
5163 (36 nil 6 6 0)
5164 (42 nil 7 6 1)
5165 (49 nil 7 7 0)
5166 (50 t 5 10 0)
5167 (56 nil 8 7 1)
5168 (64 nil 8 8 0)
5169 (72 nil 9 8 1)
5170 (81 nil 9 9 0)
5171 (90 nil 10 9 1)
5172 (100 nil 10 10 0))
5174 (1 nil 1 1 0)
5175 (2 t 1 2 0)
5176 (4 nil 2 2 0)
5177 (6 t 2 3 1)
5178 (8 t 2 4 0)
5179 (9 nil 3 3 0)
5180 (12 nil 4 3 1)
5181 (16 nil 4 4 0)
5182 (18 t 3 6 0)
5183 (20 nil 5 4 1)
5184 (25 nil 5 5 0)
5185 (30 nil 6 5 1)
5186 (32 t 4 8 0)
5187 (36 nil 6 6 0)
5188 (42 nil 7 6 1)
5189 (49 nil 7 7 0)
5190 (50 t 5 10 0)
5191 (56 nil 8 7 1)
5192 (64 nil 8 8 0)
5193 (72 nil 9 8 0)
5194 (81 nil 9 9 0)
5195 (90 nil 10 9 1)
5196 (98 t 7 14 0)
5197 (100 nil 10 10 0)))
5198 "Alist which is the page matrix database used for N-up printing.
5200 Each element has the following form:
5202 (PAGE
5203 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
5204 ...)
5206 Where:
5207 PAGE is the page size used (see `ps-paper-type').
5208 MAX is the maximum elements of this page matrix.
5209 LANDSCAPE specifies if page matrix is landscaped, has the following valid
5210 values:
5211 nil the sheet is in portrait mode.
5212 t the sheet is in landscape mode.
5213 pag the sheet is in portrait mode and page is in landscape mode.
5214 LINES is the number of lines of page matrix.
5215 COLUMNS is the number of columns of page matrix.
5216 COL-MISSING is the number of columns missing to fill the sheet.")
5219 (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
5220 (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
5221 (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
5222 (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
5225 (defun ps-n-up-printing ()
5226 ;; force `ps-n-up-printing' be in range 1 to 100.
5227 (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
5228 ;; find suitable page matrix for a given `ps-paper-type'.
5229 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
5230 (and the-list
5231 (while (> ps-n-up-printing (caar the-list))
5232 (setq the-list (cdr the-list))))
5233 (car the-list)))
5236 (defconst ps-n-up-filling-database
5237 '((left-top
5238 "PageWidth" ; N-Up-XColumn
5239 "0" ; N-Up-YColumn
5240 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5241 "LandscapePageHeight neg" ; N-Up-YLine
5242 "N-Up-Lines" ; N-Up-Repeat
5243 "N-Up-Columns" ; N-Up-End
5244 "0" ; N-Up-XStart
5245 "0") ; N-Up-YStart
5246 (left-bottom
5247 "PageWidth" ; N-Up-XColumn
5248 "0" ; N-Up-YColumn
5249 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5250 "LandscapePageHeight" ; N-Up-YLine
5251 "N-Up-Lines" ; N-Up-Repeat
5252 "N-Up-Columns" ; N-Up-End
5253 "0" ; N-Up-XStart
5254 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5255 (right-top
5256 "PageWidth neg" ; N-Up-XColumn
5257 "0" ; N-Up-YColumn
5258 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5259 "LandscapePageHeight neg" ; N-Up-YLine
5260 "N-Up-Lines" ; N-Up-Repeat
5261 "N-Up-Columns" ; N-Up-End
5262 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5263 "0") ; N-Up-YStart
5264 (right-bottom
5265 "PageWidth neg" ; N-Up-XColumn
5266 "0" ; N-Up-YColumn
5267 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5268 "LandscapePageHeight" ; N-Up-YLine
5269 "N-Up-Lines" ; N-Up-Repeat
5270 "N-Up-Columns" ; N-Up-End
5271 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5272 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5273 (top-left
5274 "0" ; N-Up-XColumn
5275 "LandscapePageHeight neg" ; N-Up-YColumn
5276 "PageWidth" ; N-Up-XLine
5277 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5278 "N-Up-Columns" ; N-Up-Repeat
5279 "N-Up-Lines" ; N-Up-End
5280 "0" ; N-Up-XStart
5281 "0") ; N-Up-YStart
5282 (bottom-left
5283 "0" ; N-Up-XColumn
5284 "LandscapePageHeight" ; N-Up-YColumn
5285 "PageWidth" ; N-Up-XLine
5286 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5287 "N-Up-Columns" ; N-Up-Repeat
5288 "N-Up-Lines" ; N-Up-End
5289 "0" ; N-Up-XStart
5290 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5291 (top-right
5292 "0" ; N-Up-XColumn
5293 "LandscapePageHeight neg" ; N-Up-YColumn
5294 "PageWidth neg" ; N-Up-XLine
5295 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5296 "N-Up-Columns" ; N-Up-Repeat
5297 "N-Up-Lines" ; N-Up-End
5298 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5299 "0") ; N-Up-YStart
5300 (bottom-right
5301 "0" ; N-Up-XColumn
5302 "LandscapePageHeight" ; N-Up-YColumn
5303 "PageWidth neg" ; N-Up-XLine
5304 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5305 "N-Up-Columns" ; N-Up-Repeat
5306 "N-Up-Lines" ; N-Up-End
5307 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5308 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
5309 "Alist for n-up printing initializations.
5311 Each element has the following form:
5313 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5315 Where:
5316 KIND is a valid value of `ps-n-up-filling'.
5317 XCOL YCOL are the relative position for the next column.
5318 XLIN YLIN are the relative position for the beginning of next line.
5319 REPEAT is the number of repetions for external loop.
5320 END is the number of repetions for internal loop and also the number of pages in
5321 a row.
5322 XSTART YSTART are the relative position for the first page in a sheet.")
5325 (defun ps-n-up-filling ()
5326 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
5327 (assq 'left-top ps-n-up-filling-database))))
5330 (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
5331 (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
5332 (defmacro ps-n-up-xline (init) `(nth 2 ,init))
5333 (defmacro ps-n-up-yline (init) `(nth 3 ,init))
5334 (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
5335 (defmacro ps-n-up-end (init) `(nth 5 ,init))
5336 (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
5337 (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
5340 (defconst ps-error-handler-alist
5341 '((none . 0)
5342 (paper . 1)
5343 (system . 2)
5344 (paper-and-system . 3))
5345 "Alist for error handler message.")
5348 (defconst ps-zebra-stripe-alist
5349 '((follow . 1)
5350 (full . 2)
5351 (full-follow . 3))
5352 "Alist for zebra stripe continuation.")
5355 (defun ps-begin-file ()
5356 (setq ps-page-order 0
5357 ps-page-printed 0
5358 ps-background-text-count 0
5359 ps-background-image-count 0
5360 ps-background-pages nil
5361 ps-background-all-pages nil)
5363 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
5364 (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
5365 (n-up (ps-n-up-printing))
5366 (n-up-filling (ps-n-up-filling)))
5367 (and ps-n-up-on (setq tumble (not tumble)))
5368 (ps-output
5369 ps-adobe-tag
5370 "%%Title: " (buffer-name) ; Take job name from name of
5371 ; first buffer printed
5372 "\n%%Creator: " (user-full-name)
5373 " (using ps-print v" ps-print-version
5374 ")\n%%CreationDate: " (format-time-string "%T %b %d %Y")
5375 "\n%%Orientation: "
5376 (if ps-landscape-mode "Landscape" "Portrait")
5377 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
5378 (mapconcat 'identity
5379 (ps-remove-duplicates
5380 (append (ps-fonts 'ps-font-for-text)
5381 (list (ps-font 'ps-font-for-header 'normal)
5382 (ps-font 'ps-font-for-header 'bold))))
5383 "\n%%+ font ")
5384 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
5385 (format " %d" (round (ps-page-dimensions-get-width dimensions)))
5386 (format " %d" (round (ps-page-dimensions-get-height dimensions)))
5387 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
5388 (if ps-spool-duplex
5389 (if tumble " duplex(tumble)\n" " duplex\n")
5390 "\n"))
5392 (ps-insert-string ps-print-prologue-header)
5394 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5395 (ps-page-dimensions-get-media dimensions)
5396 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
5397 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5398 (format "/ErrorMessage %s def\n\n"
5399 (or (cdr (assoc ps-error-handler-message
5400 ps-error-handler-alist))
5401 1)) ; send to paper
5402 ps-print-prologue-0
5403 "\n%%BeginProcSet: UserDefinedPrologue\n\n")
5405 (ps-insert-string ps-user-defined-prologue)
5407 (ps-output "\n%%EndProcSet\n\n")
5409 (ps-output-boolean "LandscapeMode "
5410 (or ps-landscape-mode
5411 (eq (ps-n-up-landscape n-up) 'pag)))
5412 (ps-output-boolean "UpsideDown " ps-print-upside-down)
5413 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
5415 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
5416 (format "/PrintPageWidth %s def\n"
5417 (- (* (+ ps-print-width ps-inter-column)
5418 ps-number-of-columns)
5419 ps-inter-column))
5420 (format "/PrintWidth %s def\n" ps-print-width)
5421 (format "/PrintHeight %s def\n" ps-print-height)
5423 (format "/LeftMargin %s def\n" ps-left-margin)
5424 (format "/RightMargin %s def\n" ps-right-margin)
5425 (format "/InterColumn %s def\n" ps-inter-column)
5427 (format "/BottomMargin %s def\n" ps-bottom-margin)
5428 (format "/TopMargin %s def\n" ps-top-margin) ; not used
5429 (format "/HeaderOffset %s def\n" ps-header-offset)
5430 (format "/HeaderPad %s def\n" ps-header-pad)
5431 (format "/FooterOffset %s def\n" ps-footer-offset)
5432 (format "/FooterPad %s def\n" ps-footer-pad)
5433 (format "/FooterLines %s def\n" ps-footer-lines))
5435 (ps-output-boolean "ShowNofN " ps-show-n-of-n)
5436 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
5437 ps-spool-duplex
5438 ps-switch-header))
5439 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
5440 (ps-output-boolean "PrintHeader " ps-print-header)
5441 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
5442 (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist)
5443 (ps-output-boolean "PrintFooter " ps-print-footer)
5444 (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame)
5445 (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist)
5447 (let ((line-height (ps-line-height 'ps-font-for-text)))
5448 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
5449 (format "/ParagraphSpacing %s def\n"
5450 ps-paragraph-spacing-internal)
5451 (format "/LineHeight %s def\n" line-height)
5452 (format "/LinesPerColumn %d def\n"
5453 (let ((height (+ line-height
5454 ps-line-spacing-internal)))
5455 (round (/ (+ ps-print-height
5456 (* height 0.45))
5457 height))))))
5459 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
5460 (ps-output-boolean "Zebra " ps-zebra-stripes)
5461 (ps-output-boolean "PrintLineNumber " ps-line-number)
5462 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
5463 (ps-output (format "/ZebraFollow %d def\n"
5464 (or (cdr (assq ps-zebra-stripe-follow
5465 ps-zebra-stripe-alist))
5467 (format "/PrintLineStep %d def\n"
5468 (if (integerp ps-line-number-step)
5469 ps-line-number-step
5470 ps-zebra-stripe-height))
5471 (format "/PrintLineStart %d def\n" ps-line-number-start)
5472 "/LineNumberColor "
5473 (ps-format-color ps-line-number-color 0.0)
5474 (format "def\n/ZebraHeight %d def\n"
5475 ps-zebra-stripe-height)
5476 "/ZebraColor "
5477 (ps-format-color ps-zebra-color 0.95)
5478 "def\n/BackgroundColor "
5479 (ps-format-color ps-default-background 1.0)
5480 "def\n/UseSetpagedevice "
5481 (if (eq ps-spool-config 'setpagedevice)
5482 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5483 "false")
5484 " def\n\n/PageWidth "
5485 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
5486 (format "/N-Up %d def\n" ps-n-up-printing))
5487 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
5488 (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
5489 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
5490 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
5491 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
5492 (format "/N-Up-Margin %s def\n" ps-n-up-margin)
5493 "/N-Up-Repeat "
5494 (if ps-landscape-mode
5495 (ps-n-up-end n-up-filling)
5496 (ps-n-up-repeat n-up-filling))
5497 " def\n/N-Up-End "
5498 (if ps-landscape-mode
5499 (ps-n-up-repeat n-up-filling)
5500 (ps-n-up-end n-up-filling))
5501 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
5502 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
5503 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
5504 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
5505 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
5506 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
5508 (ps-background-text)
5509 (ps-background-image)
5510 (setq ps-background-all-pages (nreverse ps-background-all-pages)
5511 ps-background-pages (nreverse ps-background-pages))
5513 (ps-output "\n" ps-print-prologue-1)
5515 (ps-output "\n/printGlobalBackground{\n")
5516 (mapcar 'ps-output ps-background-all-pages)
5517 (ps-output "}def\n/printLocalBackground{\n}def\n")
5519 ;; Header/line number fonts
5520 (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
5521 ps-header-title-font-size-internal
5522 (ps-font 'ps-font-for-header 'bold))
5523 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
5524 ps-header-font-size-internal
5525 (ps-font 'ps-font-for-header 'normal))
5526 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
5527 (ps-get-font-size 'ps-line-number-font-size)
5528 ps-line-number-font)
5529 (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
5530 ps-footer-font-size-internal
5531 (ps-font 'ps-font-for-footer 'normal))
5532 "\n\n% ---- These lines must be kept together because...
5534 /h0 F
5535 /HeaderTitleLineHeight FontHeight def
5537 /h1 F
5538 /HeaderLineHeight FontHeight def
5539 /HeaderDescent Descent def
5541 /H0 F
5542 /FooterLineHeight FontHeight def
5543 /FooterDescent Descent def
5545 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
5547 ;; Text fonts
5548 (let ((font (ps-font-alist 'ps-font-for-text))
5549 (i 0))
5550 (while font
5551 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
5553 ps-font-size-internal
5554 (ps-font 'ps-font-for-text (car (car font)))))
5555 (setq font (cdr font)
5556 i (1+ i))))
5558 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
5559 (ps-output (format "/SpaceWidthRatio %f def\n"
5560 (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
5562 (ps-output "\n%%EndProlog\n\n%%BeginSetup\n")
5563 (unless (eq ps-spool-config 'lpr-switches)
5564 (ps-output "\n%%BeginFeature: *Duplex "
5565 (ps-boolean-capitalized ps-spool-duplex)
5566 " *Tumble "
5567 (ps-boolean-capitalized tumble)
5568 "\nUseSetpagedevice\n{BMark/Duplex "
5569 (ps-boolean-constant ps-spool-duplex)
5570 "/Tumble "
5571 (ps-boolean-constant tumble)
5572 " EMark setpagedevice}\n{statusdict begin "
5573 (ps-boolean-constant ps-spool-duplex)
5574 " setduplexmode "
5575 (ps-boolean-constant tumble)
5576 " settumble end}ifelse\n%%EndFeature\n")))
5577 (ps-output "\n%%BeginFeature: *ManualFeed "
5578 (ps-boolean-capitalized ps-manual-feed)
5579 "\nBMark /ManualFeed "
5580 (ps-boolean-constant ps-manual-feed)
5581 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
5582 (and ps-banner-page-when-duplexing
5583 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
5586 (defun ps-format-color (color &optional default)
5587 (let ((the-color (if (stringp color)
5588 (ps-color-scale color)
5589 color)))
5590 (if (and the-color (listp the-color))
5591 (concat "["
5592 (format ps-color-format
5593 (* (nth 0 the-color) 1.0) ; force float number
5594 (* (nth 1 the-color) 1.0) ; force float number
5595 (* (nth 2 the-color) 1.0)) ; force float number
5596 "] ")
5597 (ps-float-format (if (numberp the-color) the-color default)))))
5600 (defun ps-insert-string (prologue)
5601 (let ((str (if (functionp prologue)
5602 (funcall prologue)
5603 prologue)))
5604 (and (stringp str)
5605 (ps-output str))))
5608 (defun ps-boolean-capitalized (bool)
5609 (if bool "True" "False"))
5612 (defun ps-boolean-constant (bool)
5613 (if bool "true" "false"))
5616 (defun ps-header-dirpart ()
5617 (let ((fname (buffer-file-name)))
5618 (if fname
5619 (if (string-equal (buffer-name) (file-name-nondirectory fname))
5620 (abbreviate-file-name (file-name-directory fname))
5621 fname)
5622 "")))
5625 (defun ps-get-buffer-name ()
5626 (cond
5627 ;; Indulge Jim this little easter egg:
5628 ((string= (buffer-name) "ps-print.el")
5629 "Hey, Cool! It's ps-print.el!!!")
5630 ;; Indulge Jack this other little easter egg:
5631 ((string= (buffer-name) "sokoban.el")
5632 "Super! C'est sokoban.el!")
5633 (t (concat
5634 (and ps-printing-region-p "Subset of: ")
5635 (buffer-name)
5636 (and (buffer-modified-p) " (unsaved)")))))
5639 (defun ps-get-size (size mess &optional arg)
5640 (let ((siz (cond ((numberp size)
5641 size)
5642 ((and (consp size)
5643 (numberp (car size))
5644 (numberp (cdr size)))
5645 (if ps-landscape-mode
5646 (car size)
5647 (cdr size)))
5649 -1))))
5650 (and (< siz 0)
5651 (error "Invalid %s `%S'%s"
5652 mess size
5653 (if arg
5654 (format " for `%S'" arg)
5655 "")))
5656 siz))
5659 (defun ps-get-font-size (font-sym)
5660 (ps-get-size (symbol-value font-sym) "font size" font-sym))
5663 (defun ps-rgb-color (color default)
5664 (cond ((and color (listp color) (= (length color) 3)
5665 (let ((cl color)
5666 (ok t) e)
5667 (while (and ok cl)
5668 (setq e (car cl)
5669 cl (cdr cl)
5670 ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
5671 ok))
5672 color)
5673 ((and (floatp color) (<= 0.0 color) (<= color 1.0))
5674 (list color color color))
5675 ((stringp color) (ps-color-scale color))
5676 (t (list default default default))
5680 (defun ps-begin-job ()
5681 ;; prologue files
5682 (or (equal ps-mark-code-directory ps-postscript-code-directory)
5683 (setq ps-print-prologue-0 (ps-prologue-file 0)
5684 ps-print-prologue-1 (ps-prologue-file 1)
5685 ps-mark-code-directory ps-postscript-code-directory))
5686 ;; selected pages
5687 (let (new page)
5688 (while ps-selected-pages
5689 (setq page (car ps-selected-pages)
5690 ps-selected-pages (cdr ps-selected-pages))
5691 (cond ((integerp page)
5692 (and (> page 0)
5693 (setq new (cons (cons page page) new))))
5694 ((consp page)
5695 (and (integerp (car page)) (integerp (cdr page))
5696 (> (car page) 0)
5697 (<= (car page) (cdr page))
5698 (setq new (cons page new))))))
5699 (setq ps-selected-pages (sort new #'(lambda (one other)
5700 (< (car one) (car other))))
5701 ps-last-selected-pages ps-selected-pages
5702 ps-first-page nil
5703 ps-last-page nil))
5704 ;; face background
5705 (or (listp ps-use-face-background)
5706 (setq ps-use-face-background t))
5707 ;; line number
5708 (and (integerp ps-line-number-step)
5709 (<= ps-line-number-step 0)
5710 (setq ps-line-number-step 1))
5711 (setq ps-n-up-on (> ps-n-up-printing 1)
5712 ps-line-number-start (max 1 (min ps-line-number-start
5713 (if (integerp ps-line-number-step)
5714 ps-line-number-step
5715 ps-zebra-stripe-height))))
5716 ;; spooling buffer
5717 (save-excursion
5718 (set-buffer ps-spool-buffer)
5719 (goto-char (point-max))
5720 (and (re-search-backward "^%%Trailer$" nil t)
5721 (delete-region (match-beginning 0) (point-max))))
5722 ;; miscellaneous
5723 (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
5724 '(full full-follow))
5725 ps-page-postscript 0
5726 ps-page-sheet 0
5727 ps-page-n-up 0
5728 ps-page-column 0
5729 ps-lines-printed 0
5730 ps-print-page-p t
5731 ps-showline-count (car ps-printing-region)
5732 ps-line-spacing-internal (ps-get-size ps-line-spacing
5733 "line spacing")
5734 ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
5735 "paragraph spacing")
5736 ps-font-size-internal (ps-get-font-size 'ps-font-size)
5737 ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
5738 ps-header-title-font-size-internal
5739 (ps-get-font-size 'ps-header-title-font-size)
5740 ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
5741 ps-control-or-escape-regexp
5742 (cond ((eq ps-print-control-characters '8-bit)
5743 (string-as-unibyte "[\000-\037\177-\377]"))
5744 ((eq ps-print-control-characters 'control-8-bit)
5745 (string-as-unibyte "[\000-\037\177-\237]"))
5746 ((eq ps-print-control-characters 'control)
5747 "[\000-\037\177]")
5748 (t "[\t\n\f]"))
5749 ps-default-background (ps-rgb-color
5750 (if (eq ps-default-bg t)
5751 (ps-face-background-name 'default)
5752 ps-default-bg)
5753 1.0)
5754 ps-default-foreground (ps-rgb-color
5755 (if (eq ps-default-fg t)
5756 (ps-face-foreground-name 'default)
5757 ps-default-fg)
5758 0.0)
5759 ps-default-color (and (eq ps-print-color-p t) ps-default-foreground)
5760 ps-current-color ps-default-color
5761 ;; Set the color scale. We do it here instead of in the defvar so
5762 ;; that ps-print can be dumped into emacs. This expression can't be
5763 ;; evaluated at dump-time because X isn't initialized.
5764 ps-color-p (and ps-print-color-p (ps-color-device))
5765 ps-print-color-scale (if ps-color-p
5766 (float (car (ps-color-values "white")))
5767 1.0))
5768 ;; initialize page dimensions
5769 (ps-get-page-dimensions)
5770 ;; final check
5771 (and ps-color-p
5772 (equal ps-default-background ps-default-foreground)
5773 (error
5774 (concat
5775 "`ps-default-fg' and `ps-default-bg' have the same color.\n"
5776 "Text won't appear on page. Please, check these variables."))))
5779 (defun ps-page-number ()
5780 (if ps-print-only-one-header
5781 (1+ (/ (1- ps-page-column) ps-number-of-columns))
5782 ps-page-column))
5785 (defsubst ps-end-page ()
5786 (ps-output "EndPage\nEndDSCPage\n"))
5789 (defsubst ps-next-page ()
5790 (ps-end-page)
5791 (ps-flush-output)
5792 (ps-begin-page))
5795 (defun ps-header-sheet ()
5796 ;; Print only when a new sheet begins.
5797 (and ps-print-page-p (> ps-page-sheet 0)
5798 (ps-output "EndSheet\n"))
5799 (setq ps-page-sheet (1+ ps-page-sheet))
5800 (when (ps-print-sheet-p)
5801 (setq ps-page-order (1+ ps-page-order))
5802 (ps-output (if ps-n-up-on
5803 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5804 ps-page-order ps-page-postscript ps-page-order)
5805 (format "\n%%%%Page: %d %d\n"
5806 ps-page-postscript ps-page-order))
5807 ;; spooling needs to redefine Lines and PageCount on each page
5808 "/Lines 0 def\n/PageCount 0 def\n"
5809 (format "%d BeginSheet\nBeginDSCPage\n"
5810 ps-n-up-printing))))
5813 (defun ps-header-page ()
5814 ;; set total line and page number when printing has finished
5815 ;; (see `ps-generate')
5816 (if (zerop (mod ps-page-column ps-number-of-columns))
5817 (progn
5818 (setq ps-page-postscript (1+ ps-page-postscript))
5819 (when (ps-print-page-p)
5820 (ps-print-sheet-p)
5821 (if (zerop (mod ps-page-n-up ps-n-up-printing))
5822 ;; Print only when a new sheet begins.
5823 (progn
5824 (ps-header-sheet)
5825 (run-hooks 'ps-print-begin-sheet-hook))
5826 ;; Print only when a new page begins.
5827 (ps-output "BeginDSCPage\n")
5828 (run-hooks 'ps-print-begin-page-hook))
5829 (ps-background ps-page-postscript)
5830 (setq ps-page-n-up (1+ ps-page-n-up))
5831 (and ps-print-page-p
5832 (setq ps-page-printed (1+ ps-page-printed)))))
5833 ;; Print only when a new column begins.
5834 (ps-output "BeginDSCPage\n")
5835 (run-hooks 'ps-print-begin-column-hook))
5836 (setq ps-page-column (1+ ps-page-column)))
5838 (defun ps-begin-page ()
5839 (setq ps-width-remaining ps-print-width
5840 ps-height-remaining ps-print-height)
5842 (ps-header-page)
5844 (ps-output (format "/LineNumber %d def\n" ps-showline-count)
5845 (format "/PageNumber %d def\n" (ps-page-number)))
5847 (when ps-print-header
5848 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1"
5849 (or ps-lh-cache ps-left-header))
5850 (ps-generate-header "HeaderLinesRight" "/h0" "/h1"
5851 (or ps-rh-cache ps-right-header))
5852 (ps-output (format "%d SetHeaderLines\n" ps-header-lines))
5853 (setq ps-lh-cache nil
5854 ps-rh-cache nil))
5856 (when ps-print-footer
5857 (ps-generate-header "FooterLinesLeft" "/H0" "/H0"
5858 (or ps-lf-cache ps-left-footer))
5859 (ps-generate-header "FooterLinesRight" "/H0" "/H0"
5860 (or ps-rf-cache ps-right-footer))
5861 (ps-output (format "%d SetFooterLines\n" ps-footer-lines))
5862 (setq ps-lf-cache nil
5863 ps-rf-cache nil))
5865 (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
5866 (ps-set-font ps-current-font)
5867 (ps-set-bg ps-current-bg)
5868 (ps-set-color ps-current-color)
5869 (ps-mule-begin-page))
5871 (defsubst ps-skip-newline (limit)
5872 (setq ps-showline-count (1+ ps-showline-count)
5873 ps-lines-printed (1+ ps-lines-printed))
5874 (and (< (point) limit)
5875 (forward-char 1)))
5877 (defsubst ps-next-line ()
5878 (setq ps-showline-count (1+ ps-showline-count)
5879 ps-lines-printed (1+ ps-lines-printed))
5880 (let* ((paragraph-p (and ps-paragraph-regexp
5881 (looking-at ps-paragraph-regexp)))
5882 (lh (+ (ps-line-height 'ps-font-for-text)
5883 (if paragraph-p
5884 ps-paragraph-spacing-internal
5885 ps-line-spacing-internal))))
5886 (if (< ps-height-remaining lh)
5887 (ps-next-page)
5888 (setq ps-width-remaining ps-print-width
5889 ps-height-remaining (- ps-height-remaining lh))
5890 (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
5892 (defun ps-continue-line ()
5893 (setq ps-lines-printed (1+ ps-lines-printed))
5894 (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
5895 (if (< ps-height-remaining lh)
5896 (ps-next-page)
5897 (setq ps-width-remaining ps-print-width
5898 ps-height-remaining (- ps-height-remaining lh))
5899 (ps-output "SL\n"))))
5901 (defun ps-find-wrappoint (from to char-width)
5902 (let ((avail (truncate (/ ps-width-remaining char-width)))
5903 (todo (- to from)))
5904 (if (< todo avail)
5905 (cons to (* todo char-width))
5906 (cons (+ from avail) ps-width-remaining))))
5908 (defun ps-basic-plot-str (from to string)
5909 (let* ((wrappoint (ps-find-wrappoint from to
5910 (ps-avg-char-width 'ps-font-for-text)))
5911 (to (car wrappoint))
5912 (str (substring string from to)))
5913 (ps-mule-prepare-ascii-font str)
5914 (ps-output-string str)
5915 (ps-output " S\n")
5916 wrappoint))
5918 (defun ps-basic-plot-string (from to &optional bg-color)
5919 (let* ((wrappoint (ps-find-wrappoint from to
5920 (ps-avg-char-width 'ps-font-for-text)))
5921 (to (car wrappoint))
5922 (string (buffer-substring-no-properties from to)))
5923 (ps-mule-prepare-ascii-font string)
5924 (ps-output-string string)
5925 (ps-output " S\n")
5926 wrappoint))
5928 (defun ps-basic-plot-whitespace (from to &optional bg-color)
5929 (let* ((wrappoint (ps-find-wrappoint from to
5930 (ps-space-width 'ps-font-for-text)))
5931 (to (car wrappoint)))
5932 (ps-output (format "%d W\n" (- to from)))
5933 wrappoint))
5935 (defun ps-plot (plotfunc from to &optional bg-color)
5936 (while (< from to)
5937 (let* ((wrappoint (funcall plotfunc from to bg-color))
5938 (plotted-to (car wrappoint))
5939 (plotted-width (cdr wrappoint)))
5940 (setq from plotted-to
5941 ps-width-remaining (- ps-width-remaining plotted-width))
5942 (if (< from to)
5943 (ps-continue-line))))
5944 (if ps-razzle-dazzle
5945 (let* ((q-todo (- (point-max) (point-min)))
5946 (q-done (- (point) (point-min)))
5947 (chunkfrac (/ q-todo 8))
5948 (chunksize (min chunkfrac 1000)))
5949 (if (> (- q-done ps-razchunk) chunksize)
5950 (progn
5951 (setq ps-razchunk q-done)
5952 (message "Formatting...%3d%%"
5953 (if (< q-todo 100)
5954 (/ (* 100 q-done) q-todo)
5955 (/ q-done (/ q-todo 100)))
5956 ))))))
5958 (defvar ps-last-font nil)
5960 (defun ps-set-font (font)
5961 (setq ps-last-font (format "f%d" (setq ps-current-font font)))
5962 (ps-output (format "/%s F\n" ps-last-font)))
5964 (defun ps-set-bg (color)
5965 (if (setq ps-current-bg color)
5966 (ps-output (format ps-color-format
5967 (nth 0 color) (nth 1 color) (nth 2 color))
5968 " true BG\n")
5969 (ps-output "false BG\n")))
5971 (defun ps-set-color (color)
5972 (setq ps-current-color (or color ps-default-foreground))
5973 (ps-output (format ps-color-format
5974 (nth 0 ps-current-color)
5975 (nth 1 ps-current-color) (nth 2 ps-current-color))
5976 " FG\n"))
5979 (defsubst ps-plot-string (string)
5980 (ps-plot 'ps-basic-plot-str 0 (length string) string))
5983 (defvar ps-current-effect 0)
5986 (defun ps-plot-region (from to font &optional fg-color bg-color effects)
5987 (or (equal font ps-current-font)
5988 (ps-set-font font))
5990 ;; Specify a foreground color only if one's specified and it's
5991 ;; different than the current.
5992 (let ((fg (or fg-color ps-default-foreground)))
5993 (or (equal fg ps-current-color)
5994 (ps-set-color fg)))
5996 (or (equal bg-color ps-current-bg)
5997 (ps-set-bg bg-color))
5999 ;; Specify effects (underline, overline, box, etc)
6000 (cond
6001 ((not (integerp effects))
6002 (ps-output "0 EF\n")
6003 (setq ps-current-effect 0))
6004 ((/= effects ps-current-effect)
6005 (ps-output (number-to-string effects) " EF\n")
6006 (setq ps-current-effect effects)))
6008 ;; Starting at the beginning of the specified region...
6009 (save-excursion
6010 (goto-char from)
6012 ;; ...break the region up into chunks separated by tabs, linefeeds,
6013 ;; pagefeeds, control characters, and plot each chunk.
6014 (while (< from to)
6015 ;; skip lines between cut markers
6016 (and ps-begin-cut-regexp ps-end-cut-regexp
6017 (looking-at ps-begin-cut-regexp)
6018 (progn
6019 (goto-char (match-end 0))
6020 (and (re-search-forward ps-end-cut-regexp to 'noerror)
6021 (= (following-char) ?\n)
6022 (forward-char 1))
6023 (setq from (point))))
6024 (if (re-search-forward ps-control-or-escape-regexp to t)
6025 ;; region with some control characters or some multi-byte characters
6026 (let* ((match-point (match-beginning 0))
6027 (match (char-after match-point))
6028 (composition (ps-e-find-composition from (1+ match-point))))
6029 (if composition
6030 (if (and (nth 2 composition)
6031 (<= (car composition) match-point))
6032 (progn
6033 (setq match-point (car composition)
6034 match 0)
6035 (goto-char (nth 1 composition)))
6036 (setq composition nil)))
6037 (when (< from match-point)
6038 (ps-mule-set-ascii-font)
6039 (ps-plot 'ps-basic-plot-string from match-point bg-color))
6040 (cond
6041 ((= match ?\t) ; tab
6042 (let ((linestart (line-beginning-position)))
6043 (forward-char -1)
6044 (setq from (+ linestart (current-column)))
6045 (when (re-search-forward "[ \t]+" to t)
6046 (ps-mule-set-ascii-font)
6047 (ps-plot 'ps-basic-plot-whitespace
6048 from (+ linestart (current-column))
6049 bg-color))))
6051 ((= match ?\n) ; newline
6052 (if (looking-at "\f[^\n]")
6053 ;; \n\ftext\n ==>> next page, but keep line counting!!
6054 (progn
6055 (ps-skip-newline to)
6056 (ps-next-page))
6057 ;; \n\f\n ==>> it'll be handled by form feed
6058 ;; \ntext\n ==>> next line
6059 (ps-next-line)))
6061 ((= match ?\f) ; form feed
6062 ;; do not skip page if previous character is NEWLINE and
6063 ;; it is a beginning of page.
6064 (unless (and (equal (char-after (1- match-point)) ?\n)
6065 (= ps-height-remaining ps-print-height))
6066 ;; \f\n ==>> skip \n, but keep line counting!!
6067 (and (equal (following-char) ?\n)
6068 (ps-skip-newline to))
6069 (ps-next-page)))
6071 (composition ; a composite sequence
6072 (ps-plot 'ps-mule-plot-composition match-point (point) bg-color))
6074 ((> match 255) ; a multi-byte character
6075 (let* ((charset (char-charset match))
6076 (composition (ps-e-find-composition match-point to))
6077 (stop (if (nth 2 composition) (car composition) to)))
6078 (or (eq charset 'composition)
6079 (while (and (< (point) stop) (eq (charset-after) charset))
6080 (forward-char 1)))
6081 (ps-plot 'ps-mule-plot-string match-point (point) bg-color)))
6082 ; characters from ^@ to ^_ and
6083 (t ; characters from 127 to 255
6084 (ps-control-character match)))
6085 (setq from (point)))
6086 ;; region without control characters nor multi-byte characters
6087 (ps-mule-set-ascii-font)
6088 (ps-plot 'ps-basic-plot-string from to bg-color)
6089 (setq from to)))))
6091 (defvar ps-string-control-codes
6092 (let ((table (make-vector 256 nil))
6093 (char ?\000))
6094 ;; control character
6095 (while (<= char ?\037)
6096 (aset table char (format "^%c" (+ char ?@)))
6097 (setq char (1+ char)))
6098 ;; printable character
6099 (while (< char ?\177)
6100 (aset table char (format "%c" char))
6101 (setq char (1+ char)))
6102 ;; DEL
6103 (aset table char "^?")
6104 ;; 8-bit character
6105 (while (<= (setq char (1+ char)) ?\377)
6106 (aset table char (format "\\%o" char)))
6107 table)
6108 "Vector used to map characters to a printable string.")
6110 (defun ps-control-character (char)
6111 (let* ((str (aref ps-string-control-codes char))
6112 (from (1- (point)))
6113 (len (length str))
6114 (to (+ from len))
6115 (char-width (ps-avg-char-width 'ps-font-for-text))
6116 (wrappoint (ps-find-wrappoint from to char-width)))
6117 (if (< (car wrappoint) to)
6118 (ps-continue-line))
6119 (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
6120 (ps-mule-prepare-ascii-font str)
6121 (ps-output-string str)
6122 (ps-output " S\n")))
6125 (defun ps-face-attributes (face)
6126 "Return face attribute vector.
6128 If FACE is not in `ps-print-face-extension-alist' or in
6129 `ps-print-face-alist', insert it on `ps-print-face-alist' and
6130 return the attribute vector.
6132 If FACE is not a valid face name, it is used default face."
6133 (cond
6134 (ps-black-white-faces-alist
6135 (or (and (symbolp face)
6136 (cdr (assq face ps-black-white-faces-alist)))
6137 (vector 0 nil nil)))
6138 ((symbolp face)
6139 (cdr (or (assq face ps-print-face-extension-alist)
6140 (assq face ps-print-face-alist)
6141 (let* ((the-face (if (facep face) face 'default))
6142 (new-face (ps-screen-to-bit-face the-face)))
6143 (or (and (eq the-face 'default)
6144 (assq the-face ps-print-face-alist))
6145 (setq ps-print-face-alist
6146 (cons new-face ps-print-face-alist)))
6147 new-face))))
6148 ((eq (car face) 'foreground-color)
6149 (vector 0 (cdr face) nil))
6150 ((eq (car face) 'background-color)
6151 (vector 0 nil (cdr face)))
6153 (vector 0 nil nil))))
6156 (defun ps-face-background (face background)
6157 (and (or (eq ps-use-face-background t)
6158 (cond ((symbolp face)
6159 (memq face ps-use-face-background))
6160 ((listp face)
6161 (or (memq (car face) '(foreground-color background-color))
6162 (let (ok)
6163 (while face
6164 (if (or (memq (car face) ps-use-face-background)
6165 (memq (car face)
6166 '(foreground-color background-color)))
6167 (setq face nil
6168 ok t)
6169 (setq face (cdr face))))
6170 ok)))
6172 nil)
6174 background))
6177 (defun ps-face-attribute-list (face-or-list)
6178 (cond
6179 ;; simple face
6180 ((not (listp face-or-list))
6181 (ps-face-attributes face-or-list))
6182 ;; only foreground color, not a `real' face
6183 ((eq (car face-or-list) 'foreground-color)
6184 (vector 0 (cdr face-or-list) nil))
6185 ;; only background color, not a `real' face
6186 ((eq (car face-or-list) 'background-color)
6187 (vector 0 nil (cdr face-or-list)))
6188 ;; list of faces
6190 (let ((effects 0)
6191 foreground background face-attr face)
6192 (while face-or-list
6193 (setq face (car face-or-list)
6194 face-or-list (cdr face-or-list)
6195 face-attr (ps-face-attributes face)
6196 effects (logior effects (aref face-attr 0)))
6197 (or foreground (setq foreground (aref face-attr 1)))
6198 (or background
6199 (setq background (ps-face-background face (aref face-attr 2)))))
6200 (vector effects foreground background)))))
6203 (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
6206 (defun ps-plot-with-face (from to face)
6207 (cond
6208 ((null face) ; print text with null face
6209 (ps-plot-region from to 0))
6210 ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
6211 (t ; otherwise, text has a valid face
6212 (let* ((face-bit (ps-face-attribute-list face))
6213 (effect (aref face-bit 0))
6214 (foreground (aref face-bit 1))
6215 (background (ps-face-background face (aref face-bit 2)))
6216 (fg-color (if (and ps-color-p foreground)
6217 (ps-color-scale foreground)
6218 ps-default-color))
6219 (bg-color (and ps-color-p background
6220 (ps-color-scale background))))
6221 (ps-plot-region
6222 from to
6223 (ps-font-number 'ps-font-for-text
6224 (or (aref ps-font-type (logand effect 3))
6225 face))
6226 fg-color bg-color (lsh effect -2)))))
6227 (goto-char to))
6230 ;; Ensure that face-list is fbound.
6231 (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
6234 (defun ps-build-reference-face-lists ()
6235 ;; Ensure that face database is updated with faces on
6236 ;; `font-lock-face-attributes' (obsolete stuff)
6237 (ps-font-lock-face-attributes)
6238 ;; Now, rebuild reference face lists
6239 (setq ps-print-face-alist nil)
6240 (if ps-auto-font-detect
6241 (mapcar 'ps-map-face (face-list))
6242 (mapcar 'ps-set-face-bold ps-bold-faces)
6243 (mapcar 'ps-set-face-italic ps-italic-faces)
6244 (mapcar 'ps-set-face-underline ps-underlined-faces))
6245 (setq ps-build-face-reference nil))
6248 (defun ps-set-face-bold (face)
6249 (ps-set-face-attribute face 1))
6251 (defun ps-set-face-italic (face)
6252 (ps-set-face-attribute face 2))
6254 (defun ps-set-face-underline (face)
6255 (ps-set-face-attribute face 4))
6258 (defun ps-set-face-attribute (face effect)
6259 (let ((face-bit (cdr (ps-map-face face))))
6260 (aset face-bit 0 (logior (aref face-bit 0) effect))))
6263 (defun ps-map-face (face)
6264 (let* ((face-map (ps-screen-to-bit-face face))
6265 (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
6266 (if ps-face-bit
6267 ;; if face exists, merge both
6268 (let ((face-bit (cdr face-map)))
6269 (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
6270 (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
6271 (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
6272 ;; if face does not exist, insert it
6273 (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
6274 face-map))
6277 (defun ps-screen-to-bit-face (face)
6278 (cons face
6279 (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
6280 (if (ps-face-italic-p face) 2 0) ; italic
6281 (if (ps-face-underlined-p face) 4 0)) ; underline
6282 (ps-face-foreground-name face)
6283 (ps-face-background-name face))))
6286 ;; to avoid compilation gripes
6287 (defun ps-print-ensure-fontified (start end)
6288 (cond
6289 ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
6290 (defalias 'ps-jitify 'jit-lock-fontify-now) ; avoid compilation gripes
6291 (ps-jitify start end))
6292 ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
6293 (defalias 'ps-lazify 'lazy-lock-fontify-region) ; avoid compilation gripes
6294 (ps-lazify start end))))
6297 (defun ps-generate-postscript-with-faces (from to)
6298 ;; Some initialization...
6299 (setq ps-current-effect 0)
6301 ;; Build the reference lists of faces if necessary.
6302 (when (or ps-always-build-face-reference
6303 ps-build-face-reference)
6304 (message "Collecting face information...")
6305 (ps-build-reference-face-lists))
6307 ;; Black/white printer.
6308 (setq ps-black-white-faces-alist nil)
6309 (and (eq ps-print-color-p 'black-white)
6310 (ps-extend-face-list ps-black-white-faces nil
6311 'ps-black-white-faces-alist))
6313 ;; Generate some PostScript.
6314 (save-restriction
6315 (narrow-to-region from to)
6316 (ps-print-ensure-fontified from to)
6317 (let ((face 'default)
6318 (position to))
6319 (cond
6320 ((eq ps-print-emacs-type 'xemacs)
6321 ;; Build the list of extents...
6322 (let ((a (cons 'dummy nil))
6323 record type extent extent-list)
6324 (ps-x-map-extents 'ps-mapper nil from to a)
6325 (setq a (sort (cdr a) 'car-less-than-car)
6326 extent-list nil)
6328 ;; Loop through the extents...
6329 (while a
6330 (setq record (car a)
6331 position (car record)
6333 record (cdr record)
6334 type (car record)
6336 record (cdr record)
6337 extent (car record))
6339 ;; Plot up to this record.
6340 ;; XEmacs 19.12: for some reason, we're getting into a
6341 ;; situation in which some of the records have
6342 ;; positions less than 'from'. Since we've narrowed
6343 ;; the buffer, this'll generate errors. This is a hack,
6344 ;; but don't call ps-plot-with-face unless from > point-min.
6345 (and (>= from (point-min))
6346 (ps-plot-with-face from (min position (point-max)) face))
6348 (cond
6349 ((eq type 'push)
6350 (and (ps-x-extent-face extent)
6351 (setq extent-list (sort (cons extent extent-list)
6352 'ps-extent-sorter))))
6354 ((eq type 'pull)
6355 (setq extent-list (sort (delq extent extent-list)
6356 'ps-extent-sorter))))
6358 (setq face (if extent-list
6359 (ps-x-extent-face (car extent-list))
6360 'default)
6361 from position
6362 a (cdr a)))))
6364 ((eq ps-print-emacs-type 'emacs)
6365 (let ((property-change from)
6366 (overlay-change from)
6367 (save-buffer-invisibility-spec buffer-invisibility-spec)
6368 (buffer-invisibility-spec nil)
6369 before-string after-string)
6370 (while (< from to)
6371 (and (< property-change to) ; Don't search for property change
6372 ; unless previous search succeeded.
6373 (setq property-change (next-property-change from nil to)))
6374 (and (< overlay-change to) ; Don't search for overlay change
6375 ; unless previous search succeeded.
6376 (setq overlay-change (min (ps-e-next-overlay-change from)
6377 to)))
6378 (setq position (min property-change overlay-change)
6379 before-string nil
6380 after-string nil)
6381 ;; The code below is not quite correct,
6382 ;; because a non-nil overlay invisible property
6383 ;; which is inactive according to the current value
6384 ;; of buffer-invisibility-spec nonetheless overrides
6385 ;; a face text property.
6386 (setq face
6387 (cond ((let ((prop (get-text-property from 'invisible)))
6388 ;; Decide whether this invisible property
6389 ;; really makes the text invisible.
6390 (if (eq save-buffer-invisibility-spec t)
6391 (not (null prop))
6392 (or (memq prop save-buffer-invisibility-spec)
6393 (assq prop save-buffer-invisibility-spec))))
6394 'emacs--invisible--face)
6395 ((get-text-property from 'face))
6396 (t 'default)))
6397 (let ((overlays (ps-e-overlays-at from))
6398 (face-priority -1)) ; text-property
6399 (while (and overlays
6400 (not (eq face 'emacs--invisible--face)))
6401 (let* ((overlay (car overlays))
6402 (overlay-invisible
6403 (ps-e-overlay-get overlay 'invisible))
6404 (overlay-priority
6405 (or (ps-e-overlay-get overlay 'priority) 0)))
6406 (and (> overlay-priority face-priority)
6407 (setq before-string
6408 (or (ps-e-overlay-get overlay 'before-string)
6409 before-string)
6410 after-string
6411 (or (and (<= (ps-e-overlay-end overlay) position)
6412 (ps-e-overlay-get overlay 'after-string))
6413 after-string)
6414 face-priority overlay-priority
6415 face
6416 (cond
6417 ((if (eq save-buffer-invisibility-spec t)
6418 (not (null overlay-invisible))
6419 (or (memq overlay-invisible
6420 save-buffer-invisibility-spec)
6421 (assq overlay-invisible
6422 save-buffer-invisibility-spec)))
6423 'emacs--invisible--face)
6424 ((ps-e-overlay-get overlay 'face))
6425 (t face)
6426 ))))
6427 (setq overlays (cdr overlays))))
6428 ;; Plot up to this record.
6429 (and before-string
6430 (ps-plot-string before-string))
6431 (ps-plot-with-face from position face)
6432 (and after-string
6433 (ps-plot-string after-string))
6434 (setq from position)))))
6435 (ps-plot-with-face from to face))))
6437 (defun ps-generate-postscript (from to)
6438 (ps-plot-region from to 0 nil))
6440 (defun ps-generate (buffer from to genfunc)
6441 (save-excursion
6442 (let ((from (min to from))
6443 (to (max to from))
6444 ;; This avoids trouble if chars with read-only properties
6445 ;; are copied into ps-spool-buffer.
6446 (inhibit-read-only t))
6447 (save-restriction
6448 (narrow-to-region from to)
6449 (and ps-razzle-dazzle
6450 (message "Formatting...%3d%%" (setq ps-razchunk 0)))
6451 (setq ps-source-buffer buffer
6452 ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
6453 (ps-init-output-queue)
6454 (let (safe-marker completed-safely needs-begin-file)
6455 (unwind-protect
6456 (progn
6457 (set-buffer ps-spool-buffer)
6458 (set-buffer-multibyte nil)
6460 ;; Get a marker and make it point to the current end of the
6461 ;; buffer, If an error occurs, we'll delete everything from
6462 ;; the end of this marker onwards.
6463 (setq safe-marker (make-marker))
6464 (set-marker safe-marker (point-max))
6466 (goto-char (point-min))
6467 (or (looking-at (regexp-quote ps-adobe-tag))
6468 (setq needs-begin-file t))
6470 (set-buffer ps-source-buffer)
6471 (save-excursion
6472 (let ((ps-print-page-p t)
6473 ps-even-or-odd-pages)
6474 (ps-begin-job)
6475 (when needs-begin-file
6476 (ps-begin-file)
6477 (ps-mule-initialize))
6478 (ps-mule-begin-job from to)
6479 (ps-selected-pages)))
6480 (ps-begin-page)
6481 (funcall genfunc from to)
6482 (ps-end-page)
6483 (ps-end-job needs-begin-file)
6485 ;; Setting this variable tells the unwind form that the
6486 ;; the PostScript was generated without error.
6487 (setq completed-safely t))
6489 ;; Unwind form: If some bad mojo occurred while generating
6490 ;; PostScript, delete all the PostScript that was generated.
6491 ;; This protects the previously spooled files from getting
6492 ;; corrupted.
6493 (and (markerp safe-marker) (not completed-safely)
6494 (progn
6495 (set-buffer ps-spool-buffer)
6496 (delete-region (marker-position safe-marker) (point-max))))))
6498 (and ps-razzle-dazzle (message "Formatting...done"))))))
6501 (defun ps-end-job (needs-begin-file)
6502 (let ((previous-print ps-print-page-p)
6503 (ps-print-page-p t))
6504 (ps-flush-output)
6505 (save-excursion
6506 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
6507 (total-lines (cdr ps-printing-region))
6508 (total-pages (ps-page-number)))
6509 (set-buffer ps-spool-buffer)
6510 (let (case-fold-search)
6511 ;; Back to the PS output buffer to set the last page n-up printing
6512 (goto-char (point-max))
6513 (and (> pages-per-sheet 0)
6514 (re-search-backward "^[0-9]+ BeginSheet$" nil t)
6515 (replace-match (format "%d BeginSheet" pages-per-sheet) t))
6516 ;; Back to the PS output buffer to set the page count
6517 (goto-char (point-min))
6518 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
6519 (replace-match (format "/Lines %d def\n/PageCount %d def"
6520 total-lines total-pages) t)))))
6521 ;; Set dummy page
6522 (and ps-spool-duplex (= (mod ps-page-order 2) 1)
6523 (let ((ps-n-up-printing 0))
6524 (ps-header-sheet)
6525 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
6526 "/PrintLineNumber false def\n"
6527 (number-to-string ps-lines-printed) " BeginPage\n")
6528 (ps-end-page)))
6529 ;; Set end of PostScript file
6530 (and previous-print
6531 (ps-output "EndSheet\n"))
6532 (ps-output "\n%%Trailer\n%%Pages: "
6533 (number-to-string
6534 (if (and needs-begin-file
6535 ps-banner-page-when-duplexing)
6536 (1+ ps-page-order)
6537 ps-page-order))
6538 "\n\nEndDoc\n\n%%EOF\n")
6539 (and ps-end-with-control-d
6540 (ps-output "\C-d"))
6541 (ps-flush-output))
6542 ;; disable selected pages
6543 (setq ps-selected-pages nil))
6546 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
6547 (defun ps-do-despool (filename)
6548 (if (or (not (boundp 'ps-spool-buffer))
6549 (not (symbol-value 'ps-spool-buffer)))
6550 (message "No spooled PostScript to print")
6551 (if filename
6552 (save-excursion
6553 (and ps-razzle-dazzle (message "Saving..."))
6554 (set-buffer ps-spool-buffer)
6555 (setq filename (expand-file-name filename))
6556 (let ((coding-system-for-write 'raw-text-unix))
6557 (write-region (point-min) (point-max) filename))
6558 (and ps-razzle-dazzle (message "Wrote %s" filename)))
6559 ;; Else, spool to the printer
6560 (and ps-razzle-dazzle (message "Printing..."))
6561 (save-excursion
6562 (set-buffer ps-spool-buffer)
6563 (let* ((coding-system-for-write 'raw-text-unix)
6564 (ps-printer-name (or ps-printer-name
6565 (and (boundp 'printer-name)
6566 (symbol-value 'printer-name))))
6567 (ps-lpr-switches
6568 (append ps-lpr-switches
6569 (and (stringp ps-printer-name)
6570 (string< "" ps-printer-name)
6571 (list (concat
6572 (and (stringp ps-printer-name-option)
6573 ps-printer-name-option)
6574 ps-printer-name))))))
6575 (apply (or ps-print-region-function 'call-process-region)
6576 (point-min) (point-max) ps-lpr-command nil
6577 (and (fboundp 'start-process) 0)
6579 (ps-flatten-list ; dynamic evaluation
6580 (mapcar 'ps-eval-switch ps-lpr-switches)))))
6581 (and ps-razzle-dazzle (message "Printing...done")))
6582 (kill-buffer ps-spool-buffer)))
6584 ;; Dynamic evaluation
6585 (defun ps-eval-switch (arg)
6586 (cond ((stringp arg) arg)
6587 ((functionp arg) (apply arg nil))
6588 ((symbolp arg) (symbol-value arg))
6589 ((consp arg) (apply (car arg) (cdr arg)))
6590 (t nil)))
6592 ;; `ps-flatten-list' is defined here (copied from "message.el" and
6593 ;; enhanced to handle dotted pairs as well) until we can get some
6594 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
6596 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
6597 ;; => (a b c d e f g h i j)
6599 (defun ps-flatten-list (&rest list)
6600 (ps-flatten-list-1 list))
6602 (defun ps-flatten-list-1 (list)
6603 (cond ((null list) nil)
6604 ((consp list) (append (ps-flatten-list-1 (car list))
6605 (ps-flatten-list-1 (cdr list))))
6606 (t (list list))))
6608 (defun ps-kill-emacs-check ()
6609 (let (ps-buffer)
6610 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6611 (buffer-modified-p ps-buffer)
6612 (y-or-n-p "Unprinted PostScript waiting; print now? ")
6613 (ps-despool))
6614 (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
6615 (buffer-modified-p ps-buffer)
6616 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
6617 (error "Unprinted PostScript"))))
6619 (cond ((fboundp 'add-hook)
6620 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
6621 (kill-emacs-hook
6622 (message "Won't override existing `kill-emacs-hook'"))
6624 (setq kill-emacs-hook 'ps-kill-emacs-check)))
6627 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6628 ;;; Sample Setup Code:
6631 ;; This stuff is for anybody that's brave enough to look this far,
6632 ;; and able to figure out how to use it. It isn't really part of
6633 ;; ps-print, but I'll leave it here in hopes it might be useful:
6635 ;; WARNING!!! The following code is *sample* code only.
6636 ;; Don't use it unless you understand what it does!
6638 (defmacro ps-prsc ()
6639 `(if (eq ps-print-emacs-type 'emacs) [f22] 'f22))
6640 (defmacro ps-c-prsc ()
6641 `(if (eq ps-print-emacs-type 'emacs) [C-f22] '(control f22)))
6642 (defmacro ps-s-prsc ()
6643 `(if (eq ps-print-emacs-type 'emacs) [S-f22] '(shift f22)))
6645 ;; A hook to bind to `rmail-mode-hook' to locally bind prsc and set the
6646 ;; `ps-left-headers' specially for mail messages.
6647 (defun ps-rmail-mode-hook ()
6648 (local-set-key (ps-prsc) 'ps-rmail-print-message-from-summary)
6649 (setq ps-header-lines 3
6650 ps-left-header
6651 ;; The left headers will display the message's subject, its
6652 ;; author, and the name of the folder it was in.
6653 '(ps-article-subject ps-article-author buffer-name)))
6655 ;; See `ps-gnus-print-article-from-summary'. This function does the
6656 ;; same thing for rmail.
6657 (defun ps-rmail-print-message-from-summary ()
6658 (interactive)
6659 (ps-print-message-from-summary 'rmail-summary-buffer "RMAIL"))
6661 ;; Used in `ps-rmail-print-article-from-summary',
6662 ;; `ps-gnus-print-article-from-summary' and `ps-vm-print-message-from-summary'.
6663 (defun ps-print-message-from-summary (summary-buffer summary-default)
6664 (let ((ps-buf (or (and (boundp summary-buffer)
6665 (symbol-value summary-buffer))
6666 summary-default)))
6667 (and (get-buffer ps-buf)
6668 (save-excursion
6669 (set-buffer ps-buf)
6670 (ps-spool-buffer-with-faces)))))
6672 ;; Look in an article or mail message for the Subject: line. To be
6673 ;; placed in `ps-left-headers'.
6674 (defun ps-article-subject ()
6675 (save-excursion
6676 (goto-char (point-min))
6677 (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
6678 (buffer-substring (match-beginning 1) (match-end 1))
6679 "Subject ???")))
6681 ;; Look in an article or mail message for the From: line. Sorta-kinda
6682 ;; understands RFC-822 addresses and can pull the real name out where
6683 ;; it's provided. To be placed in `ps-left-headers'.
6684 (defun ps-article-author ()
6685 (save-excursion
6686 (goto-char (point-min))
6687 (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
6688 (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
6689 (cond
6691 ;; Try first to match addresses that look like
6692 ;; thompson@wg2.waii.com (Jim Thompson)
6693 ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
6694 (substring fromstring (match-beginning 1) (match-end 1)))
6696 ;; Next try to match addresses that look like
6697 ;; Jim Thompson <thompson@wg2.waii.com> or
6698 ;; "Jim Thompson" <thompson@wg2.waii.com>
6699 ((string-match "\\(\"?\\)\\(.*\\)\\1[ \t]+<.*>" fromstring)
6700 (substring fromstring (match-beginning 2) (match-end 2)))
6702 ;; Couldn't find a real name -- show the address instead.
6703 (t fromstring)))
6704 "From ???")))
6706 ;; A hook to bind to `gnus-article-prepare-hook'. This will set the
6707 ;; `ps-left-headers' specially for gnus articles. Unfortunately,
6708 ;; `gnus-article-mode-hook' is called only once, the first time the *Article*
6709 ;; buffer enters that mode, so it would only work for the first time
6710 ;; we ran gnus. The second time, this hook wouldn't get set up. The
6711 ;; only alternative is `gnus-article-prepare-hook'.
6712 (defun ps-gnus-article-prepare-hook ()
6713 (setq ps-header-lines 3
6714 ps-left-header
6715 ;; The left headers will display the article's subject, its
6716 ;; author, and the newsgroup it was in.
6717 '(ps-article-subject ps-article-author gnus-newsgroup-name)))
6719 ;; A hook to bind to `vm-mode-hook' to locally bind prsc and set the
6720 ;; `ps-left-headers' specially for mail messages.
6721 (defun ps-vm-mode-hook ()
6722 (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
6723 (setq ps-header-lines 3
6724 ps-left-header
6725 ;; The left headers will display the message's subject, its
6726 ;; author, and the name of the folder it was in.
6727 '(ps-article-subject ps-article-author buffer-name)))
6729 ;; Every now and then I forget to switch from the *Summary* buffer to
6730 ;; the *Article* before hitting prsc, and a nicely formatted list of
6731 ;; article subjects shows up at the printer. This function, bound to
6732 ;; prsc for the gnus *Summary* buffer means I don't have to switch
6733 ;; buffers first.
6734 ;; sb: Updated for Gnus 5.
6735 (defun ps-gnus-print-article-from-summary ()
6736 (interactive)
6737 (ps-print-message-from-summary 'gnus-article-buffer "*Article*"))
6739 ;; See `ps-gnus-print-article-from-summary'. This function does the
6740 ;; same thing for vm.
6741 (defun ps-vm-print-message-from-summary ()
6742 (interactive)
6743 (ps-print-message-from-summary 'vm-mail-buffer ""))
6745 ;; A hook to bind to bind to `gnus-summary-setup-buffer' to locally bind
6746 ;; prsc.
6747 (defun ps-gnus-summary-setup ()
6748 (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
6750 ;; Look in an article or mail message for the Subject: line. To be
6751 ;; placed in `ps-left-headers'.
6752 (defun ps-info-file ()
6753 (save-excursion
6754 (goto-char (point-min))
6755 (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
6756 (buffer-substring (match-beginning 1) (match-end 1))
6757 "File ???")))
6759 ;; Look in an article or mail message for the Subject: line. To be
6760 ;; placed in `ps-left-headers'.
6761 (defun ps-info-node ()
6762 (save-excursion
6763 (goto-char (point-min))
6764 (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
6765 (buffer-substring (match-beginning 1) (match-end 1))
6766 "Node ???")))
6768 (defun ps-info-mode-hook ()
6769 (setq ps-left-header
6770 ;; The left headers will display the node name and file name.
6771 '(ps-info-node ps-info-file)))
6773 ;; WARNING! The following function is a *sample* only, and is *not*
6774 ;; meant to be used as a whole unless you understand what the effects
6775 ;; will be! (In fact, this is a copy of Jim's setup for ps-print --
6776 ;; I'd be very surprised if it was useful to *anybody*, without
6777 ;; modification.)
6779 (defun ps-jts-ps-setup ()
6780 (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
6781 (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
6782 (global-set-key (ps-c-prsc) 'ps-despool)
6783 (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
6784 (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
6785 (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
6786 (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
6787 (add-hook 'Info-mode-hook 'ps-info-mode-hook)
6788 (setq ps-spool-duplex t
6789 ps-print-color-p nil
6790 ps-lpr-command "lpr"
6791 ps-lpr-switches '("-Jjct,duplex_long"))
6792 'ps-jts-ps-setup)
6794 ;; WARNING! The following function is a *sample* only, and is *not*
6795 ;; meant to be used as a whole unless it corresponds to your needs.
6796 ;; (In fact, this is a copy of Jack's setup for ps-print --
6797 ;; I would not be that surprised if it was useful to *anybody*,
6798 ;; without modification.)
6800 (defun ps-jack-setup ()
6801 (setq ps-print-color-p nil
6802 ps-lpr-command "lpr"
6803 ps-lpr-switches nil
6805 ps-paper-type 'a4
6806 ps-landscape-mode t
6807 ps-number-of-columns 2
6809 ps-left-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6810 ps-right-margin (/ (* 72 1.0) 2.54) ; 1.0 cm
6811 ps-inter-column (/ (* 72 1.0) 2.54) ; 1.0 cm
6812 ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6813 ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
6814 ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
6815 ps-header-line-pad .15
6816 ps-print-header t
6817 ps-print-header-frame t
6818 ps-header-lines 2
6819 ps-show-n-of-n t
6820 ps-spool-duplex nil
6822 ps-font-family 'Courier
6823 ps-font-size 5.5
6824 ps-header-font-family 'Helvetica
6825 ps-header-font-size 6
6826 ps-header-title-font-size 8)
6827 'ps-jack-setup)
6830 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6831 ;; To make this file smaller, some commands go in a separate file.
6832 ;; But autoload them here to make the separation invisible.
6834 (autoload 'ps-mule-prepare-ascii-font "ps-mule"
6835 "Setup special ASCII font for STRING.
6836 STRING should contain only ASCII characters.")
6838 (autoload 'ps-mule-set-ascii-font "ps-mule"
6839 "Adjust current font if current charset is not ASCII.")
6841 (autoload 'ps-mule-plot-string "ps-mule"
6842 "Generate PostScript code for plotting characters in the region FROM and TO.
6844 It is assumed that all characters in this region belong to the same charset.
6846 Optional argument BG-COLOR specifies background color.
6848 Returns the value:
6850 (ENDPOS . RUN-WIDTH)
6852 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
6853 the sequence.")
6855 (autoload 'ps-mule-initialize "ps-mule"
6856 "Initialize global data for printing multi-byte characters.")
6858 (autoload 'ps-mule-begin-job "ps-mule"
6859 "Start printing job for multi-byte chars between FROM and TO.
6860 This checks if all multi-byte characters in the region are printable or not.")
6862 (autoload 'ps-mule-begin-page "ps-mule"
6863 "Initialize multi-byte charset for printing current page.")
6865 (autoload 'ps-mule-encode-header-string "ps-mule"
6866 "Generate PostScript code for plotting characters in header STRING.
6868 It is assumed that the length of STRING is not zero.")
6871 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6873 (provide 'ps-print)
6875 ;;; ps-print.el ends here