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