aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKarl Heuer1998-10-26 20:22:17 +0000
committerKarl Heuer1998-10-26 20:22:17 +0000
commitd3ab8dac3eb081b38cee2b138d1712c52ee1cb8c (patch)
tree549849e6cbea1e7ada1b01ed33976a49330b0fbc
parent27606920fbf588089b094e11c9cff26fa2364ccf (diff)
downloademacs-d3ab8dac3eb081b38cee2b138d1712c52ee1cb8c.tar.gz
emacs-d3ab8dac3eb081b38cee2b138d1712c52ee1cb8c.zip
User option for multibyte buffer handling and doc fix.
(ps-multibyte-buffer): New user option. (ps-setup): Print new user option. (ps-print-quote): New fun. (ps-color-p, ps-mule-font-info-database-latin): New var. (ps-default-color, ps-mule-font-info-database) (ps-mule-font-info-database-ps-bdf): Adjust initialization. (ps-mule-get-font-spec, ps-mule-begin, ps-begin-file) (ps-plot-with-face, ps-generate-postscript-with-faces, ps-generate): Little code improvement. (ps-mule-initialize): Initialize ps-mule-font-info-database. (ps-print-prologue-header, ps-font-family, ps-font-size) (ps-header-font-family, ps-header-font-size, ps-header-title-font-size) (ps-build-face-reference, ps-mule-font-info-database-bdf) (ps-mule-external-libraries, ps-mule-init-external-library) (ps-mule-prepare-font, ps-mule-find-wrappoint, ps-mule-plot-string): doc fix. To make it work also on Emacs 20.2 and the earlier version, check the value of mule-version. (ps-print-version): New version number (4.1.1) and doc fix. (ps-print-prologue-header): New user option. (ps-color-values, ps-xemacs-face-kind-p, ps-mapper, ps-extent-sorter): Conditional compilation for GNU Emacs and emacsens. (ps-generate-postscript-with-faces): Skip invisible text better. (ps-setup): Print new user option. (ps-print-preprint): Check if input file name exists and is unwritable. (ps-begin-file): Adjust PostScript prologue header for duplex printers and insert user PostScript prologue header comments. (ps-mule-encode-bit, ps-mule-string-ascii, ps-mule-string-encoding): New funs. (dos-ps-printer, lazy-lock-fontify-buffer): Eliminated. (ps-mule-prologue, ps-mule-cmpchar-prologue, ps-mule-bitmap-prologue): PostScript programming normalization. (ps-mule-encode-7bit, ps-mule-encode-8bit, ps-mule-generate-font) (ps-mule-generate-glyphs, ps-mule-prepare-font, ps-mule-plot-string) (ps-mule-skip-same-charset, ps-mule-plot-rule-cmpchar) (ps-mule-plot-cmpchar, ps-mule-prepare-cmpchar-font) (ps-mule-initialize, ps-mule-begin, ps-face-bold-p, ps-do-despool): Programming style normalization.
Diffstat
-rw-r--r--lisp/ps-print.el967
1 files changed, 569 insertions, 398 deletions
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index c289fbc3580..f93110d84f9 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -9,11 +9,11 @@
9;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multibyte characters) 9;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multibyte characters)
10;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> 10;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
11;; Keywords: print, PostScript 11;; Keywords: print, PostScript
12;; Time-stamp: <98/09/18 9:51:23 vinicius> 12;; Time-stamp: <98/10/13 15:42:23 vinicius>
13;; Version: 4.1 13;; Version: 4.1.1
14 14
15(defconst ps-print-version "4.1" 15(defconst ps-print-version "4.1.1"
16 "ps-print.el, v 4.1 <98/09/18 vinicius> 16 "ps-print.el, v 4.1.1 <98/10/13 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,
@@ -50,7 +50,7 @@ Please send all bug fixes and enhancements to
50;; 50;;
51;; This package provides printing of Emacs buffers on PostScript 51;; This package provides printing of Emacs buffers on PostScript
52;; printers; the buffer's bold and italic text attributes are 52;; printers; the buffer's bold and italic text attributes are
53;; preserved in the printer output. Ps-print is intended for use with 53;; preserved in the printer output. ps-print is intended for use with
54;; Emacs 19 or Lucid Emacs, together with a fontifying package such as 54;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
55;; font-lock or hilit. 55;; font-lock or hilit.
56;; 56;;
@@ -69,7 +69,7 @@ Please send all bug fixes and enhancements to
69;; 69;;
70;; The Commands 70;; The Commands
71;; 71;;
72;; Ps-print provides eight commands for generating PostScript images 72;; ps-print provides eight commands for generating PostScript images
73;; of Emacs buffers: 73;; of Emacs buffers:
74;; 74;;
75;; ps-print-buffer 75;; ps-print-buffer
@@ -103,7 +103,7 @@ Please send all bug fixes and enhancements to
103;; your output at the printer (it's easier to pick up one 50-page 103;; your output at the printer (it's easier to pick up one 50-page
104;; printout than to find 50 single-page printouts). 104;; printout than to find 50 single-page printouts).
105;; 105;;
106;; Ps-print has a hook in the `kill-emacs-hook' so that you won't 106;; ps-print has a hook in the `kill-emacs-hook' so that you won't
107;; accidentally quit from Emacs while you have unprinted PostScript 107;; accidentally quit from Emacs while you have unprinted PostScript
108;; waiting in the spool buffer. If you do attempt to exit with 108;; waiting in the spool buffer. If you do attempt to exit with
109;; spooled PostScript, you'll be asked if you want to print it, and if 109;; spooled PostScript, you'll be asked if you want to print it, and if
@@ -183,11 +183,16 @@ Please send all bug fixes and enhancements to
183;; Make sure that they contain appropriate values for your system; 183;; Make sure that they contain appropriate values for your system;
184;; see the usage notes below and the documentation of these variables. 184;; see the usage notes below and the documentation of these variables.
185;; 185;;
186;; The variable `ps-printer-name' determine the name of a local printer for
187;; printing PostScript files.
188;;
186;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values 189;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
187;; from the variables `lpr-command' and `lpr-switches'. If you have 190;; from the variables `lpr-command' and `lpr-switches'. If you have
188;; `lpr-command' set to invoke a pretty-printer such as `enscript', 191;; `lpr-command' set to invoke a pretty-printer such as `enscript',
189;; then ps-print won't work properly. `ps-lpr-command' must name 192;; then ps-print won't work properly. `ps-lpr-command' must name
190;; a program that does not format the files it prints. 193;; a program that does not format the files it prints.
194;; `ps-printer-name' takes its initial value from the variable
195;; `printer-name'.
191;; 196;;
192;; 197;;
193;; The Page Layout 198;; The Page Layout
@@ -271,7 +276,7 @@ Please send all bug fixes and enhancements to
271;; Headers 276;; Headers
272;; ------- 277;; -------
273;; 278;;
274;; Ps-print can print headers at the top of each column or at the top 279;; ps-print can print headers at the top of each column or at the top
275;; of each page; the default headers contain the following four items: 280;; of each page; the default headers contain the following four items:
276;; on the left, the name of the buffer and, if the buffer is visiting 281;; on the left, the name of the buffer and, if the buffer is visiting
277;; a file, the file's directory; on the right, the page number and 282;; a file, the file's directory; on the right, the page number and
@@ -357,12 +362,43 @@ Please send all bug fixes and enhancements to
357;; Consider yourself warned! 362;; Consider yourself warned!
358;; 363;;
359;; 364;;
365;; PostScript Prologue Header
366;; --------------------------
367;;
368;; It is possible to add PostScript prologue header comments besides that
369;; ps-print generates by setting the variable `ps-print-prologue-header'.
370;;
371;; `ps-print-prologue-header' may be a string or a symbol function which
372;; returns a string. Note that this string is inserted on PostScript prologue
373;; header section which is used to define some document characteristic through
374;; PostScript special comments, like "%%Requirements: jog\n".
375;;
376;; By default `ps-print-prologue-header' is nil.
377;;
378;; ps-print always inserts the %%Requirements: comment, so if you need to insert
379;; more requirements put them first in `ps-print-prologue-header' using the
380;; "%%+" comment. For example, if you need to set numcopies to 3 and jog on
381;; requirements and set %%LanguageLevel: to 2, do:
382;;
383;; (setq ps-print-prologue-header
384;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
385;;
386;; The duplex requirement is inserted by ps-print (see section Duplex Printers).
387;;
388;; Do not forget to terminate the string with "\n".
389;;
390;; For more information about PostScript document comments, see:
391;; PostScript Language Reference Manual (2nd edition)
392;; Adobe Systems Incorporated
393;; Appendix G: Document Structuring Conventions -- Version 3.0
394;;
395;;
360;; Duplex Printers 396;; Duplex Printers
361;; --------------- 397;; ---------------
362;; 398;;
363;; If you have a duplex-capable printer (one that prints both sides of 399;; If you have a duplex-capable printer (one that prints both sides of
364;; the paper), set `ps-spool-duplex' to t. 400;; the paper), set `ps-spool-duplex' to t.
365;; Ps-print will insert blank pages to make sure each buffer starts 401;; ps-print will insert blank pages to make sure each buffer starts
366;; on the correct side of the paper. 402;; on the correct side of the paper.
367;; Don't forget to set `ps-lpr-switches' to select duplex printing 403;; Don't forget to set `ps-lpr-switches' to select duplex printing
368;; for your printer. 404;; for your printer.
@@ -401,30 +437,47 @@ Please send all bug fixes and enhancements to
401;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine. 437;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
402;; 438;;
403;; 439;;
404;; Printing Multi-Byte Buffer 440;; Printing Multibyte Buffer
405;; -------------------------- 441;; -------------------------
406;; 442;;
407;; ps-print can print multi-byte buffer. 443;; The variable `ps-multibyte-buffer' specifies the ps-print multibyte buffer
444;; handling.
445;;
446;; Valid values for `ps-multibyte-buffer' are:
447;;
448;; nil This is the value to use when you are printing
449;; buffer with only ASCII and Latin characters.
450;;
451;; `non-latin-printer' This is the value to use when you have a japanese
452;; or korean PostScript printer and want to print
453;; buffer with ASCII, Latin-1, Japanese (JISX0208 and
454;; JISX0201-Kana) and Korean characters. At present,
455;; it was not tested the Korean characters printing.
456;; If you have a korean PostScript printer, please,
457;; test it.
458;;
459;; `bdf-font' This is the value to use when you want to print
460;; buffer with BDF fonts. BDF fonts include both latin
461;; and non-latin fonts. BDF (Bitmap Distribution
462;; Format) is a format used for distributing X's font
463;; source file. BDF fonts are included in
464;; `intlfonts-1.1' which is a collection of X11 fonts
465;; for all characters supported by Emacs. In order to
466;; use this value, be sure to have installed
467;; `intlfonts-1.1' and set the variable
468;; `bdf-directory-list' appropriately (see bdf.el for
469;; documentation of this variable).
470;;
471;; `bdf-font-except-latin' This is like `bdf-font' except that it is used
472;; PostScript default fonts to print ASCII and Latin-1
473;; characters. This is convenient when you want or
474;; need to use both latin and non-latin characters on
475;; the same buffer. See `ps-font-family',
476;; `ps-header-font-family' and `ps-font-info-database'.
408;; 477;;
409;; If you are using only Latin-1 characters, you don't need to do anything else. 478;; Any other value is treated as nil.
410;;
411;; If you have a japanese or korean PostScript printer, you can print ASCII,
412;; Latin-1, Japanese (JISX0208, and JISX0201-Kana) and Korean characters by
413;; setting:
414;;
415;; (setq ps-mule-font-info-database ps-mule-font-info-database-ps)
416;;
417;; At present, it was not tested the korean characters printing. If you have
418;; a korean PostScript printer, please verify it.
419;;
420;; If you use any other kind of character, you need to install intlfonts-1.1.
421;; So you can print using BDF fonts contained in intlfonts-1.1. To print using
422;; BDF fonts, do the following settings:
423;;
424;; (1) Set the variable `bdf-directory-list' appropriately (see bdf.el for
425;; documentation of this variable).
426;; 479;;
427;; (2) (setq ps-mule-font-info-database-ps ps-mule-font-info-database-bdf) 480;; The default is nil.
428;; 481;;
429;; 482;;
430;; Line Number 483;; Line Number
@@ -466,7 +519,7 @@ Please send all bug fixes and enhancements to
466;; Hooks 519;; Hooks
467;; ----- 520;; -----
468;; 521;;
469;; Ps-print has the following hook variables: 522;; ps-print has the following hook variables:
470;; 523;;
471;; `ps-print-hook' 524;; `ps-print-hook'
472;; It is evaluated once before any printing process. This is the right 525;; It is evaluated once before any printing process. This is the right
@@ -487,7 +540,7 @@ Please send all bug fixes and enhancements to
487;; Font Managing 540;; Font Managing
488;; ------------- 541;; -------------
489;; 542;;
490;; Ps-print now knows rather precisely some fonts: 543;; ps-print now knows rather precisely some fonts:
491;; the variable `ps-font-info-database' contains information 544;; the variable `ps-font-info-database' contains information
492;; for a list of font families (currently mainly `Courier' `Helvetica' 545;; for a list of font families (currently mainly `Courier' `Helvetica'
493;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk'). 546;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
@@ -573,6 +626,7 @@ Please send all bug fixes and enhancements to
573;; (line-height . 10.55) 626;; (line-height . 10.55)
574;; (space-width . 6.0) 627;; (space-width . 6.0)
575;; (avg-char-width . 6.0)) 628;; (avg-char-width . 6.0))
629;;
576;; Now you can use your new font family with any size: 630;; Now you can use your new font family with any size:
577;; (setq ps-font-family 'my-mixed-family) 631;; (setq ps-font-family 'my-mixed-family)
578;; 632;;
@@ -631,7 +685,7 @@ Please send all bug fixes and enhancements to
631;; Faces like bold-italic that are both bold and italic should go in 685;; Faces like bold-italic that are both bold and italic should go in
632;; *both* lists. 686;; *both* lists.
633;; 687;;
634;; Ps-print keeps internal lists of which fonts are bold and which are 688;; ps-print keeps internal lists of which fonts are bold and which are
635;; italic; these lists are built the first time you invoke ps-print. 689;; italic; these lists are built the first time you invoke ps-print.
636;; For the sake of efficiency, the lists are built only once; the same 690;; For the sake of efficiency, the lists are built only once; the same
637;; lists are referred in later invocations of ps-print. 691;; lists are referred in later invocations of ps-print.
@@ -648,7 +702,7 @@ Please send all bug fixes and enhancements to
648;; How Ps-Print Deals With Color 702;; How Ps-Print Deals With Color
649;; ----------------------------- 703;; -----------------------------
650;; 704;;
651;; Ps-print detects faces with foreground and background colors 705;; ps-print detects faces with foreground and background colors
652;; defined and embeds color information in the PostScript image. 706;; defined and embeds color information in the PostScript image.
653;; The default foreground and background colors are defined by the 707;; The default foreground and background colors are defined by the
654;; variables `ps-default-fg' and `ps-default-bg'. 708;; variables `ps-default-fg' and `ps-default-bg'.
@@ -683,7 +737,7 @@ Please send all bug fixes and enhancements to
683;; How Ps-Print Has A Text And/Or Image On Background 737;; How Ps-Print Has A Text And/Or Image On Background
684;; -------------------------------------------------- 738;; --------------------------------------------------
685;; 739;;
686;; Ps-print can print texts and/or EPS PostScript images on background; it is 740;; ps-print can print texts and/or EPS PostScript images on background; it is
687;; possible to define the following text attributes: font name, font size, 741;; possible to define the following text attributes: font name, font size,
688;; initial position, angle, gray scale and pages to print. 742;; initial position, angle, gray scale and pages to print.
689;; 743;;
@@ -772,9 +826,14 @@ Please send all bug fixes and enhancements to
772;; New since version 2.8 826;; New since version 2.8
773;; --------------------- 827;; ---------------------
774;; 828;;
829;; [vinicius] 980922 Vinicius Jose Latorre <vinicius@cpqd.com.br>
830;;
831;; PostScript prologue header comment insertion.
832;; Skip invisible text better.
833;;
775;; [keinichi] 980819 Kein'ichi Handa <handa@etl.go.jp> 834;; [keinichi] 980819 Kein'ichi Handa <handa@etl.go.jp>
776;; 835;;
777;; Multi-byte buffer handling. 836;; Multibyte buffer handling.
778;; 837;;
779;; [vinicius] 980306 Vinicius Jose Latorre <vinicius@cpqd.com.br> 838;; [vinicius] 980306 Vinicius Jose Latorre <vinicius@cpqd.com.br>
780;; 839;;
@@ -806,7 +865,7 @@ Please send all bug fixes and enhancements to
806;; Tools for page setup. 865;; Tools for page setup.
807;; 866;;
808;; 867;;
809;; Known bugs and limitations of ps-print: 868;; Known bugs and limitations of ps-print
810;; -------------------------------------- 869;; --------------------------------------
811;; 870;;
812;; Although color printing will work in XEmacs 19.12, it doesn't work 871;; Although color printing will work in XEmacs 19.12, it doesn't work
@@ -839,9 +898,10 @@ Please send all bug fixes and enhancements to
839;; of folding lines. 898;; of folding lines.
840;; 899;;
841;; 900;;
842;; Things to change: 901;; Things to change
843;; ---------------- 902;; ----------------
844;; 903;;
904;; 2-up and 4-up capabilities.
845;; Avoid page break inside a paragraph. 905;; Avoid page break inside a paragraph.
846;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy). 906;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
847;; Improve the memory management for big files (hard?). 907;; Improve the memory management for big files (hard?).
@@ -852,7 +912,7 @@ Please send all bug fixes and enhancements to
852;; Acknowledgements 912;; Acknowledgements
853;; ---------------- 913;; ----------------
854;; 914;;
855;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multi-byte buffer handling. 915;; Thanks to Kein'ichi Handa <handa@etl.go.jp> for multibyte buffer handling.
856;; 916;;
857;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on 917;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
858;; empty columns. 918;; empty columns.
@@ -963,6 +1023,73 @@ Please send all bug fixes and enhancements to
963 :group 'faces) 1023 :group 'faces)
964 1024
965 1025
1026(defcustom ps-multibyte-buffer nil
1027 "*Specifies the multibyte buffer handling.
1028
1029Valid values are:
1030
1031 nil This is the value to use when you are printing
1032 buffer with only ASCII and Latin characters.
1033
1034 `non-latin-printer' This is the value to use when you have a japanese
1035 or korean PostScript printer and want to print
1036 buffer with ASCII, Latin-1, Japanese (JISX0208 and
1037 JISX0201-Kana) and Korean characters. At present,
1038 it was not tested the Korean characters printing.
1039 If you have a korean PostScript printer, please,
1040 test it.
1041
1042 `bdf-font' This is the value to use when you want to print
1043 buffer with BDF fonts. BDF fonts include both latin
1044 and non-latin fonts. BDF (Bitmap Distribution
1045 Format) is a format used for distributing X's font
1046 source file. BDF fonts are included in
1047 `intlfonts-1.1' which is a collection of X11 fonts
1048 for all characters supported by Emacs. In order to
1049 use this value, be sure to have installed
1050 `intlfonts-1.1' and set the variable
1051 `bdf-directory-list' appropriately (see bdf.el for
1052 documentation of this variable).
1053
1054 `bdf-font-except-latin' This is like `bdf-font' except that it is used
1055 PostScript default fonts to print ASCII and Latin-1
1056 characters. This is convenient when you want or
1057 need to use both latin and non-latin characters on
1058 the same buffer. See `ps-font-family',
1059 `ps-header-font-family' and `ps-font-info-database'.
1060
1061Any other value is treated as nil."
1062 :type '(choice (const non-latin-printer) (const bdf-font)
1063 (const bdf-font-except-latin) (other :tag "nil" nil))
1064 :group 'ps-print-font)
1065
1066(defcustom ps-print-prologue-header nil
1067 "*PostScript prologue header comments besides that ps-print generates.
1068
1069`ps-print-prologue-header' may be a string or a symbol function which
1070returns a string. Note that this string is inserted on PostScript prologue
1071header section which is used to define some document characteristic through
1072PostScript special comments, like \"%%Requirements: jog\\n\".
1073
1074ps-print always inserts the %%Requirements: comment, so if you need to insert
1075more requirements put them first in `ps-print-prologue-header' using the
1076\"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
1077requirements and set %%LanguageLevel: to 2, do:
1078
1079(setq ps-print-prologue-header
1080 \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
1081
1082The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
1083
1084Do not forget to terminate the string with \"\\n\".
1085
1086For more information about PostScript document comments, see:
1087 PostScript Language Reference Manual (2nd edition)
1088 Adobe Systems Incorporated
1089 Appendix G: Document Structuring Conventions -- Version 3.0"
1090 :type '(choice string symbol (other :tag "nil" nil))
1091 :group 'ps-print)
1092
966(defcustom ps-printer-name printer-name 1093(defcustom ps-printer-name printer-name
967 "*The name of a local printer for printing PostScript files. 1094 "*The name of a local printer for printing PostScript files.
968 1095
@@ -1064,21 +1191,21 @@ it is sent the string \"^D\".
1064Valid values are: 1191Valid values are:
1065 1192
1066 `8-bit' This is the value to use when you want an ASCII encoding of 1193 `8-bit' This is the value to use when you want an ASCII encoding of
1067 any control or non-ASCII character. Control characters are 1194 any control or non-ASCII character. Control characters are
1068 encoded as \"^D\", and non-ASCII characters have an 1195 encoded as \"^D\", and non-ASCII characters have an
1069 octal encoding. 1196 octal encoding.
1070 1197
1071 `control-8-bit' This is the value to use when you want an ASCII encoding of 1198 `control-8-bit' This is the value to use when you want an ASCII encoding of
1072 any control character, whether it is 7 or 8-bit. 1199 any control character, whether it is 7 or 8-bit.
1073 European 8-bits accented characters are printed according 1200 European 8-bits accented characters are printed according
1074 the current font. 1201 the current font.
1075 1202
1076 `control' Only ASCII control characters have an ASCII encoding. 1203 `control' Only ASCII control characters have an ASCII encoding.
1077 European 8-bits accented characters are printed according 1204 European 8-bits accented characters are printed according
1078 the current font. 1205 the current font.
1079 1206
1080 nil No ASCII encoding. Any character is printed according the 1207 nil No ASCII encoding. Any character is printed according the
1081 current font. 1208 current font.
1082 1209
1083Any other value is treated as nil." 1210Any other value is treated as nil."
1084 :type '(choice (const 8-bit) (const control-8-bit) 1211 :type '(choice (const 8-bit) (const control-8-bit)
@@ -1450,27 +1577,27 @@ You can get all the fonts of YOUR printer using `ReportAllFontInfo'."
1450 :group 'ps-print-font) 1577 :group 'ps-print-font)
1451 1578
1452(defcustom ps-font-family 'Courier 1579(defcustom ps-font-family 'Courier
1453 "Font family name for ordinary text, when generating PostScript." 1580 "*Font family name for ordinary text, when generating PostScript."
1454 :type 'symbol 1581 :type 'symbol
1455 :group 'ps-print-font) 1582 :group 'ps-print-font)
1456 1583
1457(defcustom ps-font-size (if ps-landscape-mode 7 8.5) 1584(defcustom ps-font-size (if ps-landscape-mode 7 8.5)
1458 "Font size, in points, for ordinary text, when generating PostScript." 1585 "*Font size, in points, for ordinary text, when generating PostScript."
1459 :type 'number 1586 :type 'number
1460 :group 'ps-print-font) 1587 :group 'ps-print-font)
1461 1588
1462(defcustom ps-header-font-family 'Helvetica 1589(defcustom ps-header-font-family 'Helvetica
1463 "Font family name for text in the header, when generating PostScript." 1590 "*Font family name for text in the header, when generating PostScript."
1464 :type 'symbol 1591 :type 'symbol
1465 :group 'ps-print-font) 1592 :group 'ps-print-font)
1466 1593
1467(defcustom ps-header-font-size (if ps-landscape-mode 10 12) 1594(defcustom ps-header-font-size (if ps-landscape-mode 10 12)
1468 "Font size, in points, for text in the header, when generating PostScript." 1595 "*Font size, in points, for text in the header, when generating PostScript."
1469 :type 'number 1596 :type 'number
1470 :group 'ps-print-font) 1597 :group 'ps-print-font)
1471 1598
1472(defcustom ps-header-title-font-size (if ps-landscape-mode 12 14) 1599(defcustom ps-header-title-font-size (if ps-landscape-mode 12 14)
1473 "Font size, in points, for the top line of text in header, in PostScript." 1600 "*Font size, in points, for the top line of text in header, in PostScript."
1474 :type 'number 1601 :type 'number
1475 :group 'ps-print-font) 1602 :group 'ps-print-font)
1476 1603
@@ -1582,7 +1709,7 @@ printers require slightly different versions of this line."
1582(defcustom ps-build-face-reference t 1709(defcustom ps-build-face-reference t
1583 "*Non-nil means build the reference face lists. 1710 "*Non-nil means build the reference face lists.
1584 1711
1585Ps-print sets this value to nil after it builds its internal reference 1712ps-print sets this value to nil after it builds its internal reference
1586lists of bold and italic faces. By settings its value back to t, you 1713lists of bold and italic faces. By settings its value back to t, you
1587can force ps-print to rebuild the lists the next time you invoke one 1714can force ps-print to rebuild the lists the next time you invoke one
1588of the ...-with-faces commands. 1715of the ...-with-faces commands.
@@ -1735,10 +1862,11 @@ The table depends on the current ps-print setup."
1735 (format 1862 (format
1736 " 1863 "
1737\(setq ps-print-color-p %s 1864\(setq ps-print-color-p %s
1738 ps-lpr-command \"%s\" 1865 ps-lpr-command %S
1739 ps-lpr-switches %s 1866 ps-lpr-switches %S
1867 ps-printer-name %S
1740 1868
1741 ps-paper-type '%s 1869 ps-paper-type %S
1742 ps-landscape-mode %s 1870 ps-landscape-mode %s
1743 ps-number-of-columns %s 1871 ps-number-of-columns %s
1744 1872
@@ -1746,43 +1874,49 @@ The table depends on the current ps-print setup."
1746 ps-zebra-stripe-height %s 1874 ps-zebra-stripe-height %s
1747 ps-line-number %s 1875 ps-line-number %s
1748 1876
1749 ps-print-control-characters %s 1877 ps-print-control-characters %S
1878
1879 ps-print-background-image %S
1750 1880
1751 ps-print-background-image %s 1881 ps-print-background-text %S
1752 1882
1753 ps-print-background-text %s 1883 ps-print-prologue-header %S
1754 1884
1755 ps-left-margin %s 1885 ps-left-margin %s
1756 ps-right-margin %s 1886 ps-right-margin %s
1757 ps-inter-column %s 1887 ps-inter-column %s
1758 ps-bottom-margin %s 1888 ps-bottom-margin %s
1759 ps-top-margin %s 1889 ps-top-margin %s
1760 ps-header-offset %s 1890 ps-header-offset %s
1761 ps-header-line-pad %s 1891 ps-header-line-pad %s
1762 ps-print-header %s 1892 ps-print-header %s
1763 ps-print-header-frame %s 1893 ps-print-only-one-header %s
1764 ps-header-lines %s 1894 ps-print-header-frame %s
1765 ps-show-n-of-n %s 1895 ps-header-lines %s
1766 ps-spool-duplex %s 1896 ps-show-n-of-n %s
1897 ps-spool-duplex %s
1767 1898
1768 ps-font-family '%s 1899 ps-multibyte-buffer %S
1900 ps-font-family %S
1769 ps-font-size %s 1901 ps-font-size %s
1770 ps-header-font-family '%s 1902 ps-header-font-family %S
1771 ps-header-font-size %s 1903 ps-header-font-size %s
1772 ps-header-title-font-size %s) 1904 ps-header-title-font-size %s)
1773" 1905"
1774 ps-print-color-p 1906 ps-print-color-p
1775 ps-lpr-command 1907 ps-lpr-command
1776 ps-lpr-switches 1908 (ps-print-quote ps-lpr-switches)
1777 ps-paper-type 1909 ps-printer-name
1910 (ps-print-quote ps-paper-type)
1778 ps-landscape-mode 1911 ps-landscape-mode
1779 ps-number-of-columns 1912 ps-number-of-columns
1780 ps-zebra-stripes 1913 ps-zebra-stripes
1781 ps-zebra-stripe-height 1914 ps-zebra-stripe-height
1782 ps-line-number 1915 ps-line-number
1783 ps-print-control-characters 1916 (ps-print-quote ps-print-control-characters)
1784 ps-print-background-image 1917 (ps-print-quote ps-print-background-image)
1785 ps-print-background-text 1918 (ps-print-quote ps-print-background-text)
1919 (ps-print-quote ps-print-prologue-header)
1786 ps-left-margin 1920 ps-left-margin
1787 ps-right-margin 1921 ps-right-margin
1788 ps-inter-column 1922 ps-inter-column
@@ -1791,19 +1925,27 @@ The table depends on the current ps-print setup."
1791 ps-header-offset 1925 ps-header-offset
1792 ps-header-line-pad 1926 ps-header-line-pad
1793 ps-print-header 1927 ps-print-header
1928 ps-print-only-one-header
1794 ps-print-header-frame 1929 ps-print-header-frame
1795 ps-header-lines 1930 ps-header-lines
1796 ps-show-n-of-n 1931 ps-show-n-of-n
1797 ps-spool-duplex 1932 ps-spool-duplex
1798 ps-font-family 1933 (ps-print-quote ps-multibyte-buffer)
1934 (ps-print-quote ps-font-family)
1799 ps-font-size 1935 ps-font-size
1800 ps-header-font-family 1936 (ps-print-quote ps-header-font-family)
1801 ps-header-font-size 1937 ps-header-font-size
1802 ps-header-title-font-size)) 1938 ps-header-title-font-size))
1803 1939
1804;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1940;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1805;; Utility functions and variables: 1941;; Utility functions and variables:
1806 1942
1943(defun ps-print-quote (sym)
1944 (and sym
1945 (if (or (symbolp sym) (listp sym))
1946 (format "'%S" sym)
1947 sym)))
1948
1807(defvar ps-print-emacs-type 1949(defvar ps-print-emacs-type
1808 (cond ((string-match "XEmacs" emacs-version) 'xemacs) 1950 (cond ((string-match "XEmacs" emacs-version) 'xemacs)
1809 ((string-match "Lucid" emacs-version) 'lucid) 1951 ((string-match "Lucid" emacs-version) 'lucid)
@@ -2486,12 +2628,13 @@ StandardEncoding 46 82 getinterval aload pop
2486(defvar ps-background-image-count 0) 2628(defvar ps-background-image-count 0)
2487 2629
2488(defvar ps-current-font 0) 2630(defvar ps-current-font 0)
2489(defvar ps-default-color (if ps-print-color-p ps-default-fg)) ; black 2631(defvar ps-default-color (and ps-print-color-p ps-default-fg)) ; black
2490(defvar ps-current-color ps-default-color) 2632(defvar ps-current-color ps-default-color)
2491(defvar ps-current-bg nil) 2633(defvar ps-current-bg nil)
2492 2634
2493(defvar ps-razchunk 0) 2635(defvar ps-razchunk 0)
2494 2636
2637(defvar ps-color-p nil)
2495(defvar ps-color-format 2638(defvar ps-color-format
2496 (if (eq ps-print-emacs-type 'emacs) 2639 (if (eq ps-print-emacs-type 'emacs)
2497 2640
@@ -2795,14 +2938,14 @@ which long lines wrap around."
2795 2938
2796 2939
2797;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2940;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2798;; For handling multibyte characters. 2941;; For handling multibyte characters -- Begin.
2799;; 2942;;
2800;; The following comments apply only to this part (through the next ^L). 2943;; The following comments apply only to this part (through the next ^L).
2801;; Author: Kenichi Handa <handa@etl.go.jp> 2944;; Author: Kenichi Handa <handa@etl.go.jp>
2802;; Maintainer: Kenichi Handa <handa@etl.go.jp> 2945;; Maintainer: Kenichi Handa <handa@etl.go.jp>
2803 2946
2804(eval-and-compile 2947(eval-and-compile
2805 (if (fboundp 'set-buffer-multibyte) 2948 (if (not (string< mule-version "4.0"))
2806 (progn 2949 (progn
2807 (defalias 'ps-mule-next-point '1+) 2950 (defalias 'ps-mule-next-point '1+)
2808 (defalias 'ps-mule-chars-in-string 'length) 2951 (defalias 'ps-mule-chars-in-string 'length)
@@ -2824,47 +2967,51 @@ which long lines wrap around."
2824 ) 2967 )
2825 2968
2826(defvar ps-mule-font-info-database 2969(defvar ps-mule-font-info-database
2827 '((latin-iso8859-1 2970 nil
2828 (normal nil nil iso-latin-1))) 2971 "Alist of charsets with the corresponding font information.
2829 "Alist of charsets vs the corresponding font information.
2830Each element has the form: 2972Each element has the form:
2973
2831 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...) 2974 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
2832where 2975
2976Where
2833 2977
2834CHARSET is a charset (symbol) for this font family, 2978CHARSET is a charset (symbol) for this font family,
2835 2979
2836FONT-TYPE is a type of font: normal, bold, italic, or bold-italic. 2980FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
2837 2981
2838FONT-SRC is a source of font: builtin, bdf, vflib, or nil. 2982FONT-SRC is a font source: builtin, bdf, vflib, or nil.
2839 2983
2840 If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name. 2984 If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name.
2841 2985
2842 If FONT-SRC is bdf, FONT-NAME is a BDF font file name. To use this 2986 If FONT-SRC is bdf, FONT-NAME is a BDF font file name. To use this font,
2843 font, the external library `bdf' is required. 2987 the external library `bdf' is required.
2844 2988
2845 If FONT-SRC is vflib, FONT-NAME is name of font VFlib knows. To use 2989 If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
2846 this font, the external library `vflib' is required. 2990 To use this font, the external library `vflib' is required.
2847 2991
2848 If FONT-SRC is nil, a proper ASCII font in the variable 2992 If FONT-SRC is nil, a proper ASCII font in the variable
2849 `ps-font-info-database' is used. This is useful for Latin-1 2993 `ps-font-info-database' is used. This is useful for Latin-1 characters.
2850 characters.
2851 2994
2852ENCODING is a coding system to encode a string of characters of 2995ENCODING is a coding system to encode a string of characters of CHARSET into a
2853CHARSET into a proper string matching an encoding of the specified 2996proper string matching an encoding of the specified font. ENCODING may be a
2854font. ENCODING may be a function to call to do this encoding. In 2997function that does this encoding. In this case, the function is called with
2855this case, the function is called with one arguemnt, the string to 2998one argument, the string to encode, and it should return an encoded string.
2856encode, and it should return an encoded string.
2857 2999
2858BYTES specifies how many bytes in encoded byte sequence construct esch 3000BYTES specifies how many bytes each character has in the encoded byte
2859character, it should be 1 or 2. 3001sequence; it should be 1 or 2.
2860 3002
2861All multibyte characters are printed by fonts specified in this 3003All multibyte characters are printed by fonts specified in this database
2862database regardless of a font family of ASCII characters. The 3004regardless of a font family of ASCII characters. The exception is Latin-1
2863exception is Latin-1 characters which are printed by the same font as 3005characters which are printed by the same font as ASCII characters, thus obey
2864ASCII characters, thus obey font family. 3006font family.
2865 3007
2866See also the variable `ps-font-info-database'.") 3008See also the variable `ps-font-info-database'.")
2867 3009
3010(defconst ps-mule-font-info-database-latin
3011 '((latin-iso8859-1
3012 (normal nil nil iso-latin-1)))
3013 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
3014
2868(defconst ps-mule-font-info-database-ps 3015(defconst ps-mule-font-info-database-ps
2869 '((katakana-jisx0201 3016 '((katakana-jisx0201
2870 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1) 3017 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
@@ -2974,69 +3121,56 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
2974 (tibetan 3121 (tibetan
2975 (normal bdf "mule-tibmdx-24.bdf" ps-mule-encode-7bit 2))) 3122 (normal bdf "mule-tibmdx-24.bdf" ps-mule-encode-7bit 2)))
2976 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. 3123 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
2977BDF (Bitmap Distribution Format) is a format used for distributing 3124BDF (Bitmap Distribution Format) is a format used for distributing X's font
2978X's font source file. 3125source file.
2979 3126
2980Current default value lists BDF fonts included in `intlfonts-1.1' 3127Current default value list for BDF fonts is included in `intlfonts-1.1' which is
2981which is a collection of X11 fonts for all characters supported by 3128a collection of X11 fonts for all characters supported by Emacs.
2982Emacs.
2983 3129
2984With the default value, all characters including ASCII and Latin-1 are 3130Using this list as default value to `ps-mule-font-info-database', all characters
2985printed by BDF fonts. See also `ps-mule-font-info-database-ps-bdf'.") 3131including ASCII and Latin-1 are printed by BDF fonts.
3132
3133See also `ps-mule-font-info-database-ps-bdf'.")
2986 3134
2987(defconst ps-mule-font-info-database-ps-bdf 3135(defconst ps-mule-font-info-database-ps-bdf
2988 (cons '(latin-iso8859-1 3136 (cons (car ps-mule-font-info-database-latin)
2989 (normal nil nil iso-latin-1))
2990 (cdr (cdr ps-mule-font-info-database-bdf))) 3137 (cdr (cdr ps-mule-font-info-database-bdf)))
2991 "Sample setting of the `ps-mule-font-info-database to use BDF fonts. 3138 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
2992 3139
2993Current default value lists BDF fonts included in `intlfonts-1.1' 3140Current default value list for BDF fonts is included in `intlfonts-1.1' which is
2994which is a collection of X11 fonts for all characters supported by 3141a collection of X11 fonts for all characters supported by Emacs.
2995Emacs.
2996 3142
2997With the default value, all characters except for ASCII and Latin-1 are 3143Using this list as default value to `ps-mule-font-info-database', all characters
2998printed by BDF fonts. ASCII and Latin-1 charcaters are printed by 3144except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1
2999PostScript font specified by `ps-font-family'. 3145characters are printed by PostScript font specified by `ps-font-family' and
3146`ps-header-font-family'.
3000 3147
3001See also `ps-mule-font-info-database-bdf'.") 3148See also `ps-mule-font-info-database-bdf'.")
3002 3149
3003;; Two typical encoding functions for PostScript fonts. 3150;; Two typical encoding functions for PostScript fonts.
3004 3151
3005(defun ps-mule-encode-7bit (string) 3152(defun ps-mule-encode-7bit (string)
3006 (let* ((dim (charset-dimension 3153 (ps-mule-encode-bit string 0))
3007 (char-charset (ps-mule-string-char string 0))))
3008 (len (* (ps-mule-chars-in-string string) dim))
3009 (str (make-string len 0))
3010 (i 0) (j 0))
3011 (if (= dim 1)
3012 (while (< j len)
3013 (aset str j (nth 1 (split-char (ps-mule-string-char string i))))
3014 (setq i (ps-mule-next-index string i)
3015 j (1+ j)))
3016 (while (< j len)
3017 (let ((split (split-char (ps-mule-string-char string i))))
3018 (aset str j (nth 1 split))
3019 (aset str (1+ j) (nth 2 split))
3020 (setq i (ps-mule-next-index string i)
3021 j (+ j 2)))))
3022 str))
3023 3154
3024(defun ps-mule-encode-8bit (string) 3155(defun ps-mule-encode-8bit (string)
3025 (let* ((dim (charset-dimension 3156 (ps-mule-encode-bit string 128))
3026 (char-charset (ps-mule-string-char string 0)))) 3157
3158(defun ps-mule-encode-bit (string delta)
3159 (let* ((dim (charset-dimension (char-charset (ps-mule-string-char string 0))))
3027 (len (* (ps-mule-chars-in-string string) dim)) 3160 (len (* (ps-mule-chars-in-string string) dim))
3028 (str (make-string len 0)) 3161 (str (make-string len 0))
3029 (i 0) (j 0)) 3162 (i 0)
3163 (j 0))
3030 (if (= dim 1) 3164 (if (= dim 1)
3031 (while (< j len) 3165 (while (< j len)
3032 (aset str j 3166 (aset str j
3033 (+ (nth 1 (split-char (ps-mule-string-char string i))) 128)) 3167 (+ (nth 1 (split-char (ps-mule-string-char string i))) delta))
3034 (setq i (ps-mule-next-index string i) 3168 (setq i (ps-mule-next-index string i)
3035 j (1+ j))) 3169 j (1+ j)))
3036 (while (< j len) 3170 (while (< j len)
3037 (let ((split (split-char (ps-mule-string-char string i)))) 3171 (let ((split (split-char (ps-mule-string-char string i))))
3038 (aset str j (+ (nth 1 split) 128)) 3172 (aset str j (+ (nth 1 split) delta))
3039 (aset str (1+ j) (+ (nth 2 split) 128)) 3173 (aset str (1+ j) (+ (nth 2 split) delta))
3040 (setq i (ps-mule-next-index string i) 3174 (setq i (ps-mule-next-index string i)
3041 j (+ j 2))))) 3175 j (+ j 2)))))
3042 str)) 3176 str))
@@ -3067,17 +3201,21 @@ See also `ps-mule-font-info-database-bdf'.")
3067(defvar ps-mule-current-charset nil) 3201(defvar ps-mule-current-charset nil)
3068 3202
3069(defun ps-mule-get-font-spec (charset font-type) 3203(defun ps-mule-get-font-spec (charset font-type)
3070 "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE. 3204 "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE.
3071FONT-SPEC is a list of FONT-SRC, FONT-NAME, ENCODING, and BYTES, 3205FONT-SPEC is a list that has the form:
3072this information is extracted from `ps-mule-font-info-database' 3206
3073See the documentation of `ps-mule-font-info-database' for the meaning 3207 (FONT-SRC FONT-NAME ENCODING BYTES)
3074of each element of the list." 3208
3209FONT-SPEC is extracted from `ps-mule-font-info-database'.
3210
3211See the documentation of `ps-mule-font-info-database' for the meaning of each
3212element of the list."
3075 (let ((slot (cdr (assq charset ps-mule-font-info-database)))) 3213 (let ((slot (cdr (assq charset ps-mule-font-info-database))))
3076 (if slot 3214 (and slot
3077 (cdr (or (assq font-type slot) 3215 (cdr (or (assq font-type slot)
3078 (and (eq font-type 'bold-italic) 3216 (and (eq font-type 'bold-italic)
3079 (or (assq 'bold slot) (assq 'italic slot))) 3217 (or (assq 'bold slot) (assq 'italic slot)))
3080 (assq 'normal slot)))))) 3218 (assq 'normal slot))))))
3081 3219
3082;; Functions to access each element of FONT-SPEC. 3220;; Functions to access each element of FONT-SPEC.
3083(defsubst ps-mule-font-spec-src (font-spec) (car font-spec)) 3221(defsubst ps-mule-font-spec-src (font-spec) (car font-spec))
@@ -3100,30 +3238,29 @@ of each element of the list."
3100 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs)) 3238 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs))
3101 "Alist of information of external libraries to support PostScript printing. 3239 "Alist of information of external libraries to support PostScript printing.
3102Each element has the form: 3240Each element has the form:
3241
3103 (FONT-SRC INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC) 3242 (FONT-SRC INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC)
3104 3243
3105FONT-SRC is a source of font: builtin, bdf, pcf, or vflib. Except for 3244FONT-SRC is the font source: builtin, bdf, pcf, or vflib. Except for `builtin',
3106builtin, libraries of the same names are necessary, but currently, we 3245libraries must have the same name as indicated by FONT-SRC. Currently, we only
3107only have the library `bdf'. 3246have the `bdf' library.
3108 3247
3109INITIALIZED-P is a flag to tell this library is initialized or not. 3248INITIALIZED-P indicates if this library is initialized or not.
3110 3249
3111PROLOGUE-FUNC is a function to call to get a PostScript codes which 3250PROLOGUE-FUNC is a function to generate PostScript code which define several
3112define procedures to use this library. It is called with no argument, 3251PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
3113and should return a list of strings. 3252called with no argument, and should return a list of strings.
3114 3253
3115FONT-FUNC is a function to call to get a PostScript codes which define 3254FONT-FUNC is a function to generate PostScript code which define a new font. It
3116a new font. It is called with one argument FONT-SPEC, and should 3255is called with one argument FONT-SPEC, and should return a list of strings.
3117return a list of strings.
3118 3256
3119GLYPHS-FUNC is a function to call to get a PostScript codes which 3257GLYPHS-FUNC is a function to generate PostScript code which define glyphs of
3120define glyphs of characters. It is called with three arguments 3258characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES,
3121FONT-SPEC, CODE-LIST, and BYTES, and should return a list of strings.") 3259and should return a list of strings.")
3122 3260
3123(defun ps-mule-init-external-library (font-spec) 3261(defun ps-mule-init-external-library (font-spec)
3124 "Initialize external librarie specified in FONT-SPEC for PostScript printing. 3262 "Initialize external library specified by FONT-SPEC for PostScript printing.
3125See the documentation of `ps-mule-get-font-spec' for the meaning of 3263See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
3126each element of the list."
3127 (let* ((font-src (ps-mule-font-spec-src font-spec)) 3264 (let* ((font-src (ps-mule-font-spec-src font-spec))
3128 (slot (assq font-src ps-mule-external-libraries))) 3265 (slot (assq font-src ps-mule-external-libraries)))
3129 (or (not font-src) 3266 (or (not font-src)
@@ -3152,8 +3289,8 @@ each element of the list."
3152 (format "f%d" ps-current-font) 3289 (format "f%d" ps-current-font)
3153 (format "f%02x-%d" 3290 (format "f%02x-%d"
3154 (charset-id charset) ps-current-font)))) 3291 (charset-id charset) ps-current-font))))
3155 (if (and func (not font-cache)) 3292 (and func (not font-cache)
3156 (ps-output-prologue (funcall func charset font-spec))) 3293 (ps-output-prologue (funcall func charset font-spec)))
3157 (ps-output-prologue 3294 (ps-output-prologue
3158 (list (format "/%s %f /%s Def%sFontMule\n" 3295 (list (format "/%s %f /%s Def%sFontMule\n"
3159 scaled-font-name ps-font-size font-name 3296 scaled-font-name ps-font-size font-name
@@ -3164,27 +3301,29 @@ each element of the list."
3164 (nth 1 font-cache))) 3301 (nth 1 font-cache)))
3165 (setq font-cache (list font-name 3302 (setq font-cache (list font-name
3166 (list (cons ps-current-font scaled-font-name)) 3303 (list (cons ps-current-font scaled-font-name))
3167 'cache)) 3304 'cache)
3168 (setq ps-mule-font-cache (cons font-cache ps-mule-font-cache))) 3305 ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
3169 font-cache)) 3306 font-cache))
3170 3307
3171(defun ps-mule-generate-glyphs (font-spec code-list) 3308(defun ps-mule-generate-glyphs (font-spec code-list)
3172 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC." 3309 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC."
3173 (let* ((font-src (ps-mule-font-spec-src font-spec)) 3310 (let* ((font-src (ps-mule-font-spec-src font-spec))
3174 (func (nth 4 (assq font-src ps-mule-external-libraries)))) 3311 (func (nth 4 (assq font-src ps-mule-external-libraries))))
3175 (if func 3312 (and func
3176 (ps-output-prologue 3313 (ps-output-prologue
3177 (funcall func font-spec code-list 3314 (funcall func font-spec code-list
3178 (ps-mule-font-spec-bytes font-spec)))))) 3315 (ps-mule-font-spec-bytes font-spec))))))
3179 3316
3180(defvar ps-last-font nil) 3317(defvar ps-last-font nil)
3181 3318
3182(defun ps-mule-prepare-font (font-spec string charset &optional no-setfont) 3319(defun ps-mule-prepare-font (font-spec string charset &optional no-setfont)
3183 "Generate PostScript codes to print STRING of CHARSET by font in FONT-SPEC. 3320 "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
3184The generated codes goes to prologue part except for a code for 3321
3185setting the current font (using PostScript procedure `FM'). 3322The generated code is inserted on prologue part except the code that sets the
3186If optional arg NO-SETFONT is non-nil, don't generate the code for 3323current font (using PostScript procedure `FM').
3187setting the current font." 3324
3325If optional arg NO-SETFONT is non-nil, don't generate the code for setting the
3326current font."
3188 (let ((font-cache (assoc (ps-mule-font-spec-name font-spec) 3327 (let ((font-cache (assoc (ps-mule-font-spec-name font-spec)
3189 ps-mule-font-cache))) 3328 ps-mule-font-cache)))
3190 (or (and font-cache (assq ps-current-font (nth 1 font-cache))) 3329 (or (and font-cache (assq ps-current-font (nth 1 font-cache)))
@@ -3205,31 +3344,29 @@ setting the current font."
3205 (i 0) 3344 (i 0)
3206 code) 3345 code)
3207 (while (< i len) 3346 (while (< i len)
3208 (setq code 3347 (setq code (if (= bytes 1)
3209 (if (= bytes 1) (aref string i) 3348 (aref string i)
3210 (+ (* (aref string i) 256) (aref string (1+ i))))) 3349 (+ (* (aref string i) 256) (aref string (1+ i)))))
3211 (or (memq code cached-codes) 3350 (or (memq code cached-codes)
3212 (progn 3351 (progn
3213 (setq newcodes (cons code newcodes)) 3352 (setq newcodes (cons code newcodes))
3214 (setcdr cached-codes (cons code (cdr cached-codes))))) 3353 (setcdr cached-codes (cons code (cdr cached-codes)))))
3215 (setq i (+ i bytes))) 3354 (setq i (+ i bytes)))
3216 (if newcodes 3355 (and newcodes
3217 (ps-mule-generate-glyphs font-spec newcodes)))))) 3356 (ps-mule-generate-glyphs font-spec newcodes))))))
3218 3357
3219;; List of charsets of multibyte characters in a text being printed. 3358;; List of charsets of multibyte characters in a text being printed.
3220;; If the text doesn't contain any multibyte characters (i.e. only 3359;; If the text doesn't contain any multibyte characters (i.e. only
3221;; ASCII), the value is nil. 3360;; ASCII), the value is nil.
3222(defvar ps-mule-charset-list nil) 3361(defvar ps-mule-charset-list nil)
3223 3362
3224;; This constant string is a PostScript code embeded as is in the
3225;; header of generated PostScript.
3226
3227(defvar ps-mule-prologue-generated nil) 3363(defvar ps-mule-prologue-generated nil)
3228 3364
3365;; This is a PostScript code inserted in the header of generated PostScript.
3229(defconst ps-mule-prologue 3366(defconst ps-mule-prologue
3230 "%%%% Start of Mule Section 3367 "%%%% Start of Mule Section
3231 3368
3232%% Working dictionaly for general use. 3369%% Working dictionary for general use.
3233/MuleDict 10 dict def 3370/MuleDict 10 dict def
3234 3371
3235%% Define already scaled font for non-ASCII character sets. 3372%% Define already scaled font for non-ASCII character sets.
@@ -3277,19 +3414,23 @@ setting the current font."
3277 3414
3278(defun ps-mule-skip-same-charset (charset) 3415(defun ps-mule-skip-same-charset (charset)
3279 "Skip characters of CHARSET following the current point." 3416 "Skip characters of CHARSET following the current point."
3280 (while (eq (charset-after) charset) (forward-char 1))) 3417 (while (eq (charset-after) charset)
3418 (forward-char 1)))
3281 3419
3282(defun ps-mule-find-wrappoint (from to char-width) 3420(defun ps-mule-find-wrappoint (from to char-width)
3283 "Find a longest sequence at FROM which is printable in the current line. 3421 "Find the longest sequence which is printable in the current line.
3422
3423The search starts at FROM and goes until TO. It is assumed that all characters
3424between FROM and TO belong to a charset in `ps-mule-current-charset'.
3425
3426CHAR-WIDTH is the average width of ASCII characters in the current font.
3284 3427
3285TO limits the sequence. It is assumed that all characters between 3428Returns the value:
3286FROM and TO belong to a charset set in `ps-mule-current-charset'.
3287 3429
3288CHAR-WIDTH is an average width of ASCII characters in the current font. 3430 (ENDPOS . RUN-WIDTH)
3289 3431
3290The return value is a cons of ENDPOS and RUN-WIDTH, where 3432Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
3291ENDPOS is an end position of the sequence, 3433the sequence."
3292RUN-WIDTH is the width of the sequence."
3293 (let (run-width) 3434 (let (run-width)
3294 (if (eq ps-mule-current-charset 'composition) 3435 (if (eq ps-mule-current-charset 'composition)
3295 ;; We must draw one char by one. 3436 ;; We must draw one char by one.
@@ -3311,18 +3452,24 @@ RUN-WIDTH is the width of the sequence."
3311 3452
3312(defun ps-mule-plot-string (from to &optional bg-color) 3453(defun ps-mule-plot-string (from to &optional bg-color)
3313 "Generate PostScript code for ploting characters in the region FROM and TO. 3454 "Generate PostScript code for ploting characters in the region FROM and TO.
3314It is assumed that all characters in this region belong to the 3455
3315charset `ps-mule-current-charset'. 3456It is assumed that all characters in this region belong to a charset in
3316Optional arg BG-COLOR specifies background color. 3457`ps-mule-current-charset'.
3317The return value is a cons of ENDPOS and WIDTH of the sequence 3458
3318actually plotted by this function." 3459Optional argument BG-COLOR specifies background color.
3460
3461Returns the value:
3462
3463 (ENDPOS . RUN-WIDTH)
3464
3465Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
3466the sequence."
3319 (let* ((wrappoint (ps-mule-find-wrappoint 3467 (let* ((wrappoint (ps-mule-find-wrappoint
3320 from to (ps-avg-char-width 'ps-font-for-text))) 3468 from to (ps-avg-char-width 'ps-font-for-text)))
3321 (to (car wrappoint)) 3469 (to (car wrappoint))
3322 (font-type (car (nth ps-current-font 3470 (font-type (car (nth ps-current-font
3323 (ps-font-alist 'ps-font-for-text)))) 3471 (ps-font-alist 'ps-font-for-text))))
3324 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) 3472 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
3325 (encoding (ps-mule-font-spec-encoding font-spec))
3326 (string (buffer-substring-no-properties from to))) 3473 (string (buffer-substring-no-properties from to)))
3327 (cond 3474 (cond
3328 ((= from to) 3475 ((= from to)
@@ -3331,24 +3478,12 @@ actually plotted by this function."
3331 3478
3332 (font-spec 3479 (font-spec
3333 ;; We surely have a font for printing this character set. 3480 ;; We surely have a font for printing this character set.
3334 (if (coding-system-p encoding) 3481 (ps-output-string (ps-mule-string-encoding font-spec string))
3335 (setq string (encode-coding-string string encoding))
3336 (if (functionp encoding)
3337 (setq string (funcall encoding string))
3338 (if encoding
3339 (error "Invalid coding system or function: %s" encoding))))
3340 (setq string (string-as-unibyte string))
3341 (if (ps-mule-font-spec-src font-spec)
3342 (ps-mule-prepare-font font-spec string ps-mule-current-charset)
3343 (ps-set-font ps-current-font))
3344 (ps-output-string string)
3345 (ps-output " S\n")) 3482 (ps-output " S\n"))
3346 3483
3347 ((eq ps-mule-current-charset 'latin-iso8859-1) 3484 ((eq ps-mule-current-charset 'latin-iso8859-1)
3348 ;; Latin-1 can be printed by a normal ASCII font. 3485 ;; Latin-1 can be printed by a normal ASCII font.
3349 (ps-set-font ps-current-font) 3486 (ps-output-string (ps-mule-string-ascii string))
3350 (ps-output-string
3351 (string-as-unibyte (encode-coding-string string 'iso-latin-1)))
3352 (ps-output " S\n")) 3487 (ps-output " S\n"))
3353 3488
3354 ((eq ps-mule-current-charset 'composition) 3489 ((eq ps-mule-current-charset 'composition)
@@ -3439,7 +3574,7 @@ actually plotted by this function."
3439 currentpoint pop btm LLY sub moveto 3574 currentpoint pop btm LLY sub moveto
3440 S 3575 S
3441 grestore 3576 grestore
3442} bind def 3577} bind def
3443 3578
3444%% Relative composition 3579%% Relative composition
3445/RLC { % str |- -- 3580/RLC { % str |- --
@@ -3464,10 +3599,10 @@ actually plotted by this function."
3464(defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type) 3599(defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type)
3465 (let* ((leftmost 0.0) 3600 (let* ((leftmost 0.0)
3466 (rightmost (float (char-width (car ch-rule-list)))) 3601 (rightmost (float (char-width (car ch-rule-list))))
3467 (l (cons '(3 . 3) ch-rule-list)) 3602 (the-list (cons '(3 . 3) ch-rule-list))
3468 (cmpchar-elements nil)) 3603 (cmpchar-elements nil))
3469 (while l 3604 (while the-list
3470 (let* ((this (car l)) 3605 (let* ((this (car the-list))
3471 (gref (car this)) 3606 (gref (car this))
3472 (nref (cdr this)) 3607 (nref (cdr this))
3473 ;; X-axis info (0:left, 1:center, 2:right) 3608 ;; X-axis info (0:left, 1:center, 2:right)
@@ -3476,75 +3611,73 @@ actually plotted by this function."
3476 ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center) 3611 ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center)
3477 (gref-y (if (= gref 4) 3 (/ gref 3))) 3612 (gref-y (if (= gref 4) 3 (/ gref 3)))
3478 (nref-y (if (= nref 4) 3 (/ nref 3))) 3613 (nref-y (if (= nref 4) 3 (/ nref 3)))
3479 (width (float (char-width (car (cdr l))))) 3614 (width (float (char-width (car (cdr the-list)))))
3480 left) 3615 left)
3481 (setq left (+ leftmost 3616 (setq left (+ leftmost
3482 (/ (* (- rightmost leftmost) gref-x) 2.0) 3617 (/ (* (- rightmost leftmost) gref-x) 2.0)
3483 (- (/ (* nref-x width) 2.0)))) 3618 (- (/ (* nref-x width) 2.0)))
3484 (setq cmpchar-elements 3619 cmpchar-elements (cons (list (car (cdr the-list))
3485 (cons (list (car (cdr l)) left gref-y nref-y) cmpchar-elements)) 3620 left gref-y nref-y)
3486 (if (< left leftmost) 3621 cmpchar-elements)
3487 (setq leftmost left)) 3622 leftmost (min left leftmost)
3488 (if (> (+ left width) rightmost) 3623 rightmost (max (+ left width) rightmost)
3489 (setq rightmost (+ left width))) 3624 the-list (nthcdr 2 the-list))))
3490 (setq l (nthcdr 2 l))))
3491 (if (< leftmost 0) 3625 (if (< leftmost 0)
3492 (let ((l cmpchar-elements)) 3626 (let ((the-list cmpchar-elements))
3493 (while l 3627 (while the-list
3494 (setcar (cdr (car l)) 3628 (setcar (cdr (car the-list))
3495 (- (nth 1 (car l)) leftmost)) 3629 (- (nth 1 (car the-list)) leftmost))
3496 (setq l (cdr l))))) 3630 (setq the-list (cdr the-list)))))
3497 (ps-mule-plot-cmpchar (nreverse cmpchar-elements) 3631 (ps-mule-plot-cmpchar (nreverse cmpchar-elements)
3498 total-width nil font-type))) 3632 total-width nil font-type)))
3499 3633
3500(defun ps-mule-plot-cmpchar (elements total-width relativep font-type) 3634(defun ps-mule-plot-cmpchar (elements total-width relativep font-type)
3501 (let* ((ch (if relativep (car elements) (car (car elements)))) 3635 (let* ((elt (car elements))
3502 (str (ps-mule-prepare-cmpchar-font ch font-type))) 3636 (ch (if relativep elt (car elt))))
3503 (ps-output-string str) 3637 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
3504 (ps-output (format " %d %d BC " 3638 (ps-output (format " %d %d BC "
3505 (if relativep 0 (nth 1 (car elements))) 3639 (if relativep 0 (nth 1 elt))
3506 total-width))) 3640 total-width))
3507 (setq elements (cdr elements)) 3641 (while (setq elements (cdr elements))
3508 (while elements 3642 (setq elt (car elements)
3509 (let* ((elt (car elements)) 3643 ch (if relativep elt (car elt)))
3510 (ch (if relativep elt (car elt))) 3644 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
3511 (str (ps-mule-prepare-cmpchar-font ch font-type))) 3645 (ps-output (if relativep
3512 (if relativep 3646 " RLC "
3513 (progn 3647 (format " %d %d %d RBC "
3514 (ps-output-string str) 3648 (nth 1 elt) (nth 2 elt) (nth 3 elt))))))
3515 (ps-output " RLC "))
3516 (ps-output-string str)
3517 (ps-output (format " %d %d %d RBC "
3518 (nth 1 elt) (nth 2 elt) (nth 3 elt)))))
3519 (setq elements (cdr elements)))
3520 (ps-output "EC\n")) 3649 (ps-output "EC\n"))
3521 3650
3522(defun ps-mule-prepare-cmpchar-font (char font-type) 3651(defun ps-mule-prepare-cmpchar-font (char font-type)
3523 (let* ((ps-mule-current-charset (char-charset char)) 3652 (let* ((ps-mule-current-charset (char-charset char))
3524 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) 3653 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)))
3525 (encoding (ps-mule-font-spec-encoding font-spec))
3526 (str (char-to-string char)))
3527 (cond (font-spec 3654 (cond (font-spec
3528 (if (coding-system-p encoding) 3655 (ps-mule-string-encoding font-spec (char-to-string char)))
3529 (setq str (encode-coding-string str encoding))
3530 (if (functionp encoding)
3531 (setq str (funcall encoding str))
3532 (if encoding
3533 (error "Invalid coding system or function: %s" encoding))))
3534 (setq str (string-as-unibyte str))
3535 (if (ps-mule-font-spec-src font-spec)
3536 (ps-mule-prepare-font font-spec str ps-mule-current-charset)
3537 (ps-set-font ps-current-font)))
3538 3656
3539 ((eq ps-mule-current-charset 'latin-iso8859-1) 3657 ((eq ps-mule-current-charset 'latin-iso8859-1)
3540 (ps-set-font ps-current-font) 3658 (ps-mule-string-ascii (char-to-string char)))
3541 (setq str
3542 (string-as-unibyte (encode-coding-string str 'iso-latin-1))))
3543 3659
3544 (t 3660 (t
3545 ;; No font for CHAR. 3661 ;; No font for CHAR.
3546 (ps-set-font ps-current-font) 3662 (ps-set-font ps-current-font)
3547 (setq str " "))) 3663 " "))))
3664
3665(defun ps-mule-string-ascii (str)
3666 (ps-set-font ps-current-font)
3667 (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
3668
3669(defun ps-mule-string-encoding (font-spec str)
3670 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
3671 (cond ((coding-system-p encoding)
3672 (setq str (encode-coding-string str encoding)))
3673 ((functionp encoding)
3674 (setq str (funcall encoding str)))
3675 (encoding
3676 (error "Invalid coding system or function: %s" encoding)))
3677 (setq str (string-as-unibyte str))
3678 (if (ps-mule-font-spec-src font-spec)
3679 (ps-mule-prepare-font font-spec str ps-mule-current-charset)
3680 (ps-set-font ps-current-font))
3548 str)) 3681 str))
3549 3682
3550;; Bitmap font support 3683;; Bitmap font support
@@ -3591,7 +3724,7 @@ NewBitmapDict
3591 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put 3724 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put
3592 str7 cvn 3725 str7 cvn
3593} bind def 3726} bind def
3594 3727
3595%% Character code holder for a 2-byte character. 3728%% Character code holder for a 2-byte character.
3596/FirstCode -1 def 3729/FirstCode -1 def
3597 3730
@@ -3633,7 +3766,7 @@ NewBitmapDict
3633 imagemask 3766 imagemask
3634 } if 3767 } if
3635 } ifelse 3768 } ifelse
3636} bind def 3769} bind def
3637 3770
3638/BuildCharCommon { 3771/BuildCharCommon {
3639 1 index /Encoding get exch get 3772 1 index /Encoding get exch get
@@ -3723,51 +3856,60 @@ NewBitmapDict
3723 3856
3724(defun ps-mule-initialize () 3857(defun ps-mule-initialize ()
3725 "Produce Poscript code in the prologue part for multibyte characters." 3858 "Produce Poscript code in the prologue part for multibyte characters."
3726 (setq ps-mule-current-charset 'ascii 3859 (setq ps-mule-font-info-database
3860 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
3861 ps-mule-font-info-database-ps)
3862 ((eq ps-multibyte-buffer 'bdf-font)
3863 ps-mule-font-info-database-bdf)
3864 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
3865 ps-mule-font-info-database-ps-bdf)
3866 (t
3867 ps-mule-font-info-database-latin))
3868 ps-mule-current-charset 'ascii
3727 ps-mule-font-cache nil 3869 ps-mule-font-cache nil
3728 ps-mule-prologue-generated nil 3870 ps-mule-prologue-generated nil
3729 ps-mule-cmpchar-prologue-generated nil 3871 ps-mule-cmpchar-prologue-generated nil
3730 ps-mule-bitmap-prologue-generated nil) 3872 ps-mule-bitmap-prologue-generated nil)
3731 (mapcar (function (lambda (x) (setcar (cdr x) nil))) 3873 (mapcar `(lambda (x) (setcar (cdr x) nil))
3732 ps-mule-external-libraries)) 3874 ps-mule-external-libraries))
3733 3875
3734(defun ps-mule-begin (from to) 3876(defun ps-mule-begin (from to)
3735 (if (and (boundp 'enable-multibyte-characters) 3877 (and (boundp 'enable-multibyte-characters)
3736 enable-multibyte-characters) 3878 enable-multibyte-characters
3737 ;; Initialize `ps-mule-charset-list'. If some characters aren't 3879 ;; Initialize `ps-mule-charset-list'. If some characters aren't
3738 ;; printable, warn it. 3880 ;; printable, warn it.
3739 (let ((charsets (delete 'ascii (find-charset-region from to)))) 3881 (let ((charsets (delete 'ascii (find-charset-region from to))))
3740 (setq ps-mule-charset-list charsets) 3882 (setq ps-mule-charset-list charsets)
3741 (save-excursion 3883 (save-excursion
3742 (goto-char from) 3884 (goto-char from)
3743 (if (search-forward "\200" to t) 3885 (and (search-forward "\200" to t)
3744 (setq ps-mule-charset-list 3886 (setq ps-mule-charset-list
3745 (cons 'composition ps-mule-charset-list)))) 3887 (cons 'composition ps-mule-charset-list))))
3746 (if (and (catch 'tag 3888 (while charsets
3747 (while charsets 3889 (cond
3748 (if (or (eq (car charsets) 'composition) 3890 ((or (eq (car charsets) 'composition)
3749 (ps-mule-printable-p (car charsets))) 3891 (ps-mule-printable-p (car charsets)))
3750 (setq charsets (cdr charsets)) 3892 (setq charsets (cdr charsets)))
3751 (throw 'tag t)))) 3893 ((y-or-n-p "Font for some characters not found, continue anyway? ")
3752 (not (y-or-n-p "Font for some characters not found, continue anyway? "))) 3894 (setq charsets nil))
3753 (error "Printing cancelled")))) 3895 (t
3896 (error "Printing cancelled"))))))
3754 3897
3755 (if ps-mule-charset-list 3898 (if ps-mule-charset-list
3756 (let ((l ps-mule-charset-list) 3899 (let ((the-list ps-mule-charset-list)
3757 font-spec) 3900 font-spec)
3758 (unless ps-mule-prologue-generated 3901 (unless ps-mule-prologue-generated
3759 (ps-output-prologue ps-mule-prologue) 3902 (ps-output-prologue ps-mule-prologue)
3760 (setq ps-mule-prologue-generated t)) 3903 (setq ps-mule-prologue-generated t))
3761 ;; If external functions are necessary, generate prologues for them. 3904 ;; If external functions are necessary, generate prologues for them.
3762 (while l 3905 (while the-list
3763 (if (and (eq (car l) 'composition) 3906 (cond ((and (eq (car the-list) 'composition)
3764 (not ps-mule-cmpchar-prologue-generated)) 3907 (not ps-mule-cmpchar-prologue-generated))
3765 (progn 3908 (ps-output-prologue ps-mule-cmpchar-prologue)
3766 (ps-output-prologue ps-mule-cmpchar-prologue) 3909 (setq ps-mule-cmpchar-prologue-generated t))
3767 (setq ps-mule-cmpchar-prologue-generated t)) 3910 ((setq font-spec (ps-mule-get-font-spec (car the-list) 'normal))
3768 (if (setq font-spec (ps-mule-get-font-spec (car l) 'normal)) 3911 (ps-mule-init-external-library font-spec)))
3769 (ps-mule-init-external-library font-spec))) 3912 (setq the-list (cdr the-list)))))
3770 (setq l (cdr l)))))
3771 3913
3772 ;; If ASCII font is also specified in ps-mule-font-info-database, 3914 ;; If ASCII font is also specified in ps-mule-font-info-database,
3773 ;; use it istead of what specified in ps-font-info-database. 3915 ;; use it istead of what specified in ps-font-info-database.
@@ -3786,10 +3928,12 @@ NewBitmapDict
3786 (ps-mule-prepare-font 3928 (ps-mule-prepare-font
3787 (ps-mule-get-font-spec 'ascii (car font)) 3929 (ps-mule-get-font-spec 'ascii (car font))
3788 " " 'ascii 'no-setfont)) 3930 " " 'ascii 'no-setfont))
3789 (setq font (cdr font) i (1+ i)))))))) 3931 (setq font (cdr font)
3932 i (1+ i))))))))
3790 3933
3791 3934;; For handling multibyte characters -- End.
3792;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3935;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3936
3793 3937
3794(defun ps-line-lengths-internal () 3938(defun ps-line-lengths-internal ()
3795 "Display the correspondence between a line length and a font size, 3939 "Display the correspondence between a line length and a font size,
@@ -3990,9 +4134,23 @@ page-height == bm + print-height + tm - ho - hh
3990 (and filename 4134 (and filename
3991 (or (numberp filename) 4135 (or (numberp filename)
3992 (listp filename)) 4136 (listp filename))
3993 (let* ((name (concat (buffer-name) ".ps")) 4137 (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
4138 (buffer-name)))
4139 ".ps"))
3994 (prompt (format "Save PostScript to file: (default %s) " name)) 4140 (prompt (format "Save PostScript to file: (default %s) " name))
3995 (res (read-file-name prompt default-directory name nil))) 4141 (res (read-file-name prompt default-directory name nil)))
4142 (while (cond ((not (file-writable-p res))
4143 (ding)
4144 (setq prompt "is unwritable"))
4145 ((file-exists-p res)
4146 (setq prompt "exists")
4147 (not (y-or-n-p (format "File `%s' exists; overwrite? "
4148 res))))
4149 (t nil))
4150 (setq res (read-file-name
4151 (format "File %s; save PostScript to file: " prompt)
4152 (file-name-directory res) nil nil
4153 (file-name-nondirectory res))))
3996 (if (file-directory-p res) 4154 (if (file-directory-p res)
3997 (expand-file-name name (file-name-as-directory res)) 4155 (expand-file-name name (file-name-as-directory res))
3998 res)))) 4156 res))))
@@ -4303,15 +4461,23 @@ page-height == bm + print-height + tm - ho - hh
4303 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) 4461 (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy)
4304 "\n%%Orientation: " 4462 "\n%%Orientation: "
4305 (if ps-landscape-mode "Landscape" "Portrait") 4463 (if ps-landscape-mode "Landscape" "Portrait")
4306 "\n%% DocumentFonts: Times-Roman Times-Italic " 4464 "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
4307 (mapconcat 'identity 4465 (mapconcat 'identity
4308 (ps-remove-duplicates 4466 (ps-remove-duplicates
4309 (append (ps-fonts 'ps-font-for-text) 4467 (append (ps-fonts 'ps-font-for-text)
4310 (list (ps-font 'ps-font-for-header 'normal) 4468 (list (ps-font 'ps-font-for-header 'normal)
4311 (ps-font 'ps-font-for-header 'bold)))) 4469 (ps-font 'ps-font-for-header 'bold))))
4312 " ") 4470 "\n%%+ font ")
4313 "\n%%Pages: (atend)\n" 4471 "\n%%Pages: (atend)\n%%Requirements:"
4314 "%%EndComments\n\n") 4472 (if ps-spool-duplex " duplex\n" "\n"))
4473
4474 (let ((comments (if (functionp ps-print-prologue-header)
4475 (funcall ps-print-prologue-header)
4476 ps-print-prologue-header)))
4477 (and (stringp comments)
4478 (ps-output comments)))
4479
4480 (ps-output "%%EndComments\n\n%%BeginPrologue\n\n")
4315 4481
4316 (ps-output-boolean "LandscapeMode" ps-landscape-mode) 4482 (ps-output-boolean "LandscapeMode" ps-landscape-mode)
4317 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns) 4483 (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
@@ -4708,19 +4874,31 @@ EndDSCPage\n"))
4708 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval. 4874 ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
4709 (/ x-color-value ps-print-color-scale)) 4875 (/ x-color-value ps-print-color-scale))
4710 4876
4711(defun ps-color-values (x-color) 4877
4712 (cond ((fboundp 'x-color-values) 4878(cond ((eq ps-print-emacs-type 'emacs) ; emacs
4713 (x-color-values x-color)) 4879
4714 ((and (fboundp 'color-instance-rgb-components) 4880 (defun ps-color-values (x-color)
4715 (ps-color-device)) 4881 (if (fboundp 'x-color-values)
4716 (color-instance-rgb-components 4882 (x-color-values x-color)
4717 (if (color-instance-p x-color) 4883 (error "No available function to determine X color values.")))
4718 x-color 4884 )
4719 (make-color-instance 4885 ; xemacs
4720 (if (color-specifier-p x-color) 4886 ; lucid
4721 (color-name x-color) 4887 (t ; epoch
4722 x-color))))) 4888 (defun ps-color-values (x-color)
4723 (t (error "No available function to determine X color values.")))) 4889 (cond ((fboundp 'x-color-values)
4890 (x-color-values x-color))
4891 ((and (fboundp 'color-instance-rgb-components)
4892 (ps-color-device))
4893 (color-instance-rgb-components
4894 (if (color-instance-p x-color)
4895 x-color
4896 (make-color-instance
4897 (if (color-specifier-p x-color)
4898 (color-name x-color)
4899 x-color)))))
4900 (t (error "No available function to determine X color values."))))
4901 ))
4724 4902
4725 4903
4726(defun ps-face-attributes (face) 4904(defun ps-face-attributes (face)
@@ -4770,11 +4948,11 @@ If FACE is not a valid face name, it is used default face."
4770 (effect (aref face-bit 0)) 4948 (effect (aref face-bit 0))
4771 (foreground (aref face-bit 1)) 4949 (foreground (aref face-bit 1))
4772 (background (aref face-bit 2)) 4950 (background (aref face-bit 2))
4773 (fg-color (if (and ps-print-color-p foreground (ps-color-device)) 4951 (fg-color (if (and ps-color-p foreground)
4774 (mapcar 'ps-color-value 4952 (mapcar 'ps-color-value
4775 (ps-color-values foreground)) 4953 (ps-color-values foreground))
4776 ps-default-color)) 4954 ps-default-color))
4777 (bg-color (and ps-print-color-p background (ps-color-device) 4955 (bg-color (and ps-color-p background
4778 (mapcar 'ps-color-value 4956 (mapcar 'ps-color-value
4779 (ps-color-values background))))) 4957 (ps-color-values background)))))
4780 (ps-plot-region 4958 (ps-plot-region
@@ -4786,18 +4964,6 @@ If FACE is not a valid face name, it is used default face."
4786 (goto-char to)) 4964 (goto-char to))
4787 4965
4788 4966
4789(defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
4790 (let* ((frame-font (or (face-font-instance face)
4791 (face-font-instance 'default)))
4792 (kind-cons (and frame-font
4793 (assq kind (font-instance-properties frame-font))))
4794 (kind-spec (cdr-safe kind-cons))
4795 (case-fold-search t))
4796 (or (and kind-spec (string-match kind-regex kind-spec))
4797 ;; Kludge-compatible:
4798 (memq face kind-list))))
4799
4800
4801(cond ((eq ps-print-emacs-type 'emacs) ; emacs 4967(cond ((eq ps-print-emacs-type 'emacs) ; emacs
4802 4968
4803 (defun ps-face-bold-p (face) 4969 (defun ps-face-bold-p (face)
@@ -4811,8 +4977,21 @@ If FACE is not a valid face name, it is used default face."
4811 ; xemacs 4977 ; xemacs
4812 ; lucid 4978 ; lucid
4813 (t ; epoch 4979 (t ; epoch
4980 (defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
4981 (let* ((frame-font (or (face-font-instance face)
4982 (face-font-instance 'default)))
4983 (kind-cons (and frame-font
4984 (assq kind
4985 (font-instance-properties frame-font))))
4986 (kind-spec (cdr-safe kind-cons))
4987 (case-fold-search t))
4988 (or (and kind-spec (string-match kind-regex kind-spec))
4989 ;; Kludge-compatible:
4990 (memq face kind-list))))
4991
4814 (defun ps-face-bold-p (face) 4992 (defun ps-face-bold-p (face)
4815 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold" ps-bold-faces)) 4993 (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
4994 ps-bold-faces))
4816 4995
4817 (defun ps-face-italic-p (face) 4996 (defun ps-face-italic-p (face)
4818 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces) 4997 (or (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces)
@@ -4881,19 +5060,23 @@ If FACE is not a valid face name, it is used default face."
4881 (face-background face)))) 5060 (face-background face))))
4882 5061
4883 5062
4884(defun ps-mapper (extent list) 5063(cond ((not (eq ps-print-emacs-type 'emacs))
4885 (nconc list (list (list (extent-start-position extent) 'push extent) 5064 ; xemacs
4886 (list (extent-end-position extent) 'pull extent))) 5065 ; lucid
4887 nil) 5066 ; epoch
5067 (defun ps-mapper (extent list)
5068 (nconc list (list (list (extent-start-position extent) 'push extent)
5069 (list (extent-end-position extent) 'pull extent)))
5070 nil)
5071
5072 (defun ps-extent-sorter (a b)
5073 (< (extent-priority a) (extent-priority b)))
5074 ))
4888 5075
4889(defun ps-extent-sorter (a b)
4890 (< (extent-priority a) (extent-priority b)))
4891 5076
4892(defun ps-print-ensure-fontified (start end) 5077(defun ps-print-ensure-fontified (start end)
4893 (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode) 5078 (and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode)
4894 (if (fboundp 'lazy-lock-fontify-region) 5079 (lazy-lock-fontify-region start end)))
4895 (lazy-lock-fontify-region start end) ; the new
4896 (lazy-lock-fontify-buffer)))) ; the old
4897 5080
4898(defun ps-generate-postscript-with-faces (from to) 5081(defun ps-generate-postscript-with-faces (from to)
4899 ;; Some initialization... 5082 ;; Some initialization...
@@ -4908,16 +5091,16 @@ If FACE is not a valid face name, it is used default face."
4908 ;; Set the color scale. We do it here instead of in the defvar so 5091 ;; Set the color scale. We do it here instead of in the defvar so
4909 ;; that ps-print can be dumped into emacs. This expression can't be 5092 ;; that ps-print can be dumped into emacs. This expression can't be
4910 ;; evaluated at dump-time because X isn't initialized. 5093 ;; evaluated at dump-time because X isn't initialized.
4911 (setq ps-print-color-scale 5094 (setq ps-color-p (and ps-print-color-p (ps-color-device))
4912 (if (and ps-print-color-p (ps-color-device)) 5095 ps-print-color-scale (if ps-color-p
4913 (float (car (ps-color-values "white"))) 5096 (float (car (ps-color-values "white")))
4914 1.0)) 5097 1.0))
4915 ;; Generate some PostScript. 5098 ;; Generate some PostScript.
4916 (save-restriction 5099 (save-restriction
4917 (narrow-to-region from to) 5100 (narrow-to-region from to)
5101 (ps-print-ensure-fontified from to)
4918 (let ((face 'default) 5102 (let ((face 'default)
4919 (position to)) 5103 (position to))
4920 (ps-print-ensure-fontified from to)
4921 (cond 5104 (cond
4922 ((or (eq ps-print-emacs-type 'lucid) 5105 ((or (eq ps-print-emacs-type 'lucid)
4923 (eq ps-print-emacs-type 'xemacs)) 5106 (eq ps-print-emacs-type 'xemacs))
@@ -4952,19 +5135,17 @@ If FACE is not a valid face name, it is used default face."
4952 5135
4953 (cond 5136 (cond
4954 ((eq type 'push) 5137 ((eq type 'push)
4955 (if (extent-face extent) 5138 (and (extent-face extent)
4956 (setq extent-list (sort (cons extent extent-list) 5139 (setq extent-list (sort (cons extent extent-list)
4957 'ps-extent-sorter)))) 5140 'ps-extent-sorter))))
4958 5141
4959 ((eq type 'pull) 5142 ((eq type 'pull)
4960 (setq extent-list (sort (delq extent extent-list) 5143 (setq extent-list (sort (delq extent extent-list)
4961 'ps-extent-sorter)))) 5144 'ps-extent-sorter))))
4962 5145
4963 (setq face 5146 (setq face (if extent-list
4964 (if extent-list 5147 (extent-face (car extent-list))
4965 (extent-face (car extent-list)) 5148 'default)
4966 'default)
4967
4968 from position 5149 from position
4969 a (cdr a))))) 5150 a (cdr a)))))
4970 5151
@@ -4974,16 +5155,13 @@ If FACE is not a valid face name, it is used default face."
4974 (save-buffer-invisibility-spec buffer-invisibility-spec) 5155 (save-buffer-invisibility-spec buffer-invisibility-spec)
4975 (buffer-invisibility-spec nil)) 5156 (buffer-invisibility-spec nil))
4976 (while (< from to) 5157 (while (< from to)
4977 (if (< property-change to) ; Don't search for property change 5158 (and (< property-change to) ; Don't search for property change
4978 ; unless previous search succeeded. 5159 ; unless previous search succeeded.
4979 (setq property-change 5160 (setq property-change (next-property-change from nil to)))
4980 (next-property-change from nil to))) 5161 (and (< overlay-change to) ; Don't search for overlay change
4981 (if (< overlay-change to) ; Don't search for overlay change
4982 ; unless previous search succeeded. 5162 ; unless previous search succeeded.
4983 (setq overlay-change 5163 (setq overlay-change (min (next-overlay-change from) to)))
4984 (min (next-overlay-change from) to))) 5164 (setq position (min property-change overlay-change))
4985 (setq position
4986 (min property-change overlay-change))
4987 ;; The code below is not quite correct, 5165 ;; The code below is not quite correct,
4988 ;; because a non-nil overlay invisible property 5166 ;; because a non-nil overlay invisible property
4989 ;; which is inactive according to the current value 5167 ;; which is inactive according to the current value
@@ -5002,15 +5180,13 @@ If FACE is not a valid face name, it is used default face."
5002 (t 'default))) 5180 (t 'default)))
5003 (let ((overlays (overlays-at from)) 5181 (let ((overlays (overlays-at from))
5004 (face-priority -1)) ; text-property 5182 (face-priority -1)) ; text-property
5005 (while overlays 5183 (while (and overlays
5184 (not (eq face 'emacs--invisible--face)))
5006 (let* ((overlay (car overlays)) 5185 (let* ((overlay (car overlays))
5007 (overlay-face (overlay-get overlay 'face))
5008 (overlay-invisible (overlay-get overlay 'invisible)) 5186 (overlay-invisible (overlay-get overlay 'invisible))
5009 (overlay-priority (or (overlay-get overlay 5187 (overlay-priority (or (overlay-get overlay 'priority)
5010 'priority)
5011 0))) 5188 0)))
5012 (and (or overlay-invisible overlay-face) 5189 (and (> overlay-priority face-priority)
5013 (> overlay-priority face-priority)
5014 (setq face 5190 (setq face
5015 (cond ((if (eq save-buffer-invisibility-spec t) 5191 (cond ((if (eq save-buffer-invisibility-spec t)
5016 (not (null overlay-invisible)) 5192 (not (null overlay-invisible))
@@ -5019,7 +5195,8 @@ If FACE is not a valid face name, it is used default face."
5019 (assq overlay-invisible 5195 (assq overlay-invisible
5020 save-buffer-invisibility-spec))) 5196 save-buffer-invisibility-spec)))
5021 'emacs--invisible--face) 5197 'emacs--invisible--face)
5022 (face overlay-face)) 5198 ((overlay-get overlay 'face))
5199 (t face))
5023 face-priority overlay-priority))) 5200 face-priority overlay-priority)))
5024 (setq overlays (cdr overlays)))) 5201 (setq overlays (cdr overlays))))
5025 ;; Plot up to this record. 5202 ;; Plot up to this record.
@@ -5061,7 +5238,7 @@ If FACE is not a valid face name, it is used default face."
5061 (setq needs-begin-file t)) 5238 (setq needs-begin-file t))
5062 (save-excursion 5239 (save-excursion
5063 (set-buffer ps-source-buffer) 5240 (set-buffer ps-source-buffer)
5064 (if needs-begin-file (ps-begin-file)) 5241 (and needs-begin-file (ps-begin-file))
5065 (ps-mule-begin from to) 5242 (ps-mule-begin from to)
5066 (ps-begin-job) 5243 (ps-begin-job)
5067 (ps-begin-page)) 5244 (ps-begin-page))
@@ -5103,8 +5280,6 @@ If FACE is not a valid face name, it is used default face."
5103 5280
5104 (and ps-razzle-dazzle (message "Formatting...done")))))) 5281 (and ps-razzle-dazzle (message "Formatting...done"))))))
5105 5282
5106;; To avoid compilation gripes
5107(defvar dos-ps-printer nil)
5108 5283
5109;; Permit dynamic evaluation at print time of `ps-lpr-switches'. 5284;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
5110(defun ps-do-despool (filename) 5285(defun ps-do-despool (filename)
@@ -5130,13 +5305,8 @@ If FACE is not a valid face name, it is used default face."
5130 (list (concat "-P" ps-printer-name))) 5305 (list (concat "-P" ps-printer-name)))
5131 ps-lpr-switches))) 5306 ps-lpr-switches)))
5132 (if (and (memq system-type '(ms-dos windows-nt)) 5307 (if (and (memq system-type '(ms-dos windows-nt))
5133 (or (stringp dos-ps-printer) 5308 (stringp ps-printer-name))
5134 (stringp ps-printer-name))) 5309 (write-region (point-min) (point-max) ps-printer-name t 0)
5135 (write-region (point-min) (point-max)
5136 (if (stringp dos-ps-printer)
5137 dos-ps-printer
5138 ps-printer-name)
5139 t 0)
5140 (apply 'call-process-region 5310 (apply 'call-process-region
5141 (point-min) (point-max) ps-lpr-command nil 5311 (point-min) (point-max) ps-lpr-command nil
5142 (and (fboundp 'start-process) 0) 5312 (and (fboundp 'start-process) 0)
@@ -5181,11 +5351,12 @@ If FACE is not a valid face name, it is used default face."
5181 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")) 5351 (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
5182 (error "Unprinted PostScript")))) 5352 (error "Unprinted PostScript"))))
5183 5353
5184(if (fboundp 'add-hook) 5354(cond ((fboundp 'add-hook)
5185 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check) 5355 (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check))
5186 (if kill-emacs-hook 5356 (kill-emacs-hook
5187 (message "Won't override existing kill-emacs-hook") 5357 (message "Won't override existing `kill-emacs-hook'"))
5188 (setq kill-emacs-hook 'ps-kill-emacs-check))) 5358 (t
5359 (setq kill-emacs-hook 'ps-kill-emacs-check)))
5189 5360
5190;;; Sample Setup Code: 5361;;; Sample Setup Code:
5191 5362
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-21 09:36:41 +0000