Fix typo in comment.
[bpt/emacs.git] / lisp / ps-mule.el
CommitLineData
e8af40ee 1;;; ps-mule.el --- provide multi-byte character facility to ps-print
2cb842ae 2
0d30b337 3;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
409cc4a3 4;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
2cb842ae 5
f123cf2e 6;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
3412b8d9
VJL
7;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
8;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
f123cf2e 9;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
e8af40ee 10;; Keywords: wp, print, PostScript, multibyte, mule
2cb842ae
KH
11
12;; This file is part of GNU Emacs.
13
14;; GNU Emacs is free software; you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
b4aa6026 16;; the Free Software Foundation; either version 3, or (at your option)
2cb842ae
KH
17;; any later version.
18
19;; GNU Emacs is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22;; GNU General Public License for more details.
23
24;; You should have received a copy of the GNU General Public License
25;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27;; Boston, MA 02110-1301, USA.
2cb842ae
KH
28
29;;; Commentary:
30
c276ee05 31;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2cb842ae
KH
32;;
33;; About ps-mule
34;; -------------
35;;
36;; This package is used for ps-print to print multi-byte buffer.
37;;
38;; See also ps-print.el.
39;;
40;;
41;; Printing Multi-byte Buffer
42;; --------------------------
43;;
44;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer
45;; handling.
46;;
47;; Valid values for `ps-multibyte-buffer' are:
48;;
41a247c2
VJL
49;; nil This is the value to use the default settings;
50;; by default, this only works to print buffers with
51;; only ASCII and Latin characters. But this default
52;; setting can be changed by setting the variable
c276ee05
KH
53;; `ps-mule-font-info-database-default' differently.
54;; The initial value of this variable is
55;; `ps-mule-font-info-database-latin' (see
56;; documentation).
2cb842ae 57;;
41a247c2 58;; `non-latin-printer' This is the value to use when you have a japanese
2cb842ae
KH
59;; or korean PostScript printer and want to print
60;; buffer with ASCII, Latin-1, Japanese (JISX0208 and
61;; JISX0201-Kana) and Korean characters. At present,
41a247c2
VJL
62;; it was not tested with the Korean characters
63;; printing. If you have a korean PostScript printer,
64;; please, test it.
2cb842ae 65;;
41a247c2 66;; `bdf-font' This is the value to use when you want to print
2cb842ae
KH
67;; buffer with BDF fonts. BDF fonts include both latin
68;; and non-latin fonts. BDF (Bitmap Distribution
69;; Format) is a format used for distributing X's font
70;; source file. BDF fonts are included in
922be019 71;; `intlfonts-1.2' which is a collection of X11 fonts
2cb842ae
KH
72;; for all characters supported by Emacs. In order to
73;; use this value, be sure to have installed
922be019 74;; `intlfonts-1.2' and set the variable
2cb842ae
KH
75;; `bdf-directory-list' appropriately (see ps-bdf.el
76;; for documentation of this variable).
77;;
41a247c2 78;; `bdf-font-except-latin' This is like `bdf-font' except that it uses
2cb842ae
KH
79;; PostScript default fonts to print ASCII and Latin-1
80;; characters. This is convenient when you want or
81;; need to use both latin and non-latin characters on
82;; the same buffer. See `ps-font-family',
83;; `ps-header-font-family' and `ps-font-info-database'.
84;;
85;; Any other value is treated as nil.
86;;
87;; The default is nil.
88;;
c276ee05 89;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2cb842ae
KH
90
91;;; Code:
92
922be019 93(eval-and-compile
c97a3f22 94 (require 'ps-print))
2cb842ae 95
c276ee05 96
3ea591bd
KH
97;;;###autoload
98(defcustom ps-multibyte-buffer nil
99 "*Specifies the multi-byte buffer handling.
100
101Valid values are:
102
41a247c2
VJL
103 nil This is the value to use the default settings;
104 by default, this only works to print buffers with
105 only ASCII and Latin characters. But this default
106 setting can be changed by setting the variable
3ea591bd
KH
107 `ps-mule-font-info-database-default' differently.
108 The initial value of this variable is
109 `ps-mule-font-info-database-latin' (see
110 documentation).
111
41a247c2 112 `non-latin-printer' This is the value to use when you have a Japanese
3ea591bd
KH
113 or Korean PostScript printer and want to print
114 buffer with ASCII, Latin-1, Japanese (JISX0208 and
115 JISX0201-Kana) and Korean characters. At present,
41a247c2
VJL
116 it was not tested with the Korean characters
117 printing. If you have a korean PostScript printer,
118 please, test it.
3ea591bd 119
41a247c2 120 `bdf-font' This is the value to use when you want to print
3ea591bd
KH
121 buffer with BDF fonts. BDF fonts include both latin
122 and non-latin fonts. BDF (Bitmap Distribution
123 Format) is a format used for distributing X's font
124 source file. BDF fonts are included in
922be019 125 `intlfonts-1.2' which is a collection of X11 fonts
3ea591bd
KH
126 for all characters supported by Emacs. In order to
127 use this value, be sure to have installed
922be019 128 `intlfonts-1.2' and set the variable
3ea591bd
KH
129 `bdf-directory-list' appropriately (see ps-bdf.el for
130 documentation of this variable).
131
41a247c2 132 `bdf-font-except-latin' This is like `bdf-font' except that it uses
3ea591bd
KH
133 PostScript default fonts to print ASCII and Latin-1
134 characters. This is convenient when you want or
135 need to use both latin and non-latin characters on
136 the same buffer. See `ps-font-family',
137 `ps-header-font-family' and `ps-font-info-database'.
138
139Any other value is treated as nil."
9909b395
GM
140 :type '(choice (const non-latin-printer) (const bdf-font)
141 (const bdf-font-except-latin) (const :tag "nil" nil))
3ea591bd 142 :group 'ps-print-font)
c276ee05 143
2cb842ae
KH
144(defvar ps-mule-font-info-database
145 nil
146 "Alist of charsets with the corresponding font information.
147Each element has the form:
148
41a247c2 149 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
2cb842ae
KH
150
151Where
152
153CHARSET is a charset (symbol) for this font family,
154
155FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
156
b1a733ef 157FONT-SRC is a font source: builtin, bdf, vflib, or nil.
2cb842ae 158
922be019 159 If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.
2cb842ae 160
5d5bea97
EZ
161 If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
162 alternative font names. To use this font, the external library `ps-bdf'
163 is required.
2cb842ae
KH
164
165 If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
166 To use this font, the external library `vflib' is required.
167
168 If FONT-SRC is nil, a proper ASCII font in the variable
41a247c2 169 `ps-font-info-database' is used. This is useful for Latin-1 characters.
2cb842ae 170
41a247c2
VJL
171ENCODING is a coding system to encode a string of characters of CHARSET into a
172proper string matching an encoding of the specified font. ENCODING may be a
173function that does this encoding. In this case, the function is called with
174one argument, the string to encode, and it should return an encoded string.
2cb842ae 175
41a247c2
VJL
176BYTES specifies how many bytes each character has in the encoded byte
177sequence; it should be 1 or 2.
2cb842ae
KH
178
179All multi-byte characters are printed by fonts specified in this database
180regardless of a font family of ASCII characters. The exception is Latin-1
181characters which are printed by the same font as ASCII characters, thus obey
182font family.
183
184See also the variable `ps-font-info-database'.")
185
186(defconst ps-mule-font-info-database-latin
76875dcb
KH
187 '((iso-8859-1
188 (normal nil nil)))
2cb842ae
KH
189 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
190
c276ee05 191(defcustom ps-mule-font-info-database-default
2a772306 192 ps-mule-font-info-database-latin
8fdd56af
GM
193 "*The default setting to use when `ps-multibyte-buffer' is nil."
194 :type '(symbol :tag "Multi-Byte Buffer Database Font Default")
c276ee05 195 :group 'ps-print-font)
00cbf820 196
2cb842ae
KH
197(defconst ps-mule-font-info-database-ps
198 '((katakana-jisx0201
76875dcb
KH
199 (normal builtin "Ryumin-Light.Katakana")
200 (bold builtin "GothicBBB-Medium.Katakana")
201 (bold-italic builtin "GothicBBB-Medium.Katakana"))
2cb842ae 202 (latin-jisx0201
76875dcb
KH
203 (normal builtin "Ryumin-Light.Hankaku")
204 (bold builtin "GothicBBB-Medium.Hankaku"))
2cb842ae 205 (japanese-jisx0208
76875dcb
KH
206 (normal builtin "Ryumin-Light-H")
207 (bold builtin "GothicBBB-Medium-H"))
2cb842ae 208 (korean-ksc5601
76875dcb
KH
209 (normal builtin "Munhwa-Regular-KSC-EUC-H")
210 (bold builtin "Munhwa-Bold-KSC-EUC-H"))
2cb842ae
KH
211 )
212 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
213
214Currently, data for Japanese and Korean PostScript printers are listed.")
215
216(defconst ps-mule-font-info-database-bdf
76875dcb
KH
217 '((iso-8859-1
218 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf"))
219 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf"))
220 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf"))
221 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf")))
222 (iso-8859-2
223 (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf")))
224 (iso-8859-3
225 (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf")))
226 (iso-8859-4
227 (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf")))
2cb842ae 228 (thai-tis620
76875dcb 229 (normal bdf ("thai24.bdf" "thai-24.bdf") iso-8859-11))
2cb842ae 230 (greek-iso8859-7
76875dcb 231 (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") iso-8859-7))
2cb842ae 232 (hebrew-iso8859-8
76875dcb
KH
233 (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") iso-8859-8))
234 (jisx0201
235 (normal bdf "12x24rk.bdf" jisx0201))
2cb842ae 236 (cyrillic-iso8859-5
76875dcb
KH
237 (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") iso-8859-5))
238 (iso-8859-9
239 (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-8859-9))
2cb842ae 240 (chinese-gb2312
76875dcb 241 (normal bdf "gb24st.bdf"))
2cb842ae 242 (japanese-jisx0208
76875dcb 243 (normal bdf "jiskan24.bdf"))
2cb842ae 244 (korean-ksc5601
76875dcb 245 (normal bdf "hanglm24.bdf"))
2cb842ae 246 (japanese-jisx0212
76875dcb 247 (normal bdf ("jksp40.bdf" "jisksp40.bdf")))
2cb842ae 248 (chinese-cns11643-1
76875dcb 249 (normal bdf ("cns1-40.bdf" "cns-1-40.bdf")))
2cb842ae 250 (chinese-cns11643-2
76875dcb
KH
251 (normal bdf ("cns2-40.bdf" "cns-2-40.bdf")))
252 (big5
253 (normal bdf "taipei24.bdf"))
2cb842ae 254 (chinese-sisheng
76875dcb 255 (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf")))
2cb842ae 256 (ipa
76875dcb
KH
257 (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ipa))
258 (viscii
259 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf")))
2cb842ae 260 (arabic-digit
76875dcb 261 (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf")))
2cb842ae 262 (arabic-1-column
76875dcb 263 (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf")))
2cb842ae 264 (lao
76875dcb 265 (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") ps-mule-encode-lao 1))
2cb842ae 266 (arabic-2-column
76875dcb
KH
267 (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf")))
268 (devanagari-cdac
269 (normal bdf "dvsr0ntt-32.bdf"))
270 (malayalam-cdac
271 (normal bdf "mlkr0ntt-32.bdf"))
272 (tamil-cdac
273 (normal bdf "tmvl0ntt-32.bdf"))
2cb842ae 274 (indian-is13194
76875dcb 275 (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf")))
2cb842ae 276 (indian-1-column
76875dcb 277 (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf")))
2cb842ae 278 (ethiopic
76875dcb 279 (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") unicode-bmp))
2cb842ae 280 (chinese-cns11643-3
76875dcb 281 (normal bdf ("cns3-40.bdf" "cns-3-40.bdf")))
2cb842ae 282 (chinese-cns11643-4
76875dcb 283 (normal bdf ("cns4-40.bdf" "cns-4-40.bdf")))
2cb842ae 284 (chinese-cns11643-5
76875dcb 285 (normal bdf ("cns5-40.bdf" "cns-5-40.bdf")))
2cb842ae 286 (chinese-cns11643-6
76875dcb 287 (normal bdf ("cns6-40.bdf" "cns-6-40.bdf")))
2cb842ae 288 (chinese-cns11643-7
76875dcb 289 (normal bdf ("cns7-40.bdf" "cns-7-40.bdf")))
2cb842ae 290 (indian-2-column
76875dcb 291 (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf")))
2cb842ae 292 (tibetan
76875dcb
KH
293 (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")))
294 (unicode-bmp
295 (normal bdf "etl24-unicode.bdf"))
296 )
2cb842ae
KH
297 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
298BDF (Bitmap Distribution Format) is a format used for distributing X's font
299source file.
300
d0d08a25
EZ
301Current default value list for BDF fonts is included in `intlfonts-1.2'
302which is a collection of X11 fonts for all characters supported by Emacs.
2cb842ae 303
d0d08a25
EZ
304Using this list as default value to `ps-mule-font-info-database', all
305characters including ASCII and Latin-1 are printed by BDF fonts.
2cb842ae
KH
306
307See also `ps-mule-font-info-database-ps-bdf'.")
308
309(defconst ps-mule-font-info-database-ps-bdf
310 (cons (car ps-mule-font-info-database-latin)
311 (cdr (cdr ps-mule-font-info-database-bdf)))
312 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
313
d0d08a25
EZ
314Current default value list for BDF fonts is included in `intlfonts-1.2'
315which is a collection of X11 fonts for all characters supported by Emacs.
2cb842ae 316
d0d08a25
EZ
317Using this list as default value to `ps-mule-font-info-database', all
318characters except ASCII and Latin-1 characters are printed with BDF fonts.
319ASCII and Latin-1 characters are printed with PostScript font specified
320by `ps-font-family' and `ps-header-font-family'.
2cb842ae
KH
321
322See also `ps-mule-font-info-database-bdf'.")
323
76875dcb
KH
324(defvar ps-mule-font-spec-list nil
325 "Array of FONT-SPEC lists for each font type.
2cb842ae 326
76875dcb
KH
327Elements are for `normal' font, `bold' font, `italic' font, and
328`bold-italic' font in this order.
329
330Each element is a list of FONT-SPEC which has this form:
2cb842ae 331
76875dcb
KH
332 (ID CHARSET (FONT-SRC FONT-NAME ENCODING) EXTRA-DATA)
333
334Where
335
336ID is a number for this FONT-SPEC and is unique in the list.
337
338CHARSET, FONT-SRC, FONT-NAME, ENCODING are the same as those in
339`ps-mule-font-info-database' (which see).
340
341EXTRA-DATA is a data attached by external libraries.
342
343Each list is ordered by the current charset priorities.
344
345This variable is setup by `ps-mule-begin-job' from
346`ps-mule-font-info-database'.")
347
348;; Functions to access each element of FONT-SPEC.
349(defsubst ps-mule-font-spec-id (font-spec) (aref font-spec 0))
350(defsubst ps-mule-font-spec-charset (font-spec) (aref font-spec 1))
351(defsubst ps-mule-font-spec-font-id (font-spec) (aref font-spec 2))
352(defsubst ps-mule-font-spec-src (font-spec) (aref font-spec 3))
353(defsubst ps-mule-font-spec-name (font-spec) (aref font-spec 4))
354(defsubst ps-mule-font-spec-set-name (font-spec name)
355 (aset font-spec 4 name))
356(defsubst ps-mule-font-spec-encoding (font-spec) (aref font-spec 5))
357(defsubst ps-mule-font-spec-bytes (font-spec) (aref font-spec 6))
358(defsubst ps-mule-font-spec-extra (font-spec) (aref font-spec 7))
359(defsubst ps-mule-font-spec-set-extra (font-spec extra)
360 (aset font-spec 7 extra))
361
362;; Functions to encode character into glyph code.
363(defun ps-mule-encode-lao (char)
364 (- char #x0DE0))
365
366(defun ps-mule-encode-char (char font-spec)
367 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
368 (cond ((charsetp encoding)
369 (encode-char char encoding))
370 ((fboundp encoding)
371 (funcall encoding char))
372 (t
373 char))))
374
375;; Array of FONT-SPEC-TABLEs; Nth element is for FONT-TYPE N.
376;;
377;; FONT-TYPE is 0, 1, 2, or 3 representing normal, bold, italic, and
378;; bold-italic respectively.
379;;
380;; FONT-SPEC-TABLE is a char-table of FONT-SPECs. It records which
381;; character is printed by which FONT-SPEC. It has one extra slot
382;; whose value is an alist of the form:
383;; (CHARSET . FONT-SPEC)
384;; FONT-SPEC is a vecotr of the form:
385;; (ID FONT-SRC FONT-NAME ENCODING EXTRA)
386(defvar ps-mule-font-spec-tables nil)
387
388;; Array of FONT-TYPEs; Nth element FONT-NUMBER N.
389;;
390;; FONT-NUMBER is 0, 1, 2, 3, 4, 5, 6 representing fonts f0, f1, f2,
391;; f3, h0, h1, and H0.
392(defconst ps-mule-font-number-to-type [ 0 1 2 3 1 0 0 ])
393
394(defsubst ps-mule-get-font-spec (char font-spec-table font-spec)
395 "Return a font spec for printing CHAR with FONT-SPEC-TABLE.
396
397FONT-SPEC, if non-nil, is a font spec to try at first.
398
399See the documentation of `ps-mule-font-spec-tables' for the
400format of font spec."
401
402 (or (aref font-spec-table char)
403 (aset font-spec-table char
404 (or (and (< char 256)
405 (cdr (car (char-table-extra-slot font-spec-table 0))))
406 (and font-spec
407 (encode-char char (ps-mule-font-spec-charset font-spec))
408 font-spec)
409 (catch 'tag
410 (dolist (elt (char-table-extra-slot font-spec-table 0))
411 (and (encode-char char (car elt))
412 (throw 'tag (cdr elt)))))
413 ;; Record that no font-spec exist for CHAR.
414 t))))
2cb842ae
KH
415
416(defconst ps-mule-external-libraries
41a247c2
VJL
417 '((builtin nil nil nil
418 nil nil nil)
419 (bdf ps-bdf nil bdf-generate-prologue
420 bdf-check-font bdf-generate-font bdf-generate-glyph)
421 (pcf nil nil pcf-generate-prologue
422 pcf-check-font pcf-generate-font pcf-generate-glyph)
423 (vflib nil nil vflib-generate-prologue
424 vflib-check-font vflib-generate-font vflib-generate-glyphs))
425 "Alist of external libraries information to support PostScript printing.
2cb842ae
KH
426Each element has the form:
427
41a247c2
VJL
428 (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC
429 CHECK-FUNC FONT-FUNC GLYPH-FUNC)
2cb842ae
KH
430
431FONT-SRC is the font source: builtin, bdf, pcf, or vflib.
432
433FEATURE is the feature that provide a facility to handle FONT-SRC. Except for
434`builtin' FONT-SRC, this feature is automatically `require'd before handling
435FONT-SRC. Currently, we only have the feature `ps-bdf'.
436
437INITIALIZED-P indicates if this library is initialized or not.
438
41a247c2
VJL
439PROLOGUE-FUNC is a function to generate PostScript code which define several
440PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
441called with no argument, and should return a list of strings.
2cb842ae 442
76875dcb 443CHECK-FUNC is a function to check if a font is available or not.
41a247c2
VJL
444It is called with one argument FONT-SPEC, and should return non-nil iff the
445font specified in FONT-SPEC is available.
2cb842ae 446
41a247c2
VJL
447FONT-FUNC is a function to generate PostScript code which define a new font.
448It is called with one argument FONT-SPEC, and should return a list of strings.
76875dcb 449
41a247c2
VJL
450GLYPH-FUNC is a function to generate PostScript code which define glyphs of
451characters. It is called with two arguments FONT-SPEC and CODE, and should
452return a list of strings.")
2cb842ae 453
76875dcb
KH
454(defsubst ps-mule-exlib-feature (exlib) (nth 1 exlib))
455(defsubst ps-mule-exlib-initialized-p (exlib) (nth 2 exlib))
456(defsubst ps-mule-exlib-set-initialized-p (exlib val)
457 (setcar (nthcdr 2 exlib) val))
458(defsubst ps-mule-exlib-prologue (exlib) (nth 3 exlib))
459(defsubst ps-mule-exlib-check (exlib) (nth 4 exlib))
460(defsubst ps-mule-exlib-font (exlib) (nth 5 exlib))
461(defsubst ps-mule-exlib-glyph (exlib) (nth 6 exlib))
462
463(defun ps-mule-init-external-library (exlib)
464 "Initialize external library specified by EXLIB for PostScript printing.
465See the documentation of `ps-mule-external-libraries' for EXLIB's meaning."
466 (or (ps-mule-exlib-initialized-p exlib)
467 (let ((prologue-func (ps-mule-exlib-prologue exlib)))
468 (if prologue-func
469 (let ((feature (ps-mule-exlib-feature exlib)))
470 (if feature
471 (require feature))
472 (ps-output-prologue (funcall prologue-func))))
473 (ps-mule-exlib-set-initialized-p exlib t))))
474
475(defvar ps-mule-output-list nil)
476
477(defun ps-mule-check-font (font-spec)
478 "Check if a font specified in FONT-SPEC is available or not."
479 (let ((font-src (ps-mule-font-spec-src font-spec)))
2cb842ae 480 (or (not font-src)
76875dcb
KH
481 (let ((exlib (assq font-src ps-mule-external-libraries)))
482 (ps-mule-init-external-library exlib)
483 (or (not (ps-mule-exlib-check exlib))
484 (funcall (ps-mule-exlib-check exlib) font-spec))))))
2cb842ae 485
76875dcb 486(defun ps-mule-prepare-font (font-spec)
41a247c2 487 "Generate PostScript codes defining a new font of FONT-SPEC for charset."
76875dcb
KH
488 (let* ((font-src (ps-mule-font-spec-src font-spec))
489 (exlib (assq font-src ps-mule-external-libraries))
490 (id (ps-mule-font-spec-id font-spec))
491 (ftag (format "%02X" id))
492 (font-func (ps-mule-exlib-font exlib))
493 output-list)
494 (if font-func
495 (setq output-list (funcall font-func font-spec))
496 (setq output-list
497 (format "/F%s /%s findfont def\n"
498 ftag (or (ps-mule-font-spec-name font-spec) "Courier")))
499 (ps-mule-font-spec-set-extra font-spec t))
500 (and output-list
501 (nconc ps-mule-output-list (list output-list)))))
502
503(defun ps-mule-prepare-glyph (char font-spec)
504 "Generate PostScript codes to print CHAR by FONT-SPEC.
505
506If CHAR is a cons (FROM TO), generate codes for characters
507specified by the character code range FROM and TO.
508
509The generated code is inserted on prologue part."
510 (if (vectorp font-spec)
511 (progn
512 (or (ps-mule-font-spec-extra font-spec)
513 (ps-mule-prepare-font font-spec))
514 (let ((glyph-func (ps-mule-exlib-glyph
515 (assq (ps-mule-font-spec-src font-spec)
516 ps-mule-external-libraries))))
517 (if glyph-func
518 (let (from to output-list)
519 (if (consp char)
520 (setq from (car char) to (cdr char))
521 (setq from char to char))
522 (while (<= from to)
523 (setq output-list
524 (funcall glyph-func font-spec from))
525 (and output-list
526 (ps-output-prologue output-list))
527 (setq from (1+ from)))))))))
2cb842ae
KH
528
529;; This is a PostScript code inserted in the header of generated PostScript.
530(defconst ps-mule-prologue
531 "%%%% Start of Mule Section
532
440756f0
KH
533/Latin1Encoding { % newname fontname | font
534 findfont dup length dict begin
535 { 1 index /FID ne { def } { pop pop } ifelse } forall
536 /Encoding ISOLatin1Encoding def
537 currentdict
538 end
539 definefont
540} bind def
541
76875dcb
KH
542%% Redefine fonts for multiple charsets.
543/ReDefFont { % fontname encoding fdepvector size | -
544 20 dict begin
545 3 index findfont {
546 1 index /FID ne 2 index /UniqueID ne and {def} {pop pop} ifelse
547 } forall
548 /FontType 0 def
549 /FMapType 3 def
550 /EscChar 0 def
551 % FontMatrix ::= [ size 0 0 size 0 0 ]
552 /FontMatrix exch [ exch dup 0 exch 0 exch 0 0 ] def
553 /FDepVector exch def
554 /Encoding exch def
555 currentdict
556 end % fontname dic
557 definefont pop
440756f0 558} bind def
2cb842ae
KH
559"
560 "PostScript code for printing multi-byte characters.")
561
562(defvar ps-mule-prologue-generated nil)
563
76875dcb
KH
564;; EscChar used in generated composite fonts.
565(defconst ps-mule-esc-char 0)
566
2cb842ae
KH
567(defun ps-mule-prologue-generated ()
568 (unless ps-mule-prologue-generated
569 (ps-output-prologue ps-mule-prologue)
41a247c2
VJL
570 (ps-output-prologue
571 (format "\n/EscChar %d def\n\n%%%% End of Mule Section\n\n"
572 ps-mule-esc-char))
2cb842ae
KH
573 (setq ps-mule-prologue-generated t)))
574
76875dcb
KH
575(defun ps-mule-encode-region (from to font-spec-table)
576 "Generate PostScript code for plotting characters in the region FROM and TO.
2cb842ae 577
41a247c2
VJL
578FONT-SPEC-TABLE is 0, 1, 2, 3, 4, 5, or 6, each represents font tags f0, f1,
579f2, f3, h0, h1, and H0 respectively."
76875dcb
KH
580 (let* ((font-spec nil)
581 (font-id 0)
582 (string-list nil)
583 ;; At most 4-byte (EscChar FONT-ID CODE1 CODE2) per character.
584 (str (make-string (* (- to from) 4) 0))
585 (i 0))
586 (goto-char from)
587 (while (< (point) to)
588 (let* ((char (following-char))
589 (this-spec (ps-mule-get-font-spec char font-spec-table font-spec))
590 this-id)
591 (if (vectorp this-spec)
592 (setq this-id (ps-mule-font-spec-font-id this-spec))
593 ;; Can't print CHAR. Replace it with '?'.
594 (setq char ??
595 this-spec (ps-mule-get-font-spec char font-spec-table nil)
596 this-id (ps-mule-font-spec-font-id this-spec)))
597 (or (= font-id this-id)
598 (progn
599 (if font-spec
600 (setq string-list (cons (substring str 0 i) string-list)
601 i 0))
602 (setq font-id this-id)
603 (or (= font-id 0)
604 (progn
605 (aset str i ps-mule-esc-char)
606 (setq i (1+ i))
607 (aset str i font-id)
608 (setq i (1+ i))))))
609 (setq font-spec this-spec)
610 (if (< char 128)
611 (aset str i char)
612 (let* ((code (ps-mule-encode-char char font-spec)))
613 (if (= (ps-mule-font-spec-bytes font-spec) 1)
cb0ff0f1
KH
614 (aset str i code)
615 (aset str i (/ code 256))
76875dcb 616 (setq i (1+ i))
cb0ff0f1 617 (aset str i (% code 256)))))
76875dcb
KH
618 (setq i (1+ i))
619 (forward-char 1)))
620 (nreverse (cons (substring str 0 i) string-list))))
621
622(defun ps-mule-plot-composition (composition font-spec-table)
41a247c2 623 "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE."
76875dcb
KH
624 (ps-output "[")
625 (let ((components (copy-sequence (nth 2 composition)))
626 (font-spec nil))
627 (dotimes (i (length components))
628 (let ((elt (aref components i))
629 this-spec)
630 (if (consp elt)
631 ;; ELT is a composition rule.
632 (ps-output (format " %d" (encode-composition-rule elt)))
633 ;; ELT is a glyph character.
634 (setq this-spec
635 (ps-mule-get-font-spec elt font-spec-table font-spec))
636 (or (vectorp this-spec)
637 ;; Can't print CHAR. Replace it with '?'.
638 (setq elt ??
639 this-spec
640 (ps-mule-get-font-spec elt font-spec-table font-spec)))
641 (setq font-spec this-spec)
642 (let* ((bytes (ps-mule-font-spec-bytes font-spec))
643 (code (ps-mule-encode-char elt font-spec))
644 (font-id (ps-mule-font-spec-font-id font-spec))
645 (str (make-string (if (= font-id 0) 1 (+ 2 bytes)) 0)))
646 (if (= font-id 0)
cb0ff0f1 647 (aset str 0 code)
76875dcb 648 (aset str 0 ps-mule-esc-char)
cb0ff0f1 649 (aset str 1 font-id)
76875dcb 650 (if (= bytes 1)
cb0ff0f1
KH
651 (aset str 2 code)
652 (aset str 2 (/ code 256))
653 (aset str 3 (% code 256))))
76875dcb
KH
654 (ps-output "[")
655 (ps-output-string str)
656 (ps-output (if (eq (ps-mule-font-spec-src font-spec) 'bdf)
657 (format "/C%02X-%X" (ps-mule-font-spec-id font-spec)
658 elt)
659 "false"))
660 (ps-output "]"))))))
661 (ps-output " ] " (if (nth 3 composition) "RLC" "RBC") "\n"))
2cb842ae 662
2cb842ae 663(defun ps-mule-plot-string (from to &optional bg-color)
922be019 664 "Generate PostScript code for plotting characters in the region FROM and TO.
2cb842ae 665
76875dcb 666Optional argument BG-COLOR is ignored.
d0da93b3
KH
667
668Returns the value:
669
670 (ENDPOS . RUN-WIDTH)
671
672Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
673the sequence."
76875dcb
KH
674 (let* ((average-width (ps-avg-char-width 'ps-font-for-text))
675 (point (point))
676 (composition (find-composition from to nil t))
677 (stop (if composition (car composition) to))
678 (ascii-or-latin-1 "[\000-\377]+")
679 (run-width 0)
680 (endpos nil)
681 (font-spec-table (aref ps-mule-font-spec-tables
682 (aref ps-mule-font-number-to-type
683 ps-current-font)))
684 width)
685 (goto-char from)
686 (while (not endpos)
687 (cond ((= (point) stop)
688 (if (= stop to)
689 (setq endpos stop)
690 (if (< from stop)
691 (dolist (l (ps-mule-encode-region from (point)
692 font-spec-table))
693 (ps-output-string l)
694 (ps-output " S\n")))
695 (setq width (* (nth 5 composition) average-width))
696 (if (< ps-width-remaining (+ run-width width))
697 (setq endpos stop)
698 (ps-mule-plot-composition composition font-spec-table)
699 (setq run-width (+ run-width width)
700 from (nth 1 composition))
701 (goto-char from)
702 (setq composition (find-composition (point) to nil t))
703 (setq stop (if composition (car composition) to)))))
704
705 ((looking-at ascii-or-latin-1)
706 (let ((nchars (- (min (match-end 0) stop) (point))))
707 (setq width (* average-width nchars))
708 (if (< ps-width-remaining (+ run-width width))
709 (setq nchars (truncate (- ps-width-remaining run-width)
710 average-width)
711 run-width (+ run-width (* nchars average-width))
712 endpos (+ (point) nchars))
713 (setq run-width (+ run-width width))
714 (forward-char nchars))))
715
716 (t
717 (while (and (< (point) stop) (not endpos))
718 (setq width (char-width (following-char)))
719 (if (< ps-width-remaining (+ run-width width))
720 (setq endpos (point))
721 (setq run-width (+ run-width width))
722 (forward-char 1))))))
723
724 (if (< from endpos)
725 (dolist (l (ps-mule-encode-region from endpos font-spec-table))
726 (ps-output-string l)
727 (ps-output " S\n")))
728 (goto-char point)
729 (cons endpos run-width)))
730
731;; Character composition support
2cb842ae 732
d0da93b3 733(defvar ps-mule-composition-prologue-generated nil)
2cb842ae 734
d0da93b3 735(defconst ps-mule-composition-prologue
76875dcb 736 "%%%% Procedures for character composition.
d0da93b3 737/RelativeCompositionSkip 0.4 def
2cb842ae
KH
738
739%% Get a bounding box (relative to currentpoint) of STR.
76875dcb
KH
740/GetPathBox { % [ str cname ] | -
741 dup 1 get dup false ne {
742 BitmapDict exch get /bmp exch def
743 %% bmp ::= [ DWIDTH WIDTH HEIGHT XOFF YOFF BITMAP RELATIVE-COMPOSE]
744 /LLY bmp 4 get def
745 /URY LLY bmp 2 get add def
746 /RelativeCompose bmp 6 get dup false ne {
747 dup LLY le { pop 1 } { URY ge { -1 } { 0 } ifelse } ifelse
748 } {
749 pop 0
750 } ifelse def
751 dup 0 get stringwidth pop dup /WIDTH exch def bmp 0 get div
752 dup LLY mul /LLY exch def
753 URY mul /URY exch def
2cb842ae 754 } {
76875dcb
KH
755 pop
756 dup 0 get stringwidth pop /WIDTH exch def
757 gsave 0 0 moveto
758 dup 0 get false charpath flattenpath pathbbox
759 /URY exch def pop /LLY exch def pop
760 grestore
761 /RelativeCompose 0 def
2cb842ae 762 } ifelse
2cb842ae
KH
763} bind def
764
76875dcb
KH
765%% Apply effects except for shadow and outline to the rectangle
766%% specified by TOP BOTTOM LEFT RIGHT.
767/SpecialEffect { % -- | --
d0da93b3
KH
768 currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def
769 dup LEFT add /xx exch def RIGHT add /XX exch def
770 %% Adjust positions for future shadowing.
771 Effect 8 and 0 ne {
772 /yy yy Yshadow add def
773 /XX XX Xshadow add def
774 } if
775 Effect 1 and 0 ne { UnderlinePosition Hline } if % underline
776 Effect 2 and 0 ne { StrikeoutPosition Hline } if % strikeout
777 Effect 4 and 0 ne { OverlinePosition Hline } if % overline
778 bg { % background
779 true
780 Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse
781 } if
782 Effect 16 and 0 ne { false 0 doBox } if % box
783} def
2cb842ae 784
76875dcb
KH
785%% Draw COMPONENTS which has the form [ [str0 xoff0 yoff0] ... ] with
786%% effects shadow and outline.
787/ShowComponents { % components | -
788 gsave
789 { gsave aload pop rmoveto
790 Effect 8 and 0 ne { dup doShadow } if
791 Effect 32 and 0 ne { true doOutline } { show } ifelse
792 grestore
d0da93b3 793 } forall
76875dcb 794 grestore
d0da93b3
KH
795 RIGHT 0 rmoveto
796} def
797
798%% Show relative composition.
76875dcb 799/RLC { % [[str0 cname0] [str1 cname1] ... [strN cnameN]] | -
d0da93b3 800 /components exch def
76875dcb
KH
801 [ % push [str xoff yoff] one by one
802 [ components 0 get GetPathBox aload pop pop 0 0 ]
803 %% Bounding box of overall glyphs.
804 /LEFT 0 def
805 /RIGHT WIDTH def
806 /TOP URY def
807 /BOTTOM LLY def
808
809 1 1 components length 1 sub {
810 components exch get
811 [ exch
812 GetPathBox
813 aload pop pop % str
814 0 % xoff
815 RelativeCompose 1 eq { % compose on TOP
816 TOP LLY sub RelativeCompositionSkip add % yoff
817 /TOP TOP URY LLY sub add RelativeCompositionSkip add def
818 } { RelativeCompose -1 eq { % compose under BOTTOM
819 BOTTOM URY sub RelativeCompositionSkip sub % yoff
820 /BOTTOM BOTTOM URY LLY sub sub
821 RelativeCompositionSkip sub def
d0da93b3 822 } {
76875dcb
KH
823 0 % yoff
824 URY TOP gt { /TOP URY def } if
825 LLY BOTTOM lt { /BOTTOM LLY def } if
826 } ifelse } ifelse
827 ]
828 } for
829 ]
830 SpecialEffect % Reflect special effects.
831 ShowComponents % Draw components.
d0da93b3
KH
832} def
833
834%% Show rule-base composition.
76875dcb 835/RBC { % [[str0 cname0] rule1 [str1 cname0] rule2 ... [strN cnameN]] | -
d0da93b3 836 /components exch def
76875dcb
KH
837 [ % push [str xoff yoff] one by one
838 [ components 0 get GetPathBox aload pop pop 0 0 ]
839 %% Bounding box of overall glyphs.
840 /LEFT 0 def
841 /RIGHT WIDTH def
842 /TOP URY def
843 /BOTTOM LLY def
844 1 1 components length 1 sub {
845 components exch get /elt exch def
846 elt type /integertype eq { % rule
847 %% Do the same RULE decoding as the macro
922be019 848 %% COMPOSITION_DECODE_RULE in emacs/src/composite.h.
d0da93b3
KH
849 elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def
850 elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def
d0da93b3 851 } { % other strings
76875dcb 852 [
d0da93b3 853 elt GetPathBox
76875dcb 854 aload pop pop
d0da93b3 855 /height URY LLY sub def
76875dcb
KH
856 /left LEFT [ 0 RIGHT LEFT sub dup 2 div exch ] grefx get add
857 [ 0 WIDTH 2 div WIDTH ] nrefx get sub def
d0da93b3
KH
858 /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get
859 [ height LLY neg 0 height 2 div ] nrefy get sub def
860 %% Update bounding box
861 left LEFT lt { /LEFT left def } if
76875dcb 862 left WIDTH add RIGHT gt { /RIGHT left WIDTH add def } if
d0da93b3
KH
863 bottom BOTTOM lt { /BOTTOM bottom def } if
864 bottom height add TOP gt { /TOP bottom height add def } if
76875dcb
KH
865 left bottom LLY sub ]
866 } ifelse
867 } for
868 ]
64ed6f71 869
76875dcb
KH
870 LEFT 0 lt { % Adjust xoff to the right.
871 dup { dup 1 get LEFT sub 1 exch put } forall
872 /RIGHT RIGHT LEFT sub def
873 } if
d0da93b3 874
76875dcb
KH
875 SpecialEffect % Reflect special effects.
876 ShowComponents % Draw components.
d0da93b3 877} def
41a247c2 878
76875dcb 879%%%% End of procedures for character composition
2cb842ae 880"
922be019 881 "PostScript code for printing character composition.")
2cb842ae 882
76875dcb
KH
883(defun ps-mule-composition-prologue-generated ()
884 (unless ps-mule-composition-prologue-generated
885 (ps-mule-prologue-generated)
886 (ps-output-prologue ps-mule-composition-prologue)
887 (setq ps-mule-composition-prologue-generated t)))
2cb842ae
KH
888
889;; Bitmap font support
890
891(defvar ps-mule-bitmap-prologue-generated nil)
892
893(defconst ps-mule-bitmap-prologue
76875dcb 894 "%%%% Procedures for bitmap fonts.
2cb842ae 895
76875dcb
KH
896%% Create a base bitmap font.
897/NBF { % fontname fontsize relative-compose baseline-offset enc | --
898 11 dict begin
899 /FontType 3 def
900 /FontMatrix matrix def
901 /FontBBox [ 0 0 0 0 ] def
902 /Encoding exch def
2cb842ae
KH
903 /BaselineOffset exch def
904 /RelativeCompose exch def
905 /FontSize exch def
76875dcb
KH
906 /FontMatrix [ 1 FontSize div 0 0 1 FontSize div 0 0 ] def
907 /BuildGlyph { % fontdict charname | -
908 BitmapDict exch get /bmp exch def pop
909 %% bmp ::= [ DWIDTH WIDTH HEIGHT XOFF YOFF BITMAP RELATIVE-COMPOSE ]
910 /llx bmp 3 get def
911 /lly bmp 4 get def
912 /urx llx bmp 1 get add def
913 /ury lly bmp 2 get add def
914 bmp 0 get 0 llx lly urx ury setcachedevice
915 bmp 5 get length 0 gt {
916 llx ury translate
917 bmp 1 get bmp 2 get
918 true [ 1 0 0 -1 0 0 ] { bmp 5 get } imagemask
919 } if
920 } bind def
921 /BuildChar { % fontdict byte | -
922 1 index /Encoding get exch get
923 1 index /BuildGlyph get exec
924 } bind def
925 dup currentdict end
926 definefont def
2cb842ae
KH
927} bind def
928
76875dcb
KH
929%% Create a parent font of 8/8 mapping.
930/NPF { % fontname encoding fdepvector | -
931 8 dict begin
932 /FontType 0 def
933 /FMapType 2 def
934 /FontMatrix matrix def
935 /FDepVector exch def
936 /Encoding exch def
937 dup currentdict
938 end
939 definefont def
2cb842ae 940} bind def
2cb842ae 941
76875dcb 942%%%% End of procedures for bitmap fonts.
2cb842ae
KH
943")
944
945;; External library support.
946
76875dcb 947(defvar ps-mule-bitmap-dict-list nil)
a4c2acb3 948(defvar ps-mule-bitmap-font-record nil)
76875dcb 949
2cb842ae
KH
950;; The following three functions are to be called from external
951;; libraries which support bitmap fonts (e.g. `bdf') to get
952;; appropriate PostScript code.
953
954(defun ps-mule-generate-bitmap-prologue ()
955 (unless ps-mule-bitmap-prologue-generated
76875dcb
KH
956 (setq ps-mule-bitmap-prologue-generated t
957 ps-mule-bitmap-dict-list nil
958 ps-mule-bitmap-font-record (make-vector 1024 nil))
2cb842ae
KH
959 (list ps-mule-bitmap-prologue)))
960
76875dcb
KH
961(defun ps-mule-generate-bitmap-font (font-spec size relative-compose
962 baselie-offset bbx)
963 (let* ((id (ps-mule-font-spec-id font-spec))
964 (bytes (ps-mule-font-spec-bytes font-spec))
965 output-list)
966 (if (= bytes 1)
967 (setq output-list
968 (list (format "/E%02X [ 0 1 255 {pop /.notdef} for ] def\n" id)
969 (format "%%%% %s\n" (ps-mule-font-spec-name font-spec))
970 (format "/F%02X %f %S %d E%02X NBF\n" id size
971 relative-compose baselie-offset id)))
972 (setq output-list
973 (list (list (format "/E%02X [ 0 1 255 { pop 0 } for ] def\n" id))
974 (list (format "/V%02X [" id))
975 " ] def\n"
976 (format "%%%% %s\n" (ps-mule-font-spec-name font-spec))
977 (format "/F%02X E%02X V%02X NPF\n" id id id))))
978 (aset ps-mule-bitmap-font-record id
979 (vector (= bytes 1) output-list
980 size relative-compose baselie-offset bbx))
981 (if ps-mule-bitmap-dict-list
982 output-list
983 (setq ps-mule-bitmap-dict-list (list "/BitmapDict <<\n" ">> def\n"))
984 (cons ps-mule-bitmap-dict-list output-list))))
985
986(defun ps-mule-generate-bitmap-glyph (font-spec char code bitmap)
987 (let* ((id (ps-mule-font-spec-id font-spec))
988 ;; FONT-RECORD ::= ([(SUBFONT-OUTPUT-LIST ...) | t]
989 ;; BASEFONT-OUTPUT-LIST SIZE REL-COMP B-OFFSET BBX)
990 (font-record (aref ps-mule-bitmap-font-record id))
991 enc-name
992 output-list)
993 (if (listp (aref font-record 0))
994 ;; This is a 2-dimensional font. Create a subfont for this
995 ;; glyph if not yet created.
996 (let* ((high (/ code 256))
997 (id2 (+ (* id 256) high)))
998 (setq output-list (cdr (assq high (aref font-record 0)))
999 code (% code 256))
1000 (or output-list
1001 ;; We must create a subfont.
1002 (let ((enc-list (car (aref font-record 1)))
1003 (fdep-list (nth 1 (aref font-record 1))))
1004 (setq output-list
1005 (list
1006 (format "/E%04X [ 0 1 255 {pop /.notdef} for ] def\n"
1007 id2)
1008 (format "/F%04X %f %S %d E%04X NBF\n"
1009 id2 (aref font-record 2) (aref font-record 3)
1010 (aref font-record 4) id2)
1011 (format "E%02X %d %d put\n"
1012 id high (1- (length fdep-list)))))
1013 (nconc enc-list (list output-list))
1014 (nconc fdep-list (list (format " F%04X" id2)))
1015 (aset font-record 0
1016 (cons (cons high output-list) (aref font-record 0)))))
1017 (setq enc-name (format "%04X" id2)))
1018 (setq output-list (aref font-record 1)
1019 enc-name (format "%02X" id)))
1020 (setcdr ps-mule-bitmap-dict-list
1021 (cons (format "/C%02X-%X %s\n" id char bitmap)
1022 (cdr ps-mule-bitmap-dict-list)))
1023 (setcdr output-list
1024 (cons (format "E%s %d /C%02X-%X put\n" enc-name code id char)
1025 (cdr output-list))))
1026 nil)
2cb842ae
KH
1027
1028;; Mule specific initializers.
1029
1030;;;###autoload
1031(defun ps-mule-initialize ()
1032 "Initialize global data for printing multi-byte characters."
76875dcb 1033 (setq ps-mule-prologue-generated nil
d0da93b3 1034 ps-mule-composition-prologue-generated nil
2cb842ae
KH
1035 ps-mule-bitmap-prologue-generated nil)
1036 (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
1037 ps-mule-external-libraries))
1038
922be019
GM
1039(defun ps-mule-encode-header-string (string fonttag)
1040 "Generate PostScript code for ploting STRING by font FONTTAG.
41a247c2
VJL
1041FONTTAG should be a string \"/h0\", \"/h1\", \"/L0\", or \"/H0\".
1042Any other value is treated as \"/H0\"."
76875dcb
KH
1043 (with-temp-buffer
1044 (insert string)
1045 (ps-mule-encode-region (point-min) (point-max)
1046 (aref ps-mule-font-spec-tables
1047 (aref ps-mule-font-number-to-type
1048 (cond ((string= fonttag "/h0") 4)
1049 ((string= fonttag "/h1") 5)
1050 ((string= fonttag "/L0") 6)
1051 (t 0)))))))
922be019 1052
2cb842ae
KH
1053;;;###autoload
1054(defun ps-mule-begin-job (from to)
1055 "Start printing job for multi-byte chars between FROM and TO.
41a247c2 1056It checks if all multi-byte characters in the region are printable or not."
76875dcb
KH
1057 (auto-compose-region from to)
1058 (if (and (not (find-composition from to))
1059 (save-excursion
1060 (goto-char from)
1061 (= (skip-chars-forward "\x00-\xFF" to) to)))
1062 ;; All characters can be printed by normal PostScript fonts.
1063 (setq ps-basic-plot-string-function 'ps-basic-plot-string
1064 ps-encode-header-string-function 'identity)
1065 (setq ps-basic-plot-string-function 'ps-mule-plot-string
1066 ps-encode-header-string-function 'ps-mule-encode-header-string
1067 ps-mule-font-info-database
1068 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
1069 ps-mule-font-info-database-ps)
1070 ((eq ps-multibyte-buffer 'bdf-font)
1071 ps-mule-font-info-database-bdf)
1072 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
1073 ps-mule-font-info-database-ps-bdf)
1074 (t
1075 ps-mule-font-info-database-default)))
1076
1077 ;; Be sure to have font information for Latin-1.
1078 (or (assq 'iso-8859-1 ps-mule-font-info-database)
1079 (setq ps-mule-font-info-database
0e78bb62 1080 (cons '(iso-8859-1 (normal nil nil))
76875dcb
KH
1081 ps-mule-font-info-database)))
1082
1083 ;; Generate ps-mule-font-spec-tables.
1084 (let ((font-spec-alist (make-vector 4 nil))
1085 (id-max 0)
1086 (font-id 0)
1087 font-info-list)
1088 ;; Generate properly ordered font-info-list from
1089 ;; ps-mule-font-info-database.
1090 (let ((charset-list
1091 (copy-sequence (get-language-info current-language-environment
1092 'charset))))
1093 (setq charset-list (cons 'iso-8859-1 (delq 'iso-8859-1 charset-list)))
1094 (dolist (charset charset-list)
1095 (let ((font-info (assq charset ps-mule-font-info-database)))
1096 (and font-info
1097 (setq font-info-list (cons font-info font-info-list)))))
1098 (dolist (font-info ps-mule-font-info-database)
1099 (or (memq (car font-info) charset-list)
1100 (setq font-info-list (cons font-info font-info-list))))
1101 (setq font-info-list (nreverse font-info-list)))
1102
1103 ;; Store FONT-SPECs in each element of font-spec-alist.
1104 (dolist (font-info font-info-list)
1105 (let ((font-spec-vec (make-vector 4 nil))
1106 (charset (car font-info))
1107 encoding font-spec)
1108 (dolist (e (cdr font-info))
1109 (setq encoding (or (nth 3 e) charset)
1110 font-spec (vector id-max charset font-id
1111 (nth 1 e) (nth 2 e) encoding
1112 (or (nth 4 e) (charset-dimension encoding))
1113 nil)
1114 id-max (1+ id-max))
1115 (if (ps-mule-check-font font-spec)
1116 (aset font-spec-vec
1117 (cond ((eq (car e) 'normal) 0)
1118 ((eq (car e) 'bold) 1)
1119 ((eq (car e) 'italic) 2)
1120 (t 3)) font-spec)))
1121 (when (aref font-spec-vec 0)
1122 (or (aref font-spec-vec 3)
1123 (aset font-spec-vec 3 (or (aref font-spec-vec 1)
1124 (aref font-spec-vec 2)
1125 (aref font-spec-vec 0))))
1126 (or (aref font-spec-vec 1)
1127 (aset font-spec-vec 1 (aref font-spec-vec 0)))
1128 (or (aref font-spec-vec 2)
1129 (aset font-spec-vec 2 (aref font-spec-vec 1)))
1130 (dotimes (i 4)
1131 (aset font-spec-alist i
1132 (nconc (aref font-spec-alist i)
1133 (list (cons charset (aref font-spec-vec i))))))
1134 (setq font-id (1+ font-id)))))
1135
1136 ;; Make four FONT-SPEC-TABLEs and set them in
1137 ;; ps-mule-font-spec-tables. Each char table has one extra slot
1138 ;; whose value is an element of font-spec-alist.
1139 (setq ps-mule-font-spec-tables (make-vector 4 nil))
1140 (put 'font-spec-table 'char-table-extra-slots 1)
1141 (dotimes (i 4)
1142 (let ((table (make-char-table 'font-spec-table)))
1143 (aset ps-mule-font-spec-tables i table)
1144 (set-char-table-extra-slot table 0 (aref font-spec-alist i))
1145 ;; Be sure to have glyphs for "0123456789/" in advance for
1146 ;; page numbering.
1147 (let ((str " 0123456789/"))
1148 (dotimes (i (length str))
1149 (or (vectorp (ps-mule-get-font-spec (aref str i) table nil))
1150 (error "ASCII font not available")))))))
1151
1152 (ps-mule-prologue-generated)
1153 (if (find-composition from to)
1154 (ps-mule-composition-prologue-generated))))
1155
1156(defun ps-mule-restruct-output-list (list tail)
1157 (dolist (elt list)
1158 (if (listp elt)
1159 (setq tail (ps-mule-restruct-output-list elt tail))
1160 (setcdr tail (cons elt (cdr tail)))
1161 (setq tail (cdr tail))))
1162 tail)
1163
1164(defun ps-mule-redefine-font (font-number fonttag size ps-font)
1165 (let* ((font-type (aref ps-mule-font-number-to-type font-number))
1166 (font-spec-alist (char-table-extra-slot
1167 (aref ps-mule-font-spec-tables font-type) 0)))
1168 (ps-output-prologue
1169 (list (if (ps-mule-font-spec-src (cdr (car font-spec-alist)))
1170 ;; We ignore a font specfied in ps-font-info-database.
1171 (format "/V%s VTOP%d def\n" fonttag font-type)
440756f0
KH
1172 (format "/V%s [ VTOP%d aload pop ] def\n
1173V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
1174 fonttag font-type fonttag ps-font ps-font))
76875dcb
KH
1175 (format "/%s ETOP%d V%s %f ReDefFont\n"
1176 fonttag font-type fonttag size)))))
2cb842ae 1177
2cb842ae 1178
76875dcb
KH
1179;;;###autoload
1180(defun ps-mule-end-job ()
1181 "Finish printing job for multi-byte chars."
1182
1183 ;; Prepare root and sub fonts while generating glyphs if necessary.
1184 (let ((output-head (list t))
1185 (ps-mule-output-list (list t)))
1186 (dotimes (i 4)
1187 (map-char-table 'ps-mule-prepare-glyph
1188 (aref ps-mule-font-spec-tables i)))
1189 (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
1190 (ps-output-prologue (cdr output-head)))
1191
1192 ;; Prepare top Encoding and templates of FDepVector.
1193 (dotimes (i 4)
1194 (let ((font-spec-alist (char-table-extra-slot
1195 (aref ps-mule-font-spec-tables i) 0))
1196 font-list font-spec)
1197 (dolist (elt font-spec-alist)
1198 (setq font-spec (cdr elt))
1199 (if (ps-mule-font-spec-extra font-spec)
1200 (push (cons (ps-mule-font-spec-font-id font-spec)
1201 (ps-mule-font-spec-id font-spec))
1202 font-list)))
1203 (setq font-list (nreverse font-list))
1204 (ps-output-prologue
1205 (list (format "/ETOP%d 256 array def\n" i)
1206 (format "0 1 255 { ETOP%d exch 0 put } for\n" i)))
1207 (let ((index 0))
1208 (dolist (font font-list)
1209 (ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index))
1210 (setq index (1+ index))))
1211 (ps-output-prologue (format "/VTOP%d [%s] def\n" i
1212 (mapconcat #'(lambda (x)
1213 (format "F%02X" (cdr x)))
1214 font-list " ")))))
1215
1216 ;; Redefine fonts f0, f1, f2, f3, h0, h1, H0.
1217 (ps-mule-redefine-font 4 "h0" ps-header-title-font-size-internal
1218 (ps-font 'ps-font-for-header 'bold))
1219 (ps-mule-redefine-font 5 "h1" ps-header-font-size-internal
1220 (ps-font 'ps-font-for-header 'normal))
1221 (ps-mule-redefine-font 6 "H0" ps-footer-font-size-internal
1222 (ps-font 'ps-font-for-footer 'normal))
1223 (let ((font (ps-font-alist 'ps-font-for-text))
1224 (i 0))
1225 (while font
1226 (ps-mule-redefine-font i (format "f%d" i)
1227 ps-font-size-internal
1228 (ps-font 'ps-font-for-text (car (car font))))
1229 (setq font (cdr font)
1230 i (1+ i)))))
2cb842ae
KH
1231
1232(provide 'ps-mule)
1233
413d6d87
SM
1234;; Local Variables:
1235;; generated-autoload-file: "ps-print.el"
1236;; End:
1237
1238;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
2cb842ae 1239;;; ps-mule.el ends here