aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKenichi Handa2000-01-05 08:11:30 +0000
committerKenichi Handa2000-01-05 08:11:30 +0000
commit41481e4bcd41a0d8ca9b74ef742494cc3d764533 (patch)
treec11de21e75b28458f3a28aaff503fde8736dff5f
parent894ee0a289ace271980e08d4e00800ad3284d493 (diff)
downloademacs-41481e4bcd41a0d8ca9b74ef742494cc3d764533.tar.gz
emacs-41481e4bcd41a0d8ca9b74ef742494cc3d764533.zip
PostScript code now is in separate files, doc fix.
(ps-print-version): New version number (5.0.3). (ps-header-lines, ps-left-header, ps-right-header): No more buffer local. (ps-spool-config): Initialization fix. (ps-print-prologue-1, ps-print-prologue-2, ps-print-duplex-feature): PostScript code moved to separated file. (ps-background-image): Little code reformating. (ps-begin-file, ps-begin-job): Fix code. (ps-postscript-code-directory, ps-mark-code-directory): New vars. (ps-prologue-file): New fun.
-rw-r--r--lisp/ps-print.el876
1 files changed, 80 insertions, 796 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index 69bf1fc1e15..0ceb66f4a21 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -9,11 +9,11 @@
9;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) 9;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
10;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> 10;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
11;; Keywords: wp, print, PostScript 11;; Keywords: wp, print, PostScript
12;; Time-stamp: <99/12/11 20:14:41 vinicius> 12;; Time-stamp: <99/12/18 13:21:51 vinicius>
13;; Version: 5.0.2 13;; Version: 5.0.3
14 14
15(defconst ps-print-version "5.0.2" 15(defconst ps-print-version "5.0.3"
16 "ps-print.el, v 5.0.2 <99/12/11 vinicius> 16 "ps-print.el, v 5.0.3 <99/12/18 vinicius>
17 17
18Vinicius's last change version -- this file may have been edited as part of 18Vinicius's last change version -- this file may have been edited as part of
19Emacs without changes to the version number. When reporting bugs, 19Emacs without changes to the version number. When reporting bugs,
@@ -976,7 +976,7 @@ Please send all bug fixes and enhancements to
976;; 976;;
977;; Faces are always treated as opaque. 977;; Faces are always treated as opaque.
978;; 978;;
979;; Epoch and Emacs 18 not supported. At all. 979;; Epoch and Emacs 19 not supported. At all.
980;; 980;;
981;; Fixed-pitch fonts work better for line folding, but are not required. 981;; Fixed-pitch fonts work better for line folding, but are not required.
982;; 982;;
@@ -1591,7 +1591,6 @@ See also `ps-print-header'."
1591 "*Number of lines to display in page header, when generating PostScript." 1591 "*Number of lines to display in page header, when generating PostScript."
1592 :type 'integer 1592 :type 'integer
1593 :group 'ps-print-header) 1593 :group 'ps-print-header)
1594(make-variable-buffer-local 'ps-header-lines)
1595 1594
1596(defcustom ps-show-n-of-n t 1595(defcustom ps-show-n-of-n t
1597 "*Non-nil means show page numbers as N/M, meaning page N of M. 1596 "*Non-nil means show page numbers as N/M, meaning page N of M.
@@ -1600,8 +1599,9 @@ NOTE: page numbers are displayed as part of headers,
1600 :type 'boolean 1599 :type 'boolean
1601 :group 'ps-print-header) 1600 :group 'ps-print-header)
1602 1601
1603(defcustom ps-spool-config (if (memq system-type '(ms-dos windows-nt)) 1602(defcustom ps-spool-config (if (memq system-type
1604 'setpagedevice 1603 '(win32 w32 mswindows ms-dos windows-nt))
1604 nil
1605 'lpr-switches) 1605 'lpr-switches)
1606 "*Specify who is responsable for setting duplex and page size switches. 1606 "*Specify who is responsable for setting duplex and page size switches.
1607 1607
@@ -1913,7 +1913,6 @@ In either case, function or variable, the string value has PostScript
1913string delimiters added to it." 1913string delimiters added to it."
1914 :type '(repeat (choice string symbol)) 1914 :type '(repeat (choice string symbol))
1915 :group 'ps-print-header) 1915 :group 'ps-print-header)
1916(make-variable-buffer-local 'ps-left-header)
1917 1916
1918(defcustom ps-right-header 1917(defcustom ps-right-header
1919 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss) 1918 (list "/pagenumberstring load" 'time-stamp-mon-dd-yyyy 'time-stamp-hh:mm:ss)
@@ -1924,7 +1923,6 @@ See the variable `ps-left-header' for a description of the format of
1924this variable." 1923this variable."
1925 :type '(repeat (choice string symbol)) 1924 :type '(repeat (choice string symbol))
1926 :group 'ps-print-header) 1925 :group 'ps-print-header)
1927(make-variable-buffer-local 'ps-right-header)
1928 1926
1929(defcustom ps-razzle-dazzle t 1927(defcustom ps-razzle-dazzle t
1930 "*Non-nil means report progress while formatting buffer." 1928 "*Non-nil means report progress while formatting buffer."
@@ -1968,6 +1966,12 @@ It's like the very first character of buffer (or region) is ^L (\\014)."
1968 :type 'boolean 1966 :type 'boolean
1969 :group 'ps-print-header) 1967 :group 'ps-print-header)
1970 1968
1969(defcustom ps-postscript-code-directory data-directory
1970 "*Directory where it's located the PostScript prologue file used by ps-print.
1971By default, this directory is the same as in the variable `data-directory'."
1972 :type 'directory
1973 :group 'ps-print)
1974
1971 1975
1972;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1976;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1973;; Customization 1977;; Customization
@@ -2252,758 +2256,32 @@ The table depends on the current ps-print setup."
2252 2256
2253(require 'time-stamp) 2257(require 'time-stamp)
2254 2258
2255(defconst ps-print-prologue-1
2256 "
2257% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
2258/ISOLatin1Encoding where { pop } {
2259% -- The ISO Latin-1 encoding vector isn't known, so define it.
2260% -- The first half is the same as the standard encoding,
2261% -- except for minus instead of hyphen at code 055.
2262/ISOLatin1Encoding
2263StandardEncoding 0 45 getinterval aload pop
2264 /minus
2265StandardEncoding 46 82 getinterval aload pop
2266%*** NOTE: the following are missing in the Adobe documentation,
2267%*** but appear in the displayed table:
2268%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
2269% 0200 (128)
2270 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
2271 /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
2272 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
2273 /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
2274% 0240 (160)
2275 /space /exclamdown /cent /sterling
2276 /currency /yen /brokenbar /section
2277 /dieresis /copyright /ordfeminine /guillemotleft
2278 /logicalnot /hyphen /registered /macron
2279 /degree /plusminus /twosuperior /threesuperior
2280 /acute /mu /paragraph /periodcentered
2281 /cedilla /onesuperior /ordmasculine /guillemotright
2282 /onequarter /onehalf /threequarters /questiondown
2283% 0300 (192)
2284 /Agrave /Aacute /Acircumflex /Atilde
2285 /Adieresis /Aring /AE /Ccedilla
2286 /Egrave /Eacute /Ecircumflex /Edieresis
2287 /Igrave /Iacute /Icircumflex /Idieresis
2288 /Eth /Ntilde /Ograve /Oacute
2289 /Ocircumflex /Otilde /Odieresis /multiply
2290 /Oslash /Ugrave /Uacute /Ucircumflex
2291 /Udieresis /Yacute /Thorn /germandbls
2292% 0340 (224)
2293 /agrave /aacute /acircumflex /atilde
2294 /adieresis /aring /ae /ccedilla
2295 /egrave /eacute /ecircumflex /edieresis
2296 /igrave /iacute /icircumflex /idieresis
2297 /eth /ntilde /ograve /oacute
2298 /ocircumflex /otilde /odieresis /divide
2299 /oslash /ugrave /uacute /ucircumflex
2300 /udieresis /yacute /thorn /ydieresis
2301256 packedarray def
2302} ifelse
2303
2304/reencodeFontISO { %def
2305 dup
2306 length 12 add dict % Make a new font (a new dict the same size
2307 % as the old one) with room for our new symbols.
2308
2309 begin % Make the new font the current dictionary.
2310
2311
2312 { 1 index /FID ne
2313 { def } { pop pop } ifelse
2314 } forall % Copy each of the symbols from the old dictionary
2315 % to the new one except for the font ID.
2316
2317 currentdict /FontType get 0 ne {
2318 /Encoding ISOLatin1Encoding def % Override the encoding with
2319 % the ISOLatin1 encoding.
2320 } if
2321
2322 % Use the font's bounding box to determine the ascent, descent,
2323 % and overall height; don't forget that these values have to be
2324 % transformed using the font's matrix.
2325
2326% ^ (x2 y2)
2327% | |
2328% | v
2329% | +----+ - -
2330% | | | ^
2331% | | | | Ascent (usually > 0)
2332% | | | |
2333% (0 0) -> +--+----+-------->
2334% | | |
2335% | | v Descent (usually < 0)
2336% (x1 y1) --> +----+ - -
2337
2338 currentdict /FontType get 0 ne {
2339 /FontBBox load aload pop % -- x1 y1 x2 y2
2340 FontMatrix transform /Ascent exch def pop
2341 FontMatrix transform /Descent exch def pop
2342 } {
2343 /PrimaryFont FDepVector 0 get def
2344 PrimaryFont /FontBBox get aload pop
2345 PrimaryFont /FontMatrix get transform /Ascent exch def pop
2346 PrimaryFont /FontMatrix get transform /Descent exch def pop
2347 } ifelse
2348
2349 /FontHeight Ascent Descent sub def % use `sub' because descent < 0
2350
2351 % Define these in case they're not in the FontInfo
2352 % (also, here they're easier to get to).
2353 /UnderlinePosition Descent 0.70 mul def
2354 /OverlinePosition Descent UnderlinePosition sub Ascent add def
2355 /StrikeoutPosition Ascent 0.30 mul def
2356 /LineThickness FontHeight 0.05 mul def
2357 /Xshadow FontHeight 0.08 mul def
2358 /Yshadow FontHeight -0.09 mul def
2359 /SpaceBackground Descent neg UnderlinePosition add def
2360 /XBox Descent neg def
2361 /YBox LineThickness 0.7 mul def
2362
2363 currentdict % Leave the new font on the stack
2364 end % Stop using the font as the current dictionary.
2365 definefont % Put the font into the font dictionary
2366 pop % Discard the returned font.
2367} bind def
2368
2369/DefFont { % Font definition
2370 findfont exch scalefont reencodeFontISO
2371} def
2372
2373/F { % Font selection
2374 findfont
2375 dup /Ascent get /Ascent exch def
2376 dup /Descent get /Descent exch def
2377 dup /FontHeight get /FontHeight exch def
2378 dup /UnderlinePosition get /UnderlinePosition exch def
2379 dup /OverlinePosition get /OverlinePosition exch def
2380 dup /StrikeoutPosition get /StrikeoutPosition exch def
2381 dup /LineThickness get /LineThickness exch def
2382 dup /Xshadow get /Xshadow exch def
2383 dup /Yshadow get /Yshadow exch def
2384 dup /SpaceBackground get /SpaceBackground exch def
2385 dup /XBox get /XBox exch def
2386 dup /YBox get /YBox exch def
2387 setfont
2388} def
2389
2390/FG /setrgbcolor load def
2391
2392/bg false def
2393/BG {
2394 dup /bg exch def
2395 {mark 4 1 roll ]}
2396 {[ 1.0 1.0 1.0 ]}
2397 ifelse
2398 /bgcolor exch def
2399} def
2400
2401% B width C
2402% +-----------+
2403% | Ascent (usually > 0)
2404% A + +
2405% | Descent (usually < 0)
2406% +-----------+
2407% E width D
2408
2409/dobackground { % width --
2410 currentpoint % -- width x y
2411 gsave
2412 newpath
2413 moveto % A (x y)
2414 0 Ascent rmoveto % B
2415 dup 0 rlineto % C
2416 0 Descent Ascent sub rlineto % D
2417 neg 0 rlineto % E
2418 closepath
2419 bgcolor aload pop setrgbcolor
2420 fill
2421 grestore
2422} def
2423
2424/eolbg { % dobackground until right margin
2425 PrintWidth % -- x-eol
2426 currentpoint pop % -- cur-x
2427 sub % -- width until eol
2428 dobackground
2429} def
2430
2431/PLN {PrintLineNumber {doLineNumber}if} def
2432
2433/SL { % Soft Linefeed
2434 bg { eolbg } if
2435 0 currentpoint exch pop LineHeight sub moveto
2436} def
2437
2438/HL {SL PLN} def % Hard Linefeed
2439
2440% Some debug
2441/dcp { currentpoint exch 40 string cvs print (, ) print = } def
2442/dp { print 2 copy exch 40 string cvs print (, ) print = } def
2443
2444/W {
2445 ( ) stringwidth % Get the width of a space in the current font.
2446 pop % Discard the Y component.
2447 mul % Multiply the width of a space
2448 % by the number of spaces to plot
2449 bg { dup dobackground } if
2450 0 rmoveto
2451} def
2452
2453/Effect 0 def
2454/EF {/Effect exch def} def
2455
2456% stack: string |- --
2457% effect: 1 - underline 2 - strikeout 4 - overline
2458% 8 - shadow 16 - box 32 - outline
2459/S {
2460 /xx currentpoint dup Descent add /yy exch def
2461 Ascent add /YY exch def def
2462 dup stringwidth pop xx add /XX exch def
2463 Effect 8 and 0 ne {
2464 /yy yy Yshadow add def
2465 /XX XX Xshadow add def
2466 } if
2467 bg {
2468 true
2469 Effect 16 and 0 ne
2470 {SpaceBackground doBox}
2471 {xx yy XX YY doRect}
2472 ifelse
2473 } if % background
2474 Effect 16 and 0 ne {false 0 doBox}if % box
2475 Effect 8 and 0 ne {dup doShadow}if % shadow
2476 Effect 32 and 0 ne
2477 {true doOutline} % outline
2478 {show} % normal text
2479 ifelse
2480 Effect 1 and 0 ne {UnderlinePosition Hline}if % underline
2481 Effect 2 and 0 ne {StrikeoutPosition Hline}if % strikeout
2482 Effect 4 and 0 ne {OverlinePosition Hline}if % overline
2483} bind def
2484
2485% stack: position |- --
2486/Hline {
2487 currentpoint exch pop add dup
2488 gsave
2489 newpath
2490 xx exch moveto
2491 XX exch lineto
2492 closepath
2493 LineThickness setlinewidth stroke
2494 grestore
2495} bind def
2496
2497% stack: fill-or-not delta |- --
2498/doBox {
2499 /dd exch def
2500 xx XBox sub dd sub yy YBox sub dd sub
2501 XX XBox add dd add YY YBox add dd add
2502 doRect
2503} bind def
2504
2505% stack: fill-or-not lower-x lower-y upper-x upper-y |- --
2506/doRect {
2507 /rYY exch def
2508 /rXX exch def
2509 /ryy exch def
2510 /rxx exch def
2511 gsave
2512 newpath
2513 rXX rYY moveto
2514 rxx rYY lineto
2515 rxx ryy lineto
2516 rXX ryy lineto
2517 closepath
2518 % top of stack: fill-or-not
2519 {FillBgColor}
2520 {LineThickness setlinewidth stroke}
2521 ifelse
2522 grestore
2523} bind def
2524
2525% stack: string |- --
2526/doShadow {
2527 gsave
2528 Xshadow Yshadow rmoveto
2529 false doOutline
2530 grestore
2531} bind def
2532
2533/st 1 string def
2534
2535% stack: string fill-or-not |- --
2536/doOutline {
2537 /-fillp- exch def
2538 /-ox- currentpoint /-oy- exch def def
2539 gsave
2540 LineThickness setlinewidth
2541 {
2542 st 0 3 -1 roll put
2543 st dup true charpath
2544 -fillp- {gsave FillBgColor grestore}if
2545 stroke stringwidth
2546 -oy- add /-oy- exch def
2547 -ox- add /-ox- exch def
2548 -ox- -oy- moveto
2549 } forall
2550 grestore
2551 -ox- -oy- moveto
2552} bind def
2553
2554% stack: --
2555/FillBgColor {bgcolor aload pop setrgbcolor fill} bind def
2556
2557/L0 6 /Times-Italic DefFont
2558
2559% stack: --
2560/doLineNumber {
2561 /LineNumber where
2562 {
2563 pop
2564 currentfont
2565 gsave
2566 0.0 0.0 0.0 setrgbcolor
2567 /L0 findfont setfont
2568 LineNumber Lines ge
2569 {(end )}
2570 {LineNumber 6 string cvs ( ) strcat}
2571 ifelse
2572 dup stringwidth pop neg 0 rmoveto
2573 show
2574 grestore
2575 setfont
2576 /LineNumber LineNumber 1 add def
2577 } if
2578} def
2579
2580% stack: --
2581/printZebra {
2582 gsave
2583 ZebraGray setgray
2584 /double-zebra ZebraHeight ZebraHeight add def
2585 /yiter double-zebra LineHeight mul neg def
2586 /xiter PrintWidth InterColumn add def
2587 NumberOfColumns {LinesPerColumn doColumnZebra xiter 0 rmoveto}repeat
2588 grestore
2589} def
2590
2591% stack: lines-per-column |- --
2592/doColumnZebra {
2593 gsave
2594 dup double-zebra idiv {ZebraHeight doZebra 0 yiter rmoveto}repeat
2595 double-zebra mod
2596 dup 0 le {pop}{dup ZebraHeight gt {pop ZebraHeight}if doZebra}ifelse
2597 grestore
2598} def
2599
2600% stack: zebra-height (in lines) |- --
2601/doZebra {
2602 /zh exch 0.05 sub LineHeight mul def
2603 gsave
2604 0 LineHeight 0.65 mul rmoveto
2605 PrintWidth 0 rlineto
2606 0 zh neg rlineto
2607 PrintWidth neg 0 rlineto
2608 0 zh rlineto
2609 fill
2610 grestore
2611} def
2612
2613% tx ty rotation xscale yscale xpos ypos BeginBackImage
2614/BeginBackImage {
2615 /-save-image- save def
2616 /showpage {}def
2617 translate
2618 scale
2619 rotate
2620 translate
2621} def
2622
2623/EndBackImage {
2624 -save-image- restore
2625} def
2626
2627% string fontsize fontname rotation gray xpos ypos ShowBackText
2628/ShowBackText {
2629 gsave
2630 translate
2631 setgray
2632 rotate
2633 findfont exch dup /-offset- exch -0.25 mul def scalefont setfont
2634 0 -offset- moveto
2635 /-saveLineThickness- LineThickness def
2636 /LineThickness 1 def
2637 false doOutline
2638 /LineThickness -saveLineThickness- def
2639 grestore
2640} def
2641
2642/BeginDoc {
2643 % ---- Remember space width of the normal text font `f0'.
2644 /SpaceWidth /f0 findfont setfont ( ) stringwidth pop def
2645 % ---- save the state of the document (useful for ghostscript!)
2646 /docState save def
2647 % ---- [andrewi] set PageSize based on chosen dimensions
2648 UseSetpagedevice {
2649 0
2650 {<< /PageSize [PageWidth LandscapePageHeight] >> setpagedevice}
2651 CheckConfig
2652 }{
2653 LandscapeMode {
2654 % ---- translate to bottom-right corner of Portrait page
2655 LandscapePageHeight 0 translate
2656 90 rotate
2657 }if
2658 }ifelse
2659 % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
2660 /JackGhostscript where {pop 1 27.7 29.7 div scale}if
2661 % ---- N-Up printing
2662 N-Up 1 gt {
2663 % ---- landscape
2664 N-Up-Landscape {
2665 PageWidth 0 translate
2666 90 rotate
2667 }if
2668 N-Up-Margin dup translate
2669 % ---- scale
2670 LandscapeMode{
2671 /HH PageWidth def
2672 /WW LandscapePageHeight def
2673 }{
2674 /HH LandscapePageHeight def
2675 /WW PageWidth def
2676 }ifelse
2677 WW N-Up-Margin sub N-Up-Margin sub
2678 N-Up-Landscape
2679 {N-Up-Lines div HH}{N-Up-Columns N-Up-Missing add div WW}ifelse
2680 div dup scale
2681 0 N-Up-Repeat 1 sub LandscapePageHeight mul translate
2682 % ---- go to start position in page matrix
2683 N-Up-XStart N-Up-Missing 0.5 mul
2684 LandscapeMode{
2685 LandscapePageHeight mul N-Up-YStart add
2686 }{
2687 PageWidth mul add N-Up-YStart
2688 }ifelse
2689 translate
2690 }if
2691 /ColumnWidth PrintWidth InterColumn add def
2692 % ---- translate to lower left corner of TEXT
2693 LeftMargin BottomMargin translate
2694 % ---- define where printing will start
2695 /f0 F % this installs Ascent
2696 /PrintStartY PrintHeight Ascent sub def
2697 /ColumnIndex 1 def
2698 /N-Up-Counter N-Up-End 1 sub def
2699 SkipFirstPage{save showpage restore}if
2700}def
2701
2702/EndDoc {
2703 % ---- restore the state of the document (useful for ghostscript!)
2704 docState restore
2705}def
2706
2707/BeginDSCPage {
2708 % ---- when 1st column, save the state of the page
2709 ColumnIndex 1 eq {
2710 /pageState save def
2711 }if
2712 % ---- save the state of the column
2713 /columnState save def
2714}def
2715
2716/PrintHeaderWidth PrintOnlyOneHeader{PrintPageWidth}{PrintWidth}ifelse def
2717
2718/BeginPage {
2719 % ---- when 1st column, print all background effects
2720 ColumnIndex 1 eq {
2721 0 PrintStartY moveto % move to where printing will start
2722 Zebra {printZebra}if
2723 printGlobalBackground
2724 printLocalBackground
2725 }if
2726 PrintHeader {
2727 PrintOnlyOneHeader{ColumnIndex 1 eq}{true}ifelse {
2728 PrintHeaderFrame {HeaderFrame}if
2729 HeaderText
2730 }if
2731 }if
2732 0 PrintStartY moveto % move to where printing will start
2733 PLN
2734}def
2735
2736/EndPage {
2737 bg {eolbg}if
2738}def
2739
2740/EndDSCPage {
2741 ColumnIndex NumberOfColumns eq {
2742 % ---- restore the state of the page
2743 pageState restore
2744 /ColumnIndex 1 def
2745 % ---- N-up printing
2746 N-Up 1 gt {
2747 N-Up-Counter 0 gt {
2748 % ---- Next page on same row
2749 /N-Up-Counter N-Up-Counter 1 sub def
2750 N-Up-XColumn N-Up-YColumn
2751 }{
2752 % ---- Next page on next line
2753 /N-Up-Counter N-Up-End 1 sub def
2754 N-Up-XLine N-Up-YLine
2755 }ifelse
2756 translate
2757 }if
2758 }{ % else
2759 % ---- restore the state of the current column
2760 columnState restore
2761 % ---- and translate to the next column
2762 ColumnWidth 0 translate
2763 /ColumnIndex ColumnIndex 1 add def
2764 }ifelse
2765}def
2766
2767% stack: number-of-pages-per-sheet |- --
2768/BeginSheet {
2769 /sheetState save def
2770 /pages-per-sheet exch def
2771 % ---- N-up printing
2772 N-Up 1 gt N-Up-Border and pages-per-sheet 0 gt and {
2773 % ---- page border
2774 gsave
2775 0 setgray
2776 LeftMargin neg BottomMargin neg moveto
2777 N-Up-Repeat
2778 {N-Up-End
2779 {gsave
2780 PageWidth 0 rlineto
2781 0 LandscapePageHeight rlineto
2782 PageWidth neg 0 rlineto
2783 closepath stroke
2784 grestore
2785 /pages-per-sheet pages-per-sheet 1 sub def
2786 pages-per-sheet 0 le{exit}if
2787 N-Up-XColumn N-Up-YColumn rmoveto
2788 }repeat
2789 pages-per-sheet 0 le{exit}if
2790 N-Up-XLine N-Up-XColumn sub N-Up-YLine rmoveto
2791 }repeat
2792 grestore
2793 }if
2794}def
2795
2796/EndSheet {
2797 showpage
2798 sheetState restore
2799}def
2800
2801/SetHeaderLines { % nb-lines --
2802 /HeaderLines exch def
2803 % ---- bottom up
2804 HeaderPad
2805 HeaderLines 1 sub HeaderLineHeight mul add
2806 HeaderTitleLineHeight add
2807 HeaderPad add
2808 /HeaderHeight exch def
2809} def
2810
2811% |---------|
2812% | tm |
2813% |---------|
2814% | header |
2815% |-+-------| <-- (x y)
2816% | ho |
2817% |---------|
2818% | text |
2819% |-+-------| <-- (0 0)
2820% | bm |
2821% |---------|
2822
2823/HeaderFrameStart { % -- x y
2824 0 PrintHeight HeaderOffset add
2825} def
2826
2827/HeaderFramePath {
2828 PrintHeaderWidth 0 rlineto
2829 0 HeaderHeight rlineto
2830 PrintHeaderWidth neg 0 rlineto
2831 0 HeaderHeight neg rlineto
2832} def
2833
2834/HeaderFrame {
2835 gsave
2836 0.4 setlinewidth
2837 % ---- fill a black rectangle (the shadow of the next one)
2838 HeaderFrameStart moveto
2839 1 -1 rmoveto
2840 HeaderFramePath
2841 0 setgray fill
2842 % ---- do the next rectangle ...
2843 HeaderFrameStart moveto
2844 HeaderFramePath
2845 gsave 0.9 setgray fill grestore % filled with grey
2846 gsave 0 setgray stroke grestore % drawn with black
2847 grestore
2848} def
2849
2850/HeaderStart {
2851 HeaderFrameStart
2852 exch HeaderPad add exch % horizontal pad
2853 % ---- bottom up
2854 HeaderPad add % vertical pad
2855 HeaderDescent sub
2856 HeaderLineHeight HeaderLines 1 sub mul add
2857} def
2858
2859/strcat {
2860 dup length 3 -1 roll dup length dup 4 -1 roll add string dup
2861 0 5 -1 roll putinterval
2862 dup 4 2 roll exch putinterval
2863} def
2864
2865/pagenumberstring {
2866 PageNumber 32 string cvs
2867 ShowNofN {
2868 (/) strcat
2869 PageCount 32 string cvs strcat
2870 } if
2871} def
2872
2873/HeaderText {
2874 HeaderStart moveto
2875
2876 HeaderLinesRight HeaderLinesLeft % -- rightLines leftLines
2877
2878 % ---- hack: `PN 1 and' == `PN 2 modulo'
2879
2880 % ---- if even page number and duplex, then exchange left and right
2881 PageNumber 1 and 0 eq DuplexValue and { exch } if
2882
2883 { % ---- process the left lines
2884 aload pop
2885 exch F
2886 gsave
2887 dup xcheck { exec } if
2888 show
2889 grestore
2890 0 HeaderLineHeight neg rmoveto
2891 } forall
2892
2893 HeaderStart moveto
2894
2895 { % ---- process the right lines
2896 aload pop
2897 exch F
2898 gsave
2899 dup xcheck { exec } if
2900 dup stringwidth pop
2901 PrintHeaderWidth exch sub HeaderPad 2 mul sub 0 rmoveto
2902 show
2903 grestore
2904 0 HeaderLineHeight neg rmoveto
2905 } forall
2906} def
2907
2908/ReportFontInfo {
2909 2 copy
2910 /t0 3 1 roll DefFont
2911 /t0 F
2912 /lh FontHeight def
2913 /sw ( ) stringwidth pop def
2914 /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
2915 stringwidth pop exch div def
2916 /t1 12 /Helvetica-Oblique DefFont
2917 /t1 F
2918 gsave
2919 (languagelevel = ) show
2920 gs_languagelevel 32 string cvs show
2921 grestore
2922 0 FontHeight neg rmoveto
2923 gsave
2924 (For ) show
2925 128 string cvs show
2926 ( ) show
2927 32 string cvs show
2928 ( point, the line height is ) show
2929 lh 32 string cvs show
2930 (, the space width is ) show
2931 sw 32 string cvs show
2932 (,) show
2933 grestore
2934 0 FontHeight neg rmoveto
2935 gsave
2936 (and a crude estimate of average character width is ) show
2937 aw 32 string cvs show
2938 (.) show
2939 grestore
2940 0 FontHeight neg rmoveto
2941} def
2942
2943/cm { % cm to point
2944 72 mul 2.54 div
2945} def
2946
2947/ReportAllFontInfo {
2948 FontDirectory
2949 { % key = font name value = font dictionary
2950 pop 10 exch ReportFontInfo
2951 } forall
2952} def
2953
2954% 3 cm 20 cm moveto 10 /Courier ReportFontInfo showpage
2955% 3 cm 20 cm moveto ReportAllFontInfo showpage
2956
2957/ErrorMessages
2958 [(This PostScript printer is not configured with this document page size.)
2959 (Duplex printing is not supported on this PostScript printer.)]def
2960
2961% stack: error-index proc |- --
2962/CheckConfig {
2963 stopped {
2964 1 cm LandscapePageHeight 0.5 mul moveto
2965 /Courier findfont 10 scalefont setfont
2966 gsave
2967 (ps-print error:) show
2968 grestore
2969 0 -10 rmoveto
2970 ErrorMessages exch get show
2971 showpage
2972 $error /newerror false put
2973 stop
2974 }if
2975} bind def
2976
2977")
2978 2259
2979(defconst ps-print-prologue-2 2260(defun ps-prologue-file (filenumber)
2980 " 2261 (save-excursion
2981% ---- These lines must be kept together because... 2262 (let ((buffer
2263 (or (find-file-noselect
2264 (format "%sps-prin%d.ps"
2265 ps-postscript-code-directory filenumber)
2266 'no-warn 'rawfile)
2267 (error "ps-print PostScript prologue %d file was not found."
2268 filenumber))))
2269 (set-buffer buffer)
2270 (prog1
2271 (buffer-string)
2272 (kill-buffer buffer)))))
2982 2273
2983/h0 F
2984/HeaderTitleLineHeight FontHeight def
2985 2274
2986/h1 F 2275(defvar ps-mark-code-directory nil)
2987/HeaderLineHeight FontHeight def
2988/HeaderDescent Descent def
2989 2276
2990% ---- ...because `F' has a side-effect on `FontHeight' and `Descent' 2277(defvar ps-print-prologue-1 ""
2278 "ps-print PostScript prologue begin.")
2991 2279
2992") 2280(defvar ps-print-prologue-2 ""
2281 "ps-print PostScript prologue end.")
2993 2282
2994(defconst ps-print-duplex-feature 2283(defvar ps-print-duplex-feature ""
2995 " 2284 "ps-print PostScript duplex feature.")
2996% --- duplex feature verification
29971
2998UseSetpagedevice {
2999 {<< /Duplex DuplexValue /Tumble TumbleValue >> setpagedevice}
3000}{
3001 {statusdict begin
3002 DuplexValue setduplexmode TumbleValue settumble
3003 end}
3004}ifelse
3005CheckConfig
3006")
3007 2285
3008;; Start Editing Here: 2286;; Start Editing Here:
3009 2287
@@ -3789,41 +3067,40 @@ page-height == bm + print-height + tm - ho - hh
3789 (mapcar 3067 (mapcar
3790 #'(lambda (image) 3068 #'(lambda (image)
3791 (let ((image-file (expand-file-name (nth 0 image)))) 3069 (let ((image-file (expand-file-name (nth 0 image))))
3792 (if (file-readable-p image-file) 3070 (when (file-readable-p image-file)
3793 (progn 3071 (setq ps-background-image-count (1+ ps-background-image-count))
3794 (setq ps-background-image-count (1+ ps-background-image-count)) 3072 (ps-output
3795 (ps-output 3073 (format "/ShowBackImage-%d {\n--back-- "
3796 (format "/ShowBackImage-%d {\n--back-- " 3074 ps-background-image-count)
3797 ps-background-image-count) 3075 (ps-float-format (nth 5 image) 0.0) ; rotation
3798 (ps-float-format (nth 5 image) 0.0) ; rotation 3076 (ps-float-format (nth 3 image) 1.0) ; x scale
3799 (ps-float-format (nth 3 image) 1.0) ; x scale 3077 (ps-float-format (nth 4 image) 1.0) ; y scale
3800 (ps-float-format (nth 4 image) 1.0) ; y scale 3078 (ps-float-format (nth 1 image) ; x position
3801 (ps-float-format (nth 1 image) ; x position 3079 "PrintPageWidth 2 div")
3802 "PrintPageWidth 2 div") 3080 (ps-float-format (nth 2 image) ; y position
3803 (ps-float-format (nth 2 image) ; y position 3081 "PrintHeight 2 div BottomMargin add")
3804 "PrintHeight 2 div BottomMargin add") 3082 "\nBeginBackImage\n")
3805 "\nBeginBackImage\n") 3083 (ps-insert-file image-file)
3806 (ps-insert-file image-file) 3084 ;; coordinate adjustment to centralize image
3807 ;; coordinate adjustment to centralize image 3085 ;; around x and y position
3808 ;; around x and y position 3086 (let ((box (ps-get-boundingbox)))
3809 (let ((box (ps-get-boundingbox))) 3087 (save-excursion
3810 (save-excursion 3088 (set-buffer ps-spool-buffer)
3811 (set-buffer ps-spool-buffer) 3089 (save-excursion
3812 (save-excursion 3090 (if (re-search-backward "^--back--" nil t)
3813 (if (re-search-backward "^--back--" nil t) 3091 (replace-match
3814 (replace-match 3092 (format "%s %s"
3815 (format "%s %s" 3093 (ps-float-format
3816 (ps-float-format 3094 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
3817 (- (+ (/ (- (aref box 2) (aref box 0)) 2.0) 3095 (aref box 0))))
3818 (aref box 0)))) 3096 (ps-float-format
3819 (ps-float-format 3097 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
3820 (- (+ (/ (- (aref box 3) (aref box 1)) 2.0) 3098 (aref box 1)))))
3821 (aref box 1))))) 3099 t)))))
3822 t))))) 3100 (ps-output "\nEndBackImage} def\n")
3823 (ps-output "\nEndBackImage} def\n") 3101 (ps-background-pages (nthcdr 6 image) ; page list
3824 (ps-background-pages (nthcdr 6 image) ; page list 3102 (format "ShowBackImage-%d\n"
3825 (format "ShowBackImage-%d\n" 3103 ps-background-image-count)))))
3826 ps-background-image-count))))))
3827 ps-print-background-image)) 3104 ps-print-background-image))
3828 3105
3829 3106
@@ -4336,7 +3613,8 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4336 (ps-output comments))) 3613 (ps-output comments)))
4337 3614
4338 (ps-output "%%EndComments\n\n%%BeginPrologue\n\n" 3615 (ps-output "%%EndComments\n\n%%BeginPrologue\n\n"
4339 "/gs_languagelevel /languagelevel where {pop languagelevel}{1}ifelse def\n\n") 3616 "/gs_languagelevel /languagelevel where "
3617 "{pop languagelevel}{1}ifelse def\n\n")
4340 3618
4341 (ps-output-boolean "SkipFirstPage " ps-banner-page-when-duplexing) 3619 (ps-output-boolean "SkipFirstPage " ps-banner-page-when-duplexing)
4342 (ps-output-boolean "LandscapeMode " 3620 (ps-output-boolean "LandscapeMode "
@@ -4412,9 +3690,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4412 (setq ps-background-all-pages (nreverse ps-background-all-pages) 3690 (setq ps-background-all-pages (nreverse ps-background-all-pages)
4413 ps-background-pages (nreverse ps-background-pages)) 3691 ps-background-pages (nreverse ps-background-pages))
4414 3692
4415 (ps-output ps-print-prologue-1) 3693 (ps-output "\n" ps-print-prologue-1)
4416 3694
4417 (ps-output "/printGlobalBackground {\n") 3695 (ps-output "\n/printGlobalBackground {\n")
4418 (ps-output-list ps-background-all-pages) 3696 (ps-output-list ps-background-all-pages)
4419 (ps-output "} def\n/printLocalBackground {\n} def\n") 3697 (ps-output "} def\n/printLocalBackground {\n} def\n")
4420 3698
@@ -4426,7 +3704,7 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4426 ps-header-font-size-internal 3704 ps-header-font-size-internal
4427 (ps-font 'ps-font-for-header 'normal))) 3705 (ps-font 'ps-font-for-header 'normal)))
4428 3706
4429 (ps-output ps-print-prologue-2) 3707 (ps-output "\n" ps-print-prologue-2 "\n")
4430 3708
4431 ;; Text fonts 3709 ;; Text fonts
4432 (let ((font (ps-font-alist 'ps-font-for-text)) 3710 (let ((font (ps-font-alist 'ps-font-for-text))
@@ -4449,8 +3727,9 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4449 (ps-boolean-capitalized ps-spool-duplex) 3727 (ps-boolean-capitalized ps-spool-duplex)
4450 " *Tumble " 3728 " *Tumble "
4451 (ps-boolean-capitalized tumble) 3729 (ps-boolean-capitalized tumble)
3730 "\n\n"
4452 ps-print-duplex-feature 3731 ps-print-duplex-feature
4453 "%%EndFeature\n"))) 3732 "\n%%EndFeature\n")))
4454 (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n")) 3733 (ps-output "\n/Lines 0 def\n/PageCount 0 def\n\nBeginDoc\n%%EndSetup\n"))
4455 3734
4456 3735
@@ -4496,6 +3775,11 @@ XSTART YSTART are the relative position for the first page in a sheet.")
4496 3775
4497 3776
4498(defun ps-begin-job () 3777(defun ps-begin-job ()
3778 (or (equal ps-mark-code-directory ps-postscript-code-directory)
3779 (setq ps-print-prologue-1 (ps-prologue-file 1)
3780 ps-print-prologue-2 (ps-prologue-file 2)
3781 ps-print-duplex-feature (ps-prologue-file 3)
3782 ps-mark-code-directory ps-postscript-code-directory))
4499 (save-excursion 3783 (save-excursion
4500 (set-buffer ps-spool-buffer) 3784 (set-buffer ps-spool-buffer)
4501 (goto-char (point-max)) 3785 (goto-char (point-max))