1 ;;; ps-print.el --- print text from the buffer as PostScript
3 ;; Copyright (C) 1993-2012 Free Software Foundation, Inc.
5 ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
6 ;; Jacques Duthen (was <duthen@cegelec-red.fr>)
7 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
8 ;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
9 ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
10 ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
11 ;; Keywords: wp, print, PostScript
13 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
15 (defconst ps-print-version
"7.3.5"
16 "ps-print.el, v 7.3.5 <2009/12/23 vinicius>
18 Vinicius's last change version -- this file may have been edited as part of
19 Emacs without changes to the version number. When reporting bugs, please also
20 report the version of Emacs, if any, that ps-print was distributed with.
22 Please send all bug fixes and enhancements to
23 Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
25 ;; This file is part of GNU Emacs.
27 ;; GNU Emacs is free software: you can redistribute it and/or modify
28 ;; it under the terms of the GNU General Public License as published by
29 ;; the Free Software Foundation, either version 3 of the License, or
30 ;; (at your option) any later version.
32 ;; GNU Emacs is distributed in the hope that it will be useful,
33 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
34 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
35 ;; GNU General Public License for more details.
37 ;; You should have received a copy of the GNU General Public License
38 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
42 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 ;; This package provides printing of Emacs buffers on PostScript printers; the
48 ;; buffer's bold and italic text attributes are preserved in the printer
49 ;; output. ps-print is intended for use with Emacs or XEmacs, together with a
50 ;; fontifying package such as font-lock or hilit.
52 ;; ps-print uses the same face attributes defined through font-lock or hilit to
53 ;; print a PostScript file, but some faces are better seeing on the screen than
54 ;; on paper, specially when you have a black/white PostScript printer.
56 ;; ps-print allows a remap of face to another one that it is better to print,
57 ;; for example, the face font-lock-comment-face (if you are using font-lock)
58 ;; could have bold or italic attribute when printing, besides foreground color.
59 ;; This remap improves printing look (see How Ps-Print Maps Faces).
65 ;; ps-print provides eight commands for generating PostScript images of Emacs
69 ;; ps-print-buffer-with-faces
71 ;; ps-print-region-with-faces
73 ;; ps-spool-buffer-with-faces
75 ;; ps-spool-region-with-faces
77 ;; These commands all perform essentially the same function: they generate
78 ;; PostScript images suitable for printing on a PostScript printer or
79 ;; displaying with GhostScript. These commands are collectively referred to as
80 ;; "ps-print- commands".
82 ;; The word "print" or "spool" in the command name determines when the
83 ;; PostScript image is sent to the printer:
85 ;; print - The PostScript image is immediately sent to the printer;
87 ;; spool - The PostScript image is saved temporarily in an Emacs
88 ;; buffer. Many images may be spooled locally before
89 ;; printing them. To send the spooled images to the
90 ;; printer, use the command `ps-despool'.
92 ;; The spooling mechanism was designed for printing lots of small files (mail
93 ;; messages or netnews articles) to save paper that would otherwise be wasted
94 ;; on banner pages, and to make it easier to find your output at the printer
95 ;; (it's easier to pick up one 50-page printout than to find 50 single-page
98 ;; ps-print has a hook in the `kill-emacs-hook' so that you won't accidentally
99 ;; quit from Emacs while you have unprinted PostScript waiting in the spool
100 ;; buffer. If you do attempt to exit with spooled PostScript, you'll be asked
101 ;; if you want to print it, and if you decline, you'll be asked to confirm the
102 ;; exit; this is modeled on the confirmation that Emacs uses for modified
105 ;; The word "buffer" or "region" in the command name determines how much of the
106 ;; buffer is printed:
108 ;; buffer - Print the entire buffer.
110 ;; region - Print just the current region.
112 ;; The -with-faces suffix on the command name means that the command will
113 ;; include font, color, and underline information in the PostScript image, so
114 ;; the printed image can look as pretty as the buffer. The ps-print- commands
115 ;; without the -with-faces suffix don't include font, color, or underline
116 ;; information; images printed with these commands aren't as pretty, but are
117 ;; faster to generate.
119 ;; Two ps-print- command examples:
121 ;; ps-print-buffer - print the entire buffer, without font,
122 ;; color, or underline information, and
123 ;; send it immediately to the printer.
125 ;; ps-spool-region-with-faces - print just the current region; include
126 ;; font, color, and underline information,
127 ;; and spool the image in Emacs to send to
128 ;; the printer later.
134 ;; To print your buffer, type
136 ;; M-x ps-print-buffer
138 ;; or substitute one of the other seven ps-print- commands. The command will
139 ;; generate the PostScript image and print or spool it as specified. By giving
140 ;; the command a prefix argument
142 ;; C-u M-x ps-print-buffer
144 ;; it will save the PostScript image to a file instead of sending it to the
145 ;; printer; you will be prompted for the name of the file to save the image to.
146 ;; The prefix argument is ignored by the commands that spool their images, but
147 ;; you may save the spooled images to a file by giving a prefix argument to
150 ;; C-u M-x ps-despool
152 ;; When invoked this way, `ps-despool' will prompt you for the name of the file
155 ;; Any of the `ps-print-' commands can be bound to keys; I recommend binding
156 ;; `ps-spool-buffer-with-faces', `ps-spool-region-with-faces', and
157 ;; `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
159 ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
160 ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
161 ;; (global-set-key '(control f22) 'ps-despool)
164 ;; The Printer Interface
165 ;; ---------------------
167 ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what command
168 ;; is used to send the PostScript images to the printer, and what arguments to
169 ;; give the command. These are analogous to `lpr-command' and `lpr-switches'.
171 ;; Make sure that they contain appropriate values for your system;
172 ;; see the usage notes below and the documentation of these variables.
174 ;; The variable `ps-printer-name' determines the name of a local printer for
175 ;; printing PostScript files.
177 ;; The variable `ps-printer-name-option' determines the option used by some
178 ;; utilities to indicate the printer name, it's used only when
179 ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
180 ;; print, for example, `ps-printer-name-option' should be set to "-P".
182 ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values from
183 ;; the variables `lpr-command' and `lpr-switches'. If you have
184 ;; `lpr-command' set to invoke a pretty-printer such as `enscript', then
185 ;; ps-print won't work properly. `ps-lpr-command' must name a program
186 ;; that does not format the files it prints.
187 ;; `ps-printer-name' takes its initial value from the variable
188 ;; `printer-name'. `ps-printer-name-option' tries to guess which system
189 ;; Emacs is running and takes its initial value in accordance with this
192 ;; The variable `ps-print-region-function' specifies a function to print the
193 ;; region on a PostScript printer.
194 ;; See definition of `call-process-region' for calling conventions. The fourth
195 ;; and the sixth arguments are both nil.
197 ;; The variable `ps-manual-feed' indicates if the printer will manually feed
198 ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
199 ;; feeding takes place. The default is nil (automatic feeding).
201 ;; The variable `ps-end-with-control-d' specifies whether C-d (\x04) should be
202 ;; inserted at end of PostScript generated. Non-nil means do so. The default
203 ;; is nil (don't insert).
205 ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
206 ;; customize the following variables: `ps-printer-name',
207 ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
208 ;; `ps-spool-config'. See these variables documentation in the code or by
209 ;; typing, for example, C-h v ps-printer-name RET.
215 ;; All dimensions are floats in PostScript points.
216 ;; 1 inch == 2.54 cm == 72 points
217 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
219 ;; The variable `ps-paper-type' determines the size of paper ps-print formats
220 ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
221 ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
224 ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
225 ;; PostScript printer doesn't have a paper with the size indicated by
226 ;; `ps-paper-type', instead it uses the default paper size. If variable
227 ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
228 ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
229 ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
230 ;; Printers). The default value is non-nil (it gives an error).
232 ;; The variable `ps-landscape-mode' determines the orientation of the printing
233 ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
234 ;; There is no oblique mode yet, though this is easy to do in ps.
236 ;; In landscape mode, the text is NOT scaled: you may print 70 lines in
237 ;; portrait mode and only 50 lines in landscape mode. The margins represent
238 ;; margins in the printed paper: the top margin is the margin between the top
239 ;; of the page and the printed header, whatever the orientation is.
241 ;; The variable `ps-number-of-columns' determines the number of columns both in
242 ;; landscape and portrait mode.
244 ;; - (the standard) one column portrait mode.
245 ;; - (my favorite) two columns landscape mode (which spares trees).
247 ;; - one column landscape mode for files with very long lines.
248 ;; - multi-column portrait or landscape mode.
250 ;; The variable `ps-print-upside-down' determines other orientation for
251 ;; printing page: nil means `normal' printing, non-nil means `upside-down'
252 ;; printing (that is, the page is rotated by 180 grades). The default value is
253 ;; nil (`normal' printing).
255 ;; The `upside-down' orientation can be used in portrait or landscape mode.
257 ;; The variable `ps-selected-pages' specifies which pages to print. If it's
258 ;; nil, all pages are printed. If it's a list, the list element may be an
259 ;; integer or a cons cell (FROM . TO) designating FROM page to TO page; any
260 ;; invalid element is ignored, that is, an integer lesser than one or if FROM
261 ;; is greater than TO. Otherwise, it's treated as nil. The default value is
262 ;; nil (print all pages). After ps-print processing `ps-selected-pages' is set
263 ;; to nil. But the latest `ps-selected-pages' is saved in
264 ;; `ps-last-selected-pages' (see it for documentation). So you can restore the
265 ;; latest selected pages by using `ps-last-selected-pages' or by calling
266 ;; `ps-restore-selected-pages' command (see it for documentation).
268 ;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
272 ;; nil print all pages.
274 ;; even-page print only even pages.
276 ;; odd-page print only odd pages.
278 ;; even-sheet print only even sheets.
280 ;; odd-sheet print only odd sheets.
282 ;; Any other value is treated as nil. The default value is nil.
284 ;; See `ps-even-or-odd-pages' for more detailed documentation.
290 ;; The horizontal layout is determined by the variables
291 ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
294 ;; ------------------------------------------
296 ;; | lm | text | ic | text | ic | text | rm |
298 ;; ------------------------------------------
300 ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
301 ;; Usually, lm = rm > 0 and ic = lm
302 ;; If (ic < 0), the text of adjacent columns can overlap.
308 ;; The vertical layout is determined by the variables
309 ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' `ps-footer-offset'
312 ;; |--------| |--------| |--------| |--------|
313 ;; | tm | | tm | | tm | | tm |
314 ;; |--------| |--------| |--------| |--------|
315 ;; | header | | | | header | | |
316 ;; |--------| | | |--------| | |
317 ;; | ho | | | | ho | | |
318 ;; |--------| | | |--------| | |
320 ;; | text | or | text | or | text | or | text |
322 ;; | | |--------| |--------| | |
323 ;; | | | fo | | fo | | |
324 ;; | | |--------| |--------| | |
325 ;; | | | footer | | footer | | |
326 ;; |--------| |--------| |--------| |--------|
327 ;; | bm | | bm | | bm | | bm |
328 ;; |--------| |--------| |--------| |--------|
330 ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
331 ;; If `ps-print-footer' is nil, `ps-footer-offset' is not relevant.
332 ;; The margins represent margins in the printed paper:
333 ;; the top margin is the margin between the top of the page and the printed
334 ;; header, whatever the orientation is;
335 ;; the bottom margin is the margin between the bottom of the page and the
336 ;; printed footer, whatever the orientation is.
342 ;; ps-print can print headers at the top of each column or at the top of each
343 ;; page; the default headers contain the following four items: on the left, the
344 ;; name of the buffer and, if the buffer is visiting a file, the file's
345 ;; directory; on the right, the page number and date of printing. The default
346 ;; headers look something like this:
349 ;; /home/jct/emacs-lisp/ps/new 94/12/31
351 ;; When printing on duplex printers, left and right are reversed so that the
352 ;; page numbers are toward the outside (cf. `ps-spool-duplex').
354 ;; Headers are configurable:
355 ;; To turn them off completely, set `ps-print-header' to nil.
356 ;; To turn off the header's gaudy framing box,
357 ;; set `ps-print-header-frame' to nil.
359 ;; The variable `ps-header-frame-alist' specifies header frame properties
360 ;; alist. Valid frame properties are:
362 ;; fore-color Specify the foreground frame color.
363 ;; It should be a float number between 0.0 (black color)
364 ;; and 1.0 (white color), a string which is a color name,
365 ;; or a list of 3 float numbers which corresponds to the
366 ;; Red Green Blue color scale, each float number between
367 ;; 0.0 (dark color) and 1.0 (bright color).
368 ;; The default is 0 ("black").
370 ;; back-color Specify the background frame color (similar to
371 ;; fore-color). The default is 0.9 ("gray90").
373 ;; shadow-color Specify the shadow color (similar to fore-color).
374 ;; The default is 0 ("black").
376 ;; border-color Specify the border color (similar to fore-color).
377 ;; The default is 0 ("black").
379 ;; border-width Specify the border width.
380 ;; The default is 0.4.
382 ;; Any other property is ignored.
384 ;; Don't change this alist directly, instead use customization, or `ps-value',
385 ;; `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
387 ;; To print only one header at the top of each page, set
388 ;; `ps-print-only-one-header' to t.
390 ;; To switch headers, set `ps-switch-header' to:
392 ;; nil Never switch headers.
394 ;; t Always switch headers.
396 ;; duplex Switch headers only when duplexing is on, that is, when
397 ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
399 ;; Any other value is treated as t. The default value is `duplex'.
401 ;; The font family and size of text in the header are determined by the
402 ;; variables `ps-header-font-family', `ps-header-font-size' and
403 ;; `ps-header-title-font-size' (see below).
405 ;; The variable `ps-header-line-pad' determines the portion of a header title
406 ;; line height to insert between the header frame and the text it contains,
407 ;; both in the vertical and horizontal directions: .5 means half a line.
409 ;; Page numbers are printed in `n/m' format, indicating page n of m pages; to
410 ;; omit the total page count and just print the page number, set
411 ;; `ps-show-n-of-n' to nil.
413 ;; The amount of information in the header can be changed by changing the
414 ;; number of lines. To show less, set `ps-header-lines' to 1, and the header
415 ;; will show only the buffer name and page number. To show more, set
416 ;; `ps-header-lines' to 3, and the header will show the time of printing below
419 ;; To change the content of the headers, change the variables `ps-left-header'
420 ;; and `ps-right-header'.
421 ;; These variables are lists, specifying top-to-bottom the text to display on
422 ;; the left or right side of the header. Each element of the list should be a
423 ;; string or a symbol. Strings are inserted directly into the PostScript
424 ;; arrays, and should contain the PostScript string delimiters '(' and ')'.
426 ;; Symbols in the header format lists can either represent functions or
427 ;; variables. Functions are called, and should return a string to show in the
428 ;; header. Variables should contain strings to display in the header. In
429 ;; either case, function or variable, the PostScript string delimiters are
430 ;; added by ps-print, and should not be part of the returned value.
432 ;; Here's an example: say we want the left header to display the text
438 ;; where we have a function to return "Moe"
440 ;; (defun moe-func ()
443 ;; a variable specifying "Larry"
445 ;; (setq larry-var "Larry")
447 ;; and a literal for "Curly". Here's how `ps-left-header' should be set:
449 ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
451 ;; Note that Curly has the PostScript string delimiters inside his quotes --
452 ;; those aren't misplaced lisp delimiters!
454 ;; Without them, PostScript would attempt to call the undefined function Curly,
455 ;; which would result in a PostScript error.
457 ;; Since most printers don't report PostScript errors except by aborting the
458 ;; print job, this kind of error can be hard to track down.
460 ;; Consider yourself warned!
462 ;; ps-print also print footers. The footer variables are: `ps-print-footer',
463 ;; `ps-footer-offset', `ps-print-footer-frame', `ps-footer-font-family',
464 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
465 ;; `ps-left-footer', `ps-right-footer' and `ps-footer-frame-alist'. These
466 ;; variables are similar to those one that control headers.
468 ;; The variables `ps-print-only-one-header' and `ps-switch-header' also control
469 ;; the footer (The same way that control header).
471 ;; As a footer example, if you want to have a centered page number in the
472 ;; footer but without headers, set:
474 ;; (setq ps-print-header nil
476 ;; ps-print-footer-frame nil
478 ;; ps-right-footer nil
480 ;; (list (concat "{pagenumberstring dup stringwidth pop"
481 ;; " 2 div PrintWidth 2 div exch sub 0 rmoveto}")))
484 ;; PostScript Prologue Header
485 ;; --------------------------
487 ;; It is possible to add PostScript prologue header comments besides that
488 ;; ps-print generates by setting the variable `ps-print-prologue-header'.
490 ;; `ps-print-prologue-header' may be a string or a symbol function which
491 ;; returns a string. Note that this string is inserted on PostScript prologue
492 ;; header section which is used to define some document characteristic through
493 ;; PostScript special comments, like "%%Requirements: jog\n".
495 ;; By default `ps-print-prologue-header' is nil.
497 ;; ps-print always inserts the %%Requirements: comment, so if you need to
498 ;; insert more requirements put them first in `ps-print-prologue-header' using
499 ;; the "%%+" comment. For example, if you need to set numcopies to 3 and jog
500 ;; on requirements and set %%LanguageLevel: to 2, do:
502 ;; (setq ps-print-prologue-header
503 ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
505 ;; The duplex requirement is inserted by ps-print (see section Duplex
508 ;; Do not forget to terminate the string with "\n".
510 ;; For more information about PostScript document comments, see:
511 ;; PostScript Language Reference Manual (2nd edition)
512 ;; Adobe Systems Incorporated
513 ;; Appendix G: Document Structuring Conventions -- Version 3.0
515 ;; It is also possible to add an user defined PostScript prologue code before
516 ;; all generated prologue code by setting the variable
517 ;; `ps-user-defined-prologue'.
519 ;; `ps-user-defined-prologue' may be a string or a symbol function which
520 ;; returns a string. Note that this string is inserted after `ps-adobe-tag'
521 ;; and PostScript prologue comments, and before ps-print PostScript prologue
522 ;; code section. That is, this string is inserted after error handler
523 ;; initialization and before ps-print settings.
525 ;; By default `ps-user-defined-prologue' is nil.
527 ;; It's strongly recommended only insert PostScript code and/or comments
528 ;; specific for your printing system particularities. For example, some
529 ;; special initialization that only your printing system needs.
531 ;; Do not insert code for duplex printing, n-up printing or error handler,
532 ;; ps-print handles this in a suitable way.
534 ;; For more information about PostScript, see:
535 ;; PostScript Language Reference Manual (2nd edition)
536 ;; Adobe Systems Incorporated
538 ;; As an example for `ps-user-defined-prologue' setting:
540 ;; ;; Setting for HP PostScript printer
541 ;; (setq ps-user-defined-prologue
542 ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
543 ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
546 ;; PostScript Error Handler
547 ;; ------------------------
549 ;; ps-print instruments generated PostScript code with an error handler.
551 ;; The variable `ps-error-handler-message' specifies where the error handler
552 ;; message should be sent.
556 ;; none catch the error and *DON'T* send any message.
558 ;; paper catch the error and print on paper the error message.
559 ;; This is the default value.
561 ;; system catch the error and send back the error message to
562 ;; printing system. This is useful only if printing
563 ;; system send back an email reporting the error, or if
564 ;; there is some other alternative way to report back the
565 ;; error from the system to you.
567 ;; paper-and-system catch the error, print on paper the error message and
568 ;; send back the error message to printing system.
570 ;; Any other value is treated as `paper'.
576 ;; If you have a duplex-capable printer (one that prints both sides of the
577 ;; paper), set `ps-spool-duplex' to t.
578 ;; ps-print will insert blank pages to make sure each buffer starts on the
579 ;; correct side of the paper.
581 ;; The variable `ps-spool-config' specifies who is the responsible for setting
582 ;; duplex and page size. Valid values are:
584 ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
585 ;; Don't forget to set `ps-lpr-switches' to select duplex
586 ;; printing for your printer.
588 ;; setpagedevice duplex and page size are configured by ps-print using the
589 ;; setpagedevice PostScript operator.
591 ;; nil duplex and page size are configured by ps-print *not* using
592 ;; the setpagedevice PostScript operator.
594 ;; Any other value is treated as nil.
596 ;; The default value is `lpr-switches'.
598 ;; WARNING: The setpagedevice PostScript operator affects ghostview utility
599 ;; when viewing file generated using landscape. Also on some
600 ;; printers, setpagedevice affects zebra stripes; on other printers,
601 ;; setpagedevice affects the left margin.
602 ;; Besides all that, if your printer does not have the paper size
603 ;; specified by setpagedevice, your printing will be aborted.
604 ;; So, if you need to use setpagedevice, set `ps-spool-config' to
605 ;; `setpagedevice', generate a test file and send it to your printer;
606 ;; if the printed file isn't ok, set `ps-spool-config' to nil.
608 ;; The variable `ps-spool-tumble' specifies how the page images on opposite
609 ;; sides of a sheet are oriented with respect to each other. If
610 ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left
611 ;; or right. If `ps-spool-tumble' is non-nil, produces output suitable for
612 ;; binding at the top or bottom. It has effect only when `ps-spool-duplex' is
613 ;; non-nil. The default value is nil.
615 ;; Some printer system prints a header page and forces the first page be
616 ;; printed on header page back, when using duplex. If your printer system has
617 ;; this behavior, set variable `ps-banner-page-when-duplexing' to t.
619 ;; When `ps-banner-page-when-duplexing' is non-nil, it prints a blank page as
620 ;; the very first printed page. So, it behaves as the very first character of
621 ;; buffer (or region) is ^L (\014).
623 ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the
630 ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
631 ;; paper. The value specified must be between 1 and 100. The default is 1.
633 ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is
634 ;; set to a high value (for example, 23). If this happens, set a lower value.
636 ;; The variable `ps-n-up-margin' specifies the margin in points between the
637 ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
640 ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each
641 ;; page. The default is t.
643 ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
644 ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
645 ;; filling example using a 3x4 page matrix:
647 ;; left-top 1 2 3 4 left-bottom 9 10 11 12
649 ;; 9 10 11 12 1 2 3 4
651 ;; right-top 4 3 2 1 right-bottom 12 11 10 9
653 ;; 12 11 10 9 4 3 2 1
655 ;; top-left 1 4 7 10 bottom-left 3 6 9 12
659 ;; top-right 10 7 4 1 bottom-right 12 9 6 3
663 ;; Any other value is treated as `left-top'.
665 ;; The default value is left-top.
668 ;; Control And 8-bit Characters
669 ;; ----------------------------
671 ;; The variable `ps-print-control-characters' specifies whether you want to see
672 ;; a printable form for control and 8-bit characters, that is, instead of
673 ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
675 ;; Valid values for `ps-print-control-characters' are:
677 ;; 8-bit This is the value to use when you want an ASCII encoding of
678 ;; any control or non-ASCII character. Control characters are
679 ;; encoded as "^D", and non-ASCII characters have an
682 ;; control-8-bit This is the value to use when you want an ASCII encoding of
683 ;; any control character, whether it is 7 or 8-bit.
684 ;; European 8-bits accented characters are printed according
687 ;; control Only ASCII control characters have an ASCII encoding.
688 ;; European 8-bits accented characters are printed according
691 ;; nil No ASCII encoding. Any character is printed according the
694 ;; Any other value is treated as nil.
696 ;; The default is `control-8-bit'.
698 ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
701 ;; Printing Multi-byte Buffer
702 ;; --------------------------
704 ;; See ps-mule.el for documentation.
710 ;; The variable `ps-line-number' specifies whether to number each line;
711 ;; non-nil means do so. The default is nil (don't number each line).
713 ;; The variable `ps-line-number-color' specifies the color for line number.
714 ;; See `ps-zebra-color' for documentation. The default is "black" (or 0.0, or
717 ;; The variable `ps-line-number-font' specifies the font for line number.
718 ;; The default is "Times-Italic".
720 ;; The variable `ps-line-number-font-size' specifies the font size in points
721 ;; for line number. See `ps-font-size' for documentation. The default is 6.
723 ;; The variable `ps-line-number-step' specifies the interval that line number
724 ;; is printed. For example, if `ps-line-number-step' is set to 2, the printing
737 ;; integer an integer that specifies the interval that line number is
738 ;; printed. If it's lesser than or equal to zero, it's used the
741 ;; `zebra' specifies that only the line number of the first line in a
742 ;; zebra stripe is to be printed.
744 ;; Any other value is treated as `zebra'.
745 ;; The default value is 1, so each line number is printed.
747 ;; The variable `ps-line-number-start' specifies the starting point in the
748 ;; interval given by `ps-line-number-step'. For example, if
749 ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3,
750 ;; the printing will look like:
764 ;; The values for `ps-line-number-start':
766 ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
767 ;; of `ps-line-number-step' inclusive.
769 ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
770 ;; value of `ps-zebra-stripe-height' inclusive.
772 ;; The default value is 1, so the line number of the first line of each
773 ;; interval is printed.
779 ;; Zebra stripes are a kind of background that appear "underneath" the text and
780 ;; can make the text easier to read. They look like this:
782 ;; XXXXXXXXXXXXXXXXXXXXXXXX
783 ;; XXXXXXXXXXXXXXXXXXXXXXXX
784 ;; XXXXXXXXXXXXXXXXXXXXXXXX
788 ;; XXXXXXXXXXXXXXXXXXXXXXXX
789 ;; XXXXXXXXXXXXXXXXXXXXXXXX
790 ;; XXXXXXXXXXXXXXXXXXXXXXXX
792 ;; The blocks of X's represent rectangles filled with a light gray color.
793 ;; Each rectangle extends all the way across the page.
795 ;; The height, in lines, of each rectangle is controlled by the variable
796 ;; `ps-zebra-stripe-height', which is 3 by default. The distance between
797 ;; stripes equals the height of a stripe.
799 ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
800 ;; Non-nil means yes, nil means no. The default is nil.
802 ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
803 ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
804 ;; color), a string which is a color name, or a list of 3 numbers which
805 ;; corresponds to the Red Green Blue color scale.
806 ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
808 ;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
809 ;; on next page. Visually, valid values are (the character `+' at right of
810 ;; each column indicates that a line is printed):
812 ;; `nil' `follow' `full' `full-follow'
813 ;; Current Page -------- ----------- --------- ----------------
814 ;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
815 ;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
816 ;; 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
820 ;; 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
821 ;; 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
822 ;; 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
825 ;; -------- ----------- --------- ----------------
826 ;; Next Page -------- ----------- --------- ----------------
827 ;; 12 XXXXX + 12 + 10 XXXXXX + 10 +
828 ;; 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
829 ;; 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
830 ;; 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
831 ;; 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
832 ;; 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
833 ;; 18 XXXXX + 18 + 16 XXXXXX + 16 +
834 ;; 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
835 ;; 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
836 ;; 21 + 21 XXXXXXXX +
838 ;; -------- ----------- --------- ----------------
840 ;; Any other value is treated as nil.
842 ;; See also section How Ps-Print Has A Text And/Or Image On Background.
848 ;; ps-print has the following hook variables:
851 ;; It is evaluated once before any printing process. This is the right
852 ;; place to initialize ps-print global data.
853 ;; For an example, see section Adding a New Font Family.
855 ;; `ps-print-begin-sheet-hook'
856 ;; It is evaluated on each beginning of sheet of paper.
857 ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
860 ;; `ps-print-begin-page-hook'
861 ;; It is evaluated on each beginning of page, except in the beginning of
862 ;; page that `ps-print-begin-sheet-hook' is evaluated.
864 ;; `ps-print-begin-column-hook'
865 ;; It is evaluated on each beginning of column, except in the beginning of
866 ;; column that `ps-print-begin-page-hook' is evaluated or that
867 ;; `ps-print-begin-sheet-hook' is evaluated.
873 ;; ps-print now knows rather precisely some fonts: the variable
874 ;; `ps-font-info-database' contains information for a list of font families
875 ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino'
876 ;; `Helvetica-Narrow' `NewCenturySchlbk'). Each font family contains the font
877 ;; names for standard, bold, italic and bold-italic characters, a reference
878 ;; size (usually 10) and the corresponding line height, width of a space and
879 ;; average character width.
881 ;; The variable `ps-font-family' determines which font family is to be used for
882 ;; ordinary text. If its value does not correspond to a known font family, an
883 ;; error message is printed into the `*Messages*' buffer, which lists the
884 ;; currently available font families.
886 ;; The variable `ps-font-size' determines the size (in points) of the font for
887 ;; ordinary text, when generating PostScript. Its value is a float or a cons
888 ;; of floats which has the following form:
890 ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
892 ;; Similarly, the variable `ps-header-font-family' determines which font family
893 ;; is to be used for text in the header.
895 ;; The variable `ps-header-font-size' determines the font size, in points, for
896 ;; text in the header (similar to `ps-font-size').
898 ;; The variable `ps-header-title-font-size' determines the font size, in
899 ;; points, for the top line of text in the header (similar to `ps-font-size').
901 ;; The variable `ps-line-spacing' determines the line spacing, in points, for
902 ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The
903 ;; default value is 0 (zero = no line spacing).
905 ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in
906 ;; points, for ordinary text, when generating PostScript (similar to
907 ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing).
909 ;; To get all lines with some spacing set both `ps-line-spacing' and
910 ;; `ps-paragraph-spacing' variables.
912 ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It
913 ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an
914 ;; empty line or a line containing only spaces and tabs.
916 ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start
917 ;; and end of a region to cut out when printing.
919 ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may
920 ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave
921 ;; out some special printing instructions from the actual print. Special
922 ;; printing instructions may be appended to the end of the file just like any
923 ;; other buffer-local variables. See section "Local Variables in Files" on
924 ;; Emacs manual for more information.
926 ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together
927 ;; what actually gets printed. Both variables may be set to nil in which case
928 ;; no cutting occurs. By default, both variables are set to nil.
931 ;; Adding a New Font Family
932 ;; ------------------------
934 ;; To use a new font family, you MUST first teach ps-print this font, i.e., add
935 ;; its information to `ps-font-info-database', otherwise ps-print cannot
936 ;; correctly place line and page breaks.
938 ;; For example, assuming `Helvetica' is unknown, you first need to do the
939 ;; following ONLY ONCE:
941 ;; - create a new buffer
942 ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
943 ;; - open this file and find the line:
944 ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
945 ;; - delete the leading `%' (which is the PostScript comment character)
946 ;; - replace in this line `Courier' by the new font (say `Helvetica') to get
948 ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
949 ;; - send this file to the printer (or to ghostscript).
950 ;; You should read the following on the output page:
952 ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
953 ;; and a crude estimate of average character width is 5.09243
955 ;; - Add these values to the `ps-font-info-database':
956 ;; (setq ps-font-info-database
958 ;; '((Helvetica ; the family key
959 ;; (fonts (normal . "Helvetica")
960 ;; (bold . "Helvetica-Bold")
961 ;; (italic . "Helvetica-Oblique")
962 ;; (bold-italic . "Helvetica-BoldOblique"))
964 ;; (line-height . 11.56)
965 ;; (space-width . 2.78)
966 ;; (avg-char-width . 5.09243)))
967 ;; ps-font-info-database))
968 ;; - Now you can use this font family with any size:
969 ;; (setq ps-font-family 'Helvetica)
970 ;; - if you want to use this family in another emacs session, you must put into
972 ;; (require 'ps-print)
973 ;; (setq ps-font-info-database (append ...)))
974 ;; if you don't want to load ps-print, you have to copy the whole value:
975 ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
976 ;; or, use `ps-print-hook' (see section Hooks):
977 ;; (add-hook 'ps-print-hook
979 ;; (or (assq 'Helvetica ps-font-info-database)
980 ;; (setq ps-font-info-database (append ...)))))
982 ;; You can create new `mixed' font families like:
984 ;; (fonts (normal . "Courier-Bold")
985 ;; (bold . "Helvetica")
986 ;; (italic . "ZapfChancery-MediumItalic")
987 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
988 ;; (w3-table-hack-x-face . "LineDrawNormal"))
990 ;; (line-height . 10.55)
991 ;; (space-width . 6.0)
992 ;; (avg-char-width . 6.0))
994 ;; Now you can use your new font family with any size:
995 ;; (setq ps-font-family 'my-mixed-family)
997 ;; Note that on above example the `w3-table-hack-x-face' entry refers to a face
998 ;; symbol, so when printing this face it'll be used the font `LineDrawNormal'.
999 ;; If the face `w3-table-hack-x-face' is remapped to use bold and/or italic
1000 ;; attribute, the corresponding entry (bold, italic or bold-italic) will be
1001 ;; used instead of `w3-table-hack-x-face' entry.
1003 ;; Note also that the font family entry order is irrelevant, so the above
1004 ;; example could also be written:
1007 ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
1008 ;; (bold . "Helvetica")
1009 ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
1010 ;; (italic . "ZapfChancery-MediumItalic")
1011 ;; (normal . "Courier-Bold"))
1012 ;; (avg-char-width . 6.0)
1013 ;; (space-width . 6.0)
1014 ;; (line-height . 10.55))
1016 ;; Despite the note above, it is recommended that some convention about
1017 ;; entry order be used.
1019 ;; You can get information on all the fonts resident in YOUR printer
1020 ;; by uncommenting the line:
1021 ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
1023 ;; The PostScript file should be sent to YOUR PostScript printer.
1024 ;; If you send it to ghostscript or to another PostScript printer, you may get
1025 ;; slightly different results.
1026 ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
1028 ;; Note also that ps-print DOESN'T download any font to your printer, instead
1029 ;; it uses the fonts resident in your printer.
1032 ;; How Ps-Print Deals With Faces
1033 ;; -----------------------------
1035 ;; The ps-print-*-with-faces commands attempt to determine which faces should
1036 ;; be printed in bold or italic, but their guesses aren't always right. For
1037 ;; example, you might want to map colors into faces so that blue faces print in
1038 ;; bold, and red faces in italic.
1040 ;; It is possible to force ps-print to consider specific faces bold, italic or
1041 ;; underline, no matter what font they are displayed in, by setting the
1042 ;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
1043 ;; These variables contain lists of faces that ps-print should consider bold,
1044 ;; italic or underline; to set them, put code like the following into your
1047 ;; (setq ps-bold-faces '(my-blue-face))
1048 ;; (setq ps-italic-faces '(my-red-face))
1049 ;; (setq ps-underlined-faces '(my-green-face))
1051 ;; Faces like bold-italic that are both bold and italic should go in *both*
1054 ;; ps-print keeps internal lists of which fonts are bold and which are italic;
1055 ;; these lists are built the first time you invoke ps-print.
1056 ;; For the sake of efficiency, the lists are built only once; the same lists
1057 ;; are referred in later invocations of ps-print.
1059 ;; Because these lists are built only once, it's possible for them to get out
1060 ;; of sync, if a face changes, or if new faces are added. To get the lists
1061 ;; back in sync, you can set the variable `ps-build-face-reference' to t, and
1062 ;; the lists will be rebuilt the next time ps-print is invoked. If you need
1063 ;; that the lists always be rebuilt when ps-print is invoked, set the variable
1064 ;; `ps-always-build-face-reference' to t.
1066 ;; If you need to print without worrying about face background color, set the
1067 ;; variable `ps-use-face-background' which specifies if face background should
1068 ;; be used. Valid values are:
1070 ;; t always use face background color.
1071 ;; nil never use face background color.
1072 ;; (face...) list of faces whose background color will be used.
1074 ;; Any other value will be treated as t.
1075 ;; The default value is nil.
1078 ;; How Ps-Print Deals With Color
1079 ;; -----------------------------
1081 ;; ps-print detects faces with foreground and background colors defined and
1082 ;; embeds color information in the PostScript image.
1083 ;; The default foreground and background colors are defined by the variables
1084 ;; `ps-default-fg' and `ps-default-bg'.
1085 ;; On black/white printers, colors are displayed in gray scale.
1086 ;; To turn off color output, set `ps-print-color-p' to nil.
1087 ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
1088 ;; on black/white printers. See also `ps-black-white-faces' for documentation.
1090 ;; ps-print also detects if the text foreground and background colors are
1091 ;; equals when `ps-fg-validate-p' is non-nil. In this case, if these colors
1092 ;; are used, no text will appear. You can use `ps-fg-list' to give a list of
1093 ;; foreground colors to be used when text foreground and background colors are
1094 ;; equals. It'll be used the first foreground color in `ps-fg-list' which is
1095 ;; different from the background color. If `ps-fg-list' is nil, the default
1096 ;; foreground color is used.
1099 ;; How Ps-Print Maps Faces
1100 ;; -----------------------
1102 ;; As ps-print uses PostScript to print buffers, it is possible to have other
1103 ;; attributes associated with faces. So the new attributes used by ps-print
1106 ;; strikeout - like underline, but the line is in middle of text.
1107 ;; overline - like underline, but the line is over the text.
1108 ;; shadow - text will have a shadow.
1109 ;; box - text will be surrounded by a box.
1110 ;; outline - print characters as hollow outlines.
1112 ;; See the documentation for `ps-extend-face'.
1114 ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
1115 ;; color and bold attribute:
1117 ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
1119 ;; If you want to use a new face, define it first with `defface', and then call
1120 ;; `ps-extend-face' to specify how to print it.
1123 ;; How Ps-Print Has A Text And/Or Image On Background
1124 ;; --------------------------------------------------
1126 ;; ps-print can print texts and/or EPS PostScript images on background; it is
1127 ;; possible to define the following text attributes: font name, font size,
1128 ;; initial position, angle, gray scale and pages to print.
1130 ;; It has the following EPS PostScript images attributes: file name containing
1131 ;; the image, initial position, X and Y scales, angle and pages to print.
1133 ;; See documentation for `ps-print-background-text' and
1134 ;; `ps-print-background-image'.
1136 ;; For example, if we wish to print text "preliminary" on all pages and text
1137 ;; "special" on page 5 and from page 11 to page 17, we could specify:
1139 ;; (setq ps-print-background-text
1140 ;; '(("preliminary")
1142 ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
1143 ;; ; (upper left corner)
1145 ;; "PrintHeight neg PrintPageWidth atan" ; angle
1146 ;; 5 (11 . 17)) ; page list
1149 ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
1150 ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
1153 ;; (setq ps-print-background-image
1154 ;; '(("~/images/EPS-image1.ps"
1155 ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
1156 ;; ("~/images/EPS-image2.ps"
1157 ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y pos.
1158 ;; ; (upper left corner)
1160 ;; 5 (11 . 17)) ; page list
1163 ;; If it is not possible to read (or does not exist) an image file, that file
1166 ;; The printing order is:
1168 ;; 1. Print background color
1169 ;; 2. Print zebra stripes
1170 ;; 3. Print background texts that it should be on all pages
1171 ;; 4. Print background images that it should be on all pages
1172 ;; 5. Print background texts only for current page (if any)
1173 ;; 6. Print background images only for current page (if any)
1175 ;; 8. Print buffer text (with faces, if specified) and line number
1181 ;; Some tools are provided to help you customize your font setup.
1183 ;; `ps-setup' returns (some part of) the current setup.
1185 ;; To avoid wrapping too many lines, you may want to adjust the left and right
1186 ;; margins and the font size. On UN*X systems, do:
1187 ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
1188 ;; to determine the longest lines of your file.
1189 ;; Then, the command `ps-line-lengths' will give you the correspondence between
1190 ;; a line length (number of characters) and the maximum font size which doesn't
1191 ;; wrap such a line with the current ps-print setup.
1193 ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display the
1194 ;; correspondence between a number of pages and the maximum font size which
1195 ;; allow the number of lines of the current buffer or of its current region to
1196 ;; fit in this number of pages.
1198 ;; NOTE: line folding is not taken into account in this process and could
1199 ;; change the results.
1201 ;; The command `ps-print-customize' activates a customization buffer for
1202 ;; ps-print options.
1205 ;; New since version 1.5
1206 ;; ---------------------
1208 ;; Color output capability.
1209 ;; Automatic detection of font attributes (bold, italic).
1210 ;; Configurable headers with page numbers.
1212 ;; Support for different paper sizes.
1213 ;; Better conformance to PostScript Document Structure Conventions.
1216 ;; New since version 2.8
1217 ;; ---------------------
1219 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1222 ;; `ps-fg-validate-p', `ps-fg-list'
1225 ;; `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
1228 ;; `ps-time-stamp-locale-default'
1231 ;; Handle before-string and after-string overlay properties.
1234 ;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
1235 ;; `ps-print-footer-frame', `ps-footer-font-family',
1236 ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
1237 ;; `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
1238 ;; `ps-header-frame-alist'.
1241 ;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
1242 ;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
1245 ;; `ps-line-number-font', `ps-line-number-font-size' and
1246 ;; `ps-end-with-control-d'.
1249 ;; `ps-even-or-odd-pages'
1252 ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
1253 ;; `ps-selected-pages', `ps-last-selected-pages',
1254 ;; `ps-restore-selected-pages', `ps-switch-header',
1255 ;; `ps-line-number-step', `ps-line-number-start',
1256 ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
1259 ;; PostScript error handler.
1260 ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
1263 ;; `ps-print-customize'.
1266 ;; Better customization.
1267 ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
1271 ;; Hook: `ps-print-begin-sheet-hook'.
1273 ;; [kenichi] 1999-05-09 Ken'ichi Handa <handa@m17n.org>
1275 ;; `ps-print-region-function'
1277 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1280 ;; PostScript tumble and setpagedevice.
1283 ;; PostScript prologue header comment insertion.
1284 ;; Skip invisible text better.
1286 ;; [kenichi] 1998-08-19 Ken'ichi Handa <handa@m17n.org>
1288 ;; Multi-byte buffer handling.
1290 ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
1293 ;; Skip invisible text.
1296 ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
1297 ;; `ps-print-begin-column-hook'.
1298 ;; Put one header per page over the columns.
1299 ;; Better database font management.
1300 ;; Better control characters handling.
1303 ;; Dynamic evaluation at print time of `ps-lpr-switches'.
1304 ;; Handle control characters.
1306 ;; New face attributes.
1309 ;; Text and/or image on background.
1311 ;; [jack] 1996-05-17 Jacques Duthen <duthen@cegelec-red.fr>
1313 ;; Font family and float size for text and header.
1315 ;; Multiple columns.
1316 ;; Tools for page setup.
1319 ;; Known bugs and limitations of ps-print
1320 ;; --------------------------------------
1322 ;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
1323 ;; particular, bold or italic fonts don't print in the right background color.
1325 ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
1327 ;; Automatic font-attribute detection doesn't work well, especially with
1328 ;; hilit19 and older versions of get-create-face. Users having problems with
1329 ;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
1330 ;; and `ps-underlined-faces' and/or turn off automatic detection by setting
1331 ;; `ps-auto-font-detect' to nil.
1333 ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
1334 ;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
1335 ;; `ps-underlined-faces' instead.
1337 ;; Still too slow; could use some hand-optimization.
1339 ;; Default background color isn't working.
1341 ;; Faces are always treated as opaque.
1343 ;; Epoch, Lucid and Emacs 22 not supported. At all.
1345 ;; Fixed-pitch fonts work better for line folding, but are not required.
1347 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
1354 ;; Avoid page break inside a paragraph.
1356 ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
1358 ;; Improve the memory management for big files (hard?).
1360 ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
1367 ;; Thanks to Eduard Wiebe <usenet@pusto.de> for fixing face
1368 ;; background/foreground extraction.
1370 ;; Thanks to Friedrich Delgado Friedrichs <friedel@nomaden.org> for new label
1371 ;; printer page sizes.
1373 ;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
1374 ;; compliance of the generated PostScript.
1376 ;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
1377 ;; for black/white PostScript printers.
1379 ;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
1380 ;; region to cut out when printing and footer suggestions.
1382 ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
1384 ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
1387 ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
1388 ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
1390 ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
1391 ;; suggestion for `ps-postscript-code-directory' variable.
1393 ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
1394 ;; level 1 compatibility.
1396 ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for:
1397 ;; - upside-down, line number step, line number start and zebra stripe
1398 ;; follow suggestions.
1399 ;; - `ps-time-stamp-yyyy-mm-dd' and `ps-time-stamp-iso8601' suggestion.
1400 ;; - and for XEmacs beta-tests.
1402 ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
1403 ;; prologue code suggestion, for odd/even printing suggestion and for
1404 ;; `ps-prologue-file' enhancement.
1406 ;; Thanks to Ken'ichi Handa <handa@m17n.org> for multi-byte buffer handling.
1408 ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
1411 ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
1414 ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
1415 ;; `ps-print-control-characters' variable documentation.
1417 ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
1418 ;; database font management.
1420 ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
1421 ;; header per page over the columns and correct line numbers when printing a
1424 ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
1425 ;; print time of `ps-lpr-switches'.
1427 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
1428 ;; (his code was severely modified, but the main idea was kept).
1430 ;; Thanks to some suggestions on:
1431 ;; * Face color map: Marco Melgazzi <marco@techie.com>
1432 ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
1433 ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
1435 ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for version 3.4 I
1436 ;; started from. [vinicius]
1438 ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from. [jack]
1440 ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
1441 ;; the invisible property.
1443 ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the
1444 ;; initial port to Emacs 19. His code is no longer part of ps-print, but his
1445 ;; work is still appreciated.
1447 ;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
1448 ;; adding underline support. Their code also is no longer part of ps-print,
1449 ;; but their efforts are not forgotten.
1451 ;; Thanks also to all of you who mailed code to add features to ps-print;
1452 ;; although I didn't use your code, I still appreciate your sharing it with me.
1454 ;; Thanks to all who mailed comments, encouragement, and criticism.
1455 ;; Thanks also to all who responded to my survey; I had too many responses to
1456 ;; reply to them all, but I greatly appreciate your interest.
1459 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1467 (if (featurep 'xemacs
)
1468 (or (featurep 'lisp-float-type
)
1469 (error "`ps-print' requires floating point support"))
1470 (unless (and (boundp 'emacs-major-version
)
1471 (>= emacs-major-version
23))
1472 (error "`ps-print' only supports Emacs 23 and higher")))
1475 (defconst ps-windows-system
1476 (memq system-type
'(ms-dos windows-nt
)))
1477 (defconst ps-lp-system
1478 (memq system-type
'(usg-unix-v hpux irix
)))
1481 ;; Load XEmacs/Emacs definitions
1485 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1489 ;;; Interface to the command system
1491 (defgroup postscript nil
1492 "Support for printing and PostScript."
1497 (defgroup ps-print nil
1498 "PostScript generator for Emacs."
1499 :link
'(emacs-library-link :tag
"Source Lisp File" "ps-print.el")
1505 (defgroup ps-print-horizontal nil
1506 "Horizontal page layout."
1512 (defgroup ps-print-vertical nil
1513 "Vertical page layout."
1519 (defgroup ps-print-headers nil
1520 "Headers & footers layout."
1522 :tag
"Header & Footer"
1526 (defgroup ps-print-font nil
1527 "Fonts customization."
1533 (defgroup ps-print-color nil
1534 "Color customization."
1540 (defgroup ps-print-face nil
1541 "Faces customization."
1548 (defgroup ps-print-n-up nil
1549 "N-up customization."
1555 (defgroup ps-print-zebra nil
1556 "Zebra customization."
1562 (defgroup ps-print-background nil
1563 "Background customization."
1569 (defgroup ps-print-printer
'((lpr custom-group
))
1570 "Printer customization."
1576 (defgroup ps-print-page nil
1577 "Page customization."
1583 (defgroup ps-print-miscellany nil
1584 "Miscellany customization."
1591 (defcustom ps-error-handler-message
'paper
1592 "Specify where the error handler message should be sent.
1596 `none' catch the error and *DON'T* send any message.
1598 `paper' catch the error and print on paper the error message.
1600 `system' catch the error and send back the error message to
1601 printing system. This is useful only if printing system
1602 send back an email reporting the error, or if there is
1603 some other alternative way to report back the error from
1606 `paper-and-system' catch the error, print on paper the error message and
1607 send back the error message to printing system.
1609 Any other value is treated as `paper'."
1610 :type
'(choice :menu-tag
"Error Handler Message"
1611 :tag
"Error Handler Message"
1612 (const none
) (const paper
)
1613 (const system
) (const paper-and-system
))
1615 :group
'ps-print-miscellany
)
1617 (defcustom ps-user-defined-prologue nil
1618 "User defined PostScript prologue code inserted before all prologue code.
1620 `ps-user-defined-prologue' may be a string or a symbol function which returns a
1621 string. Note that this string is inserted after `ps-adobe-tag' and PostScript
1622 prologue comments, and before ps-print PostScript prologue code section. That
1623 is, this string is inserted after error handler initialization and before
1626 It's strongly recommended only insert PostScript code and/or comments specific
1627 for your printing system particularities. For example, some special
1628 initialization that only your printing system needs.
1630 Do not insert code for duplex printing, n-up printing or error handler,
1631 ps-print handles this in a suitable way.
1633 For more information about PostScript, see:
1634 PostScript Language Reference Manual (2nd edition)
1635 Adobe Systems Incorporated
1637 As an example for `ps-user-defined-prologue' setting:
1639 ;; Setting for HP PostScript printer
1640 (setq ps-user-defined-prologue
1641 (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
1642 \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
1643 :type
'(choice :menu-tag
"User Defined Prologue"
1644 :tag
"User Defined Prologue"
1645 (const :tag
"none" nil
) string symbol
)
1647 :group
'ps-print-miscellany
)
1649 (defcustom ps-print-prologue-header nil
1650 "PostScript prologue header comments besides that ps-print generates.
1652 `ps-print-prologue-header' may be a string or a symbol function which returns a
1653 string. Note that this string is inserted on PostScript prologue header
1654 section which is used to define some document characteristic through PostScript
1655 special comments, like \"%%Requirements: jog\\n\".
1657 ps-print always inserts the %%Requirements: comment, so if you need to insert
1658 more requirements put them first in `ps-print-prologue-header' using the
1659 \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1660 requirements and set %%LanguageLevel: to 2, do:
1662 (setq ps-print-prologue-header
1663 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1665 The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1667 Do not forget to terminate the string with \"\\n\".
1669 For more information about PostScript document comments, see:
1670 PostScript Language Reference Manual (2nd edition)
1671 Adobe Systems Incorporated
1672 Appendix G: Document Structuring Conventions -- Version 3.0"
1673 :type
'(choice :menu-tag
"Prologue Header"
1674 :tag
"Prologue Header"
1675 (const :tag
"none" nil
) string symbol
)
1677 :group
'ps-print-miscellany
)
1679 (defcustom ps-printer-name
(and (boundp 'printer-name
)
1680 (symbol-value 'printer-name
))
1681 "The name of a local printer for printing PostScript files.
1683 On Unix-like systems, a string value should be a name understood by lpr's -P
1684 option; a value of nil means use the value of `printer-name' instead.
1686 On MS-DOS and MS-Windows systems, a string value is taken as the name of the
1687 printer device or port to which PostScript files are written, provided
1688 `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
1689 non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
1690 \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
1691 for a shared network printer. You can also set it to a name of a file, in
1692 which case the output gets appended to that file. \(Note that `ps-print'
1693 package already has facilities for printing to a file, so you might as well use
1694 them instead of changing the setting of this variable.\) If you want to
1695 silently discard the printed output, set this to \"NUL\".
1697 Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
1699 Any other value is treated as t, that is, an empty printer name.
1701 See also `ps-printer-name-option' for documentation."
1702 :type
'(choice :menu-tag
"Printer Name"
1704 (const :tag
"Same as printer-name" nil
)
1705 (const :tag
"No Printer Name" t
)
1706 (file :tag
"Print to file")
1707 (string :tag
"Pipe to ps-lpr-command"))
1709 :group
'ps-print-printer
)
1711 (defcustom ps-printer-name-option
1712 (cond (ps-windows-system
1718 "Option for `ps-printer-name' variable (see it).
1720 On Unix-like systems, if `lpr' is in use, this should be the string
1721 \"-P\"; if `lp' is in use, this should be the string \"-d\".
1723 On MS-DOS and MS-Windows systems, if `print' is in use, this should be
1726 For any other printing utility, see its documentation.
1728 Set this to \"\" or nil, if the utility given by `ps-lpr-command'
1729 needs an empty printer name option--that is, pass the printer name
1730 with no special option preceding it.
1732 Any value that is not a string is treated as nil.
1734 This variable is used only when `ps-printer-name' is a non-empty string."
1735 :type
'(choice :menu-tag
"Printer Name Option"
1736 :tag
"Printer Name Option"
1737 (const :tag
"None" nil
)
1738 (string :tag
"Option"))
1740 :group
'ps-print-printer
)
1742 (defcustom ps-lpr-command lpr-command
1743 "Name of program for printing a PostScript file.
1745 On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
1746 will write directly to the printer port named by `ps-printer-name'. The
1747 programs `print' and `nprint' (the standard print programs on Windows NT and
1748 Novell Netware respectively) are handled specially, using `ps-printer-name' as
1749 the destination for output; any other program is treated like `lpr' except that
1750 an explicit filename is given as the last argument."
1753 :group
'ps-print-printer
)
1755 (defcustom ps-lpr-switches lpr-switches
1756 "List of extra switches to pass to `ps-lpr-command'.
1758 The list element can be:
1760 string it should be an option for `ps-lpr-command' (which see).
1761 For example: \"-o Duplex=DuplexNoTumble\"
1763 symbol it can be a function or variable symbol. If it's a function
1764 symbol, it should be a function with no argument. The result
1765 of the function or the variable value should be a string or a
1768 list the header should be a symbol function and the tail is the
1769 arguments for this function. This function should return a
1770 string or a list of strings.
1772 Any other value is silently ignored.
1774 It is recommended to set `ps-printer-name' (which see) instead of including an
1775 explicit switch on this list.
1777 See `ps-lpr-command'."
1778 :type
'(repeat :tag
"PostScript lpr Switches"
1779 (choice :menu-tag
"PostScript lpr Switch"
1780 :tag
"PostScript lpr Switch"
1781 string symbol
(repeat sexp
)))
1783 :group
'ps-print-printer
)
1785 (defcustom ps-print-region-function nil
1786 "Specify a function to print the region on a PostScript printer.
1787 See definition of `call-process-region' for calling conventions. The fourth
1788 and the sixth arguments are both nil."
1789 :type
'(choice (const nil
) function
)
1791 :group
'ps-print-printer
)
1793 (defcustom ps-manual-feed nil
1794 "Non-nil means the printer will manually feed paper.
1796 If it's nil, automatic feeding takes place."
1799 :group
'ps-print-printer
)
1801 (defcustom ps-end-with-control-d
(and ps-windows-system t
)
1802 "Non-nil means insert C-d at end of PostScript file generated."
1806 :group
'ps-print-printer
)
1810 ;; All page dimensions are in PostScript points.
1811 ;; 1 inch == 2.54 cm == 72 points
1812 ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
1814 ;; Letter 8.5 inch x 11.0 inch
1815 ;; Legal 8.5 inch x 14.0 inch
1816 ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
1818 ;; LetterSmall 7.68 inch x 10.16 inch
1819 ;; Tabloid 11.0 inch x 17.0 inch
1820 ;; Ledger 17.0 inch x 11.0 inch
1821 ;; Statement 5.5 inch x 8.5 inch
1822 ;; Executive 7.5 inch x 10.0 inch
1823 ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
1824 ;; A4Small 7.47 inch x 10.85 inch
1825 ;; B4 10.125 inch x 14.33 inch
1826 ;; B5 7.16 inch x 10.125 inch
1829 (defcustom ps-page-dimensions-database
1831 (list (list 'a4
(/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
1832 (list 'a3
(/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
1833 (list 'letter
(* 72 8.5) (* 72 11.0) "Letter")
1834 (list 'legal
(* 72 8.5) (* 72 14.0) "Legal")
1835 (list 'letter-small
(* 72 7.68) (* 72 10.16) "LetterSmall")
1836 (list 'tabloid
(* 72 11.0) (* 72 17.0) "Tabloid")
1837 (list 'ledger
(* 72 17.0) (* 72 11.0) "Ledger")
1838 (list 'statement
(* 72 5.5) (* 72 8.5) "Statement")
1839 (list 'executive
(* 72 7.5) (* 72 10.0) "Executive")
1840 (list 'a4small
(* 72 7.47) (* 72 10.85) "A4Small")
1841 (list 'b4
(* 72 10.125) (* 72 14.33) "B4")
1842 (list 'b5
(* 72 7.16) (* 72 10.125) "B5")
1843 ;; page sizes for label printer
1844 ;; NOTE: the page sizes below don't have n-up > 1.
1845 '(addresslarge 236.0 99.0 "AddressLarge")
1846 '(addresssmall 236.0 68.0 "AddressSmall")
1847 '(cuthanging13 90.0 222.0 "CutHanging13")
1848 '(cuthanging15 90.0 114.0 "CutHanging15")
1849 '(diskette 181.0 136.0 "Diskette")
1850 '(eurofilefolder 139.0 112.0 "EuropeanFilefolder")
1851 '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow")
1852 '(eurofolderwide 526.0 136.0 "EuroFolderWide")
1853 '(euronamebadge 189.0 108.0 "EuroNameBadge")
1854 '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge")
1855 '(filefolder 230.0 37.0 "FileFolder")
1856 '(jewelry 76.0 136.0 "Jewelry")
1857 '(mediabadge 180.0 136.0 "MediaBadge")
1858 '(multipurpose 126.0 68.0 "MultiPurpose")
1859 '(retaillabel 90.0 104.0 "RetailLabel")
1860 '(shipping 271.0 136.0 "Shipping")
1861 '(slide35mm 26.0 104.0 "Slide35mm")
1862 '(spine8mm 187.0 26.0 "Spine8mm")
1863 '(topcoated 425.19685 136.0 "TopCoatedPaper")
1864 '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150")
1865 '(vhsface 205.0 127.0 "VHSFace")
1866 '(vhsspine 400.0 50.0 "VHSSpine")
1867 '(zipdisk 156.0 136.0 "ZipDisk")))
1868 "List associating a symbolic paper type to its width, height and doc media.
1869 See `ps-paper-type'."
1870 :type
'(repeat (list :tag
"Paper Type"
1871 (symbol :tag
"Symbol Name")
1872 (number :tag
"Width in points")
1873 (number :tag
"Height in points")
1874 (string :tag
"Media")))
1876 :group
'ps-print-page
)
1879 (defcustom ps-paper-type
'letter
1880 "Specify the size of paper to format for.
1881 Should be one of the paper types defined in `ps-page-dimensions-database', for
1882 example `letter', `legal' or `a4'."
1883 :type
'(symbol :validate
(lambda (wid)
1884 (if (assq (widget-value wid
)
1885 ps-page-dimensions-database
)
1887 (widget-put wid
:error
"Unknown paper size")
1890 :group
'ps-print-page
)
1892 (defcustom ps-warn-paper-type t
1893 "Non-nil means give an error if paper size is not equal to `ps-paper-type'.
1895 It's used when `ps-spool-config' is set to `setpagedevice'."
1898 :group
'ps-print-page
)
1900 (defcustom ps-landscape-mode nil
1901 "Non-nil means print in landscape mode."
1904 :group
'ps-print-page
)
1906 (defcustom ps-print-upside-down nil
1907 "Non-nil means print upside-down (that is, rotated by 180 degrees)."
1910 :group
'ps-print-page
)
1912 (defcustom ps-selected-pages nil
1913 "Specify which pages to print.
1915 If nil, print all pages.
1917 If a list, the lists element may be an integer or a cons cell (FROM . TO)
1918 designating FROM page to TO page; any invalid element is ignored, that is, an
1919 integer lesser than one or if FROM is greater than TO.
1921 Otherwise, it's treated as nil.
1923 After ps-print processing `ps-selected-pages' is set to nil. But the
1924 latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
1925 see). So you can restore the latest selected pages by using
1926 `ps-last-selected-pages' or with the `ps-restore-selected-pages'
1927 command (which see).
1929 See also `ps-even-or-odd-pages'."
1930 :type
'(repeat :tag
"Selected Pages"
1932 (integer :tag
"Number")
1934 (integer :tag
"From")
1935 (integer :tag
"To"))))
1937 :group
'ps-print-page
)
1939 (defcustom ps-even-or-odd-pages nil
1940 "Specify if it prints even/odd pages.
1944 nil print all pages.
1946 `even-page' print only even pages.
1948 `odd-page' print only odd pages.
1950 `even-sheet' print only even sheets.
1951 That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
1952 but for values greater than 1, it'll print only the even sheet
1955 `odd-sheet' print only odd sheets.
1956 That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
1957 but for values greater than 1, it'll print only the odd sheet
1960 Any other value is treated as nil.
1962 If you set `ps-selected-pages' (see it for documentation), first the pages are
1963 filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
1964 example, if we have:
1966 (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
1968 Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
1970 `ps-n-up-printing' = 1:
1971 `ps-even-or-odd-pages' PAGES PRINTED
1972 nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
1973 even-page 4, 6, 8, 10, 12, 14, 16, 20
1974 odd-page 1, 7, 9, 13, 15
1975 even-sheet 4, 6, 8, 10, 12, 14, 16, 20
1976 odd-sheet 1, 7, 9, 13, 15
1978 `ps-n-up-printing' = 2:
1979 `ps-even-or-odd-pages' PAGES PRINTED
1980 nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
1981 even-page 4/6, 8/10, 12/14, 16/20
1982 odd-page 1/7, 9/13, 15
1983 even-sheet 6/7, 10/12, 15/16
1984 odd-sheet 1/4, 8/9, 13/14, 20
1986 So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
1988 :type
'(choice :menu-tag
"Print Even/Odd Pages"
1989 :tag
"Print Even/Odd Pages"
1990 (const :tag
"All Pages" nil
)
1991 (const :tag
"Only Even Pages" even-page
)
1992 (const :tag
"Only Odd Pages" odd-page
)
1993 (const :tag
"Only Even Sheets" even-sheet
)
1994 (const :tag
"Only Odd Sheets" odd-sheet
))
1996 :group
'ps-print-page
)
1998 (defcustom ps-print-control-characters
'control-8-bit
1999 "Specify the printable form for control and 8-bit characters.
2000 That is, instead of sending, for example, a ^D (\\004) to printer,
2001 it is sent the string \"^D\".
2005 `8-bit' This is the value to use when you want an ASCII encoding of
2006 any control or non-ASCII character. Control characters are
2007 encoded as \"^D\", and non-ASCII characters have an
2010 `control-8-bit' This is the value to use when you want an ASCII encoding of
2011 any control character, whether it is 7 or 8-bit.
2012 European 8-bits accented characters are printed according
2015 `control' Only ASCII control characters have an ASCII encoding.
2016 European 8-bits accented characters are printed according
2019 nil No ASCII encoding. Any character is printed according the
2022 Any other value is treated as nil."
2023 :type
'(choice :menu-tag
"Control Char"
2025 (const 8-bit
) (const control-8-bit
)
2026 (const control
) (const :tag
"nil" nil
))
2028 :group
'ps-print-miscellany
)
2030 (defcustom ps-n-up-printing
1
2031 "Specify the number of pages per sheet paper."
2033 :tag
"N Up Printing"
2036 (if (and (< 0 (widget-value wid
))
2037 (<= (widget-value wid
) 100))
2041 "Number of pages per sheet paper must be between 1 and 100.")
2044 :group
'ps-print-n-up
)
2046 (defcustom ps-n-up-margin
(/ (* 72 1.0) 2.54) ; 1 cm
2047 "Specify the margin in points between the sheet border and n-up printing."
2050 :group
'ps-print-n-up
)
2052 (defcustom ps-n-up-border-p t
2053 "Non-nil means a border is drawn around each page."
2056 :group
'ps-print-n-up
)
2058 (defcustom ps-n-up-filling
'left-top
2059 "Specify how page matrix is filled on each sheet of paper.
2061 Following are the valid values for `ps-n-up-filling' with a filling example
2062 using a 3x4 page matrix:
2064 `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
2068 `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
2072 `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
2076 `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
2080 Any other value is treated as `left-top'."
2081 :type
'(choice :menu-tag
"N-Up Filling"
2083 (const left-top
) (const left-bottom
)
2084 (const right-top
) (const right-bottom
)
2085 (const top-left
) (const bottom-left
)
2086 (const top-right
) (const bottom-right
))
2088 :group
'ps-print-n-up
)
2090 (defcustom ps-number-of-columns
(if ps-landscape-mode
2 1)
2091 "Specify the number of columns."
2094 :group
'ps-print-miscellany
)
2096 (defcustom ps-zebra-stripes nil
2097 "Non-nil means print zebra stripes.
2098 See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
2101 :group
'ps-print-zebra
)
2103 (defcustom ps-zebra-stripe-height
3
2104 "Number of zebra stripe lines.
2105 See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
2108 :group
'ps-print-zebra
)
2110 (defcustom ps-zebra-color
0.95
2111 "Zebra stripe gray scale or RGB color.
2112 See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
2113 :type
'(choice :menu-tag
"Zebra Gray/Color"
2114 :tag
"Zebra Gray/Color"
2115 (number :tag
"Gray Scale" :value
0.95)
2116 (string :tag
"Color Name" :value
"gray95")
2117 (list :tag
"RGB Color" :value
(0.95
0.95 0.95)
2119 (number :tag
"Green")
2120 (number :tag
"Blue")))
2122 :group
'ps-print-zebra
)
2124 (defcustom ps-zebra-stripe-follow nil
2125 "Specify how zebra stripes continue on next page.
2127 Visually, valid values are (the character `+' at right of each column indicates
2128 that a line is printed):
2130 `nil' `follow' `full' `full-follow'
2131 Current Page -------- ----------- --------- ----------------
2132 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
2133 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
2134 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
2138 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
2139 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
2140 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
2143 -------- ----------- --------- ----------------
2144 Next Page -------- ----------- --------- ----------------
2145 12 XXXXX + 12 + 10 XXXXXX + 10 +
2146 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
2147 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
2148 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
2149 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
2150 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
2151 18 XXXXX + 18 + 16 XXXXXX + 16 +
2152 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
2153 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
2156 -------- ----------- --------- ----------------
2158 Any other value is treated as nil."
2159 :type
'(choice :menu-tag
"Zebra Stripe Follow"
2160 :tag
"Zebra Stripe Follow"
2161 (const :tag
"Always Restart" nil
)
2162 (const :tag
"Continue on Next Page" follow
)
2163 (const :tag
"Print Only Full Stripe" full
)
2164 (const :tag
"Continue on Full Stripe" full-follow
))
2166 :group
'ps-print-zebra
)
2168 (defcustom ps-line-number nil
2169 "Non-nil means print line number."
2172 :group
'ps-print-miscellany
)
2174 (defcustom ps-line-number-step
1
2175 "Specify the interval that line number is printed.
2177 For example, `ps-line-number-step' is set to 2, the printing will look like:
2189 integer an integer that specifies the interval that line number is
2190 printed. If it's lesser than or equal to zero, it's used the
2193 `zebra' specifies that only the line number of the first line in a
2194 zebra stripe is to be printed.
2196 Any other value is treated as `zebra'."
2197 :type
'(choice :menu-tag
"Line Number Step"
2198 :tag
"Line Number Step"
2199 (integer :tag
"Step Interval")
2200 (const :tag
"Synchronize Zebra" zebra
))
2202 :group
'ps-print-miscellany
)
2204 (defcustom ps-line-number-start
1
2205 "Specify the starting point in the interval given by `ps-line-number-step'.
2207 For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
2208 set to 3, the printing will look like:
2222 The values for `ps-line-number-start':
2224 * If `ps-line-number-step' is an integer, must be between 1 and the value of
2225 `ps-line-number-step' inclusive.
2227 * If `ps-line-number-step' is set to `zebra', must be between 1 and the
2228 value of `ps-zebra-strip-height' inclusive. Use this combination if you
2229 wish that line number be relative to zebra stripes."
2230 :type
'(integer :tag
"Start Step Interval")
2232 :group
'ps-print-miscellany
)
2234 (defcustom ps-print-background-image nil
2235 "EPS image list to be printed on background.
2239 (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
2241 FILENAME is a file name which contains an EPS image or some PostScript
2242 programming like EPS.
2243 FILENAME is ignored, if it doesn't exist or is read protected.
2245 X and Y are relative positions on paper to put the image.
2246 If X and Y are nil, the image is centered on paper.
2248 XSCALE and YSCALE are scale factor to be applied to image before printing.
2249 If XSCALE and YSCALE are nil, the original size is used.
2251 ROTATION is the image rotation angle; if nil, the default is 0.
2253 PAGES designates the page to print background image.
2254 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2256 If PAGES is nil, print background image on all pages.
2258 X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
2259 number or a string. If it is a string, the string should contain PostScript
2260 programming that returns a float or integer value.
2262 For example, if you wish to print an EPS image on all pages do:
2264 '((\"~/images/EPS-image.ps\"))"
2267 (file :tag
"EPS File")
2268 (choice :tag
"X" (const :tag
"default" nil
) number string
)
2269 (choice :tag
"Y" (const :tag
"default" nil
) number string
)
2270 (choice :tag
"X Scale" (const :tag
"default" nil
) number string
)
2271 (choice :tag
"Y Scale" (const :tag
"default" nil
) number string
)
2272 (choice :tag
"Rotation" (const :tag
"default" nil
) number string
)
2273 (repeat :tag
"Pages" :inline t
2274 (radio (integer :tag
"Page")
2276 (integer :tag
"From")
2277 (integer :tag
"To"))))))
2279 :group
'ps-print-background
)
2281 (defcustom ps-print-background-text nil
2282 "Text list to be printed on background.
2286 (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
2288 STRING is the text to be printed on background.
2290 X and Y are positions on paper to put the text.
2291 If X and Y are nil, the text is positioned at lower left corner.
2293 FONT is a font name to be used on printing the text.
2294 If nil, \"Times-Roman\" is used.
2296 FONTSIZE is font size to be used, if nil, 200 is used.
2298 GRAY is the text gray factor (should be very light like 0.8).
2299 If nil, the default is 0.85.
2301 ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
2302 from lower left corner to upper right corner.
2304 PAGES designates the page to print background text.
2305 PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
2307 If PAGES is nil, print background text on all pages.
2309 X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
2310 number or a string. If it is a string, the string should contain PostScript
2311 programming that returns a float or integer value.
2313 For example, if you wish to print text \"Preliminary\" on all pages do:
2315 '((\"Preliminary\"))"
2318 (string :tag
"Text")
2319 (choice :tag
"X" (const :tag
"default" nil
) number string
)
2320 (choice :tag
"Y" (const :tag
"default" nil
) number string
)
2321 (choice :tag
"Font" (const :tag
"default" nil
) string
)
2322 (choice :tag
"Fontsize" (const :tag
"default" nil
) number string
)
2323 (choice :tag
"Gray" (const :tag
"default" nil
) number string
)
2324 (choice :tag
"Rotation" (const :tag
"default" nil
) number string
)
2325 (repeat :tag
"Pages" :inline t
2326 (radio (integer :tag
"Page")
2328 (integer :tag
"From")
2329 (integer :tag
"To"))))))
2331 :group
'ps-print-background
)
2333 ;;; Horizontal layout
2335 ;; ------------------------------------------
2337 ;; | lm | text | ic | text | ic | text | rm |
2339 ;; ------------------------------------------
2341 (defcustom ps-left-margin
(/ (* 72 2.0) 2.54) ; 2 cm
2342 "Left margin in points (1/72 inch)."
2345 :group
'ps-print-horizontal
)
2347 (defcustom ps-right-margin
(/ (* 72 2.0) 2.54) ; 2 cm
2348 "Right margin in points (1/72 inch)."
2351 :group
'ps-print-horizontal
)
2353 (defcustom ps-inter-column
(/ (* 72 2.0) 2.54) ; 2 cm
2354 "Horizontal space between columns in points (1/72 inch)."
2357 :group
'ps-print-horizontal
)
2373 (defcustom ps-bottom-margin
(/ (* 72 1.5) 2.54) ; 1.5 cm
2374 "Bottom margin in points (1/72 inch)."
2377 :group
'ps-print-vertical
)
2379 (defcustom ps-top-margin
(/ (* 72 1.5) 2.54) ; 1.5 cm
2380 "Top margin in points (1/72 inch)."
2383 :group
'ps-print-vertical
)
2385 (defcustom ps-header-offset
(/ (* 72 1.0) 2.54) ; 1.0 cm
2386 "Vertical space in points (1/72 inch) between the main text and the header."
2389 :group
'ps-print-vertical
)
2391 (defcustom ps-header-line-pad
0.15
2392 "Portion of a header title line height to insert.
2393 The insertion is done between the header frame and the text it contains,
2394 both in the vertical and horizontal directions."
2397 :group
'ps-print-vertical
)
2399 (defcustom ps-footer-offset
(/ (* 72 1.0) 2.54) ; 1.0 cm
2400 "Vertical space in points (1/72 inch) between the main text and the footer."
2403 :group
'ps-print-vertical
)
2405 (defcustom ps-footer-line-pad
0.15
2406 "Portion of a footer title line height to insert.
2407 The insertion is done between the footer frame and the text it contains,
2408 both in the vertical and horizontal directions."
2411 :group
'ps-print-vertical
)
2413 ;;; Header/Footer setup
2415 (defcustom ps-print-header t
2416 "Non-nil means print a header at the top of each page.
2417 By default, the header displays the buffer name, page number, and, if the
2418 buffer is visiting a file, the file's directory. Headers are customizable by
2419 changing variables `ps-left-header' and `ps-right-header'."
2422 :group
'ps-print-headers
)
2424 (defcustom ps-print-header-frame t
2425 "Non-nil means draw a gaudy frame around the header."
2428 :group
'ps-print-headers
)
2430 (defcustom ps-header-frame-alist
2431 '((fore-color .
0.0)
2433 (border-width .
0.4)
2434 (border-color .
0.0)
2435 (shadow-color .
0.0))
2436 "Specify header frame properties alist.
2438 Valid frame properties are:
2440 `fore-color' Specify the foreground frame color.
2441 It should be a float number between 0.0 (black color)
2442 and 1.0 (white color), a string which is a color name,
2443 or a list of 3 float numbers which corresponds to the
2444 Red Green Blue color scale, each float number between
2445 0.0 (dark color) and 1.0 (bright color).
2447 `back-color' Specify the background frame color (similar to
2450 `shadow-color' Specify the shadow color (similar to `fore-color').
2452 `border-color' Specify the border color (similar to `fore-color').
2454 `border-width' Specify the border width.
2456 Any other property is ignored.
2458 Don't change this alist directly, instead use customization, or `ps-value',
2459 `ps-get', `ps-put' and `ps-del' functions (see them for documentation)."
2462 (choice :menu-tag
"Header Frame Element"
2464 (cons :tag
"Foreground Color" :format
"%v"
2465 (const :format
"" fore-color
)
2466 (choice :menu-tag
"Foreground Color"
2467 :tag
"Foreground Color"
2468 (number :tag
"Gray Scale" :value
0.0)
2469 (string :tag
"Color Name" :value
"black")
2470 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2472 (number :tag
"Green")
2473 (number :tag
"Blue"))))
2474 (cons :tag
"Background Color" :format
"%v"
2475 (const :format
"" back-color
)
2476 (choice :menu-tag
"Background Color"
2477 :tag
"Background Color"
2478 (number :tag
"Gray Scale" :value
0.9)
2479 (string :tag
"Color Name" :value
"gray90")
2480 (list :tag
"RGB Color" :value
(0.9
0.9 0.9)
2482 (number :tag
"Green")
2483 (number :tag
"Blue"))))
2484 (cons :tag
"Border Width" :format
"%v"
2485 (const :format
"" border-width
)
2486 (number :tag
"Border Width" :value
0.4))
2487 (cons :tag
"Border Color" :format
"%v"
2488 (const :format
"" border-color
)
2489 (choice :menu-tag
"Border Color"
2491 (number :tag
"Gray Scale" :value
0.0)
2492 (string :tag
"Color Name" :value
"black")
2493 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2495 (number :tag
"Green")
2496 (number :tag
"Blue"))))
2497 (cons :tag
"Shadow Color" :format
"%v"
2498 (const :format
"" shadow-color
)
2499 (choice :menu-tag
"Shadow Color"
2501 (number :tag
"Gray Scale" :value
0.0)
2502 (string :tag
"Color Name" :value
"black")
2503 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2505 (number :tag
"Green")
2506 (number :tag
"Blue"))))))
2508 :group
'ps-print-headers
)
2510 (defcustom ps-header-lines
2
2511 "Number of lines to display in page header, when generating PostScript."
2514 :group
'ps-print-headers
)
2516 (defcustom ps-print-footer nil
2517 "Non-nil means print a footer at the bottom of each page.
2518 By default, the footer displays page number.
2519 Footers are customizable by changing variables `ps-left-footer' and
2523 :group
'ps-print-headers
)
2525 (defcustom ps-print-footer-frame t
2526 "Non-nil means draw a gaudy frame around the footer."
2529 :group
'ps-print-headers
)
2531 (defcustom ps-footer-frame-alist
2532 '((fore-color .
0.0)
2534 (border-width .
0.4)
2535 (border-color .
0.0)
2536 (shadow-color .
0.0))
2537 "Specify footer frame properties alist.
2539 Don't change this alist directly, instead use customization, or `ps-value',
2540 `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
2542 See also `ps-header-frame-alist' for documentation."
2544 (choice :menu-tag
"Header Frame Element"
2546 (cons :tag
"Foreground Color" :format
"%v"
2547 (const :format
"" fore-color
)
2548 (choice :menu-tag
"Foreground Color"
2549 :tag
"Foreground Color"
2550 (number :tag
"Gray Scale" :value
0.0)
2551 (string :tag
"Color Name" :value
"black")
2552 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2554 (number :tag
"Green")
2555 (number :tag
"Blue"))))
2556 (cons :tag
"Background Color" :format
"%v"
2557 (const :format
"" back-color
)
2558 (choice :menu-tag
"Background Color"
2559 :tag
"Background Color"
2560 (number :tag
"Gray Scale" :value
0.9)
2561 (string :tag
"Color Name" :value
"gray90")
2562 (list :tag
"RGB Color" :value
(0.9
0.9 0.9)
2564 (number :tag
"Green")
2565 (number :tag
"Blue"))))
2566 (cons :tag
"Border Width" :format
"%v"
2567 (const :format
"" border-width
)
2568 (number :tag
"Border Width" :value
0.4))
2569 (cons :tag
"Border Color" :format
"%v"
2570 (const :format
"" border-color
)
2571 (choice :menu-tag
"Border Color"
2573 (number :tag
"Gray Scale" :value
0.0)
2574 (string :tag
"Color Name" :value
"black")
2575 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2577 (number :tag
"Green")
2578 (number :tag
"Blue"))))
2579 (cons :tag
"Shadow Color" :format
"%v"
2580 (const :format
"" shadow-color
)
2581 (choice :menu-tag
"Shadow Color"
2583 (number :tag
"Gray Scale" :value
0.0)
2584 (string :tag
"Color Name" :value
"black")
2585 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
2587 (number :tag
"Green")
2588 (number :tag
"Blue"))))))
2590 :group
'ps-print-headers
)
2592 (defcustom ps-footer-lines
2
2593 "Number of lines to display in page footer, when generating PostScript."
2596 :group
'ps-print-headers
)
2598 (defcustom ps-print-only-one-header nil
2599 "Non-nil means print only one header/footer at the top/bottom of each page.
2600 This is useful when printing more than one column, so it is possible to have
2601 only one header/footer over all columns or one header/footer per column.
2602 See also `ps-print-header' and `ps-print-footer'."
2605 :group
'ps-print-headers
)
2607 (defcustom ps-switch-header
'duplex
2608 "Specify if headers/footers are switched or not.
2612 nil Never switch headers/footers.
2614 t Always switch headers/footers.
2616 duplex Switch headers/footers only when duplexing is on, that is, when
2617 `ps-spool-duplex' is non-nil.
2619 Any other value is treated as t.
2621 See also `ps-print-header' and `ps-print-footer'."
2622 :type
'(choice :menu-tag
"Switch Header/Footer"
2623 :tag
"Switch Header/Footer"
2624 (const :tag
"Never Switch" nil
)
2625 (const :tag
"Always Switch" t
)
2626 (const :tag
"Switch When Duplexing" duplex
))
2628 :group
'ps-print-headers
)
2630 (defcustom ps-show-n-of-n t
2631 "Non-nil means show page numbers as N/M, meaning page N of M.
2632 NOTE: page numbers are displayed as part of headers,
2633 see variable `ps-print-header'."
2636 :group
'ps-print-headers
)
2638 (defcustom ps-spool-config
2639 (if ps-windows-system
2642 "Specify who is responsible for setting duplex and page size.
2646 `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
2647 Don't forget to set `ps-lpr-switches' to select duplex
2648 printing for your printer.
2650 `setpagedevice' duplex and page size are configured by ps-print using the
2651 setpagedevice PostScript operator.
2653 nil duplex and page size are configured by ps-print *not* using
2654 the setpagedevice PostScript operator.
2656 Any other value is treated as nil.
2658 WARNING: The setpagedevice PostScript operator affects ghostview utility when
2659 viewing file generated using landscape. Also on some printers,
2660 setpagedevice affects zebra stripes; on other printers, setpagedevice
2661 affects the left margin.
2662 Besides all that, if your printer does not have the paper size
2663 specified by setpagedevice, your printing will be aborted.
2664 So, if you need to use setpagedevice, set `ps-spool-config' to
2665 `setpagedevice', generate a test file and send it to your printer; if
2666 the printed file isn't OK, set `ps-spool-config' to nil."
2667 :type
'(choice :menu-tag
"Spool Config"
2669 (const lpr-switches
) (const setpagedevice
)
2670 (const :tag
"nil" nil
))
2672 :group
'ps-print-headers
)
2674 (defcustom ps-spool-duplex nil
; Not many people have duplex printers,
2675 ; so default to nil.
2676 "Non-nil generates PostScript for a two-sided printer.
2677 For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
2678 blank pages as needed between print jobs so that the next buffer printed will
2679 start on the right page. Also, if headers are turned on, the headers will be
2680 reversed on duplex printers so that the page numbers fall to the left on
2681 even-numbered pages.
2683 See also `ps-spool-tumble'."
2686 :group
'ps-print-headers
)
2688 (defcustom ps-spool-tumble nil
2689 "Specify how the page images on opposite sides of a sheet are oriented.
2690 If `ps-spool-tumble' is nil, produces output suitable for binding on the left
2691 or right. If `ps-spool-tumble' is non-nil, produces output suitable for
2692 binding at the top or bottom.
2694 It has effect only when `ps-spool-duplex' is non-nil."
2697 :group
'ps-print-headers
)
2701 (defcustom ps-font-info-database
2702 '((Courier ; the family key
2703 (fonts (normal .
"Courier")
2704 (bold .
"Courier-Bold")
2705 (italic .
"Courier-Oblique")
2706 (bold-italic .
"Courier-BoldOblique"))
2708 (line-height .
10.55)
2710 (avg-char-width .
6.0))
2711 (Helvetica ; the family key
2712 (fonts (normal .
"Helvetica")
2713 (bold .
"Helvetica-Bold")
2714 (italic .
"Helvetica-Oblique")
2715 (bold-italic .
"Helvetica-BoldOblique"))
2717 (line-height .
11.56)
2718 (space-width .
2.78)
2719 (avg-char-width .
5.09243))
2721 (fonts (normal .
"Times-Roman")
2722 (bold .
"Times-Bold")
2723 (italic .
"Times-Italic")
2724 (bold-italic .
"Times-BoldItalic"))
2726 (line-height .
11.0)
2728 (avg-char-width .
4.71432))
2730 (fonts (normal .
"Palatino-Roman")
2731 (bold .
"Palatino-Bold")
2732 (italic .
"Palatino-Italic")
2733 (bold-italic .
"Palatino-BoldItalic"))
2735 (line-height .
12.1)
2737 (avg-char-width .
5.08676))
2739 (fonts (normal .
"Helvetica-Narrow")
2740 (bold .
"Helvetica-Narrow-Bold")
2741 (italic .
"Helvetica-Narrow-Oblique")
2742 (bold-italic .
"Helvetica-Narrow-BoldOblique"))
2744 (line-height .
11.56)
2745 (space-width .
2.2796)
2746 (avg-char-width .
4.17579))
2748 (fonts (normal .
"NewCenturySchlbk-Roman")
2749 (bold .
"NewCenturySchlbk-Bold")
2750 (italic .
"NewCenturySchlbk-Italic")
2751 (bold-italic .
"NewCenturySchlbk-BoldItalic"))
2753 (line-height .
12.15)
2754 (space-width .
2.78)
2755 (avg-char-width .
5.31162))
2756 ;; got no bold for the next ones
2758 (fonts (normal .
"AvantGarde-Book")
2759 (italic .
"AvantGarde-BookOblique"))
2761 (line-height .
11.77)
2762 (space-width .
2.77)
2763 (avg-char-width .
5.45189))
2765 (fonts (normal .
"AvantGarde-Demi")
2766 (italic .
"AvantGarde-DemiOblique"))
2768 (line-height .
12.72)
2770 (avg-char-width .
5.51351))
2772 (fonts (normal .
"Bookman-Demi")
2773 (italic .
"Bookman-DemiItalic"))
2775 (line-height .
11.77)
2777 (avg-char-width .
6.05946))
2779 (fonts (normal .
"Bookman-Light")
2780 (italic .
"Bookman-LightItalic"))
2782 (line-height .
11.79)
2784 (avg-char-width .
5.67027))
2785 ;; got no bold and no italic for the next ones
2787 (fonts (normal .
"Symbol"))
2789 (line-height .
13.03)
2791 (avg-char-width .
3.24324))
2793 (fonts (normal .
"Zapf-Dingbats"))
2795 (line-height .
9.63)
2796 (space-width .
2.78)
2797 (avg-char-width .
2.78))
2798 (ZapfChancery-MediumItalic
2799 (fonts (normal .
"ZapfChancery-MediumItalic"))
2801 (line-height .
11.45)
2803 (avg-char-width .
4.10811))
2804 ;; We keep this wrong entry name (but with correct font name) for
2805 ;; backward compatibility.
2806 (Zapf-Chancery-MediumItalic
2807 (fonts (normal .
"ZapfChancery-MediumItalic"))
2809 (line-height .
11.45)
2811 (avg-char-width .
4.10811))
2813 "Font info database.
2814 Each element comprises: font family (the key), name, bold, italic, bold-italic,
2815 reference size, line height, space width, average character width.
2816 To get the info for another specific font (say Helvetica), do the following:
2817 - create a new buffer
2818 - generate the PostScript image to a file (C-u M-x ps-print-buffer)
2819 - open this file and delete the leading `%' (which is the PostScript comment
2820 character) from the line
2821 `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
2823 `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
2824 - add the values to `ps-font-info-database'.
2825 You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
2827 Note also that ps-print DOESN'T download any font to your printer, instead it
2828 uses the fonts resident in your printer."
2830 (list :tag
"Font Definition"
2831 (symbol :tag
"Font Family")
2833 (const :format
"" fonts
)
2834 (repeat :tag
"Faces"
2835 (cons (choice :menu-tag
"Font Weight/Slant"
2836 :tag
"Font Weight/Slant"
2841 (symbol :tag
"Face"))
2842 (string :tag
"Font Name"))))
2844 (const :format
"" size
)
2845 (number :tag
"Reference Size"))
2847 (const :format
"" line-height
)
2848 (number :tag
"Line Height"))
2850 (const :format
"" space-width
)
2851 (number :tag
"Space Width"))
2853 (const :format
"" avg-char-width
)
2854 (number :tag
"Average Character Width"))))
2856 :group
'ps-print-font
)
2858 (defcustom ps-font-family
'Courier
2859 "Font family name for ordinary text, when generating PostScript."
2862 :group
'ps-print-font
)
2864 (defcustom ps-font-size
'(7 .
8.5)
2865 "Font size, in points, for ordinary text, when generating PostScript.
2866 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2867 :type
'(choice :menu-tag
"Ordinary Text Font Size"
2868 :tag
"Ordinary Text Font Size"
2869 (number :tag
"Text Size")
2870 (cons :tag
"Landscape/Portrait"
2871 (number :tag
"Landscape Text Size")
2872 (number :tag
"Portrait Text Size")))
2874 :group
'ps-print-font
)
2876 (defcustom ps-header-font-family
'Helvetica
2877 "Font family name for text in the header, when generating PostScript."
2880 :group
'ps-print-font
)
2882 (defcustom ps-header-font-size
'(10 .
12)
2883 "Font size, in points, for text in the header, when generating PostScript.
2884 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2885 :type
'(choice :menu-tag
"Header Font Size"
2886 :tag
"Header Font Size"
2887 (number :tag
"Header Size")
2888 (cons :tag
"Landscape/Portrait"
2889 (number :tag
"Landscape Header Size")
2890 (number :tag
"Portrait Header Size")))
2892 :group
'ps-print-font
)
2894 (defcustom ps-header-title-font-size
'(12 .
14)
2895 "Font size, in points, for the top line of text in header, in PostScript.
2896 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2897 :type
'(choice :menu-tag
"Header Title Font Size"
2898 :tag
"Header Title Font Size"
2899 (number :tag
"Header Title Size")
2900 (cons :tag
"Landscape/Portrait"
2901 (number :tag
"Landscape Header Title Size")
2902 (number :tag
"Portrait Header Title Size")))
2904 :group
'ps-print-font
)
2906 (defcustom ps-footer-font-family
'Helvetica
2907 "Font family name for text in the footer, when generating PostScript."
2910 :group
'ps-print-font
)
2912 (defcustom ps-footer-font-size
'(10 .
12)
2913 "Font size, in points, for text in the footer, when generating PostScript.
2914 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2915 :type
'(choice :menu-tag
"Footer Font Size"
2916 :tag
"Footer Font Size"
2917 (number :tag
"Footer Size")
2918 (cons :tag
"Landscape/Portrait"
2919 (number :tag
"Landscape Footer Size")
2920 (number :tag
"Portrait Footer Size")))
2922 :group
'ps-print-font
)
2924 (defcustom ps-line-number-color
"black"
2925 "Specify color for line-number, when generating PostScript."
2926 :type
'(choice :menu-tag
"Line Number Color"
2927 :tag
"Line Number Color"
2928 (number :tag
"Gray Scale" :value
0)
2929 (string :tag
"Color Name" :value
"black")
2930 (list :tag
"RGB Color" :value
(0 0 0)
2932 (number :tag
"Green")
2933 (number :tag
"Blue")))
2935 :group
'ps-print-font
2936 :group
'ps-print-miscellany
)
2938 (defcustom ps-line-number-font
"Times-Italic"
2939 "Font for line-number, when generating PostScript."
2942 :group
'ps-print-font
2943 :group
'ps-print-miscellany
)
2945 (defcustom ps-line-number-font-size
6
2946 "Font size, in points, for line number, when generating PostScript.
2947 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
2948 :type
'(choice :menu-tag
"Line Number Font Size"
2949 :tag
"Line Number Font Size"
2950 (number :tag
"Font Size")
2951 (cons :tag
"Landscape/Portrait"
2952 (number :tag
"Landscape Font Size")
2953 (number :tag
"Portrait Font Size")))
2955 :group
'ps-print-font
2956 :group
'ps-print-miscellany
)
2960 ;; Printing color requires x-color-values.
2961 ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
2964 (defcustom ps-print-color-p
2965 (or (fboundp 'x-color-values
) ; Emacs
2966 (fboundp 'color-instance-rgb-components
))
2968 "Specify how buffer's text color is printed.
2972 nil Do not print colors.
2976 black-white Print colors on black/white printer.
2977 See also `ps-black-white-faces'.
2979 Any other value is treated as t."
2980 :type
'(choice :menu-tag
"Print Color"
2982 (const :tag
"Do NOT Print Color" nil
)
2983 (const :tag
"Print Always Color" t
)
2984 (const :tag
"Print Black/White Color" black-white
))
2986 :group
'ps-print-color
)
2988 (defcustom ps-default-fg nil
2989 "RGB values of the default foreground color.
2991 The `ps-default-fg' variable contains the default foreground color used by
2992 ps-print, that is, if there is a face in a text that doesn't have a foreground
2993 color, the `ps-default-fg' color should be used.
2997 t The foreground color of Emacs session will be used.
2999 frame-parameter The foreground-color frame parameter will be used.
3001 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3002 indicate the gray color.
3004 COLOR-NAME It's a string which contains the color name. For example:
3007 LIST It's a list of RGB values, that is a list of three real values
3012 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3015 Any other value is ignored and black color will be used.
3017 This variable is used only when `ps-print-color-p' (which see) is neither nil
3019 :type
'(choice :menu-tag
"Default Foreground Gray/Color"
3020 :tag
"Default Foreground Gray/Color"
3021 (const :tag
"Session Foreground" t
)
3022 (const :tag
"Frame Foreground" frame-parameter
)
3023 (number :tag
"Gray Scale" :value
0.0)
3024 (string :tag
"Color Name" :value
"black")
3025 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
3027 (number :tag
"Green")
3028 (number :tag
"Blue")))
3030 :group
'ps-print-color
)
3032 (defcustom ps-default-bg nil
3033 "RGB values of the default background color.
3035 The `ps-default-bg' variable contains the default background color used by
3036 ps-print, that is, if there is a face in a text that doesn't have a background
3037 color, the `ps-default-bg' color should be used.
3041 t The background color of Emacs session will be used.
3043 frame-parameter The background-color frame parameter will be used.
3045 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3046 indicate the gray color.
3048 COLOR-NAME It's a string which contains the color name. For example:
3051 LIST It's a list of RGB values, that is a list of three real values
3056 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3059 Any other value is ignored and white color will be used.
3061 This variable is used only when `ps-print-color-p' (which see) is neither nil
3064 See also `ps-use-face-background'."
3065 :type
'(choice :menu-tag
"Default Background Gray/Color"
3066 :tag
"Default Background Gray/Color"
3067 (const :tag
"Session Background" t
)
3068 (const :tag
"Frame Background" frame-parameter
)
3069 (number :tag
"Gray Scale" :value
1.0)
3070 (string :tag
"Color Name" :value
"white")
3071 (list :tag
"RGB Color" :value
(1.0
1.0 1.0)
3073 (number :tag
"Green")
3074 (number :tag
"Blue")))
3076 :group
'ps-print-color
)
3078 (defcustom ps-fg-list nil
3079 "Specify foreground color list.
3081 This list is used to chose a text foreground color which is different than the
3082 background color. It'll be used the first foreground color in `ps-fg-list'
3083 which is different from the background color.
3085 If this list is nil, the default foreground color is used. See
3088 The list element valid values are:
3090 NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
3091 indicate the gray color.
3093 COLOR-NAME It's a string which contains the color name. For example:
3096 LIST It's a list of RGB values, that is a list of three real values
3101 Where RED, GREEN and BLUE are reals between 0.0 (no color) and
3104 Any other value is ignored and black color will be used.
3106 This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
3107 when `ps-print-color-p' (which see) is neither nil nor black-white."
3109 (choice :menu-tag
"Foreground Gray/Color"
3110 :tag
"Foreground Gray/Color"
3111 (number :tag
"Gray Scale" :value
0.0)
3112 (string :tag
"Color Name" :value
"black")
3113 (list :tag
"RGB Color" :value
(0.0
0.0 0.0)
3115 (number :tag
"Green")
3116 (number :tag
"Blue"))))
3118 :group
'ps-print-color
)
3120 (defcustom ps-fg-validate-p t
3121 "Non-nil means validate if foreground color is different than background.
3123 If text foreground and background colors are equals, no text will appear.
3125 See also `ps-fg-list'."
3128 :group
'ps-print-color
)
3130 (defcustom ps-auto-font-detect t
3131 "Non-nil means automatically detect bold/italic/underline face attributes.
3132 If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
3133 `ps-underlined-faces'."
3136 :group
'ps-print-font
)
3138 (defcustom ps-black-white-faces
3139 '((font-lock-builtin-face "black" nil bold
)
3140 (font-lock-comment-face "gray20" nil italic
)
3141 (font-lock-constant-face "black" nil bold
)
3142 (font-lock-function-name-face "black" nil bold
)
3143 (font-lock-keyword-face "black" nil bold
)
3144 (font-lock-string-face "black" nil italic
)
3145 (font-lock-type-face "black" nil italic
)
3146 (font-lock-variable-name-face "black" nil bold italic
)
3147 (font-lock-warning-face "black" nil bold italic
))
3148 "Specify list of face attributes to print colors on black/white printers.
3150 The list elements are the same as defined on `ps-extend-face' (which see).
3152 This variable is used only when `ps-print-color-p' is set to `black-white'."
3155 (list :tag
"Face Specification"
3156 (face :tag
"Face Symbol")
3157 (choice :menu-tag
"Foreground Color"
3158 :tag
"Foreground Color"
3159 (const :tag
"Black" nil
)
3160 (string :tag
"Color Name"))
3161 (choice :menu-tag
"Background Color"
3162 :tag
"Background Color"
3163 (const :tag
"None" nil
)
3164 (string :tag
"Color Name"))
3166 (choice :menu-tag
"Attribute"
3176 :group
'ps-print-face
)
3178 (defcustom ps-bold-faces
3179 (unless ps-print-color-p
3180 '(font-lock-function-name-face
3181 font-lock-builtin-face
3182 font-lock-variable-name-face
3183 font-lock-keyword-face
3184 font-lock-warning-face
))
3185 "A list of the \(non-bold\) faces that should be printed in bold font.
3186 This applies to generating PostScript."
3187 :type
'(repeat face
)
3189 :group
'ps-print-face
)
3191 (defcustom ps-italic-faces
3192 (unless ps-print-color-p
3193 '(font-lock-variable-name-face
3195 font-lock-string-face
3196 font-lock-comment-face
3197 font-lock-warning-face
))
3198 "A list of the \(non-italic\) faces that should be printed in italic font.
3199 This applies to generating PostScript."
3200 :type
'(repeat face
)
3202 :group
'ps-print-face
)
3204 (defcustom ps-underlined-faces
3205 (unless ps-print-color-p
3206 '(font-lock-function-name-face
3207 font-lock-constant-face
3208 font-lock-warning-face
))
3209 "A list of the \(non-underlined\) faces that should be printed underlined.
3210 This applies to generating PostScript."
3211 :type
'(repeat face
)
3213 :group
'ps-print-face
)
3215 (defcustom ps-use-face-background nil
3216 "Specify if face background should be used.
3220 t always use face background color.
3221 nil never use face background color.
3222 (face...) list of faces whose background color will be used.
3224 Any other value will be treated as t."
3225 :type
'(choice :menu-tag
"Use Face Background"
3226 :tag
"Use Face Background"
3227 (const :tag
"Always Use Face Background" t
)
3228 (const :tag
"Never Use Face Background" nil
)
3229 (repeat :menu-tag
"Face Background List"
3230 :tag
"Face Background List"
3233 :group
'ps-print-face
)
3235 (defcustom ps-left-header
3236 (list 'ps-get-buffer-name
'ps-header-dirpart
)
3237 "The items to display (each on a line) on the left part of the page header.
3238 This applies to generating PostScript.
3240 The value should be a list of strings and symbols, each representing an entry
3241 in the PostScript array HeaderLinesLeft.
3243 Strings are inserted unchanged into the array; those representing
3244 PostScript string literals should be delimited with PostScript string
3245 delimiters '(' and ')'.
3247 For symbols with bound functions, the function is called and should return a
3248 string to be inserted into the array. For symbols with bound values, the value
3249 should be a string to be inserted into the array. In either case, function or
3250 variable, the string value has PostScript string delimiters added to it.
3252 If symbols are unbounded, they are silently ignored."
3253 :type
'(repeat (choice :menu-tag
"Left Header"
3257 :group
'ps-print-headers
)
3259 (defcustom ps-right-header
3260 (list "/pagenumberstring load"
3261 'ps-time-stamp-locale-default
'ps-time-stamp-hh
:mm
:ss
)
3262 "The items to display (each on a line) on the right part of the page header.
3263 This applies to generating PostScript.
3265 See the variable `ps-left-header' for a description of the format of this
3268 There are the following basic functions implemented:
3270 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3271 as, for example, \"06/18/01\".
3273 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3275 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3277 `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
3280 `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
3282 You can also create your own time stamp function by using `format-time-string'
3284 :type
'(repeat (choice :menu-tag
"Right Header"
3288 :group
'ps-print-headers
)
3290 (defcustom ps-left-footer
3291 (list 'ps-get-buffer-name
'ps-header-dirpart
)
3292 "The items to display (each on a line) on the left part of the page footer.
3293 This applies to generating PostScript.
3295 The value should be a list of strings and symbols, each representing an entry
3296 in the PostScript array FooterLinesLeft.
3298 Strings are inserted unchanged into the array; those representing PostScript
3299 string literals should be delimited with PostScript string delimiters '(' and
3302 For symbols with bound functions, the function is called and should return a
3303 string to be inserted into the array. For symbols with bound values, the value
3304 should be a string to be inserted into the array. In either case, function or
3305 variable, the string value has PostScript string delimiters added to it.
3307 If symbols are unbounded, they are silently ignored."
3308 :type
'(repeat (choice :menu-tag
"Left Footer"
3312 :group
'ps-print-headers
)
3314 (defcustom ps-right-footer
3315 (list "/pagenumberstring load"
3316 'ps-time-stamp-locale-default
'ps-time-stamp-hh
:mm
:ss
)
3317 "The items to display (each on a line) on the right part of the page footer.
3318 This applies to generating PostScript.
3320 See the variable `ps-left-footer' for a description of the format of this
3323 There are the following basic functions implemented:
3325 `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
3326 as, for example, \"06/18/01\".
3328 `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
3330 `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
3332 `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
3335 `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
3337 You can also create your own time stamp function by using `format-time-string'
3339 :type
'(repeat (choice :menu-tag
"Right Footer"
3343 :group
'ps-print-headers
)
3345 (defcustom ps-razzle-dazzle t
3346 "Non-nil means report progress while formatting buffer."
3349 :group
'ps-print-miscellany
)
3351 (defcustom ps-adobe-tag
"%!PS-Adobe-3.0\n"
3352 "Contains the header line identifying the output as PostScript.
3353 By default, `ps-adobe-tag' contains the standard identifier. Some printers
3354 require slightly different versions of this line."
3357 :group
'ps-print-miscellany
)
3359 (defcustom ps-build-face-reference t
3360 "Non-nil means build the reference face lists.
3362 ps-print sets this value to nil after it builds its internal reference lists of
3363 bold and italic faces. By setting its value back to t, you can force ps-print
3364 to rebuild the lists the next time you invoke one of the ...-with-faces
3367 You should set this value back to t after you change the attributes of any
3368 face, or create new faces. Most users shouldn't have to worry about its
3372 :group
'ps-print-face
)
3374 (defcustom ps-always-build-face-reference nil
3375 "Non-nil means always rebuild the reference face lists.
3377 If this variable is non-nil, ps-print will rebuild its internal reference lists
3378 of bold and italic faces *every* time one of the ...-with-faces commands is
3379 called. Most users shouldn't need to set this variable."
3382 :group
'ps-print-face
)
3384 (defcustom ps-banner-page-when-duplexing nil
3385 "Non-nil means the very first page is skipped.
3386 It's like the very first character of buffer (or region) is ^L (\\014)."
3389 :group
'ps-print-headers
)
3391 (defcustom ps-postscript-code-directory
3392 (or (if (featurep 'xemacs
)
3393 (cond ((fboundp 'locate-data-directory
) ; XEmacs
3394 (funcall 'locate-data-directory
"ps-print"))
3395 ((boundp 'data-directory
) ; XEmacs
3396 (symbol-value 'data-directory
))
3397 (t ; don't know what to do
3399 data-directory
) ; Emacs
3400 (error "`ps-postscript-code-directory' isn't set properly"))
3401 "Directory where it's located the PostScript prologue file used by ps-print.
3402 By default, this directory is the same as in the variable `data-directory'."
3405 :group
'ps-print-miscellany
)
3407 (defcustom ps-line-spacing
0
3408 "Specify line spacing, in points, for ordinary text.
3410 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3412 See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
3414 To get all lines with some spacing set both `ps-line-spacing' and
3415 `ps-paragraph-spacing' variables."
3416 :type
'(choice :menu-tag
"Line Spacing For Ordinary Text"
3417 :tag
"Line Spacing For Ordinary Text"
3418 (number :tag
"Line Spacing")
3419 (cons :tag
"Landscape/Portrait"
3420 (number :tag
"Landscape Line Spacing")
3421 (number :tag
"Portrait Line Spacing")))
3423 :group
'ps-print-miscellany
)
3425 (defcustom ps-paragraph-spacing
0
3426 "Specify paragraph spacing, in points, for ordinary text.
3428 Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
3430 See also `ps-line-spacing' and `ps-paragraph-regexp'.
3432 To get all lines with some spacing set both `ps-line-spacing' and
3433 `ps-paragraph-spacing' variables."
3434 :type
'(choice :menu-tag
"Paragraph Spacing For Ordinary Text"
3435 :tag
"Paragraph Spacing For Ordinary Text"
3436 (number :tag
"Paragraph Spacing")
3437 (cons :tag
"Landscape/Portrait"
3438 (number :tag
"Landscape Paragraph Spacing")
3439 (number :tag
"Portrait Paragraph Spacing")))
3441 :group
'ps-print-miscellany
)
3443 (defcustom ps-paragraph-regexp
"[ \t]*$"
3444 "Specify paragraph delimiter.
3446 It should be a regexp or nil.
3448 See also `ps-paragraph-spacing'."
3449 :type
'(choice :menu-tag
"Paragraph Delimiter"
3450 (const :tag
"No Delimiter" nil
)
3451 (regexp :tag
"Delimiter Regexp"))
3453 :group
'ps-print-miscellany
)
3455 (defcustom ps-begin-cut-regexp nil
3456 "Specify regexp which is start of a region to cut out when printing.
3458 As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
3459 set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
3460 some special printing instructions from the actual print. Special printing
3461 instructions may be appended to the end of the file just like any other
3462 buffer-local variables. See section \"Local Variables in Files\" on Emacs
3463 manual for more information.
3465 Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
3466 actually gets printed. Both variables may be set to nil in which case no
3468 :type
'(choice (const :tag
"No Delimiter" nil
)
3469 (regexp :tag
"Delimiter Regexp"))
3471 :group
'ps-print-miscellany
)
3473 (defcustom ps-end-cut-regexp nil
3474 "Specify regexp which is end of the region to cut out when printing.
3476 See `ps-begin-cut-regexp' for more information."
3477 :type
'(choice (const :tag
"No Delimiter" nil
)
3478 (regexp :tag
"Delimiter Regexp"))
3480 :group
'ps-print-miscellany
)
3483 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3487 (defvar ps-last-selected-pages nil
3488 "Latest `ps-selected-pages' value.")
3491 (defun ps-restore-selected-pages ()
3492 "Restore latest `ps-selected-pages' value."
3494 (setq ps-selected-pages ps-last-selected-pages
))
3497 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3502 (defun ps-print-customize ()
3503 "Customization of ps-print group."
3505 (customize-group 'ps-print
))
3508 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3513 (defun ps-print-buffer (&optional filename
)
3514 "Generate and print a PostScript image of the buffer.
3516 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3517 user for a file name, and saves the PostScript image in that file instead of
3518 sending it to the printer.
3520 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3521 send the image to the printer. If FILENAME is a string, save the PostScript
3522 image in a file with that name."
3523 (interactive (list (ps-print-preprint current-prefix-arg
)))
3524 (ps-print-without-faces (point-min) (point-max) filename
))
3528 (defun ps-print-buffer-with-faces (&optional filename
)
3529 "Generate and print a PostScript image of the buffer.
3530 Like `ps-print-buffer', but includes font, color, and underline information in
3531 the generated image. This command works only if you are using a window system,
3532 so it has a way to determine color values."
3533 (interactive (list (ps-print-preprint current-prefix-arg
)))
3534 (ps-print-with-faces (point-min) (point-max) filename
))
3538 (defun ps-print-region (from to
&optional filename
)
3539 "Generate and print a PostScript image of the region.
3540 Like `ps-print-buffer', but prints just the current region."
3541 (interactive (ps-print-preprint-region current-prefix-arg
))
3542 (ps-print-without-faces from to filename t
))
3546 (defun ps-print-region-with-faces (from to
&optional filename
)
3547 "Generate and print a PostScript image of the region.
3548 Like `ps-print-region', but includes font, color, and underline information in
3549 the generated image. This command works only if you are using a window system,
3550 so it has a way to determine color values."
3551 (interactive (ps-print-preprint-region current-prefix-arg
))
3552 (ps-print-with-faces from to filename t
))
3556 (defun ps-spool-buffer ()
3557 "Generate and spool a PostScript image of the buffer.
3558 Like `ps-print-buffer' except that the PostScript image is saved in a local
3559 buffer to be sent to the printer later.
3561 Use the command `ps-despool' to send the spooled images to the printer."
3563 (ps-spool-without-faces (point-min) (point-max)))
3567 (defun ps-spool-buffer-with-faces ()
3568 "Generate and spool a PostScript image of the buffer.
3569 Like `ps-spool-buffer', but includes font, color, and underline information in
3570 the generated image. This command works only if you are using a window system,
3571 so it has a way to determine color values.
3573 Use the command `ps-despool' to send the spooled images to the printer."
3575 (ps-spool-with-faces (point-min) (point-max)))
3579 (defun ps-spool-region (from to
)
3580 "Generate a PostScript image of the region and spool locally.
3581 Like `ps-spool-buffer', but spools just the current region.
3583 Use the command `ps-despool' to send the spooled images to the printer."
3585 (ps-spool-without-faces from to t
))
3589 (defun ps-spool-region-with-faces (from to
)
3590 "Generate a PostScript image of the region and spool locally.
3591 Like `ps-spool-region', but includes font, color, and underline information in
3592 the generated image. This command works only if you are using a window system,
3593 so it has a way to determine color values.
3595 Use the command `ps-despool' to send the spooled images to the printer."
3597 (ps-spool-with-faces from to t
))
3600 (defun ps-despool (&optional filename
)
3601 "Send the spooled PostScript to the printer.
3603 Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
3604 user for a file name, and saves the spooled PostScript image in that file
3605 instead of sending it to the printer.
3607 Noninteractively, the argument FILENAME is treated as follows: if it is nil,
3608 send the image to the printer. If FILENAME is a string, save the PostScript
3609 image in a file with that name."
3610 (interactive (list (ps-print-preprint current-prefix-arg
)))
3611 (ps-do-despool filename
))
3614 (defun ps-line-lengths ()
3615 "Display the correspondence between a line length and a font size.
3616 Done using the current ps-print setup.
3617 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
3619 (ps-line-lengths-internal))
3622 (defun ps-nb-pages-buffer (nb-lines)
3623 "Display number of pages to print this buffer, for various font heights.
3624 The table depends on the current ps-print setup."
3625 (interactive (ps-count-lines-preprint (point-min) (point-max)))
3626 (ps-nb-pages nb-lines
))
3629 (defun ps-nb-pages-region (nb-lines)
3630 "Display number of pages to print the region, for various font heights.
3631 The table depends on the current ps-print setup."
3632 (interactive (ps-count-lines-preprint (mark) (point)))
3633 (ps-nb-pages nb-lines
))
3635 (defvar ps-prefix-quote nil
3636 "Used for `ps-print-quote' (which see).")
3640 "Return the current PostScript-generation setup."
3641 (let (ps-prefix-quote)
3645 (concat "\n;;; (" (if (featurep 'xemacs
) "XEmacs" "Emacs")
3646 ") ps-print version " ps-print-version
"\n")
3648 (ps-comment-string "emacs-version " emacs-version
)
3649 (ps-comment-string "ps-windows-system " ps-windows-system
)
3650 (ps-comment-string "ps-lp-system " ps-lp-system
)
3652 '(25 . ps-print-color-p
)
3653 '(25 . ps-lpr-command
)
3654 '(25 . ps-lpr-switches
)
3655 '(25 . ps-printer-name
)
3656 '(25 . ps-printer-name-option
)
3657 '(25 . ps-print-region-function
)
3658 '(25 . ps-manual-feed
)
3659 '(25 . ps-end-with-control-d
)
3661 '(23 . ps-paper-type
)
3662 '(23 . ps-warn-paper-type
)
3663 '(23 . ps-landscape-mode
)
3664 '(23 . ps-print-upside-down
)
3665 '(23 . ps-number-of-columns
)
3667 '(23 . ps-zebra-stripes
)
3668 '(23 . ps-zebra-stripe-height
)
3669 '(23 . ps-zebra-stripe-follow
)
3670 '(23 . ps-zebra-color
)
3671 '(23 . ps-line-number
)
3672 '(23 . ps-line-number-step
)
3673 '(23 . ps-line-number-start
)
3675 '(17 . ps-razzle-dazzle
)
3676 '(17 . ps-default-bg
)
3677 '(17 . ps-default-fg
)
3678 '(17 . ps-fg-validate-p
)
3681 '(23 . ps-use-face-background
)
3683 '(28 . ps-print-control-characters
)
3685 '(26 . ps-print-background-image
)
3687 '(25 . ps-print-background-text
)
3689 '(29 . ps-error-handler-message
)
3690 '(29 . ps-user-defined-prologue
)
3691 '(29 . ps-print-prologue-header
)
3692 '(29 . ps-postscript-code-directory
)
3693 '(29 . ps-adobe-tag
)
3695 '(30 . ps-left-margin
)
3696 '(30 . ps-right-margin
)
3697 '(30 . ps-inter-column
)
3698 '(30 . ps-bottom-margin
)
3699 '(30 . ps-top-margin
)
3700 '(30 . ps-print-only-one-header
)
3701 '(30 . ps-switch-header
)
3702 '(30 . ps-print-header
)
3703 '(30 . ps-header-lines
)
3704 '(30 . ps-header-offset
)
3705 '(30 . ps-header-line-pad
)
3706 '(30 . ps-print-header-frame
)
3707 '(30 . ps-header-frame-alist
)
3708 '(30 . ps-print-footer
)
3709 '(30 . ps-footer-lines
)
3710 '(30 . ps-footer-offset
)
3711 '(30 . ps-footer-line-pad
)
3712 '(30 . ps-print-footer-frame
)
3713 '(30 . ps-footer-frame-alist
)
3714 '(30 . ps-show-n-of-n
)
3715 '(30 . ps-spool-config
)
3716 '(30 . ps-spool-duplex
)
3717 '(30 . ps-spool-tumble
)
3718 '(30 . ps-banner-page-when-duplexing
)
3719 '(30 . ps-left-header
)
3720 '(30 . ps-right-header
)
3721 '(30 . ps-left-footer
)
3722 '(30 . ps-right-footer
)
3724 '(23 . ps-n-up-printing
)
3725 '(23 . ps-n-up-margin
)
3726 '(23 . ps-n-up-border-p
)
3727 '(23 . ps-n-up-filling
)
3729 '(26 . ps-multibyte-buffer
)
3730 '(26 . ps-font-family
)
3731 '(26 . ps-font-size
)
3732 '(26 . ps-header-font-family
)
3733 '(26 . ps-header-font-size
)
3734 '(26 . ps-header-title-font-size
)
3735 '(26 . ps-footer-font-family
)
3736 '(26 . ps-footer-font-size
)
3737 '(26 . ps-line-number-color
)
3738 '(26 . ps-line-number-font
)
3739 '(26 . ps-line-number-font-size
)
3740 '(26 . ps-line-spacing
)
3741 '(26 . ps-paragraph-spacing
)
3742 '(26 . ps-paragraph-regexp
)
3743 '(26 . ps-begin-cut-regexp
)
3744 '(26 . ps-end-cut-regexp
)
3746 '(23 . ps-even-or-odd-pages
)
3747 '(23 . ps-selected-pages
)
3748 '(23 . ps-last-selected-pages
)
3750 '(31 . ps-build-face-reference
)
3751 '(31 . ps-always-build-face-reference
)
3753 '(20 . ps-auto-font-detect
)
3754 '(20 . ps-bold-faces
)
3755 '(20 . ps-italic-faces
)
3756 '(20 . ps-underlined-faces
)
3757 '(20 . ps-black-white-faces
)
3759 \;; The following customized variables have long lists and are seldom modified:
3760 \;; ps-page-dimensions-database
3761 \;; ps-font-info-database
3763 \;;; ps-print - end of settings\n")
3767 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3768 ;; Utility functions and variables:
3771 (defun ps-print-quote (elt)
3772 "Quote ELT for printing (used for showing settings).
3774 If ELT is nil, return an empty string.
3775 If ELT is string, return it.
3776 Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
3777 LEN is the field length where SYM name will be inserted. The variable
3778 `ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
3779 used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
3782 * If `ps-prefix-quote' is nil:
3783 \"(setq SYM-NAME SYM-VALUE\"
3787 * If `ps-prefix-quote' is non-nil:
3788 \" SYM-NAME SYM-VALUE\"
3792 If `ps-prefix-quote' is nil, it's set to t after generating string."
3795 ((and (consp elt
) (integerp (car elt
))
3796 (symbolp (cdr elt
)) (boundp (cdr elt
)))
3797 (let* ((col (car elt
))
3799 (key (symbol-name sym
))
3801 (val (symbol-value sym
)))
3802 (concat (if ps-prefix-quote
3804 (setq ps-prefix-quote t
)
3808 (make-string (- col len
) ?\s
)
3810 (ps-value-string val
))))
3815 (defun ps-value-string (val)
3816 "Return a string representation of VAL. Used by `ps-print-quote'."
3821 ((or (symbolp val
) (listp val
))
3824 (format "%S" val
))))
3827 (defun ps-comment-string (str value
)
3828 "Return a comment string like \";; STR = VALUE\"."
3829 (format ";; %s = %s" str
(ps-value-string value
)))
3832 (defun ps-value (alist-sym key
)
3833 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3834 (cdr (assq key
(symbol-value alist-sym
))))
3837 (defun ps-get (alist-sym key
)
3838 "Return element from association list ALIST-SYM which car is `eq' to KEY."
3839 (assq key
(symbol-value alist-sym
)))
3842 (defun ps-put (alist-sym key value
)
3843 "Store element (KEY . VALUE) into association list ALIST-SYM.
3844 If KEY already exists in ALIST-SYM, modify cdr to VALUE.
3845 It can be retrieved with `(ps-get ALIST-SYM KEY)'."
3846 (let ((elt: (assq key
(symbol-value alist-sym
)))) ; to avoid name conflict
3849 (setq elt
: (cons key value
))
3850 (set alist-sym
(cons elt
: (symbol-value alist-sym
))))
3854 (defun ps-del (alist-sym key
)
3855 "Delete by side effect element KEY from association list ALIST-SYM."
3856 (let ((a:list
: (symbol-value alist-sym
)) ; to avoid name conflict
3859 (if (eq key
(car (car a
:list
:)))
3862 (setcdr old
(cdr a
:list
:))
3863 (set alist-sym
(cdr a
:list
:)))
3866 a
:list
: (cdr a
:list
:)))))
3867 (symbol-value alist-sym
))
3870 (defun ps-time-stamp-locale-default ()
3871 "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
3872 (format-time-string "%x"))
3875 (defun ps-time-stamp-mon-dd-yyyy ()
3876 "Return date as \"Jun 18 2001\"."
3877 (format-time-string "%b %d %Y"))
3880 (defun ps-time-stamp-yyyy-mm-dd ()
3881 "Return date as \"2001-06-18\" (ISO date)."
3882 (format-time-string "%Y-%m-%d"))
3885 ;; Alias for `ps-time-stamp-yyyy-mm-dd' (which see).
3886 (defalias 'ps-time-stamp-iso8601
'ps-time-stamp-yyyy-mm-dd
)
3889 (defun ps-time-stamp-hh:mm
:ss
()
3890 "Return time as \"17:28:31\"."
3891 (format-time-string "%T"))
3894 (defvar ps-print-color-scale
1.0)
3896 (defun ps-color-scale (color)
3897 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
3898 (mapcar #'(lambda (value) (/ value ps-print-color-scale
))
3899 (ps-color-values color
)))
3902 (defun ps-face-underlined-p (face)
3903 (or (face-underline-p face
)
3904 (memq face ps-underlined-faces
)))
3907 (defun ps-prologue-file (filenumber)
3908 "If prologue FILENUMBER exists and is readable, return contents as string.
3910 Note: No major/minor-mode is activated and no local variables are evaluated for
3911 FILENUMBER, but proper EOL-conversion and character interpretation is
3913 (let ((filename (convert-standard-filename
3914 (expand-file-name (format "ps-prin%d.ps" filenumber
)
3915 ps-postscript-code-directory
))))
3916 (if (and (file-exists-p filename
)
3917 (file-readable-p filename
))
3919 (insert-file-contents filename
)
3921 (error "ps-print PostScript prologue `%s' file was not found"
3925 (defvar ps-mark-code-directory nil
)
3927 (defvar ps-print-prologue-0
""
3928 "ps-print PostScript error handler.")
3930 (defvar ps-print-prologue-1
""
3931 "ps-print PostScript prologue.")
3933 ;; Start Editing Here:
3935 (defvar ps-source-buffer nil
)
3936 (defvar ps-spool-buffer-name
"*PostScript*")
3937 (defvar ps-spool-buffer nil
)
3939 (defvar ps-output-head nil
)
3940 (defvar ps-output-tail nil
)
3942 (defvar ps-page-postscript
0) ; page number
3943 (defvar ps-page-order
0) ; PostScript page counter
3944 (defvar ps-page-sheet
0) ; sheet counter
3945 (defvar ps-page-column
0) ; column counter
3946 (defvar ps-page-printed
0) ; total pages printed
3947 (defvar ps-page-n-up
0) ; n-up counter
3948 (defvar ps-lines-printed
0) ; total lines printed
3949 (defvar ps-showline-count
1) ; line number counter
3950 (defvar ps-first-page nil
)
3951 (defvar ps-last-page nil
)
3952 (defvar ps-print-page-p t
)
3954 (defvar ps-control-or-escape-regexp nil
)
3955 (defvar ps-n-up-on nil
)
3957 (defvar ps-background-pages nil
)
3958 (defvar ps-background-all-pages nil
)
3959 (defvar ps-background-text-count
0)
3960 (defvar ps-background-image-count
0)
3962 (defvar ps-current-font
0)
3963 (defvar ps-default-foreground nil
)
3964 (defvar ps-default-background nil
)
3965 (defvar ps-default-color nil
)
3966 (defvar ps-current-color nil
)
3967 (defvar ps-current-bg nil
)
3968 (defvar ps-foreground-list nil
)
3970 (defvar ps-zebra-stripe-full-p nil
)
3971 (defvar ps-razchunk
0)
3973 (defvar ps-color-p nil
)
3975 ;; These values determine how much print-height to deduct when headers/footers
3976 ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
3979 (defvar ps-header-pad
0
3980 "Vertical and horizontal space between the header frame and the text.
3981 This is in units of points (1/72 inch).")
3983 (defvar ps-footer-pad
0
3984 "Vertical and horizontal space between the footer frame and the text.
3985 This is in units of points (1/72 inch).")
3987 ;; Define accessors to the dimensions list.
3989 (defmacro ps-page-dimensions-get-width
(dims) `(nth 0 ,dims
))
3990 (defmacro ps-page-dimensions-get-height
(dims) `(nth 1 ,dims
))
3991 (defmacro ps-page-dimensions-get-media
(dims) `(nth 2 ,dims
))
3993 (defvar ps-landscape-page-height nil
)
3995 (defvar ps-print-width nil
)
3996 (defvar ps-print-height nil
)
3998 (defvar ps-height-remaining nil
)
3999 (defvar ps-width-remaining nil
)
4001 (defvar ps-font-size-internal nil
)
4002 (defvar ps-header-font-size-internal nil
)
4003 (defvar ps-header-title-font-size-internal nil
)
4004 (defvar ps-footer-font-size-internal nil
)
4005 (defvar ps-line-spacing-internal nil
)
4006 (defvar ps-paragraph-spacing-internal nil
)
4009 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4010 ;; Internal Variables
4013 (defvar ps-black-white-faces-alist nil
4014 "Alist of symbolic faces used for black/white PostScript printers.
4015 An element of this list has the same form as `ps-print-face-extension-alist'
4018 Don't change this list directly; instead,
4019 use `ps-extend-face' and `ps-extend-face-list'.
4020 See documentation for `ps-extend-face' for valid extension symbol.
4021 See also documentation for `ps-print-color-p'.")
4024 (defvar ps-print-face-extension-alist nil
4025 "Alist of symbolic faces *WITH* extension features (box, outline, etc).
4026 An element of this list has the following form:
4028 (FACE . [BITS FG BG])
4030 FACE is a symbol denoting a face name
4031 BITS is a bit vector, where each bit correspond
4032 to a feature (bold, underline, etc)
4033 (see documentation for `ps-print-face-map-alist')
4034 FG foreground color (string or nil)
4035 BG background color (string or nil)
4037 Don't change this list directly; instead,
4038 use `ps-extend-face' and `ps-extend-face-list'.
4039 See documentation for `ps-extend-face' for valid extension symbol.")
4042 (defvar ps-print-face-alist nil
4043 "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
4045 An element of this list has the same form as an element of
4046 `ps-print-face-extension-alist'.
4048 Don't change this list directly; this list is used by `ps-face-attributes',
4049 `ps-map-face' and `ps-build-reference-face-lists'.")
4052 (defconst ps-print-face-map-alist
4061 "Alist of all features and the corresponding bit mask.
4062 Each symbol correspond to one bit in a bit vector.")
4065 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4070 (defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym
)
4071 "Extend face in ALIST-SYM.
4073 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
4074 with face extension in ALIST-SYM; otherwise, overrides.
4076 If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
4077 otherwise, it should be an alist symbol.
4079 The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.
4081 See `ps-extend-face' for documentation."
4082 (while face-extension-list
4083 (ps-extend-face (car face-extension-list
) merge-p alist-sym
)
4084 (setq face-extension-list
(cdr face-extension-list
))))
4088 (defun ps-extend-face (face-extension &optional merge-p alist-sym
)
4089 "Extend face in ALIST-SYM.
4091 If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
4092 with face extensions in ALIST-SYM; otherwise, overrides.
4094 If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
4095 otherwise, it should be an alist symbol.
4097 The elements of FACE-EXTENSION list have the form:
4099 (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
4101 FACE-NAME is a face name symbol.
4103 FOREGROUND and BACKGROUND may be nil or a string that denotes the
4104 foreground and background colors respectively.
4106 EXTENSION is one of the following symbols:
4107 bold - use bold font.
4108 italic - use italic font.
4109 underline - put a line under text.
4110 strikeout - like underline, but the line is in middle of text.
4111 overline - like underline, but the line is over the text.
4112 shadow - text will have a shadow.
4113 box - text will be surrounded by a box.
4114 outline - print characters as hollow outlines.
4116 If EXTENSION is any other symbol, it is ignored."
4118 (setq alist-sym
'ps-print-face-extension-alist
))
4119 (let* ((background (nth 2 face-extension
))
4120 (foreground (nth 1 face-extension
))
4121 (face-name (nth 0 face-extension
))
4122 (ps-face (cdr (assq face-name
(symbol-value alist-sym
))))
4123 (face-vector (or ps-face
(vector 0 nil nil
)))
4124 (face-bit (ps-extension-bit face-extension
)))
4126 (aset face-vector
0 (if merge-p
4127 (logior (aref face-vector
0) face-bit
)
4129 (and (or (not merge-p
) (and foreground
(stringp foreground
)))
4130 (aset face-vector
1 foreground
))
4131 (and (or (not merge-p
) (and background
(stringp background
)))
4132 (aset face-vector
2 background
))
4133 ;; if face does not exist, insert it
4135 (set alist-sym
(cons (cons face-name face-vector
)
4136 (symbol-value alist-sym
))))))
4139 (defun ps-extension-bit (face-extension)
4141 ;; map valid symbol extension to bit vector
4142 (setq face-extension
(cdr (cdr face-extension
)))
4143 (while (setq face-extension
(cdr face-extension
))
4144 (setq face-bit
(logior face-bit
4145 (or (cdr (assq (car face-extension
)
4146 ps-print-face-map-alist
))
4151 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4152 ;; Adapted from font-lock: (obsolete stuff)
4153 ;; Originally face attributes were specified via `font-lock-face-attributes'.
4154 ;; Users then changed the default face attributes by setting that variable.
4155 ;; However, we try and be back-compatible and respect its value if set except
4156 ;; for faces where M-x customize has been used to save changes for the face.
4159 (defun ps-font-lock-face-attributes ()
4160 (and (boundp 'font-lock-mode
) (symbol-value 'font-lock-mode
)
4161 (boundp 'font-lock-face-attributes
)
4162 (let ((face-attributes (symbol-value 'font-lock-face-attributes
)))
4163 (while face-attributes
4164 (let* ((face-attribute
4165 (car (prog1 face-attributes
4166 (setq face-attributes
(cdr face-attributes
)))))
4167 (face (car face-attribute
)))
4168 ;; Rustle up a `defface' SPEC from a
4169 ;; `font-lock-face-attributes' entry.
4170 (unless (get face
'saved-face
)
4171 (let ((foreground (nth 1 face-attribute
))
4172 (background (nth 2 face-attribute
))
4173 (bold-p (nth 3 face-attribute
))
4174 (italic-p (nth 4 face-attribute
))
4175 (underline-p (nth 5 face-attribute
))
4178 (setq face-spec
(cons ':foreground
4179 (cons foreground face-spec
))))
4181 (setq face-spec
(cons ':background
4182 (cons background face-spec
))))
4184 (setq face-spec
(append '(:weight bold
) face-spec
)))
4186 (setq face-spec
(append '(:slant italic
) face-spec
)))
4188 (setq face-spec
(append '(:underline t
) face-spec
)))
4189 (custom-declare-face face
(list (list t face-spec
)) nil
)
4193 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4194 ;; Internal functions and variables
4197 (defun ps-message-log-max ()
4198 (and (not (string= (buffer-name) "*Messages*"))
4199 (boundp 'message-log-max
)
4203 (defvar ps-print-hook nil
)
4204 (defvar ps-print-begin-sheet-hook nil
)
4205 (defvar ps-print-begin-page-hook nil
)
4206 (defvar ps-print-begin-column-hook nil
)
4209 (defun ps-print-without-faces (from to
&optional filename region-p
)
4210 (ps-spool-without-faces from to region-p
)
4211 (ps-do-despool filename
))
4214 (defun ps-spool-without-faces (from to
&optional region-p
)
4215 (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
4216 (run-hooks 'ps-print-hook
)
4217 (ps-printing-region region-p from to
)
4218 (ps-generate (current-buffer) from to
'ps-generate-postscript
)))
4221 (defun ps-print-with-faces (from to
&optional filename region-p
)
4222 (ps-spool-with-faces from to region-p
)
4223 (ps-do-despool filename
))
4226 (defun ps-spool-with-faces (from to
&optional region-p
)
4227 (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
4228 (run-hooks 'ps-print-hook
)
4229 (ps-printing-region region-p from to
)
4230 (ps-generate (current-buffer) from to
'ps-generate-postscript-with-faces
)))
4233 (defun ps-count-lines-preprint (from to
)
4235 (error "The mark is not set now"))
4236 (let ((message-log-max (ps-message-log-max))) ; to count lines of *Messages*
4237 (list (count-lines from to
))))
4240 (defun ps-count-lines (from to
)
4241 (+ (count-lines from to
)
4244 (if (= (current-column) 0) 1 0))))
4247 (defvar ps-printing-region nil
4248 "Variable used to indicate the region that ps-print is printing.
4249 It is a cons, the car of which is the line number where the region begins, and
4250 its cdr is the total number of lines in the buffer. Formatting functions can
4251 use this information to print the original line number (and not the number of
4252 lines printed), and to indicate in the header that the printout is of a partial
4256 (defvar ps-printing-region-p nil
4257 "Non-nil means ps-print is printing a region.")
4260 (defun ps-printing-region (region-p from to
)
4261 (setq ps-printing-region-p region-p
4264 (ps-count-lines (point-min) (min from to
))
4266 (ps-count-lines (point-min) (point-max)))))
4269 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4270 ;; Internal functions
4273 (defsubst ps-font-alist
(font-sym)
4274 (get font-sym
'fonts
))
4276 (defun ps-font (font-sym font-type
)
4277 "Font family name for text of `font-type', when generating PostScript."
4278 (let* ((font-list (ps-font-alist font-sym
))
4279 (normal-font (cdr (assq 'normal font-list
))))
4280 (while (and font-list
(not (eq font-type
(car (car font-list
)))))
4281 (setq font-list
(cdr font-list
)))
4282 (or (cdr (car font-list
)) normal-font
)))
4284 (defsubst ps-fonts
(font-sym)
4285 (mapcar 'cdr
(ps-font-alist font-sym
)))
4287 (defsubst ps-font-number
(font-sym font-type
)
4288 (or (ps-alist-position font-type
(ps-font-alist font-sym
))
4291 (defsubst ps-line-height
(font-sym)
4292 "The height of a line, for generating PostScript.
4293 This is the value that ps-print uses to determine the height,
4294 y-dimension, of the lines of text it has printed, and thus affects the
4295 point at which page-breaks are placed.
4296 The line-height is *not* the same as the point size of the font."
4297 (get font-sym
'line-height
))
4299 (defsubst ps-title-line-height
(font-sym)
4300 "The height of a `title' line, for generating PostScript.
4301 This is the value that ps-print uses to determine the height,
4302 y-dimension, of the lines of text it has printed, and thus affects the
4303 point at which page-breaks are placed.
4304 The title-line-height is *not* the same as the point size of the font."
4305 (get font-sym
'title-line-height
))
4307 (defsubst ps-space-width
(font-sym)
4308 "The width of a space character, for generating PostScript.
4309 This value is used in expanding tab characters."
4310 (get font-sym
'space-width
))
4312 (defsubst ps-avg-char-width
(font-sym)
4313 "The average width, in points, of a character, for generating PostScript.
4314 This is the value that ps-print uses to determine the length,
4315 x-dimension, of the text it has printed, and thus affects the point at
4316 which long lines wrap around."
4317 (get font-sym
'avg-char-width
))
4319 (defun ps-line-lengths-internal ()
4320 "Display the correspondence between a line length and a font size.
4321 Done using the current ps-print setup.
4322 Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
4323 (let* ((ps-font-size-internal
4324 (or ps-font-size-internal
4325 (ps-get-font-size 'ps-font-size
)))
4326 (ps-header-font-size-internal
4327 (or ps-header-font-size-internal
4328 (ps-get-font-size 'ps-header-font-size
)))
4329 (ps-footer-font-size-internal
4330 (or ps-footer-font-size-internal
4331 (ps-get-font-size 'ps-footer-font-size
)))
4332 (ps-header-title-font-size-internal
4333 (or ps-header-title-font-size-internal
4334 (ps-get-font-size 'ps-header-title-font-size
)))
4335 (buf (get-buffer-create "*Line-lengths*"))
4336 (ifs ps-font-size-internal
) ; initial font size
4337 (print-width (progn (ps-get-page-dimensions)
4339 (icw (ps-avg-char-width 'ps-font-for-text
)) ; initial character width
4340 (ps-setup (ps-setup)) ; setup for the current buffer
4341 (fs-min 5) ; minimum font size
4342 cw-min
; minimum character width
4343 nb-cpl-max
; maximum nb of characters per line
4344 (fs-max 14) ; maximum font size
4345 cw-max
; maximum character width
4346 nb-cpl-min
; minimum nb of characters per line
4347 fs
; current font size
4348 cw
; current character width
4349 nb-cpl
; current nb of characters per line
4351 (setq cw-min
(/ (* icw fs-min
) ifs
)
4352 nb-cpl-max
(floor (/ print-width cw-min
))
4353 cw-max
(/ (* icw fs-max
) ifs
)
4354 nb-cpl-min
(floor (/ print-width cw-max
))
4357 (goto-char (point-max))
4358 (or (bobp) (insert "\n" (make-string 75 ?\
;) "\n"))
4360 "\nnb char per line / font size\n")
4361 (while (<= nb-cpl nb-cpl-max
)
4362 (setq cw
(/ print-width
(float nb-cpl
))
4363 fs
(/ (* ifs cw
) icw
))
4364 (insert (format "%16d %s\n" nb-cpl fs
))
4365 (setq nb-cpl
(1+ nb-cpl
)))
4367 (display-buffer buf
'not-this-window
)))
4369 (defun ps-nb-pages (nb-lines)
4370 "Display correspondence between font size and the number of pages.
4371 The correspondence is based on having NB-LINES lines of text,
4372 and on the current ps-print setup."
4373 (let* ((ps-font-size-internal
4374 (or ps-font-size-internal
4375 (ps-get-font-size 'ps-font-size
)))
4376 (ps-header-font-size-internal
4377 (or ps-header-font-size-internal
4378 (ps-get-font-size 'ps-header-font-size
)))
4379 (ps-footer-font-size-internal
4380 (or ps-footer-font-size-internal
4381 (ps-get-font-size 'ps-footer-font-size
)))
4382 (ps-header-title-font-size-internal
4383 (or ps-header-title-font-size-internal
4384 (ps-get-font-size 'ps-header-title-font-size
)))
4385 (ps-line-spacing-internal
4386 (or ps-line-spacing-internal
4387 (ps-get-size ps-line-spacing
"line spacing")))
4388 (buf (get-buffer-create "*Nb-Pages*"))
4389 (ils ps-line-spacing-internal
) ; initial line spacing
4390 (ifs ps-font-size-internal
) ; initial font size
4391 (page-height (progn (ps-get-page-dimensions)
4393 (ilh (ps-line-height 'ps-font-for-text
)) ; initial line height
4394 (ps-setup (ps-setup)) ; setup for the current buffer
4395 (fs-min 4) ; minimum font size
4396 lh-min
; minimum line height
4397 nb-lpp-max
; maximum nb of lines per page
4398 nb-page-min
; minimum nb of pages
4399 (fs-max 14) ; maximum font size
4400 lh-max
; maximum line height
4401 nb-lpp-min
; minimum nb of lines per page
4402 nb-page-max
; maximum nb of pages
4403 fs
; current font size
4404 lh
; current line height
4405 nb-lpp
; current nb of lines per page
4406 nb-page
; current nb of pages
4408 (setq lh-min
(/ (- (* (+ ilh ils
) fs-min
) ils
) ifs
)
4409 nb-lpp-max
(floor (/ page-height lh-min
))
4410 nb-page-min
(ceiling (/ (float nb-lines
) nb-lpp-max
))
4411 lh-max
(/ (- (* (+ ilh ils
) fs-max
) ils
) ifs
)
4412 nb-lpp-min
(floor (/ page-height lh-max
))
4413 nb-page-max
(ceiling (/ (float nb-lines
) nb-lpp-min
))
4414 nb-page nb-page-min
)
4416 (goto-char (point-max))
4417 (or (bobp) (insert "\n" (make-string 75 ?\
;) "\n"))
4419 (format "\nThere are %d lines.\n\n" nb-lines
)
4420 "nb page / font size\n")
4421 (while (<= nb-page nb-page-max
)
4422 (setq nb-lpp
(ceiling (/ nb-lines
(float nb-page
)))
4423 lh
(/ page-height nb-lpp
)
4424 fs
(/ (* ifs lh
) ilh
))
4425 (insert (format "%7d %s\n" nb-page fs
))
4426 (setq nb-page
(1+ nb-page
)))
4428 (display-buffer buf
'not-this-window
)))
4430 ;; macros used in `ps-select-font'
4431 (defmacro ps-lookup
(key) `(cdr (assq ,key font-entry
)))
4432 (defmacro ps-size-scale
(key) `(/ (* (ps-lookup ,key
) font-size
) size
))
4434 (defun ps-select-font (font-family sym font-size title-font-size
)
4435 (let ((font-entry (cdr (assq font-family ps-font-info-database
))))
4437 (error "Don't have data to scale font %s. Known fonts families are %s"
4439 (mapcar 'car ps-font-info-database
)))
4440 (let ((size (ps-lookup 'size
)))
4441 (put sym
'fonts
(ps-lookup 'fonts
))
4442 (put sym
'space-width
(ps-size-scale 'space-width
))
4443 (put sym
'avg-char-width
(ps-size-scale 'avg-char-width
))
4444 (put sym
'line-height
(ps-size-scale 'line-height
))
4445 (put sym
'title-line-height
4446 (/ (* (ps-lookup 'line-height
) title-font-size
) size
)))))
4448 (defun ps-get-page-dimensions ()
4449 (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database
)))
4450 page-width page-height
)
4452 ((null page-dimensions
)
4453 (error "`ps-paper-type' must be one of:\n%s"
4454 (mapcar 'car ps-page-dimensions-database
)))
4455 ((< ps-number-of-columns
1)
4456 (error "The number of columns %d should be positive"
4457 ps-number-of-columns
)))
4459 (ps-select-font ps-font-family
'ps-font-for-text
4460 ps-font-size-internal ps-font-size-internal
)
4461 (ps-select-font ps-header-font-family
'ps-font-for-header
4462 ps-header-font-size-internal
4463 ps-header-title-font-size-internal
)
4464 (ps-select-font ps-footer-font-family
'ps-font-for-footer
4465 ps-footer-font-size-internal ps-footer-font-size-internal
)
4467 (setq page-width
(ps-page-dimensions-get-width page-dimensions
)
4468 page-height
(ps-page-dimensions-get-height page-dimensions
))
4471 (if ps-landscape-mode
4472 ;; exchange width and height
4473 (setq page-width
(prog1 page-height
(setq page-height page-width
))))
4475 ;; It is used to get the lower right corner (only in landscape mode)
4476 (setq ps-landscape-page-height page-height
)
4478 ;; | lm | text | ic | text | ic | text | rm |
4479 ;; page-width == lm + n * pw + (n - 1) * ic + rm
4480 ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
4481 (setq ps-print-width
(/ (- page-width
4482 ps-left-margin ps-right-margin
4483 (* (1- ps-number-of-columns
) ps-inter-column
))
4484 ps-number-of-columns
))
4485 (if (<= ps-print-width
0)
4486 (error "Bad horizontal layout:
4488 ps-left-margin == %s
4489 ps-right-margin == %s
4490 ps-inter-column == %s
4491 ps-number-of-columns == %s
4492 | lm | text | ic | text | ic | text | rm |
4493 page-width == lm + n * print-width + (n - 1) * ic + rm
4494 => print-width == %d !"
4499 ps-number-of-columns
4502 (setq ps-print-height
4503 (- page-height ps-bottom-margin ps-top-margin
))
4504 (if (<= ps-print-height
0)
4505 (error "Bad vertical layout:
4507 ps-bottom-margin == %s
4508 page-height == bm + print-height + tm
4509 => print-height == %d !"
4513 ;; If headers are turned on, deduct the height of the header from the print
4516 (setq ps-header-pad
(* ps-header-line-pad
4517 (ps-title-line-height 'ps-font-for-header
))
4518 ps-print-height
(- ps-print-height
4521 (ps-title-line-height 'ps-font-for-header
)
4522 (* (ps-line-height 'ps-font-for-header
)
4523 (1- ps-header-lines
))
4525 (if (<= ps-print-height
0)
4526 (error "Bad vertical layout (header):
4528 ps-bottom-margin == %s
4529 ps-header-offset == %s
4532 page-height == bm + print-height + tm - ho - hh
4533 => print-height == %d !"
4539 (ps-title-line-height 'ps-font-for-header
)
4540 (* (ps-line-height 'ps-font-for-header
)
4541 (1- ps-header-lines
))
4544 ;; If footers are turned on, deduct the height of the footer from the print
4547 (setq ps-footer-pad
(* ps-footer-line-pad
4548 (ps-title-line-height 'ps-font-for-footer
))
4549 ps-print-height
(- ps-print-height
4552 (* (ps-line-height 'ps-font-for-footer
)
4553 (1- ps-footer-lines
))
4555 (if (<= ps-print-height
0)
4556 (error "Bad vertical layout (footer):
4558 ps-bottom-margin == %s
4559 ps-footer-offset == %s
4562 page-height == bm + print-height + tm - fo - fh
4563 => print-height == %d !"
4569 (* (ps-line-height 'ps-font-for-footer
)
4570 (1- ps-footer-lines
))
4573 ;; ps-zebra-stripe-follow is `full' or `full-follow'
4574 (if ps-zebra-stripe-full-p
4575 (let* ((line-height (ps-line-height 'ps-font-for-text
))
4576 (zebra (* (+ line-height ps-line-spacing-internal
)
4577 ps-zebra-stripe-height
)))
4578 (setq ps-print-height
(- (* (floor ps-print-height zebra
) zebra
)
4580 (if (<= ps-print-height
0)
4581 (error "Bad vertical layout (full zebra stripe follow):
4582 ps-zebra-stripe-follow == %s
4583 ps-zebra-stripe-height == %s
4584 font-text-height == %s
4586 page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
4587 => print-height == %d !"
4588 ps-zebra-stripe-follow
4589 ps-zebra-stripe-height
4590 (ps-line-height 'ps-font-for-text
)
4591 ps-line-spacing-internal
4592 ps-print-height
))))))
4595 (defun ps-print-preprint-region (prefix)
4596 (or (ps-mark-active-p)
4597 (error "The mark is not set now"))
4598 (list (point) (mark) (ps-print-preprint prefix
)))
4601 (defun ps-print-preprint (prefix)
4603 (or (numberp prefix
)
4605 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4608 (prompt (format "Save PostScript to file (default %s): " name
))
4609 (res (read-file-name prompt default-directory name nil
)))
4610 (while (cond ((file-directory-p res
)
4612 (setq prompt
"It's a directory"))
4613 ((not (file-writable-p res
))
4615 (setq prompt
"File is unwritable"))
4616 ((file-exists-p res
)
4617 (setq prompt
"File exists")
4618 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4621 (setq res
(read-file-name
4622 (format "%s; save PostScript to file: " prompt
)
4623 (file-name-directory res
) nil nil
4624 (file-name-nondirectory res
))))
4625 (if (file-directory-p res
)
4626 (expand-file-name name
(file-name-as-directory res
))
4629 ;; The following functions implement a simple list-buffering scheme so
4630 ;; that ps-print doesn't have to repeatedly switch between buffers
4631 ;; while spooling. The functions `ps-output' and `ps-output-string' build
4632 ;; up the lists; the function `ps-flush-output' takes the lists and
4633 ;; insert its contents into the spool buffer (*PostScript*).
4635 (defvar ps-string-escape-codes
4636 (let ((table (make-vector 256 nil
))
4638 ;; control characters
4639 (while (<= char ?
\037)
4640 (aset table char
(format "\\%03o" char
))
4641 (setq char
(1+ char
)))
4642 ;; printable characters
4643 (while (< char ?
\177)
4644 (aset table char
(format "%c" char
))
4645 (setq char
(1+ char
)))
4646 ;; DEL and 8-bit characters
4647 (while (<= char ?
\377)
4648 (aset table char
(format "\\%o" char
))
4649 (setq char
(1+ char
)))
4650 ;; Override ASCII formatting characters with named escape code:
4651 (aset table ?
\n "\\n") ; [NL] linefeed
4652 (aset table ?
\r "\\r") ; [CR] carriage return
4653 (aset table ?
\t "\\t") ; [HT] horizontal tab
4654 (aset table ?
\b "\\b") ; [BS] backspace
4655 (aset table ?
\f "\\f") ; [NP] form feed
4656 ;; Escape PostScript escape and string delimiter characters:
4657 (aset table ?
\\ "\\\\")
4658 (aset table ?\
( "\\(")
4659 (aset table ?\
) "\\)")
4661 "Vector used to map characters to PostScript string escape codes.")
4663 (defsubst ps-output-string-prim
(string)
4664 (insert "(") ;insert start-string delimiter
4665 (save-excursion ;insert string
4666 (insert (string-as-unibyte string
)))
4667 ;; Find and quote special characters as necessary for PS
4668 ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
4669 (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
4670 (let ((special (following-char)))
4673 (if (and (<= 0 special
) (<= special
255))
4674 (aref ps-string-escape-codes special
)
4675 ;; insert hexadecimal representation if character code is out of range
4676 (format "\\%04X" special
)
4678 (goto-char (point-max))
4679 (insert ")")) ;insert end-string delimiter
4681 (defsubst ps-init-output-queue
()
4682 (setq ps-output-head
(list "")
4683 ps-output-tail ps-output-head
))
4686 (defun ps-selected-pages ()
4688 (setq ps-first-page
(car (car ps-selected-pages
))
4689 ps-last-page
(cdr (car ps-selected-pages
))
4690 ps-selected-pages
(cdr ps-selected-pages
))
4691 (and ps-selected-pages
4692 (< ps-last-page ps-page-postscript
)))))
4695 (defsubst ps-print-page-p
()
4696 (setq ps-print-page-p
4697 (and (cond ((null ps-first-page
))
4698 ((<= ps-page-postscript ps-last-page
)
4699 (<= ps-first-page ps-page-postscript
))
4702 (and (<= ps-first-page ps-page-postscript
)
4703 (<= ps-page-postscript ps-last-page
)))
4706 (cond ((eq ps-even-or-odd-pages
'even-page
)
4707 (= (logand ps-page-postscript
1) 0))
4708 ((eq ps-even-or-odd-pages
'odd-page
)
4709 (= (logand ps-page-postscript
1) 1))
4714 (defsubst ps-print-sheet-p
()
4715 (setq ps-print-page-p
4716 (cond ((eq ps-even-or-odd-pages
'even-sheet
)
4717 (= (logand ps-page-sheet
1) 0))
4718 ((eq ps-even-or-odd-pages
'odd-sheet
)
4719 (= (logand ps-page-sheet
1) 1))
4724 (defun ps-output (&rest args
)
4725 (when ps-print-page-p
4726 (setcdr ps-output-tail args
)
4727 (while (cdr ps-output-tail
)
4728 (setq ps-output-tail
(cdr ps-output-tail
)))))
4730 (defun ps-output-string (string)
4731 (ps-output t string
))
4733 ;; Output strings in the list ARGS in the PostScript prologue part.
4734 (defun ps-output-prologue (args)
4735 (ps-output 'prologue
(if (stringp args
) (list args
) args
)))
4737 (defun ps-flush-output ()
4738 (with-current-buffer ps-spool-buffer
4739 (goto-char (point-max))
4740 (while ps-output-head
4741 (let ((it (car ps-output-head
)))
4744 (setq ps-output-head
(cdr ps-output-head
))
4745 (ps-output-string-prim (car ps-output-head
)))
4747 (setq ps-output-head
(cdr ps-output-head
))
4749 (search-backward "\nBeginDoc")
4751 (apply 'insert
(car ps-output-head
))))
4754 (setq ps-output-head
(cdr ps-output-head
))))
4755 (ps-init-output-queue))
4757 (defun ps-insert-file (fname)
4759 (with-current-buffer ps-spool-buffer
4760 (goto-char (point-max))
4761 (insert-file-contents fname
)))
4763 ;; These functions insert the arrays that define the contents of the headers.
4765 (defvar ps-encode-header-string-function nil
)
4767 (defun ps-generate-header-line (fonttag &optional content
)
4768 (ps-output " [" fonttag
" ")
4770 ;; Literal strings should be output as is -- the string must contain its own
4771 ;; PS string delimiters, '(' and ')', if necessary.
4773 (ps-output content
))
4775 ;; Functions are called -- they should return strings; they will be inserted
4776 ;; as strings and the PS string delimiters added.
4777 ((functionp content
)
4778 (if (functionp ps-encode-header-string-function
)
4779 (dolist (l (funcall ps-encode-header-string-function
4780 (funcall content
) fonttag
))
4781 (ps-output-string l
))
4782 (ps-output-string (funcall content
))))
4784 ;; Variables will have their contents inserted. They should contain
4785 ;; strings, and will be inserted as strings.
4786 ((and (symbolp content
) (boundp content
))
4787 (if (fboundp ps-encode-header-string-function
)
4788 (dolist (l (funcall ps-encode-header-string-function
4789 (symbol-value content
) fonttag
))
4790 (ps-output-string l
))
4791 (ps-output-string (symbol-value content
))))
4793 ;; Anything else will get turned into an empty string.
4795 (ps-output-string "")))
4798 (defun ps-generate-header (name fonttag0 fonttag1 contents
)
4799 (ps-output "/" name
"[\n")
4800 (and contents
(> ps-header-lines
0)
4802 (ps-generate-header-line fonttag0
(car contents
))
4803 (while (and (< count ps-header-lines
)
4804 (setq contents
(cdr contents
)))
4805 (ps-generate-header-line fonttag1
(car contents
))
4806 (setq count
(1+ count
)))))
4807 (ps-output "]def\n"))
4810 (defun ps-output-boolean (name bool
)
4811 (ps-output (format "/%s %s def\n" name
(if bool
"true" "false"))))
4814 (defun ps-output-frame-properties (name alist
)
4815 (ps-output "/" name
" ["
4816 (ps-format-color (cdr (assq 'fore-color alist
)) 0.0)
4817 (ps-format-color (cdr (assq 'back-color alist
)) 0.9)
4818 (ps-float-format (or (cdr (assq 'border-width alist
)) 0.4))
4819 (ps-format-color (cdr (assq 'border-color alist
)) 0.0)
4820 (ps-format-color (cdr (assq 'shadow-color alist
)) 0.0)
4824 (defun ps-background-pages (page-list func
)
4828 (let ((start (if (consp pages
) (car pages
) pages
))
4829 (end (if (consp pages
) (cdr pages
) pages
)))
4830 (and (integerp start
) (integerp end
) (<= start end
)
4831 (add-to-list 'ps-background-pages
(vector start end func
)))))
4833 (setq ps-background-all-pages
(cons func ps-background-all-pages
))))
4836 (defconst ps-boundingbox-re
4838 \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
4841 (defun ps-get-boundingbox ()
4842 (with-current-buffer ps-spool-buffer
4844 (if (re-search-forward ps-boundingbox-re nil t
)
4845 (vector (string-to-number ; lower x
4846 (buffer-substring (match-beginning 1) (match-end 1)))
4847 (string-to-number ; lower y
4848 (buffer-substring (match-beginning 2) (match-end 2)))
4849 (string-to-number ; upper x
4850 (buffer-substring (match-beginning 3) (match-end 3)))
4851 (string-to-number ; upper y
4852 (buffer-substring (match-beginning 4) (match-end 4))))
4853 (vector 0 0 0 0)))))
4856 (defun ps-float-format (value &optional default
)
4857 (let ((literal (or value default
)))
4858 (cond ((null literal
)
4861 (format ps-float-format
(* literal
1.0))) ; force float number
4863 (format "%s " literal
))
4867 (defun ps-background-text ()
4870 (setq ps-background-text-count
(1+ ps-background-text-count
))
4871 (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count
))
4872 (ps-output-string (nth 0 text
)) ; text
4875 (ps-float-format (nth 4 text
) 200.0) ; font size
4876 (format "/%s " (or (nth 3 text
) "Times-Roman")) ; font name
4877 (ps-float-format (nth 6 text
)
4878 "PrintHeight PrintPageWidth atan") ; rotation
4879 (ps-float-format (nth 5 text
) 0.85) ; gray
4880 (ps-float-format (nth 1 text
) "0") ; x position
4881 (ps-float-format (nth 2 text
) "0") ; y position
4882 "\nShowBackText}def\n")
4883 (ps-background-pages (nthcdr 7 text
) ; page list
4884 (format "ShowBackText-%d\n"
4885 ps-background-text-count
)))
4886 ps-print-background-text
))
4889 (defun ps-background-image ()
4892 (let ((image-file (expand-file-name (nth 0 image
))))
4893 (when (file-readable-p image-file
)
4894 (setq ps-background-image-count
(1+ ps-background-image-count
))
4896 (format "/ShowBackImage-%d{\n--back-- "
4897 ps-background-image-count
)
4898 (ps-float-format (nth 5 image
) 0.0) ; rotation
4899 (ps-float-format (nth 3 image
) 1.0) ; x scale
4900 (ps-float-format (nth 4 image
) 1.0) ; y scale
4901 (ps-float-format (nth 1 image
) ; x position
4902 "PrintPageWidth 2 div")
4903 (ps-float-format (nth 2 image
) ; y position
4904 "PrintHeight 2 div BottomMargin add")
4905 "\nBeginBackImage\n")
4906 (ps-insert-file image-file
)
4907 ;; coordinate adjustment to center image
4908 ;; around x and y position
4909 (let ((box (ps-get-boundingbox)))
4910 (with-current-buffer ps-spool-buffer
4912 (if (re-search-backward "^--back--" nil t
)
4916 (- (+ (/ (- (aref box
2) (aref box
0)) 2.0)
4919 (- (+ (/ (- (aref box
3) (aref box
1)) 2.0)
4922 (ps-output "\nEndBackImage}def\n")
4923 (ps-background-pages (nthcdr 6 image
) ; page list
4924 (format "ShowBackImage-%d\n"
4925 ps-background-image-count
)))))
4926 ps-print-background-image
))
4929 (defun ps-background (page-number)
4930 (let (has-local-background)
4931 (mapc #'(lambda (range)
4932 (and (<= (aref range
0) page-number
)
4933 (<= page-number
(aref range
1))
4934 (if has-local-background
4935 (ps-output (aref range
2))
4936 (setq has-local-background t
)
4937 (ps-output "/printLocalBackground{\n"
4939 ps-background-pages
)
4940 (and has-local-background
(ps-output "}def\n"))))
4943 ;; Return a list of the distinct elements of LIST.
4944 ;; Elements are compared with `equal'.
4945 (defun ps-remove-duplicates (list)
4946 (let (new (tail list
))
4948 (or (member (car tail
) new
)
4949 (setq new
(cons (car tail
) new
)))
4950 (setq tail
(cdr tail
)))
4954 ;; Find the first occurrence of ITEM in LIST.
4955 ;; Return the index of the matching item, or nil if not found.
4956 ;; Elements are compared with `eq'.
4957 (defun ps-alist-position (item list
)
4958 (let ((tail list
) (index 0) found
)
4960 (if (setq found
(eq (car (car tail
)) item
))
4962 (setq index
(1+ index
)
4967 (defconst ps-n-up-database
5018 (2 t
1 2 0) ; adjusted by PostScript code
5061 (2 t
1 2 0) ; adjusted by PostScript code
5106 ;; Ledger paper size is a special case, it is the only paper size where the
5107 ;; normal size is landscaped, that is, the height is smaller than width.
5108 ;; So, we use the special value `pag' in the `landscape' field.
5157 (2 t
1 2 0) ; adjusted by PostScript code
5253 "Alist which is the page matrix database used for N-up printing.
5255 Each element has the following form:
5258 (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
5262 PAGE is the page size used (see `ps-paper-type').
5263 MAX is the maximum elements of this page matrix.
5264 LANDSCAPE specifies if page matrix is landscaped, has the following valid
5266 nil the sheet is in portrait mode.
5267 t the sheet is in landscape mode.
5268 pag the sheet is in portrait mode and page is in landscape mode.
5269 LINES is the number of lines of page matrix.
5270 COLUMNS is the number of columns of page matrix.
5271 COL-MISSING is the number of columns missing to fill the sheet.")
5274 (defmacro ps-n-up-landscape
(mat) `(nth 1 ,mat
))
5275 (defmacro ps-n-up-lines
(mat) `(nth 2 ,mat
))
5276 (defmacro ps-n-up-columns
(mat) `(nth 3 ,mat
))
5277 (defmacro ps-n-up-missing
(mat) `(nth 4 ,mat
))
5280 (defun ps-n-up-printing ()
5281 ;; force `ps-n-up-printing' be in range 1 to 100.
5282 (setq ps-n-up-printing
(max (min ps-n-up-printing
100) 1))
5283 ;; find suitable page matrix for a given `ps-paper-type'.
5284 (let ((the-list (cdr (assq ps-paper-type ps-n-up-database
))))
5286 (while (> ps-n-up-printing
(caar the-list
))
5287 (setq the-list
(cdr the-list
))))
5292 (defconst ps-n-up-filling-database
5294 "PageWidth" ; N-Up-XColumn
5296 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5297 "LandscapePageHeight neg" ; N-Up-YLine
5298 "N-Up-Lines" ; N-Up-Repeat
5299 "N-Up-Columns" ; N-Up-End
5303 "PageWidth" ; N-Up-XColumn
5305 "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
5306 "LandscapePageHeight" ; N-Up-YLine
5307 "N-Up-Lines" ; N-Up-Repeat
5308 "N-Up-Columns" ; N-Up-End
5310 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5312 "PageWidth neg" ; N-Up-XColumn
5314 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5315 "LandscapePageHeight neg" ; N-Up-YLine
5316 "N-Up-Lines" ; N-Up-Repeat
5317 "N-Up-Columns" ; N-Up-End
5318 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5321 "PageWidth neg" ; N-Up-XColumn
5323 "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
5324 "LandscapePageHeight" ; N-Up-YLine
5325 "N-Up-Lines" ; N-Up-Repeat
5326 "N-Up-Columns" ; N-Up-End
5327 "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
5328 "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5331 "LandscapePageHeight neg" ; N-Up-YColumn
5332 "PageWidth" ; N-Up-XLine
5333 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5334 "N-Up-Columns" ; N-Up-Repeat
5335 "N-Up-Lines" ; N-Up-End
5340 "LandscapePageHeight" ; N-Up-YColumn
5341 "PageWidth" ; N-Up-XLine
5342 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5343 "N-Up-Columns" ; N-Up-Repeat
5344 "N-Up-Lines" ; N-Up-End
5346 "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
5349 "LandscapePageHeight neg" ; N-Up-YColumn
5350 "PageWidth neg" ; N-Up-XLine
5351 "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
5352 "N-Up-Columns" ; N-Up-Repeat
5353 "N-Up-Lines" ; N-Up-End
5354 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5358 "LandscapePageHeight" ; N-Up-YColumn
5359 "PageWidth neg" ; N-Up-XLine
5360 "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
5361 "N-Up-Columns" ; N-Up-Repeat
5362 "N-Up-Lines" ; N-Up-End
5363 "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
5364 "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
5365 "Alist for n-up printing initializations.
5367 Each element has the following form:
5369 (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
5372 KIND is a valid value of `ps-n-up-filling'.
5373 XCOL YCOL are the relative position for the next column.
5374 XLIN YLIN are the relative position for the beginning of next line.
5375 REPEAT is the number of repetitions for external loop.
5376 END is the number of repetitions for internal loop and also the number
5378 XSTART YSTART are the relative position for the first page in a sheet.")
5381 (defun ps-n-up-filling ()
5382 (cdr (or (assq ps-n-up-filling ps-n-up-filling-database
)
5383 (assq 'left-top ps-n-up-filling-database
))))
5386 (defmacro ps-n-up-xcolumn
(init) `(nth 0 ,init
))
5387 (defmacro ps-n-up-ycolumn
(init) `(nth 1 ,init
))
5388 (defmacro ps-n-up-xline
(init) `(nth 2 ,init
))
5389 (defmacro ps-n-up-yline
(init) `(nth 3 ,init
))
5390 (defmacro ps-n-up-repeat
(init) `(nth 4 ,init
))
5391 (defmacro ps-n-up-end
(init) `(nth 5 ,init
))
5392 (defmacro ps-n-up-xstart
(init) `(nth 6 ,init
))
5393 (defmacro ps-n-up-ystart
(init) `(nth 7 ,init
))
5396 (defconst ps-error-handler-alist
5400 (paper-and-system .
3))
5401 "Alist for error handler message.")
5404 (defconst ps-zebra-stripe-alist
5408 "Alist for zebra stripe continuation.")
5411 (defun ps-begin-file ()
5412 (setq ps-page-order
0
5414 ps-background-text-count
0
5415 ps-background-image-count
0
5416 ps-background-pages nil
5417 ps-background-all-pages nil
)
5419 (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database
)))
5420 (tumble (if ps-landscape-mode
(not ps-spool-tumble
) ps-spool-tumble
))
5421 (n-up (ps-n-up-printing))
5422 (n-up-filling (ps-n-up-filling)))
5423 (and ps-n-up-on
(setq tumble
(not tumble
)))
5426 "%%Title: " (buffer-name) ; Take job name from name of
5427 ; first buffer printed
5428 "\n%%Creator: ps-print v" ps-print-version
5429 "\n%%For: " (user-full-name)
5430 "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
5432 (if ps-landscape-mode
"Landscape" "Portrait")
5433 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
5434 (mapconcat 'identity
5435 (ps-remove-duplicates
5436 (append (ps-fonts 'ps-font-for-text
)
5437 (list (ps-font 'ps-font-for-header
'normal
)
5438 (ps-font 'ps-font-for-header
'bold
)
5439 (ps-font 'ps-font-for-footer
'normal
)
5440 (ps-font 'ps-font-for-footer
'bold
))))
5442 "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
5443 "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions
)
5444 (format " %d" (round (ps-page-dimensions-get-width dimensions
)))
5445 (format " %d" (round (ps-page-dimensions-get-height dimensions
)))
5446 " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
5448 (if tumble
" duplex(tumble)\n" " duplex\n")
5451 (ps-insert-string ps-print-prologue-header
)
5453 (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
5454 (ps-page-dimensions-get-media dimensions
)
5455 "\n%%EndDefaults\n\n%%BeginProlog\n\n"
5456 "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
5457 (format "/ErrorMessage %s def\n\n"
5458 (or (cdr (assoc ps-error-handler-message
5459 ps-error-handler-alist
))
5462 "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
5464 (ps-insert-string ps-user-defined-prologue
)
5466 (ps-output "\n%%EndResource\n\n")
5468 (ps-output-boolean "LandscapeMode "
5469 (or ps-landscape-mode
5470 (eq (ps-n-up-landscape n-up
) 'pag
)))
5471 (ps-output-boolean "UpsideDown " ps-print-upside-down
)
5472 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns
)
5474 (format "/LandscapePageHeight %s def\n" ps-landscape-page-height
)
5475 (format "/PrintPageWidth %s def\n"
5476 (- (* (+ ps-print-width ps-inter-column
)
5477 ps-number-of-columns
)
5479 (format "/PrintWidth %s def\n" ps-print-width
)
5480 (format "/PrintHeight %s def\n" ps-print-height
)
5482 (format "/LeftMargin %s def\n" ps-left-margin
)
5483 (format "/RightMargin %s def\n" ps-right-margin
)
5484 (format "/InterColumn %s def\n" ps-inter-column
)
5486 (format "/BottomMargin %s def\n" ps-bottom-margin
)
5487 (format "/TopMargin %s def\n" ps-top-margin
) ; not used
5488 (format "/HeaderOffset %s def\n" ps-header-offset
)
5489 (format "/HeaderPad %s def\n" ps-header-pad
)
5490 (format "/FooterOffset %s def\n" ps-footer-offset
)
5491 (format "/FooterPad %s def\n" ps-footer-pad
)
5492 (format "/FooterLines %s def\n" ps-footer-lines
))
5494 (ps-output-boolean "ShowNofN " ps-show-n-of-n
)
5495 (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header
'duplex
)
5498 (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header
)
5499 (ps-output-boolean "PrintHeader " ps-print-header
)
5500 (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame
)
5501 (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist
)
5502 (ps-output-boolean "PrintFooter " ps-print-footer
)
5503 (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame
)
5504 (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist
)
5506 (let ((line-height (ps-line-height 'ps-font-for-text
)))
5507 (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal
)
5508 (format "/ParagraphSpacing %s def\n"
5509 ps-paragraph-spacing-internal
)
5510 (format "/LineHeight %s def\n" line-height
)
5511 (format "/LinesPerColumn %d def\n"
5512 (let ((height (+ line-height
5513 ps-line-spacing-internal
)))
5514 (round (/ (+ ps-print-height
5518 (ps-output-boolean "WarnPaperSize " ps-warn-paper-type
)
5519 (ps-output-boolean "Zebra " ps-zebra-stripes
)
5520 (ps-output-boolean "PrintLineNumber " ps-line-number
)
5521 (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step
)))
5522 (ps-output (format "/ZebraFollow %d def\n"
5523 (or (cdr (assq ps-zebra-stripe-follow
5524 ps-zebra-stripe-alist
))
5526 (format "/PrintLineStep %d def\n"
5527 (if (integerp ps-line-number-step
)
5529 ps-zebra-stripe-height
))
5530 (format "/PrintLineStart %d def\n" ps-line-number-start
)
5532 (ps-format-color ps-line-number-color
0.0)
5533 (format "def\n/ZebraHeight %d def\n"
5534 ps-zebra-stripe-height
)
5536 (ps-format-color ps-zebra-color
0.95)
5538 (ps-output "/BackgroundColor "
5539 (ps-format-color ps-default-background
1.0)
5541 (ps-output "/UseSetpagedevice "
5542 (if (eq ps-spool-config
'setpagedevice
)
5543 "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
5545 " def\n\n/PageWidth "
5546 "PrintPageWidth LeftMargin add RightMargin add def\n\n"
5547 (format "/N-Up %d def\n" ps-n-up-printing
))
5548 (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up
) t
))
5549 (ps-output-boolean "N-Up-Border " ps-n-up-border-p
)
5550 (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up
))
5551 (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up
))
5552 (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up
))
5553 (format "/N-Up-Margin %s def\n" ps-n-up-margin
)
5555 (if ps-landscape-mode
5556 (ps-n-up-end n-up-filling
)
5557 (ps-n-up-repeat n-up-filling
))
5559 (if ps-landscape-mode
5560 (ps-n-up-repeat n-up-filling
)
5561 (ps-n-up-end n-up-filling
))
5562 " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling
)
5563 " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling
)
5564 " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling
)
5565 " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling
)
5566 " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling
)
5567 " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling
) " def\n")
5569 (ps-background-text)
5570 (ps-background-image)
5571 (setq ps-background-all-pages
(nreverse ps-background-all-pages
)
5572 ps-background-pages
(nreverse ps-background-pages
))
5574 (ps-output "\n" ps-print-prologue-1
5575 "\n/printGlobalBackground{\n")
5576 (mapc 'ps-output ps-background-all-pages
)
5578 "}def\n/printLocalBackground{\n}def\n"
5579 "\n%%EndProlog\n\n%%BeginSetup\n"
5580 "\n%%IncludeResource: font Times-Roman"
5581 "\n%%IncludeResource: font Times-Italic"
5582 "\n%%IncludeResource: font "
5583 (mapconcat 'identity
5584 (ps-remove-duplicates
5585 (append (ps-fonts 'ps-font-for-text
)
5586 (list (ps-font 'ps-font-for-header
'normal
)
5587 (ps-font 'ps-font-for-header
'bold
)
5588 (ps-font 'ps-font-for-footer
'normal
)
5589 (ps-font 'ps-font-for-footer
'bold
))))
5590 "\n%%IncludeResource: font ")
5591 ;; Header/line number fonts
5592 (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
5593 ps-header-title-font-size-internal
5594 (ps-font 'ps-font-for-header
'bold
))
5595 (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
5596 ps-header-font-size-internal
5597 (ps-font 'ps-font-for-header
'normal
))
5598 (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
5599 (ps-get-font-size 'ps-line-number-font-size
)
5600 ps-line-number-font
)
5601 (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
5602 ps-footer-font-size-internal
5603 (ps-font 'ps-font-for-footer
'normal
))
5604 "\n\n% ---- These lines must be kept together because...
5607 /HeaderTitleLineHeight FontHeight def
5610 /HeaderLineHeight FontHeight def
5611 /HeaderDescent Descent def
5614 /FooterLineHeight FontHeight def
5615 /FooterDescent Descent def
5617 % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
5620 (let ((font (ps-font-alist 'ps-font-for-text
))
5623 (ps-output (format "/f%d %s(%s)cvn DefFont\n"
5625 ps-font-size-internal
5626 (ps-font 'ps-font-for-text
(car (car font
)))))
5627 (setq font
(cdr font
)
5630 (let ((font-entry (cdr (assq ps-font-family ps-font-info-database
))))
5631 (ps-output (format "/SpaceWidthRatio %f def\n"
5632 (/ (ps-lookup 'space-width
) (ps-lookup 'size
)))))
5634 (unless (eq ps-spool-config
'lpr-switches
)
5635 (ps-output "\n%%BeginFeature: *Duplex "
5636 (ps-boolean-capitalized ps-spool-duplex
)
5638 (ps-boolean-capitalized tumble
)
5639 "\nUseSetpagedevice\n{BMark/Duplex "
5640 (ps-boolean-constant ps-spool-duplex
)
5642 (ps-boolean-constant tumble
)
5643 " EMark setpagedevice}\n{statusdict begin "
5644 (ps-boolean-constant ps-spool-duplex
)
5646 (ps-boolean-constant tumble
)
5647 " settumble end}ifelse\n%%EndFeature\n")))
5648 (ps-output "\n%%BeginFeature: *ManualFeed "
5649 (ps-boolean-capitalized ps-manual-feed
)
5650 "\nBMark /ManualFeed "
5651 (ps-boolean-constant ps-manual-feed
)
5652 " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
5653 (and ps-banner-page-when-duplexing
5654 (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
5657 (defun ps-format-color (color &optional default
)
5658 (let ((the-color (if (stringp color
)
5659 (ps-color-scale color
)
5661 (if (and the-color
(listp the-color
))
5663 (format ps-color-format
5664 (* (nth 0 the-color
) 1.0) ; force float number
5665 (* (nth 1 the-color
) 1.0) ; force float number
5666 (* (nth 2 the-color
) 1.0)) ; force float number
5668 (ps-float-format (if (numberp the-color
) the-color default
)))))
5671 (defun ps-insert-string (prologue)
5672 (let ((str (if (functionp prologue
)
5679 (defun ps-boolean-capitalized (bool)
5680 (if bool
"True" "False"))
5683 (defun ps-boolean-constant (bool)
5684 (if bool
"true" "false"))
5687 (defun ps-header-dirpart ()
5688 (let ((fname (buffer-file-name)))
5690 (if (string-equal (buffer-name) (file-name-nondirectory fname
))
5691 (abbreviate-file-name (file-name-directory fname
))
5696 (defun ps-get-buffer-name ()
5698 ;; Indulge Jim this little easter egg:
5699 ((string= (buffer-name) "ps-print.el")
5700 "Hey, Cool! It's ps-print.el!!!")
5701 ;; Indulge Jack this other little easter egg:
5702 ((string= (buffer-name) "sokoban.el")
5703 "Super! C'est sokoban.el!")
5705 (and ps-printing-region-p
"Subset of: ")
5707 (and (buffer-modified-p) " (unsaved)")))))
5710 (defun ps-get-size (size mess
&optional arg
)
5711 (let ((siz (cond ((numberp size
)
5714 (numberp (car size
))
5715 (numberp (cdr size
)))
5716 (if ps-landscape-mode
5722 (error "Invalid %s `%S'%s"
5725 (format " for `%S'" arg
)
5730 (defun ps-get-font-size (font-sym)
5731 (ps-get-size (symbol-value font-sym
) "font size" font-sym
))
5734 (defun ps-rgb-color (color unspecified default
)
5736 ;; (float float float) ==> (R G B)
5737 ((and color
(listp color
) (= (length color
) 3)
5743 ok
(and (floatp e
) (<= 0.0 e
) (<= e
1.0))))
5746 ;; float ==> 0.0 = black .. 1.0 = white
5747 ((and (floatp color
) (<= 0.0 color
) (<= color
1.0))
5748 (list color color color
))
5749 ;; "colorName" but different from "unspecified-[bf]g"
5750 ((and (stringp color
) (not (string= color unspecified
)))
5751 (ps-color-scale color
))
5752 ;; ok, use the default
5754 (list default default default
))))
5756 (defvar ps-basic-plot-string-function
'ps-basic-plot-string
)
5758 (defun ps-begin-job (genfunc)
5760 (or (equal ps-mark-code-directory ps-postscript-code-directory
)
5761 (setq ps-print-prologue-0
(ps-prologue-file 0)
5762 ps-print-prologue-1
(ps-prologue-file 1)
5763 ps-mark-code-directory ps-postscript-code-directory
))
5766 (while ps-selected-pages
5767 (setq page
(car ps-selected-pages
)
5768 ps-selected-pages
(cdr ps-selected-pages
))
5769 (cond ((integerp page
)
5771 (setq new
(cons (cons page page
) new
))))
5773 (and (integerp (car page
)) (integerp (cdr page
))
5775 (<= (car page
) (cdr page
))
5776 (setq new
(cons page new
))))))
5777 (setq ps-selected-pages
(sort new
#'(lambda (one other
)
5778 (< (car one
) (car other
))))
5779 ps-last-selected-pages ps-selected-pages
5783 (or (listp ps-use-face-background
)
5784 (setq ps-use-face-background t
))
5786 (and (integerp ps-line-number-step
)
5787 (<= ps-line-number-step
0)
5788 (setq ps-line-number-step
1))
5789 (setq ps-n-up-on
(> ps-n-up-printing
1)
5790 ps-line-number-start
(max 1 (min ps-line-number-start
5791 (if (integerp ps-line-number-step
)
5793 ps-zebra-stripe-height
))))
5795 (with-current-buffer ps-spool-buffer
5796 (goto-char (point-max))
5797 (and (re-search-backward "^%%Trailer$" nil t
)
5798 (delete-region (match-beginning 0) (point-max))))
5800 (setq ps-zebra-stripe-full-p
(memq ps-zebra-stripe-follow
5801 '(full full-follow
))
5802 ps-page-postscript
0
5808 ps-showline-count
(car ps-printing-region
)
5809 ps-line-spacing-internal
(ps-get-size ps-line-spacing
5811 ps-paragraph-spacing-internal
(ps-get-size ps-paragraph-spacing
5812 "paragraph spacing")
5813 ps-font-size-internal
(ps-get-font-size 'ps-font-size
)
5814 ps-header-font-size-internal
(ps-get-font-size 'ps-header-font-size
)
5815 ps-header-title-font-size-internal
5816 (ps-get-font-size 'ps-header-title-font-size
)
5817 ps-footer-font-size-internal
(ps-get-font-size 'ps-footer-font-size
)
5818 ps-control-or-escape-regexp
5819 (cond ((eq ps-print-control-characters
'8-bit
)
5820 (string-as-unibyte "[\000-\037\177-\377]"))
5821 ((eq ps-print-control-characters
'control-8-bit
)
5822 (string-as-unibyte "[\000-\037\177-\237]"))
5823 ((eq ps-print-control-characters
'control
)
5826 ;; Set the color scale. We do it here instead of in the defvar so
5827 ;; that ps-print can be dumped into emacs. This expression can't be
5828 ;; evaluated at dump-time because X isn't initialized.
5829 ps-color-p
(and ps-print-color-p
(ps-color-device))
5830 ps-print-color-scale
(if ps-color-p
5831 (float (car (ps-color-values "white")))
5833 ps-default-background
(ps-rgb-color
5835 ((or (member ps-print-color-p
5837 (eq genfunc
'ps-generate-postscript
))
5839 ((eq ps-default-bg
'frame-parameter
)
5840 (ps-frame-parameter nil
'background-color
))
5841 ((eq ps-default-bg t
)
5842 (ps-face-background-name 'default
))
5847 ps-default-foreground
(ps-rgb-color
5849 ((or (member ps-print-color-p
5851 (eq genfunc
'ps-generate-postscript
))
5853 ((eq ps-default-fg
'frame-parameter
)
5854 (ps-frame-parameter nil
'foreground-color
))
5855 ((eq ps-default-fg t
)
5856 (ps-face-foreground-name 'default
))
5861 ps-foreground-list
(mapcar
5863 (ps-rgb-color arg
"unspecified-fg" 0.0))
5864 (append (and (not (member ps-print-color-p
5867 (list ps-default-foreground
5869 ps-default-color
(and (not (member ps-print-color-p
5871 ps-default-foreground
)
5872 ps-current-color ps-default-color
5873 ;; Set up default functions.
5874 ;; They may be overridden by ps-mule-begin-job.
5875 ps-basic-plot-string-function
'ps-basic-plot-string
5876 ps-encode-header-string-function nil
)
5877 ;; initialize page dimensions
5878 (ps-get-page-dimensions)
5880 (unless (listp ps-lpr-switches
)
5881 (error "`ps-lpr-switches' value should be a list"))
5883 (equal ps-default-background ps-default-foreground
)
5886 "`ps-default-fg' and `ps-default-bg' have the same color.\n"
5887 "Text won't appear on page. Please, check these variables."))))
5890 (defun ps-page-number ()
5891 (if ps-print-only-one-header
5892 (1+ (/ (1- ps-page-column
) ps-number-of-columns
))
5896 (defsubst ps-end-page
()
5897 (ps-output "EndPage\nEndDSCPage\n"))
5900 (defsubst ps-next-page
()
5906 (defun ps-end-sheet ()
5907 (and ps-print-page-p
(> ps-page-sheet
0)
5908 (ps-output "EndSheet\n")))
5911 (defun ps-header-sheet ()
5912 ;; Print only when a new sheet begins.
5914 (setq ps-page-sheet
(1+ ps-page-sheet
))
5915 (when (ps-print-sheet-p)
5916 (setq ps-page-order
(1+ ps-page-order
))
5917 (ps-output (if ps-n-up-on
5918 (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
5919 ps-page-order ps-page-postscript ps-page-order
)
5920 (format "\n%%%%Page: %d %d\n"
5921 ps-page-postscript ps-page-order
))
5922 ;; spooling needs to redefine Lines and PageCount on each page
5923 "/Lines 0 def\n/PageCount 0 def\n"
5924 (format "%d BeginSheet\nBeginDSCPage\n"
5925 ps-n-up-printing
))))
5928 (defun ps-header-page ()
5929 ;; set total line and page number when printing has finished
5930 ;; (see `ps-generate')
5931 (if (zerop (mod ps-page-column ps-number-of-columns
))
5933 (setq ps-page-postscript
(1+ ps-page-postscript
))
5934 (when (ps-print-page-p)
5936 (if (zerop (mod ps-page-n-up ps-n-up-printing
))
5937 ;; Print only when a new sheet begins.
5940 (run-hooks 'ps-print-begin-sheet-hook
))
5941 ;; Print only when a new page begins.
5942 (ps-output "BeginDSCPage\n")
5943 (run-hooks 'ps-print-begin-page-hook
))
5944 (ps-background ps-page-postscript
)
5945 (setq ps-page-n-up
(1+ ps-page-n-up
))
5946 (and ps-print-page-p
5947 (setq ps-page-printed
(1+ ps-page-printed
)))))
5948 ;; Print only when a new column begins.
5949 (ps-output "BeginDSCPage\n")
5950 (run-hooks 'ps-print-begin-column-hook
))
5951 (setq ps-page-column
(1+ ps-page-column
)))
5953 (defun ps-begin-page ()
5954 (setq ps-width-remaining ps-print-width
5955 ps-height-remaining ps-print-height
)
5959 (ps-output (format "/LineNumber %d def\n" ps-showline-count
)
5960 (format "/PageNumber %d def\n" (ps-page-number)))
5962 (when ps-print-header
5963 (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header
)
5964 (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header
)
5965 (ps-output (format "%d SetHeaderLines\n" ps-header-lines
)))
5967 (when ps-print-footer
5968 (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer
)
5969 (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer
)
5970 (ps-output (format "%d SetFooterLines\n" ps-footer-lines
)))
5972 (ps-output (number-to-string ps-lines-printed
) " BeginPage\n")
5973 (ps-set-font ps-current-font
)
5974 (ps-set-bg ps-current-bg
)
5975 (ps-set-color ps-current-color
))
5977 (defsubst ps-skip-newline
(limit)
5978 (setq ps-showline-count
(1+ ps-showline-count
)
5979 ps-lines-printed
(1+ ps-lines-printed
))
5980 (and (< (point) limit
)
5983 (defsubst ps-next-line
()
5984 (setq ps-showline-count
(1+ ps-showline-count
)
5985 ps-lines-printed
(1+ ps-lines-printed
))
5986 (let* ((paragraph-p (and ps-paragraph-regexp
5987 (looking-at ps-paragraph-regexp
)))
5988 (lh (+ (ps-line-height 'ps-font-for-text
)
5990 ps-paragraph-spacing-internal
5991 ps-line-spacing-internal
))))
5992 (if (< ps-height-remaining lh
)
5994 (setq ps-width-remaining ps-print-width
5995 ps-height-remaining
(- ps-height-remaining lh
))
5996 (ps-output (if paragraph-p
"PHL\n" "LHL\n")))))
5998 (defun ps-continue-line ()
5999 (setq ps-lines-printed
(1+ ps-lines-printed
))
6000 (let ((lh (+ (ps-line-height 'ps-font-for-text
) ps-line-spacing-internal
)))
6001 (if (< ps-height-remaining lh
)
6003 (setq ps-width-remaining ps-print-width
6004 ps-height-remaining
(- ps-height-remaining lh
))
6005 (ps-output "SL\n"))))
6007 (defun ps-find-wrappoint (from to char-width
)
6008 (let ((avail (truncate (/ ps-width-remaining char-width
)))
6011 (cons to
(* todo char-width
))
6012 (cons (+ from avail
) ps-width-remaining
))))
6014 (defun ps-basic-plot-str (from to string
)
6015 (let* ((wrappoint (ps-find-wrappoint from to
6016 (ps-avg-char-width 'ps-font-for-text
)))
6017 (to (car wrappoint
))
6018 (str (substring string from to
)))
6019 (ps-output-string str
)
6023 (defun ps-basic-plot-string (from to
&optional _bg-color
)
6024 (let* ((wrappoint (ps-find-wrappoint from to
6025 (ps-avg-char-width 'ps-font-for-text
)))
6026 (to (car wrappoint
))
6027 (string (buffer-substring-no-properties from to
)))
6028 (ps-output-string string
)
6032 (defun ps-basic-plot-whitespace (from to
&optional _bg-color
)
6033 (let* ((wrappoint (ps-find-wrappoint from to
6034 (ps-space-width 'ps-font-for-text
)))
6035 (to (car wrappoint
)))
6036 (ps-output (format "%d W\n" (- to from
)))
6039 (defun ps-plot (plotfunc from to
&optional bg-color
)
6041 (let* ((wrappoint (funcall plotfunc from to bg-color
))
6042 (plotted-to (car wrappoint
))
6043 (plotted-width (cdr wrappoint
)))
6044 (setq from plotted-to
6045 ps-width-remaining
(- ps-width-remaining plotted-width
))
6047 (ps-continue-line))))
6048 (if ps-razzle-dazzle
6049 (let* ((q-todo (- (point-max) (point-min)))
6050 (q-done (- (point) (point-min)))
6051 (chunkfrac (/ q-todo
8))
6052 (chunksize (min chunkfrac
1000)))
6053 (if (> (- q-done ps-razchunk
) chunksize
)
6055 (setq ps-razchunk q-done
)
6056 (message "Formatting...%3d%%"
6058 (/ (* 100 q-done
) q-todo
)
6059 (/ q-done
(/ q-todo
100)))
6062 (defvar ps-last-font nil
)
6064 (defun ps-set-font (font)
6065 (setq ps-last-font
(format "f%d" (setq ps-current-font font
)))
6066 (ps-output (format "/%s F\n" ps-last-font
)))
6068 (defun ps-set-bg (color)
6069 (if (setq ps-current-bg color
)
6070 (ps-output (format ps-color-format
6071 (nth 0 color
) (nth 1 color
) (nth 2 color
))
6073 (ps-output "false BG\n")))
6075 (defun ps-set-color (color)
6076 (setq ps-current-color
(or color ps-default-foreground
))
6077 (ps-output (format ps-color-format
6078 (nth 0 ps-current-color
)
6079 (nth 1 ps-current-color
) (nth 2 ps-current-color
))
6083 (defsubst ps-plot-string
(string)
6084 (ps-plot 'ps-basic-plot-str
0 (length string
) string
))
6087 (defvar ps-current-effect
0)
6089 (defvar ps-print-translation-table
6090 (let ((tbl (make-char-table 'translation-table nil
)))
6091 (if (and (boundp 'ucs-mule-8859-to-mule-unicode
)
6092 (char-table-p ucs-mule-8859-to-mule-unicode
))
6095 (if (and v
(eq (char-charset v
) 'latin-iso8859-1
) (/= k v
))
6097 ucs-mule-8859-to-mule-unicode
))
6099 "Translation table for PostScript printing.
6100 The default value is a table that translates non-Latin-1 Latin characters
6101 to the equivalent Latin-1 characters.")
6103 (defun ps-plot-region (from to font
&optional fg-color bg-color effects
)
6104 (or (equal font ps-current-font
)
6107 ;; Specify a foreground color only if:
6109 ;; it's different than the background (if `ps-fg-validate-p' is non-nil)
6110 ;; and it's different than the current.
6111 (let ((fg (or fg-color ps-default-foreground
)))
6112 (if ps-fg-validate-p
6113 (let ((bg (or bg-color ps-default-background
))
6114 (el ps-foreground-list
))
6115 (while (and el
(equal fg bg
))
6118 (or (equal fg ps-current-color
)
6121 (or (equal bg-color ps-current-bg
)
6122 (ps-set-bg bg-color
))
6124 ;; Specify effects (underline, overline, box, etc.)
6126 ((not (integerp effects
))
6127 (ps-output "0 EF\n")
6128 (setq ps-current-effect
0))
6129 ((/= effects ps-current-effect
)
6130 (ps-output (number-to-string effects
) " EF\n")
6131 (setq ps-current-effect effects
)))
6133 ;; Starting at the beginning of the specified region...
6137 ;; ...break the region up into chunks separated by tabs, linefeeds,
6138 ;; pagefeeds, control characters, and plot each chunk.
6140 ;; skip lines between cut markers
6141 (and ps-begin-cut-regexp ps-end-cut-regexp
6142 (looking-at ps-begin-cut-regexp
)
6144 (goto-char (match-end 0))
6145 (and (re-search-forward ps-end-cut-regexp to
'noerror
)
6146 (= (following-char) ?
\n)
6148 (setq from
(point))))
6149 (if (re-search-forward ps-control-or-escape-regexp to t
)
6150 ;; region with some control characters or some multi-byte characters
6151 (let* ((match-point (match-beginning 0))
6152 (match (char-after match-point
)))
6153 (when (< from match-point
)
6154 (ps-plot ps-basic-plot-string-function
6155 from match-point bg-color
))
6157 ((= match ?
\t) ; tab
6158 (let ((linestart (line-beginning-position)))
6160 (setq from
(+ linestart
(current-column)))
6161 (when (re-search-forward "[ \t]+" to t
)
6162 (ps-plot 'ps-basic-plot-whitespace
6163 from
(+ linestart
(current-column))
6166 ((= match ?
\n) ; newline
6167 (if (looking-at "\f[^\n]")
6168 ;; \n\ftext\n ==>> next page, but keep line counting!!
6170 (ps-skip-newline to
)
6172 ;; \n\f\n ==>> it'll be handled by form feed
6173 ;; \ntext\n ==>> next line
6176 ((= match ?
\f) ; form feed
6177 ;; do not skip page if previous character is NEWLINE and
6178 ;; it is a beginning of page.
6179 (unless (and (equal (char-after (1- match-point
)) ?
\n)
6180 (= ps-height-remaining ps-print-height
))
6181 ;; \f\n ==>> skip \n, but keep line counting!!
6182 (and (equal (following-char) ?
\n)
6183 (ps-skip-newline to
))
6186 (t ; characters from 127 to 255
6187 (ps-control-character match
)))
6188 (setq from
(point)))
6189 ;; region without control characters
6190 (ps-plot ps-basic-plot-string-function from to bg-color
)
6193 (defvar ps-string-control-codes
6194 (let ((table (make-vector 256 nil
))
6196 ;; control character
6197 (while (<= char ?
\037)
6198 (aset table char
(format "^%c" (+ char ?
@)))
6199 (setq char
(1+ char
)))
6200 ;; printable character
6201 (while (< char ?
\177)
6202 (aset table char
(format "%c" char
))
6203 (setq char
(1+ char
)))
6205 (aset table char
"^?")
6207 (while (<= (setq char
(1+ char
)) ?
\377)
6208 (aset table char
(format "\\%o" char
)))
6210 "Vector used to map characters to a printable string.")
6212 (defun ps-control-character (char)
6213 (let* ((str (aref ps-string-control-codes char
))
6217 (char-width (ps-avg-char-width 'ps-font-for-text
))
6218 (wrappoint (ps-find-wrappoint from to char-width
)))
6219 (if (< (car wrappoint
) to
)
6221 (setq ps-width-remaining
(- ps-width-remaining
(* len char-width
)))
6222 (ps-output-string str
)
6223 (ps-output " S\n")))
6226 (defsubst ps-face-foreground-color-p
(attr)
6227 (memq attr
'(foreground-color :foreground
)))
6230 (defsubst ps-face-background-color-p
(attr)
6231 (memq attr
'(background-color :background
)))
6234 (defsubst ps-face-color-p
(attr)
6235 (memq attr
'(foreground-color :foreground background-color
:background
)))
6238 (defun ps-face-extract-color (face-attrs)
6239 (let ((color (cdr face-attrs
)))
6245 (defun ps-face-attributes (face)
6246 "Return face attribute vector.
6248 If FACE is not in `ps-print-face-extension-alist' or in
6249 `ps-print-face-alist', insert it on `ps-print-face-alist' and
6250 return the attribute vector.
6252 If FACE is not a valid face name, use default face."
6253 (and (stringp face
) (facep face
) (setq face
(intern face
)))
6255 (ps-black-white-faces-alist
6256 (or (and (symbolp face
)
6257 (cdr (assq face ps-black-white-faces-alist
)))
6258 (vector 0 nil nil
)))
6260 (cdr (or (assq face ps-print-face-extension-alist
)
6261 (assq face ps-print-face-alist
)
6262 (let* ((the-face (if (facep face
) face
'default
))
6263 (new-face (ps-screen-to-bit-face the-face
)))
6264 (or (and (eq the-face
'default
)
6265 (assq the-face ps-print-face-alist
))
6266 (setq ps-print-face-alist
6267 (cons new-face ps-print-face-alist
)))
6269 ((ps-face-foreground-color-p (car face
))
6270 (vector 0 (ps-face-extract-color face
) nil
))
6271 ((ps-face-background-color-p (car face
))
6272 (vector 0 nil
(ps-face-extract-color face
)))
6274 (vector 0 nil nil
))))
6277 (defun ps-face-background (face background
)
6278 (and (cond ((eq ps-use-face-background t
)) ; always
6279 ((null ps-use-face-background
) nil
) ; never
6280 ;; ps-user-face-background is a symbol face list
6282 (memq face ps-use-face-background
))
6284 (or (ps-face-color-p (car face
))
6287 (if (or (memq (car face
) ps-use-face-background
)
6288 (ps-face-color-p (car face
)))
6291 (setq face
(cdr face
))))
6299 (defun ps-face-attribute-list (face-or-list)
6302 ((not (listp face-or-list
))
6303 (ps-face-attributes face-or-list
))
6304 ;; only foreground color, not a `real' face
6305 ((ps-face-foreground-color-p (car face-or-list
))
6306 (vector 0 (ps-face-extract-color face-or-list
) nil
))
6307 ;; only background color, not a `real' face
6308 ((ps-face-background-color-p (car face-or-list
))
6309 (vector 0 nil
(ps-face-extract-color face-or-list
)))
6313 foreground background face-attr face
)
6315 (setq face
(car face-or-list
)
6316 face-or-list
(cdr face-or-list
)
6317 face-attr
(ps-face-attributes face
)
6318 effects
(logior effects
(aref face-attr
0)))
6319 (or foreground
(setq foreground
(aref face-attr
1)))
6321 (setq background
(ps-face-background face
(aref face-attr
2)))))
6322 (vector effects foreground background
)))))
6325 (defconst ps-font-type
(vector nil
'bold
'italic
'bold-italic
))
6328 (defun ps-plot-with-face (from to face
)
6330 ((null face
) ; print text with null face
6331 (ps-plot-region from to
0))
6332 ((eq face
'emacs--invisible--face
)) ; skip invisible text!!!
6333 (t ; otherwise, text has a valid face
6334 (let* ((face-bit (ps-face-attribute-list face
))
6335 (effect (aref face-bit
0))
6336 (foreground (aref face-bit
1))
6337 (background (ps-face-background face
(aref face-bit
2)))
6338 (fg-color (if (and ps-color-p foreground
)
6339 (ps-color-scale foreground
)
6341 (bg-color (and ps-color-p background
6342 (ps-color-scale background
))))
6345 (ps-font-number 'ps-font-for-text
6346 (or (aref ps-font-type
(logand effect
3))
6348 fg-color bg-color
(lsh effect -
2)))))
6352 ;; Ensure that face-list is fbound.
6353 (or (fboundp 'face-list
) (defalias 'face-list
'list-faces
))
6356 (defun ps-build-reference-face-lists ()
6357 ;; Ensure that face database is updated with faces on
6358 ;; `font-lock-face-attributes' (obsolete stuff)
6359 (ps-font-lock-face-attributes)
6360 ;; Now, rebuild reference face lists
6361 (setq ps-print-face-alist nil
)
6362 (if ps-auto-font-detect
6363 (mapc 'ps-map-face
(face-list))
6364 (mapc 'ps-set-face-bold ps-bold-faces
)
6365 (mapc 'ps-set-face-italic ps-italic-faces
)
6366 (mapc 'ps-set-face-underline ps-underlined-faces
))
6367 (setq ps-build-face-reference nil
))
6370 (defun ps-set-face-bold (face)
6371 (ps-set-face-attribute face
1))
6373 (defun ps-set-face-italic (face)
6374 (ps-set-face-attribute face
2))
6376 (defun ps-set-face-underline (face)
6377 (ps-set-face-attribute face
4))
6380 (defun ps-set-face-attribute (face effect
)
6381 (let ((face-bit (cdr (ps-map-face face
))))
6382 (aset face-bit
0 (logior (aref face-bit
0) effect
))))
6385 (defun ps-map-face (face)
6386 (let* ((face-map (ps-screen-to-bit-face face
))
6387 (ps-face-bit (cdr (assq (car face-map
) ps-print-face-alist
))))
6389 ;; if face exists, merge both
6390 (let ((face-bit (cdr face-map
)))
6391 (aset ps-face-bit
0 (logior (aref ps-face-bit
0) (aref face-bit
0)))
6392 (or (aref ps-face-bit
1) (aset ps-face-bit
1 (aref face-bit
1)))
6393 (or (aref ps-face-bit
2) (aset ps-face-bit
2 (aref face-bit
2))))
6394 ;; if face does not exist, insert it
6395 (setq ps-print-face-alist
(cons face-map ps-print-face-alist
)))
6399 (defun ps-screen-to-bit-face (face)
6401 (vector (logior (if (ps-face-bold-p face
) 1 0) ; bold
6402 (if (ps-face-italic-p face
) 2 0) ; italic
6403 (if (ps-face-underlined-p face
) 4 0) ; underline
6404 (if (ps-face-strikeout-p face
) 8 0) ; strikeout
6405 (if (ps-face-overline-p face
) 16 0) ; overline
6406 (if (ps-face-box-p face
) 64 0)) ; box
6407 (ps-face-foreground-name face
)
6408 (ps-face-background-name face
))))
6411 (declare-function jit-lock-fontify-now
"jit-lock" (&optional start end
))
6412 (declare-function lazy-lock-fontify-region
"lazy-lock" (beg end
))
6414 ;; to avoid compilation gripes
6415 (defun ps-print-ensure-fontified (start end
)
6416 (cond ((and (boundp 'jit-lock-mode
) (symbol-value 'jit-lock-mode
))
6417 (jit-lock-fontify-now start end
))
6418 ((and (boundp 'lazy-lock-mode
) (symbol-value 'lazy-lock-mode
))
6419 (lazy-lock-fontify-region start end
))))
6422 (defun ps-generate-postscript-with-faces (from to
)
6423 ;; Some initialization...
6424 (setq ps-current-effect
0)
6426 ;; Build the reference lists of faces if necessary.
6427 (when (or ps-always-build-face-reference
6428 ps-build-face-reference
)
6429 (message "Collecting face information...")
6430 (ps-build-reference-face-lists))
6432 ;; Black/white printer.
6433 (setq ps-black-white-faces-alist nil
)
6434 (and (eq ps-print-color-p
'black-white
)
6435 (ps-extend-face-list ps-black-white-faces nil
6436 'ps-black-white-faces-alist
))
6438 ;; Generate some PostScript.
6440 (narrow-to-region from to
)
6441 (ps-print-ensure-fontified from to
)
6442 (ps-generate-postscript-with-faces1 from to
)))
6444 (defun ps-generate-postscript (from to
)
6445 (ps-plot-region from to
0))
6447 ;; These are autoloaded, but ps-mule generates autoloads at the end of
6448 ;; this file, so they are unknown at this point when compiling.
6449 (declare-function ps-mule-initialize
"ps-mule" ())
6450 (declare-function ps-mule-begin-job
"ps-mule" (from to
))
6451 (declare-function ps-mule-end-job
"ps-mule" ())
6453 (defun ps-generate (buffer from to genfunc
)
6455 (let ((from (min to from
))
6457 ;; This avoids trouble if chars with read-only properties
6458 ;; are copied into ps-spool-buffer.
6459 (inhibit-read-only t
))
6461 (narrow-to-region from to
)
6462 (and ps-razzle-dazzle
6463 (message "Formatting...%3d%%" (setq ps-razchunk
0)))
6464 (setq ps-source-buffer buffer
6465 ps-spool-buffer
(get-buffer-create ps-spool-buffer-name
))
6466 (ps-init-output-queue)
6467 (let (safe-marker completed-safely needs-begin-file
)
6470 (set-buffer ps-spool-buffer
)
6471 (set-buffer-multibyte nil
)
6473 ;; Get a marker and make it point to the current end of the
6474 ;; buffer, If an error occurs, we'll delete everything from
6475 ;; the end of this marker onwards.
6476 (setq safe-marker
(make-marker))
6477 (set-marker safe-marker
(point-max))
6479 (goto-char (point-min))
6480 (or (looking-at (regexp-quote ps-adobe-tag
))
6481 (setq needs-begin-file t
))
6483 (set-buffer ps-source-buffer
)
6485 (let ((ps-print-page-p t
)
6486 ps-even-or-odd-pages
)
6487 (ps-begin-job genfunc
)
6488 (when needs-begin-file
6490 (ps-mule-initialize))
6491 (ps-mule-begin-job from to
)
6492 (ps-selected-pages)))
6494 (funcall genfunc from to
)
6497 (ps-end-job needs-begin-file
)
6499 ;; Setting this variable tells the unwind form that the
6500 ;; the PostScript was generated without error.
6501 (setq completed-safely t
))
6503 ;; Unwind form: If some bad mojo occurred while generating
6504 ;; PostScript, delete all the PostScript that was generated.
6505 ;; This protects the previously spooled files from getting
6507 (and (markerp safe-marker
) (not completed-safely
)
6509 (set-buffer ps-spool-buffer
)
6510 (delete-region (marker-position safe-marker
) (point-max))))))
6512 (and ps-razzle-dazzle
(message "Formatting...done"))))))
6515 (defun ps-end-job (needs-begin-file)
6516 (let ((ps-print-page-p t
))
6519 (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing
))
6520 (total-lines (cdr ps-printing-region
))
6521 (total-pages (ps-page-number)))
6522 (set-buffer ps-spool-buffer
)
6523 (let (case-fold-search)
6524 ;; Back to the PS output buffer to set the last page n-up printing
6525 (goto-char (point-max))
6526 (and (> pages-per-sheet
0)
6527 (re-search-backward "^[0-9]+ BeginSheet$" nil t
)
6528 (replace-match (format "%d BeginSheet" pages-per-sheet
) t
))
6529 ;; Back to the PS output buffer to set the page count
6530 (goto-char (point-min))
6531 (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t
)
6532 (replace-match (format "/Lines %d def\n/PageCount %d def"
6533 total-lines total-pages
) t
)))))
6535 (and ps-spool-duplex
(= (mod ps-page-order
2) 1)
6536 (let ((ps-n-up-printing 0))
6538 (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
6539 "/PrintLineNumber false def\n"
6540 (number-to-string ps-lines-printed
) " BeginPage\n")
6542 ;; Set end of PostScript file
6544 (ps-output "\n%%Trailer\n%%Pages: "
6546 (if (and needs-begin-file
6547 ps-banner-page-when-duplexing
)
6550 "\n\nEndDoc\n\n%%EOF\n")
6551 (and ps-end-with-control-d
6554 ;; disable selected pages
6555 (setq ps-selected-pages nil
))
6558 ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
6559 (defun ps-do-despool (filename)
6560 (if (or (not (boundp 'ps-spool-buffer
))
6561 (not (symbol-value 'ps-spool-buffer
)))
6562 (message "No spooled PostScript to print")
6565 (and ps-razzle-dazzle
(message "Saving..."))
6566 (set-buffer ps-spool-buffer
)
6567 (setq filename
(expand-file-name filename
))
6568 (let ((coding-system-for-write 'raw-text-unix
))
6569 (write-region (point-min) (point-max) filename
))
6570 (and ps-razzle-dazzle
(message "Wrote %s" filename
)))
6571 ;; Else, spool to the printer
6572 (and ps-razzle-dazzle
(message "Printing..."))
6573 (with-current-buffer ps-spool-buffer
6574 (let* ((coding-system-for-write 'raw-text-unix
)
6575 (ps-printer-name (or ps-printer-name
6576 (and (boundp 'printer-name
)
6577 (symbol-value 'printer-name
))))
6579 (append ps-lpr-switches
6580 (and (stringp ps-printer-name
)
6581 (string< "" ps-printer-name
)
6583 (and (stringp ps-printer-name-option
)
6584 ps-printer-name-option
)
6585 ps-printer-name
))))))
6586 (or (stringp ps-printer-name
)
6587 (setq ps-printer-name nil
))
6588 (apply (or ps-print-region-function
'call-process-region
)
6589 (point-min) (point-max) ps-lpr-command nil
6590 (and (fboundp 'start-process
) 0)
6592 (ps-flatten-list ; dynamic evaluation
6594 (mapcar 'ps-eval-switch ps-lpr-switches
))))))
6595 (and ps-razzle-dazzle
(message "Printing...done")))
6596 (kill-buffer ps-spool-buffer
)))
6598 (defun ps-string-list (arg)
6601 (cond ((stringp elm
)
6602 (setq lstr
(cons elm lstr
)))
6604 (let ((s (ps-string-list elm
)))
6606 (setq lstr
(cons s lstr
)))))
6607 (t ))) ; ignore any other value
6610 ;; Dynamic evaluation
6611 (defun ps-eval-switch (arg)
6612 (cond ((stringp arg
) arg
)
6613 ((functionp arg
) (apply arg nil
))
6614 ((symbolp arg
) (symbol-value arg
))
6615 ((consp arg
) (apply (car arg
) (cdr arg
)))
6618 ;; `ps-flatten-list' is defined here (copied from "message.el" and
6619 ;; enhanced to handle dotted pairs as well) until we can get some
6620 ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
6622 ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
6623 ;; => (a b c d e f g h i j)
6625 (defun ps-flatten-list (&rest list
)
6626 (ps-flatten-list-1 list
))
6628 (defun ps-flatten-list-1 (list)
6629 (cond ((null list
) nil
)
6630 ((consp list
) (append (ps-flatten-list-1 (car list
))
6631 (ps-flatten-list-1 (cdr list
))))
6634 (defun ps-kill-emacs-check ()
6636 (and (setq ps-buffer
(get-buffer ps-spool-buffer-name
))
6637 (buffer-name ps-buffer
) ; check if it's not killed
6638 (buffer-modified-p ps-buffer
)
6639 (y-or-n-p "Unprinted PostScript waiting; print now? ")
6641 (and (setq ps-buffer
(get-buffer ps-spool-buffer-name
))
6642 (buffer-name ps-buffer
) ; check if it's not killed
6643 (buffer-modified-p ps-buffer
)
6644 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
6645 (error "Unprinted PostScript"))))
6647 (cond ((fboundp 'add-hook
)
6648 (unless noninteractive
6649 (funcall 'add-hook
'kill-emacs-hook
'ps-kill-emacs-check
)))
6651 (message "Won't override existing `kill-emacs-hook'"))
6653 (setq kill-emacs-hook
'ps-kill-emacs-check
)))
6656 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6657 ;; To make this file smaller, some commands go in a separate file.
6658 ;; But autoload them here to make the separation invisible.
6660 ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
6661 ;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "86bf8e46dac41afe73df5ab098038ab0")
6662 ;;; Generated autoloads from ps-mule.el
6664 (defvar ps-multibyte-buffer nil
"\
6665 Specifies the multi-byte buffer handling.
6669 nil This is the value to use the default settings;
6670 by default, this only works to print buffers with
6671 only ASCII and Latin characters. But this default
6672 setting can be changed by setting the variable
6673 `ps-mule-font-info-database-default' differently.
6674 The initial value of this variable is
6675 `ps-mule-font-info-database-latin' (see
6678 `non-latin-printer' This is the value to use when you have a Japanese
6679 or Korean PostScript printer and want to print
6680 buffer with ASCII, Latin-1, Japanese (JISX0208 and
6681 JISX0201-Kana) and Korean characters. At present,
6682 it was not tested with the Korean characters
6683 printing. If you have a korean PostScript printer,
6686 `bdf-font' This is the value to use when you want to print
6687 buffer with BDF fonts. BDF fonts include both latin
6688 and non-latin fonts. BDF (Bitmap Distribution
6689 Format) is a format used for distributing X's font
6690 source file. BDF fonts are included in
6691 `intlfonts-1.2' which is a collection of X11 fonts
6692 for all characters supported by Emacs. In order to
6693 use this value, be sure to have installed
6694 `intlfonts-1.2' and set the variable
6695 `bdf-directory-list' appropriately (see ps-bdf.el for
6696 documentation of this variable).
6698 `bdf-font-except-latin' This is like `bdf-font' except that it uses
6699 PostScript default fonts to print ASCII and Latin-1
6700 characters. This is convenient when you want or
6701 need to use both latin and non-latin characters on
6702 the same buffer. See `ps-font-family',
6703 `ps-header-font-family' and `ps-font-info-database'.
6705 Any other value is treated as nil.")
6707 (custom-autoload 'ps-multibyte-buffer
"ps-mule" t
)
6709 (autoload 'ps-mule-initialize
"ps-mule" "\
6710 Initialize global data for printing multi-byte characters.
6714 (autoload 'ps-mule-begin-job
"ps-mule" "\
6715 Start printing job for multi-byte chars between FROM and TO.
6716 It checks if all multi-byte characters in the region are printable or not.
6718 \(fn FROM TO)" nil nil
)
6720 (autoload 'ps-mule-end-job
"ps-mule" "\
6721 Finish printing job for multi-byte chars.
6727 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6731 ;;; ps-print.el ends here